[multiple changes]

2011-10-24  Vasiliy Fofanov  <fofanov@adacore.com>

	* gnat_ugn.texi: Document explicit use of XDECGNAT library.

2011-10-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Assignment): Add local constant N_Loc and
	update its uses.
	(Build_Discriminant_Assignments): Add local variable D_Loc and update
	its uses.
	(Build_Init_Statements): Add local variables Comp_Loc, Decl_Loc and
	Var_Loc and update their uses.
	(Build_Record_Init_Proc): Code reformatting.
	(Increment_Counter): Add formal parameter Loc.
	(Make_Counter): Add formal parameter Loc.

2011-10-24  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_disp.adb (Covers_Some_Interface): Fix typo.

2011-10-24  Matthew Heaney  <heaney@adacore.com>

	* a-cuprqu.adb, a-cbprqu.adb (Dequeue_Only_High_Priority):
	Predicate had wrong sense.

2011-10-24  Yannick Moy  <moy@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications/Aspect_Test_Case):
	Translate arguments in positional notation into pragma argument
	association arguments for the generated pragma.

2011-10-24  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch5.adb: Fix minor typo.

2011-10-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Is_Visible_Component): Refine predicate for
	the case of a component reference in an instance body, when the
	enclosing type is private.

From-SVN: r180369

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 297470c39fdc77b1c9b0f237af89ee06b7572ff7..6eec150a7e2b6f27c4b89315aff8bd814b16e69c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,44 @@
+2011-10-24  Vasiliy Fofanov  <fofanov@adacore.com>
+
+       * gnat_ugn.texi: Document explicit use of XDECGNAT library.
+
+2011-10-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_ch3.adb (Build_Assignment): Add local constant N_Loc and
+       update its uses.
+       (Build_Discriminant_Assignments): Add local variable D_Loc and update
+       its uses.
+       (Build_Init_Statements): Add local variables Comp_Loc, Decl_Loc and
+       Var_Loc and update their uses.
+       (Build_Record_Init_Proc): Code reformatting.
+       (Increment_Counter): Add formal parameter Loc.
+       (Make_Counter): Add formal parameter Loc.
+
+2011-10-24  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * sem_disp.adb (Covers_Some_Interface): Fix typo.
+
+2011-10-24  Matthew Heaney  <heaney@adacore.com>
+
+       * a-cuprqu.adb, a-cbprqu.adb (Dequeue_Only_High_Priority):
+       Predicate had wrong sense.
+
+2011-10-24  Yannick Moy  <moy@adacore.com>
+
+       * sem_ch13.adb (Analyze_Aspect_Specifications/Aspect_Test_Case):
+       Translate arguments in positional notation into pragma argument
+       association arguments for the generated pragma.
+
+2011-10-24  Arnaud Charlet  <charlet@adacore.com>
+
+       * exp_ch5.adb: Fix minor typo.
+
+2011-10-24  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Is_Visible_Component): Refine predicate for
+       the case of a component reference in an instance body, when the
+       enclosing type is private.
+
 2011-10-24  Sergey Rybin  <rybin@adacore.com frybin>
 
        * gnat_ugn.texi: For gnatelim, move the note about using the GNAT

diff --git a/gcc/ada/a-cbprqu.adb b/gcc/ada/a-cbprqu.adb
index cb96167be411a63a8457063a4abce569b61df73c..ce2fd69fae7c39a62ce2fec239e26fa4c4333e52 100644 (file)
--- a/gcc/ada/a-cbprqu.adb
+++ b/gcc/ada/a-cbprqu.adb
@@ -51,8 +51,31 @@ package body Ada.Containers.Bounded_Priority_Queues is
          Success  : out Boolean)
       is
       begin
