libaunit-1.03.orig/0000755000175000017500000000000010503342774014050 5ustar lbrentalbrentalibaunit-1.03.orig/AUnit.html0000644000175000017500000005315310174226713015763 0ustar lbrentalbrenta

AUnit Cookbook

Version 1.03


This is a short guide for using the AUnit test framework. AUnit is an adaptation of the Java JUnit (Kent Beck, Erich Gamma) unit test framework for Ada code. This document is adapted from the JUnit Cookbook document contained in the JUnit release package.

Simple Test Case

How do you write testing code?

The simplest way is as an expression in a debugger. You can change debug expressions without recompiling, and you can wait to decide what to write until you have seen the running objects. You can also write test expressions as statements which print to the standard output stream. Both styles of tests are limited because they require human judgment to analyze their results. Also, they don't compose nicely- you can only execute one debug expression at a time and a program with too many print statements causes the dreaded "Scroll Blindness".

AUnit tests do not require human judgment to interpret, and it is easy to run many of them at the same time. When you need to test something, here is what you do:

  1. Declare a package for a test case - a set of logically related test routines. A template for such a package is in /AUnit/Template/pr_xxxx_xxx.ad*.

  2. Derive from AUnit.Test_Cases.Test_Case in the new package.

  3. The new derived type must provide implementations of Register_Tests and Name.

  4. Write each test routine (see below) and register it with a line in routine Register_Tests, of the form:


    Register_Routine (T, Test_Name'Access, "Description of test routine");

  5. When you want to check a value, use:

    AUnit.Assertions.Assert(Boolean_Expression, String_Description);

  6. Create a suite function to gather together test cases and sub-suites.

  7. At any level at which you wish to run tests, create a harness instantiating Aunit.Test_Runner with a suite function collecting together test cases and sub-suites to execute.

  8. Be sure to initialize the source path for GNAT to include /aunit-1.01/aunit and its subdirectories. In GLIDE, this can be done using the "Load Recursive Directory" command in the project editing window. For other compilation systems, make these source file subdirectories known to them using their specific conventions.

  9. Build the harness routine using gnatmake. The Glide project file aunit-1.01/aunit/aunit.adp contains all the necessary links and switches for building test cases. When testing a new compiler, as opposed to incremental unit tests, the GNAT "-f" switch should be set for gnatmake. One can then use GLIDE to build and run the tests, making sure that aunit.adp is the default project file, setting "-f" if needed, and building (^C-C) and running (^C-R). For other compilation systems, use their standard build commands, ensuring that the subdirectories under aunit-1.01/aunit are known to the compilation system as containing sources.

For example, to test that the sum of two Moneys with the same currency contains a value which is the sum of the values of the two Moneys, the test routine would look like: 

procedure Test_Simple_Add
   (T : Aunit.Test_Cases.Test_Case'Class) is
   X, Y: Some_Currency;
begin
   X := 12; Y := 14;
   Assert (X + Y = 24, "Addition is incorrect");
end;

The package spec (taken almost directly from pr_xxxx_xxx.ads) looks as follows. The only modification was to remove support for a test fixture (next section), and to provide a name for the unit. Changes to "boilerplate code" are in bold:


with Ada.Strings.Unbounded;

use Ada.Strings.Unbounded;


with AUnit.Test_Cases;

use AUnit.Test_Cases;


package PR_xxxx_xxx is

type Test_Case is new AUnit.Test_Cases.Test_Case

with null record;


-- Register routines to be run:

procedure Register_Tests (T: in out Test_Case);


-- Provide name identifying the test case:

function Name (T: Test_Case) return String_Access;


end PR_xxxx_xxx;



The package body, constructed by modifying pr_xxxx_xxx.adb is:


with AUnit.Test_Cases.Registration;
use AUnit.Test_Cases.Registration;

with AUnit.Assertions; use AUnit.Assertions;

-- Template for test case body.
package body PR_xxxx_xxx is

   -- Simple test routine:
   procedure Test_Simple_Add
      (T : Aunit.Test_Cases.Test_Case'Class) is
      X, Y: Some_Currency;
   begin
      X := 12; Y := 14;
      Assert 
         (X + Y = 26, "Addition is incorrect");
   end;

   -- Register test routines to call:
   procedure Register_Tests (T: access Test_Case) is
   begin
      -- Repeat for each test routine:
      Register_Routine (T, Test_Simple_Add'Access, "Test Addition");
   end Register_Tests;



   -- Identifier of test case.  Just change the string
   -- result of the function.
   function Name (T: Test_Case) return String_Access is
   begin
      return new String'("Money Tests");
   end Name;

end PR_xxxx_xxx;

The corresponding harness code, adapted from aunit-1.01/template/harness.adb is:

with AUnit.Test_Suites; use AUnit.Test_Suites;
with AUnit.Test_Runner;

--  List of tests and suites to run:
with PR_XXXX_XXX;

procedure Harness is

   function Suite return Access_Test_Suite is
      Result : Access_Test_Suite := new Test_Suite;
   begin
      --  You may add multiple tests or suites here:
      Add_Test (Result, new PR_XXXX_XXX.Test_Case);
      return Result;
   end Suite;

   procedure Run is new AUnit.Test_Runner (Suite);

begin
   Run;
end Harness;

Fixture

Tests need to run against the background of a known set of objects. This set of objects is called a test fixture. When you are writing tests you will often find that you spend more time writing the code to set up the fixture than you do in actually testing values.

To some extent, you can make writing the fixture code easier by paying careful attention to the constructors you write. However, a much bigger savings comes from sharing fixture code. Often, you will be able to use the same fixture for several different tests. Each case will send slightly different messages or parameters to the fixture and will check for different results.

When you have a common fixture, here is what you do:

  1. Create a package as in the previous section, starting from the templates pr_xxxx_xxx.ad*

  2. Add fields for elements of the fixture into package body.

  3. Override Set_Up to initialize the variables

  4. Override Tear_Down to release any permanent resources you allocated in Set_Up

For example, to write several test cases that want to work with different combinations of 12 French Francs, 14 French Francs, and 26 US Dollars, first create a fixture. The package spec is now:

with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;

with AUnit.Test_Cases;
use AUnit.Test_Cases;
package PR_xxxx_xxx is
   type Test_Case is new AUnit.Test_Cases.Test_Case with null record;

    -- Register routines to be run:
   procedure Register_Tests (T: in out Test_Case);

   -- Provide name identifying the test case:
   function Name (T: Test_Case) return String_Access;


   -- Preparation performed before each routine:
   Procedure Set_Up (T: in out Test_Case);

end PR_xxxx_xxx;

The body becomes:

with AUnit.Test_Cases.Registration;
use AUnit.Test_Cases.Registration;

with AUnit.Assertions; use AUnit.Assertions;

with Currencies; use Currencies;
package body PR_xxxx_xxx is
   -- Fixture elements:
   FR_12, FR_14: French_Franc; 
   US_26: US_Dollar;

   -- Preparation performed before each routine:
   Procedure Set_Up (T: in out Test_Case) is
   begin
      FR_12 := 12; FR_14 := 14;
      US_26 := 26;
   end Set_Up;

   -- Simple test routine:
   procedure Test_Simple_Add
     (T : Aunit.Test_Cases.Test_Case'Class) is
   begin
       Assert 
        (FR_12 + FR_14 /= US_26, 
         "US and French currencies not diffentiated");
   end;

   -- Register test routines to call:
   procedure Register_Tests (T: in out Test_Case) is
   begin
      -- Repeat for each test routine:
      Register_Routine (T, Test_Simple_Add'Access, "Test Addition");
   end Register_Tests;



   -- Identifier of test case.  Just change the string
   -- result of the function.
   function Name (T: Test_Case) return String_Access is
   begin
      return  new String'("Money Tests");
   end Name;

end PR_xxxx_xxx;

Once you have the fixture in place, you can write as many test routines as you like. Calls to Set_Up and Tear_Down bracket the invocation of each test routine.

Note that as of AUnit 1.01 a parameter of type AUnit.Test_Cases.Test_Case'Class has been added to test routines. This parameter allows access to the current Test_Case instance, so that a test routine can access per-instance (rather than package body global) data. This can be useful when deriving one test case from another, which introduces the need to separate data of an instance of the parent type from that of derived types. This is different than the normal case of a set of tests where each Test_Case derived type almost certainly will have a singleton instance, allowing the safe use of package body global data.

Once you have several test cases, organize them into a Suite.

Suite

How do you run several test cases at once?

As soon as you have two tests, you'll want to run them together. You could run the tests one at a time yourself, but you would quickly grow tired of that. Instead, AUnit provides an object, Test_Suite which runs any number of test cases together.

For test routines that use the same fixture (i.e. those declared in the same package), the Register_Routine procedure is used to collect them into the single test case.

A single Test_Case and its collection of routines can be executed directly in a harness like so:

...
Test : PR_XXXX_XXX.Test_Case;
Result : Aunit.Test_Results.Result;
...
run (Test, Result);

To create a suite of two test cases and run them together, execute: 

with AUnit.Test_Suites; use AUnit.Test_Suites;
with AUnit.Test_Runner;

--  List of tests and suites to run:
with Test_Case_1, Test_Case_2;

procedure Harness is

   function Suite return Access_Test_Suite is
      Result : Access_Test_Suite := new Test_Suite;
   begin
      --  You may add multiple tests or suites here:
      Add_Test (Result, new Test_Case_1.Test_Case);
      Add_Test (Result, new Test_Case_2.Test_Case);
      return Result;
   end Suite;

   procedure Run is new AUnit.Test_Runner (Suite);

begin
   Run;
end Harness;

Composition of Suites

Typically, one will want the flexibility to execute a complete set of tests, or some subset of them. In order to facilitate this, we can reorganize the harness so that the composition of test cases and suites is done in a separate library function, and each composition level can have its own harness:

-- Composition function:
with AUnit.Test_Suites; use Aunit.Test_Suites;

-- List of tests and suites to compose:
with Test_Case_1;
with Test_Case_2;
function This_Suite return Access_Test_Suite is
   Result : Access_Test_Suite := new Test_Suite;
begin
   Add_Test (Result, new Test_Case_1.Test_Case);
   Add_Test (Result, new Test_Case_2.Test_Case);
   return Result;
end Suite;


-- More general form of harness for a given level:
with AUnit.Test_Runner;

--  Composition function for this level:
with This_Suite;

procedure Harness is
   procedure Run is new AUnit.Test_Runner (This_Suite);
begin
   Run;
end Harness;

At a higher level, we may wish to combine two suites of units tests that are composed with functions This_Suite and That_Suite.

The corresponding composition function and harness would be:

-- Composition function:
with AUnit.Test_Suites; use Aunit.Test_Suites;

-- List of tests and suites to compose:
with Suite_1;
with Suite_2;
function Composition_Suite return Access_Test_Suite is
   Result : Access_Test_Suite := new Test_Suite;
begin
   Add_Test (Result, Suite_1);
   Add_Test (Result, Suite_2);
   return Result;
end Composition_Suite;


-- More general form of harness for a given level:
with AUnit.Test_Runner;

--  Composition function for this level:
with Composition_Suite;

procedure Harness is
   procedure Run is new AUnit.Test_Runner (Composition_Suite);
begin
   Run;
end Harness;

As can be seen, this is a very flexible way of composing test cases into execution runs.

Note that the Aunit.Test_Runner.Run routine has a defaulted parameter to control whether timing information is reported. Its speficiation is:

procedure Run (Timed : Boolean := True);



By default the execution time for a harness is reported. If you are running some number of harnesses from a scripting language, and comparing the result to an existing file, using Timed => False ensures that the output will be identical across successful runs.

Reporting

Currently test results are reported using a simple console reporting routine:

   Test_Results.Text_Reporter.Report (Result);

A sample run on a set of problem reports submitted to ACT prints the following to the console when executed:

[efalis@dogen AUnit]$ ./harness
   Total Tests Run:  10

   Failed Tests: 1
      PR 7503-008.Allocation_Test:: Bad discriminant check

   Unexpected Errors: 0

The switch "-v" may be used with any harness to cause the list of successful tests to be printed along with any failures or errors:

[efalis@dogen AUnit]$ ./harness -v
   Total Tests Run:  17

   Successful Tests: 17
      PR 7112-001: Record_Initialization
      PR 7210-005: Test_1
      PR 7210-005: Test_2
      PR 7210-005: Test_3
      PR 7210-005: Test_4
      PR 7210-005: Test_5
      PR 7210-005: Test_6
      PR 7210-005: Test_A
      PR 7210-005: Test_B
      PR 7503-008: Allocation_Test
      PR 7605-009: Modular_Bounds
      PR 8010-001b: Test calculation of constant with modular sub-expression
      PR 7522-012: Subtype not recognized in initialization
      PR 7617-011: Test renaming in instantiation I
      PR 7624-003: Use of multi-dimensional aggregate as generic actual parameter
      PR 7813-010: Test -gnatc for bogus semantic error
      PR 8010-009: Overload resolution with enumeration literals

   Failed Tests: 0

   Unexpected Errors: 0

Time:  0.001011000 seconds
libaunit-1.03.orig/aunit/0000755000175000017500000000000010503343600015155 5ustar lbrentalbrentalibaunit-1.03.orig/aunit/framework/0000755000175000017500000000000010503343600017152 5ustar lbrentalbrentalibaunit-1.03.orig/aunit/framework/aunit-test_cases.adb0000644000175000017500000001073410503343405023105 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ C A S E S -- -- -- -- B o d y -- -- -- -- $Revision: 1.5 $ -- -- -- Copyright (C) 2000-2004 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with AUnit.Test_Results; use AUnit.Test_Results; with AUnit.Assertions; use AUnit.Assertions; pragma Elaborate_All (AUnit.Test_Results); -- Test cases. package body AUnit.Test_Cases is Set_Up_String : constant Ada.Strings.Unbounded.String_Access := new String'("*Set_Up*"); Tear_Down_String : constant Ada.Strings.Unbounded.String_Access := new String'("*Tear_Down*"); -- Run one test routine: procedure Run_Routine (Test : in out Test_Case'Class; Subtest : Routine_Spec; R : in out Result); -- Run one test routine: procedure Run_Routine (Test : in out Test_Case'Class; Subtest : Routine_Spec; R : in out Result) is begin begin Set_Up (Test); exception when E : others => Add_Error (R, Name (Test), Set_Up_String, E); return; end; begin Subtest.Routine.all (Test); Add_Success (R, Name (Test), Subtest.Routine_Name); exception when E : Assertion_Error => Add_Failure (R, Name (Test), Subtest.Routine_Name, E); when E : others => Add_Error (R, Name (Test), Subtest.Routine_Name, E); end; begin Tear_Down (Test); exception when E : others => Add_Error (R, Name (Test), Tear_Down_String, E); end; end Run_Routine; -- Run all routines registered for this test case: procedure Run (Test : in out Test_Case; R : in out Result) is begin -- Record number of test routines: Start_Test (R, Routine_Lists.Count (Test.Routines)); Start (Test.Routines); Set_Up_Case (Test_Case'Class (Test)); while not Off (Test.Routines) loop Run_Routine (Test, Item (Test.Routines), R); Remove (Test.Routines); end loop; Tear_Down_Case (Test_Case'Class (Test)); end Run; -- Default Set up routine: procedure Set_Up (Test : in out Test_Case) is begin null; end Set_Up; -- Default Set up case routine: procedure Set_Up_Case (Test : in out Test_Case) is begin null; end Set_Up_Case; -- Default Tear down routine: procedure Tear_Down (Test : in out Test_Case) is begin null; end Tear_Down; -- Default Tear down case routine: procedure Tear_Down_Case (Test : in out Test_Case) is begin null; end Tear_Down_Case; -- Register the test routines. procedure Initialize (Test : in out Test_Case) is begin Register_Tests (Test_Case'Class (Test)); end Initialize; end AUnit.Test_Cases; libaunit-1.03.orig/aunit/framework/aunit-test_cases.ads0000644000175000017500000000716710503343405023134 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ C A S E S -- -- -- -- S p e c -- -- -- -- Copyright (C) 2000 - 2003 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with AUnit.Tests; use AUnit.Tests; with AUnit.Test_Results; use AUnit.Test_Results; with AUnit.Lists; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -- Test case: A unit with a collection of test routines. -- Leaf node in composite pattern. package AUnit.Test_Cases is type Test_Case is abstract new Test with private; -- All test routines include a reference to the Test_Case instance, -- which can be useful for maintaining per-instance data in derivations -- of Test_Case: type Test_Routine is access procedure (Test : in out Test_Case'Class); -- Register test methods with test suite. Each test case has its -- own version of this routine. procedure Register_Tests (Test : in out Test_Case) is abstract; -- Test Case name function Name (Test : Test_Case) return String_Access is abstract; -- Set up performed before each test routine procedure Set_Up (Test : in out Test_Case); -- Set up performed before each case (set of test routines) procedure Set_Up_Case (Test : in out Test_Case); -- Tear down performed after each test routine procedure Tear_Down (Test : in out Test_Case); -- Tear down performed after each case procedure Tear_Down_Case (Test : in out Test_Case); -- Run one test case procedure Run (Test : in out Test_Case; R : in out Result); private -- Test case initialization procedure Initialize (Test : in out Test_Case); -- Routine info used at invocation and for error recording: type Routine_Spec is record Routine : Test_Routine; Routine_Name : String_Access; end record; package Routine_Lists is new Lists (Routine_Spec); use Routine_Lists; type Test_Case is abstract new Test with record Routines : List; end record; end AUnit.Test_Cases; libaunit-1.03.orig/aunit/framework/aunit-test_suites.adb0000644000175000017500000000524210503343405023321 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ S U I T E S -- -- -- -- B o d y -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- A collection of test cases and sub-suites. package body AUnit.Test_Suites is -- Add a test case or sub-suite to this one: procedure Add_Test (S : access Test_Suite; T : access Test'Class) is begin Extend (S.Tests, T.all); end Add_Test; -- Run each test case in this suite. Run sub-suite test cases -- recursively: procedure Run (S : in out Test_Suite; R : in out Result) is begin Start (S.Tests); while not Off (S.Tests) loop declare Dispatcher : Test'Class := Item (S.Tests); begin Tests.Run (Dispatcher, R); end; Remove (S.Tests); end loop; end Run; end AUnit.Test_Suites; libaunit-1.03.orig/aunit/framework/aunit-test_suites.ads0000644000175000017500000000533510503343405023345 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ S U I T E S -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with AUnit.Tests; use AUnit.Tests; with AUnit.Test_Results; use AUnit.Test_Results; with AUnit.Lists; -- A collection of Test cases. -- Internal node in Composite pattern. package AUnit.Test_Suites is type Test_Suite is new Test with private; type Access_Test_Suite is access all Test_Suite; -- Run all tests collected into this suite: procedure Run (S : in out Test_Suite; R : in out Result); -- Add a test case or sub-suite into this suite: procedure Add_Test (S : access Test_Suite; T : access Test'Class); private -- List of sub-suites and test cases: package Test_Lists is new Lists (Test'Class); use Test_Lists; type Test_Suite is new Test with record Tests : List; end record; end AUnit.Test_Suites; libaunit-1.03.orig/aunit/framework/aunit-lists.adb0000644000175000017500000003011110503343405022075 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . L I S T S -- -- -- -- B o d y -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; -- Simple linked lists. Adapted from EiffelBase LINKED_LIST package body AUnit.Lists is -- Local Specs: function Last_Element (L : List) return Linkable_Access; -- Last node function Previous (L : List) return Linkable_Access; -- Previous node procedure Destroy is new Ada.Unchecked_Deallocation (Element, Element_Access); -- Cleanup discarded elements procedure Destroy is new Ada.Unchecked_Deallocation (Linkable, Linkable_Access); -- Cleanup discarded nodes -- Accessors: function First (L : List) return Element is -- First Item on list begin return L.First_Element.Item.all; end First; function Index (L : List) return Natural is -- Current index -- Doing it this way in case of list merging P : Linkable_Access; Iter : List := L; Result : Natural := 0; begin if After (Iter) then Result := Count (Iter) + 1; elsif not Before (Iter) then P := L.Active; Start (Iter); Result := 1; while Iter.Active /= P loop Result := Result + 1; Forth (Iter); end loop; end if; return Result; end Index; function Item (L : List) return Element is -- Currrent item begin return L.Active.Item.all; end Item; function Last (L : List) return Element is -- Last item begin return Last_Element (L).Item.all; end Last; -- Measurement: function Count (L : List) return Natural is -- Number of items in list begin return L.Count; end Count; -- Status report: function Empty (L : List) return Boolean is -- Empty list? begin return Count (L) = 0; end Empty; function After (L : List) return Boolean is -- No valid cursor position to the right? begin return L.After; end After; function Before (L : List) return Boolean is -- No valid cursor position to the left? begin return L.Before; end Before; function Is_First (L : List) return Boolean is -- Cursor at first position? begin return not After (L) and not Before (L) and L.Active = L.First_Element; end Is_First; function Is_Last (L : List) return Boolean is -- Cursor at last position? begin return (not After (L) and not Before (L) and (L.Active /= null)) and then (L.Active.Right = null); end Is_Last; function Off (L : List) return Boolean is -- No current item? begin return L.After or else L.Before; end Off; -- Cursor movement: procedure Back (L : in out List) is -- Move to previous position begin if Empty (L) then L.Before := True; L.After := False; elsif After (L) then L.After := False; elsif Is_First (L) then L.Before := True; else L.Active := Previous (L); end if; end Back; procedure Finish (L : in out List)is -- Move to last position P : Linkable_Access; begin if not Empty (L) then P := L.Active; while P.Right /= null loop P := P.Right; end loop; L.Active := P; L.After := False; L.Before := False; else L.Before := True; L.After := False; end if; end Finish; procedure Forth (L : in out List) is -- Move to next position Old_Active : Linkable_Access; begin if Before (L) then L.Before := False; if Empty (L) then L.After := True; end if; else Old_Active := L.Active; L.Active := L.Active.Right; if L.Active = null then L.Active := Old_Active; L.After := True; end if; end if; end Forth; procedure Go_I_Th (L : in out List; I : Natural) is -- Move to i'th position begin if I = 0 then L.Before := True; L.After := False; L.Active := L.First_Element; elsif I = Count (L) + 1 then L.Before := False; L.After := True; L.Active := Last_Element (L); else Move (L, I - Index (L)); end if; end Go_I_Th; procedure Move (L : in out List; I : Integer) is -- Move I positions Counter : Natural := 0; New_Index : Integer := 0; P : Linkable_Access; begin if I > 0 then if Before (L) then L.Before := False; Counter := 1; end if; P := L.Active; while (Counter /= I) and then (P /= null) loop L.Active := P; P := P.Right; Counter := Counter + 1; end loop; if P = null then L.After := True; else L.Active := P; end if; elsif I < 0 then New_Index := Index (L) + I; L.Before := True; L.After := False; L.Active := L.First_Element; if New_Index > 0 then Move (L, New_Index); end if; end if; end Move; procedure Start (L : in out List) is -- Move to first position begin if L.First_Element /= null then L.Active := L.First_Element; L.After := False; else L.After := True; end if; L.Before := False; end Start; -- Element change: procedure Extend (L : in out List; E : Element) is -- Add E to end. Do not move cursor P : Linkable_Access := new Linkable'(new Element'(E), null); begin if Empty (L) then L.First_Element := P; L.Active := P; else Put_Right (Last_Element (L), P); if After (L) then L.Active := P; end if; end if; L.Count := L.Count + 1; end Extend; procedure Put_Front (L : in out List; E : Element) is -- Add E to start. Do not move cursor P : Linkable_Access := new Linkable'(new Element'(E), null); begin Put_Right (P, L.First_Element); L.First_Element := P; if Before (L) or else Empty (L) then L.Active := P; end if; L.Count := L.Count + 1; end Put_Front; procedure Put_Left (L : in out List; E : Element) is -- Add E to left of cursor. Do not move cursor P : Linkable_Access; begin if Empty (L) then Put_Front (L, E); elsif After (L) then Back (L); Put_Right (L, E); Move (L, 2); else P := new Linkable'(L.Active.Item, null); Put_Right (P, L.Active.Right); L.Active.Item := new Element'(E); Put_Right (L.Active, P); L.Active := P; L.Count := L.Count + 1; end if; end Put_Left; procedure Put_Right (L : in out List; E : Element) is -- Add E to right of cursor. Do not move cursor P : Linkable_Access := new Linkable'(new Element'(E), null); begin if Before (L) then Put_Right (P, L.First_Element); L.First_Element := P; L.Active := P; else Put_Right (P, L.Active.Right); Put_Right (L.Active, P); end if; L.Count := L.Count + 1; end Put_Right; procedure Replace (L : in out List; E : Element) is -- Replace current item with E begin L.Active.Item.all := E; end Replace; -- Removal: procedure Remove (L : in out List) is -- Remove current item. Move cursor to right Removed, Succ : Linkable_Access; begin Removed := L.Active; if Is_First (L) then L.First_Element := L.First_Element.Right; L.Active.Right := null; L.Active := L.First_Element; if Count (L) = 1 then L.After := True; end if; elsif Is_Last (L) then L.Active := Previous (L); if L.Active /= null then if L.Active /= null then L.Active.Right := null; end if; end if; L.After := True; else Succ := L.Active.Right; Put_Right (Previous (L), Succ); L.Active.Right := null; L.Active := Succ; end if; Destroy (Removed.Item); Destroy (Removed); L.Count := L.Count - 1; end Remove; procedure Remove_Left (L : in out List) is -- Remove item to left of cursor. Do not move cursor begin Move (L, -2); Remove_Right (L); Forth (L); end Remove_Left; procedure Remove_Right (L : in out List) is -- Remove item to right of cursor. Do not move cursor Removed, Succ : Linkable_Access; begin if Before (L) then Removed := L.First_Element; L.First_Element := L.First_Element.Right; L.Active.Right := null; L.Active := L.First_Element; else Succ := L.Active.Right; Removed := Succ; Put_Right (L.Active, Succ.Right); Succ.Right := null; end if; L.Count := L.Count - 1; Destroy (Removed.Item); Destroy (Removed); end Remove_Right; procedure Wipe_Out (L : in out List) is -- Remove all items. begin Start (L); while not Off (L) loop Remove (L); end loop; end Wipe_Out; -- Local bodies: function Last_Element (L : List) return Linkable_Access is -- Last node P, Result : Linkable_Access; begin if not Empty (L) then Result := L.Active; P := L.Active.Right; while P /= null loop Result := P; P := P.Right; end loop; end if; return Result; end Last_Element; function Previous (L : List) return Linkable_Access is -- Previous node P, Result : Linkable_Access; begin if After (L) then Result := L.Active; elsif not (Is_First (L) or Before (L)) then P := L.First_Element; while P.Right /= L.Active loop P := P.Right; end loop; Result := P; end if; return Result; end Previous; procedure Put_Right (L : Linkable_Access; R : Linkable_Access) is -- Add R to right of L begin L.Right := R; end Put_Right; end AUnit.Lists; libaunit-1.03.orig/aunit/framework/aunit-lists.ads0000644000175000017500000001504510503343405022127 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . L I S T S -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ generic type Element (<>) is private; -- Simple generic linked lists. Adapted from EiffelBase LINKED_LIST package AUnit.Lists is pragma Preelaborate (AUnit.Lists); type List is tagged private; -- Accessors: -- First Item on list function First (L : List) return Element; -- Current index function Index (L : List) return Natural; -- Currrent item function Item (L : List) return Element; -- Last item function Last (L : List) return Element; -- Measurement: -- Number of items in list function Count (L : List) return Natural; -- Status report: -- Empty list? function Empty (L : List) return Boolean; -- No valid cursor position to the right? function After (L : List) return Boolean; -- No valid cursor position to the left? function Before (L : List) return Boolean; -- Cursor at first position? function Is_First (L : List) return Boolean; -- Cursor at last position? function Is_Last (L : List) return Boolean; -- No current item? function Off (L : List) return Boolean; -- Cursor movement: -- Move to previous position -- require: not Before (L) -- ensure: Index (L) = old Index (L) - 1 procedure Back (L : in out List); -- Move to last position -- ensure: not Empty (L) implies Last (L) -- Empty (L) implies Before (L) procedure Finish (L : in out List); -- Move to next position -- require: not After (L) -- ensure: Index (L) = old Index (L) + 1 procedure Forth (L : in out List); -- Move to i'th position -- require: I in 0..Count (L) + 1 -- ensure: Index (L) = I procedure Go_I_Th (L : in out List; I : Natural); -- Move I positions -- ensure: -- old Index (L) + I > Count (L) implies Off (L) -- old Index (L) + I < 1 implies Off (L) -- not Off (L) implies Index (L) = old Index (L) + I -- (old Index (L) + I >= 0 and old Index (L) + I <= Count (L)) -- implies Index (L) = old Index (L) -- old Index (L) + I <= 0 implies Before (L) -- old Index (L) + I >= Count (L) + 1 implies After (L) procedure Move (L : in out List; I : Integer); -- Move to first position -- ensure: -- not Empty (L) implies Is_First (L) -- Empty (L) implies After (L) procedure Start (L : in out List); -- Element change: -- Add E to end. Do not move cursor procedure Extend (L : in out List; E : Element); -- Add E to start. Do not move cursor -- ensure: -- Count (L) = old Count (L) + 1 -- First (L) = E procedure Put_Front (L : in out List; E : Element); -- Add E to left of cursor. Do not move cursor -- require: not Before (L) -- ensure: -- Count (L) = old Count (L) + 1 -- Index (L) = old Index (L) + 1 procedure Put_Left (L : in out List; E : Element); -- Add E to right of cursor. Do not move cursor -- require: not After (L) -- ensure: -- Count (L) = old Count (L) + 1 -- Index (L) = old Index (L) procedure Put_Right (L : in out List; E : Element); -- Replace current item with E -- require: not Off (L) -- ensure: Item (L) = E procedure Replace (L : in out List; E : Element); -- Removal: -- Remove current item. Move cursor to right -- require: not Off (L) -- ensure: Empty (L) implies After (L) procedure Remove (L : in out List); -- Remove item to left of cursor. Do not move cursor -- require: -- Index (L) > 1 -- not Before (L) -- ensure: -- Count (L) = old Count (L) - 1 -- Index (L) = old Index (L) - 1 procedure Remove_Left (L : in out List); -- Remove item to right of cursor. Do not move cursor -- require: Index (L) < Count (L) -- ensure: -- Count (L) = old Count (L) - 1 -- Index (L) = old Index (L) procedure Remove_Right (L : in out List); -- Remove all items -- ensure: Empty (L) procedure Wipe_Out (L : in out List); private -- List node type Linkable; type Linkable_Access is access all Linkable; type List is tagged record Count : Natural := 0; Before : Boolean := True; After : Boolean := False; First_Element, Active : Linkable_Access; end record; -- Declared to allow indefinite "Item" component in "Linkable": type Element_Access is access all Element; type Linkable is record Item : Element_Access; Right : Linkable_Access := null; end record; -- Add R to right of L procedure Put_Right (L : Linkable_Access; R : Linkable_Access); end AUnit.Lists; libaunit-1.03.orig/aunit/framework/aunit-assertions.adb0000644000175000017500000000426710503343405023146 0ustar lbrentalbrenta-- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . A S S E R T I O N S -- -- -- -- B o d y -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with Ada.Exceptions; use Ada.Exceptions; package body AUnit.Assertions is procedure Assert (Condition : Boolean; Message : String) is begin if not Condition then Raise_Exception (Assertion_Error'Identity, Message); end if; end Assert; end AUnit.Assertions; libaunit-1.03.orig/aunit/framework/aunit-assertions.ads0000644000175000017500000000417010503343405023160 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . A S S E R T I O N S -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ package AUnit.Assertions is Assertion_Error : exception; procedure Assert (Condition : Boolean; Message : String); end AUnit.Assertions; libaunit-1.03.orig/aunit/framework/aunit-tests.ads0000644000175000017500000000455110503343405022133 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T S -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with Ada.Finalization; use Ada.Finalization; with AUnit.Test_Results; use AUnit.Test_Results; -- Base Test or Test Suite. package AUnit.Tests is type Test is abstract new Controlled with private; -- Run a test case or suite procedure Run (T : in out Test; R : in out Result) is abstract; private type Test is abstract new Controlled with null record; end AUnit.Tests; libaunit-1.03.orig/aunit/framework/aunit-test_results.adb0000644000175000017500000001116510503343405023507 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ R E S U L T S -- -- -- -- B o d y -- -- -- -- $Revision: 1.3 $ -- -- -- Copyright (C) 2000-2001 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- Record test results. package body AUnit.Test_Results is -- Increment count by number of test routines in a case procedure Start_Test (R : in out Result; Subtest_Count : Natural) is begin R.Tests_Run := R.Tests_Run + Subtest_Count; end Start_Test; -- Record an assertion violation procedure Add_Success (R : in out Result; Test_Name, Routine_Name : String_Access) is begin Success_Lists.Extend (R.Successes_List, Test_Success'(Test_Name, Routine_Name)); end Add_Success; -- Record a test failure procedure Add_Failure (R : in out Result; Test_Name, Routine_Name : String_Access; E : Exception_Occurrence) is begin Failure_Lists.Extend (R.Failures_List, Test_Failure'(Test_Name, Routine_Name, Save_Occurrence (E))); end Add_Failure; -- Record a test error procedure Add_Error (R : in out Result; Test_Name, Routine_Name : String_Access; E : Exception_Occurrence) is begin Failure_Lists.Extend (R.Errors_List, Test_Failure'(Test_Name, Routine_Name, Save_Occurrence (E))); end Add_Error; -- Set Elapsed time for reporter: procedure Set_Elapsed (R : in out Result; D : Duration) is begin R.Elapsed := D; end Set_Elapsed; -- Total tests run function Test_Count (R : Result) return Natural is begin return R.Tests_Run; end Test_Count; -- Number of successes function Success_Count (R : Result) return Natural is begin return Success_Lists.Count (R.Successes_List); end Success_Count; -- Number of failures function Failure_Count (R : Result) return Natural is begin return Failure_Lists.Count (R.Failures_List); end Failure_Count; -- Number of errors function Error_Count (R : Result) return Natural is begin return Failure_Lists.Count (R.Errors_List); end Error_Count; -- All tests successful? function Successful (R : Result) return Boolean is begin return Success_Count (R) = Test_Count (R); end Successful; -- List of successful tests function Successes (R : Result) return Success_Lists.List is begin return R.Successes_List; end Successes; -- List of failed tests function Failures (R : Result) return Failure_Lists.List is begin return R.Failures_List; end Failures; -- List of error tests function Errors (R : Result) return Failure_Lists.List is begin return R.Errors_List; end Errors; -- Elapsed time for test execution: function Elapsed (R : Result) return Duration is begin return R.Elapsed; end Elapsed; end AUnit.Test_Results; libaunit-1.03.orig/aunit/framework/aunit-test_results.ads0000644000175000017500000001064610503343405023533 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ R E S U L T S -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with AUnit.Lists; with Ada.Exceptions; use Ada.Exceptions; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -- Test reporting package AUnit.Test_Results is type Result is private; -- Information about a test failure or error type Test_Failure is record Test_Name : String_Access; Routine_Name : String_Access; E : Exception_Occurrence_Access; end record; -- Information about a test success type Test_Success is record Test_Name : String_Access; Routine_Name : String_Access; end record; -- Record of failures or errors package Success_Lists is new Lists (Test_Success); -- Record of failures or errors package Failure_Lists is new Lists (Test_Failure); -- Count a test run procedure Start_Test (R : in out Result; Subtest_Count : Natural); -- Record an assertion violation procedure Add_Success (R : in out Result; Test_Name, Routine_Name : String_Access); -- Record an assertion violation procedure Add_Failure (R : in out Result; Test_Name, Routine_Name : String_Access; E : Exception_Occurrence); -- Record an unexpected exception procedure Add_Error (R : in out Result; Test_Name, Routine_Name : String_Access; E : Exception_Occurrence); -- Set Elapsed time for reporter: procedure Set_Elapsed (R : in out Result; D : Duration); -- Number of tests run function Test_Count (R : Result) return Natural; -- Number of successes function Success_Count (R : Result) return Natural; -- Number of failures function Failure_Count (R : Result) return Natural; -- Number of errors function Error_Count (R : Result) return Natural; -- All tests successful? function Successful (R : Result) return Boolean; -- List of successful tests function Successes (R : Result) return Success_Lists.List; -- List of failed tests function Failures (R : Result) return Failure_Lists.List; -- List of error tests function Errors (R : Result) return Failure_Lists.List; -- Elapsed time for test execution: function Elapsed (R : Result) return Duration; private type Result is record Tests_Run : Natural := 0; Failures_List : Failure_Lists.List; Errors_List : Failure_Lists.List; Successes_List : Success_Lists.List; Elapsed : Duration := 0.0; end record; pragma Inline (Test_Count, Failure_Count, Error_Count); end AUnit.Test_Results; libaunit-1.03.orig/aunit/framework/aunit.ads0000644000175000017500000000403210503343405020765 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ package AUnit is pragma Pure (AUnit); end AUnit; libaunit-1.03.orig/aunit/framework/aunit-test_cases-registration.adb0000644000175000017500000000503310503343405025611 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ C A S E S . R E G I S T R A T I O N -- -- -- -- B o d y -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- Test routine registration package body AUnit.Test_Cases.Registration is -- Register a test routine. procedure Register_Routine (Test : in out Test_Case'Class; Routine : Test_Routine; Name : String) is begin Extend (Test.Routines, Routine_Spec'(Routine, new String'(Name))); end Register_Routine; -- Count of registered routines in test case: function Routine_Count (Test : Test_Case'Class) return Natural is begin return Count (Test.Routines); end Routine_Count; end AUnit.Test_Cases.Registration; libaunit-1.03.orig/aunit/framework/aunit-test_cases-registration.ads0000644000175000017500000000455410503343405025641 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ C A S E S . R E G I S T R A T I O N -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- Registration interface for test cases. package AUnit.Test_Cases.Registration is -- Add test routine to the test case: procedure Register_Routine (Test : in out Test_Case'Class; Routine : Test_Routine; Name : String); -- Count of registered routines in test case: function Routine_Count (Test : Test_Case'Class) return Natural; end AUnit.Test_Cases.Registration; libaunit-1.03.orig/aunit/framework/aunit-test_runner.ads0000644000175000017500000000422710503343405023341 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ R U N N E R -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- Test Suite Runner with AUnit.Test_Suites; generic with function Suite return AUnit.Test_Suites.Access_Test_Suite; procedure AUnit.Test_Runner (Timed : Boolean := True); libaunit-1.03.orig/aunit/text_reporter/0000755000175000017500000000000010503343600020063 5ustar lbrentalbrentalibaunit-1.03.orig/aunit/text_reporter/aunit-test_results-text_reporter.adb0000644000175000017500000001235510503343500027322 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ R E S U L T S . T E X T _ R E P O R T E R -- -- -- -- B o d y -- -- -- -- $Revision: 1.5 $ -- -- -- Copyright (C) 2000-2001 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with Ada.Text_IO; use Ada.Text_IO; with Ada.Exceptions; use Ada.Exceptions; with Ada.Unchecked_Deallocation; with AUnit.Options; use AUnit.Options; -- Very simple reporter to console package body AUnit.Test_Results.Text_Reporter is procedure Deallocate_Success_List (L : in out Success_Lists.List); procedure Destroy is new Ada.Unchecked_Deallocation (String, String_Access); -- Report the contents of an error or failure list procedure Dump_Failure_List (L : in out Failure_Lists.List; Is_Assertion : Boolean := True); -- List successful tests procedure Dump_Success_List (L : in out Success_Lists.List; Is_Assertion : Boolean := True); -- Report the contents of an error or failure list procedure Dump_Failure_List (L : in out Failure_Lists.List; Is_Assertion : Boolean := True) is Err_Rec : Test_Failure; use Failure_Lists; begin Start (L); while not Off (L) loop Err_Rec := Item (L); Put_Line (" " & Err_Rec.Test_Name.all & ": " & ASCII.LF & " " & Err_Rec.Routine_Name.all & ": "); if not Is_Assertion then Put_Line (" " & "**" & Exception_Name (Err_Rec.E.all) & "** : "); Put (" "); end if; Put_Line (" " & Exception_Message (Err_Rec.E.all)); New_Line; Destroy (Err_Rec.Routine_Name); Destroy (Err_Rec.Test_Name); Remove (L); end loop; end Dump_Failure_List; -- List successful tests procedure Dump_Success_List (L : in out Success_Lists.List; Is_Assertion : Boolean := True) is Rec : Test_Success; use Success_Lists; begin Start (L); while not Off (L) loop Rec := Item (L); Put_Line (" " & Rec.Test_Name.all & ": " & Rec.Routine_Name.all); Destroy (Rec.Routine_Name); Destroy (Rec.Test_Name); Remove (L); end loop; end Dump_Success_List; procedure Deallocate_Success_List (L : in out Success_Lists.List) is Rec : Test_Success; use Success_Lists; begin Start (L); while not Off (L) loop Rec := Item (L); Destroy (Rec.Routine_Name); Destroy (Rec.Test_Name); Remove (L); end loop; end Deallocate_Success_List; -- Report on a test run procedure Report (R : Result) is S : Success_Lists.List := Successes (R); F : Failure_Lists.List := Failures (R); E : Failure_Lists.List := Errors (R); begin Put_Line (" Total Tests Run: " & Natural'Image (Test_Count (R))); New_Line; Put_Line (" Successful Tests:" & Natural'Image (Success_Count (R))); if Verbose then Dump_Success_List (S); else Deallocate_Success_List (S); end if; New_Line; Put_Line (" Failed Tests:" & Natural'Image (Failure_Count (R))); Dump_Failure_List (F); New_Line; Put_Line (" Unexpected Errors:" & Natural'Image (Error_Count (R))); Dump_Failure_List (E, False); if Elapsed (R) > 0.0 then New_Line; Put_Line ("Time: " & Duration'Image (Elapsed (R)) & " seconds"); end if; end Report; end AUnit.Test_Results.Text_Reporter; libaunit-1.03.orig/aunit/text_reporter/aunit-test_results-text_reporter.ads0000644000175000017500000000417610503343500027345 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ R E S U L T S . T E X T _ R E P O R T E R -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- Very simple reporter to console package AUnit.Test_Results.Text_Reporter is procedure Report (R : Result); end AUnit.Test_Results.Text_Reporter; libaunit-1.03.orig/aunit/text_reporter/aunit-options.adb0000644000175000017500000000462410503343500023351 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . O P T I O N S -- -- -- -- B o d y -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with Ada.Command_Line; use Ada.Command_Line; with Ada.Characters.Handling; use Ada.Characters.Handling; package body AUnit.Options is Verbose_Mode : Boolean := False; function Verbose return Boolean is begin return Verbose_Mode; end Verbose; begin for I in 1 .. Argument_Count loop if To_Lower (Argument (I)) = "-v" then Verbose_Mode := True; end if; end loop; end AUnit.Options; libaunit-1.03.orig/aunit/text_reporter/aunit-options.ads0000644000175000017500000000411410503343500023364 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . O P T I O N S -- -- -- -- S p e c -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ package AUnit.Options is -- Verbose mode? function Verbose return Boolean; end AUnit.Options; libaunit-1.03.orig/aunit/text_reporter/aunit-test_runner.adb0000644000175000017500000000522210503343500024221 0ustar lbrentalbrenta------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- A U N I T . T E S T _ R U N N E R -- -- -- -- B o d y -- -- -- -- $Revision: 1.2 $ -- -- -- Copyright (C) 2000 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with AUnit.Test_Suites; use AUnit.Test_Suites; with AUnit.Test_Results; -- Reporting mechanism: with AUnit.Test_Results.Text_Reporter; with Ada.Calendar; use Ada.Calendar; -- Runner of test suites using text reporter procedure AUnit.Test_Runner (Timed : Boolean := True) is Result : AUnit.Test_Results.Result; Start_Time, End_Time : Time; Tests : Access_Test_Suite := Suite; begin -- Run them and report results: Start_Time := Clock; Run (Tests.all, Result); End_Time := Clock; if Timed then AUnit.Test_Results.Set_Elapsed (Result, End_Time - Start_Time); end if; AUnit.Test_Results.Text_Reporter.Report (Result); end AUnit.Test_Runner; libaunit-1.03.orig/aunit.gpr0000644000175000017500000000102607740306137015703 0ustar lbrentalbrentaproject Aunit is for Languages use ("Ada"); for Source_Dirs use ("aunit/framework/", "aunit/text_reporter/"); for Object_Dir use "aunit"; package Builder is for Default_Switches ("ada") use ("-g", "-gnatQ"); 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 Aunit; libaunit-1.03.orig/aunit_tests.gpr0000644000175000017500000000111710174224046017117 0ustar lbrentalbrentawith "aunit.gpr"; project Aunit_Tests is for Languages use ("Ada"); for Source_Dirs use ("./test"); for Object_Dir use "./test"; for Exec_Dir use "./"; for Main use ("harness.adb"); package Builder is for Default_Switches ("ada") use ("-g", "-gnatQ"); 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 Aunit_Tests; libaunit-1.03.orig/template/0000755000175000017500000000000010503343600015650 5ustar lbrentalbrentalibaunit-1.03.orig/template/sample_suite.adb0000644000175000017500000000053510503343521021017 0ustar lbrentalbrentawith AUnit.Test_Suites; use AUnit.Test_Suites; -- List of tests and suites to compose: with PR_XXXX_XXX; function Sample_Suite return Access_Test_Suite is Result : Access_Test_Suite := new Test_Suite; begin -- You may add multiple tests or suites here: Add_Test (Result, new PR_XXXX_XXX.Test_Case); return Result; end Sample_Suite; libaunit-1.03.orig/template/sample.adp0000644000175000017500000000113110503343521017615 0ustar lbrentalbrentagnatmake_opt=-g -i main=./harness main_unit=harness build_dir=./ check_cmd=${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current} -gnats make_cmd=cd ${build_dir} make_cmd=${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} -cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt} comp_cmd=cd ${build_dir} comp_cmd=${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current} run_cmd=cd ${build_dir} && ${main} src_dir=./ src_dir=../aunit/ src_dir=../aunit/framework/ src_dir=../aunit/text_reporter/ obj_dir=./ obj_dir=../aunit/ obj_dir=../aunit/framework/ obj_dir=../aunit/text_reporter/ libaunit-1.03.orig/template/sample.gpr0000644000175000017500000000116410503343521017647 0ustar lbrentalbrentawith "../aunit.gpr"; project Sample is for Languages use ("Ada"); for Source_Dirs use ("./"); for Object_Dir use "./"; for Exec_Dir use "./"; for Main use ("harness.adb"); package Builder is for Default_Switches ("ada") use ("-g", "-gnatQ"); for Executable ("harness.adb") use "harness"; 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 Sample; libaunit-1.03.orig/template/pr_xxxx_xxx.adb0000644000175000017500000000304110503343521020747 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; with AUnit.Assertions; use AUnit.Assertions; -- Template for test case body. package body PR_XXXX_XXX is -- Example test routine. Provide as many as are needed: procedure Test1 (R : in out AUnit.Test_Cases.Test_Case'Class); procedure Set_Up (T : in out Test_Case) is begin -- Do any necessary set ups. If there are none, -- omit from both spec and body, as a default -- version is provided in Test_Cases. null; end Set_Up; procedure Tear_Down (T : in out Test_Case) is begin -- Do any necessary cleanups, so the next test -- has a clean environment. If there is no -- cleanup, omit spec and body, as default is -- provided in Test_Cases. null; end Tear_Down; -- Example test routine. Provide as many as are needed: procedure Test1 (R : in out AUnit.Test_Cases.Test_Case'Class) is begin -- Do something: null; -- Test for expected conditions. Multiple assertions -- and actions are ok: Assert (True, "Indication of what failed"); end Test1; -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin -- Repeat for each test routine. Register_Routine (T, Test1'Access, "Description of test routine"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Test case name"); end Name; end PR_XXXX_XXX; libaunit-1.03.orig/template/pr_xxxx_xxx.ads0000644000175000017500000000125010503343521020770 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; use AUnit.Test_Cases; package PR_XXXX_XXX is type Test_Case is new AUnit.Test_Cases.Test_Case with null record; -- Override: -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; -- Override if needed. Default empty implementations provided: -- Preparation performed before each routine: procedure Set_Up (T : in out Test_Case); -- Cleanup performed after each routine: procedure Tear_Down (T : in out Test_Case); end PR_XXXX_XXX; libaunit-1.03.orig/template/harness.adb0000644000175000017500000000027510503343521017771 0ustar lbrentalbrentawith AUnit.Test_Runner; -- Suite for this level of tests: with Sample_Suite; procedure Harness is procedure Run is new AUnit.Test_Runner (Sample_Suite); begin Run; end Harness; libaunit-1.03.orig/test/0000755000175000017500000000000010503343600015014 5ustar lbrentalbrentalibaunit-1.03.orig/test/default.adp0000644000175000017500000000054710503343540017137 0ustar lbrentalbrentacomp_opt= -gnatf -gnato -gnatE -funwind-tables bind_opt=-f -p -E gnatmake_opt=-g -i run_cmd=${main} -v debug_cmd=gvd ${main} main=./timed_harness main_unit=timed_harness build_dir=./ casing=~/.emacs_case_exceptions/ src_dir=./ src_dir=../aunit/framework/ src_dir=../aunit/text_reporter/ obj_dir=./ obj_dir=../aunit/framework/ obj_dir=../aunit/text_reporter/ libaunit-1.03.orig/test/empty_test_case.adb0000644000175000017500000000072310503343540020661 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; -- Simple test case package body Empty_Test_Case is -- Test Routines: -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin null; end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Empty Test Case"); end Name; end Empty_Test_Case; libaunit-1.03.orig/test/empty_test_case.ads0000644000175000017500000000076310503343540020706 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; -- Test case with no routines. package Empty_Test_Case is type Test_Case is new AUnit.Test_Cases.Test_Case with private; -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; private type Test_Case is new AUnit.Test_Cases.Test_Case with null record; end Empty_Test_Case; libaunit-1.03.orig/test/one_test_case-inherited_test_case.adb0000644000175000017500000000332010503343540024303 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration, AUnit.Assertions; use AUnit.Test_Cases.Registration, Aunit.Assertions; -- Test case that inherits a routine. Overriding parent test routines -- isn't possible. Access to inherited parent Test_Case per-instance -- data is. package body One_Test_Case.Inherited_Test_Case is -- Test Routines: procedure Test_2 (T : in out AUnit.Test_Cases.Test_Case'Class) is begin null; end Test_2; -- Check ability to access parent and child instance-specific data. -- Downward conversion is necessary to access specific type data, -- and derived test_case must be declared in a child unit: procedure Test_Data_Access (T: in out Aunit.Test_Cases.Test_Case'Class) is begin Assert (One_Test_Case.Test_Case (T).Parent_Data = 0 and Test_Case (T).Child_Data = 1, "Parent and Child data not correctly accessed"); end Test_Data_Access; -- Register test routines to call. Total test routines = 4: procedure Register_Tests (T : in out Test_Case) is begin -- Register all tests from parent Test_Case type: One_Test_Case.Register_Tests (One_Test_Case.Test_Case (T)); -- Register one parent routine (must be declared in parent spec): Register_Routine (T, Test_1'Access, "Parent Test Routine"); -- Register tests of derived Test_Case type: Register_Routine (T, Test_2'Access, "Test Routine 2"); Register_Routine (T, Test_Data_Access'Access, "Test Data Access"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Inherited Test Case"); end Name; end One_Test_Case.Inherited_Test_Case; libaunit-1.03.orig/test/one_test_case-inherited_test_case.ads0000644000175000017500000000103410503343540024324 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with One_Test_Case; package One_Test_Case.Inherited_Test_Case is type Test_Case is new One_Test_Case.Test_Case with private; -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; private type Test_Case is new One_Test_Case.Test_Case with record Child_Data : Integer := 1; end record; end One_Test_Case.Inherited_Test_Case; libaunit-1.03.orig/test/simple_test_case.adb0000644000175000017500000000301310503343540021007 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; with AUnit.Assertions; use AUnit.Assertions; -- Simple test case package body Simple_Test_Case is procedure Set_Up (T : in out Test_Case) is begin T.Is_Set_Up := True; end Set_Up; procedure Tear_Down (T : in out Test_Case) is begin T.Is_Torn_Down := True; end Tear_Down; -- Test Routines: procedure Succeed (T : in out AUnit.Test_Cases.Test_Case'Class) is begin null; end Succeed; procedure Fail (T : in out AUnit.Test_Cases.Test_Case'Class) is begin null; Assert (False, "Failure test failed"); end Fail; procedure Error (T : in out AUnit.Test_Cases.Test_Case'Class) is begin raise Constraint_Error; end Error; -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin Register_Routine (T, Succeed'Access, "Success Test"); Register_Routine (T, Fail'Access, "Failure Test"); Register_Routine (T, Error'Access, "Error Test"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Dummy Test Case"); end Name; -- Set up? function Is_Set_Up (T : Test_Case) return Boolean is begin return T.Is_Set_Up; end Is_Set_Up; -- Torn down? function Is_Torn_Down (T : Test_Case) return Boolean is begin return T.Is_Torn_Down; end Is_Torn_Down; end Simple_Test_Case; libaunit-1.03.orig/test/simple_test_case.ads0000644000175000017500000000157210503343540021040 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; -- Simple test case. package Simple_Test_Case is type Test_Case is new AUnit.Test_Cases.Test_Case with private; -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; -- Preparation performed before each routine: procedure Set_Up (T : in out Test_Case); -- Cleanup performed after each routine: procedure Tear_Down (T : in out Test_Case); -- Set up? function Is_Set_Up (T : Test_Case) return Boolean; -- Torn down? function Is_Torn_Down (T : Test_Case) return Boolean; private type Test_Case is new AUnit.Test_Cases.Test_Case with record Is_Set_Up, Is_Torn_Down : Boolean := False; end record; end Simple_Test_Case; libaunit-1.03.orig/test/harness.adb0000644000175000017500000000024610503343540017134 0ustar lbrentalbrentawith AUnit.Test_Runner; with AUnit_Suite; procedure Harness is procedure Run is new AUnit.Test_Runner (AUnit_Suite); begin Run (Timed => False); end Harness; libaunit-1.03.orig/test/test_lists.adb0000644000175000017500000002606110503343540017671 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; with AUnit.Assertions; use AUnit.Assertions; with AUnit.Lists; package body Test_Lists is package Integer_Lists is new AUnit.Lists (Integer); use Integer_Lists; L : List; procedure Set_Up (T : in out Test_Case) is begin if not Before (L) then Back (L); end if; end Set_Up; procedure Tear_Down (T : in out Test_Case) is begin Wipe_Out (L); end Tear_Down; -- Test Routines: procedure Test_Creation (T : in out AUnit.Test_Cases.Test_Case'Class) is begin Assert (Before (L), "Cursor not properly set on initialization"); Assert (Empty (L), "Initial list not empty"); end Test_Creation; procedure Test_Back (T : in out AUnit.Test_Cases.Test_Case'Class) is I : Natural; begin Extend (L, 1); Extend (L, 2); Finish (L); Assert (Is_Last (L), "Finish did not put cursor at end of list"); I := Index (L); Back (L); Assert (Index (L) = I - 1, "Cursor not moved backwards: expected " & Integer'Image (I - 1) & ", got " & Integer'Image (Index (L))); end Test_Back; procedure Test_Finish (T : in out AUnit.Test_Cases.Test_Case'Class) is begin Finish (L); Assert (Before (L), "Finish on empty list /= Before"); Extend (L, 1); Finish (L); Assert (Is_Last (L), "Finish failed to place cursor on last element of the list"); end Test_Finish; procedure Test_Forth (T : in out AUnit.Test_Cases.Test_Case'Class) is begin Extend (L, 1); Extend (L, 2); Forth (L); Assert (Index (L) = 1, "Forth failed to advance cursor: expected " & Integer'Image (1) & " got " & Integer'Image (Index (L))); Forth (L); Assert (Index (L) = 2, "Forth failed to advance cursor: expected " & Integer'Image (2) & " got " & Integer'Image (Index (L))); end Test_Forth; procedure Test_Go_I_Th (T : in out AUnit.Test_Cases.Test_Case'Class) is begin Extend (L, 1); Extend (L, 2); Extend (L, 3); for I in 0 .. Count (L) + 1 loop Go_I_Th (L, I); Assert (Index (L) = I, "Go_I_Th failed to place cursor correctly: expected " & Integer'Image (I) & " got " & Integer'Image (Index (L))); end loop; end Test_Go_I_Th; procedure Test_Move (T : in out AUnit.Test_Cases.Test_Case'Class) is I : Natural; begin Extend (L, 1); Extend (L, 2); Extend (L, 3); Move (L, 4); Assert (Off (L), "Move beyond end of list did not result in Off"); Move (L, -4); Assert (Off (L), "Move before beginning of list did not result in Off"); Start (L); I := Index (L); Move (L, 2); Assert (not Off (L), "Test written incorrectly: expected not Off"); Assert (Index (L) = I + 2, "Move failed to position cursor: expected " & Integer'Image (I + 2) & " got " & Integer'Image (Index (L))); Finish (L); I := Index (L); Move (L, -2); Assert (not Off (L), "Test written incorrectly: expected not Off"); Assert (Index (L) = I + (-2), "Move failed to position cursor: expected " & Integer'Image (I + (-2)) & " got " & Integer'Image (Index (L))); Start (L); Move (L, -1); Assert (Before (L), "Move prior to first element failed to indicate Before"); Finish (L); Move (L, 1); Assert (After (L), "Move beyond last element failed to indicate After"); end Test_Move; procedure Test_Start (T : in out AUnit.Test_Cases.Test_Case'Class) is begin Start (L); Assert (After (L), "Start on empty list failed to indicate After"); Extend (L, 1); Extend (L, 2); Finish (L); Start (L); Assert (Is_First (L), "Start on non-empty list failed to indicate Is_First"); end Test_Start; procedure Test_Put_Front (T : in out AUnit.Test_Cases.Test_Case'Class) is Old_Count : Natural := 0; begin Put_Front (L, 1); Assert (Count (L) = Old_Count + 1, "Put_Front failed to increment count on initial list"); Assert (First (L) = 1, "Put_Front inserted element incorrectly on empty list"); Old_Count := Count (L); Put_Front (L, 2); Assert (Count (L) = Old_Count + 1, "Put_Front failed to increment count on non-empty list"); Assert (First (L) = 2, "Put_Front inserted element incorrectly on non-empty list"); end Test_Put_Front; procedure Test_Put_Left (T : in out AUnit.Test_Cases.Test_Case'Class) is Old_Count, Old_Index : Natural; begin Extend (L, 1); Start (L); Old_Count := Count (L); Old_Index := Index (L); Put_Left (L, 2); Assert (Count (L) = Old_Count + 1, "Put_Left failed to increment Count for single element list"); Assert (Index (L) = Old_Index + 1, "Put_Left failed to adjust index for single element list"); Finish (L); Old_Count := Count (L); Old_Index := Index (L); Put_Left (L, 3); Assert (Count (L) = Old_Count + 1, "Put_Left failed to increment Count for multi-element list"); Assert (Index (L) = Old_Index + 1, "Put_Left failed to adjust index for multi-element list"); end Test_Put_Left; procedure Test_Put_Right (T : in out AUnit.Test_Cases.Test_Case'Class) is Old_Count, Old_Index : Natural; begin Extend (L, 1); Start (L); Old_Count := Count (L); Old_Index := Index (L); Put_Right (L, 2); Assert (Count (L) = Old_Count + 1, "Put_Right failed to increment Count for single element list"); Assert (Index (L) = Old_Index, "Put_Right failed to maintain index for single element list"); Start (L); Old_Count := Count (L); Old_Index := Index (L); Put_Right (L, 3); Assert (Count (L) = Old_Count + 1, "Put_Right failed to increment Count for multi-element list"); Assert (Index (L) = Old_Index, "Put_Right failed to maintain index for multi-element list"); end Test_Put_Right; procedure Test_Replace (T : in out AUnit.Test_Cases.Test_Case'Class) is begin Extend (L, 1); Start (L); Replace (L, 2); Assert (Item (L) = 2, "Replace failed for one element list"); Extend (L, 1); Finish (L); Replace (L, 3); Assert (Item (L) = 3, "Replace failed at end of list"); Extend (L, 1); Start (L); Forth (L); Replace (L, 4); Assert (Item (L) = 4, "Replace failed in middle of list"); end Test_Replace; procedure Test_Remove (T : in out AUnit.Test_Cases.Test_Case'Class) is begin Extend (L, 1); Extend (L, 2); Extend (L, 3); Start (L); Forth (L); Remove (L); Assert (Count (L) = 2, "Remove failed to adjust Count when removing from middle of list"); Finish (L); Remove (L); Assert (Count (L) = 1, "Remove failed to adjust Count when removing from end of list"); Start (L); Remove (L); Assert (Empty (L), "Removal of last element failed to empty list"); Assert (After (L), "Removal of last element failed to indicate After"); end Test_Remove; procedure Test_Remove_Left (T : in out AUnit.Test_Cases.Test_Case'Class) is Old_Count, Old_Index : Natural; begin Extend (L, 1); Extend (L, 2); Extend (L, 3); Extend (L, 4); Finish (L); Old_Count := Count (L); Old_Index := Index (L); Remove_Left (L); Assert (Count (L) = Old_Count - 1, "Remove_Left failed to adjust Count when removing before last element"); Assert (Index (L) = Old_Index - 1, "Remove_Left failed to adjust Index when removing before last element"); Start (L); Forth (L); Old_Count := Count (L); Old_Index := Index (L); Remove_Left (L); Assert (Count (L) = Old_Count - 1, "Remove_Left failed to adjust Count when removing first element"); Assert (Index (L) = Old_Index - 1, "Remove_Left failed to adjust Index when removing first element"); end Test_Remove_Left; procedure Test_Remove_Right (T : in out AUnit.Test_Cases.Test_Case'Class) is Old_Count, Old_Index : Natural; begin Extend (L, 1); Extend (L, 2); Extend (L, 3); Extend (L, 4); Start (L); Old_Count := Count (L); Old_Index := Index (L); Remove_Right (L); Assert (Count (L) = Old_Count - 1, "Remove_Right failed to adjust Count when removing after first element"); Assert (Index (L) = Old_Index, "Remove_Right failed to maintain Index when removing after first element"); Finish (L); Back (L); Old_Count := Count (L); Old_Index := Index (L); Remove_Right (L); Assert (Count (L) = Old_Count - 1, "Remove_Right failed to adjust Count when removing last element"); Assert (Index (L) = Old_Index, "Remove_Right failed to maintain Index when removing last element"); end Test_Remove_Right; procedure Test_Wipe_Out (T : in out AUnit.Test_Cases.Test_Case'Class) is begin for I in 1 .. 10 loop Extend (L, I); end loop; Wipe_Out (L); Assert (Empty (L), "Wipe_Out failed to empty list"); Wipe_Out (L); exception when others => Assert (False, "Wipe_Out fails when called on empty list"); end Test_Wipe_Out; -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin -- Repeat for each test routine. Register_Routine (T, Test_Creation'Access, "Test Creation"); Register_Routine (T, Test_Back'Access, "Test Back"); Register_Routine (T, Test_Finish'Access, "Test Finish"); Register_Routine (T, Test_Forth'Access, "Test Forth"); Register_Routine (T, Test_Go_I_Th'Access, "Test Go_I_Th"); Register_Routine (T, Test_Move'Access, "Test Move"); Register_Routine (T, Test_Start'Access, "Test Start"); Register_Routine (T, Test_Put_Front'Access, "Test Put_Front"); Register_Routine (T, Test_Put_Left'Access, "Test Put_Left"); Register_Routine (T, Test_Put_Right'Access, "Test Put_Right"); Register_Routine (T, Test_Replace'Access, "Test Replace"); Register_Routine (T, Test_Remove'Access, "Test Remove"); Register_Routine (T, Test_Remove_Left'Access, "Test Remove_Left"); Register_Routine (T, Test_Remove_Right'Access, "Test Remove_Right"); Register_Routine (T, Test_Wipe_Out'Access, "Test Wipe_Out"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Test_Lists"); end Name; end Test_Lists; libaunit-1.03.orig/test/test_lists.ads0000644000175000017500000000112010503343540017677 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; use AUnit.Test_Cases; package Test_Lists is type Test_Case is new AUnit.Test_Cases.Test_Case with null record; -- Override: -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; -- Setup before each routine: procedure Set_Up (T : in out Test_Case); -- Cleanup performed after each routine: procedure Tear_Down (T : in out Test_Case); end Test_Lists; libaunit-1.03.orig/test/timed_harness.adb0000644000175000017500000000024210503343540020312 0ustar lbrentalbrentawith AUnit.Test_Runner; with AUnit_Suite; procedure Timed_Harness is procedure Run is new AUnit.Test_Runner (AUnit_Suite); begin Run; end Timed_Harness; libaunit-1.03.orig/test/test_test_suite.adb0000644000175000017500000000525410503343540020724 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; with AUnit.Test_Results; use AUnit.Test_Results; with AUnit.Assertions; use AUnit.Assertions; with AUnit.Test_Suites; use AUnit.Test_Suites; with Empty_Test_Case; with One_Test_Case; with One_Test_Case.Inherited_Test_Case; -- Unit tests for AUnit.Test_Suites package body Test_Test_Suite is -- Test Routines: procedure Test_No_Test_Case (T : in out AUnit.Test_Cases.Test_Case'Class) is S : Access_Test_Suite := new Test_Suite; R : Result; begin Run (S.all, R); Assert (Successful (R), "Suite did not run successfully"); Assert (Test_Count (R) = 0, "Wrong number of tests recorded"); end Test_No_Test_Case; procedure Test_No_Test_Routines (T : in out AUnit.Test_Cases.Test_Case'Class) is S : Access_Test_Suite := new Test_Suite; R : Result; begin Add_Test (S, new Empty_Test_Case.Test_Case); Run (S.all, R); Assert (Successful (R), "Suite did not run successfully"); Assert (Test_Count (R) = 0, "Wrong number of tests recorded"); end Test_No_Test_Routines; procedure Test_One_Test_Case (T : in out AUnit.Test_Cases.Test_Case'Class) is S : Access_Test_Suite := new Test_Suite; R : Result; begin Add_Test (S, new One_Test_Case.Test_Case); Run (S.all, R); Assert (Test_Count (R) = 1, "Wrong number of tests run"); Assert (Failure_Count (R) = 0, "Wrong number of failures"); Assert (Error_Count (R) = 0, "Wrong number of unexpected errors"); Assert (Successful (R), "Suite did not run successfully"); end Test_One_Test_Case; procedure Test_Inherited_Tests (T : in out AUnit.Test_Cases.Test_Case'Class) is S : Access_Test_Suite := new Test_Suite; R : Result; begin Add_Test (S, new One_Test_Case.Inherited_Test_Case.Test_Case); Run (S.all, R); Assert (Successful (R), "Suite did not run successfully"); Assert (Test_Count (R) = 4, "Wrong number of tests run"); end Test_Inherited_Tests; -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin Register_Routine (T, Test_No_Test_Case'Access, "Test No Test Case"); Register_Routine (T, Test_No_Test_Routines'Access, "Test No Test Routines"); Register_Routine (T, Test_One_Test_Case'Access, "Test One Test Routine"); Register_Routine (T, Test_Inherited_tests'Access, "Test Inherited Test Case"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Test AUnit.Test_Suites"); end Name; end Test_Test_Suite; libaunit-1.03.orig/test/test_test_suite.ads0000644000175000017500000000070310503343540020737 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; use AUnit.Test_Cases; -- Unit tests for AUnit.Test_Suites. package Test_Test_Suite is type Test_Case is new AUnit.Test_Cases.Test_Case with null record; -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; end Test_Test_Suite; libaunit-1.03.orig/test/aunit_suite.adb0000644000175000017500000000101610503343540020016 0ustar lbrentalbrentawith AUnit.Test_Suites; use AUnit.Test_Suites; -- Unit tests for AUnit: with Test_Test_Case; with Test_Test_Case_Registration; with Test_Test_Suite; with Test_Lists; function AUnit_Suite return Access_Test_Suite is Result : Access_Test_Suite := new Test_Suite; begin Add_Test (Result, new Test_Test_Case.Test_Case); Add_Test (Result, new Test_Test_Case_Registration.Test_Case); Add_Test (Result, new Test_Test_Suite.Test_Case); Add_Test (Result, new Test_Lists.Test_Case); return Result; end AUnit_Suite; libaunit-1.03.orig/test/test_test_case_registration.adb0000644000175000017500000000235410503343540023276 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration, Empty_Test_Case; use AUnit.Test_Cases.Registration; with AUnit.Test_Results; use AUnit.Test_Results; with AUnit.Assertions; use AUnit.Assertions; -- Unit tests for AUnit.Test_Cases.Registration. package body Test_Test_Case_Registration is -- Test Routines: procedure Dummy_Test_Routine (T : in out AUnit.Test_Cases.Test_Case'Class) is begin null; end Dummy_Test_Routine; procedure Test_Register_Routine (T : in out AUnit.Test_Cases.Test_Case'Class) is E : aliased Empty_Test_Case.Test_Case; Initial_Count : Natural := Routine_Count (E); begin Register_Routine (E, Dummy_Test_Routine'Access, "Dummy"); Assert (Routine_Count (E) = Initial_Count + 1, "Register failed to update routine count"); end Test_Register_Routine; -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin Register_Routine (T, Test_Register_Routine'Access, "Test Register Routine"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Test AUnit.Test_Cases.Registration"); end Name; end Test_Test_Case_Registration; libaunit-1.03.orig/test/test_test_case_registration.ads0000644000175000017500000000074710503343540023323 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; use AUnit.Test_Cases; -- Unit tests for AUnit.Test_Cases.Registration. package Test_Test_Case_Registration is type Test_Case is new AUnit.Test_Cases.Test_Case with null record; -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; end Test_Test_Case_Registration; libaunit-1.03.orig/test/test_test_case.adb0000644000175000017500000000541710503343540020507 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration, Simple_Test_Case; use AUnit.Test_Cases.Registration; with AUnit.Test_Results; use AUnit.Test_Results; with AUnit.Assertions; use AUnit.Assertions; -- Unit tests for AUnit.Test_Cases. package body Test_Test_Case is -- Test Routines: procedure Test_Register_Tests (T : in out AUnit.Test_Cases.Test_Case'Class) is Simple : Simple_Test_Case.Test_Case; Old_Count : Positive := Routine_Count (Simple); begin Simple_Test_Case.Register_Tests (Simple); Assert (Routine_Count (Simple) = 2 * Old_Count, "Routine not properly registered"); end Test_Register_Tests; procedure Test_Set_Up (T : in out AUnit.Test_Cases.Test_Case'Class) is Simple : Simple_Test_Case.Test_Case; use Simple_Test_Case; Was_Reset : Boolean := not Is_Set_Up (Simple); begin Set_Up (Simple); Assert (Was_Reset and Is_Set_Up (Simple), "Not set up correctly"); end Test_Set_Up; procedure Test_Torn_Down (T : in out AUnit.Test_Cases.Test_Case'Class) is Simple : Simple_Test_Case.Test_Case; use Simple_Test_Case; Was_Reset : Boolean := not Is_Torn_Down (Simple); begin Tear_Down (Simple); Assert (Was_Reset and Is_Torn_Down (Simple), "Not torn down correctly"); end Test_Torn_Down; procedure Test_Run (T : in out AUnit.Test_Cases.Test_Case'Class) is use Simple_Test_Case; Simple : Simple_Test_Case.Test_Case; R : Result; Count : Natural := Routine_Count (Simple); begin Run (Simple, R); Assert (Count >= 3, "Not enough routines in simple test case"); Assert (Test_Count (R) = Count, "Not all requested routines were run"); Assert (Success_Count (R) + Failure_Count (R) + Error_Count (R) = Count, "Not all requested routines are recorded"); Assert (Success_Count (R) = 1, "Wrong success count"); Assert (Failure_Count (R) = 1, "Wrong failure count"); Assert (Error_Count (R) = 1, "Wrong error count"); Assert (Is_Torn_Down (Simple), "Not torn down correctly"); end Test_Run; -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin Register_Routine (T, Test_Register_Tests'Access, "Test Routine Registration"); Register_Routine (T, Test_Set_Up'Access, "Test Set Up"); Register_Routine (T, Test_Torn_Down'Access, "Test Tear Down"); Register_Routine (T, Test_Run'Access, "Test Run"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("Test AUnit.Test_Cases"); end Name; end Test_Test_Case; libaunit-1.03.orig/test/test_test_case.ads0000644000175000017500000000070010503343540020516 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; use AUnit.Test_Cases; -- Unit tests for AUnit.Test_Cases. package Test_Test_Case is type Test_Case is new AUnit.Test_Cases.Test_Case with null record; -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; end Test_Test_Case; libaunit-1.03.orig/test/one_test_case.adb0000644000175000017500000000117410503343540020305 0ustar lbrentalbrentawith AUnit.Test_Cases.Registration; use AUnit.Test_Cases.Registration; -- Test case with one routine package body One_Test_Case is -- Test Routines: procedure Test_1 (T : in out AUnit.Test_Cases.Test_Case'Class) is begin null; end Test_1; -- Register test routines to call: procedure Register_Tests (T : in out Test_Case) is begin Register_Routine (T, Test_1'Access, "Test Routine 1"); end Register_Tests; -- Identifier of test case: function Name (T : Test_Case) return String_Access is begin return new String'("One Test Case"); end Name; end One_Test_Case; libaunit-1.03.orig/test/one_test_case.ads0000644000175000017500000000122310503343540020321 0ustar lbrentalbrentawith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with AUnit.Test_Cases; -- Test case with one routine. package One_Test_Case is type Test_Case is new AUnit.Test_Cases.Test_Case with private; -- Register routines to be run: procedure Register_Tests (T : in out Test_Case); -- Provide name identifying the test case: function Name (T : Test_Case) return String_Access; private -- Test_1 will be inherited in another test case: procedure Test_1 (T : in out AUnit.Test_Cases.Test_Case'Class); type Test_Case is new AUnit.Test_Cases.Test_Case with record Parent_Data : Integer := 0; end record; end One_Test_Case; libaunit-1.03.orig/COPYING0000644000175000017500000004312307213463155015107 0ustar lbrentalbrenta GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA 02111 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. libaunit-1.03.orig/README0000644000175000017500000000524310061075315014725 0ustar lbrentalbrentaAUnit 1.03 README 07 June 2004 This is a minor update release of the Ada unit test framework AUnit, derived from the JUnit framework for Java. Read AUnit.html for usage. Installation: Unzip the archive into . Build and run /aunit-1.03/test/harness.adb to verify that it works. To build, connect to /aunit-1.03 and type: gnatmake -Paunit_tests To execute, type: ./harness -- or "harness" on Windows The output should be: Total Tests Run: 24 Successful Tests: 24 Failed Tests: 0 Unexpected Errors: 0 ------- Directories contain the following: aunit - Top-level: includes README etc, a GNAT project file for AUnit, and a GNAT project file for the AUnit tests aunit/* - The framework and a simple text mode reporter of results template/* - Templates for unit tests and a test harness, and for a GNAT project file. tests/* - A set of unit tests for testing the framework itself Currently AUnit is written to work with the open source GNAT Ada compilation system. To that end, GNAT project files have been provided. For other compilation systems, the sources in aunit-1.03/aunit/* must be made accessible to the compilation system according to its conventions. Switches: Any test harness using AUnit.Test_Results.Text_Reporter can be invoked with the following command syntax: test_harness [ -v | -V ] -v : Verbose mode. Lists all tests executed. When not specified, only failed and error tests are listed. Changes: 1.03 1. Handling of exceptions in Set_Up and Tear_Down implemented. D603-009. 1.02 1. Added GNAT project files (*.gpr). 2. Added routines Set_Up_Case and Tear_Down_Case to AUnit.Test_Cases to support fixture maintenance needed before and after the execution of the full sequence of test routines. 1.01 1. Added Test_Case'Class parameter to test routines, allowing access to Test_Case per-instance data. This may be useful for derived Test_Case instances, as an alternative to using global package body data. 2. Changed the profile of AUnit.Test_Runner to: procedure AUnit.Test_Runner (Timed : Boolean := True); This allows suppression of timing reporting so that the output of running a harness can be identical across runs. Useful for scripted regression tests, where the output of a harness run is compared against a reference file. 3. Implemented remaining memory management for the framework. There should be no memory leaks now (checked with gnatmem). 4. Corrected error in AUnit.Lists.Put_Right, where the list wasn't being chained correctly. 5. Added Set_Up and Tear_Down routines to AUnit.Lists tests. Maintainer: Ed Falis (falis@gnat.com)