]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Thu, 21 Apr 2016 08:19:35 +0000 (10:19 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 21 Apr 2016 08:19:35 +0000 (10:19 +0200)
2016-04-21  Hristian Kirtchev  <kirtchev@adacore.com>

* sem_ch3.adb, exp_util.adb, sem_ch13.adb, exp_unst.adb: Minor
reformatting.

2016-04-21  Ed Schonberg  <schonberg@adacore.com>

* sem_util.adb (Denotes_Iterator): Use root type to determine
whether the ultimate ancestor is the predefined iterator
interface pakage.
* exp_ch5.adb (Expand_Iterator_Over_Container): simplify code
and avoid reuse of Pack local variable.

2016-04-21  Olivier Hainque  <hainque@adacore.com>

* system-vxworks-arm.ads, system-vxworks-sparcv9.ads,
system-vxworks-ppc.ads, system-vxworks-m68k.ads,
system-vxworks-mips.ads, system-vxworks-x86.ads: Define
Executable_Extension to ".out".

From-SVN: r235304

13 files changed:
gcc/ada/ChangeLog
gcc/ada/exp_ch5.adb
gcc/ada/exp_unst.adb
gcc/ada/exp_util.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_util.adb
gcc/ada/system-vxworks-arm.ads
gcc/ada/system-vxworks-m68k.ads
gcc/ada/system-vxworks-mips.ads
gcc/ada/system-vxworks-ppc.ads
gcc/ada/system-vxworks-sparcv9.ads
gcc/ada/system-vxworks-x86.ads

index 917345be9a6c65fa1fa59421f8e864985c0819a2..8ba447ef9d5d6426d164f9cfa87af9fd09a554e2 100644 (file)
@@ -1,3 +1,23 @@
+2016-04-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_ch3.adb, exp_util.adb, sem_ch13.adb, exp_unst.adb: Minor
+       reformatting.
+
+2016-04-21  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_util.adb (Denotes_Iterator): Use root type to determine
+       whether the ultimate ancestor is the predefined iterator
+       interface pakage.
+       * exp_ch5.adb (Expand_Iterator_Over_Container): simplify code
+       and avoid reuse of Pack local variable.
+
+2016-04-21  Olivier Hainque  <hainque@adacore.com>
+
+       * system-vxworks-arm.ads, system-vxworks-sparcv9.ads,
+       system-vxworks-ppc.ads, system-vxworks-m68k.ads,
+       system-vxworks-mips.ads, system-vxworks-x86.ads: Define
+       Executable_Extension to ".out".
+
 2016-04-21  Javier Miranda  <miranda@adacore.com>
 
        * frontend.adb: Update call to Unnest_Subprograms.
index 139f5ca3ae24a6c539289997e098bf0e140e34ad..2f7e5d1dad9926dd1df8166d501ba183cc2bb6cd 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -3605,25 +3605,31 @@ package body Exp_Ch5 is
       Container     : Node_Id;
       Container_Typ : Entity_Id)
    is
-      Id  : constant Entity_Id  := Defining_Identifier (I_Spec);
-      Loc : constant Source_Ptr := Sloc (N);
-
-      I_Kind   : constant Entity_Kind := Ekind (Id);
-      Cursor   : Entity_Id;
-      Iterator : Entity_Id;
-      New_Loop : Node_Id;
-      Stats    : constant List_Id := Statements (N);
+      Id       : constant Entity_Id   := Defining_Identifier (I_Spec);
+      Elem_Typ : constant Entity_Id   := Etype (Id);
+      Id_Kind  : constant Entity_Kind := Ekind (Id);
+      Loc      : constant Source_Ptr  := Sloc (N);
+      Stats    : constant List_Id     := Statements (N);
 
-      Element_Type : constant Entity_Id := Etype (Id);
-      Iter_Type    : Entity_Id;
-      Pack         : Entity_Id;
-      Decl         : Node_Id;
-      Name_Init    : Name_Id;
-      Name_Step    : Name_Id;
+      Cursor    : Entity_Id;
+      Decl      : Node_Id;
+      Iter_Type : Entity_Id;
+      Iterator  : Entity_Id;
+      Name_Init : Name_Id;
+      Name_Step : Name_Id;
+      New_Loop  : Node_Id;
 
-      Fast_Element_Access_Op, Fast_Step_Op : Entity_Id := Empty;
+      Fast_Element_Access_Op : Entity_Id := Empty;
+      Fast_Step_Op           : Entity_Id := Empty;
       --  Only for optimized version of "for ... of"
 
