[multiple changes]

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

	* sem_ch13.adb (Analyze_Aspect_Specifications): Default_Value and
	Default_Component_Value can only be specified for scalar type or
	arrays of scalar types respectively.  This legality check must
	be performed at the point the aspect is analyzed, in order to
	reject aspect specifications that apply to a partial view.

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

	* freeze.adb: Minor reformatting.

2014-07-30  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb (Expand_Attribute, case First/Last): Don't expand in
	codepeer mode.

From-SVN: r213289
This commit is contained in:
Arnaud Charlet 2014-07-30 16:49:38 +02:00
parent 21de9325dd
commit 33c9f9af6c
4 changed files with 79 additions and 41 deletions

View File

@ -1,3 +1,20 @@
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Default_Value and
Default_Component_Value can only be specified for scalar type or
arrays of scalar types respectively. This legality check must
be performed at the point the aspect is analyzed, in order to
reject aspect specifications that apply to a partial view.
2014-07-30 Thomas Quinot <quinot@adacore.com>
* freeze.adb: Minor reformatting.
2014-07-30 Robert Dewar <dewar@adacore.com>
* exp_attr.adb (Expand_Attribute, case First/Last): Don't expand in
codepeer mode.
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Check_Expression_Function): At the freeze point

View File

@ -2884,9 +2884,11 @@ package body Exp_Attr is
-- For scalar type, if low bound is a reference to an entity, just
-- replace with a direct reference. Note that we can only have a
-- reference to a constant entity at this stage, anything else would
-- have already been rewritten.
-- have already been rewritten. We do not do this rewriting if we
-- are in CodePeer mode, since CodePeer prefers to see the explicit
-- First attribute reference.
elsif Is_Scalar_Type (Ptyp) then
elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
declare
Lo : constant Node_Id := Type_Low_Bound (Ptyp);
begin
@ -3560,9 +3562,11 @@ package body Exp_Attr is
-- For scalar type, if low bound is a reference to an entity, just
-- replace with a direct reference. Note that we can only have a
-- reference to a constant entity at this stage, anything else would
-- have already been rewritten.
-- have already been rewritten. We do not do this rewriting if we
-- are in CodePeer mode, since CodePeer prefers to see the explicit
-- Last attribute reference.
elsif Is_Scalar_Type (Ptyp) then
elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
declare
Hi : constant Node_Id := Type_High_Bound (Ptyp);
begin

View File

@ -108,8 +108,8 @@ package body Freeze is
procedure Check_Expression_Function (N : Node_Id; Nam : Entity_Id);
-- When an expression function is frozen by a use of it, the expression
-- itself is frozen. Check that the expression does not include references
-- to deferred constants without completion. We report this at the
-- freeze point of the function, to provide a better error message.
-- to deferred constants without completion. We report this at the freeze
-- point of the function, to provide a better error message.
procedure Check_Strict_Alignment (E : Entity_Id);
-- E is a base type. If E is tagged or has a component that is aliased

View File

