[multiple changes]

2010-10-11  Bob Duff  <duff@adacore.com>

	* sem_aggr.adb, impunit.adb, impunit.ads, switch-c.adb, usage.adb,
	sem_ch10.adb, sem_prag.adb, sem_ch12.adb, par-ch4.adb, par-ch6.adb,
	par-ch8.adb, exp_ch4.adb, sem_ch4.adb, sem_ch6.adb, par-prag.adb,
	opt.ads, par-ch3.adb, lib-xref.adb: Use Ada_2012 instead of Ada_12
	(Ada_Version_Type).

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* exp_util.adb (Safe_Prefixed_Reference): If the prefix is an explicit
	dereference then do not exclude dereferences of access-to-constant
	types to handle them as constant view of variables (and hence remove
	side effects when required).
	* sem_res.adb (Resolve_Slice): Ensure that side effects in the bounds
	are properly handled.

From-SVN: r165282
This commit is contained in:
Arnaud Charlet 2010-10-11 11:11:57 +02:00
parent 2b3d67a55b
commit dbe945f1d5
21 changed files with 78 additions and 56 deletions

View File

@ -1,3 +1,20 @@
2010-10-11 Bob Duff <duff@adacore.com>
* sem_aggr.adb, impunit.adb, impunit.ads, switch-c.adb, usage.adb,
sem_ch10.adb, sem_prag.adb, sem_ch12.adb, par-ch4.adb, par-ch6.adb,
par-ch8.adb, exp_ch4.adb, sem_ch4.adb, sem_ch6.adb, par-prag.adb,
opt.ads, par-ch3.adb, lib-xref.adb: Use Ada_2012 instead of Ada_12
(Ada_Version_Type).
2010-10-11 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Safe_Prefixed_Reference): If the prefix is an explicit
dereference then do not exclude dereferences of access-to-constant
types to handle them as constant view of variables (and hence remove
side effects when required).
* sem_res.adb (Resolve_Slice): Ensure that side effects in the bounds
are properly handled.
2010-10-11 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_aggr.adb, sprint.adb: Minor reformatting.

View File

@ -2181,7 +2181,7 @@ package body Exp_Ch4 is
end if;
end if;
elsif Ada_Version >= Ada_12 then
elsif Ada_Version >= Ada_2012 then
-- if no TSS has been created for the type, check whether there is
-- a primitive equality declared for it. If it is abstract replace

View File

@ -4540,16 +4540,17 @@ package body Exp_Util is
or else Ekind (Entity (Prefix (N))) = E_In_Parameter;
end if;
-- If the prefix is an explicit dereference that is not access-to-
-- constant then this construct is a variable reference, which means
-- it is to be considered to have side effects if Variable_Ref is
-- True.
-- If the prefix is an explicit dereference then this construct is a
-- variable reference, which means it is to be considered to have
-- side effects if Variable_Ref is True.
-- We do NOT exclude dereferences of access-to-constant types because
-- we handle them as constant view of variables.
-- Exception is an access to an entity that is a constant or an
-- in-parameter.
elsif Nkind (Prefix (N)) = N_Explicit_Dereference
and then not Is_Access_Constant (Etype (Prefix (Prefix (N))))
and then Variable_Ref
then
declare

View File

@ -617,7 +617,7 @@ package body Impunit is
for J in Non_Imp_File_Names_12'Range loop
if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J) then
return Ada_12_Unit;
return Ada_2012_Unit;
end if;
end loop;

View File

@ -53,7 +53,7 @@ package Impunit is
-- Ada 95 mode program will generate a warning (again, strictly speaking
-- this should be an error, but that seems over-strenuous).
Ada_12_Unit);
Ada_2012_Unit);
-- This unit is defined in the Ada 2012 RM. Withing this unit from a Ada
-- 95 mode or Ada 2005 program will generate a warning (again, strictly
-- speaking this should be an error, but that seems over-strenuous).

View File

@ -480,7 +480,7 @@ package body Lib.Xref is
if Comes_From_Source (N)
and then Is_Ada_2012_Only (E)
and then Ada_Version < Ada_12
and then Ada_Version < Ada_2012
and then Warn_On_Ada_2012_Compatibility
and then (Typ = 'm' or else Typ = 'r')
then

