Commit 33c9f9af by Arnaud Charlet

[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
parent 21de9325
2014-07-30 Ed Schonberg <schonberg@adacore.com> 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 * freeze.adb (Check_Expression_Function): At the freeze point
of an expression function, verify that the expression in the of an expression function, verify that the expression in the
function does not contain references to any deferred constants function does not contain references to any deferred constants
......
...@@ -2884,9 +2884,11 @@ package body Exp_Attr is ...@@ -2884,9 +2884,11 @@ package body Exp_Attr is
-- For scalar type, if low bound is a reference to an entity, just -- 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 -- replace with a direct reference. Note that we can only have a
-- reference to a constant entity at this stage, anything else would -- 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 declare
Lo : constant Node_Id := Type_Low_Bound (Ptyp); Lo : constant Node_Id := Type_Low_Bound (Ptyp);
begin begin
...@@ -3560,9 +3562,11 @@ package body Exp_Attr is ...@@ -3560,9 +3562,11 @@ package body Exp_Attr is
-- For scalar type, if low bound is a reference to an entity, just -- 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 -- replace with a direct reference. Note that we can only have a
-- reference to a constant entity at this stage, anything else would -- 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 declare
Hi : constant Node_Id := Type_High_Bound (Ptyp); Hi : constant Node_Id := Type_High_Bound (Ptyp);
begin begin
......
...@@ -108,8 +108,8 @@ package body Freeze is ...@@ -108,8 +108,8 @@ package body Freeze is
procedure Check_Expression_Function (N : Node_Id; Nam : Entity_Id); procedure Check_Expression_Function (N : Node_Id; Nam : Entity_Id);
-- When an expression function is frozen by a use of it, the expression -- When an expression function is frozen by a use of it, the expression
-- itself is frozen. Check that the expression does not include references -- itself is frozen. Check that the expression does not include references
-- to deferred constants without completion. We report this at the -- to deferred constants without completion. We report this at the freeze
-- freeze point of the function, to provide a better error message. -- point of the function, to provide a better error message.
procedure Check_Strict_Alignment (E : Entity_Id); procedure Check_Strict_Alignment (E : Entity_Id);
-- E is a base type. If E is tagged or has a component that is aliased -- E is a base type. If E is tagged or has a component that is aliased
......
...@@ -2618,10 +2618,28 @@ package body Sem_Ch13 is ...@@ -2618,10 +2618,28 @@ package body Sem_Ch13 is
-- Case 3a: The aspects listed below don't correspond to -- Case 3a: The aspects listed below don't correspond to
-- pragmas/attributes but do require delayed analysis. -- 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; Aitem := Empty;
-- Case 3b: The aspects listed below don't correspond to -- Case 3b: The aspects listed below don't correspond to
...@@ -2692,7 +2710,7 @@ package body Sem_Ch13 is ...@@ -2692,7 +2710,7 @@ package body Sem_Ch13 is
-- or precondition error). -- or precondition error).
-- We do not do this for Pre'Class, since we have to put -- 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 -- We do not do this in ASIS mode, as ASIS relies on the
-- original node representing the complete expression, when -- original node representing the complete expression, when
...@@ -2716,7 +2734,7 @@ package body Sem_Ch13 is ...@@ -2716,7 +2734,7 @@ package body Sem_Ch13 is
-- Build the precondition/postcondition pragma -- 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 Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List ( (Pragma_Argument_Associations => New_List (
...@@ -2776,9 +2794,9 @@ package body Sem_Ch13 is ...@@ -2776,9 +2794,9 @@ package body Sem_Ch13 is
end if; end if;
-- Make pragma expressions refer to the original aspect -- Make pragma expressions refer to the original aspect
-- expressions through the Original_Node link. This is -- expressions through the Original_Node link. This is used
-- used in semantic analysis for ASIS mode, so that the -- in semantic analysis for ASIS mode, so that the original
-- original expression also gets analyzed. -- expression also gets analyzed.
Comp_Expr := First (Expressions (Expr)); Comp_Expr := First (Expressions (Expr));
while Present (Comp_Expr) loop while Present (Comp_Expr) loop
...@@ -2885,8 +2903,8 @@ package body Sem_Ch13 is ...@@ -2885,8 +2903,8 @@ package body Sem_Ch13 is
end if; end if;
-- In older versions of Ada the corresponding pragmas -- In older versions of Ada the corresponding pragmas
-- specified a Convention. In Ada 2012 the convention -- specified a Convention. In Ada 2012 the convention is
-- is specified as a separate aspect, and it is optional, -- specified as a separate aspect, and it is optional,
-- given that it defaults to Convention_Ada. The code -- given that it defaults to Convention_Ada. The code
-- that verifed that there was a matching convention -- that verifed that there was a matching convention
-- is now obsolete. -- is now obsolete.
...@@ -2947,8 +2965,8 @@ package body Sem_Ch13 is ...@@ -2947,8 +2965,8 @@ package body Sem_Ch13 is
Pragma_Name => Nam); Pragma_Name => Nam);
end; end;
-- Cases where we do not delay, includes all cases where -- Cases where we do not delay, includes all cases where the
-- the expression is missing other than the above cases. -- expression is missing other than the above cases.
elsif not Delay_Required or else No (Expr) then elsif not Delay_Required or else No (Expr) then
Make_Aitem_Pragma Make_Aitem_Pragma
...@@ -2997,8 +3015,8 @@ package body Sem_Ch13 is ...@@ -2997,8 +3015,8 @@ package body Sem_Ch13 is
End_Label => Empty)); End_Label => Empty));
end if; end if;
-- Create a pragma and put it at the start of the -- Create a pragma and put it at the start of the task
-- task definition for the task type declaration. -- definition for the task type declaration.
Make_Aitem_Pragma Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List ( (Pragma_Argument_Associations => New_List (
...@@ -3033,10 +3051,10 @@ package body Sem_Ch13 is ...@@ -3033,10 +3051,10 @@ package body Sem_Ch13 is
-- In the context of a compilation unit, we directly put the -- In the context of a compilation unit, we directly put the
-- pragma in the Pragmas_After list of the N_Compilation_Unit_Aux -- pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
-- node (no delay is required here) except for aspects on a -- node (no delay is required here) except for aspects on a
-- subprogram body (see below) and a generic package, for which -- subprogram body (see below) and a generic package, for which we
-- we need to introduce the pragma before building the generic -- need to introduce the pragma before building the generic copy
-- copy (see sem_ch12), and for package instantiations, where -- (see sem_ch12), and for package instantiations, where the
-- the library unit pragmas are better handled early. -- library unit pragmas are better handled early.
if Nkind (Parent (N)) = N_Compilation_Unit if Nkind (Parent (N)) = N_Compilation_Unit
and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect)) and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
...@@ -3233,12 +3251,12 @@ package body Sem_Ch13 is ...@@ -3233,12 +3251,12 @@ package body Sem_Ch13 is
FOnly : Boolean := False; FOnly : Boolean := False;
-- Reset to True for subtype specific attribute (Alignment, Size) -- Reset to True for subtype specific attribute (Alignment, Size)
-- and for stream attributes, i.e. those cases where in the call -- and for stream attributes, i.e. those cases where in the call to
-- to Rep_Item_Too_Late, FOnly is set True so that only the freezing -- Rep_Item_Too_Late, FOnly is set True so that only the freezing rules
-- rules are checked. Note that the case of stream attributes is not -- are checked. Note that the case of stream attributes is not clear
-- clear from the RM, but see AI95-00137. Also, the RM seems to -- from the RM, but see AI95-00137. Also, the RM seems to disallow
-- disallow Storage_Size for derived task types, but that is also -- Storage_Size for derived task types, but that is also clearly
-- clearly unintentional. -- unintentional.
procedure Analyze_Stream_TSS_Definition (TSS_Nam : TSS_Name_Type); procedure Analyze_Stream_TSS_Definition (TSS_Nam : TSS_Name_Type);
-- Common processing for 'Read, 'Write, 'Input and 'Output attribute -- Common processing for 'Read, 'Write, 'Input and 'Output attribute
...@@ -3321,9 +3339,8 @@ package body Sem_Ch13 is ...@@ -3321,9 +3339,8 @@ package body Sem_Ch13 is
Typ := Etype (F); Typ := Etype (F);
-- If the attribute specification comes from an aspect -- If the attribute specification comes from an aspect
-- specification for a class-wide stream, the parameter -- specification for a class-wide stream, the parameter must be
-- must be a class-wide type of the entity to which the -- a class-wide type of the entity to which the aspect applies.
-- aspect applies.
if From_Aspect_Specification (N) if From_Aspect_Specification (N)
and then Class_Present (Parent (N)) and then Class_Present (Parent (N))
...@@ -3336,8 +3353,8 @@ package body Sem_Ch13 is ...@@ -3336,8 +3353,8 @@ package body Sem_Ch13 is
Typ := Etype (Subp); Typ := Etype (Subp);
end if; end if;
-- Verify that the prefix of the attribute and the local name -- Verify that the prefix of the attribute and the local name for
-- for the type of the formal match. -- the type of the formal match.
if Base_Type (Typ) /= Base_Type (Ent) if Base_Type (Typ) /= Base_Type (Ent)
or else Present ((Next_Formal (F))) or else Present ((Next_Formal (F)))
...@@ -3709,8 +3726,8 @@ package body Sem_Ch13 is ...@@ -3709,8 +3726,8 @@ package body Sem_Ch13 is
begin begin
-- The following code is a defense against recursion. Not clear that -- The following code is a defense against recursion. Not clear that
-- this can happen legitimately, but perhaps some error situations -- this can happen legitimately, but perhaps some error situations can
-- can cause it, and we did see this recursion during testing. -- cause it, and we did see this recursion during testing.
if Analyzed (N) then if Analyzed (N) then
return; return;
...@@ -3760,10 +3777,10 @@ package body Sem_Ch13 is ...@@ -3760,10 +3777,10 @@ package body Sem_Ch13 is
return; return;
-- The following should not be ignored, because in the first place -- The following should not be ignored, because in the first place
-- they are reasonably portable, and should not cause problems in -- they are reasonably portable, and should not cause problems
-- compiling code from another target, and also they do affect -- in compiling code from another target, and also they do affect
-- legality, e.g. failing to provide a stream attribute for a -- legality, e.g. failing to provide a stream attribute for a type
-- type may make a program illegal. -- may make a program illegal.
when Attribute_External_Tag | when Attribute_External_Tag |
Attribute_Input | Attribute_Input |
......
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