2009-04-24 Emmanuel Briot <briot@adacore.com>

* prj-proc.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-nmsc.ads
	(Alternate_Languages): now implemented as a malloc-ed list rather
	than through a table.

From-SVN: r146731
This commit is contained in:
Emmanuel Briot 2009-04-24 14:53:19 +00:00 committed by Arnaud Charlet
parent f22e891a06
commit e1c9f239f3
6 changed files with 139 additions and 93 deletions

View File

@ -1,3 +1,9 @@
2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-nmsc.ads
(Alternate_Languages): now implemented as a malloc-ed list rather
than through a table.
2009-04-24 Thomas Quinot <quinot@adacore.com>
* sem_res.adb (Static_Concatenation): Simplify predicate to make it

View File

@ -237,7 +237,7 @@ package body Prj.Nmsc is
Lang_Kind : Language_Kind;
Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
Alternate_Languages : Language_List := null;
Other_Part : Source_Id := No_Source;
Unit : Name_Id := No_Name;
Index : Int := 0;
@ -356,7 +356,8 @@ package body Prj.Nmsc is
procedure Find_Ada_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Explicit_Sources_Only : Boolean);
Explicit_Sources_Only : Boolean;
Proc_Data : in out Processing_Data);
-- Find all Ada sources by traversing all source directories.
-- If Explicit_Sources_Only is True, then the sources found must belong to
-- the list of sources specified explicitly in the project file.
@ -417,7 +418,7 @@ package body Prj.Nmsc is
(In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
File_Name : File_Name_Type;
Alternate_Languages : out Alternate_Language_Id;
Alternate_Languages : out Language_List;
Language : out Language_Ptr;
Language_Name : out Name_Id;
Display_Language_Name : out Name_Id;
@ -463,9 +464,10 @@ package body Prj.Nmsc is
-- Source_Names.
procedure Find_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
Proc_Data : in out Processing_Data);
-- Process the Source_Files and Source_List_File attributes, and store
-- the list of source files into the Source_Names htable.
-- When these attributes are not defined, find all files matching the
@ -529,7 +531,8 @@ package body Prj.Nmsc is
procedure Look_For_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data);
Data : in out Project_Data;
Proc_Data : in out Processing_Data);
-- Find all the sources of project Project in project tree In_Tree and
-- update its Data accordingly. This assumes that Data.First_Source has
-- been initialized with the list of excluded sources and special naming
@ -553,7 +556,7 @@ package body Prj.Nmsc is
Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Units : in out Files_Htable.Instance;
Proc_Data : in out Processing_Data;
Ada_Language : Language_Ptr;
Location : Source_Ptr;
Source_Recorded : in out Boolean);
@ -675,7 +678,7 @@ package body Prj.Nmsc is
Lang_Kind : Language_Kind;
Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
Alternate_Languages : Language_List := null;
Other_Part : Source_Id := No_Source;
Unit : Name_Id := No_Name;
Index : Int := 0;
@ -800,7 +803,8 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Current_Dir : String)
Current_Dir : String;
Proc_Data : in out Processing_Data)
is
Data : Project_Data renames In_Tree.Projects.Table (Project);
Extending : Boolean := False;
@ -859,7 +863,7 @@ package body Prj.Nmsc is
-- Find the sources
if Data.Source_Dirs /= Nil_String then
Look_For_Sources (Project, In_Tree, Data);
Look_For_Sources (Project, In_Tree, Data, Proc_Data);
if Get_Mode = Ada_Only then
@ -882,8 +886,7 @@ package body Prj.Nmsc is
declare
Language : Language_Ptr;
Source : Source_Id;
Alt_Lang : Alternate_Language_Id;
Alt_Lang_Data : Alternate_Language_Data;
Alt_Lang : Language_List;
Continuation : Boolean := False;
Iter : Source_Iterator;
@ -905,13 +908,10 @@ package body Prj.Nmsc is
Alt_Lang := Source.Alternate_Languages;
Alternate_Loop :
while Alt_Lang /= No_Alternate_Language loop
Alt_Lang_Data := In_Tree.Alt_Langs.Table (Alt_Lang);
exit Source_Loop
when Alt_Lang_Data.Language = Language;
Alt_Lang := Alt_Lang_Data.Next;
end loop Alternate_Loop;
while Alt_Lang /= null loop
exit Source_Loop when Alt_Lang.Language = Language;
Alt_Lang := Alt_Lang.Next;
end loop;
Next (Iter);
end loop Source_Loop;
@ -6876,9 +6876,10 @@ package body Prj.Nmsc is
------------------
procedure Find_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
Proc_Data : in out Processing_Data)
is
Sources : constant Variable_Value :=
Util.Value_Of
@ -7036,7 +7037,8 @@ package body Prj.Nmsc is
if Get_Mode = Ada_Only then
Find_Ada_Sources
(Project, In_Tree, Explicit_Sources_Only => Has_Explicit_Sources);
(Project, In_Tree, Explicit_Sources_Only => Has_Explicit_Sources,
Proc_Data => Proc_Data);
else
Search_Directories
@ -7096,14 +7098,14 @@ package body Prj.Nmsc is
if First_Error then
Error_Msg
(Project, In_Tree,
"source file { cannot be found",
"source file { not found",
NL.Location);
First_Error := False;
else
Error_Msg
(Project, In_Tree,
"\source file { cannot be found",
"\source file { not found",
NL.Location);
end if;
end if;
@ -7125,6 +7127,24 @@ package body Prj.Nmsc is
end if;
end Find_Sources;
----------------
-- Initialize --
----------------
procedure Initialize (Proc_Data : in out Processing_Data) is
begin
Files_Htable.Reset (Proc_Data.Units);
end Initialize;
----------
-- Free --
----------
procedure Free (Proc_Data : in out Processing_Data) is
begin
Files_Htable.Reset (Proc_Data.Units);
end Free;
----------------------
-- Find_Ada_Sources --
----------------------
@ -7132,7 +7152,8 @@ package body Prj.Nmsc is
procedure Find_Ada_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Explicit_Sources_Only : Boolean)
Explicit_Sources_Only : Boolean;
Proc_Data : in out Processing_Data)
is
Data : Project_Data renames In_Tree.Projects.Table (Project);
Source_Dir : String_List_Id;
@ -7141,11 +7162,8 @@ package body Prj.Nmsc is
Dir_Has_Source : Boolean := False;
NL : Name_Location;
Ada_Language : Language_Ptr;
Units : Files_Htable.Instance;
begin
Files_Htable.Reset (Units);
if Current_Verbosity = High then
Write_Line ("Looking for Ada sources:");
end if;
@ -7249,7 +7267,7 @@ package body Prj.Nmsc is
Path_Name => Path_Name,
Project => Project,
In_Tree => In_Tree,
Units => Units,
Proc_Data => Proc_Data,
Ada_Language => Ada_Language,
Location => Location,
Source_Recorded => Dir_Has_Source);
@ -7275,8 +7293,6 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
Write_Line ("End looking for sources");
end if;
Files_Htable.Reset (Units);
end Find_Ada_Sources;
-------------------------------
@ -7287,7 +7303,7 @@ package body Prj.Nmsc is
(In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
File_Name : File_Name_Type;
Alternate_Languages : out Alternate_Language_Id;
Alternate_Languages : out Language_List;
Language : out Language_Ptr;
Language_Name : out Name_Id;
Display_Language_Name : out Name_Id;
@ -7340,13 +7356,9 @@ package body Prj.Nmsc is
end if;
if Header_File then
Alternate_Language_Table.Increment_Last (In_Tree.Alt_Langs);
In_Tree.Alt_Langs.Table
(Alternate_Language_Table.Last (In_Tree.Alt_Langs)) :=
Alternate_Languages := new Language_List_Element'
(Language => Language,
Next => Alternate_Languages);
Alternate_Languages :=
Alternate_Language_Table.Last (In_Tree.Alt_Langs);
else
Header_File := True;
@ -7361,7 +7373,7 @@ package body Prj.Nmsc is
begin
Language := No_Language_Index;
Alternate_Languages := No_Alternate_Language;
Alternate_Languages := null;
Display_Language_Name := No_Name;
Unit := No_Name;
Lang_Kind := File_Based;
@ -7440,7 +7452,7 @@ package body Prj.Nmsc is
Name_Loc : Name_Location := Source_Names.Get (File_Name);
Check_Name : Boolean := False;
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
Alternate_Languages : Language_List;
Language : Language_Ptr;
Source : Source_Id;
Other_Part : Source_Id;
@ -7856,7 +7868,8 @@ package body Prj.Nmsc is
procedure Look_For_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data)
Data : in out Project_Data;
Proc_Data : in out Processing_Data)
is
Iter : Source_Iterator;
@ -8094,7 +8107,7 @@ package body Prj.Nmsc is
Load_Naming_Exceptions (Project, In_Tree);
end if;
Find_Sources (Project, In_Tree, Data);
Find_Sources (Project, In_Tree, Data, Proc_Data);
Mark_Excluded_Sources;
if Get_Mode = Multi_Language then
@ -8184,7 +8197,7 @@ package body Prj.Nmsc is
Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Units : in out Files_Htable.Instance;
Proc_Data : in out Processing_Data;
Ada_Language : Language_Ptr;
Location : Source_Ptr;
Source_Recorded : in out Boolean)
@ -8253,7 +8266,7 @@ package body Prj.Nmsc is
-- Record the file name in the hash table Files_Htable
Files_Htable.Set (Units, Canonical_File, Project);
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
UData.File_Names (Unit_Kind) :=
(Name => Canonical_File,
@ -8313,7 +8326,7 @@ package body Prj.Nmsc is
-- another project. If it is, report error but note we do that
-- only for the first unit in the source file.
Unit_Prj := Files_Htable.Get (Units, Canonical_File);
Unit_Prj := Files_Htable.Get (Proc_Data.Units, Canonical_File);
if not File_Recorded
and then Unit_Prj /= No_Project
@ -8330,7 +8343,7 @@ package body Prj.Nmsc is
The_Unit := Unit_Table.Last (In_Tree.Units);
Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
Files_Htable.Set (Units, Canonical_File, Project);
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
UData.Name := Unit_Name;
UData.File_Names (Unit_Kind) :=

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2009, 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- --
@ -23,39 +23,55 @@
-- --
------------------------------------------------------------------------------
-- Check the Naming Scheme of a project file, find the source files
-- Perform various checks on a project and find all its source files
private package Prj.Nmsc is
-- It would be nicer to have a higher level statement of what these
-- procedures do (related to their names), rather than just an English
-- language summary of the implementation ???
type Processing_Data is private;
-- Temporary data which is needed while parsing a project. It does not need
-- to be kept in memory once a project has been fully loaded, but is
-- necessary while performing consistency checks (duplicate sources,...)
-- This data must be initialized before processing any project, and the
-- same data is used for processing all projects in the tree.
procedure Initialize (Proc_Data : in out Processing_Data);
-- Initialize Proc_Data
procedure Free (Proc_Data : in out Processing_Data);
-- Free the memory occupied by Proc_Data
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Current_Dir : String);
-- Check the object directory and the source directories
--
-- Check the library attributes, including the library directory if any
--
-- Get the set of specification and implementation suffixes, if any
--
-- Check the naming scheme for Ada
--
-- Find the Ada source files if any
--
-- Check the naming scheme for the supported languages (c, c++, ...) other
-- than Ada. Find the source files if any.
Current_Dir : String;
Proc_Data : in out Processing_Data);
-- Perform consistency and semantic checks on a project, starting from the
-- project tree parsed from the .gpr file. This procedure interprets the
-- various case statements in the project based on the current environment
-- variables (the "scenario").
-- After checking the validity of the naming scheme, it searches for all
-- the source files of the project.
-- The result of this procedure is a filled data structure for Project_Id
-- which contains all the information about the project. This information
-- is only valid while the scenario variables are preserved.
-- If the current mode is Ada_Only, this procedure will only search Ada
-- sources; but in multi_language mode it will look for sources for all the
-- supported languages.
--
-- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
-- Current_Dir is for optimization purposes only, avoiding system calls.
-- Current_Dir is for optimization purposes only, avoiding system calls to
-- query it.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
private
type Processing_Data is record
Units : Files_Htable.Instance;
-- Mapping from file base name to the project containing the file
end record;
end Prj.Nmsc;

