OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

par_sco.adb, [...]: Minor reformatting. 

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb, a-reatim.ads, exp_attr.adb, sem_util.adb: Minor
	reformatting.

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb (Has_Out_Or_In_Out_Parameter): New flag and
	function.
	(Set_Has_Out_Or_In_Out_Parameter): New procedure.
	* sem_ch6.adb (Set_Formal_Mode): Set Has_Out_Or_In_Out_Parameter flag.
	* sem_res.adb (Resolve_Call): Error if call of Ada 2012 function
	with OUT or IN OUT from earlier Ada mode (e.g. Ada 2005)

From-SVN: r212780
This commit is contained in:
Robert Dewar 2014-07-18 09:14:14 +00:00 committed by Arnaud Charlet
parent b3b26ace90
commit fc999c5d2e
9 changed files with 99 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2014-07-18 Robert Dewar <dewar@adacore.com>
* par_sco.adb, a-reatim.ads, exp_attr.adb, sem_util.adb: Minor
reformatting.
2014-07-18 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Has_Out_Or_In_Out_Parameter): New flag and
function.
(Set_Has_Out_Or_In_Out_Parameter): New procedure.
* sem_ch6.adb (Set_Formal_Mode): Set Has_Out_Or_In_Out_Parameter flag.
* sem_res.adb (Resolve_Call): Error if call of Ada 2012 function
with OUT or IN OUT from earlier Ada mode (e.g. Ada 2005)
2014-07-18 Robert Dewar <dewar@adacore.com>
* bcheck.adb (Check_Consistent_Restrictions):

13
gcc/ada/a-reatim.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -90,10 +90,9 @@ package Ada.Real_Time is
function Minutes (M : Integer) return Time_Span;
pragma Ada_05 (Minutes);
-- Seconds_Count needs 64 bits, since Time has the full range of
-- Duration. The delta of Duration is 10 ** (-9), so the maximum
-- number of seconds is 2**63/10**9 = 8*10**9 which does not quite
-- fit in 32 bits.
-- Seconds_Count needs 64 bits, since Time has the full range of Duration.
-- The delta of Duration is 10 ** (-9), so the maximum number of seconds is
-- 2**63/10**9 = 8*10**9 which does not quite fit in 32 bits.
type Seconds_Count is range -2 ** 63 .. 2 ** 63 - 1;
@ -121,8 +120,8 @@ private
Time_Span (System.Task_Primitives.Operations.RT_Resolution);
-- Time and Time_Span are represented in 64-bit Duration value in
-- in nanoseconds. For example, 1 second and 1 nanosecond is
-- represented as the stored integer 1_000_000_001.
-- nanoseconds. For example, 1 second and 1 nanosecond is represented
-- as the stored integer 1_000_000_001.
pragma Import (Intrinsic, "<");
pragma Import (Intrinsic, "<=");

16
gcc/ada/einfo.adb
View File

@ -384,6 +384,7 @@ package body Einfo is
-- Is_Private_Composite Flag107
-- Default_Expressions_Processed Flag108
-- Is_Non_Static_Subtype Flag109
-- Has_Out_Or_In_Out_Parameter Flag110
-- Is_Formal_Subprogram Flag111
-- Is_Renaming_Of_Object Flag112
@ -563,8 +564,6 @@ package body Einfo is
-- (unused) Flag2
-- (unused) Flag3
-- (unused) Flag110
-- (unused) Flag269
-- (unused) Flag270
@ -1532,6 +1531,12 @@ package body Einfo is
return Flag172 (Id);
end Has_Object_Size_Clause;
function Has_Out_Or_In_Out_Parameter (Id : E) return B is
begin
pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
return Flag110 (Id);
end Has_Out_Or_In_Out_Parameter;
function Has_Per_Object_Constraint (Id : E) return B is
begin
return Flag154 (Id);
@ -4241,6 +4246,12 @@ package body Einfo is
Set_Flag172 (Id, V);
end Set_Has_Object_Size_Clause;
procedure Set_Has_Out_Or_In_Out_Parameter (Id : E; V : B := True) is
begin
pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
Set_Flag110 (Id, V);
end Set_Has_Out_Or_In_Out_Parameter;
procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is
begin
Set_Flag154 (Id, V);
@ -8192,6 +8203,7 @@ package body Einfo is
W ("Has_Missing_Return", Flag142 (Id));
W ("Has_Nested_Block_With_Handler", Flag101 (Id));
W ("Has_Non_Standard_Rep", Flag75 (Id));
W ("Has_Out_Or_In_Out_Parameter", Flag110 (Id));
W ("Has_Object_Size_Clause", Flag172 (Id));
W ("Has_Per_Object_Constraint", Flag154 (Id));
W ("Has_Postconditions", Flag240 (Id));

