[flang] Improve scan for dummy argument type declarations (#172706)

We can handle a forward reference to an explicitly typed integer dummy
argument when its name appears in a specification expression, rather
than applying the active implicit typing rules, so long as the explicit
type declaration statement has a literal constant kind number. Extend
this to also accept INTEGER(int_ptr_kind()) or other function reference
without an actual argument.

Author: klausler

flang/lib/Semantics/resolve-names.cpp

@@ -7565,12 +7565,14 @@ void DeclarationVisitor::SetType(
   } else if (HadForwardRef(symbol)) {
     // error recovery after use of host-associated name
   } else if (!symbol.test(Symbol::Flag::Implicit)) {
-    SayWithDecl(
-        name, symbol, "The type of '%s' has already been declared"_err_en_US);
+    SayWithDecl(name, symbol,
+        "The type of '%s' has already been declared as %s"_err_en_US,
+        prevType->AsFortran());
     context().SetError(symbol);
   } else if (type != *prevType) {
     SayWithDecl(name, symbol,
-        "The type of '%s' has already been implicitly declared"_err_en_US);
+        "The type of '%s' has already been implicitly declared as %s"_err_en_US,
+        prevType->AsFortran());
     context().SetError(symbol);
   } else {
     symbol.set(Symbol::Flag::Implicit, false);
@@ -9710,12 +9712,20 @@ void ResolveNamesVisitor::EarlyDummyTypeDeclaration(
     const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>
         &stmt) {
   context().set_location(stmt.source);
-  const auto &[declTypeSpec, attrs, entities] = stmt.statement.value().t;
+  const auto &[declTypeSpec, attrs, entities]{stmt.statement.value().t};
   if (const auto *intrin{
           std::get_if<parser::IntrinsicTypeSpec>(&declTypeSpec.u)}) {
     if (const auto *intType{std::get_if<parser::IntegerTypeSpec>(&intrin->u)}) {
       if (const auto &kind{intType->v}) {
-        if (!parser::Unwrap<parser::KindSelector::StarSize>(*kind) &&
+        if (const auto *call{parser::Unwrap<parser::Call>(*kind)}) {
+          if (!std::get<std::list<parser::ActualArgSpec>>(call->t).empty()) {
+            // Accept INTEGER(int_ptr_kind()), at least.  Don't allow a
+            // nonempty argument list, to prevent implicitly typing names
+            // that might appear.  (TODO: But maybe INTEGER(KIND(n)) after
+            // an explicit declaration of 'n' would be useful.)
+            return;
+          }
+        } else if (!parser::Unwrap<parser::KindSelector::StarSize>(*kind) &&
             !parser::Unwrap<parser::IntLiteralConstant>(*kind)) {
           return;
         }

flang/test/Semantics/bug122002b.f90

@@ -3,7 +3,7 @@ SUBROUTINE sub00(a,b,n,m)
   complex(2) n,m
 ! ERROR: Must have INTEGER type, but is COMPLEX(2)
 ! ERROR: Must have INTEGER type, but is COMPLEX(2)
-! ERROR: The type of 'b' has already been implicitly declared
+! ERROR: The type of 'b' has already been implicitly declared as REAL(4)
   complex(3) a(n,m), b(size((LOG ((x * (a) - a + b / a - a))+1 - x)))
   a = a ** n
 ! ERROR: DO controls should be INTEGER

flang/test/Semantics/bug1696.f90

@@ -0,0 +1,6 @@
+!RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+subroutine s(a,n)
+  real a(n)
+!CHECK: INTEGER(KIND=8_4) n
+  integer(int_ptr_kind()) n
+end

flang/test/Semantics/resolve01.f90

@@ -1,10 +1,10 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 integer :: x
-!ERROR: The type of 'x' has already been declared
+!ERROR: The type of 'x' has already been declared as INTEGER(4)
 real :: x
 integer(8) :: i
 parameter(i=1,j=2,k=3)
 integer :: j
-!ERROR: The type of 'k' has already been implicitly declared
+!ERROR: The type of 'k' has already been implicitly declared as INTEGER(4)
 real :: k
 end

flang/test/Semantics/resolve05.f90

@@ -32,7 +32,7 @@ subroutine s
 function f() result(res)
   integer :: res
   !ERROR: 'f' is already declared in this scoping unit
-  !ERROR: The type of 'f' has already been declared
+  !ERROR: The type of 'f' has already been declared as INTEGER(4)
   real :: f
   res = 1
 end

flang/test/Semantics/resolve40.f90

@@ -63,7 +63,7 @@ subroutine s7
 
 subroutine s8
   data x/1.0/
-  !ERROR: The type of 'x' has already been implicitly declared
+  !ERROR: The type of 'x' has already been implicitly declared as REAL(4)
   integer x
 end
 

flang/test/Semantics/resolve52.f90

@@ -74,7 +74,7 @@ subroutine s1(x)
   end
   subroutine s2(w, x)
     real :: x
-    !ERROR: The type of 'x' has already been declared
+    !ERROR: The type of 'x' has already been declared as REAL(4)
     class(t), allocatable :: x
   end
   subroutine s3(f)

flang/test/Semantics/resolve91.f90

@@ -4,14 +4,14 @@ module m
   procedure(real), pointer :: p
   !ERROR: EXTERNAL attribute was already specified on 'p'
   !ERROR: POINTER attribute was already specified on 'p'
-  !ERROR: The type of 'p' has already been declared
+  !ERROR: The type of 'p' has already been declared as REAL(4)
   procedure(integer), pointer :: p
 end
 
 module m1
     real, dimension(:), pointer :: realArray => null()
     !ERROR: POINTER attribute was already specified on 'realarray'
-    !ERROR: The type of 'realarray' has already been declared
+    !ERROR: The type of 'realarray' has already been declared as REAL(4)
     real, dimension(:), pointer :: realArray => localArray
 end module m1
 
@@ -55,7 +55,7 @@ end module m4
 module m5
   !ERROR: Actual argument for 'string=' has bad type 'REAL(4)'
   character(len=len(a)) :: b
-  !ERROR: The type of 'a' has already been implicitly declared
+  !ERROR: The type of 'a' has already been implicitly declared as REAL(4)
   character(len=len(b)) :: a
 end module m5
 
@@ -73,19 +73,19 @@ end module m7
 
 module m8
   integer :: iVar = 3
-  !ERROR: The type of 'ivar' has already been declared
+  !ERROR: The type of 'ivar' has already been declared as INTEGER(4)
   integer :: iVar = 4
   integer, target :: jVar = 5
   integer, target :: kVar = 5
   integer, pointer :: pVar => jVar
   !ERROR: POINTER attribute was already specified on 'pvar'
-  !ERROR: The type of 'pvar' has already been declared
+  !ERROR: The type of 'pvar' has already been declared as INTEGER(4)
   integer, pointer :: pVar => kVar
 end module m8
 
 module m9
   integer :: p, q
   procedure() p ! ok
-  !ERROR: The type of 'q' has already been declared
+  !ERROR: The type of 'q' has already been declared as INTEGER(4)
   procedure(real) q
 end module m9