diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-07-30 17:17:50 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-07-30 17:17:50 +0200 |
commit | ea2af26ac9d3ed57ffbd4ae28538c8f51ba63536 (patch) | |
tree | cc310e9db2f48762bb7ae1fb5ca93405bbe61466 | |
parent | 29ba9f52eee2ab585349ba71850bf9e0e5c86d3c (diff) | |
download | gcc-ea2af26ac9d3ed57ffbd4ae28538c8f51ba63536.zip gcc-ea2af26ac9d3ed57ffbd4ae28538c8f51ba63536.tar.gz gcc-ea2af26ac9d3ed57ffbd4ae28538c8f51ba63536.tar.bz2 |
[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
-rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
-rw-r--r-- | gcc/ada/bindusg.adb | 4 | ||||
-rw-r--r-- | gcc/ada/freeze.adb | 6 | ||||
-rw-r--r-- | gcc/ada/gnatcmd.adb | 14 | ||||
-rw-r--r-- | gcc/ada/make.adb | 30 | ||||
-rw-r--r-- | gcc/ada/makeutl.adb | 30 | ||||
-rw-r--r-- | gcc/ada/makeutl.ads | 17 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 10 |
8 files changed, 79 insertions, 50 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 19dbf07..aa72155 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +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, diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index 23840d3..6b1751b 100644 --- a/gcc/ada/bindusg.adb +++ b/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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index f2f7ac9..bd677d9 100644 --- a/gcc/ada/freeze.adb +++ b/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) diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 8798399..bf3bfcf 100644 --- a/gcc/ada/gnatcmd.adb +++ b/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; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 0eed65d..d45ee14 100644 --- a/gcc/ada/make.adb +++ b/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); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index bc3a0ee..253e8db 100644 --- a/gcc/ada/makeutl.adb +++ b/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 -- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 3ddb208..693fafc 100644 --- a/gcc/ada/makeutl.ads +++ b/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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 0f2d254..60edce3 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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; |