summaryrefslogtreecommitdiff
path: root/gcc/ada/mlib-utl.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/mlib-utl.adb')
-rw-r--r--gcc/ada/mlib-utl.adb117
1 files changed, 46 insertions, 71 deletions
diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb
index 215fa5d6e8d..2e3f0c0c108 100644
--- a/gcc/ada/mlib-utl.adb
+++ b/gcc/ada/mlib-utl.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2011, AdaCore --
+-- Copyright (C) 2002-2012, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -31,8 +31,6 @@ with Output; use Output;
with Interfaces.C.Strings; use Interfaces.C.Strings;
-with System;
-
package body MLib.Utl is
Adalib_Path : String_Access := null;
@@ -353,16 +351,13 @@ package body MLib.Utl is
-- Pointer to a string representing the linker option which specifies
-- the response file.
- Using_GNU_Linker : Boolean;
- for Using_GNU_Linker'Size use Character'Size;
- pragma Import (C, Using_GNU_Linker, "__gnat_using_gnu_linker");
- -- Predicate indicating whether this target uses the GNU linker. In
- -- this case we must output a GNU linker compatible response file.
+ Object_File_Option : constant String := Value (Object_File_Option_Ptr);
+ -- The linker option which specifies the response file as a string
- Opening : aliased constant String := """";
- Closing : aliased constant String := '"' & ASCII.LF;
- -- Needed to quote object paths in object list files when GNU linker
- -- is used.
+ Using_GNU_response_file : constant Boolean :=
+ Object_File_Option'Length > 0
+ and then Object_File_Option (Object_File_Option'Last) = '@';
+ -- Whether a GNU response file is used
Tname : String_Access;
Tname_FD : File_Descriptor := Invalid_FD;
@@ -390,7 +385,7 @@ package body MLib.Utl is
Position : Object_Position;
- procedure Write_RF (A : System.Address; N : Integer);
+ procedure Write_RF (S : String);
-- Write a string to the response file and check if it was successful.
-- Fail the program if it was not successful (disk full).
@@ -398,12 +393,38 @@ package body MLib.Utl is
-- Write_RF --
--------------
- procedure Write_RF (A : System.Address; N : Integer) is
- Status : Integer;
+ procedure Write_RF (S : String) is
+ Success : Boolean := True;
begin
- Status := Write (Tname_FD, A, N);
+ -- If a GNU response file is used, space and backslash need to be
+ -- escaped because they are interpreted as a string separator and
+ -- an escape character respectively by the underlying mechanism.
+ -- On the other hand, quote and double-quote are not escaped since
+ -- they are interpreted as string delimiters on both sides.
+
+ if Using_GNU_response_file then
+ for I in S'Range loop
+ if S (I) = ' ' or else S (I) = '\' then
+ if Write (Tname_FD, ASCII.BACK_SLASH'Address, 1) /= 1 then
+ Success := False;
+ end if;
+ end if;
- if Status /= N then
+ if Write (Tname_FD, S (I)'Address, 1) /= 1 then
+ Success := False;
+ end if;
+ end loop;
+ else
+ if Write (Tname_FD, S'Address, S'Length) /= S'Length then
+ Success := False;
+ end if;
+ end if;
+
+ if Write (Tname_FD, ASCII.LF'Address, 1) /= 1 then
+ Success := False;
+ end if;
+
+ if not Success then
Fail ("cannot generate response file to link library: disk full");
end if;
end Write_RF;
@@ -529,53 +550,10 @@ package body MLib.Utl is
Create_Temp_File (Tname_FD, Tname);
- -- If target is using the GNU linker we must add a special header
- -- and footer in the response file.
-
- -- The syntax is : INPUT (object1.o object2.o ... )
-
- -- Because the GNU linker does not like name with characters such
- -- as '!', we must put the object paths between double quotes.
-
- if Using_GNU_Linker then
- declare
- GNU_Header : aliased constant String := "INPUT (";
-
- begin
- Write_RF (GNU_Header'Address, GNU_Header'Length);
- end;
- end if;
-
for J in Objects'Range loop
- -- Opening quote for GNU linker
-
- if Using_GNU_Linker then
- Write_RF (Opening'Address, 1);
- end if;
-
- Write_RF (Objects (J).all'Address, Objects (J).all'Length);
-
- -- Closing quote for GNU linker
-
- if Using_GNU_Linker then
- Write_RF (Closing'Address, 2);
-
- else
- Write_RF (ASCII.LF'Address, 1);
- end if;
+ Write_RF (Objects (J).all);
end loop;
- -- Handle GNU linker response file footer
-
- if Using_GNU_Linker then
- declare
- GNU_Footer : aliased constant String := ")";
-
- begin
- Write_RF (GNU_Footer'Address, GNU_Footer'Length);
- end;
- end if;
-
Close (Tname_FD, Closing_Status);
if not Closing_Status then
@@ -583,8 +561,7 @@ package body MLib.Utl is
end if;
A := A + 1;
- Arguments (A) :=
- new String'(Value (Object_File_Option_Ptr) & Tname.all);
+ Arguments (A) := new String'(Object_File_Option & Tname.all);
else
A := A + Objects'Length;
@@ -596,17 +573,15 @@ package body MLib.Utl is
Spawn (Driver.all, Arguments (1 .. A), Success);
- if Tname /= null then
- Delete_File (Tname.all, Closing_Status);
+ if Success then
+ -- Delete the temporary file used in conjunction with linking
+ -- if one was created.
- if not Closing_Status then
- Write_Str ("warning: could not delete response file """);
- Write_Str (Tname.all);
- Write_Line (""" to link library");
+ if Tname_FD /= Invalid_FD then
+ Delete_File (Tname.all);
end if;
- end if;
- if not Success then
+ else
if Driver_Name = No_Name then
Fail (Gcc_Name.all & " execution error");
else