Commit 1aa23421 by Arnaud Charlet

[multiple changes]

2010-10-11  Emmanuel Briot  <briot@adacore.com>

	* sinfo.adb: Use GNAT.HTable rather than System.HTable.
	* prj-nmsc.adb: Minor reformatting.

2010-10-11  Thomas Quinot  <quinot@adacore.com>

	* sem_attr.adb (Type_Key): Code simplification.

From-SVN: r165289
parent 9c8e862b
2010-10-11 Emmanuel Briot <briot@adacore.com>
* sinfo.adb: Use GNAT.HTable rather than System.HTable.
* prj-nmsc.adb: Minor reformatting.
2010-10-11 Thomas Quinot <quinot@adacore.com>
* sem_attr.adb (Type_Key): Code simplification.
2010-10-11 Tristan Gingold <gingold@adacore.com> 2010-10-11 Tristan Gingold <gingold@adacore.com>
* gcc-interface/utils2.c (maybe_wrap_malloc): Fix crash when allocating * gcc-interface/utils2.c (maybe_wrap_malloc): Fix crash when allocating
......
...@@ -922,9 +922,11 @@ package body Prj.Nmsc is ...@@ -922,9 +922,11 @@ package body Prj.Nmsc is
Data.Tree); Data.Tree);
procedure Found_Project_File (Path : Path_Information; Rank : Natural); procedure Found_Project_File (Path : Path_Information; Rank : Natural);
-- Comments required ???
procedure Expand_Project_Files is new Expand_Subdirectory_Pattern procedure Expand_Project_Files is
(Callback => Found_Project_File); new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
-- Comments required ???
------------------------ ------------------------
-- Found_Project_File -- -- Found_Project_File --
...@@ -939,6 +941,8 @@ package body Prj.Nmsc is ...@@ -939,6 +941,8 @@ package body Prj.Nmsc is
end if; end if;
end Found_Project_File; end Found_Project_File;
-- Start of processing for Check_Aggregate_Project
begin begin
if Project_Files.Default then if Project_Files.Default then
Error_Msg_Name_1 := Snames.Name_Project_Files; Error_Msg_Name_1 := Snames.Name_Project_Files;
...@@ -1044,7 +1048,6 @@ package body Prj.Nmsc is ...@@ -1044,7 +1048,6 @@ package body Prj.Nmsc is
Check_Configuration (Project, Data); Check_Configuration (Project, Data);
if Project.Qualifier /= Aggregate then if Project.Qualifier /= Aggregate then
Check_Library_Attributes (Project, Data); Check_Library_Attributes (Project, Data);
Check_Package_Naming (Project, Data); Check_Package_Naming (Project, Data);
Look_For_Sources (Prj_Data, Data); Look_For_Sources (Prj_Data, Data);
...@@ -4962,7 +4965,8 @@ package body Prj.Nmsc is ...@@ -4962,7 +4965,8 @@ package body Prj.Nmsc is
Remove_Source_Dirs : Boolean := False; Remove_Source_Dirs : Boolean := False;
procedure Add_To_Or_Remove_From_Source_Dirs procedure Add_To_Or_Remove_From_Source_Dirs
(Path : Path_Information; Rank : Natural); (Path : Path_Information;
Rank : Natural);
-- When Removed = False, the directory Path_Id to the list of -- When Removed = False, the directory Path_Id to the list of
-- source_dirs if not already in the list. When Removed = True, -- source_dirs if not already in the list. When Removed = True,
-- removed directory Path_Id if in the list. -- removed directory Path_Id if in the list.
...@@ -4975,7 +4979,8 @@ package body Prj.Nmsc is ...@@ -4975,7 +4979,8 @@ package body Prj.Nmsc is
--------------------------------------- ---------------------------------------
procedure Add_To_Or_Remove_From_Source_Dirs procedure Add_To_Or_Remove_From_Source_Dirs
(Path : Path_Information; Rank : Natural) (Path : Path_Information;
Rank : Natural)
is is
List : String_List_Id; List : String_List_Id;
Prev : String_List_Id; Prev : String_List_Id;
...@@ -5047,7 +5052,7 @@ package body Prj.Nmsc is ...@@ -5047,7 +5052,7 @@ package body Prj.Nmsc is
elsif Remove_Source_Dirs and then List /= Nil_String then elsif Remove_Source_Dirs and then List /= Nil_String then
-- Remove source dir, if present -- Remove source dir if present
if Prev = Nil_String then if Prev = Nil_String then
Project.Source_Dirs := Project.Source_Dirs :=
...@@ -5232,6 +5237,7 @@ package body Prj.Nmsc is ...@@ -5232,6 +5237,7 @@ package body Prj.Nmsc is
end if; end if;
elsif Source_Dirs.Default then elsif Source_Dirs.Default then
-- No Source_Dirs specified: the single source directory is the one -- No Source_Dirs specified: the single source directory is the one
-- containing the project file. -- containing the project file.
...@@ -6753,16 +6759,20 @@ package body Prj.Nmsc is ...@@ -6753,16 +6759,20 @@ package body Prj.Nmsc is
Visited : Recursive_Dirs.Instance; Visited : Recursive_Dirs.Instance;
procedure Find_Pattern procedure Find_Pattern
(Pattern_Id : Name_Id; Rank : Natural; Location : Source_Ptr); (Pattern_Id : Name_Id;
Rank : Natural;
Location : Source_Ptr);
-- Find a specific pattern -- Find a specific pattern
function Recursive_Find_Dirs function Recursive_Find_Dirs
(Path : Path_Information; Rank : Natural) return Boolean; (Path : Path_Information;
Rank : Natural) return Boolean;
-- Search all the subdirectories (recursively) of Path. -- Search all the subdirectories (recursively) of Path.
-- Return True if at least one file or directory was processed -- Return True if at least one file or directory was processed
function Subdirectory_Matches function Subdirectory_Matches
(Path : Path_Information; Rank : Natural) return Boolean; (Path : Path_Information;
Rank : Natural) return Boolean;
-- Called when a matching directory was found. If the user is in fact -- Called when a matching directory was found. If the user is in fact
-- searching for files, we then search for those files matching the -- searching for files, we then search for those files matching the
-- pattern within the directory. -- pattern within the directory.
...@@ -6773,13 +6783,15 @@ package body Prj.Nmsc is ...@@ -6773,13 +6783,15 @@ package body Prj.Nmsc is
-------------------------- --------------------------
function Subdirectory_Matches function Subdirectory_Matches
(Path : Path_Information; Rank : Natural) return Boolean (Path : Path_Information;
Rank : Natural) return Boolean
is is
Dir : Dir_Type; Dir : Dir_Type;
Name : String (1 .. 250); Name : String (1 .. 250);
Last : Natural; Last : Natural;
Found : Path_Information; Found : Path_Information;
Success : Boolean := False; Success : Boolean := False;
begin begin
case Search_For is case Search_For is
when Search_Directories => when Search_Directories =>
...@@ -6819,7 +6831,8 @@ package body Prj.Nmsc is ...@@ -6819,7 +6831,8 @@ package body Prj.Nmsc is
------------------------- -------------------------
function Recursive_Find_Dirs function Recursive_Find_Dirs
(Path : Path_Information; Rank : Natural) return Boolean (Path : Path_Information;
Rank : Natural) return Boolean
is is
Path_Str : constant String := Get_Name_String (Path.Display_Name); Path_Str : constant String := Get_Name_String (Path.Display_Name);
Dir : Dir_Type; Dir : Dir_Type;
...@@ -6859,6 +6872,7 @@ package body Prj.Nmsc is ...@@ -6859,6 +6872,7 @@ package body Prj.Nmsc is
Resolve_Links => Resolve_Links) Resolve_Links => Resolve_Links)
& Directory_Separator; & Directory_Separator;
Path2 : Path_Information; Path2 : Path_Information;
begin begin
if Is_Directory (Path_Name) then if Is_Directory (Path_Name) then
Name_Len := 0; Name_Len := 0;
...@@ -6888,7 +6902,9 @@ package body Prj.Nmsc is ...@@ -6888,7 +6902,9 @@ package body Prj.Nmsc is
------------------ ------------------
procedure Find_Pattern procedure Find_Pattern
(Pattern_Id : Name_Id; Rank : Natural; Location : Source_Ptr) (Pattern_Id : Name_Id;
Rank : Natural;
Location : Source_Ptr)
is is
Pattern : constant String := Get_Name_String (Pattern_Id); Pattern : constant String := Get_Name_String (Pattern_Id);
Pattern_End : Natural := Pattern'Last; Pattern_End : Natural := Pattern'Last;
...@@ -6898,6 +6914,7 @@ package body Prj.Nmsc is ...@@ -6898,6 +6914,7 @@ package body Prj.Nmsc is
Dir_Exists : Boolean; Dir_Exists : Boolean;
Has_Error : Boolean := False; Has_Error : Boolean := False;
Success : Boolean; Success : Boolean;
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Expand_Subdirectory_Pattern ("""); Write_Str ("Expand_Subdirectory_Pattern (""");
...@@ -7001,11 +7018,14 @@ package body Prj.Nmsc is ...@@ -7001,11 +7018,14 @@ package body Prj.Nmsc is
end if; end if;
end Find_Pattern; end Find_Pattern;
-- Start of processing for Expand_Subdirectory_Pattern -- Local variables
Pattern_Id : String_List_Id := Patterns; Pattern_Id : String_List_Id := Patterns;
Element : String_Element; Element : String_Element;
Rank : Natural := 1; Rank : Natural := 1;
-- Start of processing for Expand_Subdirectory_Pattern
begin begin
while Pattern_Id /= Nil_String loop while Pattern_Id /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Pattern_Id); Element := Data.Tree.String_Elements.Table (Pattern_Id);
......
...@@ -4457,7 +4457,7 @@ package body Sem_Attr is ...@@ -4457,7 +4457,7 @@ package body Sem_Attr is
Check_E0; Check_E0;
Check_Type; Check_Type;
declare declare
function Type_Key return String; function Type_Key return String_Id;
-- A very preliminary implementation. -- A very preliminary implementation.
-- For now, a signature consists of only the type name. -- For now, a signature consists of only the type name.
-- This is clearly incomplete (e.g., adding a new field to -- This is clearly incomplete (e.g., adding a new field to
...@@ -4467,22 +4467,18 @@ package body Sem_Attr is ...@@ -4467,22 +4467,18 @@ package body Sem_Attr is
-- Type_Key -- -- Type_Key --
-------------- --------------
function Type_Key return String is function Type_Key return String_Id is
Full_Name : constant String_Id := Full_Name : constant String_Id :=
Fully_Qualified_Name_String (Entity (P)); Fully_Qualified_Name_String (Entity (P));
Signature : String
(1 .. Integer (String_Length (Full_Name)) - 1);
-- Decrement length to omit trailing NUL
begin begin
for J in Signature'Range loop -- Copy all characters in Full_Name but the trailing NUL
Signature (J) :=
Get_Character (Get_String_Char (Full_Name, Int (J)));
end loop;
return Signature & "'Type_Key"; Start_String;
for J in 1 .. String_Length (Full_Name) - 1 loop
Store_String_Char (Get_String_Char (Full_Name, Int (J)));
end loop;
Store_String_Chars ("'Type_Key");
return End_String;
end Type_Key; end Type_Key;
begin begin
......
...@@ -35,7 +35,7 @@ pragma Style_Checks (All_Checks); ...@@ -35,7 +35,7 @@ pragma Style_Checks (All_Checks);
with Atree; use Atree; with Atree; use Atree;
with Nlists; use Nlists; with Nlists; use Nlists;
with System.HTable; with GNAT.HTable;
package body Sinfo is package body Sinfo is
...@@ -72,7 +72,7 @@ package body Sinfo is ...@@ -72,7 +72,7 @@ package body Sinfo is
end AS_Hash; end AS_Hash;
package Aspect_Specifications_Hash_Table is new package Aspect_Specifications_Hash_Table is new
System.HTable.Simple_HTable GNAT.HTable.Simple_HTable
(Header_Num => Hash_Range, (Header_Num => Hash_Range,
Element => List_Id, Element => List_Id,
No_Element => No_List, No_Element => No_List,
......
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