OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2012-07-30 17:17:50 +02:00
parent 29ba9f52ee
commit ea2af26ac9
8 changed files with 79 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -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,

4
gcc/ada/bindusg.adb
View File

@ -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

6
gcc/ada/freeze.adb
View File

@ -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)

14
gcc/ada/gnatcmd.adb
View File

@ -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;

30
gcc/ada/make.adb
View File

@ -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);

30
gcc/ada/makeutl.adb
View File

@ -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 --

17
gcc/ada/makeutl.ads
View File

@ -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

10
gcc/ada/sem_ch12.adb
View File

@ -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;