!
!  Fortran Unit Testing Verification Module
!     In-line Fortran program unit testing and verification
!
!  Version 09X29
!
!   Charles O'Neill April 30, 2009
!    charles.oneill@gmail.com
!    www.caselab.okstate.edu
!
!  To Use:
!    1) Call PassOrFail with Variable and optional Text and Tolerance. Variables
!         outside tolerance result in a recorded failure.
!    2) Call PassOrFailSummary
!
!
!  To Test this module:
!            program TestVerify
!              use ForUTV
!              call ForUTVExample()
!            end program
!
! Copyright (c) 2009 Charles O'Neill
!
! Permission is hereby granted, free of charge, to any person
! obtaining a copy of this software and associated documentation
! files (the "Software"), to deal in the Software without
! restriction, including without limitation the rights to use,
! copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the
! Software is furnished to do so, subject to the following
! conditions:
!
! The above copyright notice and this permission notice shall be
! included in all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
! OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
! NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
! HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
! WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
! FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
! OTHER DEALINGS IN THE SOFTWARE.

module ForUTV
    implicit none
    integer,parameter :: SinglePrecision = 4, DoublePrecision = 8

    ! PassOrFailData Data Structure
    type PassOrFailData
        integer :: PassCount, FailCount
        logical :: IsInitialized = .false.
    end type

    ! Failure Text Linked List
    type TextList
        type(TextList), pointer :: next
        character(len=50) :: text
    end type

    ! Default PassOrFailData
    type (PassOrFailData),save :: VerifyCounts

    ! Linked List head and current node
    type (TextList), pointer, save :: ListHead, Current

    ! Function Interface for PassOrFail
    interface PassOrFail
        module procedure PassOrFail_rank0Single
        module procedure PassOrFail_rank0Double
        module procedure PassOrFail_rank1
        module procedure PassOrFail_rank2
        module procedure PassOrFail_rank2Integer
        module procedure PassOrFail_rank3
        module procedure PassOrFail_String
        ! Add you own data type here.....
    end interface

    ! Restrict Use of Module's Internal Functions
    private
    public PassOrFailSummary, PassOrFail, VerifySubroutine
    public ForUTVExample

