[multiple changes]

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

	* checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting.

2014-01-21  Pascal Obry  <obry@adacore.com>

	* projects.texi: Minor typo fix.

2014-01-21  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Check_Component_Storage_Order): If a record type
	has an explicit Scalar_Storage_Order attribute definition clause,
	reject any component that itself is of a composite type and does
	not have one.

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

	* sem_ch10.adb (Generate_Parent_Reference): Make public so it
	can be used to generate proper cross-reference information for
	the parent units of proper bodies.

2014-01-21  Thomas Quinot  <quinot@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity): For a modular
	type that represents a bit packed array type, propagate the
	reverse storage order flag to the generated wrapper record.
	* exp_pakd.adb (Expand_Packed_Element_Set,
	Expand_Packed_Element_Reference): No byte swapping required in
	the front-end for the case of a reverse storage order array,
	as this is now handled uniformly in the back-end.  However we
	still need to swap back an extracted element if it is itself a
	nested composite with reverse storage order.

From-SVN: r206890

gcc/ada/ChangeLog

+2014-01-21  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting.
+	* gcc-interface/Makefile.in: clean up target pairs.
+
+2014-01-21  Pascal Obry  <obry@adacore.com>
+
+	* projects.texi: Minor typo fix.
+
+2014-01-21  Thomas Quinot  <quinot@adacore.com>
+
+	* freeze.adb (Check_Component_Storage_Order): If a record type
+	has an explicit Scalar_Storage_Order attribute definition clause,
+	reject any component that itself is of a composite type and does
+	not have one.
+
+2014-01-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch10.adb (Generate_Parent_Reference): Make public so it
+	can be used to generate proper cross-reference information for
+	the parent units of proper bodies.
+
+2014-01-21  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_pakd.adb (Expand_Packed_Element_Set,
+	Expand_Packed_Element_Reference): No byte swapping required in
+	the front-end for the case of a reverse storage order array,
+	as this is now handled uniformly in the back-end.  However we
+	still need to swap back an extracted element if it is itself a
+	nested composite with reverse storage order.
+
 2014-01-21  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Analyze_External_Property): Add processing for "others".

gcc/ada/exp_pakd.adb

@@ -1378,12 +1378,6 @@ package body Exp_Pakd is
       --  contains the value. Otherwise Rhs_Val_Known is set False, and
       --  the Rhs_Val is undefined.
 
-      Require_Byte_Swapping : Boolean := False;
-      --  True if byte swapping required, for the Reverse_Storage_Order case
-      --  when the packed array is a free-standing object. (If it is part
-      --  of a composite type, and therefore potentially not aligned on a byte
-      --  boundary, the swapping is done by the back-end).
-
       function Get_Shift return Node_Id;
       --  Function used to get the value of Shift, making sure that it
       --  gets duplicated if the function is called more than once.
@@ -1562,25 +1556,8 @@ package body Exp_Pakd is
          --  array type on Obj to get lost. So we save the type of Obj, and
          --  make sure it is reset properly.
 
-         declare
-            T : constant Entity_Id := Etype (Obj);
-         begin
-            New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
-            New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
-            Set_Etype (Obj, T);
-            Set_Etype (New_Lhs, T);
-            Set_Etype (New_Rhs, T);
-
-            if Reverse_Storage_Order (Base_Type (Atyp))
-              and then Esize (T) > 8
-              and then not In_Reverse_Storage_Order_Object (Obj)
-            then
-               Require_Byte_Swapping := True;
-               New_Rhs := Byte_Swap (New_Rhs,
-                            Left_Justify  => Bytes_Big_Endian,
-                            Right_Justify => not Bytes_Big_Endian);
-            end if;
-         end;
+         New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
+         New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
 
          --  First we deal with the "and"
 
@@ -1703,13 +1680,6 @@ package body Exp_Pakd is
                   Set_Etype (New_Rhs, Etype (Left_Opnd (New_Rhs)));
                end if;
 
