Skip to content

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

[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
Showing with 218 additions and 117 deletions
gcc/ada/ChangeLog
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.
2011-12-22 Hristian Kirtchev <kirtchev@adacore.com>
......
gcc/ada/gnatcmd.adb
......@@ -264,6 +264,7 @@ procedure GNATCmd is
procedure Set_Library_For
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Libraries_Present : in out Boolean);
-- If Project is a library project, add the correct -L and -l switches to
-- the linker invocation.
......@@ -1264,9 +1265,10 @@ procedure GNATCmd is
procedure Set_Library_For
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Libraries_Present : in out Boolean)
is
pragma Unreferenced (Tree);
pragma Unreferenced (Tree, In_Aggregate_Lib);
Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option;
......
gcc/ada/makeutl.adb
......@@ -692,9 +692,10 @@ package body Makeutl is
is
procedure Recursive_Add
(Project : Project_Id;
Tree : Project_Tree_Ref;
Extended : in out Boolean);
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Extended : in out Boolean);
-- Add all the source directories of a project to the path only if
-- this project has not been visited. Calls itself recursively for
-- projects being extended, and imported projects.
......@@ -731,14 +732,18 @@ package body Makeutl is
-------------------
procedure Recursive_Add
(Project : Project_Id;
Tree : Project_Tree_Ref;
Extended : in out Boolean)
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Extended : in out Boolean)
is
pragma Unreferenced (In_Aggregate_Lib);
Current : String_List_Id;
Dir : String_Element;
OK : Boolean := False;
Lang_Proc : Language_Ptr := Project.Languages;
begin
-- Add to path all directories of this project
......@@ -1229,9 +1234,10 @@ package body Makeutl is
In_Tree : Project_Tree_Ref) return String_List
is
procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- The recursive routine used to add linker options
-------------------
......@@ -1239,11 +1245,12 @@ package body Makeutl is
-------------------
procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy);
pragma Unreferenced (Dummy, In_Aggregate_Lib);
Linker_Package : Package_Id;
Options : Variable_Value;
......
gcc/ada/prj-conf.adb
......@@ -728,9 +728,10 @@ package body Prj.Conf is
Value_Of (Name_Ide, Project.Decl.Packages, Shared);
procedure Add_Config_Switches_For_Project
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out Integer);
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
With_State : in out Integer);
-- Add all --config switches for this project. This is also called
-- for aggregate projects.
......@@ -739,11 +740,13 @@ package body Prj.Conf is
-------------------------------------
procedure Add_Config_Switches_For_Project
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out Integer)
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
With_State : in out Integer)
is
pragma Unreferenced (With_State);
pragma Unreferenced (With_State, In_Aggregate_Lib);
Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
Variable : Variable_Value;
......@@ -757,9 +760,8 @@ package body Prj.Conf is
Variable :=
Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
then
if Variable = Nil_Variable_Value or else Variable.Default then
-- Languages is not declared. If it is not an extending
-- project, or if it extends a project with no Languages,
-- check for Default_Language.
......@@ -792,17 +794,17 @@ package body Prj.Conf is
Lang := Name_Find;
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);
end if;
end if;
elsif Variable.Values /= Nil_String then
-- Attribute Languages is declared with a non empty
-- list: put all the languages in Language_HTable.
-- Attribute Languages is declared with a non empty list:
-- put all the languages in Language_HTable.
List := Variable.Values;
while List /= Nil_String loop
......
gcc/ada/prj-env.adb
......@@ -115,9 +115,10 @@ package body Prj.Env is
Buffer_Last : Natural := 0;
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Add source dirs of Project to the path
---------
......@@ -125,11 +126,12 @@ package body Prj.Env is
---------
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy);
pragma Unreferenced (Dummy, In_Aggregate_Lib);
begin
Add_To_Path
(Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
......@@ -185,9 +187,10 @@ package body Prj.Env is
Buffer_Last : Natural := 0;
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Add all the object directories of a project to the path
---------
......@@ -195,11 +198,12 @@ package body Prj.Env is
---------
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Tree);
pragma Unreferenced (Dummy, In_Tree, In_Aggregate_Lib);
Path : constant Path_Name_Type :=
Get_Object_Directory
......@@ -472,9 +476,10 @@ package body Prj.Env is
Current_Naming : Naming_Id;
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer);
-- Recursive procedure that put in the config pragmas file any non
-- standard naming schemes, if it is not already in the file, then call
-- itself for any imported project.
......@@ -496,11 +501,12 @@ package body Prj.Env is
-----------
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer)
is
pragma Unreferenced (State);
pragma Unreferenced (State, In_Aggregate_Lib);
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
......@@ -786,9 +792,10 @@ package body Prj.Env is
-- Put the line contained in the Name_Buffer in the global buffer
procedure Process
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer);
-- Generate the mapping file for Project (not recursively)
---------------------
......@@ -811,11 +818,12 @@ package body Prj.Env is
-------------
procedure Process
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer)
is
pragma Unreferenced (State);
pragma Unreferenced (State, In_Aggregate_Lib);
Source : Source_Id;
Suffix : File_Name_Type;
......@@ -1225,9 +1233,10 @@ package body Prj.Env is
Tree : Project_Tree_Ref)
is
procedure For_Project
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Integer);
(Prj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
......@@ -1235,11 +1244,12 @@ package body Prj.Env is
-----------------
procedure For_Project
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Integer)
(Prj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer)
is
pragma Unreferenced (Dummy, Tree);
pragma Unreferenced (Dummy, Tree, In_Aggregate_Lib);
begin
-- ??? Set_Ada_Paths has a different behavior for library project
......@@ -1270,9 +1280,10 @@ package body Prj.Env is
In_Tree : Project_Tree_Ref)
is
procedure For_Project
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Integer);
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
......@@ -1280,11 +1291,12 @@ package body Prj.Env is
-----------------
procedure For_Project
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Integer)
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer)
is
pragma Unreferenced (Dummy);
pragma Unreferenced (Dummy, In_Aggregate_Lib);
Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;
......@@ -1642,9 +1654,10 @@ package body Prj.Env is
Buffer_Last : Natural := 0;
procedure Recursive_Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Recursive procedure to add the source/object paths of extended/
-- imported projects.
......@@ -1653,11 +1666,12 @@ package body Prj.Env is
-------------------
procedure Recursive_Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Tree);
pragma Unreferenced (Dummy, In_Tree, In_Aggregate_Lib);
Path : Path_Name_Type;
......
gcc/ada/prj.adb
......@@ -528,20 +528,24 @@ package body Prj is
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check
(Project : Project_Id;
Tree : Project_Tree_Ref);
-- Check if a project has already been seen. If not seen, mark it as
-- Seen, Call Action, and check all its imported projects.
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean);
-- 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 --
---------------------
procedure Recursive_Check
(Project : Project_Id;
Tree : Project_Tree_Ref)
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean)
is
List : Project_List;
T : Project_Tree_Ref;
begin
if not Get (Seen, Project) then
......@@ -552,22 +556,28 @@ package body Prj is
Set (Seen, Project, True);
if not Imported_First then
Action (Project, Tree, With_State);
Action (Project, Tree, In_Aggregate_Lib, With_State);
end if;
-- Visit all extended projects
if Project.Extends /= No_Project then
Recursive_Check (Project.Extends, Tree);
Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib);
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;
while List /= null loop
Recursive_Check (List.Project, Tree);
List := List.Next;
end loop;
if Project.Qualifier /= Aggregate_Library
or else not Include_Aggregated
then
List := Project.Imported_Projects;
while List /= null loop
Recursive_Check (List.Project, Tree, In_Aggregate_Lib);
List := List.Next;
end loop;
end if;
-- Visit all aggregated projects
......@@ -580,14 +590,25 @@ package body Prj is
Agg := Project.Aggregated_Projects;
while Agg /= null loop
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;
end loop;
end;
end if;
if Imported_First then
Action (Project, Tree, With_State);
Action (Project, Tree, In_Aggregate_Lib, With_State);
end if;
end if;
end Recursive_Check;
......@@ -595,7 +616,7 @@ package body Prj is
-- Start of processing for For_Every_Project_Imported
begin
Recursive_Check (Project => By, Tree => Tree);
Recursive_Check (Project => By, Tree => Tree, In_Aggregate_Lib => False);
Reset (Seen);
end For_Every_Project_Imported;
......@@ -614,9 +635,10 @@ package body Prj is
Result : Source_Id := No_Source;
procedure Look_For_Sources
(Proj : Project_Id;
Tree : Project_Tree_Ref;
Src : in out Source_Id);
(Proj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate : Boolean;
Src : in out Source_Id);
-- Look for Base_Name in the sources of Proj
----------------------
......@@ -624,10 +646,13 @@ package body Prj is
----------------------
procedure Look_For_Sources
(Proj : Project_Id;
Tree : Project_Tree_Ref;
Src : in out Source_Id)
(Proj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate : Boolean;
Src : in out Source_Id)
is
pragma Unreferenced (In_Aggregate);
Iterator : Source_Iterator;
begin
......@@ -662,14 +687,14 @@ package body Prj is
if In_Extended_Only then
Proj := Project;
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;
Proj := Proj.Extends;
end loop;
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
For_Imported_Projects
......@@ -680,7 +705,7 @@ package body Prj is
end if;
else
Look_For_Sources (No_Project, In_Tree, Result);
Look_For_Sources (No_Project, In_Tree, False, Result);
end if;
return Result;
......@@ -1365,9 +1390,10 @@ package body Prj is
Project : Project_Id;
procedure Recursive_Add
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Boolean);
(Prj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
-- Recursively add the projects imported by project Project, but not
-- those that are extended.
......@@ -1376,11 +1402,13 @@ package body Prj is
-------------------
procedure Recursive_Add
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Boolean)
(Prj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, Tree);
pragma Unreferenced (Dummy, Tree, In_Aggregate_Lib);
List : Project_List;
Prj2 : Project_Id;
......
gcc/ada/prj.ads
......@@ -1562,9 +1562,10 @@ package Prj is
generic
type State is limited private;
with procedure Action
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State);
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
With_State : in out State);
procedure For_Every_Project_Imported
(By : Project_Id;
Tree : Project_Tree_Ref;
......@@ -1589,7 +1590,9 @@ package Prj is
--
-- If Include_Aggregated is True, then an aggregate project will recurse
-- 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
-- aggregated projects, since they might not be using the same tree as 'By'
......
gcc/ada/sem_ch3.adb
......@@ -15333,10 +15333,23 @@ package body Sem_Ch3 is
Spec : constant Entity_Id := Real_Range_Specification (Def);
begin
-- Check specified "digits" constraint
if Digs_Val > Digits_Value (E) then
return False;
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 Expr_Value_R (Type_Low_Bound (E)) >
Expr_Value_R (Low_Bound (Spec))
......
gcc/ada/sem_ch7.adb
......@@ -638,7 +638,6 @@ package body Sem_Ch7 is
-- Processing for package bodies
elsif K = N_Package_Body
and then not Has_Referencer_Except_For_Subprograms
and then Present (Corresponding_Spec (D))
then
E := Corresponding_Spec (D);
......@@ -648,7 +647,10 @@ package body Sem_Ch7 is
-- exported, i.e. where the corresponding spec is the
-- spec of the current package, but because of nested
-- 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
return True;
......@@ -657,7 +659,9 @@ package body Sem_Ch7 is
-- this is an instance, we ignore instances since they
-- 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
(Declarations (D), Outer => False)
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