Mercurial > hg > CbC > CbC_gcc
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 -- ---------------------------