[multiple changes]

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Return_Subtype_Indication): Reject a return
	subtype indication in an extended return statement when the
	return value is an ancestor of the return type of the function,
	and that return type is a null record extension.

2014-07-29  Thomas Quinot  <quinot@adacore.com>

	* sem_ch13.adb (Rep_Item_Too_Late): Specialize/clarify error
	message produced for the case of a type-related representation
	item that is made illegal by 13.10(1).
	* gnat_rm.texi (Scalar_Storage_Order): Minor change in
	documentation.

From-SVN: r213173

4 files changed, 58 insertions, 30 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d85f487..1b7701c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Check_Return_Subtype_Indication): Reject a return
+	subtype indication in an extended return statement when the
+	return value is an ancestor of the return type of the function,
+	and that return type is a null record extension.
+
+2014-07-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch13.adb (Rep_Item_Too_Late): Specialize/clarify error
+	message produced for the case of a type-related representation
+	item that is made illegal by 13.10(1).
+	* gnat_rm.texi (Scalar_Storage_Order): Minor change in
+	documentation.
+
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
 	* gnat_ugn.texi: Add section on Wide_Wide_Character encodings.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 3319bd7..7043f13 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -9419,8 +9419,8 @@ of the use of this feature:
 Other properties are as for standard representation attribute @code{Bit_Order},
 as defined by Ada RM 13.5.3(4). The default is @code{System.Default_Bit_Order}.
 
