[multiple changes]

2014-01-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Update): Analyze
	expressions in each component association, and for records note
	the entity in each association choice, for subsequent resolution.
	(Resolve_Attribute, case 'Update): Complete resolution of
	expressions in each component association.

2014-01-24  Robert Dewar  <dewar@adacore.com>

	* sem.adb (Sem): Avoid premature reference to Current_Sem_Unit
	(this was causing Is_Main_Unit_Or_Main_Unit_Spec to be set wrong,
	leading to wrong handling of SPARK_Mode for library units).

2014-01-24  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set SPARK_Mode
	on generic instances (do not consider them to be internally
	generated)

2014-01-24  Doug Rupp  <rupp@adacore.com>

	* s-osinte-android.ads (pthread_sigmask): Import sigprocmask
	vice pthread_sigmask.

2014-01-24  Vincent Celier  <celier@adacore.com>

	* prj.adb (Debug_Output (Str, Str2)): Output if verbosity is
	not default.

2014-01-24  Vincent Celier  <celier@adacore.com>

	* prj-ext.adb (Add): Do not output anything when Silent is True,
	whatever the verbosity. When Source is From_External_Attribute,
	set the corresponding environment variable if it is not already set.
	* prj-ext.ads (Add): New Boolean parameter Silent, defaulted
	to False
	* prj-proc.adb (Process_Expression_For_Associative_Array):
	For attribute External, call Prj.Ext.Add with Silent set to
	True for the child environment, to avoid useless output in non
	default verbosity.

2014-01-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Set_Slice_Subtype): Handle properly a discrete
	range given by a subtype indication, and force evaluation of
	the bounds, as for a simple range.
	* exp_util.adb (Evaluate_Slice_Bounds): Utility to force evaluation
	of bounds of slice for various kinds of discrete ranges.
	(Evaluate_Name, Evaluate_Subtype_From_Expr): use
	Evaluate_Slice_Bounds.

2014-01-24  Bob Duff  <duff@adacore.com>

	* s-taskin.ads (Activator): Make this Atomic, because
	Activation_Is_Complete reads it, and that can be called
	from any task. Previously, this component was only
	modified by the activator before activation, and by
	Self after activation.
	* a-taside.ads, a-taside.adb (Environment_Task,
	Activation_Is_Complete): Implement these missing functions.

From-SVN: r207034

14 files changed, 258 insertions, 57 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fd2bca2..03c982d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,65 @@
+2014-01-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute, case 'Update): Analyze
+	expressions in each component association, and for records note
+	the entity in each association choice, for subsequent resolution.
+	(Resolve_Attribute, case 'Update): Complete resolution of
+	expressions in each component association.
+
+2014-01-24  Robert Dewar  <dewar@adacore.com>
+
+	* sem.adb (Sem): Avoid premature reference to Current_Sem_Unit
+	(this was causing Is_Main_Unit_Or_Main_Unit_Spec to be set wrong,
+	leading to wrong handling of SPARK_Mode for library units).
+
+2014-01-24  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set SPARK_Mode
+	on generic instances (do not consider them to be internally
+	generated)
+
+2014-01-24  Doug Rupp  <rupp@adacore.com>
+
+	* s-osinte-android.ads (pthread_sigmask): Import sigprocmask
+	vice pthread_sigmask.
+
+2014-01-24  Vincent Celier  <celier@adacore.com>
+
+	* prj.adb (Debug_Output (Str, Str2)): Output if verbosity is
+	not default.
+
+2014-01-24  Vincent Celier  <celier@adacore.com>
+
+	* prj-ext.adb (Add): Do not output anything when Silent is True,
+	whatever the verbosity. When Source is From_External_Attribute,
+	set the corresponding environment variable if it is not already set.
+	* prj-ext.ads (Add): New Boolean parameter Silent, defaulted
+	to False
+	* prj-proc.adb (Process_Expression_For_Associative_Array):
+	For attribute External, call Prj.Ext.Add with Silent set to
+	True for the child environment, to avoid useless output in non
+	default verbosity.
+
+2014-01-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Set_Slice_Subtype): Handle properly a discrete
+	range given by a subtype indication, and force evaluation of
+	the bounds, as for a simple range.
+	* exp_util.adb (Evaluate_Slice_Bounds): Utility to force evaluation
+	of bounds of slice for various kinds of discrete ranges.
+	(Evaluate_Name, Evaluate_Subtype_From_Expr): use
+	Evaluate_Slice_Bounds.
+
+2014-01-24  Bob Duff  <duff@adacore.com>
+
+	* s-taskin.ads (Activator): Make this Atomic, because
+	Activation_Is_Complete reads it, and that can be called
+	from any task. Previously, this component was only
+	modified by the activator before activation, and by
+	Self after activation.
+	* a-taside.ads, a-taside.adb (Environment_Task,
+	Activation_Is_Complete): Implement these missing functions.
+
 2014-01-24  Doug Rupp  <rupp@adacore.com>
 
 	* init.c: Add a handler section for Android.
