[flang] Constraint checks C751 to C760

[PeteSteinfeld]

Summary

Many of these were already implemented, and I just annotated the tests and/or
the code.

C752 was a simple check to verify that CONTIGUOUS components are arrays with
the POINTER attribute.

C754 proved to be virtually identical to C750 that I implemented previously.
This caused me to remove the distinction between specification expressions for
type parameters and bounds expressions that I'd previously created.
the POINTER attribute.

C756 checks that procedure components have the POINTER attribute.

[klausler]

flang/lib/Semantics/check-declarations.cpp

157

?

287

Why two if statements?

flang/lib/Semantics/resolve-names.cpp

3916

Can't this constraint be checked in check-declarations.cpp? If so, keep it out of name resolution.

3922

Just return here, and remove the Boolean.

flang/test/Semantics/resolve33.f90

42

This error seems spurious to me. We know that l (lower-case letter ell) is a type parameter.

[tskeith]

flang/test/Semantics/resolve33.f90

42

Yes, the "Must be a constant value" error too. The real errors are the ones above: "No definition found for type parameter".

Setting and checking the Error flag on the symbols for k and l might be a way to avoid these.

[PeteSteinfeld]

flang/lib/Semantics/check-declarations.cpp

157

Oops. I'll remove this.

287

No reason. I'll combine them.

flang/lib/Semantics/resolve-names.cpp

3916

Thanks, Peter. It looks like I can move it, and I will.

3922

No longer necessary in the moved code.

flang/test/Semantics/resolve33.f90

42

Constraint C754 states that a type-param-value in a component-def-stmt shall not depend on the value of a variable. In this case, the type-param-value of "len" depends on "l" (lower case ell), which is a variable. But the message incorrectly says that the expression is associated with a derived type component.

Note that the constraints on specification expressions in derived types are identical for bounds expressions of components and for values of type parameters. Do you think it's important that the error messages distinguish these two cases?

[tskeith]

flang/test/Semantics/resolve33.f90

42

l isn't a variable, it's a type parameter that's missing its definition (which we've already complained about).

[PeteSteinfeld]

flang/test/Semantics/resolve33.f90

42

My understanding is that a type parameter is a variable. The relevant sections of the standard that I could find are 5.4.3.2.2 that defines variables, and 5.4.3.2.1(3) that states that a subobject of a variable is a variable.

I like your suggestion of stopping analysis of expressions containing names that have already been found to be erroneous. In this example, the compiler is not creating a Symbol for the type parameter l. I think that the right thing to do is create a Symbol for l at the point where the compiler emits the error message, and then mark the newly created Symbol as erroneous. Then, subsequent semantic processing will know not to emit redundant and possibly confusing messages when encountering it.

[PeteSteinfeld]

1. Updating D79798: [flang] Constraint checks C751 to C760 #
2. Enter a brief description of the changes included in this update.
3. The first line is used as subject, next lines as comment. #
4. If you intended to create a new revision, use:
5. $ arc diff --create

Responses to review comments

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.

[PeteSteinfeld]

@klausler and @tskeith, do these latest changes look good?

[tskeith]

flang/lib/Semantics/resolve-names.cpp

3677

You can use BeginAttrs here instead, and EndAttrs below.

flang/lib/Semantics/type.cpp

156

Could be else if

[PeteSteinfeld]

I changed some raw code to calls to BeginAttrs() and EndAttrs() and changed a
nested "if" to an "end if".

[PeteSteinfeld]

I've submitted another update.

flang/lib/Semantics/resolve-names.cpp

3677

Thanks, Tim. Will do.

flang/lib/Semantics/type.cpp

156

I will make it so.

[PeteSteinfeld]

Changes have been delivered.

flang/include/flang/Evaluate/check-expression.h

 // constant addressing and no vector-valued subscript.
 bool IsInitialDataTarget(
     const Expr<SomeType> &, parser::ContextualMessages * = nullptr);
 
 // Check whether an expression is a specification expression
 // (10.1.11(2), C1010).  Constant expressions are always valid
 // specification expressions.
 
