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

2013-04-22  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb, sem_util.adb, sem_util.ads, sem_res.adb, exp_ch6.adb,
	sem_ch6.adb, opt.ads: Minor reformatting.

From-SVN: r198132

8 files changed, 214 insertions, 219 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 18dd3b1..076f65c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2013-04-22  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb, sem_util.adb, sem_util.ads, sem_res.adb, exp_ch6.adb,
+	sem_ch6.adb, opt.ads: Minor reformatting.
+
 2013-04-22  Pascal Obry  <obry@adacore.com>
 
 	* gnat_ugn.texi, prj-nmsc.adb, projects.texi: Add check for
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 9a09746..fffeb9c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1715,11 +1715,11 @@ package body Exp_Ch6 is
                  and then Is_Inherited_Operation_For_Type (Subp, E_Actual)
                then
                   Append_To
-                   (Post_Call, Make_Predicate_Check (E_Actual, Actual));
+                    (Post_Call, Make_Predicate_Check (E_Actual, Actual));
 
                elsif Is_Entity_Name (Actual) then
                   Append_To
-                   (Post_Call, Make_Predicate_Check (E_Actual, Actual));
+                    (Post_Call, Make_Predicate_Check (E_Actual, Actual));
                end if;
             end if;
 
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 7473a5c..c99244e 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -206,7 +206,10 @@ package Opt is
 
    Assertions_Enabled : Boolean := False;
    --  GNAT
-   --  Enable assertions made using pragma Assert
+   --  Indicates default policy (True = Check, False = Ignore) to be applied
+   --  to all assertion aspects and pragmas, and to pragma Debug, if there is
+   --  no overriding Assertion_Policy, Check_Policy, or Debug_Policy pragma.
+   --  Set True by use of -gnata.
 
    Assume_No_Invalid_Values : Boolean := False;
    --  GNAT Normally, in accordance with (RM 13.9.1 (9-11)) the front end
@@ -282,13 +285,13 @@ package Opt is
 
    Check_Object_Consistency : Boolean := False;
    --  GNATBIND, GNATMAKE
-   --  Set to True to check whether every object file is consistent with
-   --  its corresponding ada library information (ALI) file. An object
-   --  file is inconsistent with the corresponding ALI file if the object
-   --  file does not exist or if it has an older time stamp than the ALI file.
-   --  Default above is for GNATBIND. GNATMAKE overrides this default to
-   --  True (see Make.Initialize) since we normally do need to check source
-   --  consistencies in gnatmake.
+   --  Set to True to check whether every object file is consistent with its
+   --  corresponding ada library information (ALI) file. An object file is
+   --  inconsistent with the corresponding ALI file if the object file does
+   --  not exist or if it has an older time stamp than the ALI file. Default
+   --  above is for GNATBIND. GNATMAKE overrides this default to True (see
+   --  Make.Initialize) since we normally do need to check source consistencies
+   --  in gnatmake.
 
    Check_Only : Boolean := False;
    --  GNATBIND
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 7d947c8..d64cdc8 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7063,17 +7063,15 @@ package body Sem_Ch6 is
       --  Last non-trivial contract-cases on the subprogram, or else Empty
 
       Attribute_Result_Mentioned : Boolean := False;
-      --  Whether attribute 'Result is mentioned in a non-trivial postcondition
-      --  or contract-cases.
+      --  True if 'Result used in a non-trivial postcondition or contract-cases
 
       No_Warning_On_Some_Postcondition : Boolean := False;
-      --  Whether there exists a non-trivial postcondition or contract-cases
+      --  True if there is a non-trivial postcondition or contract-cases
       --  without a corresponding warning.
 
       Post_State_Mentioned : Boolean := False;
-      --  Whether some expression mentioned in a postcondition or
-      --  contract-cases can have a different value in the post-state than
-      --  in the pre-state.
+      --  True if expression mentioned in a postcondition or contract-cases
+      --  can have a different value in the post-state than in the pre-state.
 
       function Check_Attr_Result (N : Node_Id) return Traverse_Result;
       --  Check if N is a reference to the attribute 'Result, and if so set
@@ -7223,7 +7221,6 @@ package body Sem_Ch6 is
                   --  or "False".
 
                   if not Is_Trivial_Post_Or_Ensures (Conseq) then
