From patchwork Fri Sep 10 09:57:58 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 64365 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 4C72FB711E for ; Fri, 10 Sep 2010 19:58:09 +1000 (EST) Received: (qmail 19020 invoked by alias); 10 Sep 2010 09:58:07 -0000 Received: (qmail 18997 invoked by uid 22791); 10 Sep 2010 09:58:05 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD, WEIRD_QUOTING X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 10 Sep 2010 09:58:01 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 1C4EFCB0246; Fri, 10 Sep 2010 11:57:59 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 6G2TaJp+d-b2; Fri, 10 Sep 2010 11:57:59 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 08F40CB01E0; Fri, 10 Sep 2010 11:57:59 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id DFAAFD9BB4; Fri, 10 Sep 2010 11:57:58 +0200 (CEST) Date: Fri, 10 Sep 2010 11:57:58 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Geert Bosch Subject: [Ada] Refuse executable with same name as source Message-ID: <20100910095758.GA18263@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Currently it is possible to accidentally and silently overwrite a source file with an executable, if the sourcefile has no file extension and the operating system uses no file extensions for executables. This fixes that. The following test case should not overwrite hello with an executable, but instead exit with an error message: % cat >hello < with Text_IO; use Text_IO; > procedure Hello is > begin > Put_Line ("This source self-destructs after compilation"); > end Hello; > EOF gcc -c -x ada hello hello:2:11: warning: file name does not match unit name, should be "hello.adb" gnatbind -x hello.ali gnatlink hello.ali gnatlink: executable name "hello" matches source file name "hello" gnatmake: *** link failed. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-09-10 Geert Bosch * gnatlink.adb (Check_ Existing_Executable): New procedure for checking validity of executable name and removing any existing executable (Gnatlink): Call Check_Existing_Executable. Index: gnatlink.adb =================================================================== --- gnatlink.adb (revision 164149) +++ gnatlink.adb (working copy) @@ -199,6 +199,13 @@ procedure Gnatlink is function Base_Name (File_Name : String) return String; -- Return just the file name part without the extension (if present) + procedure Check_Existing_Executable (File_Name : String); + -- Delete any existing executable to avoid accidentally updating + -- the target of a symbolic link, but produce a Fatail_Error if + -- File_Name matches any of the source file names. This avoids + -- overwriting of extensionless source files by accident on systems + -- where executables do not have extensions. + procedure Delete (Name : String); -- Wrapper to unlink as status is ignored by this application @@ -258,6 +265,31 @@ procedure Gnatlink is return File_Name (Findex1 .. Findex2 - 1); end Base_Name; + ------------------------------- + -- Check_Existing_Executable -- + ------------------------------- + + procedure Check_Existing_Executable (File_Name : String) is + Ename : String := File_Name; + Efile : File_Name_Type; + Sfile : File_Name_Type; + begin + Canonical_Case_File_Name (Ename); + Name_Len := 0; + Add_Str_To_Name_Buffer (Ename); + Efile := Name_Find; + + for J in Units.Table'First .. Units.Last loop + Sfile := Units.Table (J).Sfile; + if Sfile = Efile then + Exit_With_Error ("executable name """ & File_Name & """ matches " + & "source file name """ & Get_Name_String (Sfile) & """"); + end if; + end loop; + + Delete (File_Name); + end Check_Existing_Executable; + ------------ -- Delete -- ------------ @@ -1759,16 +1791,7 @@ begin new String'(Output_File_Name.all); end if; - -- Delete existing executable, in case it is a symbolic link, to avoid - -- modifying the target of the symbolic link. - - declare - Dummy : Boolean; - pragma Unreferenced (Dummy); - - begin - Delete_File (Output_File_Name.all, Dummy); - end; + Check_Existing_Executable (Output_File_Name.all); -- Warn if main program is called "test", as that may be a built-in command -- on Unix. On non-Unix systems executables have a suffix, so the warning