Skip to content

Commit 39f4ec5

Browse files
authored
[flang] Catch a dangerous ambiguity in standard Fortran (#67483)
Fortran allows forward references to type names, which can lead to ambiguity when coupled with host association, as in: module m type ambiguous; integer n; end type contains subroutine s type(ambiguous), pointer :: variable type t type(ambiguous), pointer :: component end type type ambiguous; real x; end type end end Some other compilers resolve to a host association, some resolve to a forward reference. This compiler will now emit an error.
1 parent fa7d6a0 commit 39f4ec5

File tree

3 files changed

+44
-1
lines changed

3 files changed

+44
-1
lines changed

flang/docs/Extensions.md

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -613,6 +613,21 @@ end module
613613
associated objects and do not elicit errors about improper redeclarations
614614
of implicitly typed entities.
615615

616+
* Standard Fortran allows forward references to derived types, which
617+
can lead to ambiguity when combined with host association.
618+
Some Fortran compilers resolve the type name to the host type,
619+
others to the forward-referenced local type; this compiler diagnoses
620+
an error.
621+
```
622+
module m
623+
type ambiguous; integer n; end type
624+
contains
625+
subroutine s
626+
type(ambiguous), pointer :: ptr
627+
type ambiguous; real a; end type
628+
end
629+
end
630+
```
616631

617632
## De Facto Standard Features
618633

flang/lib/Semantics/resolve-names.cpp

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6429,6 +6429,11 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
64296429
Say(name, "Derived type '%s' not found"_err_en_US);
64306430
return std::nullopt;
64316431
}
6432+
} else if (&DEREF(symbol).owner() != &outer &&
6433+
!ultimate->has<GenericDetails>()) {
6434+
// Prevent a later declaration in this scope of a host-associated
6435+
// type name.
6436+
outer.add_importName(name.source);
64326437
}
64336438
if (CheckUseError(name)) {
64346439
return std::nullopt;
@@ -8096,7 +8101,7 @@ void ResolveNamesVisitor::CheckImport(
80968101
const Symbol &ultimate{symbol->GetUltimate()};
80978102
if (&ultimate.owner() == &currScope()) {
80988103
Say(location, "'%s' from host is not accessible"_err_en_US, name)
8099-
.Attach(symbol->name(), "'%s' is hidden by this entity"_en_US,
8104+
.Attach(symbol->name(), "'%s' is hidden by this entity"_because_en_US,
81008105
symbol->name());
81018106
}
81028107
}

flang/test/Semantics/resolve29.f90

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ subroutine s1(x)
99
!ERROR: 't1' from host is not accessible
1010
import :: t1
1111
type(t1) :: x
12+
!BECAUSE: 't1' is hidden by this entity
1213
integer :: t1
1314
end subroutine
1415
subroutine s2()
@@ -24,6 +25,7 @@ subroutine s4(x, y)
2425
import, all
2526
type(t1) :: x
2627
type(t3) :: y
28+
!BECAUSE: 't3' is hidden by this entity
2729
integer :: t3
2830
end subroutine
2931
end interface
@@ -41,6 +43,27 @@ subroutine s7()
4143
!ERROR: 's5' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)
4244
call s5()
4345
end
46+
subroutine s8()
47+
!This case is a dangerous ambiguity allowed by the standard.
48+
!ERROR: 't1' from host is not accessible
49+
type(t1), pointer :: p
50+
!BECAUSE: 't1' is hidden by this entity
51+
type t1
52+
integer n(2)
53+
end type
54+
end
55+
subroutine s9()
56+
!This case is a dangerous ambiguity allowed by the standard.
57+
type t2
58+
!ERROR: 't1' from host is not accessible
59+
type(t1), pointer :: p
60+
end type
61+
!BECAUSE: 't1' is hidden by this entity
62+
type t1
63+
integer n(2)
64+
end type
65+
type(t2) x
66+
end
4467
end module
4568
module m2
4669
integer, parameter :: ck = kind('a')

0 commit comments

Comments
 (0)