diff --git a/src/JUnit.xml b/src/JUnit.xml
new file mode 100644
index 0000000..d795c4f
--- /dev/null
+++ b/src/JUnit.xml
@@ -0,0 +1,321 @@
+
+
+
+
+
+
+
+
+ Non-zero exit code encountered
+
+
+
+
+ Custom message describing the error
+
+
+
+
+ Non-zero exit code encountered
+ with an additional descriptive message here
+
+
+
+
+
+ Condition not fullfilled
+
+
+
+
+ index("info!", "!") == 0
+
+
+
+
+ Condition not fullfilled
+ index("info!", "?")
+
+
+
+
+
+
+ Exceptional value 'not a number' found
+
+
+
+
+ Floating point value missmatch
+ expected 2.000000 but got 1.000000 (difference: 1.000000)
+
+
+
+
+ Floating point value missmatch
+ expected 1.500000 but got 1.000000 (difference: 33%)
+
+
+
+
+ Actual value is not 1.5
+
+
+
+
+ Actual value is not a number
+
+
+
+
+
+
+ Exceptional value 'not a number' found
+
+
+
+
+ Floating point value missmatch
+ expected 2.000000000000000 but got 1.000000000000000 (difference: 1.000000000000000)
+
+
+
+
+ Floating point value missmatch
+ expected 1.500000000000000 but got 1.000000000000000 (difference: 33%)
+
+
+
+
+ Actual value is not 1.5
+
+
+
+
+ Actual value is not a number
+
+
+
+
+
+
+ Exceptional value 'not a number' found
+
+
+
+
+ Floating point value missmatch
+ expected (2.000000, 1.000000) but got (1.000000, 2.000000) (difference: 1.414214)
+
+
+
+
+ Floating point value missmatch
+ expected (1.500000, 1.000000) but got (1.000000, 1.500000) (difference: 39%)
+
+
+
+
+ Actual value is not 1.5+1.0i
+
+
+
+
+ Actual value is not a number
+
+
+
+
+
+
+ Exceptional value 'not a number' found
+
+
+
+
+ Floating point value missmatch
+ expected (2.000000000000000, 1.000000000000000) but got (1.000000000000000, 2.000000000000000) (difference: 1.414213562373095)
+
+
+
+
+ Floating point value missmatch
+ expected (1.500000000000000, 1.000000000000000) but got (1.000000000000000, 1.500000000000000) (difference: 39%)
+
+
+
+
+ Actual value is not 1.5+1.0i
+
+
+
+
+ Actual value is not a number
+
+
+
+
+
+ Integer value missmatch
+ expected -4 but got 3
+
+
+
+
+ Actual value is not seven
+
+
+
+
+ Integer value missmatch
+ expected 3 but got 0
+ with an additional descriptive message here
+
+
+
+
+
+ Integer value missmatch
+ expected -4 but got 3
+
+
+
+
+ Actual value is not seven
+
+
+
+
+ Integer value missmatch
+ expected 3 but got 0
+ with an additional descriptive message here
+
+
+
+
+
+ Integer value missmatch
+ expected -4 but got 3
+
+
+
+
+ Actual value is not seven
+
+
+
+
+ Integer value missmatch
+ expected 3 but got 0
+ with an additional descriptive message here
+
+
+
+
+
+ Integer value missmatch
+ expected -4 but got 3
+
+
+
+
+ Actual value is not seven
+
+
+
+
+ Integer value missmatch
+ expected 3 but got 0
+ with an additional descriptive message here
+
+
+
+
+
+
+ Logical value missmatch
+ expected F but got T
+
+
+
+
+ Logical value is not true
+
+
+
+
+ Logical value missmatch
+ expected F but got T
+ with an additional descriptive message
+
+
+
+
+
+ Character value missmatch
+ expected 'negative' but got 'positive'
+
+
+
+
+ Character string should be negative
+
+
+
+
+ Character value missmatch
+ expected 'negative' but got 'positive'
+ with an additional descriptive message
+
+
+
+
+ Character value missmatch
+ expected 'negative' but got 'positive'
+ with an additional descriptive message
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Always failing test
+
+
+
+
+
+ Always failing test
+
+
+
+
+
+
+
+
+
+ Always failing test
+
+
+
+
+
+ Always failing test
+
+
+
+
+
+
+
+
diff --git a/src/JUnit.xsd b/src/JUnit.xsd
new file mode 100644
index 0000000..d1faddd
--- /dev/null
+++ b/src/JUnit.xsd
@@ -0,0 +1,224 @@
+
+
+
+ JUnit test result schema for the Apache Ant JUnit and JUnitReport tasks
+Copyright © 2011, Windy Road Technology Pty. Limited
+The Apache Ant JUnit XML Schema is distributed under the terms of the Apache License Version 2.0 http://www.apache.org/licenses/
+Permission to waive conditions of this license may be requested from Windy Road Support (http://windyroad.org/support).
+
+
+
+
+
+
+
+
+
+ Contains an aggregation of testsuite results
+
+
+
+
+
+
+
+
+
+ Derived from testsuite/@name in the non-aggregated documents
+
+
+
+
+ Starts at '0' for the first testsuite and is incremented by 1 for each following testsuite
+
+
+
+
+
+
+
+
+
+
+
+ Contains the results of executing a testsuite
+
+
+
+
+ Properties (e.g., environment settings) set during test execution
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Indicates that the test was skipped.
+
+
+
+
+
+
+ The message specifying why the test case was skipped
+
+
+
+
+
+
+
+
+ Indicates that the test errored. An errored test is one that had an unanticipated problem. e.g., an unchecked throwable; or a problem with the implementation of the test. Contains as a text node relevant data for the error, e.g., a stack trace
+
+
+
+
+
+
+ The error message. e.g., if a java exception is thrown, the return value of getMessage()
+
+
+
+
+ The type of error that occured. e.g., if a java execption is thrown the full class name of the exception.
+
+
+
+
+
+
+
+
+ Indicates that the test failed. A failure is a test which the code has explicitly failed by using the mechanisms for that purpose. e.g., via an assertEquals. Contains as a text node relevant data for the failure, e.g., a stack trace
+
+
+
+
+
+
+ The message specified in the assert
+
+
+
+
+ The type of the assert.
+
+
+
+
+
+
+
+
+
+ Name of the test method
+
+
+
+
+ Full class name for the class the test method is in.
+
+
+
+
+ Time taken (in seconds) to execute the test
+
+
+
+
+
+
+ Data that was written to standard out while the test was executed
+
+
+
+
+
+
+
+
+
+ Data that was written to standard error while the test was executed
+
+
+
+
+
+
+
+
+
+
+ Full class name of the test for non-aggregated testsuite documents. Class name without the package for aggregated testsuites documents
+
+
+
+
+
+
+
+
+
+ when the test was executed. Timezone may not be specified.
+
+
+
+
+ Host on which the tests were executed. 'localhost' should be used if the hostname cannot be determined.
+
+
+
+
+
+
+
+
+
+ The total number of tests in the suite
+
+
+
+
+ The total number of tests in the suite that failed. A failure is a test which the code has explicitly failed by using the mechanisms for that purpose. e.g., via an assertEquals
+
+
+
+
+ The total number of tests in the suite that errored. An errored test is one that had an unanticipated problem. e.g., an unchecked throwable; or a problem with the implementation of the test.
+
+
+
+
+ The total number of ignored or skipped tests in the suite.
+
+
+
+
+ Time taken (in seconds) to execute the tests in the suite
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/src/jenkins-junit.xsd b/src/jenkins-junit.xsd
new file mode 100644
index 0000000..9ee9cea
--- /dev/null
+++ b/src/jenkins-junit.xsd
@@ -0,0 +1,118 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/testdrive.F90 b/src/testdrive.F90
index 0cd6b83..21a831a 100644
--- a/src/testdrive.F90
+++ b/src/testdrive.F90
@@ -114,7 +114,13 @@ module testdrive
public :: check, test_failed, skip_test
public :: test_interface, collect_interface
public :: get_argument, get_variable, to_string
+ public :: junitxml_open_file
+ public :: junitxml_write_testsuite_opening_tag
+ public :: junitxml_write_testsuite_closing_tag
+ public :: junitxml_close_file
+ !> Unit number for JUnit.xml.
+ integer :: unit_junitxml
!> Single precision real numbers
integer, parameter :: sp = selected_real_kind(6)
@@ -306,9 +312,134 @@ end subroutine collect_interface
character(len=*), parameter :: fmt = '(1x, *(1x, a))'
-
-contains
-
+ contains
+
+ !> Open JUnit.xml file for CLI output of test results.
+ subroutine junitxml_open_file()
+
+ open(newunit=unit_junitxml, file='JUnit.xml', form='formatted', access='sequential', status='replace')
+
+ if (unit_junitxml /= -1) then
+ write(unit_junitxml,'(a)') ''
+ write(unit_junitxml,'(a)') &
+ & ''
+ else
+ write(error_unit, '(a)') "# Error: Could not open JUnit.xml for writing! Program stops."
+ error stop 1
+ endif
+
+ end subroutine junitxml_open_file
+
+ !> Close JUnit.xml file.
+ subroutine junitxml_close_file()
+
+ write(unit_junitxml,'(a)') ''
+ close(unit_junitxml)
+
+ end subroutine junitxml_close_file
+
+ !> Write opening tag for testsuite with name to JUnit.xml.
+ subroutine junitxml_write_testsuite_opening_tag(testsuite_name, id)
+
+ character(len=*), intent(in) :: testsuite_name
+ integer, intent(in) :: id
+
+ character(len=80) :: hostname
+ character(len=8) :: cdate
+ character(len=10) :: ctime
+
+
+ call hostnm(hostname)
+ call date_and_time(DATE=cdate, TIME=ctime)
+
+ write(unit_junitxml,'(a,i0,a)') &
+ & ' '
+ write(unit_junitxml,'(a)') ' '
+ write(unit_junitxml,'(a)') ' '
+
+ end subroutine junitxml_write_testsuite_opening_tag
+
+ !> Write closing tag for testsuite to JUnit.xml.
+ subroutine junitxml_write_testsuite_closing_tag()
+
+ write(unit_junitxml,'(a)') ' '
+ write(unit_junitxml,'(a)') ' '
+ write(unit_junitxml,'(a)') ' '
+
+ end subroutine junitxml_write_testsuite_closing_tag
+
+ !> Write single tag for testcase with name to JUnit.xml.
+ !> Needed, if no failure occurred and no stdout message present.
+ !> Shortens output to a single line in xml file.
+ subroutine junitxml_write_testcase_single_tag(testcase_name)
+
+ character(len=*), intent(in) :: testcase_name
+
+ write(unit_junitxml,'(a)') &
+ & ' '
+
+ end subroutine junitxml_write_testcase_single_tag
+
+ !> Write opening tag for testcase with name to JUnit.xml. Needed, if a failure occurred.
+ subroutine junitxml_write_testcase_opening_tag(testcase_name)
+
+ character(len=*), intent(in) :: testcase_name
+
+ write(unit_junitxml,'(a)') &
+ & ' '
+
+ end subroutine junitxml_write_testcase_opening_tag
+
+ !> Write closing tag for testcase to JUnit.xml.
+ subroutine junitxml_write_testcase_closing_tag(stdout)
+
+ character(len=*), intent(in) :: stdout
+
+ if (len_trim(stdout) > 0) then
+ write(unit_junitxml,'(a)') ' '
+ write(unit_junitxml,'(a)') ' ' // stdout
+ write(unit_junitxml,'(a)') ' '
+ endif
+
+ write(unit_junitxml,'(a)') ' '
+
+ end subroutine junitxml_write_testcase_closing_tag
+
+ !> Write failure message to JUnit.xml.
+ subroutine junitxml_write_testcase_failure(message)
+
+ character(len=*), intent(in) :: message
+
+ write(unit_junitxml,'(a)') &
+ & ' '
+
+ end subroutine junitxml_write_testcase_failure
!> Driver for testsuite
recursive subroutine run_testsuite(collect, unit, stat, parallel)
@@ -396,6 +527,9 @@ recursive subroutine run_unittest(test, unit, stat)
type(error_type), allocatable :: error
character(len=:), allocatable :: message
+ character(len=:), allocatable :: res
+ character(len=:), allocatable :: stdout
+ integer :: s, e
call test%test(error)
if (.not.test_skipped(error)) then
@@ -405,6 +539,34 @@ recursive subroutine run_unittest(test, unit, stat)
!$omp critical(testdrive_testsuite)
write(unit, '(a)') message
!$omp end critical(testdrive_testsuite)
+
+ stdout = ''
+ if (allocated(error)) then
+ stdout = trim(error%message)
+ endif
+
+ s = index(message, '[')
+ e = index(message, ']')
+ res = message(s+1:e-1)
+ select case (res)
+ case ('FAILED', 'UNEXPECTED PASS')
+ call junitxml_write_testcase_opening_tag(test%name)
+ call junitxml_write_testcase_failure(res)
+ call junitxml_write_testcase_closing_tag(stdout)
+ case ('EXPECTED FAIL', 'PASSED')
+ if (len_trim(stdout) > 0) then
+ call junitxml_write_testcase_opening_tag(test%name)
+ call junitxml_write_testcase_closing_tag(stdout)
+ else
+ call junitxml_write_testcase_single_tag(test%name)
+ endif
+ case ('SKIPPED')
+ res = res
+ case default
+ write(unit, '(a)') "Error: Unknown test result '" // res // "' in test '" // test%name // "'!"
+ error stop 2
+ end select
+
if (allocated(error)) then
call clear_error(error)
end if
diff --git a/test/main.f90 b/test/main.f90
index a155118..d3a18f5 100644
--- a/test/main.f90
+++ b/test/main.f90
@@ -15,7 +15,9 @@
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite, new_testsuite, testsuite_type, &
- & select_suite, run_selected, get_argument
+ & select_suite, run_selected, get_argument, &
+ & junitxml_open_file, junitxml_close_file, &
+ & junitxml_write_testsuite_opening_tag, junitxml_write_testsuite_closing_tag
use test_check, only : collect_check
use test_select, only : collect_select
implicit none
@@ -34,18 +36,24 @@ program tester
call get_argument(1, suite_name)
call get_argument(2, test_name)
+ call junitxml_open_file()
+
if (allocated(suite_name)) then
is = select_suite(testsuites, suite_name)
if (is > 0 .and. is <= size(testsuites)) then
if (allocated(test_name)) then
write(error_unit, fmt) "Suite:", testsuites(is)%name
+ call junitxml_write_testsuite_opening_tag(testsuites(is)%name, is)
call run_selected(testsuites(is)%collect, test_name, error_unit, stat)
+ call junitxml_write_testsuite_closing_tag()
if (stat < 0) then
error stop 1
end if
else
write(error_unit, fmt) "Testing:", testsuites(is)%name
+ call junitxml_write_testsuite_opening_tag(testsuites(is)%name, is)
call run_testsuite(testsuites(is)%collect, error_unit, stat)
+ call junitxml_write_testsuite_closing_tag()
end if
else
write(error_unit, fmt) "Available testsuites"
@@ -57,7 +65,9 @@ program tester
else
do is = 1, size(testsuites)
write(error_unit, fmt) "Testing:", testsuites(is)%name
+ call junitxml_write_testsuite_opening_tag(testsuites(is)%name, is)
call run_testsuite(testsuites(is)%collect, error_unit, stat)
+ call junitxml_write_testsuite_closing_tag()
end do
end if
@@ -66,5 +76,6 @@ program tester
error stop 1
end if
+ call junitxml_close_file()
end program tester