-
                      Last_Contract_Cases := Prag;
 
                      --  For functions, look for presence of 'Result in
@@ -12272,8 +12269,7 @@ package body Sem_Ch6 is
                      end if;
 
                      if not Expander_Active then
-                        Prepend
-                          (Grab_PPC (Pspec), Declarations (N));
+                        Prepend (Grab_PPC (Pspec), Declarations (N));
                      else
                         Append (Grab_PPC (Pspec), Plist);
                      end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index bc1c63b..d58b0a7 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1525,188 +1525,6 @@ package body Sem_Prag is
          end if;
       end Check_Component;
 
-      ---------------------
-      -- Check_Test_Case --
-      ---------------------
-
-      procedure Check_Test_Case is
-         P  : Node_Id;
-         PO : Node_Id;
-
-         procedure Chain_CTC (PO : Node_Id);
-         --  If PO is a [generic] subprogram declaration node, then the
-         --  test-case applies to this subprogram and the processing for
-         --  the pragma is completed. Otherwise the pragma is misplaced.
-
-         ---------------
-         -- Chain_CTC --
-         ---------------
-
-         procedure Chain_CTC (PO : Node_Id) is
-            S   : Entity_Id;
-
-         begin
-            if Nkind (PO) = N_Abstract_Subprogram_Declaration then
-               Error_Pragma
-                 ("pragma% cannot be applied to abstract subprogram");
-
-            elsif Nkind (PO) = N_Entry_Declaration then
-               Error_Pragma ("pragma% cannot be applied to entry");
-
-            elsif not Nkind_In (PO, N_Subprogram_Declaration,
-                                    N_Generic_Subprogram_Declaration)
-            then
-               Pragma_Misplaced;
-            end if;
-
-            --  Here if we have [generic] subprogram declaration
-
-            S := Defining_Unit_Name (Specification (PO));
-
-            --  Note: we do not analyze the pragma at this point. Instead we
-            --  delay this analysis until the end of the declarative part in
-            --  which the pragma appears. This implements the required delay
-            --  in this analysis, allowing forward references. The analysis
-            --  happens at the end of Analyze_Declarations.
-
-            --  There should not be another test-case with the same name
-            --  associated to this subprogram.
-
-            declare
-               Name : constant String_Id := Get_Name_From_CTC_Pragma (N);
-               CTC  : Node_Id;
-
-            begin
-               CTC := Spec_CTC_List (Contract (S));
-               while Present (CTC) loop
-
-                  --  Omit pragma Contract_Cases because it does not introduce
-                  --  a unique case name and it does not follow the syntax of
-                  --  Test_Case.
-
-                  if Pragma_Name (CTC) = Name_Contract_Cases then
-                     null;
-
-                  elsif String_Equal
-                          (Name, Get_Name_From_CTC_Pragma (CTC))
-                  then
-                     Error_Msg_Sloc := Sloc (CTC);
-                     Error_Pragma ("name for pragma% is already used#");
-                  end if;
-
-                  CTC := Next_Pragma (CTC);
-               end loop;
-            end;
-
-            --  Chain spec CTC pragma to list for subprogram
-
-            Set_Next_Pragma (N, Spec_CTC_List (Contract (S)));
-            Set_Spec_CTC_List (Contract (S), N);
-         end Chain_CTC;
-
-      --  Start of processing for Check_Test_Case
-
-      begin
-         --  First check pragma arguments
-
-         GNAT_Pragma;
-         Check_At_Least_N_Arguments (2);
-         Check_At_Most_N_Arguments (4);
-         Check_Arg_Order
-           ((Name_Name, Name_Mode, Name_Requires, Name_Ensures));
-
-         Check_Optional_Identifier (Arg1, Name_Name);
-         Check_Arg_Is_Static_Expression (Arg1, Standard_String);
-
-         --  In ASIS mode, for a pragma generated from a source aspect, also
-         --  analyze the original aspect expression.
-
-         if ASIS_Mode
-           and then Present (Corresponding_Aspect (N))
-         then
-            Check_Expr_Is_Static_Expression
-              (Original_Node (Get_Pragma_Arg (Arg1)), Standard_String);
-         end if;
-
-         Check_Optional_Identifier (Arg2, Name_Mode);
-         Check_Arg_Is_One_Of (Arg2, Name_Nominal, Name_Robustness);
-
-         if Arg_Count = 4 then
-            Check_Identifier (Arg3, Name_Requires);
-            Check_Identifier (Arg4, Name_Ensures);
-
-         elsif Arg_Count = 3 then
-            Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures);
-         end if;
-
-         --  Check pragma placement
-
-         if not Is_List_Member (N) then
-            Pragma_Misplaced;
-         end if;
-
-         --  Test-case should only appear in package spec unit
-
-         if Get_Source_Unit (N) = No_Unit
-           or else not Nkind_In (Sinfo.Unit (Cunit (Get_Source_Unit (N))),
-                                 N_Package_Declaration,
-                                 N_Generic_Package_Declaration)
-         then
-            Pragma_Misplaced;
-         end if;
-
-         --  Search prior declarations
-
-         P := N;
-         while Present (Prev (P)) loop
-            P := Prev (P);
-
-            --  If the previous node is a generic subprogram, do not go to to
-            --  the original node, which is the unanalyzed tree: we need to
-            --  attach the test-case to the analyzed version at this point.
-            --  They get propagated to the original tree when analyzing the
-            --  corresponding body.
-
-            if Nkind (P) not in N_Generic_Declaration then
-               PO := Original_Node (P);
-            else
-               PO := P;
-            end if;
-
-            --  Skip past prior pragma
-
-            if Nkind (PO) = N_Pragma then
-               null;
-
-            --  Skip stuff not coming from source
-
-            elsif not Comes_From_Source (PO) then
-               null;
-
-            --  Only remaining possibility is subprogram declaration. First
-            --  check that it is declared directly in a package declaration.
-            --  This may be either the package declaration for the current unit
-            --  being defined or a local package declaration.
-
-            elsif not Present (Parent (Parent (PO)))
-              or else not Present (Parent (Parent (Parent (PO))))
-              or else not Nkind_In (Parent (Parent (PO)),
-                                    N_Package_Declaration,
-                                    N_Generic_Package_Declaration)
-            then
-               Pragma_Misplaced;
-
-            else
-               Chain_CTC (PO);
-               return;
-            end if;
-         end loop;
-
-         --  If we fall through, pragma was misplaced
-
-         Pragma_Misplaced;
-      end Check_Test_Case;
-
       ----------------------------
       -- Check_Duplicate_Pragma --
       ----------------------------
