2014-07-29 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 13:08:12 +0000 (13:08 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 13:08:12 +0000 (13:08 +0000)
* einfo.adb (Has_Protected): Test base type.
* sem_ch4.adb (Analyze_Allocator): Reorganize code to make sure
that we always properly check No_Protected_Type_Allocators.

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

* sem_util.ads, sem_util.adb (Defining_Entity): Now applies to
loop declarations as well.
* exp_ch5.adb (Expand_Loop_Statement): Apply Qualify_Entity_Names
to an iterator loop, because it may contain local renaming
declarations that require debugging information.

2014-07-29  Robert Dewar  <dewar@adacore.com>

* sem_util.ads, exp_util.adb, sem_attr.adb: Minor reformatting.

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

gcc/ada/ChangeLog
gcc/ada/einfo.adb
gcc/ada/exp_ch5.adb
gcc/ada/exp_util.adb
gcc/ada/sem_attr.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads

index 9aa5cb0..5b18da4 100644 (file)
@@ -1,5 +1,23 @@
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
+       * einfo.adb (Has_Protected): Test base type.
+       * sem_ch4.adb (Analyze_Allocator): Reorganize code to make sure
+       that we always properly check No_Protected_Type_Allocators.
+
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_util.ads, sem_util.adb (Defining_Entity): Now applies to
+       loop declarations as well.
+       * exp_ch5.adb (Expand_Loop_Statement): Apply Qualify_Entity_Names
+       to an iterator loop, because it may contain local renaming
+       declarations that require debugging information.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+       * sem_util.ads, exp_util.adb, sem_attr.adb: Minor reformatting.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
        * einfo.ads, einfo.adb (Static_Real_Or_String_Predicate): New function
        (Set_Static_Real_Or_String_Predicate): New procedure
        * sem_ch13.adb (Build_Predicate_Functions): Accomodate static
index 5da314a..926190b 100644 (file)
@@ -1647,7 +1647,7 @@ package body Einfo is
 
    function Has_Protected (Id : E) return B is
    begin
-      return Flag271 (Id);
+      return Flag271 (Base_Type (Id));
    end Has_Protected;
 
    function Has_Qualified_Name (Id : E) return B is
index 78f876b..96506f8 100644 (file)
@@ -3946,6 +3946,19 @@ package body Exp_Ch5 is
         and then Present (Iterator_Specification (Scheme))
       then
          Expand_Iterator_Loop (N);
+
+         --  An iterator loop may generate renaming declarations for elements
+         --  that require debug information. This is the case in particular
+         --  with element iterators, where debug information must be generated
+         --  for the temporary that holds the element value. These temporaries
+         --  are created within a transient block whose local declarations are
+         --  transferred to the loop, which now has non-trivial local objects.
+
+         if Nkind (N) = N_Loop_Statement
+           and then Present (Identifier (N))
+         then
+            Qualify_Entity_Names (N);
+         end if;
       end if;
 
       --  When the iteration scheme mentiones attribute 'Loop_Entry, the loop
index d2a5f84..0b6d7a3 100644 (file)
@@ -5447,6 +5447,8 @@ package body Exp_Util is
             --  that it is common and reasonable for code to be deleted in
             --  instances for various reasons.
 
+            --  Could we use Is_Statically_Unevaluated here???
+
             if Nkind (Parent (N)) = N_If_Statement then
                declare
                   C : constant Node_Id := Condition (Parent (N));
@@ -5495,6 +5497,7 @@ package body Exp_Util is
 
             declare
                E : Entity_Id := First_Entity (Defining_Entity (N));
+
             begin
                while Present (E) loop
                   if Ekind (E) = E_Operator then
@@ -5510,7 +5513,7 @@ package body Exp_Util is
 
          elsif Nkind (N) = N_If_Statement then
             Kill_Dead_Code (Then_Statements (N));
-            Kill_Dead_Code (Elsif_Parts (N));
+            Kill_Dead_Code (Elsif_Parts     (N));
             Kill_Dead_Code (Else_Statements (N));
 
          elsif Nkind (N) = N_Loop_Statement then
@@ -5543,8 +5546,10 @@ package body Exp_Util is
    procedure Kill_Dead_Code (L : List_Id; Warn : Boolean := False) is
       N : Node_Id;
       W : Boolean;
+
    begin
       W := Warn;
+
       if Is_Non_Empty_List (L) then
          N := First (L);
          while Present (N) loop
@@ -6770,7 +6775,7 @@ package body Exp_Util is
                Analyze (Block);
             end if;
 
-         when others                       =>
+         when others =>
             null;
       end case;
    end Process_Statements_For_Controlled_Objects;
@@ -6782,6 +6787,7 @@ package body Exp_Util is
    function Power_Of_Two (N : Node_Id) return Nat is
       Typ : constant Entity_Id := Etype (N);
       pragma Assert (Is_Integer_Type (Typ));
+
       Siz : constant Nat := UI_To_Int (Esize (Typ));
       Val : Uint;
 
@@ -8703,7 +8709,6 @@ package body Exp_Util is
       Loc   : constant Source_Ptr := Sloc (N);
       Stseq : constant Node_Id    := Handled_Statement_Sequence (N);
       Stmts : constant List_Id    := Statements (Stseq);
-
    begin
       if Abort_Allowed then
          Prepend_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
index 8b70326..d22118e 100644 (file)
@@ -5492,7 +5492,7 @@ package body Sem_Attr is
 
       when Attribute_Scalar_Storage_Order => Scalar_Storage_Order :
       declare
-            Ent : Entity_Id := Empty;
+         Ent : Entity_Id := Empty;
 
       begin
          Check_E0;
@@ -5505,7 +5505,7 @@ package body Sem_Attr is
             --  the default bit order for the target.
 
             if not (GNAT_Mode and then Is_Generic_Type (P_Type))
-                     and then not In_Instance
+              and then not In_Instance
             then
                Error_Attr_P
                  ("prefix of % attribute must be record or array type");
index 7f9f086..8ac94e9 100644 (file)
@@ -639,15 +639,6 @@ package body Sem_Ch4 is
                end;
             end if;
 
-            --  Check restriction against dynamically allocated protected
-            --  objects. Note that when limited aggregates are supported,
-            --  a similar test should be applied to an allocator with a
-            --  qualified expression ???
-
-            if Has_Protected (Type_Id) then
-               Check_Restriction (No_Protected_Type_Allocators, N);
-            end if;
-
             --  Check for missing initialization. Skip this check if we already
             --  had errors on analyzing the allocator, since in that case these
             --  are probably cascaded errors.
@@ -725,6 +716,12 @@ package body Sem_Ch4 is
          Check_Restriction (No_Task_Allocators, N);
       end if;
 
+      --  Check restriction against dynamically allocated protected objects
+
+      if Has_Protected (Designated_Type (Acc_Type)) then
+         Check_Restriction (No_Protected_Type_Allocators, N);
+      end if;
+
       --  AI05-0013-1: No_Nested_Finalization forbids allocators if the access
       --  type is nested, and the designated type needs finalization. The rule
       --  is conservative in that class-wide types need finalization.
index 0782c50..62a5bdb 100644 (file)
@@ -153,8 +153,8 @@ package body Sem_Util is
 
          elsif Nkind (Parent (Typ)) = N_Private_Type_Declaration then
             if Present (Full_View (Typ))
-              and then Nkind (Parent (Full_View (Typ)))
-                         = N_Full_Type_Declaration
+              and then
+                Nkind (Parent (Full_View (Typ))) = N_Full_Type_Declaration
             then
                Nod := Type_Definition (Parent (Full_View (Typ)));
 
@@ -2149,7 +2149,7 @@ package body Sem_Util is
                                  Get_Index_Bounds (Choice, L, H);
                                  pragma Assert
                                    (Compile_Time_Known_Value (L)
-                                      and then Compile_Time_Known_Value (H));
+                                     and then Compile_Time_Known_Value (H));
                                  Count_Components :=
                                    Count_Components
                                      + Expr_Value (H) - Expr_Value (L) + 1;
