diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2011-12-20 13:53:42 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-12-20 14:53:42 +0100 |
| commit | 76d49f494a31b307249417d0f78ed93303bbd96c (patch) | |
| tree | 8d732d54ed8e03a3134a8fa928ce114cee530c59 /gcc/ada | |
| parent | a68d415b1d94bf3cbafd889642bedc71c0e6ac5a (diff) | |
| download | gcc-76d49f494a31b307249417d0f78ed93303bbd96c.zip gcc-76d49f494a31b307249417d0f78ed93303bbd96c.tar.gz gcc-76d49f494a31b307249417d0f78ed93303bbd96c.tar.bz2 | |
sem_ch13.adb (Check_Indexing_Functions): The return type of an indexing function can be the default element type...
2011-12-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Check_Indexing_Functions): The return type of an
indexing function can be the default element type, and does not
need to be a reference type.
* sem_ch4.adb (Try_Container_Indexing): Ditto.
From-SVN: r182536
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 46 |
3 files changed, 53 insertions, 20 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c6afe58..26d8fcb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2011-12-20 Ed Schonberg <schonberg@adacore.com> + + * sem_ch13.adb (Check_Indexing_Functions): The return type of an + indexing function can be the default element type, and does not + need to be a reference type. + * sem_ch4.adb (Try_Container_Indexing): Ditto. + 2011-12-20 Robert Dewar <dewar@adacore.com> * a-cdlili.ads, sem_cat.adb, sem_ch10.adb: Minor reformatting. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 22b2bec..8c7452f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1867,6 +1867,11 @@ package body Sem_Ch13 is ------------------------ procedure Check_One_Function (Subp : Entity_Id) is + Default_Element : constant Node_Id := + Find_Aspect + (Etype (First_Formal (Subp)), + Aspect_Iterator_Element); + begin if not Check_Primitive_Function (Subp) then Error_Msg_NE @@ -1874,6 +1879,21 @@ package body Sem_Ch13 is Subp, Ent); end if; + -- An indexing function must return either the default element of + -- the container, or a reference type. + + if Present (Default_Element) then + Analyze (Default_Element); + if Is_Entity_Name (Default_Element) + and then + Covers (Entity (Default_Element), Etype (Subp)) + then + return; + end if; + end if; + + -- Otherwise the return type must be a reference type. + if not Has_Implicit_Dereference (Etype (Subp)) then Error_Msg_N ("function for indexing must return a reference type", Subp); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 1c5654e..4163231 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6491,18 +6491,22 @@ package body Sem_Ch4 is Rewrite (N, Indexing); Analyze (N); - -- The return type of the indexing function is a reference type, so - -- add the dereference as a possible interpretation. - - Disc := First_Discriminant (Etype (Func)); - while Present (Disc) loop - if Has_Implicit_Dereference (Disc) then - Add_One_Interp (N, Disc, Designated_Type (Etype (Disc))); - exit; - end if; + -- If the return type of the indexing function is a reference type, + -- add the dereference as a possible interpretation. Note that the + -- indexing aspect may be a function that returns the element type + -- with no intervening implicit dereference. + + if Has_Discriminants (Etype (Func)) then + Disc := First_Discriminant (Etype (Func)); + while Present (Disc) loop + if Has_Implicit_Dereference (Disc) then + Add_One_Interp (N, Disc, Designated_Type (Etype (Disc))); + exit; + end if; - Next_Discriminant (Disc); - end loop; + Next_Discriminant (Disc); + end loop; + end if; else Indexing := Make_Function_Call (Loc, @@ -6528,16 +6532,18 @@ package body Sem_Ch4 is -- Add implicit dereference interpretation - Disc := First_Discriminant (Etype (It.Nam)); - while Present (Disc) loop - if Has_Implicit_Dereference (Disc) then - Add_One_Interp - (N, Disc, Designated_Type (Etype (Disc))); - exit; - end if; + if Has_Discriminants (Etype (It.Nam)) then + Disc := First_Discriminant (Etype (It.Nam)); + while Present (Disc) loop + if Has_Implicit_Dereference (Disc) then + Add_One_Interp + (N, Disc, Designated_Type (Etype (Disc))); + exit; + end if; - Next_Discriminant (Disc); - end loop; + Next_Discriminant (Disc); + end loop; + end if; exit; end if; |