Source

aotus / utests / aot_table_test.f90

Harald Klimach 36a10dd 


Harald Klimach 485d564 
Harald Klimach db088f8 
Harald Klimach 36a10dd 
Harald Klimach db088f8 
Harald Klimach 36a10dd 










Harald Klimach 149cc7b 
Harald Klimach 46897ea 
Harald Klimach 36a10dd 

Harald Klimach 149cc7b 
Harald Klimach 36a10dd 

Harald Klimach 149cc7b 
Harald Klimach 46897ea 
Harald Klimach 485d564 

Harald Klimach 149cc7b 





Harald Klimach 36a10dd 






Harald Klimach 46897ea 
Harald Klimach 36a10dd 







Harald Klimach 46897ea 
Harald Klimach 36a10dd 



Harald Klimach db088f8 
Harald Klimach 36a10dd 
Harald Klimach db088f8 
Harald Klimach 36a10dd 

Harald Klimach 46897ea 
Harald Klimach 36a10dd 








Harald Klimach 46897ea 
Harald Klimach 36a10dd 






Harald Klimach db088f8 
Harald Klimach 36a10dd 
Harald Klimach db088f8 
Harald Klimach 36a10dd 


Harald Klimach 46897ea 
Harald Klimach 36a10dd 















Harald Klimach 46897ea 





Harald Klimach 36a10dd 












program aot_table_test
  use flu_binding, only: flu_State

  use aotus_module, only: open_config_file, close_config
  use aot_top_module, only: aoterr_Fatal, aoterr_NonExistent, aoterr_WrongType
  use aot_table_module, only: aot_table_open, aot_table_close, &
    &                         aot_table_length, aot_table_get_val

  implicit none

  integer, parameter :: primes(5) = [ 1, 2, 3, 5, 7 ]

  type(flu_State) :: conf
  integer :: globhandle
  integer :: tabint
  integer :: tablen
  integer :: iError
  integer :: i
  character(len=80) :: ErrString
  logical :: passed

  call create_script('aot_table_test_config.lua')

  write(*,*)
  write(*,*) 'Running aot_table_test...'

  passed = .true.
  call open_config_file(L = conf, filename = 'aot_table_test_config.lua', &
    &                   ErrCode = iError, ErrString = ErrString)
  if (iError /= 0) then
    write(*,*) 'Unexpected FATAL Error occured !!!'
    write(*,*) 'Could not open the config file aot_table_test_config.lua:'
    write(*,*) trim(ErrString)
    STOP
  end if

  ! Testing for global Table
  write(*,*) ' * opening a global table'
  call aot_table_open(L = conf, thandle = globhandle, key = 'primes')
  if (globhandle == 0) then
    write(*,*) '  : unexpected FATAL Error occured !!!'
    write(*,*) '  : could not open global table primes.'
    passed = .false.
  else
    write(*,*) '  : success.'
    write(*,*) ' * getting the length of the table'
    tablen = aot_table_length(L = conf, thandle = globhandle)
    if (tablen /= 5) then
      write(*,*) '  : unexpected FATAL Error occured !!!'
      write(*,*) '  : found a table length of ', tablen
      write(*,*) '  :    but should have been ', 5
      passed = .false.
    else
      write(*,*) '  : success.'
      write(*,*) ' * retrieving entries of table by position'
      do i=1,5
        call aot_table_get_val(L = conf, thandle = globhandle, &
          &                pos = i, &
          &                val = tabint, ErrCode = iError)
        if (btest(iError, aoterr_Fatal)) then
          write(*,*) '  : unexpected FATAL Error occured !!!'
          passed = .false.
          if (btest(iError, aoterr_NonExistent)) &
            &   write(*,*) '  : Variable not existent!'
          if (btest(iError, aoterr_WrongType)) &
            &   write(*,*) '  : Variable has wrong type!'
          exit
        else
          if (tabint /= primes(i)) then
            write(*,*) '  : unexpected ERROR, value mismatch, got: ', tabint
            write(*,*) '  :                             should be: ', primes(i)
            passed = .false.
            iError = 42
            exit
          end if
        end if
      end do
      if (iError == 0) write(*,*) '  : success.'
      write(*,*) ' * Attempting read of nonexistent entry'
      call aot_table_get_val(L = conf, thandle = globhandle, &
        &                pos = 10, &
        &                val = tabint, ErrCode = iError)
      if (btest(iError, aoterr_Fatal)) then
        write(*,*) '  : success.'
      else
        passed = .false.
        write(*,*) '  : ERROR, unexpected success in reading nonexistent entry'
        if (btest(iError, aoterr_NonExistent)) &
          &   write(*,*) '  : Variable not existent, but should be fatal!'
        if (btest(iError, aoterr_WrongType)) &
          &   write(*,*) '  : Variable has wrong type but should not exist!'
      end if
    end if
  end if

  write(*,*) ' * Closing table'
  call aot_table_close(L = conf, thandle = globhandle)
  write(*,*) '  : success.'

  call close_config(conf)
  write(*,*) '... Done with aot_table_test.'

  if (passed) then
    write(*,*) 'PASSED'
  else
    write(*,*) 'FAILED'
  end if

contains

  subroutine create_script(filename)
    character(len=*) :: filename

    open(file=trim(filename), unit=22, action='write', status='replace')
    write(22,*) '-- test script for aot_table_test'
    write(22,*) 'primes = { 1, 2, 3, 5, 7 }'
    write(22,*) 'tabtab = { origin = {0.0, 0.0, 0.0} }'
    write(22,*) 'unnamed = { { kind = 1 } }'
    close(22)
  end subroutine create_script

end program aot_table_test