From 11381028a623f939cb7148d908e75ec624e00085 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 27 Feb 2020 04:28:04 -0500 Subject: [PATCH] [Ada] Membership test against a non-excluding subtype 2020-06-09 Arnaud Charlet gcc/ada/ * exp_ch4.adb (Expand_N_In): Fix handling of null exclusion. --- gcc/ada/exp_ch4.adb | 69 ++++++++++++++++++++++++++++------------------------- 1 file 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 -- 2.7.4