-// There are two contexts where specification expressions appear -- array
-// bounds and type param expressions.  We need to differentiate them because
-// additional checks are required for array bounds expressions in declarations
-// of derived type components (see C750).
-ENUM_CLASS(SpecificationExprContext, TYPE_PARAM, BOUND)
-
 template <typename A>
 void CheckSpecificationExpr(const A &, parser::ContextualMessages &,
-    const semantics::Scope &, const IntrinsicProcTable &,
-    SpecificationExprContext);
+    const semantics::Scope &, const IntrinsicProcTable &);
 extern template void CheckSpecificationExpr(const Expr<SomeType> &x,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 extern template void CheckSpecificationExpr(const Expr<SomeInteger> &x,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 extern template void CheckSpecificationExpr(const Expr<SubscriptInteger> &x,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 extern template void CheckSpecificationExpr(
     const std::optional<Expr<SomeType>> &x, parser::ContextualMessages &,
-    const semantics::Scope &, const IntrinsicProcTable &,
-    SpecificationExprContext);
+    const semantics::Scope &, const IntrinsicProcTable &);
 extern template void CheckSpecificationExpr(
     const std::optional<Expr<SomeInteger>> &x, parser::ContextualMessages &,
-    const semantics::Scope &, const IntrinsicProcTable &,
-    SpecificationExprContext);
+    const semantics::Scope &, const IntrinsicProcTable &);
 extern template void CheckSpecificationExpr(
     const std::optional<Expr<SubscriptInteger>> &x,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 
 // Simple contiguity (9.5.4)
 template <typename A>
 bool IsSimplyContiguous(const A &, const IntrinsicProcTable &);
 extern template bool IsSimplyContiguous(
     const Expr<SomeType> &, const IntrinsicProcTable &);
 
 } // namespace Fortran::evaluate
 #endif

flang/lib/Evaluate/check-expression.cpp

 
 // Specification expression validation (10.1.11(2), C1010)
 class CheckSpecificationExprHelper
     : public AnyTraverse<CheckSpecificationExprHelper,
           std::optional<std::string>> {
 public:
   using Result = std::optional<std::string>;
   using Base = AnyTraverse<CheckSpecificationExprHelper, Result>;
-  explicit CheckSpecificationExprHelper(const semantics::Scope &s,
-      const IntrinsicProcTable &table, SpecificationExprContext specExprContext)
-      : Base{*this}, scope_{s}, table_{table}, specExprContext_{
-                                                   specExprContext} {}
+  explicit CheckSpecificationExprHelper(
+      const semantics::Scope &s, const IntrinsicProcTable &table)
+      : Base{*this}, scope_{s}, table_{table} {}
   using Base::operator();
 
   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) &&
-        specExprContext_ == SpecificationExprContext::BOUND) { // C750
-      return "derived type component not allowed to reference variable '"s +
+    } else if (scope_.IsDerivedType() && IsVariableName(symbol)) { // C750, C754
+      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 {
     // expressions will have been converted to expressions over descriptor
     // 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_ &&
-        specExprContext_ == SpecificationExprContext::BOUND) { // C750
-      return "non-constant reference to a type parameter inquiry "
-             "not allowed for derived type components";
+        inq.parameter().owner() != scope_) { // C750, C754
+      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() &&
-          specExprContext_ == SpecificationExprContext::BOUND) { // C750
+      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() &&
-          specExprContext_ == SpecificationExprContext::BOUND) { // C750
+      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;
       }
     }
     return (*this)(x.arguments());
   }
 
 private:
   const semantics::Scope &scope_;
   const IntrinsicProcTable &table_;
