From 84c0a895d4fd336f1119370c72800e43ac487ff2 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 29 Jul 2014 15:26:20 +0200 Subject: [PATCH] [multiple changes] 2014-07-29 Ed Schonberg * 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 * 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 --- gcc/ada/ChangeLog | 15 +++++++++++++++ gcc/ada/gnat_rm.texi | 6 +++--- gcc/ada/sem_ch13.adb | 33 +++++++++++++++++++++++++-------- gcc/ada/sem_ch6.adb | 34 +++++++++++++++------------------- 4 files changed, 58 insertions(+), 30 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d85f4872978..1b7701c75f2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2014-07-29 Ed Schonberg + + * 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 + + * 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 * 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 3319bd7b487..7043f134c84 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 35f4f8a6fcb..e63d4dde263 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 1f3a4c50dd7..b80c497319a 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; -- 2.30.2