[multiple changes]

2012-07-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch12.adb (Earlier): Add local variables T1 and T2. Minor code
	refactoring.

2012-07-30  Thomas Quinot  <quinot@adacore.com>

	* gnatcmd.adb, make.adb, makeutl.adb, makeutl.ads
	(Test_If_Relative_Path): Rename to Ensure_Absolute_Path to better
	reflect what this subprogram does. Rename argument Including_L_Switch
	to For_Gnatbind, and also exempt -A from rewriting.
	* bindusg.adb: Document optional =file argument to gnatbind -A.

2012-07-30  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Entity): Do no apply restriction check on
	storage pools to access to subprogram types.

From-SVN: r189978

gcc/ada/ChangeLog

+2012-07-30  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch12.adb (Earlier): Add local variables T1 and T2. Minor code
+	refactoring.
+
+2012-07-30  Thomas Quinot  <quinot@adacore.com>
+
+	* gnatcmd.adb, make.adb, makeutl.adb, makeutl.ads
+	(Test_If_Relative_Path): Rename to Ensure_Absolute_Path to better
+	reflect what this subprogram does. Rename argument Including_L_Switch
+	to For_Gnatbind, and also exempt -A from rewriting.
+	* bindusg.adb: Document optional =file argument to gnatbind -A.
+
+2012-07-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Entity): Do no apply restriction check on
+	storage pools to access to subprogram types.
+
 2012-07-30  Robert Dewar  <dewar@adacore.com>
 
 	* par_sco.adb, a-cihama.adb, a-coinve.adb, exp_ch7.adb, a-ciorse.adb,

gcc/ada/bindusg.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -78,7 +78,7 @@ package body Bindusg is
 
       --  Line for -A switch
 
-      Write_Line ("  -A        Give list of ALI files in partition");
+      Write_Line ("  -A[=file] Give list of ALI files in partition");
 
       --  Line for -b switch
 

gcc/ada/freeze.adb

@@ -4201,12 +4201,16 @@ package body Freeze is
                Check_Suspicious_Modulus (E);
             end if;
 
-         elsif Is_Access_Type (E) then
+         elsif Is_Access_Type (E)
+           and then not Is_Access_Subprogram_Type (E)
+         then
 
             --  If a pragma Default_Storage_Pool applies, and this type has no
             --  Storage_Pool or Storage_Size clause (which must have occurred
             --  before the freezing point), then use the default. This applies
             --  only to base types.
+            --  None of this applies to access to subprogramss, for which there
+            --  are clearly no pools.
 
             if Present (Default_Pool)
               and then Is_Base_Type (E)

gcc/ada/gnatcmd.adb

@@ -273,7 +273,7 @@ procedure GNATCmd is
    --  Add the -L and -l switches to the linker for all of the library
    --  projects.
 
-   procedure Test_If_Relative_Path
+   procedure Ensure_Absolute_Path
      (Switch : in out String_Access;
       Parent : String);
    --  Test if Switch is a relative search path switch. If it is and it
@@ -1303,20 +1303,20 @@ procedure GNATCmd is
    end Set_Library_For;
 
    ---------------------------
-   -- Test_If_Relative_Path --
+   -- Ensure_Absolute_Path --
    ---------------------------
 
-   procedure Test_If_Relative_Path
+   procedure Ensure_Absolute_Path
      (Switch : in out String_Access;
       Parent : String)
    is
    begin
-      Makeutl.Test_If_Relative_Path
+      Makeutl.Ensure_Absolute_Path
         (Switch, Parent,
          Do_Fail              => Osint.Fail'Access,
          Including_Non_Switch => False,
          Including_RTS        => True);
-   end Test_If_Relative_Path;
+   end Ensure_Absolute_Path;
 
    -------------------
    -- Non_VMS_Usage --
@@ -2387,7 +2387,7 @@ begin
             --  arguments.
 
             for J in 1 .. Last_Switches.Last loop
-               GNATCmd.Test_If_Relative_Path
+               GNATCmd.Ensure_Absolute_Path
                  (Last_Switches.Table (J), Current_Work_Dir);
             end loop;
 
@@ -2397,7 +2397,7 @@ begin
                Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
             begin
                for J in 1 .. First_Switches.Last loop
-                  GNATCmd.Test_If_Relative_Path
+                  GNATCmd.Ensure_Absolute_Path
                     (First_Switches.Table (J), Project_Dir);
                end loop;
             end;

gcc/ada/make.adb

