mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-19 01:40:39 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-07-13  Emmanuel Briot  <briot@adacore.com>

	* prj.adb, prj.ads, prj-env.adb, prj-conf.adb, prj-tree.adb,
	mlib-prj.adb (Private_Part.Ada_Prj_Objects_File_Set,
	Ada_Prj_Include_File_Set): Removed, since not needed
	Code clean up.

2009-07-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Set_Membership): New procedure, subsidiary of
	Analyze_Membership_Op.

	* sem_res.adb (Resolve_Set_Membership): New procedure, subsidiary of
	Resolve_Membership_Op.

	* exp_ch4.adb (Expand_Set_Membership): New procedure, subsidiary of
	Expand_N_In.

2009-07-13  Robert Dewar  <dewar@adacore.com>

	* clean.adb: Minor reformattting

From-SVN: r149569
This commit is contained in:
Arnaud Charlet 2009-07-13 12:52:34 +02:00
parent 7bccff2426
commit 197e4514ff
12 changed files with 261 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
2009-07-13 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, prj-env.adb, prj-conf.adb, prj-tree.adb,
mlib-prj.adb (Private_Part.Ada_Prj_Objects_File_Set,
Ada_Prj_Include_File_Set): Removed, since not needed
Code clean up.
2009-07-13 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Analyze_Set_Membership): New procedure, subsidiary of
Analyze_Membership_Op.
* sem_res.adb (Resolve_Set_Membership): New procedure, subsidiary of
Resolve_Membership_Op.
* exp_ch4.adb (Expand_Set_Membership): New procedure, subsidiary of
Expand_N_In.
2009-07-13 Robert Dewar <dewar@adacore.com>
* clean.adb: Minor reformattting
2009-07-13 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, make.adb, mlib-prj.adb, prj-ext.adb,

11
gcc/ada/clean.adb
View File

@ -1045,13 +1045,14 @@ package body Clean is
Proj := Project_Tree.Projects;
while Proj /= null loop
-- for gnatmake, when the project specifies more than
-- Ada as a language (even if course we could not find
-- any source file for the other languages), we will
-- take all object files found in the object
-- For gnatmake, when the project specifies more than
-- just Ada as a language (even if course we could not
-- find any source file for the other languages), we
-- will take all the object files found in the object
-- directories. Since we know the project supports at
-- least Ada, we just have to test whether it has at
-- least two languages, and not care about the sources
-- least two languages, and we do not care about the
-- sources.
if Proj.Project.Languages /= null
and then Proj.Project.Languages.Next /= null

72
gcc/ada/exp_ch4.adb
View File

@ -4121,6 +4121,67 @@ package body Exp_Ch4 is
Rop : constant Node_Id := Right_Opnd (N);
Static : constant Boolean := Is_OK_Static_Expression (N);
procedure Expand_Set_Membership;
-- For each disjunct we create a simple equality or membership test.
-- The whole membership is rewritten as a short-circuit disjunction.
---------------------------
-- Expand_Set_Membership --
---------------------------
procedure Expand_Set_Membership is
Alt : Node_Id;
Res : Node_Id;
function Make_Cond (Alt : Node_Id) return Node_Id;
-- If the alternative is a subtype mark, create a simple membership
-- test. Otherwise create an equality test for it.
---------------
-- Make_Cond --
---------------
function Make_Cond (Alt : Node_Id) return Node_Id is
Cond : Node_Id;
L : constant Node_Id := New_Copy (Lop);
R : constant Node_Id := Relocate_Node (Alt);
begin
if Is_Entity_Name (Alt)
and then Is_Type (Entity (Alt))
then
Cond :=
Make_In (Sloc (Alt),
Left_Opnd => L,
Right_Opnd => R);
else
Cond := Make_Op_Eq (Sloc (Alt),
Left_Opnd => L,
Right_Opnd => R);
end if;
return Cond;
end Make_Cond;
-- Start of proessing for Expand_N_In
begin
Alt := Last (Alternatives (N));
Res := Make_Cond (Alt);
Prev (Alt);
while Present (Alt) loop
Res :=
Make_Or_Else (Sloc (Alt),
Left_Opnd => Make_Cond (Alt),
Right_Opnd => Res);
Prev (Alt);
end loop;
Rewrite (N, Res);
Analyze_And_Resolve (N, Standard_Boolean);
end Expand_Set_Membership;
procedure Substitute_Valid_Check;
-- Replaces node N by Lop'Valid. This is done when we have an explicit
-- test for the left operand being in range of its subtype.
@ -4146,6 +4207,13 @@ package body Exp_Ch4 is
-- Start of processing for Expand_N_In
begin
if Present (Alternatives (N)) then
Remove_Side_Effects (Lop);
Expand_Set_Membership;
return;
end if;
-- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid
-- test and give a warning.
@ -4733,6 +4801,10 @@ package body Exp_Ch4 is
Left_Opnd => Left_Opnd (N),
Right_Opnd => Right_Opnd (N))));
-- If this is a set membership, preserve list of alternatives
Set_Alternatives (Right_Opnd (N), Alternatives (Original_Node (N)));
-- We want this to appear as coming from source if original does (see
-- transformations in Expand_N_In).

