diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -594,10 +594,9 @@ bool operator==(const Symbol &that) const { return this == &that; } bool operator!=(const Symbol &that) const { return !(*this == that); } - bool operator<(const Symbol &that) const { - // For sets of symbols: collate them by source location - return name_.begin() < that.name_.begin(); - } + // For sets of symbols (SymbolSet): collate them by address since their + // source location can change + bool operator<(const Symbol &that) const { return this < &that; } int Rank() const { return std::visit( diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1003,6 +1003,7 @@ context().SetError(symbol); return symbol; } + bool HasCycle(const Symbol &, const ProcInterface &); }; // Resolve construct entities and statement entities. @@ -2132,7 +2133,7 @@ void ScopeHandler::ApplyImplicitRules( Symbol &symbol, bool allowForwardReference) { - if (!NeedsType(symbol)) { + if (context().HasError(symbol) || !NeedsType(symbol)) { return; } if (const DeclTypeSpec * type{GetImplicitType(symbol)}) { @@ -2156,10 +2157,8 @@ if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) { return; } - if (!context().HasError(symbol)) { - Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US); - context().SetError(symbol); - } + Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US); + context().SetError(symbol); } // Extension: Allow forward references to scalar integer dummy arguments @@ -3641,6 +3640,35 @@ } } +bool DeclarationVisitor::HasCycle( + const Symbol &procSymbol, const ProcInterface &interface) { + SymbolSet procsInCycle; + procsInCycle.insert(procSymbol); + const ProcInterface *thisInterface{&interface}; + bool haveInterface{true}; + while (haveInterface) { + haveInterface = false; + if (const Symbol * interfaceSymbol{thisInterface->symbol()}) { + if (procsInCycle.count(*interfaceSymbol) > 0) { + for (const auto procInCycle : procsInCycle) { + Say(procInCycle->name(), + "The interface for procedure '%s' is recursively " + "defined"_err_en_US, + procInCycle->name()); + context().SetError(*procInCycle); + } + return true; + } else if (const auto *procDetails{ + interfaceSymbol->detailsIf()}) { + haveInterface = true; + thisInterface = &procDetails->interface(); + procsInCycle.insert(*interfaceSymbol); + } + } + } + return false; +} + Symbol &DeclarationVisitor::DeclareProcEntity( const parser::Name &name, Attrs attrs, const ProcInterface &interface) { Symbol &symbol{DeclareEntity(name, attrs)}; @@ -3650,20 +3678,20 @@ "The interface for procedure '%s' has already been " "declared"_err_en_US); context().SetError(symbol); - } else { - if (interface.type()) { + } else if (HasCycle(symbol, interface)) { + return symbol; + } else if (interface.type()) { + symbol.set(Symbol::Flag::Function); + } else if (interface.symbol()) { + if (interface.symbol()->test(Symbol::Flag::Function)) { symbol.set(Symbol::Flag::Function); - } else if (interface.symbol()) { - if (interface.symbol()->test(Symbol::Flag::Function)) { - symbol.set(Symbol::Flag::Function); - } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) { - symbol.set(Symbol::Flag::Subroutine); - } + } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) { + symbol.set(Symbol::Flag::Subroutine); } - details->set_interface(interface); - SetBindNameOn(symbol); - SetPassNameOn(symbol); } + details->set_interface(interface); + SetBindNameOn(symbol); + SetPassNameOn(symbol); } return symbol; } @@ -5005,7 +5033,7 @@ void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) { if (const Symbol * symbol{name.symbol}) { - if (!symbol->HasExplicitInterface()) { + if (!context().HasError(*symbol) && !symbol->HasExplicitInterface()) { Say(name, "'%s' must be an abstract interface or a procedure with " "an explicit interface"_err_en_US, diff --git a/flang/test/Semantics/data05.f90 b/flang/test/Semantics/data05.f90 --- a/flang/test/Semantics/data05.f90 +++ b/flang/test/Semantics/data05.f90 @@ -73,15 +73,15 @@ end function subroutine s11 real, target, save :: arr(3,4) ! CHECK: arr, SAVE, TARGET size=48 offset=0: ObjectEntity type: REAL(4) shape: 1_8:3_8,1_8:4_8 - type(t1) :: d1 = t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc) ! CHECK: d1 size=184 offset=48: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + type(t1) :: d1 = t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc) ! CHECK: d1 size=192 offset=48: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4)) type(t1(4,len=1)) :: d2 = t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='a& - &b',t=.false.,z=(6.,7.),x=reshape([1,2,3,4],[2,2]),j=1) ! CHECK: d2 size=184 offset=232: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) - type(t1(2+2)) :: d3 ! CHECK: d3 (InDataStmt) size=184 offset=416: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + &b',t=.false.,z=(6.,7.),x=reshape([1,2,3,4],[2,2]),j=1) ! CHECK: d2 size=192 offset=240: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4)) + type(t1(2+2)) :: d3 ! CHECK: d3 (InDataStmt) size=192 offset=432: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4)) data d3/t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc)/ - type(t1) :: d4 ! CHECK: d4 (InDataStmt) size=184 offset=600: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + type(t1) :: d4 ! CHECK: d4 (InDataStmt) size=192 offset=624: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","a"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4)) data d4/t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='ab',t=.false.,z=(6& &.,7.),x=reshape([1,2,3,4],[2,2]),j=1)/ - type(t1) :: d5 ! CHECK: d5 (InDataStmt) size=184 offset=784: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","b"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + type(t1) :: d5 ! CHECK: d5 (InDataStmt) size=192 offset=816: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(c=[CHARACTER(KIND=1,LEN=1)::"a","b"],ifptr=ifunc2,j=1_4,rp=rfunc,t=.false._4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),xp=arr,xrp=extrfunc,z=(6._4,7._4)) data d5%j/1/,d5%x/1,2,3,4/,d5%z%re/6./,d5%z%im/7./,d5%t/.false./,d5%c(1:1)/'a'/,d5%c(2:& &2)/'b'/,d5%xp/arr/,d5%ifptr/ifunc2/,d5%rp/rfunc/,d5%xrp/extrfunc/ end subroutine diff --git a/flang/test/Semantics/resolve102.f90 b/flang/test/Semantics/resolve102.f90 --- a/flang/test/Semantics/resolve102.f90 +++ b/flang/test/Semantics/resolve102.f90 @@ -9,7 +9,7 @@ end subroutine subroutine circular - !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''p', 'sub', 'p2'' + !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''sub', 'p', 'p2'' procedure(sub) :: p call p(sub) @@ -21,7 +21,7 @@ end subroutine circular program iface - !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''p', 'sub', 'p2'' + !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''sub', 'p', 'p2'' procedure(sub) :: p interface subroutine sub(p2) @@ -38,7 +38,7 @@ Call p(sub) contains - !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''p', 'sub1', 'arg'' + !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''sub1', 'p', 'arg'' Subroutine sub1(arg) procedure(sub1) :: arg End Subroutine @@ -54,7 +54,7 @@ Call p(sub) contains - !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''p', 'sub1', 'arg', 'sub', 'p2'' + !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''sub1', 'sub', 'p', 'arg', 'p2'' Subroutine sub1(arg) procedure(sub) :: arg End Subroutine @@ -63,3 +63,24 @@ Procedure(sub1) :: p2 End Subroutine End Program + +program twoCycle + !ERROR: The interface for procedure 'p1' is recursively defined + !ERROR: The interface for procedure 'p2' is recursively defined + procedure(p1) p2 + procedure(p2) p1 + call p1 + call p2 +end program + +program threeCycle + !ERROR: The interface for procedure 'p1' is recursively defined + !ERROR: The interface for procedure 'p2' is recursively defined + procedure(p1) p2 + !ERROR: The interface for procedure 'p3' is recursively defined + procedure(p2) p3 + procedure(p3) p1 + call p1 + call p2 + call p3 +end program diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90 --- a/flang/test/Semantics/typeinfo01.f90 +++ b/flang/test/Semantics/typeinfo01.f90 @@ -231,7 +231,7 @@ subroutine s1(x) !CHECK: .b.t.1.allocatable, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=1_1,value=0_8),value(genre=1_1,value=0_8)],shape=[2,1]) !CHECK: .b.t.1.automatic, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1]) -!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.allocatable,initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL()),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target)] +!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.allocatable,initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL()),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=96_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=120_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target)] !CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,parent=NULL(),uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL()) !CHECK: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1] type(t(*)), intent(in) :: x