+         --  This operation dequeues a high priority item if it exists in the
+         --  queue. By "high priority" we mean an item whose priority is equal
+         --  or greater than the value At_Least. The generic formal operation
+         --  Before has the meaning "has higher priority than". To dequeue an
+         --  item (meaning that we return True as our Success value), we need
+         --  as our predicate the equivalent of "has equal or higher priority
+         --  than", but we cannot say that directly, so we require some logical
+         --  gymnastics to make it so.
+
+         --  If E is the element at the head of the queue, and symbol ">"
+         --  refers to the "is higher priority than" function Before, then we
+         --  derive our predicate as follows:
+
+         --    original: P(E) >= At_Least
+         --    same as:  not (P(E) < At_Least)
+         --    same as:  not (At_Least > P(E))
+         --    same as:  not Before (At_Least, P(E))
+
+         --  But that predicate needs to be true in order to successfully
+         --  dequeue an item. If it's false, it means no item is dequeued, and
+         --  we return False as the Success value.
+
          if List.Length = 0
-           or else not Before (At_Least, Get_Priority (List.First_Element))
+           or else Before (At_Least,
+                           Get_Priority (List.Container.First_Element))
          then
             Success := False;
             return;

diff --git a/gcc/ada/a-cuprqu.adb b/gcc/ada/a-cuprqu.adb
index 385aa5ce7d2d37ce418175e552e205db0328c14c..4f6966dc13619e7d1616f7ff9b182cc12872894a 100644 (file)
--- a/gcc/ada/a-cuprqu.adb
+++ b/gcc/ada/a-cuprqu.adb
@@ -72,8 +72,29 @@ package body Ada.Containers.Unbounded_Priority_Queues is
          Success  : out Boolean)
       is
       begin
+         --  This operation dequeues a high priority item if it exists in the
+         --  queue. By "high priority" we mean an item whose priority is equal
+         --  or greater than the value At_Least. The generic formal operation
+         --  Before has the meaning "has higher priority than". To dequeue an
+         --  item (meaning that we return True as our Success value), we need
+         --  as our predicate the equivalent of "has equal or higher priority
+         --  than", but we cannot say that directly, so we require some logical
+         --  gymnastics to make it so.
+
+         --  If E is the element at the head of the queue, and symbol ">"
+         --  refers to the "is higher priority than" function Before, then we
+         --  derive our predicate as follows:
+         --    original: P(E) >= At_Least
+         --    same as:  not (P(E) < At_Least)
+         --    same as:  not (At_Least > P(E))
+         --    same as:  not Before (At_Least, P(E))
+
+         --  But that predicate needs to be true in order to successfully
+         --  dequeue an item. If it's false, it means no item is dequeued, and
+         --  we return False as the Success value.
+
          if List.Length = 0
-           or else not Before (At_Least, Get_Priority (List.First.Element))
+           or else Before (At_Least, Get_Priority (List.First.Element))
          then
             Success := False;
             return;

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 5f413e31bd338f1feb24645ba7b38b5ac3ceb5a1..1554723249176f0b0af3fd4c8c1ded2d802fe12b 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1538,13 +1538,13 @@ package body Exp_Ch3 is
    ----------------------------
 
    procedure Build_Record_Init_Proc (N : Node_Id; Rec_Ent : Entity_Id) is
-      Decls       : constant List_Id  := New_List;
-      Discr_Map   : constant Elist_Id := New_Elmt_List;
-      Counter     : Int := 0;
-      Loc         : Source_Ptr := Sloc (N);
-      Proc_Id     : Entity_Id;
-      Rec_Type    : Entity_Id;
-      Set_Tag     : Entity_Id := Empty;
+      Decls     : constant List_Id  := New_List;
+      Discr_Map : constant Elist_Id := New_Elmt_List;
+      Loc       : constant Source_Ptr := Sloc (Rec_Ent);
+      Counter   : Int := 0;
+      Proc_Id   : Entity_Id;
+      Rec_Type  : Entity_Id;
+      Set_Tag   : Entity_Id := Empty;
 
       function Build_Assignment (Id : Entity_Id; N : Node_Id) return List_Id;
       --  Build an assignment statement which assigns the default expression
@@ -1621,18 +1621,18 @@ package body Exp_Ch3 is
       ----------------------
 
       function Build_Assignment (Id : Entity_Id; N : Node_Id) return List_Id is
