[multiple changes]

2012-01-30  Yannick Moy  <moy@adacore.com>

	* gnat_ugn.texi: Minor correction of GNAT UG, to take into
	account changes to -gnatwa and more recent warnings.

2012-01-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Build_Finalizer_Call): Do not provide a source
	location when creating a call to a finalizer.
	* exp_ch11.adb (Expand_Exception_Handlers): Do not provide
	a source location for the first actual of Save_Occurrence for
	consistency sake.

2012-01-30  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo,adb: New attribute on scalar types:
	Default_Aspect_Value New attribute on  array types:
	Default_Aspect_Component_Value Move attribute Related_Array_Object
	to a different position to accomodate new aspect attributes.
	* freeze.adb (Freeze_Entity): Use new attributes to retrieve value
	of defaults set with an aspect specification, rather than using
	the list of aspects attached to the type, to prevent issues with
	partial views.
	* sem_ch13.adb (Analyze_Aspect_Specifications): For aspects
	Default_Value and Default_Component _Value, store corresponding
	expression in type entity.
	(Check_Aspect_At_End_Of_Declaration): If the default aspects
	are declared on the full view, use the full view to resolve the
	correseponding expression.
	* exp_ch3.adb (Init_Component): Use attribute
	Default_Aspect_Component_Value to perform default initialization,
	rather than relying on the rep item list for the type.
	(Get_Simple_Init_Val): Ditto.

From-SVN: r183707
This commit is contained in:
Arnaud Charlet 2012-01-30 12:37:42 +01:00
parent b688e03053
commit 6d9e03cb09
9 changed files with 185 additions and 60 deletions

View File

