Commit d4129bfa by Arnaud Charlet

[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
parent b6f36bf8
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> 2014-01-22 Yannick Moy <moy@adacore.com>
* errout.adb (Initialize): Remove trick to add dummy entry * errout.adb (Initialize): Remove trick to add dummy entry
......
...@@ -596,7 +596,10 @@ package body Debug is ...@@ -596,7 +596,10 @@ package body Debug is
-- d.E Turn selected errors into warnings. This debug switch causes a -- d.E Turn selected errors into warnings. This debug switch causes a
-- specific set of error messages into warnings. Setting this switch -- 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 -- d.F Sets GNATprove_Mode to True. This allows debugging the frontend in
-- the special mode used by GNATprove. -- the special mode used by GNATprove.
......
...@@ -1180,26 +1180,27 @@ package body Erroutc is ...@@ -1180,26 +1180,27 @@ package body Erroutc is
and then not GNATprove_Mode and then not GNATprove_Mode
then then
return; return;
end if;
-- If last entry in table already covers us, this is a redundant pragma -- If last entry in table already covers us, this is a redundant pragma
-- Warnings (Off) and can be ignored. -- 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 Warnings.Table (Warnings.Last).Start <= Loc
and then Loc <= Warnings.Table (Warnings.Last).Stop and then Loc <= Warnings.Table (Warnings.Last).Stop
then then
return; return;
end if;
-- Otherwise establish a new entry, extending from the location of the -- If none of those special conditions holds, establish a new entry,
-- pragma to the end of the current source file. This ending point will -- extending from the location of the pragma to the end of the current
-- be adjusted by a subsequent pragma Warnings (On). -- source file. This ending point will be adjusted by a subsequent
-- corresponding pragma Warnings (On).
else Warnings.Increment_Last;
Warnings.Increment_Last; Warnings.Table (Warnings.Last).Start := Loc;
Warnings.Table (Warnings.Last).Start := Loc; Warnings.Table (Warnings.Last).Stop :=
Warnings.Table (Warnings.Last).Stop := Source_Last (Current_Source_File);
Source_Last (Current_Source_File);
end if;
end Set_Warnings_Mode_Off; end Set_Warnings_Mode_Off;
-------------------------- --------------------------
...@@ -1223,11 +1224,12 @@ package body Erroutc is ...@@ -1223,11 +1224,12 @@ package body Erroutc is
and then not GNATprove_Mode and then not GNATprove_Mode
then then
return; return;
end if;
-- If the last entry in the warnings table covers this pragma, then -- If the last entry in the warnings table covers this pragma, then
-- we adjust the end point appropriately. -- 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 Warnings.Table (Warnings.Last).Start <= Loc
and then Loc <= Warnings.Table (Warnings.Last).Stop and then Loc <= Warnings.Table (Warnings.Last).Stop
then then
......
...@@ -5561,7 +5561,7 @@ package body Exp_Ch3 is ...@@ -5561,7 +5561,7 @@ package body Exp_Ch3 is
Apply_Constraint_Check (Expr, Typ); Apply_Constraint_Check (Expr, Typ);
-- If the expression has been marked as requiring a range -- 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 if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False); Set_Do_Range_Check (Expr, False);
......
...@@ -7330,7 +7330,6 @@ package body Exp_Ch4 is ...@@ -7330,7 +7330,6 @@ package body Exp_Ch4 is
declare declare
Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp)); Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp));
Et : constant Entity_Id := Root_Type (Underlying_Type (Exptyp)); Et : constant Entity_Id := Root_Type (Underlying_Type (Exptyp));
begin begin
Rewrite (N, Rewrite (N,
Unchecked_Convert_To (Typ, Unchecked_Convert_To (Typ,
...@@ -7610,7 +7609,7 @@ package body Exp_Ch4 is ...@@ -7610,7 +7609,7 @@ package body Exp_Ch4 is
then then
Rewrite (N, Rewrite (N,
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Reference_To (RTE (Rent), Loc), Name => New_Reference_To (RTE (Rent), Loc),
Parameter_Associations => New_List (Base, Exp))); Parameter_Associations => New_List (Base, Exp)));
-- Otherwise we have to introduce conversions (conversions are also -- Otherwise we have to introduce conversions (conversions are also
......
...@@ -2991,6 +2991,11 @@ package body Sem_Ch3 is ...@@ -2991,6 +2991,11 @@ package body Sem_Ch3 is
-- or a variant record type is encountered, Check_Restrictions is called -- or a variant record type is encountered, Check_Restrictions is called
-- indicating the count is unknown. -- 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 -- -- Count_Tasks --
----------------- -----------------
...@@ -3045,6 +3050,24 @@ package body Sem_Ch3 is ...@@ -3045,6 +3050,24 @@ package body Sem_Ch3 is
end if; end if;
end Count_Tasks; 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 -- Start of processing for Analyze_Object_Declaration
begin begin
...@@ -3647,16 +3670,15 @@ package body Sem_Ch3 is ...@@ -3647,16 +3670,15 @@ package body Sem_Ch3 is
Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc)); Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
elsif Present (Underlying_Type (T)) elsif Nkind (E) = N_Function_Call
and then not Is_Constrained (Underlying_Type (T))
and then Has_Discriminants (Underlying_Type (T))
and then Nkind (E) = N_Function_Call
and then Constant_Present (N) and then Constant_Present (N)
and then Has_Unconstrained_Elements (Etype (E))
then then
-- The back-end has problems with constants of a discriminated type -- The back-end has problems with constants of a discriminated type
-- with defaults, if the initial value is a function call. We -- with defaults, if the initial value is a function call. We
-- generate an intermediate temporary for the result of the call. -- generate an intermediate temporary that will receive a reference
-- It is unclear why this should make it acceptable to gcc. ??? -- to the result of the call. The initialization expression then
-- becomes a dereference of that temporary.
Remove_Side_Effects (E); Remove_Side_Effects (E);
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT COMPILER COMPONENTS -- -- GNAT COMPILER COMPONENTS --
-- -- -- --
-- S E M . C H 7 -- -- S E M _ C H 7 --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT COMPILER COMPONENTS -- -- GNAT COMPILER COMPONENTS --
-- -- -- --
-- S E M . C H 8 -- -- S E M _ C H 8 --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment