ahven-2.1/0000775000076400007640000000000011637173541012737 5ustar tkoskinetkoskineahven-2.1/LICENSE0000664000076400007640000000150411637173541013744 0ustar tkoskinetkoskine-- Ahven Unit Test Library - License -- -- Copyright (c) 2007-2011 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ahven-2.1/test/0000775000076400007640000000000011637173541013716 5ustar tkoskinetkoskineahven-2.1/test/simple_listener.ads0000664000076400007640000000353611637173541017614 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Listeners; package Simple_Listener is type Listener is new Ahven.Listeners.Result_Listener with record Passes : Natural := 0; Errors : Natural := 0; Failures : Natural := 0; Skips : Natural := 0; Level : Integer := 0; Start_Calls : Natural := 0; End_Calls : Natural := 0; end record; type Listener_Access is access all Listener; procedure Add_Pass (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Add_Failure (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Add_Skipped (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Add_Error (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Start_Test (Object: in out Listener; Info : Ahven.Listeners.Context); procedure End_Test (Object: in out Listener; Info : Ahven.Listeners.Context); end Simple_Listener; ahven-2.1/test/derived_tests.adb0000664000076400007640000000177711637173541017246 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package body Derived_Tests is procedure Initialize (T : in out Test) is begin Framework_Tests.Initialize (Framework_Tests.Test (T)); Set_Name (T, "Ahven.Derived_Tests"); end Initialize; end Derived_Tests; ahven-2.1/test/basic_listener_tests.adb0000664000076400007640000000763711637173541020613 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Ahven.Listeners.Basic; with Ahven.Results; with Ahven.AStrings; use Ahven; use Ahven.Results; package body Basic_Listener_Tests is procedure Assert_Equal_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); procedure Initialize (T : in out Test) is begin Set_Name (T, "Ahven.Listeners.Basic"); Framework.Add_Test_Routine (T, Test_Single_Pass'Access, "Test Single Pass"); Framework.Add_Test_Routine (T, Test_Error_Inside_Suite'Access, "Test Error Inside Suite"); end Initialize; procedure Test_Single_Pass is use Ahven.Listeners; use Ahven.AStrings; Listener : Basic.Basic_Listener; begin Listeners.Basic.Start_Test (Listener, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Listeners.Basic.Add_Pass (Listener, (Phase => TEST_RUN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE, Routine_Name => To_Bounded_String ("routine"), Message => To_Bounded_String ("message"), Long_Message => To_Bounded_String ("long_message"))); Listeners.Basic.End_Test (Listener, (Phase => TEST_END, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Assert_Equal_Nat (Test_Count (Listener.Main_Result), 1, "Test Count"); end Test_Single_Pass; procedure Test_Error_Inside_Suite is use Ahven.Listeners; use Ahven.AStrings; Listener : Basic.Basic_Listener; begin Listeners.Basic.Start_Test (Listener, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String ("suite"), Test_Kind => CONTAINER)); Listeners.Basic.Start_Test (Listener, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Listeners.Basic.Add_Error (Listener, (Phase => TEST_RUN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE, Routine_Name => To_Bounded_String ("routine"), Message => To_Bounded_String ("message"), Long_Message => To_Bounded_String ("long_message"))); Listeners.Basic.End_Test (Listener, (Phase => TEST_END, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Listeners.Basic.End_Test (Listener, (Phase => TEST_END, Test_Name => To_Bounded_String ("suite"), Test_Kind => CONTAINER)); Assert_Equal_Nat (Test_Count (Listener.Main_Result), 1, "Test Count"); Assert_Equal_Nat (Direct_Test_Count (Listener.Main_Result), 0, "Direct Test Count"); Assert_Equal_Nat (Error_Count (Listener.Main_Result), 1, "Error Count"); end Test_Error_Inside_Suite; end Basic_Listener_Tests; ahven-2.1/test/simple_listener.adb0000664000076400007640000000375311637173541017574 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package body Simple_Listener is procedure Add_Pass (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Passes := Object.Passes + 1; end Add_Pass; procedure Add_Failure (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Failures := Object.Failures + 1; end Add_Failure; procedure Add_Skipped (Object: in out Listener; Info : Ahven.Listeners.Context) is begin Object.Skips := Object.Skips + 1; end Add_Skipped; procedure Add_Error (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Errors := Object.Errors + 1; end Add_Error; procedure Start_Test (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Level := Object.Level + 1; Object.Start_Calls := Object.Start_Calls + 1; end Start_Test; procedure End_Test (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Level := Object.Level - 1; Object.End_Calls := Object.End_Calls + 1; end End_Test; end Simple_Listener; ahven-2.1/test/derived_tests.ads0000664000076400007640000000170511637173541017256 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Framework_Tests; package Derived_Tests is type Test is new Framework_Tests.Test with null record; procedure Initialize (T : in out Test); end Derived_Tests; ahven-2.1/test/dummy_tests.adb0000664000076400007640000000622411637173541016747 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; --## rule off DIRECTLY_ACCESSED_GLOBALS package body Dummy_Tests is Instance_Count : Integer := 0; procedure Initialize (T : in out Test) is procedure Register (T : in out Ahven.Framework.Test_Case'Class; Routine : Ahven.Framework.Simple_Test_Routine_Access; Name : String) renames Ahven.Framework.Add_Test_Routine; begin Register (T, This_Test_Fails'Access, "Failure"); Register (T, This_Test_Passes'Access, "Pass"); Register (T, This_Test_Raises_Error'Access, "Error"); Register (T, This_Test_Is_Skipped'Access, "Skipped"); Ahven.Framework.Add_Test_Routine (T, This_Test_Uses_Object'Access, "Object usage"); T.State := INITIALIZED; Instance_Count := Instance_Count + 1; end Initialize; procedure Adjust (T : in out Test) is begin Instance_Count := Instance_Count + 1; end Adjust; procedure Finalize (T : in out Test) is begin Instance_Count := Instance_Count - 1; end Finalize; procedure Set_Up (T : in out Test) is begin T.State := UP; end Set_Up; procedure Tear_Down (T : in out Test) is begin T.State := DOWN; end Tear_Down; procedure This_Test_Fails is begin Ahven.Fail ("Failure"); end This_Test_Fails; procedure This_Test_Passes is begin Ahven.Assert (True, "True was not true!"); end This_Test_Passes; procedure This_Test_Raises_Error is begin raise Constraint_Error; end This_Test_Raises_Error; procedure This_Test_Is_Skipped is begin Ahven.Skip ("skipped"); end This_Test_Is_Skipped; procedure This_Test_Uses_Object (T : in out Ahven.Framework.Test_Case'Class) is begin Test (T).State := USED; end This_Test_Uses_Object; procedure This_Test_Takes_12_Seconds is begin delay 12.0; end This_Test_Takes_12_Seconds; procedure This_Test_Has_Infinite_Loop is --## rule off Removable A : Integer := 0; begin loop A := 1; end loop; --## rule on Removable end This_Test_Has_Infinite_Loop; function Get_Instance_Count return Integer is begin return Instance_Count; end Get_Instance_Count; procedure Reset_Instance_Count is begin Instance_Count := 0; end Reset_Instance_Count; end Dummy_Tests; --## rule on DIRECTLY_ACCESSED_GLOBALS ahven-2.1/test/slist_tests.ads0000664000076400007640000000234311637173541016771 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package SList_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Append_Elementary; procedure Test_Append_Record; procedure Test_Clear; procedure Test_Clear_Empty; procedure Test_First; procedure Test_Next; procedure Test_Data; procedure Test_Length; procedure Test_Copy; procedure Test_For_Each; end SList_Tests; ahven-2.1/test/assertion_tests.adb0000664000076400007640000000536211637173541017625 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; use Ahven; package body Assertion_Tests is procedure Assert_Int_Equal is new Assert_Equal (Data_Type => Integer, Image => Integer'Image); procedure Initialize (T : in out Test) is begin Set_Name (T, "Ahven"); Framework.Add_Test_Routine (T, Test_Assert_Equal'Access, "Assert_Equal"); Framework.Add_Test_Routine (T, Test_Assert'Access, "Assert"); Framework.Add_Test_Routine (T, Test_Fail'Access, "Fail"); end Initialize; procedure Test_Assert_Equal is Exception_Got : Boolean; begin begin Exception_Got := False; Assert_Int_Equal (Expected => 1, Actual => 1, Message => "Assert_Equal"); exception when Assertion_Error => Exception_Got := True; end; Assert (not Exception_Got, "exception for valid condition!"); begin Exception_Got := False; Assert_Int_Equal (Expected => 1, Actual => 2, Message => "Assert_Equal"); exception when Assertion_Error => Exception_Got := True; end; Assert (Exception_Got, "no exception for invalid condition!"); end Test_Assert_Equal; procedure Test_Fail is Exception_Got : Boolean; begin begin Exception_Got := False; Fail ("fail"); exception when Assertion_Error => Exception_Got := True; end; Assert (Exception_Got, "Fail did not raise exception!"); end Test_Fail; procedure Test_Assert is Exception_Got : Boolean; begin Assert (True, "Assert (True)"); begin Exception_Got := False; Assert (False, "assertion"); exception when Assertion_Error => Exception_Got := True; end; if not Exception_Got then -- Raising Assertion_Error directly, since Assert apparently -- does not work. raise Assertion_Error; end if; end Test_Assert; end Assertion_Tests; ahven-2.1/test/tap_tester.adb0000664000076400007640000000175711637173541016552 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Tap_Runner; with Ahven_Tests; procedure Tap_Tester is Suite : Ahven.Framework.Test_Suite := Ahven_Tests.Get_Test_Suite; begin Ahven.Tap_Runner.Run (Suite); end Tap_Tester; ahven-2.1/test/assertion_tests.ads0000664000076400007640000000205011637173541017635 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Assertion_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Assert_Equal; procedure Test_Fail; procedure Test_Assert; end Assertion_Tests; ahven-2.1/test/static_test_case_tests.adb0000664000076400007640000000567011637173541021141 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Simple_Listener; with Dummy_Tests; package body Static_Test_Case_Tests is use Ahven; use Ahven.Framework; --## rule off DIRECTLY_ACCESSED_GLOBALS My_Test : Dummy_Tests.Test; Child : Test_Suite := Create_Suite ("Child suite"); procedure Assert_Eq_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); procedure Initialize (T : in out Test) is begin Set_Name (T, "Ahven.Framework.Static"); Framework.Add_Test_Routine (T, Test_Test_Suite_Run'Access, "Test_Suite: Run (Static)"); Framework.Add_Test_Routine (T, Test_Test_Suite_Inside_Suite'Access, "Test_Suite: Suite inside another (Static)"); end Initialize; procedure Test_Test_Suite_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener; My_Suite : Test_Suite := Create_Suite ("My suite"); begin Add_Static_Test (My_Suite, My_Test); Run (My_Suite, My_Listener); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "passes"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "errors"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "failures"); Assert (My_Listener.Level = 0, "Start_Test /= End_Test"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 1), "Start_Test calls"); end Test_Test_Suite_Run; procedure Test_Test_Suite_Inside_Suite is use Dummy_Tests; My_Listener : Simple_Listener.Listener; Parent : Test_Suite := Create_Suite ("Parent suite"); begin Framework.Add_Static_Test (Child, My_Test); Framework.Add_Static_Test (Parent, Child); Framework.Run (Parent, My_Listener); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "passes"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "errors"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "failures"); Assert (My_Listener.Level = 0, "Start_Test /= End_Test"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 2), "Start_Test calls"); end Test_Test_Suite_Inside_Suite; end Static_Test_Case_Tests; ahven-2.1/test/dummy_tests.ads0000664000076400007640000000350611637173541016770 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Dummy_Tests is Dummy_Passes : constant := 2; Dummy_Failures : constant := 1; Dummy_Errors : constant := 1; Dummy_Skips : constant := 1; Dummy_Test_Count : constant := Dummy_Passes + Dummy_Failures + Dummy_Errors + Dummy_Skips; type Test_State is (INITIALIZED, UP, DOWN, USED); type Test is new Ahven.Framework.Test_Case with record State : Test_State; end record; procedure Initialize (T : in out Test); procedure Adjust (T : in out Test); procedure Finalize (T : in out Test); procedure Set_Up (T : in out Test); procedure Tear_Down (T : in out Test); procedure This_Test_Fails; procedure This_Test_Passes; procedure This_Test_Raises_Error; procedure This_Test_Is_Skipped; procedure This_Test_Uses_Object (T : in out Ahven.Framework.Test_Case'Class); procedure This_Test_Takes_12_Seconds; procedure This_Test_Has_Infinite_Loop; function Get_Instance_Count return Integer; procedure Reset_Instance_Count; end Dummy_Tests; ahven-2.1/test/results_tests.adb0000664000076400007640000001260511637173541017315 0ustar tkoskinetkoskine-- -- Copyright (c) 2008-2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Ahven.Results; with Ahven.AStrings; use Ahven; use Ahven.AStrings; package body Results_Tests is procedure Assert_Eq_Int is new Ahven.Assert_Equal (Data_Type => Integer, Image => Integer'Image); procedure Initialize (T : in out Test) is use Ahven.Framework; begin Set_Name (T, "Ahven.Results"); Add_Test_Routine (T, Test_Count_Children'Access, "Test Count Children"); Add_Test_Routine (T, Test_Direct_Count'Access, "Test Direct Count"); Add_Test_Routine (T, Test_Result_Iterator'Access, "Test Result Iterator"); Add_Test_Routine (T, Test_Add_Pass'Access, "Test Add Pass"); Add_Test_Routine (T, Test_Add_Failure'Access, "Test Add Failure"); Add_Test_Routine (T, Test_Add_Error'Access, "Test Add Error"); end Initialize; procedure Test_Count_Children is use Ahven.Results; Coll : Result_Collection; Coll_Dyn : Result_Collection_Access; Info : constant Result_Info := Empty_Result_Info; begin Coll_Dyn := new Result_Collection; Add_Error (Coll, Info); Add_Pass (Coll_Dyn.all, Info); Add_Child (Coll, Coll_Dyn); Assert_Eq_Int (Actual => Test_Count (Coll), Expected => 2, Message => "test count"); end Test_Count_Children; procedure Test_Direct_Count is use Ahven.Results; Coll : Result_Collection; Coll_Dyn : Result_Collection_Access; Info : constant Result_Info := Empty_Result_Info; Expected_Test_Count : constant := 3; begin Coll_Dyn := new Result_Collection; Add_Error (Coll, Info); Add_Failure (Coll, Info); Add_Pass (Coll, Info); -- This should not be counted in direct test count Add_Pass (Coll_Dyn.all, Info); Add_Child (Coll, Coll_Dyn); Assert_Eq_Int (Actual => Direct_Test_Count (Coll), Expected => Expected_Test_Count, Message => "test count"); Assert_Eq_Int (Actual => Direct_Test_Count (Coll_Dyn.all), Expected => 1, Message => "test count (dyn)"); end Test_Direct_Count; procedure Test_Result_Iterator is use Ahven.Results; Msg : constant Bounded_String := To_Bounded_String ("hello"); function Count_Tests (Position : Result_Info_Cursor) return Integer is Count : Natural := 0; Pos : Result_Info_Cursor := Position; begin loop exit when not Is_Valid (Pos); Assert (Get_Message (Data (Pos)) = To_String (Msg), "Invalid message in the item"); Pos := Next (Pos); Count := Count + 1; end loop; return Count; end Count_Tests; Coll : Result_Collection; Info : Result_Info := Empty_Result_Info; Error_Amount : constant := 1; Failure_Amount : constant := 2; Pass_Amount : constant := 3; begin Set_Message (Info, Msg); for I in 1 .. Error_Amount loop Add_Error (Coll, Info); end loop; for I in 1 .. Failure_Amount loop Add_Failure (Coll, Info); end loop; for I in 1 .. Pass_Amount loop Add_Pass (Coll, Info); end loop; Assert_Eq_Int (Actual => Count_Tests (First_Pass (Coll)), Expected => Pass_Amount, Message => "pass amount"); Assert_Eq_Int (Actual => Count_Tests (First_Failure (Coll)), Expected => Failure_Amount, Message => "failure amount"); Assert_Eq_Int (Actual => Count_Tests (First_Error (Coll)), Expected => Error_Amount, Message => "error amount"); end Test_Result_Iterator; procedure Test_Add_Pass is use Ahven.Results; Coll : Result_Collection; Info : constant Result_Info := Empty_Result_Info; begin Add_Pass (Coll, Info); Assert (Pass_Count (Coll) = 1, "Pass was not added!"); end Test_Add_Pass; procedure Test_Add_Failure is use Ahven.Results; Coll : Result_Collection; Info : constant Result_Info := Empty_Result_Info; begin Add_Failure (Coll, Info); Assert (Failure_Count (Coll) = 1, "Failure was not added!"); end Test_Add_Failure; procedure Test_Add_Error is use Ahven.Results; Coll : Result_Collection; Info : constant Result_Info := Empty_Result_Info; begin Add_Error (Coll, Info); Assert (Error_Count (Coll) = 1, "Error was not added!"); end Test_Add_Error; end Results_Tests; ahven-2.1/test/framework_tests.ads0000664000076400007640000000354111637173541017631 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Framework_Tests is type Test_State is (UNINITIALIZED, INITIALIZED, SETUP_DONE, TEARDOWN_DONE); type Test is new Ahven.Framework.Test_Case with record Value : Test_State := UNINITIALIZED; end record; procedure Initialize (T : in out Test); procedure Set_Up (T : in out Test); procedure Tear_Down (T : in out Test); private procedure Test_Set_Up (T : in out Ahven.Framework.Test_Case'Class); procedure Test_Tear_Down; procedure Test_Test_Case_Run; procedure Test_Test_Case_Run_1s_Timeout; procedure Test_Test_Case_Run_Break_Infinite_Loop; procedure Test_Test_Case_Test_Count; procedure Test_Test_Case_Truncate_Name; procedure Test_Test_Suite_Run; procedure Test_Test_Suite_Static_Run; procedure Test_Test_Suite_Name_Run; procedure Test_Call_End_Test; procedure Test_Test_Suite_Inside_Suite; procedure Test_Test_Suite_Test_Count; procedure Test_Test_Suite_Test_Static_Count; procedure Test_Test_Suite_Test_Name_Count; procedure Test_Test_Suite_Cleanup; end Framework_Tests; ahven-2.1/test/slist_tests.adb0000664000076400007640000001752111637173541016754 0ustar tkoskinetkoskine-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Ahven.SList; use Ahven; package body SList_Tests is type Simple_Type is record Value : Integer := 0; end record; package Integer_List is new Ahven.SList (Element_Type => Integer); package Simple_List is new Ahven.SList (Element_Type => Simple_Type); procedure Initialize (T : in out Test) is use Framework; begin Set_Name (T, "Ahven.SList"); Add_Test_Routine (T, Test_Append_Elementary'Access, "Append (Elementary)"); Add_Test_Routine (T, Test_Append_Record'Access, "Append (Record)"); Add_Test_Routine (T, Test_Clear'Access, "Clear"); Add_Test_Routine (T, Test_Clear_Empty'Access, "Clear (Empty)"); Add_Test_Routine (T, Test_First'Access, "First"); Add_Test_Routine (T, Test_Next'Access, "Data"); Add_Test_Routine (T, Test_Length'Access, "Length"); Add_Test_Routine (T, Test_Copy'Access, "Copy"); Add_Test_Routine (T, Test_For_Each'Access, "For_Each"); end Initialize; procedure Test_Append_Elementary is use Integer_List; My_List : List; Position : Cursor; begin Append (My_List, 1); Assert (Length (My_List) = 1, "Length does not match (1st append)"); Append (My_List, 2); Assert (Length (My_List) = 2, "Length does not match (2nd append)"); Position := First (My_List); Assert (Data (Position) = 1, "Value of 1st item does not match"); Position := Next (Position); Assert (Data (Position) = 2, "Value of 2nd item does not match"); end Test_Append_Elementary; procedure Test_Append_Record is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); Obj_2 : constant Simple_Type := (Value => 2); Position : Cursor; begin Append (My_List, Obj_1); Assert (Length (My_List) = 1, "Length does not match (1st append)"); Append (My_List, Obj_2); Assert (Length (My_List) = 2, "Length does not match (2nd append)"); Position := First (My_List); Assert (Data (Position).Value = Obj_1.Value, "Value of 1st item does not match"); Position := Next (Position); Assert (Data (Position).Value = Obj_2.Value, "Value of 2nd item does not match"); end Test_Append_Record; procedure Test_Clear is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); begin Append (My_List, Obj_1); Append (My_List, Obj_1); Append (My_List, Obj_1); Clear (My_List); Assert (Length (My_List) = 0, "List not empty after Clear!"); end Test_Clear; procedure Test_Clear_Empty is use Simple_List; My_List : List := Empty_List; begin Clear (My_List); Assert (Length (My_List) = 0, "List not empty after Clear!"); end Test_Clear_Empty; procedure Test_First is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); Position : Cursor; begin Position := First (My_List); Assert (not Is_Valid (Position), "First (empty) returned valid cursor!"); Append (My_List, Obj_1); Position := First (My_List); Assert (Is_Valid (Position), "First (not empty) returned invalid cursor!"); end Test_First; procedure Test_Next is use Simple_List; Max_Count : constant := 10; My_List : List; Counter : Count_Type := 0; Position : Cursor; begin for A in Integer range 1 .. Max_Count loop Append (My_List, (Value => A)); end loop; Position := First (My_List); loop exit when not Is_Valid (Position); Position := Next (Position); Counter := Counter + 1; end loop; Assert (Counter = Max_Count, "Invalid counter value: " & Count_Type'Image (Counter)); end Test_Next; procedure Test_Data is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); Position : Cursor; begin Append (My_List, Obj_1); Position := First (My_List); Assert (Data (Position) = Obj_1, "Item in the list does not match original item"); end Test_Data; procedure Test_Length is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); begin Assert (Length (My_List) = 0, "Invalid initial length: " & Count_Type'Image (Length (My_List))); Append (My_List, Obj_1); Assert (Length (My_List) = 1, "Invalid length after 1st append: " & Count_Type'Image (Length (My_List))); Clear (My_List); Assert (Length (My_List) = 0, "Invalid length after Clear: " & Count_Type'Image (Length (My_List))); end Test_Length; procedure Test_Copy is use Simple_List; Object_Amount : constant := 4; My_List : List; Copy : List; Obj_1 : constant Simple_Type := (Value => 1); Obj_2 : constant Simple_Type := (Value => 2); Obj_3 : constant Simple_Type := (Value => 3); Iter_1 : Cursor; Iter_2 : Cursor; begin Append (My_List, Obj_1); Append (My_List, Obj_2); Append (My_List, Obj_3); Copy := My_List; Assert (Length (Copy) = Length (My_List), "Size does not match!"); Iter_1 := First (My_List); Iter_2 := First (Copy); Assert (Data (Iter_1) = Data (Iter_2), "First items not equal!"); Iter_1 := Next (Iter_1); Iter_2 := Next (Iter_2); Assert (Data (Iter_1) = Data (Iter_2), "Second items not equal!"); Iter_1 := Next (Iter_1); Iter_2 := Next (Iter_2); Assert (Data (Iter_1) = Data (Iter_2), "Third items not equal!"); declare Another_Copy : constant List := My_List; --## rule off IMPROPER_INITIALIZATION Yet_Another : List := Copy; begin Assert (Length (Another_Copy) = Length (My_List), "Size does not match!"); Iter_1 := First (My_List); Iter_2 := First (Another_Copy); Assert (Data (Iter_1) = Data (Iter_2), "First items not equal! (Another_Copy)"); Append (My_List, Obj_1); Yet_Another := My_List; Iter_1 := First (My_List); Iter_2 := First (Yet_Another); Assert (Data (Iter_1) = Data (Iter_2), "First items not equal! (Yet_Another)"); end; Assert (Length (My_List) = Object_Amount, "Invalid size: " & Count_Type'Image (Length (My_List))); end Test_Copy; procedure Test_For_Each is use Simple_List; Counter : Natural := 0; Max : constant := 5; procedure My_Action (Obj : in out Simple_Type) is begin Counter := Counter + 1; Assert (Counter = Obj.Value, "Data mismatch"); end My_Action; procedure Run_All is new Simple_List.For_Each (Action => My_Action); My_List : List; begin for A in Integer range 1 .. Max loop Append (My_List, (Value => A)); end loop; Run_All (My_List); end Test_For_Each; end SList_Tests; ahven-2.1/test/static_test_case_tests.ads0000664000076400007640000000206211637173541021152 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Static_Test_Case_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Test_Suite_Run; procedure Test_Test_Suite_Inside_Suite; end Static_Test_Case_Tests; ahven-2.1/test/results_tests.ads0000664000076400007640000000221711637173541017334 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Results_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Count_Children; procedure Test_Direct_Count; procedure Test_Result_Iterator; procedure Test_Add_Pass; procedure Test_Add_Failure; procedure Test_Add_Error; end Results_Tests; ahven-2.1/test/ahven_tests.adb0000664000076400007640000000351711637173541016717 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Framework_Tests; with Derived_Tests; with Results_Tests; with Basic_Listener_Tests; with Assertion_Tests; with Static_Test_Case_Tests; with SList_Tests; package body Ahven_Tests is use Ahven; function Get_Test_Suite return Ahven.Framework.Test_Suite is S : Framework.Test_Suite := Framework.Create_Suite ("All"); Assertion_Test : Assertion_Tests.Test; Derived_Test : Derived_Tests.Test; Framework_Test : Framework_Tests.Test; Listener_Test : Basic_Listener_Tests.Test; Results_Test : Results_Tests.Test; Static_Test : Static_Test_Case_Tests.Test; SList_Test : SList_Tests.Test; begin Framework.Add_Static_Test (S, Assertion_Test); Framework.Add_Static_Test (S, Derived_Test); Framework.Add_Static_Test (S, Framework_Test); Framework.Add_Static_Test (S, Listener_Test); Framework.Add_Static_Test (S, Results_Test); Framework.Add_Static_Test (S, Static_Test); Framework.Add_Static_Test (S, SList_Test); return S; end Get_Test_Suite; end Ahven_Tests; ahven-2.1/test/basic_listener_tests.ads0000664000076400007640000000204511637173541020620 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Basic_Listener_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Single_Pass; procedure Test_Error_Inside_Suite; end Basic_Listener_Tests; ahven-2.1/test/framework_tests.adb0000664000076400007640000003642011637173541017612 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Calendar; with Ada.Unchecked_Deallocation; with Simple_Listener; with Dummy_Tests; pragma Elaborate_All (Dummy_Tests); package body Framework_Tests is use Ahven; procedure Assert_Eq_Count is new Ahven.Assert_Equal (Data_Type => Framework.Test_Count_Type, Image => Framework.Test_Count_Type'Image); procedure Assert_Eq_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); procedure Assert_Eq_Int is new Ahven.Assert_Equal (Data_Type => Integer, Image => Integer'Image); procedure Free is new Ada.Unchecked_Deallocation (Object => Simple_Listener.Listener, Name => Simple_Listener.Listener_Access); procedure Initialize (T : in out Test) is use Framework; begin Set_Name (T, "Ahven.Framework"); Add_Test_Routine (T, Test_Set_Up'Access, "Test_Case: Set_Up"); T.Value := INITIALIZED; Add_Test_Routine (T, Test_Tear_Down'Access, "Test_Case: Tear_Down"); Add_Test_Routine (T, Test_Test_Case_Run'Access, "Test_Case: Run"); Add_Test_Routine (T, Test_Test_Case_Run_1s_Timeout'Access, "Test_Case: 1s Timeout"); Add_Test_Routine (T, Test_Test_Case_Run_Break_Infinite_Loop'Access, "Test_Case: Break infinite loop"); Add_Test_Routine (T, Test_Test_Case_Test_Count'Access, "Test_Case: Test_Count"); Add_Test_Routine (T, Test_Test_Case_Truncate_Name'Access, "Test_Case: Truncate Name"); Add_Test_Routine (T, Test_Call_End_Test'Access, "Test_Case: Run (Call End_Test)"); Add_Test_Routine (T, Test_Test_Suite_Run'Access, "Test_Suite: Run"); Add_Test_Routine (T, Test_Test_Suite_Static_Run'Access, "Test_Suite: Run (Static)"); Add_Test_Routine (T, Test_Test_Suite_Name_Run'Access, "Test_Suite: Run (Name)"); Add_Test_Routine (T, Test_Test_Suite_Inside_Suite'Access, "Test_Suite: Suite inside another"); Add_Test_Routine (T, Test_Test_Suite_Test_Count'Access, "Test_Suite: Test Count"); Add_Test_Routine (T, Test_Test_Suite_Test_Static_Count'Access, "Test_Suite: Test Count (Static)"); Add_Test_Routine (T, Test_Test_Suite_Test_Name_Count'Access, "Test_Suite: Test Count (Name)"); Add_Test_Routine (T, Test_Test_Suite_Cleanup'Access, "Test_Suite: Cleanup"); end Initialize; procedure Set_Up (T : in out Test) is begin T.Value := SETUP_DONE; end Set_Up; procedure Tear_Down (T : in out Test) is begin T.Value := TEARDOWN_DONE; end Tear_Down; procedure Test_Set_Up (T : in out Ahven.Framework.Test_Case'Class) is begin Assert (Test (T).Value = SETUP_DONE, "Set_Up not called!"); end Test_Set_Up; procedure Test_Tear_Down is use type Dummy_Tests.Test_State; My_Test : Dummy_Tests.Test; My_Listener : Simple_Listener.Listener; begin Dummy_Tests.Run (My_Test, My_Listener); Assert (My_Test.State = Dummy_Tests.DOWN, "Tear_Down not called!"); end Test_Tear_Down; procedure Test_Test_Case_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; My_Test : Dummy_Tests.Test; begin Dummy_Tests.Run (My_Test, My_Listener.all); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, Dummy_Test_Count, "Start_Test calls"); Free (My_Listener); end Test_Test_Case_Run; procedure Test_Test_Case_Run_1s_Timeout is use Dummy_Tests; use Ahven.Framework; use type Ada.Calendar.Time; My_Test : Dummy_Tests.Test; My_Listener : Simple_Listener.Listener; Before : Ada.Calendar.Time; After : Ada.Calendar.Time; begin Add_Test_Routine (My_Test, Dummy_Tests.This_Test_Takes_12_Seconds'Access, "Takes 12 seconds"); Before := Ada.Calendar.Clock; Ahven.Framework.Run (Ahven.Framework.Test_Case (My_Test), My_Listener, 1.0); After := Ada.Calendar.Clock; -- Timing might not be 100% accurate, so measuring -- less than 2.0 seconds should give us accetable result Assert (After - Before < 2.0, "Test took too long"); end Test_Test_Case_Run_1s_Timeout; procedure Test_Test_Case_Run_Break_Infinite_Loop is use Dummy_Tests; use Ahven.Framework; use type Ada.Calendar.Time; My_Test : Dummy_Tests.Test; My_Listener : Simple_Listener.Listener; Before : Ada.Calendar.Time; After : Ada.Calendar.Time; begin Skip ("Does not work with most Ada compilers."); Add_Test_Routine (My_Test, Dummy_Tests.This_Test_Has_Infinite_Loop'Access, "Has infinite loop"); Before := Ada.Calendar.Clock; Ahven.Framework.Run (Ahven.Framework.Test_Case (My_Test), My_Listener, 0.2); After := Ada.Calendar.Clock; -- Timing might not be 100% accurate, so measuring -- less than 1.0 seconds should give us accetable result Assert (After - Before < 1.0, "Test took too long"); end Test_Test_Case_Run_Break_Infinite_Loop; procedure Test_Test_Case_Test_Count is use type Framework.Test_Count_Type; Dummy_Test : Dummy_Tests.Test; begin Assert_Eq_Count (Dummy_Tests.Test_Count (Dummy_Test), Dummy_Tests.Dummy_Test_Count, "Test Count"); end Test_Test_Case_Test_Count; procedure Test_Test_Case_Truncate_Name is Over_Max : constant := 180; Dummy_Test : Dummy_Tests.Test; Name : constant String (1..Over_Max) := (others => 'a'); begin Dummy_Tests.Set_Name (Dummy_Test, Name); end Test_Test_Case_Truncate_Name; procedure Test_Test_Suite_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; My_Suite : Framework.Test_Suite_Access; begin My_Suite := Framework.Create_Suite ("My suite"); Framework.Add_Test (My_Suite.all, new Dummy_Tests.Test); Framework.Run (My_Suite.all, My_Listener.all); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 1), "Start_Test calls"); Free (My_Listener); Framework.Release_Suite (My_Suite); end Test_Test_Suite_Run; procedure Test_Test_Suite_Static_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener; My_Suite : Framework.Test_Suite := Framework.Create_Suite ("My suite"); Dummy_Test : Dummy_Tests.Test; begin Framework.Add_Static_Test (My_Suite, Dummy_Test); Framework.Run (My_Suite, My_Listener); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 1), "Start_Test calls"); end Test_Test_Suite_Static_Run; procedure Test_Test_Suite_Name_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener; My_Suite : Framework.Test_Suite := Framework.Create_Suite ("My suite"); Dummy_Test : Dummy_Tests.Test; begin Framework.Add_Static_Test (My_Suite, Dummy_Test); Framework.Run (My_Suite, "Failure", My_Listener); Assert_Eq_Nat (My_Listener.Passes, 0, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, 0, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Failures + 1), "Start_Test calls"); end Test_Test_Suite_Name_Run; procedure Test_Call_End_Test is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; My_Test : Dummy_Tests.Test; begin Dummy_Tests.Run (My_Test, My_Listener.all); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.End_Calls, Dummy_Test_Count, "End_Test calls"); Free (My_Listener); end Test_Call_End_Test; procedure Test_Test_Suite_Inside_Suite is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; Child : Framework.Test_Suite_Access; Parent : Framework.Test_Suite; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Test (Child.all, new Dummy_Tests.Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Test (Parent, Child); Framework.Run (Parent, My_Listener.all); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Amount of passes."); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Amount of errors."); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Amount of failures."); Assert_Eq_Nat (My_Listener.Level, 0, "Start_Test /= End_Test"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 2), "Start_Test calls"); Free (My_Listener); end Test_Test_Suite_Inside_Suite; -- Test that Test_Count works for dynamic test cases procedure Test_Test_Suite_Test_Count is use Dummy_Tests; Child : Framework.Test_Suite_Access; Parent : Framework.Test_Suite; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Test (Child.all, new Dummy_Tests.Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Test (Parent, Child); Assert_Eq_Count (Framework.Test_Count (Parent), Dummy_Test_Count, "Test Count"); end Test_Test_Suite_Test_Count; -- Test that Test_Count works for static test cases procedure Test_Test_Suite_Test_Static_Count is use Dummy_Tests; use type Framework.Test_Count_Type; Child : Framework.Test_Suite; Parent : Framework.Test_Suite; Dummy_Test : Dummy_Tests.Test; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Static_Test (Child, Dummy_Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Static_Test (Parent, Child); Assert_Eq_Count (Framework.Test_Count (Parent), Dummy_Test_Count, "Test Count"); end Test_Test_Suite_Test_Static_Count; procedure Test_Test_Suite_Test_Name_Count is use Dummy_Tests; use type Framework.Test_Count_Type; Child : Framework.Test_Suite; Parent : Framework.Test_Suite; GParent : Framework.Test_Suite; Dummy_Test : Dummy_Tests.Test; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Static_Test (Child, Dummy_Test); Framework.Add_Test (Child, new Dummy_Tests.Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Static_Test (Parent, Child); GParent := Framework.Create_Suite ("GParent suite"); Framework.Add_Static_Test (GParent, Parent); Assert_Eq_Count (Framework.Test_Count (GParent, "Failure"), 2, "Test Count"); Assert_Eq_Count (Actual => Framework.Test_Count (GParent, "GParent suite"), Expected => Dummy_Test_Count * 2, Message => "GParent suite: Test Count"); end Test_Test_Suite_Test_Name_Count; -- We test that Test_Suites do their cleanup properly -- even if we have mixed static and dynamic test cases -- or have nested test suites. procedure Test_Test_Suite_Cleanup is Initial_Count : Integer; begin Dummy_Tests.Reset_Instance_Count; Initial_Count := Dummy_Tests.Get_Instance_Count; --## rule off Long_Blocks declare use Dummy_Tests; Child : Framework.Test_Suite; Parent : Framework.Test_Suite; GParent : Framework.Test_Suite; Dummy_Test : Dummy_Tests.Test; Test_Instance_Count : Natural := 1; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Static_Test (Child, Dummy_Test); Test_Instance_Count := Test_Instance_Count + 1; -- 2 Assert_Eq_Int (Expected => Test_Instance_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Dummy_Tests instance count"); Framework.Add_Test (Child, new Dummy_Tests.Test); Test_Instance_Count := Test_Instance_Count + 1; -- 3 Assert_Eq_Int (Expected => Test_Instance_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Dummy_Tests instance count"); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Static_Test (Parent, Child); Test_Instance_Count := Test_Instance_Count + 2; -- 1 + 2 + 2 = 5 Assert_Eq_Int (Expected => Test_Instance_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Dummy_Tests instance count"); Framework.Add_Test (Parent, new Dummy_Tests.Test); Framework.Add_Static_Test (Parent, Dummy_Test); GParent := Framework.Create_Suite ("GParent suite"); Framework.Add_Test (GParent, new Dummy_Tests.Test); Framework.Add_Static_Test (GParent, Dummy_Test); Framework.Add_Static_Test (GParent, Parent); end; Assert_Eq_Int (Expected => Initial_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Not all tests freed"); --## rule on Long_Blocks end Test_Test_Suite_Cleanup; end Framework_Tests; ahven-2.1/test/tester.adb0000664000076400007640000000175711637173541015706 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Text_Runner; with Ahven_Tests; procedure Tester is Suite : Ahven.Framework.Test_Suite := Ahven_Tests.Get_Test_Suite; begin Ahven.Text_Runner.Run (Suite); end Tester; ahven-2.1/test/ahven_tests.ads0000664000076400007640000000163011637173541016732 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Ahven_Tests is function Get_Test_Suite return Ahven.Framework.Test_Suite; end Ahven_Tests; ahven-2.1/Makefile0000664000076400007640000000721311637173541014402 0ustar tkoskinetkoskine# # Copyright (c) 2007-2009 Tero Koskinen # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # PREFIX?=$(HOME)/libraries/ahven INSTALL=install OS_VERSION?=unix LIBDIR?=$(PREFIX)/lib SOURCES=src/ahven-framework.adb src/ahven-framework.ads \ src/ahven-listeners-basic.adb src/ahven-listeners-basic.ads \ src/ahven-listeners.ads \ src/ahven-results.adb src/ahven-results.ads \ src/ahven-runner.adb src/ahven-runner.ads \ src/ahven-text_runner.adb src/ahven-text_runner.ads \ src/ahven.adb src/ahven.ads \ src/ahven-temporary_output.adb \ src/ahven-temporary_output.ads \ src/ahven-parameters.adb src/ahven-parameters.ads \ src/ahven-xml_runner.adb src/ahven-xml_runner.ads \ src/ahven-tap_runner.adb src/ahven-tap_runner.ads \ src/ahven-astrings.ads \ src/${OS_VERSION}/ahven_compat.adb src/${OS_VERSION}/ahven_compat.ads \ src/ahven-slist.adb src/ahven-slist.ads ALI_FILES=lib/ahven.ali \ lib/ahven_compat.ali \ lib/ahven-framework.ali \ lib/ahven-listeners-basic.ali \ lib/ahven-listeners.ali \ lib/ahven-results.ali \ lib/ahven-runner.ali \ lib/ahven-slist.ali \ lib/ahven-tap_runner.ali \ lib/ahven-parameters.ali \ lib/ahven-temporary_output.ali \ lib/ahven-text_runner.ali \ lib/ahven-astrings.ali \ lib/ahven-xml_runner.ali STATIC_LIBRARY=libahven.a GPR_FILE=gnat/ahven.gpr default: build_all objects: mkdir -p objects test_objects: mkdir -p test_objects lib: mkdir -p lib build_all: objects test_objects build_lib build_tests build_lib: objects lib OS_VERSION=$(OS_VERSION) gnatmake -Pgnat/ahven_lib build_tests: test_objects build_lib OS_VERSION=$(OS_VERSION) gnatmake -Pgnat/ahven_tests clean: clean_lib clean_tests clean_docs clean_lib: gnatclean -q -Pgnat/ahven_lib clean_tests: gnatclean -q -Pgnat/ahven_tests clean_docs: rm -f doc/api/*.html ahven.specs distclean: rm -rf lib objects results test_objects tester tap_tester install: install_lib install_docs install_lib: mkdir -p $(PREFIX)/include/ahven mkdir -p $(LIBDIR)/ahven mkdir -p $(PREFIX)/lib/gnat $(INSTALL) -m 644 $(SOURCES) $(PREFIX)/include/ahven $(INSTALL) -m 444 $(ALI_FILES) $(LIBDIR)/ahven $(INSTALL) -m 644 lib/$(STATIC_LIBRARY) $(LIBDIR)/ahven $(INSTALL) -m 644 $(GPR_FILE) $(PREFIX)/lib/gnat install_docs: mkdir -p $(PREFIX)/share/doc/ahven cp -r doc/manual/en/build/html $(PREFIX)/share/doc/ahven check: build_tests ./tester -c check_xml: build_tests -mkdir -p results ./tester -c -x -d results check_tap: build_tests ./tap_tester control: rm -f objects/*.adt objects/*.ali cd objects && adactl -f ../rules/ahven.aru ../src/*.ad[bs] ../test/*.ad[bs] ../src/unix/*.ad[bs] rm -f objects/*.adt objects/*.ali docs: ahven.specs mkdir -p doc/api adabrowse -c adabrowse.conf -i -f@ahven.specs -o doc/api/ userguide: $(MAKE) -C doc/manual/en html ahven.specs: $(SOURCES) find src/ -name "*.ads" -print |sort|uniq > ahven.specs README.html: README.rst rst2html --stylesheet-path=css/html4css1.css,css/my-docutils.css README.rst > README.html tags: $(SOURCES) ectags src/*.adb ahven-2.1/src/0000775000076400007640000000000011637173541013526 5ustar tkoskinetkoskineahven-2.1/src/ahven-text_runner.adb0000664000076400007640000002464611637173541017666 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; with Ada.Strings.Fixed; with Ada.Characters.Latin_1; with Ahven.Runner; with Ahven.XML_Runner; with Ahven.AStrings; use Ada.Text_IO; use Ada.Strings.Fixed; package body Ahven.Text_Runner is use Ahven.Results; use Ahven.Framework; use Ahven.AStrings; -- Local procedures procedure Pad (Level : Natural); procedure Print_Test (Info : Result_Info; Level : Natural; Result : String); procedure Print_Failures (Result : Result_Collection; Level : Natural); procedure Print_Skips (Result : Result_Collection; Level : Natural); procedure Print_Errors (Result : Result_Collection; Level : Natural); procedure Print_Passes (Result : Result_Collection; Level : Natural); procedure Report_Results (Result : Result_Collection; Verbose : Boolean := False); procedure Print_Log_File (Filename : String); procedure Pad (Level : Natural) is begin for A in Integer range 1 .. Level loop Put (" "); end loop; end Pad; procedure Pad (Amount : in Natural; Total : in out Natural) is begin for A in Natural range 1 .. Amount loop Put (" "); end loop; Total := Total + Amount; end Pad; procedure Multiline_Pad (Input : String; Level : Natural) is begin Pad (Level); for A in Input'Range loop Put (Input (A)); if (Input (A) = Ada.Characters.Latin_1.LF) and (A /= Input'Last) then Pad (Level); end if; end loop; end Multiline_Pad; procedure Print_Test (Info : Result_Info; Level : Natural; Result : String) is use Ada.Strings; Max_Output_Width : constant := 50; Max_Result_Width : constant := 7; Max_Time_Out_Width : constant := 12; subtype Result_Size is Integer range 1 .. Max_Result_Width; subtype Time_Out_Size is Integer range 1 .. Max_Time_Out_Width; procedure Print_Text (Str : String; Total : in out Natural) is begin Put (Str); Total := Total + Str'Length; end Print_Text; Msg : constant String := Get_Message (Info); Result_Out : String (Result_Size) := (others => ' '); Time_Out : String (Time_Out_Size) := (others => ' '); Total_Text : Natural := 0; begin Pad (Level + 1, Total_Text); Print_Text (Get_Routine_Name (Info), Total_Text); if Msg'Length > 0 then Print_Text (" - ", Total_Text); Print_Text (Msg, Total_Text); end if; if Total_Text < Max_Output_Width then Pad (Max_Output_Width - Total_Text, Total_Text); end if; -- If we know the name of the routine, we print it, -- the result, and the execution time. if Get_Routine_Name (Info)'Length > 0 then Move (Source => Result, Target => Result_Out, Drop => Right, Justify => Left, Pad => ' '); Move (Source => Duration'Image (Get_Execution_Time (Info)), Target => Time_Out, Drop => Right, Justify => Right, Pad => ' '); Put (" " & Result_Out); Put (" " & Time_Out & "s"); end if; if Get_Long_Message (Info)'Length > 0 then New_Line; Multiline_Pad (Get_Long_Message (Info), Level + 2); end if; New_Line; end Print_Test; type Print_Child_Proc is access procedure (Result : Result_Collection; Level : Natural); type Child_Count_Proc is access function (Result : Result_Collection) return Natural; procedure Print_Children (Result : Result_Collection; Level : Natural; Action : Print_Child_Proc; Count : Child_Count_Proc) is Child_Iter : Result_Collection_Cursor := First_Child (Result); begin loop exit when not Is_Valid (Child_Iter); if Count.all (Data (Child_Iter).all) > 0 then Action.all (Data (Child_Iter).all, Level + 1); end if; Child_Iter := Next (Child_Iter); end loop; end Print_Children; procedure Print_Statuses (Result : Result_Collection; Level : Natural; Start : Result_Info_Cursor; Action : Print_Child_Proc; Status : String; Count : Child_Count_Proc; Print_Log : Boolean) is Position : Result_Info_Cursor := Start; begin if Length (Get_Test_Name (Result)) > 0 then Pad (Level); Put_Line (To_String (Get_Test_Name (Result)) & ":"); end if; Test_Loop: loop exit Test_Loop when not Is_Valid (Position); Print_Test (Data (Position), Level, Status); if Print_Log and (Length (Get_Output_File (Data (Position))) > 0) then Print_Log_File (To_String (Get_Output_File (Data (Position)))); end if; Position := Next (Position); end loop Test_Loop; Print_Children (Result => Result, Level => Level, Action => Action, Count => Count); end Print_Statuses; -- -- Print all failures from the result collection -- and then recurse into child collections. -- procedure Print_Failures (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Failure (Result), Action => Print_Failures'Access, Status => "FAIL", Count => Failure_Count'Access, Print_Log => True); end Print_Failures; -- -- Print all skips from the result collection -- and then recurse into child collections. -- procedure Print_Skips (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Skipped (Result), Action => Print_Skips'Access, Status => "SKIPPED", Count => Skipped_Count'Access, Print_Log => True); end Print_Skips; -- -- Print all errors from the result collection -- and then recurse into child collections. -- procedure Print_Errors (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Error (Result), Action => Print_Errors'Access, Status => "ERROR", Count => Error_Count'Access, Print_Log => True); end Print_Errors; -- -- Print all passes from the result collection -- and then recurse into child collections. -- procedure Print_Passes (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Pass (Result), Action => Print_Passes'Access, Status => "PASS", Count => Pass_Count'Access, Print_Log => False); end Print_Passes; -- -- Report passes, skips, failures, and errors from the result collection. procedure Report_Results (Result : Result_Collection; Verbose : Boolean := False) is begin Put_Line ("Passed : " & Integer'Image (Pass_Count (Result))); if Verbose then Print_Passes (Result, 0); end if; New_Line; if Skipped_Count (Result) > 0 then Put_Line ("Skipped : " & Integer'Image (Skipped_Count (Result))); Print_Skips (Result, 0); New_Line; end if; if Failure_Count (Result) > 0 then Put_Line ("Failed : " & Integer'Image (Failure_Count (Result))); Print_Failures (Result, 0); New_Line; end if; if Error_Count (Result) > 0 then Put_Line ("Errors : " & Integer'Image (Error_Count (Result))); Print_Errors (Result, 0); end if; end Report_Results; procedure Print_Log_File (Filename : String) is Handle : File_Type; Char : Character := ' '; First : Boolean := True; begin Open (Handle, In_File, Filename); loop exit when End_Of_File (Handle); Get (Handle, Char); if First then Put_Line ("===== Output ======="); First := False; end if; Put (Char); if End_Of_Line (Handle) then New_Line; end if; end loop; Close (Handle); if not First then Put_Line ("===================="); end if; end Print_Log_File; procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info) is begin if Parameters.XML_Results (Args) then XML_Runner.Report_Results (Test_Results, Parameters.Result_Dir (Args)); else Report_Results (Test_Results, Parameters.Verbose (Args)); end if; end Do_Report; procedure Run (Suite : in out Framework.Test'Class) is begin Runner.Run_Suite (Suite, Do_Report'Access); end Run; procedure Run (Suite : Framework.Test_Suite_Access) is begin Run (Suite.all); end Run; end Ahven.Text_Runner; ahven-2.1/src/ahven-listeners-basic.ads0000664000076400007640000000622411637173541020411 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Calendar; with Ahven.Temporary_Output; with Ahven.Results; use Ahven.Results; pragma Elaborate_All (Ahven.Results); pragma Elaborate_All (Ahven.Temporary_Output); package Ahven.Listeners.Basic is type Result_Type is (NO_RESULT, PASS_RESULT, FAILURE_RESULT, ERROR_RESULT, SKIPPED_RESULT); type Basic_Listener is new Result_Listener with record Main_Result : aliased Result_Collection; Current_Result : Result_Collection_Access; Last_Test_Result : Result_Type := NO_RESULT; Last_Info : Result_Info := Empty_Result_Info; Capture_Output : Boolean := False; Output_File : Temporary_Output.Temporary_File; Start_Time : Ada.Calendar.Time; end record; procedure Add_Pass (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Pass procedure Add_Failure (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Failure procedure Add_Skipped (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Skipped procedure Add_Error (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Error procedure Start_Test (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Start_Test procedure End_Test (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.End_Test procedure Set_Output_Capture (Listener : in out Basic_Listener; Capture : Boolean); -- Enable or disable Ada.Text_IO output capturing function Get_Output_Capture (Listener : Basic_Listener) return Boolean; -- Capture the Ada.Text_IO output? private procedure Set_Last_Test_Info (Listener : in out Basic_Listener; Info : Context; Result : Result_Type); procedure Remove_File (Name : String); procedure Remove_Files (Collection : in out Result_Collection); procedure Finalize (Listener : in out Basic_Listener); end Ahven.Listeners.Basic; ahven-2.1/src/ahven-parameters.ads0000664000076400007640000000470111637173541017463 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Ahven.Parameters is Invalid_Parameter : exception; type Parameter_Info is private; type Parameter_Mode is (NORMAL_PARAMETERS, TAP_PARAMETERS); procedure Parse_Parameters (Mode : Parameter_Mode; Info : out Parameter_Info); -- Parse Ada.Command_Line parameters and put the results -- to the Info parameter. Raises Invalid_Parameter if -- some parameter is invalid. procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS); -- Print usage. function Capture (Info : Parameter_Info) return Boolean; -- Capture Ada.Text_IO output? function Verbose (Info : Parameter_Info) return Boolean; -- Use verbose mode? function XML_Results (Info : Parameter_Info) return Boolean; -- Output XML? function Single_Test (Info : Parameter_Info) return Boolean; -- Run a single test (case/suite/routine) only? function Test_Name (Info : Parameter_Info) return String; -- Return the name of the test passed as a parameter. function Result_Dir (Info : Parameter_Info) return String; -- Return the directory for XML results. function Timeout (Info : Parameter_Info) return Framework.Test_Duration; -- Return the timeout value for a test. private type Parameter_Info is record Verbose_Output : Boolean := True; Xml_Output : Boolean := False; Capture_Output : Boolean := False; Test_Name : Natural := 0; -- Position of test name in the argument array Result_Dir : Natural := 0; -- Position of results dir in the argument array Timeout : Framework.Test_Duration := 0.0; end record; end Ahven.Parameters; ahven-2.1/src/ahven.adb0000664000076400007640000000316211637173541015301 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Exceptions; pragma Elaborate_All (Ada.Exceptions); package body Ahven is procedure Assert (Condition : Boolean; Message : String) is begin if not Condition then Ada.Exceptions.Raise_Exception (Assertion_Error'Identity, Message); end if; end Assert; procedure Assert_Equal (Actual : Data_Type; Expected : Data_Type; Message : String) is begin Assert (Actual = Expected, Message & " (Expected: " & Image (Expected) & "; Got: " & Image (Actual) & ")"); end Assert_Equal; procedure Fail (Message : String) is begin Ada.Exceptions.Raise_Exception (Assertion_Error'Identity, Message); end Fail; procedure Skip (Message : String) is begin Ada.Exceptions.Raise_Exception (Test_Skipped_Error'Identity, Message); end Skip; end Ahven; ahven-2.1/src/ahven-runner.ads0000664000076400007640000000242011637173541016625 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Results; with Ahven.Parameters; package Ahven.Runner is type Report_Proc is access procedure (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); procedure Run_Suite (Suite : in out Framework.Test'Class; Reporter : Report_Proc); -- Run the given test (case/suite) and pass the results and -- the command line argument info to the reporter procedure. end Ahven.Runner; ahven-2.1/src/unix/0000775000076400007640000000000011637173541014511 5ustar tkoskinetkoskineahven-2.1/src/unix/ahven_compat.adb0000664000076400007640000000173611637173541017634 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- UNIX version of OS compatibility package package body Ahven_Compat is function Directory_Separator return String is begin return "/"; end Directory_Separator; end Ahven_Compat; ahven-2.1/src/unix/ahven_compat.ads0000664000076400007640000000171111637173541017646 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- Operating system compatibility package package Ahven_Compat is function Directory_Separator return String; -- Return the used directory separator. end Ahven_Compat; ahven-2.1/src/windows/0000775000076400007640000000000011637173541015220 5ustar tkoskinetkoskineahven-2.1/src/windows/ahven_compat.adb0000664000076400007640000000174111637173541020337 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- Windows version of OS compatibility package package body Ahven_Compat is function Directory_Separator return String is begin return "\"; end Directory_Separator; end Ahven_Compat; ahven-2.1/src/windows/ahven_compat.ads0000664000076400007640000000171111637173541020355 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- Operating system compatibility package package Ahven_Compat is function Directory_Separator return String; -- Return the used directory separator. end Ahven_Compat; ahven-2.1/src/ahven.ads0000664000076400007640000000337111637173541015324 0ustar tkoskinetkoskine-- Ahven Unit Test Library -- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package Ahven is Max_String_Len : constant := 160; Assertion_Error : exception; -- Exception, raised when Assert fails. Test_Skipped_Error : exception; -- Exception, raised when test is skipped procedure Assert (Condition : Boolean; Message : String); -- If Condition is false, Assert raises Assertion_Error -- with given Message. generic type Data_Type is private; with function Image (Item : Data_Type) return String is <>; procedure Assert_Equal (Actual : Data_Type; Expected : Data_Type; Message : String); -- If Expected /= Actual, Assert raises Assertion_Error -- with given Message + represenation of expected and acutal values procedure Fail (Message : String); -- Fail always raises Assertion_Error with given Message. procedure Skip (Message : String); -- Skip always raises Test_Skipped_Error with given Message. end Ahven; ahven-2.1/src/ahven-results.ads0000664000076400007640000002413411637173541017023 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.SList; with Ahven.AStrings; pragma Elaborate_All (Ahven.SList); -- Like the name implies, the Results package is used for -- storing the test results. -- -- Result_Info holds one invidual result and -- Result_Collection holds multiple Result_Infos. -- package Ahven.Results is use Ahven.AStrings; type Result_Info is private; Empty_Result_Info : constant Result_Info; -- Result_Info object which holds no result. It can be used -- to initialize a new Result_Info object. procedure Set_Test_Name (Info : in out Result_Info; Name : Bounded_String); -- Set a test name for the result. procedure Set_Routine_Name (Info : in out Result_Info; Name : Bounded_String); -- Set a routine name for the result. procedure Set_Message (Info : in out Result_Info; Message : Bounded_String); -- Set a message for the result. procedure Set_Test_Name (Info : in out Result_Info; Name : String); -- A helper function, which calls Set_Test_Name (.. ; Bounded_String) procedure Set_Routine_Name (Info : in out Result_Info; Name : String); -- A helper function, which calls Set_Routine_Name (.. ; Bounded_String) procedure Set_Message (Info : in out Result_Info; Message : String); -- A helper function, which calls Set_Message (.. ; Bounded_String) procedure Set_Long_Message (Info : in out Result_Info; Message : Bounded_String); -- Set a long message for the result procedure Set_Long_Message (Info : in out Result_Info; Message : String); -- A helper function, which calls Set_Long_Message (.. ; Bounded_String) procedure Set_Execution_Time (Info : in out Result_Info; Elapsed_Time : Duration); -- Set the execution time of the result info (test). procedure Set_Output_File (Info : in out Result_Info; Filename : Bounded_String); -- Set the name of the test output file. procedure Set_Output_File (Info : in out Result_Info; Filename : String); -- Set the name of the test output file. function Get_Test_Name (Info : Result_Info) return String; -- Return the test name of the result info. function Get_Routine_Name (Info : Result_Info) return String; -- Return the routine name of the result info. function Get_Message (Info : Result_Info) return String; -- Return the message of the result info. function Get_Long_Message (Info : Result_Info) return String; -- Return the long message of the result info. function Get_Execution_Time (Info : Result_Info) return Duration; -- Return the execution time of the result info. function Get_Output_File (Info : Result_Info) return Bounded_String; -- Return the name of the output file. -- Empty string is returned in case there is no output file. type Result_Collection is limited private; -- A collection of Result_Info objects. -- Contains also child collections. type Result_Collection_Access is access Result_Collection; procedure Add_Child (Collection : in out Result_Collection; Child : Result_Collection_Access); -- Add a child collection to the collection. procedure Add_Error (Collection : in out Result_Collection; Info : Result_Info); -- Add a test error to the collection. procedure Add_Skipped (Collection : in out Result_Collection; Info : Result_Info); -- Add a skipped test to the collection. procedure Add_Failure (Collection : in out Result_Collection; Info : Result_Info); -- Add a test failure to the collection. procedure Add_Pass (Collection : in out Result_Collection; Info : Result_Info); -- Add a passed test to the collection procedure Release (Collection : in out Result_Collection); -- Release resourced held by the collection. -- Frees also all children added via Add_Child. procedure Set_Name (Collection : in out Result_Collection; Name : Bounded_String); -- Set a test name for the collection. procedure Set_Parent (Collection : in out Result_Collection; Parent : Result_Collection_Access); -- Set a parent collection to the collection. function Test_Count (Collection : Result_Collection) return Natural; -- Return the amount of tests in the collection. -- Tests in child collections are included. function Direct_Test_Count (Collection : Result_Collection) return Natural; -- Return the amount of tests in the collection. -- The tests in the child collections are NOT included. function Pass_Count (Collection : Result_Collection) return Natural; -- Return the amount of passed tests in the collection. -- Tests in child collections are included. function Error_Count (Collection : Result_Collection) return Natural; -- Return the amount of test errors in the collection. -- Tests in child collections are included. function Failure_Count (Collection : Result_Collection) return Natural; -- Return the amount of test errors in the collection. -- Tests in child collections are included. function Skipped_Count (Collection : Result_Collection) return Natural; -- Return the amount of skipped tests in the colleciton. -- Tests in child collections are included. function Get_Test_Name (Collection : Result_Collection) return Bounded_String; -- Return the name of the collection's test. function Get_Parent (Collection : Result_Collection) return Result_Collection_Access; -- Return the parent of the collection. function Get_Execution_Time (Collection : Result_Collection) return Duration; -- Return the execution time of the whole collection. type Result_Info_Cursor is private; -- A cursor type for Pass, Failure and Error results. function First_Pass (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first pass from the collection. function First_Failure (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first failure from the collection. function First_Skipped (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first skipped test from the collection. function First_Error (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first error from the collection. function Next (Position: Result_Info_Cursor) return Result_Info_Cursor; -- Get the next pass/failure/error. function Data (Position: Result_Info_Cursor) return Result_Info; -- Get the data behind the cursor. function Is_Valid (Position: Result_Info_Cursor) return Boolean; -- Is the cursor still valid? type Result_Collection_Cursor is private; -- Cursor for iterating over a set of Result_Collection access objects. function First_Child (Collection : in Result_Collection) return Result_Collection_Cursor; -- Get the first child of the collection. function Next (Position: Result_Collection_Cursor) return Result_Collection_Cursor; -- Get the next child. function Is_Valid (Position: Result_Collection_Cursor) return Boolean; -- Is the cursor still valid? function Data (Position: Result_Collection_Cursor) return Result_Collection_Access; -- Get the data (Result_Collection_Access) behind the cursor. function Child_Depth (Collection : Result_Collection) return Natural; -- Return the maximum depth of children. (a child of a child, etc.) -- -- Examples: Child_Depth is 0 for a collection without children. -- Collection with a child containing another child has a depth of 2. private type Result_Info is record Test_Name : Bounded_String := Null_Bounded_String; Output_File : Bounded_String := Null_Bounded_String; Routine_Name : Bounded_String := Null_Bounded_String; Execution_Time : Duration := 0.0; Message : Bounded_String := Null_Bounded_String; Long_Message : Bounded_String := Null_Bounded_String; end record; Empty_Result_Info : constant Result_Info := (Test_Name => Null_Bounded_String, Routine_Name => Null_Bounded_String, Message => Null_Bounded_String, Long_Message => Null_Bounded_String, Execution_Time => 0.0, Output_File => Null_Bounded_String); package Result_Info_List is new Ahven.SList (Element_Type => Result_Info); type Result_Collection_Wrapper is record Ptr : Result_Collection_Access; end record; -- Work around for Janus/Ada 3.1.1d/3.1.2beta generic bug. package Result_List is new Ahven.SList (Element_Type => Result_Collection_Wrapper); type Result_Info_Cursor is new Result_Info_List.Cursor; type Result_Collection_Cursor is new Result_List.Cursor; type Result_Collection is limited record Test_Name : Bounded_String := Null_Bounded_String; Passes : Result_Info_List.List; Failures : Result_Info_List.List; Errors : Result_Info_List.List; Skips : Result_Info_List.List; Children : Result_List.List; Parent : Result_Collection_Access := null; end record; end Ahven.Results; ahven-2.1/src/ahven-framework.ads0000664000076400007640000003300011637173541017307 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Finalization; with Ahven; with Ahven.Listeners; with Ahven.SList; with Ahven.AStrings; pragma Elaborate_All (Ahven); pragma Elaborate_All (Ahven.SList); package Ahven.Framework is Three_Hours : constant := 10800.0; subtype Test_Duration is Duration range 0.0 .. Three_Hours; type Test_Count_Type is new Natural; -- Type for the test count. This effectively -- limits the amount tests to whatever Natural is. -- -- Although, in practice when adding tests the limit -- is not checked. type Test is abstract new Ada.Finalization.Controlled with null record; -- A type, which provides the base for Test_Case and -- Test_Suite types. type Test_Class_Access is access all Test'Class; procedure Set_Up (T : in out Test); -- Set_Up is called before executing the test procedure. -- -- By default, the procedure does nothing, but derived -- types can overwrite this method and add their own -- customisations. -- -- One should not call this explicitly by herself. -- The framework calls it when necessary. procedure Tear_Down (T : in out Test); -- Tear_Down is called after the test procedure is executed. -- -- By default, the procedure does nothing, but derived -- types can overwrite this method and add their own -- customisations. -- -- One should not call this explicitly by herself. -- The framework calls it when necessary. function Get_Name (T : Test) return String is abstract; -- Return the name of the test. -- -- Types derived from the Test type are required to overwrite -- this procedure. procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); -- Run the test and place the test result to Result. -- -- Calls Run (T, Listener, Timeout) with Timeout value 0.0. procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; -- Run the test and place the test result to Result. -- Timeout specifies the maximum runtime for a single test. -- -- Types derived from the Test type are required to overwrite -- this procedure. procedure Run (T : in out Test; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); -- Run the test and place the test result to Result. -- -- Calls Run (T, Test_Name, Listener, Timeout) with Timeout value 0.0. procedure Run (T : in out Test; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; -- Run the test with given name and place the test result to Result. -- Timeout specifies the maximum runtime for a single test. -- Notice: If multiple tests have same name this might call all of -- them. -- -- Types derived from the Test type are required to overwrite -- this procedure. function Test_Count (T : Test) return Test_Count_Type is abstract; -- Return the amount of tests (test routines) which will be executed when -- the Run (T) procedure is called. function Test_Count (T : Test; Test_Name : String) return Test_Count_Type is abstract; -- Return the amount of tests (test routines) which will be executed when -- the Run (T, Test_Name) procedure is called. procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Call Test class' Run method and place the test outcome to Result. -- The procedure calls Start_Test of every listener before calling -- the Run procedure and End_Test after calling the Run procedure. -- -- This procedure is meant to be called from Runner package(s). -- There should be no need for other to use this. procedure Execute (T : in out Test'Class; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Same as Execute above, but call the Run procedure which -- takes Test_Name parameter. type Test_Case is abstract new Test with private; -- The base type for other test cases. function Get_Name (T : Test_Case) return String; -- Return the name of the test case. procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run Test_Case's test routines. procedure Run (T : in out Test_Case; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run Test_Case's test routine which matches to the Name. function Test_Count (T : Test_Case) return Test_Count_Type; -- Implementation of Test_Count (T : Test). function Test_Count (T : Test_Case; Test_Name : String) return Test_Count_Type; -- Implementation of Test_Count (T : Test, Test_Name : String). procedure Finalize (T : in out Test_Case); -- Finalize procedure of the Test_Case. procedure Set_Name (T : in out Test_Case; Name : String); -- Set Test_Case's name. -- -- If longer than 160 characters, the name is truncated -- to 160 characters. type Object_Test_Routine_Access is access procedure (T : in out Test_Case'Class); -- A pointer to a test routine which takes Test_Case'Class object -- as an argument. -- -- For this kind of test routines, the framework will -- call Set_Up and Tear_Down routines before and after -- test routine execution. type Simple_Test_Routine_Access is access procedure; -- A pointer to a test routine which does not take arguments. procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Object_Test_Routine_Access; Name : String); -- Register a test routine to the Test_Case object. -- -- The routine must have signature -- "procedure R (T : in out Test_Case'Class)". procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Simple_Test_Routine_Access; Name : String); -- Register a simple test routine to the Test_Case. -- -- The routine must have signature -- "procedure R". type Test_Suite is new Test with private; -- A collection of Tests. -- -- You can either fill a Test_Suite object with Test_Case objects -- or nest multiple Test_Suite objects. You can even mix -- Test_Case and Test_Suite objects, if necessary. type Test_Suite_Access is access all Test_Suite; function Create_Suite (Suite_Name : String) return Test_Suite_Access; -- Create a new Test_Suite. -- Caller must free the returned Test_Suite using Release_Suite. function Create_Suite (Suite_Name : String) return Test_Suite; -- Create a new Test_Suite. The suite and its children are -- released automatically. procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access); -- Add a Test to the suite. The suite frees the Test automatically -- when it is no longer needed. procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access); -- Add a Test suite to the suite. The suite frees the Test automatically -- when it is no longer needed. -- -- This is a helper function, which internally calls -- Add_Test (Suite : in out Test_Suite; T : Test_Class_Access). procedure Add_Static_Test (Suite : in out Test_Suite; T : Test'Class); -- Add a Test to the suite. This procedure is meant for statically -- allocated Test_Case objects. -- -- Please note, that a copy of the Test'Class object is saved to -- the suite. Original test object is not modified and changes -- made to it after adding the test are not propagated to -- the added object. function Get_Name (T : Test_Suite) return String; -- Return the name of Test_Suite. procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run Test_Suite's Test_Cases. procedure Run (T : in out Test_Suite; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run test suite's child which matches to the given name. function Test_Count (T : Test_Suite) return Test_Count_Type; -- Implementation of Test_Count (T : Test). function Test_Count (T : Test_Suite; Test_Name : String) return Test_Count_Type; -- Implementation of Test_Count (T : Test, Test_Name : String). procedure Adjust (T : in out Test_Suite); -- Adjust procedure of Test_Suite. -- Handles the copying of the structure properly procedure Finalize (T : in out Test_Suite); -- Finalize procedure of Test_Suite. Frees all added Tests. procedure Release_Suite (T : Test_Suite_Access); -- Release the memory of Test_Suite. -- All added tests are released automatically. private type Command_Object_Enum is (SIMPLE, OBJECT); type Test_Command (Command_Kind : Command_Object_Enum := SIMPLE) is record Name : AStrings.Bounded_String; case Command_Kind is when SIMPLE => Simple_Routine : Simple_Test_Routine_Access; when OBJECT => Object_Routine : Object_Test_Routine_Access; end case; end record; -- Name attribute tells the name of the test routine. procedure Run (Command : Test_Command; T : in out Test_Case'Class); -- Run the specified command. -- Calls Set_Up and Tear_Down if necessary. package Test_Command_List is new Ahven.SList (Element_Type => Test_Command); type Test_Case is abstract new Test with record Routines : Test_Command_List.List := Test_Command_List.Empty_List; Name : AStrings.Bounded_String := AStrings.Null_Bounded_String; end record; -- Our test case type. It holds a list of test routines -- (test command objects) and the name of the test case. procedure Run_Command (Command : Test_Command; Info : Listeners.Context; Timeout : Test_Duration; Listener : in out Listeners.Result_Listener'Class; T : in out Test_Case'Class); -- Handle dispatching to the right Run (Command : Test_Command) -- procedure and record test routine result to the Result object. -- -- Timeout parameter defines the longest time the test is allowed -- to run. Value 0.0 means infinite time. type Test_Class_Wrapper is record Ptr : Test_Class_Access; end record; package Test_List is new Ahven.SList (Element_Type => Test_Class_Wrapper); package Indefinite_Test_List is type List is new Ada.Finalization.Controlled with private; Empty_List : constant List; procedure Append (Target : in out List; Node_Data : Test'Class); -- Append an element at the end of the list. procedure Clear (Target : in out List); -- Remove all elements from the list. generic with procedure Action (T : in out Test'Class) is <>; procedure For_Each (Target : List); -- A generic procedure for walk through every item -- in the list and call Action procedure for them. private type Node; type Node_Access is access Node; procedure Remove (Ptr : Node_Access); -- A procedure to release memory pointed by Ptr. type Node is record Next : Node_Access := null; Data : Test_Class_Access := null; end record; type List is new Ada.Finalization.Controlled with record First : Node_Access := null; Last : Node_Access := null; end record; procedure Initialize (Target : in out List); procedure Finalize (Target : in out List); procedure Adjust (Target : in out List); Empty_List : constant List := (Ada.Finalization.Controlled with First => null, Last => null); end Indefinite_Test_List; type Test_Suite is new Test with record Suite_Name : AStrings.Bounded_String := AStrings.Null_Bounded_String; Test_Cases : Test_List.List := Test_List.Empty_List; Static_Test_Cases : Indefinite_Test_List.List := Indefinite_Test_List.Empty_List; end record; -- A suite type which holds a list of test cases and the name -- of the suite. end Ahven.Framework; ahven-2.1/src/ahven-slist.adb0000664000076400007640000000772111637173541016442 0ustar tkoskinetkoskine-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Unchecked_Deallocation; package body Ahven.SList is procedure Remove (Ptr : Node_Access) is procedure Free is new Ada.Unchecked_Deallocation (Object => Node, Name => Node_Access); My_Ptr : Node_Access := Ptr; begin Ptr.Next := null; Free (My_Ptr); end Remove; procedure Append (Target : in out List; Node_Data : Element_Type) is New_Node : Node_Access := null; begin if Target.Size = Count_Type'Last then raise List_Full; end if; New_Node := new Node'(Data => Node_Data, Next => null); if Target.Last = null then Target.First := New_Node; else Target.Last.Next := New_Node; end if; Target.Last := New_Node; Target.Size := Target.Size + 1; end Append; procedure Clear (Target : in out List) is Current_Node : Node_Access := Target.First; Next_Node : Node_Access := null; begin while Current_Node /= null loop Next_Node := Current_Node.Next; Remove (Current_Node); Current_Node := Next_Node; end loop; Target.First := null; Target.Last := null; Target.Size := 0; end Clear; function First (Target : List) return Cursor is begin return Cursor (Target.First); end First; function Next (Position : Cursor) return Cursor is begin if Position = null then raise Invalid_Cursor; end if; return Cursor (Position.Next); end Next; function Data (Position : Cursor) return Element_Type is begin if Position = null then raise Invalid_Cursor; end if; return Position.Data; end Data; function Is_Valid (Position : Cursor) return Boolean is begin return Position /= null; end Is_Valid; function Length (Target : List) return Count_Type is begin return Target.Size; end Length; procedure For_Each (Target : List) is Current_Node : Node_Access := Target.First; begin while Current_Node /= null loop Action (Current_Node.Data); Current_Node := Current_Node.Next; end loop; end For_Each; procedure Initialize (Target : in out List) is begin Target.Last := null; Target.First := null; Target.Size := 0; end Initialize; procedure Finalize (Target : in out List) is begin Clear (Target); end Finalize; procedure Adjust (Target : in out List) is Target_Last : Node_Access := null; Target_First : Node_Access := null; Current : Node_Access := Target.First; New_Node : Node_Access; begin -- Recreate the list using the same data while Current /= null loop New_Node := new Node'(Data => Current.Data, Next => null); if Target_Last = null then Target_First := New_Node; else Target_Last.Next := New_Node; end if; Target_Last := New_Node; Current := Current.Next; end loop; Target.First := Target_First; Target.Last := Target_Last; -- No need to adjust size, it is same as before copying end Adjust; end Ahven.SList; ahven-2.1/src/ahven-results.adb0000664000076400007640000003217711637173541017010 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Unchecked_Deallocation; package body Ahven.Results is use Ahven.Results.Result_List; use Ahven.Results.Result_Info_List; -- Bunch of setters and getters. -- The implementation is straightforward. procedure Set_Test_Name (Info : in out Result_Info; Name : Bounded_String) is begin Info.Test_Name := Name; end Set_Test_Name; procedure Set_Routine_Name (Info : in out Result_Info; Name : Bounded_String) is begin Info.Routine_Name := Name; end Set_Routine_Name; procedure Set_Message (Info : in out Result_Info; Message : Bounded_String) is begin Info.Message := Message; end Set_Message; procedure Set_Test_Name (Info : in out Result_Info; Name : String) is begin Set_Test_Name (Info, To_Bounded_String (Name)); end Set_Test_Name; procedure Set_Routine_Name (Info : in out Result_Info; Name : String) is begin Set_Routine_Name (Info, To_Bounded_String (Name)); end Set_Routine_Name; procedure Set_Message (Info : in out Result_Info; Message : String) is begin Set_Message (Info, To_Bounded_String (Message)); end Set_Message; procedure Set_Long_Message (Info : in out Result_Info; Message : Bounded_String) is begin Info.Long_Message := Message; end Set_Long_Message; procedure Set_Long_Message (Info : in out Result_Info; Message : String) is begin Set_Long_Message (Info, To_Bounded_String (Message)); end Set_Long_Message; procedure Set_Execution_Time (Info : in out Result_Info; Elapsed_Time : Duration) is begin Info.Execution_Time := Elapsed_Time; end Set_Execution_Time; procedure Set_Output_File (Info : in out Result_Info; Filename : Bounded_String) is begin Info.Output_File := Filename; end Set_Output_File; procedure Set_Output_File (Info : in out Result_Info; Filename : String) is begin Set_Output_File (Info, To_Bounded_String (Filename)); end Set_Output_File; function Get_Test_Name (Info : Result_Info) return String is begin return To_String (Info.Test_Name); end Get_Test_Name; function Get_Routine_Name (Info : Result_Info) return String is begin return To_String (Info.Routine_Name); end Get_Routine_Name; function Get_Message (Info : Result_Info) return String is begin return To_String (Info.Message); end Get_Message; function Get_Long_Message (Info : Result_Info) return String is begin return To_String (Info.Long_Message); end Get_Long_Message; function Get_Execution_Time (Info : Result_Info) return Duration is begin return Info.Execution_Time; end Get_Execution_Time; function Get_Output_File (Info : Result_Info) return Bounded_String is begin return Info.Output_File; end Get_Output_File; procedure Add_Child (Collection : in out Result_Collection; Child : Result_Collection_Access) is begin Append (Collection.Children, (Ptr => Child)); end Add_Child; procedure Add_Error (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Errors, Info); end Add_Error; procedure Add_Skipped (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Skips, Info); end Add_Skipped; procedure Add_Failure (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Failures, Info); end Add_Failure; procedure Add_Pass (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Passes, Info); end Add_Pass; -- When Result_Collection is released, it recursively releases -- its all children. procedure Release (Collection : in out Result_Collection) is procedure Free is new Ada.Unchecked_Deallocation (Object => Result_Collection, Name => Result_Collection_Access); Position: Result_List.Cursor := First (Collection.Children); Ptr : Result_Collection_Access := null; begin loop exit when not Is_Valid (Position); Ptr := Data (Position).Ptr; Release (Ptr.all); Free (Ptr); Position := Next (Position); end loop; Clear (Collection.Children); -- No need to call Free for these three since -- they are stored as plain objects instead of pointers. Clear (Collection.Errors); Clear (Collection.Failures); Clear (Collection.Passes); end Release; procedure Set_Name (Collection : in out Result_Collection; Name : Bounded_String) is begin Collection.Test_Name := Name; end Set_Name; procedure Set_Parent (Collection : in out Result_Collection; Parent : Result_Collection_Access) is begin Collection.Parent := Parent; end Set_Parent; function Test_Count (Collection : Result_Collection) return Natural is Count : Natural := Result_Info_List.Length (Collection.Errors) + Result_Info_List.Length (Collection.Failures) + Result_Info_List.Length (Collection.Skips) + Result_Info_List.Length (Collection.Passes); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Test_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Test_Count; function Direct_Test_Count (Collection : Result_Collection) return Natural is begin return Length (Collection.Errors) + Length (Collection.Failures) + Length (Collection.Passes); end Direct_Test_Count; function Pass_Count (Collection : Result_Collection) return Natural is Count : Natural := Length (Collection.Passes); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Pass_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Pass_Count; function Error_Count (Collection : Result_Collection) return Natural is Count : Natural := Length (Collection.Errors); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Error_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Error_Count; function Failure_Count (Collection : Result_Collection) return Natural is Count : Natural := Length (Collection.Failures); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Failure_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Failure_Count; function Skipped_Count (Collection : Result_Collection) return Natural is Count : Natural := Length (Collection.Skips); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Skipped_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Skipped_Count; function Get_Test_Name (Collection : Result_Collection) return Bounded_String is begin return Collection.Test_Name; end Get_Test_Name; function Get_Parent (Collection : Result_Collection) return Result_Collection_Access is begin return Collection.Parent; end Get_Parent; function Get_Execution_Time (Collection : Result_Collection) return Duration is Position : Result_Info_List.Cursor; Total_Time : Duration := 0.0; Child_Position : Result_List.Cursor; begin Position := First (Collection.Passes); Pass_Loop: loop exit Pass_Loop when not Is_Valid (Position); Total_Time := Total_Time + Get_Execution_Time (Data (Position)); Position := Next (Position); end loop Pass_Loop; Position := First (Collection.Failures); Failure_Loop: loop exit Failure_Loop when not Is_Valid (Position); Total_Time := Total_Time + Get_Execution_Time (Data (Position)); Position := Next (Position); end loop Failure_Loop; Position := First (Collection.Errors); Error_Loop: loop exit Error_Loop when not Is_Valid (Position); Total_Time := Total_Time + Get_Execution_Time (Data (Position)); Position := Next (Position); end loop Error_Loop; Child_Loop: loop exit Child_Loop when not Result_List.Is_Valid (Child_Position); Total_Time := Total_Time + Get_Execution_Time (Result_List.Data (Child_Position).Ptr.all); Child_Position := Result_List.Next (Child_Position); end loop Child_Loop; return Total_Time; end Get_Execution_Time; function First_Pass (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Passes); end First_Pass; function First_Failure (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Failures); end First_Failure; function First_Skipped (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Skips); end First_Skipped; function First_Error (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Errors); end First_Error; function Next (Position: Result_Info_Cursor) return Result_Info_Cursor is begin return Result_Info_Cursor (Result_Info_List.Next (Result_Info_List.Cursor (Position))); end Next; function Data (Position: Result_Info_Cursor) return Result_Info is begin return Result_Info_List.Data (Result_Info_List.Cursor (Position)); end Data; function Is_Valid (Position: Result_Info_Cursor) return Boolean is begin return Result_Info_List.Is_Valid (Result_Info_List.Cursor (Position)); end Is_Valid; function First_Child (Collection : in Result_Collection) return Result_Collection_Cursor is begin return First (Collection.Children); end First_Child; function Next (Position: Result_Collection_Cursor) return Result_Collection_Cursor is begin return Result_Collection_Cursor (Result_List.Next (Result_List.Cursor (Position))); end Next; function Is_Valid (Position: Result_Collection_Cursor) return Boolean is begin return Result_List.Is_Valid (Result_List.Cursor (Position)); end Is_Valid; function Data (Position: Result_Collection_Cursor) return Result_Collection_Access is begin return Result_List.Data (Result_List.Cursor (Position)).Ptr; end Data; function Child_Depth (Collection : Result_Collection) return Natural is function Child_Depth_Impl (Coll : Result_Collection; Level : Natural) return Natural; function Child_Depth_Impl (Coll : Result_Collection; Level : Natural) return Natural is Max : Natural := 0; Current : Natural := 0; Position : Result_List.Cursor := Result_List.First (Coll.Children); begin loop exit when not Is_Valid (Position); Current := Child_Depth_Impl (Data (Position).Ptr.all, Level + 1); if Max < Current then Max := Current; end if; Position := Result_List.Next (Position); end loop; return Level + Max; end Child_Depth_Impl; begin return Child_Depth_Impl (Collection, 0); end Child_Depth; end Ahven.Results; ahven-2.1/src/ahven-xml_runner.ads0000664000076400007640000000276611637173541017522 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Results; with Ahven.Parameters; package Ahven.XML_Runner is procedure Run (Suite : in out Framework.Test_Suite'Class); -- Run the suite and print the results. procedure Run (Suite : Framework.Test_Suite_Access); -- Run the suite and print the results. The routine is -- identical to the above routine, but takes an access -- parameter to a test suite. procedure Report_Results (Result : Results.Result_Collection; Dir : String); -- Report results to the given directory. private procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); end Ahven.XML_Runner; ahven-2.1/src/ahven-runner.adb0000664000076400007640000000372411637173541016614 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Command_Line; with Ahven.Listeners; with Ahven.Listeners.Basic; package body Ahven.Runner is use Ahven.Results; procedure Run_Suite (Suite : in out Framework.Test'Class; Reporter : Report_Proc) is use Ahven.Listeners.Basic; Listener : Listeners.Basic.Basic_Listener; Params : Parameters.Parameter_Info; begin Parameters.Parse_Parameters (Parameters.NORMAL_PARAMETERS, Params); Set_Output_Capture (Listener, Parameters.Capture (Params)); if Parameters.Single_Test (Params) then Framework.Execute (T => Suite, Test_Name => Parameters.Test_Name (Params), Listener => Listener, Timeout => Parameters.Timeout (Params)); else Framework.Execute (Suite, Listener, Parameters.Timeout (Params)); end if; Reporter (Listener.Main_Result, Params); if (Error_Count (Listener.Main_Result) > 0) or (Failure_Count (Listener.Main_Result) > 0) then Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); end if; exception when Parameters.Invalid_Parameter => Parameters.Usage; end Run_Suite; end Ahven.Runner; ahven-2.1/src/ahven-listeners.ads0000664000076400007640000000542311637173541017332 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Finalization; with Ahven.AStrings; package Ahven.Listeners is type Test_Phase is (TEST_BEGIN, TEST_RUN, TEST_END); -- What is test doing right now? type Test_Type is (CONTAINER, ROUTINE); type Context (Phase : Test_Phase) is record Test_Name : AStrings.Bounded_String; Test_Kind : Test_Type; case Phase is when TEST_BEGIN | TEST_END => null; when TEST_RUN => Routine_Name : AStrings.Bounded_String; Message : AStrings.Bounded_String; Long_Message : AStrings.Bounded_String; end case; end record; type Result_Listener is abstract new Ada.Finalization.Limited_Controlled with null record; -- Result_Listener is a listener for test results. -- Whenever a test is run, the framework calls -- registered listeners and tells them the result of the test. type Result_Listener_Class_Access is access all Result_Listener'Class; procedure Add_Pass (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after test passes. procedure Add_Failure (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after test fails. procedure Add_Skipped (Listener : in out Result_Listener; Info : Context); -- Called when user wants to skip the test. procedure Add_Error (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after there is an error in the test. procedure Start_Test (Listener : in out Result_Listener; Info : Context) is abstract; -- Called before the test begins. This is called before Add_* procedures. procedure End_Test (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after the test ends. Add_* procedures are called before this. end Ahven.Listeners; ahven-2.1/src/ahven-text_runner.ads0000664000076400007640000000254111637173541017675 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Results; with Ahven.Parameters; pragma Elaborate_All (Ahven.Framework); pragma Elaborate_All (Ahven.Results); pragma Elaborate_All (Ahven.Parameters); package Ahven.Text_Runner is procedure Run (Suite : in out Framework.Test'Class); -- Run the suite and print the results. procedure Run (Suite : Framework.Test_Suite_Access); -- Run the suite and print the results. private procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); end Ahven.Text_Runner; ahven-2.1/src/ahven-astrings.ads0000664000076400007640000000163211637173541017152 0ustar tkoskinetkoskine-- -- Copyright (c) 2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Bounded; package Ahven.AStrings is new Ada.Strings.Bounded.Generic_Bounded_Length (Max => Max_String_Len); ahven-2.1/src/ahven-listeners-basic.adb0000664000076400007640000001742611637173541020376 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; with Ahven.AStrings; package body Ahven.Listeners.Basic is use Ahven.AStrings; -- Because of Ada.Text_IO output capturing, the result -- recording is happening in the End_Test procedure. -- -- Add_{Pass,Failure,Error} procedures delegate result -- saving to the Set_Last_Test_Info procedure, which -- records the latest result to the listener. procedure Set_Last_Test_Info (Listener : in out Basic_Listener; Info : Context; Result : Result_Type) is begin Listener.Last_Test_Result := Result; if Info.Phase = TEST_RUN then Results.Set_Routine_Name (Listener.Last_Info, Info.Routine_Name); Results.Set_Test_Name (Listener.Last_Info, Info.Test_Name); Results.Set_Message (Listener.Last_Info, Info.Message); Results.Set_Long_Message (Listener.Last_Info, Info.Long_Message); end if; end Set_Last_Test_Info; procedure Add_Pass (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, PASS_RESULT); end Add_Pass; procedure Add_Failure (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, FAILURE_RESULT); end Add_Failure; procedure Add_Skipped (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, SKIPPED_RESULT); end Add_Skipped; procedure Add_Error (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, ERROR_RESULT); end Add_Error; procedure Start_Test (Listener : in out Basic_Listener; Info : Context) is R : Result_Collection_Access := null; begin Listener.Start_Time := Ada.Calendar.Clock; if Info.Test_Kind = CONTAINER then R := new Result_Collection; Set_Name (R.all, Info.Test_Name); Set_Parent (R.all, Listener.Current_Result); if Listener.Current_Result = null then Add_Child (Listener.Main_Result, R); else Add_Child (Listener.Current_Result.all, R); end if; Listener.Current_Result := R; elsif Listener.Capture_Output then -- A test routine? Let's create a temporary file -- and direct Ada.Text_IO output there (if requested). Temporary_Output.Create_Temp (Listener.Output_File); Temporary_Output.Redirect_Output (Listener.Output_File); end if; end Start_Test; procedure End_Test (Listener : in out Basic_Listener; Info : Context) is use type Ada.Calendar.Time; Execution_Time : constant Duration := Ada.Calendar.Clock - Listener.Start_Time; procedure Add_Result (Collection : in out Result_Collection) is My_Info : Result_Info := Listener.Last_Info; begin if Info.Phase = TEST_RUN then Set_Routine_Name (My_Info, To_String (Info.Routine_Name)); end if; -- It is possible that only Start_Test and End_Test -- are called (e.g. for Test_Suite), so the latest -- test result can be unset (set to NO_RESULT) -- -- In that case, we simply jump to parent collection. -- Otherwise, we record the result. if Listener.Last_Test_Result /= NO_RESULT then if Listener.Capture_Output then -- End of the test routine, so we can restore -- the normal output now and close the temporary file. Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); -- Saving the name of the temporary file to the test result, -- so the file can be deleted later Set_Output_File (My_Info, Temporary_Output.Get_Name (Listener.Output_File)); end if; Set_Message (My_Info, Get_Message (Listener.Last_Info)); Set_Long_Message (My_Info, Get_Long_Message (Listener.Last_Info)); Results.Set_Execution_Time (My_Info, Execution_Time); case Listener.Last_Test_Result is when PASS_RESULT => Add_Pass (Collection, My_Info); when FAILURE_RESULT => Add_Failure (Collection, My_Info); when ERROR_RESULT | NO_RESULT => Add_Error (Collection, My_Info); when SKIPPED_RESULT => Add_Skipped (Collection, My_Info); end case; Listener.Last_Test_Result := NO_RESULT; else Listener.Current_Result := Get_Parent (Listener.Current_Result.all); end if; end Add_Result; begin if Listener.Current_Result /= null then Add_Result (Listener.Current_Result.all); else Add_Result (Listener.Main_Result); end if; end End_Test; procedure Set_Output_Capture (Listener : in out Basic_Listener; Capture : Boolean) is begin Listener.Capture_Output := Capture; end Set_Output_Capture; function Get_Output_Capture (Listener : Basic_Listener) return Boolean is begin return Listener.Capture_Output; end Get_Output_Capture; procedure Remove_File (Name : String) is Handle : Ada.Text_IO.File_Type; begin Ada.Text_IO.Open (Handle, Ada.Text_IO.Out_File, Name); Ada.Text_IO.Delete (Handle); exception when others => null; -- For now we can safely ignore errors (like missing file) end Remove_File; procedure Remove_Files (Collection : in out Result_Collection) is procedure Remove (Name : Bounded_String) is begin if Length (Name) > 0 then Remove_File (To_String (Name)); end if; end Remove; procedure Remove_Loop (First_Item : Result_Info_Cursor) is Loop_Iter : Result_Info_Cursor := First_Item; begin loop exit when not Is_Valid (Loop_Iter); Remove (Get_Output_File (Data (Loop_Iter))); Loop_Iter := Next (Loop_Iter); end loop; end Remove_Loop; Child_Iter : Result_Collection_Cursor; begin Remove_Loop (First_Pass (Collection)); Remove_Loop (First_Failure (Collection)); Remove_Loop (First_Error (Collection)); Remove_Loop (First_Skipped (Collection)); Child_Iter := First_Child (Collection); Child_Loop: loop exit Child_Loop when not Is_Valid (Child_Iter); Remove_Files (Data (Child_Iter).all); Child_Iter := Next (Child_Iter); end loop Child_Loop; end Remove_Files; procedure Finalize (Listener : in out Basic_Listener) is begin Remove_Files (Listener.Main_Result); Results.Release (Listener.Main_Result); end Finalize; end Ahven.Listeners.Basic; ahven-2.1/src/ahven-xml_runner.adb0000664000076400007640000003066511637173541017500 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; with Ada.Strings; with Ada.Strings.Fixed; with Ada.Strings.Maps; with Ahven.Runner; with Ahven_Compat; with Ahven.AStrings; package body Ahven.XML_Runner is use Ada.Text_IO; use Ada.Strings.Fixed; use Ada.Strings.Maps; use Ahven.Results; use Ahven.Framework; use Ahven.AStrings; function Filter_String (Str : String) return String; function Filter_String (Str : String; Map : Character_Mapping) return String; procedure Print_Test_Pass (File : File_Type; Parent_Test : String; Info : Result_Info); procedure Print_Test_Failure (File : File_Type; Parent_Test : String; Info : Result_Info); procedure Print_Test_Error (File : File_Type; Parent_Test : String; Info : Result_Info); procedure Print_Test_Case (Collection : Result_Collection; Dir : String); procedure Print_Log_File (File : File_Type; Filename : String); procedure Print_Attribute (File : File_Type; Attr : String; Value : String); procedure Start_Testcase_Tag (File : File_Type; Parent : String; Name : String; Execution_Time : String); procedure End_Testcase_Tag (File : File_Type); function Create_Name (Dir : String; Name : String) return String; function Filter_String (Str : String) return String is Result : String (Str'Range); begin for I in Str'Range loop if Str (I) = ''' then Result (I) := '_'; else Result (I) := Str (I); end if; end loop; return Result; end Filter_String; function Filter_String (Str : String; Map : Character_Mapping) return String is begin return Translate (Source => Str, Mapping => Map); end Filter_String; procedure Print_Attribute (File : File_Type; Attr : String; Value : String) is begin Put (File, Attr & "=" & '"' & Value & '"'); end Print_Attribute; procedure Start_Testcase_Tag (File : File_Type; Parent : String; Name : String; Execution_Time : String) is begin Put (File, ""); end Start_Testcase_Tag; procedure End_Testcase_Tag (File : File_Type) is begin Put_Line (File, ""); end End_Testcase_Tag; function Create_Name (Dir : String; Name : String) return String is function Filename (Test : String) return String is Map : Ada.Strings.Maps.Character_Mapping; begin Map := To_Mapping (From => " '/\<>:|?*()" & '"', To => "-___________" & '_'); return "TEST-" & Filter_String (Test, Map) & ".xml"; end Filename; begin if Dir'Length > 0 then return Dir & Ahven_Compat.Directory_Separator & Filename (Name); else return Filename (Name); end if; end Create_Name; procedure Print_Test_Pass (File : File_Type; Parent_Test : String; Info : Result_Info) is Exec_Time : constant String := Trim (Duration'Image (Get_Execution_Time (Info)), Ada.Strings.Both); begin Start_Testcase_Tag (File => File, Parent => Parent_Test, Name => Get_Routine_Name (Info), Execution_Time => Exec_Time); if Length (Get_Output_File (Info)) > 0 then Put (File, ""); Print_Log_File (File, To_String (Get_Output_File (Info))); Put_Line (File, ""); end if; End_Testcase_Tag (File); end Print_Test_Pass; procedure Print_Test_Failure (File : File_Type; Parent_Test : String; Info : Result_Info) is Exec_Time : constant String := Trim (Duration'Image (Get_Execution_Time (Info)), Ada.Strings.Both); begin Start_Testcase_Tag (File => File, Parent => Parent_Test, Name => Get_Routine_Name (Info), Execution_Time => Exec_Time); Put (File, ""); Put_Line (File, Get_Message (Info)); Put_Line (File, ""); if Length (Get_Output_File (Info)) > 0 then Put (File, ""); Print_Log_File (File, To_String (Get_Output_File (Info))); Put_Line (File, ""); end if; End_Testcase_Tag (File); end Print_Test_Failure; procedure Print_Test_Error (File : File_Type; Parent_Test : String; Info : Result_Info) is Exec_Time : constant String := Trim (Duration'Image (Get_Execution_Time (Info)), Ada.Strings.Both); begin Start_Testcase_Tag (File => File, Parent => Parent_Test, Name => Get_Routine_Name (Info), Execution_Time => Exec_Time); Put (File, ""); Put_Line (File, Get_Message (Info)); Put_Line (File, ""); if Length (Get_Output_File (Info)) > 0 then Put (File, ""); Print_Log_File (File, To_String (Get_Output_File (Info))); Put_Line (File, ""); end if; End_Testcase_Tag (File); end Print_Test_Error; procedure Print_Test_Case (Collection : Result_Collection; Dir : String) is procedure Print (Output : File_Type; Result : Result_Collection); -- Internal procedure to print the testcase into given file. function Img (Value : Natural) return String is begin return Trim (Natural'Image (Value), Ada.Strings.Both); end Img; procedure Print (Output : File_Type; Result : Result_Collection) is Position : Result_Info_Cursor; begin Put_Line (Output, ""); Put (Output, ""); Position := First_Error (Result); Error_Loop: loop exit Error_Loop when not Is_Valid (Position); Print_Test_Error (Output, To_String (Get_Test_Name (Result)), Data (Position)); Position := Next (Position); end loop Error_Loop; Position := First_Failure (Result); Failure_Loop: loop exit Failure_Loop when not Is_Valid (Position); Print_Test_Failure (Output, To_String (Get_Test_Name (Result)), Data (Position)); Position := Next (Position); end loop Failure_Loop; Position := First_Pass (Result); Pass_Loop: loop exit Pass_Loop when not Is_Valid (Position); Print_Test_Pass (Output, To_String (Get_Test_Name (Result)), Data (Position)); Position := Next (Position); end loop Pass_Loop; Put_Line (Output, ""); end Print; File : File_Type; begin if Dir = "-" then Print (Standard_Output, Collection); else Create (File => File, Mode => Ada.Text_IO.Out_File, Name => Create_Name (Dir, To_String (Get_Test_Name (Collection)))); Print (File, Collection); Ada.Text_IO.Close (File); end if; end Print_Test_Case; procedure Report_Results (Result : Result_Collection; Dir : String) is Position : Result_Collection_Cursor; begin Position := First_Child (Result); loop exit when not Is_Valid (Position); if Child_Depth (Data (Position).all) = 0 then Print_Test_Case (Data (Position).all, Dir); else Report_Results (Data (Position).all, Dir); -- Handle the test cases in this collection if Direct_Test_Count (Result) > 0 then Print_Test_Case (Result, Dir); end if; end if; Position := Next (Position); end loop; end Report_Results; -- Print the log by placing the data inside CDATA block. procedure Print_Log_File (File : File_Type; Filename : String) is type CData_End_State is (NONE, FIRST_BRACKET, SECOND_BRACKET); function State_Change (Old_State : CData_End_State) return CData_End_State; Handle : File_Type; Char : Character := ' '; First : Boolean := True; -- We need to escape ]]>, this variable tracks -- the characters, so we know when to do the escaping. CData_Ending : CData_End_State := NONE; function State_Change (Old_State : CData_End_State) return CData_End_State is New_State : CData_End_State := NONE; -- By default New_State will be NONE, so there is -- no need to set it inside when blocks. begin case Old_State is when NONE => if Char = ']' then New_State := FIRST_BRACKET; end if; when FIRST_BRACKET => if Char = ']' then New_State := SECOND_BRACKET; end if; when SECOND_BRACKET => if Char = '>' then Put (File, " "); end if; end case; return New_State; end State_Change; begin Open (Handle, In_File, Filename); loop exit when End_Of_File (Handle); Get (Handle, Char); if First then Put (File, ""); end if; end Print_Log_File; procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info) is begin Report_Results (Test_Results, Parameters.Result_Dir (Args)); end Do_Report; procedure Run (Suite : in out Framework.Test_Suite'Class) is begin Runner.Run_Suite (Suite, Do_Report'Access); end Run; procedure Run (Suite : Framework.Test_Suite_Access) is begin Run (Suite.all); end Run; end Ahven.XML_Runner; ahven-2.1/src/ahven-framework.adb0000664000076400007640000006026011637173541017276 0ustar tkoskinetkoskine-- -- Copyright (c) 2007-2011 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings; with Ada.Unchecked_Deallocation; with Ada.Exceptions; package body Ahven.Framework is use Ahven.AStrings; -- A few local procedures, so we do not need to duplicate code. procedure Free_Test is new Ada.Unchecked_Deallocation (Object => Test'Class, Name => Test_Class_Access); generic with procedure Action is <>; procedure Execute_Internal (Test_Object : in out Test'Class; Listener_Object : in out Listeners.Result_Listener'Class); -- Logic for Execute procedures. Action is specified by the caller. procedure Set_Up (T : in out Test) is begin null; end Set_Up; procedure Tear_Down (T : in out Test) is begin null; end Tear_Down; procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class) is begin Run (T => Test'Class (T), Listener => Listener, Timeout => 0.0); end Run; procedure Run (T : in out Test; Test_Name : String; Listener : in out Listeners.Result_Listener'Class) is begin Run (T => Test'Class (T), Test_Name => Test_Name, Listener => Listener, Timeout => 0.0); end Run; procedure Execute_Internal (Test_Object : in out Test'Class; Listener_Object : in out Listeners.Result_Listener'Class) is use Ahven.Listeners; begin -- This Start_Test here is called for Test_Suites and Test_Cases. -- Info includes only the name of the test suite/case. -- -- There is a separate Start_Test/End_Test pair for test routines -- in the Run (T : in out Test_Case; ...) procedure. Listeners.Start_Test (Listener_Object, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String (Get_Name (Test_Object)), Test_Kind => CONTAINER)); Action; -- Like Start_Test, only for Test_Suites and Test_Cases. Listeners.End_Test (Listener_Object, (Phase => TEST_END, Test_Name => To_Bounded_String (Get_Name (Test_Object)), Test_Kind => CONTAINER)); end Execute_Internal; procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Run_Impl is begin Run (T, Listener, Timeout); end Run_Impl; procedure Execute_Impl is new Execute_Internal (Action => Run_Impl); begin Execute_Impl (Test_Object => T, Listener_Object => Listener); end Execute; procedure Execute (T : in out Test'Class; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Run_Impl is begin Run (T => T, Test_Name => Test_Name, Listener => Listener, Timeout => Timeout); end Run_Impl; procedure Execute_Impl is new Execute_Internal (Action => Run_Impl); begin Execute_Impl (Test_Object => T, Listener_Object => Listener); end Execute; procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Object_Test_Routine_Access; Name : String) is Command : constant Test_Command := (Command_Kind => OBJECT, Name => To_Bounded_String (Source => Name, Drop => Ada.Strings.Right), Object_Routine => Routine); begin Test_Command_List.Append (T.Routines, Command); end Add_Test_Routine; procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Simple_Test_Routine_Access; Name : String) is Command : constant Test_Command := (Command_Kind => SIMPLE, Name => To_Bounded_String (Source => Name, Drop => Ada.Strings.Right), Simple_Routine => Routine); begin Test_Command_List.Append (T.Routines, Command); end Add_Test_Routine; -- The heart of the package. -- Run one test routine (well, Command at this point) and -- store the result to the Result object. procedure Run_Command (Command : Test_Command; Info : Listeners.Context; Timeout : Test_Duration; Listener : in out Listeners.Result_Listener'Class; T : in out Test_Case'Class) is use Ahven.Listeners; type Test_Status is (TEST_PASS, TEST_FAIL, TEST_ERROR, TEST_TIMEOUT, TEST_SKIP); protected type Test_Results is function Get_Status return Test_Status; procedure Set_Status (Value : Test_Status); function Get_Message return Bounded_String; procedure Set_Message (Value : Bounded_String); function Get_Long_Message return Bounded_String; procedure Set_Long_Message (Value : Bounded_String); private Status : Test_Status := Test_Error; Message : Bounded_String; Long_Message : Bounded_String; end Test_Results; protected body Test_Results is function Get_Status return Test_Status is begin return Status; end Get_Status; procedure Set_Status (Value : Test_Status) is begin Status := Value; end Set_Status; function Get_Message return Bounded_String is begin return Message; end Get_Message; procedure Set_Message (Value : Bounded_String) is begin Message := Value; end Set_Message; function Get_Long_Message return Bounded_String is begin return Long_Message; end Get_Long_Message; procedure Set_Long_Message (Value : Bounded_String) is begin Long_Message := Value; end Set_Long_Message; end Test_Results; Result : Test_Results; task type Command_Task is entry Start_Command; entry End_Command; end Command_Task; procedure Run_A_Command is begin begin Run (Command, T); Result.Set_Status (TEST_PASS); exception when E : Assertion_Error => Result.Set_Status (TEST_FAIL); Result.Set_Message (To_Bounded_String (Source => Ada.Exceptions.Exception_Message (E), Drop => Ada.Strings.Right)); when E : Test_Skipped_Error => Result.Set_Status (TEST_SKIP); Result.Set_Message (To_Bounded_String (Source => Ada.Exceptions.Exception_Message (E), Drop => Ada.Strings.Right)); when E : others => Result.Set_Status (TEST_ERROR); Result.Set_Message (To_Bounded_String (Source => Ada.Exceptions.Exception_Name (E), Drop => Ada.Strings.Right)); Result.Set_Long_Message (To_Bounded_String (Source => Ada.Exceptions.Exception_Message (E), Drop => Ada.Strings.Right)); end; end Run_A_Command; task body Command_Task is begin accept Start_Command; Run_A_Command; accept End_Command; end Command_Task; Status : Test_Status; begin if Timeout > 0.0 then declare Command_Runner : Command_Task; begin Command_Runner.Start_Command; select Command_Runner.End_Command; or delay Duration (Timeout); abort Command_Runner; Result.Set_Status (Test_Timeout); end select; end; else Run_A_Command; end if; Status := Result.Get_Status; case Status is when TEST_PASS => Listeners.Add_Pass (Listener, Info); when TEST_FAIL => Listeners.Add_Failure (Listener, (Phase => TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => Result.Get_Message, Long_Message => Null_Bounded_String)); when TEST_ERROR => Listeners.Add_Error (Listener, (Phase => Listeners.TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => Result.Get_Message, Long_Message => Result.Get_Long_Message)); when TEST_TIMEOUT => Listeners.Add_Error (Listener, (Phase => Listeners.TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => To_Bounded_String ("TIMEOUT"), Long_Message => Null_Bounded_String)); when TEST_SKIP => Listeners.Add_Skipped (Listener, (Phase => TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => Result.Get_Message, Long_Message => Null_Bounded_String)); end case; end Run_Command; function Get_Name (T : Test_Case) return String is begin return To_String (T.Name); end Get_Name; procedure Run_Internal (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Command : Test_Command; Test_Name : String; Routine_Name : String; Timeout : Test_Duration) is use Ahven.Listeners; begin Listeners.Start_Test (Listener, (Phase => Ahven.Listeners.TEST_BEGIN, Test_Name => To_Bounded_String (Test_Name), Test_Kind => ROUTINE)); Run_Command (Command => Command, Info => (Phase => Listeners.TEST_RUN, Test_Name => To_Bounded_String (Test_Name), Test_Kind => ROUTINE, Routine_Name => To_Bounded_String (Routine_Name), Message => Null_Bounded_String, Long_Message => Null_Bounded_String), Timeout => Timeout, Listener => Listener, T => T); Listeners.End_Test (Listener, (Phase => Ahven.Listeners.TEST_END, Test_Name => To_Bounded_String (Test_Name), Test_Kind => ROUTINE)); end Run_Internal; -- Run procedure for Test_Case. -- -- Loops over the test routine list and executes the routines. procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Exec (Cmd : in out Test_Command) is begin Run_Internal (T => T, Listener => Listener, Command => Cmd, Timeout => Timeout, Test_Name => Get_Name (T), Routine_Name => To_String (Cmd.Name)); end Exec; procedure Run_All is new Test_Command_List.For_Each (Action => Exec); begin Run_All (T.Routines); end Run; -- Purpose of the procedure is to run all -- test routines with name Test_Name. procedure Run (T : in out Test_Case; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Exec (Cmd : in out Test_Command) is begin if To_String (Cmd.Name) = Test_Name then Run_Internal (T => T, Listener => Listener, Command => Cmd, Timeout => Timeout, Test_Name => Get_Name (T), Routine_Name => To_String (Cmd.Name)); end if; end Exec; procedure Run_All is new Test_Command_List.For_Each (Action => Exec); begin Run_All (T.Routines); end Run; function Test_Count (T : Test_Case) return Test_Count_Type is begin return Test_Count_Type (Test_Command_List.Length (T.Routines)); end Test_Count; function Test_Count (T : Test_Case; Test_Name : String) return Test_Count_Type is use Test_Command_List; Counter : Test_Count_Type := 0; procedure Increase (Cmd : in out Test_Command) is begin if To_String (Cmd.Name) = Test_Name then Counter := Counter + 1; end if; end Increase; procedure Count_Commands is new Test_Command_List.For_Each (Action => Increase); begin Count_Commands (T.Routines); return Counter; end Test_Count; procedure Finalize (T : in out Test_Case) is begin Test_Command_List.Clear (T.Routines); end Finalize; procedure Set_Name (T : in out Test_Case; Name : String) is begin T.Name := To_Bounded_String (Source => Name, Drop => Ada.Strings.Right); end Set_Name; function Create_Suite (Suite_Name : String) return Test_Suite_Access is begin return new Test_Suite' (Ada.Finalization.Controlled with Suite_Name => To_Bounded_String (Source => Suite_Name, Drop => Ada.Strings.Right), Test_Cases => Test_List.Empty_List, Static_Test_Cases => Indefinite_Test_List.Empty_List); end Create_Suite; function Create_Suite (Suite_Name : String) return Test_Suite is begin return (Ada.Finalization.Controlled with Suite_Name => To_Bounded_String (Source => Suite_Name, Drop => Ada.Strings.Right), Test_Cases => Test_List.Empty_List, Static_Test_Cases => Indefinite_Test_List.Empty_List); end Create_Suite; procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access) is begin Test_List.Append (Suite.Test_Cases, (Ptr => T)); end Add_Test; procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access) is begin Add_Test (Suite, Test_Class_Access (T)); end Add_Test; procedure Add_Static_Test (Suite : in out Test_Suite; T : Test'Class) is begin Indefinite_Test_List.Append (Suite.Static_Test_Cases, T); end Add_Static_Test; function Get_Name (T : Test_Suite) return String is begin return To_String (T.Suite_Name); end Get_Name; procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is -- Some nested procedure exercises here. -- -- Execute_Cases is for normal test list -- and Execute_Static_Cases is for indefinite test list. -- -- Normal test list does not have For_Each procedure, -- so we need to loop manually. -- A helper procedure which runs Execute for the given test. procedure Execute_Test (Current : in out Test'Class) is begin Execute (Current, Listener, Timeout); end Execute_Test; procedure Execute_Test_Ptr (Current : in out Test_Class_Wrapper) is begin Execute (Current.Ptr.all, Listener, Timeout); end Execute_Test_Ptr; procedure Execute_Static_Cases is new Indefinite_Test_List.For_Each (Action => Execute_Test); procedure Execute_Cases is new Test_List.For_Each (Action => Execute_Test_Ptr); begin Execute_Cases (T.Test_Cases); Execute_Static_Cases (T.Static_Test_Cases); end Run; procedure Run (T : in out Test_Suite; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Execute_Test (Current : in out Test'Class) is begin if Get_Name (Current) = Test_Name then Execute (T => Current, Listener => Listener, Timeout => Timeout); else Execute (T => Current, Test_Name => Test_Name, Listener => Listener, Timeout => Timeout); end if; end Execute_Test; procedure Execute_Test_Ptr (Current : in out Test_Class_Wrapper) is begin Execute_Test (Current.Ptr.all); end Execute_Test_Ptr; procedure Execute_Cases is new Test_List.For_Each (Action => Execute_Test_Ptr); procedure Execute_Static_Cases is new Indefinite_Test_List.For_Each (Action => Execute_Test); begin if Test_Name = To_String (T.Suite_Name) then Run (T, Listener, Timeout); else Execute_Cases (T.Test_Cases); Execute_Static_Cases (T.Static_Test_Cases); end if; end Run; function Test_Count (T : Test_Suite) return Test_Count_Type is Counter : Test_Count_Type := 0; procedure Inc_Counter (Test_Obj : in out Test'Class) is begin Counter := Counter + Test_Count (Test_Obj); end Inc_Counter; procedure Inc_Counter_Ptr (Wrapper : in out Test_Class_Wrapper) is begin Inc_Counter (Wrapper.Ptr.all); end Inc_Counter_Ptr; begin declare use Test_List; procedure Count_All is new For_Each (Action => Inc_Counter_Ptr); begin Count_All (T.Test_Cases); end; declare use Indefinite_Test_List; procedure Count_All is new For_Each (Action => Inc_Counter); begin Count_All (T.Static_Test_Cases); end; return Counter; end Test_Count; function Test_Count (T : Test_Suite; Test_Name : String) return Test_Count_Type is Counter : Test_Count_Type := 0; procedure Handle_Test (Test_Object : in out Test'Class) is begin if Get_Name (Test_Object) = Test_Name then Counter := Counter + Test_Count (Test_Object); else Counter := Counter + Test_Count (Test_Object, Test_Name); end if; end Handle_Test; procedure Handle_Test_Ptr (Obj : in out Test_Class_Wrapper) is begin Handle_Test (Obj.Ptr.all); end Handle_Test_Ptr; procedure Count_Static is new Indefinite_Test_List.For_Each (Action => Handle_Test); procedure Count_Tests is new Test_List.For_Each (Action => Handle_Test_Ptr); begin if Test_Name = To_String (T.Suite_Name) then return Test_Count (T); end if; Count_Tests (T.Test_Cases); Count_Static (T.Static_Test_Cases); return Counter; end Test_Count; procedure Adjust (T : in out Test_Suite) is use Test_List; New_List : List := Empty_List; procedure Create_Copy (Item : in out Test_Class_Wrapper) is begin Append (New_List, (Ptr => new Test'Class'(Item.Ptr.all))); end Create_Copy; procedure Copy_All is new For_Each (Action => Create_Copy); begin Copy_All (T.Test_Cases); T.Test_Cases := New_List; end Adjust; procedure Finalize (T : in out Test_Suite) is use Test_List; procedure Free_Item (Item : in out Test_Class_Wrapper) is begin Free_Test (Item.Ptr); end Free_Item; procedure Free_All is new For_Each (Action => Free_Item); begin Free_All (T.Test_Cases); Clear (T.Test_Cases); end Finalize; procedure Release_Suite (T : Test_Suite_Access) is procedure Free is new Ada.Unchecked_Deallocation (Object => Test_Suite, Name => Test_Suite_Access); Ptr : Test_Suite_Access := T; begin Free (Ptr); end Release_Suite; procedure Run (Command : Test_Command; T : in out Test_Case'Class) is begin case Command.Command_Kind is when SIMPLE => Command.Simple_Routine.all; when OBJECT => Set_Up (T); Command.Object_Routine.all (T); Tear_Down (T); end case; end Run; package body Indefinite_Test_List is procedure Remove (Ptr : Node_Access) is procedure Free is new Ada.Unchecked_Deallocation (Object => Node, Name => Node_Access); My_Ptr : Node_Access := Ptr; begin Ptr.Next := null; Free_Test (My_Ptr.Data); My_Ptr.Data := null; Free (My_Ptr); end Remove; procedure Append (Target : in out List; Node_Data : Test'Class) is New_Node : Node_Access := null; begin New_Node := new Node'(Data => new Test'Class'(Node_Data), Next => null); if Target.Last = null then Target.Last := New_Node; Target.First := New_Node; else Target.Last.Next := New_Node; Target.Last := New_Node; end if; end Append; procedure Clear (Target : in out List) is Current_Node : Node_Access := Target.First; Next_Node : Node_Access := null; begin while Current_Node /= null loop Next_Node := Current_Node.Next; Remove (Current_Node); Current_Node := Next_Node; end loop; Target.First := null; Target.Last := null; end Clear; procedure For_Each (Target : List) is Current_Node : Node_Access := Target.First; begin while Current_Node /= null loop Action (Current_Node.Data.all); Current_Node := Current_Node.Next; end loop; end For_Each; procedure Initialize (Target : in out List) is begin Target.Last := null; Target.First := null; end Initialize; procedure Finalize (Target : in out List) is begin Clear (Target); end Finalize; procedure Adjust (Target : in out List) is Target_Last : Node_Access := null; Target_First : Node_Access := null; Current : Node_Access := Target.First; New_Node : Node_Access; begin while Current /= null loop New_Node := new Node'(Data => new Test'Class'(Current.Data.all), Next => null); if Target_Last = null then Target_First := New_Node; else Target_Last.Next := New_Node; end if; Target_Last := New_Node; Current := Current.Next; end loop; Target.First := Target_First; Target.Last := Target_Last; end Adjust; end Indefinite_Test_List; end Ahven.Framework; ahven-2.1/src/ahven-parameters.adb0000664000076400007640000001430011637173541017436 0ustar tkoskinetkoskine-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Command_Line; with Ada.Text_IO; use Ada.Command_Line; use Ada.Text_IO; package body Ahven.Parameters is -- Possible options: -- -c : capture output -- -d : result directory -- -q : quiet mode -- -t : timeout -- -v : verbose mode (default) -- -x : XML output -- procedure Parse_Options (Info : in out Parameter_Info; Mode : Parameter_Mode; Option : String; Dir_Next : out Boolean; Timeout_Next : out Boolean) is procedure Check_Invalid (C : Character) is begin case Mode is when NORMAL_PARAMETERS => if C = 'n' then raise Invalid_Parameter; end if; when TAP_PARAMETERS => if (C = 'd') or (C = 'x') then raise Invalid_Parameter; end if; end case; end Check_Invalid; begin Dir_Next := False; Timeout_Next := False; for A in Option'Range loop Check_Invalid (Option (A)); case Option (A) is when 'c' => Info.Capture_Output := True; when 'd' => Dir_Next := True; when 't' => Timeout_Next := True; when 'v' => Info.Verbose_Output := True; when 'q' => Info.Verbose_Output := False; when 'x' => Info.Xml_Output := True; when others => raise Invalid_Parameter; end case; end loop; end Parse_Options; -- Recognize command line parameters. -- Option "--" can be used to separate options and test names. -- procedure Parse_Parameters (Mode : Parameter_Mode; Info : out Parameter_Info) is procedure Handle_Parameter (P : in out Parameter_Info; Arg : String; Index : Positive); -- Parse one parameter and update P if necessary. Files_Only : Boolean := False; Dir_Next : Boolean := False; Timeout_Next : Boolean := False; procedure Handle_Parameter (P : in out Parameter_Info; Arg : String; Index : Positive) is begin if Dir_Next then P.Result_Dir := Index; Dir_Next := False; elsif Timeout_Next then P.Timeout := Framework.Test_Duration'Value (Arg); Timeout_Next := False; elsif Arg = "--" then Files_Only := True; elsif Arg'Size > 1 then if (not Files_Only) and (Arg (Arg'First) = '-') then Parse_Options (Info => P, Mode => Mode, Option => Arg (Arg'First + 1 .. Arg'Last), Dir_Next => Dir_Next, Timeout_Next => Timeout_Next); else P.Test_Name := Index; end if; end if; end Handle_Parameter; begin -- Default values Info := (Verbose_Output => True, Xml_Output => False, Capture_Output => False, Test_Name => 0, Result_Dir => 0, Timeout => 0.0); for A in Positive range 1 .. Argument_Count loop Handle_Parameter (Info, Argument (A), A); end loop; if Dir_Next then raise Invalid_Parameter; end if; end Parse_Parameters; procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS) is begin case Mode is when NORMAL_PARAMETERS => Put_Line ("Possible parameters: [-cqvx] [-d directory] [--] [testname]"); Put_Line (" -d : directory for test results"); Put_Line (" -x : output in XML format"); when TAP_PARAMETERS => Put_Line ("Possible parameters: [-cqv] [--] [testname]"); end case; Put_Line (" -c : capture and report test outputs"); Put_Line (" -q : quiet results"); Put_Line (" -t : test timeout, infinite default"); Put_Line (" -v : verbose results (default)"); Put_Line (" -- : end of parameters (optional)"); end Usage; function Capture (Info : Parameter_Info) return Boolean is begin return Info.Capture_Output; end Capture; function Verbose (Info : Parameter_Info) return Boolean is begin return Info.Verbose_Output; end Verbose; function XML_Results (Info : Parameter_Info) return Boolean is begin return Info.Xml_Output; end XML_Results; function Single_Test (Info : Parameter_Info) return Boolean is begin return (Info.Test_Name /= 0); end Single_Test; function Test_Name (Info : Parameter_Info) return String is begin if Info.Test_Name = 0 then return ""; else return Argument (Info.Test_Name); end if; end Test_Name; function Result_Dir (Info : Parameter_Info) return String is begin if Info.Result_Dir = 0 then return ""; else return Argument (Info.Result_Dir); end if; end Result_Dir; function Timeout (Info : Parameter_Info) return Framework.Test_Duration is begin return Info.Timeout; end Timeout; end Ahven.Parameters; ahven-2.1/src/ahven-tap_runner.ads0000664000076400007640000000404711637173541017500 0ustar tkoskinetkoskine-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Listeners; with Ahven.Temporary_Output; package Ahven.Tap_Runner is use Ahven.Listeners; procedure Run (Suite : in out Framework.Test'Class); -- Run the suite and print the results. private type Tap_Result_Type is (OK_RESULT, NOT_OK_RESULT); type Tap_Listener is new Ahven.Listeners.Result_Listener with record Result : Tap_Result_Type := NOT_OK_RESULT; Current_Test : Framework.Test_Count_Type := 0; Verbose : Boolean := True; Output_File : Temporary_Output.Temporary_File; Capture_Output : Boolean := False; end record; procedure Add_Pass (Listener : in out Tap_Listener; Info : Context); procedure Add_Failure (Listener : in out Tap_Listener; Info : Context); procedure Add_Error (Listener : in out Tap_Listener; Info : Context); procedure Add_Skipped (Listener : in out Tap_Listener; Info : Context); procedure Start_Test (Listener : in out Tap_Listener; Info : Context); procedure End_Test (Listener : in out Tap_Listener; Info : Context); end Ahven.Tap_Runner; ahven-2.1/src/ahven-temporary_output.adb0000664000076400007640000000442511637173541020744 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Fixed; package body Ahven.Temporary_Output is use Ahven.AStrings; use Ada.Strings.Fixed; Temp_Counter : Natural := 0; procedure Create_Temp (File : out Temporary_File) is Filename : constant String := "ahven_temp_" & Trim (Integer'Image (Temp_Counter), Ada.Strings.Both); begin if Temp_Counter < Natural'Last then Temp_Counter := Temp_Counter + 1; else raise Temporary_File_Error; end if; File.Name := To_Bounded_String (Filename); Ada.Text_IO.Create (File.Handle, Ada.Text_IO.Out_File, Filename); end Create_Temp; function Get_Name (File : Temporary_File) return String is begin return To_String (File.Name); end Get_Name; procedure Redirect_Output (To_File : in out Temporary_File) is begin Ada.Text_IO.Flush; Ada.Text_IO.Set_Output (To_File.Handle); end Redirect_Output; procedure Restore_Output is begin Ada.Text_IO.Flush; Ada.Text_IO.Set_Output (Ada.Text_IO.Standard_Output); end Restore_Output; procedure Remove_Temp (File : in out Temporary_File) is begin if not Ada.Text_IO.Is_Open (File.Handle) then Ada.Text_IO.Open (File.Handle, Ada.Text_IO.Out_File, To_String (File.Name)); end if; Ada.Text_IO.Delete (File.Handle); end Remove_Temp; procedure Close_Temp (File : in out Temporary_File) is begin Ada.Text_IO.Close (File.Handle); end Close_Temp; end Ahven.Temporary_Output; ahven-2.1/src/ahven-listeners.adb0000664000076400007640000000203611637173541017306 0ustar tkoskinetkoskine-- -- Copyright (c) 2011 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package body Ahven.Listeners is procedure Add_Skipped (Listener : in out Result_Listener; Info : Context) is begin Add_Failure (Result_Listener'Class (Listener), Info); end Add_Skipped; end Ahven.Listeners; ahven-2.1/src/ahven-tap_runner.adb0000664000076400007640000001616011637173541017456 0ustar tkoskinetkoskine-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; with Ada.Strings.Fixed; with Ada.Characters.Latin_1; with Ahven.Parameters; with Ahven.AStrings; package body Ahven.Tap_Runner is use Ada.Text_IO; use Ahven.Framework; use Ahven.AStrings; function Count_Image (Count : Test_Count_Type) return String is use Ada.Strings; begin return Fixed.Trim (Test_Count_Type'Image (Count), Both); end Count_Image; procedure Print_Data (Message : String; Prefix : String) is Start_Of_Line : Boolean := True; begin for I in Message'Range loop if Start_Of_Line then Put (Prefix); Start_Of_Line := False; end if; Put (Message (I)); if Message (I) = Ada.Characters.Latin_1.LF then New_Line; Start_Of_Line := True; end if; end loop; end Print_Data; procedure Run (Suite : in out Framework.Test'Class) is Listener : Tap_Listener; Params : Parameters.Parameter_Info; begin Parameters.Parse_Parameters (Parameters.TAP_PARAMETERS, Params); Listener.Verbose := Parameters.Verbose (Params); Listener.Capture_Output := Parameters.Capture (Params); if Parameters.Single_Test (Params) then Put_Line ("1.." & Count_Image (Test_Count (Suite, Parameters.Test_Name (Params)))); Framework.Execute (T => Suite, Test_Name => Parameters.Test_Name (Params), Listener => Listener, Timeout => Parameters.Timeout (Params)); else Put_Line ("1.." & Count_Image (Test_Count (Suite))); Framework.Execute (Suite, Listener, Parameters.Timeout (Params)); end if; exception when Parameters.Invalid_Parameter => Parameters.Usage (Parameters.TAP_PARAMETERS); end Run; procedure Print_Info (Info : Context) is begin if Length (Info.Message) > 0 then Print_Data (Message => To_String (Info.Message), Prefix => "# "); New_Line; end if; if Length (Info.Long_Message) > 0 then Print_Data (Message => To_String (Info.Long_Message), Prefix => "# "); New_Line; end if; end Print_Info; procedure Print_Log_File (Filename : String; Prefix : String) is Handle : File_Type; Char : Character := ' '; First : Boolean := True; Start_Of_Line : Boolean := True; begin Open (Handle, In_File, Filename); loop exit when End_Of_File (Handle); Get (Handle, Char); if First then Put_Line (Prefix & "===== Output ======="); First := False; end if; if Start_Of_Line then Put (Prefix); Start_Of_Line := False; end if; Put (Char); if End_Of_Line (Handle) then New_Line; Start_Of_Line := True; end if; end loop; Close (Handle); if not First then Put_Line (Prefix & "===================="); end if; exception when Name_Error => -- Missing output file is ok. Put_Line (Prefix & "no output"); end Print_Log_File; procedure Add_Pass (Listener : in out Tap_Listener; Info : Context) is use Ada.Strings; use Ada.Strings.Fixed; begin if Listener.Capture_Output then Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); end if; Put ("ok "); Put (Count_Image (Listener.Current_Test) & " "); Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name)); New_Line; end Add_Pass; procedure Report_Not_Ok (Listener : in out Tap_Listener; Info : Context; Severity : String) is use Ada.Strings; use Ada.Strings.Fixed; begin if Listener.Capture_Output then Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); end if; Put ("not ok "); Put (Count_Image (Listener.Current_Test) & " "); Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name)); New_Line; if Listener.Verbose then Print_Info (Info); if Listener.Capture_Output then Print_Log_File (Filename => Temporary_Output.Get_Name (Listener.Output_File), Prefix => "# "); end if; end if; end Report_Not_Ok; procedure Add_Failure (Listener : in out Tap_Listener; Info : Context) is begin Report_Not_Ok (Listener, Info, "fail"); end Add_Failure; procedure Add_Error (Listener : in out Tap_Listener; Info : Context) is begin Report_Not_Ok (Listener, Info, "error"); end Add_Error; procedure Add_Skipped (Listener : in out Tap_Listener; Info : Context) is use Ada.Strings; use Ada.Strings.Fixed; begin if Listener.Capture_Output then Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); end if; Put ("ok "); Put (Count_Image (Listener.Current_Test) & " "); Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name)); Put (" # SKIP " & To_String (Info.Message)); New_Line; end Add_Skipped; procedure Start_Test (Listener : in out Tap_Listener; Info : Context) is begin if Info.Test_Kind = ROUTINE then Listener.Current_Test := Listener.Current_Test + 1; if Listener.Capture_Output then Temporary_Output.Create_Temp (Listener.Output_File); Temporary_Output.Redirect_Output (Listener.Output_File); end if; end if; end Start_Test; procedure End_Test (Listener : in out Tap_Listener; Info : Context) is Handle : Ada.Text_IO.File_Type; begin if Listener.Capture_Output then Ada.Text_IO.Open (Handle, Ada.Text_IO.Out_File, Temporary_Output.Get_Name (Listener.Output_File)); Ada.Text_IO.Delete (Handle); end if; exception when Name_Error => -- Missing file is safe to ignore, we are going to delete it anyway null; end End_Test; end Ahven.Tap_Runner; ahven-2.1/src/ahven-temporary_output.ads0000664000076400007640000000352711637173541020767 0ustar tkoskinetkoskine-- -- Copyright (c) 2007, 2008, 2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.AStrings; with Ada.Text_IO; package Ahven.Temporary_Output is Temporary_File_Error : exception; type Temporary_File is limited private; procedure Create_Temp (File : out Temporary_File); -- Create a new temporary file. Exception Temporary_File_Error -- is raised if the procedure cannot create a new temp file. function Get_Name (File : Temporary_File) return String; -- Return the name of the file. procedure Redirect_Output (To_File : in out Temporary_File); -- Redirect the standard output to the file. -- To_File must be opened using Create_Temp. procedure Restore_Output; -- Restore the standard output to its default settings. procedure Remove_Temp (File : in out Temporary_File); -- Remove the temporary file. File can be either open or closed. procedure Close_Temp (File : in out Temporary_File); -- Close the temporary file. private type Temporary_File is limited record Name : AStrings.Bounded_String; Handle : Ada.Text_IO.File_Type; end record; end Ahven.Temporary_Output; ahven-2.1/src/ahven-slist.ads0000664000076400007640000000601711637173541016460 0ustar tkoskinetkoskine-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Finalization; generic type Element_Type is private; package Ahven.SList is type List is new Ada.Finalization.Controlled with private; type Cursor is private; subtype Count_Type is Natural; Invalid_Cursor : exception; List_Full : exception; -- Thrown when the size of the list exceeds Count_Type'Last. Empty_List : constant List; procedure Append (Target : in out List; Node_Data : Element_Type); -- Append an element at the end of the list. -- -- Raises List_Full if the list has already Count_Type'Last items. procedure Clear (Target : in out List); -- Remove all elements from the list. function First (Target : List) return Cursor; -- Return a cursor to the first element of the list. function Next (Position : Cursor) return Cursor; -- Move the cursor to point to the next element on the list. function Data (Position : Cursor) return Element_Type; -- Return element pointed by the cursor. function Is_Valid (Position : Cursor) return Boolean; -- Tell the validity of the cursor. The cursor -- will become invalid when you iterate it over -- the last item. function Length (Target : List) return Count_Type; -- Return the length of the list. generic with procedure Action (T : in out Element_Type) is <>; procedure For_Each (Target : List); -- A generic procedure for walk through every item -- in the list and call Action procedure for them. private type Node; type Node_Access is access Node; type Cursor is new Node_Access; procedure Remove (Ptr : Node_Access); -- A procedure to release memory pointed by Ptr. type Node is record Next : Node_Access := null; Data : Element_Type; end record; type List is new Ada.Finalization.Controlled with record First : Node_Access := null; Last : Node_Access := null; Size : Count_Type := 0; end record; procedure Initialize (Target : in out List); procedure Finalize (Target : in out List); procedure Adjust (Target : in out List); Empty_List : constant List := (Ada.Finalization.Controlled with First => null, Last => null, Size => 0); end Ahven.SList; ahven-2.1/contrib/0000775000076400007640000000000011637173541014377 5ustar tkoskinetkoskineahven-2.1/contrib/gnat315p/0000775000076400007640000000000011637173541015741 5ustar tkoskinetkoskineahven-2.1/contrib/gnat315p/ahven_tests.gpr0000664000076400007640000000320511637173541020776 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- project Ahven_Tests is type OS_Type is ("unix", "windows"); OS : OS_Type := external ("OS", "windows"); for Languages use ("Ada"); for Object_Dir use "./test_objects"; for Exec_Dir use "./"; for Main use ("tester.adb"); case OS is when "unix" => for Source_Dirs use ("test", "src", "src/unix"); when "windows" => for Source_Dirs use ("test", "src", "src/windows"); end case; package Builder is for Default_Switches ("Ada") use ("-g", "-gnatQ", "-gnatwa", "-gnatwF"); end Builder; package Linker is for Default_Switches ("Ada") use ("-g"); end Linker; package Compiler is for Default_Switches ("Ada") use ("-gnatf", "-g"); end Compiler; package Binder is for Default_Switches ("Ada") use ("-E", "-static"); end Binder; end Ahven_Tests; ahven-2.1/contrib/gnat315p/ahven_lib.gpr0000664000076400007640000000317511637173541020410 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- project Ahven_Lib is type OS_Type is ("unix", "windows"); OS : OS_Type := external ("OS", "windows"); Version := "13"; for Languages use ("Ada"); for Object_Dir use "objects"; for Library_Name use "ahven"; for Library_Dir use "lib"; for Library_Kind use "dynamic"; case OS is when "unix" => for Library_Version use "libahven.so." & Version & ".0"; for Source_Dirs use ("src", "src/unix"); when "windows" => for Source_Dirs use ("src", "src/windows"); end case; package Builder is for Default_Switches ("Ada") use ("-g","-gnatf", "-gnatVa", "-gnato", "-gnatwe", "-gnatwa", "-gnatwF); end Builder; end Ahven_Lib; ahven-2.1/contrib/docbook-testreport/0000775000076400007640000000000011637173541020230 5ustar tkoskinetkoskineahven-2.1/contrib/docbook-testreport/Makefile0000664000076400007640000000670311637173541021676 0ustar tkoskinetkoskine# # Copyright (c) 2009 Reto Buerki # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # # project settings PROJECT := example-project EMAIL := developer@example.net FORMATS := html txt pdf TARGETS := $(foreach fmt,$(FORMATS),$(PROJECT).$(fmt)) SRCDIR := ../../results DOCDIR := docs XSLDIR := xsl SRCINDEX := $(SRCDIR)/index.xml RESULTFILE := result.xml HEADERFILE := result-header.xml OVERFILE := overview.xml ENTITYFILE := data.ent SOURCES := $(wildcard $(SRCDIR)/*.xml) \ $(ENTITYFILE) \ $(RESULTFILE) \ $(HEADERFILE) \ $(OVERFILE) TRANSXSL := $(XSLDIR)/transform.xsl OVERXSL := $(XSLDIR)/overview.xsl HTMLXSL := $(XSLDIR)/html.xsl TXTXSL := $(XSLDIR)/txt.xsl EXT := docbook # testresult input produced by ahven xml runner TESTS := `cd $(SRCDIR); ls TEST-*.xml` # testenv info TIME := $(shell date) OS := $(shell uname) HOSTNAME := $(shell hostname) KERNEL_NAME := $(shell uname -s) KERNEL_REL := $(shell uname -r) KERNEL_VER := $(shell uname -v) DBLATEX := dblatex --style=db2latex XP := xsltproc --nonet --novalid --xinclude all: $(TARGETS) $(PROJECT).html: $(SOURCES) @echo -n "Generating $@ ... " @$(XP) $(HTMLXSL) index.xml > $@ @echo "DONE" $(PROJECT).txt: $(SOURCES) @echo -n "Generating $@ ... " @$(XP) $(TXTXSL) index.xml | w3m -cols 65 -dump -T text/html > $@ @echo "DONE" $(PROJECT).pdf: $(SOURCES) @echo "Generating $@ ... " @$(DBLATEX) index.xml -o $@ @echo "DONE" $(OVERFILE): $(SRCINDEX) @$(XP) $(OVERXSL) $(SRCINDEX) > $@ $(SRCINDEX): @echo " $@ @for SOURCE in $(TESTS); do \ echo "" >> $@; \ done @echo "]> " >> $@ @for SOURCE in $(TESTS); do \ echo "&$$SOURCE;" >> $@; \ done @echo "" >> $@ $(RESULTFILE): to-docbook @cp $(HEADERFILE) $(RESULTFILE) @for DOC in `ls $(DOCDIR)/TEST-*.$(EXT)`; do \ echo "" \ >> $(RESULTFILE); \ done @echo "" >> $(RESULTFILE) to-docbook: @mkdir -p $(DOCDIR) @for SOURCE in $(TESTS); do \ $(XP) $(TRANSXSL) $(SRCDIR)/$$SOURCE > $(DOCDIR)/$$SOURCE.$(EXT); \ done $(ENTITYFILE): @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ clean: @rm -f $(PROJECT).* @rm -f $(RESULTFILE) @rm -f $(OVERFILE) @rm -f $(ENTITYFILE) @rm -rf $(DOCDIR) @rm -rf $(SRCINDEX) .PHONY: all $(PROJECT).html clean $(ENTITYFILE) $(SRCINDEX) ahven-2.1/contrib/docbook-testreport/xsl/0000775000076400007640000000000011637173541021036 5ustar tkoskinetkoskineahven-2.1/contrib/docbook-testreport/xsl/transform.xsl0000664000076400007640000000362111637173541023603 0ustar tkoskinetkoskine <xsl:value-of select="@name"/> <xsl:value-of select="@name"/> summary Errors Failures Tests Time
<xsl:value-of select="@name"/> Execution Time Test Status PASSED Output FAILURE ()
ahven-2.1/contrib/docbook-testreport/xsl/txt.xsl0000664000076400007640000000065611637173541022414 0ustar tkoskinetkoskine 1 1 book toc,title,figure,example,equation ahven-2.1/contrib/docbook-testreport/xsl/html.xsl0000664000076400007640000000064411637173541022536 0ustar tkoskinetkoskine 1 1 book toc,title,figure,example ahven-2.1/contrib/docbook-testreport/xsl/overview.xsl0000664000076400007640000000163511637173541023441 0ustar tkoskinetkoskine Overview Total defined testsuites Total testcases executed Total failed testcases ahven-2.1/contrib/docbook-testreport/index.xml0000664000076400007640000000320211637173541022056 0ustar tkoskinetkoskine %envdata; ]> &project; Testresults &project; development team &email; &time; This document is an auto-generated testreport for the &project; project. The unit tests have been run on the testhost described in . shows overall statistics of this testrun, detailed results for each executed test can be found in . Environment The unit tests have been executed in the following environment: Date and Time&time; Hostname&hostname; Operating System&os; Kernel &kernel_name; &kernel_release; (&kernel_version;) ahven-2.1/contrib/docbook-testreport/result-header.xml0000664000076400007640000000031611637173541023516 0ustar tkoskinetkoskine Results ahven-2.1/contrib/fedora/0000775000076400007640000000000011637173541015637 5ustar tkoskinetkoskineahven-2.1/contrib/fedora/ahven.spec0000664000076400007640000000212411637173541017613 0ustar tkoskinetkoskineName: ahven Version: 1.8 Release: 1%{?dist} Summary: Unit Test Framework for Ada 95 Programming Language Group: Development/Libraries License: ISC URL: http://ahven.stronglytyped.org/ Source0: http://downloads.sourceforge.net/%{name}/%{name}-%{version}.tar.gz Patch0: ahven-1.8-libdir.patch BuildRoot: %(mktemp -ud %{_tmppath}/%{name}-%{version}-%{release}-XXXXXX) BuildRequires: gcc-gnat BuildRequires: libgnat %description Ahven is a unit testing framework for Ada 95. # Ahven has only static libahven.a library, # no need for debug packages. %global debug_package %{nil} %prep %setup -q %patch0 -p1 %build make %{?_smp_mflags} %install rm -rf $RPM_BUILD_ROOT sed -e "s-../../lib/ahven-%{_libdir}/ahven-" -i gnat/ahven.gpr make install PREFIX=$RPM_BUILD_ROOT/usr LIBDIR=$RPM_BUILD_ROOT%{_libdir} %clean rm -rf $RPM_BUILD_ROOT %files %defattr(-,root,root,-) %{_includedir}/ahven %{_libdir}/ahven %{_prefix}/lib/gnat %changelog * Thu Jul 22 2010 Tero Koskinen - 1.8-1 - Updated to 1.8. * Fri Feb 19 2010 Tero Koskinen - 1.7-1 - Initial version. ahven-2.1/contrib/fedora/ahven-1.8-libdir.patch0000664000076400007640000000154111637173541021531 0ustar tkoskinetkoskinediff -r e0a1f2e18944 Makefile --- a/Makefile Tue Jun 01 20:49:59 2010 +0300 +++ b/Makefile Thu Jul 22 10:09:19 2010 +0300 @@ -17,6 +17,7 @@ PREFIX?=$(HOME)/libraries/ahven INSTALL=install OS_VERSION?=unix +LIBDIR?=$(PREFIX)/lib SOURCES=src/ahven-framework.adb src/ahven-framework.ads \ src/ahven-listeners-basic.adb src/ahven-listeners-basic.ads \ @@ -89,11 +90,11 @@ install_lib: mkdir -p $(PREFIX)/include/ahven - mkdir -p $(PREFIX)/lib/ahven + mkdir -p $(LIBDIR)/ahven mkdir -p $(PREFIX)/lib/gnat $(INSTALL) -m 644 $(SOURCES) $(PREFIX)/include/ahven - $(INSTALL) -m 444 $(ALI_FILES) $(PREFIX)/lib/ahven - $(INSTALL) -m 644 lib/$(STATIC_LIBRARY) $(PREFIX)/lib/ahven + $(INSTALL) -m 444 $(ALI_FILES) $(LIBDIR)/ahven + $(INSTALL) -m 644 lib/$(STATIC_LIBRARY) $(LIBDIR)/ahven $(INSTALL) -m 644 $(GPR_FILE) $(PREFIX)/lib/gnat check: build_tests ahven-2.1/contrib/tap/0000775000076400007640000000000011637173541015163 5ustar tkoskinetkoskineahven-2.1/contrib/tap/tester.pl0000664000076400007640000000063211637173541017027 0ustar tkoskinetkoskine#!/usr/bin/perl use TAP::Parser; use TAP::Parser::Aggregator; my $parser = TAP::Parser->new( { exec => [ './tap_tester' ] } ); $parser->run; # while ( my $result = $parser->next ) { # print $result->as_string . "\n"; # } my $aggregate = TAP::Parser::Aggregator->new; $aggregate->add( 'testcases', $parser ); printf "\tPassed: %s\n\tFailed: %s\n", scalar $aggregate->passed, scalar $aggregate->failed; ahven-2.1/contrib/cruisecontrol/0000775000076400007640000000000011637173541017272 5ustar tkoskinetkoskineahven-2.1/contrib/cruisecontrol/run.sh0000664000076400007640000000012111637173541020424 0ustar tkoskinetkoskine#!/bin/sh /bin/sh /opt/java/utils/cruisecontrol-2.7.1/main/bin/cruisecontrol.sh ahven-2.1/contrib/cruisecontrol/config.xml0000664000076400007640000000145711637173541021270 0ustar tkoskinetkoskine ahven-2.1/contrib/cruisecontrol/README0000664000076400007640000000103611637173541020152 0ustar tkoskinetkoskine Cruisecontrol settings for Ahven ================================ One can create continuous integration system for Ahven or projects using Ahven by setting up Cruisecontrol. Files in this directory provide example configuration. Ideally, they should work out of the box for Ahven source code. Files ===== init.sh - Initialisation script, run it once run.sh - Actual script to run Cruisecontrol config.xml - Configuration for Cruisecontrol build-ahven_trunk.xml - Build script for Ant to build Ahven ahven-2.1/contrib/cruisecontrol/init.sh0000664000076400007640000000014511637173541020571 0ustar tkoskinetkoskine#!/bin/sh mkdir checkout cd checkout && svn checkout http://svn.gna.org/svn/ahven/trunk ahven_trunk ahven-2.1/contrib/cruisecontrol/build-ahven_trunk.xml0000664000076400007640000000120711637173541023435 0ustar tkoskinetkoskine Ahven ahven-2.1/ROADMAP0000664000076400007640000000126211637173541013746 0ustar tkoskinetkoskineAhven - Roadmap ================ Release schedule and versioning ------------------------------- Ahven will use simple a.b version numbers. After "1.9" comes "2.0". I plan to release a new version two or three times a year. API stability ------------- I do not guarantee API stability but I will try to keep specification of packages Ahven and Ahven.Framework unchanged. But for example, function Ahven.Framework.Name changed to Ahven.Framework.Get_Name in Ahven 1.1. Other packages will most likely see changes. Long-term todo-list ------------------- * Graphical (GTK+/CLAW) UI for the test result reporter * Improve documentation * Replace adhoc XML writer with "a proper solution" ahven-2.1/tools/0000775000076400007640000000000011637173541014077 5ustar tkoskinetkoskineahven-2.1/tools/test_release.sh0000664000076400007640000000162011637173541017111 0ustar tkoskinetkoskine#!/bin/sh fail() { echo $* exit 1 } if [ x"$1" = x"" ]; then echo "usage: test_release.sh " exit 1 fi VERSION=$1 TEMPDIR=`mktemp -d` INSTALL_DIR=`mktemp -d` cd $TEMPDIR || fail "cd to temp failed" tar zxvf /tmp/ahven-$VERSION.tar.gz || fail "tar failed" cd ahven-$VERSION || fail "cd to ahven-$VERSION failed" make || fail "make failed" make check || fail "make check failed" make check_xml || fail "make check_xml failed" make check_tap || fail "make check_tap failed" make docs || fail "make docs failed" make control || fail "make control failed" make PREFIX=$INSTALL_DIR install || fail "make install failed" cd examples || fail "cd examples failed" export ADA_PROJECT_PATH=$INSTALL_DIR/lib/gnat gnatmake -Pexamples || fail "gnatmake -Pexamples failed" echo "EVERYTHING OK" echo echo "Please remove directories $TEMPDIR and $INSTALL_DIR" echo " rm -rf $TEMPDIR $INSTALL_DIR" echo ahven-2.1/tools/make_release.sh0000664000076400007640000000333311637173541017052 0ustar tkoskinetkoskine#!/bin/sh # # Copyright (c) 2007 Tero Koskinen # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # # # ./make_release # # For example # ./make_release 1.0 # HGROOT=https://bitbucket.org/tkoskine/ahven failure() { echo "$1" exit 1 } if [ x"$1" = x"" ]; then echo "usage: make_release " exit 1 fi VERSION=$1 cd /tmp || failure "cd /tmp failed" hg clone $HGROOT ahven-$VERSION || failure "checkout failed" cd ahven-$VERSION && rm -rf .hg .hgignore .hgtags && cd .. || failure "rm failed" cd ahven-$VERSION && cd doc/manual/en && make html && cd /tmp || failure "docs failed" tar zcf ahven-$VERSION.tar.gz ahven-$VERSION || failure "tar zcf failed" zip -r ahven-$VERSION.zip ahven-$VERSION || failure "zip -r failed" echo "Release tarball ready at /tmp/ahven-$VERSION.tar.gz" echo "Release zip ready at /tmp/ahven-$VERSION.zip" echo "Please remove /tmp/ahven-$VERSION directory." echo echo "Sign the tarball and the zip with commands" echo "gpg --detach /tmp/ahven-$VERSION.tar.gz" echo "gpg --detach /tmp/ahven-$VERSION.zip" ahven-2.1/adabrowse.conf0000664000076400007640000000004211637173541015551 0ustar tkoskinetkoskineDescription.Subprogram = After(1) ahven-2.1/janusada/0000775000076400007640000000000011637173541014525 5ustar tkoskinetkoskineahven-2.1/janusada/prepare.bat0000664000076400007640000000132011637173541016647 0ustar tkoskinetkoskinecd src set januspath=C:\jnt312a\rts\console del /q ..\lib_obj\*.* del /q ..\com_obj\*.* mkdir ..\lib_obj mkdir ..\com_obj copy /y ..\janusada\libmain.adb ..\src copy /y ..\janusada\compat.adb ..\src\windows cd windows jmanager Add_Project (..\..\com_obj\,AhvenCompat) jmanager Add_Link (..\..\com_obj\,AhvenCompat,%januspath%, JNT_RTS_CONSOLE) cd .. jmanager Add_Project (..\lib_obj\,AhvenLib) jmanager Add_Link (..\lib_obj\,AhvenLib,%januspath%, JNT_RTS_CONSOLE) jmanager Add_Link (..\lib_obj\,AhvenLib,..\com_obj\, AhvenCompat) cd ..\test del /q ..\test_obj\*.* mkdir ..\test_obj jmanager Add_Project (..\test_obj\,AhvenTst) jmanager Add_Link (..\test_obj\,AhvenTst,..\lib_obj, AhvenLib) cd .. ahven-2.1/janusada/compat.adb0000664000076400007640000000010711637173541016456 0ustar tkoskinetkoskinewith Ahven_Compat; procedure Compat is begin null; end Compat;ahven-2.1/janusada/update.bat0000664000076400007640000000055111637173541016500 0ustar tkoskinetkoskinecd src cd windows corder compat /pAhvenCompat/l'ads'/n'adb'/t/w/k255/js'jbind'/jb'/t/l/YLLIBCMT'/b'ctst.bat'/r..\..\com_obj cd .. corder libmain /pAhvenLib/l'ads'/n'adb'/t/w/k255/js'jbind'/jb'/t/l/YLLIBCMT'/b'ctst.bat'/r..\lib_obj cd ..\test corder tap_tester /pAhvenTst/l'ads'/n'adb'/js'jbind'/jb'/t/l/YLLIBCMT'/t/w/k255/b'ctst.bat'/r..\test_obj cd .. ahven-2.1/janusada/build.bat0000664000076400007640000000012711637173541016314 0ustar tkoskinetkoskinecall janusada\update.bat if ErrorLevel 2 goto abort call janusada\compile.bat :abortahven-2.1/janusada/compile.bat0000664000076400007640000000032411637173541016644 0ustar tkoskinetkoskinecd src\windows call ctst.bat if ErrorLevel 2 goto Abort cd .. call ctst.bat if ErrorLevel 2 goto Abort cd ..\test call ctst.bat if ErrorLevel 2 goto Abort cd ..\test_obj call lkc tap_test cd .. :abortahven-2.1/janusada/libmain.adb0000664000076400007640000000207411637173541016613 0ustar tkoskinetkoskine-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Ahven.Framework; with Ahven.Results; with Ahven.Text_Runner; with Ahven.Listeners; with Ahven.Listeners.Basic; with Ahven.XML_Runner; with Ahven.Runner; with Ahven.Parameters; with Ahven.SList; with Ahven.Tap_Runner; procedure LibMain is begin null; end LibMain; ahven-2.1/examples/0000775000076400007640000000000011637173541014555 5ustar tkoskinetkoskineahven-2.1/examples/examples.gpr0000664000076400007640000000036311637173541017107 0ustar tkoskinetkoskine-- Note: -- Install Ahven first before compiling it with this project file. -- with "ahven"; project Examples is for Languages use ("Ada"); for Source_Dirs use ("."); for Object_Dir use "."; for Main use ("runner.adb"); end Examples; ahven-2.1/examples/simple_tests.ads0000664000076400007640000000240211637173541017757 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Unbounded; with Ahven.Framework; use Ada.Strings.Unbounded; package Simple_Tests is type Test is new Ahven.Framework.Test_Case with record Value : Integer := -1; end record; procedure Initialize (T : in out Test); procedure Set_Up (T : in out Test); procedure Tear_Down (T : in out Test); procedure Test_Assertion; procedure Test_Error; procedure Test_With_Object (T : in out Ahven.Framework.Test_Case'Class); end Simple_Tests; ahven-2.1/examples/runner.adb0000664000076400007640000000204411637173541016536 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Text_Runner; with Ahven.Framework; with Simple_Tests; procedure Runner is S : Ahven.Framework.Test_Suite := Ahven.Framework.Create_Suite ("All"); begin Ahven.Framework.Add_Test (S, new Simple_Tests.Test); Ahven.Text_Runner.Run (S); end Runner; ahven-2.1/examples/simple_tests.adb0000664000076400007640000000407111637173541017742 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; use Ada.Text_IO; package body Simple_Tests is type Test_Access is access all Test; procedure Initialize (T : in out Test) is begin Set_Name (T, "Simple Tests"); Ahven.Framework.Add_Test_Routine (T, Test_Assertion'Access, "Test Assertion"); Ahven.Framework.Add_Test_Routine (T, Test_With_Object'Access, "Test With Object"); Ahven.Framework.Add_Test_Routine (T, Test_Error'Access, "Test Error (exception)"); end Initialize; procedure Set_Up (T : in out Test) is begin Put_Line ("Simple_Tests.Set_Up"); T.Value := 1; end Set_Up; procedure Tear_Down (T : in out Test) is begin Put_Line ("Simple_Tests.Tear_Down"); T.Value := -1; end Tear_Down; procedure Test_Assertion is begin Put_Line ("Test_Assertion"); Ahven.Assert (False, "assert(false)"); end Test_Assertion; procedure Test_Error is begin raise Constraint_Error; end Test_Error; procedure Hello (T : Test) is begin Ahven.Assert (T.Value = 1, "T.Value = 1"); end Hello; procedure Test_With_Object (T : in out Ahven.Framework.Test_Case'Class) is begin Put_Line ("Test_With_Object"); Hello (Test (T)); end Test_With_Object; end Simple_Tests; ahven-2.1/css/0000775000076400007640000000000011637173541013527 5ustar tkoskinetkoskineahven-2.1/css/my-docutils.css0000664000076400007640000000037011637173541016512 0ustar tkoskinetkoskine /* :Author: Tero Koskinen :Contact: Tero Koskinen :Copyright: This stylesheet has been placed in the public domain. Stylesheet for use with Ahven and Docutils. */ h1 { background-color: #cdcdff; padding: 0.1em; } ahven-2.1/css/html4css1.css0000664000076400007640000001364511637173541016074 0ustar tkoskinetkoskine/* :Author: David Goodger (goodger@python.org) :Id: $Id: html4css1.css 6511 2011-01-03 14:49:11Z milde $ :Copyright: This stylesheet has been placed in the public domain. Default cascading style sheet for the HTML output of Docutils. See http://docutils.sf.net/docs/howto/html-stylesheets.html for how to customize this style sheet. */ /* used to remove borders from tables and images */ .borderless, table.borderless td, table.borderless th { border: 0 } table.borderless td, table.borderless th { /* Override padding for "table.docutils td" with "! important". The right padding separates the table cells. */ padding: 0 0.5em 0 0 ! important } .first { /* Override more specific margin styles with "! important". */ margin-top: 0 ! important } .last, .with-subtitle { margin-bottom: 0 ! important } .hidden { display: none } a.toc-backref { text-decoration: none ; color: black } blockquote.epigraph { margin: 2em 5em ; } dl.docutils dd { margin-bottom: 0.5em } object[type="image/svg+xml"], object[type="application/x-shockwave-flash"] { overflow: hidden; } /* Uncomment (and remove this text!) to get bold-faced definition list terms dl.docutils dt { font-weight: bold } */ div.abstract { margin: 2em 5em } div.abstract p.topic-title { font-weight: bold ; text-align: center } div.admonition, div.attention, div.caution, div.danger, div.error, div.hint, div.important, div.note, div.tip, div.warning { margin: 2em ; border: medium outset ; padding: 1em } div.admonition p.admonition-title, div.hint p.admonition-title, div.important p.admonition-title, div.note p.admonition-title, div.tip p.admonition-title { font-weight: bold ; font-family: sans-serif } div.attention p.admonition-title, div.caution p.admonition-title, div.danger p.admonition-title, div.error p.admonition-title, div.warning p.admonition-title { color: red ; font-weight: bold ; font-family: sans-serif } /* Uncomment (and remove this text!) to get reduced vertical space in compound paragraphs. div.compound .compound-first, div.compound .compound-middle { margin-bottom: 0.5em } div.compound .compound-last, div.compound .compound-middle { margin-top: 0.5em } */ div.dedication { margin: 2em 5em ; text-align: center ; font-style: italic } div.dedication p.topic-title { font-weight: bold ; font-style: normal } div.figure { margin-left: 2em ; margin-right: 2em } div.footer, div.header { clear: both; font-size: smaller } div.line-block { display: block ; margin-top: 1em ; margin-bottom: 1em } div.line-block div.line-block { margin-top: 0 ; margin-bottom: 0 ; margin-left: 1.5em } div.sidebar { margin: 0 0 0.5em 1em ; border: medium outset ; padding: 1em ; background-color: #ffffee ; width: 40% ; float: right ; clear: right } div.sidebar p.rubric { font-family: sans-serif ; font-size: medium } div.system-messages { margin: 5em } div.system-messages h1 { color: red } div.system-message { border: medium outset ; padding: 1em } div.system-message p.system-message-title { color: red ; font-weight: bold } div.topic { margin: 2em } h1.section-subtitle, h2.section-subtitle, h3.section-subtitle, h4.section-subtitle, h5.section-subtitle, h6.section-subtitle { margin-top: 0.4em } h1.title { text-align: center } h2.subtitle { text-align: center } hr.docutils { width: 75% } img.align-left, .figure.align-left, object.align-left { clear: left ; float: left ; margin-right: 1em } img.align-right, .figure.align-right, object.align-right { clear: right ; float: right ; margin-left: 1em } img.align-center, .figure.align-center, object.align-center { display: block; margin-left: auto; margin-right: auto; } .align-left { text-align: left } .align-center { clear: both ; text-align: center } .align-right { text-align: right } /* reset inner alignment in figures */ div.align-right { text-align: inherit } /* div.align-center * { */ /* text-align: left } */ ol.simple, ul.simple { margin-bottom: 1em } ol.arabic { list-style: decimal } ol.loweralpha { list-style: lower-alpha } ol.upperalpha { list-style: upper-alpha } ol.lowerroman { list-style: lower-roman } ol.upperroman { list-style: upper-roman } p.attribution { text-align: right ; margin-left: 50% } p.caption { font-style: italic } p.credits { font-style: italic ; font-size: smaller } p.label { white-space: nowrap } p.rubric { font-weight: bold ; font-size: larger ; color: maroon ; text-align: center } p.sidebar-title { font-family: sans-serif ; font-weight: bold ; font-size: larger } p.sidebar-subtitle { font-family: sans-serif ; font-weight: bold } p.topic-title { font-weight: bold } pre.address { margin-bottom: 0 ; margin-top: 0 ; font: inherit } pre.literal-block, pre.doctest-block { margin-left: 2em ; margin-right: 2em } span.classifier { font-family: sans-serif ; font-style: oblique } span.classifier-delimiter { font-family: sans-serif ; font-weight: bold } span.interpreted { font-family: sans-serif } span.option { white-space: nowrap } span.pre { white-space: pre } span.problematic { color: red } span.section-subtitle { /* font-size relative to parent (h1..h6 element) */ font-size: 80% } table.citation { border-left: solid 1px gray; margin-left: 1px } table.docinfo { margin: 2em 4em } table.docutils { margin-top: 0.5em ; margin-bottom: 0.5em } table.footnote { border-left: solid 1px black; margin-left: 1px } table.docutils td, table.docutils th, table.docinfo td, table.docinfo th { padding-left: 0.5em ; padding-right: 0.5em ; vertical-align: top } table.docutils th.field-name, table.docinfo th.docinfo-name { font-weight: bold ; text-align: left ; white-space: nowrap ; padding-left: 0 } h1 tt.docutils, h2 tt.docutils, h3 tt.docutils, h4 tt.docutils, h5 tt.docutils, h6 tt.docutils { font-size: 100% } ul.auto-toc { list-style-type: none } ahven-2.1/README.rst0000664000076400007640000002044311637173541014431 0ustar tkoskinetkoskine===== Ahven ===== .. contents:: :depth: 1 Ahven is a simple unit test library (or a framework) for Ada programming language. It is loosely modelled after `JUnit`_ and some ideas are taken from AUnit. Ahven is free software distributed under permissive ISC license and should work with any Ada 95 or 2005 compiler. Features -------- * Simple API * Small size (Ahven 2.1 has 2.1K SLOC; 588 statements; 1228 declarations) * JUnit-compatible test results in XML format; this allows integration with tools like `Jenkins`_ or CruiseControl. * Strict coding style (enforced by AdaControl) * Plain Ada 95 code, no Ada 2005 features used, but can be compiled as Ada 2005 code if needed * Portable across different compilers and operating systems * Permissive Open Source license See also '''''''' * The project page at http://sourceforge.net/projects/ahven/ * The latest commits at http://cia.vc/stats/project/ahven * Author's blog at http://tero.stronglytyped.org/Tags/ahven Platforms --------- Ahven 2.1 compiles and passes its test suite on following platforms +-----------------------+-------+------------------------+ | OS | Arch | Compiler | +=======================+=======+========================+ | OpenBSD4.9 | amd64 | FSF GCC 4.3.5 | +-----------------------+-------+------------------------+ | Debian GNU/Linux 6.0 | i386 | FSF GCC 4.4.5 | +-----------------------+-------+------------------------+ | Fedora Linux 15 | i386 | FSF GCC 4.6.0 | +-----------------------+-------+------------------------+ | Fedora Linux 15 | i386 | GNAT GPL 2011 | +-----------------------+-------+------------------------+ | Windows XP | i386 | Janus/Ada 3.1.2beta | +-----------------------+-------+------------------------+ | Windows XP | i386 | GNAT GPL 2009 | +-----------------------+-------+------------------------+ | Windows XP | i386 | Irvine ICC Ada 9.0beta | +-----------------------+-------+------------------------+ News ---- Ahven 2.1 (2011-09-24) '''''''''''''''''''''' This is a bug fix release. The release fixes the skipped test reporting in Ahven.Text_Runner. Ahven 2.0 (2011-09-23) '''''''''''''''''''''' This is a feature release. The release adds possibility to stop tests after certain amount of time and programmatically skip tests. In addition, the README document is now in reStructured text format, like the manual. Ahven 1.9 (2011-04-19) '''''''''''''''''''''' This is a bug fix release. The release includes new HTML documentation generated from reStructured text using Python-Sphinx and fixes compilation problems with GNAT GPL 2010. (Release notes) Ahven 1.8 (2010-06-02) '''''''''''''''''''''' This is a bug fix release. Changes include a fix for double free when mixing dynamic test cases with static test suites, removal of some unfinished features like TAP 1.3 and Janus/Ada 3.1.1d support, and code cleanups. (Release notes) Ahven website location changed again (2009-11-30) ''''''''''''''''''''''''''''''''''''''''''''''''' The website location of Ahven changed once more. This time the change should be the last one for a while. At the same time, the layout was reverted to the older version, which is more friendly to the bandwidth. Technical detail which should be interesting: The new website is running on Debian and Ada Web Server. Ahven 1.7 (2009-09-14) '''''''''''''''''''''' This is a bug fix release. Changes include a fix for Constraint_Error with long test names and special character filtering from the test names when generating XML results. In addition, PDF report generation example was added to the contrib directory and some internal code cleanups were done. (Release notes) Mercurial repository, part 2 (2009-06-25) ''''''''''''''''''''''''''''''''''''''''' Sourceforge.net has had some problems with their Mercurial repositories, so now the previously unofficial Bitbucket Mercurial repository as the official Mercurial repository for Ahven. Also, bug reports are now at Bitbucket. Mercurial repository (2009-03-17) ''''''''''''''''''''''''''''''''' Sourceforge.net added support for Mercurial and now Ahven's source code repository is migrated from CVS to Mercurial. Ahven 1.6 (2009-02-28) '''''''''''''''''''''' This release fixes GNAT installation issues. (Release notes) Ahven 1.5 (2009-02-23) '''''''''''''''''''''' This is first release at SourceForge. The release includes only some build system changes. (Release notes) SourceForge.net (2009-02-18) '''''''''''''''''''''''''''' Ahven project is now hosted by SourceForge. Ahven 1.4 (2009-01-22) '''''''''''''''''''''' This release introduces Test Anything Protocol (TAP) reporter, a new API for stack-based test cases, and improved Janus/Ada support. Also, some API changes were done, but they should affect you only if you have extented the framework. (Release notes) Ahven 1.3 (2008-08-13) '''''''''''''''''''''' A bug fix release. The major change is support for Janus/Ada. (Release notes) Web site layout changes (2008-06-30) The web site layout was changed to be "less boring". The new blueish theme should work better on different types of monitors. (Some low quality monitors and graphics cards didn't show light brown colors properly.) Ahven 1.2 (2008-05-12) '''''''''''''''''''''' A major new feature in this release is support for JUnit-compatible XML-based test result format. The release also includes bug fixes and code cleanups. (Release notes) Ahven 1.1 (2008-01-30) '''''''''''''''''''''' Incremental release including bug fixes and new features. (Release notes) Ahven 1.0 (2007-10-24) '''''''''''''''''''''' Initial release. (See `News`_ for details.) Download -------- Ahven is distributed in source code format only. Please see the download page at http://sourceforge.net/projects/ahven/files/ for details. You can download the latest development source code from Ahven's Mercurial repository: https://bitbucket.org/tkoskine/ahven/ Debian package '''''''''''''' Debian stable (6.0) provides Ahven 1.7 as libahven17.0 and libahven1-dev packages. One can install the packages with command *apt-get install libahven17 libahven-dev*. Installation ------------ For building Ahven source code you need Ada 95 compiler, for example GNAT, Janus/Ada, or ObjectAda. Optionally, you need AdaBrowse to build the documentation and AdaControl to run coding style checks. The default Makefile compiles code using gnatmake. Internally, gnatmake is given a GNAT project file, which works with GNAT GPL series and relatively recent FSF GNAT. If you plan to compile Ahven with GNAT 3.15p, you need to modify the project file slightly and remove incompatible compiler flags. If you use another compiler, you need to customize the Makefile by yourself. Please note, that 'src' directory has platform specific subdirectories 'unix' and 'windows. You need to select the sources from one of them also. Installation: GNAT '''''''''''''''''' When using GNAT, simple *make* will compile the library and the unit tests. Command *make check* will run the unit tests. If you want to build the API documentation, you need AdaBrowse tool. Command 'make docs' will build the API documentation. Installation happens by typing *make install* or *make PREFIX=/my/ada/code install*. Alternatively, you can simply copy the source code directory ('src') to your project. Installation: Janus/Ada ''''''''''''''''''''''' Build scripts for Janus/Ada are located in the 'janusada' directory. To compile the source code, you need to tweak file 'prepare.bat' and then run 'prepare.bat', 'update.bat', and 'compile.bat' from the top level directory. That is the same directory where this README.rst file is located. Example: :: janusada\prepare.bat janusada\update.bat janusada\compile.bat When compilation is finished, you have tap_test.exe in the 'test_obj' directory. Documentation ------------- * The API documentation (for Ahven 2.1): http://ahven.stronglytyped.org/api-2.1/index.html * The API documentation (for Ahven 1.8): http://ahven.stronglytyped.org/api/index.html * Tutorial: http://ahven.stronglytyped.org/tutorial.html Author ------ Tero Koskinen .. image:: http://ahven.stronglytyped.org/ahven.png .. _`Jenkins`: http://www.jenkins-ci.org/ .. _`JUnit`: http://www.junit.org/ .. _`News`: http://ahven.stronglytyped.org/NEWS ahven-2.1/NEWS0000664000076400007640000002744711637173541013454 0ustar tkoskinetkoskine2011-09-24 Ahven 2.1 ==================== Bugs fixed ---------- * Ahven.Text_Runner did not report skipped tests correctly. This is now fixed. Internal -------- * Function Ahven.Results.Skipped_Count was added. 2011-09-23 Ahven 2.0 ==================== Changes ------- * Tests can be now given a timeout value. If a test is not executed in the given time, it is stopped and a timeout failure is reported. See '-t' option of the test runners. The timeout feature depends on the possibility to abort a task after a certain amount of time. If the task abortion is not possible, the current test will continue running even after the given timeout. * A test can be now skipped programmatically by calling procedure Skip("Message"). A skipped test are considered to be equal to passed tests, but depending on the test runner, they can have extra "SKIP" information attached. * README is now provided in reStructured text format, just like the manual. Bugs fixed ---------- * Ahven can be compiled on Fedora systems by installing package "libgnat-static". Note: This was not a bug in Ahven but a configuration issue on Fedora. 2011-04-19 Ahven 1.9 ==================== Changes ------- * Manual was added to 'doc/manual/en' directory. It includes User's Guide section and API documentation. The documentation is written using reStructuredText and Sphinx 1.0, so Python and py-sphinx are required for building. API documentation generation via Adabrowse is still supported, but it will be deprecated and dropped later. Bugs fixed ---------- * Extra Test'Class (...) type conversion was removed from ahven-framework.adb. This allows compilation with GNAT GPL 2010. (Bug bitbucket#3) Internal -------- * Package Ahven.VStrings was replaced with an instantiation of Ada.Strings.Bounded.Generic_Bounded_Length. This allowed us to remove over 100 lines of code. Known issues ------------ * Ahven (or actually file ahven-parameters.adb) cannot be compiled on Fedora 14 with gcc 4.5.1. See bug https://bugzilla.redhat.com/show_bug.cgi?id=690610 for details. 2010-06-02 Ahven 1.8 ==================== Changes ------- * The dynamic library support with GNAT was removed since it did not work automatically in a trouble-free way on Debian, Fedora, and Windows. * Ada.Calendar dependency was removed from Ahven.Framework. Equivalent functionality is now implemented in the test runners. * Support for TAP 1.3 was dropped. TAP 1.2 is supported normally. * Janus/Ada 3.1.1d support was dropped. Ahven now requires Janus/Ada 3.1.2beta or newer. * There is now ahven.spec file in contrib/fedora to make packaging and installing Ahven easier on Fedora. Bugs fixed ---------- * If user placed a dynamically allocated Test_Case into a statically allocated Test_Suite the finalization procedure tried to release the same memory twice. This is now fixed by implementing Adjust for the Test_Suite type. (Bug bitbucket#2) * Many Some_Type'(initial values) expressions were changed into more simpler (initial values) form. This was done to avoid Janus/Ada bug no 73. Internal -------- * Code cleanup: style fixes, removal of compiler warnings and comment clarifications. * Remove_All procedure from Ahven.SList package was renamed to Clear. The new name is more consistent with Ada.Containers naming style. * Ahven.VStrings package now depends on Ada.Strings.Fixed. * Ahven.Framework.Indefinite_Test_List has no longer procedures or functions for Cursors. Same functionality can be now achieved using generic For_Each procedure. 2009-09-14 Ahven 1.7 ==================== Changes ------- * The source code repository and the issue tracker are now hosted at Bitbucket, http://bitbucket.org/tkoskine/ahven * The usage of Unbounded_String was completely removed from all packages. Now Ahven.Framework.Get_Name function returns String. * GNAT project files (.gpr) were moved to the 'gnat' directory. * The upper limit (Count_Type'Last) of Ahven.SList is now documented. * A PDF report generation example from XML result files was added to 'contrib/docbook-testreport'. From Reto Buerki. Bugs fixed ---------- * Fix Contraint_Error when one tries to truncate overlong string. Bug report and patch from Reto Buerki. (Bug bitbucket#1) * XML_Runner now filters special characters like space or / from the filenames. Patch from Reto Buerki. Internal -------- * Makefile now has 'tags' target for generating 'tags' file. It assumes that ctags utility has support for Ada. * It is no longer necessary to have procedure or function declarations for all procedures and functions. The purpose is to allow somewhat shorter code. * User's Guide has seen some progress, but it is still not completely ready. (=one should not rely on it.) * In the test code, some Assert calls were converted to more compact Assert_Equal calls. 2009-02-28 Ahven 1.6 ==================== Bugs fixed ---------- * Installation scripts for GNAT were fixed. Bug report and patch from Reto Buerki. 2009-02-23 Ahven 1.5 ==================== Changes ------- * Ahven is now hosted at sourceforge.net. New URLs are: Project page: http://sourceforge.net/projects/ahven Home page: http://ahven.sourceforge.net/ * Janus/Ada build system was rewritten. See README for details. Also, some minor changes were done to GNAT build scripts. Bug fixed --------- * API documentation was not generated for the Ahven.SList package. 2009-01-22 Ahven 1.4 ==================== Changes ------- * Type Ahven.Framework.Test_Result and related code was removed. Ahven.Framework.Execute now takes Listeners.Result_Listener'Class directly instead of Test_Result object. * New abstract function Test_Count was added to the Test type. The function returns the amount of test routines which will be executed when the Run procedure is called. * Test Anything Protocol (TAP) support: There is now a new Ahven.Tap_Runner package, which outputs test results in TAP format (versions 1.2 and 1.3 are supported). * Get_Message and Get_Long_Message functions now return String instead of Unbounded_String. * The GNAT project files for GNAT 3.15p were synchronised with the GNAT GPL versions. * Janus/Ada build scripts are now in the 'janusada' directory instead of 'contrib\janusada'. * New (generic) assertion procedure: Assert_Equal (Expected, Actual, Message). Suggestion and the source code from Pawel Plazienski. * New procedure for inserting stack-allocated tests into test suites: Add_Static_Test (Suite, T). Idea from Pawel Plazienski. * Internally, almost all Unbounded_Strings were converted into VStrings. This limits the maximum length of test names and failure messages to 160 characters. Constraint_Error is raised for overlong test names and too long failure messages are silently truncated into 160 characters. This was done for better Janus/Ada 3.1.1d compatibility. Bugs fixed ----------- * Text-based test runner results are now aligned in a better way. Fix for bug #12220. Internal -------- * All lists were converted into singly linked lists. Lists were made generic wherever possible. * Listeners.Output_Capture was combined into Listeners.Basic. 2008-08-13 Ahven 1.3 ==================== Changes ------- * Example configuration for Cruisecontrol was added. * The GNAT project file for GNAT 3.15p was added. * Fix for bug #12165 and make test suite to work with Janus/Ada 3.1.x. Bugs fixed ---------- * The API documentation is now generated also for the Ahven.Compat and Ahven.XML_Runner packages. * The use of System.Address_To_Access_Conversions was removed. This allows Ahven to be compiled with Janus/Ada. At the same time, Ahven.Framework.Run (T : Test;...) was changed back to Ahven.Framework.Run (T : in out Test;...). Sorry for the inconvenience. * Non-standard pragmas were removed. The code should compile now on multiple Ada compilers without warnings about unrecognised pragmas. Internal -------- * Variable "OS" in Makefile and GNAT project files was renamed to "OS_Version". * New tests: Result_Tests.Test_Add_{Pass,Failure,Error}, Framework_Tests.Test_Tear_Down, Ahven.Result_Listener_List.Test_Append. * Removed tests: List_Tests.*. * Code cleanups: + Duplicate code from Text_Runner.Run and XML_Runner.Run moved into Runner.Run_Suite. + Duplicate code from various Framework.Run procedures was moved into Framework.Run_Internal. * Ahven.Doubly_Linked_List was removed. This is related to bug #12165. 2008-05-12 Ahven 1.2 ==================== Changes ------- * New XML_Runner which generates JUnit compatible XML test results. XML_Runner can be either run explicitly or via Text_Runner using the '-x' parameter. * Unused access types Test_Access, Test_Case_Class_Access, Test_Case_Access, Test_Suite_Class_Access, Result_Listener_Access, Test_Command_Access, Test_Object_Command_Access, Basic_Listener_Access, and Output_Capture_Listener_Access removed. * Ahven.Framework.Run (T : in out Test;...) is changed to Ahven.Framework.Run (T : Test;...), because 'in out' mode was not necessary. * New procedures/functions: Ahven.Text_Runner.Run (Suite : Framework.Test_Suite'Class); Ahven.Framework.Create_Suite return Test_Suite; With these, the suite can be created on stack and one does not need to play with access types. Bugs fixed ---------- * Ahven can be now compiled with GNAT 3.15p. * The GNAT project file should work on Windows again. Internal -------- * XML_Runner introduced a need for some platform specific files. Therefore, 'src' directory now contains subdirectories 'unix' and 'windows'. * New tests: Result_Tests.Test_* * Next_* procedures for in the Results package were replaced with proper iterators. 2008-01-30 Ahven 1.1 ==================== Changes ------- * The Ahven.Framework and the test runners are able to optionally run only the tests which match the given name. * The default Text_Runner is able to capture Ada.Text_IO output from a test into a temporary file and show the output if the test does not pass. Option '-c' turns the capture feature on. * The default Text_Runner shows the exception message in addition to the exception name when the test ends in error. (Idea and original patch from Alexander Senier) * The default Text_Runner is now able to provide a short summary instead of full test report. Use option '-q' to get the test summary. * The GNAT project file is now called 'ahven.gpr' instead of old 'ahven_lib.gpr'. * ALI files (*.ali) are now installed read-only, so GNAT does not try to rebuild the library. (Patch from Alexander Senier) * Function Ahven.Framework.Name is renamed to Ahven.Framework.Get_Name. * Shared library produced by GNAT now includes the version number. Internal -------- * New listener: Output_Capture_Listener, which will forward Ada.Text_IO output into a temporary file. * Type Ahven.Results.Result_Place is renamed to Ahven.Results.Result_Info. * Ahven.Double_Linked_List is renamed to Ahven.Doubly_Linked_List, because other Ada linked list implementations also use similar naming scheme. * AdaControl is used to enforce some parts of the coding style. This caused some API changes, but in most cases the changes are invisible. 2007-10-24 Ahven 1.0 ==================== Initial release. Ahven is a simple unit test library for Ada 95. It is modeled after JUnit and some ideas are taken from AUnit. Ahven 1.0 is distributed under ISC license. Features ======== * Test, Test_Case, and Test_Suite classes (tagged types) * Assert and Fail procedures for triggering assertion failures * Text-based test runner Tero Koskinen ahven-2.1/gnat/0000775000076400007640000000000011637173541013670 5ustar tkoskinetkoskineahven-2.1/gnat/ahven_tests.gpr0000664000076400007640000000314011637173541016723 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with "ahven_lib"; project Ahven_Tests is for Languages use ("Ada"); for Source_Dirs use ("../test"); for Object_Dir use "../test_objects"; for Exec_Dir use "../"; for Main use ("tester.adb", "tap_tester.adb"); package Builder is for Default_Switches ("Ada") use ("-g", "-gnatQ", "-gnatwa", "-gnatwF", -- unreferenced formal off "-gnat95"); end Builder; package Linker is for Default_Switches ("Ada") use ("-g"); end Linker; package Compiler is for Default_Switches ("Ada") use ("-gnatf", "-g"); end Compiler; package Binder is for Default_Switches ("Ada") use ("-E", "-static"); end Binder; end Ahven_Tests; ahven-2.1/gnat/ahven.gpr0000664000076400007640000000040011637173541015475 0ustar tkoskinetkoskineproject Ahven is for Languages use ("Ada"); for Source_Dirs use ("../../include/ahven"); for Library_Dir use "../../lib/ahven"; for Library_Name use "ahven"; for Library_Kind use "static"; for Externally_Built use "true"; end Ahven; ahven-2.1/gnat/ahven_lib.gpr0000664000076400007640000000346611637173541016342 0ustar tkoskinetkoskine-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- project Ahven_Lib is type OS_Type is ("unix", "windows"); OS_Version : OS_Type := external ("OS_VERSION", "windows"); Version := "18"; for Languages use ("Ada"); for Object_Dir use "../objects"; for Source_List_File use "ahven.lgpr"; for Library_Name use "ahven"; for Library_Dir use "../lib"; for Library_Kind use "static"; case OS_Version is when "unix" => for Source_Dirs use ("../src", "../src/unix"); when "windows" => for Source_Dirs use ("../src", "../src/windows"); end case; package Builder is for Default_Switches ("Ada") use ("-g","-gnatf", "-gnatVa", "-gnato", "-gnatwe", "-gnatwa", "-gnatwl", "-gnatE", "-gnatwF", -- unreferenced formal off "-gnatyd3ibmhex", "-gnat95"); end Builder; end Ahven_Lib; ahven-2.1/gnat/ahven.lgpr0000664000076400007640000000105611637173541015661 0ustar tkoskinetkoskineahven-astrings.ads ahven-framework.adb ahven-framework.ads ahven-listeners-basic.adb ahven-listeners-basic.ads ahven-listeners.adb ahven-listeners.ads ahven-parameters.adb ahven-parameters.ads ahven-results.adb ahven-results.ads ahven-runner.adb ahven-runner.ads ahven-slist.adb ahven-slist.ads ahven-tap_runner.adb ahven-tap_runner.ads ahven-temporary_output.adb ahven-temporary_output.ads ahven-text_runner.adb ahven-text_runner.ads ahven-xml_runner.adb ahven-xml_runner.ads ahven.adb ahven.ads ahven_compat.adb ahven_compat.ads ahven-2.1/extra/0000775000076400007640000000000011637173541014062 5ustar tkoskinetkoskineahven-2.1/extra/ahven.png0000664000076400007640000004150211637173541015673 0ustar tkoskinetkoskinePNG  IHDRdd[gAMA asRGB cHRMz&u0`:pQ<bKGD pHYs   vpAgd|AIDATxYu_sNIq,1HIZ~7G;#lS) R;HffV]]{VowC]0==Nč+9ܳ@?{rݳߵ?3/BH)YJg[?_qk~~i1,g_? c Ƙ{`5h `^AܳCWqciMTTQleY+s<(heY2|Xr, 0 x$4MI䞟ϩGyTZ eIdYt:e20njFdt:uSvEQ4'MS4lh4hZ4cѠh=Z4h<`kE1g0|3)Tk>i_v͛+MSfvMݦtvZ- >=2`6qiA u||<)˲{@:y/an^̓6Y Vף뱸Hףt֌٣"f( )`@𐃃9<<5SmNkӻ|7;͛$IkiiigZh$Lon8ʲic>>1 3i^#Ϝ(LiujVf/vYXX`yyZZZ b)X}(L& Cgggmvvvfht:(Lddy_8c^eVWWY[[cmmUvZ-8& Y(#1GGG3ܹÝ;wfoo~p8d2/fVCV,.KKKqΞ=˙3gX]]eqqvM,hDgoo-n߾۷g@ʹS ڬiFQDѠ?~2Ng#>4M(cr4dggm\gΜaqqF1;|Pp}`j_,K& ~-]իWy7u{{{ ,^HRr1i|`wwfww={1.^*v{:>X*p.7n7;ׯ_Ν;}&,d>$8?yVWi0%lskQ\rsαH^3Xz*o7odwwpH~ hمS+L|_p+Xu*/ ,. m4YX_`{F)Mp?F(D!?JI#0:% a`_}eߕ=/ossW^y^xa>|I bE"z*}_#!@%~BR%1(l#%*6Rr<5oJGp:nU%۷oꫯ /o}뻠v}BHtha?el r;lmj*;{: /6"Cq9Ƞ0I%񼳖k>o3Unŷ)F#ܹ믿΋/x_MQ X.qp[1["pXg.CxȄ M~LWt:]N* S½{Tᬖr>6Ic`vw2o/+P*%톄fyqHÇ,>18N(ܔAIi#Q $P1?[lq$ZC y0TI2sqR꾯]`*1s~,Nu ,0aEK QQVb/4r~1%wr&܀8?GIT\ϟre5Q/݆hBwLZSx;3eYr||&* ׯ_gp"D{0ƍND/`xEHuBЉ)$qNY{{J'O,E|dM%T ;bXM=iRf9 O{Mx yxxxȍ7x׹z*Y}B!*r`=Ny\Sc(A?Ksh Wr`*Cb.hh2)Nϯ-`ٌkvH"C[&hP~]ce>yttĭ[hZz=:Lsa`UUp8dkk7xWreY>d! >(GF[xarI6ɪ1S(D.AZH°H ۀI9Ҕ2L 5sM v; R! o€wwYBh6~kt; >5DZN%BWXcF)[DcE5qx@`.rǭ[x"t:󡣣#ܹ۷g2=unoo9Kkyme2ppp;;; (@Hr0$@+Ԁ.cC,2dEX*@~޾؂12%W 4Jh(-t:'<*5xh6#:"/ "$QEU1!8@!JoB -r&}| tOSh|"QQ4H4V.ջptt4;uTuoooV(j+%#) oƆm%U'8 [v"Dɀ h4BU3g6hYΉTL U0SdP"8'sE10X%'XtC!`4&9DqHA  s4 rTcmIx+E6FM}ZJ/B"b6"BYX˰b%i;r2V`Eq  Hh*~6'}v|]7 u]|*EtzMV,/-~#./7Hp$:D'Q\#5 IR4[ip'h5%aSV)F80IĊ¢TBݥT(a,3\2-4"W!n61ÜMa#_!p!m-zcGr@yLZ"tA%H5D0D9*( (qH3C (FeQH@XE;bx ^"]i C) Z7qE1KU߽tW%ssM>=]Z>=C}JQ{< [1㉧ F#p2"n0 r.P b2VhD'`2 H0 XјB:E12(褆a:N%d!MIZā&< fԥ@LF# DP4 iV (&a_C;)\F* -GHPKeB?DVk<1F'E,ʓ&ÅXڼvwL{4jx=h;<2OCi>ygl)'% Jh#3Z"x1&yU4l `aHa ,`0 dV2XbAIMYZzdG-9}E9Q@-XZ,X`ʝT]T8P0SL Za,M[h'5](с"V H>"="y'<)d g%ӫ|M'}~G 4 { blʀ'Ři9aRa+pU@YUV!^OQ@*JA('%s)+X^XY,wu! l{d`/mGf<9x;x%VA@,- ~h] XK`-&FxJQD lBEd لX7hQ@{ 3:~sMh<4CCW I٣Xp%%ӌ5KŒuK -Ο4"ZZ@3)NhF!Y)\>泉FI7(_"}2 ksX,֞4 2"؉h8`) Yo .6[YnXHVKnBtDSM"%G㽞Qi,\u0 i6{|&1K1}snmWx[/|~@8*\FPJyǢ,`5AB'yP"xL#KxjJL!!") d1ќIEWb1 T1vɥ JFhƴ[!catGȸEc l׿:G\>]|I DUU?loX uT 9ŷZF48`!H~#V$a; \< GQt0~9|Z+iXkT1W9O?=3_S4uatrLCN#RRلXN  Rh ): l<'H716}[ KԒ(i6jM5"je4OD!hd [ReYij^F)N8*a~BuPoG*gqJeUZT{^~A9>)})zwak2`Rm/yR$IBaaavUO꬛]t?/[9b-iIGĖՖ c4E.憢j0aJm&TVP($ C4ĉ9 4Dc;9kgs\`f-=dS)SKS @BʐȴiTA¢%MS*`=֥xT3x^O*UVq,x@Bnۀ 7XgG{fEgipv^^@T(v| qI%Ҁ12zX u4P.b("5 WXB*Bi 3#NjRVsxLQ($R())* rVg ^h'!Q(#'LTE2#fD#hTE„d. kF楗w-suj:uuqq*d=G R8v,//4k~0nn;}@̜#3\iV!:xNߜ$1S J|J&RSB"E%=RX` RW!+54TZk4eyy/lN-Dډ_[[ҥK + vu\jH\"o !AUi~D;<:e $SDGtHM[6H*KU$I #ENIDUhi3!hjb'm,u+Vq ~zU-, sk#nmNOE%9qp<͐.ⵛ|㘼zTʿjȅ rla=LVl@… Gt:YE [+:O4!NXS2.+N |Mˊ$bAًgx3x{ 4qD$2J{l" Jȫ!k1B9AD(H#H,t;HִZ-ָr ?8.\7yA~sq|||2rYw4Hd #+L9ŔBYY(cLA mgelAB"T$ )w79q<naL^/} xɕ+Wf7 L~$.--qeƣ1efqqH;3 6r,^{&N3_i$'Y*D27*45Fx J$"N%ZJB#گ| W-;:vW?G?b ?bJY@g,!aF!VM "wF۵-Oa;wJ2q8< U$,--q%~ix Ξ=;vSԎ|eLS^ʧkL(\oBpJBT'X:DµNэc},ѡ@3x٤7x~QΏ|J6g#\hw_8_z+JP#Ix4r +s+R,Rڍ@tRXqj ' yQ{d)+%6F)$W|ykgj6Z8jyg}cczzvu^U;wnth2o~Ţp|fT+<0%Hyb[!јɤ$I=IT!N*oyśW唵^G? mxVV՛/|"?ym~_woS?YP84΃I&Ih¸PsNĈL]3VA@a  Xa KTy)/_M(ޡ{5ŋyygrwC'o Vmؠ3 |K4mG2DI48`=1B ٰ??V;/4RmZcjxB+vp}61 ݔP՟`3O]z HAvp8Fmjr;?v^U%Tj_Ґ[$ z67'{lgi㣱NG766xg'??Ι3ghZZ| j:_>}yןb<ٰCg',] 9$=4ѝ) *E ij +&O.ifYUԋcOɈ "r!}. ƀjPxI ɹs9|'FJ)4eee3Gܙٹ5|q5.zI²G\W_Wq$Oq] k;?q+U z|_yCl:(hV|PvB~P?o7j%ŅWz~+;__¥s0FLvWxVeeAgSD鹕ÿ?lM4i~~f漗˿˿np$aHdzuucN#S26%oFE; I#J4E'{>qy0NRю;,|f& !tGH,ԧxgWA{ k6T30dkk#,#/^hwK \l&}^|ʐҦxgx=~WN5?< U.Dxx#./6韽HfXl$0or_g? i b=_em` 9xa8$?\}bު<ɫC =,0^NX\Fcf"k V ulAUUfkGTQB#xp=~(b2)1 ⧟;ߠ?;]Xi:[qLnJ[OzGG#|cvϲ#4D1kg^k\=8wuWvR*g>^ %pAјo|s|Cl@'Xݬ!vud^Zʕ+<<)V7;8d.;u <<\|3gO^=5/n"^7o1YQ%6:SFu66϶h6Zn ys\z|9LYD>WƭTe{=cPu9{,/_T-//jXs'T,˒h>oڵk\zk׮>ш,{?f*X}k1~6.r~Ν@h4rZ%+%I^kڏywwG|̶ltXZZbuuLkkk,--4ԼQtH5`<>>maooCdSw!=xp?=!|TվS}jz3Μ93[+++,,,jfa[e˲l6Hq=vvvݝv||p8d2c*rڏLɽ|^Ô$L;-,,<2w' xXkcLփ9888=gh3S\65sOfnvMכ5fg݊FX2e1eydhͦz(y>JPV sGq6N^7딷^N3;k 3xeש5dxh4;4`0`82L&3m,_$)a/~Ntky^A~ ljh۳~vV5k>ӣ'Xr?yx5hɄhh4b8VyȲ,f3ӓaC{jjvZ+՚izZY[y0Aӣ3zTyՠSbѱ5Ngj9o:7ky?G{Oa5JtP$:2>?0y"MAa~W{8kZک+>Z( ÷A4/}@:-;Nih~#0}j5s0_k}NcZ(}\A:-{N5ﰟ^?y@5w$?62"TLtEXtCommentCreated with GIMPW%tEXtdate:create2011-05-31T21:11:43+03:00n%tEXtdate:modify2011-05-31T21:11:43+03:00jCIENDB`ahven-2.1/rules/0000775000076400007640000000000011637173541014071 5ustar tkoskinetkoskineahven-2.1/rules/ahven.aru0000664000076400007640000000417411637173541015711 0ustar tkoskinetkoskinecheck header_comments (minimum, 10); search header_comments (model, "licenseheader.pat"); check pragmas (nonstandard); check improper_initialization (out_parameter); -- check improper_initialization (access variable); search improper_initialization (initialized_variable); check expressions (and_then, or_else, mixed_operators); search global_references (all, ahven); check naming_convention (variable, case_sensitive "^[A-Z][A-Z]?[a-z0-9]*(_[A-Z0-9][a-z0-9]*)*$"); check naming_convention (type, case_sensitive "^[A-Z][A-Z]?[a-z0-9]*(_[A-Z0-9][a-z0-9]*)*$"); check naming_convention (enumeration, case_sensitive "^[A-Z][A-Z0-9]*(_[A-Z0-9][A-Z0-9]*)*$"); check max_statement_nesting (loop, 2); search max_statement_nesting (all, 3); check simplifiable_statements (if_for_case, block, null); check simplifiable_expressions (range, logical); check characters (control, trailing_space); check max_line_length (79); search characters (not_iso_646); search max_blank_lines (2); check Multiple_Assignments (repeated); check entities (Ada.Strings.Unbounded.Unbounded_String); check declarations (integer_type); check declarations (multiple_names); -- Renamed function calls are forbidden since -- some Ada compiler do not support them. -- check declarations (function_call_renaming); check directly_accessed_globals; check style (positional_association, instantiation, 0, call, 3); -- No variables in package specs check usage (variable, from_spec); Constantable : check usage (variable, not from_spec, read, initialized, not written); Removable : check usage (object, not from_spec, not read); Hiding: check local_hiding (strict); check parameter_aliasing (certain); -- No long code blocks check Max_Size (if_branch, 30); check Max_Size (unnamed_loop, 20); Long_Blocks: check Max_Size (block, 25); check style (negative_condition); check style (casing_identifier, original); check style (multiple_elements); check style (compound_statement); check style (casing_keyword, lowercase); check style (no_closing_name); search style (exposed_literal, integer, 0, 1, 2, number, constant, var_init); check with_clauses (reduceable); check units (unchecked); ahven-2.1/rules/licenseheader.pat0000664000076400007640000000145711637173541017401 0ustar tkoskinetkoskine* ^-- Ahven Unit Test Library$ ^--$ ^-- Copyright \(c\) 20.+$ ^--$ ^-- Permission to use, copy, modify, and distribute this software for any$ ^-- purpose with or without fee is hereby granted, provided that the above$ ^-- copyright notice and this permission notice appear in all copies.$ ^--$ ^-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES$ ^-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF$ ^-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR$ ^-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES$ ^-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN$ ^-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF$ ^-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.$ ahven-2.1/doc/0000775000076400007640000000000011637173541013504 5ustar tkoskinetkoskineahven-2.1/doc/manual/0000775000076400007640000000000011637173541014761 5ustar tkoskinetkoskineahven-2.1/doc/manual/en/0000775000076400007640000000000011637173541015363 5ustar tkoskinetkoskineahven-2.1/doc/manual/en/Makefile0000664000076400007640000000431311637173541017024 0ustar tkoskinetkoskine# Makefile for Sphinx documentation # # You can set these variables from the command line. SPHINXOPTS = SPHINXBUILD = sphinx-build PAPER = # Internal variables. PAPEROPT_a4 = -D latex_paper_size=a4 PAPEROPT_letter = -D latex_paper_size=letter ALLSPHINXOPTS = -d build/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source .PHONY: help clean html web pickle htmlhelp latex changes linkcheck help: @echo "Please use \`make ' where is one of" @echo " html to make standalone HTML files" @echo " pickle to make pickle files (usable by e.g. sphinx-web)" @echo " htmlhelp to make HTML files and a HTML help project" @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter" @echo " changes to make an overview over all changed/added/deprecated items" @echo " linkcheck to check all external links for integrity" clean: -rm -rf build/* html: mkdir -p build/html build/doctrees $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) build/html @echo @echo "Build finished. The HTML pages are in build/html." pickle: mkdir -p build/pickle build/doctrees $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) build/pickle @echo @echo "Build finished; now you can process the pickle files or run" @echo " sphinx-web build/pickle" @echo "to start the sphinx-web server." web: pickle htmlhelp: mkdir -p build/htmlhelp build/doctrees $(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) build/htmlhelp @echo @echo "Build finished; now you can run HTML Help Workshop with the" \ ".hhp project file in build/htmlhelp." latex: mkdir -p build/latex build/doctrees $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) build/latex @echo @echo "Build finished; the LaTeX files are in build/latex." @echo "Run \`make all-pdf' or \`make all-ps' in that directory to" \ "run these through (pdf)latex." changes: mkdir -p build/changes build/doctrees $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) build/changes @echo @echo "The overview file is in build/changes." linkcheck: mkdir -p build/linkcheck build/doctrees $(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) build/linkcheck @echo @echo "Link check complete; look for any errors in the above output " \ "or in build/linkcheck/output.txt." ahven-2.1/doc/manual/en/build/0000775000076400007640000000000011637173541016462 5ustar tkoskinetkoskineahven-2.1/doc/manual/en/build/html/0000775000076400007640000000000011637173543017430 5ustar tkoskinetkoskineahven-2.1/doc/manual/en/build/html/api-ahven-slist.html0000664000076400007640000002525311637173543023331 0ustar tkoskinetkoskine Ahven.SList – Package — Ahven 2.1 documentation

Ahven.SList – Package

New in version 1.4.

Types

List

type List is new Ada.Finalization.Controlled with private;

Cursor

type Cursor is private;

Count_Type

subtype Count_Type is Natural;

Exceptions

Invalid_Cursor

Invalid_Cursor : exception;

Raised when the cursor given as a parameter is invalid. For example, calling Data (Pos) when Is_Valid (Pos) returns False causes the exception to be raised.

List_Full

List_Full : exception;

Raised when the size of the list exceeds Count_Type’Last.

Procedures and Functions

Append

procedure Append (Target : in out List; Node_Data : Element_Type);

Append an element at the end of the list.

Clear

Changed in version 1.8: Previously Clear was called Remove_All.

procedure Clear (Target : in out List);

Remove all elements from the list.

First

function First (Target : List) return Cursor;

Return a cursor to the first element of the list.

Data

function Data (Position : Cursor) return Element_Type;

Return element pointed by the cursor.

Is_Valid

function Is_Valid (Position : Cursor) return Boolean;

Tell the validity of the cursor. The cursor will become invalid when you iterate it over the last item.

Length

function Length (Target : List) return Count_Type;

Return the length of the list.

For_Each

New in version 1.8.

generic
   with procedure Action (T : in out Element_Type) is <>;
procedure For_Each (Target : List);

A generic procedure for walk through every item in the list and call Action procedure for them.

ahven-2.1/doc/manual/en/build/html/api-ahven-framework.html0000664000076400007640000013230711637173543024167 0ustar tkoskinetkoskine Ahven.Framework – Package — Ahven 2.1 documentation

Ahven.Framework – Package

Types

Test_Count_Type

type Test_Count_Type is new Natural;

Type for the test count. This effectively limits the amount tests to whatever Natural is.

Although, in practice when adding tests the limit is not checked.

Test_Duration

subtype Test_Duration is Duration range 0.0 .. Three_Hours;

Subtype for the test timeouts. Limited to 3 hours, which should be enough for unit tests. Timeout value 0.0 means infinite time.

Test

type Test is abstract new Ada.Finalization.Controlled with null record;

Test_Class_Access

type Test_Class_Access is access all Test'Class;

An access type for Test’Class.

Test_Case

type Test_Case is abstract new Test with private;

The base type for other test cases.

Object_Test_Routine_Access

type Object_Test_Routine_Access is
  access procedure (T : in out Test_Case'Class);

A pointer to a test routine which takes Test_Case’Class object as an argument.

For this kind of test routines, the framework will call Set_Up and Tear_Down routines before and after test routine execution.

Simple_Test_Routine_Access

type Simple_Test_Routine_Access is access procedure;

A pointer to a test routine which does not take arguments.

Test_Suite

type Test_Suite is new Test with private;

A collection of Tests.

You can either fill a Test_Suite object with Test_Case objects or nest multiple Test_Suite objects. You can even mix Test_Case and Test_Suite objects, if necessary.

Test_Suite_Access

type Test_Suite_Access is access all Test_Suite;

An access type for Test_Suite.

Procedures and functions

Set_Up

procedure Set_Up (T : in out Test);

Tear_Down

procedure Tear_Down (T : in out Test);

Tear_Down is called after the test procedure is executed.

Get_Name

function Get_Name (T : Test) return String is abstract;

Run

procedure Run (T         : in out Test;
               Listener  : in out Listeners.Result_Listener'Class);

Run

procedure Run (T         : in out Test;
               Listener  : in out Listeners.Result_Listener'Class;
               Timeout   :        Test_Duration)
  is abstract;

Run

procedure Run (T         : in out Test;
               Test_Name :        String;
               Listener  : in out Listeners.Result_Listener'Class);

Run the test with given name and place the test result to Result. Notice: If multiple tests have same name this might call all of them.

Run

procedure Run (T         : in out Test;
               Test_Name :        String;
               Listener  : in out Listeners.Result_Listener'Class;
               Timeout   :        Test_Duration)
  is abstract;

Run the test with given name and place the test result to Result. Notice: If multiple tests have same name this might call all of them. Timeout specifies maximum execution time for the tests.

param T:The test object to run.
param Test_Name:
 The name of the test which will be run.
param Listener:The listener which will be called during the test execution.
param Timeout:Time limit for the test.

Test_Count

function Test_Count (T : Test) return Test_Count_Type is abstract;

Return the amount of tests (test routines) which will be executed when the Run (T) procedure is called.

Test_Count

function Test_Count (T : Test; Test_Name : String)
  return Test_Count_Type is abstract;

Return the amount of tests (test routines) which will be executed when the Run (T, Test_Name) procedure is called.

Execute

procedure Execute (T        : in out Test'Class;
                   Listener : in out Listeners.Result_Listener'Class);

Call Test class’ Run method and place the test outcome to Result. The procedure calls Start_Test of every listener before calling the Run procedure and End_Test after calling the Run procedure.

Execute

procedure Execute (T        : in out Test'Class;
                   Listener : in out Listeners.Result_Listener'Class;
                   Timeout  :        Test_Duration);

Call Test class’ Run method and place the test outcome to Result. The procedure calls Start_Test of every listener before calling the Run procedure and End_Test after calling the Run procedure. Timeout specifies the maximum execution time for a test.

Execute

procedure Execute (T         : in out Test'Class;
                   Test_Name :        String;
                   Listener  : in out Listeners.Result_Listener'Class);

Same as Execute above, but call the Run procedure which takes Test_Name parameter.

Execute

procedure Execute (T         : in out Test'Class;
                   Test_Name :        String;
                   Listener  : in out Listeners.Result_Listener'Class;
                   Timeout  :        Test_Duration);

Same as Execute above, but call the Run procedure which takes Test_Name parameter. Timeout specifies the maximum execution time for a test.

Get_Name

function Get_Name (T : Test_Case) return String;

Return the name of the test case.

Run

procedure Run (T        : in out Test_Case;
               Listener : in out Listeners.Result_Listener'Class);

Run Test_Case’s test routines.

Run

procedure Run (T        : in out Test_Case;
               Listener : in out Listeners.Result_Listener'Class;
               Timeout  :        Test_Duration);

Run Test_Case’s test routines with timeout value.

Run

procedure Run (T         : in out Test_Case;
               Test_Name :        String;
               Listener  : in out Listeners.Result_Listener'Class);

Run Test_Case’s test routine which matches to the Name.

Run

procedure Run (T         : in out Test_Case;
               Test_Name :        String;
               Listener  : in out Listeners.Result_Listener'Class;
               Timeout   :        Test_Duration);

Run Test_Case’s test routine which matches to the Name, with timeout value.

Test_Count

function Test_Count (T : Test_Case) return Test_Count_Type;

Implementation of Test_Count (T : Test).

Test_Count

function Test_Count (T : Test_Case; Test_Name : String)
  return Test_Count_Type;

Implementation of Test_Count (T : Test, Test_Name : String).

Finalize

procedure Finalize (T : in out Test_Case);

Finalize procedure of the Test_Case.

Set_Name

procedure Set_Name (T : in out Test_Case; Name : String);

Set Test_Case’s name.

Add_Test_Routine

procedure Add_Test_Routine (T       : in out Test_Case'Class;
                            Routine :        Object_Test_Routine_Access;
                            Name    :        String);

Register a test routine to the Test_Case object.

Add_Test_Routine

procedure Add_Test_Routine (T       : in out Test_Case'Class;
                            Routine :        Simple_Test_Routine_Access;
                            Name    :        String);

Register a simple test routine to the Test_Case.

Create_Suite

function Create_Suite (Suite_Name : String)
  return Test_Suite_Access;

Create a new Test_Suite. Caller must free the returned Test_Suite using Release_Suite.

Create_Suite

function Create_Suite (Suite_Name : String)
  return Test_Suite;

Create a new Test_Suite. The suite and its children are released automatically.

Add_Test

procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access);

Add a Test to the suite. The suite frees the Test automatically when it is no longer needed.

Add_Test

procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access);

Add a Test suite to the suite. The suite frees the Test automatically when it is no longer needed.

Add_Static_Test

procedure Add_Static_Test
  (Suite : in out Test_Suite; T : Test'Class);

Add a Test to the suite. This procedure is meant for statically allocated Test_Case objects.

Get_Name

function Get_Name (T : Test_Suite) return String;

Return the name of Test_Suite.

Run

procedure Run (T        : in out Test_Suite;
               Listener : in out Listeners.Result_Listener'Class);

Run Test_Suite’s Test_Cases.

Run

procedure Run (T        : in out Test_Suite;
               Listener : in out Listeners.Result_Listener'Class;
               Timeout  :        Test_Duration);

Run Test_Suite’s Test_Cases with timeout value.

Run

procedure Run (T         : in out Test_Suite;
               Test_Name :        String;
               Listener  : in out Listeners.Result_Listener'Class);

Run test suite’s child which matches to the given name.

Run

procedure Run (T         : in out Test_Suite;
               Test_Name :        String;
               Listener  : in out Listeners.Result_Listener'Class;
               Timeout  :        Test_Duration);

Run test suite’s child which matches to the given name, with timeout value.

Test_Count

function Test_Count (T : Test_Suite) return Test_Count_Type;

Implementation of Test_Count (T : Test).

Test_Count

function Test_Count (T : Test_Suite; Test_Name : String)
  return Test_Count_Type;

Implementation of Test_Count (T : Test, Test_Name : String).

Adjust

procedure Adjust (T : in out Test_Suite);

Adjust procedure of Test_Suite. Handles the copying of the structure properly

Finalize

procedure Finalize (T : in out Test_Suite);

Finalize procedure of Test_Suite. Frees all added Tests.

Release_Suite

procedure Release_Suite (T : Test_Suite_Access);

Release the memory of Test_Suite. All added tests are released automatically.

ahven-2.1/doc/manual/en/build/html/api-ahven-text_runner.html0000664000076400007640000001425511637173543024550 0ustar tkoskinetkoskine Ahven.Text_Runner – Package — Ahven 2.1 documentation

Ahven.Text_Runner – Package

Procedures and Functions

Run

procedure Run (Suite : in out Framework.Test'Class);

Run the suite and print the results.

Run

procedure Run (Suite : Framework.Test_Suite_Access);

Run the suite and print the results.

Table Of Contents

Previous topic

Ahven.Temporary_Output – Package

Next topic

Ahven.XML_Runner – Package

This Page

ahven-2.1/doc/manual/en/build/html/api-ahven-results.html0000664000076400007640000006473311637173543023702 0ustar tkoskinetkoskine Ahven.Results – Package — Ahven 2.1 documentation

Ahven.Results – Package

Types

Result_Info

type Result_Info is private;

Result_Collection

type Result_Collection is limited private;

A collection of Result_Info objects. Contains also child collections.

Result_Collection_Access

type Result_Collection_Access is access Result_Collection;

Result_Info_Cursor

type Result_Info_Cursor is private;

A cursor type for Pass, Failure and Error results.

Result_Collection_Cursor

type Result_Collection_Cursor is private;

Cursor for iterating over a set of Result_Collection access objects.

Constants

Empty_Result_Info

Empty_Result_Info : constant Result_Info;

Result_Info object which holds no result. It can be used to initialize a new Result_Info object.

Procedures and Functions

Set_Test_Name

procedure Set_Test_Name (Info : in out Result_Info;
                         Name :        Bounded_String);

Set a test name for the result.

Set_Routine_Name

procedure Set_Routine_Name (Info : in out Result_Info;
                            Name :        Bounded_String);

Set a routine name for the result.

Set_Message

procedure Set_Message (Info : in out Result_Info;
                       Message : Bounded_String);

Set a message for the result.

Set_Test_Name

procedure Set_Test_Name (Info : in out Result_Info; Name : String);

A helper function, which calls Set_Test_Name (.. ; Bounded_String)

Set_Routine_Name

procedure Set_Routine_Name (Info : in out Result_Info; Name : String);

A helper function, which calls Set_Routine_Name (.. ; Bounded_String)

Set_Message

procedure Set_Message (Info : in out Result_Info; Message : String);

A helper function, which calls Set_Message (.. ; Bounded_String)

Set_Long_Message

procedure Set_Long_Message (Info    : in out Result_Info;
                            Message :        Bounded_String);

Set a long message for the result

Set_Long_Message

procedure Set_Long_Message (Info : in out Result_Info; Message : String);

A helper function, which calls Set_Long_Message (.. ; Bounded_String)

Set_Execution_Time

procedure Set_Execution_Time (Info         : in out Result_Info;
                              Elapsed_Time :        Duration);

Set the execution time of the result info (test).

Set_Output_File

procedure Set_Output_File (Info     : in out Result_Info;
                           Filename :        Bounded_String);

Set the name of the test output file.

Set_Output_File

procedure Set_Output_File (Info     : in out Result_Info;
                           Filename :        String);

Set the name of the test output file.

Get_Test_Name

function Get_Test_Name (Info : Result_Info) return String;

Return the test name of the result info.

Get_Routine_Name

function Get_Routine_Name (Info : Result_Info) return String;

Return the routine name of the result info.

Get_Message

function Get_Message (Info : Result_Info) return String;

Return the message of the result info.

Get_Long_Message

function Get_Long_Message (Info : Result_Info) return String;

Return the long message of the result info.

Get_Execution_Time

function Get_Execution_Time (Info : Result_Info) return Duration;

Return the execution time of the result info.

Get_Output_File

function Get_Output_File (Info : Result_Info) return Bounded_String;

Return the name of the output file. Empty string is returned in case there is no output file.

Add_Child

procedure Add_Child (Collection : in out Result_Collection;
                     Child      :        Result_Collection_Access);

Add a child collection to the collection.

Add_Error

procedure Add_Error (Collection : in out Result_Collection;
                     Info       :        Result_Info);

Add a test error to the collection.

Add_Skipped

procedure Add_Skipped (Collection : in out Result_Collection;
                       Info       :        Result_Info);

Add a skipped test to the collection.

Add_Failure

procedure Add_Failure (Collection : in out Result_Collection;
                       Info       :        Result_Info);

Add a test failure to the collection.

Add_Pass

procedure Add_Pass (Collection : in out Result_Collection;
                    Info       :        Result_Info);

Add a passed test to the collection

Release

procedure Release (Collection : in out Result_Collection);

Release resourced held by the collection. Frees also all children added via Add_Child.

Set_Name

procedure Set_Name (Collection : in out Result_Collection;
                    Name       :        Bounded_String);

Set a test name for the collection.

Set_Parent

procedure Set_Parent (Collection : in out Result_Collection;
                      Parent     :        Result_Collection_Access);

Set a parent collection to the collection.

Test_Count

function Test_Count (Collection : Result_Collection) return Natural;

Return the amount of tests in the collection. Tests in child collections are included.

Direct_Test_Count

function Direct_Test_Count (Collection : Result_Collection) return Natural;

Return the amount of tests in the collection. The tests in the child collections are NOT included.

Pass_Count

function Pass_Count (Collection : Result_Collection) return Natural;

Return the amount of passed tests in the collection. Tests in child collections are included.

Error_Count

function Error_Count (Collection : Result_Collection) return Natural;

Return the amount of test errors in the collection. Tests in child collections are included.

Failure_Count

function Failure_Count (Collection : Result_Collection) return Natural;

Return the amount of test errors in the collection. Tests in child collections are included.

Skipped_Count

function Skipped_Count (Collection : Result_Collection) return Natural;

Return the amount of skipped tests in the collection. Tests in child collections are included.

Get_Test_Name

function Get_Test_Name (Collection : Result_Collection)
  return Bounded_String;

Return the name of the collection’s test.

Get_Parent

function Get_Parent (Collection : Result_Collection)
  return Result_Collection_Access;

Return the parent of the collection.

Get_Execution_Time

function Get_Execution_Time (Collection : Result_Collection)
  return Duration;

Return the execution time of the whole collection.

First_Pass

function First_Pass (Collection : Result_Collection)
  return Result_Info_Cursor;

Get the first pass from the collection.

First_Failure

function First_Failure (Collection : Result_Collection)
  return Result_Info_Cursor;

Get the first failure from the collection.

First_Error

function First_Error (Collection : Result_Collection)
  return Result_Info_Cursor;

Get the first error from the collection.

Data

function Data (Position: Result_Info_Cursor) return Result_Info;

Get the data behind the cursor.

Is_Valid

function Is_Valid (Position: Result_Info_Cursor) return Boolean;

Is the cursor still valid?

First_Child

function First_Child (Collection : in Result_Collection)
  return Result_Collection_Cursor;

Get the first child of the collection.

Next

function Next (Position: Result_Collection_Cursor)
  return Result_Collection_Cursor;

Get the next child.

Is_Valid

function Is_Valid (Position: Result_Collection_Cursor) return Boolean;

Is the cursor still valid?

Data

function Data (Position: Result_Collection_Cursor)
  return Result_Collection_Access;

Get the data (Result_Collection_Access) behind the cursor.

Child_Depth

function Child_Depth (Collection : Result_Collection) return Natural;

Return the maximum depth of children. (a child of a child, etc.)

ahven-2.1/doc/manual/en/build/html/_sources/0000775000076400007640000000000011637173543021252 5ustar tkoskinetkoskineahven-2.1/doc/manual/en/build/html/_sources/api-ahven-xml_runner.txt0000664000076400007640000000137111637173541026052 0ustar tkoskinetkoskine:mod:`Ahven.XML_Runner` -- Package ================================== .. module:: Ahven.XML_Runner .. moduleauthor:: Tero Koskinen .. versionadded:: 1.2 ------------------------ Procedures and Functions ------------------------ Run ''' :: procedure Run (Suite : in out Framework.Test_Suite'Class); Run the suite and print the results. Run ''' :: procedure Run (Suite : Framework.Test_Suite_Access); Run the suite and print the results. The routine is identical to the above routine, but takes an access parameter to a test suite. Report_Results '''''''''''''' :: procedure Report_Results (Result : Results.Result_Collection; Dir : String); Report results to the given directory. ahven-2.1/doc/manual/en/build/html/_sources/api.txt0000664000076400007640000000066611637173541022572 0ustar tkoskinetkoskine--------------------------- API Documentation for Ahven --------------------------- .. toctree:: :maxdepth: 2 api-ahven.rst api-ahven-framework.rst api-ahven-listeners-basic.rst api-ahven-listeners.rst api-ahven-parameters.rst api-ahven-results.rst api-ahven-runner.rst api-ahven-slist.rst api-ahven-tap_runner.rst api-ahven-temporary_output.rst api-ahven-text_runner.rst api-ahven-xml_runner.rst ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-tap_runner.txt0000664000076400007640000000177111637173541026042 0ustar tkoskinetkoskine:mod:`Ahven.Tap_Runner` -- Package ================================== .. module:: Ahven.Tap_Runner .. moduleauthor:: Tero Koskinen ======================== Procedures and Functions ======================== Run ''' :: procedure Run (Suite : in out Framework.Test'Class); Run the suite and print the results. Add_Pass '''''''' :: procedure Add_Pass (Listener : in out Tap_Listener; Info : Context); Add_Failure ''''''''''' :: procedure Add_Failure (Listener : in out Tap_Listener; Info : Context); Add_Error ''''''''' :: procedure Add_Error (Listener : in out Tap_Listener; Info : Context); Start_Test '''''''''' :: procedure Start_Test (Listener : in out Tap_Listener; Info : Context); End_Test '''''''' :: procedure End_Test (Listener : in out Tap_Listener; Info : Context); ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-results.txt0000664000076400007640000002141211637173541025360 0ustar tkoskinetkoskine:mod:`Ahven.Results` -- Package =============================== .. module:: Ahven.Results .. moduleauthor:: Tero Koskinen ----- Types ----- Result_Info ''''''''''' :: type Result_Info is private; Result_Collection ''''''''''''''''' :: type Result_Collection is limited private; A collection of Result_Info objects. Contains also child collections. Result_Collection_Access '''''''''''''''''''''''' :: type Result_Collection_Access is access Result_Collection; Result_Info_Cursor '''''''''''''''''' :: type Result_Info_Cursor is private; A cursor type for Pass, Failure and Error results. Result_Collection_Cursor '''''''''''''''''''''''' :: type Result_Collection_Cursor is private; Cursor for iterating over a set of Result_Collection access objects. --------- Constants --------- Empty_Result_Info ''''''''''''''''' :: Empty_Result_Info : constant Result_Info; Result_Info object which holds no result. It can be used to initialize a new Result_Info object. ------------------------ Procedures and Functions ------------------------ Set_Test_Name ''''''''''''' :: procedure Set_Test_Name (Info : in out Result_Info; Name : Bounded_String); Set a test name for the result. Set_Routine_Name '''''''''''''''' :: procedure Set_Routine_Name (Info : in out Result_Info; Name : Bounded_String); Set a routine name for the result. Set_Message ''''''''''' :: procedure Set_Message (Info : in out Result_Info; Message : Bounded_String); Set a message for the result. Set_Test_Name ''''''''''''' :: procedure Set_Test_Name (Info : in out Result_Info; Name : String); A helper function, which calls Set_Test_Name (.. ; Bounded_String) Set_Routine_Name '''''''''''''''' :: procedure Set_Routine_Name (Info : in out Result_Info; Name : String); A helper function, which calls Set_Routine_Name (.. ; Bounded_String) Set_Message ''''''''''' :: procedure Set_Message (Info : in out Result_Info; Message : String); A helper function, which calls Set_Message (.. ; Bounded_String) Set_Long_Message '''''''''''''''' :: procedure Set_Long_Message (Info : in out Result_Info; Message : Bounded_String); Set a long message for the result Set_Long_Message '''''''''''''''' :: procedure Set_Long_Message (Info : in out Result_Info; Message : String); A helper function, which calls Set_Long_Message (.. ; Bounded_String) Set_Execution_Time '''''''''''''''''' :: procedure Set_Execution_Time (Info : in out Result_Info; Elapsed_Time : Duration); Set the execution time of the result info (test). Set_Output_File ''''''''''''''' :: procedure Set_Output_File (Info : in out Result_Info; Filename : Bounded_String); Set the name of the test output file. Set_Output_File ''''''''''''''' :: procedure Set_Output_File (Info : in out Result_Info; Filename : String); Set the name of the test output file. Get_Test_Name ''''''''''''' :: function Get_Test_Name (Info : Result_Info) return String; Return the test name of the result info. Get_Routine_Name '''''''''''''''' :: function Get_Routine_Name (Info : Result_Info) return String; Return the routine name of the result info. Get_Message ''''''''''' :: function Get_Message (Info : Result_Info) return String; Return the message of the result info. Get_Long_Message '''''''''''''''' :: function Get_Long_Message (Info : Result_Info) return String; Return the long message of the result info. Get_Execution_Time '''''''''''''''''' :: function Get_Execution_Time (Info : Result_Info) return Duration; Return the execution time of the result info. Get_Output_File ''''''''''''''' :: function Get_Output_File (Info : Result_Info) return Bounded_String; Return the name of the output file. Empty string is returned in case there is no output file. Add_Child ''''''''' :: procedure Add_Child (Collection : in out Result_Collection; Child : Result_Collection_Access); Add a child collection to the collection. Add_Error ''''''''' :: procedure Add_Error (Collection : in out Result_Collection; Info : Result_Info); Add a test error to the collection. Add_Skipped ''''''''''' :: procedure Add_Skipped (Collection : in out Result_Collection; Info : Result_Info); Add a skipped test to the collection. Add_Failure ''''''''''' :: procedure Add_Failure (Collection : in out Result_Collection; Info : Result_Info); Add a test failure to the collection. Add_Pass '''''''' :: procedure Add_Pass (Collection : in out Result_Collection; Info : Result_Info); Add a passed test to the collection Release ''''''' :: procedure Release (Collection : in out Result_Collection); Release resourced held by the collection. Frees also all children added via Add_Child. Set_Name '''''''' :: procedure Set_Name (Collection : in out Result_Collection; Name : Bounded_String); Set a test name for the collection. Set_Parent '''''''''' :: procedure Set_Parent (Collection : in out Result_Collection; Parent : Result_Collection_Access); Set a parent collection to the collection. Test_Count '''''''''' :: function Test_Count (Collection : Result_Collection) return Natural; Return the amount of tests in the collection. Tests in child collections are included. Direct_Test_Count ''''''''''''''''' :: function Direct_Test_Count (Collection : Result_Collection) return Natural; Return the amount of tests in the collection. The tests in the child collections are NOT included. Pass_Count '''''''''' :: function Pass_Count (Collection : Result_Collection) return Natural; Return the amount of passed tests in the collection. Tests in child collections are included. Error_Count ''''''''''' :: function Error_Count (Collection : Result_Collection) return Natural; Return the amount of test errors in the collection. Tests in child collections are included. Failure_Count ''''''''''''' :: function Failure_Count (Collection : Result_Collection) return Natural; Return the amount of test errors in the collection. Tests in child collections are included. Skipped_Count ''''''''''''' :: function Skipped_Count (Collection : Result_Collection) return Natural; Return the amount of skipped tests in the collection. Tests in child collections are included. Get_Test_Name ''''''''''''' :: function Get_Test_Name (Collection : Result_Collection) return Bounded_String; Return the name of the collection's test. Get_Parent '''''''''' :: function Get_Parent (Collection : Result_Collection) return Result_Collection_Access; Return the parent of the collection. Get_Execution_Time '''''''''''''''''' :: function Get_Execution_Time (Collection : Result_Collection) return Duration; Return the execution time of the whole collection. First_Pass '''''''''' :: function First_Pass (Collection : Result_Collection) return Result_Info_Cursor; Get the first pass from the collection. First_Failure ''''''''''''' :: function First_Failure (Collection : Result_Collection) return Result_Info_Cursor; Get the first failure from the collection. First_Error ''''''''''' :: function First_Error (Collection : Result_Collection) return Result_Info_Cursor; Get the first error from the collection. Next '''' :: function Next (Position: Result_Info_Cursor) return Result_Info_Cursor; Get the next pass/failure/error. Data '''' :: function Data (Position: Result_Info_Cursor) return Result_Info; Get the data behind the cursor. Is_Valid '''''''' :: function Is_Valid (Position: Result_Info_Cursor) return Boolean; Is the cursor still valid? First_Child ''''''''''' :: function First_Child (Collection : in Result_Collection) return Result_Collection_Cursor; Get the first child of the collection. Next '''' :: function Next (Position: Result_Collection_Cursor) return Result_Collection_Cursor; Get the next child. Is_Valid '''''''' :: function Is_Valid (Position: Result_Collection_Cursor) return Boolean; Is the cursor still valid? Data '''' :: function Data (Position: Result_Collection_Cursor) return Result_Collection_Access; Get the data (Result_Collection_Access) behind the cursor. Child_Depth ''''''''''' :: function Child_Depth (Collection : Result_Collection) return Natural; Return the maximum depth of children. (a child of a child, etc.) ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-runner.txt0000664000076400007640000000124011637173541025165 0ustar tkoskinetkoskine:mod:`Ahven.Runner` -- Package ============================== .. module:: Ahven.Runner .. moduleauthor:: Tero Koskinen ----- Types ----- Report_Proc ''''''''''' :: type Report_Proc is access procedure (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); ------------------------- Procedures and Funcstions ------------------------- Run_Suite ''''''''' :: procedure Run_Suite (Suite : in out Framework.Test'Class; Reporter : Report_Proc); Run the given test (case/suite) and pass the results and the command line argument info to the reporter procedure. ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-slist.txt0000664000076400007640000000374411637173541025025 0ustar tkoskinetkoskine:mod:`Ahven.SList` -- Package ============================= .. module:: Ahven.SList .. moduleauthor:: Tero Koskinen .. versionadded:: 1.4 ----- Types ----- List '''' :: type List is new Ada.Finalization.Controlled with private; Cursor '''''' :: type Cursor is private; Count_Type '''''''''' :: subtype Count_Type is Natural; ---------- Exceptions ---------- Invalid_Cursor '''''''''''''' :: Invalid_Cursor : exception; Raised when the cursor given as a parameter is invalid. For example, calling Data (Pos) when Is_Valid (Pos) returns False causes the exception to be raised. List_Full ''''''''' :: List_Full : exception; Raised when the size of the list exceeds Count_Type'Last. ------------------------ Procedures and Functions ------------------------ Append '''''' :: procedure Append (Target : in out List; Node_Data : Element_Type); Append an element at the end of the list. Clear ''''' .. versionchanged:: 1.8 Previously Clear was called Remove_All. :: procedure Clear (Target : in out List); Remove all elements from the list. First ''''' :: function First (Target : List) return Cursor; Return a cursor to the first element of the list. Next '''' :: function Next (Position : Cursor) return Cursor; Move the cursor to point to the next element on the list. Data '''' :: function Data (Position : Cursor) return Element_Type; Return element pointed by the cursor. Is_Valid '''''''' :: function Is_Valid (Position : Cursor) return Boolean; Tell the validity of the cursor. The cursor will become invalid when you iterate it over the last item. Length '''''' :: function Length (Target : List) return Count_Type; Return the length of the list. For_Each '''''''' .. versionadded:: 1.8 :: generic with procedure Action (T : in out Element_Type) is <>; procedure For_Each (Target : List); A generic procedure for walk through every item in the list and call Action procedure for them. ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-framework.txt0000664000076400007640000002646511637173541025671 0ustar tkoskinetkoskine:mod:`Ahven.Framework` -- Package ================================= .. ada:module:: Ahven.Framework .. moduleauthor:: Tero Koskinen .. highlight:: ada ----- Types ----- Test_Count_Type ''''''''''''''' .. .. xada:type:: type Test_Count_Type is new Natural; :: type Test_Count_Type is new Natural; Type for the test count. This effectively limits the amount tests to whatever Natural is. Although, in practice when adding tests the limit is not checked. Test_Duration ''''''''''''' :: subtype Test_Duration is Duration range 0.0 .. Three_Hours; Subtype for the test timeouts. Limited to 3 hours, which should be enough for unit tests. Timeout value 0.0 means infinite time. Test '''' :: type Test is abstract new Ada.Finalization.Controlled with null record; .. .. xada:type:: type Test is abstract new Ada.Finalization.Controlled with null record; A type, which provides the base for Test_Case and Test_Suite types. Test_Class_Access ''''''''''''''''' :: type Test_Class_Access is access all Test'Class; An access type for Test'Class. Test_Case ''''''''' :: type Test_Case is abstract new Test with private; The base type for other test cases. Object_Test_Routine_Access '''''''''''''''''''''''''' :: type Object_Test_Routine_Access is access procedure (T : in out Test_Case'Class); A pointer to a test routine which takes Test_Case'Class object as an argument. For this kind of test routines, the framework will call Set_Up and Tear_Down routines before and after test routine execution. Simple_Test_Routine_Access '''''''''''''''''''''''''' :: type Simple_Test_Routine_Access is access procedure; A pointer to a test routine which does not take arguments. Test_Suite '''''''''' :: type Test_Suite is new Test with private; A collection of Tests. You can either fill a Test_Suite object with Test_Case objects or nest multiple Test_Suite objects. You can even mix Test_Case and Test_Suite objects, if necessary. Test_Suite_Access ''''''''''''''''' :: type Test_Suite_Access is access all Test_Suite; An access type for Test_Suite. ------------------------ Procedures and functions ------------------------ Set_Up '''''' :: procedure Set_Up (T : in out Test); .. .. xada:procedure:: procedure Set_Up (T : in out Test); Set_Up is called before executing the test procedure. :param T: Test to be set up. Tear_Down ''''''''' :: procedure Tear_Down (T : in out Test); Tear_Down is called after the test procedure is executed. Get_Name '''''''' :: function Get_Name (T : Test) return String is abstract; .. .. xada:function:: function Get_Name (T : Test) return String is abstract; Return the name of the test. :param T: The test object. Run ''' :: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); .. .. xada:procedure:: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); Run the test and place the test result to Result. Infinite timeout. :param T: The test object to run. :param Listener: The listener which will be called during the test execution. Run ''' :: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; .. .. xada:procedure:: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); Run the test and place the test result to Result. :param T: The test object to run. :param Listener: The listener which will be called during the test execution. :param Timeout: Time limit for the test. Run ''' :: procedure Run (T : in out Test; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Run the test with given name and place the test result to Result. Notice: If multiple tests have same name this might call all of them. Run ''' :: procedure Run (T : in out Test; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; Run the test with given name and place the test result to Result. Notice: If multiple tests have same name this might call all of them. Timeout specifies maximum execution time for the tests. :param T: The test object to run. :param Test_Name: The name of the test which will be run. :param Listener: The listener which will be called during the test execution. :param Timeout: Time limit for the test. Test_Count '''''''''' :: function Test_Count (T : Test) return Test_Count_Type is abstract; Return the amount of tests (test routines) which will be executed when the Run (T) procedure is called. Test_Count '''''''''' :: function Test_Count (T : Test; Test_Name : String) return Test_Count_Type is abstract; Return the amount of tests (test routines) which will be executed when the Run (T, Test_Name) procedure is called. Execute ''''''' :: procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class); Call Test class' Run method and place the test outcome to Result. The procedure calls Start_Test of every listener before calling the Run procedure and End_Test after calling the Run procedure. Execute ''''''' :: procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Call Test class' Run method and place the test outcome to Result. The procedure calls Start_Test of every listener before calling the Run procedure and End_Test after calling the Run procedure. Timeout specifies the maximum execution time for a test. Execute ''''''' :: procedure Execute (T : in out Test'Class; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Same as Execute above, but call the Run procedure which takes Test_Name parameter. Execute ''''''' :: procedure Execute (T : in out Test'Class; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Same as Execute above, but call the Run procedure which takes Test_Name parameter. Timeout specifies the maximum execution time for a test. Get_Name '''''''' :: function Get_Name (T : Test_Case) return String; Return the name of the test case. Run ''' :: procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class); Run Test_Case's test routines. Run ''' :: procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run Test_Case's test routines with timeout value. Run ''' :: procedure Run (T : in out Test_Case; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Run Test_Case's test routine which matches to the Name. Run ''' :: procedure Run (T : in out Test_Case; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run Test_Case's test routine which matches to the Name, with timeout value. Test_Count '''''''''' :: function Test_Count (T : Test_Case) return Test_Count_Type; Implementation of Test_Count (T : Test). Test_Count '''''''''' :: function Test_Count (T : Test_Case; Test_Name : String) return Test_Count_Type; Implementation of Test_Count (T : Test, Test_Name : String). Finalize '''''''' :: procedure Finalize (T : in out Test_Case); Finalize procedure of the Test_Case. Set_Name '''''''' :: procedure Set_Name (T : in out Test_Case; Name : String); Set Test_Case's name. Add_Test_Routine '''''''''''''''' :: procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Object_Test_Routine_Access; Name : String); Register a test routine to the Test_Case object. Add_Test_Routine '''''''''''''''' :: procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Simple_Test_Routine_Access; Name : String); Register a simple test routine to the Test_Case. Create_Suite '''''''''''' :: function Create_Suite (Suite_Name : String) return Test_Suite_Access; Create a new Test_Suite. Caller must free the returned Test_Suite using Release_Suite. Create_Suite '''''''''''' :: function Create_Suite (Suite_Name : String) return Test_Suite; Create a new Test_Suite. The suite and its children are released automatically. Add_Test '''''''' :: procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access); Add a Test to the suite. The suite frees the Test automatically when it is no longer needed. Add_Test '''''''' :: procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access); Add a Test suite to the suite. The suite frees the Test automatically when it is no longer needed. Add_Static_Test ''''''''''''''' :: procedure Add_Static_Test (Suite : in out Test_Suite; T : Test'Class); Add a Test to the suite. This procedure is meant for statically allocated Test_Case objects. Get_Name '''''''' :: function Get_Name (T : Test_Suite) return String; Return the name of Test_Suite. Run ''' :: procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class); Run Test_Suite's Test_Cases. Run ''' :: procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run Test_Suite's Test_Cases with timeout value. Run ''' :: procedure Run (T : in out Test_Suite; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Run test suite's child which matches to the given name. Run ''' :: procedure Run (T : in out Test_Suite; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run test suite's child which matches to the given name, with timeout value. Test_Count '''''''''' :: function Test_Count (T : Test_Suite) return Test_Count_Type; Implementation of Test_Count (T : Test). Test_Count '''''''''' :: function Test_Count (T : Test_Suite; Test_Name : String) return Test_Count_Type; Implementation of Test_Count (T : Test, Test_Name : String). Adjust '''''' :: procedure Adjust (T : in out Test_Suite); Adjust procedure of Test_Suite. Handles the copying of the structure properly Finalize '''''''' :: procedure Finalize (T : in out Test_Suite); Finalize procedure of Test_Suite. Frees all added Tests. Release_Suite ''''''''''''' :: procedure Release_Suite (T : Test_Suite_Access); Release the memory of Test_Suite. All added tests are released automatically. ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-parameters.txt0000664000076400007640000000337411637173541026031 0ustar tkoskinetkoskine:mod:`Ahven.Parameters` -- Package ================================== .. module:: Ahven.Parameters .. moduleauthor:: Tero Koskinen ----- Types ----- Parameter_Info '''''''''''''' :: type Parameter_Info is private; Parameter_Mode '''''''''''''' :: type Parameter_Mode is (NORMAL_PARAMETERS, TAP_PARAMETERS); ------------------------ Procedures and Functions ------------------------ procedure Parse_Parameters (Mode : Parameter_Mode; Info : out Parameter_Info); Parse Ada.Command_Line parameters and put the results to the Info parameter. Raises Invalid_Parameter if some parameter is invalid. Parse_Parameters '''''''''''''''' :: procedure Parse_Parameters (Mode : Parameter_Mode; Info : out Parameter_Info); Parse Ada.Command_Line parameters and put the results to the Info parameter. Raises Invalid_Parameter if some parameter is invalid. Usage ''''' :: procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS); Print usage. Capture ''''''' :: function Capture (Info : Parameter_Info) return Boolean; Capture Ada.Text_IO output? Verbose ''''''' :: function Verbose (Info : Parameter_Info) return Boolean; Use verbose mode? XML_Results ''''''''''' :: function XML_Results (Info : Parameter_Info) return Boolean; Output XML? Single_Test ''''''''''' :: function Single_Test (Info : Parameter_Info) return Boolean; Run a single test (case/suite/routine) only? Test_Name ''''''''' :: function Test_Name (Info : Parameter_Info) return String; Return the name of the test passed as a parameter. Result_Dir '''''''''' :: function Result_Dir (Info : Parameter_Info) return String; Return the directory for XML results. ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-temporary_output.txt0000664000076400007640000000232111637173541027317 0ustar tkoskinetkoskine:mod:`Ahven.Temporary_Output` -- Package ======================================== .. module:: Ahven.Temporary_Output .. moduleauthor:: Tero Koskinen ----- Types ----- Temporary_File '''''''''''''' :: type Temporary_File is limited private; ------------------------ Procedures and Functions ------------------------ Create_Temp ''''''''''' :: procedure Create_Temp (File : out Temporary_File); Create a new temporary file. Exception Temporary_File_Error is raised if the procedure cannot create a new temp file. Get_Name '''''''' :: function Get_Name (File : Temporary_File) return String; Return the name of the file. Redirect_Output ''''''''''''''' :: procedure Redirect_Output (To_File : in out Temporary_File); Redirect the standard output to the file. To_File must be opened using Create_Temp. Restore_Output '''''''''''''' :: procedure Restore_Output; Restore the standard output to its default settings. Remove_Temp ''''''''''' :: procedure Remove_Temp (File : in out Temporary_File); Remove the temporary file. File can be either open or closed. Close_Temp '''''''''' :: procedure Close_Temp (File : in out Temporary_File); Close the temporary file. ahven-2.1/doc/manual/en/build/html/_sources/design.txt0000664000076400007640000000242511637173541023265 0ustar tkoskinetkoskine============ Design Notes ============ This section tells reasons behind various design choices of Ahven. Since Ahven is meant to be buildable with multiple different Ada compilers on multiple different operating systems, we have made certain amount of compromises. Timeout Feature =============== Starting from version 2.0, tests can be interrupted after a given time. This feature is implemented using tasks. Ahven spawns a new local task for each test routine (procedure), and kills it with "abort" statement of Ada. The task and the test routine is aborted if the runtime system of the used compiler can abort the task. The test routine should include at least one "abort completion point" to make the abortion successful. However, some environments allow the task abortion even without abort completion points in some cases. FSF GCC on OpenBSD with user space threads is one such environment. Bounded Strings =============== All strings in Ahven are either type of String or type of Ahven.AStrings.Bounded_String, which is an instantiation of Ada.Strings.Bounded.Generic_Bounded_Length with maximum length of 160. The limitation is there because some versions of Janus/Ada have a buggy Unbounded_String implementation and use of Unbounded_String causes memory leaks and random crashes. ahven-2.1/doc/manual/en/build/html/_sources/index.txt0000664000076400007640000000034111637173541023116 0ustar tkoskinetkoskine Welcome to Ahven's documentation! ================================= Contents: .. toctree:: :maxdepth: 2 manual.rst api.rst design.rst Indices and tables ================== * :ref:`genindex` * :ref:`search` ahven-2.1/doc/manual/en/build/html/_sources/manual.txt0000664000076400007640000002653511637173541023301 0ustar tkoskinetkoskine ================== Ahven User's Guide ================== Tero Koskinen Overview ######## Introduction ============ Ahven is a unit test library. It is modeled after JUnit framework for Java, but some ideas are also taken from another Ada unit test library, AUnit. The purpose of Ahven is to be a small and portable unit test library, which works with multiple different Ada 95 compilers. Ahven has no external dependencies and therefore it is easy to build on various platforms. Ahven tries to be compatible with utilities related to unit testing. For example, it uses same XML format for test results as Java tools. This allows easy integration to CruiseControl, Ant, and other similar programs. License ======= Ahven is distributed under permissive ISC license (shown below). :: -- -- Copyright (c) 2008, 2009, 2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- You are allowed to embed Ahven into a proprietary commercial application. Only requirement is to keep the copyright notice and the permission notice in the source code files. You do not need to distribute Ahven's source code if you distribute Ahven or some parts of Ahven in the binary form. Building and Installing Ahven ############################# To build and install Ahven source code, you need an Ada 95 compiler. At the moment, Ahven is tested with four different compiler families: GNAT, ObjectAda, Irvine ICCAda, and Janus/Ada. GNAT GPL series and FSF GCC =========================== When you have GNAT GPL or FSF GCC, the easieast way to compile and install Ahven is to use the *make* utility and Makefile. When compiling using the *make* utility, you need to tell your platform type. Currently, only supported platform types are *unix* and *windows*. The type can be told by setting OS_VERSION variable to the selected platform. :: $ make OS_VERSION=unix If you are unable to use *make*, you can use the GNAT project files directly. Ahven distribution comes with three GNAT project files: ahven.gpr, ahven_lib.gpr, and ahven_tests.gpr. The *ahven.gpr* file is meant to be used when compiling unit tests. The library itself is build using the *ahven_lib.gpr* file. To build the testsuite of the Ahven, one needs to use the *ahven_tests.gpr* file. Like with Makefile, you need to tell your platform type. This time the selection happens by using an environment variable called *OS*. The variable accepts same values as Makefile. :: $ OS=windows gnatmake -P ahven_lib $ OS=windows gnatmake -P ahven_tests Installing Library ------------------ You can install the library by using command *make install*. By default the installation happens to the */usr/local* directory. Alternative directory can be set by overwriting the *PREFIX* variable. :: $ make OS_VERSION=unix PREFIX=/opt/ada install GNAT 3.15p ========== Version 3.15p of GNAT does not understand some features used in the default GNAT project files. Therefore, you need to use project files from the *contrib/gnat315p* directory. ObjectAda ========= There is no project file included for ObjectAda. To compile Ahven, you need to create a new project and import the source code of Ahven to the project. Irvine ICCAda ============= Easiest way to build Ahven with ICCAda is to use *icm* utility:: C:\ahven-2.1>cd src C:\ahven-2.1\src>icm new C:\ahven-2.1\src>icm scan *.ad? windows\*.ad? C:\ahven-2.1\src>icm make libmain C:\ahven-2.1\src>cd ..\test C:\ahven-2.1\test>icm new -search=..\src C:\ahven-2.1\test>icm scan *.ad? C:\ahven-2.1\test>icm make tester Janus/Ada ========= Directory *janusada* contains project file creation scripts for Janus/Ada. By default, the scripts assume Janus/Ada to be installed to directory *C:\\Janus312\\*. If that is not the case, change the path from file *prepare.bat*. :: C:\ahven-2.1>janusada\prepare.bat Before compiling the library, you need to run the preparation script *janusada\\prepare.bat*. Then, scan the sources and create compilation script by running *janusada\\update.bat*. :: C:\ahven-2.1>janusada\update.bat Now you are ready to compile the project. This happens by running *compile.bat* script. :: C:\ahven-2.1>janusada\compile.bat After a while, you should have compiled library files in the *lib_obj* directory and an executable called *tap_test.exe* in the *test_obj* directory. The executable is Ahven's test suite and if it reports no errors, everything is working as expected. At the time of writing (Ahven 2.1), every test should pass with the latest version of Janus/Ada. However, with earlier versions of Janus/Ada some tests will fail. The failing tests are worked around in Ahven's source code, but the test exists so that one can verify when the Janus/Ada bug causing the failure is fixed. Using Ahven ########### The heart of Ahven is an abstract type called ``Test``. It presents an entity which can be run by *a test runner*. Types ``Test_Case`` and ``Test_Suite`` are derived from the ``Test`` type. The ``Test_Case`` type is the base type for unit tests and the ``Test_Suite`` type is a container, which can hold other ``Test`` objects. Writing a Test Case =================== To create a new test case you need to create a new package and a new type, which is derived from ``Ahven.Framework.Test_Case``. There are no required functions or procedures to be implemented, but to make the test case do something you need to override the ``Initialize`` procedure and create at least one procedure which tests something:: -- my_tests.ads with Ahven.Framework; package My_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Addition; end My_Tests; To add tests to the test case you need to call procedure ``Ahven.Framework.Add_Test_Routine`` during the test case initialization (in other words, in the ``Initialize`` procedure). :ref:`testcase_a_body` shows how the ``Test_Addition`` is added to the test case. It also shows how to set a name for the test case with the ``Set_Name`` procedure. .. _testcase_a_body: A test case package body ------------------------ :: -- my_tests.adb package body My_Tests is procedure Initialize (T : in out Test) is begin Set_Name (T, "My tests"); Ahven.Framework.Add_Test_Routine (T, Test_Addition'Access, "Addition"); end Initialize; procedure Test_Addition is begin null; end Test_Addition; end My_Tests; Calling Assertion Procedures ============================ To test whether a condition is true or false, Ahven offers you three procedures. The first procedure is :ref:`Ahven.Assert `. It takes a boolean value and a message string as its parameters. If the boolean value is false the ``Assert`` raises an ``Assertion_Error`` exception with the given string. The exception is catched by the framework. and when the test results are shown the error is also shown with the given message. Another assertion procedure is a generic :ref:`Ahven.Assert_Equal ` procedure. It is meant for comparing two objects of same type. If the objects are not equal the ``Assertion_Error`` exception with the given message string is raised. The third assertion procedure is simple :ref:`Ahven.Fail ` which always raises the ``Assertion_Error`` exception. It is handy for situations where the execution should not reach a certain place (see :ref:`fail_example`). .. _fail_example: Fail in action -------------- :: package body My_Tests is ... procedure Test_My_Proc is begin begin My_Proc (-1); -- should raise Custom_Error Fail ("Custom_Error expected"); exception when Custom_Error => null; -- expected -- Note: the exception block should not -- catch Assertion_Error. Otherwise -- the assertion failure will not be noticed. end; end Test_My_Proc; end My_Tests; Composing Test Hierarchies With Test Suites =========================================== The ``Test_Suite`` type is used to group related tests together. You can also add other test suites to the suite and create a hierarchy of tests. The tests are added to the test suite using either procedure ``Add_Static_Test`` or ``Add_Test``. The former procedure is meant for statically created tests and it places a copy of the given test to the test suite. The ``Add_Test`` procedure is used with dynamically created tests and test objects of type Test_Class_Access. At the moment, the dynamically added tests are executed first in the order they have been added (first in, first out - FIFO) and after them the statically added tests, also in FIFO order. :ref:`suite_example` shows how to put test cases in a test suite. .. _suite_example: Suite Example ------------- :: package body My_Tests is ... function Get_Test_Suite return Ahven.Framework.Test_Suite is S : Framework.Test_Suite := Framework.Create_Suite ("All"); Hello_World_Test : Hello_World.Test; Listener_Test : Basic_Listener_Tests.Test; begin Framework.Add_Static_Test (S, Hello_World_Test); Framework.Add_Static_Test (S, Listener_Test); return S; end Get_Test_Suite; end My_Tests; Running Tests ============= The tests are run by test runners. These runners are procedures which take either test cases or test suites as their parameters. Currently, there exists three test runners. Ahven.Runner is the basic runner, which prints the test results as a hierarchy. Ahven.XML_Runner on the other hand writes the test results to an XML file, which is understood by continuous integration systems like CruiseControl and Hudson. The third runner is Ahven.Tap_Runner. It produces the results in Test-Anything-Protocol (TAP) format. The recommended way to use these test runners is to call them from the main program: :: with Ahven.Text_Runner; with Ahven.Framework; with Simple_Tests; procedure Tester is S : Ahven.Framework.Test_Suite := Ahven.Framework.Create_Suite ("All"); begin Ahven.Framework.Add_Test (S, new Simple_Tests.Test); Ahven.Text_Runner.Run (S); end Tester; Parameters ---------- Ahven.Text_Runner recognizes following parameters: .. program:: tester .. cmdoption:: -d directory for test results .. cmdoption:: -x output in XML format .. cmdoption:: -c capture and report test outputs .. cmdoption:: -t specify timeout value for tests .. cmdoption:: -q quiet results .. cmdoption:: -v verbose results (default) ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-listeners.txt0000664000076400007640000000435211637173541025673 0ustar tkoskinetkoskine:mod:`Ahven.Listeners` -- Package ================================= .. module:: Ahven.Listeners .. moduleauthor:: Tero Koskinen ----- Types ----- Test_Phase '''''''''' :: type Test_Phase is (TEST_BEGIN, TEST_RUN, TEST_END); What is test doing right now? Test_Type ''''''''' :: type Test_Type is (CONTAINER, ROUTINE); Context ''''''' :: type Context (Phase : Test_Phase) is record Test_Name : AStrings.Bounded_String; Test_Kind : Test_Type; case Phase is when TEST_BEGIN | TEST_END => null; when TEST_RUN => Routine_Name : AStrings.Bounded_String; Message : AStrings.Bounded_String; Long_Message : AStrings.Bounded_String; end case; end record; Result_Listener ''''''''''''''' :: type Result_Listener is abstract new Ada.Finalization.Limited_Controlled with null record; Result_Listener is a listener for test results. Whenever a test is run, the framework calls registered listeners and tells them the result of the test. Result_Listener_Class_Access '''''''''''''''''''''''''''' :: type Result_Listener_Class_Access is access all Result_Listener'Class; ------------------------ Procedures and Functions ------------------------ Add_Pass '''''''' :: procedure Add_Pass (Listener : in out Result_Listener; Info : Context) is abstract; Called after test passes. Add_Failure ''''''''''' :: procedure Add_Failure (Listener : in out Result_Listener; Info : Context) is abstract; Called after test fails. Add_Error ''''''''' :: procedure Add_Error (Listener : in out Result_Listener; Info : Context) is abstract; Called after there is an error in the test. Start_Test '''''''''' :: procedure Start_Test (Listener : in out Result_Listener; Info : Context) is abstract; Called before the test begins. This is called before Add_* procedures. End_Test '''''''' :: procedure End_Test (Listener : in out Result_Listener; Info : Context) is abstract; Called after the test ends. Add_* procedures are called before this. ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-listeners-basic.txt0000664000076400007640000000413111637173541026745 0ustar tkoskinetkoskine:mod:`Ahven.Listeners.Basic` -- Package ======================================= .. module:: Ahven.Listeners.Basic .. moduleauthor:: Tero Koskinen ----- Types ----- Result_Type ''''''''''' :: type Result_Type is (NO_RESULT, PASS_RESULT, FAILURE_RESULT, ERROR_RESULT); Basic_Listener '''''''''''''' :: type Basic_Listener is new Result_Listener with record Main_Result : aliased Result_Collection; Current_Result : Result_Collection_Access; Last_Test_Result : Result_Type := NO_RESULT; Last_Info : Result_Info := Empty_Result_Info; Capture_Output : Boolean := False; Output_File : Temporary_Output.Temporary_File; Start_Time : Ada.Calendar.Time; end record; ------------------------ Procedures and Functions ------------------------ Add_Pass '''''''' :: procedure Add_Pass (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Add_Pass Add_Failure ''''''''''' :: procedure Add_Failure (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Add_Failure Add_Error ''''''''' :: procedure Add_Error (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Add_Error Start_Test '''''''''' :: procedure Start_Test (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Start_Test End_Test '''''''' :: procedure End_Test (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.End_Test Set_Output_Capture '''''''''''''''''' :: procedure Set_Output_Capture (Listener : in out Basic_Listener; Capture : Boolean); Enable or disable Ada.Text_IO output capturing Get_Output_Capture '''''''''''''''''' :: function Get_Output_Capture (Listener : Basic_Listener) return Boolean; Capture the Ada.Text_IO output? ahven-2.1/doc/manual/en/build/html/_sources/api-ahven.txt0000664000076400007640000000265611637173541023672 0ustar tkoskinetkoskine:mod:`Ahven` -- Package ======================= .. module:: Ahven .. moduleauthor:: Tero Koskinen ---------- Exceptions ---------- .. _assertion-error: ahven-assertion_error **Assertion_Error** Exception, raised when Assert fails. ------------------------ Procedures and Functions ------------------------ .. _ahven-assert: Assert '''''' :: procedure Assert (Condition : Boolean; Message : String); If Condition is false, Assert raises Assertion_Error with given Message. .. _ahven-assert_equal: Assert_Equal '''''''''''' .. versionadded:: 1.4 :: generic type Data_Type is private; with function Image (Item : Data_Type) return String is <>; procedure Assert_Equal (Actual : Data_Type; Expected : Data_Type; Message : String); If Expected /= Actual, Assert raises Assertion_Error with given Message. Example:: declare procedure Assert_Eq_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); begin Assert_Eq_Nat (Actual => Test_Count, Expected => 4, "test count"); end; .. _ahven-fail: Fail '''' :: procedure Fail (Message : String); Fail always raises Assertion_Error with given Message. .. _ahven-skip: Skip '''' .. versionadded:: 2.0 :: procedure Skip (Message : String); Skip always raises Test_Skipped_Error with given Message. ahven-2.1/doc/manual/en/build/html/_sources/api-ahven-text_runner.txt0000664000076400007640000000070511637173541026236 0ustar tkoskinetkoskine:mod:`Ahven.Text_Runner` -- Package =================================== .. module:: Ahven.Text_Runner .. moduleauthor:: Tero Koskinen ------------------------ Procedures and Functions ------------------------ Run ''' :: procedure Run (Suite : in out Framework.Test'Class); Run the suite and print the results. Run ''' :: procedure Run (Suite : Framework.Test_Suite_Access); Run the suite and print the results. ahven-2.1/doc/manual/en/build/html/api-ahven-xml_runner.html0000664000076400007640000001506711637173543024366 0ustar tkoskinetkoskine Ahven.XML_Runner – Package — Ahven 2.1 documentation

Ahven.XML_Runner – Package

New in version 1.2.

Procedures and Functions

Run

procedure Run (Suite : in out Framework.Test_Suite'Class);

Run the suite and print the results.

Run

procedure Run (Suite : Framework.Test_Suite_Access);

Run the suite and print the results. The routine is identical to the above routine, but takes an access parameter to a test suite.

Report_Results

procedure Report_Results (Result : Results.Result_Collection;
                          Dir    : String);

Report results to the given directory.

Table Of Contents

Previous topic

Ahven.Text_Runner – Package

Next topic

Design Notes

This Page

ahven-2.1/doc/manual/en/build/html/searchindex.js0000664000076400007640000002451511637173543022272 0ustar tkoskinetkoskineSearch.setIndex({objects:{"":{"-d":[5,0,1],"-c":[5,0,1],Ahven:[8,1,1],"-t":[5,0,1],"-v":[5,0,1],"-q":[5,0,1],"-x":[5,0,1]},"Ahven.Listeners":{Basic:[6,1,1]},Ahven:{SList:[1,1,1],Parameters:[9,1,1],Runner:[14,1,1],Listeners:[7,1,1],Results:[3,1,1],Tap_Runner:[12,1,1],Text_Runner:[0,1,1],Temporary_Output:[4,1,1],XML_Runner:[15,1,1]}},terms:{all:[1,3,5,7,11,13],code:5,whatev:13,skip:[8,3],four:5,test_count:[8,3,13],follow:5,children:[3,13],privat:[1,3,4,5,8,9,13],herebi:5,depend:5,error_result:6,report_proc:14,program:5,under:5,aris:5,neglig:5,junit:5,list_ful:1,tap_paramet:9,liter:[0,1,3,4,6,7,8,9,14,12,13,15],everi:[13,5,1],string:[2,3,4,5,8,9,11,13,15],fals:[8,5,6,1],util:5,funcstion:[10,14],element_typ:1,failur:[3,5],pass_count:3,tri:5,set_messag:3,long_messag:7,add_static_test:[13,5],list:1,prefix:5,iter:[3,1],item:[8,1],adjust:13,small:5,dir:15,impli:5,add_:7,natur:[8,3,1,13],janusada:5,direct:5,add_child:3,design:[2,11],pass:[3,9,5,7,14],easieast:5,append:1,first_failur:3,index:2,what:7,appear:5,compar:5,section:11,three_hour:13,access:[3,5,7,14,13,15],get_output_captur:6,"new":[1,3,4,5,6,7,8,11,13],normal_paramet:9,method:13,told:5,xml:[9,5],deriv:5,gener:[8,5,1],error:[3,5,7],first_child:3,disclaim:5,path:5,becom:1,modifi:5,sinc:11,valu:[13,5],search:[2,5],ahven_test:5,amount:[3,11,13],action:[5,1],implement:[5,11,6,13],get_messag:3,portabl:5,overrid:5,via:3,sourc:5,data_typ:8,heart:5,put:[9,5],unix:5,"boolean":[1,3,5,6,8,9],famili:5,instal:[2,5],should:[5,11,13],unit:[13,5],test_nam:[13,9,7],fee:5,from:[3,11,1,5],memori:[13,11],hudson:5,regist:[13,7],two:5,dure:[13,5],next:[3,1],call:[3,5,7,1,13],usr:5,recommend:5,taken:5,astr:[11,7],type:[1,3,4,5,6,7,8,9,10,11,13,14],tell:[5,11,7,1],result_info:[3,6],test_begin:7,get_nam:[13,4],tester:5,relat:5,notic:[13,5],result_listen:[13,6,7],exce:1,command_lin:9,accept:5,hold:[3,5],easiest:5,must:[13,4],irvin:5,word:5,hour:13,restor:4,prepar:5,work:5,add_failur:[3,12,6,7],can:[3,13,4,11,5],aunit:5,purpos:5,xml_runner:[2,15,10,5],control:[13,1],hello_world_test:5,tap:5,scan:5,indic:2,add_skip:3,abort:11,proprietari:5,suite_nam:13,alwai:[8,5],gcc:[5,11],end:[8,7,5,6,1],anoth:5,result_collection_access:[3,6],write:5,how:5,verifi:5,simpl:[13,5],test_typ:7,updat:5,current_result:6,recogn:5,count_typ:1,earlier:5,"long":3,befor:[13,5,7],pass_result:6,compat:5,add_pass:[3,12,6,7],multipl:[5,11,13],data:[3,5,1],alloc:13,practic:13,third:5,iccada:5,element:1,caus:[5,11,1],alias:6,environ:[5,11],allow:[5,11],subtyp:[13,1],end_test:[13,12,6,7],order:5,simple_test_routine_access:13,no_result:6,move:1,becaus:11,fifo:5,held:3,failure_result:6,hierarchi:5,still:3,pointer:13,dynam:5,paramet:[2,1,5,9,10,14,13,15],group:5,fit:5,start_test:[13,12,6,7],node_data:1,platform:5,window:5,first_pass:3,main:5,might:13,them:[13,5,7,1],"return":[1,3,4,5,6,8,9,13],thei:5,handl:13,handi:5,initi:[3,5],framework:[0,2,5,7,10,14,12,13,15],set_up:13,add_test:[13,5],get_par:3,introduct:5,tero:5,choic:11,name:[3,9,4,5,13],anyth:5,capture_output:6,mode:9,timeout:[2,13,11,5],each:11,mean:13,compil:[5,11],slist:[2,10,1],idea:5,procedur:[0,1,3,4,5,6,7,8,9,10,11,12,13,14,15],"static":[13,5],expect:[8,5],resourc:3,happen:5,get_routine_nam:3,event:5,special:5,out:[0,1,3,4,5,6,7,9,14,12,13,15],variabl:5,shown:5,space:11,profit:5,content:2,test_dur:13,print:[0,9,5,15,12],set_test_nam:3,model:5,after:[5,11,7,13],situat:5,given:[1,5,14,8,11,13,15],free:[3,13],standard:4,parameter_mod:9,reason:11,base:[13,5],releas:[3,13],output_fil:6,perform:5,thread:11,keep:5,get_test_suit:5,length:[11,1],place:[13,5],unabl:5,isc:5,test_end:7,first:[3,5,1],oper:11,softwar:5,my_proc:5,directli:5,first_error:3,set_output_fil:3,messag:[8,3,5,7],last_info:6,open:4,size:1,gpl:5,differ:[5,11],janus312:5,script:5,licens:5,system:[5,11],least:[5,11],statement:11,"final":[13,7,1],gpr:5,listen:[2,6,7,10,12,13],grant:5,tool:5,copi:[13,5],specifi:[13,5],create_suit:[13,5],part:5,pars:9,tap_listen:12,kind:13,target:1,whenev:7,provid:5,remov:[4,1],structur:13,project:5,posit:[3,1],start_tim:6,result:[0,2,3,5,7,9,10,14,12,13,15],pre:[0,1,3,4,6,7,8,9,14,12,13,15],failure_count:3,runner:[2,10,5,14],temporary_output:[10,2,4,6],argument:[13,14],ant:5,packag:[0,1,2,3,4,5,6,7,8,9,10,14,12,13,15],invalid_cursor:1,have:[5,11,13],child_depth:3,need:[13,5],"null":[13,5,7],automat:13,release_suit:13,note:[2,11,5],also:[3,5],exampl:[8,5,1],take:[13,15,5],which:[3,13,11,5],elapsed_tim:3,singl:9,even:[13,11],begin:[8,5,7],distribut:5,shall:5,object:[3,5,13],reach:5,single_test:9,test_class_access:[13,5],phase:7,"class":[0,1,3,4,6,7,8,9,14,12,13,15],clear:1,doe:[13,5],declar:8,runtim:11,basic_listener_test:5,show:5,random:11,assertion_error:[8,5],permiss:5,tap_test:5,result_info_cursor:3,redirect:4,current:5,test_run:7,copyright:5,test_skipped_error:8,enough:13,get_long_messag:3,version:[5,11],to_fil:4,hello_world:5,local:[5,11],over:[3,1],meant:[5,11,13],count:[8,13],variou:[5,11],get:3,listener_test:5,ahven:[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15],cannot:4,report:[14,15,5],liabl:5,text_runn:[0,10,5,2],requir:5,bat:5,object_test_routine_access:13,enabl:6,emb:5,get_output_fil:3,cruisecontrol:5,result_collect:[3,15,14,6],integr:5,contain:[3,5,7],through:1,result_typ:6,where:5,valid:[3,1],user:[2,11,5],set:[3,4,5,13],tap_runn:[2,10,5,12],see:5,error_count:3,arg:14,fail:[8,5,7],close:4,calendar:6,whatsoev:5,infinit:13,last_test_result:6,someth:5,behind:[3,11],"import":5,entiti:5,objectada:5,altern:5,run_suit:14,parent:3,temporary_file_error:4,set_routine_nam:3,iki:5,come:5,addit:5,bodi:5,last:1,temporary_fil:[4,6],howev:[5,11],equal:5,contract:5,etc:3,my_test:5,context:[12,6,7],seri:5,whole:3,fix:5,compromis:11,direct_test_count:3,set_par:3,instanti:11,overview:[2,5],walk:1,restore_output:4,constant:[3,10],guid:[2,5],assum:5,damag:5,java:5,empty_result_info:[3,6],three:5,empti:3,basic:[2,10,5,6],gnatmak:5,imag:8,consequenti:5,ani:5,assert:[8,5],understand:5,togeth:5,child:[3,13],"catch":5,rang:13,former:5,present:5,add_error:[3,12,6,7],"case":[3,5,7,9,14,13,11],ident:15,remove_temp:4,gnat315p:5,commerci:5,test_cas:[13,5],durat:[3,13],cursor:[3,1],"while":5,outcom:13,abov:[13,15,5],buildabl:11,ahven_lib:5,spawn:11,helper:3,readi:5,tabl:2,therefor:5,quiet:5,itself:5,crash:11,disabl:6,welcom:2,author:5,test_count_typ:13,make:[5,11],same:[13,5],binari:5,document:[2,10],complet:11,nest:13,effect:13,hand:5,moment:5,rais:[8,9,4,5,1],temporari:4,tortiou:5,extern:5,remove_al:1,chang:5,task:11,without:[5,11],command:[14,5],thi:[5,11,7,13],everyth:5,latest:5,protocol:5,unbounded_str:11,execut:[3,5,13],"true":5,test_phas:7,interrupt:11,kill:11,get_test_nam:3,previous:1,now:[5,7],easi:5,mix:13,koskinen:5,point:[11,1],makefil:5,except:[8,4,5,1,10],param:13,add:[3,5,13],is_valid:[3,1],adb:5,parse_paramet:9,ada:[1,5,6,7,9,11,13],match:13,build:[2,5],opt:5,applic:5,around:5,format:5,simple_test:5,routine_nam:7,loss:5,xml_result:9,like:5,success:11,filenam:3,docutil:[0,1,3,4,6,7,8,9,14,12,13,15],collect:[3,13],api:[2,10],necessari:13,either:[5,4,11,13],output:[3,9,4,5,6],set_long_messag:3,page:2,right:7,captur:[9,5,6],merchant:5,creation:5,some:[5,9,11],understood:5,indirect:5,os_vers:5,librari:5,assert_equ:[8,5],icm:5,set_execution_tim:3,leak:11,for_each:1,select:5,condit:[8,5],onli:[9,5],skipped_count:3,set_nam:[3,5,13],run:[0,5,7,9,14,12,13,15],usag:9,test_addit:5,tear_down:13,although:13,test_result:14,bounded_str:[3,11,7],src:5,actual:8,testsuit:5,parameter_info:[9,14],invalid_paramet:9,produc:5,block:5,routin:[3,7,9,11,13,15],bound:[2,11],main_result:6,compos:5,warranti:5,been:5,contrib:5,your:5,redirect_output:4,span:[0,1,3,4,6,7,8,9,14,12,13,15],wai:5,set_output_captur:6,janu:[5,11],support:5,overwrit:5,verbos:[9,5],start:11,test_suite_access:[0,15,13],result_listener_class_access:7,includ:[3,11,5],suit:[0,5,9,14,12,13,15],result_dir:9,test_suit:[13,15,5],report_result:15,"function":[0,1,3,4,5,6,7,8,9,10,12,13,15],properli:13,form:5,offer:5,regard:5,continu:5,line:14,buggi:11,test_my_proc:5,bug:5,info:[3,6,7,9,14,12],made:11,temp:4,whether:5,caller:13,maximum:[3,11,13],lib_obj:5,record:[13,5,6,7],below:5,limit:[3,4,11,13],otherwis:5,similar:5,libmain:5,connect:5,basic_listen:6,featur:[2,11,5],openbsd:11,creat:[13,4,5],certain:[5,11],"abstract":[13,5,7],exist:5,get_execution_tim:3,file:[3,4,5],test_obj:5,check:13,fill:13,when:[8,13,5,7,1],invalid:[9,1],"default":[4,5],generic_bounded_length:11,other:[13,5],limited_control:7,test:[0,3,5,7,8,9,11,12,13,14,15],you:[13,5,1],"15p":5,test_kind:7,assert_eq_nat:8,create_temp:4,close_temp:4,custom_error:5,longer:13,fsf:[5,11],directori:[9,5,15],result_collection_cursor:3,text_io:[9,6],gnat:5,depth:3,time:[3,13,11,6,5],add_test_routin:[13,5]},objtypes:{"0":"std:option","1":"py:module"},titles:["Ahven.Text_Runner – Package","Ahven.SList – Package","Welcome to Ahven’s documentation!","Ahven.Results – Package","Ahven.Temporary_Output – Package","Ahven User’s Guide","Ahven.Listeners.Basic – Package","Ahven.Listeners – Package","Ahven – Package","Ahven.Parameters – Package","API Documentation for Ahven","Design Notes","Ahven.Tap_Runner – Package","Ahven.Framework – Package","Ahven.Runner – Package","Ahven.XML_Runner – Package"],objnames:{"0":"option","1":"Python module"},filenames:["api-ahven-text_runner","api-ahven-slist","index","api-ahven-results","api-ahven-temporary_output","manual","api-ahven-listeners-basic","api-ahven-listeners","api-ahven","api-ahven-parameters","api","design","api-ahven-tap_runner","api-ahven-framework","api-ahven-runner","api-ahven-xml_runner"]})ahven-2.1/doc/manual/en/build/html/api-ahven-listeners.html0000664000076400007640000002403011637173543024173 0ustar tkoskinetkoskine Ahven.Listeners – Package — Ahven 2.1 documentation

Ahven.Listeners – Package

Types

Test_Phase

type Test_Phase is (TEST_BEGIN, TEST_RUN, TEST_END);

What is test doing right now?

Test_Type

type Test_Type is (CONTAINER, ROUTINE);

Context

type Context (Phase : Test_Phase) is record
   Test_Name : AStrings.Bounded_String;
   Test_Kind : Test_Type;
   case Phase is
      when TEST_BEGIN | TEST_END =>
         null;
      when TEST_RUN =>
         Routine_Name : AStrings.Bounded_String;
         Message      : AStrings.Bounded_String;
         Long_Message : AStrings.Bounded_String;
   end case;
end record;

Result_Listener

type Result_Listener is
  abstract new Ada.Finalization.Limited_Controlled with null record;

Result_Listener is a listener for test results. Whenever a test is run, the framework calls registered listeners and tells them the result of the test.

Result_Listener_Class_Access

type Result_Listener_Class_Access is access all Result_Listener'Class;

Procedures and Functions

Add_Pass

procedure Add_Pass (Listener : in out Result_Listener;
                    Info     :        Context) is abstract;

Called after test passes.

Add_Failure

procedure Add_Failure (Listener : in out Result_Listener;
                       Info     :        Context) is abstract;

Called after test fails.

Add_Error

procedure Add_Error (Listener : in out Result_Listener;
                     Info     :        Context) is abstract;

Called after there is an error in the test.

Start_Test

procedure Start_Test (Listener : in out Result_Listener;
                      Info     :        Context) is abstract;

Called before the test begins. This is called before Add_* procedures.

End_Test

procedure End_Test (Listener : in out Result_Listener;
                    Info     :        Context) is abstract;

Called after the test ends. Add_* procedures are called before this.

ahven-2.1/doc/manual/en/build/html/api-ahven-temporary_output.html0000664000076400007640000002056511637173543025636 0ustar tkoskinetkoskine Ahven.Temporary_Output – Package — Ahven 2.1 documentation

Ahven.Temporary_Output – Package

Types

Temporary_File

type Temporary_File is limited private;

Procedures and Functions

Create_Temp

procedure Create_Temp (File : out Temporary_File);

Create a new temporary file. Exception Temporary_File_Error is raised if the procedure cannot create a new temp file.

Get_Name

function Get_Name (File : Temporary_File) return String;

Return the name of the file.

Redirect_Output

procedure Redirect_Output (To_File : in out Temporary_File);

Redirect the standard output to the file. To_File must be opened using Create_Temp.

Restore_Output

procedure Restore_Output;

Restore the standard output to its default settings.

Remove_Temp

procedure Remove_Temp (File : in out Temporary_File);

Remove the temporary file. File can be either open or closed.

Close_Temp

procedure Close_Temp (File : in out Temporary_File);

Close the temporary file.

ahven-2.1/doc/manual/en/build/html/index.html0000664000076400007640000001667711637173543021446 0ustar tkoskinetkoskine Welcome to Ahven’s documentation! — Ahven 2.1 documentation ahven-2.1/doc/manual/en/build/html/api-ahven-listeners-basic.html0000664000076400007640000002325611637173543025263 0ustar tkoskinetkoskine Ahven.Listeners.Basic – Package — Ahven 2.1 documentation

Ahven.Listeners.Basic – Package

Types

Result_Type

type Result_Type is (NO_RESULT, PASS_RESULT, FAILURE_RESULT, ERROR_RESULT);

Basic_Listener

type Basic_Listener is new Result_Listener with record
   Main_Result       : aliased Result_Collection;
   Current_Result    : Result_Collection_Access;
   Last_Test_Result  : Result_Type := NO_RESULT;
   Last_Info         : Result_Info := Empty_Result_Info;
   Capture_Output    : Boolean     := False;
   Output_File       : Temporary_Output.Temporary_File;
   Start_Time        : Ada.Calendar.Time;
end record;

Procedures and Functions

Add_Pass

procedure Add_Pass (Listener : in out Basic_Listener;
                    Info     :        Context);

New implementation for Listeners.Add_Pass

Add_Failure

procedure Add_Failure (Listener : in out Basic_Listener;
                       Info     :        Context);

New implementation for Listeners.Add_Failure

Add_Error

procedure Add_Error (Listener : in out Basic_Listener;
                     Info     :        Context);

New implementation for Listeners.Add_Error

Start_Test

procedure Start_Test (Listener : in out Basic_Listener;
                      Info     :        Context);

New implementation for Listeners.Start_Test

End_Test

procedure End_Test (Listener : in out Basic_Listener;
                    Info     :        Context);

New implementation for Listeners.End_Test

Set_Output_Capture

procedure Set_Output_Capture (Listener : in out Basic_Listener;
                              Capture  :        Boolean);

Enable or disable Ada.Text_IO output capturing

Get_Output_Capture

function Get_Output_Capture (Listener : Basic_Listener)
  return Boolean;

Capture the Ada.Text_IO output?

ahven-2.1/doc/manual/en/build/html/api-ahven-parameters.html0000664000076400007640000002320511637173543024331 0ustar tkoskinetkoskine Ahven.Parameters – Package — Ahven 2.1 documentation

Ahven.Parameters – Package

Types

Parameter_Info

type Parameter_Info is private;

Parameter_Mode

type Parameter_Mode is (NORMAL_PARAMETERS, TAP_PARAMETERS);

Procedures and Functions

procedure Parse_Parameters (Mode : Parameter_Mode;
Info : out Parameter_Info);

Parse Ada.Command_Line parameters and put the results to the Info parameter. Raises Invalid_Parameter if some parameter is invalid.

Parse_Parameters

procedure Parse_Parameters (Mode :     Parameter_Mode;
                            Info : out Parameter_Info);

Parse Ada.Command_Line parameters and put the results to the Info parameter. Raises Invalid_Parameter if some parameter is invalid.

Usage

procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS);

Print usage.

Capture

function Capture (Info : Parameter_Info) return Boolean;

Capture Ada.Text_IO output?

Verbose

function Verbose (Info : Parameter_Info) return Boolean;

Use verbose mode?

XML_Results

function XML_Results (Info : Parameter_Info) return Boolean;

Output XML?

Single_Test

function Single_Test (Info : Parameter_Info) return Boolean;

Run a single test (case/suite/routine) only?

Test_Name

function Test_Name (Info : Parameter_Info) return String;

Return the name of the test passed as a parameter.

Result_Dir

function Result_Dir (Info : Parameter_Info) return String;

Return the directory for XML results.

ahven-2.1/doc/manual/en/build/html/api-ahven-tap_runner.html0000664000076400007640000001713211637173543024345 0ustar tkoskinetkoskine Ahven.Tap_Runner – Package — Ahven 2.1 documentation

Ahven.Tap_Runner – Package

Procedures and Functions

Run

procedure Run (Suite : in out Framework.Test'Class);

Run the suite and print the results.

Add_Pass

procedure Add_Pass (Listener : in out Tap_Listener;
                    Info     :        Context);

Add_Failure

procedure Add_Failure (Listener : in out Tap_Listener;
                       Info     :        Context);

Add_Error

procedure Add_Error (Listener : in out Tap_Listener;
                     Info     :        Context);

Start_Test

procedure Start_Test (Listener : in out Tap_Listener;
                      Info     :        Context);

End_Test

procedure End_Test (Listener : in out Tap_Listener;
                    Info     :        Context);

Table Of Contents

Previous topic

Ahven.SList – Package

Next topic

Ahven.Temporary_Output – Package

This Page

ahven-2.1/doc/manual/en/build/html/genindex.html0000664000076400007640000001457211637173543022130 0ustar tkoskinetkoskine Index — Ahven 2.1 documentation ahven-2.1/doc/manual/en/build/html/manual.html0000664000076400007640000005613511637173543021605 0ustar tkoskinetkoskine Ahven User’s Guide — Ahven 2.1 documentation

Ahven User’s Guide

Tero Koskinen

Overview

Introduction

Ahven is a unit test library. It is modeled after JUnit framework for Java, but some ideas are also taken from another Ada unit test library, AUnit.

The purpose of Ahven is to be a small and portable unit test library, which works with multiple different Ada 95 compilers. Ahven has no external dependencies and therefore it is easy to build on various platforms.

Ahven tries to be compatible with utilities related to unit testing. For example, it uses same XML format for test results as Java tools. This allows easy integration to CruiseControl, Ant, and other similar programs.

License

Ahven is distributed under permissive ISC license (shown below).

--
-- Copyright (c) 2008, 2009, 2010 Tero Koskinen <tero.koskinen@iki.fi>
--
-- Permission to use, copy, modify, and distribute this software for any
-- purpose with or without fee is hereby granted, provided that the above
-- copyright notice and this permission notice appear in all copies.
--
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
--

You are allowed to embed Ahven into a proprietary commercial application. Only requirement is to keep the copyright notice and the permission notice in the source code files. You do not need to distribute Ahven’s source code if you distribute Ahven or some parts of Ahven in the binary form.

Building and Installing Ahven

To build and install Ahven source code, you need an Ada 95 compiler. At the moment, Ahven is tested with four different compiler families: GNAT, ObjectAda, Irvine ICCAda, and Janus/Ada.

GNAT GPL series and FSF GCC

When you have GNAT GPL or FSF GCC, the easieast way to compile and install Ahven is to use the make utility and Makefile.

When compiling using the make utility, you need to tell your platform type. Currently, only supported platform types are unix and windows. The type can be told by setting OS_VERSION variable to the selected platform.

$ make OS_VERSION=unix

If you are unable to use make, you can use the GNAT project files directly. Ahven distribution comes with three GNAT project files: ahven.gpr, ahven_lib.gpr, and ahven_tests.gpr. The ahven.gpr file is meant to be used when compiling unit tests. The library itself is build using the ahven_lib.gpr file. To build the testsuite of the Ahven, one needs to use the ahven_tests.gpr file.

Like with Makefile, you need to tell your platform type. This time the selection happens by using an environment variable called OS. The variable accepts same values as Makefile.

$ OS=windows gnatmake -P ahven_lib
$ OS=windows gnatmake -P ahven_tests

Installing Library

You can install the library by using command make install. By default the installation happens to the /usr/local directory. Alternative directory can be set by overwriting the PREFIX variable.

$ make OS_VERSION=unix PREFIX=/opt/ada install

GNAT 3.15p

Version 3.15p of GNAT does not understand some features used in the default GNAT project files. Therefore, you need to use project files from the contrib/gnat315p directory.

ObjectAda

There is no project file included for ObjectAda. To compile Ahven, you need to create a new project and import the source code of Ahven to the project.

Irvine ICCAda

Easiest way to build Ahven with ICCAda is to use icm utility:

C:\ahven-2.1>cd src
C:\ahven-2.1\src>icm new
C:\ahven-2.1\src>icm scan *.ad? windows\*.ad?
C:\ahven-2.1\src>icm make libmain
C:\ahven-2.1\src>cd ..\test
C:\ahven-2.1\test>icm new -search=..\src
C:\ahven-2.1\test>icm scan *.ad?
C:\ahven-2.1\test>icm make tester

Janus/Ada

Directory janusada contains project file creation scripts for Janus/Ada. By default, the scripts assume Janus/Ada to be installed to directory C:\Janus312\. If that is not the case, change the path from file prepare.bat.

C:\ahven-2.1>janusada\prepare.bat

Before compiling the library, you need to run the preparation script janusada\prepare.bat. Then, scan the sources and create compilation script by running janusada\update.bat.

C:\ahven-2.1>janusada\update.bat

Now you are ready to compile the project. This happens by running compile.bat script.

C:\ahven-2.1>janusada\compile.bat

After a while, you should have compiled library files in the lib_obj directory and an executable called tap_test.exe in the test_obj directory. The executable is Ahven’s test suite and if it reports no errors, everything is working as expected.

At the time of writing (Ahven 2.1), every test should pass with the latest version of Janus/Ada.

However, with earlier versions of Janus/Ada some tests will fail. The failing tests are worked around in Ahven’s source code, but the test exists so that one can verify when the Janus/Ada bug causing the failure is fixed.

Using Ahven

The heart of Ahven is an abstract type called Test. It presents an entity which can be run by a test runner. Types Test_Case and Test_Suite are derived from the Test type. The Test_Case type is the base type for unit tests and the Test_Suite type is a container, which can hold other Test objects.

Writing a Test Case

To create a new test case you need to create a new package and a new type, which is derived from Ahven.Framework.Test_Case. There are no required functions or procedures to be implemented, but to make the test case do something you need to override the Initialize procedure and create at least one procedure which tests something:

-- my_tests.ads
with Ahven.Framework;
package My_Tests is
   type Test is new Ahven.Framework.Test_Case with null record;
   procedure Initialize (T : in out Test);
private
   procedure Test_Addition;
end My_Tests;

To add tests to the test case you need to call procedure Ahven.Framework.Add_Test_Routine during the test case initialization (in other words, in the Initialize procedure). A test case package body shows how the Test_Addition is added to the test case. It also shows how to set a name for the test case with the Set_Name procedure.

A test case package body

-- my_tests.adb
package body My_Tests is
   procedure Initialize (T : in out Test) is
   begin
      Set_Name (T, "My tests");
      Ahven.Framework.Add_Test_Routine
        (T, Test_Addition'Access, "Addition");
   end Initialize;

   procedure Test_Addition is
   begin
      null;
   end Test_Addition;
end My_Tests;

Calling Assertion Procedures

To test whether a condition is true or false, Ahven offers you three procedures. The first procedure is Ahven.Assert. It takes a boolean value and a message string as its parameters. If the boolean value is false the Assert raises an Assertion_Error exception with the given string. The exception is catched by the framework. and when the test results are shown the error is also shown with the given message.

Another assertion procedure is a generic Ahven.Assert_Equal procedure. It is meant for comparing two objects of same type. If the objects are not equal the Assertion_Error exception with the given message string is raised.

The third assertion procedure is simple Ahven.Fail which always raises the Assertion_Error exception. It is handy for situations where the execution should not reach a certain place (see Fail in action).

Fail in action

package body My_Tests is
   ...
   procedure Test_My_Proc is
   begin
      begin
         My_Proc (-1); -- should raise Custom_Error
         Fail ("Custom_Error expected");
      exception
         when Custom_Error =>
            null; -- expected
            -- Note: the exception block should not
            -- catch Assertion_Error. Otherwise
            -- the assertion failure will not be noticed.
      end;
   end Test_My_Proc;
end My_Tests;

Composing Test Hierarchies With Test Suites

The Test_Suite type is used to group related tests together. You can also add other test suites to the suite and create a hierarchy of tests.

The tests are added to the test suite using either procedure Add_Static_Test or Add_Test. The former procedure is meant for statically created tests and it places a copy of the given test to the test suite. The Add_Test procedure is used with dynamically created tests and test objects of type Test_Class_Access.

At the moment, the dynamically added tests are executed first in the order they have been added (first in, first out - FIFO) and after them the statically added tests, also in FIFO order.

Suite Example shows how to put test cases in a test suite.

Suite Example

package body My_Tests is
   ...
   function Get_Test_Suite return Ahven.Framework.Test_Suite is
      S : Framework.Test_Suite := Framework.Create_Suite ("All");
      Hello_World_Test : Hello_World.Test;
      Listener_Test    : Basic_Listener_Tests.Test;
   begin
      Framework.Add_Static_Test (S, Hello_World_Test);
      Framework.Add_Static_Test (S, Listener_Test);
      return S;
   end Get_Test_Suite;
end My_Tests;

Running Tests

The tests are run by test runners. These runners are procedures which take either test cases or test suites as their parameters.

Currently, there exists three test runners. Ahven.Runner is the basic runner, which prints the test results as a hierarchy. Ahven.XML_Runner on the other hand writes the test results to an XML file, which is understood by continuous integration systems like CruiseControl and Hudson. The third runner is Ahven.Tap_Runner. It produces the results in Test-Anything-Protocol (TAP) format.

The recommended way to use these test runners is to call them from the main program:

with Ahven.Text_Runner;
with Ahven.Framework;
with Simple_Tests;
procedure Tester is
   S : Ahven.Framework.Test_Suite := Ahven.Framework.Create_Suite ("All");
begin
    Ahven.Framework.Add_Test (S, new Simple_Tests.Test);
    Ahven.Text_Runner.Run (S);
end Tester;

Parameters

Ahven.Text_Runner recognizes following parameters:

-d

directory for test results

-x

output in XML format

-c

capture and report test outputs

-t

specify timeout value for tests

-q

quiet results

-v

verbose results (default)

ahven-2.1/doc/manual/en/build/html/api.html0000664000076400007640000002267211637173542021077 0ustar tkoskinetkoskine API Documentation for Ahven — Ahven 2.1 documentation ahven-2.1/doc/manual/en/build/html/api-ahven-runner.html0000664000076400007640000001472311637173543023504 0ustar tkoskinetkoskine Ahven.Runner – Package — Ahven 2.1 documentation

Ahven.Runner – Package

Types

Report_Proc

type Report_Proc is access procedure
  (Test_Results : Results.Result_Collection;
   Args         : Parameters.Parameter_Info);

Procedures and Funcstions

Run_Suite

procedure Run_Suite (Suite    : in out Framework.Test'Class;
                     Reporter :        Report_Proc);

Run the given test (case/suite) and pass the results and the command line argument info to the reporter procedure.

Table Of Contents

Previous topic

Ahven.Results – Package

Next topic

Ahven.SList – Package

This Page

ahven-2.1/doc/manual/en/build/html/api-ahven.html0000664000076400007640000001734411637173542022176 0ustar tkoskinetkoskine Ahven – Package — Ahven 2.1 documentation

Ahven – Package

Exceptions

Assertion_Error

Exception, raised when Assert fails.

Procedures and Functions

Assert

procedure Assert (Condition : Boolean; Message : String);

If Condition is false, Assert raises Assertion_Error with given Message.

Assert_Equal

New in version 1.4.

generic
   type Data_Type is private;
   with function Image (Item : Data_Type) return String is <>;
procedure Assert_Equal (Actual : Data_Type; Expected : Data_Type; Message : String);

If Expected /= Actual, Assert raises Assertion_Error with given Message.

Example:

declare
   procedure Assert_Eq_Nat is
     new Ahven.Assert_Equal (Data_Type => Natural,
                             Image     => Natural'Image);

begin
   Assert_Eq_Nat (Actual   => Test_Count,
                  Expected => 4,
                  "test count");
end;

Fail

procedure Fail (Message : String);

Fail always raises Assertion_Error with given Message.

Table Of Contents

Previous topic

API Documentation for Ahven

Next topic

Ahven.Framework – Package

This Page

ahven-2.1/doc/manual/en/build/html/objects.inv0000664000076400007640000000110411637173543021573 0ustar tkoskinetkoskine# Sphinx inventory version 2 # Project: Ahven # Version: 2.1 # The remainder of this file is compressed using zlib. xڕN0Fy KxˮH !Qn c;}{|P)ɮ9^˾ciPO8=:+f%+: ;ٵS l9vO+8|b_AK\]@*ݷ 物onk<6a" #glG_6~UrQ/.ia oOGph3м2mEql]Bbfp#86fo㢮n17%ܻ4~j;< TօI~'c6'ѧ H4<OmMdϻ܀M |OTkGeGLJyB"|Ԫ#ܰK&@n j[͐:?c^/>p"KmEFۜ"oD%QӆeC jKN.dee(ZO$+y'rQ ' ahven-2.1/doc/manual/en/build/html/_static/0000775000076400007640000000000011637173543021056 5ustar tkoskinetkoskineahven-2.1/doc/manual/en/build/html/_static/up.png0000664000076400007640000000055311571062662022207 0ustar tkoskinetkoskinePNG  IHDRasRGBbKGDC pHYs B(xtIME!.<̓EIDAT8͓NABP\EG{%<|xc  cr6@t;b$;3&)h1!﫳Hzz@=)p 3۵e2/ߴ ( %^ND^ }3H1DoǪISFұ?, G`{v^X[b]&HC3{:sO& ?,[eL#IENDB`ahven-2.1/doc/manual/en/build/html/_static/jquery.js0000664000076400007640000021475611571062662022746 0ustar tkoskinetkoskine/*! * jQuery JavaScript Library v1.4.2 * http://jquery.com/ * * Copyright 2010, John Resig * Dual licensed under the MIT or GPL Version 2 licenses. * http://jquery.org/license * * Includes Sizzle.js * http://sizzlejs.com/ * Copyright 2010, The Dojo Foundation * Released under the MIT, BSD, and GPL Licenses. * * Date: Sat Feb 13 22:33:48 2010 -0500 */ (function(A,w){function ma(){if(!c.isReady){try{s.documentElement.doScroll("left")}catch(a){setTimeout(ma,1);return}c.ready()}}function Qa(a,b){b.src?c.ajax({url:b.src,async:false,dataType:"script"}):c.globalEval(b.text||b.textContent||b.innerHTML||"");b.parentNode&&b.parentNode.removeChild(b)}function X(a,b,d,f,e,j){var i=a.length;if(typeof b==="object"){for(var o in b)X(a,o,b[o],f,e,d);return a}if(d!==w){f=!j&&f&&c.isFunction(d);for(o=0;o)[^>]*$|^#([\w-]+)$/,Ua=/^.[^:#\[\.,]*$/,Va=/\S/, Wa=/^(\s|\u00A0)+|(\s|\u00A0)+$/g,Xa=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,P=navigator.userAgent,xa=false,Q=[],L,$=Object.prototype.toString,aa=Object.prototype.hasOwnProperty,ba=Array.prototype.push,R=Array.prototype.slice,ya=Array.prototype.indexOf;c.fn=c.prototype={init:function(a,b){var d,f;if(!a)return this;if(a.nodeType){this.context=this[0]=a;this.length=1;return this}if(a==="body"&&!b){this.context=s;this[0]=s.body;this.selector="body";this.length=1;return this}if(typeof a==="string")if((d=Ta.exec(a))&& (d[1]||!b))if(d[1]){f=b?b.ownerDocument||b:s;if(a=Xa.exec(a))if(c.isPlainObject(b)){a=[s.createElement(a[1])];c.fn.attr.call(a,b,true)}else a=[f.createElement(a[1])];else{a=sa([d[1]],[f]);a=(a.cacheable?a.fragment.cloneNode(true):a.fragment).childNodes}return c.merge(this,a)}else{if(b=s.getElementById(d[2])){if(b.id!==d[2])return T.find(a);this.length=1;this[0]=b}this.context=s;this.selector=a;return this}else if(!b&&/^\w+$/.test(a)){this.selector=a;this.context=s;a=s.getElementsByTagName(a);return c.merge(this, a)}else return!b||b.jquery?(b||T).find(a):c(b).find(a);else if(c.isFunction(a))return T.ready(a);if(a.selector!==w){this.selector=a.selector;this.context=a.context}return c.makeArray(a,this)},selector:"",jquery:"1.4.2",length:0,size:function(){return this.length},toArray:function(){return R.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this.slice(a)[0]:this[a]},pushStack:function(a,b,d){var f=c();c.isArray(a)?ba.apply(f,a):c.merge(f,a);f.prevObject=this;f.context=this.context;if(b=== "find")f.selector=this.selector+(this.selector?" ":"")+d;else if(b)f.selector=this.selector+"."+b+"("+d+")";return f},each:function(a,b){return c.each(this,a,b)},ready:function(a){c.bindReady();if(c.isReady)a.call(s,c);else Q&&Q.push(a);return this},eq:function(a){return a===-1?this.slice(a):this.slice(a,+a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(R.apply(this,arguments),"slice",R.call(arguments).join(","))},map:function(a){return this.pushStack(c.map(this, function(b,d){return a.call(b,d,b)}))},end:function(){return this.prevObject||c(null)},push:ba,sort:[].sort,splice:[].splice};c.fn.init.prototype=c.fn;c.extend=c.fn.extend=function(){var a=arguments[0]||{},b=1,d=arguments.length,f=false,e,j,i,o;if(typeof a==="boolean"){f=a;a=arguments[1]||{};b=2}if(typeof a!=="object"&&!c.isFunction(a))a={};if(d===b){a=this;--b}for(;b
a"; var e=d.getElementsByTagName("*"),j=d.getElementsByTagName("a")[0];if(!(!e||!e.length||!j)){c.support={leadingWhitespace:d.firstChild.nodeType===3,tbody:!d.getElementsByTagName("tbody").length,htmlSerialize:!!d.getElementsByTagName("link").length,style:/red/.test(j.getAttribute("style")),hrefNormalized:j.getAttribute("href")==="/a",opacity:/^0.55$/.test(j.style.opacity),cssFloat:!!j.style.cssFloat,checkOn:d.getElementsByTagName("input")[0].value==="on",optSelected:s.createElement("select").appendChild(s.createElement("option")).selected, parentNode:d.removeChild(d.appendChild(s.createElement("div"))).parentNode===null,deleteExpando:true,checkClone:false,scriptEval:false,noCloneEvent:true,boxModel:null};b.type="text/javascript";try{b.appendChild(s.createTextNode("window."+f+"=1;"))}catch(i){}a.insertBefore(b,a.firstChild);if(A[f]){c.support.scriptEval=true;delete A[f]}try{delete b.test}catch(o){c.support.deleteExpando=false}a.removeChild(b);if(d.attachEvent&&d.fireEvent){d.attachEvent("onclick",function k(){c.support.noCloneEvent= false;d.detachEvent("onclick",k)});d.cloneNode(true).fireEvent("onclick")}d=s.createElement("div");d.innerHTML="";a=s.createDocumentFragment();a.appendChild(d.firstChild);c.support.checkClone=a.cloneNode(true).cloneNode(true).lastChild.checked;c(function(){var k=s.createElement("div");k.style.width=k.style.paddingLeft="1px";s.body.appendChild(k);c.boxModel=c.support.boxModel=k.offsetWidth===2;s.body.removeChild(k).style.display="none"});a=function(k){var n= s.createElement("div");k="on"+k;var r=k in n;if(!r){n.setAttribute(k,"return;");r=typeof n[k]==="function"}return r};c.support.submitBubbles=a("submit");c.support.changeBubbles=a("change");a=b=d=e=j=null}})();c.props={"for":"htmlFor","class":"className",readonly:"readOnly",maxlength:"maxLength",cellspacing:"cellSpacing",rowspan:"rowSpan",colspan:"colSpan",tabindex:"tabIndex",usemap:"useMap",frameborder:"frameBorder"};var G="jQuery"+J(),Ya=0,za={};c.extend({cache:{},expando:G,noData:{embed:true,object:true, applet:true},data:function(a,b,d){if(!(a.nodeName&&c.noData[a.nodeName.toLowerCase()])){a=a==A?za:a;var f=a[G],e=c.cache;if(!f&&typeof b==="string"&&d===w)return null;f||(f=++Ya);if(typeof b==="object"){a[G]=f;e[f]=c.extend(true,{},b)}else if(!e[f]){a[G]=f;e[f]={}}a=e[f];if(d!==w)a[b]=d;return typeof b==="string"?a[b]:a}},removeData:function(a,b){if(!(a.nodeName&&c.noData[a.nodeName.toLowerCase()])){a=a==A?za:a;var d=a[G],f=c.cache,e=f[d];if(b){if(e){delete e[b];c.isEmptyObject(e)&&c.removeData(a)}}else{if(c.support.deleteExpando)delete a[c.expando]; else a.removeAttribute&&a.removeAttribute(c.expando);delete f[d]}}}});c.fn.extend({data:function(a,b){if(typeof a==="undefined"&&this.length)return c.data(this[0]);else if(typeof a==="object")return this.each(function(){c.data(this,a)});var d=a.split(".");d[1]=d[1]?"."+d[1]:"";if(b===w){var f=this.triggerHandler("getData"+d[1]+"!",[d[0]]);if(f===w&&this.length)f=c.data(this[0],a);return f===w&&d[1]?this.data(d[0]):f}else return this.trigger("setData"+d[1]+"!",[d[0],b]).each(function(){c.data(this, a,b)})},removeData:function(a){return this.each(function(){c.removeData(this,a)})}});c.extend({queue:function(a,b,d){if(a){b=(b||"fx")+"queue";var f=c.data(a,b);if(!d)return f||[];if(!f||c.isArray(d))f=c.data(a,b,c.makeArray(d));else f.push(d);return f}},dequeue:function(a,b){b=b||"fx";var d=c.queue(a,b),f=d.shift();if(f==="inprogress")f=d.shift();if(f){b==="fx"&&d.unshift("inprogress");f.call(a,function(){c.dequeue(a,b)})}}});c.fn.extend({queue:function(a,b){if(typeof a!=="string"){b=a;a="fx"}if(b=== w)return c.queue(this[0],a);return this.each(function(){var d=c.queue(this,a,b);a==="fx"&&d[0]!=="inprogress"&&c.dequeue(this,a)})},dequeue:function(a){return this.each(function(){c.dequeue(this,a)})},delay:function(a,b){a=c.fx?c.fx.speeds[a]||a:a;b=b||"fx";return this.queue(b,function(){var d=this;setTimeout(function(){c.dequeue(d,b)},a)})},clearQueue:function(a){return this.queue(a||"fx",[])}});var Aa=/[\n\t]/g,ca=/\s+/,Za=/\r/g,$a=/href|src|style/,ab=/(button|input)/i,bb=/(button|input|object|select|textarea)/i, cb=/^(a|area)$/i,Ba=/radio|checkbox/;c.fn.extend({attr:function(a,b){return X(this,a,b,true,c.attr)},removeAttr:function(a){return this.each(function(){c.attr(this,a,"");this.nodeType===1&&this.removeAttribute(a)})},addClass:function(a){if(c.isFunction(a))return this.each(function(n){var r=c(this);r.addClass(a.call(this,n,r.attr("class")))});if(a&&typeof a==="string")for(var b=(a||"").split(ca),d=0,f=this.length;d-1)return true;return false},val:function(a){if(a===w){var b=this[0];if(b){if(c.nodeName(b,"option"))return(b.attributes.value||{}).specified?b.value:b.text;if(c.nodeName(b,"select")){var d=b.selectedIndex,f=[],e=b.options;b=b.type==="select-one";if(d<0)return null;var j=b?d:0;for(d=b?d+1:e.length;j=0;else if(c.nodeName(this,"select")){var u=c.makeArray(r);c("option",this).each(function(){this.selected= c.inArray(c(this).val(),u)>=0});if(!u.length)this.selectedIndex=-1}else this.value=r}})}});c.extend({attrFn:{val:true,css:true,html:true,text:true,data:true,width:true,height:true,offset:true},attr:function(a,b,d,f){if(!a||a.nodeType===3||a.nodeType===8)return w;if(f&&b in c.attrFn)return c(a)[b](d);f=a.nodeType!==1||!c.isXMLDoc(a);var e=d!==w;b=f&&c.props[b]||b;if(a.nodeType===1){var j=$a.test(b);if(b in a&&f&&!j){if(e){b==="type"&&ab.test(a.nodeName)&&a.parentNode&&c.error("type property can't be changed"); a[b]=d}if(c.nodeName(a,"form")&&a.getAttributeNode(b))return a.getAttributeNode(b).nodeValue;if(b==="tabIndex")return(b=a.getAttributeNode("tabIndex"))&&b.specified?b.value:bb.test(a.nodeName)||cb.test(a.nodeName)&&a.href?0:w;return a[b]}if(!c.support.style&&f&&b==="style"){if(e)a.style.cssText=""+d;return a.style.cssText}e&&a.setAttribute(b,""+d);a=!c.support.hrefNormalized&&f&&j?a.getAttribute(b,2):a.getAttribute(b);return a===null?w:a}return c.style(a,b,d)}});var O=/\.(.*)$/,db=function(a){return a.replace(/[^\w\s\.\|`]/g, function(b){return"\\"+b})};c.event={add:function(a,b,d,f){if(!(a.nodeType===3||a.nodeType===8)){if(a.setInterval&&a!==A&&!a.frameElement)a=A;var e,j;if(d.handler){e=d;d=e.handler}if(!d.guid)d.guid=c.guid++;if(j=c.data(a)){var i=j.events=j.events||{},o=j.handle;if(!o)j.handle=o=function(){return typeof c!=="undefined"&&!c.event.triggered?c.event.handle.apply(o.elem,arguments):w};o.elem=a;b=b.split(" ");for(var k,n=0,r;k=b[n++];){j=e?c.extend({},e):{handler:d,data:f};if(k.indexOf(".")>-1){r=k.split("."); k=r.shift();j.namespace=r.slice(0).sort().join(".")}else{r=[];j.namespace=""}j.type=k;j.guid=d.guid;var u=i[k],z=c.event.special[k]||{};if(!u){u=i[k]=[];if(!z.setup||z.setup.call(a,f,r,o)===false)if(a.addEventListener)a.addEventListener(k,o,false);else a.attachEvent&&a.attachEvent("on"+k,o)}if(z.add){z.add.call(a,j);if(!j.handler.guid)j.handler.guid=d.guid}u.push(j);c.event.global[k]=true}a=null}}},global:{},remove:function(a,b,d,f){if(!(a.nodeType===3||a.nodeType===8)){var e,j=0,i,o,k,n,r,u,z=c.data(a), C=z&&z.events;if(z&&C){if(b&&b.type){d=b.handler;b=b.type}if(!b||typeof b==="string"&&b.charAt(0)==="."){b=b||"";for(e in C)c.event.remove(a,e+b)}else{for(b=b.split(" ");e=b[j++];){n=e;i=e.indexOf(".")<0;o=[];if(!i){o=e.split(".");e=o.shift();k=new RegExp("(^|\\.)"+c.map(o.slice(0).sort(),db).join("\\.(?:.*\\.)?")+"(\\.|$)")}if(r=C[e])if(d){n=c.event.special[e]||{};for(B=f||0;B=0){a.type= e=e.slice(0,-1);a.exclusive=true}if(!d){a.stopPropagation();c.event.global[e]&&c.each(c.cache,function(){this.events&&this.events[e]&&c.event.trigger(a,b,this.handle.elem)})}if(!d||d.nodeType===3||d.nodeType===8)return w;a.result=w;a.target=d;b=c.makeArray(b);b.unshift(a)}a.currentTarget=d;(f=c.data(d,"handle"))&&f.apply(d,b);f=d.parentNode||d.ownerDocument;try{if(!(d&&d.nodeName&&c.noData[d.nodeName.toLowerCase()]))if(d["on"+e]&&d["on"+e].apply(d,b)===false)a.result=false}catch(j){}if(!a.isPropagationStopped()&& f)c.event.trigger(a,b,f,true);else if(!a.isDefaultPrevented()){f=a.target;var i,o=c.nodeName(f,"a")&&e==="click",k=c.event.special[e]||{};if((!k._default||k._default.call(d,a)===false)&&!o&&!(f&&f.nodeName&&c.noData[f.nodeName.toLowerCase()])){try{if(f[e]){if(i=f["on"+e])f["on"+e]=null;c.event.triggered=true;f[e]()}}catch(n){}if(i)f["on"+e]=i;c.event.triggered=false}}},handle:function(a){var b,d,f,e;a=arguments[0]=c.event.fix(a||A.event);a.currentTarget=this;b=a.type.indexOf(".")<0&&!a.exclusive; if(!b){d=a.type.split(".");a.type=d.shift();f=new RegExp("(^|\\.)"+d.slice(0).sort().join("\\.(?:.*\\.)?")+"(\\.|$)")}e=c.data(this,"events");d=e[a.type];if(e&&d){d=d.slice(0);e=0;for(var j=d.length;e-1?c.map(a.options,function(f){return f.selected}).join("-"):"";else if(a.nodeName.toLowerCase()==="select")d=a.selectedIndex;return d},fa=function(a,b){var d=a.target,f,e;if(!(!da.test(d.nodeName)||d.readOnly)){f=c.data(d,"_change_data");e=Fa(d);if(a.type!=="focusout"||d.type!=="radio")c.data(d,"_change_data", e);if(!(f===w||e===f))if(f!=null||e){a.type="change";return c.event.trigger(a,b,d)}}};c.event.special.change={filters:{focusout:fa,click:function(a){var b=a.target,d=b.type;if(d==="radio"||d==="checkbox"||b.nodeName.toLowerCase()==="select")return fa.call(this,a)},keydown:function(a){var b=a.target,d=b.type;if(a.keyCode===13&&b.nodeName.toLowerCase()!=="textarea"||a.keyCode===32&&(d==="checkbox"||d==="radio")||d==="select-multiple")return fa.call(this,a)},beforeactivate:function(a){a=a.target;c.data(a, "_change_data",Fa(a))}},setup:function(){if(this.type==="file")return false;for(var a in ea)c.event.add(this,a+".specialChange",ea[a]);return da.test(this.nodeName)},teardown:function(){c.event.remove(this,".specialChange");return da.test(this.nodeName)}};ea=c.event.special.change.filters}s.addEventListener&&c.each({focus:"focusin",blur:"focusout"},function(a,b){function d(f){f=c.event.fix(f);f.type=b;return c.event.handle.call(this,f)}c.event.special[b]={setup:function(){this.addEventListener(a, d,true)},teardown:function(){this.removeEventListener(a,d,true)}}});c.each(["bind","one"],function(a,b){c.fn[b]=function(d,f,e){if(typeof d==="object"){for(var j in d)this[b](j,f,d[j],e);return this}if(c.isFunction(f)){e=f;f=w}var i=b==="one"?c.proxy(e,function(k){c(this).unbind(k,i);return e.apply(this,arguments)}):e;if(d==="unload"&&b!=="one")this.one(d,f,e);else{j=0;for(var o=this.length;j0){y=t;break}}t=t[g]}m[q]=y}}}var f=/((?:\((?:\([^()]+\)|[^()]+)+\)|\[(?:\[[^[\]]*\]|['"][^'"]*['"]|[^[\]'"]+)+\]|\\.|[^ >+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g, e=0,j=Object.prototype.toString,i=false,o=true;[0,0].sort(function(){o=false;return 0});var k=function(g,h,l,m){l=l||[];var q=h=h||s;if(h.nodeType!==1&&h.nodeType!==9)return[];if(!g||typeof g!=="string")return l;for(var p=[],v,t,y,S,H=true,M=x(h),I=g;(f.exec(""),v=f.exec(I))!==null;){I=v[3];p.push(v[1]);if(v[2]){S=v[3];break}}if(p.length>1&&r.exec(g))if(p.length===2&&n.relative[p[0]])t=ga(p[0]+p[1],h);else for(t=n.relative[p[0]]?[h]:k(p.shift(),h);p.length;){g=p.shift();if(n.relative[g])g+=p.shift(); t=ga(g,t)}else{if(!m&&p.length>1&&h.nodeType===9&&!M&&n.match.ID.test(p[0])&&!n.match.ID.test(p[p.length-1])){v=k.find(p.shift(),h,M);h=v.expr?k.filter(v.expr,v.set)[0]:v.set[0]}if(h){v=m?{expr:p.pop(),set:z(m)}:k.find(p.pop(),p.length===1&&(p[0]==="~"||p[0]==="+")&&h.parentNode?h.parentNode:h,M);t=v.expr?k.filter(v.expr,v.set):v.set;if(p.length>0)y=z(t);else H=false;for(;p.length;){var D=p.pop();v=D;if(n.relative[D])v=p.pop();else D="";if(v==null)v=h;n.relative[D](y,v,M)}}else y=[]}y||(y=t);y||k.error(D|| g);if(j.call(y)==="[object Array]")if(H)if(h&&h.nodeType===1)for(g=0;y[g]!=null;g++){if(y[g]&&(y[g]===true||y[g].nodeType===1&&E(h,y[g])))l.push(t[g])}else for(g=0;y[g]!=null;g++)y[g]&&y[g].nodeType===1&&l.push(t[g]);else l.push.apply(l,y);else z(y,l);if(S){k(S,q,l,m);k.uniqueSort(l)}return l};k.uniqueSort=function(g){if(B){i=o;g.sort(B);if(i)for(var h=1;h":function(g,h){var l=typeof h==="string";if(l&&!/\W/.test(h)){h=h.toLowerCase();for(var m=0,q=g.length;m=0))l||m.push(v);else if(l)h[p]=false;return false},ID:function(g){return g[1].replace(/\\/g,"")},TAG:function(g){return g[1].toLowerCase()}, CHILD:function(g){if(g[1]==="nth"){var h=/(-?)(\d*)n((?:\+|-)?\d*)/.exec(g[2]==="even"&&"2n"||g[2]==="odd"&&"2n+1"||!/\D/.test(g[2])&&"0n+"+g[2]||g[2]);g[2]=h[1]+(h[2]||1)-0;g[3]=h[3]-0}g[0]=e++;return g},ATTR:function(g,h,l,m,q,p){h=g[1].replace(/\\/g,"");if(!p&&n.attrMap[h])g[1]=n.attrMap[h];if(g[2]==="~=")g[4]=" "+g[4]+" ";return g},PSEUDO:function(g,h,l,m,q){if(g[1]==="not")if((f.exec(g[3])||"").length>1||/^\w/.test(g[3]))g[3]=k(g[3],null,null,h);else{g=k.filter(g[3],h,l,true^q);l||m.push.apply(m, g);return false}else if(n.match.POS.test(g[0])||n.match.CHILD.test(g[0]))return true;return g},POS:function(g){g.unshift(true);return g}},filters:{enabled:function(g){return g.disabled===false&&g.type!=="hidden"},disabled:function(g){return g.disabled===true},checked:function(g){return g.checked===true},selected:function(g){return g.selected===true},parent:function(g){return!!g.firstChild},empty:function(g){return!g.firstChild},has:function(g,h,l){return!!k(l[3],g).length},header:function(g){return/h\d/i.test(g.nodeName)}, text:function(g){return"text"===g.type},radio:function(g){return"radio"===g.type},checkbox:function(g){return"checkbox"===g.type},file:function(g){return"file"===g.type},password:function(g){return"password"===g.type},submit:function(g){return"submit"===g.type},image:function(g){return"image"===g.type},reset:function(g){return"reset"===g.type},button:function(g){return"button"===g.type||g.nodeName.toLowerCase()==="button"},input:function(g){return/input|select|textarea|button/i.test(g.nodeName)}}, setFilters:{first:function(g,h){return h===0},last:function(g,h,l,m){return h===m.length-1},even:function(g,h){return h%2===0},odd:function(g,h){return h%2===1},lt:function(g,h,l){return hl[3]-0},nth:function(g,h,l){return l[3]-0===h},eq:function(g,h,l){return l[3]-0===h}},filter:{PSEUDO:function(g,h,l,m){var q=h[1],p=n.filters[q];if(p)return p(g,l,h,m);else if(q==="contains")return(g.textContent||g.innerText||a([g])||"").indexOf(h[3])>=0;else if(q==="not"){h= h[3];l=0;for(m=h.length;l=0}},ID:function(g,h){return g.nodeType===1&&g.getAttribute("id")===h},TAG:function(g,h){return h==="*"&&g.nodeType===1||g.nodeName.toLowerCase()===h},CLASS:function(g,h){return(" "+(g.className||g.getAttribute("class"))+" ").indexOf(h)>-1},ATTR:function(g,h){var l=h[1];g=n.attrHandle[l]?n.attrHandle[l](g):g[l]!=null?g[l]:g.getAttribute(l);l=g+"";var m=h[2];h=h[4];return g==null?m==="!=":m=== "="?l===h:m==="*="?l.indexOf(h)>=0:m==="~="?(" "+l+" ").indexOf(h)>=0:!h?l&&g!==false:m==="!="?l!==h:m==="^="?l.indexOf(h)===0:m==="$="?l.substr(l.length-h.length)===h:m==="|="?l===h||l.substr(0,h.length+1)===h+"-":false},POS:function(g,h,l,m){var q=n.setFilters[h[2]];if(q)return q(g,l,h,m)}}},r=n.match.POS;for(var u in n.match){n.match[u]=new RegExp(n.match[u].source+/(?![^\[]*\])(?![^\(]*\))/.source);n.leftMatch[u]=new RegExp(/(^(?:.|\r|\n)*?)/.source+n.match[u].source.replace(/\\(\d+)/g,function(g, h){return"\\"+(h-0+1)}))}var z=function(g,h){g=Array.prototype.slice.call(g,0);if(h){h.push.apply(h,g);return h}return g};try{Array.prototype.slice.call(s.documentElement.childNodes,0)}catch(C){z=function(g,h){h=h||[];if(j.call(g)==="[object Array]")Array.prototype.push.apply(h,g);else if(typeof g.length==="number")for(var l=0,m=g.length;l";var l=s.documentElement;l.insertBefore(g,l.firstChild);if(s.getElementById(h)){n.find.ID=function(m,q,p){if(typeof q.getElementById!=="undefined"&&!p)return(q=q.getElementById(m[1]))?q.id===m[1]||typeof q.getAttributeNode!=="undefined"&& q.getAttributeNode("id").nodeValue===m[1]?[q]:w:[]};n.filter.ID=function(m,q){var p=typeof m.getAttributeNode!=="undefined"&&m.getAttributeNode("id");return m.nodeType===1&&p&&p.nodeValue===q}}l.removeChild(g);l=g=null})();(function(){var g=s.createElement("div");g.appendChild(s.createComment(""));if(g.getElementsByTagName("*").length>0)n.find.TAG=function(h,l){l=l.getElementsByTagName(h[1]);if(h[1]==="*"){h=[];for(var m=0;l[m];m++)l[m].nodeType===1&&h.push(l[m]);l=h}return l};g.innerHTML=""; if(g.firstChild&&typeof g.firstChild.getAttribute!=="undefined"&&g.firstChild.getAttribute("href")!=="#")n.attrHandle.href=function(h){return h.getAttribute("href",2)};g=null})();s.querySelectorAll&&function(){var g=k,h=s.createElement("div");h.innerHTML="

";if(!(h.querySelectorAll&&h.querySelectorAll(".TEST").length===0)){k=function(m,q,p,v){q=q||s;if(!v&&q.nodeType===9&&!x(q))try{return z(q.querySelectorAll(m),p)}catch(t){}return g(m,q,p,v)};for(var l in g)k[l]=g[l];h=null}}(); (function(){var g=s.createElement("div");g.innerHTML="
";if(!(!g.getElementsByClassName||g.getElementsByClassName("e").length===0)){g.lastChild.className="e";if(g.getElementsByClassName("e").length!==1){n.order.splice(1,0,"CLASS");n.find.CLASS=function(h,l,m){if(typeof l.getElementsByClassName!=="undefined"&&!m)return l.getElementsByClassName(h[1])};g=null}}})();var E=s.compareDocumentPosition?function(g,h){return!!(g.compareDocumentPosition(h)&16)}: function(g,h){return g!==h&&(g.contains?g.contains(h):true)},x=function(g){return(g=(g?g.ownerDocument||g:0).documentElement)?g.nodeName!=="HTML":false},ga=function(g,h){var l=[],m="",q;for(h=h.nodeType?[h]:h;q=n.match.PSEUDO.exec(g);){m+=q[0];g=g.replace(n.match.PSEUDO,"")}g=n.relative[g]?g+"*":g;q=0;for(var p=h.length;q=0===d})};c.fn.extend({find:function(a){for(var b=this.pushStack("","find",a),d=0,f=0,e=this.length;f0)for(var j=d;j0},closest:function(a,b){if(c.isArray(a)){var d=[],f=this[0],e,j= {},i;if(f&&a.length){e=0;for(var o=a.length;e-1:c(f).is(e)){d.push({selector:i,elem:f});delete j[i]}}f=f.parentNode}}return d}var k=c.expr.match.POS.test(a)?c(a,b||this.context):null;return this.map(function(n,r){for(;r&&r.ownerDocument&&r!==b;){if(k?k.index(r)>-1:c(r).is(a))return r;r=r.parentNode}return null})},index:function(a){if(!a||typeof a=== "string")return c.inArray(this[0],a?c(a):this.parent().children());return c.inArray(a.jquery?a[0]:a,this)},add:function(a,b){a=typeof a==="string"?c(a,b||this.context):c.makeArray(a);b=c.merge(this.get(),a);return this.pushStack(qa(a[0])||qa(b[0])?b:c.unique(b))},andSelf:function(){return this.add(this.prevObject)}});c.each({parent:function(a){return(a=a.parentNode)&&a.nodeType!==11?a:null},parents:function(a){return c.dir(a,"parentNode")},parentsUntil:function(a,b,d){return c.dir(a,"parentNode", d)},next:function(a){return c.nth(a,2,"nextSibling")},prev:function(a){return c.nth(a,2,"previousSibling")},nextAll:function(a){return c.dir(a,"nextSibling")},prevAll:function(a){return c.dir(a,"previousSibling")},nextUntil:function(a,b,d){return c.dir(a,"nextSibling",d)},prevUntil:function(a,b,d){return c.dir(a,"previousSibling",d)},siblings:function(a){return c.sibling(a.parentNode.firstChild,a)},children:function(a){return c.sibling(a.firstChild)},contents:function(a){return c.nodeName(a,"iframe")? a.contentDocument||a.contentWindow.document:c.makeArray(a.childNodes)}},function(a,b){c.fn[a]=function(d,f){var e=c.map(this,b,d);eb.test(a)||(f=d);if(f&&typeof f==="string")e=c.filter(f,e);e=this.length>1?c.unique(e):e;if((this.length>1||gb.test(f))&&fb.test(a))e=e.reverse();return this.pushStack(e,a,R.call(arguments).join(","))}});c.extend({filter:function(a,b,d){if(d)a=":not("+a+")";return c.find.matches(a,b)},dir:function(a,b,d){var f=[];for(a=a[b];a&&a.nodeType!==9&&(d===w||a.nodeType!==1||!c(a).is(d));){a.nodeType=== 1&&f.push(a);a=a[b]}return f},nth:function(a,b,d){b=b||1;for(var f=0;a;a=a[d])if(a.nodeType===1&&++f===b)break;return a},sibling:function(a,b){for(var d=[];a;a=a.nextSibling)a.nodeType===1&&a!==b&&d.push(a);return d}});var Ja=/ jQuery\d+="(?:\d+|null)"/g,V=/^\s+/,Ka=/(<([\w:]+)[^>]*?)\/>/g,hb=/^(?:area|br|col|embed|hr|img|input|link|meta|param)$/i,La=/<([\w:]+)/,ib=/"},F={option:[1,""],legend:[1,"
","
"],thead:[1,"","
"],tr:[2,"","
"],td:[3,"","
"],col:[2,"","
"],area:[1,"",""],_default:[0,"",""]};F.optgroup=F.option;F.tbody=F.tfoot=F.colgroup=F.caption=F.thead;F.th=F.td;if(!c.support.htmlSerialize)F._default=[1,"div
","
"];c.fn.extend({text:function(a){if(c.isFunction(a))return this.each(function(b){var d= c(this);d.text(a.call(this,b,d.text()))});if(typeof a!=="object"&&a!==w)return this.empty().append((this[0]&&this[0].ownerDocument||s).createTextNode(a));return c.text(this)},wrapAll:function(a){if(c.isFunction(a))return this.each(function(d){c(this).wrapAll(a.call(this,d))});if(this[0]){var b=c(a,this[0].ownerDocument).eq(0).clone(true);this[0].parentNode&&b.insertBefore(this[0]);b.map(function(){for(var d=this;d.firstChild&&d.firstChild.nodeType===1;)d=d.firstChild;return d}).append(this)}return this}, wrapInner:function(a){if(c.isFunction(a))return this.each(function(b){c(this).wrapInner(a.call(this,b))});return this.each(function(){var b=c(this),d=b.contents();d.length?d.wrapAll(a):b.append(a)})},wrap:function(a){return this.each(function(){c(this).wrapAll(a)})},unwrap:function(){return this.parent().each(function(){c.nodeName(this,"body")||c(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,true,function(a){this.nodeType===1&&this.appendChild(a)})}, prepend:function(){return this.domManip(arguments,true,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,false,function(b){this.parentNode.insertBefore(b,this)});else if(arguments.length){var a=c(arguments[0]);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,false,function(b){this.parentNode.insertBefore(b, this.nextSibling)});else if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,c(arguments[0]).toArray());return a}},remove:function(a,b){for(var d=0,f;(f=this[d])!=null;d++)if(!a||c.filter(a,[f]).length){if(!b&&f.nodeType===1){c.cleanData(f.getElementsByTagName("*"));c.cleanData([f])}f.parentNode&&f.parentNode.removeChild(f)}return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++)for(b.nodeType===1&&c.cleanData(b.getElementsByTagName("*"));b.firstChild;)b.removeChild(b.firstChild); return this},clone:function(a){var b=this.map(function(){if(!c.support.noCloneEvent&&!c.isXMLDoc(this)){var d=this.outerHTML,f=this.ownerDocument;if(!d){d=f.createElement("div");d.appendChild(this.cloneNode(true));d=d.innerHTML}return c.clean([d.replace(Ja,"").replace(/=([^="'>\s]+\/)>/g,'="$1">').replace(V,"")],f)[0]}else return this.cloneNode(true)});if(a===true){ra(this,b);ra(this.find("*"),b.find("*"))}return b},html:function(a){if(a===w)return this[0]&&this[0].nodeType===1?this[0].innerHTML.replace(Ja, ""):null;else if(typeof a==="string"&&!ta.test(a)&&(c.support.leadingWhitespace||!V.test(a))&&!F[(La.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Ka,Ma);try{for(var b=0,d=this.length;b0||e.cacheable||this.length>1?k.cloneNode(true):k)}o.length&&c.each(o,Qa)}return this}});c.fragments={};c.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){c.fn[a]=function(d){var f=[];d=c(d);var e=this.length===1&&this[0].parentNode;if(e&&e.nodeType===11&&e.childNodes.length===1&&d.length===1){d[b](this[0]); return this}else{e=0;for(var j=d.length;e0?this.clone(true):this).get();c.fn[b].apply(c(d[e]),i);f=f.concat(i)}return this.pushStack(f,a,d.selector)}}});c.extend({clean:function(a,b,d,f){b=b||s;if(typeof b.createElement==="undefined")b=b.ownerDocument||b[0]&&b[0].ownerDocument||s;for(var e=[],j=0,i;(i=a[j])!=null;j++){if(typeof i==="number")i+="";if(i){if(typeof i==="string"&&!jb.test(i))i=b.createTextNode(i);else if(typeof i==="string"){i=i.replace(Ka,Ma);var o=(La.exec(i)||["", ""])[1].toLowerCase(),k=F[o]||F._default,n=k[0],r=b.createElement("div");for(r.innerHTML=k[1]+i+k[2];n--;)r=r.lastChild;if(!c.support.tbody){n=ib.test(i);o=o==="table"&&!n?r.firstChild&&r.firstChild.childNodes:k[1]===""&&!n?r.childNodes:[];for(k=o.length-1;k>=0;--k)c.nodeName(o[k],"tbody")&&!o[k].childNodes.length&&o[k].parentNode.removeChild(o[k])}!c.support.leadingWhitespace&&V.test(i)&&r.insertBefore(b.createTextNode(V.exec(i)[0]),r.firstChild);i=r.childNodes}if(i.nodeType)e.push(i);else e= c.merge(e,i)}}if(d)for(j=0;e[j];j++)if(f&&c.nodeName(e[j],"script")&&(!e[j].type||e[j].type.toLowerCase()==="text/javascript"))f.push(e[j].parentNode?e[j].parentNode.removeChild(e[j]):e[j]);else{e[j].nodeType===1&&e.splice.apply(e,[j+1,0].concat(c.makeArray(e[j].getElementsByTagName("script"))));d.appendChild(e[j])}return e},cleanData:function(a){for(var b,d,f=c.cache,e=c.event.special,j=c.support.deleteExpando,i=0,o;(o=a[i])!=null;i++)if(d=o[c.expando]){b=f[d];if(b.events)for(var k in b.events)e[k]? c.event.remove(o,k):Ca(o,k,b.handle);if(j)delete o[c.expando];else o.removeAttribute&&o.removeAttribute(c.expando);delete f[d]}}});var kb=/z-?index|font-?weight|opacity|zoom|line-?height/i,Na=/alpha\([^)]*\)/,Oa=/opacity=([^)]*)/,ha=/float/i,ia=/-([a-z])/ig,lb=/([A-Z])/g,mb=/^-?\d+(?:px)?$/i,nb=/^-?\d/,ob={position:"absolute",visibility:"hidden",display:"block"},pb=["Left","Right"],qb=["Top","Bottom"],rb=s.defaultView&&s.defaultView.getComputedStyle,Pa=c.support.cssFloat?"cssFloat":"styleFloat",ja= function(a,b){return b.toUpperCase()};c.fn.css=function(a,b){return X(this,a,b,true,function(d,f,e){if(e===w)return c.curCSS(d,f);if(typeof e==="number"&&!kb.test(f))e+="px";c.style(d,f,e)})};c.extend({style:function(a,b,d){if(!a||a.nodeType===3||a.nodeType===8)return w;if((b==="width"||b==="height")&&parseFloat(d)<0)d=w;var f=a.style||a,e=d!==w;if(!c.support.opacity&&b==="opacity"){if(e){f.zoom=1;b=parseInt(d,10)+""==="NaN"?"":"alpha(opacity="+d*100+")";a=f.filter||c.curCSS(a,"filter")||"";f.filter= Na.test(a)?a.replace(Na,b):b}return f.filter&&f.filter.indexOf("opacity=")>=0?parseFloat(Oa.exec(f.filter)[1])/100+"":""}if(ha.test(b))b=Pa;b=b.replace(ia,ja);if(e)f[b]=d;return f[b]},css:function(a,b,d,f){if(b==="width"||b==="height"){var e,j=b==="width"?pb:qb;function i(){e=b==="width"?a.offsetWidth:a.offsetHeight;f!=="border"&&c.each(j,function(){f||(e-=parseFloat(c.curCSS(a,"padding"+this,true))||0);if(f==="margin")e+=parseFloat(c.curCSS(a,"margin"+this,true))||0;else e-=parseFloat(c.curCSS(a, "border"+this+"Width",true))||0})}a.offsetWidth!==0?i():c.swap(a,ob,i);return Math.max(0,Math.round(e))}return c.curCSS(a,b,d)},curCSS:function(a,b,d){var f,e=a.style;if(!c.support.opacity&&b==="opacity"&&a.currentStyle){f=Oa.test(a.currentStyle.filter||"")?parseFloat(RegExp.$1)/100+"":"";return f===""?"1":f}if(ha.test(b))b=Pa;if(!d&&e&&e[b])f=e[b];else if(rb){if(ha.test(b))b="float";b=b.replace(lb,"-$1").toLowerCase();e=a.ownerDocument.defaultView;if(!e)return null;if(a=e.getComputedStyle(a,null))f= a.getPropertyValue(b);if(b==="opacity"&&f==="")f="1"}else if(a.currentStyle){d=b.replace(ia,ja);f=a.currentStyle[b]||a.currentStyle[d];if(!mb.test(f)&&nb.test(f)){b=e.left;var j=a.runtimeStyle.left;a.runtimeStyle.left=a.currentStyle.left;e.left=d==="fontSize"?"1em":f||0;f=e.pixelLeft+"px";e.left=b;a.runtimeStyle.left=j}}return f},swap:function(a,b,d){var f={};for(var e in b){f[e]=a.style[e];a.style[e]=b[e]}d.call(a);for(e in b)a.style[e]=f[e]}});if(c.expr&&c.expr.filters){c.expr.filters.hidden=function(a){var b= a.offsetWidth,d=a.offsetHeight,f=a.nodeName.toLowerCase()==="tr";return b===0&&d===0&&!f?true:b>0&&d>0&&!f?false:c.curCSS(a,"display")==="none"};c.expr.filters.visible=function(a){return!c.expr.filters.hidden(a)}}var sb=J(),tb=//gi,ub=/select|textarea/i,vb=/color|date|datetime|email|hidden|month|number|password|range|search|tel|text|time|url|week/i,N=/=\?(&|$)/,ka=/\?/,wb=/(\?|&)_=.*?(&|$)/,xb=/^(\w+:)?\/\/([^\/?#]+)/,yb=/%20/g,zb=c.fn.load;c.fn.extend({load:function(a,b,d){if(typeof a!== "string")return zb.call(this,a);else if(!this.length)return this;var f=a.indexOf(" ");if(f>=0){var e=a.slice(f,a.length);a=a.slice(0,f)}f="GET";if(b)if(c.isFunction(b)){d=b;b=null}else if(typeof b==="object"){b=c.param(b,c.ajaxSettings.traditional);f="POST"}var j=this;c.ajax({url:a,type:f,dataType:"html",data:b,complete:function(i,o){if(o==="success"||o==="notmodified")j.html(e?c("
").append(i.responseText.replace(tb,"")).find(e):i.responseText);d&&j.each(d,[i.responseText,o,i])}});return this}, serialize:function(){return c.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?c.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||ub.test(this.nodeName)||vb.test(this.type))}).map(function(a,b){a=c(this).val();return a==null?null:c.isArray(a)?c.map(a,function(d){return{name:b.name,value:d}}):{name:b.name,value:a}}).get()}});c.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "), function(a,b){c.fn[b]=function(d){return this.bind(b,d)}});c.extend({get:function(a,b,d,f){if(c.isFunction(b)){f=f||d;d=b;b=null}return c.ajax({type:"GET",url:a,data:b,success:d,dataType:f})},getScript:function(a,b){return c.get(a,null,b,"script")},getJSON:function(a,b,d){return c.get(a,b,d,"json")},post:function(a,b,d,f){if(c.isFunction(b)){f=f||d;d=b;b={}}return c.ajax({type:"POST",url:a,data:b,success:d,dataType:f})},ajaxSetup:function(a){c.extend(c.ajaxSettings,a)},ajaxSettings:{url:location.href, global:true,type:"GET",contentType:"application/x-www-form-urlencoded",processData:true,async:true,xhr:A.XMLHttpRequest&&(A.location.protocol!=="file:"||!A.ActiveXObject)?function(){return new A.XMLHttpRequest}:function(){try{return new A.ActiveXObject("Microsoft.XMLHTTP")}catch(a){}},accepts:{xml:"application/xml, text/xml",html:"text/html",script:"text/javascript, application/javascript",json:"application/json, text/javascript",text:"text/plain",_default:"*/*"}},lastModified:{},etag:{},ajax:function(a){function b(){e.success&& e.success.call(k,o,i,x);e.global&&f("ajaxSuccess",[x,e])}function d(){e.complete&&e.complete.call(k,x,i);e.global&&f("ajaxComplete",[x,e]);e.global&&!--c.active&&c.event.trigger("ajaxStop")}function f(q,p){(e.context?c(e.context):c.event).trigger(q,p)}var e=c.extend(true,{},c.ajaxSettings,a),j,i,o,k=a&&a.context||e,n=e.type.toUpperCase();if(e.data&&e.processData&&typeof e.data!=="string")e.data=c.param(e.data,e.traditional);if(e.dataType==="jsonp"){if(n==="GET")N.test(e.url)||(e.url+=(ka.test(e.url)? "&":"?")+(e.jsonp||"callback")+"=?");else if(!e.data||!N.test(e.data))e.data=(e.data?e.data+"&":"")+(e.jsonp||"callback")+"=?";e.dataType="json"}if(e.dataType==="json"&&(e.data&&N.test(e.data)||N.test(e.url))){j=e.jsonpCallback||"jsonp"+sb++;if(e.data)e.data=(e.data+"").replace(N,"="+j+"$1");e.url=e.url.replace(N,"="+j+"$1");e.dataType="script";A[j]=A[j]||function(q){o=q;b();d();A[j]=w;try{delete A[j]}catch(p){}z&&z.removeChild(C)}}if(e.dataType==="script"&&e.cache===null)e.cache=false;if(e.cache=== false&&n==="GET"){var r=J(),u=e.url.replace(wb,"$1_="+r+"$2");e.url=u+(u===e.url?(ka.test(e.url)?"&":"?")+"_="+r:"")}if(e.data&&n==="GET")e.url+=(ka.test(e.url)?"&":"?")+e.data;e.global&&!c.active++&&c.event.trigger("ajaxStart");r=(r=xb.exec(e.url))&&(r[1]&&r[1]!==location.protocol||r[2]!==location.host);if(e.dataType==="script"&&n==="GET"&&r){var z=s.getElementsByTagName("head")[0]||s.documentElement,C=s.createElement("script");C.src=e.url;if(e.scriptCharset)C.charset=e.scriptCharset;if(!j){var B= false;C.onload=C.onreadystatechange=function(){if(!B&&(!this.readyState||this.readyState==="loaded"||this.readyState==="complete")){B=true;b();d();C.onload=C.onreadystatechange=null;z&&C.parentNode&&z.removeChild(C)}}}z.insertBefore(C,z.firstChild);return w}var E=false,x=e.xhr();if(x){e.username?x.open(n,e.url,e.async,e.username,e.password):x.open(n,e.url,e.async);try{if(e.data||a&&a.contentType)x.setRequestHeader("Content-Type",e.contentType);if(e.ifModified){c.lastModified[e.url]&&x.setRequestHeader("If-Modified-Since", c.lastModified[e.url]);c.etag[e.url]&&x.setRequestHeader("If-None-Match",c.etag[e.url])}r||x.setRequestHeader("X-Requested-With","XMLHttpRequest");x.setRequestHeader("Accept",e.dataType&&e.accepts[e.dataType]?e.accepts[e.dataType]+", */*":e.accepts._default)}catch(ga){}if(e.beforeSend&&e.beforeSend.call(k,x,e)===false){e.global&&!--c.active&&c.event.trigger("ajaxStop");x.abort();return false}e.global&&f("ajaxSend",[x,e]);var g=x.onreadystatechange=function(q){if(!x||x.readyState===0||q==="abort"){E|| d();E=true;if(x)x.onreadystatechange=c.noop}else if(!E&&x&&(x.readyState===4||q==="timeout")){E=true;x.onreadystatechange=c.noop;i=q==="timeout"?"timeout":!c.httpSuccess(x)?"error":e.ifModified&&c.httpNotModified(x,e.url)?"notmodified":"success";var p;if(i==="success")try{o=c.httpData(x,e.dataType,e)}catch(v){i="parsererror";p=v}if(i==="success"||i==="notmodified")j||b();else c.handleError(e,x,i,p);d();q==="timeout"&&x.abort();if(e.async)x=null}};try{var h=x.abort;x.abort=function(){x&&h.call(x); g("abort")}}catch(l){}e.async&&e.timeout>0&&setTimeout(function(){x&&!E&&g("timeout")},e.timeout);try{x.send(n==="POST"||n==="PUT"||n==="DELETE"?e.data:null)}catch(m){c.handleError(e,x,null,m);d()}e.async||g();return x}},handleError:function(a,b,d,f){if(a.error)a.error.call(a.context||a,b,d,f);if(a.global)(a.context?c(a.context):c.event).trigger("ajaxError",[b,a,f])},active:0,httpSuccess:function(a){try{return!a.status&&location.protocol==="file:"||a.status>=200&&a.status<300||a.status===304||a.status=== 1223||a.status===0}catch(b){}return false},httpNotModified:function(a,b){var d=a.getResponseHeader("Last-Modified"),f=a.getResponseHeader("Etag");if(d)c.lastModified[b]=d;if(f)c.etag[b]=f;return a.status===304||a.status===0},httpData:function(a,b,d){var f=a.getResponseHeader("content-type")||"",e=b==="xml"||!b&&f.indexOf("xml")>=0;a=e?a.responseXML:a.responseText;e&&a.documentElement.nodeName==="parsererror"&&c.error("parsererror");if(d&&d.dataFilter)a=d.dataFilter(a,b);if(typeof a==="string")if(b=== "json"||!b&&f.indexOf("json")>=0)a=c.parseJSON(a);else if(b==="script"||!b&&f.indexOf("javascript")>=0)c.globalEval(a);return a},param:function(a,b){function d(i,o){if(c.isArray(o))c.each(o,function(k,n){b||/\[\]$/.test(i)?f(i,n):d(i+"["+(typeof n==="object"||c.isArray(n)?k:"")+"]",n)});else!b&&o!=null&&typeof o==="object"?c.each(o,function(k,n){d(i+"["+k+"]",n)}):f(i,o)}function f(i,o){o=c.isFunction(o)?o():o;e[e.length]=encodeURIComponent(i)+"="+encodeURIComponent(o)}var e=[];if(b===w)b=c.ajaxSettings.traditional; if(c.isArray(a)||a.jquery)c.each(a,function(){f(this.name,this.value)});else for(var j in a)d(j,a[j]);return e.join("&").replace(yb,"+")}});var la={},Ab=/toggle|show|hide/,Bb=/^([+-]=)?([\d+-.]+)(.*)$/,W,va=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]];c.fn.extend({show:function(a,b){if(a||a===0)return this.animate(K("show",3),a,b);else{a=0;for(b=this.length;a").appendTo("body");f=e.css("display");if(f==="none")f="block";e.remove();la[d]=f}c.data(this[a],"olddisplay",f)}}a=0;for(b=this.length;a=0;f--)if(d[f].elem===this){b&&d[f](true);d.splice(f,1)}});b||this.dequeue();return this}});c.each({slideDown:K("show",1),slideUp:K("hide",1),slideToggle:K("toggle",1),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"}},function(a,b){c.fn[a]=function(d,f){return this.animate(b,d,f)}});c.extend({speed:function(a,b,d){var f=a&&typeof a==="object"?a:{complete:d||!d&&b||c.isFunction(a)&&a,duration:a,easing:d&&b||b&&!c.isFunction(b)&&b};f.duration=c.fx.off?0:typeof f.duration=== "number"?f.duration:c.fx.speeds[f.duration]||c.fx.speeds._default;f.old=f.complete;f.complete=function(){f.queue!==false&&c(this).dequeue();c.isFunction(f.old)&&f.old.call(this)};return f},easing:{linear:function(a,b,d,f){return d+f*a},swing:function(a,b,d,f){return(-Math.cos(a*Math.PI)/2+0.5)*f+d}},timers:[],fx:function(a,b,d){this.options=b;this.elem=a;this.prop=d;if(!b.orig)b.orig={}}});c.fx.prototype={update:function(){this.options.step&&this.options.step.call(this.elem,this.now,this);(c.fx.step[this.prop]|| c.fx.step._default)(this);if((this.prop==="height"||this.prop==="width")&&this.elem.style)this.elem.style.display="block"},cur:function(a){if(this.elem[this.prop]!=null&&(!this.elem.style||this.elem.style[this.prop]==null))return this.elem[this.prop];return(a=parseFloat(c.css(this.elem,this.prop,a)))&&a>-10000?a:parseFloat(c.curCSS(this.elem,this.prop))||0},custom:function(a,b,d){function f(j){return e.step(j)}this.startTime=J();this.start=a;this.end=b;this.unit=d||this.unit||"px";this.now=this.start; this.pos=this.state=0;var e=this;f.elem=this.elem;if(f()&&c.timers.push(f)&&!W)W=setInterval(c.fx.tick,13)},show:function(){this.options.orig[this.prop]=c.style(this.elem,this.prop);this.options.show=true;this.custom(this.prop==="width"||this.prop==="height"?1:0,this.cur());c(this.elem).show()},hide:function(){this.options.orig[this.prop]=c.style(this.elem,this.prop);this.options.hide=true;this.custom(this.cur(),0)},step:function(a){var b=J(),d=true;if(a||b>=this.options.duration+this.startTime){this.now= this.end;this.pos=this.state=1;this.update();this.options.curAnim[this.prop]=true;for(var f in this.options.curAnim)if(this.options.curAnim[f]!==true)d=false;if(d){if(this.options.display!=null){this.elem.style.overflow=this.options.overflow;a=c.data(this.elem,"olddisplay");this.elem.style.display=a?a:this.options.display;if(c.css(this.elem,"display")==="none")this.elem.style.display="block"}this.options.hide&&c(this.elem).hide();if(this.options.hide||this.options.show)for(var e in this.options.curAnim)c.style(this.elem, e,this.options.orig[e]);this.options.complete.call(this.elem)}return false}else{e=b-this.startTime;this.state=e/this.options.duration;a=this.options.easing||(c.easing.swing?"swing":"linear");this.pos=c.easing[this.options.specialEasing&&this.options.specialEasing[this.prop]||a](this.state,e,0,1,this.options.duration);this.now=this.start+(this.end-this.start)*this.pos;this.update()}return true}};c.extend(c.fx,{tick:function(){for(var a=c.timers,b=0;b
"; a.insertBefore(b,a.firstChild);d=b.firstChild;f=d.firstChild;e=d.nextSibling.firstChild.firstChild;this.doesNotAddBorder=f.offsetTop!==5;this.doesAddBorderForTableAndCells=e.offsetTop===5;f.style.position="fixed";f.style.top="20px";this.supportsFixedPosition=f.offsetTop===20||f.offsetTop===15;f.style.position=f.style.top="";d.style.overflow="hidden";d.style.position="relative";this.subtractsBorderForOverflowNotVisible=f.offsetTop===-5;this.doesNotIncludeMarginInBodyOffset=a.offsetTop!==j;a.removeChild(b); c.offset.initialize=c.noop},bodyOffset:function(a){var b=a.offsetTop,d=a.offsetLeft;c.offset.initialize();if(c.offset.doesNotIncludeMarginInBodyOffset){b+=parseFloat(c.curCSS(a,"marginTop",true))||0;d+=parseFloat(c.curCSS(a,"marginLeft",true))||0}return{top:b,left:d}},setOffset:function(a,b,d){if(/static/.test(c.curCSS(a,"position")))a.style.position="relative";var f=c(a),e=f.offset(),j=parseInt(c.curCSS(a,"top",true),10)||0,i=parseInt(c.curCSS(a,"left",true),10)||0;if(c.isFunction(b))b=b.call(a, d,e);d={top:b.top-e.top+j,left:b.left-e.left+i};"using"in b?b.using.call(a,d):f.css(d)}};c.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),d=this.offset(),f=/^body|html$/i.test(b[0].nodeName)?{top:0,left:0}:b.offset();d.top-=parseFloat(c.curCSS(a,"marginTop",true))||0;d.left-=parseFloat(c.curCSS(a,"marginLeft",true))||0;f.top+=parseFloat(c.curCSS(b[0],"borderTopWidth",true))||0;f.left+=parseFloat(c.curCSS(b[0],"borderLeftWidth",true))||0;return{top:d.top- f.top,left:d.left-f.left}},offsetParent:function(){return this.map(function(){for(var a=this.offsetParent||s.body;a&&!/^body|html$/i.test(a.nodeName)&&c.css(a,"position")==="static";)a=a.offsetParent;return a})}});c.each(["Left","Top"],function(a,b){var d="scroll"+b;c.fn[d]=function(f){var e=this[0],j;if(!e)return null;if(f!==w)return this.each(function(){if(j=wa(this))j.scrollTo(!a?f:c(j).scrollLeft(),a?f:c(j).scrollTop());else this[d]=f});else return(j=wa(e))?"pageXOffset"in j?j[a?"pageYOffset": "pageXOffset"]:c.support.boxModel&&j.document.documentElement[d]||j.document.body[d]:e[d]}});c.each(["Height","Width"],function(a,b){var d=b.toLowerCase();c.fn["inner"+b]=function(){return this[0]?c.css(this[0],d,false,"padding"):null};c.fn["outer"+b]=function(f){return this[0]?c.css(this[0],d,false,f?"margin":"border"):null};c.fn[d]=function(f){var e=this[0];if(!e)return f==null?null:this;if(c.isFunction(f))return this.each(function(j){var i=c(this);i[d](f.call(this,j,i[d]()))});return"scrollTo"in e&&e.document?e.document.compatMode==="CSS1Compat"&&e.document.documentElement["client"+b]||e.document.body["client"+b]:e.nodeType===9?Math.max(e.documentElement["client"+b],e.body["scroll"+b],e.documentElement["scroll"+b],e.body["offset"+b],e.documentElement["offset"+b]):f===w?c.css(e,d):this.css(d,typeof f==="string"?f:f+"px")}});A.jQuery=A.$=c})(window); ahven-2.1/doc/manual/en/build/html/_static/minus.png0000664000076400007640000000030711571062662022713 0ustar tkoskinetkoskinePNG  IHDR &q pHYs  tIME <8tEXtComment̖RIDATc H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-bKGD pHYs  tIME 1;VIDAT8ukU?sg4h`G1 RQܸp%Bn"bЍXJ .4V iZ##T;m!4bP~7r>ιbwc;m;oӍAΆ ζZ^/|s{;yR=9(rtVoG1w#_ө{*E&!(LVuoᲵ‘D PG4 :&~*ݳreu: S-,U^E&JY[P!RB ŖޞʖR@_ȐdBfNvHf"2T]R j'B1ddAak/DIJD D2H&L`&L $Ex,6|~_\P $MH`I=@Z||ttvgcЕWTZ'3rje"ܵx9W> mb|byfFRx{w%DZC$wdցHmWnta(M<~;9]C/_;Տ#}o`zSڷ_>:;x컓?yݩ|}~wam-/7=0S5RP"*֯ IENDB`ahven-2.1/doc/manual/en/build/html/_static/down.png0000664000076400007640000000055311571062662022532 0ustar tkoskinetkoskinePNG  IHDRasRGBbKGDC pHYs B(xtIME"U{IDAT8ҡNCAJ, ++@4>/U^,~T&3M^^^PM6ٹs*RJa)eG*W<"F Fg78G>q OIp:sAj5GنyD^+yU:p_%G@D|aOs(yM,"msx:.b@D|`Vٟ۲иeKſ/G!IENDB`ahven-2.1/doc/manual/en/build/html/_static/underscore.js0000664000076400007640000002001511571062662023557 0ustar tkoskinetkoskine(function(){var j=this,n=j._,i=function(a){this._wrapped=a},m=typeof StopIteration!=="undefined"?StopIteration:"__break__",b=j._=function(a){return new i(a)};if(typeof exports!=="undefined")exports._=b;var k=Array.prototype.slice,o=Array.prototype.unshift,p=Object.prototype.toString,q=Object.prototype.hasOwnProperty,r=Object.prototype.propertyIsEnumerable;b.VERSION="0.5.5";b.each=function(a,c,d){try{if(a.forEach)a.forEach(c,d);else if(b.isArray(a)||b.isArguments(a))for(var e=0,f=a.length;e=e.computed&&(e={value:f,computed:g})});return e.value};b.min=function(a,c,d){if(!c&&b.isArray(a))return Math.min.apply(Math,a);var e={computed:Infinity};b.each(a,function(f,g,h){g=c?c.call(d,f,g,h):f;gf?1:0}),"value")};b.sortedIndex=function(a,c,d){d=d||b.identity;for(var e=0,f=a.length;e>1;d(a[g])=0})})};b.zip=function(){for(var a=b.toArray(arguments),c=b.max(b.pluck(a,"length")),d=new Array(c),e=0;e0?f-c:c-f)>=0)return e;e[g++]=f}};b.bind=function(a,c){var d=b.rest(arguments,2);return function(){return a.apply(c||j,d.concat(b.toArray(arguments)))}};b.bindAll=function(a){var c=b.rest(arguments);if(c.length==0)c=b.functions(a);b.each(c,function(d){a[d]=b.bind(a[d],a)}); return a};b.delay=function(a,c){var d=b.rest(arguments,2);return setTimeout(function(){return a.apply(a,d)},c)};b.defer=function(a){return b.delay.apply(b,[a,1].concat(b.rest(arguments)))};b.wrap=function(a,c){return function(){var d=[a].concat(b.toArray(arguments));return c.apply(c,d)}};b.compose=function(){var a=b.toArray(arguments);return function(){for(var c=b.toArray(arguments),d=a.length-1;d>=0;d--)c=[a[d].apply(this,c)];return c[0]}};b.keys=function(a){if(b.isArray(a))return b.range(0,a.length); var c=[];for(var d in a)q.call(a,d)&&c.push(d);return c};b.values=function(a){return b.map(a,b.identity)};b.functions=function(a){return b.select(b.keys(a),function(c){return b.isFunction(a[c])}).sort()};b.extend=function(a,c){for(var d in c)a[d]=c[d];return a};b.clone=function(a){if(b.isArray(a))return a.slice(0);return b.extend({},a)};b.tap=function(a,c){c(a);return a};b.isEqual=function(a,c){if(a===c)return true;var d=typeof a;if(d!=typeof c)return false;if(a==c)return true;if(!a&&c||a&&!c)return false; if(a.isEqual)return a.isEqual(c);if(b.isDate(a)&&b.isDate(c))return a.getTime()===c.getTime();if(b.isNaN(a)&&b.isNaN(c))return true;if(b.isRegExp(a)&&b.isRegExp(c))return a.source===c.source&&a.global===c.global&&a.ignoreCase===c.ignoreCase&&a.multiline===c.multiline;if(d!=="object")return false;if(a.length&&a.length!==c.length)return false;d=b.keys(a);var e=b.keys(c);if(d.length!=e.length)return false;for(var f in a)if(!b.isEqual(a[f],c[f]))return false;return true};b.isEmpty=function(a){return b.keys(a).length== 0};b.isElement=function(a){return!!(a&&a.nodeType==1)};b.isArray=function(a){return!!(a&&a.concat&&a.unshift)};b.isArguments=function(a){return a&&b.isNumber(a.length)&&!b.isArray(a)&&!r.call(a,"length")};b.isFunction=function(a){return!!(a&&a.constructor&&a.call&&a.apply)};b.isString=function(a){return!!(a===""||a&&a.charCodeAt&&a.substr)};b.isNumber=function(a){return p.call(a)==="[object Number]"};b.isDate=function(a){return!!(a&&a.getTimezoneOffset&&a.setUTCFullYear)};b.isRegExp=function(a){return!!(a&& a.test&&a.exec&&(a.ignoreCase||a.ignoreCase===false))};b.isNaN=function(a){return b.isNumber(a)&&isNaN(a)};b.isNull=function(a){return a===null};b.isUndefined=function(a){return typeof a=="undefined"};b.noConflict=function(){j._=n;return this};b.identity=function(a){return a};b.breakLoop=function(){throw m;};var s=0;b.uniqueId=function(a){var c=s++;return a?a+c:c};b.template=function(a,c){a=new Function("obj","var p=[],print=function(){p.push.apply(p,arguments);};with(obj){p.push('"+a.replace(/[\r\t\n]/g, " ").replace(/'(?=[^%]*%>)/g,"\t").split("'").join("\\'").split("\t").join("'").replace(/<%=(.+?)%>/g,"',$1,'").split("<%").join("');").split("%>").join("p.push('")+"');}return p.join('');");return c?a(c):a};b.forEach=b.each;b.foldl=b.inject=b.reduce;b.foldr=b.reduceRight;b.filter=b.select;b.every=b.all;b.some=b.any;b.head=b.first;b.tail=b.rest;b.methods=b.functions;var l=function(a,c){return c?b(a).chain():a};b.each(b.functions(b),function(a){var c=b[a];i.prototype[a]=function(){var d=b.toArray(arguments); o.call(d,this._wrapped);return l(c.apply(b,d),this._chain)}});b.each(["pop","push","reverse","shift","sort","splice","unshift"],function(a){var c=Array.prototype[a];i.prototype[a]=function(){c.apply(this._wrapped,arguments);return l(this._wrapped,this._chain)}});b.each(["concat","join","slice"],function(a){var c=Array.prototype[a];i.prototype[a]=function(){return l(c.apply(this._wrapped,arguments),this._chain)}});i.prototype.chain=function(){this._chain=true;return this};i.prototype.value=function(){return this._wrapped}})(); ahven-2.1/doc/manual/en/build/html/_static/file.png0000664000076400007640000000061011571062662022474 0ustar tkoskinetkoskinePNG  IHDRabKGD pHYs  tIME  )TIDAT8˭J@Ir('[ "&xYZ X0!i|_@tD] #xjv YNaEi(əy@D&`6PZk$)5%"z.NA#Aba`Vs_3c,2mj [klvy|!Iմy;v "߮a?A7`c^nk?Bg}TЙD# "RD1yER*6MJ3K_Ut8F~IENDB`ahven-2.1/doc/manual/en/build/html/_static/comment-bright.png0000664000076400007640000000665411571062662024512 0ustar tkoskinetkoskinePNG  IHDRa OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-bKGD pHYs  tIME 6 B\<IDAT8˅Kh]es1mA`jh[-E(FEaA!bIȐ*BX"؁4)NURZ!Mhjssm؋^-\gg ]o|Ҭ[346>zd ]#8Oݺt{5uIXN!I=@Vf=v1}e>;fvnvxaHrʪJF`D¹WZ]S%S)WAb |0K=So7D~\~q-˟\aMZ,S'*} F`Nnz674U)- EYm4%7YTk-Qa"NWAo-yeq,) Ypt\hqmszG]Nar߶s^l vh\2%0EeRvIENDB`ahven-2.1/doc/manual/en/build/html/_static/searchtools.js0000664000076400007640000003425511571062662023747 0ustar tkoskinetkoskine/* * searchtools.js * ~~~~~~~~~~~~~~ * * Sphinx JavaScript utilties for the full-text search. * * :copyright: Copyright 2007-2010 by the Sphinx team, see AUTHORS. * :license: BSD, see LICENSE for details. * */ /** * helper function to return a node containing the * search summary for a given text. keywords is a list * of stemmed words, hlwords is the list of normal, unstemmed * words. the first one is used to find the occurance, the * latter for highlighting it. */ jQuery.makeSearchSummary = function(text, keywords, hlwords) { var textLower = text.toLowerCase(); var start = 0; $.each(keywords, function() { var i = textLower.indexOf(this.toLowerCase()); if (i > -1) start = i; }); start = Math.max(start - 120, 0); var excerpt = ((start > 0) ? '...' : '') + $.trim(text.substr(start, 240)) + ((start + 240 - text.length) ? '...' : ''); var rv = $('
').text(excerpt); $.each(hlwords, function() { rv = rv.highlightText(this, 'highlighted'); }); return rv; } /** * Porter Stemmer */ var PorterStemmer = function() { var step2list = { ational: 'ate', tional: 'tion', enci: 'ence', anci: 'ance', izer: 'ize', bli: 'ble', alli: 'al', entli: 'ent', eli: 'e', ousli: 'ous', ization: 'ize', ation: 'ate', ator: 'ate', alism: 'al', iveness: 'ive', fulness: 'ful', ousness: 'ous', aliti: 'al', iviti: 'ive', biliti: 'ble', logi: 'log' }; var step3list = { icate: 'ic', ative: '', alize: 'al', iciti: 'ic', ical: 'ic', ful: '', ness: '' }; var c = "[^aeiou]"; // consonant var v = "[aeiouy]"; // vowel var C = c + "[^aeiouy]*"; // consonant sequence var V = v + "[aeiou]*"; // vowel sequence var mgr0 = "^(" + C + ")?" + V + C; // [C]VC... is m>0 var meq1 = "^(" + C + ")?" + V + C + "(" + V + ")?$"; // [C]VC[V] is m=1 var mgr1 = "^(" + C + ")?" + V + C + V + C; // [C]VCVC... is m>1 var s_v = "^(" + C + ")?" + v; // vowel in stem this.stemWord = function (w) { var stem; var suffix; var firstch; var origword = w; if (w.length < 3) return w; var re; var re2; var re3; var re4; firstch = w.substr(0,1); if (firstch == "y") w = firstch.toUpperCase() + w.substr(1); // Step 1a re = /^(.+?)(ss|i)es$/; re2 = /^(.+?)([^s])s$/; if (re.test(w)) w = w.replace(re,"$1$2"); else if (re2.test(w)) w = w.replace(re2,"$1$2"); // Step 1b re = /^(.+?)eed$/; re2 = /^(.+?)(ed|ing)$/; if (re.test(w)) { var fp = re.exec(w); re = new RegExp(mgr0); if (re.test(fp[1])) { re = /.$/; w = w.replace(re,""); } } else if (re2.test(w)) { var fp = re2.exec(w); stem = fp[1]; re2 = new RegExp(s_v); if (re2.test(stem)) { w = stem; re2 = /(at|bl|iz)$/; re3 = new RegExp("([^aeiouylsz])\\1$"); re4 = new RegExp("^" + C + v + "[^aeiouwxy]$"); if (re2.test(w)) w = w + "e"; else if (re3.test(w)) { re = /.$/; w = w.replace(re,""); } else if (re4.test(w)) w = w + "e"; } } // Step 1c re = /^(.+?)y$/; if (re.test(w)) { var fp = re.exec(w); stem = fp[1]; re = new RegExp(s_v); if (re.test(stem)) w = stem + "i"; } // Step 2 re = /^(.+?)(ational|tional|enci|anci|izer|bli|alli|entli|eli|ousli|ization|ation|ator|alism|iveness|fulness|ousness|aliti|iviti|biliti|logi)$/; if (re.test(w)) { var fp = re.exec(w); stem = fp[1]; suffix = fp[2]; re = new RegExp(mgr0); if (re.test(stem)) w = stem + step2list[suffix]; } // Step 3 re = /^(.+?)(icate|ative|alize|iciti|ical|ful|ness)$/; if (re.test(w)) { var fp = re.exec(w); stem = fp[1]; suffix = fp[2]; re = new RegExp(mgr0); if (re.test(stem)) w = stem + step3list[suffix]; } // Step 4 re = /^(.+?)(al|ance|ence|er|ic|able|ible|ant|ement|ment|ent|ou|ism|ate|iti|ous|ive|ize)$/; re2 = /^(.+?)(s|t)(ion)$/; if (re.test(w)) { var fp = re.exec(w); stem = fp[1]; re = new RegExp(mgr1); if (re.test(stem)) w = stem; } else if (re2.test(w)) { var fp = re2.exec(w); stem = fp[1] + fp[2]; re2 = new RegExp(mgr1); if (re2.test(stem)) w = stem; } // Step 5 re = /^(.+?)e$/; if (re.test(w)) { var fp = re.exec(w); stem = fp[1]; re = new RegExp(mgr1); re2 = new RegExp(meq1); re3 = new RegExp("^" + C + v + "[^aeiouwxy]$"); if (re.test(stem) || (re2.test(stem) && !(re3.test(stem)))) w = stem; } re = /ll$/; re2 = new RegExp(mgr1); if (re.test(w) && re2.test(w)) { re = /.$/; w = w.replace(re,""); } // and turn initial Y back to y if (firstch == "y") w = firstch.toLowerCase() + w.substr(1); return w; } } /** * Search Module */ var Search = { _index : null, _queued_query : null, _pulse_status : -1, init : function() { var params = $.getQueryParameters(); if (params.q) { var query = params.q[0]; $('input[name="q"]')[0].value = query; this.performSearch(query); } }, loadIndex : function(url) { $.ajax({type: "GET", url: url, data: null, success: null, dataType: "script", cache: true}); }, setIndex : function(index) { var q; this._index = index; if ((q = this._queued_query) !== null) { this._queued_query = null; Search.query(q); } }, hasIndex : function() { return this._index !== null; }, deferQuery : function(query) { this._queued_query = query; }, stopPulse : function() { this._pulse_status = 0; }, startPulse : function() { if (this._pulse_status >= 0) return; function pulse() { Search._pulse_status = (Search._pulse_status + 1) % 4; var dotString = ''; for (var i = 0; i < Search._pulse_status; i++) dotString += '.'; Search.dots.text(dotString); if (Search._pulse_status > -1) window.setTimeout(pulse, 500); }; pulse(); }, /** * perform a search for something */ performSearch : function(query) { // create the required interface elements this.out = $('#search-results'); this.title = $('

' + _('Searching') + '

').appendTo(this.out); this.dots = $('').appendTo(this.title); this.status = $('

').appendTo(this.out); this.output = $('