extern/bat
1
0
Fork 0
mirror of https://github.com/sharkdp/bat.git synced 2024-11-26 01:33:44 +01:00
Code Issues Packages Projects Releases Wiki Activity

Add Fortran (Modern) syntax test file

Browse Source
This commit is contained in:
Mohamed Abdelnour 2021-05-29 02:24:39 +02:00 committed by David Peter
parent d395f64f58
commit 702b5caf2d
3 changed files with 263 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
tests/syntax-tests/highlighted/Fortran (Modern)/test_savetxt.f90 Normal file
View 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

25
tests/syntax-tests/source/Fortran (Modern)/LICENSE.md Normal file
View 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
View 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