diff options
| author | Gary Dismukes <dismukes@adacore.com> | 2009-07-23 14:40:31 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-07-23 14:40:31 +0200 |
| commit | 1646c9479cc2c04f2462a91ade8569ba0a81b629 (patch) | |
| tree | c38a8bdfa1eb673bc2e9f934cdaa90dd23c9a4e0 | |
| parent | d994a6e28cbd12d699d5cf522742d9cd3e84997a (diff) | |
| download | gcc-1646c9479cc2c04f2462a91ade8569ba0a81b629.zip gcc-1646c9479cc2c04f2462a91ade8569ba0a81b629.tar.gz gcc-1646c9479cc2c04f2462a91ade8569ba0a81b629.tar.bz2 | |
sem_aggr.adb (Resolve_Extension_Aggregate): Report an error when the ancestor part is a call to a limited function with an...
2009-07-23 Gary Dismukes <dismukes@adacore.com>
* sem_aggr.adb (Resolve_Extension_Aggregate): Report an error when the
ancestor part is a call to a limited function with an unconstrained
result subtype unless the aggregate has a null extension type.
* sem_ch3.adb (Is_Null_Extension): Use the base type when retrieving
the parent type declaration to avoid blowups on subtype cases.
From-SVN: r150002
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 2 |
2 files changed, 15 insertions, 2 deletions
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 05f1ade..36fd6dc 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2376,7 +2376,20 @@ package body Sem_Aggr is Check_Unset_Reference (A); Check_Non_Static_Context (A); - if Is_Class_Wide_Type (Etype (A)) + -- The aggregate is illegal if the ancestor expression is a call + -- to a function with a limited unconstrained result, unless the + -- type of the aggregate is a null extension. This restriction + -- was added in AI05-67 to simplify implementation. + + if Nkind (A) = N_Function_Call + and then Is_Limited_Type (A_Type) + and then not Is_Null_Extension (Typ) + and then not Is_Constrained (A_Type) + then + Error_Msg_N + ("type of limited ancestor part must be constrained", A); + + elsif Is_Class_Wide_Type (Etype (A)) and then Nkind (Original_Node (A)) = N_Function_Call then -- If the ancestor part is a dispatching call, it appears diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3f1d85c..b569d70 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -14547,7 +14547,7 @@ package body Sem_Ch3 is ----------------------- function Is_Null_Extension (T : Entity_Id) return Boolean is - Type_Decl : constant Node_Id := Parent (T); + Type_Decl : constant Node_Id := Parent (Base_Type (T)); Comp_List : Node_Id; Comp : Node_Id; |