From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 122894 invoked by alias); 27 Apr 2017 09:22:52 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 122805 invoked by uid 89); 27 Apr 2017 09:22:52 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.2 spammy=sk:directo, sk:Directo, 5286 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 27 Apr 2017 09:22:50 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id AB5445A5A7; Thu, 27 Apr 2017 05:22:50 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id Qm5rd7hA07Q2; Thu, 27 Apr 2017 05:22:50 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 9AF295A5A2; Thu, 27 Apr 2017 05:22:50 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 991094F9; Thu, 27 Apr 2017 05:22:50 -0400 (EDT) Date: Thu, 27 Apr 2017 09:25:00 -0000 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Raise exception if Current_Directory does not exist Message-ID: <20170427092250.GA124270@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="Q68bSM7Ycu6FN28Q" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-SW-Source: 2017-04/txt/msg01364.txt.bz2 --Q68bSM7Ycu6FN28Q Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 1112 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 * 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. --Q68bSM7Ycu6FN28Q Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=difs Content-length: 5532 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; --Q68bSM7Ycu6FN28Q--