Mercurial > hg > CbC > CbC_gcc

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- E X P_ D I S T -- 5 -- E X P_ D I S T --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
961 end if; 961 end if;
962 962
963 when N_Package_Declaration => 963 when N_Package_Declaration =>
964 964
965 -- Case of a nested package or package instantiation coming 965 -- Case of a nested package or package instantiation coming
966 -- from source. Note that the anonymous wrapper package for 966 -- from source, including the wrapper package for an instance
967 -- subprogram instances is not flagged Is_Generic_Instance at 967 -- of a generic subprogram.
968 -- this point, so there is a distinct circuit to handle them
969 -- (see case N_Subprogram_Instantiation below).
970 968
971 declare 969 declare
972 Pkg_Ent : constant Entity_Id := 970 Pkg_Ent : constant Entity_Id :=
973 Defining_Unit_Name (Specification (Decl)); 971 Defining_Unit_Name (Specification (Decl));
974 begin 972 begin
979 (Get_Unit_Instantiation_Node (Pkg_Ent))) 977 (Get_Unit_Instantiation_Node (Pkg_Ent)))
980 then 978 then
981 Visit_Nested_Pkg (Decl); 979 Visit_Nested_Pkg (Decl);
982 end if; 980 end if;
983 end; 981 end;
984
985 when N_Subprogram_Instantiation =>
986
987 -- The subprogram declaration for an instance of a generic
988 -- subprogram is wrapped in a package that does not come from
989 -- source, so we need to explicitly traverse it here.
990
991 if Comes_From_Source (Decl) then
992 Visit_Nested_Pkg (Instance_Spec (Decl));
993 end if;
994 982
995 when others => 983 when others =>
996 null; 984 null;
997 end case; 985 end case;
998 986
8211 (Typ : Entity_Id) return Entity_Id; 8199 (Typ : Entity_Id) return Entity_Id;
8212 -- Given a numeric type Typ, return the smallest integer or modular 8200 -- Given a numeric type Typ, return the smallest integer or modular
8213 -- type from Interfaces, or the smallest floating point type from 8201 -- type from Interfaces, or the smallest floating point type from
8214 -- Standard whose range encompasses that of Typ. 8202 -- Standard whose range encompasses that of Typ.
8215 8203
8204 function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean;
8205 -- Return true if Typ is a subtype representing a generic formal type
8206 -- as a subtype of the actual type in an instance. This is needed to
8207 -- recognize these subtypes because the Is_Generic_Actual_Type flag
8208 -- can only be relied upon within the instance.
8209
8216 function Make_Helper_Function_Name 8210 function Make_Helper_Function_Name
8217 (Loc : Source_Ptr; 8211 (Loc : Source_Ptr;
8218 Typ : Entity_Id; 8212 Typ : Entity_Id;
8219 Nam : Name_Id) return Entity_Id; 8213 Nam : Name_Id) return Entity_Id;
8220 -- Return the name to be assigned for helper subprogram Nam of Typ 8214 -- Return the name to be assigned for helper subprogram Nam of Typ
8463 Fnam := Find_Inherited_TSS (U_Type, TSS_From_Any); 8457 Fnam := Find_Inherited_TSS (U_Type, TSS_From_Any);
8464 8458
8465 -- For the subtype representing a generic actual type, go to the 8459 -- For the subtype representing a generic actual type, go to the
8466 -- actual type. 8460 -- actual type.
8467 8461
8468 if Is_Generic_Actual_Type (U_Type) then 8462 if Is_Generic_Actual_Subtype (U_Type) then
8469 U_Type := Underlying_Type (Base_Type (U_Type)); 8463 U_Type := Underlying_Type (Base_Type (U_Type));
8470 end if; 8464 end if;
8471 8465
8472 -- For a standard subtype, go to the base type 8466 -- For a standard subtype, go to the base type
8473 8467
9272 Fnam := Find_Inherited_TSS (U_Type, TSS_To_Any); 9266 Fnam := Find_Inherited_TSS (U_Type, TSS_To_Any);
9273 9267
9274 -- For the subtype representing a generic actual type, go to the 9268 -- For the subtype representing a generic actual type, go to the
9275 -- actual type. 9269 -- actual type.
9276 9270
9277 if Is_Generic_Actual_Type (U_Type) then 9271 if Is_Generic_Actual_Subtype (U_Type) then
9278 U_Type := Underlying_Type (Base_Type (U_Type)); 9272 U_Type := Underlying_Type (Base_Type (U_Type));
9279 end if; 9273 end if;
9280 9274
9281 -- For a standard subtype, go to the base type 9275 -- For a standard subtype, go to the base type
9282 9276
10126 end if; 10120 end if;
10127 10121
10128 -- For the subtype representing a generic actual type, go to the 10122 -- For the subtype representing a generic actual type, go to the
10129 -- actual type. 10123 -- actual type.
10130 10124
10131 if Is_Generic_Actual_Type (U_Type) then 10125 if Is_Generic_Actual_Subtype (U_Type) then
10132 U_Type := Underlying_Type (Base_Type (U_Type)); 10126 U_Type := Underlying_Type (Base_Type (U_Type));
10133 end if; 10127 end if;
10134 10128
10135 -- For a standard subtype, go to the base type 10129 -- For a standard subtype, go to the base type
10136 10130
10911 -- TBD: fixed point types??? 10905 -- TBD: fixed point types???
10912 -- TBverified numeric types with a biased representation??? 10906 -- TBverified numeric types with a biased representation???
10913 10907
10914 end Find_Numeric_Representation; 10908 end Find_Numeric_Representation;
10915 10909
10910 ---------------------------------
10911 -- Is_Generic_Actual_Subtype --
10912 ---------------------------------
10913
10914 function Is_Generic_Actual_Subtype (Typ : Entity_Id) return Boolean is
10915 begin
10916 if Is_Itype (Typ)
10917 and then Present (Associated_Node_For_Itype (Typ))
10918 then
10919 declare
10920 N : constant Node_Id := Associated_Node_For_Itype (Typ);
10921 begin
10922 if Nkind (N) = N_Subtype_Declaration
10923 and then Nkind (Parent (N)) = N_Package_Specification
10924 and then Is_Generic_Instance (Scope_Of_Spec (Parent (N)))
10925 then
10926 return True;
10927 end if;
10928 end;
10929 end if;
10930
10931 return False;
10932 end Is_Generic_Actual_Subtype;
10933
10916 --------------------------- 10934 ---------------------------
10917 -- Append_Array_Traversal -- 10935 -- Append_Array_Traversal --
10918 --------------------------- 10936 ---------------------------
10919 10937
10920 procedure Append_Array_Traversal 10938 procedure Append_Array_Traversal