diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-30 15:21:46 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-30 15:21:46 +0000 |
| commit | 1094a5ca9023daee0ba99e838c4b718610774080 (patch) | |
| tree | 84b44adda5548733a0ba71ebd9458374b667579b /gcc/ada/makeutl.adb | |
| parent | 50b3164db09945691ae3893177f827c1839e639b (diff) | |
| download | gcc-1094a5ca9023daee0ba99e838c4b718610774080.tar.gz | |
2012-07-30 Robert Dewar <dewar@adacore.com>
* bindusg.adb: Clarify file in -A lines.
2012-07-30 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor reformatting.
2012-07-30 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb, makeutl.adb, makeutl.ads: Minor code reorganization.
2012-07-30 Vincent Pucci <pucci@adacore.com>
* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): Minor
reformatting.
* sem_ch9.adb (Allows_Lock_Free_Implementation): Minor reformatting.
Capture the correct error message in case of a quantified expression.
2012-07-30 Thomas Quinot <quinot@adacore.com>
* g-socket.adb (Get_Socket_Option, Set_Socket_Option): On Windows, the
value is a milliseconds count in a DWORD, not a struct timeval.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189979 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/makeutl.adb')
| -rw-r--r-- | gcc/ada/makeutl.adb | 206 |
1 files changed, 103 insertions, 103 deletions
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 253e8db814c..cdbe1aa134c 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -507,6 +507,109 @@ package body Makeutl is return Name_Find; end Create_Name; + --------------------------- + -- Ensure_Absolute_Path -- + --------------------------- + + procedure Ensure_Absolute_Path + (Switch : in out String_Access; + Parent : String; + Do_Fail : Fail_Proc; + For_Gnatbind : Boolean := False; + Including_Non_Switch : Boolean := True; + Including_RTS : Boolean := False) + is + begin + if Switch /= null then + declare + Sw : String (1 .. Switch'Length); + Start : Positive; + + begin + Sw := Switch.all; + + if Sw (1) = '-' then + if Sw'Length >= 3 + and then (Sw (2) = 'I' + or else (not For_Gnatbind + and then (Sw (2) = 'L' + or else Sw (2) = 'A'))) + then + Start := 3; + + if Sw = "-I-" then + return; + end if; + + elsif Sw'Length >= 4 + and then (Sw (2 .. 3) = "aL" + or else + Sw (2 .. 3) = "aO" + or else + Sw (2 .. 3) = "aI" + or else + (For_Gnatbind and then Sw (2 .. 3) = "A=")) + then + Start := 4; + + elsif Including_RTS + and then Sw'Length >= 7 + and then Sw (2 .. 6) = "-RTS=" + then + Start := 7; + + else + return; + end if; + + -- Because relative path arguments to --RTS= may be relative to + -- the search directory prefix, those relative path arguments + -- are converted only when they include directory information. + + if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then + if Parent'Length = 0 then + Do_Fail + ("relative search path switches (""" + & Sw + & """) are not allowed"); + + elsif Including_RTS then + for J in Start .. Sw'Last loop + if Sw (J) = Directory_Separator then + Switch := + new String' + (Sw (1 .. Start - 1) & + Parent & + Directory_Separator & + Sw (Start .. Sw'Last)); + return; + end if; + end loop; + + else + Switch := + new String' + (Sw (1 .. Start - 1) & + Parent & + Directory_Separator & + Sw (Start .. Sw'Last)); + end if; + end if; + + elsif Including_Non_Switch then + if not Is_Absolute_Path (Sw) then + if Parent'Length = 0 then + Do_Fail + ("relative paths (""" & Sw & """) are not allowed"); + else + Switch := new String'(Parent & Directory_Separator & Sw); + end if; + end if; + end if; + end; + end if; + end Ensure_Absolute_Path; + ---------------------------- -- Executable_Prefix_Path -- ---------------------------- @@ -1936,109 +2039,6 @@ package body Makeutl is end if; end Path_Or_File_Name; - --------------------------- - -- Ensure_Absolute_Path -- - --------------------------- - - procedure Ensure_Absolute_Path - (Switch : in out String_Access; - Parent : String; - Do_Fail : Fail_Proc; - For_Gnatbind : Boolean := False; - Including_Non_Switch : Boolean := True; - Including_RTS : Boolean := False) - is - begin - if Switch /= null then - declare - Sw : String (1 .. Switch'Length); - Start : Positive; - - begin - Sw := Switch.all; - - if Sw (1) = '-' then - if Sw'Length >= 3 - and then (Sw (2) = 'I' - or else (not For_Gnatbind - and then (Sw (2) = 'L' - or else Sw (2) = 'A'))) - then - Start := 3; - - if Sw = "-I-" then - return; - end if; - - elsif Sw'Length >= 4 - and then (Sw (2 .. 3) = "aL" - or else - Sw (2 .. 3) = "aO" - or else - Sw (2 .. 3) = "aI" - or else - (For_Gnatbind and then Sw (2 .. 3) = "A=")) - then - Start := 4; - - elsif Including_RTS - and then Sw'Length >= 7 - and then Sw (2 .. 6) = "-RTS=" - then - Start := 7; - - else - return; - end if; - - -- Because relative path arguments to --RTS= may be relative to - -- the search directory prefix, those relative path arguments - -- are converted only when they include directory information. - - if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then - if Parent'Length = 0 then - Do_Fail - ("relative search path switches (""" - & Sw - & """) are not allowed"); - - elsif Including_RTS then - for J in Start .. Sw'Last loop - if Sw (J) = Directory_Separator then - Switch := - new String' - (Sw (1 .. Start - 1) & - Parent & - Directory_Separator & - Sw (Start .. Sw'Last)); - return; - end if; - end loop; - - else - Switch := - new String' - (Sw (1 .. Start - 1) & - Parent & - Directory_Separator & - Sw (Start .. Sw'Last)); - end if; - end if; - - elsif Including_Non_Switch then - if not Is_Absolute_Path (Sw) then - if Parent'Length = 0 then - Do_Fail - ("relative paths (""" & Sw & """) are not allowed"); - else - Switch := new String'(Parent & Directory_Separator & Sw); - end if; - end if; - end if; - end; - end if; - end Ensure_Absolute_Path; - ------------------- -- Unit_Index_Of -- ------------------- |