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>
* gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb,
......
......@@ -907,9 +907,19 @@ package body Exp_Attr is
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),
Convert_To (Btyp_DDT,
New_Copy_Tree (Prefix (N))));
......
......@@ -743,34 +743,33 @@ package body Prj.Env is
--------------------
procedure Create_Mapping (In_Tree : Project_Tree_Ref) is
Unit : Unit_Index;
Data : Source_Id;
Iter : Source_Iterator;
begin
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);
while Unit /= No_Unit_Index loop
for S in Spec_Or_Body loop
Data := Unit.File_Names (S);
-- If there is a spec put it in the mapping
if Data /= null then
if Data.Locally_Removed then
Fmap.Add_Forbidden_File_Name (Data.File);
else
Fmap.Add_To_File_Map
(Unit_Name => Unit_Name_Type (Unit.Name),
File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name));
end if;
if Data.Unit /= No_Unit_Index then
if Data.Locally_Removed then
Fmap.Add_Forbidden_File_Name (Data.File);
else
-- Put back the file in case it was excluded in an extended
-- project
Fmap.Remove_Forbidden_File_Name (Data.File);
Fmap.Add_To_File_Map
(Unit_Name => Unit_Name_Type (Data.Unit.Name),
File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name));
end if;
end loop;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
Next (Iter);
end loop;
end Create_Mapping;
......@@ -853,7 +852,13 @@ package body Prj.Env is
-- 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;
end Put_Data;
......
......@@ -7324,13 +7324,16 @@ package body Prj.Nmsc is
-------------------
procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
Unit : constant Unit_Index := Source.Unit;
begin
-- Remove reference in the unit, if necessary
if Source.Unit /= null
if Unit /= null
and then Source.Kind in Spec_Or_Body
and then Unit.File_Names (Source.Kind) /= null
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;
Source.Kind := Kind;
......@@ -7821,10 +7824,6 @@ package body Prj.Nmsc is
then
OK := True;
Source.Locally_Removed := True;
Name_Len := 1;
Name_Buffer (1 .. Name_Len) := "/";
Source.Path.Name := Name_Find;
Source.In_Interfaces := False;
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