diff --git a/gcc/ada/a-taside.adb b/gcc/ada/a-taside.adb
index 4c7eb0a..520a7df 100644
--- a/gcc/ada/a-taside.adb
+++ b/gcc/ada/a-taside.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -83,6 +83,16 @@ package body Ada.Task_Identification is
       end if;
    end Abort_Task;
 
+   ----------------------------
+   -- Activation_Is_Complete --
+   ----------------------------
+
+   function Activation_Is_Complete (T : Task_Id) return Boolean is
+      use type System.Tasking.Task_Id;
+   begin
+      return Convert_Ids (T).Common.Activator = null;
+   end Activation_Is_Complete;
+
    -----------------
    -- Convert_Ids --
    -----------------
@@ -106,6 +116,15 @@ package body Ada.Task_Identification is
       return Convert_Ids (System.Task_Primitives.Operations.Self);
    end Current_Task;
 
+   ----------------------
+   -- Environment_Task --
+   ----------------------
+
+   function Environment_Task return Task_Id is
+   begin
+      return Convert_Ids (System.Task_Primitives.Operations.Environment_Task);
+   end Environment_Task;
+
    -----------
    -- Image --
    -----------
diff --git a/gcc/ada/a-taside.ads b/gcc/ada/a-taside.ads
index 7466f96..e53ff04 100644
--- a/gcc/ada/a-taside.ads
+++ b/gcc/ada/a-taside.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -53,6 +53,9 @@ package Ada.Task_Identification is
    function Current_Task return Task_Id;
    pragma Inline (Current_Task);
 
+   function Environment_Task return Task_Id;
+   pragma Inline (Environment_Task);
+
    procedure Abort_Task (T : Task_Id);
    pragma Inline (Abort_Task);
    --  Note: parameter is mode IN, not IN OUT, per AI-00101
@@ -63,6 +66,8 @@ package Ada.Task_Identification is
    function Is_Callable (T : Task_Id) return Boolean;
    pragma Inline (Is_Callable);
 
+   function Activation_Is_Complete (T : Task_Id) return Boolean;
+
 private
 
    type Task_Id is new System.Tasking.Task_Id;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index f9a5818..5262627 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -106,6 +106,10 @@ package body Exp_Util is
    --  record with task components, or for a dynamically created task that is
    --  assigned to a selected component.
 
+   procedure Evaluate_Slice_Bounds (Slice : Node_Id);
+   --  Force evaluation of bounds of a slice, which may be given by a range
+   --  or by a subtype indication with or without a constraint.
+
    function Make_CW_Equivalent_Type
      (T : Entity_Id;
       E : Node_Id) return Entity_Id;
@@ -1835,28 +1839,7 @@ package body Exp_Util is
 
       elsif K = N_Slice then
          Evaluate_Name (Prefix (Nam));
-
-         declare
-            DR     : constant Node_Id := Discrete_Range (Nam);
-            Constr : Node_Id;
-            Rexpr  : Node_Id;
-
-         begin
-            if Nkind (DR) = N_Range then
-               Force_Evaluation (Low_Bound (DR));
-               Force_Evaluation (High_Bound (DR));
-
-            elsif Nkind (DR) = N_Subtype_Indication then
-               Constr := Constraint (DR);
-
-               if Nkind (Constr) = N_Range_Constraint then
-                  Rexpr := Range_Expression (Constr);
-
-                  Force_Evaluation (Low_Bound (Rexpr));
-                  Force_Evaluation (High_Bound (Rexpr));
-               end if;
-            end if;
-         end;
+         Evaluate_Slice_Bounds (Nam);
 
       --  For a type conversion, the expression of the conversion must be the
       --  name of an object, and we simply need to evaluate this name.
@@ -1878,6 +1861,32 @@ package body Exp_Util is
       end if;
    end Evaluate_Name;
 
