[flang] Don't crash on bad inherited implied DO type

flang/docs/Extensions.md

@@ -107,12 +107,6 @@ end
   These definitions yield fairly poor results due to floating-point
   cancellation, and every Fortran compiler (including this one)
   uses better algorithms.
-* When an index variable of a `FORALL` or `DO CONCURRENT` is present
-  in the enclosing scope, and the construct does not have an explicit
-  type specification for its index variables, some weird restrictions
-  in F'2023 subclause 19.4 paragraphs 6 & 8 should apply.  Since this
-  compiler properly scopes these names, violations of these restrictions
-  elicit only portability warnings by default.
 * The rules for pairwise distinguishing the specific procedures of a
   generic interface are inadequate, as admitted in note C.11.6 of F'2023.
   Generic interfaces whose specific procedures can be easily proven by
@@ -728,6 +722,23 @@ end
   array and structure constructors not to be finalized, so it also makes sense
   not to finalize their allocatable components when releasing their storage).
 
+* F'2023 19.4 paragraph 5: "If integer-type-spec appears in data-implied-do or
+  ac-implied-do-control it has the specified type and type parameters; otherwise
+  it has the type and type parameters that it would have if it were the name of
+  a variable in the innermost executable construct or scoping unit that includes
+  the DATA statement or array constructor, and this type shall be integer type."
+  Reading "would have if it were" as being the subjunctive, this would mean that
+  an untyped implied DO index variable should be implicitly typed according to
+  the rules active in the enclosing scope.  But all other Fortran compilers interpret
+  the "would have if it were" as meaning "has if it is" -- i.e., if the name
+  is visible in the enclosing scope, the type of that name is used as the
+  type of the implied DO index.  So this is an error, not a simple application
+  of the default implicit typing rule:
+```
+character j
+print *, [(j,j=1,10)]
+```
+
 ## De Facto Standard Features
 
 * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the

flang/lib/Evaluate/formatting.cpp

@@ -539,10 +539,10 @@ std::string DynamicType::AsFortran() const {
       result += length->AsFortran();
     }
     return result + ')';
-  } else if (IsUnlimitedPolymorphic()) {
-    return "CLASS(*)";
   } else if (IsAssumedType()) {
     return "TYPE(*)";
+  } else if (IsUnlimitedPolymorphic()) {
+    return "CLASS(*)";
   } else if (IsTypelessIntrinsicArgument()) {
     return "(typeless intrinsic function argument)";
   } else {

flang/lib/Semantics/expression.cpp

@@ -1805,10 +1805,13 @@ void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
   const auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
   exprAnalyzer_.Analyze(bounds.name);
   parser::CharBlock name{bounds.name.thing.thing.source};
-  const Symbol *symbol{bounds.name.thing.thing.symbol};
   int kind{ImpliedDoIntType::kind};
-  if (const auto dynamicType{DynamicType::From(symbol)}) {
-    kind = dynamicType->kind();
+  if (const Symbol * symbol{bounds.name.thing.thing.symbol}) {
+    if (auto dynamicType{DynamicType::From(symbol)}) {
+      if (dynamicType->category() == TypeCategory::Integer) {
+        kind = dynamicType->kind();
+      }
+    }
   }
   std::optional<Expr<ImpliedDoIntType>> lower{
       GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.lower)};

flang/lib/Semantics/resolve-names.cpp

@@ -6556,6 +6556,7 @@ Symbol *DeclarationVisitor::DeclareStatementEntity(
       return nullptr;
     }
     name.symbol = nullptr;
+    // F'2023 19.4 p5 ambiguous rule about outer declarations
     declTypeSpec = prev->GetType();
   }
   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
@@ -6574,9 +6575,7 @@ Symbol *DeclarationVisitor::DeclareStatementEntity(
   } else {
     ApplyImplicitRules(symbol);
   }
-  Symbol *result{Resolve(name, &symbol)};
-  AnalyzeExpr(context(), doVar); // enforce INTEGER type
-  return result;
+  return Resolve(name, &symbol);
 }
 
 // Set the type of an entity or report an error.

flang/test/Semantics/array-constr-index01.f90

@@ -0,0 +1,8 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1
+subroutine s(i)
+  type(*) :: i
+  !ERROR: TYPE(*) dummy argument may only be used as an actual argument
+  !ERROR: Assumed-type entity 'i' must be a dummy argument
+  !ERROR: Must have INTEGER type, but is TYPE(*)
+  print *, [(i, i = 1,1)]
+end