[flang-commits] [flang] [flang] Improve scan for dummy argument type declarations (PR #172706)
via flang-commits
flang-commits at lists.llvm.org
Wed Dec 17 10:12:36 PST 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
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.
---
Full diff: https://github.com/llvm/llvm-project/pull/172706.diff
8 Files Affected:
- (modified) flang/lib/Semantics/resolve-names.cpp (+15-5)
- (modified) flang/test/Semantics/bug122002b.f90 (+1-1)
- (added) flang/test/Semantics/bug1696.f90 (+6)
- (modified) flang/test/Semantics/resolve01.f90 (+2-2)
- (modified) flang/test/Semantics/resolve05.f90 (+1-1)
- (modified) flang/test/Semantics/resolve40.f90 (+1-1)
- (modified) flang/test/Semantics/resolve52.f90 (+1-1)
- (modified) flang/test/Semantics/resolve91.f90 (+6-6)
``````````diff
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 345a0e4e8ecce..e5522ecbda7ff 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -7564,12 +7564,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);
@@ -9691,12 +9693,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;
}
diff --git a/flang/test/Semantics/bug122002b.f90 b/flang/test/Semantics/bug122002b.f90
index 1e4315d3afdb6..70727c6b09ffa 100644
--- a/flang/test/Semantics/bug122002b.f90
+++ b/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
diff --git a/flang/test/Semantics/bug1696.f90 b/flang/test/Semantics/bug1696.f90
new file mode 100644
index 0000000000000..fdae8aa988de2
--- /dev/null
+++ b/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
diff --git a/flang/test/Semantics/resolve01.f90 b/flang/test/Semantics/resolve01.f90
index 7a799940a8940..c3e7beb1cac1d 100644
--- a/flang/test/Semantics/resolve01.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve05.f90 b/flang/test/Semantics/resolve05.f90
index 7b142d2ebd613..aa97729407695 100644
--- a/flang/test/Semantics/resolve05.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve40.f90 b/flang/test/Semantics/resolve40.f90
index 81bb5f989ec48..16b825250695e 100644
--- a/flang/test/Semantics/resolve40.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve52.f90 b/flang/test/Semantics/resolve52.f90
index 9f89510652b2e..f8003889b8d4a 100644
--- a/flang/test/Semantics/resolve52.f90
+++ b/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)
diff --git a/flang/test/Semantics/resolve91.f90 b/flang/test/Semantics/resolve91.f90
index 2b0c4b6aa57e9..76b1f2a3139a1 100644
--- a/flang/test/Semantics/resolve91.f90
+++ b/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
``````````
</details>
https://github.com/llvm/llvm-project/pull/172706
More information about the flang-commits
mailing list