From: Eric Botcazou Date: Fri, 1 May 2020 13:26:08 +0000 (+0200) Subject: [Ada] Plug small loophole in implementation of AI12-0100 X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e3c1f8dd0502c22c9ad47b360a65405ae9b87b23;p=gcc.git [Ada] Plug small loophole in implementation of AI12-0100 2020-06-19 Eric Botcazou gcc/ada/ * sem_res.adb (Resolve_Allocator): Call Resolve_Qualified_Expression on the qualified expression, if any, instead of doing an incomplete type resolution manually. (Resolve_Qualified_Expression): Apply predicate check to operand. --- diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e6b4e6cd81f..e4c0c072ab9 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5133,8 +5133,9 @@ package body Sem_Res is ("class-wide allocator not allowed for this access type", N); end if; - Resolve (Expression (E), Etype (E)); - Check_Non_Static_Context (Expression (E)); + -- Do a full resolution to apply constraint and predicate checks + + Resolve_Qualified_Expression (E, Etype (E)); Check_Unset_Reference (Expression (E)); -- Allocators generated by the build-in-place expansion mechanism @@ -5168,16 +5169,6 @@ package body Sem_Res is end if; end if; - -- A qualified expression requires an exact match of the type. Class- - -- wide matching is not allowed. - - if (Is_Class_Wide_Type (Etype (Expression (E))) - or else Is_Class_Wide_Type (Etype (E))) - and then Base_Type (Etype (Expression (E))) /= Base_Type (Etype (E)) - then - Wrong_Type (Expression (E), Etype (E)); - end if; - -- Calls to build-in-place functions are not currently supported in -- allocators for access types associated with a simple storage pool. -- Supporting such allocators may require passing additional implicit @@ -10199,7 +10190,7 @@ package body Sem_Res is if Has_Predicates (Target_Typ) then Check_Expression_Against_Static_Predicate - (N, Target_Typ, Static_Failure_Is_Error => True); + (Expr, Target_Typ, Static_Failure_Is_Error => True); end if; end Resolve_Qualified_Expression;