9
gcc/ada/einfo.ads
View File

@ -1670,6 +1670,10 @@ package Einfo is
-- clause has been processed for the type Used to prevent multiple
-- Object_Size clauses for a given entity.
-- Has_Out_Or_In_Out_Parameter (Flag110)
-- Present in function and generic function entities. Set if the function
-- has at least one OUT or IN OUT parameter (allowed only in Ada 2012).
-- Has_Per_Object_Constraint (Flag154)
-- Defined in E_Component entities. Set if the subtype of the component
-- has a per object constraint. Per object constraints result from the
@ -5577,6 +5581,7 @@ package Einfo is
-- Has_Master_Entity (Flag21)
-- Has_Missing_Return (Flag142)
-- Has_Nested_Block_With_Handler (Flag101)
-- Has_Out_Or_In_Out_Parameter (Flag110)
-- Has_Postconditions (Flag240)
-- Has_Recursive_Call (Flag143)
-- Is_Abstract_Subprogram (Flag19) (non-generic case only)
@ -6498,6 +6503,7 @@ package Einfo is
function Has_Nested_Block_With_Handler (Id : E) return B;
function Has_Non_Standard_Rep (Id : E) return B;
function Has_Object_Size_Clause (Id : E) return B;
function Has_Out_Or_In_Out_Parameter (Id : E) return B;
function Has_Per_Object_Constraint (Id : E) return B;
function Has_Postconditions (Id : E) return B;
function Has_Pragma_Controlled (Id : E) return B;
@ -7122,6 +7128,7 @@ package Einfo is
procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True);
procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True);
procedure Set_Has_Object_Size_Clause (Id : E; V : B := True);
procedure Set_Has_Out_Or_In_Out_Parameter (Id : E; V : B := True);
procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True);
procedure Set_Has_Postconditions (Id : E; V : B := True);
procedure Set_Has_Pragma_Controlled (Id : E; V : B := True);
@ -7860,6 +7867,7 @@ package Einfo is
pragma Inline (Has_Nested_Block_With_Handler);
pragma Inline (Has_Non_Standard_Rep);
pragma Inline (Has_Object_Size_Clause);
pragma Inline (Has_Out_Or_In_Out_Parameter);
pragma Inline (Has_Per_Object_Constraint);
pragma Inline (Has_Postconditions);
pragma Inline (Has_Pragma_Controlled);
@ -8332,6 +8340,7 @@ package Einfo is
pragma Inline (Set_Has_Nested_Block_With_Handler);
pragma Inline (Set_Has_Non_Standard_Rep);
pragma Inline (Set_Has_Object_Size_Clause);
pragma Inline (Set_Has_Out_Or_In_Out_Parameter);
pragma Inline (Set_Has_Per_Object_Constraint);
pragma Inline (Set_Has_Postconditions);
pragma Inline (Set_Has_Pragma_Controlled);

4
gcc/ada/exp_attr.adb
View File