View File

@ -64,14 +64,13 @@ package Opt is
-- GNATBIND, GNATLINK
-- Set True if binder file to be generated in Ada rather than C
type Ada_Version_Type is (Ada_83, Ada_95, Ada_05, Ada_12);
type Ada_Version_Type is (Ada_83, Ada_95, Ada_05, Ada_2012);
pragma Ordered (Ada_Version_Type);
-- Versions of Ada for Ada_Version below. Note that these are ordered,
-- so that tests like Ada_Version >= Ada_95 are legitimate and useful.
Ada_2005 : Ada_Version_Type renames Ada_05;
Ada_2012 : Ada_Version_Type renames Ada_12;
-- Renamings with full names (preferred usage)
-- Renaming with full name (preferred usage)
Ada_Version_Default : constant Ada_Version_Type := Ada_05;
pragma Warnings (Off, Ada_Version_Default);
@ -97,7 +96,7 @@ package Opt is
-- the rare cases (notably for pragmas Preelaborate_05 and Pure_05)
-- where in the run-time we want the explicit version set.
Ada_Version_Runtime : Ada_Version_Type := Ada_12;
Ada_Version_Runtime : Ada_Version_Type := Ada_2012;
-- GNAT
-- Ada version used to compile the runtime. Used to set Ada_Version (but
-- not Ada_Version_Explicit) when compiling predefined or internal units.

View File

@ -3683,7 +3683,7 @@ package body Ch3 is
-- Technically in the grammar, the expression must match the
-- grammar for restricted expression.
if Ada_Version >= Ada_12 then
if Ada_Version >= Ada_2012 then
Check_Restricted_Expression (Expr_Node);
-- In Ada 83 mode, the syntax required a simple expression

View File

@ -235,7 +235,7 @@ package body Ch4 is
-- Qualified expression in Ada 2012 mode (treated as a name)
if Ada_Version >= Ada_12 and then Token = Tok_Left_Paren then
if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
goto Scan_Name_Extension_Apostrophe;
-- If left paren not in Ada 2012, then it is not part of the name,
@ -389,7 +389,7 @@ package body Ch4 is
begin
-- Check for qualified expression case in Ada 2012 mode
if Ada_Version >= Ada_12 and then Token = Tok_Left_Paren then
if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
Name_Node := P_Qualified_Expression (Name_Node);
goto Scan_Name_Extension;
@ -2073,7 +2073,7 @@ package body Ch4 is
-- If qualified expression, comment and continue, otherwise something
-- is pretty nasty so do an Error_Resync call.
if Ada_Version < Ada_12
if Ada_Version < Ada_2012
and then Nkind (Node1) = N_Qualified_Expression
then
Error_Msg_SC ("\would be legal in Ada 2012 mode");
@ -2400,7 +2400,7 @@ package body Ch4 is
-- If this looks like a conditional expression, then treat it
-- that way with an error message.
elsif Ada_Version >= Ada_12 then
elsif Ada_Version >= Ada_2012 then
Error_Msg_SC
("conditional expression must be parenthesized");
return P_Conditional_Expression;
@ -2426,7 +2426,7 @@ package body Ch4 is
-- If this looks like a case expression, then treat it that way
-- with an error message.
elsif Ada_Version >= Ada_12 then
elsif Ada_Version >= Ada_2012 then
Error_Msg_SC ("case expression must be parenthesized");
return P_Case_Expression;
@ -2716,7 +2716,7 @@ package body Ch4 is
Save_State : Saved_Scan_State;
begin
if Ada_Version < Ada_12 then
if Ada_Version < Ada_2012 then
Error_Msg_SC ("|case expression is an Ada 2012 feature");
Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
end if;
@ -2807,7 +2807,7 @@ package body Ch4 is
begin
Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
if Token = Tok_If and then Ada_Version < Ada_12 then
if Token = Tok_If and then Ada_Version < Ada_2012 then
Error_Msg_SC ("|conditional expression is an Ada 2012 feature");
Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
end if;
@ -2884,13 +2884,13 @@ package body Ch4 is
procedure P_Membership_Test (N : Node_Id) is
Alt : constant Node_Id :=
P_Range_Or_Subtype_Mark
(Allow_Simple_Expression => (Ada_Version >= Ada_12));
(Allow_Simple_Expression => (Ada_Version >= Ada_2012));
begin
-- Set case
if Token = Tok_Vertical_Bar then
if Ada_Version < Ada_12 then
if Ada_Version < Ada_2012 then
Error_Msg_SC ("set notation is an Ada 2012 feature");
Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
end if;