@@ -2364,9 +2364,7 @@ package body Sem_Util is
       elsif not Comes_From_Source (Nam) then
          return;
 
-      elsif Is_Entity_Name (Nam)
-        and then Is_Type (Entity (Nam))
-      then
+      elsif Is_Entity_Name (Nam) and then Is_Type (Entity (Nam)) then
          null;
 
       else
@@ -2542,11 +2540,7 @@ package body Sem_Util is
       --  Check for Is_Imported needs commenting below ???
 
       if VM_Target /= No_VM
-        and then (Ekind (Ent) = E_Variable
-                    or else
-                  Ekind (Ent) = E_Constant
-                    or else
-                  Ekind (Ent) = E_Loop_Parameter)
+        and then Ekind_In (Ent, E_Variable, E_Constant, E_Loop_Parameter)
         and then Scope (Ent) /= Empty
         and then not Is_Library_Level_Entity (Ent)
         and then not Is_Imported (Ent)
@@ -2562,9 +2556,7 @@ package body Sem_Util is
 
          Enclosing := Enclosing_Subprogram (Ent);
 
-         if Enclosing /= Empty
-           and then Enclosing /= Current_Subp
-         then
+         if Enclosing /= Empty and then Enclosing /= Current_Subp then
             Set_Has_Up_Level_Access (Ent, True);
          end if;
       end if;
@@ -2769,7 +2761,7 @@ package body Sem_Util is
            Comes_From_Source (N)
              and then Is_Entity_Name (N)
              and then (Entity (N) = Standard_True
-                         or else Entity (N) = Standard_False);
+                        or else Entity (N) = Standard_False);
       end Is_Trivial_Boolean;
 
       -------------------------
@@ -2950,9 +2942,7 @@ package body Sem_Util is
 
       begin
          S := Current_Scope;
-         while Present (S)
-           and then S /= Pref_Encl_Typ
-         loop
+         while Present (S) and then S /= Pref_Encl_Typ loop
             if Scope (S) = Pref_Encl_Typ then
                E := First_Entity (Pref_Encl_Typ);
                while Present (E)
@@ -2961,6 +2951,7 @@ package body Sem_Util is
                   if E = S then
                      return True;
                   end if;
+
                   Next_Entity (E);
                end loop;
             end if;
@@ -2987,7 +2978,7 @@ package body Sem_Util is
            and then No (Cont_Encl_Typ)
            and then Is_Public_Operation
            and then Scope_Depth (Pref_Encl_Typ) >=
-                      Object_Access_Level (Context)
+                                       Object_Access_Level (Context)
          then
             Error_Msg_N
               ("??possible unprotected access to protected data", Expr);
@@ -3064,9 +3055,7 @@ package body Sem_Util is
             Ancestor := Etype (Full_T);
             Collect (Ancestor);
 
-            if Is_Interface (Ancestor)
-              and then not Exclude_Parents
-            then
+            if Is_Interface (Ancestor) and then not Exclude_Parents then
                Append_Unique_Elmt (Ancestor, Ifaces_List);
             end if;
          end if;
@@ -3210,8 +3199,8 @@ package body Sem_Util is
          end if;
 
          while Present (ADT)
-            and then Is_Tag (Node (ADT))
-            and then Related_Type (Node (ADT)) /= Iface
+           and then Is_Tag (Node (ADT))
+           and then Related_Type (Node (ADT)) /= Iface
          loop
             --  Skip secondary dispatch table referencing thunks to user
             --  defined primitives covered by this interface.
@@ -3389,8 +3378,8 @@ package body Sem_Util is
 
       elsif Is_Generic_Type (B_Type) then
          if Nkind (B_Decl) = N_Formal_Type_Declaration
-           and then Nkind (Formal_Type_Definition (B_Decl))
-             = N_Formal_Derived_Type_Definition
+           and then Nkind (Formal_Type_Definition (B_Decl)) =
+                                           N_Formal_Derived_Type_Definition
          then
             Formal_Derived := True;
          else