@@ -2500,6 +2318,188 @@ package body Sem_Prag is
          end case;
       end Check_Static_Constraint;
 
+      ---------------------
+      -- Check_Test_Case --
+      ---------------------
+
+      procedure Check_Test_Case is
+         P  : Node_Id;
+         PO : Node_Id;
+
+         procedure Chain_CTC (PO : Node_Id);
+         --  If PO is a [generic] subprogram declaration node, then the
+         --  test-case applies to this subprogram and the processing for
+         --  the pragma is completed. Otherwise the pragma is misplaced.
+
+         ---------------
+         -- Chain_CTC --
+         ---------------
+
+         procedure Chain_CTC (PO : Node_Id) is
+            S   : Entity_Id;
+
+         begin
+            if Nkind (PO) = N_Abstract_Subprogram_Declaration then
+               Error_Pragma
+                 ("pragma% cannot be applied to abstract subprogram");
+
+            elsif Nkind (PO) = N_Entry_Declaration then
+               Error_Pragma ("pragma% cannot be applied to entry");
+
+            elsif not Nkind_In (PO, N_Subprogram_Declaration,
+                                    N_Generic_Subprogram_Declaration)
+            then
+               Pragma_Misplaced;
+            end if;
+
+            --  Here if we have [generic] subprogram declaration
+
+            S := Defining_Unit_Name (Specification (PO));
+
+            --  Note: we do not analyze the pragma at this point. Instead we
+            --  delay this analysis until the end of the declarative part in
+            --  which the pragma appears. This implements the required delay
+            --  in this analysis, allowing forward references. The analysis
+            --  happens at the end of Analyze_Declarations.
+
+            --  There should not be another test-case with the same name
+            --  associated to this subprogram.
+
+            declare
+               Name : constant String_Id := Get_Name_From_CTC_Pragma (N);
+               CTC  : Node_Id;
+
+            begin
+               CTC := Spec_CTC_List (Contract (S));
+               while Present (CTC) loop
+
+                  --  Omit pragma Contract_Cases because it does not introduce
+                  --  a unique case name and it does not follow the syntax of
+                  --  Test_Case.
+
+                  if Pragma_Name (CTC) = Name_Contract_Cases then
+                     null;
+
+                  elsif String_Equal
+                          (Name, Get_Name_From_CTC_Pragma (CTC))
+                  then
+                     Error_Msg_Sloc := Sloc (CTC);
+                     Error_Pragma ("name for pragma% is already used#");
+                  end if;
+
+                  CTC := Next_Pragma (CTC);
+               end loop;
+            end;
+
+            --  Chain spec CTC pragma to list for subprogram
+
+            Set_Next_Pragma (N, Spec_CTC_List (Contract (S)));
+            Set_Spec_CTC_List (Contract (S), N);
+         end Chain_CTC;
+
+      --  Start of processing for Check_Test_Case
+
+      begin
+         --  First check pragma arguments
+
+         GNAT_Pragma;
+         Check_At_Least_N_Arguments (2);
+         Check_At_Most_N_Arguments (4);
+         Check_Arg_Order
+           ((Name_Name, Name_Mode, Name_Requires, Name_Ensures));
+
+         Check_Optional_Identifier (Arg1, Name_Name);
+         Check_Arg_Is_Static_Expression (Arg1, Standard_String);
+
+         --  In ASIS mode, for a pragma generated from a source aspect, also
+         --  analyze the original aspect expression.
+
+         if ASIS_Mode
+           and then Present (Corresponding_Aspect (N))
+         then
+            Check_Expr_Is_Static_Expression
+              (Original_Node (Get_Pragma_Arg (Arg1)), Standard_String);
+         end if;
+
+         Check_Optional_Identifier (Arg2, Name_Mode);
+         Check_Arg_Is_One_Of (Arg2, Name_Nominal, Name_Robustness);
+
+         if Arg_Count = 4 then
+            Check_Identifier (Arg3, Name_Requires);
+            Check_Identifier (Arg4, Name_Ensures);
+
+         elsif Arg_Count = 3 then
+            Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures);
+         end if;
+
+         --  Check pragma placement
+
+         if not Is_List_Member (N) then
+            Pragma_Misplaced;
+         end if;
+
+         --  Test-case should only appear in package spec unit
+
+         if Get_Source_Unit (N) = No_Unit
+           or else not Nkind_In (Sinfo.Unit (Cunit (Get_Source_Unit (N))),
+                                 N_Package_Declaration,
+                                 N_Generic_Package_Declaration)
+         then
+            Pragma_Misplaced;
+         end if;
+
+         --  Search prior declarations
+
+         P := N;
+         while Present (Prev (P)) loop
+            P := Prev (P);
+
+            --  If the previous node is a generic subprogram, do not go to to
+            --  the original node, which is the unanalyzed tree: we need to
+            --  attach the test-case to the analyzed version at this point.
+            --  They get propagated to the original tree when analyzing the
+            --  corresponding body.
+
+            if Nkind (P) not in N_Generic_Declaration then
+               PO := Original_Node (P);
+            else
+               PO := P;
+            end if;
+
+            --  Skip past prior pragma
+
+            if Nkind (PO) = N_Pragma then
+               null;
+
+            --  Skip stuff not coming from source
+
+            elsif not Comes_From_Source (PO) then
+               null;
+
+            --  Only remaining possibility is subprogram declaration. First
+            --  check that it is declared directly in a package declaration.
+            --  This may be either the package declaration for the current unit
+            --  being defined or a local package declaration.
+
+            elsif not Present (Parent (Parent (PO)))
+              or else not Present (Parent (Parent (Parent (PO))))
+              or else not Nkind_In (Parent (Parent (PO)),
+                                    N_Package_Declaration,
+                                    N_Generic_Package_Declaration)
+            then
+               Pragma_Misplaced;
+
+            else
+               Chain_CTC (PO);
+               return;
+            end if;
+         end loop;
+
+         --  If we fall through, pragma was misplaced
+
+         Pragma_Misplaced;
+      end Check_Test_Case;
+
       --------------------------------------
       -- Check_Valid_Configuration_Pragma --
       --------------------------------------