+      Iter_Pack : Entity_Id;
+      --  The package in which the iterator interface is instantiated. This is
+      --  typically an instance within the container package.
+
+      Pack : Entity_Id;
+      --  The package in which the container type is declared
+
    begin
       --  Determine the advancement and initialization steps for the cursor.
       --  Analysis of the expanded loop will verify that the container has a
@@ -3658,8 +3664,6 @@ package body Exp_Ch5 is
          Pack := Scope (Container_Typ);
       end if;
 
-      Iter_Type := Etype (Name (I_Spec));
-
       if Of_Present (I_Spec) then
          Handle_Of : declare
             Container_Arg : Node_Id;
@@ -3734,6 +3738,8 @@ package body Exp_Ch5 is
                end if;
             end Get_Default_Iterator;
 
+            --  Local variables
+
             Default_Iter : Entity_Id;
             Ent          : Entity_Id;
 
@@ -3760,6 +3766,12 @@ package body Exp_Ch5 is
 
             Iter_Type := Etype (Default_Iter);
 
+            --  The iterator type, which is a class-wide type, may itself be
+            --  derived locally, so the desired instantiation is the scope of
+            --  the root type of the iterator type.
+
+            Iter_Pack := Scope (Root_Type (Etype (Iter_Type)));
+
             --  Find declarations needed for "for ... of" optimization
 
             Ent := First_Entity (Pack);
@@ -3798,28 +3810,35 @@ package body Exp_Ch5 is
                          New_List (New_Copy_Tree (Container_Arg)))));
             end if;
 
-            --  The iterator type, which is a class-wide type, may itself be
-            --  derived locally, so the desired instantiation is the scope of
-            --  the root type of the iterator type. Currently, Pack is the
-            --  container instance; this overwrites it with the iterator
-            --  package.
+            --  Rewrite domain of iteration as a call to the default iterator
+            --  for the container type. The formal may be an access parameter
+            --  in which case we must build a reference to the container.
 
-            Pack := Scope (Root_Type (Etype (Iter_Type)));
+            declare
+               Arg : Node_Id;
+            begin
+               if Is_Access_Type (Etype (First_Entity (Default_Iter))) then
+                  Arg :=
+                    Make_Attribute_Reference (Loc,
+                      Prefix         => Container_Arg,
+                      Attribute_Name => Name_Unrestricted_Access);
+               else
+                  Arg := Container_Arg;
+               end if;
 
-            --  Rewrite domain of iteration as a call to the default iterator
-            --  for the container type.
+               Rewrite (Name (I_Spec),
+                 Make_Function_Call (Loc,
+                   Name                   =>
+                     New_Occurrence_Of (Default_Iter, Loc),
+                   Parameter_Associations => New_List (Arg)));
+            end;
 
-            Rewrite (Name (I_Spec),
-              Make_Function_Call (Loc,
-                Name                   =>
-                  New_Occurrence_Of (Default_Iter, Loc),
-                Parameter_Associations => New_List (Container_Arg)));
             Analyze_And_Resolve (Name (I_Spec));
 
             --  Find cursor type in proper iterator package, which is an
             --  instantiation of Iterator_Interfaces.
 
-            Ent := First_Entity (Pack);
+            Ent := First_Entity (Iter_Pack);
             while Present (Ent) loop
                if Chars (Ent) = Name_Cursor then
                   Set_Etype (Cursor, Etype (Ent));