@@ -3489,8 +3478,7 @@ package body Sem_Util is
                --  package declaration are not primitive for it.
 
                if Is_Prim
-                 and then (not Formal_Derived
-                            or else Present (Alias (Id)))
+                 and then (not Formal_Derived or else Present (Alias (Id)))
                then
                   --  In the special case of an equality operator aliased to
                   --  an overriding dispatching equality belonging to the same
@@ -4223,7 +4211,10 @@ package body Sem_Util is
                end if;
             end;
 
-         when N_Block_Statement =>
+         when
+           N_Block_Statement                        |
+           N_Loop_Statement
+         =>
             return Entity (Identifier (N));
 
          when others =>
@@ -4241,10 +4232,9 @@ package body Sem_Util is
       Check_Concurrent : Boolean := False) return Boolean
    is
       E : Entity_Id;
+
    begin
-      if not Is_Entity_Name (N)
-        or else No (Entity (N))
-      then
+      if not Is_Entity_Name (N) or else No (Entity (N)) then
          return False;
       else
          E := Entity (N);
@@ -4440,7 +4430,7 @@ package body Sem_Util is
       elsif Nkind (Obj1) = N_Selected_Component then
          return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
            and then
-         Entity (Selector_Name (Obj1)) = Entity (Selector_Name (Obj2));
+             Entity (Selector_Name (Obj1)) = Entity (Selector_Name (Obj2));
 
       --  Both names are dereferences and the dereferenced names are known to
       --  denote the same object (RM 6.4.1(6.7/3))
@@ -4509,10 +4499,11 @@ package body Sem_Util is
               and then Denotes_Same_Object (Hi1, Hi2);
          end;
 
-      --  In the recursion, literals appear as indexes.
+      --  In the recursion, literals appear as indexes
 
       elsif Nkind (Obj1) = N_Integer_Literal
-        and then Nkind (Obj2) = N_Integer_Literal
+              and then
+            Nkind (Obj2) = N_Integer_Literal
       then
          return Intval (Obj1) = Intval (Obj2);
 
@@ -4678,11 +4669,9 @@ package body Sem_Util is
    --  Start of processing for Designate_Next_Unit
 
    begin
-      if (K1 = N_Identifier or else
-          K1 = N_Defining_Identifier)
-        and then
-         (K2 = N_Identifier or else
-          K2 = N_Defining_Identifier)
+      if (K1 = N_Identifier or else K1 = N_Defining_Identifier)
+           and then
+         (K2 = N_Identifier or else K2 = N_Defining_Identifier)
       then
          return Chars (Name1) = Chars (Name2);
 
@@ -5106,7 +5095,7 @@ package body Sem_Util is
          --  same name as a generic formal which has been seen already.
 
          elsif Nkind (Parent (Def_Id)) = N_Package_Renaming_Declaration
-            and then not Comes_From_Source (Def_Id)
+           and then not Comes_From_Source (Def_Id)
          then
             Set_Is_Immediately_Visible (E, False);
 
@@ -5139,9 +5128,7 @@ package body Sem_Util is
                --  entity in the scope.
 
                Prev := First_Entity (Current_Scope);
-               while Present (Prev)
-                 and then Next_Entity (Prev) /= E
-               loop
+               while Present (Prev) and then Next_Entity (Prev) /= E loop
                   Next_Entity (Prev);
                end loop;
 
@@ -5301,7 +5288,7 @@ package body Sem_Util is
             end if;
 
             if Nkind (Parent (Parent (Def_Id))) =
-                N_Generic_Subprogram_Declaration
+                                             N_Generic_Subprogram_Declaration
               and then Def_Id =
                 Defining_Entity (Specification (Parent (Parent (Def_Id))))
             then
@@ -5369,9 +5356,7 @@ package body Sem_Util is
 
       --  Declaring a homonym is not allowed in SPARK ...
 
-      if Present (C)
-        and then Restriction_Check_Required (SPARK_05)
-      then
+      if Present (C) and then Restriction_Check_Required (SPARK_05) then
          declare
             Enclosing_Subp : constant Node_Id := Enclosing_Subprogram (Def_Id);
             Enclosing_Pack : constant Node_Id := Enclosing_Package (Def_Id);
@@ -5419,38 +5404,38 @@ package body Sem_Util is
 
       if Warn_On_Hiding and then Present (C)
 
-         --  Don't warn for record components since they always have a well
-         --  defined scope which does not confuse other uses. Note that in
-         --  some cases, Ekind has not been set yet.
+        --  Don't warn for record components since they always have a well
+        --  defined scope which does not confuse other uses. Note that in
+        --  some cases, Ekind has not been set yet.
 
-         and then Ekind (C) /= E_Component
-         and then Ekind (C) /= E_Discriminant
-         and then Nkind (Parent (C)) /= N_Component_Declaration
-         and then Ekind (Def_Id) /= E_Component
-         and then Ekind (Def_Id) /= E_Discriminant
-         and then Nkind (Parent (Def_Id)) /= N_Component_Declaration
+        and then Ekind (C) /= E_Component
+        and then Ekind (C) /= E_Discriminant
+        and then Nkind (Parent (C)) /= N_Component_Declaration
+        and then Ekind (Def_Id) /= E_Component
+        and then Ekind (Def_Id) /= E_Discriminant
+        and then Nkind (Parent (Def_Id)) /= N_Component_Declaration
 
-         --  Don't warn for one character variables. It is too common to use
-         --  such variables as locals and will just cause too many false hits.
+        --  Don't warn for one character variables. It is too common to use
+        --  such variables as locals and will just cause too many false hits.
 
-         and then Length_Of_Name (Chars (C)) /= 1
+        and then Length_Of_Name (Chars (C)) /= 1
 
-         --  Don't warn for non-source entities
+        --  Don't warn for non-source entities
 
