Commit 6d9e03cb by Arnaud Charlet

[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
parent b688e030
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> 2012-01-30 Thomas Quinot <quinot@adacore.com>
* a-strhas.ads: Document risk of collision attack. * a-strhas.ads: Document risk of collision attack.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -161,9 +161,10 @@ package body Einfo is ...@@ -161,9 +161,10 @@ package body Einfo is
-- Body_Entity Node19 -- Body_Entity Node19
-- Corresponding_Discriminant Node19 -- Corresponding_Discriminant Node19
-- Default_Aspect_Value Node19
-- Default_Aspect_Component_Value Node19
-- Extra_Accessibility_Of_Result Node19 -- Extra_Accessibility_Of_Result Node19
-- Parent_Subtype Node19 -- Parent_Subtype Node19
-- Related_Array_Object Node19
-- Size_Check_Code Node19 -- Size_Check_Code Node19
-- Spec_Entity Node19 -- Spec_Entity Node19
-- Underlying_Full_View Node19 -- Underlying_Full_View Node19
...@@ -217,6 +218,7 @@ package body Einfo is ...@@ -217,6 +218,7 @@ package body Einfo is
-- Debug_Renaming_Link Node25 -- Debug_Renaming_Link Node25
-- DT_Offset_To_Top_Func Node25 -- DT_Offset_To_Top_Func Node25
-- PPC_Wrapper Node25 -- PPC_Wrapper Node25
-- Related_Array_Object Node25
-- Static_Predicate List25 -- Static_Predicate List25
-- Task_Body_Procedure Node25 -- Task_Body_Procedure Node25
...@@ -773,6 +775,18 @@ package body Einfo is ...@@ -773,6 +775,18 @@ package body Einfo is
return Node25 (Id); return Node25 (Id);
end Debug_Renaming_Link; 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 function Default_Expr_Function (Id : E) return E is
begin begin
pragma Assert (Is_Formal (Id)); pragma Assert (Is_Formal (Id));
...@@ -2528,7 +2542,7 @@ package body Einfo is ...@@ -2528,7 +2542,7 @@ package body Einfo is
function Related_Array_Object (Id : E) return E is function Related_Array_Object (Id : E) return E is
begin begin
pragma Assert (Is_Array_Type (Id)); pragma Assert (Is_Array_Type (Id));
return Node19 (Id); return Node25 (Id);
end Related_Array_Object; end Related_Array_Object;
function Related_Expression (Id : E) return N is function Related_Expression (Id : E) return N is
...@@ -3262,6 +3276,18 @@ package body Einfo is ...@@ -3262,6 +3276,18 @@ package body Einfo is
Set_Node25 (Id, V); Set_Node25 (Id, V);
end Set_Debug_Renaming_Link; 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 procedure Set_Default_Expr_Function (Id : E; V : E) is
begin begin
pragma Assert (Is_Formal (Id)); pragma Assert (Is_Formal (Id));
...@@ -5083,7 +5109,7 @@ package body Einfo is ...@@ -5083,7 +5109,7 @@ package body Einfo is
procedure Set_Related_Array_Object (Id : E; V : E) is procedure Set_Related_Array_Object (Id : E; V : E) is
begin begin
pragma Assert (Is_Array_Type (Id)); pragma Assert (Is_Array_Type (Id));
Set_Node19 (Id, V); Set_Node25 (Id, V);
end Set_Related_Array_Object; end Set_Related_Array_Object;
procedure Set_Related_Expression (Id : E; V : N) is procedure Set_Related_Expression (Id : E; V : N) is
...@@ -8317,13 +8343,15 @@ package body Einfo is ...@@ -8317,13 +8343,15 @@ package body Einfo is
when E_Discriminant => when E_Discriminant =>
Write_Str ("Corresponding_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 => when E_Record_Type =>
Write_Str ("Parent_Subtype"); Write_Str ("Parent_Subtype");
when E_Array_Type |
E_Array_Subtype =>
Write_Str ("Related_Array_Object");
when E_Constant | when E_Constant |
E_Variable => E_Variable =>
Write_Str ("Size_Check_Code"); Write_Str ("Size_Check_Code");
...@@ -8619,6 +8647,10 @@ package body Einfo is ...@@ -8619,6 +8647,10 @@ package body Einfo is
E_Record_Subtype_With_Private => E_Record_Subtype_With_Private =>
Write_Str ("Interfaces"); Write_Str ("Interfaces");
when E_Array_Type |
E_Array_Subtype =>
Write_Str ("Related_Array_Object");
when Task_Kind => when Task_Kind =>
Write_Str ("Task_Body_Procedure"); Write_Str ("Task_Body_Procedure");
......
...@@ -748,6 +748,14 @@ package Einfo is ...@@ -748,6 +748,14 @@ package Einfo is
-- default expressions (see Freeze.Process_Default_Expressions), which -- default expressions (see Freeze.Process_Default_Expressions), which
-- would not only waste time, but also generate false error messages. -- 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) -- Default_Value (Node20)
-- Present in formal parameters. Points to the node representing the -- Present in formal parameters. Points to the node representing the
-- expression for the default value for the parameter. Empty if the -- expression for the default value for the parameter. Empty if the
...@@ -3449,7 +3457,7 @@ package Einfo is ...@@ -3449,7 +3457,7 @@ package Einfo is
-- register call to make appropriate entries in the special tables -- register call to make appropriate entries in the special tables
-- used for handling these pragmas at runtime. -- 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 -- Present in array types and subtypes. Used only for the base type
-- and subtype created for an anonymous array object. Set to point -- and subtype created for an anonymous array object. Set to point
-- to the entity of the corresponding array object. Currently used -- to the entity of the corresponding array object. Currently used
...@@ -5016,11 +5024,12 @@ package Einfo is ...@@ -5016,11 +5024,12 @@ package Einfo is
-- E_Array_Type -- E_Array_Type
-- E_Array_Subtype -- E_Array_Subtype
-- First_Index (Node17) -- First_Index (Node17)
-- Related_Array_Object (Node19) -- Default_Aspect_Component_Value (Node19)
-- Component_Type (Node20) (base type only) -- Component_Type (Node20) (base type only)
-- Original_Array_Type (Node21) -- Original_Array_Type (Node21)
-- Component_Size (Uint22) (base type only) -- Component_Size (Uint22) (base type only)
-- Packed_Array_Type (Node23) -- Packed_Array_Type (Node23)
-- Related_Array_Object (Node25)
-- Component_Alignment (special) (base type only) -- Component_Alignment (special) (base type only)
-- Has_Component_Size_Clause (Flag68) (base type only) -- Has_Component_Size_Clause (Flag68) (base type only)
-- Has_Pragma_Pack (Flag121) (impl base type only) -- Has_Pragma_Pack (Flag121) (impl base type only)
...@@ -5195,6 +5204,7 @@ package Einfo is ...@@ -5195,6 +5204,7 @@ package Einfo is
-- Lit_Indexes (Node15) (root type only) -- Lit_Indexes (Node15) (root type only)
-- Lit_Strings (Node16) (root type only) -- Lit_Strings (Node16) (root type only)
-- First_Literal (Node17) -- First_Literal (Node17)
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Enum_Pos_To_Rep (Node23) (type only) -- Enum_Pos_To_Rep (Node23) (type only)
-- Static_Predicate (List25) -- Static_Predicate (List25)
...@@ -5226,6 +5236,7 @@ package Einfo is ...@@ -5226,6 +5236,7 @@ package Einfo is
-- E_Floating_Point_Subtype -- E_Floating_Point_Subtype
-- Digits_Value (Uint17) -- Digits_Value (Uint17)
-- Float_Rep (Uint10) (Float_Rep_Kind) -- Float_Rep (Uint10) (Float_Rep_Kind)
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Machine_Emax_Value (synth) -- Machine_Emax_Value (synth)
-- Machine_Emin_Value (synth) -- Machine_Emin_Value (synth)
...@@ -5397,6 +5408,7 @@ package Einfo is ...@@ -5397,6 +5408,7 @@ package Einfo is
-- E_Modular_Integer_Type -- E_Modular_Integer_Type
-- E_Modular_Integer_Subtype -- E_Modular_Integer_Subtype
-- Modulus (Uint17) (base type only) -- Modulus (Uint17) (base type only)
-- Default_Aspect_Value (Node19)
-- Original_Array_Type (Node21) -- Original_Array_Type (Node21)
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Static_Predicate (List25) -- Static_Predicate (List25)
...@@ -5431,6 +5443,7 @@ package Einfo is ...@@ -5431,6 +5443,7 @@ package Einfo is
-- E_Ordinary_Fixed_Point_Type -- E_Ordinary_Fixed_Point_Type
-- E_Ordinary_Fixed_Point_Subtype -- E_Ordinary_Fixed_Point_Subtype
-- Delta_Value (Ureal18) -- Delta_Value (Ureal18)
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Small_Value (Ureal21) -- Small_Value (Ureal21)
-- Has_Small_Clause (Flag67) -- Has_Small_Clause (Flag67)
...@@ -5672,6 +5685,7 @@ package Einfo is ...@@ -5672,6 +5685,7 @@ package Einfo is
-- E_Signed_Integer_Type -- E_Signed_Integer_Type
-- E_Signed_Integer_Subtype -- E_Signed_Integer_Subtype
-- Default_Aspect_Value (Node19)
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Static_Predicate (List25) -- Static_Predicate (List25)
-- Has_Biased_Representation (Flag139) -- Has_Biased_Representation (Flag139)
...@@ -6058,6 +6072,8 @@ package Einfo is ...@@ -6058,6 +6072,8 @@ package Einfo is
function DT_Position (Id : E) return U; function DT_Position (Id : E) return U;
function Default_Expr_Function (Id : E) return E; function Default_Expr_Function (Id : E) return E;
function Default_Expressions_Processed (Id : E) return B; 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 Default_Value (Id : E) return N;
function Delay_Cleanups (Id : E) return B; function Delay_Cleanups (Id : E) return B;
function Delay_Subprogram_Descriptors (Id : E) return B; function Delay_Subprogram_Descriptors (Id : E) return B;
...@@ -6649,6 +6665,8 @@ package Einfo is ...@@ -6649,6 +6665,8 @@ package Einfo is
procedure Set_DT_Position (Id : E; V : U); procedure Set_DT_Position (Id : E; V : U);
procedure Set_Default_Expr_Function (Id : E; V : E); procedure Set_Default_Expr_Function (Id : E; V : E);
procedure Set_Default_Expressions_Processed (Id : E; V : B := True); 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_Default_Value (Id : E; V : N);
procedure Set_Delay_Cleanups (Id : E; V : B := True); procedure Set_Delay_Cleanups (Id : E; V : B := True);
procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True); procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True);
...@@ -7354,6 +7372,8 @@ package Einfo is ...@@ -7354,6 +7372,8 @@ package Einfo is
pragma Inline (Default_Expr_Function); pragma Inline (Default_Expr_Function);
pragma Inline (Default_Expressions_Processed); pragma Inline (Default_Expressions_Processed);
pragma Inline (Default_Value); pragma Inline (Default_Value);
pragma Inline (Default_Aspect_Value);
pragma Inline (Default_Aspect_Component_Value);
pragma Inline (Delay_Cleanups); pragma Inline (Delay_Cleanups);
pragma Inline (Delay_Subprogram_Descriptors); pragma Inline (Delay_Subprogram_Descriptors);
pragma Inline (Delta_Value); pragma Inline (Delta_Value);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1033,16 +1033,17 @@ package body Exp_Ch11 is ...@@ -1033,16 +1033,17 @@ package body Exp_Ch11 is
Save := Save :=
Make_Procedure_Call_Statement (No_Location, Make_Procedure_Call_Statement (No_Location,
Name => Name =>
New_Occurrence_Of (RTE (RE_Save_Occurrence), New_Occurrence_Of
No_Location), (RTE (RE_Save_Occurrence), No_Location),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Cparm, Cloc), New_Occurrence_Of (Cparm, No_Location),
Make_Explicit_Dereference (No_Location, Make_Explicit_Dereference (No_Location,
Make_Function_Call (No_Location, Make_Function_Call (No_Location,
Name => Make_Explicit_Dereference (No_Location, Name =>
New_Occurrence_Of Make_Explicit_Dereference (No_Location,
(RTE (RE_Get_Current_Excep), New_Occurrence_Of
No_Location)))))); (RTE (RE_Get_Current_Excep),
No_Location))))));
Mark_Rewrite_Insertion (Save); Mark_Rewrite_Insertion (Save);
Prepend (Save, Statements (Handler)); Prepend (Save, Statements (Handler));
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -549,10 +549,7 @@ package body Exp_Ch3 is ...@@ -549,10 +549,7 @@ package body Exp_Ch3 is
Name => Comp, Name => Comp,
Expression => Expression =>
Convert_To (Comp_Type, Convert_To (Comp_Type,
Expression Default_Aspect_Component_Value (First_Subtype (A_Type)))));
(Get_Rep_Item_For_Entity
(First_Subtype (A_Type),
Name_Default_Component_Value)))));
elsif Needs_Simple_Initialization (Comp_Type) then elsif Needs_Simple_Initialization (Comp_Type) then
Set_Assignment_OK (Comp); Set_Assignment_OK (Comp);
...@@ -6853,14 +6850,17 @@ package body Exp_Ch3 is ...@@ -6853,14 +6850,17 @@ package body Exp_Ch3 is
return Result; 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 elsif Is_Scalar_Type (T) and then Has_Default_Aspect (T) then
return if Is_Private_Type (First_Subtype (T)) then
Convert_To (T, return Unchecked_Convert_To (T,
Expression Default_Aspect_Value (Full_View (First_Subtype (T))));
(Get_Rep_Item_For_Entity else
(First_Subtype (T), Name_Default_Value))); return
Convert_To (T, Default_Aspect_Value (First_Subtype (T)));
end if;
-- Otherwise, for scalars, we must have normalize/initialize scalars -- Otherwise, for scalars, we must have normalize/initialize scalars
-- case, or if the node N is an 'Invalid_Value attribute node. -- case, or if the node N is an 'Invalid_Value attribute node.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -2837,15 +2837,15 @@ package body Exp_Ch7 is ...@@ -2837,15 +2837,15 @@ package body Exp_Ch7 is
-------------------------- --------------------------
procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id) 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 := Is_Prot_Body : constant Boolean :=
Nkind (N) = N_Subprogram_Body Nkind (N) = N_Subprogram_Body
and then Is_Protected_Subprogram_Body (N); and then Is_Protected_Subprogram_Body (N);
-- Determine whether N denotes the protected version of a subprogram -- Determine whether N denotes the protected version of a subprogram
-- which belongs to a protected type. -- which belongs to a protected type.
Loc : constant Source_Ptr := No_Location;
HSS : Node_Id := Handled_Statement_Sequence (N);
begin begin
-- Do not perform this expansion in Alfa mode because we do not create -- Do not perform this expansion in Alfa mode because we do not create
-- finalizers in the first place. -- finalizers in the first place.
......
...@@ -4166,7 +4166,6 @@ package body Freeze is ...@@ -4166,7 +4166,6 @@ package body Freeze is
if Is_First_Subtype (E) and then Has_Default_Aspect (E) then if Is_First_Subtype (E) and then Has_Default_Aspect (E) then
declare declare
Nam : Name_Id; Nam : Name_Id;
Aspect : Node_Id;
Exp : Node_Id; Exp : Node_Id;
Typ : Entity_Id; Typ : Entity_Id;
...@@ -4174,13 +4173,13 @@ package body Freeze is ...@@ -4174,13 +4173,13 @@ package body Freeze is
if Is_Scalar_Type (E) then if Is_Scalar_Type (E) then
Nam := Name_Default_Value; Nam := Name_Default_Value;
Typ := E; Typ := E;
Exp := Default_Aspect_Value (Typ);
else else
Nam := Name_Default_Component_Value; Nam := Name_Default_Component_Value;
Exp := Default_Aspect_Component_Value (E);
Typ := Component_Type (E); Typ := Component_Type (E);
end if; end if;
Aspect := Get_Rep_Item_For_Entity (E, Nam);
Exp := Expression (Aspect);
Analyze_And_Resolve (Exp, Typ); Analyze_And_Resolve (Exp, Typ);
if Etype (Exp) /= Any_Type then if Etype (Exp) /= Any_Type then
......
...@@ -5681,7 +5681,8 @@ pragma @code{Postcondition} or a @code{Post} aspect in Ada 2012). A ...@@ -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 function postcondition is suspicious when it does not mention the result
of the function. A procedure postcondition is suspicious when it only 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 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 @item -gnatw.T
@emph{Suppress warnings on suspicious contracts.} @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 ...@@ -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 which the type is declared, or its body or subunits.) Please refer to
the description of pragma @code{Ordered} in the the description of pragma @code{Ordered} in the
@cite{@value{EDITION} Reference Manual} for further details. @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 @item -gnatw.U
@emph{Deactivate warnings on unordered enumeration types.} @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 ...@@ -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: A string of warning parameters can be used in the same parameter. For example:
@smallexample @smallexample
-gnatwaLe -gnatwaGe
@end smallexample @end smallexample
@noindent @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. and also specify that warnings should be treated as errors.
@end ifclear @end ifclear
When no switch @option{^-gnatw^/WARNINGS^} is used, this is equivalent to: When no switch @option{^-gnatw^/WARNINGS^} is used, this is equivalent to:
@table @option @table @option
@c !sort! @c !sort!
@item -gnatwB
@item -gnatw.b
@item -gnatwC @item -gnatwC
@item -gnatw.C
@item -gnatwD @item -gnatwD
@item -gnatwF @item -gnatwF
@item -gnatwg @item -gnatwg
@item -gnatwH @item -gnatwH
@item -gnatwi @item -gnatwi
@item -gnatw.I
@item -gnatwJ @item -gnatwJ
@item -gnatwK @item -gnatwK
@item -gnatwL @item -gnatwL
@item -gnatw.L
@item -gnatwM @item -gnatwM
@item -gnatw.m
@item -gnatwn @item -gnatwn
@item -gnatwo @item -gnatwo
@item -gnatw.O
@item -gnatwP @item -gnatwP
@item -gnatw.P
@item -gnatwq
@item -gnatwR @item -gnatwR
@item -gnatw.R
@item -gnatw.S
@item -gnatwT
@item -gnatw.T
@item -gnatwU @item -gnatwU
@item -gnatwv @item -gnatwv
@item -gnatwz @item -gnatww
@item -gnatw.W
@item -gnatwx @item -gnatwx
@item -gnatw.X
@item -gnatwy
@item -gnatwz
@end table @end table
...@@ -6316,9 +6337,10 @@ for the use of blanks to separate source tokens. ...@@ -6316,9 +6337,10 @@ for the use of blanks to separate source tokens.
@emph{Check Boolean operators.} @emph{Check Boolean operators.}
The use of AND/OR operators is not permitted except in the cases of modular 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 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.} @emph{Check comments, double space.}
Comments must meet the following set of rules: Comments must meet the following set of rules:
...@@ -6370,7 +6392,7 @@ example: ...@@ -6370,7 +6392,7 @@ example:
@end smallexample @end smallexample
@end itemize @end itemize
@item ^C^COMMENTS1^ (single space) @item ^C^COMMENTS1^
@emph{Check comments, single space.} @emph{Check comments, single space.}
This is identical to @code{^c^COMMENTS^} except that only one space This is identical to @code{^c^COMMENTS^} except that only one space
is required following the @code{--} of a comment instead of two. is required following the @code{--} of a comment instead of two.
...@@ -6392,7 +6414,7 @@ Neither form feeds nor vertical tab characters are permitted ...@@ -6392,7 +6414,7 @@ Neither form feeds nor vertical tab characters are permitted
in the source text. in the source text.
@item ^g^GNAT^ @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. 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 This may be useful when developing code that is eventually intended to be
incorporated into GNAT. For further details, see GNAT sources. 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 ...@@ -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. containing all or part of the condition to be tested.
@item ^I^IN_MODE^ @item ^I^IN_MODE^
@emph{check mode IN keywords} @emph{check mode IN keywords.}
Mode @code{in} (the default mode) is not Mode @code{in} (the default mode) is not
allowed to be given explicitly. @code{in out} is fine, allowed to be given explicitly. @code{in out} is fine,
but not @code{in} on its own. but not @code{in} on its own.
...@@ -6501,7 +6523,7 @@ Clear : ...@@ -6501,7 +6523,7 @@ Clear :
@end smallexample @end smallexample
@item ^Lnnn^MAX_NESTING=nnn^ @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, The maximum level of nesting of constructs (including subprograms, loops,
blocks, packages, and conditionals) may not exceed the given value blocks, packages, and conditionals) may not exceed the given value
@option{nnn}. A value of zero disconnects this style check. @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, ...@@ -6528,7 +6550,7 @@ to match the presentation in the Ada Reference Manual (for example,
@code{Integer} and @code{ASCII.NUL}). @code{Integer} and @code{ASCII.NUL}).
@item ^N^NONE^ @item ^N^NONE^
@emph{Turn off all style checks} @emph{Turn off all style checks.}
All style check options are turned off. All style check options are turned off.
@item ^o^ORDERED_SUBPROGRAMS^ @item ^o^ORDERED_SUBPROGRAMS^
...@@ -6558,13 +6580,6 @@ corresponding declaration. No specific casing style is imposed on ...@@ -6558,13 +6580,6 @@ corresponding declaration. No specific casing style is imposed on
identifiers. The only requirement is for consistency of references identifiers. The only requirement is for consistency of references
with declarations. 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^ @item ^s^SPECS^
@emph{Check separate specs.} @emph{Check separate specs.}
Separate declarations (``specs'') are required for subprograms (a Separate declarations (``specs'') are required for subprograms (a
...@@ -6573,6 +6588,13 @@ exception is that parameterless library level procedures are ...@@ -6573,6 +6588,13 @@ exception is that parameterless library level procedures are
not required to have a separate declaration. This exception covers not required to have a separate declaration. This exception covers
the most frequent form of main program procedures. 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^ @item ^t^TOKEN^
@emph{Check token spacing.} @emph{Check token spacing.}
The following token spacing rules are enforced: The following token spacing rules are enforced:
...@@ -6580,7 +6602,7 @@ The following token spacing rules are enforced: ...@@ -6580,7 +6602,7 @@ The following token spacing rules are enforced:
@itemize @bullet @itemize @bullet
@item @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 @item
The token @code{=>} must be surrounded by spaces. The token @code{=>} must be surrounded by spaces.
...@@ -6641,9 +6663,9 @@ around conditions in @code{if} statements, @code{while} statements and ...@@ -6641,9 +6663,9 @@ around conditions in @code{if} statements, @code{while} statements and
@item ^y^ALL_BUILTIN^ @item ^y^ALL_BUILTIN^
@emph{Set all standard style check options} @emph{Set all standard style check options}
This is equivalent to @code{gnaty3aAbcefhiklmnprst}, that is all checking This is equivalent to @code{gnaty3aAbcefhiklmnprst}, that is all checking
options enabled with the exception of @option{-gnatyo}, @option{-gnatyI}, options enabled with the exception of @option{-gnatyB}, @option{-gnatyd},
@option{-gnatyS}, @option{-gnatyLnnn}, @option{-gnatyI}, @option{-gnatyLnnn}, @option{-gnatyo}, @option{-gnatyO},
@option{-gnatyd}, @option{-gnatyu}, and @option{-gnatyx}. @option{-gnatyS}, @option{-gnatyu}, and @option{-gnatyx}.
@ifclear vms @ifclear vms
@item - @item -
...@@ -6691,8 +6713,8 @@ including style messages, as fatal errors. ...@@ -6691,8 +6713,8 @@ including style messages, as fatal errors.
The switch The switch
@ifclear vms @ifclear vms
@option{-gnaty} on its own (that is not @option{-gnaty} on its own (that is not
followed by any letters or digits), then the effect is equivalent followed by any letters or digits) is equivalent
to the use of @option{-gnatyy}, as described above, that is all to the use of @option{-gnatyy} as described above, that is all
built-in standard style check options are enabled. built-in standard style check options are enabled.
@end ifclear @end ifclear
......
...@@ -1201,6 +1201,12 @@ package body Sem_Ch13 is ...@@ -1201,6 +1201,12 @@ package body Sem_Ch13 is
Set_Is_Delayed_Aspect (Aspect); Set_Is_Delayed_Aspect (Aspect);
Set_Has_Default_Aspect (Base_Type (Entity (Ent))); 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 => when Aspect_Attach_Handler =>
Aitem := Aitem :=
Make_Pragma (Loc, Make_Pragma (Loc,
...@@ -6024,6 +6030,17 @@ package body Sem_Ch13 is ...@@ -6024,6 +6030,17 @@ package body Sem_Ch13 is
if No (T) then if No (T) then
Check_Aspect_At_Freeze_Point (ASN); Check_Aspect_At_Freeze_Point (ASN);
return; 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 else
Preanalyze_Spec_Expression (End_Decl_Expr, T); Preanalyze_Spec_Expression (End_Decl_Expr, T);
end if; end if;
......
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