[multiple changes]

2016-04-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Build_Pragma_Check_Equivalent): The mapping
	that relates operations of the parent type to the operations of
	the derived type has three distinct sources:
	a) explicit operations of the derived type carry an
	Overridden_Operation that designates the operation in the
	ancestor.
	b) Implicit operations that are inherited by the derived type
	carry an alias that may be an explicit subprogram (in which case
	it may have an Overridden_ Operation indicator) or may also be
	inherited and carry its own alias.
	c) If the parent type is an interface, the operation of the
	derived type does not override, but the interface operation
	indicates the operation that implements it.
	* sem_prag.adb: Minor reformatting.
	* sem_prag.adb (Check_External_Property): Update
	the comment on usage. Reimplement.

2016-04-18  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Assignment_Statement): In restricted
	profiles such as ZFP, ceiling priority is not available.

2016-04-18  Bob Duff  <duff@adacore.com>

	* namet-sp.ads: Minor typo fix, ironically in 'Spelling_Checker'.

2016-04-18  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (Output_Calls): Use
	Get_Name_String, to clearly indicate that the global Name_Buffer
	is being used. The previous code used Is_Internal_Name, which
	returns a Boolean, but also has a side effect of setting the
	Name_Buffer. Then it called the other Is_Internal_Name, which uses
	the Name_Buffer for its input. And then it called Error_Msg_N,
	again using the Name_Buffer. We haven't eliminated the global
	usage here, but we've made it a bit clearer.
	This also allows us to have a side-effect-free version of
	Is_Internal_Name.
	* namet.ads, namet.adb: Provide a type Bounded_String, along with
	routines that can be used without using global variables. Provide
	Global_Name_Buffer so existing code can continue to use the
	global. Mark the routines that use globals as obsolete.  New code
	shouldn't call the obsolete ones, and we should clean up existing
	code from time to time.
	Name_Find_Str is renamed as Name_Find.
	* namet.h: Changed as necessary to interface to the new version
	of Namet.
	* bindgen.adb, exp_unst.adb: Name_Find_Str is renamed as
	Name_Find.

From-SVN: r235123

gcc/ada/ChangeLog

+2016-04-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Build_Pragma_Check_Equivalent): The mapping
+	that relates operations of the parent type to the operations of
+	the derived type has three distinct sources:
+	a) explicit operations of the derived type carry an
+	Overridden_Operation that designates the operation in the
+	ancestor.
+	b) Implicit operations that are inherited by the derived type
+	carry an alias that may be an explicit subprogram (in which case
+	it may have an Overridden_ Operation indicator) or may also be
+	inherited and carry its own alias.
+	c) If the parent type is an interface, the operation of the
+	derived type does not override, but the interface operation
+	indicates the operation that implements it.
+	* sem_prag.adb: Minor reformatting.
+	* sem_prag.adb (Check_External_Property): Update
+	the comment on usage. Reimplement.
+
+2016-04-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_Assignment_Statement): In restricted
+	profiles such as ZFP, ceiling priority is not available.
+
+2016-04-18  Bob Duff  <duff@adacore.com>
+
+	* namet-sp.ads: Minor typo fix, ironically in 'Spelling_Checker'.
+
+2016-04-18  Bob Duff  <duff@adacore.com>
+
+	* sem_elab.adb (Output_Calls): Use
+	Get_Name_String, to clearly indicate that the global Name_Buffer
+	is being used. The previous code used Is_Internal_Name, which
+	returns a Boolean, but also has a side effect of setting the
+	Name_Buffer. Then it called the other Is_Internal_Name, which uses
+	the Name_Buffer for its input. And then it called Error_Msg_N,
+	again using the Name_Buffer. We haven't eliminated the global
+	usage here, but we've made it a bit clearer.
+	This also allows us to have a side-effect-free version of
+	Is_Internal_Name.
+	* namet.ads, namet.adb: Provide a type Bounded_String, along with
+	routines that can be used without using global variables. Provide
+	Global_Name_Buffer so existing code can continue to use the
+	global. Mark the routines that use globals as obsolete.  New code
+	shouldn't call the obsolete ones, and we should clean up existing
+	code from time to time.
+	Name_Find_Str is renamed as Name_Find.
+	* namet.h: Changed as necessary to interface to the new version
+	of Namet.
+	* bindgen.adb, exp_unst.adb: Name_Find_Str is renamed as
+	Name_Find.
+
 2016-04-18  Yannick Moy  <moy@adacore.com>
 
 	* sem_util.adb, sem_util.ads (Has_Full_Default_Initialization): used