@@ -2366,7 +2366,7 @@ package body Make is
                                  Last_New := Last_New + 1;
                                  New_Args (Last_New) :=
                                    new String'(Name_Buffer (1 .. Name_Len));
-                                 Test_If_Relative_Path
+                                 Ensure_Absolute_Path
                                    (New_Args (Last_New),
                                     Do_Fail              => Make_Failed'Access,
                                     Parent               => Dir_Path,
@@ -2399,7 +2399,7 @@ package body Make is
                                         Directory.Display_Name);
 
                      begin
-                        Test_If_Relative_Path
+                        Ensure_Absolute_Path
                           (New_Args (1),
                            Do_Fail              => Make_Failed'Access,
                            Parent               => Dir_Path,
@@ -5028,36 +5028,36 @@ package body Make is
                       Get_Name_String (Main_Project.Directory.Display_Name);
       begin
          for J in 1 .. Binder_Switches.Last loop
-            Test_If_Relative_Path
+            Ensure_Absolute_Path
               (Binder_Switches.Table (J),
                Do_Fail => Make_Failed'Access,
-               Parent => Dir_Path, Including_L_Switch => False);
+               Parent => Dir_Path, For_Gnatbind => True);
          end loop;
 
          for J in 1 .. Saved_Binder_Switches.Last loop
-            Test_If_Relative_Path
+            Ensure_Absolute_Path
               (Saved_Binder_Switches.Table (J),
-               Do_Fail            => Make_Failed'Access,
-               Parent             => Current_Work_Dir,
-               Including_L_Switch => False);
+               Do_Fail             => Make_Failed'Access,
+               Parent              => Current_Work_Dir,
+               For_Gnatbind        => True);
          end loop;
 
          for J in 1 .. Linker_Switches.Last loop