@@ -3834,7 +3853,7 @@ package body Exp_Ch5 is
                  Make_Object_Renaming_Declaration (Loc,
                    Defining_Identifier => Id,
                    Subtype_Mark        =>
-                     New_Occurrence_Of (Element_Type, Loc),
+                     New_Occurrence_Of (Elem_Typ, Loc),
                    Name                =>
                      Make_Explicit_Dereference (Loc,
                        Prefix =>
@@ -3849,7 +3868,7 @@ package body Exp_Ch5 is
                  Make_Object_Renaming_Declaration (Loc,
                    Defining_Identifier => Id,
                    Subtype_Mark        =>
-                     New_Occurrence_Of (Element_Type, Loc),
+                     New_Occurrence_Of (Elem_Typ, Loc),
                    Name                =>
                      Make_Indexed_Component (Loc,
                        Prefix      => Relocate_Node (Container_Arg),
@@ -3857,8 +3876,8 @@ package body Exp_Ch5 is
                          New_List (New_Occurrence_Of (Cursor, Loc))));
             end if;
 
-            --  The defining identifier in the iterator is user-visible
-            --  and must be visible in the debugger.
+            --  The defining identifier in the iterator is user-visible and
+            --  must be visible in the debugger.
 
             Set_Debug_Info_Needed (Id);
 
@@ -3878,18 +3897,25 @@ package body Exp_Ch5 is
             Prepend_To (Stats, Decl);
          end Handle_Of;
 
-      --  X in Iterate (S) : type of iterator is type of explicitly
-      --  given Iterate function, and the loop variable is the cursor.
-      --  It will be assigned in the loop and must be a variable.
+      --  X in Iterate (S) : type of iterator is type of explicitly given
+      --  Iterate function, and the loop variable is the cursor. It will be
+      --  assigned in the loop and must be a variable.
 
       else
+         Iter_Type := Etype (Name (I_Spec));
+
+         --  The iterator type, which is a class-wide type, may itself be
+         --  derived locally, so the desired instantiation is the scope of
+         --  the root type of the iterator type, as in the "of" case.
+
+         Iter_Pack := Scope (Root_Type (Etype (Iter_Type)));
          Cursor := Id;
       end if;
 
       Iterator := Make_Temporary (Loc, 'I');
 
-      --  For both iterator forms, add a call to the step operation to
-      --  advance the cursor. Generate:
+      --  For both iterator forms, add a call to the step operation to advance
+      --  the cursor. Generate:
 
       --     Cursor := Iterator.Next (Cursor);
 
@@ -3899,8 +3925,9 @@ package body Exp_Ch5 is
 
       if Present (Fast_Element_Access_Op) and then Present (Fast_Step_Op) then
          declare
-            Step_Call : Node_Id;
             Curs_Name : constant Node_Id := New_Occurrence_Of (Cursor, Loc);
+            Step_Call : Node_Id;
+
          begin
             Step_Call :=
               Make_Procedure_Call_Statement (Loc,
@@ -3948,16 +3975,16 @@ package body Exp_Ch5 is
               Condition =>
                 Make_Function_Call (Loc,
                   Name                   =>
-                    New_Occurrence_Of (
-                     Next_Entity (First_Entity (Pack)), Loc),
-                  Parameter_Associations =>
-                    New_List (New_Occurrence_Of (Cursor, Loc)))),
+                    New_Occurrence_Of
+                      (Next_Entity (First_Entity (Iter_Pack)), Loc),
+                  Parameter_Associations => New_List (
+                    New_Occurrence_Of (Cursor, Loc)))),
 
           Statements => Stats,
           End_Label  => Empty);
 
-      --  If present, preserve identifier of loop, which can be used in
-      --  an exit statement in the body.
+      --  If present, preserve identifier of loop, which can be used in an exit
+      --  statement in the body.
 
       if Present (Identifier (N)) then
          Set_Identifier (New_Loop, Relocate_Node (Identifier (N)));
@@ -3971,22 +3998,23 @@ package body Exp_Ch5 is
       Insert_Action (N,
         Make_Object_Renaming_Declaration (Loc,
           Defining_Identifier => Iterator,
-          Subtype_Mark  => New_Occurrence_Of (Iter_Type, Loc),
-          Name          => Relocate_Node (Name (I_Spec))));
+          Subtype_Mark        => New_Occurrence_Of (Iter_Type, Loc),
+          Name                => Relocate_Node (Name (I_Spec))));
 
       --  Create declaration for cursor
 
       declare
          Cursor_Decl : constant Node_Id :=
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Cursor,
-             Object_Definition   =>
-               New_Occurrence_Of (Etype (Cursor), Loc),
-             Expression          =>
-               Make_Selected_Component (Loc,
-                 Prefix        => New_Occurrence_Of (Iterator, Loc),
-                 Selector_Name =>
-                   Make_Identifier (Loc, Name_Init)));
+                         Make_Object_Declaration (Loc,
+                           Defining_Identifier => Cursor,
+                           Object_Definition   =>
+                             New_Occurrence_Of (Etype (Cursor), Loc),
+                           Expression          =>
+                             Make_Selected_Component (Loc,
+                               Prefix        =>
+                                 New_Occurrence_Of (Iterator, Loc),
+                               Selector_Name =>
+                                 Make_Identifier (Loc, Name_Init)));
 
       begin
          --  The cursor is only modified in expanded code, so it appears