gcc/ada/bindgen.adb

@@ -2922,7 +2922,7 @@ package body Bindgen is
          Osint.Fail ("bind environment value """ & Value & """ too long");
       end if;
 
-      Bind_Environment.Set (Name_Find_Str (Key), Name_Find_Str (Value));
+      Bind_Environment.Set (Name_Find (Key), Name_Find (Value));
    end Set_Bind_Env;
 
    -----------------

gcc/ada/exp_ch5.adb

@@ -1693,9 +1693,10 @@ package body Exp_Ch5 is
 
             --  The attribute Priority applied to protected objects has been
             --  previously expanded into a call to the Get_Ceiling run-time
-            --  subprogram.
+            --  subprogram. In restricted profiles this is not available.
 
             if Nkind (Ent) = N_Function_Call
+              and then RTE_Available (RE_Get_Ceiling)
               and then (Entity (Name (Ent)) = RTE (RE_Get_Ceiling)
                           or else
                         Entity (Name (Ent)) = RTE (RO_PE_Get_Ceiling))

gcc/ada/exp_unst.adb

@@ -161,7 +161,7 @@ package body Exp_Unst is
 
       function AREC_Name (J : Pos; S : String) return Name_Id is
       begin
-         return Name_Find_Str ("AREC" & Img_Pos (J) & S);
+         return Name_Find ("AREC" & Img_Pos (J) & S);
       end AREC_Name;
 
       --------------------
@@ -244,7 +244,7 @@ package body Exp_Unst is
             if No (C) then
                return Chars (Ent);
             elsif Chars (Defining_Identifier (C)) = Chars (Ent) then
-               return Name_Find_Str
+               return Name_Find
                         (Get_Name_String (Chars (Ent)) & Img_Pos (Index));
             else
                Next (C);

gcc/ada/namet-sp.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-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- --
@@ -31,7 +31,7 @@
 
 --  This child package contains a spell checker for Name_Id values. It is
 --  separated off as a child package, because of the extra dependencies,
---  in particular on GNAT.UTF_32_ Spelling_Checker. There are a number of
+--  in particular on GNAT.UTF_32_Spelling_Checker. There are a number of
 --  packages that use Namet that do not need the spell checking feature,
 --  and this separation helps in dealing with older versions of GNAT.
 

gcc/ada/namet.h

@@ -25,7 +25,7 @@
 
 /* This is the C file that corresponds to the Ada package specification
    Namet.  It was created manually from files namet.ads and namet.adb.
-   Some subprograms from Sinput are also made acessable here.  */
+   Some subprograms from Sinput are also made accessible here.  */
 
 #ifdef __cplusplus
 extern "C" {
@@ -52,16 +52,26 @@ extern struct Name_Entry *Names_Ptr;
 #define Name_Chars_Ptr namet__name_chars__table
 extern char *Name_Chars_Ptr;
 
-#define Name_Buffer namet__name_buffer
-extern char Name_Buffer[];
+/* The global name buffer. */
+struct Bounded_String
+{
+  Nat Max_Length;
+  Nat Length;
+  char Chars[1];
+  /* The 1 here is wrong, but it doesn't matter, because all the code either
+     goes by Length, or NUL-terminates the string before processing it. */
+};
+
+#define Global_Name_Buffer namet__global_name_buffer
+extern struct Bounded_String Global_Name_Buffer;
 
-extern Int namet__name_len;
-#define Name_Len namet__name_len
+#define Name_Buffer Global_Name_Buffer.Chars
+#define Name_Len Global_Name_Buffer.Length
 
-/* Get_Name_String returns a null terminated C string for the specified name.
+/* Get_Name_String returns a NUL terminated C string for the specified name.
    We could use the official Ada routine for this purpose, but since the
    strings we want are sitting in the name strings table in exactly the form
-   we need them (null terminated), we just point to the name directly. */
+   we need them (NUL terminated), we just point to the name directly. */
 
 static char *Get_Name_String (Name_Id);
 

gcc/ada/sem_elab.adb

@@ -3287,11 +3287,11 @@ package body Sem_Elab is
       --  Determine whether to emit an error message based on the combination
       --  of flags Check_Elab_Flag and Flag.
 
-      function Is_Printable_Error_Name (Nm : Name_Id) return Boolean;
-      --  An internal function, used to determine if a name, Nm, is either
-      --  a non-internal name, or is an internal name that is printable
-      --  by the error message circuits (i.e. it has a single upper
-      --  case letter at the end).
+      function Is_Printable_Error_Name return Boolean;
+      --  An internal function, used to determine if a name, stored in the
+      --  Name_Buffer, is either a non-internal name, or is an internal name
+      --  that is printable by the error message circuits (i.e. it has a single
+      --  upper case letter at the end).
 
       ----------
       -- Emit --
@@ -3310,9 +3310,9 @@ package body Sem_Elab is
       -- Is_Printable_Error_Name --
       -----------------------------
 
-      function Is_Printable_Error_Name (Nm : Name_Id) return Boolean is
+      function Is_Printable_Error_Name return Boolean is
       begin
-         if not Is_Internal_Name (Nm) then
+         if not Is_Internal_Name then
             return True;
 
          elsif Name_Len = 1 then
@@ -3335,6 +3335,7 @@ package body Sem_Elab is
          Error_Msg_Sloc := Elab_Call.Table (J).Cloc;
 
          Ent := Elab_Call.Table (J).Ent;
+         Get_Name_String (Chars (Ent));
 
          --  Dynamic elaboration model, warnings controlled by -gnatwl
 
@@ -3344,7 +3345,7 @@ package body Sem_Elab is
                   Error_Msg_NE ("\\?l?& instantiated #", N, Ent);
                elsif Is_Init_Proc (Ent) then
                   Error_Msg_N ("\\?l?initialization procedure called #", N);
-               elsif Is_Printable_Error_Name (Chars (Ent)) then
+               elsif Is_Printable_Error_Name then
                   Error_Msg_NE ("\\?l?& called #", N, Ent);
                else
                   Error_Msg_N ("\\?l?called #", N);
@@ -3359,7 +3360,7 @@ package body Sem_Elab is
                   Error_Msg_NE ("\\?$?& instantiated #", N, Ent);
                elsif Is_Init_Proc (Ent) then
                   Error_Msg_N ("\\?$?initialization procedure called #", N);
-               elsif Is_Printable_Error_Name (Chars (Ent)) then
+               elsif Is_Printable_Error_Name then
                   Error_Msg_NE ("\\?$?& called #", N, Ent);
                else
                   Error_Msg_N ("\\?$?called #", N);

gcc/ada/sem_prag.adb

@@ -25188,9 +25188,10 @@ package body Sem_Prag is
             Enabled  : Boolean;
             Constit  : Entity_Id);
          --  Determine whether a property denoted by name Prop_Nam is present
-         --  in both the refined state and constituent Constit. Flag Enabled
-         --  should be set when the property applies to the refined state. If
-         --  this is not the case, emit an error message.
+         --  in the refined state. Emit an error if this is not the case. Flag
+         --  Enabled should be set when the property applies to the refined
+         --  state. Constit denotes the constituent (if any) which introduces
+         --  the property in the refinement.
 
          procedure Match_State;
          --  Determine whether the state being refined appears in list
@@ -25511,27 +25512,21 @@ package body Sem_Prag is
             Constit  : Entity_Id)
          is
          begin
-            Error_Msg_Name_1 := Prop_Nam;
-
-            --  The property is enabled in the related Abstract_State pragma
-            --  that defines the state (SPARK RM 7.2.8(2)).
-
-            if Enabled then
-               if No (Constit) then
-                  SPARK_Msg_NE
-                    ("external state & requires at least one constituent with "
-                     & "property %", State, State_Id);
-               end if;
-
             --  The property is missing in the declaration of the state, but
             --  a constituent is introducing it in the state refinement
             --  (SPARK RM 7.2.8(2)).
 
-            elsif Present (Constit) then
-               Error_Msg_Name_2 := Chars (Constit);
+            if not Enabled and then Present (Constit) then
+               Error_Msg_Name_1 := Prop_Nam;
+               Error_Msg_Name_2 := Chars (State_Id);
                SPARK_Msg_NE
-                 ("external state & lacks property % set by constituent %",
-                  State, State_Id);
+                 ("constituent & introduces external property % in refinement "
+                  & "of state %", State, Constit);
+
+               Error_Msg_Sloc := Sloc (State_Id);
+               SPARK_Msg_N
+                 ("\property is missing in abstract state declaration #",
+                  State);
             end if;
          end Check_External_Property;
 
@@ -25746,10 +25741,8 @@ package body Sem_Prag is
             Analyze_Constituent (Constit);
          end if;
 
-         --  The set of properties that all external constituents yield must
-         --  match that of the refined state. There are two cases to detect:
-         --  the refined state lacks a property or has an extra property
-         --  (SPARK RM 7.2.8(2)).
+         --  Verify that external constituents do not introduce new external
+         --  property in the state refinement (SPARK RM 7.2.8(2)).
 
          if Is_External_State (State_Id) then
             Check_External_Property
@@ -26050,14 +26043,20 @@ package body Sem_Prag is
             if Present (New_E) then
                Rewrite (N, New_Occurrence_Of (New_E, Sloc (N)));
             end if;
-         end if;
 
-         if not Is_Abstract_Subprogram (Inher_Id)
-           and then Nkind (N) = N_Function_Call
-           and then Present (Entity (Name (N)))
-           and then Is_Abstract_Subprogram (Entity (Name (N)))
+            --  Check that there are no calls left to abstract operations
+            --  if the current subprogram is not abstract.
+
+            if Nkind (Parent (N)) = N_Function_Call
+              and then N = Name (Parent (N))
+              and then not Is_Abstract_Subprogram (Subp_Id)
+              and then Is_Abstract_Subprogram (Entity (N))
             then
-            Error_Msg_N ("cannot call abstract subprogram", N);
+               Error_Msg_Sloc := Sloc (Current_Scope);
+               Error_Msg_NE
+                 ("cannot call abstract subprogram in inherited condition "
+                   & "for&#", N, Current_Scope);
+            end if;
 
          --  The whole expression will be reanalyzed
 
@@ -26140,13 +26139,47 @@ package body Sem_Prag is
          --  operations of the descendant. Note that the descendant type may
          --  not be frozen yet, so we cannot use the dispatch table directly.
 
-         declare
+         --  Note : the construction of the map involves a full traversal of
+         --  the list of primitive operations, as well as a scan of the
+         --  declarations in the scope of the operation. Given that class-wide
+         --  conditions are typically short expressions, it might be much more
+         --  efficient to collect the identifiers in the expression first, and
+         --  then determine the ones that have to be mapped. Optimization ???
+
+         Primitive_Mapping : declare
+            function Overridden_Ancestor (S : Entity_Id) return Entity_Id;
+            --  Given the controlling type of the overridden operation and a
+            --  primitive of the current type, find the corresponding operation
+            --  of the parent type.
+
+            -------------------------
+            -- Overridden_Ancestor --
+            -------------------------
+
+            function Overridden_Ancestor (S : Entity_Id) return Entity_Id is
+               Anc : Entity_Id;
+
+            begin
+               Anc := S;
+               while Present (Overridden_Operation (Anc)) loop
+                  exit when Scope (Anc) = Scope (Inher_Id);
+                  Anc := Overridden_Operation (Anc);
+               end loop;
+
+               return Anc;
+            end Overridden_Ancestor;
+
+            --  Local variables
+
             Old_Typ  : constant Entity_Id := Find_Dispatching_Type (Inher_Id);
             Typ      : constant Entity_Id := Find_Dispatching_Type (Subp_Id);
             Decl     : Node_Id;
+            Old_Elmt : Elmt_Id;
             Old_Prim : Entity_Id;
             Prim     : Entity_Id;
 
+         --  Start of processing for Primitive_Mapping
+
          begin
             Decl := First (List_Containing (Unit_Declaration_Node (Subp_Id)));
 
@@ -26163,12 +26196,7 @@ package body Sem_Prag is
                     and then Present (Overridden_Operation (Prim))
                     and then Find_Dispatching_Type (Prim) = Typ
                   then
-                     Old_Prim := Overridden_Operation (Prim);
-                     while Present (Overridden_Operation (Old_Prim))
-                       and then Scope (Old_Prim) /= Scope (Inher_Id)
-                     loop
-                        Old_Prim := Overridden_Operation (Old_Prim);
-                     end loop;
+                     Old_Prim := Overridden_Ancestor (Prim);
 
                      Append_Elmt (Old_Prim, Map);
                      Append_Elmt (Prim,     Map);
@@ -26178,6 +26206,13 @@ package body Sem_Prag is
                Next (Decl);
             end loop;
 
+            --  Now examine inherited operations. These do not override, but
+            --  have an alias, which is the entity used in a call. In turn
+            --  that alias may be inherited or comes from source, in which
+            --  case it may override an earlier operation. We only need to
+            --  examine inherited functions, that may appear within the
+            --  inherited expression.
+
             Prim := First_Entity (Scope (Subp_Id));
             while Present (Prim) loop
                if not Comes_From_Source (Prim)
@@ -26185,11 +26220,22 @@ package body Sem_Prag is
                  and then Present (Alias (Prim))
                then
                   Old_Prim := Alias (Prim);
+
+                  if Comes_From_Source (Old_Prim) then
+                     Old_Prim := Overridden_Ancestor (Old_Prim);
+
+                  else
                      while Present (Alias (Old_Prim))
                        and then Scope (Old_Prim) /= Scope (Inher_Id)
                      loop
                         Old_Prim := Alias (Old_Prim);
+
+                        if Comes_From_Source (Old_Prim) then
+                           Old_Prim := Overridden_Ancestor (Old_Prim);
+                           exit;
+                        end if;
                      end loop;
+                  end if;
 
                   Append_Elmt (Old_Prim, Map);
                   Append_Elmt (Prim,     Map);
@@ -26198,11 +26244,31 @@ package body Sem_Prag is
                Next_Entity (Prim);
             end loop;
 
+            --  If the parent operation is an interface operation, the
+            --  overriding indicator is not present. Instead, we get from
+            --  the interface operation the primitive of the current type
+            --  that implements it.
+
+            if Is_Interface (Old_Typ) then
+               Old_Elmt := First_Elmt (Collect_Primitive_Operations (Old_Typ));
+               while Present (Old_Elmt) loop
+                  Old_Prim := Node (Old_Elmt);
+                  Prim := Find_Primitive_Covering_Interface (Typ, Old_Prim);
+
+                  if Present (Prim) then
+                     Append_Elmt (Old_Prim, Map);
+                     Append_Elmt (Prim,     Map);
+                  end if;
+
+                  Next_Elmt (Old_Elmt);
+               end loop;
+            end if;
+
             if Map /= No_Elist then
                Append_Elmt (Old_Typ, Map);
                Append_Elmt (Typ,     Map);
             end if;
-         end;
+         end Primitive_Mapping;
       end if;
 
       --  Copy the original pragma while performing substitutions (if