46 use,
intrinsic ::
iso_fortran_env,
only:
output_unit
61 character(
*, SK) ,
parameter :: NLC
= new_line(SK_
"a")
62 character(
*, SK) ,
parameter :: MODULE_NAME
= SK_
"pm_test"
64 integer(IK) ,
parameter :: TIME_FIELD_LEN
= 9_IK
65 integer(IK) :: mv_testCounterOld
66 integer(IK) :: mv_testCounter
67 integer(IK) :: mv_nfail
68 integer(IK) :: mv_npass
69 type(css_type) ,
allocatable :: mv_failedTestFuncName(:)
70 character(:, SK) ,
allocatable :: mc_passedString
71 character(:, SK) ,
allocatable :: mc_failedString
72 logical(LK) :: mv_uninit
= .true._LK
73 class(timer_type) ,
allocatable :: mv_timer
74 type(image_type) :: mv_image
93 character(:, SK) ,
allocatable :: inp
94 character(:, SK) ,
allocatable :: out
115 character(:, SK) ,
allocatable :: path
141 character(:, SK) ,
allocatable :: name
145 integer(IK) :: counter
= 0_IK
147 character(:, SK) ,
allocatable :: id
210 integer(IK) ,
private :: counter
= 0_IK
211 logical(LK) ,
private :: asserted
= .true._LK
212 logical(LK) ,
public :: traceable
261#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
266 mv_uninit
= .false._LK
271 mv_testCounterOld
= 0_IK
272 mv_testCounter
= 0_IK
276 call setResized(mv_failedTestFuncName, mv_nfail
+ 1_IK)
277 write(
output_unit,
"(*(g0,:,' '))")
308#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
314 real(RKG) :: percentageTestPassed
315 character(:, SK),
allocatable :: msg, color
316 character(
*),
parameter :: format
= "(*(g0,:,' '))"
317 integer(IK) :: ntotal, ifail, ndigit
319 ntotal
= mv_npass
+ mv_nfail
320 percentageTestPassed
= 0._RKG
321 if (ntotal
/= 0_IK) percentageTestPassed
= 100_IK * mv_npass
/ real(ntotal, RKG)
322 if (mv_image
%is
%first)
then
324 if (
nint(percentageTestPassed, IK)
== 0_IK)
then
329 msg
= msg
//bright//color
//getStr(percentageTestPassed,SK_
"(f0.2)")
//SK_
"% of "//getStr(ntotal)
//SK_
" tests passed. "//reset
330 if (
0_IK < mv_nfail)
then
335 msg
= msg
//bright//color
//getStr(mv_nfail, SK_
"(g0)")
//SK_
" tests failed. "//reset
336 msg
= msg
//bright//fyellow//SK_
"The total elapsed wall-clock time: "//getStr(mv_timer
%time(since
= mv_timer
%start), SK_
"(f0.6)")
//SK_
" seconds."//reset
337 write(
output_unit, format) NLC
//msg
//NLC
339 if (mv_nfail
> 0_IK)
then
340 write(
output_unit, format) NLC
//bright//fred//SK_
"The following tests FAILED:"//reset//NLC
341 do ifail
= 1, mv_nfail
342 write(
output_unit, format)
bright//fred//TABEQV//adjustr(
getStr(ifail, length
= ndigit))
//SK_
") "//mv_failedTestFuncName(ifail)
%val
//reset
344 write(
output_unit, format) NLC
//bright//fred//SK_
"Errors occurred while running the ParaMonte tests."
345 write(
output_unit, format) SK_
"Please report this issue at: "//bright//fcyan//underlined//SK_
"https://github.com/cdslaborg/paramonte/issues"//reset//NLC
//NLC
347 write(
output_unit, format) NLC
//bright//fred//SK_
"To get information about the cause of failure, compile the library with FPP runtime checks enabled and rerun the tests."//reset//NLC
352 call mv_image
%finalize()
353 mv_uninit
= .true._LK
413#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
418 character(
*, SK),
intent(in),
optional :: host, inp, out
419 logical(LK),
intent(in),
optional :: traceable
422 test
%image
= mv_image
423 test
%disp
= display_type()
426 if (
present(traceable))
then
427 test
%traceable
= traceable
430 test
%traceable
= .true._LK
432 test
%traceable
= .false._LK
435 if (
present(host))
then
436 test
%host
%name = trim(
adjustl(host))
438 test
%host
%name
= SK_
"@unknown_scope"
440 if (
present(inp))
then
443 test
%dir
%inp
= SK_
"./input"
445 if (
present(out))
then
448 test
%dir
%out
= SK_
"./output"
451 if (test
%image
%is
%first
.and. .not. isDir(test
%dir
%out))
then
452 if (
isFailedMakeDir(test
%dir
%out))
error stop MODULE_NAME
//SK_
"@test_typer(): Failed to generate the test module output directory: "//test
%dir
%out
454 call test
%image
%sync()
509#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
513 procedure(
logical(LK)) :: getAssertion
515 character(
*, SK),
intent(in),
optional :: name
516 logical(LK) :: assertion
517 if (
present(name))
then
518 self
%func
%name = trim(
adjustl(name))
519 if (
4_IK < len(self
%func
%name, IK))
then
520 if (self
%func
%name(
1:
5)
== SK_
"test_") self
%func
%name
= self
%func
%name(
6:)
524 integer(IK),
allocatable :: loc(:)
527 call setLoc(loc, nloc, self
%func
%name, SK_
"_", blindness
= 1_IK)
528 if (nloc
== 0_IK)
then
529 self
%func
%id
= SK_
"#1"
530 elseif (
isStrInteger(self
%func
%name(loc(nloc)
+ 1 :)))
then
531 self
%func
%id
= SK_
"#"//self
%func
%name(loc(nloc)
+ 1 :)
532 self
%func
%name
= self
%func
%name(
1 : loc(nloc)
- 1)
534 self
%func
%id
= SK_
"#1"
535 self
%func
%name
= name
539 self
%func
%id
= SK_
"#1"
540 self
%func
%name
= SK_
"unknown"
544 self
%func
%name
= self
%host
%name
//SK_
"@"//trim(
adjustl(self
%func
%name))
546 assertion
= getAssertion()
547 self
%asserted
= self
%asserted
.and. assertion
548 call self
%assert(assertion)
549 self
%func
%counter
= 0_IK
593#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
598 logical(LK),
intent(in) :: assertion
600 integer(IK),
intent(in),
optional :: line
601 character(
*, SK),
intent(in),
optional :: desc
602 character(:, SK),
allocatable :: statusMsg
603 character(:, SK),
allocatable :: desc_def
604 character(:, SK),
allocatable :: traceback
605 character(:, SK),
allocatable :: assertionID
606 character(:, SK),
allocatable :: errmsg
608 self
%func
%timer
%delta
= self
%func
%timer
%time(since
= self
%func
%timer
%start)
- self
%func
%timer
%clock
609 self
%func
%timer
%clock
= self
%func
%timer
%time(since
= self
%func
%timer
%start)
610 self
%func
%counter
= self
%func
%counter
+ 1_IK
611 if (
present(desc))
then
614 desc_def
= SK_
"unavailable"
616 if (
present(line))
then
617 traceback
= SK_
"traceback test source line: "//getStr(line)
621 assertionID
= self
%func
%name
//self
%func
%id
//SK_
"-"//getStr(self
%func
%counter)
//SK_
" "
623 mv_npass
= mv_npass
+ 1_IK
624 statusMsg
= mc_passedString
626 mv_nfail
= mv_nfail
+ 1_IK
627 statusMsg
= mc_failedString
628 if (
size(mv_failedTestFuncName,
1, IK)
< mv_nfail)
call setResized(mv_failedTestFuncName)
629 mv_failedTestFuncName(mv_nfail)
%val
= assertionID
631 mv_testCounter
= mv_testCounter
+ 1_IK
632 do iid
= 1, self
%image
%count
633 if (iid
== self
%image
%id)
then
634 write(self
%disp
%unit,
"(*(A))")
&
635 SK_
"["//adjustr(
getStr(mv_testCounter))
//SK_
"] testing "// &
636 getCoreHalo(
79_IK, assertionID, SK_
".",
0_IK)
//SK_
" "//statusMsg
// &
637 SK_
" in "//adjustr(
getStr(self
%func
%timer
%delta, SK_
"(f0.4)", TIME_FIELD_LEN))
// &
638 SK_
" out of "//adjustr(
getStr(self
%func
%timer
%clock, SK_
"(f0.4)", TIME_FIELD_LEN))
// &
639 SK_
" seconds on image "//getStr(self
%image
%id)
641#if CAF_ENABLED || MPI_ENABLED
644 call execute_command_line(
" ", cmdstat
= stat)
646 call self
%image
%sync()
650 call self
%func
%timer
%wait(
0.0001_RKG)
651 if (self
%traceable
.and. .not. assertion)
then
652 errmsg
= SK_
"The test assertion is FALSE."//NLC
//SK_
"The assertion description: "//trim(
adjustl(desc_def))
//NLC
//traceback
653 call setAborted(msg
= errmsg, prefix
= SK_
"ParaMonteTest"//self
%func
%name)
683#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
689 character(:, SK),
allocatable :: statusMsg
690 if (self
%asserted)
then
691 statusMsg
= mc_passedString
693 statusMsg
= mc_failedString
695 self
%host
%timer
%delta
= self
%host
%timer
%time(since
= self
%host
%timer
%start)
697 SK_
"["//adjustr(
getStr(mv_testCounter
- mv_testCounterOld, length
= getCountDigit(mv_testCounter)))
//SK_
"] testing "// &
698 getCoreHalo(
79_IK, self
%host
%name
//SK_
" ", SK_
".",
0_IK)
//SK_
" "//statusMsg
// &
699 SK_
" in "//adjustr(
getStr(self
%host
%timer
%delta, SK_
"(f0.4)", TIME_FIELD_LEN))
// &
700 SK_
" out of "//adjustr(
getStr(mv_timer
%time(since
= mv_timer
%start), SK_
"(f0.4)", TIME_FIELD_LEN))
// &
701 SK_
" seconds on image "//getStr(self
%image
%id)
//reset
702 mv_testCounterOld
= mv_testCounter
703 call self
%image
%sync()
710 function openFile(self, path, label, status, position)
result(file)
712 character(
*, SK),
intent(in),
optional :: path, label, status, position
713 character(:, SK),
allocatable :: prefix_def, status_def, position_def
715 if (
present(position))
then
716 position_def
= position
718 position_def
= SK_
"asis"
720 if (
present(status))
then
723 status_def
= SK_
"unknown"
725 if (
present(path))
then
728 if (
present(label))
then
729 prefix_def
= SK_
"@"//label
733 file
%path
= self
%dir
%out
//SK_
"/"//self
%func
%name
//prefix_def
//SK_
"@"//getStr(self
%image
%id)
//SK_
".txt"
736#if INTEL_ENABLED && WINDOWS_ENABLED
737#define SHARED, shared
741 open(
file = file
%path,
newunit = file
%unit,
status = status_def,
position = position_def SHARED)
749 function getLogFuncMVN(ndim,Point)
result(logFunc) BIND_C
751 integer(IK) ,
intent(in) :: ndim
752 real(RKG) ,
intent(in) :: Point(ndim)
757 real(RKG) ,
parameter :: LOG_INVERSE_SQRT_TWO_PI
= log(
1._RKG / sqrt(
2._RKG * acos(
-1._RKG)))
774 logFunc
= ndim
* LOG_INVERSE_SQRT_TWO_PI
- 0.5_RKG * sum(Point
**2_IK)
794 end function getLogFuncMVN
800 function getLogFuncBanana2D(ndim,Point)
result(logFunc) BIND_C
805 integer(IK) ,
intent(in) :: ndim
806 real(RKG) ,
intent(in) :: Point(ndim)
811 integer(IK) ,
parameter :: NPAR
= 2_IK
812 real(RKG) ,
parameter :: normfac
= 0.3_RKG
813 real(RKG) ,
parameter :: lognormfac
= log(normfac)
814 real(RKG) ,
parameter :: a
= 0.7_RKG, b
= 1.5_RKG
815 real(RKG) ,
parameter :: MeanB(NPAR)
= [
-5.0_RKG ,
0._RKG ]
816 real(RKG) ,
parameter :: MeanG(NPAR)
= [
3.5_RKG ,
0._RKG ]
817 real(RKG) ,
parameter :: CovMatB(NPAR,NPAR)
= reshape([
0.25_RKG,
0._RKG,
0._RKG,
0.81_RKG],shape
=shape(CovMatB))
818 real(RKG) ,
parameter :: CovMatG(NPAR,NPAR)
= reshape([
0.15_RKG,
0._RKG,
0._RKG,
0.15_RKG],shape
=shape(CovMatB))
819 real(RKG) ,
parameter :: InvCovMatB(NPAR,NPAR)
= reshape([
4._RKG,
0._RKG,
0._RKG,
1.23456790123457_RKG],shape
=shape(InvCovMatB))
820 real(RKG) ,
parameter :: InvCovMatG(NPAR,NPAR)
= reshape([
6.66666666666667_RKG,
0._RKG,
0._RKG,
6.66666666666667_RKG],shape
=shape(InvCovMatG))
821 real(RKG) ,
parameter :: logSqrtDetInvCovB
= log(
sqrt(
4.93827160493827_RKG))
822 real(RKG) ,
parameter :: logSqrtDetInvCovG
= log(
sqrt(
44.4444444444445_RKG))
823 real(RKG) :: PointSkewed(NPAR)
824 real(RKG) :: LogProb(
2)
826 PointSkewed(
1)
= -Point(
1)
827 PointSkewed(
2)
= +Point(
2)
835 PointSkewed(
2)
= a
* PointSkewed(
2)
836 PointSkewed(
1)
= PointSkewed(
1)
/a
- b
*(PointSkewed(
2)
**2 + a
**2)
849 end function getLogFuncBanana2D
857 function getLogFuncEggBox2D(ndim,Point)
result(logFunc) BIND_C
858 integer(IK) ,
intent(in) :: ndim
859 real(RKG) ,
intent(in) :: Point(ndim)
861 real(RKG) ,
parameter :: PI
= acos(
-1._RKG)
866 logFunc
= (
2._RKG + cos(
5_IK * PI
* Point(
1)
- 2.5_RKG * PI)
* cos(
5_IK * PI
* Point(
2)
- 2.5_RKG * PI))
** 5.0
867 end function getLogFuncEggBox2D
Return an allocatable array containing the indices of the locations within the input array where the ...
Generate and return an array of specified rank and shape of arbitrary intrinsic type and kind with it...
Allocate or resize (shrink or expand) an input allocatable scalar string or array of rank 1....
Generate and return the natural logarithm of the normalization coefficient of the Probability Density...
Generate and return the natural logarithm of the Probability Density Function (PDF) of the MultiVaria...
Write the input string in the format of a fatal error to the output, then call error stop or return t...
Generate and return the natural logarithm of the sum of the exponential of the input array robustly (...
Generate and return the number of digits in the input integer.
Generate and return .true. if all characters of the input string collectively represent an integer.
Generate and return .true. is the input path is an extant system directory, otherwise return ....
Generate and return .true. if the attempt to create the requested directory path fails,...
Generate and return the conversion of the input value to an output Fortran string,...
This module contains procedures and generic interfaces for finding locations of a pattern in arrays o...
This module contains procedures and generic interfaces for efficient initialization of arbitrary rect...
This module contains procedures and generic interfaces for resizing allocatable arrays of various typ...
This module contains the derived types for generating allocatable containers of scalar,...
This module contains classes and procedures for computing various statistical quantities related to t...
This module contains classes and procedures for reporting and handling errors.
This module contains classes and procedures for input/output (IO) or generic display operations on st...
type(display_type) disp
This is a scalar module variable an object of type display_type for general display.
character(*, SK), parameter TABEQV
The scalar character of default kind SK of len = 4 representing the default string that is used in pl...
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
integer, parameter RK
The default real kind in the ParaMonte library: real64 in Fortran, c_double in C-Fortran Interoperati...
integer, parameter LK
The default logical kind in the ParaMonte library: kind(.true.) in Fortran, kind(....
integer, parameter IK
The default integer kind in the ParaMonte library: int32 in Fortran, c_int32_t in C-Fortran Interoper...
integer, parameter SK
The default character kind in the ParaMonte library: kind("a") in Fortran, c_char in C-Fortran Intero...
This module contains the procedures and interfaces for computing the natural logarithm of the sum of ...
This module contains procedures and generic interfaces for converting numbers to different bases in d...
This module contains procedures and generic interfaces for facilitating parallel computations or comp...
This module contains procedures and generic interfaces for styling strings according for display on D...
character(5, SK) fcyan
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
character(5, SK) fgreen
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
character(4, SK) bright
The ANSI escape code that makes subsequent texts appear bold/bright.
character(4, SK) underlined
The ANSI escape code that makes subsequent texts appear underlined.
character(4, SK) reset
The ANSI escape code that resets all previously specified ANSI text styles (same as [](pm_strANSI::en...
character(5, SK) fyellow
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
character(5, SK) fred
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
This module contains the uncommon and hardly representable ASCII characters as well as procedures for...
This module contains classes and procedures for manipulating system file/folder paths.
This module contains a simple unit-testing framework for the Fortran libraries, including the ParaMon...
subroutine setTestSummary(self)
Summarize the suite of tests performed by the parent object of type test_type of this method.
subroutine setInitial()
Initialize the global module variables for testing.
subroutine setSummary()
Summarize the collection of all tests performed on all modules (or scoping units).
type(test_type) function test_typer(host, inp, out, traceable)
Generate and return an object of type test_type.
subroutine setTestFunc(self, getAssertion, name)
Run the input test function and verify the assertion returned by the test function.
subroutine setTestAsserted(self, assertion, desc, line)
Test the validity of the input assertion and if it does not hold,
This module contains the timer procedures and derived types to facilitate timing applications at runt...
This module contains the generic procedures for converting values of different types and kinds to For...
This is the css_type type for generating instances of container of scalar of string objects.
This is the derived type for generating objects to gracefully and verbosely handle runtime unexpected...
Generate and return an object of type display_type.
This is the image_type type for generating objects that contain information about the current image/p...
This is the module private derived type for constructing objects that contain the input and output di...
This is the module private derived type for constructing objects that contain the path to a file and ...
This is the derived type test_type for generating objects that facilitate testing of a series of proc...
This is the abstract base derived type that serves as a simple container template for other timer cla...