View File

@ -710,7 +710,7 @@ package body Ch6 is
-- Check we are in Ada 2012 mode
if Ada_Version < Ada_12 then
if Ada_Version < Ada_2012 then
Error_Msg_SC
("parameterized expression is an Ada 2012 feature!");
Error_Msg_SC

View File

@ -109,7 +109,7 @@ package body Ch8 is
begin
if Token = Tok_All then
if Ada_Version < Ada_12 then
if Ada_Version < Ada_2012 then
Error_Msg_SC ("|`USE ALL TYPE` is an Ada 2012 feature");
Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
end if;

View File

@ -328,8 +328,8 @@ begin
when Pragma_Ada_12 | Pragma_Ada_2012 =>
if Arg_Count = 0 then
Ada_Version := Ada_12;
Ada_Version_Explicit := Ada_12;
Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_2012;
end if;
-----------
@ -389,7 +389,7 @@ begin
if Chars (Expression (Arg1)) = Name_On then
Extensions_Allowed := True;
Ada_Version := Ada_12;
Ada_Version := Ada_2012;
else
Extensions_Allowed := False;
Ada_Version := Ada_Version_Explicit;

View File

@ -3965,7 +3965,7 @@ package body Sem_Aggr is
-- designated types match.
elsif Typech /= Base_Type (Etype (Component)) then
if Ada_Version >= Ada_12
if Ada_Version >= Ada_2012
and then Ekind (Typech) = E_Anonymous_Access_Type
and then
Ekind (Etype (Component)) = E_Anonymous_Access_Type

View File

@ -2458,8 +2458,8 @@ package body Sem_Ch10 is
then
Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
elsif U_Kind = Ada_12_Unit
and then Ada_Version < Ada_12
elsif U_Kind = Ada_2012_Unit
and then Ada_Version < Ada_2012
and then Warn_On_Ada_2012_Compatibility
then
Error_Msg_N ("& is an Ada 2012 unit?", Name (N));

View File

@ -2808,7 +2808,7 @@ package body Sem_Ch12 is
-- versions of Ada as well as Ada 2012???
if Is_Abstract_Type (Designated_Type (Result_Type))
and then Ada_Version >= Ada_12
and then Ada_Version >= Ada_2012
then
Error_Msg_N ("generic function cannot have an access result"
& " that designates an abstract type", Spec);
@ -2819,7 +2819,7 @@ package body Sem_Ch12 is
Typ := Entity (Result_Definition (Spec));
if Is_Abstract_Type (Typ)
and then Ada_Version >= Ada_12
and then Ada_Version >= Ada_2012
then
Error_Msg_N
("generic function cannot have abstract result type", Spec);
@ -9986,7 +9986,7 @@ package body Sem_Ch12 is
if Is_Limited_Type (Act_T)
and then not Is_Limited_Type (A_Gen_T)
and then Ada_Version >= Ada_12
and then Ada_Version >= Ada_2012
then
Error_Msg_NE
("actual for non-limited & cannot be a limited type", Actual,

View File

@ -562,7 +562,7 @@ package body Sem_Ch4 is
Reason => CE_Null_Not_Allowed);
begin
if Ada_Version >= Ada_12 then
if Ada_Version >= Ada_2012 then
Error_Msg_N
("an uninitialized allocator cannot have"
& " a null exclusion", N);
@ -2419,7 +2419,7 @@ package body Sem_Ch4 is
Analyze_Expression (L);
if No (R)
and then Ada_Version >= Ada_12
and then Ada_Version >= Ada_2012
then
Analyze_Set_Membership;
return;

View File

