2015-11-12 Bob Duff <duff@adacore.com>

	* impunit.adb, lib-xref.ads, restrict.ads, scos.ads, sem_attr.ads,
	types.ads: Get rid of some global variables.
	* output.adb, output.ads: Move some global variables to the body.

2015-11-12  Yannick Moy  <moy@adacore.com>

	* lib-xref-spark_specific.adb
	(Is_Constant_Object_Without_Variable_Input): Add special case
	for imported constants.

2015-11-12  Philippe Gil  <gil@adacore.com>

	* g-debpoo.adb (Allocate): Avoid having allocations not handled.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Apply_Scalar_Range_Check): If the expression is
	a real literal and the context type has static bounds, remove
	range check when possible.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Collect_Primitive_Operations): If the type is
	derived from a type declared elsewhere that has an incomplete
	type declaration, the primitives are found in the scope of the
	type nat that of its ancestor.

2015-11-12  Arnaud Charlet  <charlet@adacore.com>

	* switch-c.adb, debug.adb, osint-c.adb, gnat1drv.adb: Remove -gnatd.V
	debug switch.
	* exp_aggr.adb, exp_util.adb: Fix typos.

2015-11-12  Jerome Lambourg  <lambourg@adacore.com>

	* init.c: Properly adjust PC values in case of signals.

2015-11-12  Bob Duff  <duff@adacore.com>

	* sem_prag.adb (Check_Arg_Is_Library_Level_Local_Name): A
	pragma that comes from an aspect does not "come from source",
	so we need to test whether it comes from an aspect.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@230253 138bc75d-0d04-0410-961f-82ee72b054a4

20 files changed, 193 insertions, 84 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 51448ed271f..98764271489 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,48 @@
+2015-11-12  Bob Duff  <duff@adacore.com>
+
+	* impunit.adb, lib-xref.ads, restrict.ads, scos.ads, sem_attr.ads,
+	types.ads: Get rid of some global variables.
+	* output.adb, output.ads: Move some global variables to the body.
+
+2015-11-12  Yannick Moy  <moy@adacore.com>
+
+	* lib-xref-spark_specific.adb
+	(Is_Constant_Object_Without_Variable_Input): Add special case
+	for imported constants.
+
+2015-11-12  Philippe Gil  <gil@adacore.com>
+
+	* g-debpoo.adb (Allocate): Avoid having allocations not handled.
+
+2015-11-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* checks.adb (Apply_Scalar_Range_Check): If the expression is
+	a real literal and the context type has static bounds, remove
+	range check when possible.
+
+2015-11-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Collect_Primitive_Operations): If the type is
+	derived from a type declared elsewhere that has an incomplete
+	type declaration, the primitives are found in the scope of the
+	type nat that of its ancestor.
+
+2015-11-12  Arnaud Charlet  <charlet@adacore.com>
+
+	* switch-c.adb, debug.adb, osint-c.adb, gnat1drv.adb: Remove -gnatd.V
+	debug switch.
+	* exp_aggr.adb, exp_util.adb: Fix typos.
+
+2015-11-12  Jerome Lambourg  <lambourg@adacore.com>
+
+	* init.c: Properly adjust PC values in case of signals.
+
+2015-11-12  Bob Duff  <duff@adacore.com>
+
+	* sem_prag.adb (Check_Arg_Is_Library_Level_Local_Name): A
+	pragma that comes from an aspect does not "come from source",
+	so we need to test whether it comes from an aspect.
+
 2015-11-12  Arnaud Charlet  <charlet@adacore.com>
 
 	* switch-c.adb, gnat1drv.adb, opt.ads: Reserve -gnateg for generation
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 05ec983dee7..b5086cc38d3 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2878,11 +2878,35 @@ package body Checks is
          --  Always do a range check if the source type includes infinities and
          --  the target type does not include infinities. We do not do this if
          --  range checks are killed.
+         --  If the expression is a literal and the bounds of the type are
+         --  static constants it may be possible to optimize the check.
 
          if Has_Infinities (S_Typ)
            and then not Has_Infinities (Target_Typ)
          then