@ -1,3 +1,37 @@
2012-01-30 Yannick Moy <moy@adacore.com>
* gnat_ugn.texi: Minor correction of GNAT UG, to take into
account changes to -gnatwa and more recent warnings.
2012-01-30 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Build_Finalizer_Call): Do not provide a source
location when creating a call to a finalizer.
* exp_ch11.adb (Expand_Exception_Handlers): Do not provide
a source location for the first actual of Save_Occurrence for
consistency sake.
2012-01-30 Ed Schonberg <schonberg@adacore.com>
* einfo.ads, einfo,adb: New attribute on scalar types:
Default_Aspect_Value New attribute on array types:
Default_Aspect_Component_Value Move attribute Related_Array_Object
to a different position to accomodate new aspect attributes.
* freeze.adb (Freeze_Entity): Use new attributes to retrieve value
of defaults set with an aspect specification, rather than using
the list of aspects attached to the type, to prevent issues with
partial views.
* sem_ch13.adb (Analyze_Aspect_Specifications): For aspects
Default_Value and Default_Component _Value, store corresponding
expression in type entity.
(Check_Aspect_At_End_Of_Declaration): If the default aspects
are declared on the full view, use the full view to resolve the
correseponding expression.
* exp_ch3.adb (Init_Component): Use attribute
Default_Aspect_Component_Value to perform default initialization,
rather than relying on the rep item list for the type.
(Get_Simple_Init_Val): Ditto.
2012-01-30 Thomas Quinot <quinot@adacore.com>
* a-strhas.ads: Document risk of collision attack.

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -161,9 +161,10 @@ package body Einfo is
-- Body_Entity Node19
-- Corresponding_Discriminant Node19
-- Default_Aspect_Value Node19
-- Default_Aspect_Component_Value Node19
-- Extra_Accessibility_Of_Result Node19
-- Parent_Subtype Node19
-- Related_Array_Object Node19
-- Size_Check_Code Node19
-- Spec_Entity Node19
-- Underlying_Full_View Node19
@ -217,6 +218,7 @@ package body Einfo is
-- Debug_Renaming_Link Node25
-- DT_Offset_To_Top_Func Node25
-- PPC_Wrapper Node25
-- Related_Array_Object Node25
-- Static_Predicate List25
-- Task_Body_Procedure Node25
@ -773,6 +775,18 @@ package body Einfo is
return Node25 (Id);
end Debug_Renaming_Link;
function Default_Aspect_Value (Id : E) return N is
begin
pragma Assert (Is_Scalar_Type (Id));
return Node19 (Id);
end Default_Aspect_Value;
function Default_Aspect_Component_Value (Id : E) return N is
begin
pragma Assert (Is_Array_Type (Id));
return Node19 (Id);
end Default_Aspect_Component_Value;
function Default_Expr_Function (Id : E) return E is
begin
pragma Assert (Is_Formal (Id));
@ -2528,7 +2542,7 @@ package body Einfo is
function Related_Array_Object (Id : E) return E is
begin
pragma Assert (Is_Array_Type (Id));
return Node19 (Id);
return Node25 (Id);
end Related_Array_Object;
function Related_Expression (Id : E) return N is
@ -3262,6 +3276,18 @@ package body Einfo is
Set_Node25 (Id, V);
end Set_Debug_Renaming_Link;
procedure Set_Default_Aspect_Value (Id : E; V : E) is
begin
pragma Assert (Is_Scalar_Type (Id));
Set_Node19 (Id, V);
end Set_Default_Aspect_Value;
procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is
begin
pragma Assert (Is_Array_Type (Id));
Set_Node19 (Id, V);
end Set_Default_Aspect_Component_Value;
procedure Set_Default_Expr_Function (Id : E; V : E) is
begin
pragma Assert (Is_Formal (Id));
@ -5083,7 +5109,7 @@ package body Einfo is
procedure Set_Related_Array_Object (Id : E; V : E) is
begin
pragma Assert (Is_Array_Type (Id));
Set_Node19 (Id, V);
Set_Node25 (Id, V);
end Set_Related_Array_Object;
procedure Set_Related_Expression (Id : E; V : N) is
@ -8317,13 +8343,15 @@ package body Einfo is
when E_Discriminant =>
Write_Str ("Corresponding_Discriminant");
when Scalar_Kind =>
Write_Str ("Default_Value");
when E_Array_Type =>
Write_Str ("Default_Component_Value");
when E_Record_Type =>
Write_Str ("Parent_Subtype");
when E_Array_Type |
E_Array_Subtype =>
Write_Str ("Related_Array_Object");
when E_Constant |
E_Variable =>
Write_Str ("Size_Check_Code");
@ -8619,6 +8647,10 @@ package body Einfo is
E_Record_Subtype_With_Private =>
Write_Str ("Interfaces");
when E_Array_Type |
E_Array_Subtype =>
Write_Str ("Related_Array_Object");
when Task_Kind =>
Write_Str ("Task_Body_Procedure");

View File

