https://gcc.gnu.org/g:fdf84665158e44c4dc0fdc63b023784a8c091f04
commit r15-6522-gfdf84665158e44c4dc0fdc63b023784a8c091f04
Author: Tonu Naks <n...@adacore.com>
Date: Tue Dec 3 12:50:45 2024 +0000
ada: Do not search executables in current dir by default
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
Diff:
---
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 9ccac305dde9..0b6d4bb6b4e5 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 0cbfd0e151d8..26184640211a 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 dd2156e1dcb5..d249663e73a4 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 54e7205c3e6a..37ce8cfd855c 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 6182316da554..2b9333d9aa1b 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
