Skip to content

R
riscv-gcc-1
Commit 7f4c1903 by Arnaud Charlet
Options

[multiple changes] 

2009-04-29  Thomas Quinot  <quinot@adacore.com>

	* sem_elim.adb: Minor reformatting

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Convert_To_Positional): if the current unit is a
	predefined unit, allow arbitrary number of components in static
	aggregate, to ensure that the same level of constant folding applies
	for Ada 95 and Ada 05 versions of the file.

From-SVN: r146944
parent 33374829
Showing with 47 additions and 14 deletions
gcc/ada/ChangeLog
2009-04-29 Thomas Quinot <quinot@adacore.com>
* sem_elim.adb: Minor reformatting
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Convert_To_Positional): if the current unit is a
predefined unit, allow arbitrary number of components in static
aggregate, to ensure that the same level of constant folding applies
for Ada 95 and Ada 05 versions of the file.
2009-04-29 Ed Schonberg <schonberg@adacore.com> 2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_elim.adb (Check_Eliminated): Handle new improved eliminate * sem_elim.adb (Check_Eliminated): Handle new improved eliminate
......
gcc/ada/exp_aggr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,6 +35,7 @@ with Exp_Ch3; use Exp_Ch3; ...@@ -35,6 +35,7 @@ with Exp_Ch3; use Exp_Ch3;
with Exp_Ch7; use Exp_Ch7; with Exp_Ch7; use Exp_Ch7;
with Exp_Ch9; use Exp_Ch9; with Exp_Ch9; use Exp_Ch9;
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
with Fname; use Fname;
with Freeze; use Freeze; with Freeze; use Freeze;
with Itypes; use Itypes; with Itypes; use Itypes;
with Lib; use Lib; with Lib; use Lib;
...@@ -506,7 +507,7 @@ package body Exp_Aggr is ...@@ -506,7 +507,7 @@ package body Exp_Aggr is
-- 9. There cannot be any discriminated record components, since the -- 9. There cannot be any discriminated record components, since the
-- back end cannot handle this complex case. -- back end cannot handle this complex case.
-- 10. No controlled actions need to be generated for components. -- 10. No controlled actions need to be generated for components
function Backend_Processing_Possible (N : Node_Id) return Boolean is function Backend_Processing_Possible (N : Node_Id) return Boolean is
Typ : constant Entity_Id := Etype (N); Typ : constant Entity_Id := Etype (N);
...@@ -3735,24 +3736,43 @@ package body Exp_Aggr is ...@@ -3735,24 +3736,43 @@ package body Exp_Aggr is
-- Check for maximum others replication. Note that -- Check for maximum others replication. Note that
-- we skip this test if either of the restrictions -- we skip this test if either of the restrictions
-- No_Elaboration_Code or No_Implicit_Loops is -- No_Elaboration_Code or No_Implicit_Loops is
-- active, or if this is a preelaborable unit. -- active, if this is a preelaborable unit or a
-- predefined unit. This ensures that predefined
-- units get the same level of constant folding in
-- Ada 95 and Ada 05, where their categorization
-- has changed.
declare declare
P : constant Entity_Id := P : constant Entity_Id :=
Cunit_Entity (Current_Sem_Unit); Cunit_Entity (Current_Sem_Unit);
begin begin
-- Check if duplication OK and if so continue
-- processing.
if Restriction_Active (No_Elaboration_Code) if Restriction_Active (No_Elaboration_Code)
or else Restriction_Active (No_Implicit_Loops) or else Restriction_Active (No_Implicit_Loops)
or else Is_Preelaborated (P) or else Is_Preelaborated (P)
or else (Ekind (P) = E_Package_Body or else (Ekind (P) = E_Package_Body
and then and then
Is_Preelaborated (Spec_Entity (P))) Is_Preelaborated (Spec_Entity (P)))
or else
Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (P)))
then then
null; null;
-- If duplication not OK, then we return False
-- if the replication count is too high
elsif Rep_Count > Max_Others_Replicate then elsif Rep_Count > Max_Others_Replicate then
return False; return False;
-- Continue on if duplication not OK, but the
-- replication count is not excessive.
else
null;
end if; end if;
end; end;
end if; end if;
...@@ -4989,7 +5009,7 @@ package body Exp_Aggr is ...@@ -4989,7 +5009,7 @@ package body Exp_Aggr is
-- STEP 4 -- STEP 4
-- Look if in place aggregate expansion is possible. -- Look if in place aggregate expansion is possible
-- For object declarations we build the aggregate in place, unless -- For object declarations we build the aggregate in place, unless
-- the array is bit-packed or the component is controlled. -- the array is bit-packed or the component is controlled.
......
gcc/ada/sem_elim.adb
...@@ -286,7 +286,7 @@ package body Sem_Elim is ...@@ -286,7 +286,7 @@ package body Sem_Elim is
goto Continue; goto Continue;
end if; end if;
-- Find enclosing unit. -- Find enclosing unit
Scop := Cunit_Entity (Current_Sem_Unit); Scop := Cunit_Entity (Current_Sem_Unit);
...@@ -386,8 +386,8 @@ package body Sem_Elim is ...@@ -386,8 +386,8 @@ package body Sem_Elim is
function Skip_Spaces return Natural; function Skip_Spaces return Natural;
-- If Sloc_Trace (Idx) is not space character, returns -- If Sloc_Trace (Idx) is not space character, returns
-- Idx. Otherwise returns the index of the nearest -- Idx. Otherwise returns the index of the nearest
-- non-space character in Sloc_Trace to the right of -- non-space character in Sloc_Trace to the right of Idx.
-- Idx. Returns 0 if there is no such character. -- Returns 0 if there is no such character.
----------------------------- -----------------------------
-- Different_Trace_Lengths -- -- Different_Trace_Lengths --
...@@ -441,17 +441,19 @@ package body Sem_Elim is ...@@ -441,17 +441,19 @@ package body Sem_Elim is
end if; end if;
end loop; end loop;
-- Find last non-space before this colon. If there -- Find last non-space before this colon. If there is
-- is no space character before this colon, then -- no space character before this colon, then return
-- return False. Otherwise, End_Idx set to point to -- False. Otherwise, End_Idx is set to point to this
-- this non-space character. -- non-space character.
End_Idx := Tmp_Idx; End_Idx := Tmp_Idx;
loop loop
if End_Idx < Idx then if End_Idx < Idx then
return False; return False;
elsif Sloc_Trace (End_Idx) /= ' ' then elsif Sloc_Trace (End_Idx) /= ' ' then
exit; exit;
else else
End_Idx := End_Idx - 1; End_Idx := End_Idx - 1;
end if; end if;
...@@ -559,8 +561,8 @@ package body Sem_Elim is ...@@ -559,8 +561,8 @@ package body Sem_Elim is
end; end;
end if; end if;
-- If we have a Result_Type, then we must have a function -- If we have a Result_Type, then we must have a function with
-- with the proper result type -- the proper result type.
if Elmt.Result_Type /= No_Name then if Elmt.Result_Type /= No_Name then
if Ekind (E) /= E_Function if Ekind (E) /= E_Function
...@@ -658,7 +660,7 @@ package body Sem_Elim is ...@@ -658,7 +660,7 @@ package body Sem_Elim is
end if; end if;
end loop; end loop;
-- If this is an internal operation generated for a protected operation. -- If this is an internal operation generated for a protected operation,
-- its name does not match the source name, so just report the error. -- its name does not match the source name, so just report the error.
if not Comes_From_Source (E) if not Comes_From_Source (E)
......
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