[multiple changes]

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Check_Component_Storage_Order): Do not reject a
	nested composite with different scalar storage order if it is
	byte aligned.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* gnat_rm.texi: Update documentation for Scalar_Storage_Order.

2012-07-16  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr.adb (Propagate_Exception): Adjust call to
	Exception_Traces procedures.
	* a-exexpr-gcc.adb (Setup_Current_Excep): Now a
	function that returns an access to the Ada occurrence.
	(Propagate_GCC_Exception): Adjust calls.
	* raise.h (struct Exception_Occurrence): Declare.
	* a-exextr.adb: Remove useless pragma.	(Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	* a-except.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	(Process_Raise_Exception): Adjust calls.
	* a-except-2005.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add
	Excep parameter.
	(Raise_Exception): Calls Raise_Exception_Always.
	* raise-gcc.c (__gnat_setup_current_excep,
	__gnat_notify_handled_exception)
	(__gnat_notify_unhandled_exception): Adjust declarations.
	(PERSONALITY_FUNCTION): Adjust calls.
	(__gnat_personality_seh0): Remove warning.

2012-07-16  Javier Miranda  <miranda@adacore.com>

	* sem_eval.adb (Test_Expression_Is_Foldable): Adding documentation.
	(Eval_Relational_Op): Adding documentation.

From-SVN: r189532

11 files changed, 255 insertions, 178 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a0724c0..b18dbac 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,43 @@
+2012-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* freeze.adb (Check_Component_Storage_Order): Do not reject a
+	nested composite with different scalar storage order if it is
+	byte aligned.
+
+2012-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* gnat_rm.texi: Update documentation for Scalar_Storage_Order.
+
+2012-07-16  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr.adb (Propagate_Exception): Adjust call to
+	Exception_Traces procedures.
+	* a-exexpr-gcc.adb (Setup_Current_Excep): Now a
+	function that returns an access to the Ada occurrence.
+	(Propagate_GCC_Exception): Adjust calls.
+	* raise.h (struct Exception_Occurrence): Declare.
+	* a-exextr.adb: Remove useless pragma.	(Notify_Handled_Exception,
+	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
+	Add Excep parameter.
+	* a-except.adb (Notify_Handled_Exception,
+	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
+	Add Excep parameter.
+	(Process_Raise_Exception): Adjust calls.
+	* a-except-2005.adb (Notify_Handled_Exception,
+	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add
+	Excep parameter.
+	(Raise_Exception): Calls Raise_Exception_Always.
+	* raise-gcc.c (__gnat_setup_current_excep,
+	__gnat_notify_handled_exception)
+	(__gnat_notify_unhandled_exception): Adjust declarations.
+	(PERSONALITY_FUNCTION): Adjust calls.
+	(__gnat_personality_seh0): Remove warning.
+
+2012-07-16  Javier Miranda  <miranda@adacore.com>
+
+	* sem_eval.adb (Test_Expression_Is_Foldable): Adding documentation.
+	(Eval_Relational_Op): Adding documentation.
+
 2012-07-16  Robert Dewar  <dewar@adacore.com>
 
 	* freeze.adb, g-debpoo.adb, exp_ch3.adb: Minor reformatting.
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index b7dcb0a..c69c7762 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -209,19 +209,19 @@ package body Ada.Exceptions is
       --  exported to be usable by the Ada exception handling personality
       --  routine when the GCC 3 mechanism is used.
 
-      procedure Notify_Handled_Exception;
+      procedure Notify_Handled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
       --  This routine is called for a handled occurrence is about to be
       --  propagated.
 
-      procedure Notify_Unhandled_Exception;
+      procedure Notify_Unhandled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
       --  This routine is called when an unhandled occurrence is about to be
       --  propagated.
 
-      procedure Unhandled_Exception_Terminate;
+      procedure Unhandled_Exception_Terminate (Excep : EOA);
       pragma No_Return (Unhandled_Exception_Terminate);
       --  This procedure is called to terminate execution following an
       --  unhandled exception. The exception information, including
@@ -395,15 +395,16 @@ package body Ada.Exceptions is
    --  Reraises the exception referenced by the Current_Excep field of
    --  the TSD (all fields of this exception occurrence are set). Abort
    --  is deferred before the reraise operation.
+   --  Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
 
    procedure Transfer_Occurrence
      (Target : Exception_Occurrence_Access;
       Source : Exception_Occurrence);
    pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
-   --  Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
-   --  to setup Target from Source as an exception to be propagated in the
-   --  caller task. Target is expected to be a pointer to the fixed TSD
-   --  occurrence for this task.
+   --  Called from s-tasren.adb:Local_Complete_RendezVous and
+   --  s-tpobop.adb:Exceptional_Complete_Entry_Body to setup Target from
+   --  Source as an exception to be propagated in the caller task. Target is
+   --  expected to be a pointer to the fixed TSD occurrence for this task.
 
    -----------------------------
    -- Run-Time Check Routines --
@@ -953,8 +954,6 @@ package body Ada.Exceptions is
       Message : String := "")
    is
       EF : Exception_Id := E;
-      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
    begin
       --  Raise CE if E = Null_ID (AI-446)
 
@@ -964,14 +963,7 @@ package body Ada.Exceptions is
 
       --  Go ahead and raise appropriate exception
 
-      Exception_Data.Set_Exception_Msg (X, EF, Message);
-
-      if not ZCX_By_Default then
-         Abort_Defer.all;
-      end if;
-
-      Complete_Occurrence (X);
-      Exception_Propagation.Propagate_Exception (X);
+      Raise_Exception_Always (EF, Message);
    end Raise_Exception;
 
    ----------------------------
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 1201ab0..3d3ba61 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -189,19 +189,19 @@ package body Ada.Exceptions is
       --  exported to be usable by the Ada exception handling personality
       --  routine when the GCC 3 mechanism is used.
 
-      procedure Notify_Handled_Exception;
+      procedure Notify_Handled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
       --  This routine is called for a handled occurrence is about to be
       --  propagated.
 
-      procedure Notify_Unhandled_Exception;
+      procedure Notify_Unhandled_Exception (Excep : EOA);
       pragma Export
         (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
       --  This routine is called when an unhandled occurrence is about to be
       --  propagated.
 
-      procedure Unhandled_Exception_Terminate;
+      procedure Unhandled_Exception_Terminate (Excep : EOA);
       pragma No_Return (Unhandled_Exception_Terminate);
       --  This procedure is called to terminate program execution following an
       --  unhandled exception. The exception information, including traceback
@@ -895,14 +895,14 @@ package body Ada.Exceptions is
       if Jumpbuf_Ptr /= Null_Address then
          if not Excep.Exception_Raised then
             Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception;
+            Exception_Traces.Notify_Handled_Exception (Excep);
          end if;
 
          builtin_longjmp (Jumpbuf_Ptr, 1);
 
       else
-         Exception_Traces.Notify_Unhandled_Exception;
-         Exception_Traces.Unhandled_Exception_Terminate;
+         Exception_Traces.Notify_Unhandled_Exception (Excep);
+         Exception_Traces.Unhandled_Exception_Terminate (Excep);
       end if;
    end Process_Raise_Exception;
 
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index 10e91bf..e266cb4 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -202,8 +202,9 @@ package body Exception_Propagation is
    --  Called to implement raise without exception, ie reraise.  Called
    --  directly from gigi.
 
-   procedure Setup_Current_Excep
-     (GCC_Exception : not null GCC_Exception_Access);
+   function Setup_Current_Excep
+     (GCC_Exception : not null GCC_Exception_Access)
+     return EOA;
    pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
    --  Write Get_Current_Excep.all from GCC_Exception
 
@@ -342,8 +343,9 @@ package body Exception_Propagation is
    -- Setup_Current_Excep --
    -------------------------
 
-   procedure Setup_Current_Excep
+   function Setup_Current_Excep
      (GCC_Exception : not null GCC_Exception_Access)
+     return EOA
    is
       Excep : constant EOA := Get_Current_Excep.all;
 
@@ -359,6 +361,8 @@ package body Exception_Propagation is
                                 To_GNAT_GCC_Exception (GCC_Exception);
          begin
             Excep.all := GNAT_Occurrence.Occurrence;
+
+            return GNAT_Occurrence.Occurrence'Access;
          end;
       else
 
@@ -370,6 +374,8 @@ package body Exception_Propagation is
          Excep.Exception_Raised := True;
          Excep.Pid := Local_Partition_ID;
          Excep.Num_Tracebacks := 0;
+
+         return Excep;
       end if;
    end Setup_Current_Excep;
 
@@ -420,6 +426,7 @@ package body Exception_Propagation is
    procedure Propagate_GCC_Exception
      (GCC_Exception : not null GCC_Exception_Access)
    is
+      Excep : EOA;
    begin
       --  Perform a standard raise first. If a regular handler is found, it
       --  will be entered after all the intermediate cleanups have run. If
@@ -432,8 +439,8 @@ package body Exception_Propagation is
       --  the necessary steps to enable the debugger to gain control while the
       --  stack is still intact.
 
-      Setup_Current_Excep (GCC_Exception);
-      Notify_Unhandled_Exception;
+      Excep := Setup_Current_Excep (GCC_Exception);
+      Notify_Unhandled_Exception (Excep);
 
       --  Now, un a forced unwind to trigger cleanups. Control should not
       --  resume there, if there are cleanups and in any cases as the
@@ -466,9 +473,10 @@ package body Exception_Propagation is
    procedure Unhandled_Except_Handler
      (GCC_Exception : not null GCC_Exception_Access)
    is
+      Excep : EOA;
    begin
-      Setup_Current_Excep (GCC_Exception);
-      Unhandled_Exception_Terminate;
+      Excep := Setup_Current_Excep (GCC_Exception);
+      Unhandled_Exception_Terminate (Excep);
    end Unhandled_Except_Handler;
 
    -------------
diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb
index ccedcb2..bf5f680 100644
--- a/gcc/ada/a-exexpr.adb
+++ b/gcc/ada/a-exexpr.adb
@@ -43,7 +43,7 @@ package body Exception_Propagation is
    pragma No_Return (builtin_longjmp);
    pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
 
-   procedure Propagate_Continue (Excep : EOA);
+   procedure Propagate_Continue (E : Exception_Id);
    pragma No_Return (Propagate_Continue);
    pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg");
    --  A call to this procedure is inserted automatically by GIGI, in order
@@ -74,14 +74,14 @@ package body Exception_Propagation is
       if Jumpbuf_Ptr /= Null_Address then
          if not Excep.Exception_Raised then
             Excep.Exception_Raised := True;
-            Exception_Traces.Notify_Handled_Exception;
+            Exception_Traces.Notify_Handled_Exception (Excep);
          end if;
 
          builtin_longjmp (Jumpbuf_Ptr, 1);
 
       else
-         Exception_Traces.Notify_Unhandled_Exception;
-         Exception_Traces.Unhandled_Exception_Terminate;
+         Exception_Traces.Notify_Unhandled_Exception (Excep);
+         Exception_Traces.Unhandled_Exception_Terminate (Excep);
       end if;
    end Propagate_Exception;
 
@@ -89,9 +89,10 @@ package body Exception_Propagation is
    -- Propagate_Continue --
    ------------------------
 
-   procedure Propagate_Continue (Excep : EOA) is
+   procedure Propagate_Continue (E : Exception_Id) is
+      pragma Unreferenced (E);
    begin
-      Propagate_Exception (Excep);
+      Propagate_Exception (Get_Current_Excep.all);
    end Propagate_Continue;
 
 end Exception_Propagation;
diff --git a/gcc/ada/a-exextr.adb b/gcc/ada/a-exextr.adb
index d8f4072..fe4b706 100644
--- a/gcc/ada/a-exextr.adb
+++ b/gcc/ada/a-exextr.adb
@@ -72,17 +72,6 @@ package body Exception_Traces is
    --  latter case because Notify_Handled_Exception may be called for an
    --  actually unhandled occurrence in the Front-End-SJLJ case.
 
-   --------------------------------
-   -- Import Run-Time C Routines --
-   --------------------------------
-
-   --  The purpose of the following pragma Import is to ensure that we
-   --  generate appropriate subprogram descriptors for all C routines in
-   --  the standard GNAT library that can raise exceptions. This ensures
-   --  that the exception propagation can properly find these routines
-
-   pragma Propagate_Exceptions;
-
    ----------------------
    -- Notify_Exception --
    ----------------------
@@ -132,18 +121,16 @@ package body Exception_Traces is
    -- Notify_Handled_Exception --
    ------------------------------
 
-   procedure Notify_Handled_Exception is
+   procedure Notify_Handled_Exception (Excep : EOA) is
    begin
-      Notify_Exception (Get_Current_Excep.all, Is_Unhandled => False);
+      Notify_Exception (Excep, Is_Unhandled => False);
    end Notify_Handled_Exception;
 
    --------------------------------
    -- Notify_Unhandled_Exception --
    --------------------------------
 
-   procedure Notify_Unhandled_Exception is
-      Excep : constant EOA := Get_Current_Excep.all;
-
+   procedure Notify_Unhandled_Exception (Excep : EOA) is
    begin
       --  Check whether there is any termination handler to be executed for
       --  the environment task, and execute it if needed. Here we handle both
@@ -161,8 +148,8 @@ package body Exception_Traces is
    -- Unhandled_Exception_Terminate --
    -----------------------------------
 
-   procedure Unhandled_Exception_Terminate is
-      Excep : Exception_Occurrence;
+   procedure Unhandled_Exception_Terminate (Excep : EOA) is
+      Occ : Exception_Occurrence;
       --  This occurrence will be used to display a message after finalization.
       --  It is necessary to save a copy here, or else the designated value
       --  could be overwritten if an exception is raised during finalization
@@ -172,8 +159,8 @@ package body Exception_Traces is
       --  that there is enough room on the stack however.
 
    begin
-      Save_Occurrence (Excep, Get_Current_Excep.all.all);
-      Last_Chance_Handler (Excep);
+      Save_Occurrence (Occ, Excep.all);
+      Last_Chance_Handler (Occ);
    end Unhandled_Exception_Terminate;
 
    ------------------------------------
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 3a34fbe..9b9f618 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1029,6 +1029,10 @@ package body Freeze is
       Err_Node  : Node_Id;
       ADC       : Node_Id;
 
+      Comp_Byte_Aligned : Boolean;
+      --  Set True for the record case, when Comp starts on a byte boundary
+      --  (in which case it is allowed to have different storage order).
+
    begin
       --  Record case
 
@@ -1037,6 +1041,9 @@ package body Freeze is
          Comp_Type := Etype (Comp);
          Comp_Def  := Component_Definition (Parent (Comp));
 
+         Comp_Byte_Aligned := Present (Component_Clause (Comp))
+           and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+
       --  Array case
 
       else
@@ -1044,6 +1051,8 @@ package body Freeze is
          Comp_Type := Component_Type (Encl_Type);
          Comp_Def  := Component_Definition
                         (Type_Definition (Declaration_Node (Encl_Type)));
+
+         Comp_Byte_Aligned := False;
       end if;
 
       --  Note: the Reverse_Storage_Order flag is set on the base type, but
@@ -1054,14 +1063,20 @@ package body Freeze is
                (First_Subtype (Comp_Type),
                 Attribute_Scalar_Storage_Order);
 
-      if (Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type))
-           and then
-             (No (ADC) or else Reverse_Storage_Order (Encl_Type) /=
-                               Reverse_Storage_Order (Etype (Comp_Type)))
-      then
-         Error_Msg_N
-           ("component type must have same scalar storage order as "
-            & "enclosing composite", Err_Node);
+      if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
+         if No (ADC) then
+            Error_Msg_N ("nested composite must have explicit scalar "
+                         & "storage order", Err_Node);
+
+         elsif (Reverse_Storage_Order (Encl_Type)
+                  /=
+                Reverse_Storage_Order (Etype (Comp_Type)))
+           and then not Comp_Byte_Aligned
+         then
+            Error_Msg_N
+              ("type of non-byte-aligned component must have same scalar "
+               & "storage order as enclosing composite", Err_Node);
+         end if;
 
       elsif Aliased_Present (Comp_Def) then
          Error_Msg_N
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 3b05e47..0c86091 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -6709,7 +6709,7 @@ this attribute.
 @cindex Scalar storage order
 @findex Scalar_Storage_Order
 @noindent
-For every record subtype @var{S}, the representation attribute
+For every array or record type @var{S}, the representation attribute
 @code{Scalar_Storage_Order} denotes the order in which storage elements
 that make up scalar components are ordered within S. Other properties are
 as for standard representation attribute @code{Bit_Order}, as defined by
@@ -6721,6 +6721,11 @@ equal to @code{@var{S}'Bit_Order}. Note: This means that if a
 then the type's @code{Bit_Order} shall be specified explicitly and set to
 the same value.
 
+If a component of S has itself a record or array type, then it shall also
+have a @code{Scalar_Storage_Order} attribute definition clause. In addition,
+if the component does not start on a byte boundary, then the scalar storage
+order specified for S and for the nested component type shall be identical.
+
 A confirming @code{Scalar_Storage_Order} attribute definition clause (i.e.
 with a value equal to @code{System.Default_Bit_Order}) has no effect.
 
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 8aef5b0..418e080 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -77,7 +77,8 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *);
 _Unwind_Reason_Code
 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
 
-extern void __gnat_setup_current_excep (_Unwind_Exception *);
+extern struct Exception_Occurrence *__gnat_setup_current_excep
+ (_Unwind_Exception *);
 extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
 
 #include "dwarf2.h"
@@ -1001,8 +1002,8 @@ setup_to_install (_Unwind_Context *uw_context,
 /* The following is defined from a-except.adb. Its purpose is to enable
    automatic backtraces upon exception raise, as provided through the
    GNAT.Traceback facilities.  */
-extern void __gnat_notify_handled_exception (void);
-extern void __gnat_notify_unhandled_exception (void);
+extern void __gnat_notify_handled_exception (struct Exception_Occurrence *);
+extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
 
 /* Below is the eh personality routine per se. We currently assume that only
    GNU-Ada exceptions are met.  */
@@ -1131,14 +1132,16 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
 	}
       else
 	{
+	  struct Exception_Occurrence *excep;
+
 	  /* Trigger the appropriate notification routines before the second
 	     phase starts, which ensures the stack is still intact.
              First, setup the Ada occurrence.  */
-          __gnat_setup_current_excep (uw_exception);
+          excep = __gnat_setup_current_excep (uw_exception);
 	  if (action.kind == unhandler)
-	    __gnat_notify_unhandled_exception ();
+	    __gnat_notify_unhandled_exception (excep);
 	  else
-	    __gnat_notify_handled_exception ();
+	    __gnat_notify_handled_exception (excep);
 
 	  return _URC_HANDLER_FOUND;
 	}
@@ -1324,7 +1327,7 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
 	  CONTEXT context;
 	  PRUNTIME_FUNCTION mf_func = NULL;
 	  ULONG64 mf_imagebase;
-	  ULONG64 mf_rsp;
+	  ULONG64 mf_rsp = 0;
 
 	  /* Get the context.  */
 	  RtlCaptureContext (&context);
diff --git a/gcc/ada/raise.h b/gcc/ada/raise.h
index 7fb1859..5761154 100644
--- a/gcc/ada/raise.h
+++ b/gcc/ada/raise.h
@@ -49,6 +49,8 @@ struct Exception_Data
 
 typedef struct Exception_Data *Exception_Id;
 
+struct Exception_Occurrence;
+
 extern void _gnat_builtin_longjmp	(void *, int);
 extern void __gnat_unhandled_terminate	(void);
 extern void *__gnat_malloc		(__SIZE_TYPE__);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index cecdbef..1268ee4 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -214,6 +214,16 @@ package body Sem_Eval is
    --  e.g. in the two operand case below, for string comparison, the result
    --  is not static even though the two operands are static. In such cases,
    --  the caller must reset the Is_Static_Expression flag in N.
+   --
+   --  If Fold and Stat are both set to False then this routine performs also
+   --  the following extra actions:
+   --
+   --    * If either operand is Any_Type then propagate it to result to
+   --      prevent cascaded errors.
+   --
+   --    * If some operand raises constraint error, then replace the node N
+   --      with the raise constraint error node. This replacement inherits the
+   --      Is_Static_Expression flag from the operands.
 
    procedure Test_Expression_Is_Foldable
      (N    : Node_Id;
@@ -2702,8 +2712,6 @@ package body Sem_Eval is
       Typ    : constant Entity_Id := Etype (Left);
       Otype  : Entity_Id := Empty;
       Result : Boolean;
-      Stat   : Boolean;
-      Fold   : Boolean;
 
    begin
       --  One special case to deal with first. If we can tell that the result
@@ -2919,128 +2927,144 @@ package body Sem_Eval is
          end Length_Mismatch;
       end if;
 
-      --  Test for expression being foldable
-
-      Test_Expression_Is_Foldable (N, Left, Right, Stat, Fold);
-
-      --  Only comparisons of scalars can give static results. In particular,
-      --  comparisons of strings never yield a static result, even if both
-      --  operands are static strings.
-
-      if not Is_Scalar_Type (Typ) then
-         Stat := False;
-         Set_Is_Static_Expression (N, False);
-      end if;
+      declare
+         Is_Static_Expression : Boolean;
+         Is_Foldable          : Boolean;
+         pragma Unreferenced (Is_Foldable);
 
-      --  For operators on universal numeric types called as functions with
-      --  an explicit scope, determine appropriate specific numeric type, and
-      --  diagnose possible ambiguity.
+      begin
+         --  Initialize the value of Is_Static_Expression. The value of
+         --  Is_Foldable returned by Test_Expression_Is_Foldable is not needed
+         --  since, even when some operand is a variable, we can still perform
+         --  the static evaluation of the expression in some cases (for
+         --  example, for a variable of a subtype of Integer we statically
+         --  know that any value stored in such variable is smaller than
+         --  Integer'Last).
+
+         Test_Expression_Is_Foldable
+           (N, Left, Right, Is_Static_Expression, Is_Foldable);
+
+         --  Only comparisons of scalars can give static results. In
+         --  particular, comparisons of strings never yield a static
+         --  result, even if both operands are static strings.
+
+         if not Is_Scalar_Type (Typ) then
+            Is_Static_Expression := False;
+            Set_Is_Static_Expression (N, False);
+         end if;
 
-      if Is_Universal_Numeric_Type (Etype (Left))
-           and then
-         Is_Universal_Numeric_Type (Etype (Right))
-      then
-         Otype := Find_Universal_Operator_Type (N);
-      end if;
+         --  For operators on universal numeric types called as functions with
+         --  an explicit scope, determine appropriate specific numeric type,
+         --  and diagnose possible ambiguity.
 
-      --  For static real type expressions, we cannot use Compile_Time_Compare
-      --  since it worries about run-time results which are not exact.
+         if Is_Universal_Numeric_Type (Etype (Left))
+              and then
+            Is_Universal_Numeric_Type (Etype (Right))
+         then
+            Otype := Find_Universal_Operator_Type (N);
+         end if;
 
-      if Stat and then Is_Real_Type (Typ) then
-         declare
-            Left_Real  : constant Ureal := Expr_Value_R (Left);
-            Right_Real : constant Ureal := Expr_Value_R (Right);
+         --  For static real type expressions, we cannot use
+         --  Compile_Time_Compare since it worries about run-time
+         --  results which are not exact.
 
-         begin
-            case Nkind (N) is
-               when N_Op_Eq => Result := (Left_Real =  Right_Real);
-               when N_Op_Ne => Result := (Left_Real /= Right_Real);
-               when N_Op_Lt => Result := (Left_Real <  Right_Real);
-               when N_Op_Le => Result := (Left_Real <= Right_Real);
-               when N_Op_Gt => Result := (Left_Real >  Right_Real);
-               when N_Op_Ge => Result := (Left_Real >= Right_Real);
+         if Is_Static_Expression and then Is_Real_Type (Typ) then
+            declare
+               Left_Real  : constant Ureal := Expr_Value_R (Left);
+               Right_Real : constant Ureal := Expr_Value_R (Right);
 
-               when others =>
-                  raise Program_Error;
-            end case;
+            begin
+               case Nkind (N) is
+                  when N_Op_Eq => Result := (Left_Real =  Right_Real);
+                  when N_Op_Ne => Result := (Left_Real /= Right_Real);
+                  when N_Op_Lt => Result := (Left_Real <  Right_Real);
+                  when N_Op_Le => Result := (Left_Real <= Right_Real);
+                  when N_Op_Gt => Result := (Left_Real >  Right_Real);
+                  when N_Op_Ge => Result := (Left_Real >= Right_Real);
+
+                  when others =>
+                     raise Program_Error;
+               end case;
 
-            Fold_Uint (N, Test (Result), True);
-         end;
+               Fold_Uint (N, Test (Result), True);
+            end;
 
-      --  For all other cases, we use Compile_Time_Compare to do the compare
+         --  For all other cases, we use Compile_Time_Compare to do the compare
 
-      else
-         declare
-            CR : constant Compare_Result :=
-                   Compile_Time_Compare (Left, Right, Assume_Valid => False);
+         else
+            declare
+               CR : constant Compare_Result :=
+                      Compile_Time_Compare
+                        (Left, Right, Assume_Valid => False);
 
-         begin
-            if CR = Unknown then
-               return;
-            end if;
+            begin
+               if CR = Unknown then
+                  return;
+               end if;
 
-            case Nkind (N) is
-               when N_Op_Eq =>
-                  if CR = EQ then
-                     Result := True;
-                  elsif CR = NE or else CR = GT or else CR = LT then
-                     Result := False;
-                  else
-                     return;
-                  end if;
+               case Nkind (N) is
+                  when N_Op_Eq =>
+                     if CR = EQ then
+                        Result := True;
+                     elsif CR = NE or else CR = GT or else CR = LT then
+                        Result := False;
+                     else
+                        return;
+                     end if;
 
-               when N_Op_Ne =>
-                  if CR = NE or else CR = GT or else CR = LT then
-                     Result := True;
-                  elsif CR = EQ then
-                     Result := False;
-                  else
-                     return;
-                  end if;
+                  when N_Op_Ne =>
+                     if CR = NE or else CR = GT or else CR = LT then
+                        Result := True;
+                     elsif CR = EQ then
+                        Result := False;
+                     else
+                        return;
+                     end if;
 
-               when N_Op_Lt =>
-                  if CR = LT then
-                     Result := True;
-                  elsif CR = EQ or else CR = GT or else CR = GE then
-                     Result := False;
-                  else
-                     return;
-                  end if;
+                  when N_Op_Lt =>
+                     if CR = LT then
+                        Result := True;
+                     elsif CR = EQ or else CR = GT or else CR = GE then
+                        Result := False;
+                     else
+                        return;
+                     end if;
 
-               when N_Op_Le =>
-                  if CR = LT or else CR = EQ or else CR = LE then
-                     Result := True;
-                  elsif CR = GT then
-                     Result := False;
-                  else
-                     return;
-                  end if;
+                  when N_Op_Le =>
+                     if CR = LT or else CR = EQ or else CR = LE then
+                        Result := True;
+                     elsif CR = GT then
+                        Result := False;
+                     else
+                        return;
+                     end if;
 
-               when N_Op_Gt =>
-                  if CR = GT then
-                     Result := True;
-                  elsif CR = EQ or else CR = LT or else CR = LE then
-                     Result := False;
-                  else
-                     return;
-                  end if;
+                  when N_Op_Gt =>
+                     if CR = GT then
+                        Result := True;
+                     elsif CR = EQ or else CR = LT or else CR = LE then
+                        Result := False;
+                     else
+                        return;
+                     end if;
 
-               when N_Op_Ge =>
-                  if CR = GT or else CR = EQ or else CR = GE then
-                     Result := True;
-                  elsif CR = LT then
-                     Result := False;
-                  else
-                     return;
-                  end if;
+                  when N_Op_Ge =>
+                     if CR = GT or else CR = EQ or else CR = GE then
+                        Result := True;
+                     elsif CR = LT then
+                        Result := False;
+                     else
+                        return;
+                     end if;
 
-               when others =>
-                  raise Program_Error;
-            end case;
-         end;
+                  when others =>
+                     raise Program_Error;
+               end case;
+            end;
 
-         Fold_Uint (N, Test (Result), Stat);
-      end if;
+            Fold_Uint (N, Test (Result), Is_Static_Expression);
+         end if;
+      end;
 
       --  For the case of a folded relational operator on a specific numeric
       --  type, freeze operand type now.