* [Ada] Raise exception if Current_Directory does not exist
@ 2017-04-27 9:25 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2017-04-27 9:25 UTC (permalink / raw)
To: gcc-patches; +Cc: Bob Duff
[-- Attachment #1: Type: text/plain, Size: 1112 bytes --]
This patch fixes a bug in which Ada.Directories.Current_Directory
returns invalid data if the current directory does not exist.
The following test should run silently:
rm -rf bug7550
mkdir -p bug7550
cd bug7550
cp ../bug7550.adb .
gnatmake -q -f bug7550.adb -o bug7550
./bug7550 &
cd ..
sleep 1
rm -rf bug7550
with Ada.IO_Exceptions;
with Ada.Directories;
with Ada.Text_IO;
with Ada.Strings.Fixed;
procedure bug7550 is
begin
loop
declare
check : constant String := Ada.Directories.Current_Directory;
begin
if Ada.Strings.Fixed.Index (check, "bug7550") = 0 then
Ada.Text_IO.Put_Line
("invalid current directory returned: " & check);
exit;
end if;
end;
delay 0.1;
end loop;
exception
when Ada.IO_Exceptions.Use_Error =>
null; -- OK
end bug7550;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-27 Bob Duff <duff@adacore.com>
* adaint.c (__gnat_get_current_dir): Return 0 in length if
getcwd fails.
* a-direct.adb, g-dirope.adb, osint.adb, s-os_lib.adb: Raise
exception if getcwd failed.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 5532 bytes --]
Index: a-direct.adb
===================================================================
--- a-direct.adb (revision 247293)
+++ a-direct.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2017, Free Software Foundation, Inc. --
-- --
-- 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- --
@@ -528,6 +528,10 @@
begin
Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
+ if Path_Len = 0 then
+ raise Use_Error with "current directory does not exist";
+ end if;
+
-- We need to resolve links because of RM A.16(47), which requires
-- that we not return alternative names for files.
Index: g-dirope.adb
===================================================================
--- g-dirope.adb (revision 247293)
+++ g-dirope.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2014, AdaCore --
+-- Copyright (C) 1998-2017, 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- --
@@ -29,6 +29,7 @@
-- --
------------------------------------------------------------------------------
+with Ada.IO_Exceptions;
with Ada.Characters.Handling;
with Ada.Strings.Fixed;
@@ -573,6 +574,11 @@
begin
Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
+ if Path_Len = 0 then
+ raise Ada.IO_Exceptions.Use_Error
+ with "current directory does not exist";
+ end if;
+
Last :=
(if Dir'Length > Path_Len then Dir'First + Path_Len - 1 else Dir'Last);
Index: adaint.c
===================================================================
--- adaint.c (revision 247293)
+++ adaint.c (working copy)
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2015, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2017, Free Software Foundation, Inc. *
* *
* 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- *
@@ -613,7 +613,16 @@
WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
#else
- getcwd (dir, *length);
+ char* result = getcwd (dir, *length);
+ /* If the current directory does not exist, set length = 0
+ to indicate error. That can't happen on windows, where
+ you can't delete a directory if it is the current
+ directory of some process. */
+ if (!result)
+ {
+ *length = 0;
+ return;
+ }
#endif
*length = strlen (dir);
Index: osint.adb
===================================================================
--- osint.adb (revision 247293)
+++ osint.adb (working copy)
@@ -1550,6 +1550,10 @@
begin
Get_Current_Dir (Buffer'Address, Path_Len'Address);
+ if Path_Len = 0 then
+ raise Program_Error;
+ end if;
+
if Buffer (Path_Len) /= Directory_Separator then
Path_Len := Path_Len + 1;
Buffer (Path_Len) := Directory_Separator;
Index: s-os_lib.adb
===================================================================
--- s-os_lib.adb (revision 247293)
+++ s-os_lib.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2016, AdaCore --
+-- Copyright (C) 1995-2017, 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- --
@@ -2191,6 +2191,10 @@
begin
Get_Current_Dir (Buffer'Address, Path_Len'Address);
+ if Path_Len = 0 then
+ raise Program_Error;
+ end if;
+
if Buffer (Path_Len) /= Directory_Separator then
Path_Len := Path_Len + 1;
Buffer (Path_Len) := Directory_Separator;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2017-04-27 9:22 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-04-27 9:25 [Ada] Raise exception if Current_Directory does not exist Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).