@@ -3999,7 +4027,7 @@ package body Exp_Ch5 is
          Set_Assignment_OK (Cursor_Decl);
 
          Insert_Action (N, Cursor_Decl);
-         Set_Ekind (Cursor, I_Kind);
+         Set_Ekind (Cursor, Id_Kind);
       end;
 
       --  If the range of iteration is given by a function call that returns
index d5eb07d4383e4cad9f2371490061815f800fc52b..d1475e7d1eadf641e937a6b3da5e482b9bec89ae 100644 (file)
@@ -1721,7 +1721,6 @@ package body Exp_Unst is
    ------------------------
 
    procedure Unnest_Subprograms (N : Node_Id) is
-
       function Search_Subprograms (N : Node_Id) return Traverse_Result;
       --  Tree visitor that search for outer level procedures with nested
       --  subprograms and invokes Unnest_Subprogram()
@@ -1732,9 +1731,7 @@ package body Exp_Unst is
 
       function Search_Subprograms (N : Node_Id) return Traverse_Result is
       begin
-         if Nkind_In (N, N_Subprogram_Body,
-                         N_Subprogram_Body_Stub)
-         then
+         if Nkind_In (N, N_Subprogram_Body, N_Subprogram_Body_Stub) then
             declare
                Spec_Id : constant Entity_Id := Unique_Defining_Entity (N);
 
index b78907632243a8de3cf6dee4503317884cd09dde..52f5157e40cca726389a06a13a74e9fbd847c41f 100644 (file)
@@ -1728,11 +1728,12 @@ package body Exp_Util is
    ----------------------------------------
 
    function Containing_Package_With_Ext_Axioms
-     (E : Entity_Id) return Entity_Id is
+     (E : Entity_Id) return Entity_Id
+   is
    begin
       --  E is the package or generic package which is externally axiomatized
 
-      if Ekind_In (E, E_Package, E_Generic_Package)
+      if Ekind_In (E, E_Generic_Package, E_Package)
         and then Has_Annotate_Pragma_For_External_Axiomatization (E)
       then
          return E;
@@ -1758,6 +1759,7 @@ package body Exp_Util is
          declare
             Par  : constant Node_Id := Parent (E);
             Decl : Node_Id;
+
          begin
             if Nkind (Par) = N_Defining_Program_Unit_Name then
                Decl := Parent (Par);
index 57e4c8dcb81a24e5355a506bf2277ccae30aa8b5..777964e2d3d0e267aefb4a4e3bf7c20a69a78b22 100644 (file)
@@ -8438,11 +8438,11 @@ package body Sem_Ch13 is
       --  Entity for argument of separate Predicate procedure when exceptions
       --  are present in expression.
 
-      FDecl         : Node_Id;
-      --  The function declaration.
+      FDecl : Node_Id;
+      --  The function declaration
 
-      SId            : Entity_Id;
-      --  Its entity.
+      SId : Entity_Id;
+      --  Its entity
 
       Raise_Expression_Present : Boolean := False;
       --  Set True if Expr has at least one Raise_Expression
@@ -8725,6 +8725,7 @@ package body Sem_Ch13 is
             Add_Call (Atyp);
          end if;
       end;
+
       --  Add Predicates for the current type
 
       Add_Predicates;
@@ -8842,7 +8843,7 @@ package body Sem_Ch13 is
                Insert_Before_And_Analyze (N, FDecl);
             end if;
 
-            Insert_After_And_Analyze  (N, FBody);
+            Insert_After_And_Analyze (N, FBody);
 
             --  Static predicate functions are always side-effect free, and
             --  in most cases dynamic predicate functions are as well. Mark
@@ -9065,7 +9066,8 @@ package body Sem_Ch13 is
       Loc : constant Source_Ptr := Sloc (Typ);
 
       Object_Entity : constant Entity_Id :=
-              Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('I'));
+                        Make_Defining_Identifier (Loc,
+                          Chars => New_Internal_Name ('I'));
 
       --  The formal parameter of the function
 
@@ -12613,9 +12615,10 @@ package body Sem_Ch13 is
             then
                Find_Selected_Component (Parent (N));
             end if;
+
             return Skip;
 
-         elsif Nkind (N) = N_Identifier and then  Chars (N) /= Chars (E) then
+         elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
             Find_Direct_Name (N);
             Set_Entity (N, Empty);
          end if;
@@ -12625,6 +12628,8 @@ package body Sem_Ch13 is
 
       procedure Resolve_Aspect_Expression is new Traverse_Proc (Resolve_Name);
 
