Skip to content

Commit

Permalink
[flang] Catch a dangerous ambiguity in standard Fortran (#67483)
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
klausler committed Oct 16, 2023
1 parent fa7d6a0 commit 39f4ec5
Show file tree
Hide file tree
Showing 3 changed files with 44 additions and 1 deletion.
15 changes: 15 additions & 0 deletions flang/docs/Extensions.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
7 changes: 6 additions & 1 deletion flang/lib/Semantics/resolve-names.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -6429,6 +6429,11 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
Say(name, "Derived type '%s' not found"_err_en_US);
return std::nullopt;
}
} else if (&DEREF(symbol).owner() != &outer &&
!ultimate->has<GenericDetails>()) {
// Prevent a later declaration in this scope of a host-associated
// type name.
outer.add_importName(name.source);
}
if (CheckUseError(name)) {
return std::nullopt;
Expand Down Expand Up @@ -8096,7 +8101,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());
}
}
Expand Down
23 changes: 23 additions & 0 deletions flang/test/Semantics/resolve29.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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()
Expand All @@ -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
Expand All @@ -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')
Expand Down

0 comments on commit 39f4ec5

Please sign in to comment.