-         and then Comes_From_Source (C)
-         and then Comes_From_Source (Def_Id)
+        and then Comes_From_Source (C)
+        and then Comes_From_Source (Def_Id)
 
-         --  Don't warn unless entity in question is in extended main source
+        --  Don't warn unless entity in question is in extended main source
 
-         and then In_Extended_Main_Source_Unit (Def_Id)
+        and then In_Extended_Main_Source_Unit (Def_Id)
 
-         --  Finally, the hidden entity must be either immediately visible or
-         --  use visible (i.e. from a used package).
+        --  Finally, the hidden entity must be either immediately visible or
+        --  use visible (i.e. from a used package).
 
-         and then
-           (Is_Immediately_Visible (C)
-              or else
-            Is_Potentially_Use_Visible (C))
+        and then
+          (Is_Immediately_Visible (C)
+             or else
+           Is_Potentially_Use_Visible (C))
       then
          Error_Msg_Sloc := Sloc (C);
          Error_Msg_N ("declaration hides &#?h?", Def_Id);
@@ -5552,9 +5537,7 @@ package body Sem_Util is
       Actual : Node_Id;
 
    begin
-      if (Nkind (Parnt) = N_Indexed_Component
-            or else
-          Nkind (Parnt) = N_Selected_Component)
+      if Nkind_In (Parnt, N_Indexed_Component, N_Selected_Component)
         and then N = Prefix (Parnt)
       then
          Find_Actual (Parnt, Formal, Call);
@@ -5693,10 +5676,10 @@ package body Sem_Util is
       while Present (Old_Disc) and then Present (New_Disc) loop
          if Old_Disc = Par_Disc  then
             return New_Disc;
-         else
-            Next_Discriminant (Old_Disc);
-            Next_Discriminant (New_Disc);
          end if;
+
+         Next_Discriminant (Old_Disc);
+         Next_Discriminant (New_Disc);
       end loop;
 
       --  Should always find it
@@ -5984,8 +5967,7 @@ package body Sem_Util is
                --  be a static subtype, since otherwise it would have
                --  been diagnosed as illegal.
 
-               elsif Is_Entity_Name (Choice)
-                 and then Is_Type (Entity (Choice))
+               elsif Is_Entity_Name (Choice) and then Is_Type (Entity (Choice))
                then
                   exit Search when Is_In_Range (Expr, Etype (Choice),
                                                 Assume_Valid => False);
@@ -5999,7 +5981,7 @@ package body Sem_Util is
 
                   begin
                      exit Search when
-                       Val >= Expr_Value (Low_Bound (R))
+                       Val >= Expr_Value (Low_Bound  (R))
                          and then
                        Val <= Expr_Value (High_Bound (R));
                   end;
@@ -7273,8 +7255,7 @@ package body Sem_Util is
                --  where we do not know the alignment of Obj.
 
                if Known_Alignment (Entity (Expr))
-                 and then
-                   UI_To_Int (Alignment (Entity (Expr))) <
+                 and then UI_To_Int (Alignment (Entity (Expr))) <
                                                     Ttypes.Maximum_Alignment
                then
                   Set_Result (Unknown);
@@ -7509,7 +7490,7 @@ package body Sem_Util is
 
                      if Nkind (Prop_Nam) = N_Others_Choice
                        or else (Nkind (Prop_Nam) = N_Identifier
-                                  and then Chars (Prop_Nam) = Property)
+                                 and then Chars (Prop_Nam) = Property)
                      then
                         return Is_True (Expr_Value (Expression (Prop)));
                      end if;
@@ -7563,24 +7544,20 @@ package body Sem_Util is
             return True;
 
          elsif Property = Name_Async_Writers
-           and then
-             (Present (AW)
-                or else
-             (No (AR) and then No (ER) and then No (EW)))
+           and then (Present (AW)
+                      or else (No (AR) and then No (ER) and then No (EW)))
          then
             return True;
 
          elsif Property = Name_Effective_Reads
-           and then
-             (Present (ER)
-                or else
-             (No (AR) and then No (AW) and then No (EW)))
+           and then (Present (ER)
+                      or else (No (AR) and then No (AW) and then No (EW)))
          then
             return True;
 
          elsif Property = Name_Effective_Writes
-           and then
-             (Present (EW) or else (No (AR) and then No (AW) and then No (ER)))
+           and then (Present (EW)
+                      or else (No (AR) and then No (AW) and then No (ER)))
          then
             return True;
 
@@ -7646,9 +7623,7 @@ package body Sem_Util is
 
       --  Handle private types
 
-      if Use_Full_View
-        and then Present (Full_View (Typ))
-      then
+      if Use_Full_View and then Present (Full_View (Typ)) then
          Typ := Full_View (Typ);
       end if;
 
@@ -7675,7 +7650,7 @@ package body Sem_Util is
             --  Handle private types
 
             or else (Present (Full_View (Etype (Typ)))
-                       and then Full_View (Etype (Typ)) = Typ)
+                      and then Full_View (Etype (Typ)) = Typ)
 
             --  Protect the frontend against wrong source with cyclic
             --  derivations
@@ -7714,13 +7689,12 @@ package body Sem_Util is
          return Has_No_Obvious_Side_Effects (Right_Opnd (N));
 
       elsif Nkind (N) in N_Binary_Op or else Nkind (N) in N_Short_Circuit then
-         return Has_No_Obvious_Side_Effects (Left_Opnd (N))
-                   and then
+         return Has_No_Obvious_Side_Effects (Left_Opnd  (N))
+                  and then
                 Has_No_Obvious_Side_Effects (Right_Opnd (N));
 
       elsif Nkind (N) = N_Expression_With_Actions
-              and then
-            Is_Empty_List (Actions (N))
+        and then Is_Empty_List (Actions (N))
       then
          return Has_No_Obvious_Side_Effects (Expression (N));
 
@@ -7850,13 +7824,13 @@ package body Sem_Util is
                   Formal : constant Entity_Id := First_Formal (Init);
                begin
                   if Ekind (Init) = E_Procedure
