File tree Expand file tree Collapse file tree 3 files changed +44
-1
lines changed Expand file tree Collapse file tree 3 files changed +44
-1
lines changed Original file line number Diff line number Diff 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
Original file line number Diff line number Diff 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 }
Original file line number Diff line number Diff 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
4467end module
4568module m2
4669 integer , parameter :: ck = kind (' a' )
You can’t perform that action at this time.
0 commit comments