diff options
| -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 05f1ade75bf..36fd6dc8e4b 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 3f1d85c9c8a..b569d7062f3 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; |