-  const SpecificationExprContext specExprContext_;
   const std::set<std::string> badIntrinsicsForComponents_{
       "allocated", "associated", "extends_type_of", "present", "same_type_as"};
   static bool IsProhibitedFunction(std::string name) { return false; }
 };
 
 template <typename A>
 void CheckSpecificationExpr(const A &x, parser::ContextualMessages &messages,
-    const semantics::Scope &scope, const IntrinsicProcTable &table,
-    SpecificationExprContext specExprContext) {
-  if (auto why{
-          CheckSpecificationExprHelper{scope, table, specExprContext}(x)}) {
+    const semantics::Scope &scope, const IntrinsicProcTable &table) {
+  if (auto why{CheckSpecificationExprHelper{scope, table}(x)}) {
     messages.Say("Invalid specification expression: %s"_err_en_US, *why);
   }
 }
 
 template void CheckSpecificationExpr(const Expr<SomeType> &,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 template void CheckSpecificationExpr(const Expr<SomeInteger> &,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 template void CheckSpecificationExpr(const Expr<SubscriptInteger> &,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &,
     parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &, SpecificationExprContext);
+    const IntrinsicProcTable &);
 template void CheckSpecificationExpr(
     const std::optional<Expr<SubscriptInteger>> &, parser::ContextualMessages &,
-    const semantics::Scope &, const IntrinsicProcTable &,
-    SpecificationExprContext);
+    const semantics::Scope &, const IntrinsicProcTable &);
 
 // IsSimplyContiguous() -- 9.5.4
 class IsSimplyContiguousHelper
     : public AnyTraverse<IsSimplyContiguousHelper, std::optional<bool>> {
 public:
   using Result = std::optional<bool>; // tri-state
   using Base = AnyTraverse<IsSimplyContiguousHelper, Result>;
   explicit IsSimplyContiguousHelper(const IntrinsicProcTable &t)

flang/lib/Semantics/check-declarations.cpp

 using evaluate::characteristics::Procedure;
 
 class CheckHelper {
 public:
   explicit CheckHelper(SemanticsContext &c) : context_{c} {}
 
   void Check() { Check(context_.globalScope()); }
   void Check(const ParamValue &, bool canBeAssumed);
-  void Check(const Bound &bound) {
-    CheckSpecExpr(
-        bound.GetExplicit(), evaluate::SpecificationExprContext::BOUND);
-  }
+  void Check(const Bound &bound) { CheckSpecExpr(bound.GetExplicit()); }
   void Check(const ShapeSpec &spec) {
     Check(spec.lbound());
     Check(spec.ubound());
   }
   void Check(const ArraySpec &);
   void Check(const DeclTypeSpec &, bool canHaveAssumedTypeParameters);
   void Check(const Symbol &);
   void Check(const Scope &);
 
 private:
-  template <typename A>
-  void CheckSpecExpr(
-      const A &x, const evaluate::SpecificationExprContext specExprContext) {
+  template <typename A> void CheckSpecExpr(const A &x) {
     if (symbolBeingChecked_ && IsSaved(*symbolBeingChecked_)) {
       if (!evaluate::IsConstantExpr(x)) {
         messages_.Say(
             "Specification expression must be constant in declaration of '%s' with the SAVE attribute"_err_en_US,
             symbolBeingChecked_->name());
       }
     } else {
       evaluate::CheckSpecificationExpr(
-          x, messages_, DEREF(scope_), context_.intrinsics(), specExprContext);
+          x, messages_, DEREF(scope_), context_.intrinsics());
     }
   }
-  template <typename A>
-  void CheckSpecExpr(const std::optional<A> &x,
-      const evaluate::SpecificationExprContext specExprContext) {
+  template <typename A> void CheckSpecExpr(const std::optional<A> &x) {
     if (x) {
-      CheckSpecExpr(*x, specExprContext);
+      CheckSpecExpr(*x);
     }
   }
-  template <typename A>
-  void CheckSpecExpr(
-      A &x, const evaluate::SpecificationExprContext specExprContext) {
+  template <typename A> void CheckSpecExpr(A &x) {
     x = Fold(foldingContext_, std::move(x));
     const A &constx{x};
-    CheckSpecExpr(constx, specExprContext);
+    CheckSpecExpr(constx);
   }
   void CheckValue(const Symbol &, const DerivedTypeSpec *);
   void CheckVolatile(
       const Symbol &, bool isAssociated, const DerivedTypeSpec *);
   void CheckPointer(const Symbol &);
   void CheckPassArg(
       const Symbol &proc, const Symbol *interface, const WithPassArg &);
   void CheckProcBinding(const Symbol &, const ProcBindingDetails &);
void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
   if (value.isAssumed()) {
     if (!canBeAssumed) { // C795, C721, C726
       messages_.Say(
           "An assumed (*) type parameter may be used only for a (non-statement"
           " function) dummy argument, associate name, named constant, or"
           " external function result"_err_en_US);
     }
   } else {
-    CheckSpecExpr(
-        value.GetExplicit(), evaluate::SpecificationExprContext::TYPE_PARAM);
+    CheckSpecExpr(value.GetExplicit());
   }
 }
 
 void CheckHelper::Check(const ArraySpec &shape) {
   for (const auto &spec : shape) {
     Check(spec);
   }
 }
 
 void CheckHelper::Check(
     const DeclTypeSpec &type, bool canHaveAssumedTypeParameters) {
   if (type.category() == DeclTypeSpec::Character) {
     Check(type.characterTypeSpec().length(), canHaveAssumedTypeParameters);
   } else if (const DerivedTypeSpec * derived{type.AsDerived()}) {
     for (auto &parm : derived->parameters()) {
       Check(parm.second, canHaveAssumedTypeParameters);
     }
   }
 }
 
 void CheckHelper::Check(const Symbol &symbol) {
   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 (symbol.attrs().test(Attr::VOLATILE)) {
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() &&
+      (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);
+  }
 }
 
 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 (!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
if (derived) {
             "VOLATILE attribute may not apply to a type with a coarray ultimate component accessed by USE or host association"_err_en_US);
       }
     }
   }
 }
 
 void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
   CheckConflicting(symbol, Attr::POINTER, Attr::TARGET);
-  CheckConflicting(symbol, Attr::POINTER, Attr::ALLOCATABLE);
+  CheckConflicting(symbol, Attr::POINTER, Attr::ALLOCATABLE); // C751
   CheckConflicting(symbol, Attr::POINTER, Attr::INTRINSIC);
   if (symbol.Corank() > 0) {
     messages_.Say(
         "'%s' may not have the POINTER attribute because it is a coarray"_err_en_US,
         symbol.name());
   }
 }
 
 // C760 constraints on the passed-object dummy argument
