[multiple changes]

2014-01-20  Robert Dewar  <dewar@adacore.com>

	* s-tataat.adb: Minor reformatting.

2014-01-20  Robert Dewar  <dewar@adacore.com>

	* einfo.adb (Is_Descendent_Of_Address): Now applies to all
	entities, and also fix documentation to remove mention of visible
	integer type, since this is not what the implementation does.
	* einfo.ads (Is_Descendent_Of_Address): Now applies to all
	entities, and also fix documentation to remove mention of visible
	integer type, since this is not what the implementation does.
	* gnat_rm.texi: Minor clarification of Allow_Integer_Address
	function.
	* sem_ch4.adb (Analyze_One_Call): Handle Allow_Integer_Address
	case for parameter type check.
	* sem_res.adb (Resolve): Use new function
	Address_Integer_Convert_OK.
	* sem_type.adb: Minor code reorganization (use Ekind_In) Minor
	reformatting throughout.
	* sem_util.adb (Address_Integer_Convert_OK): New function.
	* sem_util.ads: Minor reformatting (put specs in alpha order)
	(Address_Integer_Convert_OK): New function.

2014-01-20  Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.adb (Wrap_Transient_Expression):
	Insertion extra conditional expression only if
	Opt.Suppress_Control_Flow_Optimizations is set.

From-SVN: r206832

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 99cfe83a391e6de3812ba36c56500a64ace4c670..93c1d9fa1d3694db898ab580956961c5abda40fc 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,33 @@
+2014-01-20  Robert Dewar  <dewar@adacore.com>
+
+       * s-tataat.adb: Minor reformatting.
+
+2014-01-20  Robert Dewar  <dewar@adacore.com>
+
+       * einfo.adb (Is_Descendent_Of_Address): Now applies to all
+       entities, and also fix documentation to remove mention of visible
+       integer type, since this is not what the implementation does.
+       * einfo.ads (Is_Descendent_Of_Address): Now applies to all
+       entities, and also fix documentation to remove mention of visible
+       integer type, since this is not what the implementation does.
+       * gnat_rm.texi: Minor clarification of Allow_Integer_Address
+       function.
+       * sem_ch4.adb (Analyze_One_Call): Handle Allow_Integer_Address
+       case for parameter type check.
+       * sem_res.adb (Resolve): Use new function
+       Address_Integer_Convert_OK.
+       * sem_type.adb: Minor code reorganization (use Ekind_In) Minor
+       reformatting throughout.
+       * sem_util.adb (Address_Integer_Convert_OK): New function.
+       * sem_util.ads: Minor reformatting (put specs in alpha order)
+       (Address_Integer_Convert_OK): New function.
+
+2014-01-20  Thomas Quinot  <quinot@adacore.com>
+
+       * exp_ch7.adb (Wrap_Transient_Expression):
+       Insertion extra conditional expression only if
+       Opt.Suppress_Control_Flow_Optimizations is set.
+
 2014-01-20  Arnaud Charlet  <charlet@adacore.com>
 
        * s-tataat.adb (Initialize_Attributes): Abort might already be

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 3ae97862085d0007c07e7b5351c8ba53eca237cd..399afa8e097825869f7fa5be32a8256506e17ce2 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -1927,7 +1927,6 @@ package body Einfo is
 
    function Is_Descendent_Of_Address (Id : E) return B is
    begin
-      pragma Assert (Is_Type (Id));
       return Flag223 (Id);
    end Is_Descendent_Of_Address;
 

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 548090e83518721c793458a99592d8b82af976fa..9f4726cb0842c60c8fa6a55e1e74d6a762e03f0a 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2216,10 +2216,8 @@ package Einfo is
 --       types and subtypes.
 
 --    Is_Descendent_Of_Address (Flag223)
---       Defined in all type and subtype entities. Indicates that a type is an
---       address type that is visibly a numeric type. Used for semantic checks
---       on VMS to remove ambiguities in universal integer expressions that may
---       have an address interpretation
+--       Defined in all entities. True if the entity is type System.Address,
+--       or (recursively) a subtype or derived type of System.Address.
 
 --    Is_Discrete_Type (synthesized)
 --       Applies to all entities, true for all discrete types and subtypes
@@ -4961,6 +4959,7 @@ package Einfo is
    --    Is_Child_Unit                       (Flag73)
    --    Is_Compilation_Unit                 (Flag149)
    --    Is_Completely_Hidden                (Flag103)
+   --    Is_Descendent_Of_Address            (Flag223)
    --    Is_Discrim_SO_Function              (Flag176)
    --    Is_Dispatch_Table_Entity            (Flag234)
    --    Is_Dispatching_Operation            (Flag6)
@@ -6451,6 +6450,7 @@ package Einfo is
    function Is_Constructor                      (Id : E) return B;
    function Is_Controlled                       (Id : E) return B;
    function Is_Controlling_Formal               (Id : E) return B;