-For a record type @var{S}, if @code{@var{S}'Scalar_Storage_Order} is
-specified explicitly, it shall be equal to @code{@var{S}'Bit_Order}. Note:
+For a record type @var{T}, if @code{@var{T}'Scalar_Storage_Order} is
+specified explicitly, it shall be equal to @code{@var{T}'Bit_Order}. Note:
 this means that if a @code{Scalar_Storage_Order} attribute definition
 clause is not confirming, then the type's @code{Bit_Order} shall be
 specified explicitly and set to the same value.
@@ -9430,7 +9430,7 @@ types. This may be overridden for the derived type by giving an explicit scalar
 storage order for the derived type. For a record extension, the derived type
 must have the same scalar storage order as the parent type.
 
-If a component of @var{S} is of a record or array type, then that type must
+If a component of @var{T} is of a record or array type, then that type must
 also have a @code{Scalar_Storage_Order} attribute definition clause.
 
 A component of a record or array type that is a packed array, or that
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 35f4f8a..e63d4dd 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -11064,10 +11064,25 @@ package body Sem_Ch13 is
       S           : Entity_Id;
       Parent_Type : Entity_Id;
 
+      procedure No_Type_Rep_Item;
+      --  Output message indicating that no type-related aspects can be
+      --  specified due to some property of the parent type.
+
       procedure Too_Late;
-      --  Output the too late message. Note that this is not considered a
-      --  serious error, since the effect is simply that we ignore the
-      --  representation clause in this case.
+      --  Output message for an aspect being specified too late
+
+      --  Note that neither of the above errors is considered a serious one,
+      --  since the effect is simply that we ignore the representation clause
+      --  in these cases.
+
+      ----------------------
+      -- No_Type_Rep_Item --
+      ----------------------
+
+      procedure No_Type_Rep_Item is
+      begin
+         Error_Msg_N ("|type-related representation item not permitted!", N);
+      end No_Type_Rep_Item;
 
       --------------
       -- Too_Late --
@@ -11114,7 +11129,9 @@ package body Sem_Ch13 is
          return True;
 
       --  Check for case of non-tagged derived type whose parent either has
-      --  primitive operations, or is a by reference type (RM 13.1(10)).
+      --  primitive operations, or is a by reference type (RM 13.1(10)). In
+      --  this case we do not output a Too_Late message, since there is no
+      --  earlier point where the rep item could be placed to make it legal.
 
       elsif Is_Type (T)
         and then not FOnly
@@ -11124,15 +11141,15 @@ package body Sem_Ch13 is
          Parent_Type := Etype (Base_Type (T));
 
          if Has_Primitive_Operations (Parent_Type) then
-            Too_Late;
+            No_Type_Rep_Item;
             Error_Msg_NE
-              ("primitive operations already defined for&!", N, Parent_Type);
+              ("\parent type & has primitive operations!", N, Parent_Type);
             return True;
 
          elsif Is_By_Reference_Type (Parent_Type) then
-            Too_Late;
+            No_Type_Rep_Item;
             Error_Msg_NE
-              ("parent type & is a by reference type!", N, Parent_Type);
+              ("\parent type & is a by reference type!", N, Parent_Type);
             return True;
          end if;
       end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 1f3a4c5..b80c497 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -811,10 +811,9 @@ package body Sem_Ch6 is
                end if;
             end if;
 
-         elsif Etype (Base_Type (R_Type)) = R_Stm_Type
-           and then Is_Null_Extension (Base_Type (R_Type))
-         then
-            null;
+            --  Previous versions of this subprogram allowed the return value
+            --  to be the ancestor of the return type if the return type was
+            --  a null extension.  This was plainly incorrect.
 
          else
             Error_Msg_N
@@ -10631,7 +10630,6 @@ package body Sem_Ch6 is
       is
          AO : constant Entity_Id := Alias (Old_E);
          AN : constant Entity_Id := Alias (New_E);
-
       begin
          return Scope (AO) /= Scope (AN)
            or else No (DTC_Entity (AO))
@@ -10847,7 +10845,7 @@ package body Sem_Ch6 is
                             or else Is_Abstract_Subprogram (S)
                             or else
                               (Is_Dispatching_Operation (E)
-                                 and then Is_Overriding_Alias (E, S)))
+                                and then Is_Overriding_Alias (E, S)))
                  and then Ekind (E) /= E_Enumeration_Literal
                then
                   --  When an derived operation is overloaded it may be due to
@@ -11505,8 +11503,8 @@ package body Sem_Ch6 is
               and then Is_Access_Constant (Etype (Default))
             then
                Error_Msg_N
-                 ("formal that is access to variable cannot be initialized " &
-                    "with an access-to-constant expression", Default);
+                 ("formal that is access to variable cannot be initialized "
+                  & "with an access-to-constant expression", Default);
             end if;
 
             --  Check that the designated type of an access parameter's default
@@ -11700,11 +11698,11 @@ package body Sem_Ch6 is
    -------------------------
 
    procedure Set_Actual_Subtypes (N : Node_Id; Subp : Entity_Id) is
-      Decl           : Node_Id;
-      Formal         : Entity_Id;
-      T              : Entity_Id;
-      First_Stmt     : Node_Id := Empty;
-      AS_Needed      : Boolean;
+      Decl       : Node_Id;
+      Formal     : Entity_Id;
+      T          : Entity_Id;
+      First_Stmt : Node_Id := Empty;
+      AS_Needed  : Boolean;
 
    begin
       --  If this is an empty initialization procedure, no need to create
@@ -11991,7 +11989,6 @@ package body Sem_Ch6 is
       Result : Boolean;
    begin
       May_Hide_Profile := False;
-
       Check_Conformance
         (New_Id, Old_Id, Type_Conformant, False, Result,
          Skip_Controlling_Formals => Skip_Controlling_Formals);
@@ -12020,12 +12017,11 @@ package body Sem_Ch6 is
 
          --  For function instantiations that are operators, we must check
          --  separately that the corresponding generic only has in-parameters.
-         --  For subprogram declarations this is done in Set_Formal_Mode.
-         --  Such an error could not arise in earlier versions of the language.
+         --  For subprogram declarations this is done in Set_Formal_Mode. Such
+         --  an error could not arise in earlier versions of the language.
 
          elsif Ekind (F) /= E_In_Parameter then
-            Error_Msg_N
-              ("operators can only have IN parameters", F);
+            Error_Msg_N ("operators can only have IN parameters", F);
          end if;
 
          Next_Formal (F);
@@ -12058,7 +12054,7 @@ package body Sem_Ch6 is
         and then not Is_Intrinsic_Subprogram (Designator)
       then
          Error_Msg_N
-            ("explicit definition of inequality not allowed", Designator);
+           ("explicit definition of inequality not allowed", Designator);
       end if;
    end Valid_Operator_Definition;