@@ -7503,7 +7503,6 @@ package body Sem_Prag is
             Policy : Node_Id;
             Arg    : Node_Id;
             Kind   : Name_Id;
-            Prag   : Node_Id;
 
          begin
             Ada_2005_Pragma;
@@ -7550,10 +7549,7 @@ package body Sem_Prag is
                      Make_Pragma_Argument_Association (Loc,
                        Expression =>
                          Make_Identifier (Sloc (Policy), Chars (Policy))))));
-
-               Set_Analyzed (N);
-               Set_Next_Pragma (N, Opt.Check_Policy_List);
-               Opt.Check_Policy_List := N;
+               Analyze (N);
 
             --  Here if we have two or more arguments
 
@@ -7593,19 +7589,14 @@ package body Sem_Prag is
 
                   --    Check_Policy (Kind, Policy);
 
-                  Prag :=
+                  Insert_Action (N,
                     Make_Pragma (LocP,
                       Chars                        => Name_Check_Policy,
                       Pragma_Argument_Associations => New_List (
                          Make_Pragma_Argument_Association (LocP,
                            Expression => Make_Identifier (LocP, Kind)),
                          Make_Pragma_Argument_Association (LocP,
-                           Expression => Get_Pragma_Arg (Arg))));
-
-                  Set_Analyzed (Prag);
-                  Set_Next_Pragma (Prag, Opt.Check_Policy_List);
-                  Opt.Check_Policy_List := Prag;
-                  Insert_Action (N, Prag);
+                           Expression => Get_Pragma_Arg (Arg)))));
 
                   Arg := Next (Arg);
                end loop;
