prj.ads (Error_Warning): New enumeration type

2006-02-13  Vincent Celier  <celier@adacore.com>

	* prj.ads (Error_Warning): New enumeration type

	* prj-nmsc.ads, prj-nmsc.adb (Error_Msg): If location parameter is
	unknown, use the location of the project to report the error.
	(When_No_Sources): New global variable
	(Report_No_Ada_Sources): New procedure
	(Check): New parameter When_No_Sources. Set value of global variable
	When_No_Sources,
	(Find_Sources): Call Report_No_Ada_Sources when appropriate
	(Get_Sources_From_File): Ditto
	(Warn_If_Not_Sources): Better warning messages indicating the unit name
	and the file name.

	* prj-pars.ads, prj-pars.adb (Parse): New parameter When_No_Sources.
	Call Prj.Proc.Process with parameter When_No_Sources.

	* prj-proc.ads, prj-proc.adb (Check): New parameter When_No_Sources.
	Call Recursive_Check with parameter When_No_Sources.
	(Recursive_Check): New parameter When_No_Sources. Call itself and
	Prj.Nmsc.Check with parameter When_No_Sources.
	(Process): New parameter When_No_Sources. Call Check with parameter
	When_No_Sources.
	(Copy_Package_Declarations): New procedure to copy renamed parameters
	and setting the location of the declared attributes to the location
	of the renamed package.
	(Process_Declarative_Items): Call Copy_Package_Declarations for renamed
	packages.

From-SVN: r111084

gcc/ada/prj-nmsc.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2006, 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- --
@@ -27,11 +27,10 @@
 with Err_Vars; use Err_Vars;
 with Fmap;     use Fmap;
 with Hostparm;
-with MLib.Tgt;
+with MLib.Tgt; use MLib.Tgt;
 with Namet;    use Namet;
 with Osint;    use Osint;
 with Output;   use Output;
-with MLib.Tgt; use MLib.Tgt;
 with Prj.Env;  use Prj.Env;
 with Prj.Err;
 with Prj.Util; use Prj.Util;
@@ -54,6 +53,10 @@ package body Prj.Nmsc is
    Error_Report : Put_Line_Access := null;
    --  Set to point to error reporting procedure
 
+   When_No_Sources : Error_Warning := Error;
+   --  Indicates what should be done when there is no Ada sources in a non
+   --  extending Ada project.
+
    ALI_Suffix   : constant String := ".ali";
    --  File suffix for ali files
 
@@ -352,6 +355,12 @@ package body Prj.Nmsc is
    --  When Naming_Exceptions is True, mark the found sources as such, to
    --  later remove those that are not named in a list of sources.
 
+   procedure Report_No_Ada_Sources
+     (Project  : Project_Id;
+      In_Tree  : Project_Tree_Ref;
+      Location : Source_Ptr);
+   --  Report an error or a warning depending on the value of When_No_Sources
+
    procedure Show_Source_Dirs
      (Project : Project_Id; In_Tree : Project_Tree_Ref);
    --  List all the source directories of a project
@@ -401,12 +410,14 @@ package body Prj.Nmsc is
      (Project         : Project_Id;
       In_Tree         : Project_Tree_Ref;
       Report_Error    : Put_Line_Access;
-      Follow_Links : Boolean)
+      Follow_Links    : Boolean;
+      When_No_Sources : Error_Warning)
    is
       Data      : Project_Data := In_Tree.Projects.Table (Project);
       Extending : Boolean := False;
 
    begin
+      Nmsc.When_No_Sources := When_No_Sources;
       Error_Report := Report_Error;
 
       Recursive_Dirs.Reset;
@@ -2793,6 +2804,7 @@ package body Prj.Nmsc is
       Msg           : String;
       Flag_Location : Source_Ptr)
    is
+      Real_Location : Source_Ptr := Flag_Location;
       Error_Buffer : String (1 .. 5_000);
       Error_Last   : Natural := 0;
       Msg_Name     : Natural := 0;
@@ -2832,8 +2844,14 @@ package body Prj.Nmsc is
    --  Start of processing for Error_Msg
 
    begin
