diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index 3503a0dde694b..37a49f12f9177 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -875,6 +875,13 @@ print *, [(j,j=1,10)] compilers) and don't use any defined unformatted WRITE that might have been defined. +* Forward references to target objects are allowed to appear + in the initializers of data pointer declarationss. + Forward references to target objects are not accepted in the default + initializers of derived type component declarations, however, + since these default values need to be available to process incomplete + structure constructors. + ## De Facto Standard Features * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 9e465f8ff3e1e..987824f0fcee8 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -5383,7 +5383,7 @@ void DeclarationVisitor::Post(const parser::EntityDecl &x) { ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol); symbol.set( Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors - Initialization(name, *init, false); + Initialization(name, *init, /*inComponentDecl=*/false); } else if (attrs.test(Attr::PARAMETER)) { // C882, C883 Say(name, "Missing initialization for parameter '%s'"_err_en_US); } @@ -6398,7 +6398,7 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { SetCUDADataAttr(name.source, symbol, cudaDataAttr()); if (symbol.has()) { if (auto &init{std::get>(x.t)}) { - Initialization(name, *init, true); + Initialization(name, *init, /*inComponentDecl=*/true); } } currScope().symbol()->get().add_component(symbol); @@ -8933,9 +8933,13 @@ void DeclarationVisitor::Initialization(const parser::Name &name, // Defer analysis to the end of the specification part // so that forward references and attribute checks like SAVE // work better. - auto restorer{common::ScopedSet(deferImplicitTyping_, true)}; - Walk(target); - ultimate.set(Symbol::Flag::InDataStmt); + if (inComponentDecl) { + PointerInitialization(name, target); + } else { + auto restorer{common::ScopedSet(deferImplicitTyping_, true)}; + Walk(target); + ultimate.set(Symbol::Flag::InDataStmt); + } }, [&](const std::list> &values) { // Handled later in data-to-inits conversion @@ -10355,11 +10359,6 @@ class DeferredCheckVisitor { std::get>(decl.t)); return false; } - bool Pre(const parser::ComponentDecl &decl) { - Init(std::get(decl.t), - std::get>(decl.t)); - return false; - } bool Pre(const parser::ProcDecl &decl) { if (const auto &init{ std::get>(decl.t)}) { diff --git a/flang/test/Semantics/bug1056.f90 b/flang/test/Semantics/bug1056.f90 new file mode 100644 index 0000000000000..b32270dab8f71 --- /dev/null +++ b/flang/test/Semantics/bug1056.f90 @@ -0,0 +1,13 @@ +! RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s +program bug + integer, target :: ita(2) = [1,2], itb(2) = [3,4], itc(2) = [5,6] + type t1 + integer, pointer :: p1(:) => ita, p2(:) => itb + end type + type t2 + !CHECK: TYPE(t1) :: comp = t1(p1=itc,p2=itb) + type(t1) :: comp = t1(itc) + end type + integer, pointer :: p3(:) => itd + integer, target :: itd(2) = [7,8] +end diff --git a/flang/test/Semantics/symbol15.f90 b/flang/test/Semantics/symbol15.f90 index 97dc50a23845f..df10942e6af2d 100644 --- a/flang/test/Semantics/symbol15.f90 +++ b/flang/test/Semantics/symbol15.f90 @@ -43,6 +43,9 @@ subroutine iface !DEF: /m/pp6 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity !DEF: /m/modproc1 PUBLIC (Subroutine) Subprogram procedure(iface), pointer :: pp6 => modproc1 + !DEF: /m/xx PUBLIC, TARGET ObjectEntity REAL(4) + !DEF: /m/yy PUBLIC, TARGET ObjectEntity REAL(4) + real, target :: xx, yy(2) !DEF: /m/t1 PUBLIC DerivedType type :: t1 !DEF: /m/t1/opc1 POINTER ObjectEntity REAL(4) @@ -51,11 +54,11 @@ subroutine iface !REF: /m/null real, pointer :: opc2 => null() !DEF: /m/t1/opc3 POINTER ObjectEntity REAL(4) - !REF: /m/x - real, pointer :: opc3 => x + !REF: /m/xx + real, pointer :: opc3 => xx !DEF: /m/t1/opc4 POINTER ObjectEntity REAL(4) - !REF: /m/y - real, pointer :: opc4 => y(1) + !REF: /m/yy + real, pointer :: opc4 => yy(1) !REF: /m/iface !DEF: /m/t1/ppc1 NOPASS, POINTER (Subroutine) ProcEntity procedure(iface), nopass, pointer :: ppc1 @@ -101,12 +104,12 @@ subroutine iface !REF: /m/null real, pointer :: opc2 => null() !DEF: /m/pdt1/opc3 POINTER ObjectEntity REAL(4) - !REF: /m/x - real, pointer :: opc3 => x + !REF: /m/xx + real, pointer :: opc3 => xx !DEF: /m/pdt1/opc4 POINTER ObjectEntity REAL(4) - !REF: /m/y + !REF: /m/yy !REF: /m/pdt1/k - real, pointer :: opc4 => y(k) + real, pointer :: opc4 => yy(k) !REF: /m/iface !DEF: /m/pdt1/ppc1 NOPASS, POINTER (Subroutine) ProcEntity procedure(iface), nopass, pointer :: ppc1 diff --git a/t.f90 b/t.f90 new file mode 100644 index 0000000000000..2b8f7129ca666 --- /dev/null +++ b/t.f90 @@ -0,0 +1,11 @@ +integer, target :: ita(2) = [1,2], itb(2) = [3,4], itc(2) = [5,6] +type t1 + integer, pointer :: p1(:) => ita, p2(:) => itb +end type +type t2 + type(t1) :: comp = t1(itc) +end type +type(t2) :: var +print *, var%comp%p2 +var%comp = t1(itc) +end