diff mbox series

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

Message ID 20191212100430.GA114695@adacore.com
State New
Headers show
Series [Ada] Missing length check on private type with unknown discriminants | expand

Commit Message

Pierre-Marie de Rodat Dec. 12, 2019, 10:04 a.m. UTC 
Compiler fails to emit a length check on the right-hand side of an
assignment when the type involved is a private type with unknown
discriminants whose full view is an unconstrained array type.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
diff mbox series

Patch

--- gcc/ada/exp_ch5.adb
+++ 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.