diff options
| author | Thomas Quinot <quinot@adacore.com> | 2005-03-15 17:01:51 +0100 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2005-03-15 17:01:51 +0100 |
| commit | 6e40e4814884d3e9243ce4b58ad7d92e2606cfe3 (patch) | |
| tree | b15a4e5da3fd768c2a54e3cad4fe67dbd4e28dcc /gcc/ada/exp_tss.adb | |
| parent | 4ee27193ec6d9e19751d24c8302f051ac979cad6 (diff) | |
| download | gcc-6e40e4814884d3e9243ce4b58ad7d92e2606cfe3.zip gcc-6e40e4814884d3e9243ce4b58ad7d92e2606cfe3.tar.gz gcc-6e40e4814884d3e9243ce4b58ad7d92e2606cfe3.tar.bz2 | |
exp_tss.ads, [...] (Find_Inherited_TSS): New subprogram...
2005-03-08 Thomas Quinot <quinot@adacore.com>
* exp_tss.ads, exp_tss.adb (Find_Inherited_TSS): New subprogram, moved
here from exp_attr so it can be shared between exp_attr and exp_dist.
(TSS_Names): Renamed from OK_TSS_Names. This array contains the list of
all TSS names, not a subset thereof, and the previous name introduced
an unnecessarily confusion that a distinction might exist between
"OK" TSS names and some "not OK" TSS names.
From-SVN: r96497
Diffstat (limited to 'gcc/ada/exp_tss.adb')
| -rw-r--r-- | gcc/ada/exp_tss.adb | 41 |
1 files changed, 38 insertions, 3 deletions
diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index 5068b24..50d9605 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -97,6 +97,41 @@ package body Exp_Tss is Prepend_Elmt (TSS, TSS_Elist (FN)); end Copy_TSS; + ------------------------ + -- Find_Inherited_TSS -- + ------------------------ + + function Find_Inherited_TSS + (Typ : Entity_Id; + Nam : TSS_Name_Type) return Entity_Id + is + Btyp : Entity_Id := Typ; + Proc : Entity_Id; + + begin + loop + Btyp := Base_Type (Btyp); + Proc := TSS (Btyp, Nam); + + exit when Present (Proc) + or else not Is_Derived_Type (Btyp); + + -- If Typ is a derived type, it may inherit attributes from some + -- ancestor. + + Btyp := Etype (Btyp); + end loop; + + if No (Proc) then + + -- If nothing else, use the TSS of the root type + + Proc := TSS (Base_Type (Underlying_Type (Typ)), Nam); + end if; + + return Proc; + end Find_Inherited_TSS; + ----------------------- -- Get_TSS_Name_Type -- ----------------------- @@ -112,8 +147,8 @@ package body Exp_Tss is if C1 in 'A' .. 'Z' and then C2 in 'A' .. 'Z' then Nm := (C1, C2); - for J in OK_TSS_Names'Range loop - if Nm = OK_TSS_Names (J) then + for J in TSS_Names'Range loop + if Nm = TSS_Names (J) then return Nm; end if; end loop; |