[Ada] Missing length check on private type with unknown discriminants

2019-12-12  Ed Schonberg  <schonberg@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 150ee5677852a6066a9dcf7a27023ef693a29c62..a4dc13890e00430d2a7eaa7f6fcc2c4c0bc4968b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-12-12  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <duff@adacore.com>
 
        * sem_ch4.adb (Transform_Object_Operation): Deal properly with

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 4bbe86a933346fda92df29c73b1c520c3b58d265..f3139bd1c0b8f456d5a29db4a2f454fe7d6fd9de 100644 (file)
--- 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.