@ -800,8 +800,8 @@ package body Exp_Attr is
else
pragma Assert
(Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
and then Nkind (Parent (Parent (Loop_Stmt))) =
N_Block_Statement);
and then
Nkind (Parent (Parent (Loop_Stmt))) = N_Block_Statement);
Decls := Declarations (Parent (Parent (Loop_Stmt)));
end if;

4
gcc/ada/par_sco.adb
View File

@ -102,8 +102,8 @@ package body Par_SCO is
function Is_Logical_Operator (N : Node_Id) return Boolean;
-- N is the node for a subexpression. This procedure just tests N to see
-- if it is a logical operator (including short circuit conditions, but
-- excluding OR and AND) and returns True if so, False otherwise, it does
-- no other processing.
-- excluding OR and AND) and returns True if so. It also returns True for
-- an if expression. False in all other cases, no other processing is done.
function To_Source_Location (S : Source_Ptr) return Source_Location;
-- Converts Source_Ptr value to Source_Location (line/col) format

23
gcc/ada/sem_ch6.adb
View File

@ -2040,6 +2040,11 @@ package body Sem_Ch6 is
Spec_Id : Entity_Id;
begin
-- Due to the timing of contract analysis, delayed pragmas may be
-- subject to the wrong SPARK_Mode, usually that of the enclosing
-- context. To remedy this, restore the original SPARK_Mode of the
-- related subprogram body.
Save_SPARK_Mode_And_Set (Body_Id, Mode);
-- When a subprogram body declaration is illegal, its defining entity is
@ -2116,6 +2121,9 @@ package body Sem_Ch6 is
end if;
end if;
-- Restore the SPARK_Mode of the enclosing context after all delayed
-- pragmas have been analyzed.
Restore_SPARK_Mode (Mode);
end Analyze_Subprogram_Body_Contract;
@ -3693,6 +3701,11 @@ package body Sem_Ch6 is
Seen_In_Post : Boolean := False;
begin
-- Due to the timing of contract analysis, delayed pragmas may be
-- subject to the wrong SPARK_Mode, usually that of the enclosing
-- context. To remedy this, restore the original SPARK_Mode of the
-- related subprogram body.
Save_SPARK_Mode_And_Set (Subp, Mode);
if Present (Items) then
@ -3817,6 +3830,9 @@ package body Sem_Ch6 is
end if;
end if;
-- Restore the SPARK_Mode of the enclosing context after all delayed
-- pragmas have been analyzed.
Restore_SPARK_Mode (Mode);
end Analyze_Subprogram_Contract;
@ -11832,9 +11848,8 @@ package body Sem_Ch6 is
-- point of the call.
if Out_Present (Spec) then
if Ekind (Scope (Formal_Id)) = E_Function
or else Ekind (Scope (Formal_Id)) = E_Generic_Function
then
if Ekind_In (Scope (Formal_Id), E_Function, E_Generic_Function) then
-- [IN] OUT parameters allowed for functions in Ada 2012
if Ada_Version >= Ada_2012 then
@ -11851,6 +11866,8 @@ package body Sem_Ch6 is
Set_Ekind (Formal_Id, E_Out_Parameter);
end if;
Set_Has_Out_Or_In_Out_Parameter (Scope (Formal_Id), True);
-- But not in earlier versions of Ada
else

26
gcc/ada/sem_res.adb
View File