@@ -8339,7 +8330,7 @@ package body Sem_Prag is
             --  For the new syntax, what we do is to convert each argument to
             --  an old syntax equivalent. We do that because we want to chain
             --  old style Check_Policy pragmas for the search (we don't want
-            --  to have to deal with multiple arguments in the search.)
+            --  to have to deal with multiple arguments in the search).
 
             else
                declare
@@ -9230,7 +9221,6 @@ package body Sem_Prag is
 
                   Make_Pragma_Argument_Association (Loc,
                     Expression => Get_Pragma_Arg (Arg1)))));
-
             Analyze (N);
 
          -------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 63bbef6..99fd9d5 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5899,8 +5899,7 @@ package body Sem_Res is
       if Nkind (N) = N_Function_Call
         and then Is_Tagged_Type (Etype (N))
         and then Is_Entity_Name (Name (N))
-        and then Is_Inherited_Operation_For_Type
-                   (Entity (Name (N)), Etype (N))
+        and then Is_Inherited_Operation_For_Type (Entity (Name (N)), Etype (N))
       then
          Check_SPARK_Restriction ("function not inherited", N);
       end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index fb45129..ea4fe46 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8462,8 +8462,7 @@ package body Sem_Util is
       Typ : Entity_Id) return Boolean
    is
    begin
-      --  Check that the operation has been created by the declaration for
-      --  the type.
+      --  Check that the operation has been created by the type declaration
 
       return Is_Inherited_Operation (E)
         and then Defining_Identifier (Parent (E)) = Typ;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index a47eb98..3256e4c 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -576,6 +576,7 @@ package Sem_Util is
 
    function Get_Ensures_From_CTC_Pragma (N : Node_Id) return Node_Id;
    --  Return the Ensures component of Test_Case pragma N, or Empty otherwise
+   --  Bad name now that this no longer applies to Contract_Case ???
 
    function Get_Generic_Entity (N : Node_Id) return Entity_Id;
    --  Returns the true generic entity in an instantiation. If the name in the
@@ -616,6 +617,7 @@ package Sem_Util is
 
    function Get_Name_From_CTC_Pragma (N : Node_Id) return String_Id;
    --  Return the Name component of Test_Case pragma N
+   --  Bad name now that this no longer applies to Contract_Case ???
 
    function Get_Pragma_Id (N : Node_Id) return Pragma_Id;
    pragma Inline (Get_Pragma_Id);
@@ -634,6 +636,7 @@ package Sem_Util is
 
    function Get_Requires_From_CTC_Pragma (N : Node_Id) return Node_Id;
    --  Return the Requires component of Test_Case pragma N, or Empty otherwise
+   --  Bad name now that this no longer applies to Contract_Case ???
 
    function Get_Subprogram_Entity (Nod : Node_Id) return Entity_Id;
    --  Nod is either a procedure call statement, or a function call, or an