+   --  Start of processing for Resolve_Aspect_Expressions
+
    begin
       ASN := First_Rep_Item (E);
       while Present (ASN) loop
@@ -12637,7 +12642,7 @@ package body Sem_Ch13 is
                --  subprograms, or that may mention current instances of
                --  types. These will require special handling (???TBD).
 
-               when Aspect_Predicate |
+               when Aspect_Predicate         |
                     Aspect_Predicate_Failure |
                     Aspect_Invariant =>
                   null;
@@ -12645,13 +12650,13 @@ package body Sem_Ch13 is
                when Aspect_Static_Predicate |
                     Aspect_Dynamic_Predicate =>
 
-                  --  build predicate function specification and preanalyze
+                  --  Build predicate function specification and preanalyze
                   --  expression after type replacement.
 
                   if No (Predicate_Function (E)) then
                      declare
                         FDecl : constant Node_Id :=
-                           Build_Predicate_Function_Declaration (E);
+                                  Build_Predicate_Function_Declaration (E);
                         pragma Unreferenced (FDecl);
                      begin
                         Resolve_Aspect_Expression (Expr);
index 71af299777db902b755b5a809921a036d6f0514f..615a7d25e75bdb2e2c0d35e1dae4b5aa74db59cd 100644 (file)
@@ -11826,8 +11826,9 @@ package body Sem_Ch3 is
 
       if Has_Predicates (Priv) then
          Set_Has_Predicates (Full);
+
          if Present (Predicate_Function (Priv))
-            and then No (Predicate_Function (Full))
+           and then No (Predicate_Function (Full))
          then
             Set_Predicate_Function (Full, Predicate_Function (Priv));
          end if;
index ac4e8c2a39a2eaa824f83c5e16d00935658a3f89..0702cc71970af1f6b05368b2cf6cd53c744b07e2 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -12650,11 +12650,14 @@ package body Sem_Util is
 
       function Denotes_Iterator (Iter_Typ : Entity_Id) return Boolean is
       begin
+         --  Check that the name matches, and that the ultimate ancestor is in
+         --  a predefined unit, i.e the one that declares iterator interfaces.
+
          return
            Nam_In (Chars (Iter_Typ), Name_Forward_Iterator,
                                      Name_Reversible_Iterator)
              and then Is_Predefined_File_Name
-                        (Unit_File_Name (Get_Source_Unit (Iter_Typ)));
+                     (Unit_File_Name (Get_Source_Unit (Root_Type (Iter_Typ))));
       end Denotes_Iterator;
 
       --  Local variables
index c3b429f9cbd262bf3633da172b97c154cbf73db9..16cd2b0d5a21584bdcd758811a5568aad20f9c15 100644 (file)
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (VxWorks Version ARM)                           --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -161,4 +161,6 @@ private
    Frontend_Exceptions       : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
 
+   Executable_Extension : constant String := ".out";
+
 end System;
index ca59e7a9d9ba3693e89458ae4f97b23118cf8db7..1fab781a7da16bf4f7c88cdc31e7e59285f5098d 100644 (file)
@@ -157,4 +157,6 @@ private
    Frontend_Exceptions       : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
 
+   Executable_Extension : constant String := ".out";
+
 end System;
index d4860f42daf4efcc7ecd6feaa3310a2b866ef6ce..5cba6cd932b923fdfa1bb0257b102e3125ec1491 100644 (file)
@@ -157,4 +157,6 @@ private
    Frontend_Exceptions       : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
 
+   Executable_Extension : constant String := ".out";
+
 end System;
index bb27ee4b99330781cb5fcb895d6072ee4c96b471..ea2eff982325bac3ccf15a506e76d9d6562d2cf5 100644 (file)
@@ -164,4 +164,6 @@ private
    Frontend_Exceptions       : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
 
+   Executable_Extension : constant String := ".out";
+
 end System;
index f3caca4fea93a2ecb281e7ad471d8345aceef760..a7c0b5a0a47a8a693f0e0399ea0de151262d5065 100644 (file)
@@ -159,4 +159,6 @@ private
    Frontend_Exceptions       : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
 
+   Executable_Extension : constant String := ".out";
+
 end System;
index a7508aadfa36bab6ada2c48d526e748832bbac27..22f42f3c6da01c25fe009667e83024d39ec6eacc 100644 (file)
@@ -161,4 +161,6 @@ private
    Frontend_Exceptions       : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
 
+   Executable_Extension : constant String := ".out";
+
 end System;