sinfo.ads, [...]: Minor reformatting and code clean up.

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

	* sinfo.ads, einfo.adb, sem_res.adb, exp_ch6.adb, aspects.adb: Minor
	reformatting and code clean up.

From-SVN: r198186

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 984e97d..216d437 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2013-04-23  Robert Dewar  <dewar@adacore.com>
+
+       * sinfo.ads, einfo.adb, sem_res.adb, exp_ch6.adb, aspects.adb: Minor
+       reformatting and code clean up.
+
 2013-04-23  Vincent Celier  <celier@adacore.com>
 
        * prj-part.ads, prj-conf.ads: Minor comment updates.

diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index b72debb..401928b 100644 (file)
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -164,9 +164,7 @@ package body Aspects is
             Owner := Root_Type (Owner);
          end if;
 
-         if Is_Private_Type (Owner)
-           and then Present (Full_View (Owner))
-         then
+         if Is_Private_Type (Owner) and then Present (Full_View (Owner)) then
             Owner := Full_View (Owner);
          end if;
       end if;

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index aa254f5..0c85d51 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -7205,15 +7205,25 @@ package body Einfo is
 
    function Predicate_Function_M (Id : E) return E is
       S : Entity_Id;
+      T : Entity_Id;
 
    begin
       pragma Assert (Is_Type (Id));
 
-      if No (Subprograms_For_Type (Id)) then
+      --  If type is private and has a completion, predicate may be defined
+      --  on the full view.
+
+      if Is_Private_Type (Id) and then Present (Full_View (Id)) then
+         T := Full_View (Id);
+      else
+         T := Id;
+      end if;
+
+      if No (Subprograms_For_Type (T)) then
          return Empty;
 
       else
-         S := Subprograms_For_Type (Id);
+         S := Subprograms_For_Type (T);
          while Present (S) loop
             if Is_Predicate_Function_M (S) then
                return S;

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index bbb7bde..c98affb 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1740,14 +1740,14 @@ package body Exp_Ch6 is
                     and then Is_Inherited_Operation_For_Type (Subp, E_Actual))
                  or else Is_Entity_Name (Actual)
                then
-                  Append_To
-                    (Post_Call, Make_Predicate_Check (E_Actual, Actual));
+                  Append_To (Post_Call,
+                    Make_Predicate_Check (E_Actual, Actual));
 
                elsif Is_Class_Wide_Type (E_Formal)
                  and then not Is_Class_Wide_Type (E_Actual)
                then
-                  Append_To
-                    (Post_Call, Make_Predicate_Check (E_Actual, Actual));
+                  Append_To (Post_Call,
+                    Make_Predicate_Check (E_Actual, Actual));
                end if;
             end if;
 

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ee2483b..1cb465a 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3612,7 +3612,7 @@ package body Sem_Res is
                  and then not Same_Ancestor (Etype (F), Etype (Expression (A)))
                  and then
                   (Is_Limited_Type (Etype (F))
-                     or else Is_Limited_Type (Etype (Expression (A))))
+                    or else Is_Limited_Type (Etype (Expression (A))))
                then
                   Error_Msg_N
                     ("conversion between unrelated limited array types "
@@ -3671,13 +3671,13 @@ package body Sem_Res is
                   end if;
                end if;
 
-               --  (Ada 2005): The call may be to a primitive operation of
-               --   a tagged synchronized type, declared outside of the type.
-               --   In this case the controlling actual must be converted to
-               --   its corresponding record type, which is the formal type.
-               --   The actual may be a subtype, either because of a constraint
-               --   or because it is a generic actual, so use base type to
-               --   locate concurrent type.
+               --  (Ada 2005): The call may be to a primitive operation of a
+               --  tagged synchronized type, declared outside of the type. In
+               --  this case the controlling actual must be converted to its
+               --  corresponding record type, which is the formal type. The
+               --  actual may be a subtype, either because of a constraint or
+               --  because it is a generic actual, so use base type to locate
+               --  concurrent type.
 
                F_Typ := Base_Type (Etype (F));
 
@@ -3951,7 +3951,8 @@ package body Sem_Res is
 
                if not (Ekind (Nam) = E_Function
                         and then (Is_Predicate_Function (Nam)
-                                    or else Is_Predicate_Function_M (Nam)))
+                                    or else
+                                  Is_Predicate_Function_M (Nam)))
                  and then not Is_Init_Proc (Nam)
                then
                   Apply_Predicate_Check (A, F_Typ);