+// C757 constraints on procedure pointer components
 void CheckHelper::CheckPassArg(
     const Symbol &proc, const Symbol *interface, const WithPassArg &details) {
   if (proc.attrs().test(Attr::NOPASS)) {
     return;
   }
   const auto &name{proc.name()};
   if (!interface) {
     messages_.Say(name,
void CheckHelper::CheckPassArg(
   }
   std::optional<int> passArgIndex{};
   for (std::size_t i{0}; i < dummyArgs.size(); ++i) {
     if (dummyArgs[i] && dummyArgs[i]->name() == *passName) {
       passArgIndex = i;
       break;
     }
   }
-  if (!passArgIndex) {
+  if (!passArgIndex) { // C758
     messages_.Say(*passName,
         "'%s' is not a dummy argument of procedure interface '%s'"_err_en_US,
         *passName, interface->name());
     return;
   }
   const Symbol &passArg{*dummyArgs[*passArgIndex]};
   std::optional<parser::MessageFixedText> msg;
   if (!passArg.has<ObjectEntityDetails>()) {

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
+      BeginAttrs();
+      Symbol *typeParam{MakeTypeSymbol(
+          paramName, TypeParamDetails{common::TypeParamAttr::Len})};
+      typeParam->set(Symbol::Flag::Error);
+      EndAttrs();
     } 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) {
   set_allowForwardReferenceToDerivedType(false);
   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 &) {
+void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &stmt) {
   interfaceName_ = nullptr;
 }
 bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
     return !NameIsKnownOrIntrinsic(*name);
   }
   return true;
 }
 void DeclarationVisitor::Post(const parser::ProcInterface &x) {
   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
     interfaceName_ = name;
     NoteInterfaceName(*name);
   }
 }
if (charInfo_.length) { // Declaration has "*length" (R723)
     auto length{std::move(*charInfo_.length)};
     charInfo_.length.reset();
     if (type.category() == DeclTypeSpec::Character) {
       auto kind{type.characterTypeSpec().kind()};
       // Recurse with correct type.
       SetType(name,
           currScope().MakeCharacterType(std::move(length), std::move(kind)));
       return;
-    } else {
+    } else { // C753
       Say(name,
           "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
     }
   }
   auto *prevType{symbol.GetType()};
   if (!prevType) {
     symbol.SetType(type);
   } else if (symbol.has<UseDetails>()) {

 
 // 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 {
+      } 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)))};

flang/test/Semantics/assign02.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 ! Pointer assignment constraints 10.2.2.2
 
 module m1
   type :: t(k)
     integer, kind :: k
   end type
   type t2
     sequence
     real :: t2Field
   end type
 contains
 
