From patchwork Mon Jun 21 15:24:46 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56327 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 0EBF6B6F10 for ; Tue, 22 Jun 2010 01:25:01 +1000 (EST) Received: (qmail 30987 invoked by alias); 21 Jun 2010 15:24:56 -0000 Received: (qmail 30940 invoked by uid 22791); 21 Jun 2010 15:24:52 -0000 X-SWARE-Spam-Status: No, hits=-1.5 required=5.0 tests=AWL, BAYES_00, KAM_ADVERT2, TW_PR, T_FILL_THIS_FORM_SHORT, T_RP_MATCHES_RCVD 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; Mon, 21 Jun 2010 15:24:47 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 35A65CB029A; Mon, 21 Jun 2010 17:24:46 +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 IJn7U9WhizsZ; Mon, 21 Jun 2010 17:24:46 +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 232C5CB0299; Mon, 21 Jun 2010 17:24:46 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 1BC81D9A01; Mon, 21 Jun 2010 17:24:46 +0200 (CEST) Date: Mon, 21 Jun 2010 17:24:46 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Celier Subject: [Ada] Exceptions not in specified list of sources Message-ID: <20100621152446.GA20071@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 When there are specified bodies or specs in package Naming for sources thare are not in the list of sources specified with attributes Source_Files or Source_List_File, if these sources are found in the source directories, the Project Manager adds these sources to the list. This patch ensures that this no longer happens. The test for this is to invoke gnatmake on the following project file with all the named sources available: project Ticket2 is for Source_Files use ("package_1.adb", "package_1.ads"); package Naming is for Spec ("unwanted_package_1") use "unwanted_package_1.ads"; for Body ("unwanted_package_1") use "unwanted_package_1.adb"; for Spec ("package_1") use "package_1.ads"; for Body ("package_1") use "package_1.adb"; end Naming; end Ticket2; Only package_1.adb should be compiled and there should be a warning about unknown source files unwanted_package_1.ads and unwanted_package_1.adb. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-21 Vincent Celier * prj-nmsc.adb (Name_Location): New Boolean component Listed, to record source files in specified list of sources. (Check_Package_Naming): Remove out parameters Bodies and Specs, as they are never used. (Add_Source): Set the Location of the new source (Process_Exceptions_File_Based): Call Add_Source with the Location (Get_Sources_From_File): If an exception is found, set its Listed to True (Find_Sources): When Source_Files is specified, if an exception is found, set its Listed to True. Remove any exception that is not in a specified list of sources. * prj.ads (Source_Data): New component Location Index: prj.ads =================================================================== --- prj.ads (revision 161073) +++ prj.ads (working copy) @@ -667,6 +667,10 @@ package Prj is Project : Project_Id := No_Project; -- Project of the source + Location : Source_Ptr := No_Location; + -- Location in the project file of the declaration of the source in + -- package Naming. + Source_Dir_Rank : Natural := 0; -- The rank of the source directory in list declared with attribute -- Source_Dirs. Two source files with the same name cannot appears in @@ -768,6 +772,7 @@ package Prj is No_Source_Data : constant Source_Data := (Project => No_Project, + Location => No_Location, Source_Dir_Rank => 0, Language => No_Language_Index, In_Interfaces => True, Index: prj-nmsc.adb =================================================================== --- prj-nmsc.adb (revision 161077) +++ prj-nmsc.adb (working copy) @@ -54,10 +54,11 @@ package body Prj.Nmsc is Name : File_Name_Type; -- ??? duplicates the key Location : Source_Ptr; Source : Source_Id := No_Source; + Listed : Boolean := False; Found : Boolean := False; end record; No_Name_Location : constant Name_Location := - (No_File, No_Location, No_Source, False); + (No_File, No_Location, No_Source, False, False); package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, Element => Name_Location, @@ -234,13 +235,9 @@ package body Prj.Nmsc is procedure Check_Package_Naming (Project : Project_Id; - Data : in out Tree_Processing_Data; - Bodies : out Array_Element_Id; - Specs : out Array_Element_Id); + Data : in out Tree_Processing_Data); -- Check the naming scheme part of Data, and initialize the naming scheme - -- data in the config of the various languages. This also returns the - -- naming scheme exceptions for unit-based languages (Bodies and Specs are - -- associative arrays mapping individual unit names to source file names). + -- data in the config of the various languages. procedure Check_Configuration (Project : Project_Id; @@ -727,6 +724,7 @@ package body Prj.Nmsc is end if; Id.Project := Project; + Id.Location := Location; Id.Source_Dir_Rank := Source_Dir_Rank; Id.Language := Lang_Id; Id.Kind := Kind; @@ -816,8 +814,6 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is - Specs : Array_Element_Id; - Bodies : Array_Element_Id; Extending : Boolean := False; Prj_Data : Project_Processing_Data; @@ -889,7 +885,7 @@ package body Prj.Nmsc is Extending := Project.Extends /= No_Project; - Check_Package_Naming (Project, Data, Bodies => Bodies, Specs => Specs); + Check_Package_Naming (Project, Data); -- Find the sources @@ -2722,9 +2718,7 @@ package body Prj.Nmsc is procedure Check_Package_Naming (Project : Project_Id; - Data : in out Tree_Processing_Data; - Bodies : out Array_Element_Id; - Specs : out Array_Element_Id) + Data : in out Tree_Processing_Data) is Naming_Id : constant Package_Id := Util.Value_Of @@ -2957,7 +2951,8 @@ package body Prj.Nmsc is Kind => Kind, File_Name => File_Name, Display_File => File_Name_Type (Element.Value), - Naming_Exception => True); + Naming_Exception => True, + Location => Element.Location); else -- Check if the file name is already recorded for another @@ -3380,9 +3375,6 @@ package body Prj.Nmsc is -- Start of processing for Check_Naming_Schemes begin - Specs := No_Array_Element; - Bodies := No_Array_Element; - -- No Naming package or parsing a configuration file? nothing to do if Naming_Id /= No_Package @@ -5557,7 +5549,11 @@ package body Prj.Nmsc is (Name => Source_Name, Location => Location, Source => No_Source, + Listed => True, Found => False); + + else + Name_Loc.Listed := True; end if; Source_Names_Htable.Set @@ -6292,11 +6288,16 @@ package body Prj.Nmsc is (Name => Name, Location => Location, Source => No_Source, + Listed => True, Found => False); - Source_Names_Htable.Set - (Project.Source_Names, Name, Name_Loc); + + else + Name_Loc.Listed := True; end if; + Source_Names_Htable.Set + (Project.Source_Names, Name, Name_Loc); + Current := Element.Next; end loop; @@ -6343,6 +6344,57 @@ package body Prj.Nmsc is Has_Explicit_Sources := False; end if; + -- Remove any exception that is not in the specified list of sources + + if Has_Explicit_Sources then + declare + Source : Source_Id; + Iter : Source_Iterator; + NL : Name_Location; + Again : Boolean; + begin + Iter_Loop : + loop + Again := False; + Iter := For_Each_Source (Data.Tree, Project.Project); + + Source_Loop : + loop + Source := Prj.Element (Iter); + exit Source_Loop when Source = No_Source; + + if Source.Naming_Exception then + NL := Source_Names_Htable.Get + (Project.Source_Names, Source.File); + + if NL /= No_Name_Location and then not NL.Listed then + -- Remove the exception + Source_Names_Htable.Set + (Project.Source_Names, + Source.File, + No_Name_Location); + Remove_Source (Source, No_Source); + + Error_Msg_Name_1 := Name_Id (Source.File); + Error_Msg + (Data.Flags, + "? unknown source file %%", + NL.Location, + Project.Project); + + Again := True; + exit Source_Loop; + end if; + end if; + + Next (Iter); + end loop Source_Loop; + + exit Iter_Loop when not Again; + end loop Iter_Loop; + end; + end if; + Search_Directories (Project, Data => Data, @@ -7031,8 +7083,9 @@ package body Prj.Nmsc is K => Source.File, E => Name_Location' (Name => Source.File, - Location => No_Location, + Location => Source.Location, Source => Source, + Listed => False, Found => False)); -- If this is an Ada exception, record in table Unit_Exceptions