@ -748,6 +748,14 @@ package Einfo is
-- default expressions (see Freeze.Process_Default_Expressions), which
-- would not only waste time, but also generate false error messages.
-- Default_Aspect_Value (Node19)
-- Present in scalar types. Holds the static value specified in a
-- default_value aspect specification for the type.
-- Default_Aspect_Component_Value (Node19)
-- Present in array types. Holds the static value specified in a
-- default_component_value aspect specification for the array type.
-- Default_Value (Node20)
-- Present in formal parameters. Points to the node representing the
-- expression for the default value for the parameter. Empty if the
@ -3449,7 +3457,7 @@ package Einfo is
-- register call to make appropriate entries in the special tables
-- used for handling these pragmas at runtime.
-- Related_Array_Object (Node19)
-- Related_Array_Object (Node25)
-- Present in array types and subtypes. Used only for the base type
-- and subtype created for an anonymous array object. Set to point
-- to the entity of the corresponding array object. Currently used
@ -5016,11 +5024,12 @@ package Einfo is
-- E_Array_Type
-- E_Array_Subtype
-- First_Index (Node17)
-- Related_Array_Object (Node19)
-- Default_Aspect_Component_Value (Node19)
-- Component_Type (Node20) (base type only)
-- Original_Array_Type (Node21)
-- Component_Size (Uint22) (base type only)
-- Packed_Array_Type (Node23)
-- Related_Array_Object (Node25)
-- Component_Alignment (special) (base type only)
-- Has_Component_Size_Clause (Flag68) (base type only)
-- Has_Pragma_Pack (Flag121) (impl base type only)
@ -5195,6 +5204,7 @@ package Einfo is
-- Lit_Indexes (Node15) (root type only)
-- Lit_Strings (Node16) (root type only)
-- First_Literal (Node17)
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20)
-- Enum_Pos_To_Rep (Node23) (type only)
-- Static_Predicate (List25)
@ -5226,6 +5236,7 @@ package Einfo is
-- E_Floating_Point_Subtype
-- Digits_Value (Uint17)
-- Float_Rep (Uint10) (Float_Rep_Kind)
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20)
-- Machine_Emax_Value (synth)
-- Machine_Emin_Value (synth)
@ -5397,6 +5408,7 @@ package Einfo is
-- E_Modular_Integer_Type
-- E_Modular_Integer_Subtype
-- Modulus (Uint17) (base type only)
-- Default_Aspect_Value (Node19)
-- Original_Array_Type (Node21)
-- Scalar_Range (Node20)
-- Static_Predicate (List25)
@ -5431,6 +5443,7 @@ package Einfo is
-- E_Ordinary_Fixed_Point_Type
-- E_Ordinary_Fixed_Point_Subtype
-- Delta_Value (Ureal18)
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20)
-- Small_Value (Ureal21)
-- Has_Small_Clause (Flag67)
@ -5672,6 +5685,7 @@ package Einfo is
-- E_Signed_Integer_Type
-- E_Signed_Integer_Subtype
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20)
-- Static_Predicate (List25)
-- Has_Biased_Representation (Flag139)
@ -6058,6 +6072,8 @@ package Einfo is
function DT_Position (Id : E) return U;
function Default_Expr_Function (Id : E) return E;
function Default_Expressions_Processed (Id : E) return B;
function Default_Aspect_Value (Id : E) return N;
function Default_Aspect_Component_Value (Id : E) return N;
function Default_Value (Id : E) return N;
function Delay_Cleanups (Id : E) return B;
function Delay_Subprogram_Descriptors (Id : E) return B;
@ -6649,6 +6665,8 @@ package Einfo is
procedure Set_DT_Position (Id : E; V : U);
procedure Set_Default_Expr_Function (Id : E; V : E);
procedure Set_Default_Expressions_Processed (Id : E; V : B := True);
procedure Set_Default_Aspect_Value (Id : E; V : N);
procedure Set_Default_Aspect_Component_Value (Id : E; V : N);
procedure Set_Default_Value (Id : E; V : N);
procedure Set_Delay_Cleanups (Id : E; V : B := True);
procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True);
@ -7354,6 +7372,8 @@ package Einfo is
pragma Inline (Default_Expr_Function);
pragma Inline (Default_Expressions_Processed);
pragma Inline (Default_Value);
pragma Inline (Default_Aspect_Value);
pragma Inline (Default_Aspect_Component_Value);
pragma Inline (Delay_Cleanups);
pragma Inline (Delay_Subprogram_Descriptors);
pragma Inline (Delta_Value);

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -1033,16 +1033,17 @@ package body Exp_Ch11 is
Save :=
Make_Procedure_Call_Statement (No_Location,
Name =>
New_Occurrence_Of (RTE (RE_Save_Occurrence),
No_Location),
New_Occurrence_Of
(RTE (RE_Save_Occurrence), No_Location),
Parameter_Associations => New_List (
New_Occurrence_Of (Cparm, Cloc),
New_Occurrence_Of (Cparm, No_Location),
Make_Explicit_Dereference (No_Location,
Make_Function_Call (No_Location,
Name => Make_Explicit_Dereference (No_Location,
New_Occurrence_Of
(RTE (RE_Get_Current_Excep),
No_Location))))));
Name =>
Make_Explicit_Dereference (No_Location,
New_Occurrence_Of
(RTE (RE_Get_Current_Excep),
No_Location))))));
Mark_Rewrite_Insertion (Save);
Prepend (Save, Statements (Handler));

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -549,10 +549,7 @@ package body Exp_Ch3 is
Name => Comp,
Expression =>
Convert_To (Comp_Type,
Expression
(Get_Rep_Item_For_Entity
(First_Subtype (A_Type),
Name_Default_Component_Value)))));
Default_Aspect_Component_Value (First_Subtype (A_Type)))));
elsif Needs_Simple_Initialization (Comp_Type) then
Set_Assignment_OK (Comp);
@ -6853,14 +6850,17 @@ package body Exp_Ch3 is
return Result;
-- Scalars with Default_Value aspect
-- Scalars with Default_Value aspect. The first subtype may now be
-- private, so retrieve value from underlying type.
elsif Is_Scalar_Type (T) and then Has_Default_Aspect (T) then
return
Convert_To (T,
Expression
(Get_Rep_Item_For_Entity
(First_Subtype (T), Name_Default_Value)));
if Is_Private_Type (First_Subtype (T)) then
return Unchecked_Convert_To (T,
Default_Aspect_Value (Full_View (First_Subtype (T))));
else
return
Convert_To (T, Default_Aspect_Value (First_Subtype (T)));
end if;
-- Otherwise, for scalars, we must have normalize/initialize scalars
-- case, or if the node N is an 'Invalid_Value attribute node.

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -2837,15 +2837,15 @@ package body Exp_Ch7 is
--------------------------
procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
HSS : Node_Id := Handled_Statement_Sequence (N);
Is_Prot_Body : constant Boolean :=
Nkind (N) = N_Subprogram_Body
and then Is_Protected_Subprogram_Body (N);
-- Determine whether N denotes the protected version of a subprogram
-- which belongs to a protected type.
Loc : constant Source_Ptr := No_Location;
HSS : Node_Id := Handled_Statement_Sequence (N);
begin
-- Do not perform this expansion in Alfa mode because we do not create
-- finalizers in the first place.