+   function Is_Descendent_Of_Address            (Id : E) return B;
    function Is_Discrim_SO_Function              (Id : E) return B;
    function Is_Dispatch_Table_Entity            (Id : E) return B;
    function Is_Dispatching_Operation            (Id : E) return B;
@@ -6666,7 +6666,6 @@ package Einfo is
    function Is_Concurrent_Type                  (Id : E) return B;
    function Is_Decimal_Fixed_Point_Type         (Id : E) return B;
    function Is_Digits_Type                      (Id : E) return B;
-   function Is_Descendent_Of_Address            (Id : E) return B;
    function Is_Discrete_Or_Fixed_Point_Type     (Id : E) return B;
    function Is_Discrete_Type                    (Id : E) return B;
    function Is_Elementary_Type                  (Id : E) return B;

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 8a16033233fe5db94d89b2dcfa19aa684705913b..42d499b2d1842b03e9a3585f0a3bafe75255fc31 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -7982,16 +7982,13 @@ package body Exp_Ch7 is
       --    end;
 
       --  A special case is made for Boolean expressions so that the back-end
-      --  knows to generate a conditional branch instruction if running with
+      --  knows to generate a conditional branch instruction, if running with
       --  -fpreserve-control-flow. This ensures that a control flow change
       --  signalling the decision outcome occurs before the cleanup actions.
-      --  In the absence of -fpreserve-control-flow, the back-end will
-      --  optimize away the extra conditional expression, so we can do this
-      --  modification unconditionally here.
 
-      --  Why don't we add a test of Opt.Preserve_Control_Flow here???
-
-      if Is_Boolean_Type (Typ) then
+      if Opt.Suppress_Control_Flow_Optimizations
+           and then Is_Boolean_Type (Typ)
+      then
          Expr :=
            Make_If_Expression (Loc,
              Expressions => New_List (

diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 8b349b417d6a1f18c377ee51b54c2280ece646d8..53286d8b5c4cd9875375c2ab2555e69180b15e0f 100644 (file)
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1263,6 +1263,12 @@ package AddrAsInt is
 end AddrAsInt;
 @end smallexample
 
+@noindent
+Note that these automatic conversions do not apply to expressions used
+as subprogram arguments, because in general overloading can take place,
+so that the required type is not fixed by the context. If necessary
+adjust the type of the subprogram argument, e.g. by adding a conversion.
+
 @node Pragma Annotate
 @unnumberedsec Pragma Annotate
 @findex Annotate

diff --git a/gcc/ada/s-tataat.adb b/gcc/ada/s-tataat.adb
index c78543077f856f2438c284825ebf863bd0ef9954..e812d1415cb50c883f4366357ff9a5086a0494c1 100644 (file)
--- a/gcc/ada/s-tataat.adb
+++ b/gcc/ada/s-tataat.adb
@@ -186,6 +186,9 @@ package body System.Tasking.Task_Attributes is
       Self_Id : constant Task_Id := Self;
 
    begin
+      --  Note: we call [Un]Defer_Abort_Nestable, rather than [Un]Defer_Abort,
+      --  because Abort might already be deferred in Create_Task.
+
       Defer_Abort_Nestable (Self_Id);
       Lock_RTS;
 

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 457b581da5d8fce6ce6b8ef7d9a74234d2b96e38..daf8afe353b5b98857f61ed9367b6acd9b777856 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3189,6 +3189,23 @@ package body Sem_Ch4 is
                   Next_Actual (Actual);
                   Next_Formal (Formal);
 
+               --  In Allow_Integer_Address mode, we allow an actual integer to
+               --  match a formal address type and vice versa. We only do this
+               --  if we are certain that an error will otherwise be issued
+
+               elsif Address_Integer_Convert_OK
+                       (Etype (Actual), Etype (Formal))
+                 and then (Report and not Is_Indexed and not Is_Indirect)
+               then
+                  --  Handle this case by introducing an unchecked conversion
+
+                  Rewrite (Actual,
+                           Unchecked_Convert_To (Etype (Formal),
+                             Relocate_Node (Actual)));
+                  Analyze_And_Resolve (Actual, Etype (Formal));
+                  Next_Actual (Actual);
+                  Next_Formal (Formal);
+
                else
                   if Debug_Flag_E then
                      Write_Str (" type checking fails in call ");
@@ -3200,6 +3217,8 @@ package body Sem_Ch4 is
                      Write_Eol;
                   end if;
 
+                  --  Comment needed on the following test???
+
                   if Report and not Is_Indexed and not Is_Indirect then
 
                      --  Ada 2005 (AI-251): Complete the error notification

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 2dc9291a4114b7f714c15935efd0aa04a525519c..89fbb75490544b620664acfa0dd24191e5e30d9f 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2619,17 +2619,10 @@ package body Sem_Res is
             --  treated as an Address. The reverse case of integer wanted,
             --  Address found, is treated in an analogous manner.
 
-            if Allow_Integer_Address then
-               if (Is_RTE (Typ, RE_Address)
-                    and then Is_Integer_Type (Etype (N)))
-                 or else
-                   (Is_Integer_Type (Typ)
-                     and then Is_RTE (Etype (N), RE_Address))
-               then
-                  Rewrite (N, Unchecked_Convert_To (Typ, Relocate_Node (N)));
-                  Analyze_And_Resolve (N, Typ);
-                  return;
-               end if;
+            if Address_Integer_Convert_OK (Typ, Etype (N)) then
+               Rewrite (N, Unchecked_Convert_To (Typ, Relocate_Node (N)));
+               Analyze_And_Resolve (N, Typ);
+               return;
             end if;
 
             --  That special Allow_Integer_Address check did not appply, so we
@@ -11095,14 +11088,7 @@ package body Sem_Res is
       --  Allow_Integer_Address is in effect. We convert the conversion to
       --  an unchecked conversion in this case and we are all done!
 
-      if Allow_Integer_Address
-        and then
-          ((Is_RTE (Target_Type, RE_Address)
-             and then Is_Integer_Type (Opnd_Type))
-          or else
-           (Is_RTE (Opnd_Type, RE_Address)
-             and then Is_Integer_Type (Target_Type)))
-      then
+      if Address_Integer_Convert_OK (Opnd_Type, Target_Type) then
          Rewrite (N, Unchecked_Convert_To (Target_Type, Expression (N)));
          Analyze_And_Resolve (N, Target_Type);
          return True;

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 8e0fd5fa80d98f30ff9ee0a27d4a190dbb65b8da..b7371b7d5003ad863104d0ee8d9c31df7b5361fb 100644 (file)
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -252,10 +252,9 @@ package body Sem_Type is
             --  preference rule applies.
 
             if (((Ekind (Name) = E_Function or else Ekind (Name) = E_Procedure)
-                 and then Ekind (Name) = Ekind (It.Nam))
-                or else (Ekind (Name) = E_Operator
-              and then Ekind (It.Nam) = E_Function))
-
+                   and then Ekind (Name) = Ekind (It.Nam))
+                 or else (Ekind (Name) = E_Operator
+                           and then Ekind (It.Nam) = E_Function))
               and then Is_Immediately_Visible (It.Nam)
               and then Type_Conformant (Name, It.Nam)
               and then Base_Type (It.Typ) = Base_Type (T)