+      --  If location of error is unknown, use the location of the project
+
+      if Real_Location = No_Location then
+         Real_Location := In_Tree.Projects.Table (Project).Location;
+      end if;
+
       if Error_Report = null then
-         Prj.Err.Error_Msg (Msg, Flag_Location);
+         Prj.Err.Error_Msg (Msg, Real_Location);
          return;
       end if;
 
@@ -3024,10 +3042,7 @@ package body Prj.Nmsc is
             Data.Ada_Sources_Present := True;
 
          elsif Data.Extends = No_Project then
-            Error_Msg
-              (Project, In_Tree,
-               "there are no Ada sources in this project",
-               Data.Location);
+            Report_No_Ada_Sources (Project, In_Tree, Data.Location);
          end if;
       end if;
    end Find_Sources;
@@ -4243,12 +4258,10 @@ package body Prj.Nmsc is
          Get_Path_Names_And_Record_Sources (Follow_Links);
 
          --  We should have found at least one source.
-         --  If not, report an error.
+         --  If not, report an error/warning.
 
          if Data.Sources = Nil_String then
-            Error_Msg (Project, In_Tree,
-                       "there are no Ada sources in this project",
-                       Location);
+            Report_No_Ada_Sources (Project, In_Tree, Location);
          end if;
       end Get_Sources_From_File;
 
@@ -5304,6 +5317,30 @@ package body Prj.Nmsc is
       end if;
    end Record_Other_Sources;
 
+   ---------------------------
+   -- Report_No_Ada_Sources --
+   ---------------------------
+
+   procedure Report_No_Ada_Sources
+     (Project  : Project_Id;
+      In_Tree  : Project_Tree_Ref;
+      Location : Source_Ptr)
+   is
+   begin
+      case When_No_Sources is
+         when Silent =>
+            null;
+
+         when Warning | Error =>
+            Error_Msg_Warn := When_No_Sources = Warning;
+
+            Error_Msg
+              (Project, In_Tree,
+               "<there are no Ada sources in this project",
+               Location);
+      end case;
+   end Report_No_Ada_Sources;
+
    ----------------------
    -- Show_Source_Dirs --
    ----------------------
@@ -5413,6 +5450,8 @@ package body Prj.Nmsc is
 
          else
             The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
+            Error_Msg_Name_2 :=
+              In_Tree.Array_Elements.Table (Conv).Value.Value;
 
             if Specs then
                if not Check_Project
@@ -5421,7 +5460,8 @@ package body Prj.Nmsc is
                then
                   Error_Msg
                     (Project, In_Tree,
-                     "?unit{ has no spec in this project",
+                     "?source of spec of unit { ({)" &
+                     " cannot be found in this project",
                      Location);
                end if;
 
@@ -5432,7 +5472,8 @@ package body Prj.Nmsc is
                then
                   Error_Msg
                     (Project, In_Tree,
-                     "?unit{ has no body in this project",
+                     "?source of body of unit { ({)" &
+                     " cannot be found in this project",
                      Location);
                end if;
             end if;

gcc/ada/prj-nmsc.ads

@@ -36,7 +36,8 @@ private package Prj.Nmsc is
      (Project         : Project_Id;
       In_Tree         : Project_Tree_Ref;
       Report_Error    : Put_Line_Access;
-      Follow_Links : Boolean);
+      Follow_Links    : Boolean;
+      When_No_Sources : Error_Warning);
    --  Check the object directory and the source directories
    --
    --  Check the library attributes, including the library directory if any
@@ -57,5 +58,8 @@ private package Prj.Nmsc is
    --  any file duplicated through symbolic links (although the latter are
    --  still valid if they point to a file which is outside of the project),
    --  and that no directory has a name which is a valid source name.
+   --
+   --  When_No_Ada_Sources indicates what should be done when no Ada sources
+   --  are found in a project where Ada is a language.
 
 end Prj.Nmsc;

gcc/ada/prj-pars.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2006, 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- --
@@ -43,7 +43,8 @@ package body Prj.Pars is
      (In_Tree           : Project_Tree_Ref;
       Project           : out Project_Id;
       Project_File_Name : String;
-      Packages_To_Check : String_List_Access := All_Packages)
+      Packages_To_Check : String_List_Access := All_Packages;
+      When_No_Sources   : Error_Warning := Error)
    is
       Project_Node_Tree : constant Project_Node_Tree_Ref :=
                             new Project_Node_Tree_Data;
