From: Arnaud Charlet <charlet@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Bob Duff <duff@adacore.com>
Subject: [Ada] Raise exception if Current_Directory does not exist
Date: Thu, 27 Apr 2017 09:25:00 -0000 [thread overview]
Message-ID: <20170427092250.GA124270@adacore.com> (raw)
[-- 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;
reply other threads:[~2017-04-27 9:22 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170427092250.GA124270@adacore.com \
--to=charlet@adacore.com \
--cc=duff@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).