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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164147 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 122 insertions, 37 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e718fc06ed7..9e59c39fed3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,21 @@
 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
diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb
index 65c5726b901..445349ac8c1 100644
--- a/gcc/ada/opt.adb
+++ b/gcc/ada/opt.adb
@@ -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;
 
    ---------------
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index ac893a1403b..59658c63c02 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -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;
 
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index acc941e5eb6..f0259168476 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -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    |
diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb
index 76387b7923c..62e6e6ddd1e 100644
--- a/gcc/ada/prj-util.adb
+++ b/gcc/ada/prj-util.adb
@@ -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);
 
diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads
index 02d2cea6808..3c1ac0a741d 100644
--- a/gcc/ada/prj-util.ads
+++ b/gcc/ada/prj-util.ads
@@ -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).
    --
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a3b400e6100..f2b74b56440 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 7abd945de0a..411e3dbd3f0 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -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,