summaryrefslogtreecommitdiff
path: root/gcc/ada/gnatlink.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-09-10 09:57:37 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-09-10 09:57:37 +0000
commitae35d473dcba37da6805652727c83a7f7699eae6 (patch)
treec4b0656553329eed6d33379035b426abfcd5d89c /gcc/ada/gnatlink.adb
parent01eb761e3088d72508d2190978ad488cbb75c321 (diff)
downloadgcc-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.adb43
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