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

[multiple changes]

Browse Source 
2010-09-10  Robert Dewar  <dewar@adacore.com>

	* opt.adb (Short_Descriptors): New flag
	(Short_Descriptors_Config): New flag
	* opt.ads (Short_Descriptors): New flag
	(Short_Descriptors_Config): New flag
	* par-prag.adb: Add dummy entry for Short_Descriptors pragma
	* sem_prag.adb (Set_Mechanism_Value): Deal with Short_Descriptors pragma
	(Analyze_Pragma): Implement Short_Descriptors pragma
	* snames.ads-tmpl: Add entry for Short_Descriptors pragma

2010-09-10  Emmanuel Briot  <briot@adacore.com>

	* prj-util.adb, prj-util.ads (Executable_Of): Take into account the
	project's Executable_Suffix.

From-SVN: r164147
This commit is contained in:
Arnaud Charlet 2010-09-10 11:41:06 +02:00
parent e5dc610e6d
commit 292beb8fda
8 changed files with 122 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2010-09-10 Robert Dewar <dewar@adacore.com>
* opt.adb (Short_Descriptors): New flag
(Short_Descriptors_Config): New flag
* opt.ads (Short_Descriptors): New flag
(Short_Descriptors_Config): New flag
* par-prag.adb: Add dummy entry for Short_Descriptors pragma
* sem_prag.adb (Set_Mechanism_Value): Deal with Short_Descriptors pragma
(Analyze_Pragma): Implement Short_Descriptors pragma
* snames.ads-tmpl: Add entry for Short_Descriptors pragma
2010-09-10 Emmanuel Briot <briot@adacore.com>
* prj-util.adb, prj-util.ads (Executable_Of): Take into account the
project's Executable_Suffix.
2010-09-10 Robert Dewar <dewar@adacore.com>
* g-pehage.ads: Minor reformatting

4
gcc/ada/opt.adb
View File

@ -61,6 +61,7 @@ package body Opt is
Optimize_Alignment_Config := Optimize_Alignment;
Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
Polling_Required_Config := Polling_Required;
Short_Descriptors_Config := Short_Descriptors;
Use_VADS_Size_Config := Use_VADS_Size;
-- Reset the indication that Optimize_Alignment was set locally, since
@ -94,6 +95,7 @@ package body Opt is
Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
Polling_Required := Save.Polling_Required;
Short_Descriptors := Save.Short_Descriptors;
Use_VADS_Size := Save.Use_VADS_Size;
end Restore_Opt_Config_Switches;
@ -121,6 +123,7 @@ package body Opt is
Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
Save.Polling_Required := Polling_Required;
Save.Short_Descriptors := Short_Descriptors;
Save.Use_VADS_Size := Use_VADS_Size;
end Save_Opt_Config_Switches;
@ -193,6 +196,7 @@ package body Opt is
Fast_Math := Fast_Math_Config;
Optimize_Alignment := Optimize_Alignment_Config;
Polling_Required := Polling_Required_Config;
Short_Descriptors := Short_Descriptors_Config;
end Set_Opt_Config_Switches;
---------------

14
gcc/ada/opt.ads
View File

@ -1089,7 +1089,12 @@ package Opt is
-- GNAT
-- Set True if a pragma Short_Circuit_And_Or applies to the current unit.
Short_Descriptors : Boolean := False;
-- GNAT
-- Set True if a pragma Short_Descriptors applies to the current unit.
Sprint_Line_Limit : Nat := 72;
-- GNAT
-- Limit values for chopping long lines in Sprint output, can be reset
-- by use of NNN parameter with -gnatG or -gnatD switches.
@ -1651,6 +1656,14 @@ package Opt is
-- flag is used to set the initial value for Polling_Required at the start
-- of analyzing each unit.
Short_Descriptors_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that controls the use of
-- Short_Descriptors for setting descriptor default sizes. It can be set
-- True by the use of the pragma Short_Descriptors in the gnat.adc file.
-- This flag is used to set the initial value for Short_Descriptors at the
-- start of analyzing each unit.
Use_VADS_Size_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that controls the use of
@ -1780,6 +1793,7 @@ private
Optimize_Alignment_Local : Boolean;
Persistent_BSS_Mode : Boolean;
Polling_Required : Boolean;
Short_Descriptors : Boolean;
Use_VADS_Size : Boolean;
end record;

1
gcc/ada/par-prag.adb
View File

@ -1192,6 +1192,7 @@ begin
Pragma_Shared |
Pragma_Shared_Passive |
Pragma_Short_Circuit_And_Or |
Pragma_Short_Descriptors |
Pragma_Storage_Size |
Pragma_Storage_Unit |
Pragma_Static_Elaboration_Desired |

