diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-19 12:30:18 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-19 12:30:18 +0200 |
| commit | 4adf3c50f1398e6efc4ab6f5e061e2ecea145855 (patch) | |
| tree | 68fe3d1d6a7c9c7ad653e6ddc50449d6d8b5092f /gcc/ada/sem_util.adb | |
| parent | e2f289f3c75abb5716f15cd7d3e0d78b0439f952 (diff) | |
| download | gcc-4adf3c50f1398e6efc4ab6f5e061e2ecea145855.zip gcc-4adf3c50f1398e6efc4ab6f5e061e2ecea145855.tar.gz gcc-4adf3c50f1398e6efc4ab6f5e061e2ecea145855.tar.bz2 | |
[multiple changes]
2010-10-19 Javier Miranda <miranda@adacore.com>
* par-ch4.adb: Update documentation of Ada 2012 syntax rules for
membership test.
2010-10-19 Bob Duff <duff@adacore.com>
* sem_attr.adb (Eval_Attribute): Implement Max_Alignment_For_Allocation
attribute.
* exp_attr.adb (Expand_N_Attribute_Reference): Add
Attribute_Max_Alignment_For_Allocation to the case statement.
* snames.ads-tmpl (Name_Max_Alignment_For_Allocation,
Attribute_Max_Alignment_For_Allocation): New attribute name.
2010-10-19 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (OK_For_Limited_Init_In_05): a call to an access to
parameterless function appears syntactically as an explicit dereference.
2010-10-19 Thomas Quinot <quinot@adacore.com>
* sem_ch8.adb, sem_ch12.adb, opt.ads, sem_ch6.adb, sem_res.adb,
i-cexten.ads, exp_disp.adb, exp_ch4.adb, exp_ch9.adb: Minor reformatting
2010-10-19 Thomas Quinot <quinot@adacore.com>
* sem_util.adb (Collect_Primitive_Operations): A function with an
anonymous access result designating T is a primitive operation of T.
From-SVN: r165692
Diffstat (limited to 'gcc/ada/sem_util.adb')
| -rw-r--r-- | gcc/ada/sem_util.adb | 33 |
1 files changed, 24 insertions, 9 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d278e1d..53726d4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1693,6 +1693,27 @@ package body Sem_Util is Formal_Derived : Boolean := False; Id : Entity_Id; + function Match (E : Entity_Id) return Boolean; + -- True if E's base type is B_Type, or E is of an anonymous access type + -- and the base type of its designated type is B_Type. + + ----------- + -- Match -- + ----------- + + function Match (E : Entity_Id) return Boolean is + Etyp : Entity_Id := Etype (E); + + begin + if Ekind (Etyp) = E_Anonymous_Access_Type then + Etyp := Designated_Type (Etyp); + end if; + + return Base_Type (Etyp) = B_Type; + end Match; + + -- Start of processing for Collect_Primitive_Operations + begin -- For tagged types, the primitive operations are collected as they -- are declared, and held in an explicit list which is simply returned. @@ -1761,19 +1782,13 @@ package body Sem_Util is then Is_Prim := False; - if Base_Type (Etype (Id)) = B_Type then + if Match (Id) then Is_Prim := True; + else Formal := First_Formal (Id); while Present (Formal) loop - if Base_Type (Etype (Formal)) = B_Type then - Is_Prim := True; - exit; - - elsif Ekind (Etype (Formal)) = E_Anonymous_Access_Type - and then Base_Type - (Designated_Type (Etype (Formal))) = B_Type - then + if Match (Formal) then Is_Prim := True; exit; end if; |