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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148932 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b5703fb..f9f110b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+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,

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index bdc3c53..897b9e1 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.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))));

diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index aa050d4..d728b05 100644 (file)
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -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;
 

diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 0f5cf32..9b345b4 100644 (file)
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -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