git.iko.soy/bat
on master help sign in
Add Fortran (Modern) syntax test file
commit702b5caf2d27955da0caf6e4432823b1e7d7fb99 authorMohamed Abdelnour <mohamed.k.abdelnour@gmail.com> dateSat 29 May 2021, 02:24 (5 years ago) parentd395f64
3 files changed+263
compare with master
unifiedsplit
tests/syntax-tests/highlighted/Fortran (Modern)/test_savetxt.f90+119 tests/syntax-tests/source/Fortran (Modern)/LICENSE.md+25 tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90+119
tests/syntax-tests/highlighted/Fortran (Modern)/test_savetxt.f90new file+119
@@ -0,0 +1,119 @@
1+program test_savetxt
2+use stdlib_kinds, only: int32, sp, dp
3+use stdlib_io, only: loadtxt, savetxt
4+use stdlib_error, only: check
5+implicit none
6+
7+character(:), allocatable :: outpath
8+
9+outpath = get_outpath() // "/tmp.dat"
10+
11+call test_iint32(outpath)
12+call test_rsp(outpath)
13+call test_rdp(outpath)
14+call test_csp(outpath)
15+call test_cdp(outpath)
16+
17+contains
18+
19+ function get_outpath() result(outpath)
20+ integer :: ierr
21+ character(256) :: argv
22+ character(:), allocatable :: outpath
23+
24+ call get_command_argument(1, argv, status=ierr)
25+ if (ierr==0) then
26+ outpath = trim(argv)
27+ else
28+ outpath = '.'
29+ endif
30+ end function get_outpath
31+
32+ subroutine test_iint32(outpath)
33+ character(*), intent(in) :: outpath
34+ integer(int32) :: d(3, 2), e(2, 3)
35+ integer(int32), allocatable :: d2(:, :)
36+ d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
37+ call savetxt(outpath, d)
38+ call loadtxt(outpath, d2)
39+ call check(all(shape(d2) == [3, 2]))
40+ call check(all(abs(d-d2) == 0))
41+
42+ e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
43+ call savetxt(outpath, e)
44+ call loadtxt(outpath, d2)
45+ call check(all(shape(d2) == [2, 3]))
46+ call check(all(abs(e-d2) == 0))
47+ end subroutine
48+
49+
50+ subroutine test_rsp(outpath)
51+ character(*), intent(in) :: outpath
52+ real(sp) :: d(3, 2), e(2, 3)
53+ real(sp), allocatable :: d2(:, :)
54+ d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
55+ call savetxt(outpath, d)
56+ call loadtxt(outpath, d2)
57+ call check(all(shape(d2) == [3, 2]))
58+ call check(all(abs(d-d2) < epsilon(1._sp)))
59+
60+ e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
61+ call savetxt(outpath, e)
62+ call loadtxt(outpath, d2)
63+ call check(all(shape(d2) == [2, 3]))
64+ call check(all(abs(e-d2) < epsilon(1._sp)))
65+ end subroutine test_rsp
66+
67+
68+ subroutine test_rdp(outpath)
69+ character(*), intent(in) :: outpath
70+ real(dp) :: d(3, 2), e(2, 3)
71+ real(dp), allocatable :: d2(:, :)
72+ d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
73+ call savetxt(outpath, d)
74+ call loadtxt(outpath, d2)
75+ call check(all(shape(d2) == [3, 2]))
76+ call check(all(abs(d-d2) < epsilon(1._dp)))
77+
78+ e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
79+ call savetxt(outpath, e)
80+ call loadtxt(outpath, d2)
81+ call check(all(shape(d2) == [2, 3]))
82+ call check(all(abs(e-d2) < epsilon(1._dp)))
83+ end subroutine test_rdp
84+
85+ subroutine test_csp(outpath)
86+ character(*), intent(in) :: outpath
87+ complex(sp) :: d(3, 2), e(2, 3)
88+ complex(sp), allocatable :: d2(:, :)
89+ d = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
90+ call savetxt(outpath, d)
91+ call loadtxt(outpath, d2)
92+ call check(all(shape(d2) == [3, 2]))
93+ call check(all(abs(d-d2) < epsilon(1._sp)))
94+
95+ e = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
96+ call savetxt(outpath, e)
97+ call loadtxt(outpath, d2)
98+ call check(all(shape(d2) == [2, 3]))
99+ call check(all(abs(e-d2) < epsilon(1._sp)))
100+ end subroutine test_csp
101+
102+ subroutine test_cdp(outpath)
103+ character(*), intent(in) :: outpath
104+ complex(dp) :: d(3, 2), e(2, 3)
105+ complex(dp), allocatable :: d2(:, :)
106+ d = cmplx(1._dp, 1._dp,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
107+ call savetxt(outpath, d)
108+ call loadtxt(outpath, d2)
109+ call check(all(shape(d2) == [3, 2]))
110+ call check(all(abs(d-d2) < epsilon(1._dp)))
111+
112+ e = cmplx(1, 1,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
113+ call savetxt(outpath, e)
114+ call loadtxt(outpath, d2)
115+ call check(all(shape(d2) == [2, 3]))
116+ call check(all(abs(e-d2) < epsilon(1._dp)))
117+ end subroutine test_cdp
118+
119+end program test_savetxt
tests/syntax-tests/source/Fortran (Modern)/LICENSE.mdnew file+25
@@ -0,0 +1,25 @@
1+The `test_savetxt.f90` file has been added from https://github.com/fortran-lang/stdlib under the following license:
2+
3+```text
4+MIT License
5+
6+Copyright (c) 2019 Fortran stdlib developers
7+
8+Permission is hereby granted, free of charge, to any person obtaining a copy
9+of this software and associated documentation files (the "Software"), to deal
10+in the Software without restriction, including without limitation the rights
11+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
12+copies of the Software, and to permit persons to whom the Software is
13+furnished to do so, subject to the following conditions:
14+
15+The above copyright notice and this permission notice shall be included in all
16+copies or substantial portions of the Software.
17+
18+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
19+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
21+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
22+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
23+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
24+SOFTWARE.
25+```
tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90new file+119
@@ -0,0 +1,119 @@
1+program test_savetxt
2+use stdlib_kinds, only: int32, sp, dp
3+use stdlib_io, only: loadtxt, savetxt
4+use stdlib_error, only: check
5+implicit none
6+
7+character(:), allocatable :: outpath
8+
9+outpath = get_outpath() // "/tmp.dat"
10+
11+call test_iint32(outpath)
12+call test_rsp(outpath)
13+call test_rdp(outpath)
14+call test_csp(outpath)
15+call test_cdp(outpath)
16+
17+contains
18+
19+ function get_outpath() result(outpath)
20+ integer :: ierr
21+ character(256) :: argv
22+ character(:), allocatable :: outpath
23+
24+ call get_command_argument(1, argv, status=ierr)
25+ if (ierr==0) then
26+ outpath = trim(argv)
27+ else
28+ outpath = '.'
29+ endif
30+ end function get_outpath
31+
32+ subroutine test_iint32(outpath)
33+ character(*), intent(in) :: outpath
34+ integer(int32) :: d(3, 2), e(2, 3)
35+ integer(int32), allocatable :: d2(:, :)
36+ d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
37+ call savetxt(outpath, d)
38+ call loadtxt(outpath, d2)
39+ call check(all(shape(d2) == [3, 2]))
40+ call check(all(abs(d-d2) == 0))
41+
42+ e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
43+ call savetxt(outpath, e)
44+ call loadtxt(outpath, d2)
45+ call check(all(shape(d2) == [2, 3]))
46+ call check(all(abs(e-d2) == 0))
47+ end subroutine
48+
49+
50+ subroutine test_rsp(outpath)
51+ character(*), intent(in) :: outpath
52+ real(sp) :: d(3, 2), e(2, 3)
53+ real(sp), allocatable :: d2(:, :)
54+ d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
55+ call savetxt(outpath, d)
56+ call loadtxt(outpath, d2)
57+ call check(all(shape(d2) == [3, 2]))
58+ call check(all(abs(d-d2) < epsilon(1._sp)))
59+
60+ e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
61+ call savetxt(outpath, e)
62+ call loadtxt(outpath, d2)
63+ call check(all(shape(d2) == [2, 3]))
64+ call check(all(abs(e-d2) < epsilon(1._sp)))
65+ end subroutine test_rsp
66+
67+
68+ subroutine test_rdp(outpath)
69+ character(*), intent(in) :: outpath
70+ real(dp) :: d(3, 2), e(2, 3)
71+ real(dp), allocatable :: d2(:, :)
72+ d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
73+ call savetxt(outpath, d)
74+ call loadtxt(outpath, d2)
75+ call check(all(shape(d2) == [3, 2]))
76+ call check(all(abs(d-d2) < epsilon(1._dp)))
77+
78+ e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
79+ call savetxt(outpath, e)
80+ call loadtxt(outpath, d2)
81+ call check(all(shape(d2) == [2, 3]))
82+ call check(all(abs(e-d2) < epsilon(1._dp)))
83+ end subroutine test_rdp
84+
85+ subroutine test_csp(outpath)
86+ character(*), intent(in) :: outpath
87+ complex(sp) :: d(3, 2), e(2, 3)
88+ complex(sp), allocatable :: d2(:, :)
89+ d = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
90+ call savetxt(outpath, d)
91+ call loadtxt(outpath, d2)
92+ call check(all(shape(d2) == [3, 2]))
93+ call check(all(abs(d-d2) < epsilon(1._sp)))
94+
95+ e = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
96+ call savetxt(outpath, e)
97+ call loadtxt(outpath, d2)
98+ call check(all(shape(d2) == [2, 3]))
99+ call check(all(abs(e-d2) < epsilon(1._sp)))
100+ end subroutine test_csp
101+
102+ subroutine test_cdp(outpath)
103+ character(*), intent(in) :: outpath
104+ complex(dp) :: d(3, 2), e(2, 3)
105+ complex(dp), allocatable :: d2(:, :)
106+ d = cmplx(1._dp, 1._dp,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
107+ call savetxt(outpath, d)
108+ call loadtxt(outpath, d2)
109+ call check(all(shape(d2) == [3, 2]))
110+ call check(all(abs(d-d2) < epsilon(1._dp)))
111+
112+ e = cmplx(1, 1,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
113+ call savetxt(outpath, e)
114+ call loadtxt(outpath, d2)
115+ call check(all(shape(d2) == [2, 3]))
116+ call check(all(abs(e-d2) < epsilon(1._dp)))
117+ end subroutine test_cdp
118+
119+end program test_savetxt