Responses to review comments

[PeteSteinfeld]

Summary

I changed the error messages to specify that errors in specification
expressions could arise from either bad derived type components or type
parameters.

I moved error detection for constraint C756 from resolve-names.cpp to
check-declarations.cpp.

I collapsed a nested if statement to a single if with a more complex
condition.

In cases where we detect a type param that was not declared, I created a symbol
marked as erroneous. That avoids subsequent semantic process for expressions
containing the symbol. This change caused me to adjust tests resolve33.f90 and
resolve34.f90. Also, I avoided putting out error messages for erroneous type
param symbols in OkToAddComponent() in resolve-names.cpp and in
EvaluateParameters(), type.cpp.

flang/lib/Evaluate/check-expression.cpp

Result operator()(const ProcedureDesignator &) const {
     return "dummy procedure argument";
   }
   Result operator()(const CoarrayRef &) const { return "coindexed reference"; }
 
   Result operator()(const semantics::Symbol &symbol) const {
     if (semantics::IsNamedConstant(symbol)) {
       return std::nullopt;
     } else if (scope_.IsDerivedType() && IsVariableName(symbol)) { // C750, C754
-      return "derived type component not allowed to reference variable '"s +
+      return "derived type component or type parameter value not allowed to "
+             "reference variable '"s +
           symbol.name().ToString() + "'";
     } else if (symbol.IsDummy()) {
       if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
         return "reference to OPTIONAL dummy argument '"s +
             symbol.name().ToString() + "'";
       } else if (symbol.attrs().test(semantics::Attr::INTENT_OUT)) {
         return "reference to INTENT(OUT) dummy argument '"s +
             symbol.name().ToString() + "'";
Result operator()(const DescriptorInquiry &) const {
     // inquiries by Fold().
     return std::nullopt;
   }
 
   template <int KIND>
   Result operator()(const TypeParamInquiry<KIND> &inq) const {
     if (scope_.IsDerivedType() && !IsConstantExpr(inq) &&
         inq.parameter().owner() != scope_) { // C750, C754
-      return "non-constant reference to a type parameter inquiry "
-             "not allowed for derived type components";
+      return "non-constant reference to a type parameter inquiry not "
+             "allowed for derived type components or type parameter values";
     }
     return std::nullopt;
   }
 
   template <typename T> Result operator()(const FunctionRef<T> &x) const {
     if (const auto *symbol{x.proc().GetSymbol()}) {
       if (!semantics::IsPureProcedure(*symbol)) {
         return "reference to impure function '"s + symbol->name().ToString() +
             "'";
       }
       if (semantics::IsStmtFunction(*symbol)) {
         return "reference to statement function '"s +
             symbol->name().ToString() + "'";
       }
       if (scope_.IsDerivedType()) { // C750, C754
         return "reference to function '"s + symbol->name().ToString() +
-            "' not allowed for derived type components";
+            "' not allowed for derived type components or type parameter"
+            " values";
       }
       // TODO: other checks for standard module procedures
     } else {
       const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
       if (scope_.IsDerivedType()) { // C750, C754
         if ((table_.IsIntrinsic(intrin.name) &&
                 badIntrinsicsForComponents_.find(intrin.name) !=
                     badIntrinsicsForComponents_.end()) ||
             IsProhibitedFunction(intrin.name)) {
           return "reference to intrinsic '"s + intrin.name +
-              "' not allowed for derived type components";
+              "' not allowed for derived type components or type parameter"
+              " values";
         }
         if (table_.GetIntrinsicClass(intrin.name) ==
                 IntrinsicClass::inquiryFunction &&
             !IsConstantExpr(x)) {
           return "non-constant reference to inquiry intrinsic '"s +
-              intrin.name + "' not allowed for derived type components";
+              intrin.name +
+              "' not allowed for derived type components or type"
+              " parameter values";
         }
       } else if (intrin.name == "present") {
         return std::nullopt; // no need to check argument(s)
       }
       if (IsConstantExpr(x)) {
         // inquiry functions may not need to check argument(s)
         return std::nullopt;
       }

flang/lib/Semantics/check-declarations.cpp

void CheckHelper::Check(
   } else if (const DerivedTypeSpec * derived{type.AsDerived()}) {
     for (auto &parm : derived->parameters()) {
       Check(parm.second, canHaveAssumedTypeParameters);
     }
   }
 }
 
 void CheckHelper::Check(const Symbol &symbol) {
-  // xmark
   if (context_.HasError(symbol)) {
     return;
   }
   const DeclTypeSpec *type{symbol.GetType()};
   const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
   auto restorer{messages_.SetLocation(symbol.name())};
   context_.set_location(symbol.name());
   bool isAssociated{symbol.has<UseDetails>() || symbol.has<HostAssocDetails>()};
if (IsNamedConstant(symbol)) {
       messages_.Say(
           "A dummy argument may not also be a named constant"_err_en_US);
     }
     if (IsSaved(symbol)) {
       messages_.Say(
           "A dummy argument may not have the SAVE attribute"_err_en_US);
     }
   }
-  if (symbol.owner().IsDerivedType()) {
-    if (symbol.attrs().test(Attr::CONTIGUOUS) &&
-        !(IsPointer(symbol) && symbol.Rank() > 0)) { // C752
-      messages_.Say(
-          "A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
-    }
-  }
-}
+  if (symbol.owner().IsDerivedType() &&
+      (symbol.attrs().test(Attr::CONTIGUOUS) &&
+          !(IsPointer(symbol) && symbol.Rank() > 0))) { // C752
 
 void CheckHelper::CheckValue(
     const Symbol &symbol, const DerivedTypeSpec *derived) { // C863 - C865
   if (!IsDummy(symbol)) {
     messages_.Say(
         "VALUE attribute may apply only to a dummy argument"_err_en_US);
   }
   if (IsProcedure(symbol)) {
if (!symbol.attrs().test(Attr::INTRINSIC) &&
       // standard for this check, but it seems to be implied in multiple
       // sites, and ELEMENTAL non-intrinsic actual arguments *are*
       // explicitly forbidden.  But we allow "PROCEDURE(SIN)::dummy"
       // because it is explicitly legal to *pass* the specific intrinsic
       // function SIN as an actual argument.
       messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
     }
   } else if (symbol.owner().IsDerivedType()) {
+    if (!symbol.attrs().test(Attr::POINTER)) { // C756
+      const auto &name{symbol.name()};
+      messages_.Say(name,
+          "Procedure component '%s' must have POINTER attribute"_err_en_US,
+          name);
+    }
     CheckPassArg(symbol, details.interface().symbol(), details);
   }
   if (symbol.attrs().test(Attr::POINTER)) {
     if (const Symbol * interface{details.interface().symbol()}) {
       if (interface->attrs().test(Attr::ELEMENTAL) &&
           !interface->attrs().test(Attr::INTRINSIC)) {
         messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
             symbol.name()); // C1517

flang/lib/Semantics/resolve-names.cpp

bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
   auto &details{scope.symbol()->get<DerivedTypeDetails>()};
   std::set<SourceName> paramNames;
   for (auto &paramName : std::get<std::list<parser::Name>>(stmt.statement.t)) {
     details.add_paramName(paramName.source);
     auto *symbol{FindInScope(scope, paramName)};
     if (!symbol) {
       Say(paramName,
           "No definition found for type parameter '%s'"_err_en_US); // C742
+      // No symbol for a type param.  Create one and mark it as containing an
+      // error to improve subsequent semantic processing
+      CHECK(!attrs_);
+      attrs_ = std::make_optional<Attrs>();
+      Symbol *typeParam{MakeTypeSymbol(
+          paramName, TypeParamDetails{common::TypeParamAttr::Len})};
+      attrs_.reset();
+      typeParam->set(Symbol::Flag::Error);
     } else if (!symbol->has<TypeParamDetails>()) {
       Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US,
           *symbol, "Definition of '%s'"_en_US); // C741
     }
     if (!paramNames.insert(paramName.source).second) {
       Say(paramName,
           "Duplicate type parameter name: '%s'"_err_en_US); // C731
     }
bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
   Walk(std::get<std::list<parser::ComponentDecl>>(x.t));
   return false;
 }
 bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
   CHECK(!interfaceName_);
   return true;
 }
 void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &stmt) {
-  const auto &attrList{
-      std::get<std::list<parser::ProcComponentAttrSpec>>(stmt.t)};
-  bool foundPointer{false};
-  for (const auto &attr : attrList) {
-    if (std::get_if<parser::Pointer>(&attr.u)) {
-      foundPointer = true;
-    }
-  }
-  if (!foundPointer) { // C756
-    Say("A procedure component must have the POINTER attribute"_err_en_US);
-  }
   interfaceName_ = nullptr;
 }
 bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
     return !NameIsKnownOrIntrinsic(*name);
   }
   return true;
 }

 
 // Return true if it is ok to declare this component in the current scope.
 // Otherwise, emit an error and return false.
 bool DeclarationVisitor::OkToAddComponent(
     const parser::Name &name, const Symbol *extends) {
   for (const Scope *scope{&currScope()}; scope;) {
     CHECK(scope->IsDerivedType());
     if (auto *prev{FindInScope(*scope, name)}) {
+      if (!prev->test(Symbol::Flag::Error)) {
         auto msg{""_en_US};
         if (extends) {
           msg = "Type cannot be extended as it has a component named"
                 " '%s'"_err_en_US;
         } else if (prev->test(Symbol::Flag::ParentComp)) {
           msg = "'%s' is a parent type of this type and so cannot be"
                 " a component"_err_en_US;
         } else if (scope != &currScope()) {
           msg = "Component '%s' is already declared in a parent of this"
                 " derived type"_err_en_US;
         } else {
           msg = "Component '%s' is already declared in this"
                 " derived type"_err_en_US;
         }
         Say2(name, std::move(msg), *prev, "Previous declaration of '%s'"_en_US);
+      }
       return false;
     }
     if (scope == &currScope() && extends) {
       // The parent component has not yet been added to the scope.
       scope = extends->scope();
     } else {
       scope = scope->GetDerivedTypeParent();
     }

flang/lib/Semantics/type.cpp

if (ParamValue * paramValue{FindParameter(name)}) {
         if (auto converted{evaluate::ConvertToType(symbol, SomeExpr{*expr})}) {
           SomeExpr folded{
               evaluate::Fold(foldingContext, std::move(*converted))};
           if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) {
             paramValue->SetExplicit(std::move(*intExpr));
             continue;
           }
         }
+        if (!symbol.test(Symbol::Flag::Error)) {
           evaluate::SayWithDeclaration(messages, symbol,
-            "Value of type parameter '%s' (%s) is not convertible to its type"_err_en_US,
+              "Value of type parameter '%s' (%s) is not convertible to its"
+              " type"_err_en_US,
               name, expr->AsFortran());
         }
       }
     }
+  }
 
   // Default initialization expressions for the derived type's parameters
   // may reference other parameters so long as the declaration precedes the
   // use in the expression (10.1.12).  This is not necessarily the same
   // order as "type parameter order" (7.5.3.2).
   // Type parameter default value expressions are folded in declaration order
   // within the scope of the derived type so that the values of earlier type
   // parameters are available for use in the default initialization
   // expressions of later parameters.
   auto restorer{foldingContext.WithPDTInstance(*this)};
   for (const Symbol &symbol : parameterDecls) {
     const SourceName &name{symbol.name()};
     if (!FindParameter(name)) {
       const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
       if (details.init()) {
         auto expr{
             evaluate::Fold(foldingContext, common::Clone(details.init()))};
         AddParamValue(name, ParamValue{std::move(*expr), details.attr()});
       } else {
+        if (!symbol.test(Symbol::Flag::Error)) {
           messages.Say(name_,
               "Type parameter '%s' lacks a value and has no default"_err_en_US,
               name);
         }
       }
     }
   }
+}
 
 void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) {
   CHECK(cooked_);
   auto pair{parameters_.insert(std::make_pair(name, std::move(value)))};
   CHECK(pair.second); // name was not already present
 }
 
 int DerivedTypeSpec::NumLengthParameters() const {

flang/test/Semantics/resolve33.f90

type t5(a, b)
     integer, len :: a
     integer, len :: b
     !ERROR: Type parameter, component, or procedure binding 'a' already defined in this type
     integer, len :: a
   end type
   !ERROR: No definition found for type parameter 'k'
   !ERROR: No definition found for type parameter 'l'
   type :: t6(k, l)
-    !ERROR: Must be a constant value
-    !ERROR: Invalid specification expression: derived type component not allowed to reference variable 'l'
     character(kind=k, len=l) :: d3
   end type
   type(t6(2, 10)) :: x3
 end module

flang/test/Semantics/resolve34.f90

 module m3
   type :: t1
   end type
   type, extends(t1) :: t2
     integer :: i
     !ERROR: 't1' is a parent type of this type and so cannot be a component
     real :: t1
   end type
-  type, extends(t2) :: t3
-    !ERROR: 't1' is a parent type of this type and so cannot be a component
-    real :: t1
+  type :: t3
+  end type
+  type, extends(t3) :: t4
+  end type
+  type, extends(t4) :: t5
+    !ERROR: 't3' is a parent type of this type and so cannot be a component
+    real :: t3
   end type
 end
 
 module m4
   type :: t1
     integer :: t1
   end type
   !ERROR: Type cannot be extended as it has a component named 't1'

flang/test/Semantics/resolve79.f90

type :: procComponentType
     !WARNING: Attribute 'NOPASS' cannot be used more than once
     procedure(nopassProc), nopass, pointer, nopass :: noPassField
     !WARNING: Attribute 'PASS' cannot be used more than once
     procedure(passProc), pass, pointer, pass :: passField
     !ERROR: Attributes 'PASS' and 'NOPASS' conflict with each other
     procedure(passNopassProc), pass, pointer, nopass :: passNopassField
     !WARNING: Attribute 'POINTER' cannot be used more than once
     procedure(pointerProc), pointer, public, pointer :: pointerField
-    !ERROR: A procedure component must have the POINTER attribute
+    !ERROR: Procedure component 'nonpointerfield' must have POINTER attribute
     procedure(publicProc), public :: nonpointerField
   contains
     procedure :: noPassProc
     procedure :: passProc
     procedure :: passNopassProc
     procedure :: publicProc
     procedure :: privateProc
   end type procComponentType

flang/test/Semantics/resolve89.f90

! C750
   real, dimension(iVolatileStmtFunc()) :: arrayVarWithVolatile
     !ERROR: Invalid specification expression: reference to impure function 'iimpurestmtfunc'
   real, dimension(iImpureStmtFunc()) :: arrayVarWithImpureFunction
     !ERROR: Invalid specification expression: reference to statement function 'ipurestmtfunc'
   real, dimension(iPureStmtFunc()) :: arrayVarWithPureFunction
   real, dimension(iabs(iArg)) :: arrayVarWithIntrinsic
 
   type arrayType
-    !ERROR: Invalid specification expression: derived type component not allowed to reference variable 'var'
+    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'var'
     real, dimension(var) :: varField
     !ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
     real, dimension(iVolatileStmtFunc()) :: arrayFieldWithVolatile
     !ERROR: Invalid specification expression: reference to impure function 'iimpurestmtfunc'
     real, dimension(iImpureStmtFunc()) :: arrayFieldWithImpureFunction
     !ERROR: Invalid specification expression: reference to statement function 'ipurestmtfunc'
     real, dimension(iPureStmtFunc()) :: arrayFieldWithPureFunction
-    !ERROR: Invalid specification expression: derived type component not allowed to reference variable 'iarg'
+    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
     real, dimension(iabs(iArg)) :: arrayFieldWithIntrinsic
-    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
     real, dimension(merge(1, 2, allocated(allocArg))) :: realField1
-    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
     real, dimension(merge(1, 2, associated(pointerArg))) :: realField2
-    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components
+    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
     real, dimension(merge(1, 2, is_contiguous(arrayArg))) :: realField3
-    !ERROR: Invalid specification expression: derived type component not allowed to reference variable 'ioarg'
+    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'ioarg'
     real, dimension(ioArg) :: realField4
-    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
     real, dimension(merge(1, 2, present(optionalArg))) :: realField5
   end type arrayType
 
 end subroutine s
 
 subroutine s1()
   ! C750, check for a constant specification inquiry that's a type parameter
   ! inquiry which are defined in 9.4.5
   type derived(kindParam, lenParam)
     integer, kind :: kindParam = 3
     integer, len :: lenParam = 3
   end type
 
   contains
     subroutine inner (derivedArg)
       type(derived), intent(in), dimension(3) :: derivedArg
       integer :: localInt
 
       type(derived), parameter :: localderived = derived()
 
       type localDerivedType
         ! OK because the specification inquiry is a constant
         integer, dimension(localDerived%kindParam) :: goodField
-        !ERROR: Invalid specification expression: non-constant reference to a type parameter inquiry not allowed for derived type components
+        !ERROR: Invalid specification expression: non-constant reference to a type parameter inquiry not allowed for derived type components or type parameter values
         integer, dimension(derivedArg%lenParam) :: badField
       end type localDerivedType
 
       ! OK because we're not defining a component
       integer, dimension(derivedArg%kindParam) :: localVar
     end subroutine inner
 end subroutine s1
 
 subroutine s2(iArg, allocArg, pointerArg, arrayArg, optionalArg)
   ! C754
   integer, intent(in) :: iArg
   real, allocatable, intent(in) :: allocArg
   real, pointer, intent(in) :: pointerArg
   integer, dimension(:), intent(in) :: arrayArg
   real, optional, intent(in) :: optionalArg
 
   type paramType(lenParam)
     integer, len :: lenParam = 4
   end type paramType
 
   type charType
-    !ERROR: Invalid specification expression: derived type component not allowed to reference variable 'iarg'
+    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
     character(iabs(iArg)) :: fieldWithIntrinsic
-    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
     character(merge(1, 2, allocated(allocArg))) :: allocField
-    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
     character(merge(1, 2, associated(pointerArg))) :: assocField
-    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components
+    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
     character(merge(1, 2, is_contiguous(arrayArg))) :: contigField
-    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
     character(merge(1, 2, present(optionalArg))) :: presentField
   end type charType
 
   type derivedType
-    !ERROR: Invalid specification expression: derived type component not allowed to reference variable 'iarg'
+    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
     type(paramType(iabs(iArg))) :: fieldWithIntrinsic
-    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
     type(paramType(merge(1, 2, allocated(allocArg)))) :: allocField
-    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
     type(paramType(merge(1, 2, associated(pointerArg)))) :: assocField
-    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components
+    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
     type(paramType(merge(1, 2, is_contiguous(arrayArg)))) :: contigField
-    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components
+    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
     type(paramType(merge(1, 2, present(optionalArg)))) :: presentField
   end type derivedType
 end subroutine s2