-            Enable_Range_Check (Expr);
+            --  If the expression is a literal and the bounds of the type are
+            --  static constants it may be possible to optimize the check.
+
+            if Nkind (Expr) = N_Real_Literal then
+               declare
+                  Tlo : constant Node_Id := Type_Low_Bound  (Target_Typ);
+                  Thi : constant Node_Id := Type_High_Bound (Target_Typ);
+
+               begin
+                  if Compile_Time_Known_Value (Tlo)
+                    and then Compile_Time_Known_Value (Thi)
+                    and then Expr_Value_R (Expr) >= Expr_Value_R (Tlo)
+                    and then Expr_Value_R (Expr) <= Expr_Value_R (Thi)
+                  then
+                     return;
+                  else
+                     Enable_Range_Check (Expr);
+                  end if;
+               end;
+
+            else
+               Enable_Range_Check (Expr);
+            end if;
          end if;
       end if;
 
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index dbc0d7afdf3..ad23a661b64 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1936,8 +1936,7 @@ package body Exp_Aggr is
                --  constraint associated with the type entity (which is
                --  preferable, but it's not always present ???)
 
-               if Is_Empty_Elmt_List (
-                 Discriminant_Constraint (Current_Typ))
+               if Is_Empty_Elmt_List (Discriminant_Constraint (Current_Typ))
                then
                   Assoc := Get_Constraint_Association (Current_Typ);
                   Assoc_Elmt := No_Elmt;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index f2d7b59b18a..bd7b25ce54e 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1672,17 +1672,10 @@ package body Exp_Util is
    function Containing_Package_With_Ext_Axioms
      (E : Entity_Id) return Entity_Id
    is
+      First_Ax_Parent_Scope : Entity_Id;
       Decl : Node_Id;
 
    begin
-      if Ekind (E) = E_Package then
-         if Nkind (Parent (E)) = N_Defining_Program_Unit_Name then
-            Decl := Parent (Parent (E));
-         else
-            Decl := Parent (E);
-         end if;
-      end if;
-
       --  E is the package or generic package which is externally axiomatized
 
       if Ekind_In (E, E_Package, E_Generic_Package)
@@ -1691,33 +1684,35 @@ package body Exp_Util is
          return E;
       end if;
 
-      --  If E's scope is axiomatized, E is axiomatized.
-
-      declare
-         First_Ax_Parent_Scope : Entity_Id := Empty;
+      --  If E's scope is axiomatized, E is axiomatized
 
-      begin
-         if Present (Scope (E)) then
-            First_Ax_Parent_Scope :=
-              Containing_Package_With_Ext_Axioms (Scope (E));
-         end if;
+      if Present (Scope (E)) then
+         First_Ax_Parent_Scope :=
+           Containing_Package_With_Ext_Axioms (Scope (E));
 
          if Present (First_Ax_Parent_Scope) then
             return First_Ax_Parent_Scope;
          end if;
 
-         --  otherwise, if E is a package instance, it is axiomatized if the
-         --  corresponding generic package is axiomatized.
+      end if;
+
+      --  Otherwise, if E is a package instance, it is axiomatized if the
+      --  corresponding generic package is axiomatized.
 
-         if Ekind (E) = E_Package
-           and then Present (Generic_Parent (Decl))
-         then
+      if Ekind (E) = E_Package then
+         if Nkind (Parent (E)) = N_Defining_Program_Unit_Name then
+            Decl := Parent (Parent (E));
+         else
+            Decl := Parent (E);
+         end if;
+
+         if Present (Generic_Parent (Decl)) then
             return
               Containing_Package_With_Ext_Axioms (Generic_Parent (Decl));
-         else
-            return Empty;
          end if;
-      end;
+      end if;
+
+      return Empty;
    end Containing_Package_With_Ext_Axioms;
 
    -------------------------------
diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb
index 5857094ff2b..d51ae903c2b 100644
--- a/gcc/ada/g-debpoo.adb
+++ b/gcc/ada/g-debpoo.adb
@@ -874,7 +874,7 @@ package body GNAT.Debug_Pools is
       P       : Ptr;
       Trace   : Traceback_Htable_Elem_Ptr;
 
-      Disable_Exit_Value : constant Boolean := Disable;
+      Reset_Disable_At_Exit : Boolean := False;
 
    begin
       <<Allocate_Label>>
@@ -887,6 +887,7 @@ package body GNAT.Debug_Pools is
          return;
       end if;
 
+      Reset_Disable_At_Exit := True;
       Disable := True;
 
       Pool.Alloc_Count := Pool.Alloc_Count + 1;
@@ -1017,13 +1018,15 @@ package body GNAT.Debug_Pools is
          Pool.High_Water := Current;
       end if;
 
-      Disable := Disable_Exit_Value;
+      Disable := False;
 
       Unlock_Task.all;
 
    exception
       when others =>
-         Disable := Disable_Exit_Value;
+         if Reset_Disable_At_Exit then
+            Disable := False;
+         end if;
          Unlock_Task.all;
          raise;
    end Allocate;
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 7e5b0671685..17e7d9c5a53 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -142,12 +142,6 @@ procedure Gnat1drv is
          Modify_Tree_For_C := True;
       end if;
 
-      --  -gnatd.V enables C generation
-
-      if Debug_Flag_Dot_VV then
-         Generate_C_Code := True;
-      end if;
-
       --  Set all flags required when generating C code
 
       if Generate_C_Code then
@@ -222,7 +216,7 @@ procedure Gnat1drv is
          --  do not expect this to happen in normal use, since both modes are
          --  enabled by special tools, but it is useful to turn off these flags
          --  this way when we are doing CodePeer tests on existing test suites
-         --  that may have -gnatd.V set, to avoid the need for special casing.
+         --  that may have -gnateg set, to avoid the need for special casing.
 
          Modify_Tree_For_C := False;
          Generate_C_Code := False;
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index 5fea99d59c9..e7d86d2faa5 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -604,21 +604,21 @@ package body Impunit is
 
    type Aunit_Record is record
       Fname : String (1 .. 6);
-      Aname : String_Ptr;
+      Aname : String_Ptr_Const;
    end record;
 
    --  Array of alternative unit names
 
-   Scasuti : aliased String := "GNAT.Case_Util";
-   Scrc32  : aliased String := "GNAT.CRC32";
-   Shtable : aliased String := "GNAT.HTable";
-   Sos_lib : aliased String := "GNAT.OS_Lib";
-   Sregexp : aliased String := "GNAT.Regexp";
-   Sregpat : aliased String := "GNAT.Regpat";
-   Sstring : aliased String := "GNAT.Strings";
-   Sstusta : aliased String := "GNAT.Task_Stack_Usage";
-   Stasloc : aliased String := "GNAT.Task_Lock";
-   Sutf_32 : aliased String := "GNAT.UTF_32";
+   Scasuti : aliased constant String := "GNAT.Case_Util";
+   Scrc32  : aliased constant String := "GNAT.CRC32";
+   Shtable : aliased constant String := "GNAT.HTable";
+   Sos_lib : aliased constant String := "GNAT.OS_Lib";
+   Sregexp : aliased constant String := "GNAT.Regexp";
+   Sregpat : aliased constant String := "GNAT.Regpat";
+   Sstring : aliased constant String := "GNAT.Strings";
+   Sstusta : aliased constant String := "GNAT.Task_Stack_Usage";
+   Stasloc : aliased constant String := "GNAT.Task_Lock";
+   Sutf_32 : aliased constant String := "GNAT.UTF_32";
 
    --  Array giving mapping
 
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 59fc335b6fe..4acf1a29015 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1911,6 +1911,41 @@ __gnat_vxsim_error_handler (int sig, siginfo_t *si, void *sc);
 static int is_vxsim = 0;
 #endif
 
+#if defined (ARMEL) && (_WRS_VXWORKS_MAJOR >= 7)
+
+/* ARM-vx7 case with arm unwinding exceptions */
+#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+
+#include <arch/../regs.h>
+#ifndef __RTP__
+#include <sigLib.h>
+#else
+#include <signal.h>
+#include <regs.h>
+#include <ucontext.h>
+#endif /* __RTP__ */
+
+void
+__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
+				 void *sc ATTRIBUTE_UNUSED)
+{
+  /* In case of ARM exceptions, the registers context have the PC pointing
+     to the instruction that raised the signal. However the Unwinder expects
+     the instruction to be in the range ]PC,PC+1].
+      */
+  uintptr_t *pc_addr; /* address of the pc value to restore */
+#ifdef __RTP__
+  mcontext_t *mcontext = &((ucontext_t *) sc)->uc_mcontext;
+  pc_addr = (uintptr_t*)&mcontext->regs.pc;
+#else
+  struct sigcontext * sctx = (struct sigcontext *) sc;
+  pc_addr = (uintptr_t*)&sctx->sc_pregs->pc;
+#endif
+  /* ARM Bump has to be an even number because of odd/even architecture.  */
+  *pc_addr += 2;
+}
+#endif /* ARMEL && _WRS_VXWORKS_MAJOR >= 7 */
+
 /* Tasking and Non-tasking signal handler.  Map SIGnal to Ada exception
    propagation after the required low level adjustments.  */
 
