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)



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212780 138bc75d-0d04-0410-961f-82ee72b054a4

9 files changed, 99 insertions, 35 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 632da87f745..51c2bf8eea3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,19 @@
 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):
 	Remove obsolete code checking for violation of
 	No_Standard_Allocators_After_Elaboration (main program)
diff --git a/gcc/ada/a-reatim.ads b/gcc/ada/a-reatim.ads
index 2c86289a614..084c1ef0593 100644
--- a/gcc/ada/a-reatim.ads
+++ b/gcc/ada/a-reatim.ads
@@ -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, "<=");
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 13349e18c6c..9fc6760ba25 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -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));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 40243732869..011e10ca324 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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);
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 1585b7d4a09..544a9232f35 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -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;
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 8712ba627a4..6fe803d9e80 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -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
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index ce4c8b9b8b4..bd9e4ec52ee 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index dfb3fe5e188..97a11d19591 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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.
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index faf43338807..f05d084ce24 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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;