@@ -73,7 +74,8 @@ package body Prj.Pars is
             From_Project_Node      => Project_Node,
             From_Project_Node_Tree => Project_Node_Tree,
             Report_Error           => null,
-            Follow_Links           => Opt.Follow_Links);
+            Follow_Links           => Opt.Follow_Links,
+            When_No_Sources        => When_No_Sources);
          Prj.Err.Finalize;
 
          if not Success then
@@ -99,7 +101,7 @@ package body Prj.Pars is
    -- Set_Verbosity --
    -------------------
 
-   procedure Set_Verbosity (To : in Verbosity) is
+   procedure Set_Verbosity (To : Verbosity) is
    begin
       Current_Verbosity := To;
    end Set_Verbosity;

gcc/ada/prj-pars.ads

@@ -35,7 +35,8 @@ package Prj.Pars is
      (In_Tree           : Project_Tree_Ref;
       Project           : out Project_Id;
       Project_File_Name : String;
-      Packages_To_Check : String_List_Access := All_Packages);
+      Packages_To_Check : String_List_Access := All_Packages;
+      When_No_Sources   : Error_Warning := Error);
    --  Parse a project files and all its imported project files, in the
    --  project tree In_Tree.
    --
@@ -46,5 +47,8 @@ package Prj.Pars is
    --  Packages_To_Check indicates the packages where any unknown attribute
    --  produces an error. For other packages, an unknown attribute produces
    --  a warning.
+   --
+   --  When_No_Sources indicates what should be done when no sources
+   --  are found in a project for a specified or implied language.
 
 end Prj.Pars;

gcc/ada/prj-proc.adb

@@ -67,10 +67,19 @@ package body Prj.Proc is
    procedure Check
      (In_Tree         : Project_Tree_Ref;
       Project         : in out Project_Id;
-      Follow_Links : Boolean);
+      Follow_Links    : Boolean;
+      When_No_Sources : Error_Warning);
    --  Set all projects to not checked, then call Recursive_Check for the
    --  main project Project. Project is set to No_Project if errors occurred.
 
+   procedure Copy_Package_Declarations
+     (From    : Declarations;
+      To      : in out Declarations;
+      New_Loc : Source_Ptr;
+      In_Tree : Project_Tree_Ref);
+   --  Copy a package declaration From to To for a renamed package. Change the
+   --  locations of all the attributes to New_Loc.
+
    function Expression
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
@@ -121,7 +130,8 @@ package body Prj.Proc is
    procedure Recursive_Check
      (Project         : Project_Id;
       In_Tree         : Project_Tree_Ref;
-      Follow_Links : Boolean);
+      Follow_Links    : Boolean;
+      When_No_Sources : Error_Warning);
    --  If Project is not marked as checked, mark it as checked, call
    --  Check_Naming_Scheme for the project, then call itself for a
    --  possible extended project and all the imported projects of Project.
@@ -227,7 +237,8 @@ package body Prj.Proc is
    procedure Check
      (In_Tree         : Project_Tree_Ref;
       Project         : in out Project_Id;
-      Follow_Links : Boolean)
+      Follow_Links    : Boolean;
+      When_No_Sources : Error_Warning)
    is
    begin
       --  Make sure that all projects are marked as not checked
@@ -238,9 +249,136 @@ package body Prj.Proc is
          In_Tree.Projects.Table (Index).Checked := False;
       end loop;
 
-      Recursive_Check (Project, In_Tree, Follow_Links);
+      Recursive_Check (Project, In_Tree, Follow_Links, When_No_Sources);
    end Check;
 