+   ---------------------------
+   -- Evaluate_Slice_Bounds --
+   ---------------------------
+
+   procedure Evaluate_Slice_Bounds (Slice : Node_Id) is
+      DR     : constant Node_Id := Discrete_Range (Slice);
+      Constr : Node_Id;
+      Rexpr  : Node_Id;
+
+   begin
+      if Nkind (DR) = N_Range then
+         Force_Evaluation (Low_Bound (DR));
+         Force_Evaluation (High_Bound (DR));
+
+      elsif Nkind (DR) = N_Subtype_Indication then
+         Constr := Constraint (DR);
+
+         if Nkind (Constr) = N_Range_Constraint then
+            Rexpr := Range_Expression (Constr);
+
+            Force_Evaluation (Low_Bound (Rexpr));
+            Force_Evaluation (High_Bound (Rexpr));
+         end if;
+      end if;
+   end Evaluate_Slice_Bounds;
+
    ---------------------
    -- Evolve_And_Then --
    ---------------------
@@ -2067,8 +2076,7 @@ package body Exp_Util is
             --  we better make sure that if a variable was used as a bound of
             --  of the original slice, its value is frozen.
 
-            Force_Evaluation (Low_Bound (Scalar_Range (Slice_Type)));
-            Force_Evaluation (High_Bound (Scalar_Range (Slice_Type)));
+            Evaluate_Slice_Bounds (Exp);
          end;
 
       elsif Ekind (Exp_Typ) = E_String_Literal_Subtype then
diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb
index 5d49fa4..5f13400 100644
--- a/gcc/ada/prj-ext.adb
+++ b/gcc/ada/prj-ext.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2000-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2013, 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- --
@@ -66,12 +66,39 @@ package body Prj.Ext is
      (Self          : External_References;
       External_Name : String;
       Value         : String;
-      Source        : External_Source := External_Source'First)
+      Source        : External_Source := External_Source'First;
+      Silent        : Boolean := False)
    is
       Key : Name_Id;
       N   : Name_To_Name_Ptr;
 
    begin
+      --  For external attribute, set the environment variable
+
+      if Source = From_External_Attribute and then External_Name /= "" then
+         declare
+            Env_Var : String_Access := Getenv (External_Name);
+
+         begin
+            if Env_Var = null or else Env_Var.all = "" then
+               Setenv (Name => External_Name, Value => Value);
+
+               if not Silent then
+                  Debug_Output
+                    ("Environment variable """ & External_Name
+                     & """ = """ & Value & '"');
+               end if;
+
+            elsif not Silent then
+               Debug_Output
+                 ("Not overriding existing environment variable """
+                  & External_Name & """, value is """ & Env_Var.all & '"');
+            end if;
+
+            Free (Env_Var);
+         end;
+      end if;
+
       Name_Len := External_Name'Length;
       Name_Buffer (1 .. Name_Len) := External_Name;
       Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len));
@@ -87,11 +114,13 @@ package body Prj.Ext is
             if External_Source'Pos (N.Source) <
                External_Source'Pos (Source)
             then
-               if Current_Verbosity = High then
+               if not Silent then
                   Debug_Output
