| 1 | ------------------------------------------------------------------------------ |
|---|---|
| 2 | -- -- |
| 3 | -- GNAT COMPILER COMPONENTS -- |
| 4 | -- -- |
| 5 | -- A U N I T . A S S E R T I O N S -- |
| 6 | -- -- |
| 7 | -- S p e c -- |
| 8 | -- -- |
| 9 | -- -- |
| 10 | -- Copyright (C) 2000-2011, AdaCore -- |
| 11 | -- -- |
| 12 | -- GNAT is free software; you can redistribute it and/or modify it under -- |
| 13 | -- terms of the GNU General Public License as published by the Free Soft- -- |
| 14 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| 15 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| 16 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| 17 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| 18 | -- -- |
| 19 | -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| 20 | -- additional permissions described in the GCC Runtime Library Exception, -- |
| 21 | -- version 3.1, as published by the Free Software Foundation. -- |
| 22 | -- -- |
| 23 | -- You should have received a copy of the GNU General Public License and -- |
| 24 | -- a copy of the GCC Runtime Library Exception along with this program; -- |
| 25 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| 26 | -- <http://www.gnu.org/licenses/>. -- |
| 27 | -- -- |
| 28 | -- GNAT is maintained by AdaCore (http://www.adacore.com) -- |
| 29 | -- -- |
| 30 | ------------------------------------------------------------------------------ |
| 31 | |
| 32 | -- <description> |
| 33 | -- This package provides the Assert methods used by the user to verify test |
| 34 | -- results. |
| 35 | -- Those methods are used to report errors within AUnit tests when a result |
| 36 | -- does not match an expected value. |
| 37 | -- </description> |
| 38 | |
| 39 | with GNAT.Source_Info; |
| 40 | with AUnit.Tests; |
| 41 | with AUnit.Test_Results; |
| 42 | with Ada_Containers.AUnit_Lists; |
| 43 | |
| 44 | package AUnit.Assertions is |
| 45 | |
| 46 | type Throwing_Exception_Proc is access procedure; |
| 47 | |
| 48 | procedure Assert |
| 49 | (Condition : Boolean; |
| 50 | Message : String; |
| 51 | Source : String := GNAT.Source_Info.File; |
| 52 | Line : Natural := GNAT.Source_Info.Line); |
| 53 | -- Test "Condition" and record "Message" if false. |
| 54 | -- If the condition is false, an exception is then raised and the running |
| 55 | -- test is aborted. |
| 56 | |
| 57 | function Assert |
| 58 | (Condition : Boolean; |
| 59 | Message : String; |
| 60 | Source : String := GNAT.Source_Info.File; |
| 61 | Line : Natural := GNAT.Source_Info.Line) return Boolean; |
| 62 | -- Functional version to allow the calling routine to decide whether to |
| 63 | -- continue or abandon the execution. |
| 64 | |
| 65 | ----------------------- |
| 66 | -- Simple assertions -- |
| 67 | ----------------------- |
| 68 | -- The following subprograms provide specialized version of Assert |
| 69 | -- to compare simple types. In case of failure, the error message will |
| 70 | -- contain both the expected and actual values. |
| 71 | |
| 72 | procedure Assert |
| 73 | (Actual : String; |
| 74 | Expected : String; |
| 75 | Message : String; |
| 76 | Source : String := GNAT.Source_Info.File; |
| 77 | Line : Natural := GNAT.Source_Info.Line); |
| 78 | -- Specialized versions of Assert, they call the general version that |
| 79 | -- takes a Condition as a parameter |
| 80 | |
| 81 | procedure Assert_Exception |
| 82 | (Proc : Throwing_Exception_Proc; |
| 83 | Message : String; |
| 84 | Source : String := GNAT.Source_Info.File; |
| 85 | Line : Natural := GNAT.Source_Info.Line); |
| 86 | -- Test that Proc throws an exception and record "Message" if not. |
| 87 | |
| 88 | ------------------------------------------------------------ |
| 89 | -- The following declarations are for internal use only -- |
| 90 | ------------------------------------------------------------ |
| 91 | |
| 92 | Assertion_Error : exception; |
| 93 | -- For run-time libraries that support exception handling, raised when an |
| 94 | -- assertion fails in order to abandon execution of a test routine. |
| 95 | |
| 96 | type Test is abstract new AUnit.Tests.Test with private; |
| 97 | -- Test is used as root type for all Test cases, but also for Test fixtures |
| 98 | -- This allows easy access to all Assert procedures from user tests. |
| 99 | type Test_Access is access all Test'Class; |
| 100 | |
| 101 | procedure Init_Test (T : in out Test); |
| 102 | -- Init a new test |
| 103 | |
| 104 | procedure Clear_Failures (T : Test); |
| 105 | -- Clear all failures related to T |
| 106 | |
| 107 | function Has_Failures (T : Test) return Boolean; |
| 108 | -- The number of failures reported by test |
| 109 | |
| 110 | type Failure_Iter is private; |
| 111 | -- Iterator used to retrieve failures. |
| 112 | |
| 113 | function First_Failure (T : Test) return Failure_Iter; |
| 114 | function Has_Failure (I : Failure_Iter) return Boolean; |
| 115 | function Get_Failure |
| 116 | (I : Failure_Iter) return AUnit.Test_Results.Test_Failure; |
| 117 | procedure Next (I : in out Failure_Iter); |
| 118 | -- Failures list handling |
| 119 | |
| 120 | -- The following is used for the non-dispatching Assert methods. |
| 121 | -- This uses global variables, and thus is incompatible with multitasking. |
| 122 | function Current_Test return Test_Access; |
| 123 | procedure Set_Current_Test (T : Test_Access); |
| 124 | |
| 125 | procedure Copy_Id (From : Test'Class; To : in out Test'Class); |
| 126 | -- Copy From's Id to To so that failures reported via To are identified as |
| 127 | -- belonging to From. |
| 128 | |
| 129 | private |
| 130 | use AUnit.Test_Results; |
| 131 | |
| 132 | -- We can't set the results directly within the test as the result list is |
| 133 | -- limited and we don't want Test to be limited. |
| 134 | -- Instead, we initialize tests with a unique id that we use when putting |
| 135 | -- a new error in this global list. |
| 136 | |
| 137 | type Test_Id is new Natural; |
| 138 | Null_Id : constant Test_Id := 0; |
| 139 | |
| 140 | type Failure_Elt is record |
| 141 | Failure : Test_Failure; |
| 142 | Id : Test_Id := Null_Id; |
| 143 | end record; |
| 144 | |
| 145 | package Failure_Lists is |
| 146 | new Ada_Containers.AUnit_Lists (Failure_Elt); |
| 147 | -- Container for failed assertion messages per routine |
| 148 | |
| 149 | type Failure_Iter is new Failure_Lists.Cursor; |
| 150 | |
| 151 | type Test is abstract new AUnit.Tests.Test with record |
| 152 | Id : Test_Id := Null_Id; |
| 153 | end record; |
| 154 | |
| 155 | end AUnit.Assertions; |