Commit a1efcc17 by Arnaud Charlet

[multiple changes]

2014-01-20  Fedor Rybin  <frybin@adacore.com>

	* gnat_ugn.texi: Documenting --passed-tests option for gnattest.

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_util.adb (Default_Initialization): New routine.
	* sem_util.ads: Add new type Default_Initialization_Kind.
	(Default_Initialization): New routine.

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Check_Mode): Correct all error
	message logic dealing with in/in out parameters that may appear
	as inputs or have a self reference.

From-SVN: r206830
parent 6fd0a72a
2014-01-20 Fedor Rybin <frybin@adacore.com>
* gnat_ugn.texi: Documenting --passed-tests option for gnattest.
2014-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_util.adb (Default_Initialization): New routine.
* sem_util.ads: Add new type Default_Initialization_Kind.
(Default_Initialization): New routine.
2014-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Check_Mode): Correct all error
message logic dealing with in/in out parameters that may appear
as inputs or have a self reference.
2014-01-20 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, checks.adb, exp_intr.adb: Minor reformatting.
......
......@@ -19496,6 +19496,12 @@ to check substitutability.
Specifies the default behavior of generated skeletons. @var{val} can be either
"fail" or "pass", "fail" being the default.
@item --passed-tests=@var{val}
@cindex @option{--skeleton-default} (@command{gnattest})
Specifies whether or not passed tests should be shown. @var{val} can be either
"show" or "hide", "show" being the default.
@item --tests-root=@var{dirname}
@cindex @option{--tests-root} (@command{gnattest})
The directory hierarchy of tested sources is recreated in the @var{dirname}
......@@ -964,9 +964,12 @@ package body Sem_Prag is
-- or tags can be read. In general, states and variables are
-- considered to have mode IN OUT unless they are classified by
-- pragma [Refined_]Global. In that case, the item must appear in
-- an input global list.
-- an input global list. OUT parameters of enclosing subprograms
-- behave as read-write variables in which case do not emit an
-- error.
if (Ekind (Item_Id) = E_Out_Parameter
and then Scope (Item_Id) = Spec_Id
and then not Is_Unconstrained_Or_Tagged_Item (Item_Id))
or else
(Global_Seen and then not Appears_In (Subp_Inputs, Item_Id))
......@@ -999,18 +1002,34 @@ package body Sem_Prag is
-- type acts as an input because the discriminants, array bounds
-- or the tag may be read. Note that the presence of [Refined_]
-- Global is not significant here because the item is a parameter.
-- This rule applies only to the formals of the related subprogram
-- as OUT parameters of enclosing subprograms behave as read-write
-- variables and their types do not matter.
elsif Ekind (Item_Id) = E_Out_Parameter
and then Scope (Item_Id) = Spec_Id
and then Is_Unconstrained_Or_Tagged_Item (Item_Id)
then
null;
-- The remaining cases are IN, IN OUT, and OUT parameters. To
-- qualify as self-referential item, the parameter must be of
-- mode IN OUT.
-- mode IN OUT or be an IN OUT or OUT parameter of an enclosing
-- subprogram.
elsif Ekind (Item_Id) /= E_In_Out_Parameter then
Error_Msg_NE ("item & must have mode `IN OUT`", Item, Item_Id);
elsif Scope (Item_Id) = Spec_Id then
if Ekind (Item_Id) /= E_In_Out_Parameter then
Error_Msg_NE
("item & must have mode `IN OUT`", Item, Item_Id);
end if;
-- Enclosing subprogram parameter
elsif not Ekind_In (Item_Id, E_In_Out_Parameter,
E_Out_Parameter)
then
Error_Msg_NE
("item & must have mode `IN OUT` or `OUT`", Item, Item_Id);
end if;
-- Output
......
......@@ -3863,6 +3863,138 @@ package body Sem_Util is
end if;
end Deepest_Type_Access_Level;
----------------------------
-- Default_Initialization --
----------------------------
function Default_Initialization
(Typ : Entity_Id) return Default_Initialization_Kind
is
Comp : Entity_Id;
Init : Default_Initialization_Kind;
FDI : Boolean := False;
NDI : Boolean := False;
-- Two flags used to designate whether a record type has at least one
-- fully default initialized component and/or one not fully default
-- initialized component.
begin
-- Access types are always fully default initialized
if Is_Access_Type (Typ) then
return Full_Default_Initialization;
-- An array type subject to aspect/pragma Default_Component_Value is
-- fully default initialized. Otherwise its initialization status is
-- that of its component type.
elsif Is_Array_Type (Typ) then
if Present (Default_Aspect_Component_Value (Base_Type (Typ))) then
return Full_Default_Initialization;
else
return Default_Initialization (Component_Type (Typ));
end if;
-- The initialization status of a private type depends on its full view
elsif Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
return Default_Initialization (Full_View (Typ));
-- Record and protected types offer several initialization options
-- depending on their components (if any).
elsif Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
Comp := First_Component (Typ);
-- Inspect all components
if Present (Comp) then
while Present (Comp) loop
-- Do not process internally generated components except for
-- _parent which represents the ancestor portion of a derived
-- type.
if Comes_From_Source (Comp)
or else Chars (Comp) = Name_uParent
then
Init := Default_Initialization (Base_Type (Etype (Comp)));
-- A component with mixed initialization renders the whole
-- record/protected type mixed.
if Init = Mixed_Initialization then
return Mixed_Initialization;
-- The component is fully default initialized when its type
-- is fully default initialized or when the component has an
-- initialization expression. Note that this has precedence
-- given that the component type may lack initialization.
elsif Init = Full_Default_Initialization
or else Present (Expression (Parent (Comp)))
then
FDI := True;
-- Components with no possible initialization are ignored
elsif Init = No_Possible_Initialization then
null;
-- The component has no full default initialization
else
NDI := True;
end if;
end if;
Next_Component (Comp);
end loop;
-- Detect a mixed case of initialization
if FDI and NDI then
return Mixed_Initialization;
elsif FDI then
return Full_Default_Initialization;
elsif NDI then
return No_Default_Initialization;
-- The type either has no components or they are all internally
-- generated.
else
return No_Possible_Initialization;
end if;
-- The record type is null, there is nothing to initialize
else
return No_Possible_Initialization;
end if;
-- A scalar type subject to aspect/pragma Default_Value is fully default
-- initialized.
elsif Is_Scalar_Type (Typ)
and then Present (Default_Aspect_Value (Base_Type (Typ)))
then
return Full_Default_Initialization;
-- Task types are always fully default initialized
elsif Is_Task_Type (Typ) then
return Full_Default_Initialization;
end if;
-- The type has no full default initialization
return No_Default_Initialization;
end Default_Initialization;
---------------------
-- Defining_Entity --
---------------------
......
......@@ -384,6 +384,40 @@ package Sem_Util is
-- Current_Scope is returned. The returned value is Empty if this is called
-- from a library package which is not within any subprogram.
-- The following type lists all possible forms of default initialization
-- that may apply to a type.
type Default_Initialization_Kind is
(No_Possible_Initialization,
-- This value signifies that a type cannot possibly be initialized
-- because it has no content, for example - a null record.
Full_Default_Initialization,
-- This value covers the following combinations of types and content:
-- * Access type
-- * Array-of-scalars with specified Default_Component_Value
-- * Array type with fully default initialized component type
-- * Record or protected type with components that either have a
-- default expression or their related types are fully default
-- initialized.
-- * Scalar type with specified Default_Value
-- * Task type
-- * Type extension of a type with full default initialization where
-- the extension components are also fully default initialized
Mixed_Initialization,
-- This value applies to a type where some of its internals are fully
-- default initialized and some are not.
No_Default_Initialization);
-- This value reflects a type where none of its content is fully
-- default initialized.
function Default_Initialization
(Typ : Entity_Id) return Default_Initialization_Kind;
-- Determine the default initialization kind that applies to a particular
-- type.
function Deepest_Type_Access_Level (Typ : Entity_Id) return Uint;
-- Same as Type_Access_Level, except that if the type is the type of an Ada
-- 2012 stand-alone object of an anonymous access type, then return the
......
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