-                    ("Not overridding existing variable '" & External_Name
-                     & "', value was defined in " & N.Source'Img);
+                    ("Not overridding existing external reference '"
+                     & External_Name & "', value was defined in "
+                     & N.Source'Img);
                end if;
+
                return;
             end if;
          end if;
@@ -105,7 +134,7 @@ package body Prj.Ext is
                   Value  => Name_Find,
                   Next   => null);
 
-      if Current_Verbosity = High then
+      if not Silent then
          Debug_Output ("Add external (" & External_Name & ") is", N.Value);
       end if;
 
diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads
index 01719cf..ca01959 100644
--- a/gcc/ada/prj-ext.ads
+++ b/gcc/ada/prj-ext.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2013, 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- --
@@ -68,11 +68,13 @@ package Prj.Ext is
      (Self          : External_References;
       External_Name : String;
       Value         : String;
-      Source        : External_Source := External_Source'First);
+      Source        : External_Source := External_Source'First;
+      Silent        : Boolean := False);
    --  Add an external reference (or modify an existing one). No overriding is
    --  done if the Source's priority is less than the one used to previously
    --  set the value of the variable. The default for Source is such that
-   --  overriding always occurs.
+   --  overriding always occurs. When Silent is True, nothing is output even
+   --  with non default verbosity.
 
    function Value_Of
      (Self          : External_References;
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index fe4c252..43a0f87 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -1969,7 +1969,8 @@ package body Prj.Proc is
                Add (Env.External,
                     External_Name => Get_Name_String (Index_Name),
                     Value         => Get_Name_String (New_Value.Value),
-                    Source        => From_External_Attribute);
+                    Source        => From_External_Attribute,
+                    Silent        => True);
             else
                if Current_Verbosity = High then
                   Debug_Output
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index b98f711..29798a1 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -1838,7 +1838,7 @@ package body Prj is
 
    procedure Debug_Output (Str : String; Str2 : Name_Id) is
    begin
-      if Current_Verbosity = High then
+      if Current_Verbosity > Default then
          Debug_Indent;
          Set_Standard_Error;
          Write_Str (Str);
diff --git a/gcc/ada/s-osinte-android.ads b/gcc/ada/s-osinte-android.ads
index bdcf4c7..2b94f3f 100644
--- a/gcc/ada/s-osinte-android.ads
+++ b/gcc/ada/s-osinte-android.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1995-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2013, 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- --
@@ -354,7 +354,10 @@ package System.OS_Interface is
      (how  : int;
       set  : access sigset_t;
       oset : access sigset_t) return int;
-   pragma Import (C, pthread_sigmask, "pthread_sigmask");
+   pragma Import (C, pthread_sigmask, "sigprocmask");
+   --  pthread_sigmask maybe be broken due to mismatch between sigset_t and
+   --  kernel_sigset_t, substitute sigprocmask temporarily.  ???
+   --  pragma Import (C, pthread_sigmask, "pthread_sigmask");
 
    --------------------------
    -- POSIX.1c  Section 11 --
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index 26cfabb..ab9e89e 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -615,12 +615,14 @@ package System.Tasking is
       --  Protection: Only used by Activator
 
       Activator : Task_Id;
+      pragma Atomic (Activator);
       --  The task that created this task, either by declaring it as a task
       --  object or by executing a task allocator. The value is null iff Self
       --  has completed activation.
       --
-      --  Protection: Set by Activator before Self is activated, and only read
-      --  and modified by Self after that.
+      --  Protection: Set by Activator before Self is activated, and
+      --  only modified by Self after that. Can be read by any task via
+      --  Ada.Task_Identification.Activation_Is_Complete; hence Atomic.
 
       Wait_Count : Natural;
       --  This count is used by a task that is waiting for other tasks. At all
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index b6eb3fe..94ee841 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1312,18 +1312,19 @@ package body Sem is
       S_Outer_Gen_Scope   : constant Entity_Id        := Outer_Generic_Scope;
       S_Style_Check       : constant Boolean          := Style_Check;
 
+      Curunit : constant Unit_Number_Type := Get_Cunit_Unit_Number (Comp_Unit);
+      --  New value of Current_Sem_Unit
+
       Generic_Main : constant Boolean :=
-                       Nkind (Unit (Cunit (Main_Unit)))
-                         in N_Generic_Declaration;
+        Nkind (Unit (Cunit (Main_Unit))) in N_Generic_Declaration;
       --  If the main unit is generic, every compiled unit, including its
       --  context, is compiled with expansion disabled.
 
       Is_Main_Unit_Or_Main_Unit_Spec : constant Boolean :=
-         Current_Sem_Unit = Main_Unit
+         Curunit = Main_Unit
            or else
              (Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body
-               and then Library_Unit (Cunit (Main_Unit)) =
-                  Cunit (Current_Sem_Unit));
+               and then Library_Unit (Cunit (Main_Unit)) = Cunit (Curunit));
       --  Configuration flags have special settings when compiling a predefined
       --  file as a main unit. This applies to its spec as well.
 
@@ -1393,7 +1394,7 @@ package body Sem is
       end if;
 
       Compiler_State   := Analyzing;
-      Current_Sem_Unit := Get_Cunit_Unit_Number (Comp_Unit);
+      Current_Sem_Unit := Curunit;
 
       --  Compile predefined units with GNAT_Mode set to True, to properly
       --  process the categorization stuff. However, do not set GNAT_Mode
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index fdd1d0c..b737493 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6013,6 +6013,11 @@ package body Sem_Attr is
             Comp_Or_Discr := First_Entity (Typ);
             while Present (Comp_Or_Discr) loop
                if Chars (Comp_Or_Discr) = Comp_Name then
