+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):
-- --
-- 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 --
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;
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, "<=");
-- 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
-- (unused) Flag2
-- (unused) Flag3
- -- (unused) Flag110
-
-- (unused) Flag269
-- (unused) Flag270
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);
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);
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));
-- 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
-- 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)
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;
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);
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);
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);
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;
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
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
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;
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
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;
-- 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
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
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
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)))),
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;
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.
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;
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
N_Op_Rem
=>
if Do_Division_Check (Expr)
- or else Do_Overflow_Check (Expr)
+ or else
+ Do_Overflow_Check (Expr)
then
return False;
else
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;
end if;
Append_Elmt (N, Writable_Actuals_List);
+
else
if Identifiers_List = No_Elist then
Identifiers_List := New_Elmt_List;
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;
when N_Op | N_Membership_Test =>
declare
Expr : Node_Id;
+
begin
Collect_Identifiers (Left_Opnd (N));
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;
projects / thirdparty / gcc.git / commitdiff
