Commit bea993f9 by Arnaud Charlet

[multiple changes]

2009-06-25  Ed Schonberg  <schonberg@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, case 'Access and
	Unchecked_Access): If the context is an interface type, and the prefix
	is of the corresponding class-wide type, do not insert a conversion
	because the pointer displacement has already taken place, and we must
	retain the class-wide type in a dispatching context.

2009-06-25  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb, prj-env.adb (Override_Kind): Unset the unit field of
	the previous source file.
	(Create_Mapping): Iterate on sources rather than on units.

From-SVN: r148932
parent cabadd1c
2009-06-25 Ed Schonberg <schonberg@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference, case 'Access and
Unchecked_Access): If the context is an interface type, and the prefix
is of the corresponding class-wide type, do not insert a conversion
because the pointer displacement has already taken place, and we must
retain the class-wide type in a dispatching context.
2009-06-25 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb, prj-env.adb (Override_Kind): Unset the unit field of
the previous source file.
(Create_Mapping): Iterate on sources rather than on units.
2009-06-25 Emmanuel Briot <briot@adacore.com> 2009-06-25 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb, * gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb,
......
...@@ -907,9 +907,19 @@ package body Exp_Attr is ...@@ -907,9 +907,19 @@ package body Exp_Attr is
then then
if Nkind (Ref_Object) /= N_Explicit_Dereference then if Nkind (Ref_Object) /= N_Explicit_Dereference then
-- No implicit conversion required if types match -- No implicit conversion required if types match, or if
-- the prefix is the class_wide_type of the interface. In
-- either case passing an object of the interface type has
-- already set the pointer correctly.
if Btyp_DDT = Etype (Ref_Object)
or else (Is_Class_Wide_Type (Etype (Ref_Object))
and then
Class_Wide_Type (Btyp_DDT) = Etype (Ref_Object))
then
null;
if Btyp_DDT /= Etype (Ref_Object) then else
Rewrite (Prefix (N), Rewrite (Prefix (N),
Convert_To (Btyp_DDT, Convert_To (Btyp_DDT,
New_Copy_Tree (Prefix (N)))); New_Copy_Tree (Prefix (N))));
......
...@@ -743,34 +743,33 @@ package body Prj.Env is ...@@ -743,34 +743,33 @@ package body Prj.Env is
-------------------- --------------------
procedure Create_Mapping (In_Tree : Project_Tree_Ref) is procedure Create_Mapping (In_Tree : Project_Tree_Ref) is
Unit : Unit_Index;
Data : Source_Id; Data : Source_Id;
Iter : Source_Iterator;
begin begin
Fmap.Reset_Tables; Fmap.Reset_Tables;
-- ??? Shouldn't we iterate on source files instead ? Iter := For_Each_Source (In_Tree);
loop
Data := Element (Iter);
exit when Data = No_Source;
Unit := Units_Htable.Get_First (In_Tree.Units_HT); if Data.Unit /= No_Unit_Index then
while Unit /= No_Unit_Index loop if Data.Locally_Removed then
for S in Spec_Or_Body loop Fmap.Add_Forbidden_File_Name (Data.File);
Data := Unit.File_Names (S); else
-- Put back the file in case it was excluded in an extended
-- If there is a spec put it in the mapping -- project
Fmap.Remove_Forbidden_File_Name (Data.File);
if Data /= null then
if Data.Locally_Removed then Fmap.Add_To_File_Map
Fmap.Add_Forbidden_File_Name (Data.File); (Unit_Name => Unit_Name_Type (Data.Unit.Name),
else File_Name => Data.File,
Fmap.Add_To_File_Map Path_Name => File_Name_Type (Data.Path.Name));
(Unit_Name => Unit_Name_Type (Unit.Name),
File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name));
end if;
end if; end if;
end loop; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT); Next (Iter);
end loop; end loop;
end Create_Mapping; end Create_Mapping;
...@@ -853,7 +852,13 @@ package body Prj.Env is ...@@ -853,7 +852,13 @@ package body Prj.Env is
-- Line with the path name -- Line with the path name
Get_Name_String (Data.Path.Name); if Data.Locally_Removed then
Name_Len := 1;
Name_Buffer (1 .. Name_Len) := "/";
else
Get_Name_String (Data.Path.Name);
end if;
Put_Name_Buffer; Put_Name_Buffer;
end Put_Data; end Put_Data;
......
...@@ -7324,13 +7324,16 @@ package body Prj.Nmsc is ...@@ -7324,13 +7324,16 @@ package body Prj.Nmsc is
------------------- -------------------
procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
Unit : constant Unit_Index := Source.Unit;
begin begin
-- Remove reference in the unit, if necessary -- Remove reference in the unit, if necessary
if Source.Unit /= null if Unit /= null
and then Source.Kind in Spec_Or_Body and then Source.Kind in Spec_Or_Body
and then Unit.File_Names (Source.Kind) /= null
then then
Source.Unit.File_Names (Source.Kind) := null; Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
Unit.File_Names (Source.Kind) := null;
end if; end if;
Source.Kind := Kind; Source.Kind := Kind;
...@@ -7821,10 +7824,6 @@ package body Prj.Nmsc is ...@@ -7821,10 +7824,6 @@ package body Prj.Nmsc is
then then
OK := True; OK := True;
Source.Locally_Removed := True; Source.Locally_Removed := True;
Name_Len := 1;
Name_Buffer (1 .. Name_Len) := "/";
Source.Path.Name := Name_Find;
Source.In_Interfaces := False; Source.In_Interfaces := False;
if Current_Verbosity = High then if Current_Verbosity = High 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