+   -------------------------------
+   -- Copy_Package_Declarations --
+   -------------------------------
+
+   procedure Copy_Package_Declarations
+     (From    : Declarations;
+      To      : in out Declarations;
+      New_Loc : Source_Ptr;
+      In_Tree : Project_Tree_Ref)
+   is
+      V1  : Variable_Id := From.Attributes;
+      V2  : Variable_Id := No_Variable;
+      Var : Variable;
+      A1  : Array_Id := From.Arrays;
+      A2  : Array_Id := No_Array;
+      Arr : Array_Data;
+      E1  : Array_Element_Id;
+      E2  : Array_Element_Id := No_Array_Element;
+      Elm : Array_Element;
+
+   begin
+      --  To avoid references in error messages to attribute declarations in
+      --  an original package that has been renamed, copy all the attribute
+      --  declarations of the package and change all locations to New_Loc,
+      --  the location of the renamed package.
+
+      --  First single attributes
+
+      while V1 /= No_Variable loop
+
+         --  Copy the attribute
+
+         Var := In_Tree.Variable_Elements.Table (V1);
+         V1  := Var.Next;
+
+         --  Remove the Next component
+
+         Var.Next := No_Variable;
+
+         --  Change the location to New_Loc
+
+         Var.Value.Location := New_Loc;
+         Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
+
+         --  Put in new declaration
+
+         if To.Attributes = No_Variable then
+            To.Attributes :=
+              Variable_Element_Table.Last (In_Tree.Variable_Elements);
+
+         else
+            In_Tree.Variable_Elements.Table (V2).Next :=
+              Variable_Element_Table.Last (In_Tree.Variable_Elements);
+         end if;
+
+         V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements);
+         In_Tree.Variable_Elements.Table (V2) := Var;
+      end loop;
+
+      --  Then the associated array attributes
+
+      while A1 /= No_Array loop
+
+         --  Copy the array
+
+         Arr := In_Tree.Arrays.Table (A1);
+         A1  := Arr.Next;
+
+         --  Remove the Next component
+
+         Arr.Next := No_Array;
+
+         Array_Table.Increment_Last (In_Tree.Arrays);
+
+         --  Create new Array declaration
+         if To.Arrays = No_Array then
+            To.Arrays := Array_Table.Last (In_Tree.Arrays);
+
+         else
+            In_Tree.Arrays.Table (A2).Next :=
+              Array_Table.Last (In_Tree.Arrays);
+         end if;
+
+         A2 := Array_Table.Last (In_Tree.Arrays);
+
+         --  Don't store the array, as its first element has not been set yet
+
+         --  Copy the array elements of the array
+
+         E1 := Arr.Value;
+         Arr.Value := No_Array_Element;
+
+         while E1 /= No_Array_Element loop
+
+            --  Copy the array element
+
+            Elm := In_Tree.Array_Elements.Table (E1);
+            E1 := Elm.Next;
+
+            --  Remove the Next component
+
+            Elm.Next := No_Array_Element;
+
+            --  Change the location
+
+            Elm.Value.Location := New_Loc;
+            Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
+
+            --  Create new array element
+
+            if Arr.Value = No_Array_Element then
+               Arr.Value := Array_Element_Table.Last (In_Tree.Array_Elements);
+            else
+               In_Tree.Array_Elements.Table (E2).Next :=
+                 Array_Element_Table.Last (In_Tree.Array_Elements);
+            end if;
+
+            E2 := Array_Element_Table.Last (In_Tree.Array_Elements);
+            In_Tree.Array_Elements.Table (E2) := Elm;
+         end loop;
+
+         --  Finally, store the new array
+
+         In_Tree.Arrays.Table (A2) := Arr;
+      end loop;
+   end Copy_Package_Declarations;
+
    ----------------
    -- Expression --
    ----------------
@@ -998,7 +1136,8 @@ package body Prj.Proc is
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Report_Error           : Put_Line_Access;
-      Follow_Links           : Boolean := True)
+      Follow_Links           : Boolean := True;
+      When_No_Sources        : Error_Warning := Error)
    is
       Obj_Dir    : Name_Id;
       Extending  : Project_Id;
@@ -1024,7 +1163,7 @@ package body Prj.Proc is
          Extended_By            => No_Project);
 
       if Project /= No_Project then
-         Check (In_Tree, Project, Follow_Links);
+         Check (In_Tree, Project, Follow_Links, When_No_Sources);
       end if;
 
       --  If main project is an extending all project, set the object
