[Ada] Add another ad-hoc case to the Has_Private_View mechanism
authorEric Botcazou <ebotcazou@adacore.com>
Sun, 19 Jan 2020 17:25:37 +0000 (18:25 +0100)
committerPierre-Marie de Rodat <derodat@adacore.com>
Thu, 4 Jun 2020 09:10:57 +0000 (05:10 -0400)
2020-06-04  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

* sem_ch12.adb (Copy_Generic_Node): Add special handling for a
conversion between access types.

gcc/ada/sem_ch12.adb

index 23ee796..49a8720 100644 (file)
@@ -7900,6 +7900,37 @@ package body Sem_Ch12 is
                                  Sloc (N)));
                            end if;
                         end;
+
+                     --  Here is a similar case, for the Designated_Type of an
+                     --  access type that is present as target type in a type
+                     --  conversion from another access type. In this case, if
+                     --  the base types of the designated types are different
+                     --  and the conversion was accepted during the semantic
+                     --  analysis of the generic, this means that the target
+                     --  type cannot have been private (see Valid_Conversion).
+
+                     elsif Nkind (Assoc) = N_Identifier
+                       and then Nkind (Parent (Assoc)) = N_Type_Conversion
+                       and then Subtype_Mark (Parent (Assoc)) = Assoc
+                       and then Is_Access_Type (Etype (Assoc))
+                       and then Present (Etype (Expression (Parent (Assoc))))
+                       and then
+                         Is_Access_Type (Etype (Expression (Parent (Assoc))))
+                     then
+                        declare
+                           Targ_Desig : constant Entity_Id :=
+                             Designated_Type (Etype (Assoc));
+                           Expr_Desig : constant Entity_Id :=
+                             Designated_Type
+                               (Etype (Expression (Parent (Assoc))));
+                        begin
+                           if Base_Type (Targ_Desig) /= Base_Type (Expr_Desig)
+                             and then Is_Private_Type (Targ_Desig)
+                           then
+                              Check_Private_View
+                                (New_Occurrence_Of (Targ_Desig, Sloc (N)));
+                           end if;
+                        end;
                      end if;
 
                   --  The node is a reference to a global type and acts as the