1:mod:`Ahven.Framework` -- Package 2================================= 3 4.. ada:module:: Ahven.Framework 5.. moduleauthor:: Tero Koskinen <tero.koskinen@iki.fi> 6.. highlight:: ada 7 8 9----- 10Types 11----- 12 13Test_Count_Type 14''''''''''''''' 15 16.. .. xada:type:: type Test_Count_Type is new Natural; 17 18:: 19 20 type Test_Count_Type is new Natural; 21 22Type for the test count. This effectively 23limits the amount tests to whatever Natural is. 24 25Although, in practice when adding tests the limit 26is not checked. 27 28Test_Duration 29''''''''''''' 30 31:: 32 33 subtype Test_Duration is Duration range 0.0 .. Three_Hours; 34 35Subtype for the test timeouts. Limited to 3 hours, which 36should be enough for unit tests. Timeout value 0.0 means infinite time. 37 38 39Test 40'''' 41 42:: 43 44 type Test is abstract new Ada.Finalization.Controlled with null record; 45 46.. .. xada:type:: type Test is abstract new Ada.Finalization.Controlled with null record; 47 48 A type, which provides the base for Test_Case and Test_Suite types. 49 50Test_Class_Access 51''''''''''''''''' 52 53:: 54 55 type Test_Class_Access is access all Test'Class; 56 57An access type for Test'Class. 58 59Test_Case 60''''''''' 61 62:: 63 64 type Test_Case is abstract new Test with private; 65 66The base type for other test cases. 67 68Object_Test_Routine_Access 69'''''''''''''''''''''''''' 70 71:: 72 73 type Object_Test_Routine_Access is 74 access procedure (T : in out Test_Case'Class); 75 76A pointer to a test routine which takes Test_Case'Class object 77as an argument. 78 79For this kind of test routines, the framework will 80call Set_Up and Tear_Down routines before and after 81test routine execution. 82 83Simple_Test_Routine_Access 84'''''''''''''''''''''''''' 85 86:: 87 88 type Simple_Test_Routine_Access is access procedure; 89 90A pointer to a test routine which does not take arguments. 91 92Test_Suite 93'''''''''' 94 95:: 96 97 type Test_Suite is new Test with private; 98 99A collection of Tests. 100 101You can either fill a Test_Suite object with Test_Case objects 102or nest multiple Test_Suite objects. You can even mix 103Test_Case and Test_Suite objects, if necessary. 104 105Test_Suite_Access 106''''''''''''''''' 107 108:: 109 110 type Test_Suite_Access is access all Test_Suite; 111 112An access type for Test_Suite. 113 114 115 116------------------------ 117Procedures and functions 118------------------------ 119 120Set_Up 121'''''' 122 123:: 124 125 procedure Set_Up (T : in out Test); 126 127.. .. xada:procedure:: procedure Set_Up (T : in out Test); 128 129 Set_Up is called before executing the test procedure. 130 131 :param T: Test to be set up. 132 133Tear_Down 134''''''''' 135 136:: 137 138 procedure Tear_Down (T : in out Test); 139 140Tear_Down is called after the test procedure is executed. 141 142Get_Name 143'''''''' 144 145:: 146 147 function Get_Name (T : Test) return String is abstract; 148 149.. .. xada:function:: function Get_Name (T : Test) return String is abstract; 150 151 Return the name of the test. 152 153 :param T: The test object. 154 155Run 156''' 157 158:: 159 160 procedure Run (T : in out Test; 161 Listener : in out Listeners.Result_Listener'Class); 162 163.. .. xada:procedure:: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); 164 165 Run the test and place the test result to Result. Infinite timeout. 166 167 :param T: The test object to run. 168 :param Listener: The listener which will be called during the test execution. 169 170Run 171''' 172 173:: 174 175 procedure Run (T : in out Test; 176 Listener : in out Listeners.Result_Listener'Class; 177 Timeout : Test_Duration) 178 is abstract; 179 180.. .. xada:procedure:: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); 181 182 Run the test and place the test result to Result. 183 184 :param T: The test object to run. 185 :param Listener: The listener which will be called during the test execution. 186 :param Timeout: Time limit for the test. 187 188 189Run 190''' 191 192:: 193 194 procedure Run (T : in out Test; 195 Test_Name : String; 196 Listener : in out Listeners.Result_Listener'Class); 197 198Run the test with given name and place the test result to Result. 199Notice: If multiple tests have same name this might call all of 200them. 201 202 203Run 204''' 205 206:: 207 208 procedure Run (T : in out Test; 209 Test_Name : String; 210 Listener : in out Listeners.Result_Listener'Class; 211 Timeout : Test_Duration) 212 is abstract; 213 214Run the test with given name and place the test result to Result. 215Notice: If multiple tests have same name this might call all of 216them. Timeout specifies maximum execution time for the tests. 217 218 219 :param T: The test object to run. 220 :param Test_Name: The name of the test which will be run. 221 :param Listener: The listener which will be called during the test execution. 222 :param Timeout: Time limit for the test. 223 224 225Test_Count 226'''''''''' 227 228:: 229 230 function Test_Count (T : Test) return Test_Count_Type is abstract; 231 232Return the amount of tests (test routines) which will be executed when 233the Run (T) procedure is called. 234 235Test_Count 236'''''''''' 237 238:: 239 240 function Test_Count (T : Test; Test_Name : String) 241 return Test_Count_Type is abstract; 242 243Return the amount of tests (test routines) which will be executed when 244the Run (T, Test_Name) procedure is called. 245 246Execute 247''''''' 248 249:: 250 251 procedure Execute (T : in out Test'Class; 252 Listener : in out Listeners.Result_Listener'Class); 253 254Call Test class' Run method and place the test outcome to Result. 255The procedure calls Start_Test of every listener before calling 256the Run procedure and End_Test after calling the Run procedure. 257 258Execute 259''''''' 260 261:: 262 263 procedure Execute (T : in out Test'Class; 264 Listener : in out Listeners.Result_Listener'Class; 265 Timeout : Test_Duration); 266 267Call Test class' Run method and place the test outcome to Result. 268The procedure calls Start_Test of every listener before calling 269the Run procedure and End_Test after calling the Run procedure. 270Timeout specifies the maximum execution time for each test. 271 272 273Execute 274''''''' 275 276:: 277 278 procedure Execute (T : in out Test'Class; 279 Test_Name : String; 280 Listener : in out Listeners.Result_Listener'Class); 281 282Same as Execute above, but call the Run procedure which 283takes Test_Name parameter. 284 285Execute 286''''''' 287 288:: 289 290 procedure Execute (T : in out Test'Class; 291 Test_Name : String; 292 Listener : in out Listeners.Result_Listener'Class; 293 Timeout : Test_Duration); 294 295Same as Execute above, but call the Run procedure which 296takes Test_Name parameter. Timeout specifies the maximum execution 297time for each test. 298 299 300Get_Name 301'''''''' 302 303:: 304 305 function Get_Name (T : Test_Case) return String; 306 307Return the name of the test case. 308 309Run 310''' 311 312:: 313 314 procedure Run (T : in out Test_Case; 315 Listener : in out Listeners.Result_Listener'Class); 316 317Run Test_Case's test routines. 318 319Run 320''' 321 322:: 323 324 procedure Run (T : in out Test_Case; 325 Listener : in out Listeners.Result_Listener'Class; 326 Timeout : Test_Duration); 327 328Run Test_Case's test routines with timeout value. 329 330 331Run 332''' 333 334:: 335 336 procedure Run (T : in out Test_Case; 337 Test_Name : String; 338 Listener : in out Listeners.Result_Listener'Class); 339 340Run Test_Case's test routine which matches to the Name. 341 342Run 343''' 344 345:: 346 347 procedure Run (T : in out Test_Case; 348 Test_Name : String; 349 Listener : in out Listeners.Result_Listener'Class; 350 Timeout : Test_Duration); 351 352Run Test_Case's test routine which matches to the Name, with timeout value. 353 354 355Test_Count 356'''''''''' 357 358:: 359 360 function Test_Count (T : Test_Case) return Test_Count_Type; 361 362Implementation of Test_Count (T : Test). 363 364Test_Count 365'''''''''' 366 367:: 368 369 function Test_Count (T : Test_Case; Test_Name : String) 370 return Test_Count_Type; 371 372Implementation of Test_Count (T : Test, Test_Name : String). 373 374Finalize 375'''''''' 376 377:: 378 379 procedure Finalize (T : in out Test_Case); 380 381Finalize procedure of the Test_Case. 382 383Set_Name 384'''''''' 385 386:: 387 388 procedure Set_Name (T : in out Test_Case; Name : String); 389 390Set Test_Case's name. 391 392Add_Test_Routine 393'''''''''''''''' 394 395:: 396 397 procedure Add_Test_Routine (T : in out Test_Case'Class; 398 Routine : Object_Test_Routine_Access; 399 Name : String); 400 401Register a test routine to the Test_Case object. 402 403Add_Test_Routine 404'''''''''''''''' 405 406:: 407 408 procedure Add_Test_Routine (T : in out Test_Case'Class; 409 Routine : Simple_Test_Routine_Access; 410 Name : String); 411 412Register a simple test routine to the Test_Case. 413 414Create_Suite 415'''''''''''' 416 417:: 418 419 function Create_Suite (Suite_Name : String) 420 return Test_Suite_Access; 421 422Create a new Test_Suite. 423Caller must free the returned Test_Suite using Release_Suite. 424 425Create_Suite 426'''''''''''' 427 428:: 429 430 function Create_Suite (Suite_Name : String) 431 return Test_Suite; 432 433Create a new Test_Suite. The suite and its children are 434released automatically. 435 436Add_Test 437'''''''' 438 439:: 440 441 procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access); 442 443Add a Test to the suite. The suite frees the Test automatically 444when it is no longer needed. 445 446Add_Test 447'''''''' 448 449:: 450 451 procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access); 452 453Add a Test suite to the suite. The suite frees the Test automatically 454when it is no longer needed. 455 456Add_Static_Test 457''''''''''''''' 458 459:: 460 461 procedure Add_Static_Test 462 (Suite : in out Test_Suite; T : Test'Class); 463 464Add a Test to the suite. This procedure is meant for statically 465allocated Test_Case objects. 466 467Get_Name 468'''''''' 469 470:: 471 472 function Get_Name (T : Test_Suite) return String; 473 474Return the name of Test_Suite. 475 476Run 477''' 478 479:: 480 481 procedure Run (T : in out Test_Suite; 482 Listener : in out Listeners.Result_Listener'Class); 483 484Run Test_Suite's Test_Cases. 485 486Run 487''' 488 489:: 490 491 procedure Run (T : in out Test_Suite; 492 Listener : in out Listeners.Result_Listener'Class; 493 Timeout : Test_Duration); 494 495Run Test_Suite's Test_Cases with timeout value. 496 497 498Run 499''' 500 501:: 502 503 procedure Run (T : in out Test_Suite; 504 Test_Name : String; 505 Listener : in out Listeners.Result_Listener'Class); 506 507Run test suite's child which matches to the given name. 508 509Run 510''' 511 512:: 513 514 procedure Run (T : in out Test_Suite; 515 Test_Name : String; 516 Listener : in out Listeners.Result_Listener'Class; 517 Timeout : Test_Duration); 518 519Run test suite's child which matches to the given name, with timeout value. 520 521 522Test_Count 523'''''''''' 524 525:: 526 527 function Test_Count (T : Test_Suite) return Test_Count_Type; 528 529Implementation of Test_Count (T : Test). 530 531Test_Count 532'''''''''' 533 534:: 535 536 function Test_Count (T : Test_Suite; Test_Name : String) 537 return Test_Count_Type; 538 539Implementation of Test_Count (T : Test, Test_Name : String). 540 541Adjust 542'''''' 543 544:: 545 546 procedure Adjust (T : in out Test_Suite); 547 548Adjust procedure of Test_Suite. 549Handles the copying of the structure properly 550 551Finalize 552'''''''' 553 554:: 555 556 procedure Finalize (T : in out Test_Suite); 557 558Finalize procedure of Test_Suite. Frees all added Tests. 559 560Release_Suite 561''''''''''''' 562 563:: 564 565 procedure Release_Suite (T : Test_Suite_Access); 566 567Release the memory of Test_Suite. 568All added tests are released automatically. 569 570