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 17 llvm::LogicalResult verifyDeclareLikeOpImpl(mlir::Value memref)18fir::FortranVariableOpInterface::verifyDeclareLikeOpImpl(mlir::Value memref) { 19 const unsigned numExplicitTypeParams = getExplicitTypeParams().size(); 20 mlir::Type memType = memref.getType(); 21 const bool sourceIsBoxValue = mlir::isa<fir::BaseBoxType>(memType); 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 = 33 mlir::dyn_cast<fir::RecordType>(getElementType())) { 34 if (numExplicitTypeParams < recordType.getNumLenParams() && !sourceIsBox) 35 return emitOpError("must be provided all the derived type length " 36 "parameters when the base is not a box"); 37 if (numExplicitTypeParams > recordType.getNumLenParams()) 38 return emitOpError("has too many length parameters"); 39 } else if (numExplicitTypeParams != 0) { 40 return emitOpError("of numeric, logical, or assumed type entity must not " 41 "have length parameters"); 42 } 43 44 if (isArray()) { 45 if (mlir::Value shape = getShape()) { 46 if (sourceIsBoxAddress) 47 return emitOpError("for box address must not have a shape operand"); 48 unsigned shapeRank = 0; 49 if (auto shapeType = mlir::dyn_cast<fir::ShapeType>(shape.getType())) { 50 shapeRank = shapeType.getRank(); 51 } else if (auto shapeShiftType = 52 mlir::dyn_cast<fir::ShapeShiftType>(shape.getType())) { 53 shapeRank = shapeShiftType.getRank(); 54 } else { 55 if (!sourceIsBoxValue) 56 emitOpError("of array entity with a raw address base must have a " 57 "shape operand that is a shape or shapeshift"); 58 shapeRank = mlir::cast<fir::ShiftType>(shape.getType()).getRank(); 59 } 60 61 std::optional<unsigned> rank = getRank(); 62 if (!rank || *rank != shapeRank) 63 return emitOpError("has conflicting shape and base operand ranks"); 64 } else if (!sourceIsBox) { 65 emitOpError("of array entity with a raw address base must have a shape " 66 "operand that is a shape or shapeshift"); 67 } 68 } 69 return mlir::success(); 70 } 71