-                       and then Chars (Init) = Name_Initialize
-                       and then Comes_From_Source (Init)
-                       and then Present (Formal)
-                       and then Etype (Formal) = BT
-                       and then No (Next_Formal (Formal))
-                       and then (Ada_Version < Ada_2012
-                                   or else not Null_Present (Parent (Init)))
+                    and then Chars (Init) = Name_Initialize
+                    and then Comes_From_Source (Init)
+                    and then Present (Formal)
+                    and then Etype (Formal) = BT
+                    and then No (Next_Formal (Formal))
+                    and then (Ada_Version < Ada_2012
+                               or else not Null_Present (Parent (Init)))
                   then
                      return True;
                   end if;
@@ -8613,9 +8587,7 @@ package body Sem_Util is
 
    begin
       S := Current_Scope;
-      while Present (S)
-        and then S /= Standard_Standard
-      loop
+      while Present (S) and then S /= Standard_Standard loop
          if (Ekind (S) = E_Function
               or else Ekind (S) = E_Package
               or else Ekind (S) = E_Procedure)
@@ -8628,9 +8600,8 @@ package body Sem_Util is
             --  that it is not currently on the scope stack.
 
             if Is_Child_Unit (Curr_Unit)
-              and then
-                Nkind (Unit (Cunit (Current_Sem_Unit)))
-                  = N_Package_Instantiation
+              and then Nkind (Unit (Cunit (Current_Sem_Unit))) =
+                                                     N_Package_Instantiation
               and then not In_Open_Scopes (Curr_Unit)
             then
                return False;
@@ -8654,11 +8625,8 @@ package body Sem_Util is
 
    begin
       S := Current_Scope;
-      while Present (S)
-        and then S /= Standard_Standard
-      loop
-         if (Ekind (S) = E_Function
-              or else Ekind (S) = E_Procedure)
+      while Present (S) and then S /= Standard_Standard loop
+         if Ekind_In (S, E_Function, E_Procedure)
            and then Is_Generic_Instance (S)
          then
             return True;
@@ -8685,11 +8653,8 @@ package body Sem_Util is
 
    begin
       S := Current_Scope;
-      while Present (S)
-        and then S /= Standard_Standard
-      loop
-         if (Ekind (S) = E_Function
-              or else Ekind (S) = E_Procedure)
+      while Present (S) and then S /= Standard_Standard loop
+         if Ekind_In (S, E_Function, E_Procedure)
            and then Is_Generic_Instance (S)
          then
             return True;
@@ -8716,9 +8681,7 @@ package body Sem_Util is
 
    begin
       S := Current_Scope;
-      while Present (S)
-        and then S /= Standard_Standard
-      loop
+      while Present (S) and then S /= Standard_Standard loop
          if Ekind (S) = E_Package
            and then Is_Generic_Instance (S)
            and then not In_Package_Body (S)
@@ -8742,12 +8705,8 @@ package body Sem_Util is
 
    begin
       S := Current_Scope;
-      while Present (S)
-        and then S /= Standard_Standard
-      loop
-         if Ekind (S) = E_Package
-           and then In_Package_Body (S)
-         then
+      while Present (S) and then S /= Standard_Standard loop
+         if Ekind (S) = E_Package and then In_Package_Body (S) then
             return True;
          else
             S := Scope (S);
@@ -8827,10 +8786,9 @@ package body Sem_Util is
          Btyp := Base_Type (Etype (Pref));
       end if;
 
-      return
-        Present (Btyp)
-          and then (Is_Record_Type (Btyp) or else Is_Array_Type (Btyp))
-          and then Reverse_Storage_Order (Btyp);
+      return Present (Btyp)
+        and then (Is_Record_Type (Btyp) or else Is_Array_Type (Btyp))
+        and then Reverse_Storage_Order (Btyp);
    end In_Reverse_Storage_Order_Object;
 
    --------------------------------------
@@ -8868,11 +8826,10 @@ package body Sem_Util is
 
    function In_Visible_Part (Scope_Id : Entity_Id) return Boolean is
    begin
-      return
-        Is_Package_Or_Generic_Package (Scope_Id)
-          and then In_Open_Scopes (Scope_Id)
-          and then not In_Package_Body (Scope_Id)
-          and then not In_Private_Part (Scope_Id);
+      return Is_Package_Or_Generic_Package (Scope_Id)
+        and then In_Open_Scopes (Scope_Id)
+        and then not In_Package_Body (Scope_Id)
+        and then not In_Private_Part (Scope_Id);
    end In_Visible_Part;
 
    --------------------------------
@@ -9043,14 +9000,13 @@ package body Sem_Util is
          --  For a retrieval of a subcomponent of some composite object,
          --  retrieve the ultimate entity if there is one.
 
-         elsif Nkind (New_Prefix) = N_Selected_Component
-           or else Nkind (New_Prefix) = N_Indexed_Component
+         elsif Nkind_In (New_Prefix, N_Selected_Component,
+                                     N_Indexed_Component)
          then
             Pref := Prefix (New_Prefix);
             while Present (Pref)
-              and then
-                (Nkind (Pref) = N_Selected_Component
-                  or else Nkind (Pref) = N_Indexed_Component)
+              and then Nkind_In (Pref, N_Selected_Component,
+                                       N_Indexed_Component)
             loop
                Pref := Prefix (Pref);
             end loop;
@@ -9226,9 +9182,7 @@ package body Sem_Util is
 
    begin
       Par := E2;
-      while Present (Par)
-        and then Par /= Standard_Standard
-      loop
+      while Present (Par) and then Par /= Standard_Standard loop
          if Par = E1 then
             return True;
          end if;
@@ -9331,9 +9285,8 @@ package body Sem_Util is
 
    function Is_Attribute_Result (N : Node_Id) return Boolean is
    begin
-      return
-         Nkind (N) = N_Attribute_Reference
-           and then Attribute_Name (N) = Name_Result;
+      return Nkind (N) = N_Attribute_Reference
+        and then Attribute_Name (N) = Name_Result;
    end Is_Attribute_Result;
 
    ------------------------------------