@ -2618,10 +2618,28 @@ package body Sem_Ch13 is
-- Case 3a: The aspects listed below don't correspond to
-- pragmas/attributes but do require delayed analysis.
-- Default_Value, Default_Component_Value
-- Default_Value can only apply to a scalar type
when Aspect_Default_Value =>
if not Is_Scalar_Type (E) then
Error_Msg_N
("aspect Default_Value must apply to a scalar_Type", N);
end if;
Aitem := Empty;
-- Default_Component_Value can only apply to an array type
-- with scalar components.
when Aspect_Default_Component_Value =>
if not (Is_Array_Type (E)
and then
Is_Scalar_Type (Component_Type (E)))
then
Error_Msg_N ("aspect Default_Component_Value can only "
& "apply to an array of scalar components", N);
end if;
when Aspect_Default_Value |
Aspect_Default_Component_Value =>
Aitem := Empty;
-- Case 3b: The aspects listed below don't correspond to
@ -2692,7 +2710,7 @@ package body Sem_Ch13 is
-- or precondition error).
-- We do not do this for Pre'Class, since we have to put
-- these conditions together in a complex OR expression
-- these conditions together in a complex OR expression.
-- We do not do this in ASIS mode, as ASIS relies on the
-- original node representing the complete expression, when
@ -2716,7 +2734,7 @@ package body Sem_Ch13 is
-- Build the precondition/postcondition pragma
-- Add note about why we do NOT need Copy_Tree here ???
-- Add note about why we do NOT need Copy_Tree here???
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
@ -2776,9 +2794,9 @@ package body Sem_Ch13 is
end if;
-- Make pragma expressions refer to the original aspect
-- expressions through the Original_Node link. This is
-- used in semantic analysis for ASIS mode, so that the
-- original expression also gets analyzed.
-- expressions through the Original_Node link. This is used
-- in semantic analysis for ASIS mode, so that the original
-- expression also gets analyzed.
Comp_Expr := First (Expressions (Expr));
while Present (Comp_Expr) loop
@ -2885,8 +2903,8 @@ package body Sem_Ch13 is
end if;
-- In older versions of Ada the corresponding pragmas
-- specified a Convention. In Ada 2012 the convention
-- is specified as a separate aspect, and it is optional,
-- specified a Convention. In Ada 2012 the convention is
-- specified as a separate aspect, and it is optional,
-- given that it defaults to Convention_Ada. The code
-- that verifed that there was a matching convention
-- is now obsolete.
@ -2947,8 +2965,8 @@ package body Sem_Ch13 is
Pragma_Name => Nam);
end;
-- Cases where we do not delay, includes all cases where
-- the expression is missing other than the above cases.
-- Cases where we do not delay, includes all cases where the
-- expression is missing other than the above cases.
elsif not Delay_Required or else No (Expr) then
Make_Aitem_Pragma
@ -2997,8 +3015,8 @@ package body Sem_Ch13 is
End_Label => Empty));
end if;
-- Create a pragma and put it at the start of the
-- task definition for the task type declaration.
-- Create a pragma and put it at the start of the task
-- definition for the task type declaration.
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
@ -3033,10 +3051,10 @@ package body Sem_Ch13 is
-- In the context of a compilation unit, we directly put the
-- pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
-- node (no delay is required here) except for aspects on a
-- subprogram body (see below) and a generic package, for which
-- we need to introduce the pragma before building the generic
-- copy (see sem_ch12), and for package instantiations, where
-- the library unit pragmas are better handled early.
-- subprogram body (see below) and a generic package, for which we
-- need to introduce the pragma before building the generic copy
-- (see sem_ch12), and for package instantiations, where the
-- library unit pragmas are better handled early.
if Nkind (Parent (N)) = N_Compilation_Unit
and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@ -3233,12 +3251,12 @@ package body Sem_Ch13 is
FOnly : Boolean := False;
-- Reset to True for subtype specific attribute (Alignment, Size)
-- and for stream attributes, i.e. those cases where in the call
-- to Rep_Item_Too_Late, FOnly is set True so that only the freezing
-- rules are checked. Note that the case of stream attributes is not
-- clear from the RM, but see AI95-00137. Also, the RM seems to
-- disallow Storage_Size for derived task types, but that is also
-- clearly unintentional.
-- and for stream attributes, i.e. those cases where in the call to
-- Rep_Item_Too_Late, FOnly is set True so that only the freezing rules
-- are checked. Note that the case of stream attributes is not clear
-- from the RM, but see AI95-00137. Also, the RM seems to disallow
-- Storage_Size for derived task types, but that is also clearly
-- unintentional.
procedure Analyze_Stream_TSS_Definition (TSS_Nam : TSS_Name_Type);
-- Common processing for 'Read, 'Write, 'Input and 'Output attribute
@ -3321,9 +3339,8 @@ package body Sem_Ch13 is
Typ := Etype (F);
-- If the attribute specification comes from an aspect
-- specification for a class-wide stream, the parameter
-- must be a class-wide type of the entity to which the
-- aspect applies.
-- specification for a class-wide stream, the parameter must be
-- a class-wide type of the entity to which the aspect applies.
if From_Aspect_Specification (N)
and then Class_Present (Parent (N))
@ -3336,8 +3353,8 @@ package body Sem_Ch13 is
Typ := Etype (Subp);
end if;
-- Verify that the prefix of the attribute and the local name
-- for the type of the formal match.
-- Verify that the prefix of the attribute and the local name for
-- the type of the formal match.
if Base_Type (Typ) /= Base_Type (Ent)
or else Present ((Next_Formal (F)))
@ -3709,8 +3726,8 @@ package body Sem_Ch13 is
begin
-- The following code is a defense against recursion. Not clear that
-- this can happen legitimately, but perhaps some error situations
-- can cause it, and we did see this recursion during testing.
-- this can happen legitimately, but perhaps some error situations can
-- cause it, and we did see this recursion during testing.
if Analyzed (N) then
return;
@ -3760,10 +3777,10 @@ package body Sem_Ch13 is
return;
-- The following should not be ignored, because in the first place
-- they are reasonably portable, and should not cause problems in
-- compiling code from another target, and also they do affect
-- legality, e.g. failing to provide a stream attribute for a
-- type may make a program illegal.
-- they are reasonably portable, and should not cause problems
-- in compiling code from another target, and also they do affect
-- legality, e.g. failing to provide a stream attribute for a type
-- may make a program illegal.
when Attribute_External_Tag |
Attribute_Input |