diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-09-10 09:57:37 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-09-10 09:57:37 +0000 |
commit | ae35d473dcba37da6805652727c83a7f7699eae6 (patch) | |
tree | c4b0656553329eed6d33379035b426abfcd5d89c /gcc/ada/gnatlink.adb | |
parent | 01eb761e3088d72508d2190978ad488cbb75c321 (diff) | |
download | gcc-ae35d473dcba37da6805652727c83a7f7699eae6.tar.gz |
2010-09-10 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Add section on intent of style checking options.
2010-09-10 Arnaud Charlet <charlet@adacore.com>
* xref_lib.adb (Get_Full_Type): Fix handling of 'a' char.
2010-09-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb: Improve error message on derivation from class-wide type
2010-09-10 Steve Baird <baird@adacore.com>
* gnat1drv.adb (Adjust_Global_Switches): Enable Expression_With_Actions
generation when Generate_SCIL is True.
2010-09-10 Geert Bosch <bosch@adacore.com>
* gnatlink.adb (Check_ Existing_Executable): New procedure for checking
validity of executable name and removing any existing executable
(Gnatlink): Call Check_Existing_Executable.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164154 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/gnatlink.adb')
-rw-r--r-- | gcc/ada/gnatlink.adb | 43 |
1 files changed, 33 insertions, 10 deletions
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 191021dfc6e..3cf65eb2d47 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -199,6 +199,13 @@ procedure Gnatlink is function Base_Name (File_Name : String) return String; -- Return just the file name part without the extension (if present) + procedure Check_Existing_Executable (File_Name : String); + -- Delete any existing executable to avoid accidentally updating + -- the target of a symbolic link, but produce a Fatail_Error if + -- File_Name matches any of the source file names. This avoids + -- overwriting of extensionless source files by accident on systems + -- where executables do not have extensions. + procedure Delete (Name : String); -- Wrapper to unlink as status is ignored by this application @@ -258,6 +265,31 @@ procedure Gnatlink is return File_Name (Findex1 .. Findex2 - 1); end Base_Name; + ------------------------------- + -- Check_Existing_Executable -- + ------------------------------- + + procedure Check_Existing_Executable (File_Name : String) is + Ename : String := File_Name; + Efile : File_Name_Type; + Sfile : File_Name_Type; + begin + Canonical_Case_File_Name (Ename); + Name_Len := 0; + Add_Str_To_Name_Buffer (Ename); + Efile := Name_Find; + + for J in Units.Table'First .. Units.Last loop + Sfile := Units.Table (J).Sfile; + if Sfile = Efile then + Exit_With_Error ("executable name """ & File_Name & """ matches " + & "source file name """ & Get_Name_String (Sfile) & """"); + end if; + end loop; + + Delete (File_Name); + end Check_Existing_Executable; + ------------ -- Delete -- ------------ @@ -1759,16 +1791,7 @@ begin new String'(Output_File_Name.all); end if; - -- Delete existing executable, in case it is a symbolic link, to avoid - -- modifying the target of the symbolic link. - - declare - Dummy : Boolean; - pragma Unreferenced (Dummy); - - begin - Delete_File (Output_File_Name.all, Dummy); - end; + Check_Existing_Executable (Output_File_Name.all); -- Warn if main program is called "test", as that may be a built-in command -- on Unix. On non-Unix systems executables have a suffix, so the warning |