[Ada] Incorrect expansion on renamings of formal parameters

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.

2019-07-03  Justin Squirek  <squirek@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.

From-SVN: r272982
This commit is contained in:
Justin Squirek 2019-07-03 08:16:06 +00:00 committed by Pierre-Marie de Rodat
parent f4c16c58e1
commit eee51f3dd6
5 changed files with 72 additions and 4 deletions

View File

@ -1,3 +1,10 @@
2019-07-03 Justin Squirek <squirek@adacore.com>
* 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.
2019-07-03 Yannick Moy <moy@adacore.com>
* sem_spark.adb (Get_Observed_Or_Borrowed_Expr): New function to

View File

@ -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

View File

@ -1,3 +1,7 @@
2019-07-03 Justin Squirek <squirek@adacore.com>
* gnat.dg/renaming13.adb, gnat.dg/renaming14.adb: New testcases.
2019-07-03 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/inline15.adb, gnat.dg/inline15_gen.adb,

View File

@ -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;

View File

@ -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;