@ -5605,9 +5605,8 @@ package body Sem_Res is
Index_Node :=
Make_Indexed_Component (Loc,
Prefix =>
Make_Function_Call (Loc,
Name => New_Subp),
Prefix =>
Make_Function_Call (Loc, Name => New_Subp),
Expressions => Parameter_Associations (N));
else
-- An Ada 2005 prefixed call to a primitive operation
@ -5618,9 +5617,9 @@ package body Sem_Res is
Index_Node :=
Make_Indexed_Component (Loc,
Prefix =>
Prefix =>
Make_Function_Call (Loc,
Name => New_Subp,
Name => New_Subp,
Parameter_Associations =>
New_List
(Remove_Head (Parameter_Associations (N)))),
@ -5749,9 +5748,8 @@ package body Sem_Res is
begin
P := Prev (N);
while Present (P) loop
if not Nkind_In (P,
N_Assignment_Statement,
N_Raise_Constraint_Error)
if not Nkind_In (P, N_Assignment_Statement,
N_Raise_Constraint_Error)
then
exit Scope_Loop;
end if;
@ -6103,6 +6101,18 @@ package body Sem_Res is
end;
end if;
-- Check for calling a function with OUT or IN OUT parameter when the
-- calling context (us right now) is not Ada 2012, so does not allow
-- OUT or IN OUT parameters in function calls.
if Ada_Version < Ada_2012
and then Ekind (Nam) = E_Function
and then Has_Out_Or_In_Out_Parameter (Nam)
then
Error_Msg_NE ("& has at least one OUT or `IN OUT` parameter", N, Nam);
Error_Msg_N ("\call to this function only allowed in Ada 2012", N);
end if;
-- Check the dimensions of the actuals in the call. For function calls,
-- propagate the dimensions from the returned type to N.

25
gcc/ada/sem_util.adb
View File

@ -1205,7 +1205,6 @@ package body Sem_Util is
if Denotes_Discriminant (Node (D)) then
D_Val :=
New_Occurrence_Of (Discriminal (Entity (Node (D))), Loc);
else
D_Val := New_Copy_Tree (Node (D));
end if;
@ -1223,7 +1222,8 @@ package body Sem_Util is
if Ekind (T) = E_Array_Subtype then
Id := First_Index (T);
while Present (Id) loop
if Denotes_Discriminant (Type_Low_Bound (Etype (Id))) or else
if Denotes_Discriminant (Type_Low_Bound (Etype (Id)))
or else
Denotes_Discriminant (Type_High_Bound (Etype (Id)))
then
return Build_Component_Subtype
@ -1493,7 +1493,8 @@ package body Sem_Util is
N_Op_Rem
=>
if Do_Division_Check (Expr)
or else Do_Overflow_Check (Expr)
or else
Do_Overflow_Check (Expr)
then
return False;
else
@ -1636,12 +1637,13 @@ package body Sem_Util is
and then not Comes_From_Source (T)
and then Nkind (N) = N_Object_Declaration
then
Error_Msg_NE ("type of& has incomplete component", N,
Defining_Identifier (N));
Error_Msg_NE
("type of& has incomplete component",
N, Defining_Identifier (N));
else
Error_Msg_NE
("premature usage of incomplete}", N, First_Subtype (T));
("premature usage of incomplete}",
N, First_Subtype (T));
end if;
end if;
end Check_Fully_Declared;
@ -1754,6 +1756,7 @@ package body Sem_Util is
end if;
Append_Elmt (N, Writable_Actuals_List);
else
if Identifiers_List = No_Elist then
Identifiers_List := New_Elmt_List;
@ -1809,9 +1812,7 @@ package body Sem_Util is
return;
end if;
if Nkind (N) in N_Subexpr
and then Is_Static_Expression (N)
then
if Nkind (N) in N_Subexpr and then Is_Static_Expression (N) then
return;
end if;
@ -1902,6 +1903,7 @@ package body Sem_Util is
when N_Op | N_Membership_Test =>
declare
Expr : Node_Id;
begin
Collect_Identifiers (Left_Opnd (N));
@ -2018,7 +2020,8 @@ package body Sem_Util is
and then Present (Aggregate_Bounds (N))
and then Compile_Time_Known_Bounds (Etype (N))
and then Expr_Value (High_Bound (Aggregate_Bounds (N)))
> Expr_Value (Low_Bound (Aggregate_Bounds (N)))
>
Expr_Value (Low_Bound (Aggregate_Bounds (N)))
then
declare
Count_Components : Uint := Uint_0;