Skip to content

R
riscv-gcc-1
Commit c0e538ad by Arnaud Charlet
Options

[multiple changes] 

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj-part.adb, prj-part.ads, prj-makr.adb, prj-pars.adb, prj-conf.adb,
	prj-env.adb (Prj.Part.Parse): change parameter Always_Errout_Finalize
	to Errout_Handling.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj-dect.adb (Parse_Attribute_Declaration): make sure we can use
	"external" as an attribute name in aggregate projects.

2011-08-03  Jose Ruiz  <ruiz@adacore.com>

	* s-taprop-vxworks.adb: (Create_Task, Initialize): Ada 2012 pragma CPU
	uses CPU numbers starting 1, while VxWorks uses CPU numbers starting
	from 0, so we need to adjust.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj-ext.adb, prj-ext.ads, makeutl.adb, prj-tree.adb,
	prj-tree.ads, gnatcmd.adb, clean.adb (External_References): new type.

From-SVN: r177244
parent c4d67e2d
Showing with 274 additions and 70 deletions
gcc/ada/ChangeLog
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj-part.adb, prj-part.ads, prj-makr.adb, prj-pars.adb, prj-conf.adb,
prj-env.adb (Prj.Part.Parse): change parameter Always_Errout_Finalize
to Errout_Handling.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj-dect.adb (Parse_Attribute_Declaration): make sure we can use
"external" as an attribute name in aggregate projects.
2011-08-03 Jose Ruiz <ruiz@adacore.com>
* s-taprop-vxworks.adb: (Create_Task, Initialize): Ada 2012 pragma CPU
uses CPU numbers starting 1, while VxWorks uses CPU numbers starting
from 0, so we need to adjust.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj-ext.adb, prj-ext.ads, makeutl.adb, prj-tree.adb,
prj-tree.ads, gnatcmd.adb, clean.adb (External_References): new type.
2011-08-03 Yannick Moy <moy@adacore.com> 2011-08-03 Yannick Moy <moy@adacore.com>
* sem_ch6.adb (New_Overloaded_Entity): only issue error for SPARK * sem_ch6.adb (New_Overloaded_Entity): only issue error for SPARK
......
gcc/ada/clean.adb
...@@ -1886,7 +1886,7 @@ package body Clean is ...@@ -1886,7 +1886,7 @@ package body Clean is
if OK then if OK then
Prj.Ext.Add Prj.Ext.Add
(Project_Node_Tree, (Project_Node_Tree.External,
External_Name => External_Name =>
Ext_Asgn (Start .. Equal_Pos - 1), Ext_Asgn (Start .. Equal_Pos - 1),
Value => Value =>
......
gcc/ada/gnatcmd.adb
...@@ -1822,7 +1822,7 @@ begin ...@@ -1822,7 +1822,7 @@ begin
if Equal_Pos >= Argv'First + 3 if Equal_Pos >= Argv'First + 3
and then Equal_Pos /= Argv'Last and then Equal_Pos /= Argv'Last
then then
Add (Project_Node_Tree, Add (Project_Node_Tree.External,
External_Name => External_Name =>
Argv (Argv'First + 2 .. Equal_Pos - 1), Argv (Argv'First + 2 .. Equal_Pos - 1),
Value => Argv (Equal_Pos + 1 .. Argv'Last)); Value => Argv (Equal_Pos + 1 .. Argv'Last));
......
gcc/ada/makeutl.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -724,7 +724,7 @@ package body Makeutl is ...@@ -724,7 +724,7 @@ package body Makeutl is
end if; end if;
return Prj.Ext.Check return Prj.Ext.Check
(Tree => Tree, (Self => Tree.External,
Declaration => Argv (Start .. Finish)); Declaration => Argv (Start .. Finish));
end Is_External_Assignment; end Is_External_Assignment;
......
gcc/ada/prj-conf.adb
...@@ -1119,7 +1119,7 @@ package body Prj.Conf is ...@@ -1119,7 +1119,7 @@ package body Prj.Conf is
(In_Tree => Project_Node_Tree, (In_Tree => Project_Node_Tree,
Project => Config_Project_Node, Project => Config_Project_Node,
Project_File_Name => Config_File_Path.all, Project_File_Name => Config_File_Path.all,
Always_Errout_Finalize => False, Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory, Current_Directory => Current_Directory,
Is_Config_File => True, Is_Config_File => True,
...@@ -1212,7 +1212,7 @@ package body Prj.Conf is ...@@ -1212,7 +1212,7 @@ package body Prj.Conf is
(In_Tree => Project_Node_Tree, (In_Tree => Project_Node_Tree,
Project => User_Project_Node, Project => User_Project_Node,
Project_File_Name => Project_File_Name, Project_File_Name => Project_File_Name,
Always_Errout_Finalize => False, Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory, Current_Directory => Current_Directory,
Is_Config_File => False, Is_Config_File => False,
......
gcc/ada/prj-dect.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -494,13 +494,18 @@ package body Prj.Dect is ...@@ -494,13 +494,18 @@ package body Prj.Dect is
Scan (In_Tree); Scan (In_Tree);
-- Body may be an attribute name -- Body or External may be an attribute name
if Token = Tok_Body then if Token = Tok_Body then
Token := Tok_Identifier; Token := Tok_Identifier;
Token_Name := Snames.Name_Body; Token_Name := Snames.Name_Body;
end if; end if;
if Token = Tok_External then
Token := Tok_Identifier;
Token_Name := Snames.Name_External;
end if;
Expect (Tok_Identifier, "identifier"); Expect (Tok_Identifier, "identifier");
Process_Attribute_Name; Process_Attribute_Name;
Rename_Obsolescent_Attributes (In_Tree, Attribute, Current_Package); Rename_Obsolescent_Attributes (In_Tree, Attribute, Current_Package);
......
gcc/ada/prj-ext.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -23,31 +23,65 @@ ...@@ -23,31 +23,65 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Osint; use Osint; with Osint; use Osint;
with Prj.Tree; use Prj.Tree;
package body Prj.Ext is package body Prj.Ext is
----------------
-- Initialize --
----------------
procedure Initialize
(Self : out External_References;
Copy_From : External_References := No_External_Refs)
is
N : Name_To_Name_Ptr;
N2 : Name_To_Name_Ptr;
begin
if Self.Refs = null then
Self.Refs := new Name_To_Name_HTable.Instance;
if Copy_From.Refs /= null then
N := Name_To_Name_HTable.Get_First (Copy_From.Refs.all);
while N /= null loop
N2 := new Name_To_Name;
N2.Key := N.Key;
N2.Value := N.Value;
Name_To_Name_HTable.Set (Self.Refs.all, N2);
N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all);
end loop;
end if;
end if;
end Initialize;
--------- ---------
-- Add -- -- Add --
--------- ---------
procedure Add procedure Add
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Self : External_References;
External_Name : String; External_Name : String;
Value : String) Value : String)
is is
The_Key : Name_Id; N : Name_To_Name_Ptr;
The_Value : Name_Id;
begin begin
N := new Name_To_Name;
Name_Len := Value'Length; Name_Len := Value'Length;
Name_Buffer (1 .. Name_Len) := Value; Name_Buffer (1 .. Name_Len) := Value;
The_Value := Name_Find; N.Value := Name_Find;
Name_Len := External_Name'Length; Name_Len := External_Name'Length;
Name_Buffer (1 .. Name_Len) := External_Name; Name_Buffer (1 .. Name_Len) := External_Name;
Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len));
The_Key := Name_Find; N.Key := Name_Find;
Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value);
if Current_Verbosity = High then
Debug_Output ("Add (" & External_Name & ") is", N.Value);
end if;
Name_To_Name_HTable.Set (Self.Refs.all, N);
end Add; end Add;
----------- -----------
...@@ -55,7 +89,7 @@ package body Prj.Ext is ...@@ -55,7 +89,7 @@ package body Prj.Ext is
----------- -----------
function Check function Check
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Self : External_References;
Declaration : String) return Boolean Declaration : String) return Boolean
is is
begin begin
...@@ -63,7 +97,7 @@ package body Prj.Ext is ...@@ -63,7 +97,7 @@ package body Prj.Ext is
if Declaration (Equal_Pos) = '=' then if Declaration (Equal_Pos) = '=' then
exit when Equal_Pos = Declaration'First; exit when Equal_Pos = Declaration'First;
Add Add
(Tree => Tree, (Self => Self,
External_Name => External_Name =>
Declaration (Declaration'First .. Equal_Pos - 1), Declaration (Declaration'First .. Equal_Pos - 1),
Value => Value =>
...@@ -79,9 +113,12 @@ package body Prj.Ext is ...@@ -79,9 +113,12 @@ package body Prj.Ext is
-- Reset -- -- Reset --
----------- -----------
procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref) is procedure Reset (Self : External_References) is
begin begin
Name_To_Name_HTable.Reset (Tree.External_References); if Self.Refs /= null then
Debug_Output ("Reset external references");
Name_To_Name_HTable.Reset (Self.Refs.all);
end if;
end Reset; end Reset;
-------------- --------------
...@@ -89,23 +126,26 @@ package body Prj.Ext is ...@@ -89,23 +126,26 @@ package body Prj.Ext is
-------------- --------------
function Value_Of function Value_Of
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Self : External_References;
External_Name : Name_Id; External_Name : Name_Id;
With_Default : Name_Id := No_Name) With_Default : Name_Id := No_Name)
return Name_Id return Name_Id
is is
The_Value : Name_Id; Value : Name_To_Name_Ptr;
Name : String := Get_Name_String (External_Name); Val : Name_Id;
Name : String := Get_Name_String (External_Name);
begin begin
Canonical_Case_Env_Var_Name (Name); Canonical_Case_Env_Var_Name (Name);
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
The_Value :=
Name_To_Name_HTable.Get (Tree.External_References, Name_Find);
if The_Value /= No_Name then if Self.Refs /= null then
return The_Value; Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
Value := Name_To_Name_HTable.Get (Self.Refs.all, Name_Find);
if Value /= null then
return Value.Value;
end if;
end if; end if;
-- Find if it is an environment, if it is, put value in the hash table -- Find if it is an environment, if it is, put value in the hash table
...@@ -117,17 +157,73 @@ package body Prj.Ext is ...@@ -117,17 +157,73 @@ package body Prj.Ext is
if Env_Value /= null and then Env_Value'Length > 0 then if Env_Value /= null and then Env_Value'Length > 0 then
Name_Len := Env_Value'Length; Name_Len := Env_Value'Length;
Name_Buffer (1 .. Name_Len) := Env_Value.all; Name_Buffer (1 .. Name_Len) := Env_Value.all;
The_Value := Name_Find; Val := Name_Find;
Name_To_Name_HTable.Set
(Tree.External_References, External_Name, The_Value); if Current_Verbosity = High then
Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
& ") is", Val);
end if;
if Self.Refs /= null then
Value := new Name_To_Name;
Value.Key := External_Name;
Value.Value := Val;
Name_To_Name_HTable.Set (Self.Refs.all, Value);
end if;
Free (Env_Value); Free (Env_Value);
return The_Value; return Val;
else else
if Current_Verbosity = High then
Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
& ") is default", With_Default);
end if;
Free (Env_Value); Free (Env_Value);
return With_Default; return With_Default;
end if; end if;
end; end;
end Value_Of; end Value_Of;
----------
-- Free --
----------
procedure Free (Self : in out External_References) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Name_To_Name_HTable.Instance, Instance_Access);
begin
if Self.Refs /= null then
Reset (Self);
Unchecked_Free (Self.Refs);
end if;
end Free;
--------------
-- Set_Next --
--------------
procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr) is
begin
E.Next := Next;
end Set_Next;
----------
-- Next --
----------
function Next (E : Name_To_Name_Ptr) return Name_To_Name_Ptr is
begin
return E.Next;
end Next;
-------------
-- Get_Key --
-------------
function Get_Key (E : Name_To_Name_Ptr) return Name_Id is
begin
return E.Key;
end Get_Key;
end Prj.Ext; end Prj.Ext;
gcc/ada/prj-ext.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -26,7 +26,7 @@ ...@@ -26,7 +26,7 @@
-- Subprograms to set, get and cache external references, to be used as -- Subprograms to set, get and cache external references, to be used as
-- External functions in project files. -- External functions in project files.
with Prj.Tree; with GNAT.Dynamic_HTables;
package Prj.Ext is package Prj.Ext is
...@@ -42,27 +42,84 @@ package Prj.Ext is ...@@ -42,27 +42,84 @@ package Prj.Ext is
-- trees are loaded in parallel we can have different scenarios (or even -- trees are loaded in parallel we can have different scenarios (or even
-- load the same tree twice and see different views of it). -- load the same tree twice and see different views of it).
type External_References is private;
No_External_Refs : constant External_References;
procedure Initialize
(Self : out External_References;
Copy_From : External_References := No_External_Refs);
-- Initialize Self, and copy all values from Copy_From if needed.
-- This has no effect if Self was already initialized.
procedure Free (Self : in out External_References);
-- Free memory used by Self
procedure Add procedure Add
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Self : External_References;
External_Name : String; External_Name : String;
Value : String); Value : String);
-- Add an external reference (or modify an existing one) -- Add an external reference (or modify an existing one)
function Value_Of function Value_Of
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Self : External_References;
External_Name : Name_Id; External_Name : Name_Id;
With_Default : Name_Id := No_Name) With_Default : Name_Id := No_Name)
return Name_Id; return Name_Id;
-- Get the value of an external reference, and cache it for future uses -- Get the value of an external reference, and cache it for future uses
function Check function Check
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Self : External_References;
Declaration : String) return Boolean; Declaration : String) return Boolean;
-- Check that an external declaration <external>=<value> is correct. -- Check that an external declaration <external>=<value> is correct.
-- If it is correct, the external reference is Added. -- If it is correct, the external reference is Added.
procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref); procedure Reset (Self : External_References);
-- Clear the internal data structure that stores the external references -- Clear the internal data structure that stores the external references
-- and free any allocated memory. -- and free any allocated memory.
private
-- Use a Static_HTable, not a Simple_HTable.
-- The issue is that we need to be able to copy the contents of the table
-- (in Initialize), but this isn't doable for Simple_HTable for which
-- iterators do not return the key.
type Name_To_Name;
type Name_To_Name_Ptr is access all Name_To_Name;
type Name_To_Name is record
Key : Name_Id;
Value : Name_Id;
Next : Name_To_Name_Ptr;
end record;
procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr);
function Next (E : Name_To_Name_Ptr) return Name_To_Name_Ptr;
function Get_Key (E : Name_To_Name_Ptr) return Name_Id;
package Name_To_Name_HTable is new GNAT.Dynamic_HTables.Static_HTable
(Header_Num => Header_Num,
Element => Name_To_Name,
Elmt_Ptr => Name_To_Name_Ptr,
Null_Ptr => null,
Set_Next => Set_Next,
Next => Next,
Key => Name_Id,
Get_Key => Get_Key,
Hash => Hash,
Equal => "=");
-- General type for htables associating name_id to name_id. This is in
-- particular used to store the values of external references.
type Instance_Access is access all Name_To_Name_HTable.Instance;
type External_References is record
Refs : Instance_Access;
-- External references are stored in this hash table (and manipulated
-- through subprogrames in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but
-- have two views of it, for instance.
end record;
No_External_Refs : constant External_References := (Refs => null);
end Prj.Ext; end Prj.Ext;
gcc/ada/prj-makr.adb
...@@ -863,7 +863,7 @@ package body Prj.Makr is ...@@ -863,7 +863,7 @@ package body Prj.Makr is
(In_Tree => Tree, (In_Tree => Tree,
Project => Project_Node, Project => Project_Node,
Project_File_Name => Output_Name.all, Project_File_Name => Output_Name.all,
Always_Errout_Finalize => False, Errout_Handling => Part.Finalize_If_Error,
Store_Comments => True, Store_Comments => True,
Is_Config_File => False, Is_Config_File => False,
Flags => Flags, Flags => Flags,
......
gcc/ada/prj-pars.adb
...@@ -72,7 +72,7 @@ package body Prj.Pars is ...@@ -72,7 +72,7 @@ package body Prj.Pars is
(In_Tree => Project_Node_Tree, (In_Tree => Project_Node_Tree,
Project => Project_Node, Project => Project_Node,
Project_File_Name => Project_File_Name, Project_File_Name => Project_File_Name,
Always_Errout_Finalize => False, Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir, Current_Directory => Current_Dir,
Flags => Flags, Flags => Flags,
......
gcc/ada/prj-part.adb
...@@ -443,7 +443,7 @@ package body Prj.Part is ...@@ -443,7 +443,7 @@ package body Prj.Part is
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id; Project : out Project_Node_Id;
Project_File_Name : String; Project_File_Name : String;
Always_Errout_Finalize : Boolean; Errout_Handling : Errout_Mode := Always_Finalize;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False; Store_Comments : Boolean := False;
Current_Directory : String := ""; Current_Directory : String := "";
...@@ -477,7 +477,10 @@ package body Prj.Part is ...@@ -477,7 +477,10 @@ package body Prj.Part is
Path => Path_Name_Id); Path => Path_Name_Id);
Free (Real_Project_File_Name); Free (Real_Project_File_Name);
Prj.Err.Initialize; if Errout_Handling /= Never_Finalize then
Prj.Err.Initialize;
end if;
Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments); Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments); Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
...@@ -607,13 +610,22 @@ package body Prj.Part is ...@@ -607,13 +610,22 @@ package body Prj.Part is
Project := Empty_Node; Project := Empty_Node;
end if; end if;
if No (Project) or else Always_Errout_Finalize then case Errout_Handling is
Prj.Err.Finalize; when Always_Finalize =>
Prj.Err.Finalize;
-- Reinitialize to avoid duplicate warnings later on -- Reinitialize to avoid duplicate warnings later on
Prj.Err.Initialize;
Prj.Err.Initialize; when Finalize_If_Error =>
end if; if No (Project) then
Prj.Err.Finalize;
Prj.Err.Initialize;
end if;
when Never_Finalize =>
null;
end case;
exception exception
when X : others => when X : others =>
......
gcc/ada/prj-part.ads
...@@ -29,11 +29,19 @@ with Prj.Tree; use Prj.Tree; ...@@ -29,11 +29,19 @@ with Prj.Tree; use Prj.Tree;
package Prj.Part is package Prj.Part is
type Errout_Mode is
(Always_Finalize,
Finalize_If_Error,
Never_Finalize);
-- Whether Parse should call Errout.Finalize (which prints the error
-- messages on stdout). When Never_Finalize is used, Errout is not reset
-- either at the beginning of Parse.
procedure Parse procedure Parse
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id; Project : out Project_Node_Id;
Project_File_Name : String; Project_File_Name : String;
Always_Errout_Finalize : Boolean; Errout_Handling : Errout_Mode := Always_Finalize;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False; Store_Comments : Boolean := False;
Current_Directory : String := ""; Current_Directory : String := "";
......
gcc/ada/prj-proc.adb
...@@ -1065,7 +1065,7 @@ package body Prj.Proc is ...@@ -1065,7 +1065,7 @@ package body Prj.Proc is
if Ext_List then if Ext_List then
Value := Value :=
Prj.Ext.Value_Of Prj.Ext.Value_Of
(From_Project_Node_Tree, Name, No_Name); (From_Project_Node_Tree.External, Name, No_Name);
if Value /= No_Name then if Value /= No_Name then
declare declare
...@@ -1171,7 +1171,7 @@ package body Prj.Proc is ...@@ -1171,7 +1171,7 @@ package body Prj.Proc is
Value := Value :=
Prj.Ext.Value_Of Prj.Ext.Value_Of
(From_Project_Node_Tree, Name, Default); (From_Project_Node_Tree.External, Name, Default);
if Value = No_Name then if Value = No_Name then
if not Quiet_Output then if not Quiet_Output then
......
gcc/ada/prj-tree.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -988,8 +988,12 @@ package body Prj.Tree is ...@@ -988,8 +988,12 @@ package body Prj.Tree is
Projects_Htable.Reset (Tree.Projects_HT); Projects_Htable.Reset (Tree.Projects_HT);
-- Do not reset the external references, in case we are reloading a -- Do not reset the external references, in case we are reloading a
-- project, since we want to preserve the current environment -- project, since we want to preserve the current environment.
-- Name_To_Name_HTable.Reset (Tree.External_References); -- But we still need to ensure that the external references are properly
-- initialized.
Prj.Ext.Initialize (Tree.External);
-- Prj.Ext.Reset (Tree.External);
end Initialize; end Initialize;
---------- ----------
...@@ -1003,7 +1007,7 @@ package body Prj.Tree is ...@@ -1003,7 +1007,7 @@ package body Prj.Tree is
if Proj /= null then if Proj /= null then
Project_Node_Table.Free (Proj.Project_Nodes); Project_Node_Table.Free (Proj.Project_Nodes);
Projects_Htable.Reset (Proj.Projects_HT); Projects_Htable.Reset (Proj.Projects_HT);
Name_To_Name_HTable.Reset (Proj.External_References); Prj.Ext.Free (Proj.External);
Free (Proj.Project_Path); Free (Proj.Project_Path);
Unchecked_Free (Proj); Unchecked_Free (Proj);
end if; end if;
......
gcc/ada/prj-tree.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,6 +32,7 @@ with Table; ...@@ -32,6 +32,7 @@ with Table;
with Prj.Attr; use Prj.Attr; with Prj.Attr; use Prj.Attr;
with Prj.Env; with Prj.Env;
with Prj.Ext;
package Prj.Tree is package Prj.Tree is
...@@ -1453,21 +1454,11 @@ package Prj.Tree is ...@@ -1453,21 +1454,11 @@ package Prj.Tree is
end Tree_Private_Part; end Tree_Private_Part;
package Name_To_Name_HTable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Name_Id,
No_Element => No_Name,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- General type for htables associating name_id to name_id. This is in
-- particular used to store the values of external references.
type Project_Node_Tree_Data is record type Project_Node_Tree_Data is record
Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance; Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
Projects_HT : Tree_Private_Part.Projects_Htable.Instance; Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
External_References : Name_To_Name_HTable.Instance; External : Prj.Ext.External_References;
-- External references are stored in this hash table (and manipulated -- External references are stored in this hash table (and manipulated
-- through subprograms in prj-ext.ads). External references are -- through subprograms in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but -- project-tree specific so that one can load the same tree twice but
......
gcc/ada/s-taprop-vxworks.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- GNARL 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -954,8 +954,13 @@ package body System.Task_Primitives.Operations is ...@@ -954,8 +954,13 @@ package body System.Task_Primitives.Operations is
-- Set processor affinity -- Set processor affinity
if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
-- Ada 2012 pragma CPU uses CPU numbers starting from 1, while
-- on VxWorks the first CPU is identified by a 0, so we need to
-- adjust.
Result := Result :=
taskCpuAffinitySet (T.Common.LL.Thread, int (T.Common.Base_CPU)); taskCpuAffinitySet
(T.Common.LL.Thread, int (T.Common.Base_CPU) - 1);
elsif T.Common.Task_Info /= Unspecified_Task_Info then elsif T.Common.Task_Info /= Unspecified_Task_Info then
Result := Result :=
...@@ -1412,10 +1417,14 @@ package body System.Task_Primitives.Operations is ...@@ -1412,10 +1417,14 @@ package body System.Task_Primitives.Operations is
if Environment_Task.Common.Base_CPU /= if Environment_Task.Common.Base_CPU /=
System.Multiprocessors.Not_A_Specific_CPU System.Multiprocessors.Not_A_Specific_CPU
then then
-- Ada 2012 pragma CPU uses CPU numbers starting from 1, while
-- on VxWorks the first CPU is identified by a 0, so we need to
-- adjust.
Result := Result :=
taskCpuAffinitySet taskCpuAffinitySet
(Environment_Task.Common.LL.Thread, (Environment_Task.Common.LL.Thread,
int (Environment_Task.Common.Base_CPU)); int (Environment_Task.Common.Base_CPU) - 1);
pragma Assert (Result /= -1); pragma Assert (Result /= -1);
end if; end if;
end Initialize; end Initialize;
......
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