@@ -269,9 +268,9 @@ package body Sem_Type is
                --  predefined operator in any case.
 
                elsif Nkind (N) = N_Operator_Symbol
-                 or else (Nkind (N) = N_Expanded_Name
-                            and then
-                          Nkind (Selector_Name (N)) = N_Operator_Symbol)
+                 or else
+                   (Nkind (N) = N_Expanded_Name
+                     and then Nkind (Selector_Name (N)) = N_Operator_Symbol)
                then
                   exit;
 
@@ -373,7 +372,7 @@ package body Sem_Type is
            or else Is_Potentially_Use_Visible (Vis_Type)
            or else In_Use (Vis_Type)
            or else (In_Use (Scope (Vis_Type))
-                      and then not Is_Hidden (Vis_Type))
+                     and then not Is_Hidden (Vis_Type))
            or else Nkind (N) = N_Expanded_Name
            or else (Nkind (N) in N_Op and then E = Entity (N))
            or else In_Instance
@@ -390,8 +389,8 @@ package body Sem_Type is
          elsif Nkind (N) = N_Function_Call
            and then Nkind (Name (N)) = N_Expanded_Name
            and then (Entity (Prefix (Name (N))) = Scope (Base_Type (T))
-                       or else Entity (Prefix (Name (N))) = Scope (Vis_Type)
-                       or else Scope (Vis_Type) = System_Aux_Id)
+                      or else Entity (Prefix (Name (N))) = Scope (Vis_Type)
+                      or else Scope (Vis_Type) = System_Aux_Id)
          then
             null;
 
@@ -472,7 +471,7 @@ package body Sem_Type is
       elsif Interp_Map.Last < 0
         or else
           (Interp_Map.Table (Interp_Map.Last).Node /= N
-             and then not Is_Overloaded (N))
+            and then not Is_Overloaded (N))
       then
          New_Interps (N);
 
@@ -601,6 +600,7 @@ package body Sem_Type is
             if Scop = Inst then
                return True;
             end if;
+
             Scop := Scope (Scop);
          end loop;
 
@@ -641,9 +641,8 @@ package body Sem_Type is
             exit when (not Is_Overloadable (H))
               and then Is_Immediately_Visible (H);
 
