From: Ed Schonberg <schonberg@adacore.com>
Date: Wed, 26 Mar 2008 07:39:39 +0000 (+0100)
Subject: exp_pakd.adb (Expand_Bit_Packed_Element_Set): If the component assignment is within... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=26658d3a35a9206153d7b1d5f03decd1bdf65062;p=gcc.git

exp_pakd.adb (Expand_Bit_Packed_Element_Set): If the component assignment is within the initialization procedure for a packed...

2008-03-26  Ed Schonberg  <schonberg@adacore.com>

	* exp_pakd.adb (Expand_Bit_Packed_Element_Set): If the component
	assignment is within the initialization procedure for a packed array,
	and Initialize_Scalars is enabled, compile right-hand side with checks
	off, because the value is purposely out of range.

From-SVN: r133566
---

diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index f3ead191c96..68feec5aa3f 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -33,6 +33,7 @@ with Layout;   use Layout;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
+with Opt;      use Opt;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Ch3;  use Sem_Ch3;
@@ -1359,7 +1360,19 @@ package body Exp_Pakd is
 
       Rhs := Convert_To (Ctyp, Rhs);
       Set_Parent (Rhs, N);
-      Analyze_And_Resolve (Rhs, Ctyp);
+
+      --  If we are building the initialization procedure for a packed array,
+      --  and Initialize_Scalars is enabled, each component assignment is an
+      --  out-of-range value by design.  Compile this value without checks,
+      --  because a call to the array init_proc must not raise an exception.
+
+      if Within_Init_Proc
+        and then Initialize_Scalars
+      then
+         Analyze_And_Resolve (Rhs, Ctyp, Suppress => All_Checks);
+      else
+         Analyze_And_Resolve (Rhs, Ctyp);
+      end if;
 
       --  Case of component size 1,2,4 or any component size for the modular
       --  case. These are the cases for which we can inline the code.