-         Typ  : constant Entity_Id := Underlying_Type (Etype (Id));
-         Exp  : Node_Id := N;
-         Kind : Node_Kind := Nkind (N);
-         Lhs  : Node_Id;
-         Res  : List_Id;
+         N_Loc : constant Source_Ptr := Sloc (N);
+         Typ   : constant Entity_Id := Underlying_Type (Etype (Id));
+         Exp   : Node_Id := N;
+         Kind  : Node_Kind := Nkind (N);
+         Lhs   : Node_Id;
+         Res   : List_Id;
 
       begin
-         Loc := Sloc (N);
          Lhs :=
-           Make_Selected_Component (Loc,
+           Make_Selected_Component (N_Loc,
              Prefix        => Make_Identifier (Loc, Name_uInit),
-             Selector_Name => New_Occurrence_Of (Id, Loc));
+             Selector_Name => New_Occurrence_Of (Id, N_Loc));
          Set_Assignment_OK (Lhs);
 
          --  Case of an access attribute applied to the current instance.
@@ -1653,9 +1653,9 @@ package body Exp_Ch3 is
            and then Entity (Prefix (N)) = Rec_Type
          then
             Exp :=
-              Make_Attribute_Reference (Loc,
+              Make_Attribute_Reference (N_Loc,
                 Prefix         =>
-                  Make_Identifier (Loc, Name_uInit),
+                  Make_Identifier (N_Loc, Name_uInit),
                 Attribute_Name => Name_Unrestricted_Access);
          end if;
 
@@ -1681,13 +1681,13 @@ package body Exp_Ch3 is
            and then Tagged_Type_Expansion
          then
             Append_To (Res,
-              Make_Assignment_Statement (Loc,
+              Make_Assignment_Statement (N_Loc,
                 Name       =>
-                  Make_Selected_Component (Loc,
+                  Make_Selected_Component (N_Loc,
                     Prefix        =>
                       New_Copy_Tree (Lhs, New_Scope => Proc_Id),
                     Selector_Name =>
-                      New_Reference_To (First_Tag_Component (Typ), Loc)),
+                      New_Reference_To (First_Tag_Component (Typ), N_Loc)),
 
                 Expression =>
                   Unchecked_Convert_To (RTE (RE_Tag),
@@ -1695,7 +1695,7 @@ package body Exp_Ch3 is
                       (Node
                         (First_Elmt
                           (Access_Disp_Table (Underlying_Type (Typ)))),
-                       Loc))));
+                       N_Loc))));
          end if;
 
          --  Adjust the component if controlled except if it is an aggregate
@@ -1729,6 +1729,7 @@ package body Exp_Ch3 is
       procedure Build_Discriminant_Assignments (Statement_List : List_Id) is
          Is_Tagged : constant Boolean := Is_Tagged_Type (Rec_Type);
          D         : Entity_Id;
+         D_Loc     : Source_Ptr;
 
       begin
          if Has_Discriminants (Rec_Type)
@@ -1748,10 +1749,10 @@ package body Exp_Ch3 is
                   null;
 
                else
-                  Loc := Sloc (D);
+                  D_Loc := Sloc (D);
                   Append_List_To (Statement_List,
                     Build_Assignment (D,
-                      New_Reference_To (Discriminal (D), Loc)));
+                      New_Reference_To (Discriminal (D), D_Loc)));
                end if;
 
                Next_Discriminant (D);
@@ -2458,6 +2459,7 @@ package body Exp_Ch3 is
       function Build_Init_Statements (Comp_List : Node_Id) return List_Id is
          Checks     : constant List_Id := New_List;
          Actions    : List_Id   := No_List;
+         Comp_Loc   : Source_Ptr;
          Counter_Id : Entity_Id := Empty;
          Decl       : Node_Id;
          Has_POC    : Boolean;
@@ -2466,11 +2468,11 @@ package body Exp_Ch3 is
          Stmts      : List_Id;
          Typ        : Entity_Id;
 
-         procedure Increment_Counter;
+         procedure Increment_Counter (Loc : Source_Ptr);
          --  Generate an "increment by one" statement for the current counter
          --  and append it to the list Stmts.
 
-         procedure Make_Counter;
+         procedure Make_Counter (Loc : Source_Ptr);
          --  Create a new counter for the current component list. The routine
          --  creates a new defining Id, adds an object declaration and sets
          --  the Id generator for the next variant.