-            if Is_Immediately_Visible (H)
-              and then H /= Ent
-            then
+            if Is_Immediately_Visible (H) and then H /= Ent then
+
                --  Only add interpretation if not hidden by an inner
                --  immediately visible one.
 
@@ -766,9 +765,9 @@ package body Sem_Type is
            Is_Private_Type (Typ1)
              and then
               ((Present (Full_View (Typ1))
-                    and then Covers (Full_View (Typ1), Typ2))
-                 or else Base_Type (Typ1) = Typ2
-                 or else Base_Type (Typ2) = Typ1);
+                  and then Covers (Full_View (Typ1), Typ2))
+                or else Base_Type (Typ1) = Typ2
+                or else Base_Type (Typ2) = Typ1);
       end Full_View_Covers;
 
       -----------------
@@ -979,7 +978,7 @@ package body Sem_Type is
       elsif Is_Class_Wide_Type (T2)
         and then
           (Class_Wide_Type (T1) = Class_Wide_Type (T2)
-             or else Base_Type (Root_Type (T2)) = BT1)
+            or else Base_Type (Root_Type (T2)) = BT1)
       then
          return True;
 
@@ -998,9 +997,7 @@ package body Sem_Type is
 
       --  An aggregate is compatible with an array or record type
 
-      elsif T2 = Any_Composite
-        and then Is_Aggregate_Type (T1)
-      then
+      elsif T2 = Any_Composite and then Is_Aggregate_Type (T1) then
          return True;
 
       --  If the expected type is an anonymous access, the designated type must
@@ -1037,12 +1034,9 @@ package body Sem_Type is
         and then (not Comes_From_Source (T1)
                    or else not Comes_From_Source (T2))
         and then (Is_Overloadable (Designated_Type (T2))
-                    or else
-                  Ekind (Designated_Type (T2)) = E_Subprogram_Type)
-        and then
-          Type_Conformant (Designated_Type (T1), Designated_Type (T2))
-        and then
-          Mode_Conformant (Designated_Type (T1), Designated_Type (T2))
+                   or else Ekind (Designated_Type (T2)) = E_Subprogram_Type)
+        and then Type_Conformant (Designated_Type (T1), Designated_Type (T2))
+        and then Mode_Conformant (Designated_Type (T1), Designated_Type (T2))
       then
          return True;
 
@@ -1058,12 +1052,9 @@ package body Sem_Type is
         and then (not Comes_From_Source (T1)
                    or else not Comes_From_Source (T2))
         and then (Is_Overloadable (Designated_Type (T2))
-                    or else
-                  Ekind (Designated_Type (T2)) = E_Subprogram_Type)
-        and then
-           Type_Conformant (Designated_Type (T1), Designated_Type (T2))
-        and then
-           Mode_Conformant (Designated_Type (T1), Designated_Type (T2))
+                   or else Ekind (Designated_Type (T2)) = E_Subprogram_Type)
+        and then Type_Conformant (Designated_Type (T1), Designated_Type (T2))
+        and then Mode_Conformant (Designated_Type (T1), Designated_Type (T2))
       then
          return True;
 
@@ -1072,8 +1063,7 @@ package body Sem_Type is
       --  vice versa.
 
       elsif Is_Record_Type (T1)
-        and then (Is_Remote_Call_Interface (T1)
-                   or else Is_Remote_Types (T1))
+        and then (Is_Remote_Call_Interface (T1) or else Is_Remote_Types (T1))
         and then Present (Corresponding_Remote_Type (T1))
       then
          return Covers (Corresponding_Remote_Type (T1), T2);
@@ -1081,8 +1071,7 @@ package body Sem_Type is
       --  and conversely.
 
       elsif Is_Record_Type (T2)
-        and then (Is_Remote_Call_Interface (T2)
-                   or else Is_Remote_Types (T2))
+        and then (Is_Remote_Call_Interface (T2) or else Is_Remote_Types (T2))
         and then Present (Corresponding_Remote_Type (T2))
       then
          return Covers (Corresponding_Remote_Type (T2), T1);
@@ -1122,20 +1111,16 @@ package body Sem_Type is
 
       --  Ditto for allocators, which eventually resolve to the context type
 
-      elsif Ekind (T2) = E_Allocator_Type
-        and then Is_Access_Type (T1)
-      then
+      elsif Ekind (T2) = E_Allocator_Type and then Is_Access_Type (T1) then
          return Covers (Designated_Type (T1), Designated_Type (T2))
-          or else
-            (From_Limited_With (Designated_Type (T1))
-              and then Covers (Designated_Type (T2), Designated_Type (T1)));
+           or else
+             (From_Limited_With (Designated_Type (T1))
+               and then Covers (Designated_Type (T2), Designated_Type (T1)));
 
       --  A boolean operation on integer literals is compatible with modular
       --  context.
 
