diff options
| author | Arnaud Charlet <charlet@adacore.com> | 2020-02-27 04:28:04 -0500 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-09 04:09:01 -0400 |
| commit | 11381028a623f939cb7148d908e75ec624e00085 (patch) | |
| tree | 6d15b85d5f7a34345b457f9fcbfc3aced878e69c /gcc | |
| parent | 8e6ca7a87bf96e0baa3bfb3775bf1bff40ea0464 (diff) | |
| download | gcc-11381028a623f939cb7148d908e75ec624e00085.zip gcc-11381028a623f939cb7148d908e75ec624e00085.tar.gz gcc-11381028a623f939cb7148d908e75ec624e00085.tar.bz2 | |
[Ada] Membership test against a non-excluding subtype
2020-06-09 Arnaud Charlet <charlet@adacore.com>
gcc/ada/
* exp_ch4.adb (Expand_N_In): Fix handling of null exclusion.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 69 |
1 files changed, 36 insertions, 33 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 69b36a4..d9a96a5 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6468,12 +6468,13 @@ package body Exp_Ch4 is else declare - Typ : Entity_Id := Etype (Rop); - Is_Acc : constant Boolean := Is_Access_Type (Typ); - Cond : Node_Id := Empty; - New_N : Node_Id; - Obj : Node_Id := Lop; - SCIL_Node : Node_Id; + Typ : Entity_Id := Etype (Rop); + Is_Acc : constant Boolean := Is_Access_Type (Typ); + Check_Null_Exclusion : Boolean; + Cond : Node_Id := Empty; + New_N : Node_Id; + Obj : Node_Id := Lop; + SCIL_Node : Node_Id; begin Remove_Side_Effects (Obj); @@ -6549,12 +6550,19 @@ package body Exp_Ch4 is -- Here we have a non-scalar type if Is_Acc then + + -- If the null exclusion checks are not compatible, need to + -- perform further checks. In other words, we cannot have + -- Ltyp including null and Typ excluding null. All other cases + -- are OK. + + Check_Null_Exclusion := + Can_Never_Be_Null (Typ) and then not Can_Never_Be_Null (Ltyp); Typ := Designated_Type (Typ); end if; if not Is_Constrained (Typ) then - Rewrite (N, New_Occurrence_Of (Standard_True, Loc)); - Analyze_And_Resolve (N, Restyp); + Cond := New_Occurrence_Of (Standard_True, Loc); -- For the constrained array case, we have to check the subscripts -- for an exact match if the lengths are non-zero (the lengths @@ -6610,19 +6618,6 @@ package body Exp_Ch4 is Build_Attribute_Reference (New_Occurrence_Of (Typ, Loc), Name_Last, J))); end loop; - - if Is_Acc then - Cond := - Make_Or_Else (Loc, - Left_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => Obj, - Right_Opnd => Make_Null (Loc)), - Right_Opnd => Cond); - end if; - - Rewrite (N, Cond); - Analyze_And_Resolve (N, Restyp); end Check_Subscripts; -- These are the cases where constraint checks may be required, @@ -6638,24 +6633,32 @@ package body Exp_Ch4 is if Has_Discriminants (Typ) then Cond := Make_Op_Not (Loc, Right_Opnd => Build_Discriminant_Checks (Obj, Typ)); - - if Is_Acc then - Cond := Make_Or_Else (Loc, - Left_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => Obj, - Right_Opnd => Make_Null (Loc)), - Right_Opnd => Cond); - end if; - else Cond := New_Occurrence_Of (Standard_True, Loc); end if; + end if; - Rewrite (N, Cond); - Analyze_And_Resolve (N, Restyp); + if Is_Acc then + if Check_Null_Exclusion then + Cond := Make_And_Then (Loc, + Left_Opnd => + Make_Op_Ne (Loc, + Left_Opnd => Obj, + Right_Opnd => Make_Null (Loc)), + Right_Opnd => Cond); + else + Cond := Make_Or_Else (Loc, + Left_Opnd => + Make_Op_Eq (Loc, + Left_Opnd => Obj, + Right_Opnd => Make_Null (Loc)), + Right_Opnd => Cond); + end if; end if; + Rewrite (N, Cond); + Analyze_And_Resolve (N, Restyp); + -- Ada 2012 (AI05-0149): Handle membership tests applied to an -- expression of an anonymous access type. This can involve an -- accessibility test and a tagged type membership test in the |