52
gcc/ada/prj-util.adb
View File

@ -105,12 +105,12 @@ package body Prj.Util is
-------------------
function Executable_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main : File_Name_Type;
Index : Int;
Ada_Main : Boolean := True;
Language : String := "";
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main : File_Name_Type;
Index : Int;
Ada_Main : Boolean := True;
Language : String := "";
Include_Suffix : Boolean := True) return File_Name_Type
is
pragma Assert (Project /= No_Project);
@ -131,8 +131,6 @@ package body Prj.Util is
In_Package => Builder_Package,
In_Tree => In_Tree);
Executable_Suffix_Name : Name_Id := No_Name;
Lang : Language_Ptr;
Spec_Suffix : Name_Id := No_Name;
@ -148,7 +146,7 @@ package body Prj.Util is
function Add_Suffix (File : File_Name_Type) return File_Name_Type;
-- Return the name of the executable, based on File, and adding the
-- executable suffix if needed.
-- executable suffix if needed
------------------
-- Get_Suffixes --
@ -177,19 +175,43 @@ package body Prj.Util is
function Add_Suffix (File : File_Name_Type) return File_Name_Type is
Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
Result : File_Name_Type;
Suffix_From_Project : Variable_Value;
begin
if Include_Suffix then
if Executable_Suffix_Name /= No_Name then
Executable_Extension_On_Target := Executable_Suffix_Name;
if Project.Config.Executable_Suffix /= No_Name then
Executable_Extension_On_Target :=
Project.Config.Executable_Suffix;
end if;
Result := Executable_Name (File_Name_Type (Executable.Value));
Result := Executable_Name (File);
Executable_Extension_On_Target := Saved_EEOT;
return Result;
else
return File;
-- We still want to take into account cases where the suffix is
-- specified in the project itself, as opposed to the config file.
-- Unfortunately, when the project was processed, they are both
-- stored in Project.Config, so we need to get it from the project
-- again
Suffix_From_Project :=
Prj.Util.Value_Of
(Variable_Name => Name_Executable_Suffix,
In_Variables =>
In_Tree.Packages.Table (Builder_Package).Decl.Attributes,
In_Tree => In_Tree);
if Suffix_From_Project /= Nil_Variable_Value
and then Suffix_From_Project.Value /= No_Name
then
Executable_Extension_On_Target := Suffix_From_Project.Value;
Result := Executable_Name (File);
Executable_Extension_On_Target := Saved_EEOT;
return Result;
else
return File;
end if;
end if;
end Add_Suffix;
@ -209,8 +231,6 @@ package body Prj.Util is
end if;
if Builder_Package /= No_Package then
Executable_Suffix_Name := Project.Config.Executable_Suffix;
if Executable = Nil_Variable_Value and then Ada_Main then
Get_Name_String (Main);

5
gcc/ada/prj-util.ads
View File

@ -42,8 +42,9 @@ package Prj.Util is
-- standard executable suffix for the platform.
--
-- If Include_Suffix is true, then the ".exe" suffix (or any suffix defined
-- in the config and project files) will be added. Otherwise, such a suffix
-- is not added. In particular, the prefix should not be added if you are
-- in the config) will be added. The suffix defined by the user in his own
-- project file is always taken into account. Otherwise, such a suffix is
-- not added. In particular, the prefix should not be added if you are
-- potentially testing for cross-platforms, since the suffix might not be
-- known (its default value comes from the ...-gnatmake prefix).
--

65
gcc/ada/sem_prag.adb
View File