@@ -9532,9 +9485,8 @@ package body Sem_Util is
 
    function Is_Concurrent_Interface (T : Entity_Id) return Boolean is
    begin
-      return
-        Is_Interface (T)
-          and then
+      return Is_Interface (T)
+        and then
             (Is_Protected_Interface (T)
                or else Is_Synchronized_Interface (T)
                or else Is_Task_Interface (T));
@@ -9980,7 +9932,7 @@ package body Sem_Util is
                             and then In_Package_Body (Current_Scope)))
 
               and then (Is_Declared_Within_Variant (Comp)
-                          or else Has_Discriminant_Dependent_Constraint (Comp))
+                         or else Has_Discriminant_Dependent_Constraint (Comp))
               and then (not P_Aliased or else Ada_Version >= Ada_2005)
             then
                return True;
@@ -10025,14 +9977,10 @@ package body Sem_Util is
    function Is_Dereferenced (N : Node_Id) return Boolean is
       P : constant Node_Id := Parent (N);
    begin
-      return
-         (Nkind (P) = N_Selected_Component
-            or else
-          Nkind (P) = N_Explicit_Dereference
-            or else
-          Nkind (P) = N_Indexed_Component
-            or else
-          Nkind (P) = N_Slice)
+      return Nkind_In (P, N_Selected_Component,
+                          N_Explicit_Dereference,
+                          N_Indexed_Component,
+                          N_Slice)
         and then Prefix (P) = N;
    end Is_Dereferenced;
 
@@ -10205,7 +10153,8 @@ package body Sem_Util is
                   end if;
 
                   if Compile_Time_Known_Value (Lbd)
-                    and then Compile_Time_Known_Value (Hbd)
+                       and then
+                     Compile_Time_Known_Value (Hbd)
                   then
                      if Expr_Value (Hbd) < Expr_Value (Lbd) then
                         return True;
@@ -10287,7 +10236,7 @@ package body Sem_Util is
             while Present (Ent) loop
                if Ekind (Ent) = E_Component
                  and then (No (Parent (Ent))
-                             or else No (Expression (Parent (Ent))))
+                            or else No (Expression (Parent (Ent))))
                  and then not Is_Fully_Initialized_Type (Etype (Ent))
 
                   --  Special VM case for tag components, which need to be
@@ -10464,9 +10413,8 @@ package body Sem_Util is
 
    begin
       if Is_Class_Wide_Type (Typ)
-        and then
-          Nam_In (Chars (Etype (Typ)), Name_Forward_Iterator,
-                                       Name_Reversible_Iterator)
+        and then Nam_In (Chars (Etype (Typ)), Name_Forward_Iterator,
+                                              Name_Reversible_Iterator)
         and then
           Is_Predefined_File_Name
             (Unit_File_Name (Get_Source_Unit (Etype (Typ))))
@@ -10710,7 +10658,7 @@ package body Sem_Util is
                  Is_Object_Reference (Selector_Name (N))
                    and then
                      (Is_Object_Reference (Prefix (N))
-                        or else Is_Access_Type (Etype (Prefix (N))));
+                       or else Is_Access_Type (Etype (Prefix (N))));
 
             when N_Explicit_Dereference =>
                return True;
@@ -11230,7 +11178,7 @@ package body Sem_Util is
 
       elsif Present (Controlling_Argument (N))
         and then Is_Remote_Access_To_Class_Wide_Type
-          (Etype (Controlling_Argument (N)))
+                   (Etype (Controlling_Argument (N)))
       then
          --  Any primitive operation call with a controlling argument of
          --  a RACW type is a remote call.
@@ -11306,16 +11254,13 @@ package body Sem_Util is
 
    begin
       if Is_Class_Wide_Type (Typ)
-        and then  Chars (Etype (Typ)) = Name_Reversible_Iterator
-        and then
-          Is_Predefined_File_Name
-            (Unit_File_Name (Get_Source_Unit (Etype (Typ))))
+        and then Chars (Etype (Typ)) = Name_Reversible_Iterator
+        and then Is_Predefined_File_Name
+                   (Unit_File_Name (Get_Source_Unit (Etype (Typ))))
       then
          return True;
 
-      elsif not Is_Tagged_Type (Typ)
-        or else not Is_Derived_Type (Typ)
-      then
+      elsif not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then
          return False;
 
       else
@@ -11348,13 +11293,11 @@ package body Sem_Util is
       if not Is_List_Member (N) then
          declare
             P : constant Node_Id   := Parent (N);
-            K : constant Node_Kind := Nkind (P);
          begin
-            return
-              (K = N_Expanded_Name          or else
-               K = N_Generic_Association    or else
-               K = N_Parameter_Association  or else
-               K = N_Selected_Component)
+            return Nkind_In (P, N_Expanded_Name,
+                                N_Generic_Association,
+                                N_Parameter_Association,
+                                N_Selected_Component)
               and then Selector_Name (P) = N;
          end;
 
@@ -11429,7 +11372,8 @@ package body Sem_Util is
               N_Short_Circuit   |
               N_Membership_Test =>
             Is_Ok := Is_SPARK_Initialization_Expr (Left_Opnd (Orig_N))
-              and then Is_SPARK_Initialization_Expr (Right_Opnd (Orig_N));
+                       and then
+                         Is_SPARK_Initialization_Expr (Right_Opnd (Orig_N));
 
          when N_Aggregate           |
               N_Extension_Aggregate =>
@@ -11499,7 +11443,7 @@ package body Sem_Util is
          return Present (Entity (N))
            and then
              (Ekind_In (Entity (N), E_Constant, E_Variable)
-              or else Ekind (Entity (N)) in Formal_Kind);
+               or else Ekind (Entity (N)) in Formal_Kind);
 
       else
          case Nkind (N) is