-            Test_If_Relative_Path
+            Ensure_Absolute_Path
               (Linker_Switches.Table (J),
                Parent  => Dir_Path,
                Do_Fail => Make_Failed'Access);
          end loop;
 
          for J in 1 .. Saved_Linker_Switches.Last loop
-            Test_If_Relative_Path
+            Ensure_Absolute_Path
               (Saved_Linker_Switches.Table (J),
                Do_Fail => Make_Failed'Access,
                Parent  => Current_Work_Dir);
          end loop;
 
          for J in 1 .. Gcc_Switches.Last loop
-            Test_If_Relative_Path
+            Ensure_Absolute_Path
               (Gcc_Switches.Table (J),
                Do_Fail              => Make_Failed'Access,
                Parent               => Dir_Path,
@@ -5065,7 +5065,7 @@ package body Make is
          end loop;
 
          for J in 1 .. Saved_Gcc_Switches.Last loop
-            Test_If_Relative_Path
+            Ensure_Absolute_Path
               (Saved_Gcc_Switches.Table (J),
                Parent               => Current_Work_Dir,
                Do_Fail              => Make_Failed'Access,
@@ -5387,14 +5387,14 @@ package body Make is
                  Get_Name_String (Main_Project.Directory.Display_Name);
             begin
                for J in Last_Binder_Switch + 1 .. Binder_Switches.Last loop
-                  Test_If_Relative_Path
+                  Ensure_Absolute_Path
                     (Binder_Switches.Table (J),
                      Do_Fail => Make_Failed'Access,
-                     Parent  => Dir_Path, Including_L_Switch => False);
+                     Parent  => Dir_Path, For_Gnatbind => True);
                end loop;
 
                for J in Last_Linker_Switch + 1 .. Linker_Switches.Last loop
-                  Test_If_Relative_Path
+                  Ensure_Absolute_Path
                     (Linker_Switches.Table (J),
                      Parent  => Dir_Path,
                      Do_Fail => Make_Failed'Access);

gcc/ada/makeutl.adb

@@ -1316,11 +1316,12 @@ package body Makeutl is
                   --  Object files and -L switches specified with relative
                   --  paths must be converted to absolute paths.
 
-                  Test_If_Relative_Path
-                    (Switch  => Linker_Options_Buffer (Last_Linker_Option),
-                     Parent  => Dir_Path,
-                     Do_Fail => Do_Fail,
-                     Including_L_Switch => True);
+                  Ensure_Absolute_Path
+                    (Switch       =>
+                       Linker_Options_Buffer (Last_Linker_Option),
+                     Parent       => Dir_Path,
+                     Do_Fail      => Do_Fail,
+                     For_Gnatbind => False);
                end if;
 
                Options := In_Tree.Shared.String_Elements.Table (Options).Next;
@@ -1936,14 +1937,14 @@ package body Makeutl is
    end Path_Or_File_Name;
 
    ---------------------------
-   -- Test_If_Relative_Path --
+   -- Ensure_Absolute_Path --
    ---------------------------
 
-   procedure Test_If_Relative_Path
+   procedure Ensure_Absolute_Path
      (Switch               : in out String_Access;
       Parent               : String;
       Do_Fail              : Fail_Proc;
-      Including_L_Switch   : Boolean := True;
+      For_Gnatbind         : Boolean := False;
       Including_Non_Switch : Boolean := True;
       Including_RTS        : Boolean := False)
    is
@@ -1958,9 +1959,10 @@ package body Makeutl is
 
             if Sw (1) = '-' then
                if Sw'Length >= 3
-                 and then (Sw (2) = 'A'
-                            or else Sw (2) = 'I'
-                            or else (Including_L_Switch and then Sw (2) = 'L'))
+                 and then (Sw (2) = 'I'
+                            or else (not For_Gnatbind
+                                       and then (Sw (2) = 'L'
+                                         or else Sw (2) = 'A')))
                then
                   Start := 3;
 
@@ -1973,7 +1975,9 @@ package body Makeutl is
                              or else
                            Sw (2 .. 3) = "aO"
                              or else
-                           Sw (2 .. 3) = "aI")
+                           Sw (2 .. 3) = "aI"
+                             or else
+                           (For_Gnatbind and then Sw (2 .. 3) = "A="))
                then
                   Start := 4;
 
@@ -2033,7 +2037,7 @@ package body Makeutl is
             end if;
          end;
       end if;
-   end Test_If_Relative_Path;
+   end Ensure_Absolute_Path;
 
    -------------------
    -- Unit_Index_Of --

gcc/ada/makeutl.ads

@@ -235,20 +235,19 @@ package Makeutl is
    --  Find the index of a unit in a source file. Return zero if the file is
    --  not a multi-unit source file.
 
-   procedure Test_If_Relative_Path
+   procedure Ensure_Absolute_Path
      (Switch               : in out String_Access;
       Parent               : String;
       Do_Fail              : Fail_Proc;
-      Including_L_Switch   : Boolean := True;
+      For_Gnatbind         : Boolean := False;
       Including_Non_Switch : Boolean := True;
       Including_RTS        : Boolean := False);
-   --  Test if Switch is a relative search path switch. If so, fail if Parent
-   --  is the empty string, otherwise prepend the path with Parent. This
-   --  subprogram is only used when using project files. For gnatbind switches,
-   --  Including_L_Switch is False, because the argument of the -L switch is
-   --  not a path. If Including_RTS is True, process also switches --RTS=.
-   --  Do_Fail is called in case of error. Using Osint.Fail might be
-   --  appropriate.
+   --  Do nothing if Switch is an absolute path switch. If relative, fail if
+   --  Parent is the empty string, otherwise prepend the path with Parent. This
+   --  subprogram is only used when using project files. If For_Gnatbind is
+   --  True, gnatbind switches that are not paths (-L, -A) are left unchaned.
+   --  If Including_RTS is True, process also switches --RTS=. Do_Fail is
+   --  called in case of error. Using Osint.Fail might be appropriate.
 
    function Path_Or_File_Name (Path : Path_Name_Type) return String;
    --  Returns a file name if -df is used, otherwise return a path name

gcc/ada/sem_ch12.adb

@@ -7068,6 +7068,8 @@ package body Sem_Ch12 is
       D2 : Integer := 0;
       P1 : Node_Id := N1;
       P2 : Node_Id := N2;
+      T1 : Source_Ptr;
+      T2 : Source_Ptr;
 
    --  Start of processing for Earlier
 
@@ -7208,19 +7210,21 @@ package body Sem_Ch12 is
       --  At this point either both nodes came from source or we approximated
       --  their source locations through neighbouring source statements.
 
+      T1 := Top_Level_Location (Sloc (P1));
+      T2 := Top_Level_Location (Sloc (P2));
+
       --  When two nodes come from the same instance, they have identical top
       --  level locations. To determine proper relation within the tree, check
       --  their locations within the template.
 
-      if Top_Level_Location (Sloc (P1)) = Top_Level_Location (Sloc (P2)) then
+      if T1 = T2 then
          return Sloc (P1) < Sloc (P2);
 
       --  The two nodes either come from unrelated instances or do not come
       --  from instantiated code at all.
 
       else
-         return Top_Level_Location (Sloc (P1))
-              < Top_Level_Location (Sloc (P2));
+         return T1 < T2;
       end if;
    end Earlier;