View File

@ -145,13 +145,14 @@ package body Prj.Proc is
In_Tree : Project_Tree_Ref;
Current_Dir : String_Access;
When_No_Sources : Error_Warning;
Proc_Data : Processing_Data;
end record;
-- Data passed to Recursive_Check
-- Current_Dir is for optimization purposes, avoiding extra system calls.
procedure Recursive_Check
(Project : Project_Id;
Data : in out Recursive_Check_Data);
(Project : Project_Id;
Data : in out Recursive_Check_Data);
-- Check_Naming_Scheme for the project
---------
@ -282,10 +283,14 @@ package body Prj.Proc is
procedure Check_All_Projects is new
For_Every_Project_Imported (Recursive_Check_Data, Recursive_Check);
Data : Recursive_Check_Data :=
(In_Tree, Dir'Unchecked_Access, When_No_Sources);
Data : Recursive_Check_Data;
begin
Data.In_Tree := In_Tree;
Data.Current_Dir := Dir'Unchecked_Access;
Data.When_No_Sources := When_No_Sources;
Initialize (Data.Proc_Data);
Check_All_Projects (Project, In_Tree, Data, Imported_First => True);
-- Set the Other_Part field for the units
@ -322,6 +327,8 @@ package body Prj.Proc is
Next (Iter);
end loop;
end;
Free (Data.Proc_Data);
end Check;
-------------------------------
@ -2462,8 +2469,8 @@ package body Prj.Proc is
---------------------
procedure Recursive_Check
(Project : Project_Id;
Data : in out Recursive_Check_Data)
(Project : Project_Id;
Data : in out Recursive_Check_Data)
is
begin
if Verbose_Mode then
@ -2475,7 +2482,7 @@ package body Prj.Proc is
Prj.Nmsc.Check
(Project, Data.In_Tree, Error_Report, Data.When_No_Sources,
Data.Current_Dir.all);
Data.Current_Dir.all, Data.Proc_Data);
end Recursive_Check;
-----------------------

