+2011-10-13 Cyrille Comar <comar@adacore.com>
+
+ * gnat_ugn.texi: Minor editing.
+
+2011-10-13 Vincent Celier <celier@adacore.com>
+
+ * projects.texi: Add documentation on packages and attributes
+ that are inherited from a project being extended into the
+ extended project.
+
+2011-10-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch3.adb (Build_Master): Rewritten.
+ (Expand_N_Full_Type_Declaration): Reformat the declarative
+ region. Update the call to Build_Master_Renaming.
+ (Expand_Previous_Access_Type): Rewritten.
+ * exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call):
+ Add local constant Result_Subt and update related usage.
+ (Expand_N_Extended_Return_Statement): Add local constant
+ Result_Subt and update related usage.
+ * exp_ch9.adb (Build_Activation_Chain): Rewritten to use the
+ new context detection mechanism.
+ (Build_Class_Wide_Master):
+ Use Insert_Action to add the renaming into the tree.
+ (Build_Master_Entity): Rewritten to use the new context detection
+ mechanism.
+ (Build_Master_Renaming): Add formal parameter Ins_Nod
+ and related usage. Use Insert_Action to add the renaming into the
+ tree.
+ (Find_Enclosing_Context): New subsidiary routine. Rather
+ than relying on enclosing scopes, this routine looks at the
+ tree structure to figure out the proper context for a _master
+ or a _chain. This approach eliminates the issues with transient
+ scopes which have not been converted into blocks.
+ * exp_ch9.ads (Build_Master_Entity): Change parameter profile
+ to better reflect the new usage. Update the related comment.
+ (Build_Master_Renaming): Add formal parameter Ins_Nod. Update
+ the comment on usage.
+ * sem_ch3.adb (Access_Definition): Update the calls to
+ Build_Master_Entity and Build_Master_Renaming.
+ * sem_ch6.adb (Create_Extra_Formals): Add local variable
+ Full_Subt. Code reformatting.
+ * sem_util.adb (Is_Iterator): Alphabetized.
+ (Is_LHS): Alphabetized.
+ (Is_Limited_Class_Wide_Type): New routine.
+ * sem_util.ads (Is_Limited_Class_Wide_Type): New routine.
+
2011-10-13 Geert Bosch <bosch@adacore.com>
* a-ngrear.adb (Solve): Make generic and move to
------------------------------------
procedure Expand_N_Full_Type_Declaration (N : Node_Id) is
- Def_Id : constant Entity_Id := Defining_Identifier (N);
- B_Id : constant Entity_Id := Base_Type (Def_Id);
- FN : Node_Id;
- Par_Id : Entity_Id;
- procedure Build_Master (Def_Id : Entity_Id);
- -- Create the master associated with Def_Id
+ procedure Build_Master (Ptr_Typ : Entity_Id);
+ -- Create the master associated with Ptr_Typ
------------------
-- Build_Master --
------------------
- procedure Build_Master (Def_Id : Entity_Id) is
+ procedure Build_Master (Ptr_Typ : Entity_Id) is
+ Desig_Typ : constant Entity_Id := Designated_Type (Ptr_Typ);
+
begin
-- Anonymous access types are created for the components of the
-- record parameter for an entry declaration. No master is created
-- for such a type.
- if Has_Task (Designated_Type (Def_Id))
- and then Comes_From_Source (N)
+ if Comes_From_Source (N)
+ and then Has_Task (Desig_Typ)
then
- Build_Master_Entity (Def_Id);
- Build_Master_Renaming (Parent (Def_Id), Def_Id);
+ Build_Master_Entity (Ptr_Typ);
+ Build_Master_Renaming (Ptr_Typ);
-- Create a class-wide master because a Master_Id must be generated
-- for access-to-limited-class-wide types whose root may be extended
-- Note: This code covers access-to-limited-interfaces because they
-- can be used to reference tasks implementing them.
- elsif Is_Class_Wide_Type (Designated_Type (Def_Id))
- and then Is_Limited_Type (Designated_Type (Def_Id))
+ elsif Is_Limited_Class_Wide_Type (Desig_Typ)
and then Tasking_Allowed
-- Do not create a class-wide master for types whose convention is
-- Because the convention appears after we have done the
-- processing for type Ref.
- and then Convention (Designated_Type (Def_Id)) /= Convention_Java
- and then Convention (Designated_Type (Def_Id)) /= Convention_CIL
+ and then Convention (Desig_Typ) /= Convention_Java
+ and then Convention (Desig_Typ) /= Convention_CIL
then
- Build_Class_Wide_Master (Def_Id);
+ Build_Class_Wide_Master (Ptr_Typ);
end if;
end Build_Master;
+ -- Local declarations
+
+ Def_Id : constant Entity_Id := Defining_Identifier (N);
+ B_Id : constant Entity_Id := Base_Type (Def_Id);
+ FN : Node_Id;
+ Par_Id : Entity_Id;
+
-- Start of processing for Expand_N_Full_Type_Declaration
begin
if First then
Build_Master_Entity (Def_Id);
- Build_Master_Renaming (N, Typ);
+ Build_Master_Renaming (Typ);
M_Id := Master_Id (Typ);
First := False;
---------------------------------
procedure Expand_Previous_Access_Type (Def_Id : Entity_Id) is
- T : Entity_Id := First_Entity (Current_Scope);
+ Ptr_Typ : Entity_Id := First_Entity (Current_Scope);
begin
- -- Find all access types declared in the current scope, whose
- -- designated type is Def_Id. If it does not have a Master_Id,
- -- create one now.
-
- while Present (T) loop
- if Is_Access_Type (T)
- and then Designated_Type (T) = Def_Id
- and then No (Master_Id (T))
+ -- Find all access types in the current scope whose designated type is
+ -- Def_Id and build master renamings for them.
+
+ while Present (Ptr_Typ) loop
+ if Is_Access_Type (Ptr_Typ)
+ and then Designated_Type (Ptr_Typ) = Def_Id
+ and then No (Master_Id (Ptr_Typ))
then
+ -- Ensure that the designated type has a master
+
Build_Master_Entity (Def_Id);
- Build_Master_Renaming (Parent (Def_Id), T);
+
+ -- Private and incomplete types complicate the insertion of master
+ -- renamings because the access type may precede the full view of
+ -- the designated type. For this reason, the master renamings are
+ -- inserted relative to the designated type.
+
+ Build_Master_Renaming (Ptr_Typ, Ins_Nod => Parent (Def_Id));
end if;
- Next_Entity (T);
+ Next_Entity (Ptr_Typ);
end loop;
end Expand_Previous_Access_Type;
Function_Id : Entity_Id;
Master_Actual : Node_Id)
is
- Loc : constant Source_Ptr := Sloc (Function_Call);
- Actual : Node_Id := Master_Actual;
+ Loc : constant Source_Ptr := Sloc (Function_Call);
+ Result_Subt : constant Entity_Id := Available_View (Etype (Function_Id));
+ Actual : Node_Id := Master_Actual;
begin
-- No such extra parameters are needed if there are no tasks
- if not Has_Task (Available_View (Etype (Function_Id))) then
+ if not Has_Task (Result_Subt) then
return;
end if;
Par_Func : constant Entity_Id :=
Return_Applies_To (Return_Statement_Entity (N));
+ Result_Subt : constant Entity_Id := Etype (Par_Func);
Ret_Obj_Id : constant Entity_Id :=
First_Entity (Return_Statement_Entity (N));
Ret_Obj_Decl : constant Node_Id := Parent (Ret_Obj_Id);
-- built in place (though we plan to do so eventually).
if Present (HSS)
- or else Is_Composite_Type (Etype (Par_Func))
+ or else Is_Composite_Type (Result_Subt)
or else No (Exp)
then
if No (HSS) then
-- the case of result types with task parts.
if Is_Build_In_Place
- and then Has_Task (Etype (Par_Func))
+ and then Has_Task (Result_Subt)
then
-- The return expression is an aggregate for a complex type which
-- contains tasks. This particular case is left unexpanded since
Expand_N_Aggregate (Exp);
end if;
- Append_To (Stmts, Move_Activation_Chain);
+ -- Do not move the activation chain if the return object does not
+ -- contain tasks.
+
+ if Has_Task (Etype (Ret_Obj_Id)) then
+ Append_To (Stmts, Move_Activation_Chain);
+ end if;
end if;
-- Update the state of the function right before the object is
Return_Obj_Typ : constant Entity_Id := Etype (Return_Obj_Id);
Return_Obj_Expr : constant Node_Id :=
Expression (Ret_Obj_Decl);
- Result_Subt : constant Entity_Id := Etype (Par_Func);
Constr_Result : constant Boolean :=
Is_Constrained (Result_Subt);
Obj_Alloc_Formal : Entity_Id;
-- to handle properly the case of bounds that depend on discriminants.
-- If Cap is true, the result is capped according to Entry_Family_Bound.
+ procedure Find_Enclosing_Context
+ (N : Node_Id;
+ Context : out Node_Id;
+ Context_Id : out Entity_Id;
+ Context_Decls : out List_Id);
+ -- Subsidiary routine to procedures Build_Activation_Chain_Entity and
+ -- Build_Master_Entity. Given an arbitrary node in the tree, find the
+ -- nearest enclosing body, block, package or return statement and return
+ -- its constituents. Context is the enclosing construct, Context_Id is
+ -- the scope of Context_Id and Context_Decls is the declarative list of
+ -- Context.
+
procedure Extract_Dispatching_Call
(N : Node_Id;
Call_Ent : out Entity_Id;
-- Local variables
- Decls : List_Id;
- Par : Node_Id;
+ Context : Node_Id;
+ Context_Id : Entity_Id;
+ Decls : List_Id;
-- Start of processing for Build_Activation_Chain_Entity
begin
- -- Traverse the parent chain looking for an enclosing construct which
- -- contains an activation chain variable. The construct is either a
- -- body, a block, or an extended return.
-
- Par := Parent (N);
-
- while not Nkind_In (Par, N_Block_Statement,
- N_Entry_Body,
- N_Extended_Return_Statement,
- N_Package_Body,
- N_Package_Declaration,
- N_Subprogram_Body,
- N_Task_Body)
- loop
- Par := Parent (Par);
- end loop;
-
- -- When the enclosing construct is a package body, the activation chain
- -- variable is declared in the body, but the Activation_Chain_Entity is
- -- attached to the spec.
-
- if Nkind (Par) = N_Package_Body then
- Decls := Declarations (Par);
- Par := Unit_Declaration_Node (Corresponding_Spec (Par));
-
- elsif Nkind (Par) = N_Package_Declaration then
- Decls := Visible_Declarations (Specification (Par));
-
- elsif Nkind (Par) = N_Extended_Return_Statement then
- Decls := Return_Object_Declarations (Par);
-
- else
- Decls := Declarations (Par);
- end if;
+ Find_Enclosing_Context (N, Context, Context_Id, Decls);
-- If an activation chain entity has not been declared already, create
-- one.
- if Nkind (Par) = N_Extended_Return_Statement
- or else No (Activation_Chain_Entity (Par))
+ if Nkind (Context) = N_Extended_Return_Statement
+ or else No (Activation_Chain_Entity (Context))
then
-- Since extended return statements do not store the entity of the
-- chain, examine the return object declarations to avoid creating
-- a duplicate.
- if Nkind (Par) = N_Extended_Return_Statement
- and then Has_Activation_Chain (Par)
+ if Nkind (Context) = N_Extended_Return_Statement
+ and then Has_Activation_Chain (Context)
then
return;
end if;
declare
+ Loc : constant Source_Ptr := Sloc (Context);
Chain : Entity_Id;
Decl : Node_Id;
-- Activate_Tasks. Task activation is the responsibility of the
-- caller.
- if Nkind (Par) /= N_Extended_Return_Statement then
- Set_Activation_Chain_Entity (Par, Chain);
+ if Nkind (Context) /= N_Extended_Return_Statement then
+ Set_Activation_Chain_Entity (Context, Chain);
end if;
Decl :=
- Make_Object_Declaration (Sloc (Par),
+ Make_Object_Declaration (Loc,
Defining_Identifier => Chain,
Aliased_Present => True,
Object_Definition =>
- New_Reference_To (RTE (RE_Activation_Chain), Sloc (Par)));
+ New_Reference_To (RTE (RE_Activation_Chain), Loc));
Prepend_To (Decls, Decl);
- Analyze (Decl);
+
+ -- Ensure that the _chain appears in the proper scope of the
+ -- context.
+
+ if Context_Id /= Current_Scope then
+ Push_Scope (Context_Id);
+ Analyze (Decl);
+ Pop_Scope;
+ else
+ Analyze (Decl);
+ end if;
end;
end if;
end Build_Activation_Chain_Entity;
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Name => Name_Id);
- Insert_Before (Related_Node, Ren_Decl);
- Analyze (Ren_Decl);
+ Insert_Action (Related_Node, Ren_Decl);
Set_Master_Id (Typ, Master_Id);
end Build_Class_Wide_Master;
-- Build_Master_Entity --
-------------------------
- procedure Build_Master_Entity
- (Id : Entity_Id;
- Use_Current : Boolean := False)
- is
- Loc : constant Source_Ptr := Sloc (Id);
- Context : Node_Id;
- Master_Decl : Node_Id;
- Master_Scop : Entity_Id;
+ procedure Build_Master_Entity (Obj_Or_Typ : Entity_Id) is
+ Loc : constant Source_Ptr := Sloc (Obj_Or_Typ);
+ Context : Node_Id;
+ Context_Id : Entity_Id;
+ Decl : Node_Id;
+ Decls : List_Id;
+ Par : Node_Id;
begin
- if Use_Current then
- Master_Scop := Current_Scope;
+ if Is_Itype (Obj_Or_Typ) then
+ Par := Associated_Node_For_Itype (Obj_Or_Typ);
else
- Master_Scop := Find_Master_Scope (Id);
+ Par := Parent (Obj_Or_Typ);
end if;
- -- Do not create a master if the enclosing scope already has one or if
- -- there is no task hierarchy.
+ -- When creating a master for a record component which is either a task
+ -- or access-to-task, the enclosing record is the master scope and the
+ -- proper insertion point is the component list.
- if Has_Master_Entity (Master_Scop)
- or else Restriction_Active (No_Task_Hierarchy)
- then
- return;
- end if;
+ if Is_Record_Type (Current_Scope) then
+ Context := Par;
+ Context_Id := Current_Scope;
+ Decls := List_Containing (Context);
- -- Determine the proper context to insert the master
+ -- Default case for object declarations and access types. Note that the
+ -- context is updated to the nearest enclosing body, block, package or
+ -- return statement.
- if Is_Access_Type (Id) and then Is_Itype (Id) then
- Context := Associated_Node_For_Itype (Id);
else
- Context := Parent (Id);
+ Find_Enclosing_Context (Par, Context, Context_Id, Decls);
+ end if;
+
+ -- Do not create a master if one already exists or there is no task
+ -- hierarchy.
+
+ if Has_Master_Entity (Context_Id)
+ or else Restriction_Active (No_Task_Hierarchy)
+ then
+ return;
end if;
-- Create a master, generate:
-- _Master : constant Master_Id := Current_Master.all;
- Master_Decl :=
+ Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uMaster),
Make_Explicit_Dereference (Loc,
New_Reference_To (RTE (RE_Current_Master), Loc)));
- Insert_Before (Context, Master_Decl);
- Analyze (Master_Decl);
+ -- The master is inserted at the start of the declarative list of the
+ -- context.
- -- Mark enclosing scope and its associated construct as task masters
+ Prepend_To (Decls, Decl);
- Set_Has_Master_Entity (Master_Scop);
+ -- In certain cases where transient scopes are involved, the immediate
+ -- scope is not always the proper master scope. Ensure that the master
+ -- declaration and entity appear in the same context.
- while Nkind (Context) /= N_Compilation_Unit loop
- Context := Parent (Context);
+ if Context_Id /= Current_Scope then
+ Push_Scope (Context_Id);
+ Analyze (Decl);
+ Pop_Scope;
+ else
+ Analyze (Decl);
+ end if;
+
+ -- Mark the enclosing scope and its associated construct as being task
+ -- masters.
- -- If we fall off the top, we are at the outer level, and the
- -- environment task is our effective master, so nothing to mark.
+ Set_Has_Master_Entity (Context_Id);
+ while Present (Context)
+ and then Nkind (Context) /= N_Compilation_Unit
+ loop
if Nkind_In (Context, N_Block_Statement,
N_Subprogram_Body,
N_Task_Body)
then
- Set_Is_Task_Master (Context, True);
- return;
+ Set_Is_Task_Master (Context);
+ exit;
elsif Nkind (Parent (Context)) = N_Subunit then
Context := Corresponding_Stub (Parent (Context));
end if;
+
+ Context := Parent (Context);
end loop;
end Build_Master_Entity;
-- Build_Master_Renaming --
---------------------------
- procedure Build_Master_Renaming (N : Node_Id; Typ : Entity_Id) is
- Loc : constant Source_Ptr := Sloc (N);
+ procedure Build_Master_Renaming
+ (Ptr_Typ : Entity_Id;
+ Ins_Nod : Node_Id := Empty)
+ is
+ Loc : constant Source_Ptr := Sloc (Ptr_Typ);
+ Context : Node_Id;
Master_Decl : Node_Id;
Master_Id : Entity_Id;
return;
end if;
+ -- Determine the proper context to insert the master renaming
+
+ if Present (Ins_Nod) then
+ Context := Ins_Nod;
+ elsif Is_Itype (Ptr_Typ) then
+ Context := Associated_Node_For_Itype (Ptr_Typ);
+ else
+ Context := Parent (Ptr_Typ);
+ end if;
+
+ -- Generate:
+ -- <Ptr_Typ>M : Master_Id renames _Master;
+
Master_Id :=
Make_Defining_Identifier (Loc,
- New_External_Name (Chars (Typ), 'M'));
+ New_External_Name (Chars (Ptr_Typ), 'M'));
Master_Decl :=
Make_Object_Renaming_Declaration (Loc,
Subtype_Mark => New_Reference_To (RTE (RE_Master_Id), Loc),
Name => Make_Identifier (Loc, Name_uMaster));
- Insert_Before (N, Master_Decl);
- Analyze (Master_Decl);
+ Insert_Action (Context, Master_Decl);
- Set_Master_Id (Typ, Master_Id);
+ -- The renamed master now services the access type
+
+ Set_Master_Id (Ptr_Typ, Master_Id);
end Build_Master_Renaming;
-----------------------------------------
Make_Object_Declaration (Loc,
Defining_Identifier => Chain,
- Aliased_Present => True,
+ Aliased_Present => True,
Object_Definition =>
New_Reference_To (RTE (RE_Activation_Chain), Loc))),
Make_Integer_Literal (Loc, 0)));
end Family_Size;
+ ----------------------------
+ -- Find_Enclosing_Context --
+ ----------------------------
+
+ procedure Find_Enclosing_Context
+ (N : Node_Id;
+ Context : out Node_Id;
+ Context_Id : out Entity_Id;
+ Context_Decls : out List_Id)
+ is
+ begin
+ -- Traverse the parent chain looking for an enclosing body, block,
+ -- package or return statement.
+
+ Context := Parent (N);
+ while not Nkind_In (Context, N_Block_Statement,
+ N_Entry_Body,
+ N_Extended_Return_Statement,
+ N_Package_Body,
+ N_Package_Declaration,
+ N_Subprogram_Body,
+ N_Task_Body)
+ loop
+ Context := Parent (Context);
+ end loop;
+
+ -- Extract the constituents of the context
+
+ if Nkind (Context) = N_Extended_Return_Statement then
+ Context_Decls := Return_Object_Declarations (Context);
+ Context_Id := Return_Statement_Entity (Context);
+
+ -- Package declarations and bodies use a common library-level activation
+ -- chain or task master, therefore return the package declaration as the
+ -- proper carrier for the appropriate flag.
+
+ elsif Nkind (Context) = N_Package_Body then
+ Context_Decls := Declarations (Context);
+ Context_Id := Corresponding_Spec (Context);
+ Context := Parent (Context_Id);
+
+ if Nkind (Context) = N_Defining_Program_Unit_Name then
+ Context := Parent (Parent (Context));
+ else
+ Context := Parent (Context);
+ end if;
+
+ elsif Nkind (Context) = N_Package_Declaration then
+ Context_Decls := Visible_Declarations (Specification (Context));
+ Context_Id := Defining_Unit_Name (Specification (Context));
+
+ if Nkind (Context_Id) = N_Defining_Program_Unit_Name then
+ Context_Id := Defining_Identifier (Context_Id);
+ end if;
+
+ else
+ Context_Decls := Declarations (Context);
+
+ if Nkind (Context) = N_Block_Statement then
+ Context_Id := Entity (Identifier (Context));
+
+ elsif Nkind (Context) = N_Entry_Body then
+ Context_Id := Defining_Identifier (Context);
+
+ elsif Nkind (Context) = N_Subprogram_Body then
+ if Present (Corresponding_Spec (Context)) then
+ Context_Id := Corresponding_Spec (Context);
+ else
+ Context_Id := Defining_Unit_Name (Specification (Context));
+
+ if Nkind (Context_Id) = N_Defining_Program_Unit_Name then
+ Context_Id := Defining_Identifier (Context_Id);
+ end if;
+ end if;
+
+ elsif Nkind (Context) = N_Task_Body then
+ Context_Id := Corresponding_Spec (Context);
+
+ else
+ raise Program_Error;
+ end if;
+ end if;
+
+ pragma Assert (Present (Context));
+ pragma Assert (Present (Context_Id));
+ pragma Assert (Present (Context_Decls));
+ end Find_Enclosing_Context;
+
-----------------------
-- Find_Master_Scope --
-----------------------
-- protected type. The statements are wrapped inside a block due to a local
-- declaration.
- procedure Build_Master_Entity
- (Id : Entity_Id;
- Use_Current : Boolean := False);
+ procedure Build_Master_Entity (Obj_Or_Typ : Entity_Id);
-- Given the name of an object or a type which is either a task, contains
-- tasks or designates tasks, create a _master in the appropriate scope
- -- which captures the value of Current_Master. Mark the enclosing body as
- -- being a task master. A _master is built to avoid multiple expensive
- -- calls to Current_Master and to facilitate object initialization. Flag
- -- Use_Current ensures that the master scope is the current scope.
-
- procedure Build_Master_Renaming (N : Node_Id; Typ : Entity_Id);
- -- Given an access type Typ and a declaration N of a designated type that
- -- is either a task or contains tasks, create a renaming of the form:
+ -- which captures the value of Current_Master. Mark the nearest enclosing
+ -- body or block as being a task master.
+
+ procedure Build_Master_Renaming
+ (Ptr_Typ : Entity_Id;
+ Ins_Nod : Node_Id := Empty);
+ -- Given an access type Ptr_Typ whose designated type is either a task or
+ -- contains tasks, create a renaming of the form:
--
- -- TypM : Master_Id renames _Master;
+ -- <Ptr_Typ>M : Master_Id renames _Master;
--
- -- where _master denotes the task master of the enclosing context. The
- -- renaming declaration is inserted before N.
+ -- where _master denotes the task master of the enclosing context. Ins_Nod
+ -- is used to provide a specific insertion node for the renaming.
function Build_Private_Protected_Declaration (N : Node_Id) return Entity_Id;
-- A subprogram body without a previous spec that appears in a protected
* Stack Related Facilities::
* Verifying Properties Using gnatcheck::
* Creating Sample Bodies Using gnatstub::
-* Creating Test Drivers Using gnattest::
+* Creating Unit Tests Using gnattest::
* Generating Ada Bindings for C and C++ headers::
* Other Utility Programs::
* Running and Debugging Ada Programs::
* Running gnatstub::
* Switches for gnatstub::
-Creating Test Drivers Using gnattest
+Creating Unit Tests Using gnattest
* Running gnattest::
* Switches for gnattest::
* Project Attributes for gnattest::
-* Simple Test Driver::
+* Simple Example::
* Setting Up and Tearing Down Testing Environment::
-* Reusing Previously Written Tests::
+* Regenerating Tests::
* Default Test Behavior::
* Testing Primitive Operations of Tagged Types::
* Test Inheritance::
-* Liskov Substitution Principle Check::
+* Tagged Types Substitutability Testing::
* Testing with Contracts::
* Additional Tests::
* Current Limitations::
a utility that generates empty but compilable bodies for library units.
@item
-@ref{Creating Test Drivers Using gnattest}, discusses @code{gnattest},
+@ref{Creating Unit Tests Using gnattest}, discusses @code{gnattest},
a utility that generates unit testing templates for library units.
@item
@end table
@c *********************************
-@node Creating Test Drivers Using gnattest
-@chapter Creating Test Drivers Using @command{gnattest}
+@node Creating Unit Tests Using gnattest
+@chapter Creating Unit Tests Using @command{gnattest}
@findex gnattest
@noindent
-@command{gnattest} is an ASIS-based utility that creates template tests
-(test stubs) as well as test driver infrastructure (harness) for unit testing
-of Ada source code.
+@command{gnattest} is an ASIS-based utility that creates unit tests stubs
+as well as a test driver infrastructure (harness). @command{gnattest} creates
+a stub for each visible subprogram in the packages under consideration when
+they do not exist already.
In order to process source files from the project, @command{gnattest} has to
-semantically analyze these Ada sources. Therefore, test templates can only be
+semantically analyze these Ada sources. Therefore, test stubs can only be
generated for legal Ada units. If a unit is dependent on some other units,
those units should be among source files of the project or of other projects
imported by this one.
-Generated stubs and harness are based on AUnit testing framework. AUnit
-framework is an Ada adaptation of Java and C++ unit testing frameworks.
-While it is advised that gnattest users read AUnit manual, deep knowledge
-of AUnit is not necessary for using gnattest. For correct operation of
-@command{gnattest} AUnit should be installed on default project path.
-
+Generated stubs and harness are based on the AUnit testing framework. AUnit is
+an Ada adaptation of the xxxUnit testing frameworks similar to JUnit for Java or
+CppUnit for C++. While it is advised that gnattest users read AUnit manual, deep
+knowledge of AUnit is not necessary for using gnattest. For correct operation of
+@command{gnattest} AUnit should be installed and aunit.gpr must be on the
+project path. This happens automatically when Aunit is installed at its default
+location.
@menu
* Running gnattest::
* Switches for gnattest::
* Project Attributes for gnattest::
-* Simple Test Driver::
+* Simple Example::
* Setting Up and Tearing Down Testing Environment::
-* Reusing Previously Written Tests::
+* Regenerating Tests::
* Default Test Behavior::
* Testing Primitive Operations of Tagged Types::
* Test Inheritance::
-* Liskov Substitution Principle Check::
+* Tagged Types Substitutability Testing::
* Testing with Contracts::
* Additional Tests::
* Current Limitations::
@command{gnattest} has the command-line interface of the form
@smallexample
-@c $ gnattest @var{-Pprojname} @ovar{switches} @var{filename} @ovar{directory}
+@c $ gnattest @var{-Pprojname} @ovar{switches} @ovar{filename} @ovar{directory}
@c Expanding @ovar macro inline (explanation in macro def comments)
-$ gnattest @var{-Pprojname} @r{[}@var{--harness-dir=dirname}@r{]} @r{[}@var{switches}@r{]} @var{filename} @r{[}-cargs @var{gcc_switches}@r{]}
+$ gnattest @var{-Pprojname} @r{[}@var{--harness-dir=dirname}@r{]} @r{[}@var{switches}@r{]} @r{[}@var{filename}@r{]} @r{[}-cargs @var{gcc_switches}@r{]}
@end smallexample
@noindent
@table @var
@item -Pprojname
-specifies the project that allow locating the source files. If no [filenames]
-are provided on the command line, all project sources are used as input.
+specifies the project that allow locating the source files. When no [filenames]
+are provided on the command line, all project sources are used as input. This
+switch is mandatory.
@item --harness-dir=dirname
specifies directory to put harness packages and project file for the test
@end table
+@command{gnattest} results can be found in two different places.
+
+@itemize @bullet
+@item automatic harness
+the harnessing code which is located in the harness-dir as specified on the
+comand line or in the project file. All this code is generated completely
+automatically and can be destroyed and regenerated at will. It is not
+recommended to modify manually this code since it might be overridden
+easily. The entry point in this harnessing code is the project file called
+@command{test_driver.gpr}. Tests can be compiled and run using a command
+such as:
+
+@smallexample
+gnatmake -P<harness-dir>/test_driver
+test_runner
+@end smallexample
+
+@item actual unit test stubs
+a test stub for each visible subprogram is created in a separate file, if it
+doesn't exist already. By default, those separate test files are located in a
+"tests" directory that is created in the directory containing the source file
+itself. if it is not appropriate to create the tests in subdirs of the source,
+option @option{--separate-root} can be used. So let say for instance that
+a source file my_unit.ads in directory src contains a visible subprogram Proc.
+Then, the corresponding unit test will be found in file
+src/tests/my_unit-tests-proc_<code>.adb. <code> is an signature encoding used to
+differentiate test names in case of overloading.
+@end itemize
+
@node Switches for gnattest
@section Switches for @command{gnattest}
@end table
-Separate root ans subdir output modes cannot be used at the same time.
+@option{--separate_root} and @option{--subdir} switches are mutually exclusive.
@node Project Attributes for gnattest
@section Project Attributes for @command{gnattest}
Other @command{gnattest} switches can also be passed via the project
file as an attribute list called GNATtest_Switches.
-@node Simple Test Driver
-@section Simple Test Driver
+@node Simple Example
+@section Simple Example
@noindent
-@command{gnattest} works with package specifications. The basic functionality
-of @command{gnattest} is creating one test stub per one subprogram declared
-in package specification. This can be observes on a very simple example
+Let's take a very simple example using the first @command{gnattest} example
located at
@smallexample
-examples/lib1
+<install_prefix>/share/examples/gnattest/lib1
@end smallexample
-This is a simple package containing one subprogram. By running gnattest
+This project contains a simple package containing one subprogram. By running gnattest
@smallexample
$ gnattest --harness-dir=driver -Plib1.gpr
@end smallexample
-a test driver is created. It can be compiled and run:
+a test driver is created in dir "driver". It can be compiled and run:
@smallexample
$ cd driver
is located in
@smallexample
-examples/lib1/src/tests
+<install_prefix>/share/examples/gnattest/lib1/src/tests
@end smallexample
-For each package containing testable subprograms a child test package is
+For each package containing visible subprograms, a child test package is
generated. It contains one test routine per tested subprogram. Each
-declaration of test subprogram has a comment cpecifying to which tested
+declaration of test subprogram has a comment specifying to which tested
subprogram it corresponds. All the test routines have separated bodies.
The test routine locates at lib1-tests-test_inc_5eaee3.adb has a single
statement - procedure Assert. It has two arguments: the boolean expression
is false.
That is where actual testing code should be written after a proper setup.
-An actual check can be performed by replacing the stubbing code with
+An actual check can be performed by replacing the assert statement with
@smallexample @c ada
Assert (Inc (1) = 2, "wrong incrementation");
be used to perform necessary initialization and finalization,
memory allocation etc.
-@node Reusing Previously Written Tests
-@section Reusing Previously Written Tests
+@node Regenerating Tests
+@section Regenerating Tests
@noindent
Bodies of test routines and env_mgmt packages are never overridden after they
-were created once. As long as the name of the subprogram, full expanded Ada
-names and order of it's parameters are the same, the old test routine will
-fit in it's place.
+have been created once. As long as the name of the subprogram, full expanded Ada
+names and order of its parameters are the same, the old test routine will
+fit in it's place and no test stub will be generated for this subprogram.
-This can be demonstrated with the presious example. By uncommenting declaration
+This can be demonstrated with the previous example. By uncommenting declaration
and body of function Dec in lib1.ads and lib1.adb, running
@command{gnattest} on the project and then running the test driver:
test_runner
@end smallexample
-the old test is not replaced with a stub neither lost.
+the old test is not replaced with a stub neither lost but a new test stub is
+created for function Dec.
+
+The only way for regenerating tests stubs is t oremove the previously created
+tests.
@node Default Test Behavior
@section Default Test Behavior
Passing it to the driver generated on the first example
@smallexample
-test_runer --stub-default=pass
+test_runner --stub-default=pass
@end smallexample
makes both tests pass, even the unimplemented one.
The User_Set_Up procedure of Env_Mgmt package corresponding to a test package
of primitive operations of type T assigns Fixture with a reference to an
object of that exact type T. Notice however, that if the tagged type has
-discriminants, the User_Set_Up does has only a commented template of setting
-up the fixture since filling th discriminant with actual value is up
+discriminants, the User_Set_Up only has a commented template of setting
+up the fixture since filling the discriminant with actual value is up
to the user.
The knowledge of the structure if test types allows to have additional testing
@noindent
-Since test type hierarchy repeats the hierarchy of tested types, the
+Since test type hierarchy mimics the hierarchy of tested types, the
inheritance of tests take place. An example of such inheritance can be
shown by running the test driver generated for second example. As previously
mentioned, actual tests are already written for this example.
routine for function Speed has been inherited and ran against objects of the
derived type.
-@node Liskov Substitution Principle Check
-@section Liskov Substitution Principle Check
+@node Tagged Types Substitutability Testing
+@section Tagged Types Substitutability Testing
@noindent
-Liskov substitution principle (LSP) is a principle in object-oriented
-programming. It states that, in a computer program if S is a subtype of T,
+Tagged Types Substitutability Testing is a way of verifying by testing
+the Liskov substitution principle (LSP). LSP is a principle stating that if
+S is a subtype of T (in Ada, S is a derived type of tagged type T),
then objects of type T may be replaced with objects of type S (i.e., objects
-of type S may be substitutes for objects of type T), without altering any of
-the desirable properties of that program.
-
-In the example used for previous section there clearly have a violation of LSP.
-The overriding function Adjust_Speed in package Speed2 removes the
-functionality of the overridden function. Gnattest has a special option to run
+of type S may be substituted for objects of type T), without altering any of
+the desirable properties of the program. When the properties of the program are
+expressed in the form of subprogram pre & postconditions, LSP is formulated
+as relations between the pre & post of primitive operations and the pre & post
+of theirs derived operations. The pre of a derived operation should not be
+stronger that the original pre, and the post of the derived operation should not
+be weaker than the original post. Those relations insure that verifying if a
+dyspatching call is safe can be done just with the pre & post of the root
+operation.
+
+Verifying LSP by testing consists in running all the unit tests associated with
+the primitives of a given tagged type with objects of its derived types.
+
+In the example used by the previous section there clearly have a violation of LSP.
+The overriding primitive Adjust_Speed in package Speed2 removes the
+functionality of the overridden primitive and thus doesn't respect LSP.
+Gnattest has a special option to run
overridden parent tests against objects of the type which have overriding
primitives.
"requires" and "ensures" of the Test_Case (depending on the mode pre- and post
either count for Nominal mode or do not for Robustness mode).
-The thirg example demonstrates how it works:
+The third example demonstrates how it works:
@smallexample
cd examples/lib3
@end smallexample
@noindent
-An extending project retains all the switches specified in the
-extended project.
+All packages that are not declared in the extending project are inherited from
+the project being extended, with their attributes, with the exception of
+@code{Linker'Linker_Options} which is never inherited. In particular, an
+extending project retains all the switches specified in the project being
+extended.
+
+At the project level, if they are not declared in the extending project, some
+attributes are inherited from the project being extended. They are:
+@code{Languages}, @code{Main} (for a root non library project) and
+@code{Library_Name} (for a project extending a library project)
@menu
* Project Hierarchy Extension::
-- proper Master for the created tasks.
if Nkind (Related_Nod) = N_Object_Declaration
- and then Expander_Active
+ and then Expander_Active
then
if Is_Interface (Desig_Type)
and then Is_Limited_Record (Desig_Type)
elsif Has_Task (Desig_Type)
and then Comes_From_Source (Related_Nod)
- and then not Restriction_Active (No_Task_Hierarchy)
then
- Build_Master_Entity (Defining_Identifier (Related_Nod), True);
- Build_Master_Renaming (Related_Nod, Anon_Type);
+ Build_Master_Entity (Defining_Identifier (Related_Nod));
+ Build_Master_Renaming (Anon_Type);
end if;
end if;
if Ada_Version >= Ada_2005 and then Is_Build_In_Place_Function (E) then
declare
Result_Subt : constant Entity_Id := Etype (E);
+ Full_Subt : constant Entity_Id := Available_View (Result_Subt);
- Discard : Entity_Id;
+ Discard : Entity_Id;
pragma Warnings (Off, Discard);
+ Formal_Typ : Entity_Id;
begin
-- In the case of functions with unconstrained result subtypes,
-- master of the tasks to be created, and the caller's activation
-- chain.
- if Has_Task (Available_View (Result_Subt)) then
+ if Has_Task (Full_Subt) then
Discard :=
Add_Extra_Formal
(E, RTE (RE_Master_Id),
-- All build-in-place functions get an extra formal that will be
-- passed the address of the return object within the caller.
- declare
- Formal_Type : constant Entity_Id :=
- Create_Itype
- (E_Anonymous_Access_Type, E,
- Scope_Id => Scope (E));
- begin
- Set_Directly_Designated_Type (Formal_Type, Result_Subt);
- Set_Etype (Formal_Type, Formal_Type);
- Set_Depends_On_Private
- (Formal_Type, Has_Private_Component (Formal_Type));
- Set_Is_Public (Formal_Type, Is_Public (Scope (Formal_Type)));
- Set_Is_Access_Constant (Formal_Type, False);
+ Formal_Typ :=
+ Create_Itype (E_Anonymous_Access_Type, E, Scope_Id => Scope (E));
- -- Ada 2005 (AI-50217): Propagate the attribute that indicates
- -- the designated type comes from the limited view (for
- -- back-end purposes).
+ Set_Directly_Designated_Type (Formal_Typ, Result_Subt);
+ Set_Etype (Formal_Typ, Formal_Typ);
+ Set_Depends_On_Private
+ (Formal_Typ, Has_Private_Component (Formal_Typ));
+ Set_Is_Public (Formal_Typ, Is_Public (Scope (Formal_Typ)));
+ Set_Is_Access_Constant (Formal_Typ, False);
- Set_From_With_Type (Formal_Type, From_With_Type (Result_Subt));
+ -- Ada 2005 (AI-50217): Propagate the attribute that indicates
+ -- the designated type comes from the limited view (for back-end
+ -- purposes).
- Layout_Type (Formal_Type);
+ Set_From_With_Type (Formal_Typ, From_With_Type (Result_Subt));
- Discard :=
- Add_Extra_Formal
- (E, Formal_Type, E, BIP_Formal_Suffix (BIP_Object_Access));
- end;
+ Layout_Type (Formal_Typ);
+
+ Discard :=
+ Add_Extra_Formal
+ (E, Formal_Typ, E, BIP_Formal_Suffix (BIP_Object_Access));
end;
end if;
end Create_Extra_Formals;
end if;
end Is_Fully_Initialized_Variant;
+ ----------------------------
+ -- Is_Inherited_Operation --
+ ----------------------------
+
+ function Is_Inherited_Operation (E : Entity_Id) return Boolean is
+ Kind : constant Node_Kind := Nkind (Parent (E));
+ begin
+ pragma Assert (Is_Overloadable (E));
+ return Kind = N_Full_Type_Declaration
+ or else Kind = N_Private_Extension_Declaration
+ or else Kind = N_Subtype_Declaration
+ or else (Ekind (E) = E_Enumeration_Literal
+ and then Is_Derived_Type (Etype (E)));
+ end Is_Inherited_Operation;
+
+ -------------------------------------
+ -- Is_Inherited_Operation_For_Type --
+ -------------------------------------
+
+ function Is_Inherited_Operation_For_Type
+ (E : Entity_Id; Typ : Entity_Id) return Boolean
+ is
+ begin
+ return Is_Inherited_Operation (E)
+ and then Etype (Parent (E)) = Typ;
+ end Is_Inherited_Operation_For_Type;
+
-----------------
-- Is_Iterator --
-----------------
end if;
end Is_LHS;
- ----------------------------
- -- Is_Inherited_Operation --
- ----------------------------
-
- function Is_Inherited_Operation (E : Entity_Id) return Boolean is
- Kind : constant Node_Kind := Nkind (Parent (E));
- begin
- pragma Assert (Is_Overloadable (E));
- return Kind = N_Full_Type_Declaration
- or else Kind = N_Private_Extension_Declaration
- or else Kind = N_Subtype_Declaration
- or else (Ekind (E) = E_Enumeration_Literal
- and then Is_Derived_Type (Etype (E)));
- end Is_Inherited_Operation;
-
- -------------------------------------
- -- Is_Inherited_Operation_For_Type --
- -------------------------------------
-
- function Is_Inherited_Operation_For_Type
- (E : Entity_Id; Typ : Entity_Id) return Boolean
- is
- begin
- return Is_Inherited_Operation (E)
- and then Etype (Parent (E)) = Typ;
- end Is_Inherited_Operation_For_Type;
-
-----------------------------
-- Is_Library_Level_Entity --
-----------------------------
return Enclosing_Dynamic_Scope (E) = Standard_Standard;
end Is_Library_Level_Entity;
+ --------------------------------
+ -- Is_Limited_Class_Wide_Type --
+ --------------------------------
+
+ function Is_Limited_Class_Wide_Type (Typ : Entity_Id) return Boolean is
+ begin
+ return
+ Is_Class_Wide_Type (Typ)
+ and then Is_Limited_Type (Typ);
+ end Is_Limited_Class_Wide_Type;
+
---------------------------------
-- Is_Local_Variable_Reference --
---------------------------------
-- A library-level declaration is one that is accessible from Standard,
-- i.e. a library unit or an entity declared in a library package.
+ function Is_Limited_Class_Wide_Type (Typ : Entity_Id) return Boolean;
+ -- Given an arbitrary type, determine whether it is a limited class-wide
+ -- type.
+
function Is_Local_Variable_Reference (Expr : Node_Id) return Boolean;
-- Determines whether Expr is a reference to a variable or IN OUT mode
-- parameter of the current enclosing subprogram.
projects / gcc.git / commitdiff