-  ! C853
+  ! C852
   subroutine s0
     !ERROR: 'p1' may not have both the POINTER and TARGET attributes
     real, pointer :: p1, p3
     allocatable :: p2
     !ERROR: 'sin' may not have both the POINTER and INTRINSIC attributes
     real, intrinsic, pointer :: sin
     target :: p1
     !ERROR: 'p2' may not have both the POINTER and ALLOCATABLE attributes

flang/test/Semantics/resolve31.f90

module m4
   end type sequenceType
   type :: testType
     sequence
     !ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type
     class(*), allocatable :: typeStarField
     !ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type
     type(plainType) :: testField1
     type(sequenceType) :: testField2
-    procedure(real), nopass :: procField
+    procedure(real), pointer, nopass :: procField
   end type testType
   !ERROR: A sequence type may not have type parameters
   type :: paramType(param)
     integer, kind :: param
     sequence
     real :: paramField
   end type paramType
 contains

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
     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/resolve52.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 ! Tests for C760:
 ! The passed-object dummy argument shall be a scalar, nonpointer, nonallocatable
 ! dummy data object with the same declared type as the type being defined;
 ! all of its length type parameters shall be assumed; it shall be polymorphic
 ! (7.3.2.3) if and only if the type being defined is extensible (7.5.7).
 ! It shall not have the VALUE attribute.
+!
+! C757 If the procedure pointer component has an implicit interface or has no
+! arguments, NOPASS shall be specified.
+!
+! C758 If PASS (arg-name) appears, the interface of the procedure pointer
+! component shall have a dummy argument named arg-name.
+
 
 module m1
   type :: t
     procedure(real), pointer, nopass :: a
     !ERROR: Procedure component 'b' must have NOPASS attribute or explicit interface
     procedure(real), pointer :: b
   end type
 end

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: 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

 ! RUN: %S/test_errors.sh %s %t %f18
 ! C750 Each bound in the explicit-shape-spec shall be a specification
 ! expression in which there are no references to specification functions or
-! the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_- TYPE_OF, PRESENT,
+! the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, PRESENT,
 ! or SAME_TYPE_AS, every specification inquiry reference is a constant
 ! expression, and the value does not depend on the value of a variable.
+!
+! C754 Each type-param-value within a component-def-stmt shall be a colon or 
+! a specification expression in which there are no references to specification 
+! functions or the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF,
+! PRESENT, or SAME_TYPE_AS, every specification inquiry reference is a 
+! constant expression, and the value does not depend on the value of a variable.
 impure function impureFunc()
   integer :: impureFunc
 
   impureFunc = 3
 end function impureFunc
 
 pure function pureFunc()
   integer :: pureFunc
 
   pureFunc = 3
 end function pureFunc
 
 module m
   real, allocatable :: mVar
 end module m
 
 subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
+! C750
   use m
   implicit logical(l)
   integer, intent(in) :: iArg
   real, allocatable, intent(in) :: allocArg
   real, pointer, intent(in) :: pointerArg
   integer, dimension(:), intent(in) :: arrayArg
   integer, intent(inout) :: ioArg
   real, optional, intent(in) :: optionalArg
! 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 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 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 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 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 or type parameter values
+    character(merge(1, 2, present(optionalArg))) :: presentField
+  end type charType
+
+  type derivedType
+    !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 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 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 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 or type parameter values
+    type(paramType(merge(1, 2, present(optionalArg)))) :: presentField
+  end type derivedType
+end subroutine s2

flang/test/Semantics/resolve90.f90

+! RUN: %S/test_errors.sh %s %t %f18
+! C751 A component shall not have both the ALLOCATABLE and POINTER attributes.
+! C752 If the CONTIGUOUS attribute is specified, the component shall be an 
+!   array with the POINTER attribute.
+! C753 The * char-length option is permitted only if the component is of type 
+!   character.
+subroutine s()
+  type derivedType
+    !ERROR: 'pointerallocatablefield' may not have both the POINTER and ALLOCATABLE attributes
+    real, pointer, allocatable :: pointerAllocatableField
+    real, dimension(:), contiguous, pointer :: goodContigField
+    !ERROR: A CONTIGUOUS component must be an array with the POINTER attribute
+    real, dimension(:), contiguous, allocatable :: badContigField
+    character :: charField * 3
+    !ERROR: A length specifier cannot be used to declare the non-character entity 'realfield'
+    real :: realField * 3
+  end type derivedType
+end subroutine s