@@ -1958,6 +1993,10 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
     __gnat_vxsim_error_handler (sig, si, sc);
 #endif
 
+#ifdef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+  __gnat_adjust_context_for_raise (sig, sc);
+#endif
+
   #include "sigtramp.h"
 
   __gnat_sigtramp (sig, (void *)si, (void *)sc,
diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index 3280d184a15..43a023747e5 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/gcc/ada/lib-xref-spark_specific.adb
@@ -445,8 +445,12 @@ package body SPARK_Specific is
                      Decl := Parent (E);
                   end if;
 
-                  pragma Assert (Present (Expression (Decl)));
-                  Result := Is_Static_Expression (Expression (Decl));
+                  if Is_Imported (E) then
+                     Result := False;
+                  else
+                     pragma Assert (Present (Expression (Decl)));
+                     Result := Is_Static_Expression (Expression (Decl));
+                  end if;
                end;
 
             when E_Loop_Parameter | E_In_Parameter =>
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index 63d78c7c169..33e20ee2ae2 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -433,7 +433,7 @@ package Lib.Xref is
    --  indicating procedures and functions. If the operation is abstract,
    --  these letters are replaced in the xref by 'x' and 'y' respectively.
 
-   Xref_Entity_Letters : array (Entity_Kind) of Character :=
+   Xref_Entity_Letters : constant array (Entity_Kind) of Character :=
      (E_Abstract_State                             => '@',
       E_Access_Attribute_Type                      => 'P',
       E_Access_Protected_Subprogram_Type           => 'P',
diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb
index dcbace26fa1..a24a5a73894 100644
--- a/gcc/ada/osint-c.adb
+++ b/gcc/ada/osint-c.adb
@@ -446,7 +446,10 @@ package body Osint.C is
       if NL <= EL
          or else
           (Name (NL - EL + Name'First .. Name'Last) /= Ext
-             and then Name (NL - 2 + Name'First .. Name'Last) /= ".o")
+             and then Name (NL - 2 + Name'First .. Name'Last) /= ".o"
+             and then
+               (not Generate_C_Code
+                  or else Name (NL - 2 + Name'First .. Name'Last) /= ".c"))
       then
          Fail ("incorrect object file extension");
       end if;
diff --git a/gcc/ada/output.adb b/gcc/ada/output.adb
index 9261519b24b..fdfb7330a20 100644
--- a/gcc/ada/output.adb
+++ b/gcc/ada/output.adb
@@ -31,6 +31,17 @@
 
 package body Output is
 
+   Buffer : String (1 .. Buffer_Max + 1) := (others => '*');
+   for Buffer'Alignment use 4;
+   --  Buffer used to build output line. We do line buffering because it is
+   --  needed for the support of the debug-generated-code option (-gnatD). Note
+   --  any attempt to write more output to a line than can fit in the buffer
+   --  will be silently ignored. The alignment clause improves the efficiency
+   --  of the save/restore procedures.
+
+   Next_Col : Positive range 1 .. Buffer'Length + 1 := 1;
+   --  Column about to be written
+
    Current_FD : File_Descriptor := Standout;
    --  File descriptor for current output
 
diff --git a/gcc/ada/output.ads b/gcc/ada/output.ads
index 0fe58edeeae..5fe0d44a9c2 100644
--- a/gcc/ada/output.ads
+++ b/gcc/ada/output.ads
@@ -203,20 +203,6 @@ package Output is
    --  Dump contents of string followed by blank, Boolean, line return
 
 private
-   --  Note: the following buffer and column position are maintained by the
-   --  subprograms defined in this package, and cannot be directly modified or
-   --  accessed by a client.
-
-   Buffer : String (1 .. Buffer_Max + 1) := (others => '*');
-   for Buffer'Alignment use 4;
-   --  Buffer used to build output line. We do line buffering because it is
-   --  needed for the support of the debug-generated-code option (-gnatD). Note
-   --  any attempt to write more output to a line than can fit in the buffer
-   --  will be silently ignored. The alignment clause improves the efficiency
-   --  of the save/restore procedures.
-
-   Next_Col : Positive range 1 .. Buffer'Length + 1 := 1;
-   --  Column about to be written
 
    type Saved_Output_Buffer is record
       Buffer          : String (1 .. Buffer_Max + 1);
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index c34113a7da7..6ce790895d3 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -107,7 +107,7 @@ package Restrict is
    --  to implement pragma Restrictions (No_Implementation_Restrictions) (which
    --  is why this restriction itself is excluded from the list).
 
-   Implementation_Restriction : array (All_Restrictions) of Boolean :=
+   Implementation_Restriction : constant array (All_Restrictions) of Boolean :=
      (Simple_Barriers                    => True,
       No_Calendar                        => True,
       No_Default_Initialization          => True,
diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads
index 4f5bb57d744..2acce02ea19 100644
--- a/gcc/ada/scos.ads
+++ b/gcc/ada/scos.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2009-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -360,7 +360,8 @@ package SCOs is
       Col  : Column_Number;
    end record;
 
-   No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number);
+   No_Source_Location : constant Source_Location :=
+     (No_Line_Number, No_Column_Number);
 
    type SCO_Table_Entry is record
       From : Source_Location := No_Source_Location;
diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index d71acb33140..a8fa47139ec 100644
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -46,7 +46,8 @@ package Sem_Attr is
    --  in GNAT, as well as constructing an array of flags indicating which
    --  attributes these are.
 
-   Attribute_Impl_Def : Attribute_Class_Array := Attribute_Class_Array'(
+   Attribute_Impl_Def : constant Attribute_Class_Array :=
+     Attribute_Class_Array'(
 
       ------------------
       -- Abort_Signal --
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 4d696c49b19..9e873745e70 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -4328,8 +4328,12 @@ package body Sem_Prag is
       begin
          Check_Arg_Is_Local_Name (Arg);
 
+         --  If it came from an aspect, we want to give the error just as if it
+         --  came from source.
+
          if not Is_Library_Level_Entity (Entity (Get_Pragma_Arg (Arg)))
-           and then Comes_From_Source (N)
+           and then (Comes_From_Source (N)
+                       or else Present (Corresponding_Aspect (Parent (Arg))))
          then
             Error_Pragma_Arg
               ("argument for pragma% must be library level entity", Arg);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3512a0a9e3b..59194cf2d26 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4223,6 +4223,14 @@ package body Sem_Util is
          then
             Id := Defining_Entity (Incomplete_View (Parent (B_Type)));
 
+            --  If T is a derived from a type with an incomplete view declared
+            --  elsewhere, that incomplete view is irrelevant, we want the
+            --  operations in the scope of T.
+
+            if Scope (Id) /= Scope (B_Type) then
+               Id := Next_Entity (B_Type);
+            end if;
+
          else
             Id := Next_Entity (B_Type);
          end if;
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 4f565ceb2f4..977d00337f8 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -387,15 +387,6 @@ package body Switch.C is
                            Osint.Fail
                              ("-gnatd.b must be first if combined "
                               & "with other switches");
-
-                        --  Special check, -gnatd.V must occur after -gnatc
-
-                        elsif C = 'V'
-                          and then Operating_Mode /= Check_Semantics
-                        then
-                           Osint.Fail
-                             ("gnatd.V requires previous occurrence "
-                              & "of -gnatc");
                         end if;
 
                      --  Not a dotted flag
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 8b21b10ca4d..10756075bf3 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -109,8 +109,9 @@ package Types is
      Character range Character'Val (16#80#) .. Character'Val (16#FF#);
    --  8-bit Characters with the upper bit set
 
-   type Character_Ptr is access all Character;
-   type String_Ptr    is access all String;
+   type Character_Ptr    is access all Character;
+   type String_Ptr       is access all String;
+   type String_Ptr_Const is access constant String;
    --  Standard character and string pointers
 
    procedure Free is new Unchecked_Deallocation (String, String_Ptr);
@@ -896,7 +897,7 @@ package Types is
    type Reason_Kind is (CE_Reason, PE_Reason, SE_Reason);
    --  Categorization of reason codes by exception raised
 
-   Rkind : array (RT_Exception_Code range <>) of Reason_Kind :=
+   Rkind : constant array (RT_Exception_Code range <>) of Reason_Kind :=
              (CE_Access_Check_Failed            => CE_Reason,
               CE_Access_Parameter_Is_Null       => CE_Reason,
               CE_Discriminant_Check_Failed      => CE_Reason,