mirror of git://gcc.gnu.org/git/gcc.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 <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
This commit is contained in:
parent
6b6a0f02ab
commit
5e36662885
|
|
@ -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>
|
2018-12-11 Dmitriy Anisimkov <anisimko@adacore.com>
|
||||||
|
|
||||||
* libgnat/g-socket.ads, libgnat/g-socket.adb: Fix duration
|
* libgnat/g-socket.ads, libgnat/g-socket.adb: Fix duration
|
||||||
|
|
|
||||||
|
|
@ -10368,12 +10368,13 @@ package body Sem_Ch3 is
|
||||||
-- If Nod is a library unit entity, then Insert_After won't work,
|
-- 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
|
-- 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
|
-- 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))
|
if (Nkind (Nod) in N_Entity and then Is_Compilation_Unit (Nod))
|
||||||
or else
|
or else
|
||||||
(Nkind (Nod) = N_Defining_Program_Unit_Name
|
(Nkind_In (Nod,
|
||||||
and then Is_Compilation_Unit (Defining_Identifier (Nod)))
|
N_Defining_Program_Unit_Name, N_Subprogram_Declaration)
|
||||||
|
and then Is_Compilation_Unit (Defining_Entity (Nod)))
|
||||||
then
|
then
|
||||||
Add_Global_Declaration (IR);
|
Add_Global_Declaration (IR);
|
||||||
else
|
else
|
||||||
|
|
|
||||||
|
|
@ -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>
|
2018-12-11 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
* gnat.dg/ghost2.adb, gnat.dg/ghost2.ads: New testcase.
|
* gnat.dg/ghost2.adb, gnat.dg/ghost2.ads: New testcase.
|
||||||
|
|
|
||||||
|
|
@ -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;
|
||||||
|
|
@ -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;
|
||||||
|
|
@ -0,0 +1,2 @@
|
||||||
|
with BIP_CU_T; use BIP_CU_T;
|
||||||
|
function BIP_CU_Constructor return T;
|
||||||
|
|
@ -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;
|
||||||
|
|
@ -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;
|
||||||
Loading…
Reference in New Issue