diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index 480039911719c6..373f18e1e22847 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -613,6 +613,21 @@ end module associated objects and do not elicit errors about improper redeclarations of implicitly typed entities. +* Standard Fortran allows forward references to derived types, which + can lead to ambiguity when combined with host association. + Some Fortran compilers resolve the type name to the host type, + others to the forward-referenced local type; this compiler diagnoses + an error. +``` +module m + type ambiguous; integer n; end type + contains + subroutine s + type(ambiguous), pointer :: ptr + type ambiguous; real a; end type + end +end +``` ## De Facto Standard Features diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 40f5ab9eb6e27c..16fa1a505543e0 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -6425,6 +6425,11 @@ std::optional DeclarationVisitor::ResolveDerivedType( Say(name, "Derived type '%s' not found"_err_en_US); return std::nullopt; } + } else if (&DEREF(symbol).owner() != &outer && + !ultimate->has()) { + // Prevent a later declaration in this scope of a host-associated + // type name. + outer.add_importName(name.source); } if (CheckUseError(name)) { return std::nullopt; @@ -8092,7 +8097,7 @@ void ResolveNamesVisitor::CheckImport( const Symbol &ultimate{symbol->GetUltimate()}; if (&ultimate.owner() == &currScope()) { Say(location, "'%s' from host is not accessible"_err_en_US, name) - .Attach(symbol->name(), "'%s' is hidden by this entity"_en_US, + .Attach(symbol->name(), "'%s' is hidden by this entity"_because_en_US, symbol->name()); } } diff --git a/flang/test/Semantics/resolve29.f90 b/flang/test/Semantics/resolve29.f90 index ea4642c1b3ddc7..3e6a8a0ba69763 100644 --- a/flang/test/Semantics/resolve29.f90 +++ b/flang/test/Semantics/resolve29.f90 @@ -9,6 +9,7 @@ subroutine s1(x) !ERROR: 't1' from host is not accessible import :: t1 type(t1) :: x + !BECAUSE: 't1' is hidden by this entity integer :: t1 end subroutine subroutine s2() @@ -24,6 +25,7 @@ subroutine s4(x, y) import, all type(t1) :: x type(t3) :: y + !BECAUSE: 't3' is hidden by this entity integer :: t3 end subroutine end interface @@ -41,6 +43,27 @@ subroutine s7() !ERROR: 's5' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL) call s5() end + subroutine s8() + !This case is a dangerous ambiguity allowed by the standard. + !ERROR: 't1' from host is not accessible + type(t1), pointer :: p + !BECAUSE: 't1' is hidden by this entity + type t1 + integer n(2) + end type + end + subroutine s9() + !This case is a dangerous ambiguity allowed by the standard. + type t2 + !ERROR: 't1' from host is not accessible + type(t1), pointer :: p + end type + !BECAUSE: 't1' is hidden by this entity + type t1 + integer n(2) + end type + type(t2) x + end end module module m2 integer, parameter :: ck = kind('a')