From: Arnaud Charlet Date: Thu, 25 Jun 2009 08:36:28 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bea993f903e27a266ee22fbc7dd627fd1cbe1e1d;p=gcc.git [multiple changes] 2009-06-25 Ed Schonberg * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b5703fb6011..f9f110b9ef4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2009-06-25 Ed Schonberg + + * 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 + + * 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 * 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 bdc3c53502e..897b9e1a87d 100644 --- 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 aa050d40913..d728b050ed5 100644 --- 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 0f5cf320da2..9b345b4beec 100644 --- 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