ahven-2.7/LICENSE.txt0000644000000000000000000000150413325517624012444 0ustar 00000000000000-- Ahven Unit Test Library - License -- -- Copyright (c) 2007-2017 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ahven-2.7/Makefile0000644000000000000000000000314113325517624012260 0ustar 00000000000000# # Copyright (c) 2007-2016 Tero Koskinen # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # # # This Makefile is meant for Linux systems and uses # comfignat.mk settings from gnat_linux/ directory. # # For more simple build process, use GNAT project files # directly from gnat/ directory. # # By default, invoke Comfignat's default goal, which builds and stages the # library, including the usage project file, but not the documentation. default: ${MAKE} --directory=gnat_linux # Any goal that isn't named here is delegated to gnat_linux/Makefile. # Variables defined on the command line are passed along. %: ${MAKE} --directory=gnat_linux $@ README.html: README.rst rst2html --stylesheet-path=css/html4css1.css,css/my-docutils.css README.rst > README.html control: rm -f objects/*.adt objects/*.ali cd objects && adactl -f ../rules/ahven.aru ../src/*.ad[bs] ../test/*.ad[bs] ../src/unix/*.ad[bs] rm -f objects/*.adt objects/*.ali ahven-2.7/NEWS.txt0000644000000000000000000004240313325517624012141 0ustar 000000000000002018-07-24 Ahven 2.7 ==================== Changes ------- * NEWS file renamed to NEWS.txt, LICENSE to LICENSE.txt. * GNAT Makefile / project file / comfignat updates: - prefix variable for installation location (note: lowercase) - development / production build settings - directory changed to gnat_linux. - library so version can be overridden. * Simplified GNAT project file under gnat directory. This can be used on Windows also: gprbuild -p -P gnat\ahven * Test_Count_Type is now subtype of Long_Integer with upper limit at 2**31-1. This allows more tests on compilers where Natural is a 16-bit value. * Set_Up and Tear_Down are now called also for test routines without parameters. Idea and patch from Jacob Sparre Andersen. * Adjusted syntax checking rules to work with Adacontrol V1.18r9. * sphinxcontrib-adadomain extension is no longer needed to build the documentation. Bugs fixed ---------- * Tear_Down did not work if a test raised exception. Reported by Jacob Sparre Andersen. Internal -------- * Ahven.Long_AStrings now uses Unbounded_String instead of Bounded_String. This reduces the memory usage and therefore allows more tests. 2015-08-30 Ahven 2.6 ==================== Changes ------- * Fix release dates in documentation. 2015-08-30 Ahven 2.5 ==================== Changes ------- * The default build system (Makefile) for GNAT uses now comfignat.mk template. All existing make targets should work in the normal way, but the internals have been changed. See http://tero.stronglytyped.org/building-the-development-version-of-ahven.html for details. * Python-sphinx and sphinxcontrol-adadomain packages are now required for building the documentation. Prebuilt documentation is available online at http://docs.ahven-framework.com/2.5/index.html * XML_Runner now supports "-s" parameter, which allows one to specify suffix for test class names. Helps with CI systems which expect certain format for the names. Example: my_tests -c -x -s .Test -d results * Test runners can now accept multiple test names from the command line. Suggestion from Jacob Sparre Andersen. * Test runners have new "-i" parameter, which tells the runners to ignore the rest of the parameters until parameter "--" is seen. Suggestion and initial patch from Jacob Sparre Andersen. Example: my_tests -v -i -this-is-ignored +and-this -- MyTest * Old Cruisecontrol and Fedora packaging examples were removed from contrib/ directory. Bugs fixed ---------- * Fixed compilation with gcc/gnat 4.9. Noticed by John Marino. Hosting changes --------------- * Starting from 2.5, Ahven is no longer hosted at Sourceforge. Instead, it has dedicated site at http://www.ahven-framework.com/ Release packages can be downloaded from http://www.ahven-framework.com/releases/ Old http://ahven.stronglytyped.org/ address continues work as a mirror site. Source code repository can be accessed either via https://bitbucket.org/tkoskine/ahven or http://hg.stronglytyped.org/ahven 2014-02-09 Ahven 2.4 ==================== Changes ------- * Created a work-around to Ahven.Framework for Apex and ICCAda. Now Apex Ada compiles the the body of Ahven.Framework without errors and ICCAda does not produce any warnings. The compilers did not correctly handle the body of Indefinite_Test_List package inside Ahven.Framework when Indefinite_Test_List was at the end of ahven-framework.adb. This was fixed by moving the body to the beginning of the file. (No functional changes.) * Various documentation improvements. * Alternative comfignat-based build system (contrib/comfignat) was added. It is experimental for now and meant mostly for Linux distribution packagers. From Bjorn Persson. Known issues ------------ * On Fedora 19/20 you need to first install libgnat-static package: sudo yum install libgnat-static Otherwise GNAT will die with internal error when building Ahven. * On Windows 8.1 you need to use JNT_RTS instead of JTN_RTS_Console as Janus/Ada runtime. Otherwise, Janus/Ada fails to find Ada runtime system for Ahven. 2013-01-24 Ahven 2.3 ==================== Changes ------- * Various procedure descriptions in the API documentation were improved. * Character limit of long messages in test results have been increased to 1024. On some compilers this means that memory usage is over 1 kilobytes per test result. * New constant: Ahven.Max_Long_String_Len * Exception backtraces are now stored to test results when test fails or has an error. Bugs fixed ---------- * TAP runner did not output multiline (long) messages correctly. This is now fixed. Internal -------- * New package: Ahven.Long_AStrings * Some coding style fixes. Known issues ------------ * On Fedora 17/18 you need to first install libgnat-static package: sudo yum install libgnat-static Otherwise GNAT will die with internal error when building Ahven. 2012-03-05 Ahven 2.2 ==================== Changes ------- * GNAT 3.15p project files from contrib/gnat315p removed. * The code snippets in the documentation are now highlighted as Ada code. * API documentation generation using Adabrowse is now deprecated. The new way is to use Sphinx for document generation. Bugs fixed ---------- * Ahven.XML_Runner did not report skipped tests correctly. This is now fixed. (The bug was similar to Ahven.Text_Runner bug in Ahven 2.1.) Internal -------- * Small test suite improvements. 2011-09-24 Ahven 2.1 ==================== Bugs fixed ---------- * Ahven.Text_Runner did not report skipped tests correctly. This is now fixed. Internal -------- * Function Ahven.Results.Skipped_Count was added. 2011-09-23 Ahven 2.0 ==================== Changes ------- * Tests can be now given a timeout value. If a test is not executed in the given time, it is stopped and a timeout failure is reported. See '-t' option of the test runners. The timeout feature depends on the possibility to abort a task after a certain amount of time. If the task abortion is not possible, the current test will continue running even after the given timeout. * A test can be now skipped programmatically by calling procedure Skip("Message"). A skipped test are considered to be equal to passed tests, but depending on the test runner, they can have extra "SKIP" information attached. * README is now provided in reStructured text format, just like the manual. Bugs fixed ---------- * Ahven can be compiled on Fedora systems by installing package "libgnat-static". Note: This was not a bug in Ahven but a configuration issue on Fedora. 2011-04-19 Ahven 1.9 ==================== Changes ------- * Manual was added to 'doc/manual/en' directory. It includes User's Guide section and API documentation. The documentation is written using reStructuredText and Sphinx 1.0, so Python and py-sphinx are required for building. API documentation generation via Adabrowse is still supported, but it will be deprecated and dropped later. Bugs fixed ---------- * Extra Test'Class (...) type conversion was removed from ahven-framework.adb. This allows compilation with GNAT GPL 2010. (Bug bitbucket#3) Internal -------- * Package Ahven.VStrings was replaced with an instantiation of Ada.Strings.Bounded.Generic_Bounded_Length. This allowed us to remove over 100 lines of code. Known issues ------------ * Ahven (or actually file ahven-parameters.adb) cannot be compiled on Fedora 14 with gcc 4.5.1. See bug https://bugzilla.redhat.com/show_bug.cgi?id=690610 for details. 2010-06-02 Ahven 1.8 ==================== Changes ------- * The dynamic library support with GNAT was removed since it did not work automatically in a trouble-free way on Debian, Fedora, and Windows. * Ada.Calendar dependency was removed from Ahven.Framework. Equivalent functionality is now implemented in the test runners. * Support for TAP 1.3 was dropped. TAP 1.2 is supported normally. * Janus/Ada 3.1.1d support was dropped. Ahven now requires Janus/Ada 3.1.2beta or newer. * There is now ahven.spec file in contrib/fedora to make packaging and installing Ahven easier on Fedora. Bugs fixed ---------- * If user placed a dynamically allocated Test_Case into a statically allocated Test_Suite the finalization procedure tried to release the same memory twice. This is now fixed by implementing Adjust for the Test_Suite type. (Bug bitbucket#2) * Many Some_Type'(initial values) expressions were changed into more simpler (initial values) form. This was done to avoid Janus/Ada bug no 73. Internal -------- * Code cleanup: style fixes, removal of compiler warnings and comment clarifications. * Remove_All procedure from Ahven.SList package was renamed to Clear. The new name is more consistent with Ada.Containers naming style. * Ahven.VStrings package now depends on Ada.Strings.Fixed. * Ahven.Framework.Indefinite_Test_List has no longer procedures or functions for Cursors. Same functionality can be now achieved using generic For_Each procedure. 2009-09-14 Ahven 1.7 ==================== Changes ------- * The source code repository and the issue tracker are now hosted at Bitbucket, http://bitbucket.org/tkoskine/ahven * The usage of Unbounded_String was completely removed from all packages. Now Ahven.Framework.Get_Name function returns String. * GNAT project files (.gpr) were moved to the 'gnat' directory. * The upper limit (Count_Type'Last) of Ahven.SList is now documented. * A PDF report generation example from XML result files was added to 'contrib/docbook-testreport'. From Reto Buerki. Bugs fixed ---------- * Fix Contraint_Error when one tries to truncate overlong string. Bug report and patch from Reto Buerki. (Bug bitbucket#1) * XML_Runner now filters special characters like space or / from the filenames. Patch from Reto Buerki. Internal -------- * Makefile now has 'tags' target for generating 'tags' file. It assumes that ctags utility has support for Ada. * It is no longer necessary to have procedure or function declarations for all procedures and functions. The purpose is to allow somewhat shorter code. * User's Guide has seen some progress, but it is still not completely ready. (=one should not rely on it.) * In the test code, some Assert calls were converted to more compact Assert_Equal calls. 2009-02-28 Ahven 1.6 ==================== Bugs fixed ---------- * Installation scripts for GNAT were fixed. Bug report and patch from Reto Buerki. 2009-02-23 Ahven 1.5 ==================== Changes ------- * Ahven is now hosted at sourceforge.net. New URLs are: Project page: http://sourceforge.net/projects/ahven Home page: http://ahven.sourceforge.net/ * Janus/Ada build system was rewritten. See README for details. Also, some minor changes were done to GNAT build scripts. Bug fixed --------- * API documentation was not generated for the Ahven.SList package. 2009-01-22 Ahven 1.4 ==================== Changes ------- * Type Ahven.Framework.Test_Result and related code was removed. Ahven.Framework.Execute now takes Listeners.Result_Listener'Class directly instead of Test_Result object. * New abstract function Test_Count was added to the Test type. The function returns the amount of test routines which will be executed when the Run procedure is called. * Test Anything Protocol (TAP) support: There is now a new Ahven.Tap_Runner package, which outputs test results in TAP format (versions 1.2 and 1.3 are supported). * Get_Message and Get_Long_Message functions now return String instead of Unbounded_String. * The GNAT project files for GNAT 3.15p were synchronised with the GNAT GPL versions. * Janus/Ada build scripts are now in the 'janusada' directory instead of 'contrib\janusada'. * New (generic) assertion procedure: Assert_Equal (Expected, Actual, Message). Suggestion and the source code from Pawel Plazienski. * New procedure for inserting stack-allocated tests into test suites: Add_Static_Test (Suite, T). Idea from Pawel Plazienski. * Internally, almost all Unbounded_Strings were converted into VStrings. This limits the maximum length of test names and failure messages to 160 characters. Constraint_Error is raised for overlong test names and too long failure messages are silently truncated into 160 characters. This was done for better Janus/Ada 3.1.1d compatibility. Bugs fixed ----------- * Text-based test runner results are now aligned in a better way. Fix for bug #12220. Internal -------- * All lists were converted into singly linked lists. Lists were made generic wherever possible. * Listeners.Output_Capture was combined into Listeners.Basic. 2008-08-13 Ahven 1.3 ==================== Changes ------- * Example configuration for Cruisecontrol was added. * The GNAT project file for GNAT 3.15p was added. * Fix for bug #12165 and make test suite to work with Janus/Ada 3.1.x. Bugs fixed ---------- * The API documentation is now generated also for the Ahven.Compat and Ahven.XML_Runner packages. * The use of System.Address_To_Access_Conversions was removed. This allows Ahven to be compiled with Janus/Ada. At the same time, Ahven.Framework.Run (T : Test;...) was changed back to Ahven.Framework.Run (T : in out Test;...). Sorry for the inconvenience. * Non-standard pragmas were removed. The code should compile now on multiple Ada compilers without warnings about unrecognised pragmas. Internal -------- * Variable "OS" in Makefile and GNAT project files was renamed to "OS_Version". * New tests: Result_Tests.Test_Add_{Pass,Failure,Error}, Framework_Tests.Test_Tear_Down, Ahven.Result_Listener_List.Test_Append. * Removed tests: List_Tests.*. * Code cleanups: + Duplicate code from Text_Runner.Run and XML_Runner.Run moved into Runner.Run_Suite. + Duplicate code from various Framework.Run procedures was moved into Framework.Run_Internal. * Ahven.Doubly_Linked_List was removed. This is related to bug #12165. 2008-05-12 Ahven 1.2 ==================== Changes ------- * New XML_Runner which generates JUnit compatible XML test results. XML_Runner can be either run explicitly or via Text_Runner using the '-x' parameter. * Unused access types Test_Access, Test_Case_Class_Access, Test_Case_Access, Test_Suite_Class_Access, Result_Listener_Access, Test_Command_Access, Test_Object_Command_Access, Basic_Listener_Access, and Output_Capture_Listener_Access removed. * Ahven.Framework.Run (T : in out Test;...) is changed to Ahven.Framework.Run (T : Test;...), because 'in out' mode was not necessary. * New procedures/functions: Ahven.Text_Runner.Run (Suite : Framework.Test_Suite'Class); Ahven.Framework.Create_Suite return Test_Suite; With these, the suite can be created on stack and one does not need to play with access types. Bugs fixed ---------- * Ahven can be now compiled with GNAT 3.15p. * The GNAT project file should work on Windows again. Internal -------- * XML_Runner introduced a need for some platform specific files. Therefore, 'src' directory now contains subdirectories 'unix' and 'windows'. * New tests: Result_Tests.Test_* * Next_* procedures for in the Results package were replaced with proper iterators. 2008-01-30 Ahven 1.1 ==================== Changes ------- * The Ahven.Framework and the test runners are able to optionally run only the tests which match the given name. * The default Text_Runner is able to capture Ada.Text_IO output from a test into a temporary file and show the output if the test does not pass. Option '-c' turns the capture feature on. * The default Text_Runner shows the exception message in addition to the exception name when the test ends in error. (Idea and original patch from Alexander Senier) * The default Text_Runner is now able to provide a short summary instead of full test report. Use option '-q' to get the test summary. * The GNAT project file is now called 'ahven.gpr' instead of old 'ahven_lib.gpr'. * ALI files (*.ali) are now installed read-only, so GNAT does not try to rebuild the library. (Patch from Alexander Senier) * Function Ahven.Framework.Name is renamed to Ahven.Framework.Get_Name. * Shared library produced by GNAT now includes the version number. Internal -------- * New listener: Output_Capture_Listener, which will forward Ada.Text_IO output into a temporary file. * Type Ahven.Results.Result_Place is renamed to Ahven.Results.Result_Info. * Ahven.Double_Linked_List is renamed to Ahven.Doubly_Linked_List, because other Ada linked list implementations also use similar naming scheme. * AdaControl is used to enforce some parts of the coding style. This caused some API changes, but in most cases the changes are invisible. 2007-10-24 Ahven 1.0 ==================== Initial release. Ahven is a simple unit test library for Ada 95. It is modeled after JUnit and some ideas are taken from AUnit. Ahven 1.0 is distributed under ISC license. Features ======== * Test, Test_Case, and Test_Suite classes (tagged types) * Assert and Fail procedures for triggering assertion failures * Text-based test runner Tero Koskinen ahven-2.7/README.rst0000644000000000000000000002455713325517624012325 0ustar 00000000000000========================================================= Ahven - Unit Testing Library for Ada Programming Language ========================================================= .. contents:: :depth: 1 Ahven is a simple unit test library (or a framework) for Ada programming language. It is loosely modelled after `JUnit`_ and some ideas are taken from AUnit. Ahven is free software distributed under permissive ISC license and should work with any Ada 95, 2005, or 2012 compiler. Features -------- * Simple API * Small size (Ahven about has 3K SLOC) * JUnit-compatible test results in XML format; this allows integration with tools like `Jenkins`_ or TeamCity. * Strict coding style (enforced by AdaControl) * Plain Ada 95 code, no Ada 2005 features used, but can be compiled as Ada 2005 or Ada 2012 code if needed * Portable across different compilers and operating systems * Permissive Open Source license (ISC) See also '''''''' * Author's blog at http://tero.stronglytyped.org/tag/ahven.html Platforms --------- Ahven 2.7 compiles and passes its test suite on following platforms +-----------------------+--------+------------------------+ | OS | Arch | Compiler | +=======================+========+========================+ | Fedora Linux 28 | x86_64 | FSF GCC 8.1 | +-----------------------+--------+------------------------+ | Debian GNU/Linux 7.8 | i386 | FSF GCC 4.6 | +-----------------------+--------+------------------------+ | Debian GNU/Linux 7.8 | x86_64 | FSF GCC 4.6 | +-----------------------+--------+------------------------+ | Windows 10 | x86_64 | Janus/Ada 3.1.2c | +-----------------------+--------+------------------------+ | Windows 10 | x86_64 | GNAT GPL 2018 | +-----------------------+--------+------------------------+ News ---- Ahven 2.7 (2018-07-24) '''''''''''''''''''''' This is a minor maintenance release with some new features. In addition to existing comfignat based system, there is now very simple GNAT project file provided for Ahven library. The framework internals also got some performance increases and smaller memory usage for each test. Set_Up and Tear_Down procedures got improvements and fixes. Ahven 2.6 (2015-08-30) '''''''''''''''''''''' This release fixes release dates mentioned in the documentation. Otherwise 2.6 is identical to 2.5. Ahven 2.5 (2015-08-30) '''''''''''''''''''''' This is a minor maintenance release with some new features. The comfignat build system/Makefile is now default for GNAT. Other compilers use their own build mechanisms as before. In addition, some new command line options for the test runners were added, see the documentation for details. The hosting of Ahven's website and release files is changed to a dedicated site: http://www.ahven-framework.com/ Downloads from Sourceforge are no longer supported. Ahven 2.4 (2014-02-09) '''''''''''''''''''''' This is a minor maintenance and bug fix release. Ahven now compiles cleanly with Apex Ada (no errors) and Irvine ICC Ada (no warnings). In addition, the documentation was improved and experimental comfignat-based build system was added. Ahven 2.3 (2013-01-24) '''''''''''''''''''''' This is a minor feature release. Starting from this release, the exception backtraces are now stored to the test results and printed out along with the results. In addition, the documentation received some improvements and output of multiline messages from TAP_Runner was fixed. Ahven 2.2 (2012-03-05) '''''''''''''''''''''' This is a bug fix release. The release fixes the reporting of skipped tests in Ahven.XML_Runner. Also, support for GNAT 3.15p was removed. Documentation generation tool was changed from Adabrowse to `Sphinx`_. Ahven 2.1 (2011-09-24) '''''''''''''''''''''' This is a bug fix release. The release fixes the skipped test reporting in Ahven.Text_Runner. Ahven 2.0 (2011-09-23) '''''''''''''''''''''' This is a feature release. The release adds possibility to stop tests after certain amount of time and programmatically skip tests. In addition, the README document is now in reStructured text format, like the manual. Ahven 1.9 (2011-04-19) '''''''''''''''''''''' This is a bug fix release. The release includes new HTML documentation generated from reStructured text using Python-Sphinx and fixes compilation problems with GNAT GPL 2010. Ahven 1.8 (2010-06-02) '''''''''''''''''''''' This is a bug fix release. Changes include a fix for double free when mixing dynamic test cases with static test suites, removal of some unfinished features like TAP 1.3 and Janus/Ada 3.1.1d support, and code cleanups. Ahven website location changed again (2009-11-30) ''''''''''''''''''''''''''''''''''''''''''''''''' The website location of Ahven changed once more. This time the change should be the last one for a while. At the same time, the layout was reverted to the older version, which is more friendly to the bandwidth. Technical detail which should be interesting: The new website is running on Debian and Ada Web Server. Ahven 1.7 (2009-09-14) '''''''''''''''''''''' This is a bug fix release. Changes include a fix for Constraint_Error with long test names and special character filtering from the test names when generating XML results. In addition, PDF report generation example was added to the contrib directory and some internal code cleanups were done. Mercurial repository, part 2 (2009-06-25) ''''''''''''''''''''''''''''''''''''''''' Sourceforge.net has had some problems with their Mercurial repositories, so now the previously unofficial Bitbucket Mercurial repository as the official Mercurial repository for Ahven. Also, bug reports are now at Bitbucket. Mercurial repository (2009-03-17) ''''''''''''''''''''''''''''''''' Sourceforge.net added support for Mercurial and now Ahven's source code repository is migrated from CVS to Mercurial. Ahven 1.6 (2009-02-28) '''''''''''''''''''''' This release fixes GNAT installation issues. Ahven 1.5 (2009-02-23) '''''''''''''''''''''' This is first release at SourceForge. The release includes only some build system changes. SourceForge.net (2009-02-18) '''''''''''''''''''''''''''' Ahven project is now hosted by SourceForge. Ahven 1.4 (2009-01-22) '''''''''''''''''''''' This release introduces Test Anything Protocol (TAP) reporter, a new API for stack-based test cases, and improved Janus/Ada support. Also, some API changes were done, but they should affect you only if you have extented the framework. Ahven 1.3 (2008-08-13) '''''''''''''''''''''' A bug fix release. The major change is support for Janus/Ada. Web site layout changes (2008-06-30) The web site layout was changed to be "less boring". The new blueish theme should work better on different types of monitors. (Some low quality monitors and graphics cards didn't show light brown colors properly.) Ahven 1.2 (2008-05-12) '''''''''''''''''''''' A major new feature in this release is support for JUnit-compatible XML-based test result format. The release also includes bug fixes and code cleanups. Ahven 1.1 (2008-01-30) '''''''''''''''''''''' Incremental release including bug fixes and new features. Ahven 1.0 (2007-10-24) '''''''''''''''''''''' Initial release. (See `News`_ for details.) Download -------- Ahven is distributed in source code format only. You can get the release packages from http://www.ahven-framework.com/releases/ You can download the latest development source code from Ahven's Mercurial repository: https://bitbucket.org/tkoskine/ahven/ Debian package '''''''''''''' Debian stable (7.0) provides Ahven 2.1 as libahven21.0 and libahven3-dev packages. One can install the packages with command *apt-get install libahven21.0 libahven3-dev*. Fedora package '''''''''''''' Fedora 23 provides Ahven 2.4 as *ahven* and *ahven-devel* packages. One can install the packages with the dnf command: :: dnf install ahven ahven-devel Installation ------------ For building Ahven source code you need Ada 95/2005/2012 compiler, for example GNAT, Janus/Ada, Irvine ICCAda, or ObjectAda. Optionally, you need Sphinx_ (Python package) to build the documentation and AdaControl to run coding style checks. The default Makefile compiles code using gnatmake. Internally, gnatmake is given a GNAT project file, which works with GNAT GPL series and relatively recent FSF GNAT. If you use another compiler, you need to customize the Makefile by yourself. Please note, that 'src' directory has platform specific subdirectories 'unix' and 'windows'. You need to select the sources from one of them also. Installation: GNAT '''''''''''''''''' When using GNAT, simple *make* will compile the library. Command *make check* will compile and run the unit tests. If you want to build the API documentation, you need Sphinx_ tool. Command 'make docs' will build the API documentation. Installation happens by typing *make install*. This installs that which has been built by earlier make commands. If nothing has been built, then *make install* first builds the library, just like a plain *make*, and then installs that. Alternatively, you can simply copy the source code directory ('src') to your project. If you want to specify the installation directory, you need to give it during the first *make* via prefix variable. :: make clean # not necessary for the first build make prefix=$HOME/my-libraries/ahven make install Installation: Janus/Ada ''''''''''''''''''''''' Build scripts for Janus/Ada are located in the 'janusada' directory. To compile the source code, you need to tweak file 'prepare.bat' and then run 'prepare.bat', 'update.bat', and 'compile.bat' from the top level directory. That is the same directory where this README.rst file is located. Example: :: janusada\prepare.bat janusada\update.bat janusada\compile.bat When compilation is finished, you have tap_test.exe in the 'test_obj' directory. Documentation ------------- * The API documentation (for Ahven 2.7, generated by Sphinx): http://docs.ahven-framework.com/2.7/index.html * The API documentation (for Ahven 1.8, generated by Adabrowse): http://docs.ahven-framework.com/api/index.html * Tutorial: http://www.ahven-framework.com/tutorial.html Author ------ Tero Koskinen .. image:: http://ahven.stronglytyped.org/ahven.png .. _`Jenkins`: http://www.jenkins-ci.org/ .. _`JUnit`: http://www.junit.org/ .. _`News`: http://www.ahven-framework.com/NEWS .. _`Sphinx`: http://www.sphinx-doc.org/ ahven-2.7/ROADMAP0000644000000000000000000000126213325517624011630 0ustar 00000000000000Ahven - Roadmap ================ Release schedule and versioning ------------------------------- Ahven will use simple a.b version numbers. After "1.9" comes "2.0". I plan to release a new version two or three times a year. API stability ------------- I do not guarantee API stability but I will try to keep specification of packages Ahven and Ahven.Framework unchanged. But for example, function Ahven.Framework.Name changed to Ahven.Framework.Get_Name in Ahven 1.1. Other packages will most likely see changes. Long-term todo-list ------------------- * Graphical (GTK+/CLAW) UI for the test result reporter * Improve documentation * Replace adhoc XML writer with "a proper solution" ahven-2.7/bitbucket-pipelines.yml0000644000000000000000000000070613325517624015311 0ustar 00000000000000# This is a sample build configuration for all languages. # Check our guides at https://confluence.atlassian.com/x/VYk8Lw for more examples. # Only use spaces to indent your .yml configuration. # ----- # You can specify a custom docker image from Docker Hub as your build environment. image: rfc1149/gnat pipelines: default: - step: script: - make base - LD_LIBRARY_PATH=$PWD/gnat_linux/stage/usr/local/lib/ make check ahven-2.7/contrib/docbook-testreport/Makefile0000644000000000000000000000670313325517624017560 0ustar 00000000000000# # Copyright (c) 2009 Reto Buerki # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # # project settings PROJECT := example-project EMAIL := developer@example.net FORMATS := html txt pdf TARGETS := $(foreach fmt,$(FORMATS),$(PROJECT).$(fmt)) SRCDIR := ../../results DOCDIR := docs XSLDIR := xsl SRCINDEX := $(SRCDIR)/index.xml RESULTFILE := result.xml HEADERFILE := result-header.xml OVERFILE := overview.xml ENTITYFILE := data.ent SOURCES := $(wildcard $(SRCDIR)/*.xml) \ $(ENTITYFILE) \ $(RESULTFILE) \ $(HEADERFILE) \ $(OVERFILE) TRANSXSL := $(XSLDIR)/transform.xsl OVERXSL := $(XSLDIR)/overview.xsl HTMLXSL := $(XSLDIR)/html.xsl TXTXSL := $(XSLDIR)/txt.xsl EXT := docbook # testresult input produced by ahven xml runner TESTS := `cd $(SRCDIR); ls TEST-*.xml` # testenv info TIME := $(shell date) OS := $(shell uname) HOSTNAME := $(shell hostname) KERNEL_NAME := $(shell uname -s) KERNEL_REL := $(shell uname -r) KERNEL_VER := $(shell uname -v) DBLATEX := dblatex --style=db2latex XP := xsltproc --nonet --novalid --xinclude all: $(TARGETS) $(PROJECT).html: $(SOURCES) @echo -n "Generating $@ ... " @$(XP) $(HTMLXSL) index.xml > $@ @echo "DONE" $(PROJECT).txt: $(SOURCES) @echo -n "Generating $@ ... " @$(XP) $(TXTXSL) index.xml | w3m -cols 65 -dump -T text/html > $@ @echo "DONE" $(PROJECT).pdf: $(SOURCES) @echo "Generating $@ ... " @$(DBLATEX) index.xml -o $@ @echo "DONE" $(OVERFILE): $(SRCINDEX) @$(XP) $(OVERXSL) $(SRCINDEX) > $@ $(SRCINDEX): @echo " $@ @for SOURCE in $(TESTS); do \ echo "" >> $@; \ done @echo "]> " >> $@ @for SOURCE in $(TESTS); do \ echo "&$$SOURCE;" >> $@; \ done @echo "" >> $@ $(RESULTFILE): to-docbook @cp $(HEADERFILE) $(RESULTFILE) @for DOC in `ls $(DOCDIR)/TEST-*.$(EXT)`; do \ echo "" \ >> $(RESULTFILE); \ done @echo "" >> $(RESULTFILE) to-docbook: @mkdir -p $(DOCDIR) @for SOURCE in $(TESTS); do \ $(XP) $(TRANSXSL) $(SRCDIR)/$$SOURCE > $(DOCDIR)/$$SOURCE.$(EXT); \ done $(ENTITYFILE): @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ @echo '' >> $@ clean: @rm -f $(PROJECT).* @rm -f $(RESULTFILE) @rm -f $(OVERFILE) @rm -f $(ENTITYFILE) @rm -rf $(DOCDIR) @rm -rf $(SRCINDEX) .PHONY: all $(PROJECT).html clean $(ENTITYFILE) $(SRCINDEX) ahven-2.7/contrib/docbook-testreport/index.xml0000644000000000000000000000320213325517624017740 0ustar 00000000000000 %envdata; ]> &project; Testresults &project; development team &email; &time; This document is an auto-generated testreport for the &project; project. The unit tests have been run on the testhost described in . shows overall statistics of this testrun, detailed results for each executed test can be found in . Environment The unit tests have been executed in the following environment: Date and Time&time; Hostname&hostname; Operating System&os; Kernel &kernel_name; &kernel_release; (&kernel_version;) ahven-2.7/contrib/docbook-testreport/result-header.xml0000644000000000000000000000031613325517624021400 0ustar 00000000000000 Results ahven-2.7/contrib/docbook-testreport/xsl/html.xsl0000644000000000000000000000064413325517624020420 0ustar 00000000000000 1 1 book toc,title,figure,example ahven-2.7/contrib/docbook-testreport/xsl/overview.xsl0000644000000000000000000000163513325517624021323 0ustar 00000000000000 Overview Total defined testsuites Total testcases executed Total failed testcases ahven-2.7/contrib/docbook-testreport/xsl/transform.xsl0000644000000000000000000000362113325517624021465 0ustar 00000000000000 <xsl:value-of select="@name"/> <xsl:value-of select="@name"/> summary Errors Failures Tests Time
<xsl:value-of select="@name"/> Execution Time Test Status PASSED Output FAILURE () ahven-2.7/contrib/docbook-testreport/xsl/txt.xsl0000644000000000000000000000065613325517624020276 0ustar 00000000000000 1 1 book toc,title,figure,example,equation ahven-2.7/contrib/tap/tester.pl0000644000000000000000000000063213325517624014711 0ustar 00000000000000#!/usr/bin/perl use TAP::Parser; use TAP::Parser::Aggregator; my $parser = TAP::Parser->new( { exec => [ './tap_tester' ] } ); $parser->run; # while ( my $result = $parser->next ) { # print $result->as_string . "\n"; # } my $aggregate = TAP::Parser::Aggregator->new; $aggregate->add( 'testcases', $parser ); printf "\tPassed: %s\n\tFailed: %s\n", scalar $aggregate->passed, scalar $aggregate->failed; ahven-2.7/css/html4css1.css0000644000000000000000000001364513325517624013756 0ustar 00000000000000/* :Author: David Goodger (goodger@python.org) :Id: $Id: html4css1.css 6511 2011-01-03 14:49:11Z milde $ :Copyright: This stylesheet has been placed in the public domain. Default cascading style sheet for the HTML output of Docutils. See http://docutils.sf.net/docs/howto/html-stylesheets.html for how to customize this style sheet. */ /* used to remove borders from tables and images */ .borderless, table.borderless td, table.borderless th { border: 0 } table.borderless td, table.borderless th { /* Override padding for "table.docutils td" with "! important". The right padding separates the table cells. */ padding: 0 0.5em 0 0 ! important } .first { /* Override more specific margin styles with "! important". */ margin-top: 0 ! important } .last, .with-subtitle { margin-bottom: 0 ! important } .hidden { display: none } a.toc-backref { text-decoration: none ; color: black } blockquote.epigraph { margin: 2em 5em ; } dl.docutils dd { margin-bottom: 0.5em } object[type="image/svg+xml"], object[type="application/x-shockwave-flash"] { overflow: hidden; } /* Uncomment (and remove this text!) to get bold-faced definition list terms dl.docutils dt { font-weight: bold } */ div.abstract { margin: 2em 5em } div.abstract p.topic-title { font-weight: bold ; text-align: center } div.admonition, div.attention, div.caution, div.danger, div.error, div.hint, div.important, div.note, div.tip, div.warning { margin: 2em ; border: medium outset ; padding: 1em } div.admonition p.admonition-title, div.hint p.admonition-title, div.important p.admonition-title, div.note p.admonition-title, div.tip p.admonition-title { font-weight: bold ; font-family: sans-serif } div.attention p.admonition-title, div.caution p.admonition-title, div.danger p.admonition-title, div.error p.admonition-title, div.warning p.admonition-title { color: red ; font-weight: bold ; font-family: sans-serif } /* Uncomment (and remove this text!) to get reduced vertical space in compound paragraphs. div.compound .compound-first, div.compound .compound-middle { margin-bottom: 0.5em } div.compound .compound-last, div.compound .compound-middle { margin-top: 0.5em } */ div.dedication { margin: 2em 5em ; text-align: center ; font-style: italic } div.dedication p.topic-title { font-weight: bold ; font-style: normal } div.figure { margin-left: 2em ; margin-right: 2em } div.footer, div.header { clear: both; font-size: smaller } div.line-block { display: block ; margin-top: 1em ; margin-bottom: 1em } div.line-block div.line-block { margin-top: 0 ; margin-bottom: 0 ; margin-left: 1.5em } div.sidebar { margin: 0 0 0.5em 1em ; border: medium outset ; padding: 1em ; background-color: #ffffee ; width: 40% ; float: right ; clear: right } div.sidebar p.rubric { font-family: sans-serif ; font-size: medium } div.system-messages { margin: 5em } div.system-messages h1 { color: red } div.system-message { border: medium outset ; padding: 1em } div.system-message p.system-message-title { color: red ; font-weight: bold } div.topic { margin: 2em } h1.section-subtitle, h2.section-subtitle, h3.section-subtitle, h4.section-subtitle, h5.section-subtitle, h6.section-subtitle { margin-top: 0.4em } h1.title { text-align: center } h2.subtitle { text-align: center } hr.docutils { width: 75% } img.align-left, .figure.align-left, object.align-left { clear: left ; float: left ; margin-right: 1em } img.align-right, .figure.align-right, object.align-right { clear: right ; float: right ; margin-left: 1em } img.align-center, .figure.align-center, object.align-center { display: block; margin-left: auto; margin-right: auto; } .align-left { text-align: left } .align-center { clear: both ; text-align: center } .align-right { text-align: right } /* reset inner alignment in figures */ div.align-right { text-align: inherit } /* div.align-center * { */ /* text-align: left } */ ol.simple, ul.simple { margin-bottom: 1em } ol.arabic { list-style: decimal } ol.loweralpha { list-style: lower-alpha } ol.upperalpha { list-style: upper-alpha } ol.lowerroman { list-style: lower-roman } ol.upperroman { list-style: upper-roman } p.attribution { text-align: right ; margin-left: 50% } p.caption { font-style: italic } p.credits { font-style: italic ; font-size: smaller } p.label { white-space: nowrap } p.rubric { font-weight: bold ; font-size: larger ; color: maroon ; text-align: center } p.sidebar-title { font-family: sans-serif ; font-weight: bold ; font-size: larger } p.sidebar-subtitle { font-family: sans-serif ; font-weight: bold } p.topic-title { font-weight: bold } pre.address { margin-bottom: 0 ; margin-top: 0 ; font: inherit } pre.literal-block, pre.doctest-block { margin-left: 2em ; margin-right: 2em } span.classifier { font-family: sans-serif ; font-style: oblique } span.classifier-delimiter { font-family: sans-serif ; font-weight: bold } span.interpreted { font-family: sans-serif } span.option { white-space: nowrap } span.pre { white-space: pre } span.problematic { color: red } span.section-subtitle { /* font-size relative to parent (h1..h6 element) */ font-size: 80% } table.citation { border-left: solid 1px gray; margin-left: 1px } table.docinfo { margin: 2em 4em } table.docutils { margin-top: 0.5em ; margin-bottom: 0.5em } table.footnote { border-left: solid 1px black; margin-left: 1px } table.docutils td, table.docutils th, table.docinfo td, table.docinfo th { padding-left: 0.5em ; padding-right: 0.5em ; vertical-align: top } table.docutils th.field-name, table.docinfo th.docinfo-name { font-weight: bold ; text-align: left ; white-space: nowrap ; padding-left: 0 } h1 tt.docutils, h2 tt.docutils, h3 tt.docutils, h4 tt.docutils, h5 tt.docutils, h6 tt.docutils { font-size: 100% } ul.auto-toc { list-style-type: none } ahven-2.7/css/my-docutils.css0000644000000000000000000000037013325517624014374 0ustar 00000000000000 /* :Author: Tero Koskinen :Contact: Tero Koskinen :Copyright: This stylesheet has been placed in the public domain. Stylesheet for use with Ahven and Docutils. */ h1 { background-color: #cdcdff; padding: 0.1em; } ahven-2.7/doc/manual/en/Makefile0000644000000000000000000000457513325517624014720 0ustar 00000000000000# Makefile for Sphinx documentation # # You can set these variables from the command line. SPHINXOPTS = SPHINXBUILD = sphinx-build PAPER = BUILDDIR = build # Internal variables. PAPEROPT_a4 = -D latex_paper_size=a4 PAPEROPT_letter = -D latex_paper_size=letter ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source .PHONY: help clean html web pickle htmlhelp latex changes linkcheck help: @echo "Please use \`make ' where is one of" @echo " html to make standalone HTML files" @echo " pickle to make pickle files (usable by e.g. sphinx-web)" @echo " htmlhelp to make HTML files and a HTML help project" @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter" @echo " changes to make an overview over all changed/added/deprecated items" @echo " linkcheck to check all external links for integrity" clean: -rm -rf $(BUILDDIR)/* html: mkdir -p $(BUILDDIR)/html $(BUILDDIR)/doctrees $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html @echo @echo "Build finished. The HTML pages are in $(BUILDDIR)/html." pickle: mkdir -p $(BUILDDIR)/pickle $(BUILDDIR)/doctrees $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle @echo @echo "Build finished; now you can process the pickle files or run" @echo " sphinx-web $(BUILDDIR)/pickle" @echo "to start the sphinx-web server." web: pickle htmlhelp: mkdir -p $(BUILDDIR)/htmlhelp $(BUILDDIR)/doctrees $(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp @echo @echo "Build finished; now you can run HTML Help Workshop with the" \ ".hhp project file in $(BUILDDIR)/htmlhelp." latex: mkdir -p $(BUILDDIR)/latex $(BUILDDIR)/doctrees $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex @echo @echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex." @echo "Run \`make all-pdf' or \`make all-ps' in that directory to" \ "run these through (pdf)latex." changes: mkdir -p $(BUILDDIR)/changes $(BUILDDIR)/doctrees $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes @echo @echo "The overview file is in $(BUILDDIR)/changes." linkcheck: mkdir -p $(BUILDDIR)/linkcheck $(BUILDDIR)/doctrees $(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck @echo @echo "Link check complete; look for any errors in the above output " \ "or in $(BUILDDIR)/linkcheck/output.txt." ahven-2.7/doc/manual/en/source/api-ahven-framework.rst0000644000000000000000000002511613325517624021147 0ustar 00000000000000.. index:: ! Ahven.Framework (package) :mod:`Ahven.Framework` -- Package ================================= .. moduleauthor:: Tero Koskinen .. highlight:: ada ----- Types ----- Test_Count_Type ''''''''''''''' :: type Test_Count_Type is new Natural; Type for the test count. This effectively limits the amount tests to whatever Natural is. Although, in practice when adding tests the limit is not checked. Test_Duration ''''''''''''' :: subtype Test_Duration is Duration range 0.0 .. Three_Hours; Subtype for the test timeouts. Limited to 3 hours, which should be enough for unit tests. Timeout value 0.0 means infinite time. .. index:: single: Test (Ahven.Framework, abstract controlled type) Test '''' :: type Test is abstract new Ada.Finalization.Controlled with null record; A type, which provides the base for Test_Case and Test_Suite types. Test_Class_Access ''''''''''''''''' :: type Test_Class_Access is access all Test'Class; An access type for Test'Class. .. index:: single: Test_Case (Ahven.Framework, abstract controlled type) Test_Case ''''''''' :: type Test_Case is abstract new Test with private; The base type for other test cases. Object_Test_Routine_Access '''''''''''''''''''''''''' :: type Object_Test_Routine_Access is access procedure (T : in out Test_Case'Class); A pointer to a test routine which takes Test_Case'Class object as an argument. For this kind of test routines, the framework will call Set_Up and Tear_Down routines before and after test routine execution. Simple_Test_Routine_Access '''''''''''''''''''''''''' :: type Simple_Test_Routine_Access is access procedure; A pointer to a test routine which does not take arguments. .. index:: single: Test (Ahven.Framework, controlled type) Test_Suite '''''''''' :: type Test_Suite is new Test with private; A collection of Tests. You can either fill a Test_Suite object with Test_Case objects or nest multiple Test_Suite objects. You can even mix Test_Case and Test_Suite objects, if necessary. Test_Suite_Access ''''''''''''''''' :: type Test_Suite_Access is access all Test_Suite; An access type for Test_Suite. ------------------------ Procedures and functions ------------------------ Set_Up '''''' :: procedure Set_Up (T : in out Test); Set_Up is called before executing the test procedure. Tear_Down ''''''''' :: procedure Tear_Down (T : in out Test); Tear_Down is called after the test procedure is executed. Get_Name '''''''' :: function Get_Name (T : Test) return String is abstract; Return the name of the test. .. index:: single: Run (Ahven.Framework, procedure) Run ''' :: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); Run the test and place the test result to Result. Infinite timeout. Run ''' :: procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; Run the test and place the test result to Result. Run ''' :: procedure Run (T : in out Test; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Run the test with given name and place the test result to Result. Notice: If multiple tests have same name this might call all of them. Run ''' :: procedure Run (T : in out Test; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; Run the test with given name and place the test result to Result. Notice: If multiple tests have same name this might call all of them. Timeout specifies maximum execution time for the tests. .. index:: single: Test_Count (Ahven.Framework, procedure) Test_Count '''''''''' :: function Test_Count (T : Test) return Test_Count_Type is abstract; Return the amount of tests (test routines) which will be executed when the Run (T) procedure is called. Test_Count '''''''''' :: function Test_Count (T : Test; Test_Name : String) return Test_Count_Type is abstract; Return the amount of tests (test routines) which will be executed when the Run (T, Test_Name) procedure is called. Execute ''''''' :: procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class); Call Test class' Run method and place the test outcome to Result. The procedure calls Start_Test of every listener before calling the Run procedure and End_Test after calling the Run procedure. Execute ''''''' :: procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Call Test class' Run method and place the test outcome to Result. The procedure calls Start_Test of every listener before calling the Run procedure and End_Test after calling the Run procedure. Timeout specifies the maximum execution time for each test. Execute ''''''' :: procedure Execute (T : in out Test'Class; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Same as Execute above, but call the Run procedure which takes Test_Name parameter. Execute ''''''' :: procedure Execute (T : in out Test'Class; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Same as Execute above, but call the Run procedure which takes Test_Name parameter. Timeout specifies the maximum execution time for each test. Get_Name '''''''' :: function Get_Name (T : Test_Case) return String; Return the name of the test case. Run ''' :: procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class); Run Test_Case's test routines. Run ''' :: procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run Test_Case's test routines with timeout value. Run ''' :: procedure Run (T : in out Test_Case; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Run Test_Case's test routine which matches to the Name. Run ''' :: procedure Run (T : in out Test_Case; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run Test_Case's test routine which matches to the Name, with timeout value. Test_Count '''''''''' :: function Test_Count (T : Test_Case) return Test_Count_Type; Implementation of Test_Count (T : Test). Test_Count '''''''''' :: function Test_Count (T : Test_Case; Test_Name : String) return Test_Count_Type; Implementation of Test_Count (T : Test, Test_Name : String). Finalize '''''''' :: procedure Finalize (T : in out Test_Case); Finalize procedure of the Test_Case. Set_Name '''''''' :: procedure Set_Name (T : in out Test_Case; Name : String); Set Test_Case's name. Add_Test_Routine '''''''''''''''' :: procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Object_Test_Routine_Access; Name : String); Register a test routine to the Test_Case object. Add_Test_Routine '''''''''''''''' :: procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Simple_Test_Routine_Access; Name : String); Register a simple test routine to the Test_Case. Create_Suite '''''''''''' :: function Create_Suite (Suite_Name : String) return Test_Suite_Access; Create a new Test_Suite. Caller must free the returned Test_Suite using Release_Suite. Create_Suite '''''''''''' :: function Create_Suite (Suite_Name : String) return Test_Suite; Create a new Test_Suite. The suite and its children are released automatically. Add_Test '''''''' :: procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access); Add a Test to the suite. The suite frees the Test automatically when it is no longer needed. Add_Test '''''''' :: procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access); Add a Test suite to the suite. The suite frees the Test automatically when it is no longer needed. Add_Static_Test ''''''''''''''' :: procedure Add_Static_Test (Suite : in out Test_Suite; T : Test'Class); Add a Test to the suite. This procedure is meant for statically allocated Test_Case objects. Get_Name '''''''' :: function Get_Name (T : Test_Suite) return String; Return the name of Test_Suite. Run ''' :: procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class); Run Test_Suite's Test_Cases. Run ''' :: procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run Test_Suite's Test_Cases with timeout value. Run ''' :: procedure Run (T : in out Test_Suite; Test_Name : String; Listener : in out Listeners.Result_Listener'Class); Run test suite's child which matches to the given name. Run ''' :: procedure Run (T : in out Test_Suite; Test_Name : String; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); Run test suite's child which matches to the given name, with timeout value. Test_Count '''''''''' :: function Test_Count (T : Test_Suite) return Test_Count_Type; Implementation of Test_Count (T : Test). Test_Count '''''''''' :: function Test_Count (T : Test_Suite; Test_Name : String) return Test_Count_Type; Implementation of Test_Count (T : Test, Test_Name : String). Adjust '''''' :: procedure Adjust (T : in out Test_Suite); Adjust procedure of Test_Suite. Handles the copying of the structure properly Finalize '''''''' :: procedure Finalize (T : in out Test_Suite); Finalize procedure of Test_Suite. Frees all added Tests. Release_Suite ''''''''''''' :: procedure Release_Suite (T : Test_Suite_Access); Release the memory of Test_Suite. All added tests are released automatically. ahven-2.7/doc/manual/en/source/api-ahven-listeners-basic.rst0000644000000000000000000000434713325517624022244 0ustar 00000000000000.. index:: ! Ahven.Listeners.Basic (package) :mod:`Ahven.Listeners.Basic` -- Package ======================================= .. moduleauthor:: Tero Koskinen ----- Types ----- Result_Type ''''''''''' :: type Result_Type is (NO_RESULT, PASS_RESULT, FAILURE_RESULT, ERROR_RESULT); Basic_Listener '''''''''''''' :: type Basic_Listener is new Result_Listener with record Main_Result : aliased Result_Collection; Current_Result : Result_Collection_Access; Last_Test_Result : Result_Type := NO_RESULT; Last_Info : Result_Info := Empty_Result_Info; Capture_Output : Boolean := False; Output_File : Temporary_Output.Temporary_File; Start_Time : Ada.Calendar.Time; end record; ------------------------ Procedures and Functions ------------------------ Add_Pass '''''''' :: procedure Add_Pass (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Add_Pass Add_Failure ''''''''''' :: procedure Add_Failure (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Add_Failure Add_Error ''''''''' :: procedure Add_Error (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Add_Error Start_Test '''''''''' :: procedure Start_Test (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.Start_Test End_Test '''''''' :: procedure End_Test (Listener : in out Basic_Listener; Info : Context); New implementation for Listeners.End_Test Set_Output_Capture '''''''''''''''''' :: procedure Set_Output_Capture (Listener : in out Basic_Listener; Capture : Boolean); Enable or disable Ada.Text_IO output capturing. When Capture is True, all Ada.Text_IO output is redirected into temporary files. See Ahven.Temporary_Output package for details. Get_Output_Capture '''''''''''''''''' :: function Get_Output_Capture (Listener : Basic_Listener) return Boolean; Capture the Ada.Text_IO output? ahven-2.7/doc/manual/en/source/api-ahven-listeners.rst0000644000000000000000000000513513325517624021161 0ustar 00000000000000.. index:: ! Ahven.Listeners (package) :mod:`Ahven.Listeners` -- Package ================================= .. moduleauthor:: Tero Koskinen ----- Types ----- Test_Phase '''''''''' :: type Test_Phase is (TEST_BEGIN, TEST_RUN, TEST_END); What is test doing right now? Test_Type ''''''''' :: type Test_Type is (CONTAINER, ROUTINE); Context ''''''' :: type Context (Phase : Test_Phase) is record Test_Name : AStrings.Bounded_String; Test_Kind : Test_Type; case Phase is when TEST_BEGIN | TEST_END => null; when TEST_RUN => Routine_Name : AStrings.Bounded_String; Message : AStrings.Bounded_String; Long_Message : Long_AStrings.Bounded_String; end case; end record; Result_Listener ''''''''''''''' :: type Result_Listener is abstract new Ada.Finalization.Limited_Controlled with null record; Result_Listener is a listener for test results. Whenever a test is run, the framework calls registered listeners and tells them the result of the test. Result_Listener_Class_Access '''''''''''''''''''''''''''' :: type Result_Listener_Class_Access is access all Result_Listener'Class; ------------------------ Procedures and Functions ------------------------ Add_Pass '''''''' :: procedure Add_Pass (Listener : in out Result_Listener; Info : Context) is abstract; Called after test passes. Add_Failure ''''''''''' :: procedure Add_Failure (Listener : in out Result_Listener; Info : Context) is abstract; Called after test fails. Add_Error ''''''''' :: procedure Add_Error (Listener : in out Result_Listener; Info : Context) is abstract; Called after there is an error in the test. Add_Skipped ''''''''''' .. versionadded:: 2.0 :: procedure Add_Skipped (Listener : in out Result_Listener; Info : Context); Called when user wants to skip the test. By default, skipped tests are treated as failures. Listeners should reimplement this function if they want to report skipped tests separately. Start_Test '''''''''' :: procedure Start_Test (Listener : in out Result_Listener; Info : Context) is abstract; Called before the test begins. This is called before Add_* procedures. End_Test '''''''' :: procedure End_Test (Listener : in out Result_Listener; Info : Context) is abstract; Called after the test ends. Add_* procedures are called before this. ahven-2.7/doc/manual/en/source/api-ahven-parameters.rst0000644000000000000000000000306513325517624021314 0ustar 00000000000000.. index:: ! Ahven.Parameters (package) :mod:`Ahven.Parameters` -- Package ================================== .. moduleauthor:: Tero Koskinen ----- Types ----- Parameter_Info '''''''''''''' :: type Parameter_Info is private; Parameter_Mode '''''''''''''' :: type Parameter_Mode is (NORMAL_PARAMETERS, TAP_PARAMETERS); ------------------------ Procedures and Functions ------------------------ Parse_Parameters '''''''''''''''' :: procedure Parse_Parameters (Mode : Parameter_Mode; Info : out Parameter_Info); Parse Ada.Command_Line parameters and put the results to the Info parameter. Raises Invalid_Parameter if some parameter is invalid. Usage ''''' :: procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS); Print usage. Capture ''''''' :: function Capture (Info : Parameter_Info) return Boolean; Should we capture Ada.Text_IO output? Verbose ''''''' :: function Verbose (Info : Parameter_Info) return Boolean; Should we use verbose mode? XML_Results ''''''''''' :: function XML_Results (Info : Parameter_Info) return Boolean; Should we output XML? Single_Test ''''''''''' :: function Single_Test (Info : Parameter_Info) return Boolean; Should we run a single test (case/suite/routine) only? Test_Name ''''''''' :: function Test_Name (Info : Parameter_Info) return String; Return the name of the test passed as a parameter. Result_Dir '''''''''' :: function Result_Dir (Info : Parameter_Info) return String; Return the directory for XML results. ahven-2.7/doc/manual/en/source/api-ahven-results.rst0000644000000000000000000002222213325517624020646 0ustar 00000000000000.. index:: ! Ahven.Results (package) :mod:`Ahven.Results` -- Package =============================== .. moduleauthor:: Tero Koskinen ----- Types ----- Result_Info ''''''''''' :: type Result_Info is private; A type which holds a test result for one test. Result_Collection ''''''''''''''''' :: type Result_Collection is limited private; A collection of Result_Info objects. Contains also child collections. Result_Collection_Access '''''''''''''''''''''''' :: type Result_Collection_Access is access Result_Collection; Access type for Result_Collection. Result_Info_Cursor '''''''''''''''''' :: type Result_Info_Cursor is private; A cursor type for Pass, Failure and Error results. Result_Collection_Cursor '''''''''''''''''''''''' :: type Result_Collection_Cursor is private; Cursor for iterating over a set of Result_Collection access objects. --------- Constants --------- Empty_Result_Info ''''''''''''''''' :: Empty_Result_Info : constant Result_Info; Result_Info object which holds no result. It can be used to initialize a new Result_Info object. ------------------------ Procedures and Functions ------------------------ Set_Test_Name ''''''''''''' :: procedure Set_Test_Name (Info : in out Result_Info; Name : Bounded_String); Set a test name for the result. Set_Routine_Name '''''''''''''''' :: procedure Set_Routine_Name (Info : in out Result_Info; Name : Bounded_String); Set a routine name for the result. Set_Message ''''''''''' :: procedure Set_Message (Info : in out Result_Info; Message : Bounded_String); Set a message for the result. Set_Test_Name ''''''''''''' :: procedure Set_Test_Name (Info : in out Result_Info; Name : String); A helper function, which calls Set_Test_Name (.. ; Bounded_String). Set_Routine_Name '''''''''''''''' :: procedure Set_Routine_Name (Info : in out Result_Info; Name : String); A helper function, which calls Set_Routine_Name (.. ; Bounded_String). Set_Message ''''''''''' :: procedure Set_Message (Info : in out Result_Info; Message : String); A helper function, which calls Set_Message (.. ; Bounded_String). Set_Long_Message '''''''''''''''' :: procedure Set_Long_Message (Info : in out Result_Info; Message : Bounded_String); Set a long message for the result. Set_Long_Message '''''''''''''''' :: procedure Set_Long_Message (Info : in out Result_Info; Message : String); A helper function, which calls Set_Long_Message (.. ; Bounded_String). Set_Execution_Time '''''''''''''''''' :: procedure Set_Execution_Time (Info : in out Result_Info; Elapsed_Time : Duration); Set the execution time of the result info (test). Set_Output_File ''''''''''''''' :: procedure Set_Output_File (Info : in out Result_Info; Filename : Bounded_String); Set the name of the test output file. Set_Output_File ''''''''''''''' :: procedure Set_Output_File (Info : in out Result_Info; Filename : String); Set the name of the test output file. Get_Test_Name ''''''''''''' :: function Get_Test_Name (Info : Result_Info) return String; Return the test name of the result info. Get_Routine_Name '''''''''''''''' :: function Get_Routine_Name (Info : Result_Info) return String; Return the routine name of the result info. Get_Message ''''''''''' :: function Get_Message (Info : Result_Info) return String; Return the message of the result info. The message will be something what has been given to the Assert call. Get_Long_Message '''''''''''''''' :: function Get_Long_Message (Info : Result_Info) return String; Return the long message of the result info. The long message usually contains the backtrace or other info related to the test failure. Get_Execution_Time '''''''''''''''''' :: function Get_Execution_Time (Info : Result_Info) return Duration; Return the execution time of the result info. Get_Output_File ''''''''''''''' :: function Get_Output_File (Info : Result_Info) return Bounded_String; Return the name of the output file. Empty string is returned in case there is no output file. Add_Child ''''''''' :: procedure Add_Child (Collection : in out Result_Collection; Child : Result_Collection_Access); Add a child collection to the collection. Ownership of Child is transferred to the Collection container and Child will be automatically freed when Collection is destroyed. Add_Error ''''''''' :: procedure Add_Error (Collection : in out Result_Collection; Info : Result_Info); Add a test error to the collection. Add_Skipped ''''''''''' :: procedure Add_Skipped (Collection : in out Result_Collection; Info : Result_Info); Add a skipped test to the collection. Add_Failure ''''''''''' :: procedure Add_Failure (Collection : in out Result_Collection; Info : Result_Info); Add a test failure to the collection. Add_Pass '''''''' :: procedure Add_Pass (Collection : in out Result_Collection; Info : Result_Info); Add a passed test to the collection Release ''''''' :: procedure Release (Collection : in out Result_Collection); Release resourced held by the collection. Frees also all children added via Add_Child. Set_Name '''''''' :: procedure Set_Name (Collection : in out Result_Collection; Name : Bounded_String); Set a test name for the collection. Set_Parent '''''''''' :: procedure Set_Parent (Collection : in out Result_Collection; Parent : Result_Collection_Access); Set a parent collection to the collection. Test_Count '''''''''' :: function Test_Count (Collection : Result_Collection) return Natural; Return the amount of tests in the collection. Tests in child collections are included. Direct_Test_Count ''''''''''''''''' :: function Direct_Test_Count (Collection : Result_Collection) return Natural; Return the amount of tests in the collection. The tests in the child collections are NOT included. Pass_Count '''''''''' :: function Pass_Count (Collection : Result_Collection) return Natural; Return the amount of passed tests in the collection. Tests in child collections are included. Error_Count ''''''''''' :: function Error_Count (Collection : Result_Collection) return Natural; Return the amount of test errors in the collection. Tests in child collections are included. Failure_Count ''''''''''''' :: function Failure_Count (Collection : Result_Collection) return Natural; Return the amount of test errors in the collection. Tests in child collections are included. Skipped_Count ''''''''''''' :: function Skipped_Count (Collection : Result_Collection) return Natural; Return the amount of skipped tests in the collection. Tests in child collections are included. Get_Test_Name ''''''''''''' :: function Get_Test_Name (Collection : Result_Collection) return Bounded_String; Return the name of the collection's test. Get_Parent '''''''''' :: function Get_Parent (Collection : Result_Collection) return Result_Collection_Access; Return the parent of the collection. Get_Execution_Time '''''''''''''''''' :: function Get_Execution_Time (Collection : Result_Collection) return Duration; Return the execution time of the whole collection. First_Pass '''''''''' :: function First_Pass (Collection : Result_Collection) return Result_Info_Cursor; Get the first pass from the collection. First_Failure ''''''''''''' :: function First_Failure (Collection : Result_Collection) return Result_Info_Cursor; Get the first failure from the collection. First_Error ''''''''''' :: function First_Error (Collection : Result_Collection) return Result_Info_Cursor; Get the first error from the collection. Next '''' :: function Next (Position: Result_Info_Cursor) return Result_Info_Cursor; Get the next pass/failure/error. Data '''' :: function Data (Position: Result_Info_Cursor) return Result_Info; Get the data behind the cursor. Is_Valid '''''''' :: function Is_Valid (Position: Result_Info_Cursor) return Boolean; Is the cursor still valid? First_Child ''''''''''' :: function First_Child (Collection : in Result_Collection) return Result_Collection_Cursor; Get the first child of the collection. Next '''' :: function Next (Position: Result_Collection_Cursor) return Result_Collection_Cursor; Get the next child. Is_Valid '''''''' :: function Is_Valid (Position: Result_Collection_Cursor) return Boolean; Is the cursor still valid? Data '''' :: function Data (Position: Result_Collection_Cursor) return Result_Collection_Access; Get the data (Result_Collection_Access) behind the cursor. Child_Depth ''''''''''' :: function Child_Depth (Collection : Result_Collection) return Natural; Return the maximum depth of children. (a child of a child, etc.) ahven-2.7/doc/manual/en/source/api-ahven-runner.rst0000644000000000000000000000125113325517624020455 0ustar 00000000000000.. index:: ! Ahven.Runner (package) :mod:`Ahven.Runner` -- Package ============================== .. moduleauthor:: Tero Koskinen ----- Types ----- Report_Proc ''''''''''' :: type Report_Proc is access procedure (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); ------------------------ Procedures and Functions ------------------------ Run_Suite ''''''''' :: procedure Run_Suite (Suite : in out Framework.Test'Class; Reporter : Report_Proc); Run the given test (case/suite) and pass the results and the command line argument info to the reporter procedure. ahven-2.7/doc/manual/en/source/api-ahven-slist.rst0000644000000000000000000000376013325517624020311 0ustar 00000000000000.. index:: ! Ahven.SList (package) :mod:`Ahven.SList` -- Package ============================= .. moduleauthor:: Tero Koskinen .. versionadded:: 1.4 ----- Types ----- List '''' :: type List is new Ada.Finalization.Controlled with private; Cursor '''''' :: type Cursor is private; Count_Type '''''''''' :: subtype Count_Type is Natural; ---------- Exceptions ---------- Invalid_Cursor '''''''''''''' :: Invalid_Cursor : exception; Raised when the cursor given as a parameter is invalid. For example, calling Data (Pos) when Is_Valid (Pos) returns False causes the exception to be raised. List_Full ''''''''' :: List_Full : exception; Raised when the size of the list exceeds Count_Type'Last. ------------------------ Procedures and Functions ------------------------ Append '''''' :: procedure Append (Target : in out List; Node_Data : Element_Type); Append an element at the end of the list. Clear ''''' .. versionchanged:: 1.8 Previously Clear was called Remove_All. :: procedure Clear (Target : in out List); Remove all elements from the list. First ''''' :: function First (Target : List) return Cursor; Return a cursor to the first element of the list. Next '''' :: function Next (Position : Cursor) return Cursor; Move the cursor to point to the next element on the list. Data '''' :: function Data (Position : Cursor) return Element_Type; Return element pointed by the cursor. Is_Valid '''''''' :: function Is_Valid (Position : Cursor) return Boolean; Tell the validity of the cursor. The cursor will become invalid when you iterate it over the last item. Length '''''' :: function Length (Target : List) return Count_Type; Return the length of the list. For_Each '''''''' .. versionadded:: 1.8 :: generic with procedure Action (T : in out Element_Type) is <>; procedure For_Each (Target : List); A generic procedure for walk through every item in the list and call Action procedure for them. ahven-2.7/doc/manual/en/source/api-ahven-tap_runner.rst0000644000000000000000000000216113325517624021322 0ustar 00000000000000.. index:: ! Ahven.Tap_Runner (package) :mod:`Ahven.Tap_Runner` -- Package ================================== .. moduleauthor:: Tero Koskinen ======================== Procedures and Functions ======================== Run ''' :: procedure Run (Suite : in out Framework.Test'Class); Run the suite and print the results in Test-Anything-Protocol (TAP) format. Skipped tests are reported as *ok* with *# SKIP* text in description. Add_Pass '''''''' :: procedure Add_Pass (Listener : in out Tap_Listener; Info : Context); Add_Failure ''''''''''' :: procedure Add_Failure (Listener : in out Tap_Listener; Info : Context); Add_Error ''''''''' :: procedure Add_Error (Listener : in out Tap_Listener; Info : Context); Start_Test '''''''''' :: procedure Start_Test (Listener : in out Tap_Listener; Info : Context); End_Test '''''''' :: procedure End_Test (Listener : in out Tap_Listener; Info : Context); ahven-2.7/doc/manual/en/source/api-ahven-temporary_output.rst0000644000000000000000000000401613325517624022610 0ustar 00000000000000.. index:: ! Ahven.Temporary_Output (package) :mod:`Ahven.Temporary_Output` -- Package ======================================== .. moduleauthor:: Tero Koskinen ----- Types ----- Temporary_File '''''''''''''' :: type Temporary_File is limited private; A type which represents a temporary file. ------------------------ Procedures and Functions ------------------------ Create_Temp ''''''''''' :: procedure Create_Temp (File : out Temporary_File); Create a new temporary file. Exception Temporary_File_Error is raised if the procedure cannot create a new temp file. The name of the file is automatically generated and follows form ahven_123 where "ahven\_" is a constant prefix and "123" increases by one after every Create_Temp call. The file is created to the current working directory. For every created temporary file, you need to call either Remove_Temp or Close_Temp when the file is no longer needed. Otherwise, there will be a memory leak. Get_Name '''''''' :: function Get_Name (File : Temporary_File) return String; Return the name of the file. You need to create a new temporary file first using Create_Temp procedure before calling this function. Example:: ... Temp : Temporary_Output.Temporary_File; begin Temporary_Output.Create_Temp (Temp); Ada.Text_IO.Put_Line (Temporary_Output.Get_Name (Temp)); Redirect_Output ''''''''''''''' :: procedure Redirect_Output (To_File : in out Temporary_File); Redirect the standard output to the file. To_File must be opened using Create_Temp. Restore_Output '''''''''''''' :: procedure Restore_Output; Restore the standard output to its default settings. Remove_Temp ''''''''''' :: procedure Remove_Temp (File : in out Temporary_File); Remove the temporary file. File can be either open or closed. Close_Temp '''''''''' :: procedure Close_Temp (File : in out Temporary_File); Close the temporary file. If you want to remove the temporary file from the file system, you need to call Remove_Temp procedure. ahven-2.7/doc/manual/en/source/api-ahven-text_runner.rst0000644000000000000000000000072013325517624021521 0ustar 00000000000000.. index:: ! Ahven.Text_Runner (package) :mod:`Ahven.Text_Runner` -- Package =================================== .. moduleauthor:: Tero Koskinen ------------------------ Procedures and Functions ------------------------ Run ''' :: procedure Run (Suite : in out Framework.Test'Class); Run the suite and print the results. Run ''' :: procedure Run (Suite : Framework.Test_Suite_Access); Run the suite and print the results. ahven-2.7/doc/manual/en/source/api-ahven-xml_runner.rst0000644000000000000000000000165113325517624021341 0ustar 00000000000000.. index:: ! Ahven.XML_Runner (package) :mod:`Ahven.XML_Runner` -- Package ================================== .. moduleauthor:: Tero Koskinen .. versionadded:: 1.2 ------------------------ Procedures and Functions ------------------------ Run ''' :: procedure Run (Suite : in out Framework.Test_Suite'Class); Run the suite and write the results to a file in XML format. Run ''' :: procedure Run (Suite : Framework.Test_Suite_Access); Run the suite and write the results to a file. The routine is identical to the Run (Suite : in out Framework.Test_Suite'Class) procedure, but takes an access parameter to a test suite. Report_Results '''''''''''''' :: procedure Report_Results (Result : Results.Result_Collection; Dir : String); Write the test results to the given directory. This is called automatically during the execution of either of Run procedures. ahven-2.7/doc/manual/en/source/api-ahven.rst0000644000000000000000000000315713325517624017155 0ustar 00000000000000.. index:: ! Ahven (package) :mod:`Ahven` -- Package ======================= .. moduleauthor:: Tero Koskinen ---------- Exceptions ---------- .. _assertion-error: ahven-assertion_error **Assertion_Error** Exception, raised when Assert fails. ------------------------ Procedures and Functions ------------------------ .. _ahven-assert: Assert '''''' :: procedure Assert (Condition : Boolean; Message : String); If Condition is false, Assert raises Assertion_Error with given Message. .. _ahven-assert_equal: Assert_Equal '''''''''''' .. versionadded:: 1.4 :: generic type Data_Type is private; with function Image (Item : Data_Type) return String is <>; procedure Assert_Equal (Actual : Data_Type; Expected : Data_Type; Message : String); If Expected /= Actual, Assert raises Assertion_Error with given Message. Function Image is used to convert Actual and Expected parameters into String. Example:: declare procedure Assert_Eq_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); begin Assert_Eq_Nat (Actual => Test_Count, Expected => 4, "test count"); end; .. _ahven-fail: Fail '''' :: procedure Fail (Message : String); Fail always raises Assertion_Error with given Message. .. _ahven-skip: Skip '''' .. versionadded:: 2.0 :: procedure Skip (Message : String); Skip always raises Test_Skipped_Error with given Message. In practice, this means that the execution of tests stops there and the test is marked as 'skipped'. ahven-2.7/doc/manual/en/source/api.rst0000644000000000000000000000066613325517624016060 0ustar 00000000000000--------------------------- API Documentation for Ahven --------------------------- .. toctree:: :maxdepth: 2 api-ahven.rst api-ahven-framework.rst api-ahven-listeners-basic.rst api-ahven-listeners.rst api-ahven-parameters.rst api-ahven-results.rst api-ahven-runner.rst api-ahven-slist.rst api-ahven-tap_runner.rst api-ahven-temporary_output.rst api-ahven-text_runner.rst api-ahven-xml_runner.rst ahven-2.7/doc/manual/en/source/conf.py0000644000000000000000000001322013325517624016042 0ustar 00000000000000# -*- coding: utf-8 -*- # # Ahven documentation build configuration file, created by # sphinx-quickstart on Fri Jul 9 10:22:54 2010. # # This file is execfile()d with the current directory set to its containing dir. # # The contents of this file are pickled, so don't put values in the namespace # that aren't pickleable (module imports are okay, they're removed automatically). # # All configuration values have a default value; values that are commented out # serve to show the default value. import sys, os # If your extensions are in another directory, add it here. If the directory # is relative to the documentation root, use os.path.abspath to make it # absolute, like shown here. #sys.path.append(os.path.abspath('some/directory')) # General configuration # --------------------- # Add any Sphinx extension module names here, as strings. They can be extensions # coming with Sphinx (named 'sphinx.ext.*') or your custom ones. extensions = [] # Add any paths that contain templates here, relative to this directory. templates_path = ['_templates'] # The suffix of source filenames. source_suffix = '.rst' # The master toctree document. master_doc = 'index' # General substitutions. project = 'Ahven' copyright = '2018, Tero Koskinen' # The default replacements for |version| and |release|, also used in various # other places throughout the built documents. # # The short X.Y version. version = '2.7' # The full version, including alpha/beta/rc tags. release = '2.7' # There are two options for replacing |today|: either, you set today to some # non-false value, then it is used: #today = '' # Else, today_fmt is used as the format for a strftime call. today_fmt = '%B %d, %Y' # List of documents that shouldn't be included in the build. #unused_docs = [] # List of directories, relative to source directories, that shouldn't be searched # for source files. #exclude_dirs = [] # The reST default role (used for this markup: `text`) to use for all documents. #default_role = None # If true, '()' will be appended to :func: etc. cross-reference text. #add_function_parentheses = True # If true, the current module name will be prepended to all description # unit titles (such as .. function::). #add_module_names = True # If true, sectionauthor and moduleauthor directives will be shown in the # output. They are ignored by default. #show_authors = False # The name of the Pygments (syntax highlighting) style to use. pygments_style = 'sphinx' # Options for HTML output # ----------------------- # The style sheet to use for HTML and HTML Help pages. A file of that name # must exist either in Sphinx' static/ path, or in one of the custom paths # given in html_static_path. html_style = 'nature.css' # The name for this set of Sphinx documents. If None, it defaults to # " v documentation". #html_title = None # A shorter title for the navigation bar. Default is the same as html_title. #html_short_title = None # The name of an image file (within the static path) to place at the top of # the sidebar. #html_logo = None # The name of an image file (within the static path) to use as favicon of the # docs. This file should be a Windows icon file (.ico) being 16x16 or 32x32 # pixels large. #html_favicon = None # Add any paths that contain custom static files (such as style sheets) here, # relative to this directory. They are copied after the builtin static files, # so a file named "default.css" will overwrite the builtin "default.css". html_static_path = ['_static'] # If not '', a 'Last updated on:' timestamp is inserted at every page bottom, # using the given strftime format. html_last_updated_fmt = '%b %d, %Y' # If true, SmartyPants will be used to convert quotes and dashes to # typographically correct entities. #html_use_smartypants = True # Custom sidebar templates, maps document names to template names. #html_sidebars = {} # Additional templates that should be rendered to pages, maps page names to # template names. #html_additional_pages = {} # If false, no module index is generated. html_use_modindex = False # If false, no index is generated. #html_use_index = True # If true, the index is split into individual pages for each letter. #html_split_index = False # If true, the reST sources are included in the HTML build as _sources/. #html_copy_source = True # If true, an OpenSearch description file will be output, and all pages will # contain a tag referring to it. The value of this option must be the # base URL from which the finished HTML is served. #html_use_opensearch = '' # If nonempty, this is the file name suffix for HTML files (e.g. ".xhtml"). #html_file_suffix = '' # Output file base name for HTML help builder. htmlhelp_basename = 'Ahvendoc' html_theme = 'nature' html_theme_path= ["."] html_theme_options = { "nosidebar": "false" } # Options for LaTeX output # ------------------------ # The paper size ('letter' or 'a4'). #latex_paper_size = 'letter' # The font size ('10pt', '11pt' or '12pt'). #latex_font_size = '10pt' # Grouping the document tree into LaTeX files. List of tuples # (source start file, target name, title, author, document class [howto/manual]). latex_documents = [ ('index', 'Ahven.tex', 'Ahven Documentation', 'Tero Koskinen', 'manual'), ] highlight_language = 'ada' # The name of an image file (relative to this directory) to place at the top of # the title page. #latex_logo = None # For "manual" documents, if this is true, then toplevel headings are parts, # not chapters. #latex_use_parts = False # Additional stuff for the LaTeX preamble. #latex_preamble = '' # Documents to append as an appendix to all manuals. #latex_appendices = [] # If false, no module index is generated. #latex_use_modindex = True ahven-2.7/doc/manual/en/source/design.rst0000644000000000000000000000161013325517624016546 0ustar 00000000000000============ Design Notes ============ This section tells reasons behind various design choices of Ahven. Since Ahven is meant to be buildable with multiple different Ada compilers on multiple different operating systems, we have made certain amount of compromises. Timeout Feature =============== Starting from version 2.0, tests can be interrupted after a given time. This feature is implemented using tasks. Ahven spawns a new local task for each test routine (procedure), and kills it with "abort" statement of Ada. The task and the test routine is aborted if the runtime system of the used compiler can abort the task. The test routine should include at least one "abort completion point" to make the abortion successful. However, some environments allow the task abortion even without abort completion points in some cases. FSF GCC on OpenBSD with user space threads is one such environment. ahven-2.7/doc/manual/en/source/index.rst0000644000000000000000000000034113325517624016404 0ustar 00000000000000 Welcome to Ahven's documentation! ================================= Contents: .. toctree:: :maxdepth: 2 manual.rst api.rst design.rst Indices and tables ================== * :ref:`genindex` * :ref:`search` ahven-2.7/doc/manual/en/source/manual.rst0000644000000000000000000003010413325517624016552 0ustar 00000000000000 ================== Ahven User's Guide ================== Tero Koskinen Overview ######## Introduction ============ Ahven is a unit test library. It is modeled after JUnit framework for Java, but some ideas are also taken from another Ada unit test library, AUnit. The purpose of Ahven is to be a small and portable unit test library, which works with multiple different Ada 95 compilers. Ahven has no external dependencies and therefore it is easy to build on various platforms. Ahven tries to be compatible with utilities related to unit testing. For example, it uses same XML format for test results as Java tools. This allows easy integration to CruiseControl, Ant, and other similar programs. License ======= Ahven is distributed under permissive ISC license (shown below). :: -- -- Copyright (c) 2007-2016 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- You are allowed to embed Ahven into a proprietary commercial application. Only requirement is to keep the copyright notice and the permission notice in the source code files. You do not need to distribute Ahven's source code if you distribute Ahven or some parts of Ahven in the binary form. Building and Installing Ahven ############################# To build and install Ahven source code, you need an Ada 95 compiler. At the moment, Ahven is tested with three different compiler families: GNAT, Irvine ICCAda, and Janus/Ada. GNAT GPL series and FSF GCC =========================== For GNAT there are two sets of project files provided: * gnat * gnat_linux GNAT project files under *gnat* directory are generic and can be used on any system, but *gnat_linux* depends on GNU Make utility and expects Unix-like environment (Linux, \*BSD, Cygwin or MinGW on Windows). Using GNAT project files from gnat directory -------------------------------------------- There are two project files under *gnat* directory: ahven.gpr and ahven_tests.gpr. Project file ahven.gpr will build the library itself and ahven_tests.gpr will build the unit tests for the library. Example on Windows: .. code-block:: bash gnatmake -P gnat\ahven gnatmake -P gnat\ahven_tests Once the source files and tests are compiled, there are two executables in *gnat* directory: tester(.exe) and tap_tester(.exe). You can run them and if there are no errors, the library can be expected to be working correctly. Project files in *gnat* directory do not provide separate installation step for the library. When you wish to use the library, you can simply reference ahven.gpr in your project file:: -- my_project.gpr with "/path/to/ahven/gnat/ahven.gpr"; project My_Project is -- ... end My_Project; Alternative build system for GNAT on Linux ------------------------------------------ People using Linux and GNAT, especially Fedora Linux and FSF GNAT, can use an alternative build system based on comfignat. This build system integrates better into existing Ada library infrastructure provided by the used Linux distribution. To build and install Ahven using comfignat-based system, run: .. code-block:: bash $ cd gnat_linux $ make $ sudo make install Note: You need to have *python-sphinx* package installed to generate the documentation for Ahven. If you want to change the installation directory, you can give *make* command prefix parameter: .. code-block:: bash $ cd gnat_linux $ make prefix=$HOME/tmp/ahven-install-dir $ make install Irvine ICCAda ============= Easiest way to build Ahven with ICCAda is to use *icm* utility .. code-block:: bat C:\ahven-x.y>cd src C:\ahven-x.y\src>icm new C:\ahven-x.y\src>icm scan *.ad? windows\*.ad? C:\ahven-x.y\src>icm make libmain C:\ahven-x.y\src>cd ..\test C:\ahven-x.y\test>icm new -search=..\src C:\ahven-x.y\test>icm scan *.ad? C:\ahven-x.y\test>icm make tester There is no installation step. If you want to use Ahven from your program, run *icm new* with -search parameter: .. code-block:: bat C:\another-project> icm new -search=c:\ahven-x.y\src Janus/Ada ========= Directory *janusada* contains project file creation scripts for Janus/Ada. By default, the scripts assume Janus/Ada to be installed to directory *C:\\Janus312\\*. If that is not the case, change the path from file *prepare.bat*. .. code-block:: bat C:\ahven-x.y>janusada\prepare.bat Before compiling the library, you need to run the preparation script *janusada\\prepare.bat*. Then, scan the sources and create compilation script by running *janusada\\update.bat*. .. code-block:: bat C:\ahven-x.y>janusada\update.bat Now you are ready to compile the project. This happens by running *compile.bat* script. .. code-block:: bat C:\ahven-x.y>janusada\compile.bat After a while, you should have compiled library files in the *lib_obj* directory and an executable called *tap_test.exe* in the *test_obj* directory. The executable is Ahven's test suite and if it reports no errors, everything is working as expected. Every test, which is not skipped, should pass with the latest stable version of Janus/Ada. However, with earlier versions of Janus/Ada some tests will fail. The failing tests are worked around in Ahven's source code, but the test exists so that one can verify when the Janus/Ada bug causing the failure is fixed. Using Ahven ########### The heart of Ahven is an abstract type called ``Test``. It presents an entity which can be run by *a test runner*. Types ``Test_Case`` and ``Test_Suite`` are derived from the ``Test`` type. The ``Test_Case`` type is the base type for unit tests and the ``Test_Suite`` type is a container, which can hold other ``Test`` objects. Writing a Test Case =================== To create a new test case you need to create a new package and a new type, which is derived from ``Ahven.Framework.Test_Case``. There are no required functions or procedures to be implemented, but to make the test case do something you need to override the ``Initialize`` procedure and create at least one procedure which tests something:: -- my_tests.ads with Ahven.Framework; package My_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Addition; end My_Tests; To add tests to the test case you need to call procedure ``Ahven.Framework.Add_Test_Routine`` during the test case initialization (in other words, in the ``Initialize`` procedure). :ref:`testcase_a_body` shows how the ``Test_Addition`` is added to the test case. It also shows how to set a name for the test case with the ``Set_Name`` procedure. .. _testcase_a_body: A test case package body ------------------------ :: -- my_tests.adb package body My_Tests is procedure Initialize (T : in out Test) is begin Set_Name (T, "My tests"); Ahven.Framework.Add_Test_Routine (T, Test_Addition'Access, "Addition"); end Initialize; procedure Test_Addition is begin null; end Test_Addition; end My_Tests; Calling Assertion Procedures ============================ To test whether a condition is true or false, Ahven offers you three procedures. The first procedure is :ref:`Ahven.Assert `. It takes a boolean value and a message string as its parameters. If the boolean value is false the ``Assert`` raises an ``Assertion_Error`` exception with the given string. The exception is catched by the framework. and when the test results are shown the error is also shown with the given message. Another assertion procedure is a generic :ref:`Ahven.Assert_Equal ` procedure. It is meant for comparing two objects of same type. If the objects are not equal the ``Assertion_Error`` exception with the given message string is raised. The third assertion procedure is simple :ref:`Ahven.Fail ` which always raises the ``Assertion_Error`` exception. It is handy for situations where the execution should not reach a certain place (see :ref:`fail_example`). .. _fail_example: Fail in action -------------- :: package body My_Tests is ... procedure Test_My_Proc is begin begin My_Proc (-1); -- should raise Custom_Error Fail ("Custom_Error expected"); exception when Custom_Error => null; -- expected -- Note: the exception block should not -- catch Assertion_Error. Otherwise -- the assertion failure will not be noticed. end; end Test_My_Proc; end My_Tests; Composing Test Hierarchies With Test Suites =========================================== The ``Test_Suite`` type is used to group related tests together. You can also add other test suites to the suite and create a hierarchy of tests. The tests are added to the test suite using either procedure ``Add_Static_Test`` or ``Add_Test``. The former procedure is meant for statically created tests and it places a copy of the given test to the test suite. The ``Add_Test`` procedure is used with dynamically created tests and test objects of type Test_Class_Access. At the moment, the dynamically added tests are executed first in the order they have been added (first in, first out - FIFO) and after them the statically added tests, also in FIFO order. :ref:`suite_example` shows how to put test cases in a test suite. .. _suite_example: Suite Example ------------- :: package body My_Tests is ... function Get_Test_Suite return Ahven.Framework.Test_Suite is S : Framework.Test_Suite := Framework.Create_Suite ("All"); Hello_World_Test : Hello_World.Test; Listener_Test : Basic_Listener_Tests.Test; begin Framework.Add_Static_Test (S, Hello_World_Test); Framework.Add_Static_Test (S, Listener_Test); return S; end Get_Test_Suite; end My_Tests; Running Tests ============= The tests are run by test runners. These runners are procedures which take either test cases or test suites as their parameters. Currently, there exists three test runners. Ahven.Runner is the basic runner, which prints the test results as a hierarchy. Ahven.XML_Runner on the other hand writes the test results to an XML file, which is understood by continuous integration systems like CruiseControl and Hudson. The third runner is Ahven.Tap_Runner. It produces the results in Test-Anything-Protocol (TAP) format. The recommended way to use these test runners is to call them from the main program: :: with Ahven.Text_Runner; with Ahven.Framework; with Simple_Tests; procedure Tester is S : Ahven.Framework.Test_Suite := Ahven.Framework.Create_Suite ("All"); begin Ahven.Framework.Add_Test (S, new Simple_Tests.Test); Ahven.Text_Runner.Run (S); end Tester; Parameters ---------- Ahven.Text_Runner recognizes following parameters: .. program:: tester .. cmdoption:: -d directory for test results .. cmdoption:: -x output in XML format .. cmdoption:: -c capture and report test outputs .. cmdoption:: -s Specify test name suffix to be used in XML files .. cmdoption:: -t specify timeout value for tests (value 0 means infinite timeout) .. cmdoption:: -q quiet results .. cmdoption:: -v verbose results (default) .. cmdoption:: -i ignore remaining parameters - for passing parameters to the test cases ahven-2.7/doc/manual/notes.txt0000644000000000000000000000066413325517624014542 0ustar 00000000000000 Table of Contents: Introduction Installing Ahven - GNAT GPL and FSF GCC - GNAT 3.15p - ObjectAda V7.2.2 Special Edition - Janus/Ada Using Ahven - Writing a test case - Composing test hierarchies with test suites - Running tests API Reference - package Ahven - package Ahven.Framework - package Ahven.Text_Runner - package Ahven.XML_Runner - package Ahven.Parameters - package Ahven.Results - package Ahven.Listeners ahven-2.7/doc/tutorial/ahven.dia0000644000000000000000000000331413325517624015012 0ustar 00000000000000‹í\Û’›8}Ÿ¯p‘WGllœ‰'•¤*»ÙÊV6yvÉ ÁÚÄ 1ça¿}ÅelÆæ&o.rUR3LÓ§[H‡ÖiÃËW_}2z@,Â4Xiе êâÀ[iŸ?½{nk¯în^º¾ÿ<ý‘8#ˆ’ßVÚ–óðÅdòøøÈ.‚œ2@p "4ù'Âh¢ÝÝŒFÇ\Èar,? 9gxs4  VÚ:_Ëe×!be·~H#,Lø.¬˜ÔøIþ?²É­"axwÏ^Ïže!å¾NZ Â}È<TqÄØl L`›¦)ÃZÚK}1[OcÒns]8r]8v]8­CÊ8ƒ˜W!7”ƒ •³uljHÄ;—V,î1çôBü÷DMÈïW[Û•ë1ìž_¸‹/ØåÛõWIÕyßIòþ€#¼!èTô8àƒ¹ß ã¾|uRö>œÞs6dÞjo®,dµ¿=x1vQtašmjÿñ~ô|ô^%úSœ,nÅÚ¡òuvWÚ½8D处CÁ~•1 éa"…56ÁÔ*'^¥:€Í¦ìŸ‰,`à´Ç`zk.Átlš`Ù ä¯Ê‚jY0\F)HÊÕ¬ö÷§èã}‹°·ågÜëÀ²ô£Ñ LÜÐ:Yqe¼Ê%œ®wƒ¸Ç„4€( í 8úÊ%gqÄM–]á©&»•æÓ€F!tÄÖ'â»dË$ —ÌÅ[Qbĺá?Ñt—l»Âó7”¸6ÿÓu}…”ì|ÊÂ-v:ET¨W0NR*&?^%‚‚röQì/Íïˆ< Ž˜ŽLÏ+Ô9ût8ýÆ&'‘–¡T#éÅÑê¹XüéÀ.Všúl˜9z=äÂb½lqâ]Ä5ç²àŽ'°´”UÜäüÞ¯¶n)K}±OöÆUUôbO¨T匃š¶Ð-µÍž¥Ù¾¢ ÜÕ€ÒÌw§àPûùr;VÛÃT÷còR:±7kØHi…ƒ-b˜ÃÀAëºkvD³˜¸‘°Ý5²J9j9ôtBCÃ…0‘ÄÄ‹ªÝŽ’.߶ÀõC9’µ xò_&@g‹‰PDjbÚ§þd(-Ïì­åÍÁ|œÊ_2µ¼9°¬åÖœ{l,ÀLªœ×3©&rÞÖ%G#9o ¬¢œ7—#ç­ßÂ)MOizJÓSšžÒô”¦§4=¥é)MOizJÓSšžÒô”¦§4=¥éÉÕô®Â¯]wêiÌE¥¯hDш¢Õø™ZÓ¾­˜©h¿”Ø „mÝ&X¦Kê“=“jÒ˜yñË·‹Ÿ¡3ðW,V—j ¨Ö€j ¨Ö€j ¨Ö€j ¨Ö€j ¨Ö€j ¨ÖÀw×xø”°§„=%ì©þ€ê,*æPÌ¡Z¿FKà7*$ø[F‡G//Ì{³Þ X@·Æ É è ŸhËT´ïŠÆøvFß6§:+šmž·ÓÓgšÚuo³$¹Q†OHÞú0*Ôðsýy­c‚1§ŒÆÖPwÅò ïºÂË”Îõ]¾Çn‹Cƒ@¬ÒdGW‘§¿Œ¶0ps%ÓôC£Ã_WÚ¼2ãNœkäçN‹çÕ—µUº&“Z?“΀™2©©3k€Úß•ž51‹v=fû±¹´W=¢Èô Só%Ó×QD\Ǥóa^Kg¹L&%”5K¿°’?É*—HOäTµš£‘1æ9›ìË1£Áé³!Ež;¯•R3§Ä~°TÖq1ˤ6ôÈ À­å/î¼™»«h2~L8 vj„¦áE ÆèãEñ¢üâð8žÇWÔ†—φV骲jþÈ¿N ㇘@²Ë¤i=§-£LÊ~O_~wSxŸøÝֹ͘sdahven-2.7/doc/tutorial/ahven.png0000644000000000000000000002141313325517624015041 0ustar 00000000000000‰PNG  IHDR)³eäñsBITÛáOà IDATxœíÝpeâÇñ'¤M m ”åG ˆÎ¥ üFt,Ju@Ô±µ7ÊÜ)§£(8à}OF=ÔEÑÃô¼:£ÒV8ÊK-¤z…iG[ÒÚFús¿¬ì…4 ý‘>I¶ïך>yv÷y6Û|xžÝîE1 þ (J ›!€Ôñ'²Z£›ú?å’ýë_BˆM›6©?–””˜Íf¥ó•””!"/™8q¢„¶ƒ·ÈÏBM7·Ÿ·mÛ6f̘¬¬,ùM1›Í5—äççËo@ŽË²GQ”œœœgŸ}vûöíÍÍÍZùÚµkcccãããwìØ!„ؾ}ûرcµwm6›šUµµµ±±±V«õ¸xñbiiiDD„Ûâm¢®áÿøÇUW]­Ëþö·¿]sÍ5=zô˜0aÂÑ£GÕj&“i̘1‹/8pàO<¡.Þ²I 8uꔶþ3gÎÄÆÆ !ŠŠŠÆŽk±Xf̘QQQácëªúúúÙ³g?ýôÓmíà²ì9xð`SSSJJJxxx^^žZX__ßÜÜüÓO?-Y²Dýª:uê?ü ~ƒ———?~|Ú´iBˆ‡~¸¬¬¬¤¤äÇt:+W®ô¸x[566îÝ»÷øñãåååãÆBôéÓ'77·¦¦fæÌ™jµ†††Õ«WoÞ¼ùí·ßÞºu«ZزI6›­°°ÐµË“&MB<øàƒ‹-ªªªêß¿ÿ3Ï<ãcëBˆ¦¦¦{î¹gøðá«W¯nGB\:ß³jÕª””EQRSS—/_®\: SSS£(JQQQtt´Zó¾ûî{饗Eyýõ×.\¨(JmmmXXXqq±Z!///!!ÁÛâÏ£!¢/yå•W\ËËËË=.UTT£V3™LÇŽëѣDZcÇÔ ylÒ /¼°lÙ² .DGGÿüóÏ+V¬Xµj•ÃáBTWW+Š²oß¾Áƒ{Ûºz¾gÑ¢E³fÍjnnv;ßãõ4ÀÅeãžmÛ¶M™2E‘œœ¬ò1›Í‘‘‘ê‹ÆÆFµðÎ;ïüøã…üñüùó…çÏŸoll´ÙlV«ÕjµÎ˜1£ªªÊÛâ™ÍfÇ%>ú¨Vn2™ú÷ïïZsãÆ#FŒˆŽŽžeʔÇÿîw¿k¹ˆ¢(ÞšTSSsøðá]»v­^½:;;ûСC“&M2 ¿üòKÏž=+**zõêåmëB“Éô駟._¾<===''§ã€®æãžœœœ!C†ÔÕÕ]¼x±®®nĈÙÙÙÞ3›ÍsæÌy衇¦OŸÞ½{w!D=RSS—.]ªwJJJ>ûì3þá‡FÕŽ×××755ÅÅÅ544¼öÚk>jzl’Åb‰‹‹Û³gÏܹs:d±Xbbb¬Vë„ Ö¯_ßÔÔôÖ[o©§¯¼1 F£qåÊ•§OŸ~çwÚÑèâþ—=YYYóæÍÓ~¼ýöÛ}_i=þü={ö¤¤¤h%o¼ñ†Ñh>|¸Åb™;wî÷ßïcñúúú'N´£Å}ûö]±b…Íf6lXbb¢ïÊ›d³ÙFŽ)„5j”z¡âÝwßÝ´iSTTTYYÙóÏ?Åf˜ÍæwÞyç‰'ž8sæL;z]ÙoJ Ù1êÔ»ZÃýoKèld@6² ÙìÈFöd#{²‘=tÍý>ÖHðÛ}¬¹  ³iO`ÜìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² Ù-,Ð üÌ`0º ¾(Šè&ǸºäÁ@Ÿ:œc rÐ0îÈFöd#{²‘=Ù¸ÖÁK;9œ×h7Æ=ƒ‹Ä=!{¼Eqñ@€n=v$ ?dBƒ¿ÈàSûÚv÷Ýw“ˆ@›p­B‰?Ú·¼ú¢MW"Øl6õEiiiEE…k i÷ ôtd ”wÉ´iÓÜJ6lØššg2™®¹æš¥K—ÖÔÔ¨uŽ=:sæL«ÕwóÍ7çææj[ÿðõ×þé! wÁ5îáWíÖÁƒ§  Àn·ÿúë¯QQQ#GŽ,..~å•WöíÛ·wïÞððð  !FÝØؘ››ûÍ7ßØív!„Ífc´“½ ­9ØRSS]+ßrË-Bˆ¡C‡:EQ Õw7nܨ(Jxx¸Ân·«•+**Nž<émU¾ïvü^º¡ý׸G¥Bh5•óòò„'Nœ°Z­®åûöí»ï¾ûfÎœùÙgŸåææÆÇÇ9299yÉ’%~Ù.Ð5cö­á–:Êå—!´•ºxïÞ½\Ëãââ„™™™›6mÊÍÍýî»ïvíÚµsçÎ/¿ür÷îÝíl:Ðå‘==S§ƒ&OžüÅ_tïÞý£>êß¿¿¢¡¡!77wРABˆ¯¿þ:---==]1uêÔ]»v}õÕWڲꌜÂétöèÑ£ãtìA(éŒÔQ­Y³&99¹¬¬lðàÁ‰‰‰Š¢œ8qÂétfgg:Ôn·ÇÄÄ 4Èét;vL‘””¤-;bÄõÅèÑ£Ož<é¯&:Æ5Ö nR»ž·ô‹‰'æç秦¦ÆÄÄ|ûí·§OŸ5jÔ“O>9nÜ8!DFFÆÕW_]RRRRR{×]wýûßÿÖ–}ä‘GfÏžqêÔ)?6 бàºOp;þTº×¦±N0BÁÜ6@í·€97¯Î›aXdB©è ÙƒàEäzŵÙÈ€ld@6Î÷@‡¸!:ä÷dcÜ Î äÆ=ÙÈ€ld@6² ÙëÜ C\Q9Æ=Ù÷@‡øû È1îÈFöí4gÎœýû÷k?®_¿~Ù²elBÈt-¥¥¥ƒÁb±X,»Ý^\\ܾõäççWWWßxãZÉý÷ß¿eË–ÊÊJ?µÐ3²]ŽÙl®©©q86›---­}+Ù°aÃ=÷Üã¶Ú™3gnÙ²ÅmtŽìþ•––Z,·Â°°°{ï½W÷”––FDD¸UV ×®]¿cÇ×Åsrrìv»Û:ív{vvvguв]Tcccffæ 7Üà£N}}}ssóO?ý´dÉ’§Ÿ~Z+w8gÎœ6l˜[ýÄÄÄ£GvJs}!{ gV«ÕjµŽ?¾¶¶V}-„¨««³Z­Û¶mÛ¼y³ÅEY²dI·nÝî¸ãŽ’’­¼ªªÊh4jC%MÏž=Ggtвzæp8Gaaadd¤úZa6›Gyy¹ÓéÌÉÉñ±¸ÙlŽŒŒT_466jåV«µ©©éâÅ‹nõ«««ÕxàÙƒ.*..nÕªU«W¯B„……555©‘Z[[{Åe£££xüøq·òââ⤤¤Îh- 3dº®”””sçÎíܹ³ÿþ&“©  @‘™™ÙšegÍšµgÏ·ÂÜÜÜY³fù¿¡€î=п„„„ššš–åáááiiiëÖ­3™L/¾øâm·Ý–œœÜÊ;ߤ¥¥}ðÁ®%uuuŸþùÂ… ýÓh@×~û5 ’û_©¿öAÒ„"™‡Ðœ9sV¬X1yòdõÇ7ß|óôéÓkÖ¬ †¶ÁIû- { +Á|sÛ9´ßæܲ‘=ÙÈ€ld@6ž[ â ¡@cÜqtÅïW0 ®ŠüŽqà•:wÇ àwd@6²ðÌu¸ÃÐð/²ð…“=@g {Ztú~Dö^©ƒ†>€ß‘=€;oC†>€¿=€g®Ã†>€‘=Àe|nú~Aö´è0ôüˆìþ§5Æ>@Ç‘=€;oC†>€¿=ÀoZ? aètÙ\Æ÷à†¡àd DÛ‡2 }€Žàù=Àe@Æ=@;ó†”Úqàõ,Žš.œãüŽq@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€lan‚‹Á`tèÙ\yÜŠ¢º jd<à‹CEê„ì¼"ƒÛÀFkp­@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÂÝ ë2 nBgÑe×E tôƒqºüvZ‰qHüS:$ð¿#{‚EPÜAÕÁ4 ;̹…`û®€NŸ'ˆð¯û–He@—÷d#{²‘=ÙÈ€ld@6²Ð3ƒOí[çÝwßÝúÅwìØ1þü˜L¦¨¨¨n¸áÏþsû¶ =ák@Ïl6›ú¢´´´¢¢ÂµD‚?þñ¯¾úªÂl69²¡¡áàÁƒX±b…´6 ¨)Á!¨#“Î:®v'55Õ_«êøz‚䮥¦¦ºmñèÑ£ ,èÛ·oxxøÕW_ýØcýòË/ê[ß|óÍŒ3¢££Fcß¾}§Nº{÷n×f·æÛã½÷ÞS+Üyç.\P ÇË/¿¬¾.**JNNŽ 3›Í‰‰‰Ï=÷\CCƒïøny'Ññq(™¶'Éž à±ãñÏ…–_@]¼xqÙ²eƒ ‹ˆˆ2dÈ­·Þúí·ß¶r+6›Íf³-_¾¼­ÛmILJD`³ç믿îÞ½»"**êºë®3›ÍBˆI“&Õ××+Š’˜˜¨V=ztbb¢Ñh|íµ×Ôm6[ïÞ½ÕwÕÚÛÕVŸ>}œN§Ç ÙÙÙF£qøðá'NŒW×ùÔSOùn€ï–w‡’‘=ÁÅcÇm—¸ýªûþ…÷­•ðàƒªÕúõë7~üøØØX!ħŸ~Ú¾¶~»-éølöÜrË-Bˆ¡C‡:EQ Õw7nܨ(Jxx¸Ân·«•+**Nž<émUÞôèÑC1oÞ¶èñZƒêêjíZ×cÕétŽ9Rk¡øny'Ññq(™¶'Éž Ð¦ì‘0[ÒÜÜüÞ{ï͘1C|S¥¤¤¸¶¶ƒÙã­mÚ3!-°Ù“ŸŸ¯ŽEL&Ó˜1c’’’Ô)²ììlµm111ãÆ1b„ºÔøñãµUi 3xð`ߧÿð‡?¨5#""ÆŽ;jÔ(“ɤµa„ 껣FêÓ§v^Ów|·¼“èø8”Lۓ̹…¥ógK ÃâÅ‹/^ÜÜÜ|àÀ ”••eee¹ÖinnV_TWWû±câĉùùùÿ÷ÿ·k×®o¿ý622rÔ¨Q7ß|³:¹š‘‘‘——WRRât:ccc§L™ò—¿üE[ö‘GÙ¿ÿÎ;O:uêÔ)[Y·nÝܹsß|óͼ¼¼¢¢"³Ùœ””4oÞ<õÝÍ›7§¥¥8p ªªjÅŠû÷ïÿðÃÕ·|4ÀwËb…—UcdòÝqù³%úÓŸŠ‹‹Õ×'NBôîÝ[-‰ŽŽBLš4IQ”ÊÊʨ¨(·ö«?ºŽ{Zn×[/Ú´gBšŽ»¦?|Xþ¢íIÆ=¡gÍš5ÉÉÉeeeƒNLLTåĉN§3;;{èСv»=&&fРAN§óرcBˆ¤¤$mYmcôèÑ}ûöÍËË󸉗^z饗^êׯ_¿~ýÊÊÊÎ;'„X¸p¡úî´iÓ¶nÝšŸŸÓM7•••ÕÔÔ\±Í-·ë­ÚщPqà 7´,ôvh— lj‚ª12ùî¸Çk¬SSSãââŒFcTTÔĉŸ|òɳgÏ*Š’‘‘qÝu×Y,–nݺÅÆÆÞu×]®×TVVΞ=;""Â÷_xá…éÓ§÷ë×/,,Ìd2]{íµÏ=÷œö·{åååÓ§O7™Lýúõ{öÙgçÏŸï¶6õG×qÇízìE›öLHÓMׂù+Å_tÙ©€Ðö¤A{ÕÁôò õÒÞ iŒL]¶ãW¤ã=£ã®é–¿h{’9·.ÙÁ¸'(ªãoƒTû_LJ„Ž»¦?|Xþ¸Bð» @È Úý7 ¤ñÜR€lŒ{€@bÚ3$0<õ;²'ˆp|è"˜sÈƸ'ˆ0ýÒcA@—÷d#{²1ç“Šèš÷dcܘ„†§~GöŽo]sn€þÍ™3gÿþýÚëׯ_¶lYÛ=ADîóCC ?“@*--5 ‹Åb±Øíöâââö­'??¿ººúÆoÔJî¿ÿþ-[¶TVVú©¥@›‘=@ð2›Í555‡Ãf³¥¥¥µo%6l¸çž{ÜV;sæÌ-[¶ø£@{=:QZZj±XZS( ó<íàñ# »÷Þ{ÕqOiiiDD„[eµpíÚµ±±±ñññ;vìp]<''Çn·»­Ón·gggwV7€+!{:—/ÈÌÌ4 ›7oö× ÕùœÈÈHmn§­YåúUèŠy?jllÌÌÌôø€sM}}}ssóO?ý´dÉ’§Ÿ~Z+w8gÎœ6l˜[ýÄÄÄ£GvJsV {:‹Á`PƒG{ÑqÛ¶m3fLVV–_Ö&„¨©©©©©9räHdddÍ%~Y3ó|øÚk¯íÕ«×믿®ÕôXØzµµµ±±±V«õ¸xñ¢âí·ß4hPddä€Ö­[§Ö¼þú믻º:uÀ´uëVm%Ìó´•Ãáp8………‘‘‘êk!„Ùlv8åååN§3''ÇÇâf³922R}ÑØب•[­Ö¦¦&õCtU]]­Æd´Œo×kµ#„TljjJII ÏËËS ÓÓÓÓÒÒΟ?á­¦ÇÂÖ{øá‡ËÊÊJJJ~üñG§Ó¹råÊ .<üðÃüqmmí¡C‡l6›Ö¤#GŽ¨çÃkjjæÏŸ¯–3Ïã_qqq«V­Z½zµ",,¬©©I=¢jkk¯¸lttôÀ?îV^\\œ””Ô­Zƒìé‘ãV³M!äqú%++Ën· †ääduôPUUUPPðÐCÆŒŒ uY…­çt:ßÿý—_~ÙjµvïÞ}éÒ¥[·n5F£±¸¸ØétöíÛ×÷‰Áèø8”LÛ“Á5î ôni-­Á-@­çmðä±rNNÎ!Cêêê.^¼XWW7bĈìììèèh›ÍöÖ[o555½õÖ[jM…­×£GÔÔÔ¥K—VUU !JJJ>ûì³óçÏòÉ'N§Ó`0(Šb6›µú½zõª¯¯/--u[ó}útp%Üè6àÈžÎðÔA¨ ¡ȺÕ1tøáC74dÈŸþ¹kÓp£Û`@öA-„n ëÆ/ê Üè6=]³ Á,¤o ë‘ëÇ„EEEcÇŽµX,3f̨¨¨^žHämC7ß|sdd¤ë`ÈÛ³‹<öHÅnƒÙx|r×B7õÆíáC>øà¢E‹ªªªú÷ïÿÌ3Ïøî{Ë }ùå—GŽq«éñÙE-{¤–s£ÛàÒy·@k\ñS())Qo]ÓÐÐðøãßtÓMíÛPzzú믿îV˜––öꫯ¶o…MÇǧ[×¢£££££Õñ©¯EYµjUJJŠ¢(©©©Ë—/W.¿gÒ¾}ûZÞHI+ôÍíFJaaaÅÅÅêyyy UUUf³ùý÷߯­­m¹¬Ç)¹ÕQ;b4ÇwáÂ…–íToÎäº6×VyÛ[¡º!õ.PEEEê~óØ#õõ÷ßo4[6ø¿ÿý¯ÅbñÖ‡’i{’qOðâñÉ]J¨ß@¶¥–rk§¿FÛ-Ÿ]ä±Gjent$ÈžÃã“»ŽóçÏ<þøã>úè¡C‡Îž=Û«W¯†††_~ùE¡]îå±°õbccM&Syy¹šyUUUçÎBÌ™3'++ëìÙ³÷ßzzºV¿M70t}øPLLŒÖΊŠŠ^½z ŸO$jß}ôHð@£ Aö#Ÿ ‚7õF{øÕj0aÂúõëÕvN›6Máã‰DmÝïiïr£Û`@ö#ŸÜe…ô d½Ñ>$„x÷Ýw7mÚUVVöüóÏ !|<‘ÈmC_ýµÅbq½øÍÇ“[[öH{‹Ý‘Àž}‚ÇOÁõ¼«ëùÕþóŸIIIŠ¢œ:u*,,¬¹¹YQ”Ç«•}œ¹UîQà·IDATü÷Xit||ê¸kÁ¯­4âÃòmO2î =<>è hpdOðâñÉèË宿þúPßô„g(™wh÷Ëcu¤Ññ½ëuÜ5ýáÃòžß\8²½ÑñžÑq×ô‡Ë_´=Éœ@6žR»ÿ|iŒ{²1èÊÈž Âô €.‚97€lŒ{‚Ó/ºÆ=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=ÙÈ€ld@6² ÙìÈFöd#{²‘=tMQÆ=Ù Š¢º €®…q@¶ÿãÕ¯žjMÛ“IEND®B`‚ahven-2.7/doc/tutorial/tutorial.html0000644000000000000000000001141613325517624015765 0ustar 00000000000000 Ahven Unit Test Library - Tutorial

Ahven Tutorial

Copyright (c) 2007, 2008 Tero Koskinen <tero.koskinen@iki.fi>

Contents:

Introduction

Ahven is a unit test library modeled after JUnit library for Java. So, for JUnit users the API should be familiar.

The heart of the library is an abstract class called Test. It has two subclasses, Test_Case, and Test_Suite. Test_Case is the base class for other unit tests and Test_Suite is a container, which can hold Test objects.

Ahven.Framework class diagram

First Test Case

For your first test case, you need to create a new package and a new class, which is derived from Ahven.Framework.Test_Case. Let's call the package My_Tests and the class My_Tests.Test. 

   -- my_tests.ads
   with Ahven.Framework;
   package My_Tests is
      type Test is new Ahven.Framework.Test_Case with null record;
   end My_Tests;

After you have defined your class, you need to overload Test_Case's Initialize procedure and create your own test procedure (My_First_Test). 

   -- my_tests.ads
   with Ahven.Framework;
   package My_Tests is
      type Test is new Ahven.Framework.Test_Case with null record;

      procedure Initialize (T : in out Test);

      procedure My_First_Test;
   end My_Tests;

Next you need to create the body of the My_Tests package. In Initialize procedure you need to do two things:

  • Set a name for the test case,
  • and register the test procedures. 

   -- my_tests.adb
   package body My_Tests is
      procedure Initialize (T : in out Test) is
      begin
         Set_Name (T, "My tests");

         Ahven.Framework.Add_Test_Routine
           (T, My_First_Test'Access, "My first test");
      end Initialize;

      ...
   end My_Tests;

In the test procedure My_First_Test you can do anything you want. The Ahven package defines two utility procedures for you: Assert (Condition : Boolean; Message : String) and Fail (Message : String).

Assert will raise Assertion_Error if Condition is False. Fail does what its name implies and will raise Assertion_Error always. These Assertion_Errors will show as failures when you run the tests.

Here is an example: 

   -- my_tests.adb
   with Ahven;
   use Ahven;

   package body My_Tests is
      procedure Initialize (T : in out Test) is
      begin
         Set_Name (T, "My tests");

         Framework.Add_Test_Routine
           (T, My_First_Test'Access, "My first test");
      end Initialize;
      
      procedure My_First_Test is
      begin
         Assert (1 /= 4, "1 /= 4 failed!");
      end My_First_Test;
      
   end My_Tests;

Running a Test Case

To run your tests you need to feed them to a test runner. For example, Ahven.Text_Runner.Run runs the tests and prints the results to the standard output.

The best way to run the tests is to define a Test_Suite, add the tests there, and give the test suite to the runner. 

-- runner.adb
with Ahven.Text_Runner;
with Ahven.Framework;
with My_Tests;

procedure Runner is
   S : Ahven.Framework.Test_Suite_Access :=
     Ahven.Framework.Create_Suite ("All my tests");
begin
   Ahven.Framework.Add_Test (S.all, new My_Tests.Test);
   Ahven.Text_Runner.Run (S);
   Ahven.Framework.Release_Suite (S);
   -- Release_Suite will release all its children also.
end Runner;

Tero Koskinen, 2008-01-07

ahven-2.7/examples/examples.gpr0000644000000000000000000000036313325517624014771 0ustar 00000000000000-- Note: -- Install Ahven first before compiling it with this project file. -- with "ahven"; project Examples is for Languages use ("Ada"); for Source_Dirs use ("."); for Object_Dir use "."; for Main use ("runner.adb"); end Examples; ahven-2.7/examples/runner.adb0000644000000000000000000000204413325517624014420 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Text_Runner; with Ahven.Framework; with Simple_Tests; procedure Runner is S : Ahven.Framework.Test_Suite := Ahven.Framework.Create_Suite ("All"); begin Ahven.Framework.Add_Test (S, new Simple_Tests.Test); Ahven.Text_Runner.Run (S); end Runner; ahven-2.7/examples/simple_tests.adb0000644000000000000000000000407113325517624015624 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; use Ada.Text_IO; package body Simple_Tests is type Test_Access is access all Test; procedure Initialize (T : in out Test) is begin Set_Name (T, "Simple Tests"); Ahven.Framework.Add_Test_Routine (T, Test_Assertion'Access, "Test Assertion"); Ahven.Framework.Add_Test_Routine (T, Test_With_Object'Access, "Test With Object"); Ahven.Framework.Add_Test_Routine (T, Test_Error'Access, "Test Error (exception)"); end Initialize; procedure Set_Up (T : in out Test) is begin Put_Line ("Simple_Tests.Set_Up"); T.Value := 1; end Set_Up; procedure Tear_Down (T : in out Test) is begin Put_Line ("Simple_Tests.Tear_Down"); T.Value := -1; end Tear_Down; procedure Test_Assertion is begin Put_Line ("Test_Assertion"); Ahven.Assert (False, "assert(false)"); end Test_Assertion; procedure Test_Error is begin raise Constraint_Error; end Test_Error; procedure Hello (T : Test) is begin Ahven.Assert (T.Value = 1, "T.Value = 1"); end Hello; procedure Test_With_Object (T : in out Ahven.Framework.Test_Case'Class) is begin Put_Line ("Test_With_Object"); Hello (Test (T)); end Test_With_Object; end Simple_Tests; ahven-2.7/examples/simple_tests.ads0000644000000000000000000000240213325517624015641 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Unbounded; with Ahven.Framework; use Ada.Strings.Unbounded; package Simple_Tests is type Test is new Ahven.Framework.Test_Case with record Value : Integer := -1; end record; procedure Initialize (T : in out Test); procedure Set_Up (T : in out Test); procedure Tear_Down (T : in out Test); procedure Test_Assertion; procedure Test_Error; procedure Test_With_Object (T : in out Ahven.Framework.Test_Case'Class); end Simple_Tests; ahven-2.7/extra/ahven.png0000644000000000000000000004150213325517624013555 0ustar 00000000000000‰PNG  IHDR–dd[ÉðgAMA± üasRGB®Îé cHRMz&€„ú€èu0ê`:˜pœºQ<bKGDÿÿÿ ½§“ pHYs  šœ vpAg–dß|æôAýIDATxÚí½Y¤Ùu˜÷Ýå_s¯½«·êîÁìƒÁNIq§,1HIá‰Z~°ö‹ýÊ7GøÅ;üà°#l™’S¶)‰ R¤‚;H‚€ffÁôôV]]{VåúowñCõŸ“]èÙ0=Ó=NĬ®ªÌü+ÿ¯Ï9÷ܳï½çû@ê?Ã{ÏrÎݳ¬µßµæ¿?ÿ»ó¯3/B„H)ïYJ©û®úgó¿[?_qÏk~¿ˆ~Øð½ÊiîŽ1†ªª¨ªŠ²,gó_×?¯ª c Ƙ{`›‡«¾ñ5óðh­ ‚`ö†áì±^AܳêçÍCWöqícÖiMTTƒQÅleYö¶+Ïsò<§(ŠheYÎÀ2Æ|Xór,­õ ¨ ˆ¢ˆ0 ‰ãx¶’$™­4MI’䞟×Ï©«×Ç´G¬y­TßèZ •eIžçdYÆt:e2™0ÇŒF£Ù×ãñ˜ÉdÂt:½ªûuÚ¾Søv€EQ4ƒ'MSÒ4¥ÙlÒh4hµZ4›ÍÙc£Ñ Ñh¦é=°ÕZí4h²<’`Ík¥ú¦E1©†g0|ׇ3°¦Ó)ÓéôíTk·Ó>Öi˜ê똬å´_ôv Í›ÈÚÖÚ+MSÍf“v»M»Ý¦ÓéÐétèv»³ïµZ-Æ ÎÚÜ>ê=2`6qµi«A‡ ŽŽŽè÷û³u||<ª†)˲{@:­ê÷y/½™¿±§a›n^«Íƒ6Y V¯×£×뱸¸H¯×£ÛíÒétî­ÖŒóþÙ£"¬Óf®( ¦Ó)ãñ˜Á`@¿ßçððƒƒö÷÷9<<œ5SmÞNk£Ó»ÄÓà|›âÓ7ø´†;í£Í›Î$Ikiii¶gZ­Ñh$ÉL“Ío¦ˆ‡n8­Ê²œi¦ããcúý>ûûûìíí±»»Ëþþ>1 Ç3i^#ÝÏœÕï÷(ÉýLi­ujVûfµ/ÖívYXX`yy™•••ÙZZZ¢×ëÍ ‹¢è‘Ðb)X§}§¢(˜L& ‡CÙßßggg‡íímvvvfêøø˜ÑhÄt:¥(ŠLïædœd¶y_­öÏâ8žùc½^ååeVWWY[[cmmÕÕU–——év»´Z-â8& ÃY(ã£ì#«† öÆã1GGG3˜îܹÃ;wØÞÞfoo~¿Ïp8d2™ÌÌÜýÌÛ÷«Ü/fVCVï,»Ý.KKK¬­­qæÌΞ=Ë™3gX]]eqq‘v»Mš¦°,ïýÌÊóœÑhD¿ßgoo­­-nß¾ÍíÛ·g@Í´S ø¦·“ÓÚ¬ÞiFQD£Ñ Ûí²¸¸ÈÚÚëëëœ?~Ùòò2Ng˜Öú#ñÁ>4°æMÞ­ÈÆå(cr4dgg—íím®\¹ÂÆÆgÎœaqq‘F£1;£|Pp}`°j_ª,K&“ ý~Ÿ­­-®]»ÆÕ«WyóÍ7¹uë{{{ ²,û†úÅ^HR‘r1iò¥•ç|í`›wwÙÝÛfww—½½={ì1.^¼Èêê*ív{¦½¤”ø:>Xµ–*Š‚ápÈîî.7nÜà7Þà;ßùׯ_çÎ;ôû}&“É,dð >$’8ŒùÜÂ?y®ÇçVW¹Ôi0%ä÷ïlskïˆÁ ÏQÿˆƒƒè÷û\¹r…sçα¸¸Hš¦³ëÑ^ß3XõŽ¯ö¥¶¶¶¸zõ*¯½öo¼ñ7oÞdww—ápHžç÷ìò~ ŽhòÙ…ÿíS+<·ÖB …ÊŒ‡L&S&ã1Uqr?fç®uzccƒ••Úíö=;ÇïéZÞïjÓWU“É„ýý}nÞ¼É믿Ϋ¯¾Êo¼ÁíÛ·9<¾¸¼¼L³Ù|_p½+X§¡ºu믾ú*/½ôÒ ªƒƒ¦Óé,.õአm4YX_`{ûF)ÎMpî?F³(èD!?»ÚåJª°I§#0ÇÄ:Ä% ¦¹a`‡î_ê}–eß•ú=´¼/¸Þ¬Óæoss“W^y…^xaÕáááì¢>|¨áI «„b¨©âEò©"Ÿz*“á}õá_Ã#!‚@¥üè™%~âBßêR%1º(‰l#%*6ÈRrè<•5oûJóGpƒÁà»Êáà­ã£:˜úný»‚U–%ÃáÛ·oóꫯò /ð­o}ë» ú¨v}BHthé®Àa?eýl“ èrõ;Çlmj*;À{‡¼Ãß:øšóíÿðñ ¬/6É"CâÇ¥q9ØÈ ¼¤0†I%ñ¼³–™‡k>oîä3ßUùn»Å·«)ŒF#îܹÃ믿΋/¾x_MõQ†¤ Xê.²¶qp[‰œµ³1[û†å"á¨ïpX¼•g±.CxøïÈ„ ÑM~ôL§Wt:ƒ²]N©* S„‡²‚ƒ¬Â½Ç{Tïú‡Ãᬖr>³µ6…I’¼cœë¾`Õvw2™°··Ço¼ÁË/¿Ì+¯¼òP¡*%톄±fyµÁöþ€¥qHÇ,>18N(Ü”áAIi#ÆÖQ‹µõòã ˜$P1?¼Òá—[ Ýláq„þ$Zîü„CÛ ˆñºÉÐíà½yÏï0¯T¶··ïI2¬sº¤”ÄqŒR꾯ñ]`Õ*1Ïs¸~ýú,NuãÆ úýþ,’þ0‚žaèèEá ÑK û–QQ•–ÅVÊbÛÓ/4•Ÿr~Á1%ôwr&ƒŒÜ€÷€³8÷Þ?èGI„T\îõøÏŸëre5Q/ÂÅ݆h„Bw•ÇLª‚÷ûŸé´ÅÒZßSx;™¿Ÿ3¯ï÷‚eYr||Ìææ&¯¾ú*¯¼ò ׯ_¿g÷÷p"é‚D{Â0Æ¡NÈóÓÂâD/ä¢`xEåHuBЉ)Ž­$ ¨£qNžYŒ™â¼Á{{—¶ÉJ¢ù'O,óùÕE|ˆd…M¬ã¼%T ”²;bXŽMñ=½Ýi¸êRµf³9« ªóòO›Ä{ÀªMàxý ¬yxxxÈ7xýõ×¹zõ*»»»ŒÇãYÀì¡}´B¥!*r`=ž”ÊNy\ScÊÂ(ÍA?ÃKõ€shÁù˜ ‰¯WŽr`*CéÁÙb.àúhh2)N‚Âϯ-ò÷žÚ`±ÕÆÙŒÒkœvH“"¤C[…&ÄhP~Š–]c¾ç¿e>ŽyttÄ­[·hµZôz=:ÎLs…aøö`UUÅp8dkk‹7Þxƒ«W¯rç΃eY>ôƒd! ˆ>¦(ŠGF[xaÈrI6‰Éª1Sç(D‚²•.ñAŒ­ZH°ÄH…Ï ±áÀÛ€I9¦°’Ò”›2”LŽ Í5sM vÆÙ;Ü R!…à ¼oð€—wãûw¡û€YBh6º~þ“kt;– >5DZÐN%BWXcðFè)Æ[D cE5…ãÌq”x@÷`.r°··Ç­[·¸xñ"ëëët:™¯ëó¡££#îܹÃíÛ·Ùßßg2™<ÄxÕÛ|ÐR!eI9-Èr‰),Î%XRa6@ R!|€"Â)ƒÔ ‰q†ª”ˆm|î°Z’gŽƒƒùpúPx$¡¼×(ÒkPŽ‡Ç9Dà}…§Âûÿ~³/„b©Õäo=Ýæɵ”Qxˆw’(n¶ =@jw -! ÛP…˜Q_X¼9ØvOïÝ€!>ð=unoo³¹¹9Kk®ym­e2™pppÀÖÖ;;; ƒ™Ãþ(‰š@HªrÂ0·¦Äƒ$@+‹Ô€.ˆcC,Ê2¢dEáX…*ô@èÛ~Þ¾ÂÇØ‚1ù‰Æ2%ÎW 4JœÙh„”(-t:'Œ<*5xåh6#:"/ "Õ$QEU1éñö!ð8„ð„@‡’!Jo„B¨ ¡ ˆ÷Ÿš-¥æÒr›¿þ‰&µ†}|¡š tO šS¤¶h|"ŠQQ†¼ãýˆ4ÒH4V÷¹þ.ó‡Õ»»»ìììptt4;î“uTuoooVû÷(j+ç%#ç)Ç oƆØÊâm%ÞU'‡¤Â8‹ Õ[öv"¥DÉ€ Šh4B¤U ÜÔ3êg„±¦‘6ØØhÒYΉTÕL U“0ÜÇæSdP"8®'µs¹Eˆ’1Ñ0 ‘Xâ–%Ö' ›X“tCò!¹‰†Œ§–`4&9–DqHš„A Í s”4 r ÄT…×ÆcmIéx+ª¢¢¨á´E6êFM}Z„JáÅ/B"bÚ6"¤BY¥X”ƒË°Òb¬%’œøi;r¸2ÃV`EŠq ò¥ ¬ÕHïh·*~é¹6'}þðv…±¼¢©«î|]7 Öuâ‡]½|´Þ*E˜ÄtzMVÎÄ,/¸±äÆ-ÏÁ~…Ž#./7H›šp¥$Œ:D¡'Q\¡ƒ#5 IRä4[ŽiÕÁ—ŠpŒ'…¨h5%aSV)ÚF8¥0IŽ¶ÄŠˆ¢TB³Ý¥T¡¦(a¬£,3²\2È-ñ4"ž€WÕÉ!¶êÑn61Ãœ¢‘‘MŠÊaª#„_!p!m-‰ÕzÝcGrà@™yLZ"t‰â†A„%ÉH‰5D0D§9*( ‚Î(¼qH3ÕëCœ (•FeQH•@XE;b¡ðx ^¨Ò"]iÍÀ ¼Cæ¥ô) Z7qEˆ1KUÈß½tŽWû%¿ssÂMÇ>=]ÄZ‹>= èCÏ}êûJ„QÈã—{<ÿÙ ´[’ãþ1㉧ F#Íp2"ðn0 ¢rŒŠ´.±¹ÂÄP¹ b2V¢hD'ò`º”2† úùH0 ãXјBœ†Ä:Eê12€(­è¤†a:ÅN%d!ÚMI„¤”´ÚZî—Ä&•‚<„ ‚”fÔ¥“@™LF#öö DP‘†ž4 i‚„ÁÉÁ¸V …(•&Ïa_C;)\F«*è’ „¦°-GH¡P¾KeB?DVÎk<1F'”E…,Ê“£&ÝÃ…ž‰ÉXëü£ÇÚ¼v¸Èw†‡ð³L{º4jxøÓ=µh·;<ÿÜ2OªCi²Ã>y’g–lâ)'%Ù¼ ™”ŽJh#3Z"µ¢x¤È1&À«y„U4l ÑÌ`aHa¥ ,“‘`À0Ì ÂøÀ¢d‡VËâ2XÊbœ¯ˆ¼AIMYšZ°”zšdŒ—G-9}E9öÄQ@·-XZ²,õÚXÅ`ÊT°º˜°Ú] ÓT8P¨œ¼0”S˜äŒL Za€,M[²h–”¤'5]ŸÑŠ(Ñ"V »HÛÀ›>"="ô¡š”y‚Ó'<Ò)d ç³gø¥Ë%ÿÓ«ý|ÂM¯¹'ç}~¼ìG— 4 ½ŸüìŸ{¶… bªlÊ€’Â'”Ři9aR•Ó§åÔa+pU@YU„‰°ŠV•á¦!^O‘Q@*J<šRk¼ h'9¾×cdúÓ’*KÈdžC1Åk›Ž4—¤Aƒ8J‘Z‰|L鎙¾:©¾CE34•áì’f)àðPâ£Ý Yn…t[!‹ *H)ª’sy…Ϭ­vYj/´SFUÅ4ßeóMË­wعuÌÁñ„,¯ˆµÀYð‰´£6 QL;2,‡1+iƒå(¥Í„¤)éFËtÊ4q´ËTˆŠ0R@Hå¦(Ÿ¡C ÖÓŒüíÙoó{[9¥ùÞÁšïÚ¬”BÏÏ¿{ÐpŽS !îw”´“ˆI.ñJñù/á©Ïõˆ„ÅL$Ökœè€Xç0" ¥;ÆVH0Þ£”¯$twÓTÆK\¼LˆÇT9„#IˆH4Cái—1Õ g:Ê1‘•%“<¡ÈC„o±´Yì–X£È£˜Š¼Ê1} >ÆA('ºƒÖ%ÝÔs®°Ý)É+X^¬XYô,w›¬u! ©ªl‹Â”©{£¼dï`À‹/mòêËGŽ™fÆ<9xÁ†;”œx‘%‘V¤A@,- ¤í²¬·<½Úf£Õb­QÑIR†h×ƹCŠIŽˆ¬,.,ñC+‡|m÷˜Ò|o½ÆNOÌÐZ£Ã0¼gbÔƒ„ª^5Xfƒ+—Öø¹ÏµùÜ3š«[9¿þ•>ƒ~Ž€ìÆh]à™ ÂXK`-ºß&FxJQáD… lª²BŠEd¨ ¢áÇÙ„¼„X7h·Qœ@{ Æ3é:ÂÁ~âsMh<±°4CC·W°Ö IÈÙ£ ˜X¦†±ˆp%ØÒá¦%²êÓŒ5K˜ÃÅ’•u…•K -Ο‰¸²4"ZZ¥@Ò3)NhFù!Y)™ç\»¶ÉÕ×Þ>泉FŸIÈò¥7(_"}À‘±¼2ÌÚ ks¼³X,Öž4Š 2„£¥"؉hß8`) Yo .6[¬µ÷Yn¶XHV’KnBä¦tDÆSªM"%Gß㽞ŸQ³¤ëiŸ§«,\u‡’0 i6{|êñ&¿ðã1‹K1Ÿ}Æsnm‰ÿáWöxã[‚/|~ƒ@´ÞãÝ8*¢\FPä”Jœœ‹yÇ¢,`5A†B'yP"åøxÈþö©’L½#K—xü©ˆîjƒJL†!ÃŒ“!Æ"Óð) d1ÑœIE™WÄàbˆ—1… ñTßÄ1ívÉ¥õ JFÜhÆ´[!çcšaŠtGÚȸEcÁ »l½¶Ã׿ù:ÃG\>Ñ]á|âI‚ —‡„DU„U†ß?óæÈâl‰¿oXà¤á ¼uT¶¢ª ¦9ìÅ·Z •£F4¢„Å8`¥!ØH~¼Ó#Všå$a;½ï \­<‚ ˜•àGQtÖü0ÅÚ~âé9|Z+i‹XkT1âùW9•‡OÂðãŸ?Ã=3â_óØS‚4uatrLCN#œàRÌR´ñÙ„XN  ˆ ¤Rh¥ ): lß<æ'Hñ7žï16†¯}ó€Û[ž ­K­ƒÖÔ’èÛ(i6±¡ÛjÓM5ö¯"òÂÓje4OD´¥!–‘hd Á[ReYi”jÓ^²´š†¥ŽÄF)N8*a~BuPðòoñGö*gqüüJÄàeŒUZTÄÚÓ{^~§ÏA9>)¶}Ï)zwÏ<œÀf!+KÆcn"B¨„ßMŽ9×H94'Yï§yH-J©ÙÀ¨zf¢®K¦›Í&Q=0sx•@©»3÷‚€µUÁÖá„?~© 4ð'ÐmÄak2`Rš»m/½„Ëy°”R$IB§Óaaav»ý–UO꬛Æ×]t?è›Î/[9b-iÇIˆG‘Ä–Õ–ÇË c4E.˜æ†¢j‚È0aJmáÀ&TV€ÎP„(Ý$ Câ4¡ĉ9Ù Š˜4•D‘có;†­“´ã›»9kgsŠ©§×\`¡Ûf-=dS)SKS â°@à…BÊÈ´Ñi„ÒºTAÈ¢%MS*™`ͯ=Ö¥xÚTÖ3õ’ªŠxñêˆñ¯^äOþâ*UVqì,×x@ŠBúnÛ€Ê Œ7XgÁÛG¨ù{Íf“ÅÅEgÊiÖÊÊÊìÃápvæó^^¼–“àÝ@™T(­îv|ó òŒ­qI£%ñÒ€©èÆ1ÝÄ2žzâX uÅ4³ÞPù.bœ”È("5 W†XB•¤*Bi‹ 3#„¨Nj­äÂRV¬¸sxLQÜ(é$R())*‹ r–Vg—ˆ‚ ‡»’^êh'!‰Q(#‰'LšTEŠ2#âfD#­h¶¡²TEŽ„d.  kF¥æ¥—wù•û-¾su‹j:uu®q±ž»q*d=éG •RŠ8Žév»,//³´´4k~«Ã0¤Ýn³²²ÂÚÚÝn—ÃÃÃûæ¾ß;}@Ìœô“¨ëüª#ú­•3\¿iøì“VÚ!:€ø·¹xNòåßœ$1©””Sƒ‹Þ ‘ÂÊ£J|¨ðJ¢…&RSB"…E…%=RX„ï` ²R“Wê¤ï!+5æãÙþû4TZkÒ4eyy™‹/²±±ÁÚÚÚlÎN-³D¿Ú‰_[[ãÒ¥KìííÍ ÇãÉÜË+â ä±v‡Ïu\jHžíÆ\"´o ›!¾©¨”AªUi~D–¼©šüÚõ;<÷ø:½eÁÖî˜Ò $–SD£G¬t¨HšMâÐâÅ[6H*»KU¦„¤$©¦ÙI #EN‘IDUhi3î!hÒªjb'm†,u+V—q ~z²ËU-,¨ ”s”…çåk#nmNOE%9ïqp<¤ÊË͆’.âµ›‡¼|㘼£„ÀËàä¼í®†zT«Ê¿¨j¸¸¸È… ¸råÊl®a=LàžV‘ÀlÒ@¯×ãÂ… ²··G¿Ät:ÅY‹EÑ [üÍË+üâÆ:O4˜!NXS2.+„N |€öžÐM‰ËŠ•$bAÃÙ‹gxö3xýê‡{û 4q”ÓîD$Á2J{lØ" J„­È«!Žk–1¥B9AšÆD„(HˆÂ#Æ¡H—Ú,t;øêH¨´Ö´Z-ÖÖÖ¸rå ?þ8.\ ×ëÝ7yAŸ~šÊsçÎq|||Ò2rêYÓwø…4æ§ÎHÚd”Ó #+¦L9Å”’BYœY(””ÆcLAà š†”ìm°ƒ’ò¤geœÒlAB¨"T$Æ Ê)Û×wùË79Üq<Ón§„aL¤^š­/}þ žxêÉ•+Wfüî7 LŸ~‘Ú$.--qùòeÆ£1efqqH;3Ê š6¢Šr,^{&N3µ_i$'YŽÒ*DáÑâ¤27*4‰ï5FÆxµ‚ J’$"N%ZJBâ…#·ŽÍ‡üÚ¯|à WÎ-³…;’¸:©v–ÿðW×øƸÅ?ùG?Ìç¾ø’Ðb¢é<ÊTxrŒàÆ„:ÇHða JVìõ3¾}½â¯}FA5>ñµŒ ?îbŽ‡•¥ªJ”Y@g,!aÚF—!VM‰ "wFÿÛµ-¾²³Oa¾;wJÜí2óq8< U’$,--qéÒ%ž~úižxâ Ξ=;›v¿äÐSç×ÔŽ|–eL¦S^ʧüÚk´øL(ø\oB„§pJáB‡T'éÄÆX¼:Dë€Âµ‰NÑc¶²}¼,Ñ¡@¤3xÙ¤7ªxåµ~íÿþ“QÎ|êJ6ègƒ#Ê\Òhw¹°žðÓ_8Ë_¾zÀÿõ+JªùáþP#Iú¤x4rŽ +s„+Rá,¸RàäÚ„@ät»šR•X£qj ' y•Q{d®)+É%¾áÍ6±F)Ï$W|yk‹ßÞÝgj²û6Zû8jªyg}ccƒ§žzŠ§žzŠ™Ãþvuúí^´ŽUœ;wînétÆh2äÕé˜oïùã~Å¢p|±Ýf£ÒT+<…˜ª0%—‚Hyb[¢ !ãјɤ$I=IT!£N*¶o÷yíÅ›ÜÙÙãµWñ唵Õ^»¾G¿? mxV°¥äÖVÎÕ›š/|ê"?òÉçyõæm~ûÿý_ÿúwøÒoðS?òY¢ØáP84΃°ÕI‹&ËI‹‘h¸P¼ºsÀ…”N·²Äˆ¾LÉ]3V˜A@a ¤¢Æ „ôXaˆ KTyŽË)ÿßæ€/_½M¿(Þ¡{ŸÿØÀ5Ÿ³°°ÀÅ‹yúé§yöÙg¹råÊwCï'o VmØØØ ªª»3‚ ¯Ùïðí²ñ„¯÷§|¦ðÙå‹K4ãÕmáŠïG„2DI‰“Š48`=1¡îâ•Bù Ù°Å?ÿÕ?æ÷ëV×;¬/4°RóæmžZéðcŸjóx«ÇBØÁ+Ãvpõ€¯}ã6­¥1 Ý”P—üÕŸ¾Ìè`Ì3O]àÒzŒ” ÆH”ÌAvpá¢8F–mŒjrœ;¶÷áÓ?vÙ^ÃU%ºðTù”j_ØÒ[¦$ö zãäŸçä6ç7·'ü‹›{lgïÔiù㣱NGÖ766xæ™gøä'?Éã?Ι3ghµZïZ|£ßí jû:_>}Òyן´bÙ<üÙ°â“CÅgºŠ'–,Æ] ×9$Ð=4’¶ÔøÇÑ)ç» ø*ÃEठij¬ôº +­&í¾ðüO.¶ifYU±Ô‹¹ücO³Éˆ©ÄÅ Ã"¢ržþÁ!ýÃ}.ž» Æ€jPÙxÑÃI… Ø<å…oïáLƒõ‹1–¥Ag “Ý¿·‹dX Á{e4؀üäOÆüó­Cv²ü÷t¤ö©j¨.^¼È3Ï<ÃóÏ?Ï“O>ɹsçî9|'ÑïöFJ)Ò4eeeå¾3‚···Gܙٹ5å¯îÄ|q5ä.Ãz»I§©‘²G\´žW_Ùãù§Wq¢ðí$àïýÍOqçÍ] kø;?q™+Uã z|’ä_yCl:(åh«˜çV|²PvB~÷ëP°Åßýû?Ão€7ÈjŠ%º€Å……W®z~ç+;üÈ__çÂ¥sè0F…Lv™¼‘‘íWxë°VáeeAgSD鹕ÿÙéóûì?l©‹MÓ4iª§Ÿ~šçŸž§Ÿ~šóçÏÏfæ¼—ºõË¿üË¿ünpÕ$‡aHdzuuûcN¦#S26·Æ%oFç¸E; I…#J4E'áÛ{>qyƒ0ŠÀNRÑŽ;,¶|ý¯Þäfÿ€õ&Ý !¬ÔtŠ¶GH<Òi„rÈXâÒ6JøæK·øõß~/}ñ2¿ð·?C˜hl^âsƒ—!Rr2UÕ' ¹ñü?¿ñm£ÿÙ?ü Ë <šé'{ý·Ý§¬ì݆Ž ˜8nüûÝ#~ug?í”Ó“Ašc©•D4 –——¹|ù2Ï>û,ŸúÔ§xæ™gî‰W½×AýÞ{ k6›÷T½Ö3‚Ã0dkk‹££#²,#·/^þhwÀK \l†¤­Ã&¼´}Ä×^|ŸùÉç©ÊÒ¦xgxê=~âÿüWN5Êø§?ö<—› ¾U¢³.ÒDxâ›x#¾ñê.ÿã¯ýç/6ù韽H˜fXãl§$”0„¼oróæ¯_½Ãg?÷ i“á b°=äêŸ_e÷ÍmÜÀ`œÄ Ñß³9Éxa8áæ$?\ð}búÞªù<ÉÉ«C Ï=÷Ü,¬0Àü^ëNßXð\Fcf"k VÏ ¾uëÖlAUUäfÊÕþ”kGT QB#°xpåÅ=~ö§›è(b2Î)í1 ø⧟âÎæˆý;ß ¿Ê?øÒóÖ;]X†¤i:[qŸL…ânJòý[OzGG#Þ|cvϲ²#4ÖäD‰¤ÈƒÃ1kg^¼¹ÉkÛÇ\=8æw¿uWvúÈØRÁúê*ÿø‘g>¹‚Œ^ ð%Þ­pAÉñјo|s‹ßùøß|‰ƒãC²l@–å'¥ëXðïݬèá!vuúÐd^ÔZêÊ•+<ûì³<ÿüó<÷Üs\¾|™ÕÕÕYµÍ÷Ú(æ}i¬ZæCJ©{*a;Ýn—f³Íææ&ŒÇã{FÔyï©LÁk×®ó«_áÊŸà¹O?F”x #…ç‰'/ñÍ—wбä¹ÏžáxP`„äòâ9.¬hnm°7ñóçó<ùÌ9œ„¼ ÐaE&ýÉxÛј×_»Éï}õ_û“ï°»w@V–'fî]þ>)Žû×VÎ7;ù8d.Ì;èu àÚÚ<þøã<ñÄ\¾|™3gÎÌòÖOÄ÷^ÿ=5±µý­/ºÝn³°°ÀÂÂ"½^›7o²³³Ãññ1Y–Q–åÝ%‡©¦¼öÊ6¿:þSŽF<ÿéO°¸Üƒ da½Ë§>»Îïõu6ª6ç϶h6Z ®n yíõŸÿÒs\z|‘Â9LYD¥°…åöÖ>¿ÿWù½¯¼Æ­›»TeÁ{=§óÞcߘPuÀ³®¨9{ö,—/_æñÇŸåT-//ÓjµXsáÀ'T÷Ÿ,Ë’ÑhÄþþ>·oßæÚµk\½z•k×®±µµÅþþ>£Ñˆ,ËÞê{ê?ÌfÆ*XµÔ}äkÀÆã1ý~6.¸r~çÎÙ@ÎÑh4›ËrZ‹½Ó%+%ÑÁI³^kêâÚïyÞwwG|ë̶ÙlÒétXZZbuu•õõõLkkk,--Í4Ô¼õQtÇþHÀ‚·¶è5`µ‰<>>ž™Éíím¶··ÙÙÙaooÃÃCƒ“Édª¨Swæ!«ÿ„“=xëpÜÚ÷?=þ!Ë|ã•ÚTÕ¾S}ÊÑjµèõz3 Îœ93[+++,,,Ðjµfêa´[ÿÈÀªe°Ú˲l6HqŸ½½=vvvØÝÝv||Ìp8d2™Üc*­µ³À«”röÚâLëûɽ|îí•^Ô$ÉL;-,,°¼¼<ë´ººÊòò2‹‹‹wÓ'­ƒ xˆýûXµÌkcÌÌLÖƒ9ŽŽ888ààà€½½=ö÷÷gåhÇÇÇ3S™çùÌ\¾6›ÿ–¯5sO›·ÚÄÕfn¦v»M¯×›5¿fígÝŠïöìØÓFXó2¯eŒ1”eydõháÃÃÃÙê÷ûͦzÖæ²(ŠÙªyÐ>JØæµPýøVû§¹é s©GqÏóÛí6N‡^¯7ë”·¸¸È½^N§3;ô¯ûªÏk§‡ Ôì3xÀªeþ¦×©Ð5dÓé”ñxÌh4šÕ;Í4Ø`0`82™L&3m–çù,_ÿ$)ñ»a›/ƒ¿ßæà~ÍçNÿûtkÌyÿ¨^AÁ¬Ñ~Ý ½ÙlÒjµh·Û³~°óív›V«5k›>Ó£ î'Xór?Èêyx5h“É„ÑhÄh4b8ÎVý½yȲ,›ùfó3çý´Ó“Ðæa»çC{ˆjj³v¤Z+Õši¨zµZ­Y[ëyê0A­™êøÓ£Ôì3zTÁš—yÈæçâÕ ÕSbëѱ“Éäž5Ng«¬öÍj³9o:ç7÷k—y?G{¦ÚOªaªª5ÔüJÓtP’$³Ôï¤:2>ï„?ª0ÍËǬy™×"õM¯A¨a«›‡®~¬¿®Wý{÷ƒëíæ8Îk¨Z‹ÔÚ©«†+Žãû>ÖZ( ÷ÍA4ï/}@:-;°NËißh~#0¯}jðê5ïsÕ0Íû_ókþ}ÞNcÕZë´öª¿žÿÙü(¿Ó}\A:-{°NËéÝÞé5ï°Ÿ^ó?»äýœõy@æ5Îü÷æwþùó¯ùý$ÿ?62"‚TLtEXtCommentCreated with GIMPW%tEXtdate:create2011-05-31T21:11:43+03:00Šnÿ%tEXtdate:modify2011-05-31T21:11:43+03:00j×ÖCIEND®B`‚ahven-2.7/gnat/ahven.gpr0000644000000000000000000000172613325517624013373 0ustar 00000000000000-- -- Copyright (c) 2016 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- project Ahven is for Source_Dirs use ("../src", "../src/unix"); for Object_Dir use "obj"; for Exec_Dir use "."; for Main use ("libmain.adb"); end Ahven; ahven-2.7/gnat/ahven_tests.gpr0000644000000000000000000000176613325517624014621 0ustar 00000000000000-- -- Copyright (c) 2016 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with "ahven"; project Ahven_Tests is for Source_Dirs use ("../test"); for Object_Dir use "obj"; for Exec_Dir use "."; for Main use ("tester.adb", "tap_tester.adb"); end Ahven_Tests; ahven-2.7/gnat_linux/Makefile0000644000000000000000000000133313325517624014431 0ustar 00000000000000GNAT_BUILDER ?= gnatmake include comfignat.mk export OS_VERSION ?= unix build_GPRs = build_ahven.gpr usage_GPRs = ahven.gpr options = development_build development_build = false html: ${stage_miscdocdir}/ahven/ ${MAKE} html --directory=${srcdir}/../doc/manual/en BUILDDIR=${objdir}/sphinx cp -RHpf ${objdir}/sphinx/html ${stage_miscdocdir}/ahven docs: html # The documentation is built as part of make all, but not in the default build. all: html tests: base ahven_tests.gpr ${build_GPR} ${stage_miscdocdir}/ahven: mkdir -p ${stage_miscdocdir}/ahven check: tests ./tester -c check_xml: tests -mkdir -p results ./tester -c -x -s .Test -d results check_tap: tests ./tap_tester clean:: rm -f ${builddir}/*tester ahven-2.7/gnat_linux/ahven.gpr.gp0000644000000000000000000000054513325517624015215 0ustar 00000000000000#if Directories_GPR'Defined then with $Directories_GPR; #end if; library project Ahven is for Library_Name use "ahven"; for Library_Kind use $Library_Type; for Source_Dirs use ($Includedir & "/ahven"); for Library_Dir use $Libdir; for Library_ALI_Dir use $Alidir & "/ahven"; for Externally_Built use "true"; end Ahven; ahven-2.7/gnat_linux/ahven.lgpr0000644000000000000000000000113413325517624014757 0ustar 00000000000000ahven-astrings.ads ahven-framework.adb ahven-framework.ads ahven-listeners-basic.adb ahven-listeners-basic.ads ahven-listeners.adb ahven-listeners.ads ahven-long_astrings.ads ahven-name_list.ads ahven-parameters.adb ahven-parameters.ads ahven-results.adb ahven-results.ads ahven-runner.adb ahven-runner.ads ahven-slist.adb ahven-slist.ads ahven-tap_runner.adb ahven-tap_runner.ads ahven-temporary_output.adb ahven-temporary_output.ads ahven-text_runner.adb ahven-text_runner.ads ahven-xml_runner.adb ahven-xml_runner.ads ahven.adb ahven.ads ahven_compat.adb ahven_compat.ads ahven-2.7/gnat_linux/ahven_tests.gpr0000644000000000000000000000331413325517624016027 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with "comfignat.gpr"; with "build_ahven.gpr"; -- Link to the just compiled library. project Ahven_Tests is for Languages use ("Ada"); for Source_Dirs use ("../test"); for Object_Dir use Comfignat.Objdir & "/test"; for Exec_Dir use Comfignat.Builddir; for Main use ("tester.adb", "tap_tester.adb", "perf_tester.adb"); package Builder is for Default_Switches ("Ada") use ("-g", "-gnatQ", "-gnatwa", "-gnatwF", -- unreferenced formal off "-gnat95"); end Builder; package Linker is for Default_Switches ("Ada") use ("-g"); end Linker; package Compiler is for Default_Switches ("Ada") use ("-gnatf", "-g"); end Compiler; package Binder is for Default_Switches ("Ada") use ("-E", "-static"); end Binder; end Ahven_Tests; ahven-2.7/gnat_linux/build_ahven.gpr0000644000000000000000000000655313325517624015774 0ustar 00000000000000with "comfignat.gpr"; library project Build_Ahven is type OS_Type is ("unix", "windows"); OS_Version : OS_Type := external ("OS_VERSION", "windows"); type Boolean is ("false", "true"); Development_Build : Boolean := external ("development_build", "false"); Version := External ("ahven_soversion", "27"); for Library_Name use "ahven"; for Library_Kind use Comfignat.Library_Type; for Source_List_File use "ahven.lgpr"; for Object_Dir use Comfignat.Objdir; for Library_Src_Dir use Comfignat.Stage_Includedir & "/ahven"; for Library_Dir use Comfignat.Stage_Libdir; for Library_ALI_Dir use Comfignat.Stage_Alidir & "/ahven"; -- When building a shared library we want Library_Interface to make the -- library elaborate itself automatically. For a static library we need to -- avoid Library_Interface so that GNAT will automatically make a using -- program handle elaboration of the library. -- Library_Version sets the soname, which only shared libraries have. case Comfignat.Library_Type is when "dynamic" | "relocatable" => for Library_Version use "libahven.so." & Version; for Library_Interface use ("Ahven", "Ahven.Framework", "Ahven.Listeners", "Ahven.Listeners.Basic", "Ahven.Name_List", "Ahven.AStrings", "Ahven.Long_AStrings", "Ahven.Results", "Ahven.Parameters", "Ahven.SList", "Ahven.Runner", "Ahven.Tap_Runner", "Ahven.Temporary_Output", "Ahven.Text_Runner", "Ahven.XML_Runner"); when "static" => null; end case; case OS_Version is when "unix" => for Source_Dirs use ("../src", "../src/unix"); when "windows" => for Source_Dirs use ("../src", "../src/windows"); end case; Production_Switches := ("-g", "-gnatf", "-gnatVa", "-gnato", "-gnatwa", "-gnatwl", "-gnatE", "-gnatwF"); -- unreferenced formal off package Compiler is case Development_Build is when "false" => for Default_Switches ("Ada") use Production_Switches; when "true" => for Default_Switches ("Ada") use Production_Switches & ("-gnatwe", "-gnatyd3bmhex", "-gnat95"); end case; -- gnat style switches explained: -- 'd' - no DOS line terminators -- '3' - indentation level (3 spaces) -- 'b' - no trailing whitespace (blanks after statements) -- 'm' - lines less than 80 characters -- 'h' - no horizontal tabs -- 'e' - exit statements need to have labels in named loops -- 'x' - no unnecessary parentheses around conditions end Compiler; end Build_Ahven; ahven-2.7/gnat_linux/comfignat.gpr.gp0000644000000000000000000002566613325517624016076 0ustar 00000000000000-- Comfignat configuration variables for GNAT project files -- Copyright 2013 - 2016 B. Persson, Bjorn@Rombobeorn.se -- -- This material is provided as is, with absolutely no warranty expressed -- or implied. Any use is at your own risk. -- -- Permission is hereby granted to use or copy this project file -- for any purpose, provided the above notices are retained on all copies. -- Permission to modify the code and to distribute modified code is granted, -- provided the above notices are retained, and a notice that the code was -- modified is included with the above copyright notice. -- This file is part of Comfignat 1.5 beta – common, convenient, command-line- -- controlled compile-time configuration of software built with the GNAT tools. -- For information about Comfignat, see http://www.Rombobeorn.se/Comfignat/. -- This project file defines directory variables for use in build-controlling -- project files. It is not to be installed on the target system. -- -- Normally the preprocessing of this file will be controlled by comfignat.mk, -- which will make it import the directories project if one is provided. It can -- also be preprocessed manually if Make cannot be used for some reason. There -- are defaults that will be used if no preprocessor symbols are defined. #if Directories_GPR'Defined then with $Directories_GPR; #end if; abstract project Comfignat is #if not Invoked_By_Makefile'Defined then -- -- These variables are used in constructing the default values of the -- directory variables below. They're only needed when this file is -- preprocessed manually. -- #if Prefix'Defined then Prefix := $Prefix; #else Prefix := "/usr/local"; #end if; -- Prefix is used in the default locations for almost all files. #if Exec_Prefix'Defined then Exec_Prefix := $Exec_Prefix; #else Exec_Prefix := Prefix; #end if; -- Exec_Prefix is used in the default locations for programs, binary -- libraries and other architecture-specific files. #if Datarootdir'Defined then Datarootdir := $Datarootdir; #else Datarootdir := Prefix & "/share"; #end if; -- Datarootdir is the root of the directory tree for read-only -- architecture-independent data files. #if Localstatedir'Defined then Localstatedir := $Localstatedir; #else Localstatedir := Prefix & "/var"; #end if; -- Localstatedir is the root of the directory tree for data files that -- programs modify while they run. #end if; -- -- The following variables may be compiled into programs or libraries to -- tell them where to find or write different kinds of files at run time. -- Most of the directory names are relative to Bindir if the software was -- configured as a relocatable package. Otherwise they are absolute -- pathnames. Bindir is relative to Libexecdir when the package is -- relocatable. -- -- Programs that can be run from a command prompt are in Bindir. This is -- usually the same directory that the program itself is in, so this -- variable is probably useful only to programs under Libexecdir. #if Bindir'Defined then Bindir := $Bindir; #else Bindir := Exec_Prefix & "/bin"; #end if; -- Programs that are intended to be run by other programs rather than by -- users are under Libexecdir. #if Libexecdir'Defined then Libexecdir := $Libexecdir; #else Libexecdir := Exec_Prefix & "/libexec"; #end if; -- Idiosyncratic read-only architecture-independent data files are under an -- application-specific subdirectory of Datadir. #if Datadir'Defined then Datadir := $Datadir; #else Datadir := Datarootdir; #end if; -- Host-specific configuration files are under Sysconfdir. #if Sysconfdir'Defined then Sysconfdir := $Sysconfdir; #else Sysconfdir := Prefix & "/etc"; #end if; -- Idiosyncratic variable data files shall be kept under an application- -- specific subdirectory of Statedir. #if Statedir'Defined then Statedir := $Statedir; #else Statedir := Localstatedir & "/lib"; #end if; -- Cached data files that the application can regenerate if they are deleted -- shall be kept under an application-specific subdirectory of Cachedir. #if Cachedir'Defined then Cachedir := $Cachedir; #else Cachedir := Localstatedir & "/cache"; #end if; -- Log files shall be written under Logdir. #if Logdir'Defined then Logdir := $Logdir; #else Logdir := Localstatedir & "/log"; #end if; -- Small files that take part in describing the state of the system and that -- exist only while the program is running, such as process identifier files -- and transient Unix-domain sockets, shall be sought and created under -- Runstatedir. (This is NOT the place for temporary files in general.) #if Runstatedir'Defined then Runstatedir := $Runstatedir; #else Runstatedir := "/run"; #end if; -- Lock files that are used to prevent multiple programs from trying to -- access a device or other resource at the same time shall be sought and -- created under Lockdir. #if Lockdir'Defined then Lockdir := $Lockdir; #else Lockdir := Runstatedir & "/lock"; #end if; -- Source files to be used in the compilation of software using libraries -- are under Includedir. #if Includedir'Defined then Includedir := $Includedir; #else Includedir := Prefix & "/include"; #end if; -- If a library has installed architecture-specific source files to be used -- in compilation, then those files may also be under a library-specific -- subdirectory of Archincludedir. #if Archincludedir'Defined then Archincludedir := $Archincludedir; #else Archincludedir := Includedir; #end if; -- Binary libraries and other architecture-specific files are under Libdir. #if Libdir'Defined then Libdir := $Libdir; #else Libdir := Exec_Prefix & "/lib"; #end if; -- ALI files are under a library-specific subdirectory of Alidir. #if Alidir'Defined then Alidir := $Alidir; #else Alidir := Libdir; #end if; -- A program or library that has Archincludedir, Libdir and/or Alidir -- compiled-in will in those directories find only libraries compiled for -- the same architecture as itself. -- GNAT project files are under GPRdir. #if GPRdir'Defined then GPRdir := $GPRdir; #else GPRdir := Datarootdir & "/gpr"; #end if; -- Locale-specific message catalogs are under Localedir. #if Localedir'Defined then Localedir := $Localedir; #else Localedir := Datarootdir & "/locale"; #end if; -- Documentation in the Man format is under Mandir. #if Mandir'Defined then Mandir := $Mandir; #else Mandir := Datarootdir & "/man"; #end if; -- Documentation in the Info format is in Infodir. #if Infodir'Defined then Infodir := $Infodir; #else Infodir := Datarootdir & "/info"; #end if; -- Other documentation files are under an application-specific subdirectory -- of Miscdocdir. #if Miscdocdir'Defined then Miscdocdir := $Miscdocdir; #else Miscdocdir := Datarootdir & "/doc"; #end if; -- -- The following variables are for use in attributes to control where -- generated files are placed. -- -- Various generated files are kept in Builddir. #if Builddir'Defined then Builddir := $Builddir; #else Builddir := "."; #end if; -- Intermediate files produced during the build shall be kept in Objdir. #if Objdir'Defined then Objdir := $Objdir; #else Objdir := Builddir & "/obj"; #end if; #if Directories_Project'Defined then -- Put intermediate files for different architectures in subdirectories -- where they won't conflict with each other. (This is useful especially -- with binder files when they are packaged in debug information packages -- for multiarch systems.) Objdir := Objdir & "/" & $Directories_Project.Hardware_Platform; #end if; -- Files to be installed shall be placed under Stagedir instead of the root -- directory. (This variable is unused by Comfignat when Make is used and no -- directories project is provided.) #if Stagedir'Defined then Stagedir := $Stagedir; #else Stagedir := external("DESTDIR", ""); #end if; -- Programs that can be run from a command prompt shall be installed in -- Stage_Bindir. #if Stage_Bindir'Defined then Stage_Bindir := $Stage_Bindir; #else Stage_Bindir := Stagedir & Bindir; #end if; -- Programs that are only intended to be run by other programs, not by -- users, shall be installed under an application-specific subdirectory of -- Stage_Libexecdir. #if Stage_Libexecdir'Defined then Stage_Libexecdir := $Stage_Libexecdir; #else Stage_Libexecdir := Stagedir & Libexecdir; #end if; -- Source files needed for compiling code that uses a library shall be -- installed under Stage_Includedir. #if Stage_Includedir'Defined then Stage_Includedir := $Stage_Includedir; #else Stage_Includedir := Stagedir & Includedir; #end if; -- If architecture-specific source files absolutely must be installed, then -- those files may be placed under a library-specific subdirectory of -- Stage_Archincludedir. #if Stage_Archincludedir'Defined then Stage_Archincludedir := $Stage_Archincludedir; #else Stage_Archincludedir := Stagedir & Archincludedir; #end if; -- Binary libraries shall be installed in Stage_Libdir. #if Stage_Libdir'Defined then Stage_Libdir := $Stage_Libdir; #else Stage_Libdir := Stagedir & Libdir; #end if; -- ALI files shall be installed under a library-specific subdirectory of -- Stage_Alidir. #if Stage_Alidir'Defined then Stage_Alidir := $Stage_Alidir; #else Stage_Alidir := Stagedir & Alidir; #end if; -- -- Other configuration than directories: -- -- If a library can be built as either shared or static, then Library_Type -- shall be used to set the attribute Library_Kind. It can be overridden on -- the builder command line, which makes it possible to write a makefile -- that builds both a shared and a static library. type Library_Kind is ("dynamic", "relocatable", "static"); #if Library_Type'Defined then Library_Type : Library_Kind := external("LIBRARY_TYPE", $Library_Type); #else Library_Type : Library_Kind := external("LIBRARY_TYPE", "dynamic"); #end if; end Comfignat; ahven-2.7/gnat_linux/comfignat.mk0000644000000000000000000010505213325517624015274 0ustar 00000000000000# Comfignat makefile foundation for configuring and building GNAT projects # Copyright 2013 - 2016 B. Persson, Bjorn@Rombobeorn.se # # This material is provided as is, with absolutely no warranty expressed # or implied. Any use is at your own risk. # # Permission is hereby granted to use or copy this makefile # for any purpose, provided the above notices are retained on all copies. # Permission to modify the code and to distribute modified code is granted, # provided the above notices are retained, and a notice that the code was # modified is included with the above copyright notice. # This file is part of Comfignat 1.5 beta – common, convenient, command-line- # controlled compile-time configuration of software built with the GNAT tools. # For information about Comfignat, see http://www.Rombobeorn.se/Comfignat/. # This file contains generic Make code. It is designed to be included by other # makefiles, called containing makefiles, which add information specific to the # project at hand. Builds are controlled by GNAT project files which import the # abstract project Comfignat and use the directory variables it defines. For # libraries there shall also be usage projects to be installed on the target # system. Usage projects and the Comfignat project will be preprocessed with # Gnatprep. (Build projects may also be preprocessed.) # # If a directories project is provided, then the project files will get the # directory variables from there, otherwise the Make variables will be used. # # This file may not work with other Make clones than GNU Make. (Reusable Make # code is pretty much impossible to write without advanced Make features.) If # Make cannot be used for whatever reason, then it's not too difficult to run # the project files through Gnatprep manually. # # First of all, define some functions and constants for processing directory # variables: # nil = inert_space = _Comfignat_magic_protective_space_character_substitute_ inert_tab = _Comfignat_magic_protective_tab_character_substitute_ inert_percent = _Comfignat_magic_protective_percent_character_substitute_ mung_string = ${subst %,${inert_percent},${subst ${nil} ,${inert_tab},${subst ${nil} ,${inert_space},${1}}}} unmung_string = ${subst ${inert_percent},%,${subst ${inert_tab}, ,${subst ${inert_space}, ,${1}}}} # mung_string and unmung_string are used to prevent Make from interpreting # space and percent characters in strings. relativize = ${if ${filter ${2}%,${1}}, \ ${3}${1:${2}%=%}, \ ${call relativize,${1},${dir ${2:%/=%}},${3}../}} # relativize is the recursive algorithm that converts an absolute pathname into # a relative one. # Parameters: # 1: an absolute pathname to convert to relative # 2: the absolute base pathname, being shortened until it's a prefix of 1 # 3: a growing series of "../" to lead the relative pathname with # If 2 is a prefix of 1, then return 3 concatenated with the part of 1 that # differs from 2. Otherwise delete the last element of 2, add one level of # "../" to 3, and repeat. # Within relativize all pathnames have one trailing slash so that only whole # directory names will match. Otherwise "/usr/lib" could match "/usr/lib64" for # example. prepare_pathname = ${subst //,/,${abspath ${call mung_string,${1}}}/} # prepare_pathname prepares a pathname for use as a parameter to relativize. # · Protect space and percent characters from interpretation by Make. # · Normalize the pathname, eliminating ".", ".." and "//". # · Append a slash. # · If the input was "/", then it is now "//". Change that back to "/". relative_to = \ ${or ${call unmung_string \ ,${patsubst %/,%,${call relativize \ ,${call prepare_pathname,${1}} \ ,${call prepare_pathname,${2}},}}},.} # relative_to converts an absolute pathname into a relative one. What it # actually does is to prepare the input to relativize and fix up its output. # Parameters: # 1: an absolute pathname to convert to relative # 2: the absolute base pathname that 1 shall be made relative to # Processing: # · Prepare the two input pathnames with prepare_pathname. # · Call relativize with the prepared pathnames for parameters 1 and 2, and # an empty string for 3. # · Strip the result of surrounding spaces and the trailing slash. # · Reverse the protection of space and percent characters. # · If the result is an empty string, then return "." instead. Make_pathname = ${call relative_to,${${1}},${CURDIR}} # Make_pathname takes the name of a variable whose value is an absolute # pathname, and converts that pathname into the right form for usage in Make # targets, prerequisites and functions, which means that it is made relative # to the current working directory to prevent spaces in parent directories' # names from breaking Make. # # Program-name variables and the usual options variables are picked up from the # environment or the command line: # GNATPREP ?= gnatprep GNAT_BUILDER ?= gprbuild # If GNAT_BUILDER looks like it will invoke Gnatmake, then make the default # value of GNATFLAGS compatible with Gnatmake. Otherwise make it suitable for # building multi-language projects with GPRbuild. GNATFLAGS ?= ${if ${findstring gnatmake, \ ${notdir ${call mung_string,${GNAT_BUILDER}}}}, \ ${GNAT_BUILDER_FLAGS} \ -cargs ${ADAFLAGS} \ -bargs ${GNATBINDFLAGS} \ -largs ${GNATLINKFLAGS} ${LDFLAGS}, \ ${GNAT_BUILDER_FLAGS} \ -cargs:Ada ${ADAFLAGS} \ -cargs:C ${CPPFLAGS} ${CFLAGS} \ -cargs:C++ ${CPPFLAGS} ${CXXFLAGS} \ -cargs:Fortran ${FFLAGS} \ -bargs ${GNATBINDFLAGS} \ -largs ${LDFLAGS}} # (DESTDIR is also supported.) # Containing makefiles may assign default values to the options variables # GNATPREPFLAGS, GNAT_BUILDER_FLAGS, ADAFLAGS, CPPFLAGS, CFLAGS, CXXFLAGS, # FFLAGS, GNATBINDFLAGS, GNATLINKFLAGS and LDFLAGS if they are undefined in the # environment, but should expect that users and distributions may override # those defaults. # # These variables should be overridden on the command line as needed, but will # not be picked up from the environment: # dirgpr = # dirgpr should be the filename of the target system's directories project if # there is one. The Gnatprep symbols Directories_GPR and Directories_Project # will be derived from dirgpr, and project files will be configured to use the # directories project. relocatable_package = false # If relocatable_package is true, then directory variables in project files # will be configured with relative pathnames so that the installed directory # tree as a whole can be moved to another location in the filesystem without # breaking the project files. # dirgpr takes precedence over relocatable_package. library_type = dynamic # If a library can be built as either shared or static, then library_type shall # be used to set the attribute Library_Kind in the project files. prefix = /usr/local exec_prefix = ${prefix} datarootdir = ${prefix}/share localstatedir = ${prefix}/var # These variables are used in constructing the default values of the directory # variables below. bindir = ${exec_prefix}/bin libexecdir = ${exec_prefix}/libexec datadir = ${datarootdir} sysconfdir = ${prefix}/etc statedir = ${localstatedir}/lib cachedir = ${localstatedir}/cache logdir = ${localstatedir}/log runstatedir = /run lockdir = ${runstatedir}/lock includedir = ${prefix}/include archincludedir = ${includedir} libdir = ${exec_prefix}/lib alidir = ${libdir} gprdir = ${datarootdir}/gpr localedir = ${datarootdir}/locale mandir = ${datarootdir}/man infodir = ${datarootdir}/info miscdocdir = ${datarootdir}/doc # These are the directories where different kinds of files will be located on # the target system. builddir = ${CURDIR} objdir = ${builddir}/obj stagedir = ${builddir}/stage # builddir is the build directory, which may be separate from the source tree. # Intermediate files produced during the build are kept in objdir. Files to be # installed are written under stagedir in the build phase, and then copied to # their destination in the installation phase. # Containing makefiles should avoid modifying the directory variables. Users # should be able to rely on these defaults. install_cp_flags = ${if ${DESTDIR},--preserve=timestamps} # Timestamps are preserved when installation is done to a staging directory. # This matters for files that aren't generated during the build but copied from # the source tree. Timestamps are not preserved when installation is done # directly to the target system, because that would change the timestamps of # existing directories. do_preinstall = ${if ${DESTDIR},false,true} do_postinstall = ${if ${DESTDIR},false,true} # Any pre- and post-installation commands that the containing makefile may # specify are executed when installation is done directly to the target system, # but not when installation is done to a staging directory, because such # commands need to be run on the target system, not on a build server. # # Containing makefiles may use these variables in their rules, but nothing # should modify them: # srcdir := ${abspath ${dir ${lastword ${MAKEFILE_LIST}}}} # srcdir is the directory in the source tree where makefiles and project files # are. It may be the root of the source tree or a subdirectory. It is computed # as the directory part of the last pathname in MAKEFILE_LIST – which is this # file since there is no include directive above this point. stage_bindir = ${stagedir}${bindir} stage_libexecdir = ${stagedir}${libexecdir} stage_datadir = ${stagedir}${datadir} stage_sysconfdir = ${stagedir}${sysconfdir} stage_statedir = ${stagedir}${statedir} stage_cachedir = ${stagedir}${cachedir} stage_logdir = ${stagedir}${logdir} stage_includedir = ${stagedir}${includedir} stage_archincludedir = ${stagedir}${archincludedir} stage_libdir = ${stagedir}${libdir} stage_alidir = ${stagedir}${alidir} stage_gprdir = ${stagedir}${gprdir} stage_localedir = ${stagedir}${localedir} stage_mandir = ${stagedir}${mandir} stage_infodir = ${stagedir}${infodir} stage_miscdocdir = ${stagedir}${miscdocdir} # These are the directories where different kinds of files to be installed are # written during the build. Make_srcdir = ${call Make_pathname,srcdir} Make_builddir = ${call Make_pathname,builddir} Make_objdir = ${call Make_pathname,objdir} Make_stagedir = ${call Make_pathname,stagedir} Make_bindir = ${call Make_pathname,stage_bindir} Make_libexecdir = ${call Make_pathname,stage_libexecdir} Make_datadir = ${call Make_pathname,stage_datadir} Make_sysconfdir = ${call Make_pathname,stage_sysconfdir} Make_statedir = ${call Make_pathname,stage_statedir} Make_cachedir = ${call Make_pathname,stage_cachedir} Make_logdir = ${call Make_pathname,stage_logdir} Make_includedir = ${call Make_pathname,stage_includedir} Make_archincludedir = ${call Make_pathname,stage_archincludedir} Make_libdir = ${call Make_pathname,stage_libdir} Make_alidir = ${call Make_pathname,stage_alidir} Make_gprdir = ${call Make_pathname,stage_gprdir} Make_localedir = ${call Make_pathname,stage_localedir} Make_mandir = ${call Make_pathname,stage_mandir} Make_infodir = ${call Make_pathname,stage_infodir} Make_miscdocdir = ${call Make_pathname,stage_miscdocdir} # These variables are for use in Make targets, prerequisites and other places # where Make expects space-separated lists. preprocess_file = "${GNATPREP}" ${firstword ${filter %.gp,$^}} $@ \ ${options_preprocessing} ${Gnatprep_arguments} \ ${if ${filter ${notdir $@},${notdir ${usage_GPRs}}}, \ ${usage_directories} '-DLibrary_Type="${library_type}"', \ '-DSrcdir="${srcdir}"'} \ ${GNATPREPFLAGS} # preprocess_file is a command for use in recipes. It runs the first .gp file # among the rule's prerequisites through Gnatprep to produce the target. If the # target is a usage project, then the usage-relevant variables are conveyed to # it as Gnatprep symbols. Otherwise srcdir is conveyed, as it's needed by # preprocessed build projects. build_GPR = "${GNAT_BUILDER}" -P ${firstword ${filter %.gpr,$^}} \ ${addprefix -aP,${VPATH}} -p \ ${options_building} ${builder_arguments} ${GNATFLAGS} # build_GPR is a command for use in recipes. It performs a build controlled by # the first project file among the rule's prerequisites. # # Adjust the build directory variables, and load the configuration: # # Ensure that builddir is an absolute pathname and is inherited by sub-Makes: ifneq (${Comfignat_overriding_absolute_builddir},) override builddir := ${Comfignat_overriding_absolute_builddir} else ifeq (${origin builddir},command line) override builddir := ${abspath ${builddir}} endif export Comfignat_overriding_absolute_builddir := ${builddir} # Read the configuration file if there is one: configuration = ${Make_builddir}/comfignat_configuration.mk -include ${configuration} # Ensure that objdir and stagedir are absolute pathnames and are inherited by # sub-Makes: ifneq (${Comfignat_overriding_absolute_objdir},) override objdir := ${Comfignat_overriding_absolute_objdir} else ifeq (${origin objdir},command line) override objdir := ${abspath ${objdir}} export Comfignat_overriding_absolute_objdir := ${objdir} objdir_is_overridden = true endif ifneq (${Comfignat_overriding_absolute_stagedir},) override stagedir := ${Comfignat_overriding_absolute_stagedir} else ifeq (${origin stagedir},command line) override stagedir := ${abspath ${stagedir}} export Comfignat_overriding_absolute_stagedir := ${stagedir} stagedir_is_overridden = true endif # builddir, objdir and stagedir need to be absolute in project files, because a # pathname relative to a project file can be wrong when a separate build # directory is used and project files are both in srcdir and in builddir. # objdir and stagedir also need to be absolute in the configuration file # because the working directory might change between Make invocations. # Sub-Makes must use the same builddir, objdir and stagedir as the parent, so # the absolute pathnames are conveyed to child processes in environment # variables that won't normally be overridden and are unlikely to be defined by # accident. # The correction of builddir in sub-Makes must happen before builddir is used # in VPATH and in the pathname of the configuration file. # The inclusion of the configuration file must happen after MAKEFILE_LIST has # been used to define srcdir. # The changes to objdir and stagedir must be done after the configuration file # is read because otherwise the configuration would override the command line. # Once modified the variables are no longer of command line origin, so they are # marked as overridden so that "make configure" will save them. # # Containing makefiles should assign or append to these variables as needed: # ifneq (${origin build_GPRs},file) build_GPRs = endif # build_GPRs shall name one or more project files for building the software. # These project files will be used when "make" or "make build" is invoked. ifneq (${origin usage_GPRs},file) usage_GPRs = endif # If the build produces libraries, then usage_GPRs shall name the project files # that other projects should import to link to the libraries. These project # files will be installed to the target system. ifneq (${origin preprocessed_files},file) preprocessed_files = \ ${filter-out ${notdir ${usage_GPRs}}, \ ${basename ${notdir ${wildcard ${Make_srcdir}/*.gp}}}} endif # preprocessed_files is a list of files to be produced in the preprocessing # step at the beginning of the build. Containing makefiles may override it or # append additional filenames to it. # The files are assumed to be needed during the build. The default list is all # the .gp files in srcdir except for usage projects, minus the .gp suffix. This # includes comfignat.gpr. ifneq (${origin options},file) options = endif # options may be assigned a list of variable names. Those variables may be # overridden on the command line, and will be defined as Gnatprep symbols and # as external variables for build projects. # Their values must be "true" or "false". # The containing makefile should assign a default value to each variable unless # it shall be mandatory to always set the option on the command line. ifneq (${origin Gnatprep_arguments},file) Gnatprep_arguments = endif # Any text assigned to Gnatprep_arguments will be included in the Gnatprep # command line. It may be used for additional symbol definitions. ifneq (${origin builder_arguments},file) builder_arguments = endif # Any text assigned to builder_arguments will be included in the GPRbuild or # Gnatmake command line. It may be used for external variables for project # files or other arguments that are essential for the build to work. Global # default values for optional arguments should be set in the options variables # instead. VPATH += ${filter-out .,${Make_srcdir} ${Make_builddir}} # VPATH is a list of directories that Make should search for prerequisites. # If VPATH has been defined as simply expanded before this file was included, # then Make_srcdir and Make_builddir will be expanded now, so everything that's # involved in their values must be defined before this point. configuration_variables += \ GNATPREP GNAT_BUILDER \ GNATPREPFLAGS GNAT_BUILDER_FLAGS ADAFLAGS CPPFLAGS CFLAGS CXXFLAGS FFLAGS \ GNATBINDFLAGS GNATLINKFLAGS LDFLAGS GNATFLAGS \ DESTDIR \ dirgpr relocatable_package library_type \ prefix exec_prefix datarootdir localstatedir \ bindir libexecdir \ datadir sysconfdir statedir cachedir logdir runstatedir lockdir \ includedir archincludedir libdir alidir gprdir \ localedir mandir infodir miscdocdir \ objdir stagedir \ install_cp_flags \ do_preinstall do_postinstall \ ${options} # configuration_variables is a list of variables that can be saved in the # persistent configuration with "make configure". Containing makefiles may # append additional variable names. # # Compute symbol definitions for Gnatprep and external variable assignments for # build projects: # # For this some more functions and constants for processing directory variables # are needed. usage_directory_variables = includedir archincludedir libdir alidir # These are the usage-relevant directory variables. They are needed in usage # projects after installation. builder_directory_variables = bindir libexecdir ${usage_directory_variables} # These are the builder-relevant directory variables. They control where the # GNAT tools write files to be installed. These are the variables that # Comfignat-compatible directories projects must provide. usage_relevant = ${filter ${usage_directory_variables},${1}} # usage_relevant returns a list of the words in the input list that are usage- # relevant directory variables. If given a single variable name, it returns # that name if the variable is usage-relevant, or an empty string if it isn't. checked_boolean = ${or ${and ${filter 1,${words ${${1}}}}, \ ${filter true false,${${1}}}}, \ ${error ${1} must be "true" or "false"}} # checked_boolean takes the name of a variable and checks that its value is a # single word, and that that word is either "true" or "false". If so it returns # the value; otherwise it complains and stops the execution. checked_true = ${filter true,${call checked_boolean,${1}}} # checked_true takes the name of a variable and checks that it has a boolean # value. It then returns an empty string for "false" or a non-empty string for # "true". maybe_relative_to = ${if ${call checked_true,relocatable_package} \ ,${call relative_to,${1},${2}},${1}} # maybe_relative_to converts an absolute pathname into a relative one if a # relocatable package is desired. # Parameters: # 1: an absolute pathname to maybe convert to relative # 2: the absolute base pathname that 1 may be made relative to # If relocatable_package is "true", then let relative_to convert the pathname, # otherwise return parameter 1 unchanged. # It is checked that relocatable_package has a boolean value. embed_pathname = ${call maybe_relative_to,${${1}},${if ${filter bindir,${1}} \ ,${libexecdir},${bindir}}} # embed_pathname takes the name of a variable whose value is an absolute # pathname, and converts that pathname into the right form for inclusion in a # program, which means that bindir is made relative to libexecdir and other # variables are made relative to bindir if a relocatable package is desired. usage_pathname = ${call maybe_relative_to,${${1}},${gprdir}} # usage_pathname takes the name of a variable whose value is an absolute # pathname, and converts that pathname into the right form for inclusion in a # usage project, which means that it is made relative to gprdir if a # relocatable package is desired. define convey_builder_directory_variable all_directories += '-D${1}="${call embed_pathname,${1}}"' all_directories += '-Dstage_${1}="${stage_${1}}"' usage_directories += ${if ${call usage_relevant,${1}}, \ '-D${1}="${call usage_pathname,${1}}"'} endef # convey_builder_directory_variable takes the name of a builder-relevant # directory variable and returns Make code that conveys that variable to # project files. # · Append a symbol definition to all_directories to convey the variable to # comfignat.gpr in the right form for inclusion in a program. # · Also convey to comfignat.gpr the corresponding pathname under the # staging directory, which wouldn't be derived correctly from a relative # pathname. # · If the variable is also usage-relevant, then append a symbol definition # to usage_directories to convey it to usage projects in the form that # usage projects need. define use_directories_project_variable all_directories += '-D${1}=${directories_project}.${1}' usage_directories += ${if ${call usage_relevant,${1}}, \ '-D${1}=${directories_project}.${1}'} endef # use_directories_project_variable takes the name of a builder-relevant # directory variable and returns Make code that makes project files get that # variable from a directories project. # · Append a symbol definition to all_directories for comfignat.gpr. # · If the variable is also usage-relevant, then append a symbol definition # to usage_directories for usage projects. # Now that all those functions are defined, compute the symbol definitions for # the directory variables. # Convey builddir, objdir and stagedir to comfignat.gpr. all_directories = '-DBuilddir="${builddir}"' '-DObjdir="${objdir}"' \ '-DStagedir="${stagedir}"' usage_directories = # Make project files import the directories project if one has been provided. ifneq (${dirgpr},) directories_project := ${basename ${notdir ${call mung_string,${dirgpr}}}} all_directories += '-DDirectories_GPR="${dirgpr}"' all_directories += '-DDirectories_Project=${directories_project}' usage_directories += '-DDirectories_GPR="${dirgpr}"' endif # Convey the builder-irrelevant directory variables, making them available to # build projects for inclusion in binaries. Make most of the pathnames relative # if a relocatable package is desired. all_directories += '-DDatadir="${call embed_pathname,datadir}"' all_directories += '-DSysconfdir="${call embed_pathname,sysconfdir}"' all_directories += '-DStatedir="${call embed_pathname,statedir}"' all_directories += '-DCachedir="${call embed_pathname,cachedir}"' all_directories += '-DLogdir="${call embed_pathname,logdir}"' all_directories += '-DGPRdir="${call embed_pathname,gprdir}"' all_directories += '-DLocaledir="${call embed_pathname,localedir}"' all_directories += '-DMandir="${call embed_pathname,mandir}"' all_directories += '-DInfodir="${call embed_pathname,infodir}"' all_directories += '-DMiscdocdir="${call embed_pathname,miscdocdir}"' all_directories += '-DRunstatedir="${runstatedir}"' all_directories += '-DLockdir="${lockdir}"' # runstatedir and lockdir belong to the operating system and are used for # communication between subsystems. It wouldn't make sense for an application # to have its own runstatedir. Therefore these variables are always absolute # pathnames. # Set the builder-relevant directory variables. ${foreach var,${builder_directory_variables}, \ ${if ${or ${findstring command line,${origin ${var}}}, \ ${filter true,${${var}_is_configured}}, \ ${filter 0,${words ${dirgpr}}}}, \ ${eval ${call convey_builder_directory_variable,${var}}}, \ ${eval ${call use_directories_project_variable,${var}}}}} # For each builder-relevant directory variable, check whether its value in # project files should be taken from the corresponding Make variable or from a # directories project, and construct symbol definitions accordingly. # If a variable is of command line origin or marked as configured, or if dirgpr # is empty (that is, no directories project has been provided), then convey the # variable to project files. Otherwise make project files use the variable that # the directories project provides. # And now process any boolean options. option_values = \ ${foreach option,${options}, \ ${if ${filter-out undefined environment,${origin ${option}}}, \ ${option}=${call checked_boolean,${option}}, \ ${error ${option} has no default value and must be set to \ "true" or "false" on the command line}}} # For each variable listed in options, check that it exists, that it didn't # come from the environment (to prevent accidents), and that it has a boolean # value. If so, output a name/value pair; otherwise complain and stop. # Convey boolean options to Gnatprep. options_preprocessing = ${addprefix -D,${option_values}} # Convey boolean options to build projects. options_building = ${addprefix -X,${option_values}} # # Some other data that the rules below need: # main_makefile := ${firstword ${MAKEFILE_LIST}} delegation_command = @$${MAKE} --file=${abspath ${main_makefile}} \ --include-dir=${abspath ${dir ${main_makefile}}} # delegation_command is the Make command line that delegating makefiles in # separate build directories use to delegate commands to the main makefile. The # first pathname in MAKEFILE_LIST is the main makefile. build_targets = ${addsuffix .phony_target,${build_GPRs}} # A phony target is defined for each build project, and the job of determining # whether the project needs rebuilding is delegated to the builder. staged_usage_GPRs = ${addprefix ${Make_gprdir}/,${usage_GPRs}} preprocessed_files_in_builddir = ${addprefix ${Make_builddir}/,${preprocessed_files}} # When usage projects are preprocessed they are written to stage_gprdir. Other # preprocessed files are assumed to be needed during the build and are written # to builddir. # # Make rules: # .SECONDEXPANSION: .PHONY: Comfignat_default_goal Comfignat_default_goal: build # How to make directories: %/: mkdir -p $@ .PRECIOUS: %/ # This rule appears to work around a bug that was fixed in GNU Make 3.82: ${Make_gprdir}/: mkdir -p $@ # How to initialize a build directory with a delegating makefile: ${Make_builddir}/Makefile: | ${Make_builddir}/ @echo 'Writing $@.' @( echo 'Comfignat_default_goal: force ; ${delegation_command}'; \ echo '%: force ; ${delegation_command} $$@'; \ echo 'force: ;'; \ echo 'Makefile: ;' \ ) > $@ # This rule generates a delegating makefile in a separate build directory. The # generated makefile delegates all commands to the main makefile. The default # rule invokes the main makefile without a specified goal, triggering the main # makefile's default goal. A match-anything rule forwards any specified goals # to the main makefile. An empty recipe for "Makefile" prevents Make from using # the match-anything rule to update the makefile. # How to save configured variables: .PHONY: configure configure:: ${Make_builddir}/Makefile @echo "Writing ${configuration}." @( ${foreach var,${configuration_variables}, \ ${if ${or ${findstring command line,${origin ${var}}}, \ ${filter true,${${var}_is_overridden}}, \ ${filter true,${${var}_is_configured}}}, \ echo 'ifneq "$${origin ${var}}" "command line"'; \ echo ' override ${var} = ${value ${var}}';\ echo 'endif'; \ echo '${var}_is_configured = true'; \ echo;, \ ${if ${or ${findstring environment,${origin ${var}}}, \ ${filter true,${${var}_is_weakly_configured}}}, \ echo 'ifneq "$${origin ${var}}" "environment"'; \ echo ' ${var} = ${value ${var}}'; \ echo 'endif'; \ echo '${var}_is_weakly_configured = true'; \ echo;}}} \ true \ ) > "${configuration}" # Out of the variables listed in configuration_variables, all that were # overridden on the command line, all that are set in the environment and not # overridden elsewhere, and all that were previously configured, are written # to the configuration file. Command-line-configured values override defaults # assigned later in the containing makefile, but can be overridden on the # command line. Environment-configured values override defaults assigned with # "?=", but can be overridden in the environment or on the command line. A # variable is considered previously configured if there is another variable # with "_is_configured" or "_is_weakly_configured" appended to its name and a # value of "true". Such a variable is also written for each configured # variable. As a side effect of this it is possible to delete a variable V from # the configuration by running "make configure V_is_configured=false # V_is_weakly_configured=false". # How to show the values of configured variables: .PHONY: show_configuration show_configuration:: @${foreach var,${configuration_variables}, \ ${if ${filter true,${${var}_is_configured}}, \ echo '${var} = ${value ${var}}';} \ ${if ${filter true,${${var}_is_weakly_configured}}, \ echo '${var} ?= ${value ${var}}';}} \ true # How to preprocess the project Comfignat: ${Make_builddir}/comfignat.gpr: comfignat.gpr.gp | ${Make_builddir}/ "${GNATPREP}" $< $@ -DInvoked_By_Makefile ${all_directories} \ '-DLibrary_Type="${library_type}"' ${GNATPREPFLAGS} # How to preprocess files that are needed during the build: ${Make_builddir}/%: %.gp | ${Make_builddir}/ ${preprocess_file} # How to preprocess usage projects: ${Make_gprdir}/%: %.gp | ${Make_gprdir}/ ${preprocess_file} # How to stage usage projects that don't need preprocessing: ${Make_gprdir}/%: % | ${Make_gprdir}/ cp -p $< $@ .PHONY: preprocess preprocess: $${preprocessed_files_in_builddir} # How to build a project: %.gpr.phony_target: %.gpr preprocess ${build_GPR} # Instead of tracking dependencies between project files, this rule simply # requires that all preprocessing of files that are needed during the build is # done before any project is built. .PHONY: base base: $${build_targets} # This builds the projects listed in build_GPRs, plus any additional # prerequisites that the containing makefile might add. .PHONY: build build: base $${staged_usage_GPRs} # This is the default build. Additional targets that should be built by default # may be added as prerequisites. .PHONY: all all: build # Optional targets may be added as prerequisites of "all". ${Make_stagedir}: @${MAKE} build # "make install" straight out of a source package triggers a build, but if # something has been built then "make install" doesn't rebuild anything, just # copies the built files to their destination. .PHONY: preinstall preinstall: # A recipe may be added to "preinstall" with commands that need to be run # before the files are installed when installation is done directly to the # target system, but should be skipped when installation is done to a staging # directory. # How to install what has been built and staged: .PHONY: install_stage install_stage: ${Make_stagedir} ${if ${call checked_true,do_preinstall},preinstall} if [ "`echo "${stagedir}"/*`" != "${stagedir}/*" ]; then \ mkdir -p "${DESTDIR}/"; \ cp -RPf ${install_cp_flags} "${stagedir}"/* "${DESTDIR}/"; \ fi # If stagedir doesn't exist, then the rule to make it by running the build is # invoked. If stagedir then exists and contains some files (the asterisk gets # expanded) then those files are copied recursively to DESTDIR or to the # filesystem root. .PHONY: install_files install_files: install_stage # A recipe may be added to "install_files" if any files have to be written, # deleted or moved after the staged directory tree has been installed. This # should be used only for workarounds. It's better to stage all the files # correctly under stagedir in the build phase. .PHONY: postinstall postinstall: install_files # A recipe may be added to "postinstall" with commands that need to be run # after the files are installed when installation is done directly to the # target system, but should be skipped when installation is done to a staging # directory. This will typically be commands that modify existing files on the # target system. .PHONY: install install: install_files ${if ${call checked_true,do_postinstall},postinstall} .PHONY: clean clean:: rm -Rf "${objdir}" "${stagedir}" ${preprocessed_files_in_builddir} .PHONY: unconfigure unconfigure:: rm -f "${configuration}" .PHONY: distclean distclean: clean unconfigure ahven-2.7/janusada/build.bat0000644000000000000000000000012713325517624014176 0ustar 00000000000000call janusada\update.bat if ErrorLevel 2 goto abort call janusada\compile.bat :abortahven-2.7/janusada/compat.adb0000644000000000000000000000156213325517624014346 0ustar 00000000000000-- -- Copyright (c) 2011 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven_Compat; procedure Compat is begin null; end Compat;ahven-2.7/janusada/compile.bat0000644000000000000000000000042313325517624014526 0ustar 00000000000000cd src\windows call ctst.bat if ErrorLevel 2 goto Abort cd .. call ctst.bat if ErrorLevel 2 goto Abort cd ..\test call ctst.bat if ErrorLevel 2 goto Abort call ctsttap.bat if ErrorLevel 2 goto Abort cd ..\test_obj call lkc tap_test call lkc tester cd .. :abortahven-2.7/janusada/compileci.bat0000644000000000000000000000075713325517624015054 0ustar 00000000000000call com_obj\ctst.bat if ErrorLevel 2 goto Abort call lib_obj\ctst.bat if ErrorLevel 2 goto Abort call test_obj\ctst.bat if ErrorLevel 2 goto Abort call test_obj\ctsttap.bat if ErrorLevel 2 goto Abort cd test_obj link -subsystem:console -entry:mainCRTStartup -out:tap_test.exe tap_test.obj libcmt.lib kernel32.lib user32.lib -map:tap_test.map link -subsystem:console -entry:mainCRTStartup -out:tester.exe tester.obj libcmt.lib kernel32.lib user32.lib -map:tap_test.map cd .. :abortahven-2.7/janusada/prepare.bat0000644000000000000000000000143713325517624014542 0ustar 00000000000000cd src set januspath=C:\JWIN320p\rts\console del /q ..\lib_obj\*.* del /q ..\com_obj\*.* mkdir ..\lib_obj mkdir ..\com_obj copy /y ..\janusada\compat.adb ..\src\windows cd windows jmanager Add_Project (..\..\com_obj\,AhvenCompat) jmanager Add_Link (..\..\com_obj\,AhvenCompat,%januspath%, JWIN_RTS_CONSOLE) cd .. jmanager Add_Project (..\lib_obj\,AhvenLib) jmanager Add_Link (..\lib_obj\,AhvenLib,%januspath%, JWIN_RTS_CONSOLE) jmanager Add_Link (..\lib_obj\,AhvenLib,..\com_obj\, AhvenCompat) cd ..\test del /q ..\test_obj\*.* mkdir ..\test_obj jmanager Add_Project (..\test_obj\,AhvenTst) jmanager Add_Link (..\test_obj\,AhvenTst,..\lib_obj, AhvenLib) jmanager Add_Project (..\test_obj\,AhvenTstTAP) jmanager Add_Link (..\test_obj\,AhvenTstTAP,..\lib_obj, AhvenLib) cd .. ahven-2.7/janusada/update.bat0000644000000000000000000000072513325517624014365 0ustar 00000000000000cd src cd windows corder compat /pAhvenCompat/l'ads'/n'adb'/t/w/k255/js'jbind'/jb'/t/l/YLLIBCMT'/b'ctst.bat'/r..\..\com_obj cd .. corder libmain /pAhvenLib/l'ads'/n'adb'/t/w/k255/js'jbind'/jb'/t/l/YLLIBCMT'/b'ctst.bat'/r..\lib_obj cd ..\test corder tap_tester /pAhvenTstTAP/l'ads'/n'adb'/js'jbind'/jb'/t/l/YLLIBCMT'/t/w/k255/b'ctsttap.bat'/r..\test_obj corder tester /pAhvenTst/l'ads'/n'adb'/js'jbind'/jb'/t/l/YLLIBCMT'/t/w/k255/b'ctst.bat'/r..\test_obj cd .. ahven-2.7/janusada/updateci.bat0000644000000000000000000000106613325517624014700 0ustar 00000000000000cd src cd windows corder compat /pAhvenCompat/l'ads'/n'adb'/t/w/k255 /js'jbind'/jb'/t/l/YLLIBCMT/q' /c'/q/b'/b'..\..\com_obj\ctst.bat'/r..\..\com_obj cd .. corder libmain /pAhvenLib/l'ads'/n'adb'/t/w/k255 /js'jbind'/jb'/t/l/YLLIBCMT/q' /c'/q/b'/b'..\lib_obj\ctst.bat'/r..\lib_obj cd ..\test corder tester /pAhvenTst/l'ads'/n'adb' /js'jbind'/jb'/t/l/YLLIBCMT/q' /t/w/k255/c'/q/b'/b'..\test_obj\ctst.bat'/r..\test_obj corder tap_tester /pAhvenTstTap/l'ads'/n'adb' /js'jbind'/jb'/t/l/YLLIBCMT/q' /t/w/k255/c'/q/b'/b'..\test_obj\ctsttap.bat'/r..\test_obj cd .. ahven-2.7/robot/basic.robot0000644000000000000000000000130313325517624014073 0ustar 00000000000000*** Settings *** Library Process *** Test Cases *** Simple1 Test Passes Run Test simple1r Result Should Contain Passed :\ \ 1 Result Should Match *Simple*PASS* Fail1 Test Fails Run Test fail1r Result Should Contain Failed :\ \ 1 Result Should Match *Fail*DOES NOT WORK*FAIL* *** Keywords *** Run Test [Arguments] ${testname} ${result}= Run Process test_sources/${testname} Set Test Variable ${TEST_OUTPUT} ${result.stdout} Result Should Contain [Arguments] ${testresult} Should Contain ${TEST_OUTPUT} ${testresult} Result Should Match [Arguments] ${testresult} Should Match ${TEST_OUTPUT} ${testresult} ahven-2.7/robot/test_sources/fail1/fail1.adb0000644000000000000000000000226713325517624017137 0ustar 00000000000000-- -- Copyright (c) 2017 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; use Ada.Text_IO; with Ahven; use Ahven; package body Fail1 is type Test_Access is access all Test_Case; procedure Initialize (T : in out Test_Case) is begin Set_Name (T, "Fail1"); Ahven.Framework.Add_Test_Routine (T, Test_Fail'Access, "Fail"); end Initialize; procedure Test_Fail is begin Fail ("DOES NOT WORK"); end Test_Fail; end Fail1; ahven-2.7/robot/test_sources/fail1/fail1.ads0000644000000000000000000000203013325517624017144 0ustar 00000000000000-- -- Copyright (c) 2017 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Unbounded; with Ahven.Framework; use Ada.Strings.Unbounded; package Fail1 is type Test_Case is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test_Case); procedure Test_Fail; end Fail1; ahven-2.7/robot/test_sources/fail1/fail1r.adb0000644000000000000000000000166213325517624017317 0ustar 00000000000000-- -- Copyright (c) 2017 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Text_Runner; with Ahven.Framework; with Fail1; procedure Fail1R is S : Fail1.Test_Case; begin Ahven.Text_Runner.Run (S); end Fail1R; ahven-2.7/robot/test_sources/gnat/build.bat0000644000000000000000000000011513325517624017205 0ustar 00000000000000gnatmake -p -P gnat\tests copy gnat\simple1r.exe . copy gnat\fail1r.exe . ahven-2.7/robot/test_sources/gnat/tests.gpr0000644000000000000000000000200513325517624017272 0ustar 00000000000000-- -- Copyright (c) 2016 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with "../../../gnat/ahven"; project Tests is for Source_Dirs use ("../simple1", "../fail1"); for Object_Dir use "obj"; for Exec_Dir use "."; for Main use ("simple1r.adb", "fail1r.adb"); end Tests; ahven-2.7/robot/test_sources/janusada/build.bat0000644000000000000000000000064013325517624020045 0ustar 00000000000000cd simple1 corder simple1r /pSimple1/l'ads'/n'adb'/t/w/k255/js'jbind'/jb'/t/l/YLLIBCMT'/b'..\simple1_obj\ctst.bat'/r..\simple1_obj cd ..\simple1_obj call ctst.bat call lkc simple1r move simple1r.exe .. cd .. cd fail1 corder fail1r /pfail1/l'ads'/n'adb'/t/w/k255/js'jbind'/jb'/t/l/YLLIBCMT'/b'..\fail1_obj\ctst.bat'/r..\fail1_obj cd ..\fail1_obj call ctst.bat call lkc fail1r move fail1r.exe .. cd .. ahven-2.7/robot/test_sources/janusada/prepare.bat0000644000000000000000000000110013325517624020374 0ustar 00000000000000set januspath=C:\JanusAda\rts\console cd simple1 del /q ..\simple1_obj\*.* del /q ..\fail1_obj\*.* mkdir ..\simple1_obj jmanager Add_Project (..\simple1_obj\,Simple1) jmanager Add_Link (..\simple1_obj\,Simple1,%januspath%, JNT_RTS_CONSOLE) jmanager Add_Link (..\simple1_obj\,Simple1,..\..\..\lib_obj\, AhvenLib) cd .. cd fail1 del /q ..\fail1_obj\*.* mkdir ..\fail1_obj jmanager Add_Project (..\fail1_obj\,fail1) jmanager Add_Link (..\fail1_obj\,fail1,%januspath%, JNT_RTS_CONSOLE) jmanager Add_Link (..\fail1_obj\,fail1,..\..\..\lib_obj\, AhvenLib) cd .. ahven-2.7/robot/test_sources/simple1/simple1.adb0000644000000000000000000000223313325517624020064 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; use Ada.Text_IO; package body Simple1 is type Test_Access is access all Test_Case; procedure Initialize (T : in out Test_Case) is begin Set_Name (T, "Simple1"); Ahven.Framework.Add_Test_Routine (T, Test_Simple'Access, "Simple"); end Initialize; procedure Test_Simple is begin null; end Test_Simple; end Simple1; ahven-2.7/robot/test_sources/simple1/simple1.ads0000644000000000000000000000203613325517624020106 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Unbounded; with Ahven.Framework; use Ada.Strings.Unbounded; package Simple1 is type Test_Case is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test_Case); procedure Test_Simple; end Simple1; ahven-2.7/robot/test_sources/simple1/simple1r.adb0000644000000000000000000000167213325517624020254 0ustar 00000000000000-- -- Copyright (c) 2017 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Text_Runner; with Ahven.Framework; with Simple1; procedure Simple1R is S : Simple1.Test_Case; begin Ahven.Text_Runner.Run (S); end Simple1R; ahven-2.7/rules/ahven.aru0000644000000000000000000000422313325517624013566 0ustar 00000000000000check header_comments (minimum, 10); search header_comments (model, "licenseheader.pat"); check pragmas (nonstandard); check improper_initialization (out_parameter); -- check improper_initialization (access variable); search improper_initialization (initialized_variable); check expressions (and_then, or_else, mixed_operators); search global_references (all, ahven); check naming_convention (variable, case_sensitive "^[A-Z][A-Z]?[a-z0-9]*(_[A-Z0-9][a-z0-9]*)*$"); check naming_convention (type, case_sensitive "^[A-Z][A-Z]?[a-z0-9]*(_[A-Z0-9][a-z0-9]*)*$"); check naming_convention (enumeration, case_sensitive "^[A-Z][A-Z0-9]*(_[A-Z0-9][A-Z0-9]*)*$"); check max_statement_nesting (loop, 2); search max_statement_nesting (all, 3); check simplifiable_statements (if_for_case, block, null); check simplifiable_expressions (range, logical); check characters (control, trailing_space); check max_line_length (79); search characters (not_iso_646); search max_blank_lines (2); check assignments (repeated); check declarations (integer_type); check declarations (multiple_names); -- Renamed function calls are forbidden since -- some Ada compiler do not support them. -- check declarations (function_call_renaming); check directly_accessed_globals; check positional_associations (all, 3, call); check positional_associations (all, 0, instantiation); -- No variables in package specs check usage (variable, from_spec); Constantable : check usage (variable, not from_spec, read, initialized, not written); Removable : check usage (object, not from_spec, not read); Hiding: check local_hiding (strict); check parameter_aliasing (certain); -- No long code blocks check Max_Size (if_branch, 30); check Max_Size (unnamed_loop, 20); Long_Blocks: check Max_Size (block, 25); check style (negative_condition); check style (casing_identifier, original); check style (multiple_elements, statement); check style (compound_statement); check style (casing_keyword, lowercase); check style (no_closing_name); search style (exposed_literal, integer, 0, 1, 2, number, constant, var_init); set with_clauses.check_private_with off; check with_clauses (reduceable); check units (unchecked); ahven-2.7/rules/licenseheader.pat0000644000000000000000000000145713325517624015263 0ustar 00000000000000* ^-- Ahven Unit Test Library$ ^--$ ^-- Copyright \(c\) 20.+$ ^--$ ^-- Permission to use, copy, modify, and distribute this software for any$ ^-- purpose with or without fee is hereby granted, provided that the above$ ^-- copyright notice and this permission notice appear in all copies.$ ^--$ ^-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES$ ^-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF$ ^-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR$ ^-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES$ ^-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN$ ^-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF$ ^-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.$ ahven-2.7/run_adacontrol.bat0000644000000000000000000000065613325517624014332 0ustar 00000000000000del objects\*.adt del objects\*.ali mkdir objects cd objects adactl -p ..\gnat\ahven.gpr -f ..\rules\ahven.aru libmain Ahven Ahven.Framework Ahven.Listeners Ahven.Listeners.Basic Ahven.Parameters Ahven.Results Ahven.Runner Ahven.Slist Ahven.Tap_Runner Ahven.Text_Runner Ahven.Xml_Runner Ahven.Astrings Ahven.Long_AStrings Ahven.Name_List Ahven_Compat Ahven.Temporary_Output if ErrorLevel 0 goto :end exit /b 1 :end cd .. ahven-2.7/src/ahven-astrings.ads0000644000000000000000000000163213325517624015034 0ustar 00000000000000-- -- Copyright (c) 2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Bounded; package Ahven.AStrings is new Ada.Strings.Bounded.Generic_Bounded_Length (Max => Max_String_Len); ahven-2.7/src/ahven-framework.adb0000644000000000000000000006521613325517624015166 0ustar 00000000000000-- -- Copyright (c) 2007-2016 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings; with Ada.Unchecked_Deallocation; with Ada.Exceptions; with Ahven.Long_AStrings; package body Ahven.Framework is use Ahven.AStrings; -- A few local procedures, so we do not need to duplicate code. procedure Free_Test is new Ada.Unchecked_Deallocation (Object => Test'Class, Name => Test_Class_Access); generic with procedure Action is <>; procedure Execute_Internal (Test_Object : in out Test'Class; Listener_Object : in out Listeners.Result_Listener'Class); -- Logic for Execute procedures. Action is specified by the caller. -- Helper function to reduce some typing. function To_Bounded (Source : String) return AStrings.Bounded_String is begin return To_Bounded_String (Source => Source, Drop => Ada.Strings.Right); end To_Bounded; function Name_In_List (Name : AStrings.Bounded_String; List_Of_Names : Name_List.List) return Boolean is Pos : Name_List.Cursor := Name_List.First (List_Of_Names); begin loop exit when not Name_List.Is_Valid (Pos); if Name_List.Data (Pos) = Name then return True; end if; Pos := Name_List.Next (Pos); end loop; return False; end Name_In_List; function Name_In_List (Name : String; List_Of_Names : Name_List.List) return Boolean is begin return Name_In_List (To_Bounded (Name), List_Of_Names); end Name_In_List; ----------- Indefinite_Test_List ------------------- package body Indefinite_Test_List is procedure Remove (Ptr : Node_Access) is procedure Free is new Ada.Unchecked_Deallocation (Object => Node, Name => Node_Access); My_Ptr : Node_Access := Ptr; begin Ptr.Next := null; Free_Test (My_Ptr.Data); My_Ptr.Data := null; Free (My_Ptr); end Remove; procedure Append (Target : in out List; Node_Data : Test'Class) is New_Node : constant Node_Access := new Node'(Data => new Test'Class'(Node_Data), Next => null); begin if Target.Last = null then Target.Last := New_Node; Target.First := New_Node; else Target.Last.Next := New_Node; Target.Last := New_Node; end if; end Append; procedure Clear (Target : in out List) is Current_Node : Node_Access := Target.First; Next_Node : Node_Access := null; begin while Current_Node /= null loop Next_Node := Current_Node.Next; Remove (Current_Node); Current_Node := Next_Node; end loop; Target.First := null; Target.Last := null; end Clear; procedure For_Each (Target : List) is Current_Node : Node_Access := Target.First; begin while Current_Node /= null loop Action (Current_Node.Data.all); Current_Node := Current_Node.Next; end loop; end For_Each; procedure Initialize (Target : in out List) is begin Target.Last := null; Target.First := null; end Initialize; procedure Finalize (Target : in out List) is begin Clear (Target); end Finalize; procedure Adjust (Target : in out List) is Target_Last : Node_Access := null; Target_First : Node_Access := null; Current : Node_Access := Target.First; New_Node : Node_Access; begin while Current /= null loop New_Node := new Node'(Data => new Test'Class'(Current.Data.all), Next => null); if Target_Last = null then Target_First := New_Node; else Target_Last.Next := New_Node; end if; Target_Last := New_Node; Current := Current.Next; end loop; Target.First := Target_First; Target.Last := Target_Last; end Adjust; end Indefinite_Test_List; ----------- Test type ------------------- procedure Set_Up (T : in out Test) is begin null; -- empty by default end Set_Up; procedure Tear_Down (T : in out Test) is begin null; -- empty by default end Tear_Down; procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class) is begin Run (T => Test'Class (T), Listener => Listener, Timeout => 0.0); end Run; procedure Run (T : in out Test; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class) is begin Run (T => Test'Class (T), Test_Names => Test_Names, Listener => Listener, Timeout => 0.0); end Run; procedure Execute_Internal (Test_Object : in out Test'Class; Listener_Object : in out Listeners.Result_Listener'Class) is use Ahven.Listeners; begin -- This Start_Test here is called for Test_Suites and Test_Cases. -- Info includes only the name of the test suite/case. -- -- There is a separate Start_Test/End_Test pair for test routines -- in the Run (T : in out Test_Case; ...) procedure. Listeners.Start_Test (Listener_Object, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String (Get_Name (Test_Object)), Test_Kind => CONTAINER)); Action; -- Like Start_Test, only for Test_Suites and Test_Cases. Listeners.End_Test (Listener_Object, (Phase => TEST_END, Test_Name => To_Bounded_String (Get_Name (Test_Object)), Test_Kind => CONTAINER)); end Execute_Internal; function Test_Count (T : Test; Test_Name : String) return Test_Count_Type is A_List : Name_List.List := Name_List.Empty_List; begin Name_List.Append (A_List, To_Bounded (Test_Name)); return Test_Count (Test'Class (T), A_List); end Test_Count; procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Run_Impl is begin Run (T, Listener, Timeout); end Run_Impl; procedure Execute_Impl is new Execute_Internal (Action => Run_Impl); begin Execute_Impl (Test_Object => T, Listener_Object => Listener); end Execute; procedure Execute (T : in out Test'Class; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Run_Impl is begin Run (T => T, Test_Names => Test_Names, Listener => Listener, Timeout => Timeout); end Run_Impl; procedure Execute_Impl is new Execute_Internal (Action => Run_Impl); begin Execute_Impl (Test_Object => T, Listener_Object => Listener); end Execute; ----------- Test_Case ------------------------------ -- Wrap an "object" routine inside a Test_Command record -- and add it to the test command list. -- -- Name of the test will be silently cut if it does not -- fit completely into AStrings.Bounded_String. procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Object_Test_Routine_Access; Name : String) is Command : constant Test_Command := (Command_Kind => OBJECT, Name => To_Bounded (Source => Name), Object_Routine => Routine); begin Test_Command_List.Append (T.Routines, Command); end Add_Test_Routine; -- Wrap a "simple" routine inside a Test_Command record -- and add it to the test command list. -- -- Name of the test will be silently cut if it does not -- fit completely into AStrings.Bounded_String. procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Simple_Test_Routine_Access; Name : String) is Command : constant Test_Command := (Command_Kind => SIMPLE, Name => To_Bounded (Source => Name), Simple_Routine => Routine); begin Test_Command_List.Append (T.Routines, Command); end Add_Test_Routine; -- The heart of the package. -- Run one test routine (well, Command at this point) and -- notify listeners about the result. procedure Run_Command (Command : Test_Command; Info : Listeners.Context; Timeout : Test_Duration; Listener : in out Listeners.Result_Listener'Class; T : in out Test_Case'Class) is use Ahven.Listeners; use Ahven.Long_AStrings; type Test_Status is (TEST_PASS, TEST_FAIL, TEST_ERROR, TEST_TIMEOUT, TEST_SKIP); protected type Test_Results is function Get_Status return Test_Status; procedure Set_Status (Value : Test_Status); function Get_Message return AStrings.Bounded_String; procedure Set_Message (Value : AStrings.Bounded_String); function Get_Long_Message return Long_AStrings.Long_String; procedure Set_Long_Message (Value : Long_AStrings.Long_String); private Status : Test_Status := TEST_ERROR; Message : AStrings.Bounded_String; Long_Message : Long_AStrings.Long_String; end Test_Results; protected body Test_Results is function Get_Status return Test_Status is begin return Status; end Get_Status; procedure Set_Status (Value : Test_Status) is begin Status := Value; end Set_Status; function Get_Message return AStrings.Bounded_String is begin return Message; end Get_Message; procedure Set_Message (Value : AStrings.Bounded_String) is begin Message := Value; end Set_Message; function Get_Long_Message return Long_AStrings.Long_String is begin return Long_Message; end Get_Long_Message; procedure Set_Long_Message (Value : Long_AStrings.Long_String) is begin Long_Message := Value; end Set_Long_Message; end Test_Results; Result : Test_Results; task type Command_Task is entry Start_Command; entry End_Command; end Command_Task; procedure Run_A_Command is procedure Set_Status (S : Test_Status; Message : String; Long_Message : String; R : in out Test_Results) is begin R.Set_Status (S); R.Set_Message (To_Bounded (Source => Message)); R.Set_Long_Message (To_Long_String (Long_Message)); end Set_Status; begin begin Run (Command, T); Result.Set_Status (TEST_PASS); exception when E : Assertion_Error => Set_Status (S => TEST_FAIL, Message => Ada.Exceptions.Exception_Message (E), Long_Message => Ada.Exceptions.Exception_Information (E), R => Result); when E : Test_Skipped_Error => Set_Status (S => TEST_SKIP, Message => Ada.Exceptions.Exception_Message (E), Long_Message => Ada.Exceptions.Exception_Information (E), R => Result); when E : others => Set_Status (S => TEST_ERROR, Message => Ada.Exceptions.Exception_Message (E), Long_Message => Ada.Exceptions.Exception_Information (E), R => Result); end; end Run_A_Command; task body Command_Task is begin accept Start_Command; Run_A_Command; accept End_Command; end Command_Task; Status : Test_Status; begin if Timeout > 0.0 then declare Command_Runner : Command_Task; begin Command_Runner.Start_Command; select Command_Runner.End_Command; or delay Duration (Timeout); abort Command_Runner; Result.Set_Status (TEST_TIMEOUT); end select; end; else Run_A_Command; end if; Status := Result.Get_Status; case Status is when TEST_PASS => Listeners.Add_Pass (Listener, Info); when TEST_FAIL => Listeners.Add_Failure (Listener, (Phase => TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => Result.Get_Message, Long_Message => Long_AStrings.Null_Long_String)); when TEST_ERROR => Listeners.Add_Error (Listener, (Phase => Listeners.TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => Result.Get_Message, Long_Message => Result.Get_Long_Message)); when TEST_TIMEOUT => Listeners.Add_Error (Listener, (Phase => Listeners.TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => To_Bounded_String ("TIMEOUT"), Long_Message => Long_AStrings.Null_Long_String)); when TEST_SKIP => Listeners.Add_Skipped (Listener, (Phase => TEST_RUN, Test_Name => Info.Test_Name, Test_Kind => CONTAINER, Routine_Name => Info.Routine_Name, Message => Result.Get_Message, Long_Message => Long_AStrings.Null_Long_String)); end case; end Run_Command; function Get_Name (T : Test_Case) return String is begin return To_String (T.Name); end Get_Name; procedure Run_Internal (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Command : Test_Command; Test_Name : String; Routine_Name : String; Timeout : Test_Duration) is use Ahven.Listeners; begin Listeners.Start_Test (Listener, (Phase => Ahven.Listeners.TEST_BEGIN, Test_Name => To_Bounded_String (Test_Name), Test_Kind => ROUTINE)); Run_Command (Command => Command, Info => (Phase => Listeners.TEST_RUN, Test_Name => To_Bounded_String (Test_Name), Test_Kind => ROUTINE, Routine_Name => To_Bounded_String (Routine_Name), Message => AStrings.Null_Bounded_String, Long_Message => Long_AStrings.Null_Long_String), Timeout => Timeout, Listener => Listener, T => T); Listeners.End_Test (Listener, (Phase => Ahven.Listeners.TEST_END, Test_Name => To_Bounded_String (Test_Name), Test_Kind => ROUTINE)); end Run_Internal; -- Run procedure for Test_Case. -- -- Loops over the test routine list and executes the routines. procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Exec (Cmd : in out Test_Command) is begin Run_Internal (T => T, Listener => Listener, Command => Cmd, Timeout => Timeout, Test_Name => Get_Name (T), Routine_Name => To_String (Cmd.Name)); end Exec; procedure Run_All is new Test_Command_List.For_Each (Action => Exec); begin Run_All (T.Routines); end Run; -- Purpose of the procedure is to run all -- test routines with name Test_Name. procedure Run (T : in out Test_Case; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Exec (Cmd : in out Test_Command) is begin if Name_In_List (Cmd.Name, Test_Names) then Run_Internal (T => T, Listener => Listener, Command => Cmd, Timeout => Timeout, Test_Name => Get_Name (T), Routine_Name => To_String (Cmd.Name)); end if; end Exec; procedure Run_All is new Test_Command_List.For_Each (Action => Exec); begin Run_All (T.Routines); end Run; function Test_Count (T : Test_Case) return Test_Count_Type is begin return Test_Count_Type (Test_Command_List.Length (T.Routines)); end Test_Count; function Test_Count (T : Test_Case; Test_Names : Name_List.List) return Test_Count_Type is Counter : Test_Count_Type := 0; procedure Increase (Cmd : in out Test_Command) is begin if Name_In_List (Cmd.Name, Test_Names) then Counter := Counter + 1; end if; end Increase; procedure Count_Commands is new Test_Command_List.For_Each (Action => Increase); begin Count_Commands (T.Routines); return Counter; end Test_Count; procedure Finalize (T : in out Test_Case) is begin Test_Command_List.Clear (T.Routines); end Finalize; procedure Set_Name (T : in out Test_Case; Name : String) is begin T.Name := To_Bounded (Source => Name); end Set_Name; ----------- Test_Suite ----------------------------- function Create_Suite (Suite_Name : String) return Test_Suite_Access is begin return new Test_Suite' (Ada.Finalization.Controlled with Suite_Name => To_Bounded (Source => Suite_Name), Test_Cases => Test_List.Empty_List, Static_Test_Cases => Indefinite_Test_List.Empty_List); end Create_Suite; function Create_Suite (Suite_Name : String) return Test_Suite is begin return (Ada.Finalization.Controlled with Suite_Name => To_Bounded (Source => Suite_Name), Test_Cases => Test_List.Empty_List, Static_Test_Cases => Indefinite_Test_List.Empty_List); end Create_Suite; procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access) is begin Test_List.Append (Suite.Test_Cases, (Ptr => T)); end Add_Test; procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access) is begin Add_Test (Suite, Test_Class_Access (T)); end Add_Test; procedure Add_Static_Test (Suite : in out Test_Suite; T : Test'Class) is begin Indefinite_Test_List.Append (Suite.Static_Test_Cases, T); end Add_Static_Test; function Get_Name (T : Test_Suite) return String is begin return To_String (T.Suite_Name); end Get_Name; procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is -- Some nested procedure exercises here. -- -- Execute_Cases is for normal test list -- and Execute_Static_Cases is for indefinite test list. -- A helper procedure which runs Execute for the given test. procedure Execute_Test (Current : in out Test'Class) is begin Execute (Current, Listener, Timeout); end Execute_Test; procedure Execute_Test_Ptr (Current : in out Test_Class_Wrapper) is begin Execute (Current.Ptr.all, Listener, Timeout); end Execute_Test_Ptr; procedure Execute_Static_Cases is new Indefinite_Test_List.For_Each (Action => Execute_Test); procedure Execute_Cases is new Test_List.For_Each (Action => Execute_Test_Ptr); begin Execute_Cases (T.Test_Cases); Execute_Static_Cases (T.Static_Test_Cases); end Run; procedure Run (T : in out Test_Suite; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is procedure Execute_Test (Current : in out Test'Class) is begin if Name_In_List (Get_Name (Current), Test_Names) then Execute (T => Current, Listener => Listener, Timeout => Timeout); else Execute (T => Current, Test_Names => Test_Names, Listener => Listener, Timeout => Timeout); end if; end Execute_Test; procedure Execute_Test_Ptr (Current : in out Test_Class_Wrapper) is begin Execute_Test (Current.Ptr.all); end Execute_Test_Ptr; procedure Execute_Cases is new Test_List.For_Each (Action => Execute_Test_Ptr); procedure Execute_Static_Cases is new Indefinite_Test_List.For_Each (Action => Execute_Test); begin if Name_In_List (T.Suite_Name, Test_Names) then Run (T, Listener, Timeout); else Execute_Cases (T.Test_Cases); Execute_Static_Cases (T.Static_Test_Cases); end if; end Run; function Test_Count (T : Test_Suite) return Test_Count_Type is Counter : Test_Count_Type := 0; procedure Inc_Counter (Test_Obj : in out Test'Class) is begin Counter := Counter + Test_Count (Test_Obj); end Inc_Counter; procedure Inc_Counter_Ptr (Wrapper : in out Test_Class_Wrapper) is begin Inc_Counter (Wrapper.Ptr.all); end Inc_Counter_Ptr; begin declare use Test_List; procedure Count_All is new For_Each (Action => Inc_Counter_Ptr); begin Count_All (T.Test_Cases); end; declare use Indefinite_Test_List; procedure Count_All is new For_Each (Action => Inc_Counter); begin Count_All (T.Static_Test_Cases); end; return Counter; end Test_Count; function Test_Count (T : Test_Suite; Test_Names : Name_List.List) return Test_Count_Type is Counter : Test_Count_Type := 0; procedure Handle_Test (Test_Object : in out Test'Class) is begin if Name_In_List (Get_Name (Test_Object), Test_Names) then Counter := Counter + Test_Count (Test_Object); else Counter := Counter + Test_Count (Test_Object, Test_Names); end if; end Handle_Test; procedure Handle_Test_Ptr (Obj : in out Test_Class_Wrapper) is begin Handle_Test (Obj.Ptr.all); end Handle_Test_Ptr; procedure Count_Static is new Indefinite_Test_List.For_Each (Action => Handle_Test); procedure Count_Tests is new Test_List.For_Each (Action => Handle_Test_Ptr); begin if Name_In_List (T.Suite_Name, Test_Names) then return Test_Count (T); end if; Count_Tests (T.Test_Cases); Count_Static (T.Static_Test_Cases); return Counter; end Test_Count; procedure Adjust (T : in out Test_Suite) is use Test_List; New_List : List := Empty_List; procedure Create_Copy (Item : in out Test_Class_Wrapper) is begin Append (New_List, (Ptr => new Test'Class'(Item.Ptr.all))); end Create_Copy; procedure Copy_All is new For_Each (Action => Create_Copy); begin Copy_All (T.Test_Cases); T.Test_Cases := New_List; end Adjust; procedure Finalize (T : in out Test_Suite) is use Test_List; procedure Free_Item (Item : in out Test_Class_Wrapper) is begin Free_Test (Item.Ptr); end Free_Item; procedure Free_All is new For_Each (Action => Free_Item); begin Free_All (T.Test_Cases); Clear (T.Test_Cases); end Finalize; procedure Release_Suite (T : Test_Suite_Access) is procedure Free is new Ada.Unchecked_Deallocation (Object => Test_Suite, Name => Test_Suite_Access); Ptr : Test_Suite_Access := T; begin Free (Ptr); end Release_Suite; procedure Run (Command : Test_Command; T : in out Test_Case'Class) is begin Set_Up (T); begin case Command.Command_Kind is when SIMPLE => Command.Simple_Routine.all; when OBJECT => Command.Object_Routine.all (T); end case; exception when others => -- If a routine raises an exception, we end up here. -- Tear_Down needs to be called after every test, so -- this is a good place to do it. -- -- Tear_Down also might throw an exception, but that should be ok. -- It is just then propagated outside instead of the exception -- from the test routine. Tear_Down (T); raise; end; -- Normal case, no exceptions Tear_Down (T); end Run; end Ahven.Framework; ahven-2.7/src/ahven-framework.ads0000644000000000000000000003304213325517624015177 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Finalization; with Ahven; with Ahven.Listeners; with Ahven.SList; with Ahven.AStrings; with Ahven.Name_List; pragma Elaborate_All (Ahven); pragma Elaborate_All (Ahven.SList); package Ahven.Framework is Three_Hours : constant := 10800.0; subtype Test_Duration is Duration range 0.0 .. Three_Hours; type Test is abstract new Ada.Finalization.Controlled with null record; -- A type, which provides the base for Test_Case and -- Test_Suite types. type Test_Class_Access is access all Test'Class; procedure Set_Up (T : in out Test); -- Set_Up is called before executing the test procedure. -- -- By default, the procedure does nothing, but derived -- types can overwrite this method and add their own -- customisations. -- -- One should not call this explicitly by herself. -- The framework calls it when necessary. procedure Tear_Down (T : in out Test); -- Tear_Down is called after the test procedure is executed. -- -- By default, the procedure does nothing, but derived -- types can overwrite this method and add their own -- customisations. -- -- One should not call this explicitly by herself. -- The framework calls it when necessary. function Get_Name (T : Test) return String is abstract; -- Return the name of the test. -- -- Types derived from the Test type are required to overwrite -- this procedure. procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class); -- Run the test and place the test result to Result. -- -- Calls Run (T, Listener, Timeout) with Timeout value 0.0. procedure Run (T : in out Test; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; -- Run the test and place the test result to Result. -- Timeout specifies the maximum runtime for a single test. -- -- Types derived from the Test type are required to overwrite -- this procedure. procedure Run (T : in out Test; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class); -- Run the test and place the test result to Result. -- -- Calls Run (T, Test_Name, Listener, Timeout) with Timeout value 0.0. procedure Run (T : in out Test; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration) is abstract; -- Run the test with given name and place the test result to Result. -- Timeout specifies the maximum runtime for a single test. -- Notice: If multiple tests have same name this might call all of -- them. -- -- Types derived from the Test type are required to overwrite -- this procedure. function Test_Count (T : Test) return Test_Count_Type is abstract; -- Return the amount of tests (test routines) which will be executed when -- the Run (T) procedure is called. function Test_Count (T : Test; Test_Names : Name_List.List) return Test_Count_Type is abstract; -- Return the amount of tests (test routines) which will be executed when -- the Run (T, Test_Names) procedure is called. function Test_Count (T : Test; Test_Name : String) return Test_Count_Type; -- Single name wrapper for Test_Count (T, Test_Names) procedure Execute (T : in out Test'Class; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Call Test class' Run method and place the test outcome to Result. -- The procedure calls Start_Test of every listener before calling -- the Run procedure and End_Test after calling the Run procedure. -- -- This procedure is meant to be called from Runner package(s). -- There should be no need for other to use this. procedure Execute (T : in out Test'Class; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Same as Execute above, but call the Run procedure which -- takes Test_Name parameter. type Test_Case is abstract new Test with private; -- The base type for other test cases. function Get_Name (T : Test_Case) return String; -- Return the name of the test case. procedure Run (T : in out Test_Case; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run Test_Case's test routines. procedure Run (T : in out Test_Case; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run Test_Case's test routine which matches to the Name. function Test_Count (T : Test_Case) return Test_Count_Type; -- Implementation of Test_Count (T : Test). function Test_Count (T : Test_Case; Test_Names : Name_List.List) return Test_Count_Type; -- Implementation of Test_Count (T : Test, Test_Name : Name_List.List). procedure Finalize (T : in out Test_Case); -- Finalize procedure of the Test_Case. procedure Set_Name (T : in out Test_Case; Name : String); -- Set Test_Case's name. -- -- If longer than 160 characters, the name is truncated -- to 160 characters. type Object_Test_Routine_Access is access procedure (T : in out Test_Case'Class); -- A pointer to a test routine which takes Test_Case'Class object -- as an argument. -- -- For this kind of test routines, the framework will -- call Set_Up and Tear_Down routines before and after -- test routine execution. type Simple_Test_Routine_Access is access procedure; -- A pointer to a test routine which does not take arguments. procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Object_Test_Routine_Access; Name : String); -- Register a test routine to the Test_Case object. -- -- The routine must have signature -- "procedure R (T : in out Test_Case'Class)". procedure Add_Test_Routine (T : in out Test_Case'Class; Routine : Simple_Test_Routine_Access; Name : String); -- Register a simple test routine to the Test_Case. -- -- The routine must have signature -- "procedure R". type Test_Suite is new Test with private; -- A collection of Tests. -- -- You can either fill a Test_Suite object with Test_Case objects -- or nest multiple Test_Suite objects. You can even mix -- Test_Case and Test_Suite objects, if necessary. type Test_Suite_Access is access all Test_Suite; function Create_Suite (Suite_Name : String) return Test_Suite_Access; -- Create a new Test_Suite. -- Caller must free the returned Test_Suite using Release_Suite. function Create_Suite (Suite_Name : String) return Test_Suite; -- Create a new Test_Suite. The suite and its children are -- released automatically. procedure Add_Test (Suite : in out Test_Suite; T : Test_Class_Access); -- Add a Test to the suite. The suite frees the Test automatically -- when it is no longer needed. procedure Add_Test (Suite : in out Test_Suite; T : Test_Suite_Access); -- Add a Test suite to the suite. The suite frees the Test automatically -- when it is no longer needed. -- -- This is a helper function, which internally calls -- Add_Test (Suite : in out Test_Suite; T : Test_Class_Access). procedure Add_Static_Test (Suite : in out Test_Suite; T : Test'Class); -- Add a Test to the suite. This procedure is meant for statically -- allocated Test_Case objects. -- -- Please note, that a copy of the Test'Class object is saved to -- the suite. Original test object is not modified and changes -- made to it after adding the test are not propagated to -- the added object. function Get_Name (T : Test_Suite) return String; -- Return the name of Test_Suite. procedure Run (T : in out Test_Suite; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run Test_Suite's Test_Cases. procedure Run (T : in out Test_Suite; Test_Names : Name_List.List; Listener : in out Listeners.Result_Listener'Class; Timeout : Test_Duration); -- Run test suite's child which matches to the given name. function Test_Count (T : Test_Suite) return Test_Count_Type; -- Implementation of Test_Count (T : Test). function Test_Count (T : Test_Suite; Test_Names : Name_List.List) return Test_Count_Type; -- Implementation of Test_Count (T : Test, Test_Name : Name_List.List). procedure Adjust (T : in out Test_Suite); -- Adjust procedure of Test_Suite. -- Handles the copying of the structure properly procedure Finalize (T : in out Test_Suite); -- Finalize procedure of Test_Suite. Frees all added Tests. procedure Release_Suite (T : Test_Suite_Access); -- Release the memory of Test_Suite. -- All added tests are released automatically. private type Command_Object_Enum is (SIMPLE, OBJECT); type Test_Command (Command_Kind : Command_Object_Enum := SIMPLE) is record Name : AStrings.Bounded_String; case Command_Kind is when SIMPLE => Simple_Routine : Simple_Test_Routine_Access; when OBJECT => Object_Routine : Object_Test_Routine_Access; end case; end record; -- Name attribute tells the name of the test routine. procedure Run (Command : Test_Command; T : in out Test_Case'Class); -- Run the specified command. -- Calls Set_Up and Tear_Down if necessary. package Test_Command_List is new Ahven.SList (Element_Type => Test_Command); type Test_Case is abstract new Test with record Routines : Test_Command_List.List := Test_Command_List.Empty_List; Name : AStrings.Bounded_String := AStrings.Null_Bounded_String; end record; -- Our test case type. It holds a list of test routines -- (test command objects) and the name of the test case. procedure Run_Command (Command : Test_Command; Info : Listeners.Context; Timeout : Test_Duration; Listener : in out Listeners.Result_Listener'Class; T : in out Test_Case'Class); -- Handle dispatching to the right Run (Command : Test_Command) -- procedure and record test routine result to the Result object. -- -- Timeout parameter defines the longest time the test is allowed -- to run. Value 0.0 means infinite time. type Test_Class_Wrapper is record Ptr : Test_Class_Access; end record; package Test_List is new Ahven.SList (Element_Type => Test_Class_Wrapper); package Indefinite_Test_List is type List is new Ada.Finalization.Controlled with private; Empty_List : constant List; procedure Append (Target : in out List; Node_Data : Test'Class); -- Append an element at the end of the list. procedure Clear (Target : in out List); -- Remove all elements from the list. generic with procedure Action (T : in out Test'Class) is <>; procedure For_Each (Target : List); -- A generic procedure for walk through every item -- in the list and call Action procedure for them. private type Node; type Node_Access is access Node; procedure Remove (Ptr : Node_Access); -- A procedure to release memory pointed by Ptr. type Node is record Next : Node_Access := null; Data : Test_Class_Access := null; end record; type List is new Ada.Finalization.Controlled with record First : Node_Access := null; Last : Node_Access := null; end record; procedure Initialize (Target : in out List); procedure Finalize (Target : in out List); procedure Adjust (Target : in out List); Empty_List : constant List := (Ada.Finalization.Controlled with First => null, Last => null); end Indefinite_Test_List; type Test_Suite is new Test with record Suite_Name : AStrings.Bounded_String := AStrings.Null_Bounded_String; Test_Cases : Test_List.List := Test_List.Empty_List; Static_Test_Cases : Indefinite_Test_List.List := Indefinite_Test_List.Empty_List; end record; -- A suite type which holds a list of test cases and the name -- of the suite. end Ahven.Framework; ahven-2.7/src/ahven-listeners-basic.adb0000644000000000000000000001742613325517624016260 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; with Ahven.AStrings; package body Ahven.Listeners.Basic is use Ahven.AStrings; -- Because of Ada.Text_IO output capturing, the result -- recording is happening in the End_Test procedure. -- -- Add_{Pass,Failure,Error} procedures delegate result -- saving to the Set_Last_Test_Info procedure, which -- records the latest result to the listener. procedure Set_Last_Test_Info (Listener : in out Basic_Listener; Info : Context; Result : Result_Type) is begin Listener.Last_Test_Result := Result; if Info.Phase = TEST_RUN then Results.Set_Routine_Name (Listener.Last_Info, Info.Routine_Name); Results.Set_Test_Name (Listener.Last_Info, Info.Test_Name); Results.Set_Message (Listener.Last_Info, Info.Message); Results.Set_Long_Message (Listener.Last_Info, Info.Long_Message); end if; end Set_Last_Test_Info; procedure Add_Pass (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, PASS_RESULT); end Add_Pass; procedure Add_Failure (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, FAILURE_RESULT); end Add_Failure; procedure Add_Skipped (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, SKIPPED_RESULT); end Add_Skipped; procedure Add_Error (Listener : in out Basic_Listener; Info : Context) is begin Set_Last_Test_Info (Listener, Info, ERROR_RESULT); end Add_Error; procedure Start_Test (Listener : in out Basic_Listener; Info : Context) is R : Result_Collection_Access := null; begin Listener.Start_Time := Ada.Calendar.Clock; if Info.Test_Kind = CONTAINER then R := new Result_Collection; Set_Name (R.all, Info.Test_Name); Set_Parent (R.all, Listener.Current_Result); if Listener.Current_Result = null then Add_Child (Listener.Main_Result, R); else Add_Child (Listener.Current_Result.all, R); end if; Listener.Current_Result := R; elsif Listener.Capture_Output then -- A test routine? Let's create a temporary file -- and direct Ada.Text_IO output there (if requested). Temporary_Output.Create_Temp (Listener.Output_File); Temporary_Output.Redirect_Output (Listener.Output_File); end if; end Start_Test; procedure End_Test (Listener : in out Basic_Listener; Info : Context) is use type Ada.Calendar.Time; Execution_Time : constant Duration := Ada.Calendar.Clock - Listener.Start_Time; procedure Add_Result (Collection : in out Result_Collection) is My_Info : Result_Info := Listener.Last_Info; begin if Info.Phase = TEST_RUN then Set_Routine_Name (My_Info, To_String (Info.Routine_Name)); end if; -- It is possible that only Start_Test and End_Test -- are called (e.g. for Test_Suite), so the latest -- test result can be unset (set to NO_RESULT) -- -- In that case, we simply jump to parent collection. -- Otherwise, we record the result. if Listener.Last_Test_Result /= NO_RESULT then if Listener.Capture_Output then -- End of the test routine, so we can restore -- the normal output now and close the temporary file. Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); -- Saving the name of the temporary file to the test result, -- so the file can be deleted later Set_Output_File (My_Info, Temporary_Output.Get_Name (Listener.Output_File)); end if; Set_Message (My_Info, Get_Message (Listener.Last_Info)); Set_Long_Message (My_Info, Get_Long_Message (Listener.Last_Info)); Results.Set_Execution_Time (My_Info, Execution_Time); case Listener.Last_Test_Result is when PASS_RESULT => Add_Pass (Collection, My_Info); when FAILURE_RESULT => Add_Failure (Collection, My_Info); when ERROR_RESULT | NO_RESULT => Add_Error (Collection, My_Info); when SKIPPED_RESULT => Add_Skipped (Collection, My_Info); end case; Listener.Last_Test_Result := NO_RESULT; else Listener.Current_Result := Get_Parent (Listener.Current_Result.all); end if; end Add_Result; begin if Listener.Current_Result /= null then Add_Result (Listener.Current_Result.all); else Add_Result (Listener.Main_Result); end if; end End_Test; procedure Set_Output_Capture (Listener : in out Basic_Listener; Capture : Boolean) is begin Listener.Capture_Output := Capture; end Set_Output_Capture; function Get_Output_Capture (Listener : Basic_Listener) return Boolean is begin return Listener.Capture_Output; end Get_Output_Capture; procedure Remove_File (Name : String) is Handle : Ada.Text_IO.File_Type; begin Ada.Text_IO.Open (Handle, Ada.Text_IO.Out_File, Name); Ada.Text_IO.Delete (Handle); exception when others => null; -- For now we can safely ignore errors (like missing file) end Remove_File; procedure Remove_Files (Collection : in out Result_Collection) is procedure Remove (Name : Bounded_String) is begin if Length (Name) > 0 then Remove_File (To_String (Name)); end if; end Remove; procedure Remove_Loop (First_Item : Result_Info_Cursor) is Loop_Iter : Result_Info_Cursor := First_Item; begin loop exit when not Is_Valid (Loop_Iter); Remove (Get_Output_File (Data (Loop_Iter))); Loop_Iter := Next (Loop_Iter); end loop; end Remove_Loop; Child_Iter : Result_Collection_Cursor; begin Remove_Loop (First_Pass (Collection)); Remove_Loop (First_Failure (Collection)); Remove_Loop (First_Error (Collection)); Remove_Loop (First_Skipped (Collection)); Child_Iter := First_Child (Collection); Child_Loop: loop exit Child_Loop when not Is_Valid (Child_Iter); Remove_Files (Data (Child_Iter).all); Child_Iter := Next (Child_Iter); end loop Child_Loop; end Remove_Files; procedure Finalize (Listener : in out Basic_Listener) is begin Remove_Files (Listener.Main_Result); Results.Release (Listener.Main_Result); end Finalize; end Ahven.Listeners.Basic; ahven-2.7/src/ahven-listeners-basic.ads0000644000000000000000000000622413325517624016273 0ustar 00000000000000-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Calendar; with Ahven.Temporary_Output; with Ahven.Results; use Ahven.Results; pragma Elaborate_All (Ahven.Results); pragma Elaborate_All (Ahven.Temporary_Output); package Ahven.Listeners.Basic is type Result_Type is (NO_RESULT, PASS_RESULT, FAILURE_RESULT, ERROR_RESULT, SKIPPED_RESULT); type Basic_Listener is new Result_Listener with record Main_Result : aliased Result_Collection; Current_Result : Result_Collection_Access; Last_Test_Result : Result_Type := NO_RESULT; Last_Info : Result_Info := Empty_Result_Info; Capture_Output : Boolean := False; Output_File : Temporary_Output.Temporary_File; Start_Time : Ada.Calendar.Time; end record; procedure Add_Pass (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Pass procedure Add_Failure (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Failure procedure Add_Skipped (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Skipped procedure Add_Error (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Add_Error procedure Start_Test (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.Start_Test procedure End_Test (Listener : in out Basic_Listener; Info : Context); -- New implementation for Listeners.End_Test procedure Set_Output_Capture (Listener : in out Basic_Listener; Capture : Boolean); -- Enable or disable Ada.Text_IO output capturing function Get_Output_Capture (Listener : Basic_Listener) return Boolean; -- Capture the Ada.Text_IO output? private procedure Set_Last_Test_Info (Listener : in out Basic_Listener; Info : Context; Result : Result_Type); procedure Remove_File (Name : String); procedure Remove_Files (Collection : in out Result_Collection); procedure Finalize (Listener : in out Basic_Listener); end Ahven.Listeners.Basic; ahven-2.7/src/ahven-listeners.adb0000644000000000000000000000226613325517624015175 0ustar 00000000000000-- -- Copyright (c) 2011 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package body Ahven.Listeners is procedure Add_Skipped (Listener : in out Result_Listener; Info : Context) is begin -- By default, we treat skipped tests as Failures. -- This is for compatibility with earlier API -- which did not know Skipped tests. Add_Failure (Result_Listener'Class (Listener), Info); end Add_Skipped; end Ahven.Listeners; ahven-2.7/src/ahven-listeners.ads0000644000000000000000000000572613325517624015222 0ustar 00000000000000-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Finalization; with Ahven.AStrings; with Ahven.Long_AStrings; package Ahven.Listeners is type Test_Phase is (TEST_BEGIN, TEST_RUN, TEST_END); -- What is test doing right now? type Test_Type is (CONTAINER, ROUTINE); type Context (Phase : Test_Phase) is record Test_Name : AStrings.Bounded_String; Test_Kind : Test_Type; case Phase is when TEST_BEGIN | TEST_END => null; when TEST_RUN => Routine_Name : AStrings.Bounded_String; Message : AStrings.Bounded_String; Long_Message : Long_AStrings.Long_String; end case; end record; type Result_Listener is abstract new Ada.Finalization.Limited_Controlled with null record; -- Result_Listener is a listener for test results. -- Whenever a test is run, the framework calls -- registered listeners and tells them the result of the test. type Result_Listener_Class_Access is access all Result_Listener'Class; procedure Add_Pass (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after test passes. procedure Add_Failure (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after test fails. procedure Add_Skipped (Listener : in out Result_Listener; Info : Context); -- Called when user wants to skip the test. -- -- By default, skipped tests are treated as failures. -- Listeners should reimplement this function if -- they want to report skipped tests separately. procedure Add_Error (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after there is an error in the test. procedure Start_Test (Listener : in out Result_Listener; Info : Context) is abstract; -- Called before the test begins. This is called before Add_* procedures. procedure End_Test (Listener : in out Result_Listener; Info : Context) is abstract; -- Called after the test ends. Add_* procedures are called before this. end Ahven.Listeners; ahven-2.7/src/ahven-long_astrings.ads0000644000000000000000000000250013325517624016046 0ustar 00000000000000-- -- Copyright (c) 2012 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Unbounded; package Ahven.Long_AStrings is subtype Long_String is Ada.Strings.Unbounded.Unbounded_String; Null_Long_String : constant Long_String := Ada.Strings.Unbounded.Null_Unbounded_String; function To_Long_String (Str : String) return Long_String renames Ada.Strings.Unbounded.To_Unbounded_String; function To_String (U : Long_String) return String renames Ada.Strings.Unbounded.To_String; function Length (U : Long_String) return Natural renames Ada.Strings.Unbounded.Length; end Ahven.Long_AStrings; ahven-2.7/src/ahven-name_list.ads0000644000000000000000000000170613325517624015157 0ustar 00000000000000-- -- Copyright (c) 2015 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.SList; with Ahven.AStrings; pragma Elaborate_All (Ahven.SList); package Ahven.Name_List is new Ahven.SList (Element_Type => Ahven.AStrings.Bounded_String); ahven-2.7/src/ahven-parameters.adb0000644000000000000000000001667313325517624015337 0ustar 00000000000000-- -- Copyright (c) 2008-2015 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Command_Line; with Ada.Text_IO; with Ahven.AStrings; use Ada.Command_Line; use Ada.Text_IO; package body Ahven.Parameters is type Parser_State is (NONE, DIR_NEXT, TIMEOUT_NEXT, SUFFIX_NEXT, IGNORE_REST); -- Possible options: -- -c : capture output -- -d : result directory -- -q : quiet mode -- -s : test class suffix in XML files -- -t : timeout -- -v : verbose mode (default) -- -x : XML output -- procedure Parse_Options (Info : in out Parameter_Info; Mode : Parameter_Mode; Option : String; State : out Parser_State) is procedure Check_Invalid (C : Character) is begin case Mode is when NORMAL_PARAMETERS => if C = 'n' then raise Invalid_Parameter; end if; when TAP_PARAMETERS => if (C = 'd') or (C = 'x') or (C = 's') then raise Invalid_Parameter; end if; end case; end Check_Invalid; begin State := NONE; Option_Loop: for A in Option'Range loop Check_Invalid (Option (A)); case Option (A) is when 'c' => Info.Capture_Output := True; when 'd' => State := DIR_NEXT; when 't' => State := TIMEOUT_NEXT; when 'v' => Info.Verbose_Output := True; when 'q' => Info.Verbose_Output := False; when 'x' => Info.Xml_Output := True; when 's' => State := SUFFIX_NEXT; when 'i' => State := IGNORE_REST; exit Option_Loop; when others => raise Invalid_Parameter; end case; end loop Option_Loop; end Parse_Options; -- Recognize command line parameters. -- Option "--" can be used to separate options and test names. -- procedure Parse_Parameters (Mode : Parameter_Mode; Info : out Parameter_Info) is State : Parser_State := NONE; Files_Only : Boolean := False; procedure Handle_Parameter (P : in out Parameter_Info; Arg : String; Index : Positive) -- Parse one parameter and update P if necessary. is begin if (State = IGNORE_REST) and (Arg = "--") then State := NONE; Files_Only := True; elsif State = IGNORE_REST then null; -- Do nothing elsif State = DIR_NEXT then P.Result_Dir := Index; State := NONE; elsif State = TIMEOUT_NEXT then P.Timeout := Framework.Test_Duration'Value (Arg); State := NONE; elsif State = SUFFIX_NEXT then P.Test_Suffix := Index; State := NONE; elsif Arg = "--" then Files_Only := True; elsif Arg'Size > 1 then if (not Files_Only) and (Arg (Arg'First) = '-') then Parse_Options (Info => P, Mode => Mode, Option => Arg (Arg'First + 1 .. Arg'Last), State => State); else Name_List.Append (P.Test_Names, AStrings.To_Bounded_String (Ada.Command_Line.Argument (Index))); end if; end if; end Handle_Parameter; begin -- Default values Info := (Verbose_Output => True, Xml_Output => False, Capture_Output => False, Test_Names => Name_List.Empty_List, Result_Dir => 0, Test_Suffix => 0, Timeout => 0.0); for A in Positive range 1 .. Argument_Count loop Handle_Parameter (Info, Argument (A), A); end loop; if (State /= NONE) and (State /= IGNORE_REST) then raise Invalid_Parameter; end if; end Parse_Parameters; procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS) is begin case Mode is when NORMAL_PARAMETERS => Put_Line ("Possible parameters: [-cqvxi] [-t timeout ] " & "[-s suffix] " & "[-d directory] [--]" & " [testname] .. [testname]"); Put_Line (" -d : directory for test results"); Put_Line (" -x : output in XML format"); Put_Line (" -s : Test name suffix in XML files"); when TAP_PARAMETERS => Put_Line ("Possible parameters: [-cqvi] [-t timeout] [--] " & "[testname] .. [testname]"); end case; Put_Line (" -c : capture and report test outputs"); Put_Line (" -q : quiet results"); Put_Line (" -t : test timeout, infinite(0) default"); Put_Line (" -v : verbose results (default)"); Put_Line (" -i : ignore remaining parameters up to ""--"""); Put_Line (" -- : test names follow (optional)"); end Usage; function Capture (Info : Parameter_Info) return Boolean is begin return Info.Capture_Output; end Capture; function Verbose (Info : Parameter_Info) return Boolean is begin return Info.Verbose_Output; end Verbose; function XML_Results (Info : Parameter_Info) return Boolean is begin return Info.Xml_Output; end XML_Results; function Single_Test (Info : Parameter_Info) return Boolean is begin return (Name_List.Length (Info.Test_Names) /= 0); end Single_Test; function Test_Name (Info : Parameter_Info) return String is use Ahven.AStrings; begin if Name_List.Length (Info.Test_Names) = 0 then return ""; else return To_String (Name_List.Data (Name_List.First (Info.Test_Names))); end if; end Test_Name; function Test_Names (Info : Parameter_Info) return Ahven.Name_List.List is begin return Info.Test_Names; end Test_Names; function Result_Dir (Info : Parameter_Info) return String is begin if Info.Result_Dir = 0 then return ""; else return Argument (Info.Result_Dir); end if; end Result_Dir; function Timeout (Info : Parameter_Info) return Framework.Test_Duration is begin return Info.Timeout; end Timeout; function Test_Class_Suffix (Info : Parameter_Info) return String is begin if Info.Test_Suffix = 0 then return ""; else return Argument (Info.Test_Suffix); end if; end Test_Class_Suffix; end Ahven.Parameters; ahven-2.7/src/ahven-parameters.ads0000644000000000000000000000576513325517624015360 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Name_List; -- A package for handling command line parameters -- -- Parameters are handled for normal and TAP test runners -- and the used mode is specified by giving either -- NORMAL_PARAMETERS or TAP_PARAMETERS parameter to -- Parse_Parameters procedure. package Ahven.Parameters is Invalid_Parameter : exception; type Parameter_Info is private; type Parameter_Mode is (NORMAL_PARAMETERS, TAP_PARAMETERS); procedure Parse_Parameters (Mode : Parameter_Mode; Info : out Parameter_Info); -- Parse Ada.Command_Line parameters and put the results -- to the Info parameter. Raises Invalid_Parameter if -- some parameter is invalid. procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS); -- Print usage. function Capture (Info : Parameter_Info) return Boolean; -- Capture Ada.Text_IO output? function Verbose (Info : Parameter_Info) return Boolean; -- Use verbose mode? function XML_Results (Info : Parameter_Info) return Boolean; -- Output XML? function Single_Test (Info : Parameter_Info) return Boolean; -- Run a single test (case/suite/routine) only? function Test_Name (Info : Parameter_Info) return String; -- Return the name of the test passed as a parameter. function Test_Names (Info : Parameter_Info) return Ahven.Name_List.List; -- Return all the test names passed as a parameter function Result_Dir (Info : Parameter_Info) return String; -- Return the directory for XML results. function Timeout (Info : Parameter_Info) return Framework.Test_Duration; -- Return the timeout value for a test. function Test_Class_Suffix (Info : Parameter_Info) return String; private type Parameter_Info is record Verbose_Output : Boolean := True; Xml_Output : Boolean := False; Capture_Output : Boolean := False; Test_Names : Name_List.List; -- Names of the wanted tests Result_Dir : Natural := 0; -- Position of results dir in the argument array Test_Suffix : Natural := 0; -- Position of test class name suffix in the argument array Timeout : Framework.Test_Duration := 0.0; end record; end Ahven.Parameters; ahven-2.7/src/ahven-results.adb0000644000000000000000000003263413325517624014670 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Unchecked_Deallocation; package body Ahven.Results is use Ahven.Results.Result_List; use Ahven.Results.Result_Info_List; -- Bunch of setters and getters. -- The implementation is straightforward. procedure Set_Test_Name (Info : in out Result_Info; Name : Bounded_String) is begin Info.Test_Name := Name; end Set_Test_Name; procedure Set_Routine_Name (Info : in out Result_Info; Name : Bounded_String) is begin Info.Routine_Name := Name; end Set_Routine_Name; procedure Set_Message (Info : in out Result_Info; Message : Bounded_String) is begin Info.Message := Message; end Set_Message; procedure Set_Test_Name (Info : in out Result_Info; Name : String) is begin Set_Test_Name (Info, To_Bounded_String (Name)); end Set_Test_Name; procedure Set_Routine_Name (Info : in out Result_Info; Name : String) is begin Set_Routine_Name (Info, To_Bounded_String (Name)); end Set_Routine_Name; procedure Set_Message (Info : in out Result_Info; Message : String) is begin Set_Message (Info, To_Bounded_String (Message)); end Set_Message; procedure Set_Long_Message (Info : in out Result_Info; Message : Bounded_String) is begin Set_Long_Message (Info, To_String (Message)); end Set_Long_Message; procedure Set_Long_Message (Info : in out Result_Info; Message : Long_AStrings.Long_String) is begin Info.Long_Message := Message; end Set_Long_Message; procedure Set_Long_Message (Info : in out Result_Info; Message : String) is begin Set_Long_Message (Info, Long_AStrings.To_Long_String (Message)); end Set_Long_Message; procedure Set_Execution_Time (Info : in out Result_Info; Elapsed_Time : Duration) is begin Info.Execution_Time := Elapsed_Time; end Set_Execution_Time; procedure Set_Output_File (Info : in out Result_Info; Filename : Bounded_String) is begin Info.Output_File := Filename; end Set_Output_File; procedure Set_Output_File (Info : in out Result_Info; Filename : String) is begin Set_Output_File (Info, To_Bounded_String (Filename)); end Set_Output_File; function Get_Test_Name (Info : Result_Info) return String is begin return To_String (Info.Test_Name); end Get_Test_Name; function Get_Routine_Name (Info : Result_Info) return String is begin return To_String (Info.Routine_Name); end Get_Routine_Name; function Get_Message (Info : Result_Info) return String is begin return To_String (Info.Message); end Get_Message; function Get_Long_Message (Info : Result_Info) return String is begin return Long_AStrings.To_String (Info.Long_Message); end Get_Long_Message; function Get_Execution_Time (Info : Result_Info) return Duration is begin return Info.Execution_Time; end Get_Execution_Time; function Get_Output_File (Info : Result_Info) return Bounded_String is begin return Info.Output_File; end Get_Output_File; procedure Add_Child (Collection : in out Result_Collection; Child : Result_Collection_Access) is begin Append (Collection.Children, (Ptr => Child)); end Add_Child; procedure Add_Error (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Errors, Info); end Add_Error; procedure Add_Skipped (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Skips, Info); end Add_Skipped; procedure Add_Failure (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Failures, Info); end Add_Failure; procedure Add_Pass (Collection : in out Result_Collection; Info : Result_Info) is begin Append (Collection.Passes, Info); end Add_Pass; -- When Result_Collection is released, it recursively releases -- its all children. procedure Release (Collection : in out Result_Collection) is procedure Free is new Ada.Unchecked_Deallocation (Object => Result_Collection, Name => Result_Collection_Access); Position : Result_List.Cursor := First (Collection.Children); Ptr : Result_Collection_Access := null; begin loop exit when not Is_Valid (Position); Ptr := Data (Position).Ptr; Release (Ptr.all); Free (Ptr); Position := Next (Position); end loop; Clear (Collection.Children); -- No need to call Free for these three since -- they are stored as plain objects instead of pointers. Clear (Collection.Errors); Clear (Collection.Failures); Clear (Collection.Passes); end Release; procedure Set_Name (Collection : in out Result_Collection; Name : Bounded_String) is begin Collection.Test_Name := Name; end Set_Name; procedure Set_Parent (Collection : in out Result_Collection; Parent : Result_Collection_Access) is begin Collection.Parent := Parent; end Set_Parent; function Test_Count (Collection : Result_Collection) return Test_Count_Type is Count : Test_Count_Type := Result_Info_List.Length (Collection.Errors) + Result_Info_List.Length (Collection.Failures) + Result_Info_List.Length (Collection.Skips) + Result_Info_List.Length (Collection.Passes); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Test_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Test_Count; function Direct_Test_Count (Collection : Result_Collection) return Test_Count_Type is begin return Length (Collection.Errors) + Length (Collection.Failures) + Length (Collection.Passes); end Direct_Test_Count; function Pass_Count (Collection : Result_Collection) return Test_Count_Type is Count : Test_Count_Type := Length (Collection.Passes); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Pass_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Pass_Count; function Error_Count (Collection : Result_Collection) return Test_Count_Type is Count : Test_Count_Type := Length (Collection.Errors); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Error_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Error_Count; function Failure_Count (Collection : Result_Collection) return Test_Count_Type is Count : Test_Count_Type := Length (Collection.Failures); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Failure_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Failure_Count; function Skipped_Count (Collection : Result_Collection) return Test_Count_Type is Count : Test_Count_Type := Length (Collection.Skips); Position : Result_List.Cursor := First (Collection.Children); begin loop exit when not Is_Valid (Position); Count := Count + Skipped_Count (Data (Position).Ptr.all); Position := Next (Position); end loop; return Count; end Skipped_Count; function Get_Test_Name (Collection : Result_Collection) return Bounded_String is begin return Collection.Test_Name; end Get_Test_Name; function Get_Parent (Collection : Result_Collection) return Result_Collection_Access is begin return Collection.Parent; end Get_Parent; function Get_Execution_Time (Collection : Result_Collection) return Duration is Position : Result_Info_List.Cursor; Total_Time : Duration := 0.0; Child_Position : Result_List.Cursor; begin Position := First (Collection.Passes); Pass_Loop: loop exit Pass_Loop when not Is_Valid (Position); Total_Time := Total_Time + Get_Execution_Time (Data (Position)); Position := Next (Position); end loop Pass_Loop; Position := First (Collection.Failures); Failure_Loop: loop exit Failure_Loop when not Is_Valid (Position); Total_Time := Total_Time + Get_Execution_Time (Data (Position)); Position := Next (Position); end loop Failure_Loop; Position := First (Collection.Errors); Error_Loop: loop exit Error_Loop when not Is_Valid (Position); Total_Time := Total_Time + Get_Execution_Time (Data (Position)); Position := Next (Position); end loop Error_Loop; Child_Loop: loop exit Child_Loop when not Result_List.Is_Valid (Child_Position); Total_Time := Total_Time + Get_Execution_Time (Result_List.Data (Child_Position).Ptr.all); Child_Position := Result_List.Next (Child_Position); end loop Child_Loop; return Total_Time; end Get_Execution_Time; function First_Pass (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Passes); end First_Pass; function First_Failure (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Failures); end First_Failure; function First_Skipped (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Skips); end First_Skipped; function First_Error (Collection : Result_Collection) return Result_Info_Cursor is begin return First (Collection.Errors); end First_Error; function Next (Position : Result_Info_Cursor) return Result_Info_Cursor is begin return Result_Info_Cursor (Result_Info_List.Next (Result_Info_List.Cursor (Position))); end Next; function Data (Position : Result_Info_Cursor) return Result_Info is begin return Result_Info_List.Data (Result_Info_List.Cursor (Position)); end Data; function Is_Valid (Position : Result_Info_Cursor) return Boolean is begin return Result_Info_List.Is_Valid (Result_Info_List.Cursor (Position)); end Is_Valid; function First_Child (Collection : in Result_Collection) return Result_Collection_Cursor is begin return First (Collection.Children); end First_Child; function Next (Position : Result_Collection_Cursor) return Result_Collection_Cursor is begin return Result_Collection_Cursor (Result_List.Next (Result_List.Cursor (Position))); end Next; function Is_Valid (Position : Result_Collection_Cursor) return Boolean is begin return Result_List.Is_Valid (Result_List.Cursor (Position)); end Is_Valid; function Data (Position : Result_Collection_Cursor) return Result_Collection_Access is begin return Result_List.Data (Result_List.Cursor (Position)).Ptr; end Data; function Child_Depth (Collection : Result_Collection) return Natural is function Child_Depth_Impl (Coll : Result_Collection; Level : Natural) return Natural; function Child_Depth_Impl (Coll : Result_Collection; Level : Natural) return Natural is Max : Natural := 0; Current : Natural := 0; Position : Result_List.Cursor := Result_List.First (Coll.Children); begin loop exit when not Is_Valid (Position); Current := Child_Depth_Impl (Data (Position).Ptr.all, Level + 1); if Max < Current then Max := Current; end if; Position := Result_List.Next (Position); end loop; return Level + Max; end Child_Depth_Impl; begin return Child_Depth_Impl (Collection, 0); end Child_Depth; end Ahven.Results; ahven-2.7/src/ahven-results.ads0000644000000000000000000002460613325517624014711 0ustar 00000000000000-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.SList; with Ahven.AStrings; with Ahven.Long_AStrings; pragma Elaborate_All (Ahven.SList); -- Like the name implies, the Results package is used for -- storing the test results. -- -- Result_Info holds one invidual result and -- Result_Collection holds multiple Result_Infos. -- package Ahven.Results is use Ahven.AStrings; type Result_Info is private; Empty_Result_Info : constant Result_Info; -- Result_Info object which holds no result. It can be used -- to initialize a new Result_Info object. procedure Set_Test_Name (Info : in out Result_Info; Name : Bounded_String); -- Set a test name for the result. procedure Set_Routine_Name (Info : in out Result_Info; Name : Bounded_String); -- Set a routine name for the result. procedure Set_Message (Info : in out Result_Info; Message : Bounded_String); -- Set a message for the result. procedure Set_Test_Name (Info : in out Result_Info; Name : String); -- A helper function, which calls Set_Test_Name (.. ; Bounded_String) procedure Set_Routine_Name (Info : in out Result_Info; Name : String); -- A helper function, which calls Set_Routine_Name (.. ; Bounded_String) procedure Set_Message (Info : in out Result_Info; Message : String); -- A helper function, which calls Set_Message (.. ; Bounded_String) procedure Set_Long_Message (Info : in out Result_Info; Message : Bounded_String); -- Set a long message for the result procedure Set_Long_Message (Info : in out Result_Info; Message : Long_AStrings.Long_String); -- Set a long message for the result procedure Set_Long_Message (Info : in out Result_Info; Message : String); -- A helper function, which calls Set_Long_Message (.. ; Bounded_String) procedure Set_Execution_Time (Info : in out Result_Info; Elapsed_Time : Duration); -- Set the execution time of the result info (test). procedure Set_Output_File (Info : in out Result_Info; Filename : Bounded_String); -- Set the name of the test output file. procedure Set_Output_File (Info : in out Result_Info; Filename : String); -- Set the name of the test output file. function Get_Test_Name (Info : Result_Info) return String; -- Return the test name of the result info. function Get_Routine_Name (Info : Result_Info) return String; -- Return the routine name of the result info. function Get_Message (Info : Result_Info) return String; -- Return the message of the result info. function Get_Long_Message (Info : Result_Info) return String; -- Return the long message of the result info. function Get_Execution_Time (Info : Result_Info) return Duration; -- Return the execution time of the result info. function Get_Output_File (Info : Result_Info) return Bounded_String; -- Return the name of the output file. -- Empty string is returned in case there is no output file. type Result_Collection is limited private; -- A collection of Result_Info objects. -- Contains also child collections. type Result_Collection_Access is access Result_Collection; procedure Add_Child (Collection : in out Result_Collection; Child : Result_Collection_Access); -- Add a child collection to the collection. procedure Add_Error (Collection : in out Result_Collection; Info : Result_Info); -- Add a test error to the collection. procedure Add_Skipped (Collection : in out Result_Collection; Info : Result_Info); -- Add a skipped test to the collection. procedure Add_Failure (Collection : in out Result_Collection; Info : Result_Info); -- Add a test failure to the collection. procedure Add_Pass (Collection : in out Result_Collection; Info : Result_Info); -- Add a passed test to the collection procedure Release (Collection : in out Result_Collection); -- Release resourced held by the collection. -- Frees also all children added via Add_Child. procedure Set_Name (Collection : in out Result_Collection; Name : Bounded_String); -- Set a test name for the collection. procedure Set_Parent (Collection : in out Result_Collection; Parent : Result_Collection_Access); -- Set a parent collection to the collection. function Test_Count (Collection : Result_Collection) return Test_Count_Type; -- Return the amount of tests in the collection. -- Tests in child collections are included. function Direct_Test_Count (Collection : Result_Collection) return Test_Count_Type; -- Return the amount of tests in the collection. -- The tests in the child collections are NOT included. function Pass_Count (Collection : Result_Collection) return Test_Count_Type; -- Return the amount of passed tests in the collection. -- Tests in child collections are included. function Error_Count (Collection : Result_Collection) return Test_Count_Type; -- Return the amount of test errors in the collection. -- Tests in child collections are included. function Failure_Count (Collection : Result_Collection) return Test_Count_Type; -- Return the amount of test errors in the collection. -- Tests in child collections are included. function Skipped_Count (Collection : Result_Collection) return Test_Count_Type; -- Return the amount of skipped tests in the colleciton. -- Tests in child collections are included. function Get_Test_Name (Collection : Result_Collection) return Bounded_String; -- Return the name of the collection's test. function Get_Parent (Collection : Result_Collection) return Result_Collection_Access; -- Return the parent of the collection. function Get_Execution_Time (Collection : Result_Collection) return Duration; -- Return the execution time of the whole collection. type Result_Info_Cursor is private; -- A cursor type for Pass, Failure and Error results. function First_Pass (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first pass from the collection. function First_Failure (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first failure from the collection. function First_Skipped (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first skipped test from the collection. function First_Error (Collection : Result_Collection) return Result_Info_Cursor; -- Get the first error from the collection. function Next (Position : Result_Info_Cursor) return Result_Info_Cursor; -- Get the next pass/failure/error. function Data (Position : Result_Info_Cursor) return Result_Info; -- Get the data behind the cursor. function Is_Valid (Position : Result_Info_Cursor) return Boolean; -- Is the cursor still valid? type Result_Collection_Cursor is private; -- Cursor for iterating over a set of Result_Collection access objects. function First_Child (Collection : in Result_Collection) return Result_Collection_Cursor; -- Get the first child of the collection. function Next (Position : Result_Collection_Cursor) return Result_Collection_Cursor; -- Get the next child. function Is_Valid (Position : Result_Collection_Cursor) return Boolean; -- Is the cursor still valid? function Data (Position : Result_Collection_Cursor) return Result_Collection_Access; -- Get the data (Result_Collection_Access) behind the cursor. function Child_Depth (Collection : Result_Collection) return Natural; -- Return the maximum depth of children. (a child of a child, etc.) -- -- Examples: Child_Depth is 0 for a collection without children. -- Collection with a child containing another child has a depth of 2. private type Result_Info is record Test_Name : Bounded_String := Null_Bounded_String; Output_File : Bounded_String := Null_Bounded_String; Routine_Name : Bounded_String := Null_Bounded_String; Execution_Time : Duration := 0.0; Message : Bounded_String := Null_Bounded_String; Long_Message : Long_AStrings.Long_String := Long_AStrings.Null_Long_String; end record; Empty_Result_Info : constant Result_Info := (Test_Name => Null_Bounded_String, Routine_Name => Null_Bounded_String, Message => Null_Bounded_String, Long_Message => Long_AStrings.Null_Long_String, Execution_Time => 0.0, Output_File => Null_Bounded_String); package Result_Info_List is new Ahven.SList (Element_Type => Result_Info); type Result_Collection_Wrapper is record Ptr : Result_Collection_Access; end record; -- Work around for Janus/Ada 3.1.1d/3.1.2beta generic bug. package Result_List is new Ahven.SList (Element_Type => Result_Collection_Wrapper); type Result_Info_Cursor is new Result_Info_List.Cursor; type Result_Collection_Cursor is new Result_List.Cursor; type Result_Collection is limited record Test_Name : Bounded_String := Null_Bounded_String; Passes : Result_Info_List.List; Failures : Result_Info_List.List; Errors : Result_Info_List.List; Skips : Result_Info_List.List; Children : Result_List.List; Parent : Result_Collection_Access := null; end record; end Ahven.Results; ahven-2.7/src/ahven-runner.adb0000644000000000000000000000452113325517624014472 0ustar 00000000000000-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Command_Line; with Ahven.Name_List; with Ahven.Listeners; with Ahven.Listeners.Basic; package body Ahven.Runner is use Ahven.Results; procedure Run_Suite (Suite : in out Framework.Test'Class; Reporter : Report_Proc) is use Ahven.Listeners.Basic; Listener : Listeners.Basic.Basic_Listener; Params : Parameters.Parameter_Info; Tests : Name_List.List; begin Parameters.Parse_Parameters (Parameters.NORMAL_PARAMETERS, Params); Set_Output_Capture (Listener, Parameters.Capture (Params)); -- Execute only tests which match to the given name. -- -- Single_Test procedure is somewhat misleading since we -- can actually execute more than one test if there are multiple -- matching names or if a whole test suite or a test case -- matches the given name. if Parameters.Single_Test (Params) then Tests := Parameters.Test_Names (Params); Framework.Execute (T => Suite, Test_Names => Tests, Listener => Listener, Timeout => Parameters.Timeout (Params)); else Framework.Execute (Suite, Listener, Parameters.Timeout (Params)); end if; Reporter (Listener.Main_Result, Params); if (Error_Count (Listener.Main_Result) > 0) or (Failure_Count (Listener.Main_Result) > 0) then Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); end if; exception when Parameters.Invalid_Parameter => Parameters.Usage; end Run_Suite; end Ahven.Runner; ahven-2.7/src/ahven-runner.ads0000644000000000000000000000242013325517624014507 0ustar 00000000000000-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Results; with Ahven.Parameters; package Ahven.Runner is type Report_Proc is access procedure (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); procedure Run_Suite (Suite : in out Framework.Test'Class; Reporter : Report_Proc); -- Run the given test (case/suite) and pass the results and -- the command line argument info to the reporter procedure. end Ahven.Runner; ahven-2.7/src/ahven-slist.adb0000644000000000000000000000772113325517624014324 0ustar 00000000000000-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Unchecked_Deallocation; package body Ahven.SList is procedure Remove (Ptr : Node_Access) is procedure Free is new Ada.Unchecked_Deallocation (Object => Node, Name => Node_Access); My_Ptr : Node_Access := Ptr; begin Ptr.Next := null; Free (My_Ptr); end Remove; procedure Append (Target : in out List; Node_Data : Element_Type) is New_Node : Node_Access := null; begin if Target.Size = Count_Type'Last then raise List_Full; end if; New_Node := new Node'(Data => Node_Data, Next => null); if Target.Last = null then Target.First := New_Node; else Target.Last.Next := New_Node; end if; Target.Last := New_Node; Target.Size := Target.Size + 1; end Append; procedure Clear (Target : in out List) is Current_Node : Node_Access := Target.First; Next_Node : Node_Access := null; begin while Current_Node /= null loop Next_Node := Current_Node.Next; Remove (Current_Node); Current_Node := Next_Node; end loop; Target.First := null; Target.Last := null; Target.Size := 0; end Clear; function First (Target : List) return Cursor is begin return Cursor (Target.First); end First; function Next (Position : Cursor) return Cursor is begin if Position = null then raise Invalid_Cursor; end if; return Cursor (Position.Next); end Next; function Data (Position : Cursor) return Element_Type is begin if Position = null then raise Invalid_Cursor; end if; return Position.Data; end Data; function Is_Valid (Position : Cursor) return Boolean is begin return Position /= null; end Is_Valid; function Length (Target : List) return Count_Type is begin return Target.Size; end Length; procedure For_Each (Target : List) is Current_Node : Node_Access := Target.First; begin while Current_Node /= null loop Action (Current_Node.Data); Current_Node := Current_Node.Next; end loop; end For_Each; procedure Initialize (Target : in out List) is begin Target.Last := null; Target.First := null; Target.Size := 0; end Initialize; procedure Finalize (Target : in out List) is begin Clear (Target); end Finalize; procedure Adjust (Target : in out List) is Target_Last : Node_Access := null; Target_First : Node_Access := null; Current : Node_Access := Target.First; New_Node : Node_Access; begin -- Recreate the list using the same data while Current /= null loop New_Node := new Node'(Data => Current.Data, Next => null); if Target_Last = null then Target_First := New_Node; else Target_Last.Next := New_Node; end if; Target_Last := New_Node; Current := Current.Next; end loop; Target.First := Target_First; Target.Last := Target_Last; -- No need to adjust size, it is same as before copying end Adjust; end Ahven.SList; ahven-2.7/src/ahven-slist.ads0000644000000000000000000000605613325517624014345 0ustar 00000000000000-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Finalization; generic type Element_Type is private; package Ahven.SList is type List is new Ada.Finalization.Controlled with private; type Cursor is private; subtype Count_Type is Long_Integer'Base range 0 .. Count_Max; Invalid_Cursor : exception; List_Full : exception; -- Thrown when the size of the list exceeds Count_Type'Last. Empty_List : constant List; procedure Append (Target : in out List; Node_Data : Element_Type); -- Append an element at the end of the list. -- -- Raises List_Full if the list has already Count_Type'Last items. procedure Clear (Target : in out List); -- Remove all elements from the list. function First (Target : List) return Cursor; -- Return a cursor to the first element of the list. function Next (Position : Cursor) return Cursor; -- Move the cursor to point to the next element on the list. function Data (Position : Cursor) return Element_Type; -- Return element pointed by the cursor. function Is_Valid (Position : Cursor) return Boolean; -- Tell the validity of the cursor. The cursor -- will become invalid when you iterate it over -- the last item. function Length (Target : List) return Count_Type; -- Return the length of the list. generic with procedure Action (T : in out Element_Type) is <>; procedure For_Each (Target : List); -- A generic procedure for walk through every item -- in the list and call Action procedure for them. private type Node; type Node_Access is access Node; type Cursor is new Node_Access; procedure Remove (Ptr : Node_Access); -- A procedure to release memory pointed by Ptr. type Node is record Next : Node_Access := null; Data : Element_Type; end record; type List is new Ada.Finalization.Controlled with record First : Node_Access := null; Last : Node_Access := null; Size : Count_Type := 0; end record; procedure Initialize (Target : in out List); procedure Finalize (Target : in out List); procedure Adjust (Target : in out List); Empty_List : constant List := (Ada.Finalization.Controlled with First => null, Last => null, Size => 0); end Ahven.SList; ahven-2.7/src/ahven-tap_runner.adb0000644000000000000000000001625713325517624015347 0ustar 00000000000000-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; with Ada.Strings.Fixed; with Ada.Characters.Latin_1; with Ahven.Name_List; with Ahven.Parameters; with Ahven.AStrings; with Ahven.Long_AStrings; package body Ahven.Tap_Runner is use Ada.Text_IO; use Ahven.Framework; use Ahven.AStrings; function Count_Image (Count : Test_Count_Type) return String is use Ada.Strings; begin return Fixed.Trim (Test_Count_Type'Image (Count), Both); end Count_Image; procedure Print_Data (Message : String; Prefix : String) is Start_Of_Line : Boolean := True; begin for I in Message'Range loop if Start_Of_Line then Put (Prefix); Start_Of_Line := False; end if; if Message (I) = Ada.Characters.Latin_1.LF then New_Line; Start_Of_Line := True; elsif Message (I) /= Ada.Characters.Latin_1.CR then Put (Message (I)); end if; end loop; if not Start_Of_Line then New_Line; end if; end Print_Data; procedure Run (Suite : in out Framework.Test'Class) is Listener : Tap_Listener; Params : Parameters.Parameter_Info; Tests : Name_List.List; begin Parameters.Parse_Parameters (Parameters.TAP_PARAMETERS, Params); Listener.Verbose := Parameters.Verbose (Params); Listener.Capture_Output := Parameters.Capture (Params); if Parameters.Single_Test (Params) then Tests := Parameters.Test_Names (Params); Put_Line ("1.." & Count_Image (Test_Count (Suite, Tests))); Framework.Execute (T => Suite, Test_Names => Tests, Listener => Listener, Timeout => Parameters.Timeout (Params)); else Put_Line ("1.." & Count_Image (Test_Count (Suite))); Framework.Execute (Suite, Listener, Parameters.Timeout (Params)); end if; exception when Parameters.Invalid_Parameter => Parameters.Usage (Parameters.TAP_PARAMETERS); end Run; procedure Print_Info (Info : Context) is begin if Length (Info.Message) > 0 then Print_Data (Message => To_String (Info.Message), Prefix => "# "); end if; if Long_AStrings.Length (Info.Long_Message) > 0 then Print_Data (Message => Long_AStrings.To_String (Info.Long_Message), Prefix => "# "); end if; end Print_Info; procedure Print_Log_File (Filename : String; Prefix : String) is Handle : File_Type; Char : Character := ' '; First : Boolean := True; Start_Of_Line : Boolean := True; begin Open (Handle, In_File, Filename); loop exit when End_Of_File (Handle); Get (Handle, Char); if First then Put_Line (Prefix & "===== Output ======="); First := False; end if; if Start_Of_Line then Put (Prefix); Start_Of_Line := False; end if; Put (Char); if End_Of_Line (Handle) then New_Line; Start_Of_Line := True; end if; end loop; Close (Handle); if not First then Put_Line (Prefix & "===================="); end if; exception when Name_Error => -- Missing output file is ok. Put_Line (Prefix & "no output"); end Print_Log_File; procedure Add_Pass (Listener : in out Tap_Listener; Info : Context) is begin if Listener.Capture_Output then Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); end if; Put ("ok "); Put (Count_Image (Listener.Current_Test) & " "); Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name)); New_Line; end Add_Pass; procedure Report_Not_Ok (Listener : in out Tap_Listener; Info : Context; Severity : String) is begin if Listener.Capture_Output then Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); end if; Put ("not ok "); Put (Count_Image (Listener.Current_Test) & " "); Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name)); New_Line; if Listener.Verbose then Print_Info (Info); if Listener.Capture_Output then Print_Log_File (Filename => Temporary_Output.Get_Name (Listener.Output_File), Prefix => "# "); end if; end if; end Report_Not_Ok; procedure Add_Failure (Listener : in out Tap_Listener; Info : Context) is begin Report_Not_Ok (Listener, Info, "fail"); end Add_Failure; procedure Add_Error (Listener : in out Tap_Listener; Info : Context) is begin Report_Not_Ok (Listener, Info, "error"); end Add_Error; procedure Add_Skipped (Listener : in out Tap_Listener; Info : Context) is begin if Listener.Capture_Output then Temporary_Output.Restore_Output; Temporary_Output.Close_Temp (Listener.Output_File); end if; Put ("ok "); Put (Count_Image (Listener.Current_Test) & " "); Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name)); Put (" # SKIP " & To_String (Info.Message)); New_Line; end Add_Skipped; procedure Start_Test (Listener : in out Tap_Listener; Info : Context) is begin if Info.Test_Kind = ROUTINE then Listener.Current_Test := Listener.Current_Test + 1; if Listener.Capture_Output then Temporary_Output.Create_Temp (Listener.Output_File); Temporary_Output.Redirect_Output (Listener.Output_File); end if; end if; end Start_Test; procedure End_Test (Listener : in out Tap_Listener; Info : Context) is Handle : Ada.Text_IO.File_Type; begin if Listener.Capture_Output then Ada.Text_IO.Open (Handle, Ada.Text_IO.Out_File, Temporary_Output.Get_Name (Listener.Output_File)); Ada.Text_IO.Delete (Handle); end if; exception when Name_Error => -- Missing file is safe to ignore, we are going to delete it anyway null; end End_Test; end Ahven.Tap_Runner; ahven-2.7/src/ahven-tap_runner.ads0000644000000000000000000000404313325517624015356 0ustar 00000000000000-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Listeners; with Ahven.Temporary_Output; package Ahven.Tap_Runner is use Ahven.Listeners; procedure Run (Suite : in out Framework.Test'Class); -- Run the suite and print the results. private type Tap_Result_Type is (OK_RESULT, NOT_OK_RESULT); type Tap_Listener is new Ahven.Listeners.Result_Listener with record Result : Tap_Result_Type := NOT_OK_RESULT; Current_Test : Ahven.Test_Count_Type := 0; Verbose : Boolean := True; Output_File : Temporary_Output.Temporary_File; Capture_Output : Boolean := False; end record; procedure Add_Pass (Listener : in out Tap_Listener; Info : Context); procedure Add_Failure (Listener : in out Tap_Listener; Info : Context); procedure Add_Error (Listener : in out Tap_Listener; Info : Context); procedure Add_Skipped (Listener : in out Tap_Listener; Info : Context); procedure Start_Test (Listener : in out Tap_Listener; Info : Context); procedure End_Test (Listener : in out Tap_Listener; Info : Context); end Ahven.Tap_Runner; ahven-2.7/src/ahven-temporary_output.adb0000644000000000000000000000453413325517624016627 0ustar 00000000000000-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Strings.Fixed; package body Ahven.Temporary_Output is use Ahven.AStrings; use Ada.Strings.Fixed; subtype Temp_Counter_Type is Long_Integer; Temp_Counter : Temp_Counter_Type := 0; procedure Create_Temp (File : out Temporary_File) is Filename : constant String := "ahven_temp_" & Trim (Long_Integer'Image (Temp_Counter), Ada.Strings.Both); begin if Temp_Counter < Temp_Counter_Type'Last then Temp_Counter := Temp_Counter + 1; else raise Temporary_File_Error; end if; File.Name := To_Bounded_String (Filename); Ada.Text_IO.Create (File.Handle, Ada.Text_IO.Out_File, Filename); end Create_Temp; function Get_Name (File : Temporary_File) return String is begin return To_String (File.Name); end Get_Name; procedure Redirect_Output (To_File : in out Temporary_File) is begin Ada.Text_IO.Flush; Ada.Text_IO.Set_Output (To_File.Handle); end Redirect_Output; procedure Restore_Output is begin Ada.Text_IO.Flush; Ada.Text_IO.Set_Output (Ada.Text_IO.Standard_Output); end Restore_Output; procedure Remove_Temp (File : in out Temporary_File) is begin if not Ada.Text_IO.Is_Open (File.Handle) then Ada.Text_IO.Open (File.Handle, Ada.Text_IO.Out_File, To_String (File.Name)); end if; Ada.Text_IO.Delete (File.Handle); end Remove_Temp; procedure Close_Temp (File : in out Temporary_File) is begin Ada.Text_IO.Close (File.Handle); end Close_Temp; end Ahven.Temporary_Output; ahven-2.7/src/ahven-temporary_output.ads0000644000000000000000000000356613325517624016654 0ustar 00000000000000-- -- Copyright (c) 2007, 2008, 2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.AStrings; with Ada.Text_IO; package Ahven.Temporary_Output is Temporary_File_Error : exception; type Temporary_File is limited private; procedure Create_Temp (File : out Temporary_File); -- Create a new temporary file. Exception Temporary_File_Error -- is raised if the procedure cannot create a new temp file. function Get_Name (File : Temporary_File) return String; -- Return the name of the file. procedure Redirect_Output (To_File : in out Temporary_File); -- Redirect the standard output to the file. -- To_File must be opened using Create_Temp. procedure Restore_Output; -- Restore the standard output to its default settings. procedure Remove_Temp (File : in out Temporary_File); -- Remove the temporary file. File can be either open or closed. procedure Close_Temp (File : in out Temporary_File); -- Close the temporary file. File needs to be opened first. private type Temporary_File is limited record Name : AStrings.Bounded_String; Handle : Ada.Text_IO.File_Type; end record; end Ahven.Temporary_Output; ahven-2.7/src/ahven-text_runner.adb0000644000000000000000000002515613325517624015545 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Text_IO; with Ada.Strings.Fixed; with Ada.Characters.Latin_1; with Ahven.Runner; with Ahven.XML_Runner; with Ahven.AStrings; use Ada.Text_IO; use Ada.Strings.Fixed; package body Ahven.Text_Runner is use Ahven.Results; use Ahven.Framework; use Ahven.AStrings; -- Local procedures procedure Pad (Level : Natural); procedure Print_Test (Info : Result_Info; Level : Natural; Result : String); procedure Print_Failures (Result : Result_Collection; Level : Natural); procedure Print_Skips (Result : Result_Collection; Level : Natural); procedure Print_Errors (Result : Result_Collection; Level : Natural); procedure Print_Passes (Result : Result_Collection; Level : Natural); procedure Report_Results (Result : Result_Collection; Verbose : Boolean := False); procedure Print_Log_File (Filename : String); procedure Pad (Level : Natural) is begin for A in Integer range 1 .. Level loop Put (" "); end loop; end Pad; procedure Pad (Amount : in Natural; Total : in out Natural) is begin for A in Natural range 1 .. Amount loop Put (" "); end loop; Total := Total + Amount; end Pad; procedure Multiline_Pad (Input : String; Level : Natural) is begin Pad (Level); for A in Input'Range loop Put (Input (A)); if (Input (A) = Ada.Characters.Latin_1.LF) and (A /= Input'Last) then Pad (Level); end if; end loop; end Multiline_Pad; procedure Print_Test (Info : Result_Info; Level : Natural; Result : String) is use Ada.Strings; Max_Output_Width : constant := 50; Max_Result_Width : constant := 7; Max_Time_Out_Width : constant := 12; subtype Result_Size is Integer range 1 .. Max_Result_Width; subtype Time_Out_Size is Integer range 1 .. Max_Time_Out_Width; procedure Print_Text (Str : String; Total : in out Natural) is begin Put (Str); Total := Total + Str'Length; end Print_Text; Msg : constant String := Get_Message (Info); Result_Out : String (Result_Size) := (others => ' '); Time_Out : String (Time_Out_Size) := (others => ' '); Total_Text : Natural := 0; begin Pad (Level + 1, Total_Text); Print_Text (Get_Routine_Name (Info), Total_Text); if Msg'Length > 0 then Print_Text (" - ", Total_Text); Print_Text (Msg, Total_Text); end if; if Total_Text < Max_Output_Width then Pad (Max_Output_Width - Total_Text, Total_Text); end if; -- If we know the name of the routine, we print it, -- the result, and the execution time. if Get_Routine_Name (Info)'Length > 0 then Move (Source => Result, Target => Result_Out, Drop => Right, Justify => Left, Pad => ' '); Move (Source => Duration'Image (Get_Execution_Time (Info)), Target => Time_Out, Drop => Right, Justify => Right, Pad => ' '); Put (" " & Result_Out); Put (" " & Time_Out & "s"); end if; if Get_Long_Message (Info)'Length > 0 then New_Line; Multiline_Pad (Get_Long_Message (Info), Level + 2); end if; New_Line; end Print_Test; type Print_Child_Proc is access procedure (Result : Result_Collection; Level : Natural); type Child_Count_Proc is access function (Result : Result_Collection) return Test_Count_Type; procedure Print_Children (Result : Result_Collection; Level : Natural; Action : Print_Child_Proc; Count : Child_Count_Proc) is Child_Iter : Result_Collection_Cursor := First_Child (Result); begin loop exit when not Is_Valid (Child_Iter); if Count.all (Data (Child_Iter).all) > 0 then Action.all (Data (Child_Iter).all, Level + 1); end if; Child_Iter := Next (Child_Iter); end loop; end Print_Children; procedure Print_Statuses (Result : Result_Collection; Level : Natural; Start : Result_Info_Cursor; Action : Print_Child_Proc; Status : String; Count : Child_Count_Proc; Print_Log : Boolean) is Position : Result_Info_Cursor := Start; begin if Length (Get_Test_Name (Result)) > 0 then Pad (Level); Put_Line (To_String (Get_Test_Name (Result)) & ":"); end if; Test_Loop: loop exit Test_Loop when not Is_Valid (Position); Print_Test (Data (Position), Level, Status); if Print_Log and (Length (Get_Output_File (Data (Position))) > 0) then Print_Log_File (To_String (Get_Output_File (Data (Position)))); end if; Position := Next (Position); end loop Test_Loop; Print_Children (Result => Result, Level => Level, Action => Action, Count => Count); end Print_Statuses; -- -- Print all failures from the result collection -- and then recurse into child collections. -- procedure Print_Failures (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Failure (Result), Action => Print_Failures'Access, Status => "FAIL", Count => Failure_Count'Access, Print_Log => True); end Print_Failures; -- -- Print all skips from the result collection -- and then recurse into child collections. -- procedure Print_Skips (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Skipped (Result), Action => Print_Skips'Access, Status => "SKIPPED", Count => Skipped_Count'Access, Print_Log => True); end Print_Skips; -- -- Print all errors from the result collection -- and then recurse into child collections. -- procedure Print_Errors (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Error (Result), Action => Print_Errors'Access, Status => "ERROR", Count => Error_Count'Access, Print_Log => True); end Print_Errors; -- -- Print all passes from the result collection -- and then recurse into child collections. -- procedure Print_Passes (Result : Result_Collection; Level : Natural) is begin Print_Statuses (Result => Result, Level => Level, Start => First_Pass (Result), Action => Print_Passes'Access, Status => "PASS", Count => Pass_Count'Access, Print_Log => False); end Print_Passes; -- -- Report passes, skips, failures, and errors from the result collection. procedure Report_Results (Result : Result_Collection; Verbose : Boolean := False) is begin Put_Line ("Passed : " & Test_Count_Type'Image (Pass_Count (Result))); if Verbose then Print_Passes (Result => Result, Level => 0); end if; New_Line; if Skipped_Count (Result) > 0 then Put_Line ("Skipped : " & Test_Count_Type'Image (Skipped_Count (Result))); Print_Skips (Result => Result, Level => 0); New_Line; end if; if Failure_Count (Result) > 0 then Put_Line ("Failed : " & Test_Count_Type'Image (Failure_Count (Result))); Print_Failures (Result => Result, Level => 0); New_Line; end if; if Error_Count (Result) > 0 then Put_Line ("Errors : " & Test_Count_Type'Image (Error_Count (Result))); Print_Errors (Result => Result, Level => 0); end if; end Report_Results; procedure Print_Log_File (Filename : String) is Handle : File_Type; Char : Character := ' '; First : Boolean := True; begin Open (Handle, In_File, Filename); loop exit when End_Of_File (Handle); Get (Handle, Char); if First then Put_Line ("===== Output ======="); First := False; end if; Put (Char); if End_Of_Line (Handle) then New_Line; end if; end loop; Close (Handle); if not First then Put_Line ("===================="); end if; end Print_Log_File; procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info) is begin if Parameters.XML_Results (Args) then XML_Runner.Report_Results (Test_Results, Parameters.Result_Dir (Args), Parameters.Test_Class_Suffix (Args)); else Report_Results (Test_Results, Parameters.Verbose (Args)); end if; end Do_Report; procedure Run (Suite : in out Framework.Test'Class) is begin Runner.Run_Suite (Suite, Do_Report'Access); end Run; procedure Run (Suite : Framework.Test_Suite_Access) is begin Run (Suite.all); end Run; end Ahven.Text_Runner; ahven-2.7/src/ahven-text_runner.ads0000644000000000000000000000254113325517624015557 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Results; with Ahven.Parameters; pragma Elaborate_All (Ahven.Framework); pragma Elaborate_All (Ahven.Results); pragma Elaborate_All (Ahven.Parameters); package Ahven.Text_Runner is procedure Run (Suite : in out Framework.Test'Class); -- Run the suite and print the results. procedure Run (Suite : Framework.Test_Suite_Access); -- Run the suite and print the results. private procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); end Ahven.Text_Runner; ahven-2.7/src/ahven-xml_runner.adb0000644000000000000000000003732113325517624015356 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Characters.Latin_1; with Ada.Text_IO; with Ada.Strings; with Ada.Strings.Fixed; with Ada.Strings.Maps; with Ahven.Runner; with Ahven_Compat; with Ahven.AStrings; package body Ahven.XML_Runner is use Ada.Text_IO; use Ada.Strings.Fixed; use Ada.Strings.Maps; use Ahven.Results; use Ahven.Framework; use Ahven.AStrings; function Filter_String (Str : String) return String; function Filter_String (Str : String; Map : Character_Mapping) return String; procedure Print_Test_Pass (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String); procedure Print_Test_Failure (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String); procedure Print_Test_Error (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String); procedure Print_Test_Case (Collection : Result_Collection; Dir : String; Test_Suffix : String); procedure Print_Log_File (File : File_Type; Filename : String); procedure Print_Attribute (File : File_Type; Attr : String; Value : String); procedure Start_Testcase_Tag (File : File_Type; Parent : String; Name : String; Execution_Time : String; Test_Suffix : String); procedure End_Testcase_Tag (File : File_Type); function Create_Name (Dir : String; Name : String) return String; function Filter_String (Str : String) return String is use Ada.Characters; Result : String (Str'Range); begin for I in Str'Range loop if (Str (I) = ''') or (Str (I) < Latin_1.Space) then Result (I) := '_'; else Result (I) := Str (I); end if; end loop; return Result; end Filter_String; function Filter_String (Str : String; Map : Character_Mapping) return String is begin return Translate (Source => Str, Mapping => Map); end Filter_String; procedure Print_Attribute (File : File_Type; Attr : String; Value : String) is use Ada.Characters; Map : Ada.Strings.Maps.Character_Mapping; begin Map := To_Mapping (From => " '/\<>" & '"' & Latin_1.CR & Latin_1.LF, To => "______" & "___"); Put (File, Attr & "=" & '"' & Filter_String (Value, Map) & '"'); end Print_Attribute; procedure Start_Testcase_Tag (File : File_Type; Parent : String; Name : String; Execution_Time : String; Test_Suffix : String) is begin Put (File, ""); end Start_Testcase_Tag; procedure End_Testcase_Tag (File : File_Type) is begin Put_Line (File, ""); end End_Testcase_Tag; function Create_Name (Dir : String; Name : String) return String is use Ada.Characters; function Filename (Test : String) return String is Map : Ada.Strings.Maps.Character_Mapping; begin Map := To_Mapping (From => " '/\<>:|?*()" & '"' & Latin_1.CR & Latin_1.LF, To => "-___________" & "___"); return "TEST-" & Filter_String (Test, Map) & ".xml"; end Filename; begin if Dir'Length > 0 then return Dir & Ahven_Compat.Directory_Separator & Filename (Name); else return Filename (Name); end if; end Create_Name; procedure Print_Test_Pass (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String) is Exec_Time : constant String := Trim (Duration'Image (Get_Execution_Time (Info)), Ada.Strings.Both); begin Start_Testcase_Tag (File => File, Parent => Parent_Test, Name => Get_Routine_Name (Info), Execution_Time => Exec_Time, Test_Suffix => Test_Suffix); if Length (Get_Output_File (Info)) > 0 then Put (File, ""); Print_Log_File (File, To_String (Get_Output_File (Info))); Put_Line (File, ""); end if; End_Testcase_Tag (File); end Print_Test_Pass; procedure Print_Test_Skipped (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String) is Exec_Time : constant String := Trim (Duration'Image (Get_Execution_Time (Info)), Ada.Strings.Both); begin Start_Testcase_Tag (File => File, Parent => Parent_Test, Name => Get_Routine_Name (Info), Execution_Time => Exec_Time, Test_Suffix => Test_Suffix); Put (File, ""); Put_Line (File, Get_Message (Info)); Put_Line (File, ""); End_Testcase_Tag (File); end Print_Test_Skipped; procedure Print_Test_Failure (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String) is Exec_Time : constant String := Trim (Duration'Image (Get_Execution_Time (Info)), Ada.Strings.Both); begin Start_Testcase_Tag (File => File, Parent => Parent_Test, Name => Get_Routine_Name (Info), Execution_Time => Exec_Time, Test_Suffix => Test_Suffix); Put (File, ""); Put_Line (File, Get_Message (Info)); Put_Line (File, ""); if Length (Get_Output_File (Info)) > 0 then Put (File, ""); Print_Log_File (File, To_String (Get_Output_File (Info))); Put_Line (File, ""); end if; End_Testcase_Tag (File); end Print_Test_Failure; procedure Print_Test_Error (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String) is Exec_Time : constant String := Trim (Duration'Image (Get_Execution_Time (Info)), Ada.Strings.Both); begin Start_Testcase_Tag (File => File, Parent => Parent_Test, Name => Get_Routine_Name (Info), Execution_Time => Exec_Time, Test_Suffix => Test_Suffix); Put (File, ""); Put_Line (File, Get_Message (Info)); Put_Line (File, ""); if Length (Get_Output_File (Info)) > 0 then Put (File, ""); Print_Log_File (File, To_String (Get_Output_File (Info))); Put_Line (File, ""); end if; End_Testcase_Tag (File); end Print_Test_Error; generic with procedure Print (File : File_Type; Parent_Test : String; Info : Result_Info; Test_Suffix : String); procedure Print_Results (Output : File_Type; First_Item : Result_Info_Cursor; Result : Result_Collection; Test_Suffix : String); procedure Print_Results (Output : File_Type; First_Item : Result_Info_Cursor; Result : Result_Collection; Test_Suffix : String) is Position : Result_Info_Cursor := First_Item; begin loop exit when not Is_Valid (Position); Print (File => Output, Parent_Test => To_String (Get_Test_Name (Result)), Info => Data (Position), Test_Suffix => Test_Suffix); Position := Next (Position); end loop; end Print_Results; procedure Print_Test_Case (Collection : Result_Collection; Dir : String; Test_Suffix : String) is procedure Print (Output : File_Type; Result : Result_Collection); -- Internal procedure to print the testcase into given file. function Img (Value : Test_Count_Type) return String is begin return Trim (Test_Count_Type'Image (Value), Ada.Strings.Both); end Img; procedure Print (Output : File_Type; Result : Result_Collection) is procedure Print_Errors is new Print_Results (Print => Print_Test_Error); procedure Print_Failures is new Print_Results (Print => Print_Test_Failure); procedure Print_Passes is new Print_Results (Print => Print_Test_Pass); procedure Print_Skips is new Print_Results (Print => Print_Test_Skipped); begin Put_Line (Output, ""); Put (Output, ""); Print_Errors (Output => Output, First_Item => First_Error (Result), Result => Result, Test_Suffix => Test_Suffix); Print_Failures (Output => Output, First_Item => First_Failure (Result), Result => Result, Test_Suffix => Test_Suffix); Print_Passes (Output => Output, First_Item => First_Pass (Result), Result => Result, Test_Suffix => Test_Suffix); Print_Skips (Output => Output, First_Item => First_Skipped (Result), Result => Result, Test_Suffix => Test_Suffix); Put_Line (Output, ""); end Print; File : File_Type; begin if Dir = "-" then Print (Standard_Output, Collection); else Create (File => File, Mode => Ada.Text_IO.Out_File, Name => Create_Name (Dir, To_String (Get_Test_Name (Collection)))); Print (File, Collection); Ada.Text_IO.Close (File); end if; end Print_Test_Case; procedure Report_Results (Result : Result_Collection; Dir : String; Test_Suffix : String) is Position : Result_Collection_Cursor; begin Position := First_Child (Result); loop exit when not Is_Valid (Position); if Child_Depth (Data (Position).all) = 0 then Print_Test_Case (Data (Position).all, Dir, Test_Suffix); else Report_Results (Data (Position).all, Dir, Test_Suffix); -- Handle the test cases in this collection if Direct_Test_Count (Result) > 0 then Print_Test_Case (Result, Dir, Test_Suffix); end if; end if; Position := Next (Position); end loop; end Report_Results; -- Print the log by placing the data inside CDATA block. procedure Print_Log_File (File : File_Type; Filename : String) is type CData_End_State is (NONE, FIRST_BRACKET, SECOND_BRACKET); function State_Change (Old_State : CData_End_State) return CData_End_State; Handle : File_Type; Char : Character := ' '; First : Boolean := True; -- We need to escape ]]>, this variable tracks -- the characters, so we know when to do the escaping. CData_Ending : CData_End_State := NONE; function State_Change (Old_State : CData_End_State) return CData_End_State is New_State : CData_End_State := NONE; -- By default New_State will be NONE, so there is -- no need to set it inside when blocks. begin case Old_State is when NONE => if Char = ']' then New_State := FIRST_BRACKET; end if; when FIRST_BRACKET => if Char = ']' then New_State := SECOND_BRACKET; end if; when SECOND_BRACKET => if Char = '>' then Put (File, " "); end if; end case; return New_State; end State_Change; begin Open (Handle, In_File, Filename); loop exit when End_Of_File (Handle); Get (Handle, Char); if First then Put (File, ""); end if; end Print_Log_File; procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info) is begin Report_Results (Test_Results, Parameters.Result_Dir (Args), Parameters.Test_Class_Suffix (Args)); end Do_Report; procedure Run (Suite : in out Framework.Test_Suite'Class) is begin Runner.Run_Suite (Suite, Do_Report'Access); end Run; procedure Run (Suite : Framework.Test_Suite_Access) is begin Run (Suite.all); end Run; end Ahven.XML_Runner; ahven-2.7/src/ahven-xml_runner.ads0000644000000000000000000000305113325517624015370 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Results; with Ahven.Parameters; package Ahven.XML_Runner is procedure Run (Suite : in out Framework.Test_Suite'Class); -- Run the suite and print the results. procedure Run (Suite : Framework.Test_Suite_Access); -- Run the suite and print the results. The routine is -- identical to the above routine, but takes an access -- parameter to a test suite. procedure Report_Results (Result : Results.Result_Collection; Dir : String; Test_Suffix : String); -- Report results to the given directory. private procedure Do_Report (Test_Results : Results.Result_Collection; Args : Parameters.Parameter_Info); end Ahven.XML_Runner; ahven-2.7/src/ahven.adb0000644000000000000000000000316113325517624013162 0ustar 00000000000000-- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Exceptions; pragma Elaborate_All (Ada.Exceptions); package body Ahven is procedure Assert (Condition : Boolean; Message : String) is begin if not Condition then Ada.Exceptions.Raise_Exception (Assertion_Error'Identity, Message); end if; end Assert; procedure Assert_Equal (Actual : Data_Type; Expected : Data_Type; Message : String) is begin Assert (Actual = Expected, Message & " (Expected: " & Image (Expected) & "; Got: " & Image (Actual) & ")"); end Assert_Equal; procedure Fail (Message : String) is begin Ada.Exceptions.Raise_Exception (Assertion_Error'Identity, Message); end Fail; procedure Skip (Message : String) is begin Ada.Exceptions.Raise_Exception (Test_Skipped_Error'Identity, Message); end Skip; end Ahven; ahven-2.7/src/ahven.ads0000644000000000000000000000416713325517624013212 0ustar 00000000000000-- Ahven Unit Test Library -- -- Copyright (c) 2007-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package Ahven is Max_String_Len : constant := 160; Max_Long_String_Len : constant := 1024; Count_Max : constant := (2**31) - 1; Assertion_Error : exception; -- Exception, raised when Assert fails. Test_Skipped_Error : exception; -- Exception, raised when test is skipped subtype Test_Count_Type is Long_Integer range 0 .. Count_Max; -- Type for the test count. Long_Integer might be bigger -- on some platforms, but the upper limit is something -- what most compilers support. -- -- In practice, when adding tests the limit is not explicitly checked. procedure Assert (Condition : Boolean; Message : String); -- If Condition is false, Assert raises Assertion_Error -- with given Message. generic type Data_Type is private; with function Image (Item : Data_Type) return String is <>; procedure Assert_Equal (Actual : Data_Type; Expected : Data_Type; Message : String); -- If Expected /= Actual, Assert raises Assertion_Error -- with given Message + represenation of expected and acutal values procedure Fail (Message : String); -- Fail always raises Assertion_Error with given Message. procedure Skip (Message : String); -- Skip always raises Test_Skipped_Error with given Message. end Ahven; ahven-2.7/src/libmain.adb0000644000000000000000000000212713325517624013475 0ustar 00000000000000-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- --## rule off WITH_CLAUSES with Ahven; with Ahven.Framework; with Ahven.Results; with Ahven.Text_Runner; with Ahven.Listeners; with Ahven.Listeners.Basic; with Ahven.XML_Runner; with Ahven.Runner; with Ahven.Parameters; with Ahven.SList; with Ahven.Tap_Runner; procedure LibMain is begin null; end LibMain; ahven-2.7/src/unix/ahven_compat.adb0000644000000000000000000000173613325517624015516 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- UNIX version of OS compatibility package package body Ahven_Compat is function Directory_Separator return String is begin return "/"; end Directory_Separator; end Ahven_Compat; ahven-2.7/src/unix/ahven_compat.ads0000644000000000000000000000171113325517624015530 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- Operating system compatibility package package Ahven_Compat is function Directory_Separator return String; -- Return the used directory separator. end Ahven_Compat; ahven-2.7/src/windows/ahven_compat.adb0000644000000000000000000000174113325517624016221 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- Windows version of OS compatibility package package body Ahven_Compat is function Directory_Separator return String is begin return "\"; end Directory_Separator; end Ahven_Compat; ahven-2.7/src/windows/ahven_compat.ads0000644000000000000000000000171113325517624016237 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- -- Operating system compatibility package package Ahven_Compat is function Directory_Separator return String; -- Return the used directory separator. end Ahven_Compat; ahven-2.7/test/ahven_tests.adb0000644000000000000000000000351713325517624014601 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Framework_Tests; with Derived_Tests; with Results_Tests; with Basic_Listener_Tests; with Assertion_Tests; with Static_Test_Case_Tests; with SList_Tests; package body Ahven_Tests is use Ahven; function Get_Test_Suite return Ahven.Framework.Test_Suite is S : Framework.Test_Suite := Framework.Create_Suite ("All"); Assertion_Test : Assertion_Tests.Test; Derived_Test : Derived_Tests.Test; Framework_Test : Framework_Tests.Test; Listener_Test : Basic_Listener_Tests.Test; Results_Test : Results_Tests.Test; Static_Test : Static_Test_Case_Tests.Test; SList_Test : SList_Tests.Test; begin Framework.Add_Static_Test (S, Assertion_Test); Framework.Add_Static_Test (S, Derived_Test); Framework.Add_Static_Test (S, Framework_Test); Framework.Add_Static_Test (S, Listener_Test); Framework.Add_Static_Test (S, Results_Test); Framework.Add_Static_Test (S, Static_Test); Framework.Add_Static_Test (S, SList_Test); return S; end Get_Test_Suite; end Ahven_Tests; ahven-2.7/test/ahven_tests.ads0000644000000000000000000000163013325517624014614 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Ahven_Tests is function Get_Test_Suite return Ahven.Framework.Test_Suite; end Ahven_Tests; ahven-2.7/test/assertion_tests.adb0000644000000000000000000000536213325517624015507 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; use Ahven; package body Assertion_Tests is procedure Assert_Int_Equal is new Assert_Equal (Data_Type => Integer, Image => Integer'Image); procedure Initialize (T : in out Test) is begin Set_Name (T, "Ahven"); Framework.Add_Test_Routine (T, Test_Assert_Equal'Access, "Assert_Equal"); Framework.Add_Test_Routine (T, Test_Assert'Access, "Assert"); Framework.Add_Test_Routine (T, Test_Fail'Access, "Fail"); end Initialize; procedure Test_Assert_Equal is Exception_Got : Boolean; begin begin Exception_Got := False; Assert_Int_Equal (Expected => 1, Actual => 1, Message => "Assert_Equal"); exception when Assertion_Error => Exception_Got := True; end; Assert (not Exception_Got, "exception for valid condition!"); begin Exception_Got := False; Assert_Int_Equal (Expected => 1, Actual => 2, Message => "Assert_Equal"); exception when Assertion_Error => Exception_Got := True; end; Assert (Exception_Got, "no exception for invalid condition!"); end Test_Assert_Equal; procedure Test_Fail is Exception_Got : Boolean; begin begin Exception_Got := False; Fail ("fail"); exception when Assertion_Error => Exception_Got := True; end; Assert (Exception_Got, "Fail did not raise exception!"); end Test_Fail; procedure Test_Assert is Exception_Got : Boolean; begin Assert (True, "Assert (True)"); begin Exception_Got := False; Assert (False, "assertion"); exception when Assertion_Error => Exception_Got := True; end; if not Exception_Got then -- Raising Assertion_Error directly, since Assert apparently -- does not work. raise Assertion_Error; end if; end Test_Assert; end Assertion_Tests; ahven-2.7/test/assertion_tests.ads0000644000000000000000000000205013325517624015517 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Assertion_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Assert_Equal; procedure Test_Fail; procedure Test_Assert; end Assertion_Tests; ahven-2.7/test/basic_listener_tests.adb0000644000000000000000000000755613325517624016475 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Ahven.Listeners.Basic; with Ahven.Results; with Ahven.AStrings; with Ahven.Long_AStrings; use Ahven; use Ahven.Results; package body Basic_Listener_Tests is procedure Assert_Eq is new Ahven.Assert_Equal (Data_Type => Test_Count_Type, Image => Test_Count_Type'Image); procedure Initialize (T : in out Test) is begin Set_Name (T, "Ahven.Listeners.Basic"); Framework.Add_Test_Routine (T, Test_Single_Pass'Access, "Test Single Pass"); Framework.Add_Test_Routine (T, Test_Error_Inside_Suite'Access, "Test Error Inside Suite"); end Initialize; procedure Test_Single_Pass is use Ahven.Listeners; use Ahven.AStrings; Listener : Basic.Basic_Listener; begin Listeners.Basic.Start_Test (Listener, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Listeners.Basic.Add_Pass (Listener, (Phase => TEST_RUN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE, Routine_Name => To_Bounded_String ("routine"), Message => To_Bounded_String ("message"), Long_Message => Long_AStrings.To_Long_String ("long_message"))); Listeners.Basic.End_Test (Listener, (Phase => TEST_END, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Assert_Eq (Test_Count (Listener.Main_Result), 1, "Test Count"); end Test_Single_Pass; procedure Test_Error_Inside_Suite is use Ahven.Listeners; use Ahven.AStrings; Listener : Basic.Basic_Listener; begin Listeners.Basic.Start_Test (Listener, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String ("suite"), Test_Kind => CONTAINER)); Listeners.Basic.Start_Test (Listener, (Phase => TEST_BEGIN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Listeners.Basic.Add_Error (Listener, (Phase => TEST_RUN, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE, Routine_Name => To_Bounded_String ("routine"), Message => To_Bounded_String ("message"), Long_Message => Long_AStrings.To_Long_String ("long_message"))); Listeners.Basic.End_Test (Listener, (Phase => TEST_END, Test_Name => To_Bounded_String ("testname"), Test_Kind => ROUTINE)); Listeners.Basic.End_Test (Listener, (Phase => TEST_END, Test_Name => To_Bounded_String ("suite"), Test_Kind => CONTAINER)); Assert_Eq (Test_Count (Listener.Main_Result), 1, "Test Count"); Assert_Eq (Direct_Test_Count (Listener.Main_Result), 0, "Direct Test Count"); Assert_Eq (Error_Count (Listener.Main_Result), 1, "Error Count"); end Test_Error_Inside_Suite; end Basic_Listener_Tests; ahven-2.7/test/basic_listener_tests.ads0000644000000000000000000000204513325517624016502 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Basic_Listener_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Single_Pass; procedure Test_Error_Inside_Suite; end Basic_Listener_Tests; ahven-2.7/test/derived_tests.adb0000644000000000000000000000177713325517624015130 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package body Derived_Tests is procedure Initialize (T : in out Test) is begin Framework_Tests.Initialize (Framework_Tests.Test (T)); Set_Name (T, "Ahven.Derived_Tests"); end Initialize; end Derived_Tests; ahven-2.7/test/derived_tests.ads0000644000000000000000000000170513325517624015140 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Framework_Tests; package Derived_Tests is type Test is new Framework_Tests.Test with null record; procedure Initialize (T : in out Test); end Derived_Tests; ahven-2.7/test/dummy_tests.adb0000644000000000000000000001010713325517624014624 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; --## rule off DIRECTLY_ACCESSED_GLOBALS package body Dummy_Tests is Instance_Count : Integer := 0; procedure Initialize (T : in out Test) is procedure Register (T : in out Ahven.Framework.Test_Case'Class; Routine : Ahven.Framework.Simple_Test_Routine_Access; Name : String) renames Ahven.Framework.Add_Test_Routine; begin Register (T, This_Test_Fails'Access, "Failure"); Register (T, This_Test_Passes'Access, "Pass"); Register (T, This_Test_Raises_Error'Access, "Error"); Register (T, This_Test_Is_Skipped'Access, "Skipped"); Ahven.Framework.Add_Test_Routine (T, This_Test_Uses_Object'Access, "Object usage"); T.State := INITIALIZED; Instance_Count := Instance_Count + 1; end Initialize; procedure Adjust (T : in out Test) is begin Instance_Count := Instance_Count + 1; end Adjust; procedure Finalize (T : in out Test) is begin Instance_Count := Instance_Count - 1; end Finalize; procedure Set_Up (T : in out Test) is begin T.State := UP; end Set_Up; procedure Tear_Down (T : in out Test) is begin T.State := DOWN; end Tear_Down; procedure This_Test_Fails is begin Ahven.Fail ("Failure"); end This_Test_Fails; procedure This_Test_Passes is begin Ahven.Assert (True, "True was not true!"); end This_Test_Passes; procedure This_Test_Raises_Error is begin raise Constraint_Error; end This_Test_Raises_Error; procedure This_Test_Is_Skipped is begin Ahven.Skip ("skipped"); end This_Test_Is_Skipped; procedure This_Test_Uses_Object (T : in out Ahven.Framework.Test_Case'Class) is begin Test (T).State := USED; end This_Test_Uses_Object; procedure This_Test_Takes_12_Seconds is begin delay 12.0; end This_Test_Takes_12_Seconds; procedure This_Test_Has_Infinite_Loop is --## rule off Removable A : Integer := 0; begin loop A := 1; end loop; --## rule on Removable end This_Test_Has_Infinite_Loop; function Get_Instance_Count return Integer is begin return Instance_Count; end Get_Instance_Count; procedure Reset_Instance_Count is begin Instance_Count := 0; end Reset_Instance_Count; procedure Initialize (T : in out Test_Simple) is procedure Register (T : in out Ahven.Framework.Test_Case'Class; Routine : Ahven.Framework.Simple_Test_Routine_Access; Name : String) renames Ahven.Framework.Add_Test_Routine; begin Register (T, This_Test_Modifies_The_Package_State'Access, "Package state modification"); Package_State := INITIALIZED; end Initialize; procedure Set_Up (T : in out Test_Simple) is begin Package_State := UP; T.Tear_Down_Count := 0; end Set_Up; procedure Tear_Down (T : in out Test_Simple) is begin Package_State := DOWN; T.Tear_Down_Count := T.Tear_Down_Count + 1; end Tear_Down; procedure This_Test_Modifies_The_Package_State is begin Ahven.Assert (Package_State = UP, "Package_State = UP"); Package_State := USED; end This_Test_Modifies_The_Package_State; end Dummy_Tests; --## rule on DIRECTLY_ACCESSED_GLOBALS ahven-2.7/test/dummy_tests.ads0000644000000000000000000000424613325517624014654 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Dummy_Tests is Dummy_Passes : constant := 2; Dummy_Failures : constant := 1; Dummy_Errors : constant := 1; Dummy_Skips : constant := 1; Dummy_Test_Count : constant := Dummy_Passes + Dummy_Failures + Dummy_Errors + Dummy_Skips; type Test_State is (INITIALIZED, UP, DOWN, USED); type Test is new Ahven.Framework.Test_Case with record State : Test_State; end record; procedure Initialize (T : in out Test); procedure Adjust (T : in out Test); procedure Finalize (T : in out Test); procedure Set_Up (T : in out Test); procedure Tear_Down (T : in out Test); procedure This_Test_Fails; procedure This_Test_Passes; procedure This_Test_Raises_Error; procedure This_Test_Is_Skipped; procedure This_Test_Uses_Object (T : in out Ahven.Framework.Test_Case'Class); procedure This_Test_Takes_12_Seconds; procedure This_Test_Has_Infinite_Loop; function Get_Instance_Count return Integer; procedure Reset_Instance_Count; Package_State : Test_State; type Test_Simple is new Ahven.Framework.Test_Case with record Tear_Down_Count : Integer := -1; end record; procedure Initialize (T : in out Test_Simple); procedure Set_Up (T : in out Test_Simple); procedure Tear_Down (T : in out Test_Simple); procedure This_Test_Modifies_The_Package_State; end Dummy_Tests; ahven-2.7/test/framework_tests.adb0000644000000000000000000004403413325517624015474 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ada.Calendar; with Ada.Unchecked_Deallocation; with Ada.Strings; with Ahven.Name_List; with Ahven.AStrings; with Simple_Listener; with Dummy_Tests; pragma Elaborate_All (Dummy_Tests); package body Framework_Tests is use Ahven; procedure Assert_Eq_Count is new Ahven.Assert_Equal (Data_Type => Ahven.Test_Count_Type, Image => Ahven.Test_Count_Type'Image); procedure Assert_Eq_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); procedure Assert_Eq_Int is new Ahven.Assert_Equal (Data_Type => Integer, Image => Integer'Image); procedure Free is new Ada.Unchecked_Deallocation (Object => Simple_Listener.Listener, Name => Simple_Listener.Listener_Access); function To_Bounded (Source : String) return AStrings.Bounded_String is use Ahven.AStrings; begin return To_Bounded_String (Source => Source, Drop => Ada.Strings.Right); end To_Bounded; function To_List (Name : String) return Name_List.List is A_List : Name_List.List := Name_List.Empty_List; begin Name_List.Append (A_List, To_Bounded (Name)); return A_List; end To_List; procedure Initialize (T : in out Test) is use Framework; begin Set_Name (T, "Ahven.Framework"); Add_Test_Routine (T, Test_Set_Up'Access, "Test_Case: Set_Up"); T.Value := INITIALIZED; Add_Test_Routine (T, Test_Set_Up_And_Tear_Down_Simple'Access, "Test_Case: Set_Up and Tear_Down (Simple)"); Add_Test_Routine (T, Test_Tear_Down_After_Exception_Simple'Access, "Test_Case: Tear_Down after exception (Simple)"); Add_Test_Routine (T, Test_Tear_Down'Access, "Test_Case: Tear_Down"); Add_Test_Routine (T, Test_Test_Case_Run'Access, "Test_Case: Run"); Add_Test_Routine (T, Test_Test_Case_Run_Empty'Access, "Test_Case: Run (Empty)"); Add_Test_Routine (T, Test_Test_Case_Run_1s_Timeout'Access, "Test_Case: 1s Timeout"); Add_Test_Routine (T, Test_Test_Case_Run_Break_Infinite_Loop'Access, "Test_Case: Break infinite loop"); Add_Test_Routine (T, Test_Test_Case_Test_Count'Access, "Test_Case: Test_Count"); Add_Test_Routine (T, Test_Test_Case_Truncate_Name'Access, "Test_Case: Truncate Name"); Add_Test_Routine (T, Test_Call_End_Test'Access, "Test_Case: Run (Call End_Test)"); Add_Test_Routine (T, Test_Test_Suite_Run'Access, "Test_Suite: Run"); Add_Test_Routine (T, Test_Test_Suite_Static_Run'Access, "Test_Suite: Run (Static)"); Add_Test_Routine (T, Test_Test_Suite_Name_Run'Access, "Test_Suite: Run (Name)"); Add_Test_Routine (T, Test_Test_Suite_Inside_Suite'Access, "Test_Suite: Suite inside another"); Add_Test_Routine (T, Test_Test_Suite_Test_Count'Access, "Test_Suite: Test Count"); Add_Test_Routine (T, Test_Test_Suite_Test_Static_Count'Access, "Test_Suite: Test Count (Static)"); Add_Test_Routine (T, Test_Test_Suite_Test_Name_Count'Access, "Test_Suite: Test Count (Name)"); Add_Test_Routine (T, Test_Test_Suite_Cleanup'Access, "Test_Suite: Cleanup"); end Initialize; procedure Set_Up (T : in out Test) is begin T.Value := SETUP_DONE; end Set_Up; procedure Tear_Down (T : in out Test) is begin T.Value := TEARDOWN_DONE; end Tear_Down; procedure Test_Set_Up (T : in out Ahven.Framework.Test_Case'Class) is begin Assert (Test (T).Value = SETUP_DONE, "Set_Up not called!"); end Test_Set_Up; -- Test that Set_Up and Tear_Down procedures are called -- for simple test routines. -- -- Actual Set_Up test is inside Dummy_Tests. -- If My_Listener has one pass, everything went fine. procedure Test_Set_Up_And_Tear_Down_Simple is use type Dummy_Tests.Test_State; My_Simple_Test : Dummy_Tests.Test_Simple; My_Listener : Simple_Listener.Listener; begin Dummy_Tests.Run (My_Simple_Test, My_Listener); Assert (My_Listener.Passes = 1, "No passed test."); Assert (Dummy_Tests.Package_State = Dummy_Tests.DOWN, "Tear_Down not called!"); end Test_Set_Up_And_Tear_Down_Simple; procedure Test_Tear_Down_After_Exception_Simple is use type Dummy_Tests.Test_State; My_Simple_Test : Dummy_Tests.Test_Simple; My_Listener : Simple_Listener.Listener; begin Ahven.Framework.Add_Test_Routine (My_Simple_Test, Dummy_Tests.This_Test_Raises_Error'Access, "exception"); Dummy_Tests.Run (My_Simple_Test, My_Listener); Assert_Eq_Nat (My_Listener.Passes, 1, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, 1, "Error count"); Assert_Eq_Nat (My_Listener.Failures, 0, "Failure count"); Assert_Eq_Int (My_Simple_Test.Tear_Down_Count, 1, "Tear_Down count"); Assert (Dummy_Tests.Package_State = Dummy_Tests.DOWN, "Tear_Down not called!"); end Test_Tear_Down_After_Exception_Simple; procedure Test_Tear_Down is use type Dummy_Tests.Test_State; My_Test : Dummy_Tests.Test; My_Listener : Simple_Listener.Listener; begin Dummy_Tests.Run (My_Test, My_Listener); Assert (My_Test.State = Dummy_Tests.DOWN, "Tear_Down not called!"); end Test_Tear_Down; procedure Test_Test_Case_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; My_Test : Dummy_Tests.Test; begin Dummy_Tests.Run (My_Test, My_Listener.all); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, Dummy_Test_Count, "Start_Test calls"); Free (My_Listener); end Test_Test_Case_Run; type Empty_Test_Case is new Ahven.Framework.Test_Case with null record; procedure Test_Test_Case_Run_Empty is My_Listener : Simple_Listener.Listener; My_Test : Empty_Test_Case; begin Run (My_Test, My_Listener); Assert_Eq_Nat (My_Listener.Passes, 0, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, 0, "Error count"); Assert_Eq_Nat (My_Listener.Failures, 0, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, 0, "Start_Test calls"); end Test_Test_Case_Run_Empty; procedure Test_Test_Case_Run_1s_Timeout is use Dummy_Tests; use Ahven.Framework; use type Ada.Calendar.Time; My_Test : Dummy_Tests.Test; My_Listener : Simple_Listener.Listener; Before : Ada.Calendar.Time; After : Ada.Calendar.Time; begin Add_Test_Routine (My_Test, Dummy_Tests.This_Test_Takes_12_Seconds'Access, "Takes 12 seconds"); Before := Ada.Calendar.Clock; Ahven.Framework.Run (Ahven.Framework.Test_Case (My_Test), My_Listener, 1.0); After := Ada.Calendar.Clock; -- Timing might not be 100% accurate, so measuring -- less than 2.0 seconds should give us accetable result Assert (After - Before < 2.0, "Test took too long"); end Test_Test_Case_Run_1s_Timeout; procedure Test_Test_Case_Run_Break_Infinite_Loop is use Dummy_Tests; use Ahven.Framework; use type Ada.Calendar.Time; My_Test : Dummy_Tests.Test; My_Listener : Simple_Listener.Listener; Before : Ada.Calendar.Time; After : Ada.Calendar.Time; begin Skip ("Does not work with most Ada compilers."); Add_Test_Routine (My_Test, Dummy_Tests.This_Test_Has_Infinite_Loop'Access, "Has infinite loop"); Before := Ada.Calendar.Clock; Ahven.Framework.Run (Ahven.Framework.Test_Case (My_Test), My_Listener, 0.2); After := Ada.Calendar.Clock; -- Timing might not be 100% accurate, so measuring -- less than 1.0 seconds should give us accetable result Assert (After - Before < 1.0, "Test took too long"); end Test_Test_Case_Run_Break_Infinite_Loop; procedure Test_Test_Case_Test_Count is Dummy_Test : Dummy_Tests.Test; begin Assert_Eq_Count (Dummy_Tests.Test_Count (Dummy_Test), Dummy_Tests.Dummy_Test_Count, "Test Count"); end Test_Test_Case_Test_Count; procedure Test_Test_Case_Truncate_Name is Over_Max : constant := 180; Dummy_Test : Dummy_Tests.Test; Name : constant String (1..Over_Max) := (others => 'a'); begin Dummy_Tests.Set_Name (Dummy_Test, Name); end Test_Test_Case_Truncate_Name; procedure Test_Test_Suite_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; My_Suite : Framework.Test_Suite_Access; begin My_Suite := Framework.Create_Suite ("My suite"); Framework.Add_Test (My_Suite.all, new Dummy_Tests.Test); Framework.Run (My_Suite.all, My_Listener.all); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 1), "Start_Test calls"); Free (My_Listener); Framework.Release_Suite (My_Suite); end Test_Test_Suite_Run; procedure Test_Test_Suite_Static_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener; My_Suite : Framework.Test_Suite := Framework.Create_Suite ("My suite"); Dummy_Test : Dummy_Tests.Test; begin Framework.Add_Static_Test (My_Suite, Dummy_Test); Framework.Run (My_Suite, My_Listener); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 1), "Start_Test calls"); end Test_Test_Suite_Static_Run; procedure Test_Test_Suite_Name_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener; My_Suite : Framework.Test_Suite := Framework.Create_Suite ("My suite"); Dummy_Test : Dummy_Tests.Test; begin Framework.Add_Static_Test (My_Suite, Dummy_Test); Framework.Run (My_Suite, To_List ("Failure"), My_Listener); Assert_Eq_Nat (My_Listener.Passes, 0, "Pass count"); Assert_Eq_Nat (My_Listener.Errors, 0, "Error count"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Failure count"); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Failures + 1), "Start_Test calls"); end Test_Test_Suite_Name_Run; procedure Test_Call_End_Test is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; My_Test : Dummy_Tests.Test; begin Dummy_Tests.Run (My_Test, My_Listener.all); Assert_Eq_Nat (My_Listener.Level, 0, "Listener.Level"); Assert_Eq_Nat (My_Listener.End_Calls, Dummy_Test_Count, "End_Test calls"); Free (My_Listener); end Test_Call_End_Test; procedure Test_Test_Suite_Inside_Suite is use Dummy_Tests; My_Listener : Simple_Listener.Listener_Access := new Simple_Listener.Listener; Child : Framework.Test_Suite_Access; Parent : Framework.Test_Suite; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Test (Child.all, new Dummy_Tests.Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Test (Parent, Child); Framework.Run (Parent, My_Listener.all); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "Amount of passes."); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "Amount of errors."); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "Amount of failures."); Assert_Eq_Nat (My_Listener.Level, 0, "Start_Test /= End_Test"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 2), "Start_Test calls"); Free (My_Listener); end Test_Test_Suite_Inside_Suite; -- Test that Test_Count works for dynamic test cases procedure Test_Test_Suite_Test_Count is use Dummy_Tests; Child : Framework.Test_Suite_Access; Parent : Framework.Test_Suite; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Test (Child.all, new Dummy_Tests.Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Test (Parent, Child); Assert_Eq_Count (Framework.Test_Count (Parent), Dummy_Test_Count, "Test Count"); end Test_Test_Suite_Test_Count; -- Test that Test_Count works for static test cases procedure Test_Test_Suite_Test_Static_Count is use Dummy_Tests; Child : Framework.Test_Suite; Parent : Framework.Test_Suite; Dummy_Test : Dummy_Tests.Test; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Static_Test (Child, Dummy_Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Static_Test (Parent, Child); Assert_Eq_Count (Framework.Test_Count (Parent), Dummy_Test_Count, "Test Count"); end Test_Test_Suite_Test_Static_Count; procedure Test_Test_Suite_Test_Name_Count is use Dummy_Tests; Child : Framework.Test_Suite; Parent : Framework.Test_Suite; GParent : Framework.Test_Suite; Dummy_Test : Dummy_Tests.Test; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Static_Test (Child, Dummy_Test); Framework.Add_Test (Child, new Dummy_Tests.Test); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Static_Test (Parent, Child); GParent := Framework.Create_Suite ("GParent suite"); Framework.Add_Static_Test (GParent, Parent); Assert_Eq_Count (Framework.Test_Count (GParent, "Failure"), 2, "Test Count"); Assert_Eq_Count (Actual => Framework.Test_Count (GParent, "GParent suite"), Expected => Dummy_Test_Count * 2, Message => "GParent suite: Test Count"); end Test_Test_Suite_Test_Name_Count; -- We test that Test_Suites do their cleanup properly -- even if we have mixed static and dynamic test cases -- or have nested test suites. procedure Test_Test_Suite_Cleanup is Initial_Count : Integer; begin Dummy_Tests.Reset_Instance_Count; Initial_Count := Dummy_Tests.Get_Instance_Count; --## rule off Long_Blocks declare use Dummy_Tests; Child : Framework.Test_Suite; Parent : Framework.Test_Suite; GParent : Framework.Test_Suite; Dummy_Test : Dummy_Tests.Test; Test_Instance_Count : Natural := 1; begin Child := Framework.Create_Suite ("Child suite"); Framework.Add_Static_Test (Child, Dummy_Test); Test_Instance_Count := Test_Instance_Count + 1; -- 2 Assert_Eq_Int (Expected => Test_Instance_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Dummy_Tests instance count"); Framework.Add_Test (Child, new Dummy_Tests.Test); Test_Instance_Count := Test_Instance_Count + 1; -- 3 Assert_Eq_Int (Expected => Test_Instance_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Dummy_Tests instance count"); Parent := Framework.Create_Suite ("Parent suite"); Framework.Add_Static_Test (Parent, Child); Test_Instance_Count := Test_Instance_Count + 2; -- 1 + 2 + 2 = 5 Assert_Eq_Int (Expected => Test_Instance_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Dummy_Tests instance count"); Framework.Add_Test (Parent, new Dummy_Tests.Test); Framework.Add_Static_Test (Parent, Dummy_Test); GParent := Framework.Create_Suite ("GParent suite"); Framework.Add_Test (GParent, new Dummy_Tests.Test); Framework.Add_Static_Test (GParent, Dummy_Test); Framework.Add_Static_Test (GParent, Parent); end; Assert_Eq_Int (Expected => Initial_Count, Actual => Dummy_Tests.Get_Instance_Count, Message => "Not all tests freed"); --## rule on Long_Blocks end Test_Test_Suite_Cleanup; end Framework_Tests; ahven-2.7/test/framework_tests.ads0000644000000000000000000000375613325517624015523 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Framework_Tests is type Test_State is (UNINITIALIZED, INITIALIZED, SETUP_DONE, TEARDOWN_DONE); type Test is new Ahven.Framework.Test_Case with record Value : Test_State := UNINITIALIZED; end record; procedure Initialize (T : in out Test); procedure Set_Up (T : in out Test); procedure Tear_Down (T : in out Test); private procedure Test_Set_Up (T : in out Ahven.Framework.Test_Case'Class); procedure Test_Set_Up_And_Tear_Down_Simple; procedure Test_Tear_Down_After_Exception_Simple; procedure Test_Tear_Down; procedure Test_Test_Case_Run; procedure Test_Test_Case_Run_Empty; procedure Test_Test_Case_Run_1s_Timeout; procedure Test_Test_Case_Run_Break_Infinite_Loop; procedure Test_Test_Case_Test_Count; procedure Test_Test_Case_Truncate_Name; procedure Test_Test_Suite_Run; procedure Test_Test_Suite_Static_Run; procedure Test_Test_Suite_Name_Run; procedure Test_Call_End_Test; procedure Test_Test_Suite_Inside_Suite; procedure Test_Test_Suite_Test_Count; procedure Test_Test_Suite_Test_Static_Count; procedure Test_Test_Suite_Test_Name_Count; procedure Test_Test_Suite_Cleanup; end Framework_Tests; ahven-2.7/test/perf_tester.adb0000644000000000000000000000177713325517624014606 0ustar 00000000000000-- -- Copyright (c) 2016 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Text_Runner; with Performance_Tests; procedure Perf_Tester is Suite : Ahven.Framework.Test_Suite := Performance_Tests.Get_Test_Suite; begin Ahven.Text_Runner.Run (Suite); end Perf_Tester; ahven-2.7/test/performance_tests.adb0000644000000000000000000000636113325517624016001 0ustar 00000000000000-- -- Copyright (c) 2008-2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Simple_Listener; use Ahven; package body Performance_Tests is procedure Assert_Eq_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); procedure Initialize (T : in out Test) is use Ahven.Framework; begin Set_Name (T, "Run_Tests_X_Times"); Add_Test_Routine (T, Test_100K_Tests'Access, "Test 100K tests"); Add_Test_Routine (T, Test_1M_Tests'Access, "Test 1M tests"); Add_Test_Routine (T, Test_10M_Tests'Access, "Test 10M tests"); Add_Test_Routine (T, Test_100M_Tests'Access, "Test 100M tests"); end Initialize; procedure Dummy_Test_Routine is begin null; end Dummy_Test_Routine; type T is new Ahven.Framework.Test_Case with record null; end record; procedure Run_Tests_X_Times (X : Natural) is use Ahven.Framework; My_Test : T; My_Listener : Simple_Listener.Listener; begin My_Listener.Passes := 0; for I in Natural range 1 .. X loop Add_Test_Routine (My_Test, Dummy_Test_Routine'Access, "passed test"); end loop; Ahven.Framework.Run (Ahven.Framework.Test_Case (My_Test), My_Listener); Assert_Eq_Nat (Actual => My_Listener.Start_Calls, Expected => X, Message => "start calls"); Assert_Eq_Nat (Actual => My_Listener.End_Calls, Expected => X, Message => "end calls"); Assert_Eq_Nat (Actual => My_Listener.Passes, Expected => X, Message => "all passed"); end Run_Tests_X_Times; procedure Test_100K_Tests is begin Run_Tests_X_Times (X => 100_000); --## rule line off STYLE end Test_100K_Tests; function Get_Test_Suite return Ahven.Framework.Test_Suite is S : Framework.Test_Suite := Framework.Create_Suite ("Performance"); Perf_Test : Test; begin Framework.Add_Static_Test (S, Perf_Test); return S; end Get_Test_Suite; procedure Test_1M_Tests is begin Run_Tests_X_Times (X => 1_000_000); --## rule line off STYLE end Test_1M_Tests; procedure Test_10M_Tests is begin Run_Tests_X_Times (X => 10_000_000); --## rule line off STYLE end Test_10M_Tests; procedure Test_100M_Tests is begin Skip ("Requires too much memory"); Run_Tests_X_Times (X => 100_000_000); --## rule line off STYLE end Test_100M_Tests; end Performance_Tests; ahven-2.7/test/performance_tests.ads0000644000000000000000000000221613325517624016015 0ustar 00000000000000-- -- Copyright (c) 2016 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Performance_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); function Get_Test_Suite return Ahven.Framework.Test_Suite; private procedure Test_100K_Tests; procedure Test_1M_Tests; procedure Test_10M_Tests; procedure Test_100M_Tests; end Performance_Tests; ahven-2.7/test/results_tests.adb0000644000000000000000000001253113325517624015175 0ustar 00000000000000-- -- Copyright (c) 2008-2010 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Ahven.Results; with Ahven.AStrings; use Ahven; use Ahven.AStrings; package body Results_Tests is procedure Assert_Eq is new Ahven.Assert_Equal (Data_Type => Test_Count_Type, Image => Test_Count_Type'Image); procedure Initialize (T : in out Test) is use Ahven.Framework; begin Set_Name (T, "Ahven.Results"); Add_Test_Routine (T, Test_Count_Children'Access, "Test Count Children"); Add_Test_Routine (T, Test_Direct_Count'Access, "Test Direct Count"); Add_Test_Routine (T, Test_Result_Iterator'Access, "Test Result Iterator"); Add_Test_Routine (T, Test_Add_Pass'Access, "Test Add Pass"); Add_Test_Routine (T, Test_Add_Failure'Access, "Test Add Failure"); Add_Test_Routine (T, Test_Add_Error'Access, "Test Add Error"); end Initialize; procedure Test_Count_Children is use Ahven.Results; Coll : Result_Collection; Coll_Dyn : Result_Collection_Access; Info : constant Result_Info := Empty_Result_Info; begin Coll_Dyn := new Result_Collection; Add_Error (Coll, Info); Add_Pass (Coll_Dyn.all, Info); Add_Child (Coll, Coll_Dyn); Assert_Eq (Actual => Test_Count (Coll), Expected => 2, Message => "test count"); end Test_Count_Children; procedure Test_Direct_Count is use Ahven.Results; Coll : Result_Collection; Coll_Dyn : Result_Collection_Access; Info : constant Result_Info := Empty_Result_Info; Expected_Test_Count : constant := 3; begin Coll_Dyn := new Result_Collection; Add_Error (Coll, Info); Add_Failure (Coll, Info); Add_Pass (Coll, Info); -- This should not be counted in direct test count Add_Pass (Coll_Dyn.all, Info); Add_Child (Coll, Coll_Dyn); Assert_Eq (Actual => Direct_Test_Count (Coll), Expected => Expected_Test_Count, Message => "test count"); Assert_Eq (Actual => Direct_Test_Count (Coll_Dyn.all), Expected => 1, Message => "test count (dyn)"); end Test_Direct_Count; procedure Test_Result_Iterator is use Ahven.Results; Msg : constant Bounded_String := To_Bounded_String ("hello"); function Count_Tests (Position : Result_Info_Cursor) return Test_Count_Type is Count : Test_Count_Type := 0; Pos : Result_Info_Cursor := Position; begin loop exit when not Is_Valid (Pos); Assert (Get_Message (Data (Pos)) = To_String (Msg), "Invalid message in the item"); Pos := Next (Pos); Count := Count + 1; end loop; return Count; end Count_Tests; Coll : Result_Collection; Info : Result_Info := Empty_Result_Info; Error_Amount : constant := 1; Failure_Amount : constant := 2; Pass_Amount : constant := 3; begin Set_Message (Info, Msg); for I in 1 .. Error_Amount loop Add_Error (Coll, Info); end loop; for I in 1 .. Failure_Amount loop Add_Failure (Coll, Info); end loop; for I in 1 .. Pass_Amount loop Add_Pass (Coll, Info); end loop; Assert_Eq (Actual => Count_Tests (First_Pass (Coll)), Expected => Pass_Amount, Message => "pass amount"); Assert_Eq (Actual => Count_Tests (First_Failure (Coll)), Expected => Failure_Amount, Message => "failure amount"); Assert_Eq (Actual => Count_Tests (First_Error (Coll)), Expected => Error_Amount, Message => "error amount"); end Test_Result_Iterator; procedure Test_Add_Pass is use Ahven.Results; Coll : Result_Collection; Info : constant Result_Info := Empty_Result_Info; begin Add_Pass (Coll, Info); Assert (Pass_Count (Coll) = 1, "Pass was not added!"); end Test_Add_Pass; procedure Test_Add_Failure is use Ahven.Results; Coll : Result_Collection; Info : constant Result_Info := Empty_Result_Info; begin Add_Failure (Coll, Info); Assert (Failure_Count (Coll) = 1, "Failure was not added!"); end Test_Add_Failure; procedure Test_Add_Error is use Ahven.Results; Coll : Result_Collection; Info : constant Result_Info := Empty_Result_Info; begin Add_Error (Coll, Info); Assert (Error_Count (Coll) = 1, "Error was not added!"); end Test_Add_Error; end Results_Tests; ahven-2.7/test/results_tests.ads0000644000000000000000000000221713325517624015216 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Results_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Count_Children; procedure Test_Direct_Count; procedure Test_Result_Iterator; procedure Test_Add_Pass; procedure Test_Add_Failure; procedure Test_Add_Error; end Results_Tests; ahven-2.7/test/simple_listener.adb0000644000000000000000000000375313325517624015456 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- package body Simple_Listener is procedure Add_Pass (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Passes := Object.Passes + 1; end Add_Pass; procedure Add_Failure (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Failures := Object.Failures + 1; end Add_Failure; procedure Add_Skipped (Object: in out Listener; Info : Ahven.Listeners.Context) is begin Object.Skips := Object.Skips + 1; end Add_Skipped; procedure Add_Error (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Errors := Object.Errors + 1; end Add_Error; procedure Start_Test (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Level := Object.Level + 1; Object.Start_Calls := Object.Start_Calls + 1; end Start_Test; procedure End_Test (Object : in out Listener; Info : Ahven.Listeners.Context) is begin Object.Level := Object.Level - 1; Object.End_Calls := Object.End_Calls + 1; end End_Test; end Simple_Listener; ahven-2.7/test/simple_listener.ads0000644000000000000000000000353613325517624015476 0ustar 00000000000000-- -- Copyright (c) 2007 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Listeners; package Simple_Listener is type Listener is new Ahven.Listeners.Result_Listener with record Passes : Natural := 0; Errors : Natural := 0; Failures : Natural := 0; Skips : Natural := 0; Level : Integer := 0; Start_Calls : Natural := 0; End_Calls : Natural := 0; end record; type Listener_Access is access all Listener; procedure Add_Pass (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Add_Failure (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Add_Skipped (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Add_Error (Object: in out Listener; Info : Ahven.Listeners.Context); procedure Start_Test (Object: in out Listener; Info : Ahven.Listeners.Context); procedure End_Test (Object: in out Listener; Info : Ahven.Listeners.Context); end Simple_Listener; ahven-2.7/test/slist_tests.adb0000644000000000000000000001752113325517624014636 0ustar 00000000000000-- -- Copyright (c) 2008-2009 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Ahven.SList; use Ahven; package body SList_Tests is type Simple_Type is record Value : Integer := 0; end record; package Integer_List is new Ahven.SList (Element_Type => Integer); package Simple_List is new Ahven.SList (Element_Type => Simple_Type); procedure Initialize (T : in out Test) is use Framework; begin Set_Name (T, "Ahven.SList"); Add_Test_Routine (T, Test_Append_Elementary'Access, "Append (Elementary)"); Add_Test_Routine (T, Test_Append_Record'Access, "Append (Record)"); Add_Test_Routine (T, Test_Clear'Access, "Clear"); Add_Test_Routine (T, Test_Clear_Empty'Access, "Clear (Empty)"); Add_Test_Routine (T, Test_First'Access, "First"); Add_Test_Routine (T, Test_Next'Access, "Data"); Add_Test_Routine (T, Test_Length'Access, "Length"); Add_Test_Routine (T, Test_Copy'Access, "Copy"); Add_Test_Routine (T, Test_For_Each'Access, "For_Each"); end Initialize; procedure Test_Append_Elementary is use Integer_List; My_List : List; Position : Cursor; begin Append (My_List, 1); Assert (Length (My_List) = 1, "Length does not match (1st append)"); Append (My_List, 2); Assert (Length (My_List) = 2, "Length does not match (2nd append)"); Position := First (My_List); Assert (Data (Position) = 1, "Value of 1st item does not match"); Position := Next (Position); Assert (Data (Position) = 2, "Value of 2nd item does not match"); end Test_Append_Elementary; procedure Test_Append_Record is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); Obj_2 : constant Simple_Type := (Value => 2); Position : Cursor; begin Append (My_List, Obj_1); Assert (Length (My_List) = 1, "Length does not match (1st append)"); Append (My_List, Obj_2); Assert (Length (My_List) = 2, "Length does not match (2nd append)"); Position := First (My_List); Assert (Data (Position).Value = Obj_1.Value, "Value of 1st item does not match"); Position := Next (Position); Assert (Data (Position).Value = Obj_2.Value, "Value of 2nd item does not match"); end Test_Append_Record; procedure Test_Clear is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); begin Append (My_List, Obj_1); Append (My_List, Obj_1); Append (My_List, Obj_1); Clear (My_List); Assert (Length (My_List) = 0, "List not empty after Clear!"); end Test_Clear; procedure Test_Clear_Empty is use Simple_List; My_List : List := Empty_List; begin Clear (My_List); Assert (Length (My_List) = 0, "List not empty after Clear!"); end Test_Clear_Empty; procedure Test_First is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); Position : Cursor; begin Position := First (My_List); Assert (not Is_Valid (Position), "First (empty) returned valid cursor!"); Append (My_List, Obj_1); Position := First (My_List); Assert (Is_Valid (Position), "First (not empty) returned invalid cursor!"); end Test_First; procedure Test_Next is use Simple_List; Max_Count : constant := 10; My_List : List; Counter : Count_Type := 0; Position : Cursor; begin for A in Integer range 1 .. Max_Count loop Append (My_List, (Value => A)); end loop; Position := First (My_List); loop exit when not Is_Valid (Position); Position := Next (Position); Counter := Counter + 1; end loop; Assert (Counter = Max_Count, "Invalid counter value: " & Count_Type'Image (Counter)); end Test_Next; procedure Test_Data is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); Position : Cursor; begin Append (My_List, Obj_1); Position := First (My_List); Assert (Data (Position) = Obj_1, "Item in the list does not match original item"); end Test_Data; procedure Test_Length is use Simple_List; My_List : List; Obj_1 : constant Simple_Type := (Value => 1); begin Assert (Length (My_List) = 0, "Invalid initial length: " & Count_Type'Image (Length (My_List))); Append (My_List, Obj_1); Assert (Length (My_List) = 1, "Invalid length after 1st append: " & Count_Type'Image (Length (My_List))); Clear (My_List); Assert (Length (My_List) = 0, "Invalid length after Clear: " & Count_Type'Image (Length (My_List))); end Test_Length; procedure Test_Copy is use Simple_List; Object_Amount : constant := 4; My_List : List; Copy : List; Obj_1 : constant Simple_Type := (Value => 1); Obj_2 : constant Simple_Type := (Value => 2); Obj_3 : constant Simple_Type := (Value => 3); Iter_1 : Cursor; Iter_2 : Cursor; begin Append (My_List, Obj_1); Append (My_List, Obj_2); Append (My_List, Obj_3); Copy := My_List; Assert (Length (Copy) = Length (My_List), "Size does not match!"); Iter_1 := First (My_List); Iter_2 := First (Copy); Assert (Data (Iter_1) = Data (Iter_2), "First items not equal!"); Iter_1 := Next (Iter_1); Iter_2 := Next (Iter_2); Assert (Data (Iter_1) = Data (Iter_2), "Second items not equal!"); Iter_1 := Next (Iter_1); Iter_2 := Next (Iter_2); Assert (Data (Iter_1) = Data (Iter_2), "Third items not equal!"); declare Another_Copy : constant List := My_List; --## rule off IMPROPER_INITIALIZATION Yet_Another : List := Copy; begin Assert (Length (Another_Copy) = Length (My_List), "Size does not match!"); Iter_1 := First (My_List); Iter_2 := First (Another_Copy); Assert (Data (Iter_1) = Data (Iter_2), "First items not equal! (Another_Copy)"); Append (My_List, Obj_1); Yet_Another := My_List; Iter_1 := First (My_List); Iter_2 := First (Yet_Another); Assert (Data (Iter_1) = Data (Iter_2), "First items not equal! (Yet_Another)"); end; Assert (Length (My_List) = Object_Amount, "Invalid size: " & Count_Type'Image (Length (My_List))); end Test_Copy; procedure Test_For_Each is use Simple_List; Counter : Natural := 0; Max : constant := 5; procedure My_Action (Obj : in out Simple_Type) is begin Counter := Counter + 1; Assert (Counter = Obj.Value, "Data mismatch"); end My_Action; procedure Run_All is new Simple_List.For_Each (Action => My_Action); My_List : List; begin for A in Integer range 1 .. Max loop Append (My_List, (Value => A)); end loop; Run_All (My_List); end Test_For_Each; end SList_Tests; ahven-2.7/test/slist_tests.ads0000644000000000000000000000234313325517624014653 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package SList_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Append_Elementary; procedure Test_Append_Record; procedure Test_Clear; procedure Test_Clear_Empty; procedure Test_First; procedure Test_Next; procedure Test_Data; procedure Test_Length; procedure Test_Copy; procedure Test_For_Each; end SList_Tests; ahven-2.7/test/static_test_case_tests.adb0000644000000000000000000000567013325517624017023 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven; with Simple_Listener; with Dummy_Tests; package body Static_Test_Case_Tests is use Ahven; use Ahven.Framework; --## rule off DIRECTLY_ACCESSED_GLOBALS My_Test : Dummy_Tests.Test; Child : Test_Suite := Create_Suite ("Child suite"); procedure Assert_Eq_Nat is new Ahven.Assert_Equal (Data_Type => Natural, Image => Natural'Image); procedure Initialize (T : in out Test) is begin Set_Name (T, "Ahven.Framework.Static"); Framework.Add_Test_Routine (T, Test_Test_Suite_Run'Access, "Test_Suite: Run (Static)"); Framework.Add_Test_Routine (T, Test_Test_Suite_Inside_Suite'Access, "Test_Suite: Suite inside another (Static)"); end Initialize; procedure Test_Test_Suite_Run is use Dummy_Tests; My_Listener : Simple_Listener.Listener; My_Suite : Test_Suite := Create_Suite ("My suite"); begin Add_Static_Test (My_Suite, My_Test); Run (My_Suite, My_Listener); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "passes"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "errors"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "failures"); Assert (My_Listener.Level = 0, "Start_Test /= End_Test"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 1), "Start_Test calls"); end Test_Test_Suite_Run; procedure Test_Test_Suite_Inside_Suite is use Dummy_Tests; My_Listener : Simple_Listener.Listener; Parent : Test_Suite := Create_Suite ("Parent suite"); begin Framework.Add_Static_Test (Child, My_Test); Framework.Add_Static_Test (Parent, Child); Framework.Run (Parent, My_Listener); Assert_Eq_Nat (My_Listener.Passes, Dummy_Passes, "passes"); Assert_Eq_Nat (My_Listener.Errors, Dummy_Errors, "errors"); Assert_Eq_Nat (My_Listener.Failures, Dummy_Failures, "failures"); Assert (My_Listener.Level = 0, "Start_Test /= End_Test"); Assert_Eq_Nat (My_Listener.Start_Calls, (Dummy_Test_Count + 2), "Start_Test calls"); end Test_Test_Suite_Inside_Suite; end Static_Test_Case_Tests; ahven-2.7/test/static_test_case_tests.ads0000644000000000000000000000206213325517624017034 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; package Static_Test_Case_Tests is type Test is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Test); private procedure Test_Test_Suite_Run; procedure Test_Test_Suite_Inside_Suite; end Static_Test_Case_Tests; ahven-2.7/test/tap_tester.adb0000644000000000000000000000175713325517624014434 0ustar 00000000000000-- -- Copyright (c) 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Tap_Runner; with Ahven_Tests; procedure Tap_Tester is Suite : Ahven.Framework.Test_Suite := Ahven_Tests.Get_Test_Suite; begin Ahven.Tap_Runner.Run (Suite); end Tap_Tester; ahven-2.7/test/tester.adb0000644000000000000000000000175713325517624013570 0ustar 00000000000000-- -- Copyright (c) 2007, 2008 Tero Koskinen -- -- Permission to use, copy, modify, and distribute this software for any -- purpose with or without fee is hereby granted, provided that the above -- copyright notice and this permission notice appear in all copies. -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- with Ahven.Framework; with Ahven.Text_Runner; with Ahven_Tests; procedure Tester is Suite : Ahven.Framework.Test_Suite := Ahven_Tests.Get_Test_Suite; begin Ahven.Text_Runner.Run (Suite); end Tester; ahven-2.7/tools/check_spaces.pl0000644000000000000000000000141113325517624014726 0ustar 00000000000000#!/usr/bin/perl # # A script to check tabs and trailing whitespace from diff files. # # Usage: perl check_spaces.pl file1.diff file2.diff .. fileN.diff # # Use as a precommit hook in .hg/hgrc: # pretxncommit.whitespace = hg export tip|perl tools/check_spaces.pl # # or (if using color extension also) # pretxncommit.whitespace = hg --color never export tip|perl tools/check_spaces.pl # my $line = 0; while(<>) { $line++; if (/^\+\+\+/) { next; } if (/^\+/) { if (/\t/) { print "Tabs in the file\n"; chomp; $_ = substr $_,1; print "line $line: $_.\n"; exit 1 } elsif (/[ \t]+$/) { print "Spaces at the end of line\n"; chomp; $_ = substr $_,1; print "line $line: $_.\n"; exit 1; } } } exit 0 ahven-2.7/tools/make_release.sh0000644000000000000000000000330713325517624014735 0ustar 00000000000000#!/bin/sh # # Copyright (c) 2007 Tero Koskinen # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # # # ./make_release # # For example # ./make_release 1.0 # HGROOT=https://bitbucket.org/tkoskine/ahven failure() { echo "$1" exit 1 } if [ x"$1" = x"" ]; then echo "usage: make_release " exit 1 fi if [ x"$2" != x"" ]; then HGROOT=$2 echo "Using $HGROOT as repository" fi VERSION=$1 AHVEN_TMP_DIR=`mktemp -d` cd $AHVEN_TMP_DIR || failure "cd $AHVEN_TMP_DIR failed" hg clone $HGROOT ahven-$VERSION || failure "checkout failed" cd ahven-$VERSION || failure "cd failed" hg archive -X ".hg*" -p ahven-$VERSION $AHVEN_TMP_DIR/ahven-$VERSION.tar.gz || failure "hg archive .tar.gz failed" hg archive -X ".hg*" -p ahven-$VERSION $AHVEN_TMP_DIR/ahven-$VERSION.zip || failure "hg archive .zip failed" cd .. echo "Release tarball ready at $AHVEN_TMP_DIR/ahven-$VERSION.tar.gz" echo "Release zip ready at $AHVEN_TMP_DIR/ahven-$VERSION.zip" echo "Please remove $AHVEN_TMP_DIR/ahven-$VERSION directory." echo ahven-2.7/tools/test_release.sh0000644000000000000000000000176213325517624015002 0ustar 00000000000000#!/bin/sh fail() { echo $* exit 1 } if [ x"$1" = x"" ]; then echo "usage: test_release.sh [ahven-x.x.tar.gz]" exit 1 fi if [ x"$2" = x"" ]; then TARBALL=/tmp/ahven-$VERSION.tar.gz else TARBALL=$2 fi VERSION=$1 TEMPDIR=`mktemp -d` INSTALL_DIR=`mktemp -d` cd $TEMPDIR || fail "cd to temp failed" tar zxvf $TARBALL || fail "tar $TARBALL failed" cd ahven-$VERSION || fail "cd to ahven-$VERSION failed" make || fail "make failed" make check || fail "make check failed" make check_xml || fail "make check_xml failed" make check_tap || fail "make check_tap failed" make docs || fail "make docs failed" make control || fail "make control failed" make PREFIX=$INSTALL_DIR install || fail "make install failed" cd examples || fail "cd examples failed" export ADA_PROJECT_PATH=$INSTALL_DIR/lib/gnat gnatmake -Pexamples || fail "gnatmake -Pexamples failed" echo "EVERYTHING OK" echo echo "Please remove directories $TEMPDIR and $INSTALL_DIR" echo " rm -rf $TEMPDIR $INSTALL_DIR" echo