1//===-- FortranVariableInterface.cpp.cpp ----------------------------------===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8//
9// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
10//
11//===----------------------------------------------------------------------===//
12
13#include "flang/Optimizer/Dialect/FortranVariableInterface.h"
14
15#include "flang/Optimizer/Dialect/FortranVariableInterface.cpp.inc"
16
17mlir::LogicalResult
18fir::FortranVariableOpInterface::verifyDeclareLikeOpImpl(mlir::Value memref) {
19 const unsigned numExplicitTypeParams = getExplicitTypeParams().size();
20 mlir::Type memType = memref.getType();
21 const bool sourceIsBoxValue = memType.isa<fir::BaseBoxType>();
22 const bool sourceIsBoxAddress = fir::isBoxAddress(memType);
23 const bool sourceIsBox = sourceIsBoxValue || sourceIsBoxAddress;
24 if (isCharacter()) {
25 if (numExplicitTypeParams > 1)
26 return emitOpError(
27 "of character entity must have at most one length parameter");
28 if (numExplicitTypeParams == 0 && !sourceIsBox)
29 return emitOpError("must be provided exactly one type parameter when its "
30 "base is a character that is not a box");
31
32 } else if (auto recordType = getElementType().dyn_cast<fir::RecordType>()) {
33 if (numExplicitTypeParams < recordType.getNumLenParams() && !sourceIsBox)
34 return emitOpError("must be provided all the derived type length "
35 "parameters when the base is not a box");
36 if (numExplicitTypeParams > recordType.getNumLenParams())
37 return emitOpError("has too many length parameters");
38 } else if (numExplicitTypeParams != 0) {
39 return emitOpError("of numeric, logical, or assumed type entity must not "
40 "have length parameters");
41 }
42
43 if (isArray()) {
44 if (mlir::Value shape = getShape()) {
45 if (sourceIsBoxAddress)
46 return emitOpError("for box address must not have a shape operand");
47 unsigned shapeRank = 0;
48 if (auto shapeType = shape.getType().dyn_cast<fir::ShapeType>()) {
49 shapeRank = shapeType.getRank();
50 } else if (auto shapeShiftType =
51 shape.getType().dyn_cast<fir::ShapeShiftType>()) {
52 shapeRank = shapeShiftType.getRank();
53 } else {
54 if (!sourceIsBoxValue)
55 emitOpError("of array entity with a raw address base must have a "
56 "shape operand that is a shape or shapeshift");
57 shapeRank = shape.getType().cast<fir::ShiftType>().getRank();
58 }
59
60 std::optional<unsigned> rank = getRank();
61 if (!rank || *rank != shapeRank)
62 return emitOpError("has conflicting shape and base operand ranks");
63 } else if (!sourceIsBox) {
64 emitOpError("of array entity with a raw address base must have a shape "
65 "operand that is a shape or shapeshift");
66 }
67 }
68 return mlir::success();
69}
70

source code of flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp