Commit 84c0a895 by Arnaud Charlet

[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
parent 7a2c2277
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> 2014-07-29 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Add section on Wide_Wide_Character encodings. * gnat_ugn.texi: Add section on Wide_Wide_Character encodings.
......
...@@ -9419,8 +9419,8 @@ of the use of this feature: ...@@ -9419,8 +9419,8 @@ of the use of this feature:
Other properties are as for standard representation attribute @code{Bit_Order}, 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}. 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 For a record type @var{T}, if @code{@var{T}'Scalar_Storage_Order} is
specified explicitly, it shall be equal to @code{@var{S}'Bit_Order}. Note: specified explicitly, it shall be equal to @code{@var{T}'Bit_Order}. Note:
this means that if a @code{Scalar_Storage_Order} attribute definition this means that if a @code{Scalar_Storage_Order} attribute definition
clause is not confirming, then the type's @code{Bit_Order} shall be clause is not confirming, then the type's @code{Bit_Order} shall be
specified explicitly and set to the same value. 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 ...@@ -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 storage order for the derived type. For a record extension, the derived type
must have the same scalar storage order as the parent 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. 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 A component of a record or array type that is a packed array, or that
......
...@@ -11064,10 +11064,25 @@ package body Sem_Ch13 is ...@@ -11064,10 +11064,25 @@ package body Sem_Ch13 is
S : Entity_Id; S : Entity_Id;
Parent_Type : 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; procedure Too_Late;
-- Output the too late message. Note that this is not considered a -- Output message for an aspect being specified too late
-- serious error, since the effect is simply that we ignore the
-- representation clause in this case. -- 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 -- -- Too_Late --
...@@ -11114,7 +11129,9 @@ package body Sem_Ch13 is ...@@ -11114,7 +11129,9 @@ package body Sem_Ch13 is
return True; return True;
-- Check for case of non-tagged derived type whose parent either has -- 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) elsif Is_Type (T)
and then not FOnly and then not FOnly
...@@ -11124,15 +11141,15 @@ package body Sem_Ch13 is ...@@ -11124,15 +11141,15 @@ package body Sem_Ch13 is
Parent_Type := Etype (Base_Type (T)); Parent_Type := Etype (Base_Type (T));
if Has_Primitive_Operations (Parent_Type) then if Has_Primitive_Operations (Parent_Type) then
Too_Late; No_Type_Rep_Item;
Error_Msg_NE Error_Msg_NE
("primitive operations already defined for&!", N, Parent_Type); ("\parent type & has primitive operations!", N, Parent_Type);
return True; return True;
elsif Is_By_Reference_Type (Parent_Type) then elsif Is_By_Reference_Type (Parent_Type) then
Too_Late; No_Type_Rep_Item;
Error_Msg_NE 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; return True;
end if; end if;
end if; end if;
......
...@@ -811,10 +811,9 @@ package body Sem_Ch6 is ...@@ -811,10 +811,9 @@ package body Sem_Ch6 is
end if; end if;
end if; end if;
elsif Etype (Base_Type (R_Type)) = R_Stm_Type -- Previous versions of this subprogram allowed the return value
and then Is_Null_Extension (Base_Type (R_Type)) -- to be the ancestor of the return type if the return type was
then -- a null extension. This was plainly incorrect.
null;
else else
Error_Msg_N Error_Msg_N
...@@ -10631,7 +10630,6 @@ package body Sem_Ch6 is ...@@ -10631,7 +10630,6 @@ package body Sem_Ch6 is
is is
AO : constant Entity_Id := Alias (Old_E); AO : constant Entity_Id := Alias (Old_E);
AN : constant Entity_Id := Alias (New_E); AN : constant Entity_Id := Alias (New_E);
begin begin
return Scope (AO) /= Scope (AN) return Scope (AO) /= Scope (AN)
or else No (DTC_Entity (AO)) or else No (DTC_Entity (AO))
...@@ -10847,7 +10845,7 @@ package body Sem_Ch6 is ...@@ -10847,7 +10845,7 @@ package body Sem_Ch6 is
or else Is_Abstract_Subprogram (S) or else Is_Abstract_Subprogram (S)
or else or else
(Is_Dispatching_Operation (E) (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 and then Ekind (E) /= E_Enumeration_Literal
then then
-- When an derived operation is overloaded it may be due to -- When an derived operation is overloaded it may be due to
...@@ -11505,8 +11503,8 @@ package body Sem_Ch6 is ...@@ -11505,8 +11503,8 @@ package body Sem_Ch6 is
and then Is_Access_Constant (Etype (Default)) and then Is_Access_Constant (Etype (Default))
then then
Error_Msg_N Error_Msg_N
("formal that is access to variable cannot be initialized " & ("formal that is access to variable cannot be initialized "
"with an access-to-constant expression", Default); & "with an access-to-constant expression", Default);
end if; end if;
-- Check that the designated type of an access parameter's default -- Check that the designated type of an access parameter's default
...@@ -11700,11 +11698,11 @@ package body Sem_Ch6 is ...@@ -11700,11 +11698,11 @@ package body Sem_Ch6 is
------------------------- -------------------------
procedure Set_Actual_Subtypes (N : Node_Id; Subp : Entity_Id) is procedure Set_Actual_Subtypes (N : Node_Id; Subp : Entity_Id) is
Decl : Node_Id; Decl : Node_Id;
Formal : Entity_Id; Formal : Entity_Id;
T : Entity_Id; T : Entity_Id;
First_Stmt : Node_Id := Empty; First_Stmt : Node_Id := Empty;
AS_Needed : Boolean; AS_Needed : Boolean;
begin begin
-- If this is an empty initialization procedure, no need to create -- If this is an empty initialization procedure, no need to create
...@@ -11991,7 +11989,6 @@ package body Sem_Ch6 is ...@@ -11991,7 +11989,6 @@ package body Sem_Ch6 is
Result : Boolean; Result : Boolean;
begin begin
May_Hide_Profile := False; May_Hide_Profile := False;
Check_Conformance Check_Conformance
(New_Id, Old_Id, Type_Conformant, False, Result, (New_Id, Old_Id, Type_Conformant, False, Result,
Skip_Controlling_Formals => Skip_Controlling_Formals); Skip_Controlling_Formals => Skip_Controlling_Formals);
...@@ -12020,12 +12017,11 @@ package body Sem_Ch6 is ...@@ -12020,12 +12017,11 @@ package body Sem_Ch6 is
-- For function instantiations that are operators, we must check -- For function instantiations that are operators, we must check
-- separately that the corresponding generic only has in-parameters. -- separately that the corresponding generic only has in-parameters.
-- For subprogram declarations this is done in Set_Formal_Mode. -- For subprogram declarations this is done in Set_Formal_Mode. Such
-- Such an error could not arise in earlier versions of the language. -- an error could not arise in earlier versions of the language.
elsif Ekind (F) /= E_In_Parameter then elsif Ekind (F) /= E_In_Parameter then
Error_Msg_N Error_Msg_N ("operators can only have IN parameters", F);
("operators can only have IN parameters", F);
end if; end if;
Next_Formal (F); Next_Formal (F);
...@@ -12058,7 +12054,7 @@ package body Sem_Ch6 is ...@@ -12058,7 +12054,7 @@ package body Sem_Ch6 is
and then not Is_Intrinsic_Subprogram (Designator) and then not Is_Intrinsic_Subprogram (Designator)
then then
Error_Msg_N Error_Msg_N
("explicit definition of inequality not allowed", Designator); ("explicit definition of inequality not allowed", Designator);
end if; end if;
end Valid_Operator_Definition; end Valid_Operator_Definition;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment