diff options
author | Ed Schonberg <schonberg@adacore.com> | 2018-12-11 11:11:00 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-12-11 11:11:00 +0000 |
commit | 5e366628853651e5d7a98e7bc12f5fb7746ce993 (patch) | |
tree | 4ac1f440ff6cb94ae1ee87f2653e8177773edad1 | |
parent | 6b6a0f02ab7012daebd62726066b827fbdfa62f9 (diff) | |
download | gcc-5e366628853651e5d7a98e7bc12f5fb7746ce993.zip gcc-5e366628853651e5d7a98e7bc12f5fb7746ce993.tar.gz gcc-5e366628853651e5d7a98e7bc12f5fb7746ce993.tar.bz2 |
[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 <schonberg@adacore.com>
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.
From-SVN: r266999
-rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 7 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/bip_cu.adb | 10 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/bip_cu_constructor.adb | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/bip_cu_constructor.ads | 2 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/bip_cu_t.adb | 8 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/bip_cu_t.ads | 10 |
8 files changed, 52 insertions, 3 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 34c3a2f..76c6e76 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-12-11 Ed Schonberg <schonberg@adacore.com> + + * 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 <anisimko@adacore.com> * 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 d99370a..5195f8a 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 d5c371c..3bc15f0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-12-11 Ed Schonberg <schonberg@adacore.com> + + * 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 <kirtchev@adacore.com> * 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 0000000..39790cd --- /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 0000000..7ed3cab9 --- /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 0000000..ed77cf4 --- /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 0000000..bf005b1c --- /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 0000000..75e97b9 --- /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; |