-      elsif T2 = Any_Modular
-        and then Is_Modular_Integer_Type (T1)
-      then
+      elsif T2 = Any_Modular and then Is_Modular_Integer_Type (T1) then
          return True;
 
       --  The actual type may be the result of a previous error
@@ -1167,9 +1152,7 @@ package body Sem_Type is
       --  legal, to prevent cascaded errors.
 
       elsif In_Instance
-        and then
-          (Full_View_Covers (T1, T2)
-            or else Full_View_Covers (T2, T1))
+        and then (Full_View_Covers (T1, T2) or else Full_View_Covers (T2, T1))
       then
          return True;
 
@@ -1190,15 +1173,16 @@ package body Sem_Type is
 
       elsif In_Inlined_Body
         and then (Underlying_Type (T1) = Underlying_Type (T2)
-                   or else (Is_Access_Type (T1)
-                              and then Is_Access_Type (T2)
-                              and then
-                                Designated_Type (T1) = Designated_Type (T2))
-                   or else (T1 = Any_Access
-                              and then Is_Access_Type (Underlying_Type (T2)))
-                   or else (T2 = Any_Composite
-                              and then
-                                Is_Composite_Type (Underlying_Type (T1))))
+                   or else
+                     (Is_Access_Type (T1)
+                       and then Is_Access_Type (T2)
+                       and then Designated_Type (T1) = Designated_Type (T2))
+                   or else
+                     (T1 = Any_Access
+                       and then Is_Access_Type (Underlying_Type (T2)))
+                   or else
+                     (T2 = Any_Composite
+                       and then Is_Composite_Type (Underlying_Type (T1))))
       then
          return True;
 
@@ -1364,8 +1348,8 @@ package body Sem_Type is
          else
             return Is_Entity_Name (Subtype_Indication (Type_Definition (Par)))
               and then
-               Is_Generic_Actual_Type (
-                 Entity (Subtype_Indication (Type_Definition (Par))));
+                Is_Generic_Actual_Type (
+                  Entity (Subtype_Indication (Type_Definition (Par))));
          end if;
       end Inherited_From_Actual;
 
@@ -1383,10 +1367,10 @@ package body Sem_Type is
          return In_Same_List (Parent (Typ), Op_Decl)
            or else
              (Ekind_In (Scop, E_Package, E_Generic_Package)
-                and then List_Containing (Op_Decl) =
-                  Visible_Declarations (Parent (Scop))
-                and then List_Containing (Parent (Typ)) =
-                  Private_Declarations (Parent (Scop)));
+               and then List_Containing (Op_Decl) =
+                              Visible_Declarations (Parent (Scop))
+               and then List_Containing (Parent (Typ)) =
+                              Private_Declarations (Parent (Scop)));
       end In_Same_Declaration_List;
 
       --------------------------
@@ -1765,8 +1749,7 @@ package body Sem_Type is
             begin
                Get_First_Interp (N, I, It);
                while Present (It.Typ) loop
-                  if (Covers (Typ, It.Typ)
-                        or else Typ = Any_Type)
+                  if (Covers (Typ, It.Typ) or else Typ = Any_Type)
                     and then
                      (It.Typ = Universal_Integer
                        or else It.Typ = Universal_Real)
@@ -1917,9 +1900,7 @@ package body Sem_Type is
          --  handled here as well. We test Comes_From_Source to exclude this
          --  treatment for implicit renamings created for formal subprograms.
 
-         elsif In_Instance
-           and then not In_Generic_Actual (N)
-         then
+         elsif In_Instance and then not In_Generic_Actual (N) then
             if Nkind (N) in N_Subprogram_Call
               or else
                 (Nkind (N) in N_Has_Entity
@@ -2053,7 +2034,7 @@ package body Sem_Type is
 
       else
          if (In_Open_Scopes (Scope (User_Subp))
-           or else Is_Potentially_Use_Visible (User_Subp))
+              or else Is_Potentially_Use_Visible (User_Subp))
            and then not In_Instance
          then
             if Is_Fixed_Point_Type (Typ)
@@ -2149,14 +2130,10 @@ package body Sem_Type is
       then
          return Type_Conformant (New_S, Old_S);
 
-      elsif Ekind (New_S) = E_Function
-        and then Ekind (Old_S) = E_Operator
-      then
+      elsif Ekind (New_S) = E_Function and then Ekind (Old_S) = E_Operator then
          return Operator_Matches_Spec (Old_S, New_S);
 
-      elsif Ekind (New_S) = E_Procedure
-        and then Is_Entry (Old_S)
-      then
+      elsif Ekind (New_S) = E_Procedure and then Is_Entry (Old_S) then
          return Type_Conformant (New_S, Old_S);
 
       else
