[Ada] Minor reformattings

2018-07-31  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada

	* checks.adb, contracts.adb, exp_aggr.adb, exp_ch5.adb,
	exp_disp.adb, make.adb, sem_ch4.adb, sem_eval.adb, sem_res.adb,
	usage.adb: Minor reformatting.

From-SVN: r263089

gcc/ada/ChangeLog

@@ -1,3 +1,9 @@
+2018-07-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb, contracts.adb, exp_aggr.adb, exp_ch5.adb,
+	exp_disp.adb, make.adb, sem_ch4.adb, sem_eval.adb, sem_res.adb,
+	usage.adb: Minor reformatting.
+
 2018-07-31  Bob Duff  <duff@adacore.com>
 
 	* sem_res.adb (Resolve_Allocator): Do not complain about the

gcc/ada/checks.adb

@@ -1874,41 +1874,37 @@ package body Checks is
 
       Loc   : constant Source_Ptr := Sloc (N);
       Right : constant Node_Id := Right_Opnd (N);
+      Opnd  : Node_Id;
 
    begin
       if Expander_Active
         and then not Backend_Divide_Checks_On_Target
         and then Check_Needed (Right, Division_Check)
-      then
-         --  See if division by zero possible, and if so generate test. This
-         --  part of the test is not controlled by the -gnato switch, since
-         --  it is a Division_Check and not an Overflow_Check.
 
-         if Do_Division_Check (N) then
+        --  See if division by zero possible, and if so generate test. This
+        --  part of the test is not controlled by the -gnato switch, since it
+        --  is a Division_Check and not an Overflow_Check.
+
+        and then Do_Division_Check (N)
+      then
          Set_Do_Division_Check (N, False);
 
          if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then
             if Is_Floating_Point_Type (Etype (N)) then
-                  Insert_Action (N,
+               Opnd := Make_Real_Literal (Loc, Ureal_0);
-                    Make_Raise_Constraint_Error (Loc,
-                      Condition =>
-                        Make_Op_Eq (Loc,
-                          Left_Opnd  => Duplicate_Subexpr_Move_Checks (Right),
-                          Right_Opnd => Make_Real_Literal (Loc, Ureal_0)),
-                      Reason => CE_Divide_By_Zero));
-
             else
+               Opnd := Make_Integer_Literal (Loc, 0);
+            end if;
+
             Insert_Action (N,
               Make_Raise_Constraint_Error (Loc,
                 Condition =>
                   Make_Op_Eq (Loc,
                     Left_Opnd  => Duplicate_Subexpr_Move_Checks (Right),
-                          Right_Opnd => Make_Integer_Literal (Loc, 0)),
+                    Right_Opnd => Opnd),
                 Reason    => CE_Divide_By_Zero));
          end if;
       end if;
-         end if;
-      end if;
    end Apply_Division_Check;
 
    ----------------------------------
@@ -3552,6 +3548,7 @@ package body Checks is
                  and then not GNATprove_Mode
                then
                   Apply_Float_Conversion_Check (Expr, Target_Type);
+
                else
                   Apply_Scalar_Range_Check
                     (Expr, Target_Type, Fixed_Int => Conv_OK);

gcc/ada/contracts.adb

@@ -888,8 +888,8 @@ package body Contracts is
 
                if not Is_Library_Level_Entity (Obj_Id) then
                   Error_Msg_N
-                    ("volatile variable & must be declared at library level",
+                    ("volatile variable & must be declared at library level "
-                     Obj_Id);
+                     & "(SPARK RM 7.1.3(3))", Obj_Id);
 
                --  An object of a discriminated type cannot be effectively
                --  volatile except for protected objects (SPARK RM 7.1.3(5)).

gcc/ada/exp_aggr.adb

@@ -7242,21 +7242,19 @@ package body Exp_Aggr is
             --  constraint error.
 
             declare
-               Comp : Entity_Id;
+               Comp : constant Entity_Id := First (Choices (C));
                Indx : Node_Id;
 
             begin
-               Comp := First (Choices (C));
                if Present (Etype (Comp))
                  and then Is_Array_Type (Etype (Comp))
                then
                   Indx := First_Index (Etype (Comp));