@@ -2479,7 +2481,7 @@ package body Exp_Ch3 is
          -- Increment_Counter --
          -----------------------
 
-         procedure Increment_Counter is
+         procedure Increment_Counter (Loc : Source_Ptr) is
          begin
             --  Generate:
             --    Counter := Counter + 1;
@@ -2497,7 +2499,7 @@ package body Exp_Ch3 is
          -- Make_Counter --
          ------------------
 
-         procedure Make_Counter is
+         procedure Make_Counter (Loc : Source_Ptr) is
          begin
             --  Increment the Id generator
 
@@ -2582,11 +2584,11 @@ package body Exp_Ch3 is
 
          Decl := First_Non_Pragma (Component_Items (Comp_List));
          while Present (Decl) loop
-            Loc := Sloc (Decl);
+            Comp_Loc := Sloc (Decl);
             Build_Record_Checks
               (Subtype_Indication (Component_Definition (Decl)), Checks);
 
-            Id := Defining_Identifier (Decl);
+            Id  := Defining_Identifier (Decl);
             Typ := Etype (Id);
 
             --  Leave any processing of per-object constrained component for
@@ -2606,12 +2608,13 @@ package body Exp_Ch3 is
                   if Is_CPP_Constructor_Call (Expression (Decl)) then
                      Actions :=
                        Build_Initialization_Call