+
+                  --  Record component entity in the given aggregate choice,
+                  --  for subsequent resolution.
+
+                  Set_Entity (Comp, Comp_Or_Discr);
                   exit;
                end if;
 
@@ -6086,6 +6091,7 @@ package body Sem_Attr is
          Assoc := First (Component_Associations (E1));
          while Present (Assoc) loop
             Comp := First (Choices (Assoc));
+            Analyze (Expression (Assoc));
             while Present (Comp) loop
                if Nkind (Comp) = N_Others_Choice then
                   Error_Attr
@@ -8826,12 +8832,8 @@ package body Sem_Attr is
 
       --  Attribute Update is never static
 
-      ------------
-      -- Update --
-      ------------
-
       when Attribute_Update =>
-         null;
+         return;
 
       ---------------
       -- VADS_Size --
@@ -10409,6 +10411,57 @@ package body Sem_Attr is
 
          --  Processing is shared with Access
 
+         ------------
+         -- Update --
+         ------------
+
+         --  Resolve aggregate components in component associations
+
+         when Attribute_Update =>
+            declare
+               Aggr  : constant Node_Id   := First (Expressions (N));
+               Typ   : constant Entity_Id := Etype (Prefix (N));
+               Assoc : Node_Id;
+               Comp  : Node_Id;
+
+            begin
+               --  Set the Etype of the aggregate to that of the prefix, even
+               --  though the aggregate may not be a proper representation of a
+               --  value of the type (missing or duplicated associations, etc.)
+
+               Set_Etype (Aggr, Typ);
+
+               --  For an array type, resolve expressions with the component
+               --  type of the array.
+
+               if Is_Array_Type (Typ) then
+                  Assoc := First (Component_Associations (Aggr));
+                  while Present (Assoc) loop
+                     Resolve (Expression (Assoc), Component_Type (Typ));
+                     Next (Assoc);
+                  end loop;
+
+               --  For a record type, use type of each component, which is
+               --  recorded during analysis.
+
+               else
+                  Assoc := First (Component_Associations (Aggr));
+                  while Present (Assoc) loop
+                     Comp := First (Choices (Assoc));
+                     if Nkind (Comp) /= N_Others_Choice
+                       and then not Error_Posted (Comp)
+                     then
+                        Resolve (Expression (Assoc), Etype (Entity (Comp)));
+                     end if;
+                     Next (Assoc);
+                  end loop;
+               end if;
+            end;
+
+            --  Premature return requires comment ???
+
+            return;
+
          ---------
          -- Val --
          ---------
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 3fa6183..edfaff2 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2997,9 +2997,13 @@ package body Sem_Ch6 is
 
             --  Set SPARK_Mode
 
-            --  For internally generated subprogram, always off
+            --  For internally generated subprogram, always off. But generic
+            --  instances are not generated implicitly, so are never considered
+            --  as internal, even though Comes_From_Source is false.
 
-            if not Comes_From_Source (Spec_Id) then
+            if not Comes_From_Source (Spec_Id)
+              and then not Is_Generic_Instance (Spec_Id)
+            then
                SPARK_Mode := Off;
                SPARK_Mode_Pragma := Empty;
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 751ca29..989e3f1 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -10518,6 +10518,8 @@ package body Sem_Res is
       Drange        : constant Node_Id := Discrete_Range (N);
 
    begin
+      Index_Type := Base_Type (Etype (Drange));
+
       if Is_Entity_Name (Drange) then
          Index_Subtype := Entity (Drange);
 
@@ -10531,9 +10533,19 @@ package body Sem_Res is
          if Nkind (Drange) = N_Range then
             Force_Evaluation (Low_Bound (Drange));
             Force_Evaluation (High_Bound (Drange));
-         end if;
 
-         Index_Type := Base_Type (Etype (Drange));
+         --  If the discrete range is given by a subtype indication, the
+         --  type of the slice is the base of the subtype mark.
+
+         elsif Nkind (Drange) = N_Subtype_Indication then
+            declare
+               R : constant Node_Id := Range_Expression (Constraint (Drange));
+            begin
+               Index_Type := Base_Type (Entity (Subtype_Mark (Drange)));
+               Force_Evaluation (Low_Bound  (R));
+               Force_Evaluation (High_Bound (R));
+            end;
+         end if;
 
          Index_Subtype := Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);