-
                   while Present (Indx) loop
-                     if Nkind (Type_Low_Bound (Etype (Indx)))
+                     if Nkind (Type_Low_Bound (Etype (Indx))) =
-                       = N_Raise_Constraint_Error
+                          N_Raise_Constraint_Error
-                     or else Nkind (Type_High_Bound (Etype (Indx)))
+                       or else Nkind (Type_High_Bound (Etype (Indx))) =
-                       = N_Raise_Constraint_Error
+                                 N_Raise_Constraint_Error
                      then
                         return False;
                      end if;
@@ -7276,10 +7274,11 @@ package body Exp_Aggr is
             --  the machine.)
 
             if Is_Tagged_Type (Etype (Expr_Q))
-              and then (Nkind (Expr_Q) = N_Type_Conversion
-                         or else (Is_Entity_Name (Expr_Q)
               and then
-                                      Ekind (Entity (Expr_Q)) in Formal_Kind))
+                (Nkind (Expr_Q) = N_Type_Conversion
+                  or else
+                    (Is_Entity_Name (Expr_Q)
+                      and then Ekind (Entity (Expr_Q)) in Formal_Kind))
               and then Tagged_Type_Expansion
             then
                Static_Components := False;

gcc/ada/exp_disp.adb

@@ -7206,7 +7206,8 @@ package body Exp_Disp is
                       Make_Index_Or_Discriminant_Constraint (Loc, New_List (
                         Make_Range (Loc,
                           Low_Bound  => Make_Integer_Literal (Loc, 1),
-                          High_Bound => Make_Integer_Literal (Loc,
+                          High_Bound =>
+                            Make_Integer_Literal (Loc,
                               DT_Entry_Count
                                 (First_Tag_Component (Typ)))))))));
 

gcc/ada/sem_ch4.adb

@@ -8928,51 +8928,57 @@ package body Sem_Ch4 is
            (Anc_Type : Entity_Id;
             Error    : out Boolean)
          is
-            Candidate   : Entity_Id;
-            --  If homonym is a renaming, examine the renamed program
-
-            Cls_Type    : Entity_Id;
-            Hom         : Entity_Id;
-            Hom_Ref     : Node_Id;
-            Success     : Boolean;
-
             function First_Formal_Match
-              (Typ : Entity_Id) return Boolean;
+              (Subp_Id : Entity_Id;
-            --  Predicate to verify that the first formal of a class-wide
+               Typ     : Entity_Id) return Boolean;
-            --  candidate matches the type of the prefix.
+            --  Predicate to verify that the first foramal of class-wide
+            --  subprogram Subp_Id matches type Typ of the prefix.
 
             ------------------------
             -- First_Formal_Match --
             ------------------------
 
             function First_Formal_Match
-             (Typ : Entity_Id) return Boolean
+              (Subp_Id : Entity_Id;
+               Typ     : Entity_Id) return Boolean
             is
-               Ctrl : constant Entity_Id := First_Formal (Candidate);
+               Ctrl : constant Entity_Id := First_Formal (Subp_Id);
+
             begin
-               return Present (Ctrl)
+               return
+                 Present (Ctrl)
                    and then
                      (Base_Type (Etype (Ctrl)) = Typ
                        or else
                          (Ekind (Etype (Ctrl)) = E_Anonymous_Access_Type
                            and then
-                           Base_Type
+                             Base_Type (Designated_Type (Etype (Ctrl))) =
-                            (Designated_Type (Etype (Ctrl))) = Typ));
+                               Typ));
             end First_Formal_Match;
 
+            --  Local variables
+
+            CW_Typ : constant Entity_Id := Class_Wide_Type (Anc_Type);
+
+            Candidate : Entity_Id;
+            --  If homonym is a renaming, examine the renamed program
+
+            Hom      : Entity_Id;
+            Hom_Ref  : Node_Id;
+            Success  : Boolean;
+
+         --  Start of processing for Traverse_Homonyms
+
          begin
             Error := False;
 
