Patchwork [Ada] Exceptions not in specified list of sources

login
register
mail settings
Submitter Arnaud Charlet
Date June 21, 2010, 3:24 p.m.
Message ID <20100621152446.GA20071@adacore.com>
Download mbox | patch
Permalink /patch/56327/
State New
Headers show

Comments

Arnaud Charlet - June 21, 2010, 3:24 p.m.
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  <celier@adacore.com>

	* 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

Patch

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