@@ -2184,7 +2161,6 @@ package body Sem_Type is
                --  apply preference rule.
 
                if TR /= Any_Type then
-
                   if (T = Universal_Integer or else T = Universal_Real)
                     and then It.Typ = T
                   then
@@ -2230,19 +2206,16 @@ package body Sem_Type is
       --  is no rule in 4.6 that allows "access Integer" to be converted to P.
 
       elsif Ada_Version >= Ada_2005
-        and then
-          (Ekind (Etype (L)) = E_Anonymous_Access_Type
-             or else
-           Ekind (Etype (L)) = E_Anonymous_Access_Subprogram_Type)
+        and then Ekind_In (Etype (L), E_Anonymous_Access_Type,
+                                      E_Anonymous_Access_Subprogram_Type)
         and then Is_Access_Type (Etype (R))
         and then Ekind (Etype (R)) /= E_Access_Type
       then
          return Etype (L);
 
       elsif Ada_Version >= Ada_2005
-        and then
-          (Ekind (Etype (R)) = E_Anonymous_Access_Type
-            or else Ekind (Etype (R)) = E_Anonymous_Access_Subprogram_Type)
+        and then Ekind_In (Etype (R), E_Anonymous_Access_Type,
+                                      E_Anonymous_Access_Subprogram_Type)
         and then Is_Access_Type (Etype (L))
         and then Ekind (Etype (L)) /= E_Access_Type
       then
@@ -2273,9 +2246,7 @@ package body Sem_Type is
       if Is_Overloaded (N) and then Is_Overloadable (E) then
          Act_Parm  := First_Actual (N);
          Form_Parm := First_Formal (E);
-         while Present (Act_Parm)
-           and then Present (Form_Parm)
-         loop
+         while Present (Act_Parm) and then Present (Form_Parm) loop
             Act := Act_Parm;
 
             if Nkind (Act) = N_Parameter_Association then
@@ -2379,20 +2350,22 @@ package body Sem_Type is
 
            or else
              (Is_Record_Type (Typ)
-                and then Is_Concurrent_Type (Etype (N))
-                and then Present (Corresponding_Record_Type (Etype (N)))
-                and then Covers (Typ, Corresponding_Record_Type (Etype (N))))
+               and then Is_Concurrent_Type (Etype (N))
+               and then Present (Corresponding_Record_Type (Etype (N)))
+               and then Covers (Typ, Corresponding_Record_Type (Etype (N))))
 
            or else
              (Is_Concurrent_Type (Typ)
-                and then Is_Record_Type (Etype (N))
-                and then Present (Corresponding_Record_Type (Typ))
-                and then Covers (Corresponding_Record_Type (Typ), Etype (N)))
+               and then Is_Record_Type (Etype (N))
+               and then Present (Corresponding_Record_Type (Typ))
+               and then Covers (Corresponding_Record_Type (Typ), Etype (N)))
 
            or else
              (not Is_Tagged_Type (Typ)
-                and then Ekind (Typ) /= E_Anonymous_Access_Type
-                and then Covers (Etype (N), Typ));
+               and then Ekind (Typ) /= E_Anonymous_Access_Type
+               and then Covers (Etype (N), Typ));
+
+      --  Overloaded case
 
       else
          Get_First_Interp (N, I, It);
@@ -2474,10 +2447,10 @@ package body Sem_Type is
    begin
       return Operator_Matches_Spec (Op, F)
         and then (In_Open_Scopes (Scope (F))
-                    or else Scope (F) = Scope (Btyp)
-                    or else (not In_Open_Scopes (Scope (Btyp))
-                              and then not In_Use (Btyp)
-                              and then not In_Use (Scope (Btyp))));
+                   or else Scope (F) = Scope (Btyp)
+                   or else (not In_Open_Scopes (Scope (Btyp))
+                             and then not In_Use (Btyp)
+                             and then not In_Use (Scope (Btyp))));
    end Hides_Op;
 
    ------------------------
@@ -2621,7 +2594,7 @@ package body Sem_Type is
                      return True;
 
                   elsif Present (Interfaces (Etype (AI)))
-                     and then Iface_Present_In_Ancestor (Etype (AI))
+                    and then Iface_Present_In_Ancestor (Etype (AI))
                   then
                      return True;
                   end if;
@@ -2727,11 +2700,10 @@ package body Sem_Type is
          --  Ada 2005 (AI-251): Complete the error notification
 
          elsif Is_Class_Wide_Type (Etype (R))
-             and then Is_Interface (Etype (Class_Wide_Type (Etype (R))))
+           and then Is_Interface (Etype (Class_Wide_Type (Etype (R))))
          then
             Error_Msg_NE ("(Ada 2005) does not implement interface }",
                           L, Etype (Class_Wide_Type (Etype (R))));
