From: Tonu Naks <n...@adacore.com>

gcc/ada/ChangeLog:

        * adaint.c: change default behaviour of __gnat_locate_exec_on_path
        * adaint.h: change prototype of __gnat_locate_exec_on_path
        * libgnat/s-os_lib.adb: pass optional argument in Locate_Exec_On_Path
        * libgnat/s-os_lib.ads: change spec of Locate_Exec_On_Path
        * libgnat/s-trasym__dwarf.adb: update import of 
__gnat_locate_exec_on_path

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/adaint.c                    | 31 ++++++++++++++++-------------
 gcc/ada/adaint.h                    |  2 +-
 gcc/ada/libgnat/s-os_lib.adb        | 11 +++++++---
 gcc/ada/libgnat/s-os_lib.ads        |  9 ++++++++-
 gcc/ada/libgnat/s-trasym__dwarf.adb |  7 +++++--
 5 files changed, 39 insertions(+), 21 deletions(-)

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 9ccac305dde..0b6d4bb6b4e 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -3079,32 +3079,35 @@ __gnat_locate_exec (char *exec_name, char *path_val)
 /* Locate an executable using the Systems default PATH.  */
 
 char *
-__gnat_locate_exec_on_path (char *exec_name)
+__gnat_locate_exec_on_path (char *exec_name, int current_dir_on_windows)
 {
   char *apath_val;
 
 #if defined (_WIN32)
   TCHAR *wpath_val = _tgetenv (_T("PATH"));
-  TCHAR *wapath_val;
-  /* In Win32 systems we expand the PATH as for XP environment
-     variables are not automatically expanded. We also prepend the
-     ".;" to the path to match normal NT path search semantics */
-
   #define EXPAND_BUFFER_SIZE 32767
+  apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
 
-  wapath_val = (TCHAR *) alloca (EXPAND_BUFFER_SIZE);
+  if (current_dir_on_windows) {
+    TCHAR *wapath_val;
+    /* In Win32 systems we expand the PATH as for XP environment
+      variables are not automatically expanded. We also prepend the
+      ".;" to the path to match normal NT path search semantics */
 
-  wapath_val [0] = '.';
-  wapath_val [1] = ';';
+    wapath_val = (TCHAR *) alloca (EXPAND_BUFFER_SIZE);
 
-  DWORD res = ExpandEnvironmentStrings
-    (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
+    wapath_val [0] = '.';
+    wapath_val [1] = ';';
 
-  if (!res) wapath_val [0] = _T('\0');
+    DWORD res = ExpandEnvironmentStrings
+      (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
 
-  apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
+    if (!res) wapath_val [0] = _T('\0');
 
-  WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
+    WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
+  } else {
+    WS2SC (apath_val, wpath_val, EXPAND_BUFFER_SIZE);
+  }
 
 #else
   const char *path_val = getenv ("PATH");
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 0cbfd0e151d..26184640211 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -240,7 +240,7 @@ extern int    __gnat_portable_wait                 (int *);
 extern int    __gnat_portable_no_block_wait        (int *);
 extern int    __gnat_current_process_id            (void);
 extern char  *__gnat_locate_exec                   (char *, char *);
-extern char  *__gnat_locate_exec_on_path           (char *);
+extern char  *__gnat_locate_exec_on_path           (char *, int);
 extern char  *__gnat_locate_regular_file           (char *, char *);
 extern void   __gnat_maybe_glob_args               (int *, char ***);
 extern void   __gnat_os_exit                      (int);
diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb
index dd2156e1dcb..d249663e73a 100644
--- a/gcc/ada/libgnat/s-os_lib.adb
+++ b/gcc/ada/libgnat/s-os_lib.adb
@@ -34,6 +34,7 @@ with Ada.Unchecked_Deallocation;
 with System.Case_Util;
 with System.CRTL;
 with System.Soft_Links;
+with Interfaces.C;
 
 package body System.OS_Lib is
 
@@ -1641,9 +1642,12 @@ package body System.OS_Lib is
    -------------------------
 
    function Locate_Exec_On_Path
-     (Exec_Name : String) return String_Access
+     (Exec_Name : String;
+      Current_Dir_On_Win : Boolean := False) return String_Access
    is
-      function Locate_Exec_On_Path (C_Exec_Name : Address) return Address;
+      function Locate_Exec_On_Path
+        (C_Exec_Name        : Address;
+         Current_Dir_On_Win : Interfaces.C.int) return Address;
       pragma Import (C, Locate_Exec_On_Path, "__gnat_locate_exec_on_path");
 
       C_Exec_Name  : String (1 .. Exec_Name'Length + 1);
@@ -1655,7 +1659,8 @@ package body System.OS_Lib is
       C_Exec_Name (1 .. Exec_Name'Length)   := Exec_Name;
       C_Exec_Name (C_Exec_Name'Last)        := ASCII.NUL;
 
-      Path_Addr := Locate_Exec_On_Path (C_Exec_Name'Address);
+      Path_Addr := Locate_Exec_On_Path
+        (C_Exec_Name'Address, (if Current_Dir_On_Win then 1 else 0));
       Path_Len  := C_String_Length (Path_Addr);
 
       if Path_Len = 0 then
diff --git a/gcc/ada/libgnat/s-os_lib.ads b/gcc/ada/libgnat/s-os_lib.ads
index 54e7205c3e6..37ce8cfd855 100644
--- a/gcc/ada/libgnat/s-os_lib.ads
+++ b/gcc/ada/libgnat/s-os_lib.ads
@@ -494,13 +494,20 @@ package System.OS_Lib is
    --  used. Use Is_Owner_Readable_File/Is_Owner_Writable_File or
    --  Is_Read_Accessible_File/Is_Write_Accessible_File instead.
 
-   function Locate_Exec_On_Path (Exec_Name : String) return String_Access;
+   function Locate_Exec_On_Path
+     (Exec_Name : String;
+      Current_Dir_On_Win : Boolean := False) return String_Access;
    --  Try to locate an executable whose name is given by Exec_Name in the
    --  directories listed in the environment Path. If the Exec_Name does not
    --  have the executable suffix, it will be appended before the search.
    --  Otherwise works like Locate_Regular_File below. If the executable is
    --  not found, null is returned.
    --
+   --  When Current_Dir_On_Win is passed, attempt to look for the
+   --  executable on the current working directory before looking in
+   --  those listed on the PATH. This mimics the Windows behavior,
+   --  and only has an effect on Windows.
+   --
    --  Note that this function allocates memory for the returned value. This
    --  memory needs to be deallocated after use.
 
diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb 
b/gcc/ada/libgnat/s-trasym__dwarf.adb
index 6182316da55..2b9333d9aa1 100644
--- a/gcc/ada/libgnat/s-trasym__dwarf.adb
+++ b/gcc/ada/libgnat/s-trasym__dwarf.adb
@@ -45,6 +45,7 @@ with System.Standard_Library;
 with System.Traceback_Entries;
 with System.Strings;
 with System.Bounded_Strings;
+with Interfaces.C;
 
 package body System.Traceback.Symbolic is
 
@@ -341,7 +342,9 @@ package body System.Traceback.Symbolic is
       type Argv_Array is array (0 .. 0) of System.Address;
       package Conv is new System.Address_To_Access_Conversions (Argv_Array);
 
-      function locate_exec_on_path (A : System.Address) return System.Address;
+      function locate_exec_on_path
+        (A : System.Address;
+         Current_Dir_On_Win : Interfaces.C.int) return System.Address;
       pragma Import (C, locate_exec_on_path, "__gnat_locate_exec_on_path");
 
    begin
@@ -361,7 +364,7 @@ package body System.Traceback.Symbolic is
            Conv.To_Pointer (Gnat_Argv) (0);
 
          Resolved_Argv0 : constant System.Address :=
-           locate_exec_on_path (Argv0);
+           locate_exec_on_path (Argv0, 0);
 
          Exe_Argv : constant System.Address :=
            (if Resolved_Argv0 /= System.Null_Address
-- 
2.43.0

Reply via email to