flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp

   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
  18 fir::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 }