-
          else
             Error_Msg_N ("incompatible types", Parent (L));
          end if;
@@ -2843,8 +2815,8 @@ package body Sem_Type is
 
             elsif BT1 = Base_Type (Par)
               or else (Is_Private_Type (T1)
-                         and then Present (Full_View (T1))
-                         and then Base_Type (Par) = Base_Type (Full_View (T1)))
+                        and then Present (Full_View (T1))
+                        and then Base_Type (Par) = Base_Type (Full_View (T1)))
             then
                return True;
 
@@ -3162,10 +3134,10 @@ package body Sem_Type is
             return Is_Array_Type (T)
               and then (Base_Type (T) = Base_Type (Etype (Op)))
               and then (Base_Type (T1) = Base_Type (T)
-                         or else
+                          or else
                         Base_Type (T1) = Base_Type (Component_Type (T)))
               and then (Base_Type (T2) = Base_Type (T)
-                         or else
+                          or else
                         Base_Type (T2) = Base_Type (Component_Type (T)));
 
          else
@@ -3314,14 +3286,10 @@ package body Sem_Type is
       then
          return T1;
 
-      elsif T2 = Any_Composite
-        and then Is_Aggregate_Type (T1)
-      then
+      elsif T2 = Any_Composite and then Is_Aggregate_Type (T1) then
          return T1;
 
-      elsif T1 = Any_Composite
-        and then Is_Aggregate_Type (T2)
-      then
+      elsif T1 = Any_Composite and then Is_Aggregate_Type (T2) then
          return T2;
 
       elsif T1 = Any_Modular and then Is_Modular_Integer_Type (T2) then
@@ -3349,7 +3317,7 @@ package body Sem_Type is
 
       elsif Is_Class_Wide_Type (T2)
         and then Is_Interface (Etype (T2))