2
gcc/ada/gnat1drv.adb
View File

@ -752,7 +752,7 @@ begin
-- a VM, since representations are largely symbolic there.
if Back_End_Mode = Declarations_Only
and then (not (Back_Annotate_Rep_Info or else Inspector_Mode)
and then (not (Back_Annotate_Rep_Info or Inspector_Mode)
or else Main_Kind = N_Subunit
or else Targparm.Frontend_Layout_On_Target
or else Targparm.VM_Target /= No_VM)

4
gcc/ada/mlib-prj.adb
View File

@ -1328,12 +1328,12 @@ package body MLib.Prj is
In_Main_Object_Directory := True;
-- for gnatmake, when the project specifies more than Ada as a
-- For gnatmake, when the project specifies more than just Ada as a
-- language (even if course we could not find any source file for
-- the other languages), we will take all object files found in the
-- object directories. Since we know the project supports at least
-- Ada, we just have to test whether it has at least two languages,
-- and not care about the sources
-- and not care about the sources.
Foreign_Sources := For_Project.Languages.Next /= null;
Current_Proj := For_Project;

6
gcc/ada/prj-conf.adb
View File

@ -1185,10 +1185,14 @@ package body Prj.Conf is
Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
Name := Name_Find;
-- An invalid project name to avoid conflicts with user-created ones
Name_Len := 5;
Name_Buffer (1 .. Name_Len) := "_auto";
Config_File :=
Create_Project
(In_Tree => Project_Tree,
Name => Name_Default,
Name => Name_Find,
Full_Path => Path_Name_Type (Name),
Is_Config_File => True);

3
gcc/ada/prj-env.adb
View File

@ -1641,7 +1641,6 @@ package body Prj.Env is
Set_Path_File_Var
(Project_Include_Path_File,
Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File));
In_Tree.Private_Part.Ada_Prj_Include_File_Set := True;
end if;
if Including_Libraries then
@ -1654,7 +1653,6 @@ package body Prj.Env is
(Project_Objects_Path_File,
Get_Name_String
(In_Tree.Private_Part.Current_Object_Path_File));
In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
end if;
else
@ -1667,7 +1665,6 @@ package body Prj.Env is
(Project_Objects_Path_File,
Get_Name_String
(In_Tree.Private_Part.Current_Object_Path_File));
In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
end if;
end if;
end Set_Ada_Paths;

24
gcc/ada/prj-tree.adb
View File

@ -2848,15 +2848,17 @@ package body Prj.Tree is
Qualifier := Configuration;
end if;
Prj.Tree.Tree_Private_Part.Projects_Htable.Set
(In_Tree.Projects_HT,
Name,
Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
(Name => Name,
Canonical_Path => No_Path,
Node => Project,
Extended => False,
Proj_Qualifier => Qualifier));
if not Is_Config_File then
Prj.Tree.Tree_Private_Part.Projects_Htable.Set
(In_Tree.Projects_HT,
Name,
Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
(Name => Name,
Canonical_Path => No_Path,
Node => Project,
Extended => False,
Proj_Qualifier => Qualifier));
end if;
return Project;
end Create_Project;
@ -3044,7 +3046,9 @@ package body Prj.Tree is
-- Find out the case sensitivity of the attribute
if Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration then
if Prj_Or_Pkg /= Empty_Node
and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
then
Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
Start_At := First_Attribute_Of (Pkg);
else

8
gcc/ada/prj.adb
View File

@ -223,14 +223,12 @@ package body Prj is
-- the empty string. On VMS, this has the effect of deassigning
-- the logical names.
if Tree.Private_Part.Ada_Prj_Include_File_Set then
if Tree.Private_Part.Current_Source_Path_File /= No_Path then
Setenv (Project_Include_Path_File, "");
Tree.Private_Part.Ada_Prj_Include_File_Set := False;
end if;
if Tree.Private_Part.Ada_Prj_Objects_File_Set then
if Tree.Private_Part.Current_Object_Path_File /= No_Path then
Setenv (Project_Objects_Path_File, "");
Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
end if;
end Delete_All_Temp_Files;
@ -879,8 +877,6 @@ package body Prj is
Tree.Private_Part.Current_Source_Path_File := No_Path;
Tree.Private_Part.Current_Object_Path_File := No_Path;
Tree.Private_Part.Ada_Prj_Include_File_Set := False;
Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
end Reset;
-------------------

15
gcc/ada/prj.ads
View File

