Line data    Source code

       1             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       2             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       3             : !!!!                                                                                                                            !!!!
       4             : !!!!    ParaMonte: Parallel Monte Carlo and Machine Learning Library.                                                           !!!!
       5             : !!!!                                                                                                                            !!!!
       6             : !!!!    Copyright (C) 2012-present, The Computational Data Science Lab                                                          !!!!
       7             : !!!!                                                                                                                            !!!!
       8             : !!!!    This file is part of the ParaMonte library.                                                                             !!!!
       9             : !!!!                                                                                                                            !!!!
      10             : !!!!    LICENSE                                                                                                                 !!!!
      11             : !!!!                                                                                                                            !!!!
      12             : !!!!       https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md                                                          !!!!
      13             : !!!!                                                                                                                            !!!!
      14             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      15             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      16             : 
      17             : !>  \brief
      18             : !>  This module contains implementations of the tests of the procedures under the generic interfaces [pm_arrayFill](@ref pm_arrayFill).
      19             : !>
      20             : !>  \fintest
      21             : !>
      22             : !>  \author
      23             : !>  \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             : #if     LK_ENABLED
      28             : #define IS_EQUAL .eqv.
      29             : #else
      30             : #define IS_EQUAL ==
      31             : #endif
      32             : #if     SK_ENABLED
      33             :         character(2,SKC), allocatable   :: vector(:), matrix(:,:), cuboid(:,:,:)
      34             :         character(2,SKC), parameter     :: fill = SKC_"**"
      35             : #elif   LK_ENABLED
      36             :         logical(LKC)    , allocatable   :: vector(:), matrix(:,:), cuboid(:,:,:)
      37             :         logical(LKC)    , parameter     :: fill = .false._LKC
      38             : #elif   IK_ENABLED
      39             :         integer(IKC)    , allocatable   :: vector(:), matrix(:,:), cuboid(:,:,:)
      40             :         integer(IKC)    , parameter     :: fill = huge(1_IKC)
      41             : #elif   CK_ENABLED
      42             :         complex(CKC)    , allocatable   :: vector(:), matrix(:,:), cuboid(:,:,:)
      43             :         complex(CKC)    , parameter     :: fill = cmplx(huge(0._CKC), huge(0._CKC), kind = CKC)
      44             : #elif   RK_ENABLED
      45             :         real(RKC)       , allocatable   :: vector(:), matrix(:,:), cuboid(:,:,:)
      46             :         real(RKC)       , parameter     :: fill = huge(0._RKC)
      47             : #else
      48             : #error  "Unrecognized interface."
      49             : #endif
      50          19 :         type(display_type) :: disp
      51             :         character(6) :: objects(3)
      52             :         integer(IK) :: iobj, itry, oshape(3)
      53          76 :         objects = ["vector", "matrix", "cuboid"]
      54          19 :         assertion = .true._LK
      55             : 
      56          95 :         do iobj = 1, size(objects)
      57        2926 :             do itry = 1, 50
      58       11400 :                 call setUnifRand(oshape, 0_IK, 3_IK)
      59        2850 :                 if (objects(iobj) == "vector") then
      60        3379 :                     vector = getFilled(fill, oshape(1))
      61        1900 :                     assertion = assertion .and. all(shape(vector, IK) == oshape(1:iobj))
      62        2429 :                     assertion = assertion .and. all(vector IS_EQUAL fill)
      63        1900 :                 elseif (objects(iobj) == "matrix") then
      64        5408 :                     matrix = getFilled(fill, oshape(1), oshape(2))
      65        2850 :                     assertion = assertion .and. all(shape(matrix, IK) == oshape(1:iobj))
      66        4458 :                     assertion = assertion .and. all(matrix IS_EQUAL fill)
      67         950 :                 elseif (objects(iobj) == "cuboid") then
      68        8905 :                     cuboid = getFilled(fill, oshape(1), oshape(2), oshape(3))
      69        3800 :                     assertion = assertion .and. all(shape(cuboid, IK) == oshape(1:iobj))
      70        7955 :                     assertion = assertion .and. all(cuboid IS_EQUAL fill)
      71             :                 else
      72             :                     error stop "Unrecognized object shape." ! LCOV_EXCL_LINE
      73             :                 end if
      74        2850 :                 call report()
      75        2850 :                 call test%assert(assertion, SK_"The shape of the output must be the specified input shape.", int(__LINE__, IK))
      76        2907 :                 call test%assert(assertion, SK_"The output must be filled with the specified `fill`.", int(__LINE__, IK))
      77             :             end do
      78             :         end do
      79             : 
      80             :     contains
      81             : 
      82        2850 :         subroutine report()
      83        2850 :             if (test%traceable .and. .not. assertion) then
      84             :                 ! LCOV_EXCL_START
      85             :                 call disp%skip
      86             :                 call disp%show("oshape(1:iobj)")
      87             :                 call disp%show( oshape(1:iobj) )
      88             :                 if (objects(iobj) == "vector") then
      89             :                     call disp%show("vector")
      90             :                     call disp%show( vector )
      91             :                 elseif (objects(iobj) == "matrix") then
      92             :                     call disp%show("matrix")
      93             :                     call disp%show( matrix )
      94             :                 elseif (objects(iobj) == "cuboid") then
      95             :                     call disp%show("cuboid")
      96             :                     call disp%show( cuboid )
      97             :                 end if
      98             :                 ! LCOV_EXCL_STOP
      99             :             end if
     100        2850 :         end subroutine
     101             : 
     102             : #undef IS_EQUAL
     103             : #undef GET_SIZE
     104             : #undef ALL