Commit 292beb8f by Arnaud Charlet

[multiple changes]

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
parent e5dc610e
2010-09-10 Robert Dewar <dewar@adacore.com> 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 * g-pehage.ads: Minor reformatting
* gnat_ugn.texi: Clarifying comment on -gnatyc * gnat_ugn.texi: Clarifying comment on -gnatyc
......
...@@ -61,6 +61,7 @@ package body Opt is ...@@ -61,6 +61,7 @@ package body Opt is
Optimize_Alignment_Config := Optimize_Alignment; Optimize_Alignment_Config := Optimize_Alignment;
Persistent_BSS_Mode_Config := Persistent_BSS_Mode; Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
Polling_Required_Config := Polling_Required; Polling_Required_Config := Polling_Required;
Short_Descriptors_Config := Short_Descriptors;
Use_VADS_Size_Config := Use_VADS_Size; Use_VADS_Size_Config := Use_VADS_Size;
-- Reset the indication that Optimize_Alignment was set locally, since -- Reset the indication that Optimize_Alignment was set locally, since
...@@ -94,6 +95,7 @@ package body Opt is ...@@ -94,6 +95,7 @@ package body Opt is
Optimize_Alignment_Local := Save.Optimize_Alignment_Local; Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode; Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
Polling_Required := Save.Polling_Required; Polling_Required := Save.Polling_Required;
Short_Descriptors := Save.Short_Descriptors;
Use_VADS_Size := Save.Use_VADS_Size; Use_VADS_Size := Save.Use_VADS_Size;
end Restore_Opt_Config_Switches; end Restore_Opt_Config_Switches;
...@@ -121,6 +123,7 @@ package body Opt is ...@@ -121,6 +123,7 @@ package body Opt is
Save.Optimize_Alignment_Local := Optimize_Alignment_Local; Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
Save.Persistent_BSS_Mode := Persistent_BSS_Mode; Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
Save.Polling_Required := Polling_Required; Save.Polling_Required := Polling_Required;
Save.Short_Descriptors := Short_Descriptors;
Save.Use_VADS_Size := Use_VADS_Size; Save.Use_VADS_Size := Use_VADS_Size;
end Save_Opt_Config_Switches; end Save_Opt_Config_Switches;
...@@ -193,6 +196,7 @@ package body Opt is ...@@ -193,6 +196,7 @@ package body Opt is
Fast_Math := Fast_Math_Config; Fast_Math := Fast_Math_Config;
Optimize_Alignment := Optimize_Alignment_Config; Optimize_Alignment := Optimize_Alignment_Config;
Polling_Required := Polling_Required_Config; Polling_Required := Polling_Required_Config;
Short_Descriptors := Short_Descriptors_Config;
end Set_Opt_Config_Switches; end Set_Opt_Config_Switches;
--------------- ---------------
......
...@@ -1089,7 +1089,12 @@ package Opt is ...@@ -1089,7 +1089,12 @@ package Opt is
-- GNAT -- GNAT
-- Set True if a pragma Short_Circuit_And_Or applies to the current unit. -- 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; Sprint_Line_Limit : Nat := 72;
-- GNAT
-- Limit values for chopping long lines in Sprint output, can be reset -- Limit values for chopping long lines in Sprint output, can be reset
-- by use of NNN parameter with -gnatG or -gnatD switches. -- by use of NNN parameter with -gnatG or -gnatD switches.
...@@ -1651,6 +1656,14 @@ package Opt is ...@@ -1651,6 +1656,14 @@ package Opt is
-- flag is used to set the initial value for Polling_Required at the start -- flag is used to set the initial value for Polling_Required at the start
-- of analyzing each unit. -- 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; Use_VADS_Size_Config : Boolean;
-- GNAT -- GNAT
-- This is the value of the configuration switch that controls the use of -- This is the value of the configuration switch that controls the use of
...@@ -1780,6 +1793,7 @@ private ...@@ -1780,6 +1793,7 @@ private
Optimize_Alignment_Local : Boolean; Optimize_Alignment_Local : Boolean;
Persistent_BSS_Mode : Boolean; Persistent_BSS_Mode : Boolean;
Polling_Required : Boolean; Polling_Required : Boolean;
Short_Descriptors : Boolean;
Use_VADS_Size : Boolean; Use_VADS_Size : Boolean;
end record; end record;
......
...@@ -1192,6 +1192,7 @@ begin ...@@ -1192,6 +1192,7 @@ begin
Pragma_Shared | Pragma_Shared |
Pragma_Shared_Passive | Pragma_Shared_Passive |
Pragma_Short_Circuit_And_Or | Pragma_Short_Circuit_And_Or |
Pragma_Short_Descriptors |
Pragma_Storage_Size | Pragma_Storage_Size |
Pragma_Storage_Unit | Pragma_Storage_Unit |
Pragma_Static_Elaboration_Desired | Pragma_Static_Elaboration_Desired |
......
...@@ -105,12 +105,12 @@ package body Prj.Util is ...@@ -105,12 +105,12 @@ package body Prj.Util is
------------------- -------------------
function Executable_Of function Executable_Of
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Main : File_Name_Type; Main : File_Name_Type;
Index : Int; Index : Int;
Ada_Main : Boolean := True; Ada_Main : Boolean := True;
Language : String := ""; Language : String := "";
Include_Suffix : Boolean := True) return File_Name_Type Include_Suffix : Boolean := True) return File_Name_Type
is is
pragma Assert (Project /= No_Project); pragma Assert (Project /= No_Project);
...@@ -131,8 +131,6 @@ package body Prj.Util is ...@@ -131,8 +131,6 @@ package body Prj.Util is
In_Package => Builder_Package, In_Package => Builder_Package,
In_Tree => In_Tree); In_Tree => In_Tree);
Executable_Suffix_Name : Name_Id := No_Name;
Lang : Language_Ptr; Lang : Language_Ptr;
Spec_Suffix : Name_Id := No_Name; Spec_Suffix : Name_Id := No_Name;
...@@ -148,7 +146,7 @@ package body Prj.Util is ...@@ -148,7 +146,7 @@ package body Prj.Util is
function Add_Suffix (File : File_Name_Type) return File_Name_Type; function Add_Suffix (File : File_Name_Type) return File_Name_Type;
-- Return the name of the executable, based on File, and adding the -- Return the name of the executable, based on File, and adding the
-- executable suffix if needed. -- executable suffix if needed
------------------ ------------------
-- Get_Suffixes -- -- Get_Suffixes --
...@@ -177,19 +175,43 @@ package body Prj.Util is ...@@ -177,19 +175,43 @@ package body Prj.Util is
function Add_Suffix (File : File_Name_Type) return File_Name_Type is function Add_Suffix (File : File_Name_Type) return File_Name_Type is
Saved_EEOT : constant Name_Id := Executable_Extension_On_Target; Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
Result : File_Name_Type; Result : File_Name_Type;
Suffix_From_Project : Variable_Value;
begin begin
if Include_Suffix then if Include_Suffix then
if Executable_Suffix_Name /= No_Name then if Project.Config.Executable_Suffix /= No_Name then
Executable_Extension_On_Target := Executable_Suffix_Name; Executable_Extension_On_Target :=
Project.Config.Executable_Suffix;
end if; end if;
Result := Executable_Name (File_Name_Type (Executable.Value)); Result := Executable_Name (File);
Executable_Extension_On_Target := Saved_EEOT; Executable_Extension_On_Target := Saved_EEOT;
return Result; return Result;
else 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 if;
end Add_Suffix; end Add_Suffix;
...@@ -209,8 +231,6 @@ package body Prj.Util is ...@@ -209,8 +231,6 @@ package body Prj.Util is
end if; end if;
if Builder_Package /= No_Package then if Builder_Package /= No_Package then
Executable_Suffix_Name := Project.Config.Executable_Suffix;
if Executable = Nil_Variable_Value and then Ada_Main then if Executable = Nil_Variable_Value and then Ada_Main then
Get_Name_String (Main); Get_Name_String (Main);
......
...@@ -42,8 +42,9 @@ package Prj.Util is ...@@ -42,8 +42,9 @@ package Prj.Util is
-- standard executable suffix for the platform. -- standard executable suffix for the platform.
-- --
-- If Include_Suffix is true, then the ".exe" suffix (or any suffix defined -- 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 -- in the config) will be added. The suffix defined by the user in his own
-- is not added. In particular, the prefix should not be added if you are -- 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 -- potentially testing for cross-platforms, since the suffix might not be
-- known (its default value comes from the ...-gnatmake prefix). -- known (its default value comes from the ...-gnatmake prefix).
-- --
......
...@@ -4907,8 +4907,8 @@ package body Sem_Prag is ...@@ -4907,8 +4907,8 @@ package body Sem_Prag is
-- form created by the parser. -- form created by the parser.
procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
Class : Node_Id; Class : Node_Id;
Param : Node_Id; Param : Node_Id;
Mech_Name_Id : Name_Id; Mech_Name_Id : Name_Id;
procedure Bad_Class; procedure Bad_Class;
...@@ -4957,7 +4957,15 @@ package body Sem_Prag is ...@@ -4957,7 +4957,15 @@ package body Sem_Prag is
elsif Chars (Mech_Name) = Name_Descriptor then elsif Chars (Mech_Name) = Name_Descriptor then
Check_VMS (Mech_Name); 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; return;
elsif Chars (Mech_Name) = Name_Short_Descriptor then elsif Chars (Mech_Name) = Name_Short_Descriptor then
...@@ -4980,7 +4988,6 @@ package body Sem_Prag is ...@@ -4980,7 +4988,6 @@ package body Sem_Prag is
-- Note: this form is parsed as an indexed component -- Note: this form is parsed as an indexed component
elsif Nkind (Mech_Name) = N_Indexed_Component then elsif Nkind (Mech_Name) = N_Indexed_Component then
Class := First (Expressions (Mech_Name)); Class := First (Expressions (Mech_Name));
if Nkind (Prefix (Mech_Name)) /= N_Identifier if Nkind (Prefix (Mech_Name)) /= N_Identifier
...@@ -4991,6 +4998,14 @@ package body Sem_Prag is ...@@ -4991,6 +4998,14 @@ package body Sem_Prag is
Bad_Mechanism; Bad_Mechanism;
else else
Mech_Name_Id := Chars (Prefix (Mech_Name)); 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; end if;
-- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) | -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
...@@ -5000,7 +5015,6 @@ package body Sem_Prag is ...@@ -5000,7 +5015,6 @@ package body Sem_Prag is
-- Note: this form is parsed as a function call -- Note: this form is parsed as a function call
elsif Nkind (Mech_Name) = N_Function_Call then elsif Nkind (Mech_Name) = N_Function_Call then
Param := First (Parameter_Associations (Mech_Name)); Param := First (Parameter_Associations (Mech_Name));
if Nkind (Name (Mech_Name)) /= N_Identifier if Nkind (Name (Mech_Name)) /= N_Identifier
...@@ -5028,72 +5042,72 @@ package body Sem_Prag is ...@@ -5028,72 +5042,72 @@ package body Sem_Prag is
Bad_Class; Bad_Class;
elsif Mech_Name_Id = Name_Descriptor elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBS and then Chars (Class) = Name_UBS
then then
Set_Mechanism (Ent, By_Descriptor_UBS); Set_Mechanism (Ent, By_Descriptor_UBS);
elsif Mech_Name_Id = Name_Descriptor elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBSB and then Chars (Class) = Name_UBSB
then then
Set_Mechanism (Ent, By_Descriptor_UBSB); Set_Mechanism (Ent, By_Descriptor_UBSB);
elsif Mech_Name_Id = Name_Descriptor elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBA and then Chars (Class) = Name_UBA
then then
Set_Mechanism (Ent, By_Descriptor_UBA); Set_Mechanism (Ent, By_Descriptor_UBA);
elsif Mech_Name_Id = Name_Descriptor elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_S and then Chars (Class) = Name_S
then then
Set_Mechanism (Ent, By_Descriptor_S); Set_Mechanism (Ent, By_Descriptor_S);
elsif Mech_Name_Id = Name_Descriptor elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_SB and then Chars (Class) = Name_SB
then then
Set_Mechanism (Ent, By_Descriptor_SB); Set_Mechanism (Ent, By_Descriptor_SB);
elsif Mech_Name_Id = Name_Descriptor elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_A and then Chars (Class) = Name_A
then then
Set_Mechanism (Ent, By_Descriptor_A); Set_Mechanism (Ent, By_Descriptor_A);
elsif Mech_Name_Id = Name_Descriptor elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_NCA and then Chars (Class) = Name_NCA
then then
Set_Mechanism (Ent, By_Descriptor_NCA); Set_Mechanism (Ent, By_Descriptor_NCA);
elsif Mech_Name_Id = Name_Short_Descriptor elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBS and then Chars (Class) = Name_UBS
then then
Set_Mechanism (Ent, By_Short_Descriptor_UBS); Set_Mechanism (Ent, By_Short_Descriptor_UBS);
elsif Mech_Name_Id = Name_Short_Descriptor elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBSB and then Chars (Class) = Name_UBSB
then then
Set_Mechanism (Ent, By_Short_Descriptor_UBSB); Set_Mechanism (Ent, By_Short_Descriptor_UBSB);
elsif Mech_Name_Id = Name_Short_Descriptor elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBA and then Chars (Class) = Name_UBA
then then
Set_Mechanism (Ent, By_Short_Descriptor_UBA); Set_Mechanism (Ent, By_Short_Descriptor_UBA);
elsif Mech_Name_Id = Name_Short_Descriptor elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_S and then Chars (Class) = Name_S
then then
Set_Mechanism (Ent, By_Short_Descriptor_S); Set_Mechanism (Ent, By_Short_Descriptor_S);
elsif Mech_Name_Id = Name_Short_Descriptor elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_SB and then Chars (Class) = Name_SB
then then
Set_Mechanism (Ent, By_Short_Descriptor_SB); Set_Mechanism (Ent, By_Short_Descriptor_SB);
elsif Mech_Name_Id = Name_Short_Descriptor elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_A and then Chars (Class) = Name_A
then then
Set_Mechanism (Ent, By_Short_Descriptor_A); Set_Mechanism (Ent, By_Short_Descriptor_A);
elsif Mech_Name_Id = Name_Short_Descriptor elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_NCA and then Chars (Class) = Name_NCA
then then
Set_Mechanism (Ent, By_Short_Descriptor_NCA); Set_Mechanism (Ent, By_Short_Descriptor_NCA);
...@@ -11052,6 +11066,18 @@ package body Sem_Prag is ...@@ -11052,6 +11066,18 @@ package body Sem_Prag is
Set_Is_Shared_Passive (Cunit_Ent); Set_Is_Shared_Passive (Cunit_Ent);
end Shared_Passive; 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 -- -- Source_File_Name --
---------------------- ----------------------
...@@ -12887,6 +12913,7 @@ package body Sem_Prag is ...@@ -12887,6 +12913,7 @@ package body Sem_Prag is
Pragma_Share_Generic => -1, Pragma_Share_Generic => -1,
Pragma_Shared => -1, Pragma_Shared => -1,
Pragma_Shared_Passive => -1, Pragma_Shared_Passive => -1,
Pragma_Short_Descriptors => 0,
Pragma_Source_File_Name => -1, Pragma_Source_File_Name => -1,
Pragma_Source_File_Name_Project => -1, Pragma_Source_File_Name_Project => -1,
Pragma_Source_Reference => -1, Pragma_Source_Reference => -1,
......
...@@ -386,6 +386,7 @@ package Snames is ...@@ -386,6 +386,7 @@ package Snames is
Name_Restriction_Warnings : constant Name_Id := N + $; -- GNAT Name_Restriction_Warnings : constant Name_Id := N + $; -- GNAT
Name_Reviewable : constant Name_Id := N + $; Name_Reviewable : constant Name_Id := N + $;
Name_Short_Circuit_And_Or : constant Name_Id := N + $; -- GNAT 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 : constant Name_Id := N + $; -- GNAT
Name_Source_File_Name_Project : constant Name_Id := N + $; -- GNAT Name_Source_File_Name_Project : constant Name_Id := N + $; -- GNAT
Name_Style_Checks : constant Name_Id := N + $; -- GNAT Name_Style_Checks : constant Name_Id := N + $; -- GNAT
...@@ -1466,6 +1467,7 @@ package Snames is ...@@ -1466,6 +1467,7 @@ package Snames is
Pragma_Restriction_Warnings, Pragma_Restriction_Warnings,
Pragma_Reviewable, Pragma_Reviewable,
Pragma_Short_Circuit_And_Or, Pragma_Short_Circuit_And_Or,
Pragma_Short_Descriptors,
Pragma_Source_File_Name, Pragma_Source_File_Name,
Pragma_Source_File_Name_Project, Pragma_Source_File_Name_Project,
Pragma_Style_Checks, Pragma_Style_Checks,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment