Commit a17e8c05 by Arnaud Charlet

[multiple changes]

2011-12-23  Pascal Obry  <obry@adacore.com>

	* prj.ads (For_Every_Project_Imported): Add In_Aggregate_Lib
	parameter to generic formal procedure.
	* prj.adb (For_Every_Project_Imported): Update accordingly.
	(Recursive_Check): Likewise. Do not parse imported project for
	aggregate library. This is needed as the imported projects are
	there just to handle dependencies.
	(Look_For_Sources): Likewise.
	(Recursive_Add): Likewise.
	* prj-env.adb, prj-conf.adb, makeutl.adb, gnatcmd.adb:
	Add In_Aggregate_Lib parameter to routines used with
	For_Every_Project_Imported generic procedure.
	* prj-nmsc.adb (Tree_Processing_Data): Add In_Aggregate_Lib field.
	(Check): Move where it is used. Fix implementation
	to not check libraries that are inside aggregate libraries.
	(Recursive_Check): Add In_Aggregate_Lib parameter.

2011-12-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb (Analyze_Package_Body, Has_Referencer): A generic
	package is a referencer regardless of whether there is a
	subsequent subprogram with an Inline pragma.

2011-12-23  Geert Bosch  <bosch@adacore.com>

	* sem_ch3.adb (Can_Derive_From): Check matching Float_Rep on VMS.

From-SVN: r182656
parent 7471389a
2011-12-23 Pascal Obry <obry@adacore.com> 2011-12-23 Pascal Obry <obry@adacore.com>
* prj.ads (For_Every_Project_Imported): Add In_Aggregate_Lib
parameter to generic formal procedure.
* prj.adb (For_Every_Project_Imported): Update accordingly.
(Recursive_Check): Likewise. Do not parse imported project for
aggregate library. This is needed as the imported projects are
there just to handle dependencies.
(Look_For_Sources): Likewise.
(Recursive_Add): Likewise.
* prj-env.adb, prj-conf.adb, makeutl.adb, gnatcmd.adb:
Add In_Aggregate_Lib parameter to routines used with
For_Every_Project_Imported generic procedure.
* prj-nmsc.adb (Tree_Processing_Data): Add In_Aggregate_Lib field.
(Check): Move where it is used. Fix implementation
to not check libraries that are inside aggregate libraries.
(Recursive_Check): Add In_Aggregate_Lib parameter.
2011-12-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch7.adb (Analyze_Package_Body, Has_Referencer): A generic
package is a referencer regardless of whether there is a
subsequent subprogram with an Inline pragma.
2011-12-23 Geert Bosch <bosch@adacore.com>
* sem_ch3.adb (Can_Derive_From): Check matching Float_Rep on VMS.
2011-12-23 Pascal Obry <obry@adacore.com>
* gnatcmd.adb, prj.adb, prj-nmsc.adb: Minor reformatting. * gnatcmd.adb, prj.adb, prj-nmsc.adb: Minor reformatting.
2011-12-22 Hristian Kirtchev <kirtchev@adacore.com> 2011-12-22 Hristian Kirtchev <kirtchev@adacore.com>
......
...@@ -264,6 +264,7 @@ procedure GNATCmd is ...@@ -264,6 +264,7 @@ procedure GNATCmd is
procedure Set_Library_For procedure Set_Library_For
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Libraries_Present : in out Boolean); Libraries_Present : in out Boolean);
-- If Project is a library project, add the correct -L and -l switches to -- If Project is a library project, add the correct -L and -l switches to
-- the linker invocation. -- the linker invocation.
...@@ -1264,9 +1265,10 @@ procedure GNATCmd is ...@@ -1264,9 +1265,10 @@ procedure GNATCmd is
procedure Set_Library_For procedure Set_Library_For
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Libraries_Present : in out Boolean) Libraries_Present : in out Boolean)
is is
pragma Unreferenced (Tree); pragma Unreferenced (Tree, In_Aggregate_Lib);
Path_Option : constant String_Access := Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option; MLib.Linker_Library_Path_Option;
......
...@@ -692,9 +692,10 @@ package body Makeutl is ...@@ -692,9 +692,10 @@ package body Makeutl is
is is
procedure Recursive_Add procedure Recursive_Add
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Extended : in out Boolean); In_Aggregate_Lib : Boolean;
Extended : in out Boolean);
-- Add all the source directories of a project to the path only if -- Add all the source directories of a project to the path only if
-- this project has not been visited. Calls itself recursively for -- this project has not been visited. Calls itself recursively for
-- projects being extended, and imported projects. -- projects being extended, and imported projects.
...@@ -731,14 +732,18 @@ package body Makeutl is ...@@ -731,14 +732,18 @@ package body Makeutl is
------------------- -------------------
procedure Recursive_Add procedure Recursive_Add
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Extended : in out Boolean) In_Aggregate_Lib : Boolean;
Extended : in out Boolean)
is is
pragma Unreferenced (In_Aggregate_Lib);
Current : String_List_Id; Current : String_List_Id;
Dir : String_Element; Dir : String_Element;
OK : Boolean := False; OK : Boolean := False;
Lang_Proc : Language_Ptr := Project.Languages; Lang_Proc : Language_Ptr := Project.Languages;
begin begin
-- Add to path all directories of this project -- Add to path all directories of this project
...@@ -1229,9 +1234,10 @@ package body Makeutl is ...@@ -1229,9 +1234,10 @@ package body Makeutl is
In_Tree : Project_Tree_Ref) return String_List In_Tree : Project_Tree_Ref) return String_List
is is
procedure Recursive_Add procedure Recursive_Add
(Proj : Project_Id; (Proj : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean); In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- The recursive routine used to add linker options -- The recursive routine used to add linker options
------------------- -------------------
...@@ -1239,11 +1245,12 @@ package body Makeutl is ...@@ -1239,11 +1245,12 @@ package body Makeutl is
------------------- -------------------
procedure Recursive_Add procedure Recursive_Add
(Proj : Project_Id; (Proj : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean) In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy, In_Aggregate_Lib);
Linker_Package : Package_Id; Linker_Package : Package_Id;
Options : Variable_Value; Options : Variable_Value;
......
...@@ -728,9 +728,10 @@ package body Prj.Conf is ...@@ -728,9 +728,10 @@ package body Prj.Conf is
Value_Of (Name_Ide, Project.Decl.Packages, Shared); Value_Of (Name_Ide, Project.Decl.Packages, Shared);
procedure Add_Config_Switches_For_Project procedure Add_Config_Switches_For_Project
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
With_State : in out Integer); In_Aggregate_Lib : Boolean;
With_State : in out Integer);
-- Add all --config switches for this project. This is also called -- Add all --config switches for this project. This is also called
-- for aggregate projects. -- for aggregate projects.
...@@ -739,11 +740,13 @@ package body Prj.Conf is ...@@ -739,11 +740,13 @@ package body Prj.Conf is
------------------------------------- -------------------------------------
procedure Add_Config_Switches_For_Project procedure Add_Config_Switches_For_Project
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
With_State : in out Integer) In_Aggregate_Lib : Boolean;
With_State : in out Integer)
is is
pragma Unreferenced (With_State); pragma Unreferenced (With_State, In_Aggregate_Lib);
Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared; Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
Variable : Variable_Value; Variable : Variable_Value;
...@@ -757,9 +760,8 @@ package body Prj.Conf is ...@@ -757,9 +760,8 @@ package body Prj.Conf is
Variable := Variable :=
Value_Of (Name_Languages, Project.Decl.Attributes, Shared); Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
if Variable = Nil_Variable_Value if Variable = Nil_Variable_Value or else Variable.Default then
or else Variable.Default
then
-- Languages is not declared. If it is not an extending -- Languages is not declared. If it is not an extending
-- project, or if it extends a project with no Languages, -- project, or if it extends a project with no Languages,
-- check for Default_Language. -- check for Default_Language.
...@@ -792,17 +794,17 @@ package body Prj.Conf is ...@@ -792,17 +794,17 @@ package body Prj.Conf is
Lang := Name_Find; Lang := Name_Find;
Language_Htable.Set (Lang, Lang); Language_Htable.Set (Lang, Lang);
else -- If no default language is declared, default to Ada
-- If no default language is declared, default to Ada
else
Language_Htable.Set (Name_Ada, Name_Ada); Language_Htable.Set (Name_Ada, Name_Ada);
end if; end if;
end if; end if;
elsif Variable.Values /= Nil_String then elsif Variable.Values /= Nil_String then
-- Attribute Languages is declared with a non empty -- Attribute Languages is declared with a non empty list:
-- list: put all the languages in Language_HTable. -- put all the languages in Language_HTable.
List := Variable.Values; List := Variable.Values;
while List /= Nil_String loop while List /= Nil_String loop
......
...@@ -115,9 +115,10 @@ package body Prj.Env is ...@@ -115,9 +115,10 @@ package body Prj.Env is
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
procedure Add procedure Add
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean); In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Add source dirs of Project to the path -- Add source dirs of Project to the path
--------- ---------
...@@ -125,11 +126,12 @@ package body Prj.Env is ...@@ -125,11 +126,12 @@ package body Prj.Env is
--------- ---------
procedure Add procedure Add
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean) In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy, In_Aggregate_Lib);
begin begin
Add_To_Path Add_To_Path
(Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last); (Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
...@@ -185,9 +187,10 @@ package body Prj.Env is ...@@ -185,9 +187,10 @@ package body Prj.Env is
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
procedure Add procedure Add
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean); In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Add all the object directories of a project to the path -- Add all the object directories of a project to the path
--------- ---------
...@@ -195,11 +198,12 @@ package body Prj.Env is ...@@ -195,11 +198,12 @@ package body Prj.Env is
--------- ---------
procedure Add procedure Add
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean) In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is is
pragma Unreferenced (Dummy, In_Tree); pragma Unreferenced (Dummy, In_Tree, In_Aggregate_Lib);
Path : constant Path_Name_Type := Path : constant Path_Name_Type :=
Get_Object_Directory Get_Object_Directory
...@@ -472,9 +476,10 @@ package body Prj.Env is ...@@ -472,9 +476,10 @@ package body Prj.Env is
Current_Naming : Naming_Id; Current_Naming : Naming_Id;
procedure Check procedure Check
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
State : in out Integer); In_Aggregate_Lib : Boolean;
State : in out Integer);
-- Recursive procedure that put in the config pragmas file any non -- Recursive procedure that put in the config pragmas file any non
-- standard naming schemes, if it is not already in the file, then call -- standard naming schemes, if it is not already in the file, then call
-- itself for any imported project. -- itself for any imported project.
...@@ -496,11 +501,12 @@ package body Prj.Env is ...@@ -496,11 +501,12 @@ package body Prj.Env is
----------- -----------
procedure Check procedure Check
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
State : in out Integer) In_Aggregate_Lib : Boolean;
State : in out Integer)
is is
pragma Unreferenced (State); pragma Unreferenced (State, In_Aggregate_Lib);
Lang : constant Language_Ptr := Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada"); Get_Language_From_Name (Project, "ada");
...@@ -786,9 +792,10 @@ package body Prj.Env is ...@@ -786,9 +792,10 @@ package body Prj.Env is
-- Put the line contained in the Name_Buffer in the global buffer -- Put the line contained in the Name_Buffer in the global buffer
procedure Process procedure Process
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
State : in out Integer); In_Aggregate_Lib : Boolean;
State : in out Integer);
-- Generate the mapping file for Project (not recursively) -- Generate the mapping file for Project (not recursively)
--------------------- ---------------------
...@@ -811,11 +818,12 @@ package body Prj.Env is ...@@ -811,11 +818,12 @@ package body Prj.Env is
------------- -------------
procedure Process procedure Process
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
State : in out Integer) In_Aggregate_Lib : Boolean;
State : in out Integer)
is is
pragma Unreferenced (State); pragma Unreferenced (State, In_Aggregate_Lib);
Source : Source_Id; Source : Source_Id;
Suffix : File_Name_Type; Suffix : File_Name_Type;
...@@ -1225,9 +1233,10 @@ package body Prj.Env is ...@@ -1225,9 +1233,10 @@ package body Prj.Env is
Tree : Project_Tree_Ref) Tree : Project_Tree_Ref)
is is
procedure For_Project procedure For_Project
(Prj : Project_Id; (Prj : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Dummy : in out Integer); In_Aggregate_Lib : Boolean;
Dummy : in out Integer);
-- Get all object directories of Prj -- Get all object directories of Prj
----------------- -----------------
...@@ -1235,11 +1244,12 @@ package body Prj.Env is ...@@ -1235,11 +1244,12 @@ package body Prj.Env is
----------------- -----------------
procedure For_Project procedure For_Project
(Prj : Project_Id; (Prj : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Dummy : in out Integer) In_Aggregate_Lib : Boolean;
Dummy : in out Integer)
is is
pragma Unreferenced (Dummy, Tree); pragma Unreferenced (Dummy, Tree, In_Aggregate_Lib);
begin begin
-- ??? Set_Ada_Paths has a different behavior for library project -- ??? Set_Ada_Paths has a different behavior for library project
...@@ -1270,9 +1280,10 @@ package body Prj.Env is ...@@ -1270,9 +1280,10 @@ package body Prj.Env is
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
is is
procedure For_Project procedure For_Project
(Prj : Project_Id; (Prj : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Integer); In_Aggregate_Lib : Boolean;
Dummy : in out Integer);
-- Get all object directories of Prj -- Get all object directories of Prj
----------------- -----------------
...@@ -1280,11 +1291,12 @@ package body Prj.Env is ...@@ -1280,11 +1291,12 @@ package body Prj.Env is
----------------- -----------------
procedure For_Project procedure For_Project
(Prj : Project_Id; (Prj : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Integer) In_Aggregate_Lib : Boolean;
Dummy : in out Integer)
is is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy, In_Aggregate_Lib);
Current : String_List_Id := Prj.Source_Dirs; Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element; The_String : String_Element;
...@@ -1642,9 +1654,10 @@ package body Prj.Env is ...@@ -1642,9 +1654,10 @@ package body Prj.Env is
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
procedure Recursive_Add procedure Recursive_Add
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean); In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Recursive procedure to add the source/object paths of extended/ -- Recursive procedure to add the source/object paths of extended/
-- imported projects. -- imported projects.
...@@ -1653,11 +1666,12 @@ package body Prj.Env is ...@@ -1653,11 +1666,12 @@ package body Prj.Env is
------------------- -------------------
procedure Recursive_Add procedure Recursive_Add
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Dummy : in out Boolean) In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is is
pragma Unreferenced (Dummy, In_Tree); pragma Unreferenced (Dummy, In_Tree, In_Aggregate_Lib);
Path : Path_Name_Type; Path : Path_Name_Type;
......
...@@ -528,20 +528,24 @@ package body Prj is ...@@ -528,20 +528,24 @@ package body Prj is
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref); Tree : Project_Tree_Ref;
-- Check if a project has already been seen. If not seen, mark it as In_Aggregate_Lib : Boolean);
-- Seen, Call Action, and check all its imported projects. -- Check if a project has already been seen. If not seen, mark it
-- as Seen, Call Action, and check all its imported and aggregated
-- projects.
--------------------- ---------------------
-- Recursive_Check -- -- Recursive_Check --
--------------------- ---------------------
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref) Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean)
is is
List : Project_List; List : Project_List;
T : Project_Tree_Ref;
begin begin
if not Get (Seen, Project) then if not Get (Seen, Project) then
...@@ -552,22 +556,28 @@ package body Prj is ...@@ -552,22 +556,28 @@ package body Prj is
Set (Seen, Project, True); Set (Seen, Project, True);
if not Imported_First then if not Imported_First then
Action (Project, Tree, With_State); Action (Project, Tree, In_Aggregate_Lib, With_State);
end if; end if;
-- Visit all extended projects -- Visit all extended projects
if Project.Extends /= No_Project then if Project.Extends /= No_Project then
Recursive_Check (Project.Extends, Tree); Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib);
end if; end if;
-- Visit all imported projects -- Visit all imported projects if needed. This is not needed
-- for an aggregate library as imported libraries are just
-- there for dependency support.
List := Project.Imported_Projects; if Project.Qualifier /= Aggregate_Library
while List /= null loop or else not Include_Aggregated
Recursive_Check (List.Project, Tree); then
List := List.Next; List := Project.Imported_Projects;
end loop; while List /= null loop
Recursive_Check (List.Project, Tree, In_Aggregate_Lib);
List := List.Next;
end loop;
end if;
-- Visit all aggregated projects -- Visit all aggregated projects
...@@ -580,14 +590,25 @@ package body Prj is ...@@ -580,14 +590,25 @@ package body Prj is
Agg := Project.Aggregated_Projects; Agg := Project.Aggregated_Projects;
while Agg /= null loop while Agg /= null loop
pragma Assert (Agg.Project /= No_Project); pragma Assert (Agg.Project /= No_Project);
Recursive_Check (Agg.Project, Agg.Tree);
-- For aggregated libraries, the tree must be the one
-- of the aggregate library.
if Project.Qualifier = Aggregate_Library then
T := Tree;
else
T := Agg.Tree;
end if;
Recursive_Check
(Agg.Project, T, Project.Qualifier = Aggregate_Library);
Agg := Agg.Next; Agg := Agg.Next;
end loop; end loop;
end; end;
end if; end if;
if Imported_First then if Imported_First then
Action (Project, Tree, With_State); Action (Project, Tree, In_Aggregate_Lib, With_State);
end if; end if;
end if; end if;
end Recursive_Check; end Recursive_Check;
...@@ -595,7 +616,7 @@ package body Prj is ...@@ -595,7 +616,7 @@ package body Prj is
-- Start of processing for For_Every_Project_Imported -- Start of processing for For_Every_Project_Imported
begin begin
Recursive_Check (Project => By, Tree => Tree); Recursive_Check (Project => By, Tree => Tree, In_Aggregate_Lib => False);
Reset (Seen); Reset (Seen);
end For_Every_Project_Imported; end For_Every_Project_Imported;
...@@ -614,9 +635,10 @@ package body Prj is ...@@ -614,9 +635,10 @@ package body Prj is
Result : Source_Id := No_Source; Result : Source_Id := No_Source;
procedure Look_For_Sources procedure Look_For_Sources
(Proj : Project_Id; (Proj : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Src : in out Source_Id); In_Aggregate : Boolean;
Src : in out Source_Id);
-- Look for Base_Name in the sources of Proj -- Look for Base_Name in the sources of Proj
---------------------- ----------------------
...@@ -624,10 +646,13 @@ package body Prj is ...@@ -624,10 +646,13 @@ package body Prj is
---------------------- ----------------------
procedure Look_For_Sources procedure Look_For_Sources
(Proj : Project_Id; (Proj : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Src : in out Source_Id) In_Aggregate : Boolean;
Src : in out Source_Id)
is is
pragma Unreferenced (In_Aggregate);
Iterator : Source_Iterator; Iterator : Source_Iterator;
begin begin
...@@ -662,14 +687,14 @@ package body Prj is ...@@ -662,14 +687,14 @@ package body Prj is
if In_Extended_Only then if In_Extended_Only then
Proj := Project; Proj := Project;
while Proj /= No_Project loop while Proj /= No_Project loop
Look_For_Sources (Proj, In_Tree, Result); Look_For_Sources (Proj, In_Tree, False, Result);
exit when Result /= No_Source; exit when Result /= No_Source;
Proj := Proj.Extends; Proj := Proj.Extends;
end loop; end loop;
elsif In_Imported_Only then elsif In_Imported_Only then
Look_For_Sources (Project, In_Tree, Result); Look_For_Sources (Project, In_Tree, False, Result);
if Result = No_Source then if Result = No_Source then
For_Imported_Projects For_Imported_Projects
...@@ -680,7 +705,7 @@ package body Prj is ...@@ -680,7 +705,7 @@ package body Prj is
end if; end if;
else else
Look_For_Sources (No_Project, In_Tree, Result); Look_For_Sources (No_Project, In_Tree, False, Result);
end if; end if;
return Result; return Result;
...@@ -1365,9 +1390,10 @@ package body Prj is ...@@ -1365,9 +1390,10 @@ package body Prj is
Project : Project_Id; Project : Project_Id;
procedure Recursive_Add procedure Recursive_Add
(Prj : Project_Id; (Prj : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Dummy : in out Boolean); In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Recursively add the projects imported by project Project, but not -- Recursively add the projects imported by project Project, but not
-- those that are extended. -- those that are extended.
...@@ -1376,11 +1402,13 @@ package body Prj is ...@@ -1376,11 +1402,13 @@ package body Prj is
------------------- -------------------
procedure Recursive_Add procedure Recursive_Add
(Prj : Project_Id; (Prj : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Dummy : in out Boolean) In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is is
pragma Unreferenced (Dummy, Tree); pragma Unreferenced (Dummy, Tree, In_Aggregate_Lib);
List : Project_List; List : Project_List;
Prj2 : Project_Id; Prj2 : Project_Id;
......
...@@ -1562,9 +1562,10 @@ package Prj is ...@@ -1562,9 +1562,10 @@ package Prj is
generic generic
type State is limited private; type State is limited private;
with procedure Action with procedure Action
(Project : Project_Id; (Project : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
With_State : in out State); In_Aggregate_Lib : Boolean;
With_State : in out State);
procedure For_Every_Project_Imported procedure For_Every_Project_Imported
(By : Project_Id; (By : Project_Id;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
...@@ -1589,7 +1590,9 @@ package Prj is ...@@ -1589,7 +1590,9 @@ package Prj is
-- --
-- If Include_Aggregated is True, then an aggregate project will recurse -- If Include_Aggregated is True, then an aggregate project will recurse
-- into the projects it aggregates. Otherwise, the latter are never -- into the projects it aggregates. Otherwise, the latter are never
-- returned -- returned.
--
-- In_Aggregate_Lib is True if the project is in an aggregate library
-- --
-- The Tree argument passed to the callback is required in the case of -- The Tree argument passed to the callback is required in the case of
-- aggregated projects, since they might not be using the same tree as 'By' -- aggregated projects, since they might not be using the same tree as 'By'
......
...@@ -15333,10 +15333,23 @@ package body Sem_Ch3 is ...@@ -15333,10 +15333,23 @@ package body Sem_Ch3 is
Spec : constant Entity_Id := Real_Range_Specification (Def); Spec : constant Entity_Id := Real_Range_Specification (Def);
begin begin
-- Check specified "digits" constraint
if Digs_Val > Digits_Value (E) then if Digs_Val > Digits_Value (E) then
return False; return False;
end if; end if;
-- Avoid types not matching pragma Float_Representation, if present
if (Opt.Float_Format = 'I' and then Float_Rep (E) /= IEEE_Binary)
or else
(Opt.Float_Format = 'V' and then Float_Rep (E) /= VAX_Native)
then
return False;
end if;
-- Check for matching range, if specified
if Present (Spec) then if Present (Spec) then
if Expr_Value_R (Type_Low_Bound (E)) > if Expr_Value_R (Type_Low_Bound (E)) >
Expr_Value_R (Low_Bound (Spec)) Expr_Value_R (Low_Bound (Spec))
......
...@@ -638,7 +638,6 @@ package body Sem_Ch7 is ...@@ -638,7 +638,6 @@ package body Sem_Ch7 is
-- Processing for package bodies -- Processing for package bodies
elsif K = N_Package_Body elsif K = N_Package_Body
and then not Has_Referencer_Except_For_Subprograms
and then Present (Corresponding_Spec (D)) and then Present (Corresponding_Spec (D))
then then
E := Corresponding_Spec (D); E := Corresponding_Spec (D);
...@@ -648,7 +647,10 @@ package body Sem_Ch7 is ...@@ -648,7 +647,10 @@ package body Sem_Ch7 is
-- exported, i.e. where the corresponding spec is the -- exported, i.e. where the corresponding spec is the
-- spec of the current package, but because of nested -- spec of the current package, but because of nested
-- instantiations, a fully private generic body may -- instantiations, a fully private generic body may
-- export other private body entities. -- export other private body entities. Furthermore,
-- regardless of whether there was a previous inlined
-- subprogram, (an instantiation of) the generic package
-- may reference any entity declared before it.
if Is_Generic_Unit (E) then if Is_Generic_Unit (E) then
return True; return True;
...@@ -657,7 +659,9 @@ package body Sem_Ch7 is ...@@ -657,7 +659,9 @@ package body Sem_Ch7 is
-- this is an instance, we ignore instances since they -- this is an instance, we ignore instances since they
-- cannot have references that affect outer entities. -- cannot have references that affect outer entities.
elsif not Is_Generic_Instance (E) then elsif not Is_Generic_Instance (E)
and then not Has_Referencer_Except_For_Subprograms
then
if Has_Referencer if Has_Referencer
(Declarations (D), Outer => False) (Declarations (D), Outer => False)
then then
......
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