committed: PR 12950 changes
Arnaud Charlet
charlet@ACT-Europe.FR
Mon Nov 10 09:44:00 GMT 2003
2003-11-10 Arnaud Charlet <charlet@act-europe.fr>
PR 12950
* osint.ads, osint.adb (Relocate_Path, Executable_Suffix): New
functions. Used to handle dynamic prefix relocation, via set_std_prefix.
Replace GNAT_ROOT by GCC_ROOT.
* Make-lang.in: Use new function Relocate_Path to generate sdefault.adb
--
Index: osint.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/osint.adb,v
retrieving revision 1.12
diff -u -c -3 -p -r1.12 osint.adb
*** osint.adb 21 Oct 2003 13:42:10 -0000 1.12
--- osint.adb 10 Nov 2003 09:39:33 -0000
***************
*** 24,35 ****
-- --
------------------------------------------------------------------------------
! with Fmap; use Fmap;
with Hostparm;
! with Namet; use Namet;
! with Opt; use Opt;
! with Output; use Output;
! with Sdefault; use Sdefault;
with Table;
with Unchecked_Conversion;
--- 24,36 ----
-- --
------------------------------------------------------------------------------
! with Fmap; use Fmap;
with Hostparm;
! with Namet; use Namet;
! with Opt; use Opt;
! with Output; use Output;
! with Sdefault; use Sdefault;
! with System.Case_Util; use System.Case_Util;
with Table;
with Unchecked_Conversion;
*************** package body Osint is
*** 42,47 ****
--- 43,52 ----
Running_Program : Program_Type := Unspecified;
Program_Set : Boolean := False;
+ Std_Prefix : String_Ptr;
+ -- Standard prefix, computed dynamically the first time Relocate_Path
+ -- is called, and cached for subsequent calls.
+
-------------------------------------
-- Use of Name_Find and Name_Enter --
-------------------------------------
*************** package body Osint is
*** 71,76 ****
--- 76,89 ----
function Concat (String_One : String; String_Two : String) return String;
-- Concatenates 2 strings and returns the result of the concatenation
+ function Executable_Prefix return String_Ptr;
+ -- Returns the name of the root directory where the executable is stored.
+ -- The executable must be located in a directory called "bin", or
+ -- under root/lib/gcc-lib/..., or under root/libexec/gcc/... Thus, if
+ -- the executable is stored in directory "/foo/bar/bin", this routine
+ -- returns "/foo/bar/".
+ -- Return "" if the location is not recognized as described above.
+
function Update_Path (Path : String_Ptr) return String_Ptr;
-- Update the specified path to replace the prefix with the location
-- where GNAT is installed. See the file prefix.c in GCC for details.
*************** package body Osint is
*** 735,740 ****
--- 748,810 ----
return Name_Enter;
end Executable_Name;
+ -------------------------
+ -- Executable_Prefix --
+ -------------------------
+
+ function Executable_Prefix return String_Ptr is
+ Exec_Name : String (1 .. Len_Arg (0));
+
+ function Get_Install_Dir (Exec : String) return String_Ptr;
+ -- S is the executable name preceeded by the absolute or relative
+ -- path, e.g. "c:\usr\bin\gcc.exe" or "..\bin\gcc".
+
+ ---------------------
+ -- Get_Install_Dir --
+ ---------------------
+
+ function Get_Install_Dir (Exec : String) return String_Ptr is
+ begin
+ for J in reverse Exec'Range loop
+ if Is_Directory_Separator (Exec (J)) then
+ if J < Exec'Last - 5 then
+ if (To_Lower (Exec (J + 1)) = 'l'
+ and then To_Lower (Exec (J + 2)) = 'i'
+ and then To_Lower (Exec (J + 3)) = 'b')
+ or else
+ (To_Lower (Exec (J + 1)) = 'b'
+ and then To_Lower (Exec (J + 2)) = 'i'
+ and then To_Lower (Exec (J + 3)) = 'n')
+ then
+ return new String'(Exec (Exec'First .. J));
+ end if;
+ end if;
+ end if;
+ end loop;
+
+ return new String'("");
+ end Get_Install_Dir;
+
+ -- Beginning of Executable_Prefix
+
+ begin
+ Osint.Fill_Arg (Exec_Name'Address, 0);
+
+ -- First determine if a path prefix was placed in front of the
+ -- executable name.
+
+ for J in reverse Exec_Name'Range loop
+ if Is_Directory_Separator (Exec_Name (J)) then
+ return Get_Install_Dir (Exec_Name);
+ end if;
+ end loop;
+
+ -- If you are here, the user has typed the executable name with no
+ -- directory prefix.
+
+ return Get_Install_Dir (GNAT.OS_Lib.Locate_Exec_On_Path (Exec_Name).all);
+ end Executable_Prefix;
+
------------------
-- Exit_Program --
------------------
*************** package body Osint is
*** 2074,2079 ****
--- 2144,2187 ----
end Read_Source_File;
+ -------------------
+ -- Relocate_Path --
+ -------------------
+
+ function Relocate_Path
+ (Prefix : String;
+ Path : String) return String_Ptr
+ is
+ S : String_Ptr;
+
+ procedure set_std_prefix (S : String; Len : Integer);
+ pragma Import (C, set_std_prefix);
+
+ begin
+ if Std_Prefix = null then
+ Std_Prefix := Executable_Prefix;
+
+ if Std_Prefix.all /= "" then
+ -- Remove trailing directory separator when calling set_std_prefix
+
+ set_std_prefix (Std_Prefix.all, Std_Prefix'Length - 1);
+ end if;
+ end if;
+
+ if Path (Prefix'Range) = Prefix then
+ if Std_Prefix.all /= "" then
+ S := new String
+ (1 .. Std_Prefix'Length + Path'Last - Prefix'Last);
+ S (1 .. Std_Prefix'Length) := Std_Prefix.all;
+ S (Std_Prefix'Length + 1 .. S'Last) :=
+ Path (Prefix'Last + 1 .. Path'Last);
+ return S;
+ end if;
+ end if;
+
+ return new String'(Path);
+ end Relocate_Path;
+
-----------------
-- Set_Program --
-----------------
*************** package body Osint is
*** 2493,2499 ****
In_Length : constant Integer := Path'Length;
In_String : String (1 .. In_Length + 1);
! Component_Name : aliased String := "GNAT" & ASCII.NUL;
Result_Ptr : Address;
Result_Length : Integer;
Out_String : String_Ptr;
--- 2601,2607 ----
In_Length : constant Integer := Path'Length;
In_String : String (1 .. In_Length + 1);
! Component_Name : aliased String := "GCC" & ASCII.NUL;
Result_Ptr : Address;
Result_Length : Integer;
Out_String : String_Ptr;
Index: osint.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/osint.ads,v
retrieving revision 1.8
diff -u -c -3 -p -r1.8 osint.ads
*** osint.ads 21 Oct 2003 13:42:10 -0000 1.8
--- osint.ads 10 Nov 2003 09:39:33 -0000
*************** package Osint is
*** 202,207 ****
--- 202,218 ----
return String_Access;
-- Convert a canonical syntax file specification to host syntax.
+ function Relocate_Path
+ (Prefix : String;
+ Path : String) return String_Ptr;
+ -- Given an absolute path and a prefix, if Path starts with Prefix,
+ -- replace the Prefix substring with the root installation directory.
+ -- By default, try to compute the root installation directory by looking
+ -- at the executable name as it was typed on the command line and, if
+ -- needed, use the PATH environment variable.
+ -- If the above computation fails, return Path.
+ -- This function assumes that Prefix'First = Path'First
+
-------------------------
-- Search Dir Routines --
-------------------------
Index: Make-lang.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Make-lang.in,v
retrieving revision 1.49
diff -u -c -3 -p -r1.49 Make-lang.in
*** Make-lang.in 4 Nov 2003 12:51:46 -0000 1.49
--- Make-lang.in 10 Nov 2003 09:39:33 -0000
*************** ada/sdefault.adb: ada/stamp-sdefault ; @
*** 1075,1100 ****
ada/stamp-sdefault : $(srcdir)/version.c $(srcdir)/move-if-change \
Makefile
$(ECHO) "pragma Style_Checks (Off);" >tmp-sdefault.adb
$(ECHO) "package body Sdefault is" >>tmp-sdefault.adb
! $(ECHO) " S1 : aliased constant String := \"$(ADA_INCLUDE_DIR)/\";" >>tmp-sdefault.adb
! $(ECHO) " S2 : aliased constant String := \"$(ADA_RTL_OBJ_DIR)/\";" >>tmp-sdefault.adb
! $(ECHO) " S3 : aliased constant String := \"$(target)/\";" >>tmp-sdefault.adb
! $(ECHO) " S4 : aliased constant String := \"$(libsubdir)/\";" >>tmp-sdefault.adb
$(ECHO) " function Include_Dir_Default_Name return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return new String'(S1);" >>tmp-sdefault.adb
$(ECHO) " end Include_Dir_Default_Name;" >>tmp-sdefault.adb
$(ECHO) " function Object_Dir_Default_Name return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return new String'(S2);" >>tmp-sdefault.adb
$(ECHO) " end Object_Dir_Default_Name;" >>tmp-sdefault.adb
$(ECHO) " function Target_Name return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return new String'(S3);" >>tmp-sdefault.adb
$(ECHO) " end Target_Name;" >>tmp-sdefault.adb
$(ECHO) " function Search_Dir_Prefix return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return new String'(S4);" >>tmp-sdefault.adb
$(ECHO) " end Search_Dir_Prefix;" >>tmp-sdefault.adb
$(ECHO) "end Sdefault;" >> tmp-sdefault.adb
$(srcdir)/move-if-change tmp-sdefault.adb ada/sdefault.adb
--- 1075,1102 ----
ada/stamp-sdefault : $(srcdir)/version.c $(srcdir)/move-if-change \
Makefile
$(ECHO) "pragma Style_Checks (Off);" >tmp-sdefault.adb
+ $(ECHO) "with Osint; use Osint;" >>tmp-sdefault.adb
$(ECHO) "package body Sdefault is" >>tmp-sdefault.adb
! $(ECHO) " S0 : constant String := \"$(prefix)/\";" >>tmp-sdefault.adb
! $(ECHO) " S1 : constant String := \"$(ADA_INCLUDE_DIR)/\";" >>tmp-sdefault.adb
! $(ECHO) " S2 : constant String := \"$(ADA_RTL_OBJ_DIR)/\";" >>tmp-sdefault.adb
! $(ECHO) " S3 : constant String := \"$(target)/\";" >>tmp-sdefault.adb
! $(ECHO) " S4 : constant String := \"$(libsubdir)/\";" >>tmp-sdefault.adb
$(ECHO) " function Include_Dir_Default_Name return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return Relocate_Path (S0, S1);" >>tmp-sdefault.adb
$(ECHO) " end Include_Dir_Default_Name;" >>tmp-sdefault.adb
$(ECHO) " function Object_Dir_Default_Name return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return Relocate_Path (S0, S2);" >>tmp-sdefault.adb
$(ECHO) " end Object_Dir_Default_Name;" >>tmp-sdefault.adb
$(ECHO) " function Target_Name return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return Relocate_Path (S0, S3);" >>tmp-sdefault.adb
$(ECHO) " end Target_Name;" >>tmp-sdefault.adb
$(ECHO) " function Search_Dir_Prefix return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
! $(ECHO) " return Relocate_Path (S0, S4);" >>tmp-sdefault.adb
$(ECHO) " end Search_Dir_Prefix;" >>tmp-sdefault.adb
$(ECHO) "end Sdefault;" >> tmp-sdefault.adb
$(srcdir)/move-if-change tmp-sdefault.adb ada/sdefault.adb
More information about the Gcc-patches
mailing list