diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2020-05-01 15:26:08 +0200 |
|---|---|---|
| committer | Giuliano Belinassi <giuliano.belinassi@usp.br> | 2020-08-17 13:14:10 -0300 |
| commit | bdf04ccb320684c05e9745a7a2b421d68c6f246b (patch) | |
| tree | 6a907247fa4d1f4a713f6c94e8c83b1414a9e704 /gcc | |
| parent | 27c714f9a70d37ccf3e2ba19f1bb65dc8ca004fa (diff) | |
| download | gcc-bdf04ccb320684c05e9745a7a2b421d68c6f246b.zip gcc-bdf04ccb320684c05e9745a7a2b421d68c6f246b.tar.gz gcc-bdf04ccb320684c05e9745a7a2b421d68c6f246b.tar.bz2 | |
[Ada] Plug small loophole in implementation of AI12-0100
2020-06-19 Eric Botcazou <ebotcazou@adacore.com>
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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/sem_res.adb | 17 |
1 files changed, 4 insertions, 13 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e6b4e6c..e4c0c07 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; |