-            Cls_Type := Class_Wide_Type (Anc_Type);
-
-            Hom := Current_Entity (Subprog);
-
             --  Find a non-hidden operation whose first parameter is of the
             --  class-wide type, a subtype thereof, or an anonymous access
             --  to same. If in an instance, the operation can be considered
             --  even if hidden (it may be hidden because the instantiation
             --  is expanded after the containing package has been analyzed).
 
+            Hom := Current_Entity (Subprog);
             while Present (Hom) loop
                if Ekind_In (Hom, E_Procedure, E_Function)
                  and then Present (Renamed_Entity (Hom))
@@ -8983,10 +8989,10 @@ package body Sem_Ch4 is
                   Candidate := Hom;
                end if;
 
-               if Ekind_In (Candidate, E_Procedure, E_Function)
+               if Ekind_In (Candidate, E_Function, E_Procedure)
                  and then (not Is_Hidden (Candidate) or else In_Instance)
                  and then Scope (Candidate) = Scope (Base_Type (Anc_Type))
-                 and then First_Formal_Match (Cls_Type)
+                 and then First_Formal_Match (Candidate, CW_Typ)
                then
                   --  If the context is a procedure call, ignore functions
                   --  in the name of the call.
@@ -9012,10 +9018,10 @@ package body Sem_Ch4 is
 
                   if No (Matching_Op) then
                      Hom_Ref := New_Occurrence_Of (Candidate, Sloc (Subprog));
-                     Set_Etype (Call_Node, Any_Type);
-                     Set_Parent (Call_Node, Parent (Node_To_Replace));
 
+                     Set_Etype  (Call_Node, Any_Type);
                      Set_Name   (Call_Node, Hom_Ref);
+                     Set_Parent (Call_Node, Parent (Node_To_Replace));
 
                      Analyze_One_Call
                        (N          => Call_Node,

gcc/ada/sem_eval.adb

@@ -5688,8 +5688,8 @@ package body Sem_Eval is
    -------------------------
 
    procedure Rewrite_In_Raise_CE (N : Node_Id; Exp : Node_Id) is
-      Typ  : constant Entity_Id := Etype (N);
       Stat : constant Boolean   := Is_Static_Expression (N);
+      Typ  : constant Entity_Id := Etype (N);
 
    begin
       --  If we want to raise CE in the condition of a N_Raise_CE node, we

gcc/ada/sem_res.adb

@@ -5015,9 +5015,10 @@ package body Sem_Res is
                if In_Instance_Body then
                   Error_Msg_Warn := SPARK_Mode /= On;
                   Error_Msg_N
-                    ("type in allocator has deeper level than "
+                    ("type in allocator has deeper level than designated "
-                     & "designated class-wide type<<", E);
+                     & "class-wide type<<", E);
                   Error_Msg_N ("\Program_Error [<<", E);
+
                   Rewrite (N,
                     Make_Raise_Program_Error (Sloc (N),
                       Reason => PE_Accessibility_Check_Failed));
@@ -5028,8 +5029,9 @@ package body Sem_Res is
                --  type. A run-time check will be performed in the instance.
 
                elsif not Is_Generic_Type (Exp_Typ) then
-                  Error_Msg_N ("type in allocator has deeper level than "
+                  Error_Msg_N
-                               & "designated class-wide type", E);
+                    ("type in allocator has deeper level than designated "
+                     & "class-wide type", E);
                end if;
             end if;
          end;

gcc/ada/usage.adb

@@ -461,6 +461,7 @@ begin
    Write_Line ("        I    turn off checking for in params");
    Write_Line ("        m    turn on checking for in out params");
    Write_Line ("        M    turn off checking for in out params");
+   Write_Line ("        n    turn off all validity checks (including RM)");
    Write_Line ("        o    turn on checking for operators/attributes");
    Write_Line ("        O    turn off checking for operators/attributes");
    Write_Line ("        p    turn on checking for parameters");
@@ -471,7 +472,6 @@ begin
    Write_Line ("        S    turn off checking for subscripts");
    Write_Line ("        t    turn on checking for tests");
    Write_Line ("        T    turn off checking for tests");
-   Write_Line ("        n    turn off all validity checks (including RM)");
 
    --  Lines for -gnatw switch