This patch fixes an issue whereby a renaming of an unconstrained formal
parameter leads to spurious runtime errors; manifesting either as a
storage or constraint error due to incorrect bounds being assumed.
This issue also occurs when the renamings are implicit such as through
generic instantiations.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-03 Justin Squirek <squi...@adacore.com>
gcc/ada/
* sem_ch8.adb (Analyze_Object_Renaming): Add call to search for
the appropriate actual subtype of the object renaming being
analyzed.
(Check_Constrained_Object): Minor cleanup.
gcc/testsuite/
* gnat.dg/renaming13.adb, gnat.dg/renaming14.adb: New testcases.--- gcc/ada/sem_ch8.adb
+++ gcc/ada/sem_ch8.adb
@@ -784,9 +784,9 @@ package body Sem_Ch8 is
begin
if Nkind_In (Nam, N_Function_Call, N_Explicit_Dereference)
- and then Is_Composite_Type (Etype (Nam))
- and then not Is_Constrained (Etype (Nam))
- and then not Has_Unknown_Discriminants (Etype (Nam))
+ and then Is_Composite_Type (Typ)
+ and then not Is_Constrained (Typ)
+ and then not Has_Unknown_Discriminants (Typ)
and then Expander_Active
then
-- If Actual_Subtype is already set, nothing to do
@@ -1122,7 +1122,11 @@ package body Sem_Ch8 is
Wrong_Type (Nam, T);
end if;
- T2 := Etype (Nam);
+ -- We must search for an actual subtype here so that the bounds of
+ -- objects of unconstrained types don't get dropped on the floor - such
+ -- as with renamings of formal parameters.
+
+ T2 := Get_Actual_Subtype_If_Available (Nam);
-- Ada 2005 (AI-326): Handle wrong use of incomplete type
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/renaming13.adb
@@ -0,0 +1,21 @@
+-- { dg-do run }
+
+procedure Renaming13 is
+ type Stack_Type_Base is array (Natural range <>) of Integer;
+
+ procedure Foo (Buf : in out Stack_Type_Base) is
+ S : Stack_Type_Base renames Buf;
+
+ procedure Init is
+ begin
+ S := (others => 0);
+ end;
+
+ begin
+ Init;
+ end;
+
+ Temp : Stack_Type_Base (1 .. 100);
+begin
+ Foo (Temp);
+end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/renaming14.adb
@@ -0,0 +1,32 @@
+-- { dg-do run }
+
+procedure Renaming14 is
+ type Rec_Typ is record
+ XX : Integer;
+ end record;
+
+ type Stack_Type_Base is array (Natural range <>) of Rec_Typ;
+
+ generic
+ S : in out Stack_Type_Base;
+ package Stack is
+ procedure Init;
+ end;
+
+ package body Stack is
+ procedure Init is
+ begin
+ S := (others => (XX => 0));
+ end;
+ end;
+
+ procedure Foo (Buf : in out Stack_Type_Base) is
+ package Stack_Inst is new Stack (Buf);
+ begin
+ Stack_Inst.Init;
+ end;
+
+ Temp : Stack_Type_Base (1 .. 100);
+begin
+ Foo (Temp);
+end;