View File

@ -4166,7 +4166,6 @@ package body Freeze is
if Is_First_Subtype (E) and then Has_Default_Aspect (E) then
declare
Nam : Name_Id;
Aspect : Node_Id;
Exp : Node_Id;
Typ : Entity_Id;
@ -4174,13 +4173,13 @@ package body Freeze is
if Is_Scalar_Type (E) then
Nam := Name_Default_Value;
Typ := E;
Exp := Default_Aspect_Value (Typ);
else
Nam := Name_Default_Component_Value;
Exp := Default_Aspect_Component_Value (E);
Typ := Component_Type (E);
end if;
Aspect := Get_Rep_Item_For_Entity (E, Nam);
Exp := Expression (Aspect);
Analyze_And_Resolve (Exp, Typ);
if Etype (Exp) /= Any_Type then

View File

@ -5681,7 +5681,8 @@ pragma @code{Postcondition} or a @code{Post} aspect in Ada 2012). A
function postcondition is suspicious when it does not mention the result
of the function. A procedure postcondition is suspicious when it only
refers to the pre-state of the procedure, because in that case it should
rather be expressed as a precondition.
rather be expressed as a precondition. The default is that such warnings
are not generated. This warning can also be turned on using @option{-gnatwa}.
@item -gnatw.T
@emph{Suppress warnings on suspicious contracts.}
@ -5728,6 +5729,8 @@ ordered. (A @emph{client} is defined as a unit that is other than the unit in
which the type is declared, or its body or subunits.) Please refer to
the description of pragma @code{Ordered} in the
@cite{@value{EDITION} Reference Manual} for further details.
The default is that such warnings are not generated.
This warning is not automatically turned on by the use of @option{-gnatwa}.
@item -gnatw.U
@emph{Deactivate warnings on unordered enumeration types.}
@ -5918,35 +5921,53 @@ The use of this switch also sets the default front end warning mode to
A string of warning parameters can be used in the same parameter. For example:
@smallexample
-gnatwaLe
-gnatwaGe
@end smallexample
@noindent
will turn on all optional warnings except for elaboration pragma warnings,
will turn on all optional warnings except for unrecognized pragma warnings,
and also specify that warnings should be treated as errors.
@end ifclear
When no switch @option{^-gnatw^/WARNINGS^} is used, this is equivalent to:
@table @option
@c !sort!
@item -gnatwB
@item -gnatw.b
@item -gnatwC
@item -gnatw.C
@item -gnatwD
@item -gnatwF
@item -gnatwg
@item -gnatwH
@item -gnatwi
@item -gnatw.I
@item -gnatwJ
@item -gnatwK
@item -gnatwL
@item -gnatw.L
@item -gnatwM
@item -gnatw.m
@item -gnatwn
@item -gnatwo
@item -gnatw.O
@item -gnatwP
@item -gnatw.P
@item -gnatwq
@item -gnatwR
@item -gnatw.R
@item -gnatw.S
@item -gnatwT
@item -gnatw.T
@item -gnatwU
@item -gnatwv
@item -gnatwz
@item -gnatww
@item -gnatw.W
@item -gnatwx
@item -gnatw.X
@item -gnatwy
@item -gnatwz
@end table
@ -6316,9 +6337,10 @@ for the use of blanks to separate source tokens.
@emph{Check Boolean operators.}
The use of AND/OR operators is not permitted except in the cases of modular
operands, array operands, and simple stand-alone boolean variables or
boolean constants. In all other cases AND THEN/OR ELSE are required.
boolean constants. In all other cases @code{and then}/@code{or else} are
required.
@item ^c^COMMENTS^ (double space)
@item ^c^COMMENTS^
@emph{Check comments, double space.}
Comments must meet the following set of rules:
@ -6370,7 +6392,7 @@ example:
@end smallexample
@end itemize
@item ^C^COMMENTS1^ (single space)
@item ^C^COMMENTS1^
@emph{Check comments, single space.}
This is identical to @code{^c^COMMENTS^} except that only one space
is required following the @code{--} of a comment instead of two.
@ -6392,7 +6414,7 @@ Neither form feeds nor vertical tab characters are permitted
in the source text.
@item ^g^GNAT^
@emph{GNAT style mode}
@emph{GNAT style mode.}
The set of style check switches is set to match that used by the GNAT sources.
This may be useful when developing code that is eventually intended to be
incorporated into GNAT. For further details, see GNAT sources.
@ -6412,7 +6434,7 @@ up under the @code{if} with at least one non-blank line in between
containing all or part of the condition to be tested.
@item ^I^IN_MODE^
@emph{check mode IN keywords}
@emph{check mode IN keywords.}
Mode @code{in} (the default mode) is not
allowed to be given explicitly. @code{in out} is fine,
but not @code{in} on its own.
@ -6501,7 +6523,7 @@ Clear :
@end smallexample
@item ^Lnnn^MAX_NESTING=nnn^
@emph{Set maximum nesting level}
@emph{Set maximum nesting level.}
The maximum level of nesting of constructs (including subprograms, loops,
blocks, packages, and conditionals) may not exceed the given value
@option{nnn}. A value of zero disconnects this style check.
@ -6528,7 +6550,7 @@ to match the presentation in the Ada Reference Manual (for example,
@code{Integer} and @code{ASCII.NUL}).
@item ^N^NONE^
@emph{Turn off all style checks}
@emph{Turn off all style checks.}
All style check options are turned off.
@item ^o^ORDERED_SUBPROGRAMS^
@ -6558,13 +6580,6 @@ corresponding declaration. No specific casing style is imposed on
identifiers. The only requirement is for consistency of references
with declarations.
@item ^S^STATEMENTS_AFTER_THEN_ELSE^
@emph{Check no statements after THEN/ELSE.}
No statements are allowed
on the same line as a THEN or ELSE keyword following the
keyword in an IF statement. OR ELSE and AND THEN are not affected,
and a special exception allows a pragma to appear after ELSE.
@item ^s^SPECS^
@emph{Check separate specs.}
Separate declarations (``specs'') are required for subprograms (a
@ -6573,6 +6588,13 @@ exception is that parameterless library level procedures are
not required to have a separate declaration. This exception covers
the most frequent form of main program procedures.
@item ^S^STATEMENTS_AFTER_THEN_ELSE^
@emph{Check no statements after @code{then}/@code{else}.}
No statements are allowed
on the same line as a @code{then} or @code{else} keyword following the
keyword in an @code{if} statement. @code{or else} and @code{and then} are not
affected, and a special exception allows a pragma to appear after @code{else}.
@item ^t^TOKEN^
@emph{Check token spacing.}
The following token spacing rules are enforced:
@ -6580,7 +6602,7 @@ The following token spacing rules are enforced:
@itemize @bullet
@item
The keywords @code{@b{abs}} and @code{@b{not}} must be followed by a space.
The keywords @code{abs} and @code{not} must be followed by a space.
@item
The token @code{=>} must be surrounded by spaces.
@ -6641,9 +6663,9 @@ around conditions in @code{if} statements, @code{while} statements and
@item ^y^ALL_BUILTIN^
@emph{Set all standard style check options}
This is equivalent to @code{gnaty3aAbcefhiklmnprst}, that is all checking
options enabled with the exception of @option{-gnatyo}, @option{-gnatyI},
@option{-gnatyS}, @option{-gnatyLnnn},
@option{-gnatyd}, @option{-gnatyu}, and @option{-gnatyx}.
options enabled with the exception of @option{-gnatyB}, @option{-gnatyd},
@option{-gnatyI}, @option{-gnatyLnnn}, @option{-gnatyo}, @option{-gnatyO},
@option{-gnatyS}, @option{-gnatyu}, and @option{-gnatyx}.
@ifclear vms
@item -
@ -6691,8 +6713,8 @@ including style messages, as fatal errors.
The switch
@ifclear vms
@option{-gnaty} on its own (that is not
followed by any letters or digits), then the effect is equivalent
to the use of @option{-gnatyy}, as described above, that is all
followed by any letters or digits) is equivalent
to the use of @option{-gnatyy} as described above, that is all
built-in standard style check options are enabled.
@end ifclear

View File

@ -1201,6 +1201,12 @@ package body Sem_Ch13 is
Set_Is_Delayed_Aspect (Aspect);
Set_Has_Default_Aspect (Base_Type (Entity (Ent)));
if Is_Scalar_Type (E) then
Set_Default_Aspect_Value (Entity (Ent), Expr);
else
Set_Default_Aspect_Component_Value (Entity (Ent), Expr);
end if;
when Aspect_Attach_Handler =>
Aitem :=
Make_Pragma (Loc,
@ -6024,6 +6030,17 @@ package body Sem_Ch13 is
if No (T) then
Check_Aspect_At_Freeze_Point (ASN);
return;
-- The default values attributes may be defined in the private part,
-- and the analysis of the expression may take place when only the
-- partial view is visible. The expression must be scalar, so use
-- the full view to resolve.
elsif (A_Id = Aspect_Default_Value or else
A_Id = Aspect_Default_Component_Value)
and then Is_Private_Type (T)
then
Preanalyze_Spec_Expression (End_Decl_Expr, Full_View (T));
else
Preanalyze_Spec_Expression (End_Decl_Expr, T);
end if;