@@ -11913,7 +11857,7 @@ package body Sem_Util is
 
       elsif Nkind (N) = N_Explicit_Dereference
         and then Present (Etype (Orig_Node))
-        and then  Ada_Version >= Ada_2012
+        and then Ada_Version >= Ada_2012
         and then Has_Implicit_Dereference (Etype (Orig_Node))
       then
          return True;
@@ -11933,10 +11877,10 @@ package body Sem_Util is
             K : constant Entity_Kind := Ekind (E);
 
          begin
-            return (K = E_Variable
-                      and then Nkind (Parent (E)) /= N_Exception_Handler)
+            return     (K = E_Variable
+                         and then Nkind (Parent (E)) /= N_Exception_Handler)
               or else  (K = E_Component
-                          and then not In_Protected_Function (E))
+                         and then not In_Protected_Function (E))
               or else  K = E_Out_Parameter
               or else  K = E_In_Out_Parameter
               or else  K = E_Generic_In_Out_Parameter
@@ -12410,7 +12354,7 @@ package body Sem_Util is
 
          if Is_OK_Static_Expression (L_Low)
               and then
-             Is_OK_Static_Expression (L_High)
+            Is_OK_Static_Expression (L_High)
          then
             if Expr_Value (L_High) < Expr_Value (L_Low) then
                L_Len := Uint_0;
@@ -13462,9 +13406,7 @@ package body Sem_Util is
                end;
             end if;
 
-         elsif F in List_Range
-           and then Parent (List_Id (F)) = N
-         then
+         elsif F in List_Range and then Parent (List_Id (F)) = N then
             Visit_List (List_Id (F));
             return;
          end if;
@@ -13540,8 +13482,7 @@ package body Sem_Util is
                   end if;
 
                   if Is_Type (Node (E))
-                    and then
-                      Old_Itype = Associated_Node_For_Itype (Node (E))
+                    and then Old_Itype = Associated_Node_For_Itype (Node (E))
                   then
                      Set_Associated_Node_For_Itype
                        (Node (Next_Elmt (E)), New_Itype);
@@ -13637,9 +13578,8 @@ package body Sem_Util is
       begin
          --  Handle case of an Itype, which must be copied
 
-         if Has_Extension (N)
-           and then Is_Itype (N)
-         then
+         if Has_Extension (N) and then Is_Itype (N) then
+
             --  Nothing to do if already in the list. This can happen with an
             --  Itype entity that appears more than once in the tree.
             --  Note that we do not want to visit descendents in this case.
@@ -14071,14 +14011,13 @@ package body Sem_Util is
                      then
                         if No (Actuals)
                           and then
-                           (Nkind (Parent (N)) = N_Procedure_Call_Statement
-                             or else
-                           (Nkind (Parent (N)) = N_Function_Call
-                             or else
-                            Nkind (Parent (N)) = N_Parameter_Association))
+                           Nkind_In (Parent (N), N_Procedure_Call_Statement,
+                                                 N_Function_Call,
+                                                 N_Parameter_Association)
                           and then Ekind (S) /= E_Function
                         then
                            Set_Etype (N, Etype (S));
+
                         else
                            Error_Msg_Name_1 := Chars (S);
                            Error_Msg_Sloc := Sloc (S);
@@ -14317,8 +14256,7 @@ package body Sem_Util is
                   --  or container is also modified.
 
                   if Ada_Version >= Ada_2012
-                    and then
-                      Nkind (Parent (Ent)) = N_Iterator_Specification
+                    and then Nkind (Parent (Ent)) = N_Iterator_Specification
                   then
                      declare
                         Domain : constant Node_Id := Name (Parent (Ent));
@@ -14409,10 +14347,9 @@ package body Sem_Util is
 
       function Is_Interface_Conversion (N : Node_Id) return Boolean is
       begin
-         return
-           Nkind (N) = N_Unchecked_Type_Conversion
-             and then Nkind (Expression (N)) = N_Attribute_Reference
-             and then Attribute_Name (Expression (N)) = Name_Address;
+         return Nkind (N) = N_Unchecked_Type_Conversion
+           and then Nkind (Expression (N)) = N_Attribute_Reference
+           and then Attribute_Name (Expression (N)) = Name_Address;
       end Is_Interface_Conversion;
 
       ------------------
@@ -14786,9 +14723,7 @@ package body Sem_Util is
             return Any_Type;
          end if;
 
-         if Is_Private_Type (Btype)
-           and then not Is_Generic_Type (Btype)
-         then
+         if Is_Private_Type (Btype) and then not Is_Generic_Type (Btype) then
             if Present (Full_View (Btype))
               and then Is_Record_Type (Full_View (Btype))
               and then not Is_Frozen (Btype)
@@ -14875,16 +14810,16 @@ package body Sem_Util is
       return Chars (E1) = Chars (E2)
         or else
            (not Is_Internal_Name (Chars (E1))
-              and then Is_Internal_Name (Chars (E2))
-              and then Non_Internal_Name (E2) = Chars (E1))
+             and then Is_Internal_Name (Chars (E2))
+             and then Non_Internal_Name (E2) = Chars (E1))
         or else
            (not Is_Internal_Name (Chars (E2))
-              and then Is_Internal_Name (Chars (E1))
-              and then Non_Internal_Name (E1) = Chars (E2))
+             and then Is_Internal_Name (Chars (E1))
+             and then Non_Internal_Name (E1) = Chars (E2))
         or else
            (Is_Predefined_Dispatching_Operation (E1)
-              and then Is_Predefined_Dispatching_Operation (E2)
-              and then Same_TSS (E1, E2))
+             and then Is_Predefined_Dispatching_Operation (E2)
+             and then Same_TSS (E1, E2))
         or else
            (Is_Init_Proc (E1) and then Is_Init_Proc (E2));
    end Primitive_Names_Match;
@@ -15484,12 +15419,7 @@ package body Sem_Util is
       --  For conditionals, we also allow loop parameters and all formals,
       --  including in parameters.
 