View File

@ -149,6 +149,7 @@ package body Prj is
procedure Free_List (Languages : in out Language_Ptr);
procedure Free_List (Source : in out Source_Id);
procedure Free_List (List : in out Project_List);
procedure Free_List (Languages : in out Language_List);
-- Free memory allocated for the list of languages or sources
procedure Language_Changed (Iter : in out Source_Iterator);
@ -841,6 +842,22 @@ package body Prj is
-- Free_List --
---------------
procedure Free_List (Languages : in out Language_List) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Language_List_Element, Language_List);
Tmp : Language_List;
begin
while Languages /= null loop
Tmp := Languages.Next;
Unchecked_Free (Languages);
Languages := Tmp;
end loop;
end Free_List;
---------------
-- Free_List --
---------------
procedure Free_List (Source : in out Source_Id) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Source_Data, Source_Id);
@ -848,6 +865,7 @@ package body Prj is
begin
while Source /= No_Source loop
Tmp := Source.Next_In_Lang;
Free_List (Source.Alternate_Languages);
Unchecked_Free (Source);
Source := Tmp;
end loop;
@ -902,7 +920,6 @@ package body Prj is
Array_Element_Table.Free (Tree.Array_Elements);
Array_Table.Free (Tree.Arrays);
Package_Table.Free (Tree.Packages);
Alternate_Language_Table.Free (Tree.Alt_Langs);
Unit_Table.Free (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
@ -944,7 +961,6 @@ package body Prj is
Array_Element_Table.Init (Tree.Array_Elements);
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
Alternate_Language_Table.Init (Tree.Alt_Langs);
Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);