@@ -4293,8 +4294,8 @@ package body Sem_Res is
          Error_Msg_N ("type of allocator cannot be abstract",  N);
       end if;
 
-      --  For qualified expression, resolve the expression using the
-      --  given subtype (nothing to do for type mark, subtype indication)
+      --  For qualified expression, resolve the expression using the given
+      --  subtype (nothing to do for type mark, subtype indication)
 
       if Nkind (E) = N_Qualified_Expression then
          if Is_Class_Wide_Type (Etype (E))
@@ -4308,8 +4309,8 @@ package body Sem_Res is
          Resolve (Expression (E), Etype (E));
          Check_Unset_Reference (Expression (E));
 
-         --  A qualified expression requires an exact match of the type,
-         --  class-wide matching is not allowed.
+         --  A qualified expression requires an exact match of the type.
+         --  Class-wide matching is not allowed.
 
          if (Is_Class_Wide_Type (Etype (Expression (E)))
               or else Is_Class_Wide_Type (Etype (E)))
@@ -4350,9 +4351,9 @@ package body Sem_Res is
          --  deeper than the type of the allocator (in contrast to access
          --  parameters, where the level of the actual can be arbitrary).
 
-         --  We can't use Valid_Conversion to perform this check because
-         --  in general the type of the allocator is unrelated to the type
-         --  of the access discriminant.
+         --  We can't use Valid_Conversion to perform this check because in
+         --  general the type of the allocator is unrelated to the type of
+         --  the access discriminant.
 
          if Ekind (Typ) /= E_Anonymous_Access_Type
            or else Is_Local_Anonymous_Access (Typ)
@@ -4771,8 +4772,7 @@ package body Sem_Res is
             Resolve (N, Any_Fixed);
 
          elsif Is_Fixed_Point_Type (B_Typ)
-           and then (T = Universal_Real
-                      or else Is_Fixed_Point_Type (T))
+           and then (T = Universal_Real or else Is_Fixed_Point_Type (T))
            and then Is_Overloaded (N)
          then
             --  C * F(X) in a fixed context, where C is a real literal or a
@@ -4880,7 +4880,7 @@ package body Sem_Res is
                         and then Is_Fixed_Point_Type (B_Typ))
               or else (Is_Fixed_Point_Type (B_Typ)
                         and then (Is_Integer_Or_Universal (L)
-                                   or else
+                                    or else
                                   Is_Integer_Or_Universal (R))))
         and then Nkind_In (N, N_Op_Multiply, N_Op_Divide)
       then
@@ -4974,7 +4974,7 @@ package body Sem_Res is
 
       else
          if (TL = Universal_Integer or else TL = Universal_Real)
-              and then
+               and then
             (TR = Universal_Integer or else TR = Universal_Real)
          then
             Check_For_Visible_Operator (N, B_Typ);
@@ -5138,7 +5138,7 @@ package body Sem_Res is
                --  In this case, the back end has to generate additional tests.
 
                if (Nkind (N) = N_Op_Rem and then (LNeg and RNeg))
-                    or else
+                     or else
                   (Nkind (N) = N_Op_Mod and then (LNeg or RNeg))
                then
                   Check_Restriction (No_Implicit_Conditionals, N);

diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 90de0b0..7ded7db 100644 (file)
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -6772,6 +6772,9 @@ package Sinfo is
       --  a copy of the expression for visibility analysis, see spec of
       --  Sem_Ch13 for full details of this usage.
 
+      --  In the case of aspects of the form xxx'Class, the aspect identifier
+      --  is for xxx, and Class_Present is set to True.
+
       --  Note: When a Pre or Post aspect specification is processed, it is
       --  broken into AND THEN sections. The left most section has Split_PPC
       --  set to False, indicating that it is the original specification (e.g.