[multiple changes]

2014-01-22  Robert Dewar  <dewar@adacore.com>

	* debug.adb, exp_ch4.adb, erroutc.adb: Minor reformatting.

2014-01-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch7.adb, sem_ch8.adb, exp_ch3.adb: Minor reformatting.

2014-01-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): For a constant
	declaration initialized with a function call, whose type
	has variable size, need to remove side effects so that the
	initialization expression becomes a dereference of a temporary
	reference to the function result.

From-SVN: r206928
This commit is contained in:
Arnaud Charlet 2014-01-22 17:42:55 +01:00
parent b6f36bf8c7
commit d4129bfa7c
8 changed files with 66 additions and 24 deletions

View file

@ -1,3 +1,19 @@
2014-01-22 Robert Dewar <dewar@adacore.com>
* debug.adb, exp_ch4.adb, erroutc.adb: Minor reformatting.
2014-01-22 Thomas Quinot <quinot@adacore.com>
* sem_ch7.adb, sem_ch8.adb, exp_ch3.adb: Minor reformatting.
2014-01-22 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): For a constant
declaration initialized with a function call, whose type
has variable size, need to remove side effects so that the
initialization expression becomes a dereference of a temporary
reference to the function result.
2014-01-22 Yannick Moy <moy@adacore.com>
* errout.adb (Initialize): Remove trick to add dummy entry

View file

@ -596,7 +596,10 @@ package body Debug is
-- d.E Turn selected errors into warnings. This debug switch causes a
-- specific set of error messages into warnings. Setting this switch
-- causes Opt.Error_To_Warning to be set to True.
-- causes Opt.Error_To_Warning to be set to True. Right now the only
-- error affected is the case of overlapping subprogram parameters
-- which has become illegal in Ada 2012, but only generates a warning
-- in earlier versions of Ada.
-- d.F Sets GNATprove_Mode to True. This allows debugging the frontend in
-- the special mode used by GNATprove.

View file

@ -1180,26 +1180,27 @@ package body Erroutc is
and then not GNATprove_Mode
then
return;
end if;
-- If last entry in table already covers us, this is a redundant pragma
-- Warnings (Off) and can be ignored.
elsif Warnings.Last >= Warnings.First
if Warnings.Last >= Warnings.First
and then Warnings.Table (Warnings.Last).Start <= Loc
and then Loc <= Warnings.Table (Warnings.Last).Stop
then
return;
-- Otherwise establish a new entry, extending from the location of the
-- pragma to the end of the current source file. This ending point will
-- be adjusted by a subsequent pragma Warnings (On).
else
Warnings.Increment_Last;
Warnings.Table (Warnings.Last).Start := Loc;
Warnings.Table (Warnings.Last).Stop :=
Source_Last (Current_Source_File);
end if;
-- If none of those special conditions holds, establish a new entry,
-- extending from the location of the pragma to the end of the current
-- source file. This ending point will be adjusted by a subsequent
-- corresponding pragma Warnings (On).
Warnings.Increment_Last;
Warnings.Table (Warnings.Last).Start := Loc;
Warnings.Table (Warnings.Last).Stop :=
Source_Last (Current_Source_File);
end Set_Warnings_Mode_Off;
--------------------------
@ -1223,11 +1224,12 @@ package body Erroutc is
and then not GNATprove_Mode
then
return;
end if;
-- If the last entry in the warnings table covers this pragma, then
-- we adjust the end point appropriately.
elsif Warnings.Last >= Warnings.First
if Warnings.Last >= Warnings.First
and then Warnings.Table (Warnings.Last).Start <= Loc
and then Loc <= Warnings.Table (Warnings.Last).Stop
then

View file

@ -5561,7 +5561,7 @@ package body Exp_Ch3 is
Apply_Constraint_Check (Expr, Typ);
-- If the expression has been marked as requiring a range
-- generate it now and reset the flag.
-- check, generate it now and reset the flag.
if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False);

View file

@ -7330,7 +7330,6 @@ package body Exp_Ch4 is
declare
Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp));
Et : constant Entity_Id := Root_Type (Underlying_Type (Exptyp));
begin
Rewrite (N,
Unchecked_Convert_To (Typ,
@ -7610,7 +7609,7 @@ package body Exp_Ch4 is
then
Rewrite (N,
Make_Function_Call (Loc,
Name => New_Reference_To (RTE (Rent), Loc),
Name => New_Reference_To (RTE (Rent), Loc),
Parameter_Associations => New_List (Base, Exp)));
-- Otherwise we have to introduce conversions (conversions are also

View file

@ -2991,6 +2991,11 @@ package body Sem_Ch3 is
-- or a variant record type is encountered, Check_Restrictions is called
-- indicating the count is unknown.
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
-- True if T has discriminants and is unconstrained, or is an array
-- type whose element type Has_Unconstrained_Elements. Shouldn't this
-- be in sem_util???
-----------------
-- Count_Tasks --
-----------------
@ -3045,6 +3050,24 @@ package body Sem_Ch3 is
end if;
end Count_Tasks;
--------------------------------
-- Has_Unconstrained_Elements --
--------------------------------
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean is
U_T : constant Entity_Id := Underlying_Type (T);
begin
if No (U_T) then
return False;
elsif Is_Record_Type (U_T) then
return Has_Discriminants (U_T) and then not Is_Constrained (U_T);
elsif Is_Array_Type (U_T) then
return Has_Unconstrained_Elements (Component_Type (U_T));
else
return False;
end if;
end Has_Unconstrained_Elements;
-- Start of processing for Analyze_Object_Declaration
begin
@ -3647,16 +3670,15 @@ package body Sem_Ch3 is
Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
elsif Present (Underlying_Type (T))
and then not Is_Constrained (Underlying_Type (T))
and then Has_Discriminants (Underlying_Type (T))
and then Nkind (E) = N_Function_Call
elsif Nkind (E) = N_Function_Call
and then Constant_Present (N)
and then Has_Unconstrained_Elements (Etype (E))
then
-- The back-end has problems with constants of a discriminated type
-- with defaults, if the initial value is a function call. We
-- generate an intermediate temporary for the result of the call.
-- It is unclear why this should make it acceptable to gcc. ???
-- generate an intermediate temporary that will receive a reference
-- to the result of the call. The initialization expression then
-- becomes a dereference of that temporary.
Remove_Side_Effects (E);

View file

@ -2,7 +2,7 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M . C H 7 --
-- S E M _ C H 7 --
-- --
-- B o d y --
-- --

View file

@ -2,7 +2,7 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M . C H 8 --
-- S E M _ C H 8 --
-- --
-- B o d y --
-- --