From: pmderodat Date: Tue, 11 Dec 2018 11:11:00 +0000 (+0000) Subject: [Ada] Crash on compilation unit function that builds in place X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=3d8677c9b09e4c93552673fb04382142bc7275e8;p=thirdparty%2Fgcc.git [Ada] Crash on compilation unit function that builds in place This patch fixes a crash on a function that builds its limited result in place. Previously this was handled properly only if the function was a child unit. 2018-12-11 Ed Schonberg gcc/ada/ * sem_ch3.adb (Build_Itype_Reference): Handle properly an itype reference created for a function that is a compilation unit, for example if the function builds in place an object of a limited type. gcc/testsuite/ * gnat.dg/bip_cu.adb, gnat.dg/bip_cu_constructor.adb, gnat.dg/bip_cu_constructor.ads, gnat.dg/bip_cu_t.adb, gnat.dg/bip_cu_t.ads: New testcase. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@266999 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 34c3a2fad4a3..76c6e761e004 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-12-11 Ed Schonberg + + * sem_ch3.adb (Build_Itype_Reference): Handle properly an itype + reference created for a function that is a compilation unit, for + example if the function builds in place an object of a limited + type. + 2018-12-11 Dmitriy Anisimkov * libgnat/g-socket.ads, libgnat/g-socket.adb: Fix duration diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d99370ae6bb7..5195f8a267b3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -10368,12 +10368,13 @@ package body Sem_Ch3 is -- If Nod is a library unit entity, then Insert_After won't work, -- because Nod is not a member of any list. Therefore, we use -- Add_Global_Declaration in this case. This can happen if we have a - -- build-in-place library function. + -- build-in-place library function, child unit or not. if (Nkind (Nod) in N_Entity and then Is_Compilation_Unit (Nod)) or else - (Nkind (Nod) = N_Defining_Program_Unit_Name - and then Is_Compilation_Unit (Defining_Identifier (Nod))) + (Nkind_In (Nod, + N_Defining_Program_Unit_Name, N_Subprogram_Declaration) + and then Is_Compilation_Unit (Defining_Entity (Nod))) then Add_Global_Declaration (IR); else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d5c371c5c5e1..3bc15f08521d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-12-11 Ed Schonberg + + * gnat.dg/bip_cu.adb, gnat.dg/bip_cu_constructor.adb, + gnat.dg/bip_cu_constructor.ads, gnat.dg/bip_cu_t.adb, + gnat.dg/bip_cu_t.ads: New testcase. + 2018-12-11 Hristian Kirtchev * gnat.dg/ghost2.adb, gnat.dg/ghost2.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/bip_cu.adb b/gcc/testsuite/gnat.dg/bip_cu.adb new file mode 100644 index 000000000000..39790cdc6332 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_cu.adb @@ -0,0 +1,10 @@ +-- { dg-do compile } + +with BIP_CU_T; use BIP_CU_T; +with BIP_CU_Constructor; + +procedure BIP_CU is + Value : constant T := BIP_CU_Constructor; +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/bip_cu_constructor.adb b/gcc/testsuite/gnat.dg/bip_cu_constructor.adb new file mode 100644 index 000000000000..7ed3cab9b5cf --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_cu_constructor.adb @@ -0,0 +1,5 @@ +with BIP_CU_T; use BIP_CU_T; +function BIP_CU_Constructor return T is +begin + return Make_T (Name => "Rumplestiltskin"); +end BIP_CU_Constructor; diff --git a/gcc/testsuite/gnat.dg/bip_cu_constructor.ads b/gcc/testsuite/gnat.dg/bip_cu_constructor.ads new file mode 100644 index 000000000000..ed77cf48c989 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_cu_constructor.ads @@ -0,0 +1,2 @@ +with BIP_CU_T; use BIP_CU_T; +function BIP_CU_Constructor return T; diff --git a/gcc/testsuite/gnat.dg/bip_cu_t.adb b/gcc/testsuite/gnat.dg/bip_cu_t.adb new file mode 100644 index 000000000000..bf005b1c1915 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_cu_t.adb @@ -0,0 +1,8 @@ +package body BIP_CU_T is + + function Make_T (Name : String) return T is + begin + return (Name => To_Unbounded_String (Name), others => <>); + end Make_T; + +end BIP_CU_T; diff --git a/gcc/testsuite/gnat.dg/bip_cu_t.ads b/gcc/testsuite/gnat.dg/bip_cu_t.ads new file mode 100644 index 000000000000..75e97b9d4cfa --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_cu_t.ads @@ -0,0 +1,10 @@ +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; + +package BIP_CU_T is + type T is limited private; + function Make_T (Name : String) return T; +private + type T is limited record + Name : Unbounded_String; + end record; +end BIP_CU_T;