@ -3002,7 +3002,7 @@ package body Sem_Ch6 is
and then
not Is_Class_Wide_Type (Designated_Type (Etype (Designator)))
and then Is_Abstract_Type (Designated_Type (Etype (Designator)))
and then Ada_Version >= Ada_12
and then Ada_Version >= Ada_2012
then
Error_Msg_N ("function whose access result designates "
& "abstract type must be abstract", N);
@ -7112,7 +7112,7 @@ package body Sem_Ch6 is
and then Is_Tagged_Type (Designated_Type (Etype (S)))
and then
not Is_Class_Wide_Type (Designated_Type (Etype (S)))
and then Ada_Version >= Ada_12
and then Ada_Version >= Ada_2012
then
Error_Msg_N
("private function with controlling access result "
@ -8160,7 +8160,7 @@ package body Sem_Ch6 is
then
Make_Inequality_Operator (S);
if Ada_Version >= Ada_12 then
if Ada_Version >= Ada_2012 then
Check_Untagged_Equality (S);
end if;
end if;

View File

@ -5542,8 +5542,8 @@ package body Sem_Prag is
-- Now set Ada 2012 mode
Ada_Version := Ada_12;
Ada_Version_Explicit := Ada_12;
Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_2012;
end if;
end;
@ -10684,7 +10684,7 @@ package body Sem_Prag is
-- This is one of the few cases where we need to test the value of
-- Ada_Version_Explicit rather than Ada_Version (which is always
-- set to Ada_12 in a predefined unit), we need to know the
-- set to Ada_2012 in a predefined unit), we need to know the
-- explicit version set to know if this pragma is active.
if Ada_Version_Explicit >= Ada_05 then
@ -11184,7 +11184,7 @@ package body Sem_Prag is
-- This is one of the few cases where we need to test the value of
-- Ada_Version_Explicit rather than Ada_Version (which is always
-- set to Ada_12 in a predefined unit), we need to know the
-- set to Ada_2012 in a predefined unit), we need to know the
-- explicit version set to know if this pragma is active.
if Ada_Version_Explicit >= Ada_05 then

View File

@ -8362,23 +8362,28 @@ package body Sem_Res is
Index := First_Index (Array_Type);
Resolve (Drange, Base_Type (Etype (Index)));
if Nkind (Drange) = N_Range
if Nkind (Drange) = N_Range then
-- Ensure that side effects in the bounds are properly handled
Remove_Side_Effects (Low_Bound (Drange), Variable_Ref => True);
Remove_Side_Effects (High_Bound (Drange), Variable_Ref => True);
-- Do not apply the range check to nodes associated with the
-- frontend expansion of the dispatch table. We first check
-- if Ada.Tags is already loaded to void the addition of an
-- if Ada.Tags is already loaded to avoid the addition of an
-- undesired dependence on such run-time unit.
and then
(not Tagged_Type_Expansion
or else not
(RTU_Loaded (Ada_Tags)
if not Tagged_Type_Expansion
or else not
(RTU_Loaded (Ada_Tags)
and then Nkind (Prefix (N)) = N_Selected_Component
and then Present (Entity (Selector_Name (Prefix (N))))
and then Entity (Selector_Name (Prefix (N))) =
RTE_Record_Component (RE_Prims_Ptr)))
then
Apply_Range_Check (Drange, Etype (Index));
RTE_Record_Component (RE_Prims_Ptr))
then
Apply_Range_Check (Drange, Etype (Index));
end if;
end if;
end if;

View File

@ -548,7 +548,7 @@ package body Switch.C is
-- implicit setting here, since for example, we want
-- Preelaborate_05 treated as Preelaborate
Ada_Version := Ada_12;
Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_Version;
-- Set default warnings and style checks for -gnatg
@ -1075,7 +1075,7 @@ package body Switch.C is
Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
Ada_Version := Ada_12;
Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_Version;
end if;
@ -1089,7 +1089,7 @@ package body Switch.C is
Ada_Version := Ada_05;
elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
Ada_Version := Ada_12;
Ada_Version := Ada_2012;
else
Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));

View File

@ -608,7 +608,7 @@ begin
Write_Switch_Char ("12");
if Ada_Version_Default = Ada_12 then
if Ada_Version_Default = Ada_2012 then
Write_Line ("Ada 2012 mode (default)");
else
Write_Line ("Allow Ada 2012 extensions");