View File

@ -604,24 +604,13 @@ package Prj is
Mapping_Files => Mapping_Files_Htable.Nil,
Next => No_Language_Index);
type Alternate_Language_Id is new Nat;
No_Alternate_Language : constant Alternate_Language_Id := 0;
type Alternate_Language_Data is record
type Language_List_Element;
type Language_List is access Language_List_Element;
type Language_List_Element is record
Language : Language_Ptr := No_Language_Index;
Next : Alternate_Language_Id := No_Alternate_Language;
Next : Language_List;
end record;
package Alternate_Language_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Alternate_Language_Data,
Table_Index_Type => Alternate_Language_Id,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100);
-- The table for storing the alternate languages of a header file that
-- is used for several languages.
type Source_Kind is (Spec, Impl, Sep);
type Source_Data is record
@ -645,7 +634,7 @@ package Prj is
Declared_In_Interfaces : Boolean := False;
-- True when source is declared in attribute Interfaces
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
Alternate_Languages : Language_List;
-- List of languages a header file may also be, in addition of language
-- Language_Name.
@ -746,7 +735,7 @@ package Prj is
Compiled => True,
In_Interfaces => True,
Declared_In_Interfaces => False,
Alternate_Languages => No_Alternate_Language,
Alternate_Languages => null,
Kind => Spec,
Dependency => None,
Other_Part => No_Source,
@ -1439,7 +1428,6 @@ package Prj is
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Projects : Project_Table.Instance;
Alt_Langs : Alternate_Language_Table.Instance;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;