Add Fortran (Modern) syntax test file

3 files changed, 263 insertions, 0 deletions

diff --git a/tests/syntax-tests/highlighted/Fortran (Modern)/test_savetxt.f90 b/tests/syntax-tests/highlighted/Fortran (Modern)/test_savetxt.f90
new file mode 100644
index 00000000..156885c6
--- /dev/null
+++ b/tests/syntax-tests/highlighted/Fortran (Modern)/test_savetxt.f90
@@ -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
diff --git a/tests/syntax-tests/source/Fortran (Modern)/LICENSE.md b/tests/syntax-tests/source/Fortran (Modern)/LICENSE.md
new file mode 100644
index 00000000..0cc45c70
--- /dev/null
+++ b/tests/syntax-tests/source/Fortran (Modern)/LICENSE.md
@@ -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.
+```
diff --git a/tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90 b/tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90
new file mode 100644
index 00000000..b7e1ef1b
--- /dev/null
+++ b/tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90
@@ -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