[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:
parent
b6f36bf8c7
commit
d4129bfa7c
8 changed files with 66 additions and 24 deletions
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S E M . C H 7 --
|
||||
-- S E M _ C H 7 --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S E M . C H 8 --
|
||||
-- S E M _ C H 8 --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
|
|
Loading…
Add table
Reference in a new issue