diff gcc/ada/exp_dist.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
line wrap: on
line diff
--- a/gcc/ada/exp_dist.adb	Thu Oct 25 07:37:49 2018 +0900
+++ b/gcc/ada/exp_dist.adb	Thu Feb 13 11:34:05 2020 +0900
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2019, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -963,10 +963,8 @@
             when N_Package_Declaration =>
 
                --  Case of a nested package or package instantiation coming
-               --  from source. Note that the anonymous wrapper package for
-               --  subprogram instances is not flagged Is_Generic_Instance at
-               --  this point, so there is a distinct circuit to handle them
-               --  (see case N_Subprogram_Instantiation below).
+               --  from source, including the wrapper package for an instance
+               --  of a generic subprogram.
 
                declare
                   Pkg_Ent : constant Entity_Id :=
@@ -982,16 +980,6 @@
                   end if;
                end;
 
-            when N_Subprogram_Instantiation =>
-
-               --  The subprogram declaration for an instance of a generic
-               --  subprogram is wrapped in a package that does not come from
-               --  source, so we need to explicitly traverse it here.
-
-               if Comes_From_Source (Decl) then
-                  Visit_Nested_Pkg (Instance_Spec (Decl));
-               end if;
-
             when others =>
                null;
          end case;
@@ -8213,6 +8201,12 @@
          --  type from Interfaces, or the smallest floating point type from
          --  Standard whose range encompasses that of Typ.
 
+         function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean;
+         --  Return true if Typ is a subtype representing a generic formal type
+         --  as a subtype of the actual type in an instance. This is needed to
+         --  recognize these subtypes because the Is_Generic_Actual_Type flag
+         --  can only be relied upon within the instance.
+
          function Make_Helper_Function_Name
            (Loc : Source_Ptr;
             Typ : Entity_Id;
@@ -8465,7 +8459,7 @@
             --  For the subtype representing a generic actual type, go to the
             --  actual type.
 
-            if Is_Generic_Actual_Type (U_Type) then
+            if Is_Generic_Actual_Subtype (U_Type) then
                U_Type := Underlying_Type (Base_Type (U_Type));
             end if;
 
@@ -9274,7 +9268,7 @@
             --  For the subtype representing a generic actual type, go to the
             --  actual type.
 
-            if Is_Generic_Actual_Type (U_Type) then
+            if Is_Generic_Actual_Subtype (U_Type) then
                U_Type := Underlying_Type (Base_Type (U_Type));
             end if;
 
@@ -10128,7 +10122,7 @@
             --  For the subtype representing a generic actual type, go to the
             --  actual type.
 
-            if Is_Generic_Actual_Type (U_Type) then
+            if Is_Generic_Actual_Subtype (U_Type) then
                U_Type := Underlying_Type (Base_Type (U_Type));
             end if;
 
@@ -10913,6 +10907,30 @@
 
          end Find_Numeric_Representation;
 
+         ---------------------------------
+         --  Is_Generic_Actual_Subtype  --
+         ---------------------------------
+
+         function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean is
+         begin
+            if Is_Itype (Typ)
+              and then Present (Associated_Node_For_Itype (Typ))
+            then
+               declare
+                  N : constant Node_Id := Associated_Node_For_Itype (Typ);
+               begin
+                  if Nkind (N) = N_Subtype_Declaration
+                    and then Nkind (Parent (N)) = N_Package_Specification
+                    and then Is_Generic_Instance (Scope_Of_Spec (Parent (N)))
+                  then
+                     return True;
+                  end if;
+               end;
+            end if;
+
+            return False;
+         end Is_Generic_Actual_Subtype;
+
          ---------------------------
          -- Append_Array_Traversal --
          ---------------------------