contains

  ! Example Usage of ForUTV.f90
  subroutine ForUTVExample()
    character(len=10) :: A, B
    A = "BigBadWolf"
    B = "TinyPiglet"

    ! This tests a subroutine by name
    call VerifySubroutine(testSubroutine,"testSubroutine()")

    ! Pretend that multiple write statements occur here
    write(*,*) "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"
    write(*,*) " ."
    write(*,*) " ."
    write(*,*) " Pretend that the program spends some time here and that"
    write(*,*) " multiple write statements occur. You *might* not notice"
    write(*,*) " a failure among the chaff."
    write(*,*) " ."
    write(*,*) " ."
    write(*,*) "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"

    ! Or call PassOrFail directly
    call PassOrFail(epsilon(1.0d0)-tiny(1.0d0),"Direct Function Calls")
    call PassOrFail(0.01,"Direct Call should Fail")
    call PassOrFail_String( A,A ,"Test String Pass")
    call PassOrFail_String( A,B ,"Test String should Fail")
    call PassOrFail_String( B,"TinyPiglet" ,"Test Direct String Pass")

    ! Print out the pass/fail Summary
    call PassOrFailSummary
  end subroutine


  ! Test Pressure
  subroutine testSubroutine()
    real(DoublePrecision) :: P
    P = 0.4d0
    call PassOrFail(P-0.4d0,"testFunction should pass")
    call PassOrFail(P-0.4d0,"testFunction should pass again")
    call PassOrFail(P-0.5d0,"testFunction should Fail")
    call PassOrFail(P-0.41d0,"testFunction should pass", Tolerance=0.02d0)
  end subroutine

  !.......................................................
  ! PassOrFail for a real scalar
  !     Pass requires absolute value of Scalar less than tolerance
  subroutine PassOrFail_rank0Single(Scalar,Text,Tolerance)
    real(SinglePrecision) :: Scalar
    character(len=*),optional :: Text
    real(SinglePrecision),optional :: Tolerance
    real(SinglePrecision) :: WorkingTolerance

    ! Initialize Data if needed
    if(.NOT.VerifyCounts%IsInitialized) call initPassOrFail()

    ! Tolerance
    if(present(Tolerance))then
        ! Tolerance from call
        WorkingTolerance = Tolerance
    else
        ! Default Tolerance
        WorkingTolerance = epsilon(1.0)
    endif

    ! Check if pass or fail
    if( abs(Scalar)>WorkingTolerance )then
        VerifyCounts%FailCount = VerifyCounts%FailCount + 1
        if(present(Text))then
            write(*,*) "  FAILED ", Text
            call addTextList(Text)
        else
            write(*,*) "  FAILED at unknown location"
        endif
    else
        VerifyCounts%PassCount = VerifyCounts%PassCount + 1
        write(*,*) "  passed  ", Text
    endif
  end subroutine

  !.......................................................
  ! PassOrFail for a double scalar
  !     Pass requires absolute value of Scalar less than tolerance
  subroutine PassOrFail_rank0Double(Scalar,Text,Tolerance)
    real(DoublePrecision) :: Scalar
    character(len=*),optional :: Text
    real(DoublePrecision),optional :: Tolerance
    real(DoublePrecision) :: WorkingTolerance

    ! Initialize Data if needed
    if(.NOT.VerifyCounts%IsInitialized) call initPassOrFail()

    ! Tolerance
    if(present(Tolerance))then
        ! Tolerance from call
        WorkingTolerance = Tolerance
    else
        ! Default Tolerance
        WorkingTolerance = epsilon(1.0d0)
    endif

    ! Check if pass or fail
    if( abs(Scalar)>WorkingTolerance )then
        VerifyCounts%FailCount = VerifyCounts%FailCount + 1
        if(present(Text))then
            write(*,*) "  FAILED ", Text
            call addTextList(Text)
        else
            write(*,*) "  FAILED at unknown location"
        endif
    else
        VerifyCounts%PassCount = VerifyCounts%PassCount + 1
        write(*,*) "  passed  ", Text
    endif
  end subroutine

  !.......................................................
  ! PassOrFail for a vector
  !     Pass requires sum of absolute value of vector less than tolerance
  subroutine PassOrFail_rank1(Vector,Text,Tolerance)
    real(DoublePrecision) :: Vector(:)
    character(len=*),optional :: Text
    real(DoublePrecision),optional :: Tolerance
    real(DoublePrecision) :: WorkingTolerance

    ! Initialize Data if needed
    if(.NOT.VerifyCounts%IsInitialized) call initPassOrFail()

    ! Tolerance
    if(present(Tolerance))then
        ! Tolerance from call
        WorkingTolerance = Tolerance
    else
        ! Default Tolerance
        WorkingTolerance = epsilon(1.0d0)
    endif

    ! Check if pass or fail
    if( sum(abs(Vector))>WorkingTolerance )then
        VerifyCounts%FailCount = VerifyCounts%FailCount + 1
        if(present(Text))then
            write(*,*) "  FAILED ", Text
            call addTextList(Text)
        else
            write(*,*) "  FAILED at unknown location"
        endif
    else
        VerifyCounts%PassCount = VerifyCounts%PassCount + 1
        write(*,*) "  passed  ", Text
    endif
  end subroutine

  !.......................................................
  ! PassOrFail for a matrix
  !     Pass requires sum of absolute value of matrix less than tolerance
  subroutine PassOrFail_rank2(Matrix,Text,Tolerance)
    real(DoublePrecision) :: Matrix(:,:)
    character(len=*),optional :: Text
    real(DoublePrecision),optional :: Tolerance
    real(DoublePrecision) :: WorkingTolerance

    ! Initialize Data if needed
    if(.NOT.VerifyCounts%IsInitialized) call initPassOrFail()

    ! Tolerance
    if(present(Tolerance))then
        ! Tolerance from call
        WorkingTolerance = Tolerance
    else
        ! Default Tolerance
        WorkingTolerance = epsilon(1.0d0)
    endif

    ! Check if pass or fail
    if( sum(abs(Matrix))>WorkingTolerance )then
        VerifyCounts%FailCount = VerifyCounts%FailCount + 1
        if(present(Text))then
            write(*,*) "  FAILED ", Text
            call addTextList(Text)
        else
            write(*,*) "  FAILED at unknown location"
        endif
    else
        VerifyCounts%PassCount = VerifyCounts%PassCount + 1
        write(*,*) "  passed  ", Text
    endif
  end subroutine

  !.......................................................
  ! PassOrFail for a matrix
  !     Pass requires sum of absolute value of matrix less than tolerance
  subroutine PassOrFail_rank2Integer(Matrix,Text,Tolerance)
    integer :: Matrix(:,:)
    character(len=*),optional :: Text
    integer,optional :: Tolerance
    integer :: WorkingTolerance

    ! Initialize Data if needed
    if(.NOT.VerifyCounts%IsInitialized) call initPassOrFail()

    ! Tolerance
    if(present(Tolerance))then
        ! Tolerance from call
        WorkingTolerance = Tolerance
    else
        ! Default Tolerance
        WorkingTolerance = 0
    endif

    ! Check if pass or fail
    if( sum(abs(Matrix))>WorkingTolerance )then
        VerifyCounts%FailCount = VerifyCounts%FailCount + 1
        if(present(Text))then
            write(*,*) "  FAILED ", Text
            call addTextList(Text)
        else
            write(*,*) "  FAILED at unknown location"
        endif
    else
        VerifyCounts%PassCount = VerifyCounts%PassCount + 1
        write(*,*) "  passed  ", Text
    endif
  end subroutine

  !.......................................................
  ! PassOrFail for a matrix of 3 dimensions
  !     Pass requires sum of absolute value of matrix less than tolerance
  subroutine PassOrFail_rank3(Matrix,Text,Tolerance)
    real(DoublePrecision) :: Matrix(:,:,:)
    character(len=*),optional :: Text
    real(DoublePrecision),optional :: Tolerance
    real(DoublePrecision) :: WorkingTolerance

    ! Initialize Data if needed
    if(.NOT.VerifyCounts%IsInitialized) call initPassOrFail()

    ! Tolerance
    if(present(Tolerance))then
        ! Tolerance from call
        WorkingTolerance = Tolerance
    else
        ! Default Tolerance
        WorkingTolerance = epsilon(1.0d0)
    endif

    ! Check if pass or fail
    if( sum(abs(Matrix))>WorkingTolerance )then
        VerifyCounts%FailCount = VerifyCounts%FailCount + 1
        if(present(Text))then
            write(*,*) "  FAILED ", Text
            call addTextList(Text)
        else
            write(*,*) "  FAILED at unknown location"
        endif
    else
        VerifyCounts%PassCount = VerifyCounts%PassCount + 1
        write(*,*) "  passed  ", Text
    endif
  end subroutine

  !.......................................................
  ! PassOrFail for a matrix of 3 dimensions
  !     Pass requires sum of absolute value of matrix less than tolerance
  subroutine PassOrFail_String(stringA,stringB,Text)
    character(len=*) :: stringA, stringB
    character(len=*),optional :: Text

    ! Initialize Data if needed
    if(.NOT.VerifyCounts%IsInitialized) call initPassOrFail()

    ! Check if pass or fail
    if( stringA /= stringB )then
        VerifyCounts%FailCount = VerifyCounts%FailCount + 1
        if(present(Text))then
            write(*,*) "  FAILED ", Text
            call addTextList(Text)
        else
            write(*,*) "  FAILED at unknown location"
        endif
    else
        VerifyCounts%PassCount = VerifyCounts%PassCount + 1
        write(*,*) "  passed  ", Text
    endif
  end subroutine


  !----------------------------------------------------------------------------

  ! Call Specific "Named" subroutine for Verification
  !    (Generously Sprinkle with the Fortran Magic Wand)
  subroutine VerifySubroutine(Func,String)
    character(len=*) :: String
    interface
      subroutine Func()
      end subroutine
    end interface
    write(*,*) String
    call Func()
  end subroutine

  ! Initialize PassOrFail Data
  subroutine initPassOrFail
    ! Setup Linked List
    allocate(ListHead)
    Current => ListHead
    nullify(Current%next)

    ! Initialize the pass and fail counts
    VerifyCounts%PassCount = 0
    VerifyCounts%FailCount = 0

    ! Remember that initialization occured
    VerifyCounts%IsInitialized=.true.

  end subroutine

  ! Adds a line of text to the *failure* list
  subroutine addTextList(Text)
    character(len=*) :: Text
    Current%text = Text
    ! Add new node to Linked List
    allocate(Current%next)
    Current => Current%next
    nullify(Current%next)
  end subroutine

  ! prints the *failure* list
  subroutine printTextList()
    ! Start at Linked List Head
    Current => ListHead
    if(.NOT.associated(Current%next)) return
    write(*,*) "          List of Failures:"
    ! Go to next node
    do while( associated(Current%next) )
        write(*,*) "               ",Current%text
        ! Linked list points to next node
        Current => Current%next
    end do
    write(*,*) "===================================================================="
  end subroutine

  ! Summary of PassOrFail Verification
  subroutine PassOrFailSummary
    write(*,*)
    write(*,*) "===================================================================="
    write(*,*) "                        Verify Completed:"
    write(*,'( "                            Passed: ", i4)' ) VerifyCounts%PassCount
    write(*,'( "                            FAILED: ", i4)' ) VerifyCounts%FailCount
    write(*,*) "===================================================================="
    call printTextList()
  end subroutine
end module