aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/osint.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2009-11-30 12:55:21 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2009-11-30 12:55:21 +0100
commit828781519a85aa04c47b5057555938017cec3ae2 (patch)
tree59148f8fcc8d5a03432b0b4f1157f9066894a5d2 /gcc/ada/osint.adb
parentfd0d899b57a1c3283bf47e414cad99e0f1bd3a2c (diff)
downloadgcc-828781519a85aa04c47b5057555938017cec3ae2.zip
gcc-828781519a85aa04c47b5057555938017cec3ae2.tar.gz
gcc-828781519a85aa04c47b5057555938017cec3ae2.tar.bz2
[multiple changes]
2009-11-30 Vincent Celier <celier@adacore.com> * gnatlink.adb (Process_Args): Call Executable_Name on argument of -o with Only_If_No_Suffix set to True. * osint.adb (Executable_Name): Do not add executable suffix if there is already a suffix and Only_If_No_Suffix is True. * osint.ads (Executable_Name): New Boolean parameter Only_If_No_Suffix, defaulted to False. 2009-11-30 Javier Miranda <miranda@adacore.com> * exp_atag.adb (Build_TSD): Change argument name because the actual is now the address of a tag (instead of the tag). Update implementation accordingly. (Build_CW_Membership): New implementation. Converted into a procedure because it has an additional out mode parameter. Its implementation has been rewritten to improve the generated code but also to facilitate referencing the relocated object node in the caller. * exp_atag.ads (Build_CW_Membership): Update profile and documentation. * sinfo.ads (N_SCIL_Membership_Test) New_Node. (SCIL_Tag_Value): New field of N_SCIL_Membership_Test nodes. (Is_Syntactic_Field): Add entry of new node. (SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms. * sinfo.adb (SCIL_Related_Node, SCIL_Entity): Update assertions to handle N_SCIL_Membership_Test nodes. (SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms. * sem.adb (Analyze): Add null management for new node. * sem_scil.adb (Find_SCIL_Node): Add null management for new node. (Check_SCIL_Node): Add checks of N_SCIL_Membership_Test nodes. * exp_ch4.adb (Tagged_Membership): Change profile from function to procedure. Add generation of SCIL node associated with class-wide membership test. (Expand_N_In): Complete decoration of SCIL nodes. * exp_intr.adb (Expand_Dispatching_Constructor_Call): Tune call to Build_CW_Membership because its profile has been changed. * exp_util.adb (Insert_Actions): Add null management for new node. * sprint.adb (Sprint_Node_Actual): Handle new node. * gcc-interface/trans.c Add no processing for N_SCIL_Membership_Test nodes. * gcc-interface/Make-lang.in: Update dependencies. 2009-11-30 Ed Schonberg <schonberg@adacore.com> * opt.ads: New flags Init_Or_Norm_Scalars_Config, Initialize_Scalars_Config, to capture the presence of the corresponding pragmas in a configuration file. * opt.adb (Register_, Save_, Set_, Restore_Opt_Configuration_Switches): handle new flags so that they are restored for each compilation unit. * frontend.adb: At the end of compilation, scan the context of the main unit to recover occurrences of pragma Initialize_Scalars, to annotate the ALI file accordingly. From-SVN: r154792
Diffstat (limited to 'gcc/ada/osint.adb')
-rw-r--r--gcc/ada/osint.adb89
1 files changed, 61 insertions, 28 deletions
diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb
index 57df5ea..523852a 100644
--- a/gcc/ada/osint.adb
+++ b/gcc/ada/osint.adb
@@ -793,8 +793,12 @@ package body Osint is
-- Executable_Name --
---------------------
- function Executable_Name (Name : File_Name_Type) return File_Name_Type is
+ function Executable_Name
+ (Name : File_Name_Type;
+ Only_If_No_Suffix : Boolean := False) return File_Name_Type
+ is
Exec_Suffix : String_Access;
+ Add_Suffix : Boolean;
begin
if Name = No_File then
@@ -808,40 +812,59 @@ package body Osint is
Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
end if;
- Get_Name_String (Name);
-
if Exec_Suffix'Length /= 0 then
- declare
- Buffer : String := Name_Buffer (1 .. Name_Len);
+ Add_Suffix := not Only_If_No_Suffix;
- begin
- -- Get the file name in canonical case to accept as is names
- -- ending with ".EXE" on VMS and Windows.
+ if not Add_Suffix then
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '.' then
+ Add_Suffix := True;
+ exit;
+ end if;
+ end loop;
+ end if;
- Canonical_Case_File_Name (Buffer);
+ if Add_Suffix then
+ Get_Name_String (Name);
- -- If Executable does not end with the executable suffix, add it
+ declare
+ Buffer : String := Name_Buffer (1 .. Name_Len);
- if Buffer'Length <= Exec_Suffix'Length
- or else
- Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
- /= Exec_Suffix.all
- then
- Name_Buffer (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
- Exec_Suffix.all;
- Name_Len := Name_Len + Exec_Suffix'Length;
- Free (Exec_Suffix);
- return Name_Find;
- end if;
- end;
+ begin
+ -- Get the file name in canonical case to accept as is names
+ -- ending with ".EXE" on VMS and Windows.
+
+ Canonical_Case_File_Name (Buffer);
+
+ -- If Executable does not end with the executable suffix, add
+ -- it.
+
+ if Buffer'Length <= Exec_Suffix'Length
+ or else
+ Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
+ /= Exec_Suffix.all
+ then
+ Name_Buffer
+ (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
+ Exec_Suffix.all;
+ Name_Len := Name_Len + Exec_Suffix'Length;
+ Free (Exec_Suffix);
+ return Name_Find;
+ end if;
+ end;
+ end if;
end if;
Free (Exec_Suffix);
return Name;
end Executable_Name;
- function Executable_Name (Name : String) return String is
+ function Executable_Name
+ (Name : String;
+ Only_If_No_Suffix : Boolean := False) return String
+ is
Exec_Suffix : String_Access;
+ Add_Suffix : Boolean;
Canonical_Name : String := Name;
begin
@@ -858,12 +881,22 @@ package body Osint is
begin
Free (Exec_Suffix);
Canonical_Case_File_Name (Canonical_Name);
+ Add_Suffix := not Only_If_No_Suffix;
+
+ if not Add_Suffix then
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '.' then
+ Add_Suffix := True;
+ exit;
+ end if;
+ end loop;
+ end if;
- if Suffix'Length /= 0
- and then
- (Canonical_Name'Length <= Suffix'Length
- or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
- .. Canonical_Name'Last) /= Suffix)
+ if Suffix'Length = 0 and then
+ Add_Suffix and then
+ (Canonical_Name'Length <= Suffix'Length
+ or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
+ .. Canonical_Name'Last) /= Suffix)
then
declare
Result : String (1 .. Name'Length + Suffix'Length);