@ -4907,8 +4907,8 @@ package body Sem_Prag is
-- form created by the parser.
procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
Class : Node_Id;
Param : Node_Id;
Class : Node_Id;
Param : Node_Id;
Mech_Name_Id : Name_Id;
procedure Bad_Class;
@ -4957,7 +4957,15 @@ package body Sem_Prag is
elsif Chars (Mech_Name) = Name_Descriptor then
Check_VMS (Mech_Name);
Set_Mechanism (Ent, By_Descriptor);
-- Descriptor => Short_Descriptor if pragma was given
if Short_Descriptors then
Set_Mechanism (Ent, By_Short_Descriptor);
else
Set_Mechanism (Ent, By_Descriptor);
end if;
return;
elsif Chars (Mech_Name) = Name_Short_Descriptor then
@ -4980,7 +4988,6 @@ package body Sem_Prag is
-- Note: this form is parsed as an indexed component
elsif Nkind (Mech_Name) = N_Indexed_Component then
Class := First (Expressions (Mech_Name));
if Nkind (Prefix (Mech_Name)) /= N_Identifier
@ -4991,6 +4998,14 @@ package body Sem_Prag is
Bad_Mechanism;
else
Mech_Name_Id := Chars (Prefix (Mech_Name));
-- Change Descriptor => Short_Descriptor if pragma was given
if Mech_Name_Id = Name_Descriptor
and then Short_Descriptors
then
Mech_Name_Id := Name_Short_Descriptor;
end if;
end if;
-- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
@ -5000,7 +5015,6 @@ package body Sem_Prag is
-- Note: this form is parsed as a function call
elsif Nkind (Mech_Name) = N_Function_Call then
Param := First (Parameter_Associations (Mech_Name));
if Nkind (Name (Mech_Name)) /= N_Identifier
@ -5028,72 +5042,72 @@ package body Sem_Prag is
Bad_Class;
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBS
and then Chars (Class) = Name_UBS
then
Set_Mechanism (Ent, By_Descriptor_UBS);
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBSB
and then Chars (Class) = Name_UBSB
then
Set_Mechanism (Ent, By_Descriptor_UBSB);
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBA
and then Chars (Class) = Name_UBA
then
Set_Mechanism (Ent, By_Descriptor_UBA);
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_S
and then Chars (Class) = Name_S
then
Set_Mechanism (Ent, By_Descriptor_S);
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_SB
and then Chars (Class) = Name_SB
then
Set_Mechanism (Ent, By_Descriptor_SB);
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_A
and then Chars (Class) = Name_A
then
Set_Mechanism (Ent, By_Descriptor_A);
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_NCA
and then Chars (Class) = Name_NCA
then
Set_Mechanism (Ent, By_Descriptor_NCA);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBS
and then Chars (Class) = Name_UBS
then
Set_Mechanism (Ent, By_Short_Descriptor_UBS);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBSB
and then Chars (Class) = Name_UBSB
then
Set_Mechanism (Ent, By_Short_Descriptor_UBSB);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBA
and then Chars (Class) = Name_UBA
then
Set_Mechanism (Ent, By_Short_Descriptor_UBA);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_S
and then Chars (Class) = Name_S
then
Set_Mechanism (Ent, By_Short_Descriptor_S);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_SB
and then Chars (Class) = Name_SB
then
Set_Mechanism (Ent, By_Short_Descriptor_SB);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_A
and then Chars (Class) = Name_A
then
Set_Mechanism (Ent, By_Short_Descriptor_A);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_NCA
and then Chars (Class) = Name_NCA
then
Set_Mechanism (Ent, By_Short_Descriptor_NCA);
@ -11052,6 +11066,18 @@ package body Sem_Prag is
Set_Is_Shared_Passive (Cunit_Ent);
end Shared_Passive;
-----------------------
-- Short_Descriptors --
-----------------------
-- pragma Short_Descriptors;
when Pragma_Short_Descriptors =>
GNAT_Pragma;
Check_Arg_Count (0);
Check_Valid_Configuration_Pragma;
Short_Descriptors := True;
----------------------
-- Source_File_Name --
----------------------
@ -12887,6 +12913,7 @@ package body Sem_Prag is
Pragma_Share_Generic => -1,
Pragma_Shared => -1,
Pragma_Shared_Passive => -1,
Pragma_Short_Descriptors => 0,
Pragma_Source_File_Name => -1,
Pragma_Source_File_Name_Project => -1,
Pragma_Source_Reference => -1,

2
gcc/ada/snames.ads-tmpl
View File

@ -386,6 +386,7 @@ package Snames is
Name_Restriction_Warnings : constant Name_Id := N + $; -- GNAT
Name_Reviewable : constant Name_Id := N + $;
Name_Short_Circuit_And_Or : constant Name_Id := N + $; -- GNAT
Name_Short_Descriptors : constant Name_Id := N + $; -- GNAT
Name_Source_File_Name : constant Name_Id := N + $; -- GNAT
Name_Source_File_Name_Project : constant Name_Id := N + $; -- GNAT
Name_Style_Checks : constant Name_Id := N + $; -- GNAT
@ -1466,6 +1467,7 @@ package Snames is
Pragma_Restriction_Warnings,
Pragma_Reviewable,
Pragma_Short_Circuit_And_Or,
Pragma_Short_Descriptors,
Pragma_Source_File_Name,
Pragma_Source_File_Name_Project,
Pragma_Style_Checks,