diff options
Diffstat (limited to 'gcc/ada/mlib-utl.adb')
-rw-r--r-- | gcc/ada/mlib-utl.adb | 117 |
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 |