-               --  If New_Rhs has been byte swapped, need to convert Or_Rhs
-               --  to the return type of the byte swapping function now.
-
-               if Require_Byte_Swapping then
-                  Or_Rhs := Unchecked_Convert_To (Etype (New_Rhs), Or_Rhs);
-               end if;
-
                New_Rhs :=
                  Make_Op_Or (Loc,
                    Left_Opnd  => New_Rhs,
@@ -1717,15 +1687,6 @@ package body Exp_Pakd is
             end;
          end if;
 
-         if Require_Byte_Swapping then
-            Set_Etype (New_Rhs, Etype (Obj));
-            New_Rhs :=
-              Unchecked_Convert_To (Etype (Obj),
-                Byte_Swap (New_Rhs,
-                             Left_Justify  => not Bytes_Big_Endian,
-                             Right_Justify => Bytes_Big_Endian));
-         end if;
-
          --  Now do the rewrite
 
          Rewrite (N,
@@ -2043,11 +2004,6 @@ package body Exp_Pakd is
       Lit   : Node_Id;
       Arg   : Node_Id;
 
-      Byte_Swapped : Boolean;
-      --  Set true if bytes were swapped for the purpose of extracting the
-      --  element, in which case we must swap back if the component type is
-      --  a composite type with reverse scalar storage order.
-
    begin
       --  If the node is an actual in a call, the prefix has not been fully
       --  expanded, to account for the additional expansion for in-out actuals
@@ -2106,23 +2062,6 @@ package body Exp_Pakd is
          Lit := Make_Integer_Literal (Loc, Cmask);
          Set_Print_In_Hex (Lit);
 
-         --  Byte swapping required for the Reverse_Storage_Order case, but
-         --  only for a free-standing object (see note on Require_Byte_Swapping
-         --  in Expand_Bit_Packed_Element_Set).
-
-         if Reverse_Storage_Order (Atyp)
-           and then Esize (Atyp) > 8
-           and then not In_Reverse_Storage_Order_Object (Obj)
-         then
-            Obj := Byte_Swap (Obj,
-                     Left_Justify  => Bytes_Big_Endian,
-                     Right_Justify => not Bytes_Big_Endian);
-            Byte_Swapped := True;
-
-         else
-            Byte_Swapped := False;
-         end if;
-
          --  We generate a shift right to position the field, followed by a
          --  masking operation to extract the bit field, and we finally do an
          --  unchecked conversion to convert the result to the required target.
@@ -2137,12 +2076,16 @@ package body Exp_Pakd is
            Make_Op_And (Loc,
              Left_Opnd  => Make_Shift_Right (Obj, Shift),
              Right_Opnd => Lit);
-
-         --  Swap back if necessary
-
          Set_Etype (Arg, Ctyp);
 
-         if Byte_Swapped
+         --  Component extraction is performed on a native endianness scalar
+         --  value: if Atyp has reverse storage order, then it has been byte
+         --  swapped, and if the component being extracted is itself of a
+         --  composite type with reverse storage order, then we need to swap
+         --  it back to its expected endianness after extraction.
+
+         if Reverse_Storage_Order (Atyp)
+           and then Esize (Atyp) > 8
            and then (Is_Record_Type (Ctyp) or else Is_Array_Type (Ctyp))
            and then Reverse_Storage_Order (Ctyp)
          then

gcc/ada/freeze.adb

@@ -1083,6 +1083,10 @@ package body Freeze is
       --  Set True for the record case, when Comp starts on a byte boundary
       --  (in which case it is allowed to have different storage order).
 
+      Comp_SSO_Differs  : Boolean;
+      --  Set True when the component is a nested composite, and it does not
+      --  have the same scalar storage order as Encl_Type.
+
       Component_Aliased : Boolean;
 
    begin
@@ -1136,28 +1140,42 @@ package body Freeze is
       --  attribute on Comp_Type if composite.
 
       elsif Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
+         Comp_SSO_Differs :=
+           Reverse_Storage_Order (Encl_Type)
+             /=
+           Reverse_Storage_Order (Comp_Type);
+
          if Present (Comp) and then Chars (Comp) = Name_uParent then
-            if Reverse_Storage_Order (Encl_Type)
-                 /=
-               Reverse_Storage_Order (Comp_Type)
-            then
+            if Comp_SSO_Differs then
                Error_Msg_N
                  ("record extension must have same scalar storage order as "
                   & "parent", Err_Node);
             end if;
 
-         elsif No (ADC) then
+         elsif No (Comp_ADC) then
             Error_Msg_N ("nested composite must have explicit scalar "
                          & "storage order", Err_Node);
 
-         elsif (Reverse_Storage_Order (Encl_Type)
-                  /=
-                Reverse_Storage_Order (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);
+         elsif Comp_SSO_Differs then
+
+            --  Component SSO differs from enclosing composite:
+
+            --  Reject if component is a packed array, as it may be represented
+            --  as a scalar internally.
+
+            if Is_Packed (Comp_Type) then
+               Error_Msg_N
+                 ("type of packed component must have same scalar "
+                  & "storage order as enclosing composite", Err_Node);
+
+            --  Reject if not byte aligned
+
+            elsif 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;
          end if;
 
       --  Enclosing type has explicit SSO, non-composite component must not

gcc/ada/gcc-interface/Makefile.in

@@ -562,8 +562,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
     s-vxwext.adb<s-vxwext-rtp.adb \
     s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
     system.ads<system-vxworks-$(ARCH_STR)-rtp.ads
-
-    EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
   else
     ifeq ($(strip $(filter-out rtp-smp,$(THREAD_KIND))),)
       LIBGNAT_TARGET_PAIRS += \
@@ -573,7 +571,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
       s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
       system.ads<system-vxworks-$(ARCH_STR)-rtp.ads
 
-      EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
       EXTRA_LIBGNAT_OBJS+=affinity.o
     else
       ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
@@ -603,7 +600,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
           system.ads<system-vxworks-ppc.ads
         endif
       endif
-      EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
+      EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
       EXTRA_LIBGNAT_OBJS+=sigtramp-ppcvxw.o
     endif
   endif
@@ -650,7 +647,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(target_cpu) $(target_vendor)
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
   indepsw.adb<indepsw-gnu.adb
 
-  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
+  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
   EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
 
   EXTRA_LIBGNAT_OBJS+=sigtramp-ppcvxw.o
@@ -714,7 +711,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(target_cpu) $(target_vendo
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
   indepsw.adb<indepsw-gnu.adb
 
-  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o s-vxwexc.o
+  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
   EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
 
   EXTRA_LIBGNAT_OBJS+=vx_stack_info.o sigtramp-ppcvxw.o
@@ -736,8 +733,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
   LIBGNAT_TARGET_PAIRS = \
   a-elchha.adb<a-elchha-vxworks-ppc-full.adb \
   a-intnam.ads<a-intnam-vxworks.ads \
-  a-sytaco.ads<1asytaco.ads \
-  a-sytaco.adb<1asytaco.adb \
+  a-numaux.ads<a-numaux-vxworks.ads \
   g-io.adb<g-io-vxworks-ppc-cert.adb \
   s-inmaop.adb<s-inmaop-vxworks.adb \
   s-interr.adb<s-interr-hwint.adb \
@@ -747,6 +743,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
   s-osinte.ads<s-osinte-vxworks.ads \
   s-osprim.adb<s-osprim-vxworks.adb \
   s-parame.ads<s-parame-ae653.ads \
+  s-parame.adb<s-parame-vxworks.adb \
   s-taprop.adb<s-taprop-vxworks.adb \
   s-tasinf.ads<s-tasinf-vxworks.ads \
   s-taspri.ads<s-taspri-vxworks.ads \
@@ -754,17 +751,20 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
   s-vxwext.adb<s-vxwext-noints.adb \
   s-vxwext.ads<s-vxwext-vthreads.ads \
   s-vxwork.ads<s-vxwork-x86.ads \
+  system.ads<system-vxworks-x86.ads \
   $(ATOMICS_TARGET_PAIRS) \
-  $(X86_TARGET_PAIRS) \
-  system.ads<system-vxworks-x86.ads
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS=\
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
   indepsw.adb<indepsw-gnu.adb
 
-  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
+  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
   EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
 
+  EXTRA_LIBGNAT_OBJS+=vx_stack_info.o # sigtramp-ppcvxw.o
+  GNATRTL_SOCKETS_OBJS =
+
   # Extra pairs for the vthreads runtime
   ifeq ($(strip $(filter-out vthreads,$(THREAD_KIND))),)
     LIBGNAT_TARGET_PAIRS += \
@@ -887,7 +887,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
     s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
     system.ads<system-vxworks-x86-rtp.ads
 
-    EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
   else
     ifeq ($(strip $(filter-out rtp-smp, $(THREAD_KIND))),)
       LIBGNAT_TARGET_PAIRS += \
@@ -897,7 +896,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
       s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
       system.ads<system-vxworks-x86-rtp.ads
 
-      EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
       EXTRA_LIBGNAT_OBJS+=affinity.o
     else
       ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
@@ -925,7 +923,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
         endif
       endif
 
-      EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
+      EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
     endif
   endif
   EXTRA_GNATRTL_TASKING_OBJS += s-vxwork.o s-vxwext.o
@@ -2421,7 +2419,7 @@ ADA_EXCLUDE_SRCS =\
   s-po32gl.adb s-po32gl.ads \
   s-stache.adb s-stache.ads \
   s-thread.ads \
-  s-vxwexc.adb s-vxwexc.ads s-vxwext.adb s-vxwext.ads \
+  s-vxwext.adb s-vxwext.ads \
   s-win32.ads  s-winext.ads \
   g-regist.adb g-regist.ads g-sse.ads    g-ssvety.ads \
   i-vxwoio.adb i-vxwoio.ads i-vxwork.ads \

gcc/ada/projects.texi

@@ -3171,8 +3171,8 @@ The following packages are currently supported in project files
   @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
   package @code{Builder}.
 @item ^Gnatls^Gnatls^
-  This package the options to use when invoking @command{gnatls} via the
-  @command{gnat} driver.
+  This package specifies the options to use when invoking @command{gnatls}
+  via the @command{gnat} driver.
 @item ^Gnatstub^Gnatstub^
   This package specifies the options used when calling the tool
   @command{gnatstub} via the @command{gnat} driver. Its attributes

gcc/ada/sem_ch10.adb

@@ -105,6 +105,11 @@ package body Sem_Ch10 is
    --  N is the compilation unit whose list of context items receives the
    --  implicit with_clauses.
 
+   procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);
+   --  Generate cross-reference information for the parents of child units
+   --  and of subunits. N is a defining_program_unit_name, and P_Id is the
+   --  immediate parent scope.
+
    function Get_Parent_Entity (Unit : Node_Id) return Entity_Id;
    --  Get defining entity of parent unit of a child unit. In most cases this
    --  is the defining entity of the unit, but for a child instance whose
@@ -261,10 +266,6 @@ package body Sem_Ch10 is
       --  Spec_Context_Items to that of the spec. Parent packages are not
       --  examined for documentation purposes.
 
-      procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);
-      --  Generate cross-reference information for the parents of child units.
-      --  N is a defining_program_unit_name, and P_Id is the immediate parent.
-
       ---------------------------
       -- Check_Redundant_Withs --
       ---------------------------
@@ -598,45 +599,6 @@ package body Sem_Ch10 is
          end loop;
       end Check_Redundant_Withs;
 
-      --------------------------------
-      -- Generate_Parent_References --
-      --------------------------------
-
-      procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id) is
-         Pref   : Node_Id;
-         P_Name : Entity_Id := P_Id;
-
-      begin
-         Pref := Name (Parent (Defining_Entity (N)));
-
-         if Nkind (Pref) = N_Expanded_Name then
-
-            --  Done already, if the unit has been compiled indirectly as
-            --  part of the closure of its context because of inlining.
-
-            return;
-         end if;
-
-         while Nkind (Pref) = N_Selected_Component loop
-            Change_Selected_Component_To_Expanded_Name (Pref);
-            Set_Entity (Pref, P_Name);
-            Set_Etype (Pref, Etype (P_Name));
-            Generate_Reference (P_Name, Pref, 'r');
-            Pref   := Prefix (Pref);
-            P_Name := Scope (P_Name);
-         end loop;
-
-         --  The guard here on P_Name is to handle the error condition where
-         --  the parent unit is missing because the file was not found.
-
-         if Present (P_Name) then
-            Set_Entity (Pref, P_Name);
-            Set_Etype (Pref, Etype (P_Name));
-            Generate_Reference (P_Name, Pref, 'r');
-            Style.Check_Identifier (Pref, P_Name);
-         end if;
-      end Generate_Parent_References;
-
    --  Start of processing for Analyze_Compilation_Unit
 
    begin
@@ -865,9 +827,9 @@ package body Sem_Ch10 is
          if Nkind (Defining_Unit_Name (Specification (Unit_Node))) =
                                              N_Defining_Program_Unit_Name
          then
-            Generate_Parent_References (
-              Specification (Unit_Node),
-                Scope (Defining_Entity (Unit (Lib_Unit))));
+            Generate_Parent_References
+              (Specification (Unit_Node),
+               Scope (Defining_Entity (Unit (Lib_Unit))));
          end if;
       end if;
 
@@ -906,8 +868,8 @@ package body Sem_Ch10 is
 
          --  Set the entities of all parents in the program_unit_name
 
-         Generate_Parent_References (
-           Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
+         Generate_Parent_References
+           (Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
       end if;
 
       --  All components of the context: with-clauses, library unit, ancestors
@@ -2326,6 +2288,7 @@ package body Sem_Ch10 is
          end if;
       end if;
 
+      Generate_Parent_References (Unit (N), Par_Unit);
       Analyze (Proper_Body (Unit (N)));
       Remove_Context (N);
 
@@ -3056,6 +3019,49 @@ package body Sem_Ch10 is
       end if;
    end Expand_With_Clause;
 
+   --------------------------------
+   -- Generate_Parent_References --
+   --------------------------------
+
+   procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id) is
+      Pref   : Node_Id;
+      P_Name : Entity_Id := P_Id;
+
+   begin
+      if Nkind (N) = N_Subunit then
+         Pref := Name (N);
+      else
+         Pref := Name (Parent (Defining_Entity (N)));
+      end if;
+
+      if Nkind (Pref) = N_Expanded_Name then
+
+         --  Done already, if the unit has been compiled indirectly as
+         --  part of the closure of its context because of inlining.
+
+         return;
+      end if;
+
+      while Nkind (Pref) = N_Selected_Component loop
+         Change_Selected_Component_To_Expanded_Name (Pref);
+         Set_Entity (Pref, P_Name);
+         Set_Etype (Pref, Etype (P_Name));
+         Generate_Reference (P_Name, Pref, 'r');
+         Pref   := Prefix (Pref);
+         P_Name := Scope (P_Name);
+      end loop;
+
+      --  The guard here on P_Name is to handle the error condition where
+      --  the parent unit is missing because the file was not found.
+
+      if Present (P_Name) then
+         Set_Entity (Pref, P_Name);
+         Set_Etype (Pref, Etype (P_Name));
+         Generate_Reference (P_Name, Pref, 'r');
+         Style.Check_Identifier (Pref, P_Name);
+      end if;
+   end Generate_Parent_References;
+
    -----------------------
    -- Get_Parent_Entity --
    -----------------------

gcc/ada/sem_ch4.adb

@@ -4652,15 +4652,16 @@ package body Sem_Ch4 is
                      Set_Etype (Sel, Etype (Comp));
                      Set_Etype (N,   Etype (Comp));
 
-                     --  Emit appropriate message. Gigi will replace the node
-                     --  subsequently with the appropriate Raise.
+                     --  Emit appropriate message. The node will be replaced
+                     --  by an appropriate raise statement.
 
-                     --  In SPARK mode, this is made into an error to simplify
-                     --  the processing of the formal verification backend.
+                     --  Note that in SPARK mode, as with all calls to apply a
+                     --  compile time constraint error, this will be made into
+                     --  an error to simplify the processing of the formal
+                     --  verification backend.
 
-                     Error_Msg_Warn := SPARK_Mode /= On;
                      Apply_Compile_Time_Constraint_Error
-                       (N, "component not present in }<<",
+                       (N, "component not present in }??",
                         CE_Discriminant_Check_Failed,
                         Ent => Prefix_Type, Rep => False);
 

gcc/ada/sem_util.ads

@@ -122,7 +122,7 @@ package Sem_Util is
    --  is present, this is used instead. Warn is normally False. If it is
    --  True then the message is treated as a warning even though it does
    --  not end with a ? (this is used when the caller wants to parameterize
-   --  whether an error or warning is given.
+   --  whether an error or warning is given).
 
    function Async_Readers_Enabled (Id : Entity_Id) return Boolean;
    --  Given the entity of an abstract state or a variable, determine whether