Commit e1c9f239 by Emmanuel Briot Committed by Arnaud Charlet

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
parent f22e891a
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
......
......@@ -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;
......@@ -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;
-----------------------
......
......@@ -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);
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment