mirror of
https://github.com/sharkdp/bat.git
synced 2025-09-01 10:52:24 +01:00
Add Fortran (Modern) syntax test file
This commit is contained in:
committed by
David Peter
parent
d395f64f58
commit
702b5caf2d
25
tests/syntax-tests/source/Fortran (Modern)/LICENSE.md
Normal file
25
tests/syntax-tests/source/Fortran (Modern)/LICENSE.md
Normal file
@@ -0,0 +1,25 @@
|
||||
The `test_savetxt.f90` file has been added from https://github.com/fortran-lang/stdlib under the following license:
|
||||
|
||||
```text
|
||||
MIT License
|
||||
|
||||
Copyright (c) 2019 Fortran stdlib developers
|
||||
|
||||
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.
|
||||
```
|
119
tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90
Normal file
119
tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90
Normal file
@@ -0,0 +1,119 @@
|
||||
program test_savetxt
|
||||
use stdlib_kinds, only: int32, sp, dp
|
||||
use stdlib_io, only: loadtxt, savetxt
|
||||
use stdlib_error, only: check
|
||||
implicit none
|
||||
|
||||
character(:), allocatable :: outpath
|
||||
|
||||
outpath = get_outpath() // "/tmp.dat"
|
||||
|
||||
call test_iint32(outpath)
|
||||
call test_rsp(outpath)
|
||||
call test_rdp(outpath)
|
||||
call test_csp(outpath)
|
||||
call test_cdp(outpath)
|
||||
|
||||
contains
|
||||
|
||||
function get_outpath() result(outpath)
|
||||
integer :: ierr
|
||||
character(256) :: argv
|
||||
character(:), allocatable :: outpath
|
||||
|
||||
call get_command_argument(1, argv, status=ierr)
|
||||
if (ierr==0) then
|
||||
outpath = trim(argv)
|
||||
else
|
||||
outpath = '.'
|
||||
endif
|
||||
end function get_outpath
|
||||
|
||||
subroutine test_iint32(outpath)
|
||||
character(*), intent(in) :: outpath
|
||||
integer(int32) :: d(3, 2), e(2, 3)
|
||||
integer(int32), allocatable :: d2(:, :)
|
||||
d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
|
||||
call savetxt(outpath, d)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [3, 2]))
|
||||
call check(all(abs(d-d2) == 0))
|
||||
|
||||
e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
|
||||
call savetxt(outpath, e)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [2, 3]))
|
||||
call check(all(abs(e-d2) == 0))
|
||||
end subroutine
|
||||
|
||||
|
||||
subroutine test_rsp(outpath)
|
||||
character(*), intent(in) :: outpath
|
||||
real(sp) :: d(3, 2), e(2, 3)
|
||||
real(sp), allocatable :: d2(:, :)
|
||||
d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
|
||||
call savetxt(outpath, d)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [3, 2]))
|
||||
call check(all(abs(d-d2) < epsilon(1._sp)))
|
||||
|
||||
e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
|
||||
call savetxt(outpath, e)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [2, 3]))
|
||||
call check(all(abs(e-d2) < epsilon(1._sp)))
|
||||
end subroutine test_rsp
|
||||
|
||||
|
||||
subroutine test_rdp(outpath)
|
||||
character(*), intent(in) :: outpath
|
||||
real(dp) :: d(3, 2), e(2, 3)
|
||||
real(dp), allocatable :: d2(:, :)
|
||||
d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
|
||||
call savetxt(outpath, d)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [3, 2]))
|
||||
call check(all(abs(d-d2) < epsilon(1._dp)))
|
||||
|
||||
e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
|
||||
call savetxt(outpath, e)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [2, 3]))
|
||||
call check(all(abs(e-d2) < epsilon(1._dp)))
|
||||
end subroutine test_rdp
|
||||
|
||||
subroutine test_csp(outpath)
|
||||
character(*), intent(in) :: outpath
|
||||
complex(sp) :: d(3, 2), e(2, 3)
|
||||
complex(sp), allocatable :: d2(:, :)
|
||||
d = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
|
||||
call savetxt(outpath, d)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [3, 2]))
|
||||
call check(all(abs(d-d2) < epsilon(1._sp)))
|
||||
|
||||
e = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
|
||||
call savetxt(outpath, e)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [2, 3]))
|
||||
call check(all(abs(e-d2) < epsilon(1._sp)))
|
||||
end subroutine test_csp
|
||||
|
||||
subroutine test_cdp(outpath)
|
||||
character(*), intent(in) :: outpath
|
||||
complex(dp) :: d(3, 2), e(2, 3)
|
||||
complex(dp), allocatable :: d2(:, :)
|
||||
d = cmplx(1._dp, 1._dp,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
|
||||
call savetxt(outpath, d)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [3, 2]))
|
||||
call check(all(abs(d-d2) < epsilon(1._dp)))
|
||||
|
||||
e = cmplx(1, 1,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
|
||||
call savetxt(outpath, e)
|
||||
call loadtxt(outpath, d2)
|
||||
call check(all(shape(d2) == [2, 3]))
|
||||
call check(all(abs(e-d2) < epsilon(1._dp)))
|
||||
end subroutine test_cdp
|
||||
|
||||
end program test_savetxt
|
Reference in New Issue
Block a user