From c2f3e1a3e369fe549fa76e9821d2e17bc3d55dc7 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:02:23 +0000 Subject: [Ada] Missing length check on private type with unknown discriminants 2019-12-12 Ed Schonberg gcc/ada/ * exp_ch5.adb (Expand_N_Assognment_Statement): Extend the processing involving private types with unknown discriminants to handle the case where the full view of the type is an unconstrained array type. From-SVN: r279286 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_ch5.adb | 23 ++++++++++++++++------- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 150ee56..a4dc138 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-12-12 Ed Schonberg + + * exp_ch5.adb (Expand_N_Assognment_Statement): Extend the + processing involving private types with unknown discriminants to + handle the case where the full view of the type is an + unconstrained array type. + 2019-12-12 Bob Duff * sem_ch4.adb (Transform_Object_Operation): Deal properly with diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 4bbe86a..f3139bd 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2409,14 +2409,23 @@ package body Exp_Ch5 is -- checking. Convert Lhs as well, otherwise the actual subtype might -- not be constructible. If the discriminants have defaults the type -- is unconstrained and there is nothing to check. + -- Ditto if a private type with unknown discriminants has a full view + -- that is an unconstrained array, in which case a length check is + -- needed. - elsif Has_Unknown_Discriminants (Base_Type (Etype (Lhs))) - and then Has_Discriminants (Typ) - and then not Has_Defaulted_Discriminants (Typ) - then - Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); - Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs)); - Apply_Discriminant_Check (Rhs, Typ, Lhs); + elsif Has_Unknown_Discriminants (Base_Type (Etype (Lhs))) then + if Has_Discriminants (Typ) + and then not Has_Defaulted_Discriminants (Typ) + then + Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); + Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs)); + Apply_Discriminant_Check (Rhs, Typ, Lhs); + + elsif Is_Array_Type (Typ) and then Is_Constrained (Typ) then + Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); + Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs)); + Apply_Length_Check (Rhs, Typ); + end if; -- In the access type case, we need the same discriminant check, and -- also range checks if we have an access to constrained array. -- cgit v1.1