@ -1477,7 +1477,10 @@ private
Current_Source_Path_File : Path_Name_Type := No_Path;
-- Current value of project source path file env var. Used to avoid
-- setting the env var to the same value.
-- setting the env var to the same value. When different from No_Path,
-- this indicates that logical names (VMS) or environment variables were
-- created and should be deassigned to avoid polluting the environment
-- on VMS.
-- gnatmake only
Current_Object_Path_File : Path_Name_Type := No_Path;
@ -1485,16 +1488,6 @@ private
-- setting the env var to the same value.
-- gnatmake only
Ada_Prj_Include_File_Set : Boolean := False;
Ada_Prj_Objects_File_Set : Boolean := False;
-- These flags are set to True when the corresponding environment
-- variables are set and are used to give these environment variables an
-- empty string value at the end of the program. This has no practical
-- effect on most platforms, except on VMS where the logical names are
-- deassigned, thus avoiding the pollution of the environment of the
-- caller.
-- gnatmake only
end record;
-- Type to represent the part of a project tree which is private to the
-- Project Manager.

95
gcc/ada/sem_ch4.adb
View File

@ -2050,11 +2050,105 @@ package body Sem_Ch4 is
end Try_One_Interp;
procedure Analyze_Set_Membership;
-- If a set of alternatives is present, analyze each and find the
-- common type to which they must all resolve.
----------------------------
-- Analyze_Set_Membership --
----------------------------
procedure Analyze_Set_Membership is
Alt : Node_Id;
Index : Interp_Index;
It : Interp;
Candidate_Interps : Node_Id;
Common_Type : Entity_Id := Empty;
begin
Analyze (L);
Candidate_Interps := L;
if not Is_Overloaded (L) then
Common_Type := Etype (L);
Alt := First (Alternatives (N));
while Present (Alt) loop
Analyze (Alt);
if not Has_Compatible_Type (Alt, Common_Type) then
Wrong_Type (Alt, Common_Type);
end if;
Next (Alt);
end loop;
else
Alt := First (Alternatives (N));
while Present (Alt) loop
Analyze (Alt);
if not Is_Overloaded (Alt) then
Common_Type := Etype (Alt);
else
Get_First_Interp (Alt, Index, It);
while Present (It.Typ) loop
if
not Has_Compatible_Type (Candidate_Interps, It.Typ)
then
Remove_Interp (Index);
end if;
Get_Next_Interp (Index, It);
end loop;
Get_First_Interp (Alt, Index, It);
if No (It.Typ) then
Error_Msg_N ("alternative has no legal type", Alt);
return;
end if;
-- If alternative is not overloaded, we have a
-- unique type for all of them.
Set_Etype (Alt, It.Typ);
Get_Next_Interp (Index, It);
if No (It.Typ) then
Set_Is_Overloaded (Alt, False);
Common_Type := Etype (Alt);
end if;
Candidate_Interps := Alt;
end if;
Next (Alt);
end loop;
end if;
Set_Etype (N, Standard_Boolean);
if Present (Common_Type) then
Set_Etype (L, Common_Type);
Set_Is_Overloaded (L, False);
else
Error_Msg_N ("cannot resolve membership operation", N);
end if;
end Analyze_Set_Membership;
-- Start of processing for Analyze_Membership_Op
begin
Analyze_Expression (L);
if No (R)
and then Extensions_Allowed
then
Analyze_Set_Membership;
return;
end if;
if Nkind (R) = N_Range
or else (Nkind (R) = N_Attribute_Reference
and then Attribute_Name (R) = Name_Range)
@ -2090,6 +2184,7 @@ package body Sem_Ch4 is
Set_Etype (N, Standard_Boolean);
if Comes_From_Source (N)
and then Present (Right_Opnd (N))
and then Is_CPP_Class (Etype (Etype (Right_Opnd (N))))
then
Error_Msg_N ("membership test not applicable to cpp-class types", N);

40
gcc/ada/sem_res.adb
View File

@ -6734,16 +6734,52 @@ package body Sem_Res is
procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id) is
pragma Warnings (Off, Typ);
L : constant Node_Id := Left_Opnd (N);
L : constant Node_Id := Left_Opnd (N);
R : constant Node_Id := Right_Opnd (N);
T : Entity_Id;
procedure Resolve_Set_Membership;
-- Analysis has determined a unique type for the left operand.
-- Use it to resolve the disjuncts.
----------------------------
-- Resolve_Set_Membership --
----------------------------
procedure Resolve_Set_Membership is
Alt : Node_Id;
begin
Resolve (L, Etype (L));
Alt := First (Alternatives (N));
while Present (Alt) loop
-- Alternative is an expression, a range
-- or a subtype mark.
if not Is_Entity_Name (Alt)
or else not Is_Type (Entity (Alt))
then
Resolve (Alt, Etype (L));
end if;
Next (Alt);
end loop;
end Resolve_Set_Membership;
-- start of processing for Resolve_Membership_Op
begin
if L = Error or else R = Error then
return;
end if;
if not Is_Overloaded (R)
if Present (Alternatives (N)) then
Resolve_Set_Membership;
return;
elsif not Is_Overloaded (R)
and then
(Etype (R) = Universal_Integer or else
Etype (R) = Universal_Real)