@@ -1233,11 +1372,20 @@ package body Prj.Proc is
                                                      From_Project_Node_Tree));
 
                         begin
-                           --  For a renamed package, set declarations to
-                           --  the declarations of the renamed package.
-
-                           In_Tree.Packages.Table (New_Pkg).Decl :=
-                             In_Tree.Packages.Table (Renamed_Package).Decl;
+                           --  For a renamed package, copy the declarations of
+                           --  the renamed package, but set all the locations
+                           --  to the location of the package name in the
+                           --  renaming declaration.
+
+                           Copy_Package_Declarations
+                             (From     =>
+                                In_Tree.Packages.Table (Renamed_Package).Decl,
+                              To      =>
+                                In_Tree.Packages.Table (New_Pkg).Decl,
+                              New_Loc =>
+                                Location_Of
+                                  (Current_Item, From_Project_Node_Tree),
+                              In_Tree => In_Tree);
                         end;
 
                      --  Standard package declaration, not renaming
@@ -2108,7 +2256,8 @@ package body Prj.Proc is
    procedure Recursive_Check
      (Project         : Project_Id;
       In_Tree         : Project_Tree_Ref;
-      Follow_Links      : Boolean)
+      Follow_Links    : Boolean;
+      When_No_Sources : Error_Warning)
    is
       Data                  : Project_Data;
       Imported_Project_List : Project_List := Empty_Project_List;
@@ -2130,7 +2279,8 @@ package body Prj.Proc is
          --  Call itself for a possible extended project.
          --  (if there is no extended project, then nothing happens).
 
-         Recursive_Check (Data.Extends, In_Tree, Follow_Links);
+         Recursive_Check
+           (Data.Extends, In_Tree, Follow_Links, When_No_Sources);
 
          --  Call itself for all imported projects
 
@@ -2139,7 +2289,7 @@ package body Prj.Proc is
             Recursive_Check
               (In_Tree.Project_Lists.Table
                  (Imported_Project_List).Project,
-               In_Tree, Follow_Links);
+               In_Tree, Follow_Links, When_No_Sources);
             Imported_Project_List :=
               In_Tree.Project_Lists.Table
                 (Imported_Project_List).Next;
@@ -2151,7 +2301,8 @@ package body Prj.Proc is
             Write_Line ("""");
          end if;
 
-         Prj.Nmsc.Check (Project, In_Tree, Error_Report, Follow_Links);
+         Prj.Nmsc.Check
+           (Project, In_Tree, Error_Report, Follow_Links, When_No_Sources);
       end if;
    end Recursive_Check;
 

gcc/ada/prj-proc.ads

@@ -39,7 +39,8 @@ package Prj.Proc is
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Report_Error           : Put_Line_Access;
-      Follow_Links           : Boolean := True);
+      Follow_Links           : Boolean := True;
+      When_No_Sources        : Error_Warning := Error);
    --  Process a project file tree into project file data structures. If
    --  Report_Error is null, use the error reporting mechanism. Otherwise,
    --  report errors using Report_Error.
@@ -49,6 +50,9 @@ package Prj.Proc is
    --  still valid if they point to a file which is outside of the project),
    --  and that no directory has a name which is a valid source name.
    --
+   --  When_No_Sources indicates what should be done when no sources
+   --  are found in a project for a specified or implied language.
+   --
    --  Process is a bit of a junk name, how about Process_Project_Tree???
 
 end Prj.Proc;

gcc/ada/prj.ads

@@ -72,6 +72,16 @@ package Prj is
    --  The standard project file name extension. It is not a constant, because
    --  Canonical_Case_File_Name is called on this variable in the body of Prj.
 
+   type Error_Warning is (Silent, Warning, Error);
+   --  Severity of some situations, such as: no Ada sources in a project where
+   --  Ada is one of the language.
+   --
+   --  When the situation occurs, the behaviour depends on the setting:
+   --
+   --    - Silent:  no action
+   --    - Warning: issue a warning, does not cause the tool to fail
+   --    - Error:   issue an error, causes the tool to fail
+
    -----------------------------------------------------
    -- Multi-language Stuff That Will be Modified Soon --
    -----------------------------------------------------