-                         (Loc,
+                         (Comp_Loc,
                           Id_Ref          =>
-                            Make_Selected_Component (Loc,
+                            Make_Selected_Component (Comp_Loc,
                               Prefix        =>
-                                Make_Identifier (Loc, Name_uInit),
-                              Selector_Name => New_Occurrence_Of (Id, Loc)),
+                                Make_Identifier (Comp_Loc, Name_uInit),
+                              Selector_Name =>
+                                New_Occurrence_Of (Id, Comp_Loc)),
                           Typ             => Typ,
                           In_Init_Proc    => True,
                           Enclos_Type     => Rec_Type,
@@ -2628,10 +2631,11 @@ package body Exp_Ch3 is
                then
                   Actions :=
                     Build_Initialization_Call
-                      (Loc,
-                       Make_Selected_Component (Loc,
-                         Prefix        => Make_Identifier (Loc, Name_uInit),
-                         Selector_Name => New_Occurrence_Of (Id, Loc)),
+                      (Comp_Loc,
+                       Make_Selected_Component (Comp_Loc,
+                         Prefix        =>
+                           Make_Identifier (Comp_Loc, Name_uInit),
+                         Selector_Name => New_Occurrence_Of (Id, Comp_Loc)),
                        Typ,
                        In_Init_Proc => True,
                        Enclos_Type  => Rec_Type,
@@ -2665,10 +2669,10 @@ package body Exp_Ch3 is
                     and then Needs_Finalization (Typ)
                   then
                      if No (Counter_Id) then
-                        Make_Counter;
+                        Make_Counter (Comp_Loc);
                      end if;
 
-                     Increment_Counter;
+                     Increment_Counter (Comp_Loc);
                   end if;
                end if;
             end if;
@@ -2724,6 +2728,7 @@ package body Exp_Ch3 is
                              Corresponding_Concurrent_Type (Rec_Type);
                Task_Decl : constant Node_Id := Parent (Task_Type);
                Task_Def  : constant Node_Id := Task_Definition (Task_Decl);
+               Decl_Loc  : Source_Ptr;
                Ent       : Entity_Id;
                Vis_Decl  : Node_Id;
 
@@ -2731,7 +2736,7 @@ package body Exp_Ch3 is
                if Present (Task_Def) then
                   Vis_Decl := First (Visible_Declarations (Task_Def));
                   while Present (Vis_Decl) loop
-                     Loc := Sloc (Vis_Decl);
+                     Decl_Loc := Sloc (Vis_Decl);
 
                      if Nkind (Vis_Decl) = N_Attribute_Definition_Clause then
                         if Get_Attribute_Id (Chars (Vis_Decl)) =
@@ -2741,18 +2746,19 @@ package body Exp_Ch3 is
 
                            if Ekind (Ent) = E_Entry then
                               Append_To (Stmts,
-                                Make_Procedure_Call_Statement (Loc,
+                                Make_Procedure_Call_Statement (Decl_Loc,
                                   Name =>
                                     New_Reference_To (RTE (
-                                      RE_Bind_Interrupt_To_Entry), Loc),
+                                      RE_Bind_Interrupt_To_Entry), Decl_Loc),
                                   Parameter_Associations => New_List (
-                                    Make_Selected_Component (Loc,
+                                    Make_Selected_Component (Decl_Loc,
                                       Prefix        =>
-                                        Make_Identifier (Loc, Name_uInit),
+                                        Make_Identifier (Decl_Loc, Name_uInit),
                                       Selector_Name =>
-                                        Make_Identifier (Loc, Name_uTask_Id)),
+                                        Make_Identifier
+                                         (Decl_Loc, Name_uTask_Id)),
                                     Entry_Index_Expression
-                                      (Loc, Ent, Empty, Task_Type),
+                                      (Decl_Loc, Ent, Empty, Task_Type),
                                     Expression (Vis_Decl))));
                            end if;
                         end if;
@@ -2789,7 +2795,7 @@ package body Exp_Ch3 is
          if Has_POC then
             Decl := First_Non_Pragma (Component_Items (Comp_List));
             while Present (Decl) loop
-               Loc := Sloc (Decl);
+               Comp_Loc := Sloc (Decl);
                Id := Defining_Identifier (Decl);
                Typ := Etype (Id);
 
@@ -2798,10 +2804,11 @@ package body Exp_Ch3 is
                then
                   if Has_Non_Null_Base_Init_Proc (Typ) then
                      Append_List_To (Stmts,
-                       Build_Initialization_Call (Loc,
-                         Make_Selected_Component (Loc,
-                           Prefix        => Make_Identifier (Loc, Name_uInit),
-                           Selector_Name => New_Occurrence_Of (Id, Loc)),
+                       Build_Initialization_Call (Comp_Loc,
+                         Make_Selected_Component (Comp_Loc,
+                           Prefix        =>
+                             Make_Identifier (Comp_Loc, Name_uInit),
+                           Selector_Name => New_Occurrence_Of (Id, Comp_Loc)),
                          Typ,
                          In_Init_Proc => True,
                          Enclos_Type  => Rec_Type,
@@ -2814,10 +2821,10 @@ package body Exp_Ch3 is
 
                      if Needs_Finalization (Typ) then
                         if No (Counter_Id) then
-                           Make_Counter;
+                           Make_Counter (Comp_Loc);
                         end if;
 
-                        Increment_Counter;
+                        Increment_Counter (Comp_Loc);
                      end if;
 
                   elsif Component_Needs_Simple_Initialization (Typ) then
@@ -2836,15 +2843,16 @@ package body Exp_Ch3 is
          if Present (Variant_Part (Comp_List)) then
             declare
                Variant_Alts : constant List_Id := New_List;
+               Var_Loc      : Source_Ptr;
                Variant      : Node_Id;
 
             begin
                Variant :=
                  First_Non_Pragma (Variants (Variant_Part (Comp_List)));
                while Present (Variant) loop
-                  Loc := Sloc (Variant);
+                  Var_Loc := Sloc (Variant);
                   Append_To (Variant_Alts,
-                    Make_Case_Statement_Alternative (Loc,
+                    Make_Case_Statement_Alternative (Var_Loc,
                       Discrete_Choices =>
                         New_Copy_List (Discrete_Choices (Variant)),
                       Statements =>
@@ -2857,10 +2865,10 @@ package body Exp_Ch3 is
                --  formal parameter of the initialization procedure.
 
                Append_To (Stmts,
-                 Make_Case_Statement (Loc,
+                 Make_Case_Statement (Var_Loc,
                    Expression =>
                      New_Reference_To (Discriminal (
-                       Entity (Name (Variant_Part (Comp_List)))), Loc),
+                       Entity (Name (Variant_Part (Comp_List)))), Var_Loc),
                    Alternatives => Variant_Alts));
             end;
          end if;

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 8d487727009cfb75eaa5f951ef52f0f8b7935adf..971d0ad65d2e65dadf8f7768233d19dacf5b96c3 100644 (file)
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -3460,7 +3460,7 @@ package body Exp_Ch5 is
                    End_Label => End_Label (N)));
 
                --  The loop parameter's entity must be removed from the loop
-               --  scope's entity list, since itw will now be located in the
+               --  scope's entity list, since it will now be located in the
                --  new block scope. Any other entities already associated with
                --  the loop scope, such as the loop parameter's subtype, will
                --  remain there.

diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 377eb75bd1a39c15d4ba79769d3e2e4fc0b8f42d..abf8093a8ed6416a69131f55e5b6efcf767ce08d 100644 (file)
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -21143,6 +21143,13 @@ On OpenVMS Alpha, HP Ada provides the following strongly-typed bindings:
 GNAT provides implementations of these HP bindings in the @code{DECLIB}
 directory, on both the Alpha and I64 OpenVMS platforms.
 
+The X components of DECLIB compatibility package are located in a separate
+library, called XDECGNAT, which is not linked with by default; this library
+must be explicitly linked with any application that makes use of any X facilities,
+with a command similar to
+
+@code{GNAT MAKE USE_X /LINK /LIBRARY=XDECGNAT}
+
 The X/Motif bindings used to build @code{DECLIB} are whatever versions are
 in the
 HP Ada @file{ADA$PREDEFINED} directory with extension @file{.ADC}.

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 5790b9a85a08c6f0c4e6e1b31597f00c4b25535e..d30ba09635d826b5229ae648dd9551f6d5f45cbb 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1403,7 +1403,10 @@ package body Sem_Ch13 is
 
                   Comp_Expr := First (Expressions (Expr));
                   while Present (Comp_Expr) loop
-                     Append (Relocate_Node (Comp_Expr), Args);
+                     Append
+                       (Make_Pragma_Argument_Association (Sloc (Comp_Expr),
+                          Expression => Relocate_Node (Comp_Expr)),
+                       Args);
                      Next (Comp_Expr);
                   end loop;
 

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 98169b276d1fb0e140ea355f8743f128b9bb9ecb..98a032f425d139706a102eff9ddfb57c46966e35 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16178,13 +16178,6 @@ package body Sem_Ch3 is
       elsif not Comes_From_Source (Original_Comp) then
          return True;
 
-      --  If we are in the body of an instantiation, the component is visible
-      --  even when the parent type (possibly defined in an enclosing unit or
-      --  in a parent unit) might not.
-
-      elsif In_Instance_Body then
-         return True;
-
       --  Discriminants are always visible
 
       elsif Ekind (Original_Comp) = E_Discriminant
@@ -16192,6 +16185,35 @@ package body Sem_Ch3 is
       then
          return True;
 
+      --  If we are in the body of an instantiation, the component is visible
+      --  if the parent type is non-private, or in  an enclosing scope. The
+      --  scope stack is not present when analyzing an instance body, so we
+      --  must inspect the chain of scopes explicitly.
+
+      elsif In_Instance_Body then
+         if not Is_Private_Type (Scope (C)) then
+            return True;
+
+         else
+            declare
+               S : Entity_Id;
+
+            begin
+               S := Current_Scope;
+               while Present (S)
+                 and then S /= Standard_Standard
+               loop
+                  if S = Type_Scope then
+                     return True;
+                  end if;
+
+                  S := Scope (S);
+               end loop;
+
+               return False;
+            end;
+         end if;
+
       --  If the component has been declared in an ancestor which is currently
       --  a private type, then it is not visible. The same applies if the
       --  component's containing type is not in an open scope and the original

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 2d80676791cc9ed6c2580d8403f542df42e72e5d..c4dd8ede6baa75a4cbda1e131d7f56efca0c9faf 100644 (file)
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -160,7 +160,7 @@ package body Sem_Disp is
                   while Present (Elmt) loop
                      Iface_Prim := Node (Elmt);
 
-                     if Chars (E) = Chars (Prim)
+                     if Chars (Iface) = Chars (Prim)
                        and then Is_Interface_Conformant
                                   (Tagged_Type, Iface_Prim, Prim)
                      then