-      elsif Cond
-        and then
-          (Ekind (Ent) = E_Loop_Parameter
-             or else
-           Ekind (Ent) = E_In_Parameter)
-      then
+      elsif Cond and then Ekind_In (Ent, E_Loop_Parameter, E_In_Parameter) then
          null;
 
       --  For all other cases, not just unsafe, but impossible to capture
@@ -15511,7 +15441,7 @@ package body Sem_Util is
         or else Present (Address_Clause (Ent))
         or else Address_Taken (Ent)
         or else (Is_Library_Level_Entity (Ent)
-                   and then Ekind (Ent) = E_Variable)
+                  and then Ekind (Ent) = E_Variable)
       then
          return False;
       end if;
@@ -15560,9 +15490,9 @@ package body Sem_Util is
             if         Nkind (P) = N_If_Statement
               or else  Nkind (P) = N_Case_Statement
               or else (Nkind (P) in N_Short_Circuit
-                         and then Desc = Right_Opnd (P))
+                        and then Desc = Right_Opnd (P))
               or else (Nkind (P) = N_If_Expression
-                         and then Desc /= First (Expressions (P)))
+                        and then Desc /= First (Expressions (P)))
               or else  Nkind (P) = N_Exception_Handler
               or else  Nkind (P) = N_Selective_Accept
               or else  Nkind (P) = N_Conditional_Entry_Call
@@ -15570,9 +15500,10 @@ package body Sem_Util is
               or else  Nkind (P) = N_Asynchronous_Select
             then
                return False;
+
             else
                Desc := P;
-               P    := Parent (P);
+               P := Parent (P);
 
                --  A special Ada 2012 case: the original node may be part
                --  of the else_actions of a conditional expression, in which
@@ -15908,9 +15839,7 @@ package body Sem_Util is
 
       procedure Set_Debug_Info_Needed_If_Not_Set (E : Entity_Id) is
       begin
-         if Present (E)
-           and then not Needs_Debug_Info (E)
-         then
+         if Present (E) and then not Needs_Debug_Info (E) then
             Set_Debug_Info_Needed (E);
 
             --  For a private type, indicate that the full view also needs
@@ -16540,12 +16469,9 @@ package body Sem_Util is
          if not Is_Public (Ent) then
             Set_Public_Status (Ent);
 
-            if Is_Public (Ent)
-              and then Ekind (Ent) = E_Record_Subtype
+            if Is_Public (Ent) and then Ekind (Ent) = E_Record_Subtype then
 
-            then
-               --  The components of the propagated Itype must be public
-               --  as well.
+               --  The components of the propagated Itype must also be public
 
                declare
                   Comp : Entity_Id;
@@ -16608,7 +16534,7 @@ package body Sem_Util is
               or else
                 (Is_Itype (Btyp)
                   and then Nkind (Associated_Node_For_Itype (Btyp)) =
-                             N_Object_Declaration
+                                                         N_Object_Declaration
                   and then Is_Return_Object
                              (Defining_Identifier
                                 (Associated_Node_For_Itype (Btyp))))
@@ -16730,9 +16656,7 @@ package body Sem_Util is
             return Empty;
          end;
 
-      elsif Is_Private_Type (T)
-        and then Present (Full_View (T))
-      then
+      elsif Is_Private_Type (T) and then Present (Full_View (T)) then
          return Type_Without_Stream_Operation (Full_View (T), Op);
       else
          return Empty;
@@ -17032,8 +16956,7 @@ package body Sem_Util is
       Elmt   : Elmt_Id;
 
    begin
-      pragma Assert (Is_Record_Type (Typ)
-        and then Is_Tagged_Type (Typ));
+      pragma Assert (Is_Record_Type (Typ) and then Is_Tagged_Type (Typ));
 
       --  Collect all the parents and progenitors of Typ. If the full-view of
       --  private parents and progenitors is available then it is used to
@@ -17133,8 +17056,7 @@ package body Sem_Util is
 
          if Is_Array_Type (Expec_Type)
            and then Number_Dimensions (Expec_Type) = 1
-           and then
-             Covers (Etype (Component_Type (Expec_Type)), Found_Type)
+           and then Covers (Etype (Component_Type (Expec_Type)), Found_Type)
          then
             --  Use type name if available. This excludes multidimensional
             --  arrays and anonymous arrays.
@@ -17284,9 +17206,7 @@ package body Sem_Util is
 
       elsif Is_Integer_Type (Expec_Type)
         and then Is_RTE (Found_Type, RE_Address)
-        and then (Nkind (Parent (Expr)) = N_Op_Add
-                    or else
-                  Nkind (Parent (Expr)) = N_Op_Subtract)
+        and then Nkind_In (Parent (Expr), N_Op_Add, N_Op_Subtract)
         and then Expr = Left_Opnd (Parent (Expr))
         and then Is_Integer_Type (Etype (Right_Opnd (Parent (Expr))))
       then
@@ -17376,10 +17296,7 @@ package body Sem_Util is
             Error_Msg_N ("\\found package name!", Expr);
 
          elsif Is_Entity_Name (Expr)
-           and then
-             (Ekind (Entity (Expr)) = E_Procedure
-                or else
-              Ekind (Entity (Expr)) = E_Generic_Procedure)
+           and then Ekind_In (Entity (Expr), E_Procedure, E_Generic_Procedure)
          then
             if Ekind (Expec_Type) = E_Access_Subprogram_Type then
                Error_Msg_N
index d696341..8140f61 100644 (file)
@@ -444,6 +444,11 @@ package Sem_Util is
    --  specification. If the declaration has a defining unit name, then the
    --  defining entity is obtained from the defining unit name ignoring any
    --  child unit prefixes.
+   --
+   --  Iterator loops also have a defining entity, which holds the list of
+   --  local entities declared during loop expansion. These entities need
+   --  debugging information, generated through QUalify_Entity_Names, and
+   --  the loop declaration must be placed in the table Name_Qualify_Units.
 
    function Denotes_Discriminant
      (N                : Node_Id;