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
* gnat_ugn.texi: Clarifying comment on -gnatyc
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
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;
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;
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;
---------------
-- 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.
-- 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
Optimize_Alignment_Local : Boolean;
Persistent_BSS_Mode : Boolean;
Polling_Required : Boolean;
+ Short_Descriptors : Boolean;
Use_VADS_Size : Boolean;
end record;
Pragma_Shared |
Pragma_Shared_Passive |
Pragma_Short_Circuit_And_Or |
+ Pragma_Short_Descriptors |
Pragma_Storage_Size |
Pragma_Storage_Unit |
Pragma_Static_Elaboration_Desired |
-------------------
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);
In_Package => Builder_Package,
In_Tree => In_Tree);
- Executable_Suffix_Name : Name_Id := No_Name;
-
Lang : Language_Ptr;
Spec_Suffix : Name_Id := No_Name;
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 --
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;
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);
-- 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).
--
-- 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;
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
-- 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
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) |
-- 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
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);
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 --
----------------------
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,
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
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,
OSDN Git Service