-        and then Interface_Present_In_Ancestor (Typ => T1,
+        and then Interface_Present_In_Ancestor (Typ   => T1,
                                                 Iface => Etype (T2))
       then
          return T1;
@@ -3364,32 +3332,30 @@ package body Sem_Type is
       then
          return T2;
 
-      elsif (Ekind (B1) = E_Access_Subprogram_Type
-               or else
-             Ekind (B1) = E_Access_Protected_Subprogram_Type)
+      elsif Ekind_In (B1, E_Access_Subprogram_Type,
+                          E_Access_Protected_Subprogram_Type)
         and then Ekind (Designated_Type (B1)) /= E_Subprogram_Type
         and then Is_Access_Type (T2)
       then
          return T2;
 
-      elsif (Ekind (B2) = E_Access_Subprogram_Type
-               or else
-             Ekind (B2) = E_Access_Protected_Subprogram_Type)
+      elsif Ekind_In (B2, E_Access_Subprogram_Type,
+                          E_Access_Protected_Subprogram_Type)
         and then Ekind (Designated_Type (B2)) /= E_Subprogram_Type
         and then Is_Access_Type (T1)
       then
          return T1;
 
-      elsif (Ekind (T1) = E_Allocator_Type
-              or else Ekind (T1) = E_Access_Attribute_Type
-              or else Ekind (T1) = E_Anonymous_Access_Type)
+      elsif Ekind_In (T1, E_Allocator_Type,
+                          E_Access_Attribute_Type,
+                          E_Anonymous_Access_Type)
         and then Is_Access_Type (T2)
       then
          return T2;
 
-      elsif (Ekind (T2) = E_Allocator_Type
-              or else Ekind (T2) = E_Access_Attribute_Type
-              or else Ekind (T2) = E_Anonymous_Access_Type)
+      elsif Ekind_In (T2, E_Allocator_Type,
+                          E_Access_Attribute_Type,
+                          E_Anonymous_Access_Type)
         and then Is_Access_Type (T1)
       then
          return T1;
@@ -3435,8 +3401,7 @@ package body Sem_Type is
         and then Number_Dimensions (T) = 1
         and then Is_Boolean_Type (Component_Type (T))
         and then
-         ((not Is_Private_Composite (T)
-            and then not Is_Limited_Composite (T))
+         ((not Is_Private_Composite (T) and then not Is_Limited_Composite (T))
            or else In_Instance
            or else Available_Full_View_Of_Component (T))
       then
@@ -3465,10 +3430,8 @@ package body Sem_Type is
       elsif Is_Array_Type (T)
           and then Number_Dimensions (T) = 1
           and then Is_Discrete_Type (Component_Type (T))
-          and then (not Is_Private_Composite (T)
-                     or else In_Instance)
-          and then (not Is_Limited_Composite (T)
-                     or else In_Instance)
+          and then (not Is_Private_Composite (T) or else In_Instance)
+          and then (not Is_Limited_Composite (T) or else In_Instance)
       then
          return True;
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e6468548b7318b167cc0ef6babb87b8fae5aa53f..7664e60659d29c416951efce4aa2eb804bcdce0f 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -361,6 +361,27 @@ package body Sem_Util is
       Analyze (N);
    end Add_Global_Declaration;
 
+   --------------------------------
+   -- Address_Integer_Convert_OK --
+   --------------------------------
+
+   function Address_Integer_Convert_OK (T1, T2 : Entity_Id) return Boolean is
+   begin
+      if Allow_Integer_Address
+        and then ((Is_Descendent_Of_Address  (T1)
+                    and then Is_Private_Type (T1)
+                    and then Is_Integer_Type (T2))
+                            or else
+                  (Is_Descendent_Of_Address  (T2)
+                    and then Is_Private_Type (T2)
+                    and then Is_Integer_Type (T1)))
+      then
+         return True;
+      else
+         return False;
+      end if;
+   end Address_Integer_Convert_OK;
+
    -----------------
    -- Addressable --
    -----------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 8b95413bd3cd450151227e5faf10d7995b3d39d1..4c6dde99f96267e7f0892458f70457df17a64338 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -67,6 +67,11 @@ package Sem_Util is
    --  for the current unit. The declarations are added in the current scope,
    --  so the caller should push a new scope as required before the call.
 
+   function Address_Integer_Convert_OK (T1, T2 : Entity_Id) return Boolean;
+   --  Given two types, returns True if we are in Allow_Integer_Address mode
+   --  and one of the types is (a descendent of) System.Address (and this type
+   --  is private), and the other type is any integer type.
+
    function Addressable (V : Uint) return Boolean;
    function Addressable (V : Int)  return Boolean;
    pragma Inline (Addressable);
@@ -398,12 +403,12 @@ package Sem_Util is
       --    * Array-of-scalars with specified Default_Component_Value
       --    * Array type with fully default initialized component type
       --    * Record or protected type with components that either have a
-      --        default expression or their related types are fully default
-      --        initialized.
+      --      default expression or their related types are fully default
+      --      initialized.
       --    * Scalar type with specified Default_Value
       --    * Task type
       --    * Type extension of a type with full default initialization where
-      --        the extension components are also fully default initialized
+      --      the extension components are also fully default initialized.
 
       Mixed_Initialization,
       --  This value applies to a type where some of its internals are fully
@@ -415,8 +420,7 @@ package Sem_Util is
 
    function Default_Initialization
      (Typ : Entity_Id) return Default_Initialization_Kind;
-   --  Determine the default initialization kind that applies to a particular
-   --  type.
+   --  Determine default initialization kind that applies to a particular type
 
    function Deepest_Type_Access_Level (Typ : Entity_Id) return Uint;
    --  Same as Type_Access_Level, except that if the type is the type of an Ada
@@ -973,6 +977,20 @@ package Sem_Util is
    function Is_CPP_Constructor_Call (N : Node_Id) return Boolean;
    --  Returns True if N is a call to a CPP constructor
 
+   function Is_Child_Or_Sibling
+     (Pack_1        : Entity_Id;
+      Pack_2        : Entity_Id;
+      Private_Child : Boolean) return Boolean;
+   --  Determine the following relations between two arbitrary packages:
+   --    1) One package is the parent of a child package
+   --    2) Both packages are siblings and share a common parent
+   --  If flag Private_Child is set, then the child in case 1) or both siblings
+   --  in case 2) must be private.
+
+   function Is_Concurrent_Interface (T : Entity_Id) return Boolean;
+   --  First determine whether type T is an interface and then check whether
+   --  it is of protected, synchronized or task kind.
+
    function Is_Dependent_Component_Of_Mutable_Object
      (Object : Node_Id) return Boolean;
    --  Returns True if Object is the name of a subcomponent that depends on
@@ -991,20 +1009,6 @@ package Sem_Util is
    --  This is the RM definition, a type is a descendent of another type if it
    --  is the same type or is derived from a descendent of the other type.
 
-   function Is_Child_Or_Sibling
-     (Pack_1        : Entity_Id;
-      Pack_2        : Entity_Id;
-      Private_Child : Boolean) return Boolean;
-   --  Determine the following relations between two arbitrary packages:
-   --    1) One package is the parent of a child package
-   --    2) Both packages are siblings and share a common parent
-   --  If flag Private_Child is set, then the child in case 1) or both siblings
-   --  in case 2) must be private.
-
-   function Is_Concurrent_Interface (T : Entity_Id) return Boolean;
-   --  First determine whether type T is an interface and then check whether
-   --  it is of protected, synchronized or task kind.
-
    function Is_Expression_Function (Subp : Entity_Id) return Boolean;
    --  Predicate to determine whether a scope entity comes from a rewritten
    --  expression function call, and should be inlined unconditionally. Also