!> Fortranテスト用の簡易アサート・進捗表示・一時ファイル補助。
module test_support
  use iso_fortran_env, only: error_unit, output_unit
  use bem_kinds, only: dp, i32, i64
  implicit none
  private

  !> テストランナー状態（モジュール変数）。
  integer, save :: ts_total_tests = 0
  integer, save :: ts_current_test = 0
  integer, save :: ts_passed = 0
  integer, save :: ts_failed = 0
  integer, save :: ts_assertions = 0
  logical, save :: ts_current_ok = .true.
  logical, save :: ts_in_test = .false.
  character(len=128), save :: ts_current_name = ''

  ! 既存 API（完全互換）
  public :: fail_test
  public :: assert_true
  public :: assert_equal_i32
  public :: assert_equal_i64
  public :: assert_close_dp
  public :: assert_allclose_1d
  public :: delete_file_if_exists
  public :: ensure_directory
  public :: remove_empty_directory

  ! 新 API（テストランナー）
  public :: test_init
  public :: test_begin
  public :: test_end
  public :: test_summary

contains

  ! ============================================================
  !  テストランナー API
  ! ============================================================

  !> テストスイートを初期化する。
  !! @param[in] total_tests 予定テスト数（進捗表示 [n/total] に使用）。
  subroutine test_init(total_tests)
    integer, intent(in) :: total_tests

    ts_total_tests = total_tests
    ts_current_test = 0
    ts_passed = 0
    ts_failed = 0
    ts_assertions = 0
    ts_in_test = .false.
  end subroutine test_init

  !> テストケースの開始を宣言する。
  !! @param[in] name テストケース名。
  subroutine test_begin(name)
    character(len=*), intent(in) :: name

    ! 前のテストが test_end 未呼びのまま来た場合の安全策
    if (ts_in_test) call test_end()

    ts_current_test = ts_current_test + 1
    ts_current_name = name
    ts_current_ok = .true.
    ts_in_test = .true.

    if (ts_total_tests > 0) then
      write (output_unit, '(a,i0,a,i0,a,a,a)', advance='no') &
        '[', ts_current_test, '/', ts_total_tests, '] ', trim(name), ' ... '
    else
      write (output_unit, '(a,i0,a,a,a)', advance='no') &
        '[', ts_current_test, '] ', trim(name), ' ... '
    end if
    flush (output_unit)
  end subroutine test_begin

  !> テストケースの終了を宣言し、結果を表示する。
  subroutine test_end()
    if (.not. ts_in_test) return

    if (ts_current_ok) then
      ts_passed = ts_passed + 1
      write (output_unit, '(a)') 'PASS'
    end if
    ! FAIL の場合は assert 内で既に表示済み
    flush (output_unit)
    ts_in_test = .false.
  end subroutine test_end

  !> テストスイートのサマリーを表示し、失敗があれば error stop する。
  subroutine test_summary()
    ! 閉じ忘れ対策
    if (ts_in_test) call test_end()

    write (output_unit, '(a)') ''
    write (output_unit, '(a,i0,a,i0,a,i0,a)') &
      '=== ', ts_passed, ' passed, ', ts_failed, ' failed (', &
      ts_assertions, ' assertions) ==='
    flush (output_unit)

    if (ts_failed > 0) error stop 1
  end subroutine test_summary

  ! ============================================================
  !  アサート API（強化版、既存シグネチャ完全互換）
  ! ============================================================

  !> 失敗理由を表示してテストを停止する。
  !! @param[in] message 失敗理由メッセージ。
  subroutine fail_test(message)
    character(len=*), intent(in) :: message

    ts_assertions = ts_assertions + 1

    if (ts_in_test .and. ts_current_ok) then
      ts_current_ok = .false.
      ts_failed = ts_failed + 1
      write (output_unit, '(a)') 'FAIL'
    end if

    write (error_unit, '(a,a)') '  ASSERT FAILED: ', trim(message)
    flush (error_unit)
    flush (output_unit)
    error stop 1
  end subroutine fail_test

  !> 条件が偽ならテストを失敗させる。
  !! @param[in] condition 検証対象の真偽値。
  !! @param[in] message 失敗時に表示するメッセージ。
  subroutine assert_true(condition, message)
    logical, intent(in) :: condition
    character(len=*), intent(in) :: message

    ts_assertions = ts_assertions + 1
    if (.not. condition) call fail_test(message)
  end subroutine assert_true

  !> 32bit整数の一致を確認する。
  !! @param[in] actual 実測値。
  !! @param[in] expected 期待値。
  !! @param[in] message 失敗時に表示するメッセージ。
  subroutine assert_equal_i32(actual, expected, message)
    integer(i32), intent(in) :: actual
    integer(i32), intent(in) :: expected
    character(len=*), intent(in) :: message

    ts_assertions = ts_assertions + 1
    if (actual /= expected) then
      call report_i32_mismatch(actual, expected, message)
      call fail_test(message)
    end if
  end subroutine assert_equal_i32

  !> 64bit整数の一致を確認する。
  subroutine assert_equal_i64(actual, expected, message)
    integer(i64), intent(in) :: actual
    integer(i64), intent(in) :: expected
    character(len=*), intent(in) :: message

    ts_assertions = ts_assertions + 1
    if (actual /= expected) then
      call report_i64_mismatch(actual, expected, message)
      call fail_test(message)
    end if
  end subroutine assert_equal_i64

  !> 倍精度実数の近接一致を確認する。
  !! @param[in] actual 実測値。
  !! @param[in] expected 期待値。
  !! @param[in] tol 許容誤差。
  !! @param[in] message 失敗時に表示するメッセージ。
  subroutine assert_close_dp(actual, expected, tol, message)
    real(dp), intent(in) :: actual
    real(dp), intent(in) :: expected
    real(dp), intent(in) :: tol
    character(len=*), intent(in) :: message

    ts_assertions = ts_assertions + 1
    if (abs(actual - expected) > tol) then
      call report_dp_mismatch(actual, expected, abs(actual - expected), tol, message)
      call fail_test(message)
    end if
  end subroutine assert_close_dp

  !> 1次元実数配列の要素ごとの近接一致を確認する。
  !! @param[in] actual 実測配列。
  !! @param[in] expected 期待配列。
  !! @param[in] tol 許容誤差。
  !! @param[in] message 失敗時に表示するメッセージ。
  subroutine assert_allclose_1d(actual, expected, tol, message)
    real(dp), intent(in) :: actual(:)
    real(dp), intent(in) :: expected(:)
    real(dp), intent(in) :: tol
    character(len=*), intent(in) :: message
    integer :: i

    ts_assertions = ts_assertions + 1
    if (size(actual) /= size(expected)) then
      write (error_unit, '(a,i0,a,i0)') '  size mismatch: actual=', size(actual), ', expected=', size(expected)
      call fail_test(message)
    end if
    do i = 1, size(actual)
      if (abs(actual(i) - expected(i)) > tol) then
        write (error_unit, '(a,i0,a)') '  element ', i, ':'
        call report_dp_mismatch(actual(i), expected(i), abs(actual(i) - expected(i)), tol, message)
        call fail_test(message)
      end if
    end do
  end subroutine assert_allclose_1d

  ! ============================================================
  !  診断出力ヘルパー（private）
  ! ============================================================

  subroutine report_i32_mismatch(actual, expected, message)
    integer(i32), intent(in) :: actual, expected
    character(len=*), intent(in) :: message

    if (ts_in_test .and. ts_current_ok) then
      ts_current_ok = .false.
      ts_failed = ts_failed + 1
      write (output_unit, '(a)') 'FAIL'
    end if
    write (error_unit, '(a,a)') '  ASSERT FAILED: ', trim(message)
    write (error_unit, '(a,i0)') '    actual   = ', actual
    write (error_unit, '(a,i0)') '    expected = ', expected
    flush (error_unit)
  end subroutine report_i32_mismatch

  subroutine report_i64_mismatch(actual, expected, message)
    integer(i64), intent(in) :: actual, expected
    character(len=*), intent(in) :: message

    if (ts_in_test .and. ts_current_ok) then
      ts_current_ok = .false.
      ts_failed = ts_failed + 1
      write (output_unit, '(a)') 'FAIL'
    end if
    write (error_unit, '(a,a)') '  ASSERT FAILED: ', trim(message)
    write (error_unit, '(a,i0)') '    actual   = ', actual
    write (error_unit, '(a,i0)') '    expected = ', expected
    flush (error_unit)
  end subroutine report_i64_mismatch

  subroutine report_dp_mismatch(actual, expected, diff, tol, message)
    real(dp), intent(in) :: actual, expected, diff, tol
    character(len=*), intent(in) :: message

    if (ts_in_test .and. ts_current_ok) then
      ts_current_ok = .false.
      ts_failed = ts_failed + 1
      write (output_unit, '(a)') 'FAIL'
    end if
    write (error_unit, '(a,a)') '  ASSERT FAILED: ', trim(message)
    write (error_unit, '(a,es22.14)') '    actual   = ', actual
    write (error_unit, '(a,es22.14)') '    expected = ', expected
    write (error_unit, '(a,es22.14)') '    diff     = ', diff
    write (error_unit, '(a,es22.14)') '    tol      = ', tol
    flush (error_unit)
  end subroutine report_dp_mismatch

  ! ============================================================
  !  ファイル / ディレクトリ補助
  ! ============================================================

  !> 既存ファイルがあれば削除する。
  !! @param[in] path 削除対象ファイルパス。
  subroutine delete_file_if_exists(path)
    character(len=*), intent(in) :: path
    logical :: exists
    integer :: u, ios

    inquire (file=trim(path), exist=exists)
    if (.not. exists) return

    open (newunit=u, file=trim(path), status='old', action='readwrite', iostat=ios)
    if (ios /= 0) return
    close (u, status='delete')
  end subroutine delete_file_if_exists

  !> ディレクトリを作成する。
  !! @param[in] path 作成対象ディレクトリパス。
  subroutine ensure_directory(path)
    character(len=*), intent(in) :: path
    character(len=1024) :: cmd
    integer :: ios

    cmd = 'mkdir -p "'//trim(path)//'"'
    call execute_command_line(trim(cmd), wait=.true., exitstat=ios)
    if (ios /= 0) call fail_test('failed to create directory: '//trim(path))
  end subroutine ensure_directory

  !> 空ディレクトリを削除する。
  !! @param[in] path 削除対象ディレクトリパス。
  subroutine remove_empty_directory(path)
    character(len=*), intent(in) :: path
    character(len=1024) :: cmd
    integer :: ios

    cmd = 'if [ -d "'//trim(path)//'" ]; then rmdir "'//trim(path)//'"; fi'
    call execute_command_line(trim(cmd), wait=.true., exitstat=ios)
  end subroutine remove_empty_directory

end module test_support
