From f39b481a4e6bd18bee23f648cd7d62d51f641462 Mon Sep 17 00:00:00 2001 From: zoziha <1325686572@qq.com> Date: Sun, 19 Sep 2021 22:02:57 +0800 Subject: [PATCH 1/6] add `stdlib_io_disp.fypp`. --- doc/specs/stdlib_io.md | 127 +++++++++++ src/CMakeLists.txt | 1 + src/Makefile.manual | 12 +- src/stdlib_io.fypp | 38 +++- src/stdlib_io_disp.fypp | 213 ++++++++++++++++++ src/tests/io/CMakeLists.txt | 1 + src/tests/io/Makefile.manual | 3 +- src/tests/io/test_disp.f90 | 410 +++++++++++++++++++++++++++++++++++ 8 files changed, 799 insertions(+), 6 deletions(-) create mode 100644 src/stdlib_io_disp.fypp create mode 100644 src/tests/io/test_disp.f90 diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 40cb2b426..0fa0d30b6 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -131,3 +131,130 @@ program demo_savetxt call savetxt('example.dat', x) end program demo_savetxt ``` + +## `disp` - display your data + +### Status + +Experimental + +### Class + +Impure subroutine. + +### Description + +Outputs a `logical/integer/real/complex/character/string_type` scalar or `logical/integer/real/complex` and rank-1/rank-2 array to the screen or a file `unit`. + +#### More details + +```fortran +call disp( A(i, j, 2, :, 1:10) [, header, unit, brief] ) !! `i, j, ...` can be determined by `do` loop. +``` + +For `complex` type, the output format is `*(A25, 1X)`; +For other types, the output format is `*(A12, 1X)`. + +To prevent users from accidentally passing large-length arrays to `disp`, causing unnecessary io blockage: +1. If the `brief` argument is not specified, `disp` will print **the brief array content with a length of `10*50` by default**. +2. Specify `brief=.true.`, `disp` will print **the brief array content with a length of `5*5`**; +3. Specify `brief=.false.`, `disp` will print **`all` the contents of the array**. + +### Syntax + +`call [[stdlib_io(module):disp(interface)]]([x, header, unit, brief])` + +### Arguments + +`x`: Shall be a `logical/integer/real/complex/string_type` scalar or `logical/integer/real/complex` and rank-1/rank-2 array. +This argument is `intent(in)` and `optional`. + +`header`: Shall be a `character(len=*)` scalar. +This argument is `intent(in)` and `optional`. + +`unit`: Shall be an `integer` scalar linked to an IO stream. +This argument is `intent(in)` and `optional`. + +`brief`: Shall be a `logical` scalar. +This argument is `intent(in)` and `optional`. +Controls an abridged version of the `x` object is printed. + +### Output + +The result is to print `header` and `x` on the screen (or another output `unit/file`) in this order. +If `x` is a rank-1/rank-2 `array` type, the dimension length information of the `array` will also be outputted. + +If `disp` is not passed any arguments, a blank line is printed. + +If the `x` is present and of `real/complex` type, the data will retain four significant decimal places, like `(g0.4)`. + +### Example + +```fortran +program test_io_disp + + use stdlib_io, only: disp + + real(8) :: r(2, 3) + complex :: c(2, 3), c_3d(2, 100, 20) + integer :: i(2, 3) + logical :: l(10, 10) + r = 1.; c = 1.; c_3d = 2.; i = 1; l = .true. + r(1, 1) = -1.e-11 + r(1, 2) = -1.e10 + c(2, 2) = (-1.e10,-1.e10) + c_3d(1,3,1) = (1000, 0.001) + c_3d(1,3,2) = (1.e4, 100.) + call disp('string', header='disp(string):') + call disp('It is a note.') + call disp() + call disp(r, header='disp(r):') + call disp(r(1,:), header='disp(r(1,:))') + call disp(c, header='disp(c):') + call disp(i, header='disp(i):') + call disp(l, header='disp(l):', brief=.true.) + call disp(c_3d(:,:,3), header='disp(c_3d(:,:,3)):', brief=.true.) + call disp(c_3d(2,:,:), header='disp(c_3d(2,:,:)):', brief=.true.) + +end program test_io_disp +``` +**Results:** +```fortran + disp(string): + string + It is a note. + + disp(r): + [matrix size: 2×3] + -0.1000E-10 -0.1000E+11 1.000 + 1.000 1.000 1.000 + disp(r(1,:)) + [vector size: 3] + -0.1000E-10 -0.1000E+11 1.000 + disp(c): + [matrix size: 2×3] + (1.000,0.000) (1.000,0.000) (1.000,0.000) + (1.000,0.000) (-0.1000E+11,-0.1000E+11) (1.000,0.000) + disp(i): + [matrix size: 2×3] + 1 1 1 + 1 1 1 + disp(l): + [matrix size: 10×10] + T T T ... T + T T T ... T + T T T ... T + : : : : : + T T T ... T + disp(c_3d(:,:,3)): + [matrix size: 2×100] + (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) + (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) + disp(c_3d(2,:,:)): + [matrix size: 100×20] + (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) + (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) + (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) + : : : : : + (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) +``` \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index b56d75b0e..08eb00dac 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,6 +7,7 @@ set(fppFiles stdlib_bitsets_64.fypp stdlib_bitsets_large.fypp stdlib_io.fypp + stdlib_io_disp.fypp stdlib_linalg.fypp stdlib_linalg_diag.fypp stdlib_linalg_outer_product.fypp diff --git a/src/Makefile.manual b/src/Makefile.manual index 7576cf3d8..2ee03fc57 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -4,6 +4,7 @@ SRCFYPP = \ stdlib_bitsets_large.fypp \ stdlib_bitsets.fypp \ stdlib_io.fypp \ + stdlib_io_disp.fypp \ stdlib_linalg.fypp \ stdlib_linalg_diag.fypp \ stdlib_linalg_outer_product.fypp \ @@ -27,8 +28,8 @@ SRCFYPP = \ stdlib_stats_moment_scalar.fypp \ stdlib_stats_var.fypp \ stdlib_math.fypp \ - stdlib_math_linspace.fypp \ - stdlib_math_logspace.fypp \ + stdlib_math_linspace.fypp \ + stdlib_math_logspace.fypp \ stdlib_stats_distribution_PRNG.fypp \ stdlib_string_type.fypp \ stdlib_string_type_constructor.fypp \ @@ -85,7 +86,12 @@ stdlib_io.o: \ stdlib_error.o \ stdlib_optval.o \ stdlib_kinds.o \ - stdlib_ascii.o + stdlib_ascii.o \ + stdlib_string_type.o +stdlib_io_disp.o: \ + stdlib_strings.o \ + stdlib_string_type.o \ + stdlib_io.o stdlib_linalg.o: \ stdlib_kinds.o stdlib_linalg_diag.o: \ diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index dcacaa644..b3749430b 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -7,18 +7,52 @@ module stdlib_io !! ([Specification](../page/specs/stdlib_io.html)) use stdlib_kinds, only: sp, dp, qp, & - int8, int16, int32, int64 + int8, int16, int32, int64, lk, c_bool use stdlib_error, only: error_stop use stdlib_optval, only: optval use stdlib_ascii, only: is_blank + use stdlib_string_type, only: string_type implicit none private ! Public API - public :: loadtxt, savetxt, open + public :: loadtxt, savetxt, open, disp ! Private API that is exposed so that we can test it in tests public :: parse_mode + + !> version: experimental + !> + !> Display a scalar, vector or matrix. + !> ([Specification](../page/specs/stdlib_io.html#disp-display-your-data)) + interface disp + #:set DISP_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES & + & + CMPLX_KINDS_TYPES + LOG_KINDS_TYPES + #:set DISP_RANKS = range(0, 3) + #:for k1, t1 in DISP_KINDS_TYPES + #:for rank in DISP_RANKS + module subroutine disp_${rank}$_${t1[0]}$${k1}$(x, header, unit, brief) + ${t1}$, intent(in) :: x${ranksuffix(rank)}$ + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + end subroutine disp_${rank}$_${t1[0]}$${k1}$ + #:endfor + #:endfor + module subroutine disp_character(x, header, unit, brief) + character(len=*), intent(in), optional :: x + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + end subroutine disp_character + module subroutine disp_string_type(x, header, unit, brief) + type(string_type), intent(in) :: x + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + end subroutine disp_string_type + end interface disp + interface loadtxt !! version: experimental !! diff --git a/src/stdlib_io_disp.fypp b/src/stdlib_io_disp.fypp new file mode 100644 index 000000000..a7651cd5d --- /dev/null +++ b/src/stdlib_io_disp.fypp @@ -0,0 +1,213 @@ +#:include "common.fypp" +#:set RIL_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES + +submodule (stdlib_io) stdlib_io_disp + + use, intrinsic :: iso_fortran_env, only: output_unit + use stdlib_strings, only: to_string + use stdlib_string_type, only: char + implicit none + + character(len=*), parameter :: rfmt = '(*(g12.4, 1x))' + character(len=*), parameter :: cfmt = '(*(g25.0, 1x))' + character(len=*), parameter :: fmt_ = 'g0.4' + integer, parameter :: brief_row = 5 + integer, parameter :: brief_col = 5 + integer, parameter :: default_row = 50 + integer, parameter :: default_col = 10 + +contains + + #:for k1, t1 in RIL_KINDS_TYPES + #! Display a/an ${t1}$ scalar. + module procedure disp_0_${t1[0]}$${k1}$ + integer :: unit_ + + unit_ = optval(unit, output_unit) + + if (present(header)) write(unit_, *) header + write(unit_, rfmt) x + + end procedure disp_0_${t1[0]}$${k1}$ + + #! Display a/an ${t1}$ vector. + module procedure disp_1_${t1[0]}$${k1}$ + integer :: unit_ + logical :: brief_ + integer :: n, col + + unit_ = optval(unit, output_unit) + brief_ = optval(brief, .true.) + col = merge(brief_col, default_col, present(brief) .and. brief_) + n = size(x, 1) + + if (present(header)) write(unit_, *) header + write(unit_, *) '[vector size: ' // to_string(n) // ']' + + if (brief_ .and. n > col) then + #! Brief Print. + write(unit_, rfmt) x(1:col-2), '...', x(n) + else + #! Full Print. + write(unit_, rfmt) x(:) + end if + + end procedure disp_1_${t1[0]}$${k1}$ + + #! Display a/an ${t1}$ matrix. + module procedure disp_2_${t1[0]}$${k1}$ + integer :: unit_ + logical :: brief_ + integer :: i, m, n + integer :: row, col + character(len=1) :: colon(default_col) + + unit_ = optval(unit, output_unit) + brief_ = optval(brief, .true.) + row = merge(brief_row, default_row, present(brief) .and. brief_) + col = merge(brief_col, default_col, present(brief) .and. brief_) + m = size(x, 1) + n = size(x, 2) + + if (present(header)) write(unit_, *) header + write(unit_, *) '[matrix size: ' // to_string(m) // '×' // to_string(n) // ']' + + if (brief_ .and. (m > row .or. n > col)) then + #! Brief Print. + colon = ':' + if (m > row .and. n > col) then + do i = 1, row-2 + write(unit_, rfmt) x(i,1:col-2), '...', x(i,n) + end do + write(unit_, rfmt) colon(1:col) + write(unit_, rfmt) x(m,1:col-2), '...', x(m,n) + elseif (m > row .and. n <= col) then + do i = 1, row-2 + write(unit_, rfmt) x(i,:) + end do + write(unit_, rfmt) colon(1:n) + write(unit_, rfmt) x(m,:) + elseif (m <= row .and. n > col) then + do i = 1, m + write(unit_, rfmt) x(i,1:col-2), '...', x(i,n) + end do + end if + else + #! Full Print. + do i = 1, m + write(unit_, rfmt) x(i,:) + end do + end if + + end procedure disp_2_${t1[0]}$${k1}$ + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + #! Display a ${t1}$ scalar. + module procedure disp_0_${t1[0]}$${k1}$ + integer :: unit_ + + unit_ = optval(unit, output_unit) + + if (present(header)) write(unit_, *) header + write(unit_, cfmt) to_string(x, fmt_) + + end procedure disp_0_${t1[0]}$${k1}$ + + #! Display a ${t1}$ vector. + module procedure disp_1_${t1[0]}$${k1}$ + integer :: unit_ + logical :: brief_ + integer :: i, n, col + + unit_ = optval(unit, output_unit) + brief_ = optval(brief, .true.) + col = merge(brief_col, default_col, present(brief) .and. brief_) + n = size(x, 1) + + if (present(header)) write(unit_, *) header + write(unit_, *) '[vector size: ' // to_string(n) // ']' + + if (brief_ .and. n > col) then + #! Brief Print. + write(unit_, cfmt) (to_string(x(i), fmt_), i=1, col-2), '...', to_string(x(n), fmt_) + else + #! Full Print. + write(unit_, cfmt) (to_string(x(i), fmt_), i=1, n) + end if + + end procedure disp_1_${t1[0]}$${k1}$ + + #! Display a ${t1}$ matrix. + module procedure disp_2_${t1[0]}$${k1}$ + integer :: unit_ + logical :: brief_ + integer :: i, j, m, n + integer :: row, col + character(len=1) :: colon(default_col) + + unit_ = optval(unit, output_unit) + brief_ = optval(brief, .true.) + row = merge(brief_row, default_row, present(brief) .and. brief_) + col = merge(brief_col, default_col, present(brief) .and. brief_) + m = size(x, 1) + n = size(x, 2) + + if (present(header)) write(unit_, *) header + write(unit_, *) '[matrix size: ' // to_string(m) // '×' // to_string(n) // ']' + + if (brief_ .and. (m > row .or. n > col)) then + #! Brief Print. + colon = ':' + if (m > row .and. n > col) then + do i = 1, row-2 + write(unit_, cfmt) (to_string(x(i,j), fmt_), j=1, col-2), '...', to_string(x(i,n), fmt_) + end do + write(unit_, cfmt) colon(1:col) + write(unit_, cfmt) (to_string(x(m,j), fmt_), j=1, col-2), '...', to_string(x(m,n), fmt_) + elseif (m > row .and. n <= col) then + do i = 1, row-2 + write(unit_, cfmt) (to_string(x(i,j), fmt_), j=1, n) + end do + write(unit_, cfmt) colon(1:n) + write(unit_, cfmt) (to_string(x(m,j), fmt_), j=1, n) + elseif (m <= row .and. n > col) then + do i = 1, m + write(unit_, cfmt) (to_string(x(m,j), fmt_), j=1, col-2), '...', to_string(x(m,n), fmt_) + end do + end if + else + #! Full Print. + do i = 1, m + write(unit_, cfmt) (to_string(x(i,j), fmt_), j=1, n) + end do + end if + + end procedure disp_2_${t1[0]}$${k1}$ + #:endfor + + #! Display a `character` scalar. + module procedure disp_character + character(len=:), allocatable :: x_ + integer :: unit_ + + x_ = optval(x, '') + unit_ = optval(unit, output_unit) + + if (present(header)) write(unit_, *) header + write(unit_, *) x_ + + end procedure disp_character + + #! Display a `string_type` scalar + module procedure disp_string_type + integer :: unit_ + + unit_ = optval(unit, output_unit) + + if (present(header)) write(unit_, *) header + write(unit_, *) char(x) + + end procedure disp_string_type + +end submodule stdlib_io_disp \ No newline at end of file diff --git a/src/tests/io/CMakeLists.txt b/src/tests/io/CMakeLists.txt index 68388a5e5..8963859e5 100644 --- a/src/tests/io/CMakeLists.txt +++ b/src/tests/io/CMakeLists.txt @@ -8,3 +8,4 @@ set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) ADDTEST(open) ADDTEST(parse_mode) +ADDTEST(disp) diff --git a/src/tests/io/Makefile.manual b/src/tests/io/Makefile.manual index 3bbce9db7..cb7122ff1 100644 --- a/src/tests/io/Makefile.manual +++ b/src/tests/io/Makefile.manual @@ -3,7 +3,8 @@ PROGS_SRC = test_loadtxt.f90 \ test_loadtxt_qp.f90 \ test_savetxt_qp.f90 \ test_parse_mode.f90 \ - test_open.f90 + test_open.f90 \ + test_disp.f90 CLEAN_FILES = tmp.dat tmp_qp.dat io_open.dat io_open.stream diff --git a/src/tests/io/test_disp.f90 b/src/tests/io/test_disp.f90 new file mode 100644 index 000000000..dc3268fe1 --- /dev/null +++ b/src/tests/io/test_disp.f90 @@ -0,0 +1,410 @@ +module test_io_disp + + use stdlib_strings, only: starts_with + use stdlib_string_type, only: string_type, assignment(=) + use stdlib_error, only: check + use stdlib_io, only: disp + use stdlib_optval, only: optval + implicit none + + integer :: unit + character(len=200) :: string + +contains + + subroutine check_formatter(actual, expected, description, partial) + character(len=*), intent(in) :: actual, expected, description + logical, intent(in), optional :: partial + logical :: stat + character(len=:), allocatable :: msg + + if (optval(partial, .false.)) then + stat = starts_with(actual, expected) + else + stat = actual == expected + end if + + if (.not. stat) then + msg = description//new_line("a")// & + & "Expected: '"//expected//"' but got '"//actual//"'" + else + print '(" - ", a, /, " Result: ''", a, "''")', description, actual + end if + + call check(stat, msg) + + end subroutine check_formatter + + subroutine test_io_disp_complex + complex :: c(6,6) = (1.0, 1.0) + + open(newunit=unit, status='scratch') + call disp(c(1,1), header='Test_io_disp_complex_scalar (brief) : ', brief=.true.) + call disp(c(1,1), unit=unit, header='Test_io_disp_complex_scalar (brief) : ', brief=.true.) + + call disp(c(1,:), header='Test_io_disp_complex_vector (brief) : ', brief=.true.) + call disp(c(1,:), unit=unit, header='Test_io_disp_complex_vector (brief) : ', brief=.true.) + + call disp(c(:,1), header='Test_io_disp_complex_vector : ', brief=.false.) + call disp(c(:,1), unit=unit, header='Test_io_disp_complex_vector : ', brief=.false.) + + call disp(c(1:2,1:2), header='Test_io_disp_complex_matrix : ', brief=.false.) + call disp(c(1:2,1:2), unit=unit, header='Test_io_disp_complex_matrix : ', brief=.false.) + + call disp(c(:,:), header='Test_io_disp_complex_matrix (brief) : ', brief=.true.) + call disp(c(:,:), unit=unit, header='Test_io_disp_complex_matrix (brief) : ', brief=.true.) + + !! Checks + rewind(unit) + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_scalar (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '(1.000,1.000)', 'Value') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_vector (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000) (1.000,1.000) & + & ... (1.000,1.000)', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_vector :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000) (1.000,1.000) & + & (1.000,1.000) (1.000,1.000) (1.000,1.000)', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_matrix :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000)', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000)', 'Matrix Vector 2') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_matrix (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000) (1.000,1.000) & + & ... (1.000,1.000)', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000) (1.000,1.000) & + & ... (1.000,1.000)', 'Matrix Vector 2') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000) (1.000,1.000) & + & ... (1.000,1.000)', 'Matrix Vector 3') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + ': : : & + & : :', 'Matrix Vector ..') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '(1.000,1.000) (1.000,1.000) (1.000,1.000) & + & ... (1.000,1.000)', 'Matrix Vector Size(Matrix, 1)') + close(unit) + + end subroutine test_io_disp_complex + + subroutine test_io_disp_real + + real :: r(6,6) = 1.0 + + open(newunit=unit, status='scratch') + call disp(r(1,1), header='Test_io_disp_real_scalar (brief) : ', brief=.true.) + call disp(r(1,1), unit=unit, header='Test_io_disp_real_scalar (brief) : ', brief=.true.) + + call disp(r(1,:), header='Test_io_disp_real_vector (brief) : ', brief=.true.) + call disp(r(1,:), unit=unit, header='Test_io_disp_real_vector (brief) : ', brief=.true.) + + call disp(r(:,1), header='Test_io_disp_real_vector : ', brief=.false.) + call disp(r(:,1), unit=unit, header='Test_io_disp_real_vector : ', brief=.false.) + + call disp(r(1:2,1:2), header='Test_io_disp_real_matrix : ', brief=.false.) + call disp(r(1:2,1:2), unit=unit, header='Test_io_disp_real_matrix : ', brief=.false.) + + call disp(r(:,:), header='Test_io_disp_real_matrix (brief) : ', brief=.true.) + call disp(r(:,:), unit=unit, header='Test_io_disp_real_matrix (brief) : ', brief=.true.) + + !! Checks + rewind(unit) + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_scalar (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '1.000', 'Value') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_vector (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000 1.000 ... 1.000', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_vector :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000 1.000 1.000 1.000 1.000', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_matrix :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000', 'Matrix Vector 2') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_matrix (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000 1.000 ... 1.000', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000 1.000 ... 1.000', 'Matrix Vector 2') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000 1.000 ... 1.000', 'Matrix Vector 3') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + ': : : : :', 'Matrix Vector ..') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1.000 1.000 1.000 ... 1.000', 'Matrix Vector Size(Matrix, 1)') + close(unit) + + end subroutine test_io_disp_real + + subroutine test_io_disp_integer + + integer :: i(6,6) = 1 + + open(newunit=unit, status='scratch') + call disp(i(1,1), header='Test_io_disp_integer_scalar (brief) : ', brief=.true.) + call disp(i(1,1), unit=unit, header='Test_io_disp_integer_scalar (brief) : ', brief=.true.) + + call disp(i(1,:), header='Test_io_disp_integer_vector (brief) : ', brief=.true.) + call disp(i(1,:), unit=unit, header='Test_io_disp_integer_vector (brief) : ', brief=.true.) + + call disp(i(:,1), header='Test_io_disp_integer_vector : ', brief=.false.) + call disp(i(:,1), unit=unit, header='Test_io_disp_integer_vector : ', brief=.false.) + + call disp(i(1:2,1:2), header='Test_io_disp_integer_matrix : ', brief=.false.) + call disp(i(1:2,1:2), unit=unit, header='Test_io_disp_integer_matrix : ', brief=.false.) + + call disp(i(:,:), header='Test_io_disp_integer_matrix (brief) : ', brief=.true.) + call disp(i(:,:), unit=unit, header='Test_io_disp_integer_matrix (brief) : ', brief=.true.) + + !! Checks + rewind(unit) + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_scalar (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '1', 'Value') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_vector (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1 1 ... 1', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_vector :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1 1 1 1 1', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_matrix :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1', 'Matrix Vector 2') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_matrix (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1 1 ... 1', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1 1 ... 1', 'Matrix Vector 2') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1 1 ... 1', 'Matrix Vector 3') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + ': : : : :', 'Matrix Vector ..') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + '1 1 1 ... 1', 'Matrix Vector Size(Matrix, 1)') + close(unit) + + end subroutine test_io_disp_integer + + subroutine test_io_disp_logical + + logical :: l(6,6) = .true. + ! unit = open(filenanme, 'w+t') + open(newunit=unit, status='scratch') + call disp(l(1,1), header='Test_io_disp_logical_scalar (brief) : ', brief=.true.) + call disp(l(1,1), unit=unit, header='Test_io_disp_logical_scalar (brief) : ', brief=.true.) + + call disp(l(1,:), header='Test_io_disp_logical_vector (brief) : ', brief=.true.) + call disp(l(1,:), unit=unit, header='Test_io_disp_logical_vector (brief) : ', brief=.true.) + + call disp(l(:,1), header='Test_io_disp_logical_vector : ', brief=.false.) + call disp(l(:,1), unit=unit, header='Test_io_disp_logical_vector : ', brief=.false.) + + call disp(l(1:2,1:2), header='Test_io_disp_logical_matrix : ', brief=.false.) + call disp(l(1:2,1:2), unit=unit, header='Test_io_disp_logical_matrix : ', brief=.false.) + + call disp(l(:,:), header='Test_io_disp_logical_matrix (brief) : ', brief=.true.) + call disp(l(:,:), unit=unit, header='Test_io_disp_logical_matrix (brief) : ', brief=.true.) + + !! Checks + rewind(unit) + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_scalar (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'T', 'Value') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_vector (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T T ... T', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_vector :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T T T T T', 'Brief Vector') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_matrix :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T', 'Matrix Vector 2') + + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_matrix (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T T ... T', 'Matrix Vector 1') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T T ... T', 'Matrix Vector 2') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T T ... T', 'Matrix Vector 3') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + ': : : : :', 'Matrix Vector ..') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'T T T ... T', 'Matrix Vector Size(Matrix, 1)') + close(unit) + + end subroutine test_io_disp_logical + + subroutine test_io_disp_character + + character(*), parameter :: str = 'It is a character.' + ! unit = open(filenanme, 'w+t') + open(newunit=unit, status='scratch') + call disp(str, header='Test_io_disp_character_scalar (brief) : ', brief=.true.) + call disp(str, unit=unit, header='Test_io_disp_character_scalar (brief) : ', brief=.true.) + + !! Checks + rewind(unit) + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_character_scalar (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'It is a character.', 'Value') + close(unit) + + end subroutine test_io_disp_character + + subroutine test_io_disp_string_type + + type(string_type) :: str + + str = 'It is a string_type.' + open(newunit=unit, status='scratch') + call disp(str, header='Test_io_disp_string_type_scalar (brief) : ', brief=.true.) + call disp(str, unit=unit, header='Test_io_disp_string_type_scalar (brief) : ', brief=.true.) + + !! Checks + rewind(unit) + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_string_type_scalar (brief) :', 'Header') + read(unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'It is a string_type.', 'Value') + close(unit) + + end subroutine test_io_disp_string_type + +end module test_io_disp + +program tester + + use test_io_disp + ! real(4) :: x(51,51) + + call test_io_disp_complex + call test_io_disp_real + call test_io_disp_integer + call test_io_disp_logical + call test_io_disp_character + call test_io_disp_string_type + + !> Content that is difficult to test: The length of the dimension is too large + !> to print and check by a test program. + ! x = 0.0 + ! call disp(x, header="Test_io_disp_real_matrix (51×51)(default) : [10×50]") + ! call disp(x, header="Test_io_disp_real_matrix (51×51)(brief=.true.) : [5×5]", brief=.true.) + ! call disp(x, header="Test_io_disp_real_matrix (51×51)(brief=.false.) : [all]", brief=.false.) + +end program tester \ No newline at end of file From 4bae1701b40b8caf5cdd161b61a573848d6e1614 Mon Sep 17 00:00:00 2001 From: zoziha Date: Tue, 9 Nov 2021 19:17:56 +0800 Subject: [PATCH 2/6] Redesign and update disp. --- doc/specs/stdlib_io.md | 114 +++++---- src/stdlib_io.fypp | 45 ++-- src/stdlib_io_disp.fypp | 473 ++++++++++++++++++++++--------------- src/tests/io/test_disp.f90 | 438 ++++++++++++++++++---------------- 4 files changed, 593 insertions(+), 477 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 0fa0d30b6..b0a354f7b 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -132,7 +132,7 @@ program demo_savetxt end program demo_savetxt ``` -## `disp` - display your data +## `disp` - display the value of the vairable ### Status @@ -144,49 +144,45 @@ Impure subroutine. ### Description -Outputs a `logical/integer/real/complex/character/string_type` scalar or `logical/integer/real/complex` and rank-1/rank-2 array to the screen or a file `unit`. - -#### More details - -```fortran -call disp( A(i, j, 2, :, 1:10) [, header, unit, brief] ) !! `i, j, ...` can be determined by `do` loop. -``` - -For `complex` type, the output format is `*(A25, 1X)`; -For other types, the output format is `*(A12, 1X)`. - -To prevent users from accidentally passing large-length arrays to `disp`, causing unnecessary io blockage: -1. If the `brief` argument is not specified, `disp` will print **the brief array content with a length of `10*50` by default**. -2. Specify `brief=.true.`, `disp` will print **the brief array content with a length of `5*5`**; -3. Specify `brief=.false.`, `disp` will print **`all` the contents of the array**. +Outputs a `logical/integer/real/complex/character/string_type` scalar, +or `logical/integer/real/complex/string_type` and rank-1/rank-2 array to the screen or a file `unit`. ### Syntax -`call [[stdlib_io(module):disp(interface)]]([x, header, unit, brief])` +`call [[stdlib_io(module):disp(interface)]]( [x, header, unit, brief, format, width, sep] )` ### Arguments -`x`: Shall be a `logical/integer/real/complex/string_type` scalar or `logical/integer/real/complex` and rank-1/rank-2 array. +- `x`: Shall be a `logical/integer/real/complex/character(len=*)/string_type` scalar or `logical/integer/real/complex/string_type` and rank-1/rank-2 array. This argument is `intent(in)` and `optional`. -`header`: Shall be a `character(len=*)` scalar. +- `header`: Shall be a `character(len=*)` scalar. This argument is `intent(in)` and `optional`. -`unit`: Shall be an `integer` scalar linked to an IO stream. -This argument is `intent(in)` and `optional`. +- `unit`: Shall be an `integer` scalar, linked to an IO stream. +This argument is `intent(in)` and `optional`.
+The default value is `output_unit` from `iso_fortran_env` module. -`brief`: Shall be a `logical` scalar. -This argument is `intent(in)` and `optional`. -Controls an abridged version of the `x` object is printed. +- `brief`: Shall be a `logical` scalar, controls an abridged version of the `x` array to be outputed. +This argument is `intent(in)` and `optional`.
+The default value is `.false.` -### Output +- `format`: Shall be a `character(len=*)` scalar. +This argument is `intent(in)` and `optional`.
+The default value is `g0.4`. + +- `width`: Shall be an `integer` scalar, controls the outputed maximum width (`>=80`). +This argument is `intent(in)` and `optional`.
+The default value is `80`. -The result is to print `header` and `x` on the screen (or another output `unit/file`) in this order. -If `x` is a rank-1/rank-2 `array` type, the dimension length information of the `array` will also be outputted. +- `sep`: Shall be a `character(len=*)` scalar, separator. +This argument is `intent(in)` and `optional`.
+The default value is "  ", two spaces. -If `disp` is not passed any arguments, a blank line is printed. +### Output -If the `x` is present and of `real/complex` type, the data will retain four significant decimal places, like `(g0.4)`. +The result is to print `header` and `x` on the screen (or another output `unit/file`) in this order.
+If `disp` is not passed any arguments, a blank line will be printed. ### Example @@ -195,25 +191,23 @@ program test_io_disp use stdlib_io, only: disp - real(8) :: r(2, 3) + real :: r(2, 3) complex :: c(2, 3), c_3d(2, 100, 20) integer :: i(2, 3) logical :: l(10, 10) + r = 1.; c = 1.; c_3d = 2.; i = 1; l = .true. - r(1, 1) = -1.e-11 - r(1, 2) = -1.e10 - c(2, 2) = (-1.e10,-1.e10) c_3d(1,3,1) = (1000, 0.001) - c_3d(1,3,2) = (1.e4, 100.) + call disp('string', header='disp(string):') call disp('It is a note.') call disp() call disp(r, header='disp(r):') - call disp(r(1,:), header='disp(r(1,:))') + call disp(r(1,:), header='disp(r(1,:))', format="f6.2") call disp(c, header='disp(c):') - call disp(i, header='disp(i):') + call disp(i, header='disp(i):', sep=",") call disp(l, header='disp(l):', brief=.true.) - call disp(c_3d(:,:,3), header='disp(c_3d(:,:,3)):', brief=.true.) + call disp(c_3d(:,3,1:10), header='disp(c_3d(:,3,1:10)):', width=100) call disp(c_3d(2,:,:), header='disp(c_3d(2,:,:)):', brief=.true.) end program test_io_disp @@ -221,40 +215,42 @@ end program test_io_disp **Results:** ```fortran disp(string): - string - It is a note. +string +It is a note. disp(r): [matrix size: 2×3] - -0.1000E-10 -0.1000E+11 1.000 - 1.000 1.000 1.000 +1.000 1.000 1.000 +1.000 1.000 1.000 disp(r(1,:)) [vector size: 3] - -0.1000E-10 -0.1000E+11 1.000 + 1.00 1.00 1.00 disp(c): [matrix size: 2×3] - (1.000,0.000) (1.000,0.000) (1.000,0.000) - (1.000,0.000) (-0.1000E+11,-0.1000E+11) (1.000,0.000) +(1.000,0.000) (1.000,0.000) (1.000,0.000) +(1.000,0.000) (1.000,0.000) (1.000,0.000) disp(i): [matrix size: 2×3] - 1 1 1 - 1 1 1 +1, 1, 1, +1, 1, 1, disp(l): [matrix size: 10×10] - T T T ... T - T T T ... T - T T T ... T - : : : : : - T T T ... T +T T T .. T +T T T .. T +T T T .. T +: : : : : +T T T .. T disp(c_3d(:,:,3)): - [matrix size: 2×100] - (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) - (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) + [matrix size: 2×10] +(1000.,0.1000E-2) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) & +(2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) +(2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) & +(2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) disp(c_3d(2,:,:)): [matrix size: 100×20] - (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) - (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) - (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) - : : : : : - (2.000,0.000) (2.000,0.000) (2.000,0.000) ... (2.000,0.000) +(2.000,0.000) (2.000,0.000) (2.000,0.000) .. (2.000,0.000) +(2.000,0.000) (2.000,0.000) (2.000,0.000) .. (2.000,0.000) +(2.000,0.000) (2.000,0.000) (2.000,0.000) .. (2.000,0.000) +: : : : : +(2.000,0.000) (2.000,0.000) (2.000,0.000) .. (2.000,0.000) ``` \ No newline at end of file diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 297b6b6a3..79bd493be 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -34,32 +34,31 @@ module stdlib_io !> !> Display a scalar, vector or matrix. !> ([Specification](../page/specs/stdlib_io.html#disp-display-your-data)) + #! Displays a scalar or array value nicely interface disp - #:set DISP_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES & - & + CMPLX_KINDS_TYPES + LOG_KINDS_TYPES - #:set DISP_RANKS = range(0, 3) - #:for k1, t1 in DISP_KINDS_TYPES - #:for rank in DISP_RANKS - module subroutine disp_${rank}$_${t1[0]}$${k1}$(x, header, unit, brief) - ${t1}$, intent(in) :: x${ranksuffix(rank)}$ + #:set ALL_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES + STRING_KINDS_TYPES + module subroutine disp_char(x, header, unit, brief, format, width, sep) + character(*), intent(in), optional :: x character(len=*), intent(in), optional :: header - integer, intent(in), optional :: unit - logical, intent(in), optional :: brief - end subroutine disp_${rank}$_${t1[0]}$${k1}$ - #:endfor - #:endfor - module subroutine disp_character(x, header, unit, brief) - character(len=*), intent(in), optional :: x + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep + end subroutine disp_char + #:for r1 in range(0, 3) + #:for k1, t1 in ALL_KINDS_TYPES + module subroutine disp_${r1}$_${t1[0]}$${k1}$(x, header, unit, brief, format, width, sep) + ${t1}$, intent(in) :: x${ranksuffix(r1)}$ character(len=*), intent(in), optional :: header - integer, intent(in), optional :: unit - logical, intent(in), optional :: brief - end subroutine disp_character - module subroutine disp_string_type(x, header, unit, brief) - type(string_type), intent(in) :: x - character(len=*), intent(in), optional :: header - integer, intent(in), optional :: unit - logical, intent(in), optional :: brief - end subroutine disp_string_type + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep + end subroutine disp_${r1}$_${t1[0]}$${k1}$ + #:endfor + #:endfor end interface disp interface loadtxt diff --git a/src/stdlib_io_disp.fypp b/src/stdlib_io_disp.fypp index a7651cd5d..c8d51fb66 100644 --- a/src/stdlib_io_disp.fypp +++ b/src/stdlib_io_disp.fypp @@ -1,213 +1,310 @@ #:include "common.fypp" -#:set RIL_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES +#:set ALL_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES + STRING_KINDS_TYPES submodule (stdlib_io) stdlib_io_disp use, intrinsic :: iso_fortran_env, only: output_unit - use stdlib_strings, only: to_string - use stdlib_string_type, only: char + use stdlib_string_type, only: char, len + use stdlib_strings, only: to_string implicit none - character(len=*), parameter :: rfmt = '(*(g12.4, 1x))' - character(len=*), parameter :: cfmt = '(*(g25.0, 1x))' - character(len=*), parameter :: fmt_ = 'g0.4' - integer, parameter :: brief_row = 5 - integer, parameter :: brief_col = 5 - integer, parameter :: default_row = 50 - integer, parameter :: default_col = 10 + type(string_type) :: coloum(5) contains - #:for k1, t1 in RIL_KINDS_TYPES - #! Display a/an ${t1}$ scalar. - module procedure disp_0_${t1[0]}$${k1}$ - integer :: unit_ - - unit_ = optval(unit, output_unit) - - if (present(header)) write(unit_, *) header - write(unit_, rfmt) x - - end procedure disp_0_${t1[0]}$${k1}$ - - #! Display a/an ${t1}$ vector. - module procedure disp_1_${t1[0]}$${k1}$ - integer :: unit_ +#! | string | data elem 1 | unknown width | sep | string | line 1 | defined width | +#! Any type data -> | string | data elem 2 | unknown width | --> | string | line 2 | defined width | -> sequncetial output +#! | ... | ... | ... | add | ... | ... | ... | + + #! REAL, COMPLEX, INTEGER, LOGICAL, STRING_TYPE + #:for r1 in range(0, 3) + #:for k1, t1 in ALL_KINDS_TYPES + module subroutine disp_${r1}$_${t1[0]}$${k1}$(x, header, unit, brief, format, width, sep) + + ${t1}$, intent(in) :: x${ranksuffix(r1)}$ + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep + + integer :: unit_, width_#{if r1 == 2}#, max_elem_len#{endif}# logical :: brief_ - integer :: n, col - - unit_ = optval(unit, output_unit) - brief_ = optval(brief, .true.) - col = merge(brief_col, default_col, present(brief) .and. brief_) - n = size(x, 1) - - if (present(header)) write(unit_, *) header - write(unit_, *) '[vector size: ' // to_string(n) // ']' - - if (brief_ .and. n > col) then - #! Brief Print. - write(unit_, rfmt) x(1:col-2), '...', x(n) - else - #! Full Print. - write(unit_, rfmt) x(:) + character(len=:), allocatable :: format_, sep_ + #{if r1 != 0 or (r1 == 1 and k1 != "string_type")}#integer :: i#{endif}# + #{if r1 == 2 and k1 != "string_type"}#integer :: j#{endif}# + #{if k1 != "string_type"}#type(string_type), allocatable :: x_str${ranksuffix(r1)}$#{endif}# + #{if r1 != 0}#type(string_type) :: array_info#{endif}# + + #! State default values + unit_ = optval(unit, output_unit) + brief_ = optval(brief, .false.) + format_ = optval(format, "g0.4") + + #! width have to be greater than or equal 80 by default + width_ = optval(width, 80) + width_ = merge(width_, 80, width_ > 80) + + sep_ = optval(sep, " ") + coloum = string_type(":") + + #! Prints header + if (present(header)) then + write(unit_, *) format_output_string([string_type(header)], width_, brief_, "", len(header)) end if - - end procedure disp_1_${t1[0]}$${k1}$ - - #! Display a/an ${t1}$ matrix. - module procedure disp_2_${t1[0]}$${k1}$ - integer :: unit_ - logical :: brief_ - integer :: i, m, n - integer :: row, col - character(len=1) :: colon(default_col) - - unit_ = optval(unit, output_unit) - brief_ = optval(brief, .true.) - row = merge(brief_row, default_row, present(brief) .and. brief_) - col = merge(brief_col, default_col, present(brief) .and. brief_) - m = size(x, 1) - n = size(x, 2) - - if (present(header)) write(unit_, *) header - write(unit_, *) '[matrix size: ' // to_string(m) // '×' // to_string(n) // ']' - - if (brief_ .and. (m > row .or. n > col)) then - #! Brief Print. - colon = ':' - if (m > row .and. n > col) then - do i = 1, row-2 - write(unit_, rfmt) x(i,1:col-2), '...', x(i,n) + + #:if k1 != "string_type" + + #:if r1 == 0 + allocate(x_str) + x_str = string_type(to_string(x, format_)) + write(unit_, "(A)") format_output_string([x_str], width_, brief_, sep_, len(x_str)) + + #:elif r1 == 1 + array_info = array_info_maker(size(x, 1)) + write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + + allocate(x_str(size(x, 1))) + do i = 1, size(x, 1) + x_str(i) = string_type(to_string(x(i), format_)) + end do + write(unit_, "(*(A))") format_output_string(x_str, width_, brief_, sep_, maxval(len(x_str))) + + #:elif r1 == 2 + + array_info = array_info_maker(size(x, 1), size(x, 2)) + write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + + allocate(x_str(size(x, 1), size(x, 2))) + do i = 1, size(x, 1) + do j = 1, size(x, 2) + x_str(i, j) = string_type(to_string(x(i, j), format_)) + end do end do - write(unit_, rfmt) colon(1:col) - write(unit_, rfmt) x(m,1:col-2), '...', x(m,n) - elseif (m > row .and. n <= col) then - do i = 1, row-2 - write(unit_, rfmt) x(i,:) + + max_elem_len = maxval(len(x_str)) + + #! Brief mode of rank-2 array + if (brief_.and.size(x, 1)>5) then + do i = 1, 3 + write(unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len) + end do + + write(unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2)<=5)), & + width_, brief_, sep_, max_elem_len) + write(unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len) + + else + do i = 1, size(x, 1) + write(unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len) + end do + end if + + #:endif + + #:elif k1 == "string_type" + + #:if r1 == 0 + write(unit_, "(A)") format_output_string([x], width_, brief_, sep_, len(x)) + + #:elif r1 == 1 + array_info = array_info_maker(size(x, 1)) + write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + + write(unit_, "(*(A))") format_output_string(x, width_, brief_, sep_, maxval(len(x))) + + #:elif r1 == 2 + + array_info = array_info_maker(size(x, 1), size(x, 2)) + write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + + max_elem_len = maxval(len(x)) + + #! Brief mode of rank-2 array + if (brief_.and.size(x, 1)>5) then + do i = 1, 3 + write(unit_, "(*(A))") format_output_string(x(i, :), width_, brief_, sep_, max_elem_len) + end do + + write(unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2)<=5)), & + width_, brief_, sep_, max_elem_len) + write(unit_, "(*(A))") format_output_string(x(size(x, 1), :), width_, brief_, sep_, max_elem_len) + + else + do i = 1, size(x, 1) + write(unit_, "(*(A))") format_output_string(x(i, :), width_, brief_, sep_, max_elem_len) + end do + end if + + #:endif + + #:endif + + end subroutine disp_${r1}$_${t1[0]}$${k1}$ + #:endfor + #:endfor + + !> Format output string + pure module function format_output_string(x, width, brief, sep, max_elem_len) result(str) + + type(string_type), intent(in) :: x(:) + integer, intent(in) :: width + logical, intent(in) :: brief + character(len=*), intent(in) :: sep + + #! Maxium elementaral string length. + integer, intent(in) :: max_elem_len + + #! Output string: brief, ingore width. + character(merge((max(max_elem_len, 2)+len(sep))*min(size(x, 1), 5), width, brief)+2), allocatable :: str(:) + + character(:), allocatable :: buffer + + #! Elementaral string length + character(max(max_elem_len, 2)+len(sep)) :: elem_buffer + integer :: elem_len, num1, num2, i, j + + #! Make brief buffer + if (brief) then + + allocate(str(1)) + buffer = "" + + if (size(x, 1) <= 5) then + + do i = 1, size(x, 1) + elem_buffer = char(x(i))//sep + buffer = buffer//elem_buffer end do - write(unit_, rfmt) colon(1:n) - write(unit_, rfmt) x(m,:) - elseif (m <= row .and. n > col) then - do i = 1, m - write(unit_, rfmt) x(i,1:col-2), '...', x(i,n) + + else + + do i = 1, 3 + elem_buffer = char(x(i))//sep + buffer = buffer//elem_buffer end do + + elem_buffer = ".."//sep + buffer = buffer//elem_buffer + + elem_buffer = char(x(size(x, 1)))//sep + buffer = buffer//elem_buffer + end if + + str(1) = buffer + + #! Make full buffer else - #! Full Print. - do i = 1, m - write(unit_, rfmt) x(i,:) - end do - end if - - end procedure disp_2_${t1[0]}$${k1}$ - #:endfor - - #:for k1, t1 in CMPLX_KINDS_TYPES - #! Display a ${t1}$ scalar. - module procedure disp_0_${t1[0]}$${k1}$ - integer :: unit_ - - unit_ = optval(unit, output_unit) - - if (present(header)) write(unit_, *) header - write(unit_, cfmt) to_string(x, fmt_) - - end procedure disp_0_${t1[0]}$${k1}$ - - #! Display a ${t1}$ vector. - module procedure disp_1_${t1[0]}$${k1}$ - integer :: unit_ - logical :: brief_ - integer :: i, n, col - - unit_ = optval(unit, output_unit) - brief_ = optval(brief, .true.) - col = merge(brief_col, default_col, present(brief) .and. brief_) - n = size(x, 1) - - if (present(header)) write(unit_, *) header - write(unit_, *) '[vector size: ' // to_string(n) // ']' - - if (brief_ .and. n > col) then - #! Brief Print. - write(unit_, cfmt) (to_string(x(i), fmt_), i=1, col-2), '...', to_string(x(n), fmt_) - else - #! Full Print. - write(unit_, cfmt) (to_string(x(i), fmt_), i=1, n) - end if - - end procedure disp_1_${t1[0]}$${k1}$ - - #! Display a ${t1}$ matrix. - module procedure disp_2_${t1[0]}$${k1}$ - integer :: unit_ - logical :: brief_ - integer :: i, j, m, n - integer :: row, col - character(len=1) :: colon(default_col) - - unit_ = optval(unit, output_unit) - brief_ = optval(brief, .true.) - row = merge(brief_row, default_row, present(brief) .and. brief_) - col = merge(brief_col, default_col, present(brief) .and. brief_) - m = size(x, 1) - n = size(x, 2) - - if (present(header)) write(unit_, *) header - write(unit_, *) '[matrix size: ' // to_string(m) // '×' // to_string(n) // ']' - - if (brief_ .and. (m > row .or. n > col)) then - #! Brief Print. - colon = ':' - if (m > row .and. n > col) then - do i = 1, row-2 - write(unit_, cfmt) (to_string(x(i,j), fmt_), j=1, col-2), '...', to_string(x(i,n), fmt_) + + elem_len = len(elem_buffer) + + #! Elementaral string length > Print width + num1 = merge(width/elem_len, 1, elem_len <= width) + num2 = size(x, 1)/num1 + + if (num2 > 1 .or. size(x, 1) /= 0) then + allocate(str(merge(num2, num2 + 1, mod(size(x, 1), num1)==0))) + + do i = 1, size(str) - 1 + + buffer = "" + do j = 1, num1 + elem_buffer = char(x((i-1)*num1+j))//sep + buffer = buffer//elem_buffer + end do + + #! Overlength elementaral string adjustment + if ( len(x((i-1)*num1+j-1)) > width-len(sep)-1 ) then + buffer(width-len(sep)-1:) = "**"//repeat(" ", len(sep)) + end if + + str(i) = buffer + + #! Set continuation flags and line breaks + str(i)(width+1:) = "&"//new_line("") + end do - write(unit_, cfmt) colon(1:col) - write(unit_, cfmt) (to_string(x(m,j), fmt_), j=1, col-2), '...', to_string(x(m,n), fmt_) - elseif (m > row .and. n <= col) then - do i = 1, row-2 - write(unit_, cfmt) (to_string(x(i,j), fmt_), j=1, n) + + buffer = "" + do j = 1, merge(num1, mod(size(x, 1), num1), mod(size(x, 1), num1)==0) + elem_buffer = char(x((i-1)*num1+j))//sep + buffer = buffer//elem_buffer end do - write(unit_, cfmt) colon(1:n) - write(unit_, cfmt) (to_string(x(m,j), fmt_), j=1, n) - elseif (m <= row .and. n > col) then - do i = 1, m - write(unit_, cfmt) (to_string(x(m,j), fmt_), j=1, col-2), '...', to_string(x(m,n), fmt_) + + #! Overlength elementaral string adjustment + if ( len(x((i-1)*num1+j-1)) > width-len(sep)-1 ) then + buffer(width-len(sep)-1:) = "**"//repeat(" ", len(sep)) + end if + + str(i) = buffer + + else + + allocate(str(1)) + buffer = "" + do j = 1, size(x, 1) + elem_buffer = char(x(j))//sep + buffer = buffer//elem_buffer end do + + #! Overlength elementaral string adjustment + if ( len(x(j-1)) > width-len(sep)-1 ) then + buffer(width-len(sep)-1:) = "**"//repeat(" ", len(sep)) + end if + + str(1) = buffer + end if + + end if + + end function format_output_string + + !> Print array infomation + pure type(string_type) module function array_info_maker(m, n) result(info) + integer, intent(in) :: m + integer, intent(in), optional :: n + + if (present(n)) then + info = string_type('[matrix size: ' // to_string(m) // '×' // to_string(n) // ']') else - #! Full Print. - do i = 1, m - write(unit_, cfmt) (to_string(x(i,j), fmt_), j=1, n) - end do + info = string_type('[vector size: ' // to_string(m) // ']') end if - - end procedure disp_2_${t1[0]}$${k1}$ - #:endfor - - #! Display a `character` scalar. - module procedure disp_character - character(len=:), allocatable :: x_ - integer :: unit_ - - x_ = optval(x, '') - unit_ = optval(unit, output_unit) - - if (present(header)) write(unit_, *) header - write(unit_, *) x_ - - end procedure disp_character - - #! Display a `string_type` scalar - module procedure disp_string_type - integer :: unit_ - - unit_ = optval(unit, output_unit) - - if (present(header)) write(unit_, *) header - write(unit_, *) char(x) - - end procedure disp_string_type + + end function array_info_maker + + !> Display `character(*)` value. + module subroutine disp_char(x, header, unit, brief, format, width, sep) + + character(*), intent(in), optional :: x + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep + + integer :: unit_, width_ + logical :: brief_ + character(len=:), allocatable :: x_, sep_ + + !> State default values + x_ = optval(x, "") + unit_ = optval(unit, output_unit) + brief_ = optval(brief, .false.) + width_ = optval(width, 80) + width_ = merge(width_, 80, width_ > 80) + sep_ = optval(sep, " ") + + if (present(header)) then + write(unit_, *) format_output_string([string_type(header)], width_, brief_, "", len(header)) + end if + + coloum(1) = string_type(x_) + write(unit_, "(A)") format_output_string(coloum(1:1), width_, brief_, sep_, len(coloum(1))) + + end subroutine disp_char end submodule stdlib_io_disp \ No newline at end of file diff --git a/src/tests/io/test_disp.f90 b/src/tests/io/test_disp.f90 index dc3268fe1..12e626ff3 100644 --- a/src/tests/io/test_disp.f90 +++ b/src/tests/io/test_disp.f90 @@ -36,316 +36,311 @@ subroutine check_formatter(actual, expected, description, partial) end subroutine check_formatter subroutine test_io_disp_complex - complex :: c(6,6) = (1.0, 1.0) + complex :: c(6, 6) = (1.0, 1.0) - open(newunit=unit, status='scratch') - call disp(c(1,1), header='Test_io_disp_complex_scalar (brief) : ', brief=.true.) - call disp(c(1,1), unit=unit, header='Test_io_disp_complex_scalar (brief) : ', brief=.true.) + open (newunit=unit, status='scratch') + call disp(c(1, 1), header='Test_io_disp_complex_scalar (brief) : ', brief=.true.) + call disp(c(1, 1), unit=unit, header='Test_io_disp_complex_scalar (brief) : ', brief=.true.) - call disp(c(1,:), header='Test_io_disp_complex_vector (brief) : ', brief=.true.) - call disp(c(1,:), unit=unit, header='Test_io_disp_complex_vector (brief) : ', brief=.true.) + call disp(c(1, :), header='Test_io_disp_complex_vector (brief) : ', brief=.true.) + call disp(c(1, :), unit=unit, header='Test_io_disp_complex_vector (brief) : ', brief=.true.) - call disp(c(:,1), header='Test_io_disp_complex_vector : ', brief=.false.) - call disp(c(:,1), unit=unit, header='Test_io_disp_complex_vector : ', brief=.false.) + call disp(c(:, 1), header='Test_io_disp_complex_vector : ', brief=.false.) + call disp(c(:, 1), unit=unit, header='Test_io_disp_complex_vector : ', brief=.false.) - call disp(c(1:2,1:2), header='Test_io_disp_complex_matrix : ', brief=.false.) - call disp(c(1:2,1:2), unit=unit, header='Test_io_disp_complex_matrix : ', brief=.false.) + call disp(c(1:2, 1:2), header='Test_io_disp_complex_matrix : ', brief=.false.) + call disp(c(1:2, 1:2), unit=unit, header='Test_io_disp_complex_matrix : ', brief=.false.) + + call disp(c(:, :), header='Test_io_disp_complex_matrix (brief) : ', brief=.true.) + call disp(c(:, :), unit=unit, header='Test_io_disp_complex_matrix (brief) : ', brief=.true.) - call disp(c(:,:), header='Test_io_disp_complex_matrix (brief) : ', brief=.true.) - call disp(c(:,:), unit=unit, header='Test_io_disp_complex_matrix (brief) : ', brief=.true.) - !! Checks - rewind(unit) - read(unit, '(A200)') string + rewind (unit) + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_scalar (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '(1.000,1.000)', 'Value') - - read(unit, '(A200)') string + + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_vector (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000) (1.000,1.000) & - & ... (1.000,1.000)', 'Brief Vector') + '(1.000,1.000) (1.000,1.000) (1.000,1.000) .. (1.000,1.000)', "Test_io_disp_complex_vector (brief)") - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_vector :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000) (1.000,1.000) & - & (1.000,1.000) (1.000,1.000) (1.000,1.000)', 'Brief Vector') + '(1.000,1.000) (1.000,1.000) (1.000,1.000) (1.000,1.000) (1.000,1.000) &', 'Vector') + read (unit, '(A200)') string + call check_formatter(trim(adjustl(string)), '(1.000,1.000)', 'Vector') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_matrix :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000)', 'Matrix Vector 1') - read(unit, '(A200)') string + '(1.000,1.000) (1.000,1.000)', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000)', 'Matrix Vector 2') + '(1.000,1.000) (1.000,1.000)', 'Matrix Vector 2') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_complex_matrix (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000) (1.000,1.000) & - & ... (1.000,1.000)', 'Matrix Vector 1') - read(unit, '(A200)') string + '(1.000,1.000) (1.000,1.000) (1.000,1.000) .. (1.000,1.000)', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000) (1.000,1.000) & - & ... (1.000,1.000)', 'Matrix Vector 2') - read(unit, '(A200)') string + '(1.000,1.000) (1.000,1.000) (1.000,1.000) .. (1.000,1.000)', 'Matrix Vector 2') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000) (1.000,1.000) & - & ... (1.000,1.000)', 'Matrix Vector 3') - read(unit, '(A200)') string + '(1.000,1.000) (1.000,1.000) (1.000,1.000) .. (1.000,1.000)', 'Matrix Vector 3') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - ': : : & - & : :', 'Matrix Vector ..') - read(unit, '(A200)') string + ': : : : :', 'Matrix Vector ..') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '(1.000,1.000) (1.000,1.000) (1.000,1.000) & - & ... (1.000,1.000)', 'Matrix Vector Size(Matrix, 1)') - close(unit) + '(1.000,1.000) (1.000,1.000) (1.000,1.000) .. (1.000,1.000)', 'Matrix Vector Size(Matrix, 1)') + close (unit) end subroutine test_io_disp_complex subroutine test_io_disp_real - real :: r(6,6) = 1.0 - - open(newunit=unit, status='scratch') - call disp(r(1,1), header='Test_io_disp_real_scalar (brief) : ', brief=.true.) - call disp(r(1,1), unit=unit, header='Test_io_disp_real_scalar (brief) : ', brief=.true.) + real :: r(6, 6) = 1.0 - call disp(r(1,:), header='Test_io_disp_real_vector (brief) : ', brief=.true.) - call disp(r(1,:), unit=unit, header='Test_io_disp_real_vector (brief) : ', brief=.true.) + open (newunit=unit, status='scratch') + call disp(r(1, 1), header='Test_io_disp_real_scalar (brief) : ', brief=.true.) + call disp(r(1, 1), unit=unit, header='Test_io_disp_real_scalar (brief) : ', brief=.true.) - call disp(r(:,1), header='Test_io_disp_real_vector : ', brief=.false.) - call disp(r(:,1), unit=unit, header='Test_io_disp_real_vector : ', brief=.false.) + call disp(r(1, :), header='Test_io_disp_real_vector (brief) : ', brief=.true.) + call disp(r(1, :), unit=unit, header='Test_io_disp_real_vector (brief) : ', brief=.true.) - call disp(r(1:2,1:2), header='Test_io_disp_real_matrix : ', brief=.false.) - call disp(r(1:2,1:2), unit=unit, header='Test_io_disp_real_matrix : ', brief=.false.) + call disp(r(:, 1), header='Test_io_disp_real_vector : ', brief=.false.) + call disp(r(:, 1), unit=unit, header='Test_io_disp_real_vector : ', brief=.false.) + + call disp(r(1:2, 1:2), header='Test_io_disp_real_matrix : ', brief=.false.) + call disp(r(1:2, 1:2), unit=unit, header='Test_io_disp_real_matrix : ', brief=.false.) + + call disp(r(:, :), header='Test_io_disp_real_matrix (brief) : ', brief=.true.) + call disp(r(:, :), unit=unit, header='Test_io_disp_real_matrix (brief) : ', brief=.true.) - call disp(r(:,:), header='Test_io_disp_real_matrix (brief) : ', brief=.true.) - call disp(r(:,:), unit=unit, header='Test_io_disp_real_matrix (brief) : ', brief=.true.) - !! Checks - rewind(unit) - read(unit, '(A200)') string + rewind (unit) + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_scalar (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '1.000', 'Value') - - read(unit, '(A200)') string + + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_vector (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000 1.000 ... 1.000', 'Brief Vector') + '1.000 1.000 1.000 .. 1.000', 'Brief Vector') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_vector :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000 1.000 1.000 1.000 1.000', 'Brief Vector') + '1.000 1.000 1.000 1.000 1.000 1.000', 'Brief Vector') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_matrix :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000', 'Matrix Vector 1') - read(unit, '(A200)') string + '1.000 1.000', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000', 'Matrix Vector 2') + '1.000 1.000', 'Matrix Vector 2') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_real_matrix (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000 1.000 ... 1.000', 'Matrix Vector 1') - read(unit, '(A200)') string + '1.000 1.000 1.000 .. 1.000', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000 1.000 ... 1.000', 'Matrix Vector 2') - read(unit, '(A200)') string + '1.000 1.000 1.000 .. 1.000', 'Matrix Vector 2') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000 1.000 ... 1.000', 'Matrix Vector 3') - read(unit, '(A200)') string + '1.000 1.000 1.000 .. 1.000', 'Matrix Vector 3') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - ': : : : :', 'Matrix Vector ..') - read(unit, '(A200)') string + ': : : : :', 'Matrix Vector ..') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1.000 1.000 1.000 ... 1.000', 'Matrix Vector Size(Matrix, 1)') - close(unit) + '1.000 1.000 1.000 .. 1.000', 'Matrix Vector Size(Matrix, 1)') + close (unit) end subroutine test_io_disp_real subroutine test_io_disp_integer - integer :: i(6,6) = 1 - - open(newunit=unit, status='scratch') - call disp(i(1,1), header='Test_io_disp_integer_scalar (brief) : ', brief=.true.) - call disp(i(1,1), unit=unit, header='Test_io_disp_integer_scalar (brief) : ', brief=.true.) + integer :: i(6, 6) = 1 - call disp(i(1,:), header='Test_io_disp_integer_vector (brief) : ', brief=.true.) - call disp(i(1,:), unit=unit, header='Test_io_disp_integer_vector (brief) : ', brief=.true.) + open (newunit=unit, status='scratch') + call disp(i(1, 1), header='Test_io_disp_integer_scalar (brief) : ', brief=.true.) + call disp(i(1, 1), unit=unit, header='Test_io_disp_integer_scalar (brief) : ', brief=.true.) - call disp(i(:,1), header='Test_io_disp_integer_vector : ', brief=.false.) - call disp(i(:,1), unit=unit, header='Test_io_disp_integer_vector : ', brief=.false.) + call disp(i(1, :), header='Test_io_disp_integer_vector (brief) : ', brief=.true.) + call disp(i(1, :), unit=unit, header='Test_io_disp_integer_vector (brief) : ', brief=.true.) - call disp(i(1:2,1:2), header='Test_io_disp_integer_matrix : ', brief=.false.) - call disp(i(1:2,1:2), unit=unit, header='Test_io_disp_integer_matrix : ', brief=.false.) + call disp(i(:, 1), header='Test_io_disp_integer_vector : ', brief=.false.) + call disp(i(:, 1), unit=unit, header='Test_io_disp_integer_vector : ', brief=.false.) + + call disp(i(1:2, 1:2), header='Test_io_disp_integer_matrix : ', brief=.false.) + call disp(i(1:2, 1:2), unit=unit, header='Test_io_disp_integer_matrix : ', brief=.false.) + + call disp(i(:, :), header='Test_io_disp_integer_matrix (brief) : ', brief=.true.) + call disp(i(:, :), unit=unit, header='Test_io_disp_integer_matrix (brief) : ', brief=.true.) - call disp(i(:,:), header='Test_io_disp_integer_matrix (brief) : ', brief=.true.) - call disp(i(:,:), unit=unit, header='Test_io_disp_integer_matrix (brief) : ', brief=.true.) - !! Checks - rewind(unit) - read(unit, '(A200)') string + rewind (unit) + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_scalar (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '1', 'Value') - - read(unit, '(A200)') string + + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_vector (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1 1 ... 1', 'Brief Vector') + '1 1 1 .. 1', 'Brief Vector') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_vector :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1 1 1 1 1', 'Brief Vector') + '1 1 1 1 1 1', 'Brief Vector') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_matrix :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1', 'Matrix Vector 1') - read(unit, '(A200)') string + '1 1', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1', 'Matrix Vector 2') + '1 1', 'Matrix Vector 2') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_integer_matrix (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1 1 ... 1', 'Matrix Vector 1') - read(unit, '(A200)') string + '1 1 1 .. 1', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1 1 ... 1', 'Matrix Vector 2') - read(unit, '(A200)') string + '1 1 1 .. 1', 'Matrix Vector 2') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1 1 ... 1', 'Matrix Vector 3') - read(unit, '(A200)') string + '1 1 1 .. 1', 'Matrix Vector 3') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - ': : : : :', 'Matrix Vector ..') - read(unit, '(A200)') string + ': : : : :', 'Matrix Vector ..') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - '1 1 1 ... 1', 'Matrix Vector Size(Matrix, 1)') - close(unit) + '1 1 1 .. 1', 'Matrix Vector Size(Matrix, 1)') + close (unit) end subroutine test_io_disp_integer subroutine test_io_disp_logical - logical :: l(6,6) = .true. + logical :: l(6, 6) = .true. ! unit = open(filenanme, 'w+t') - open(newunit=unit, status='scratch') - call disp(l(1,1), header='Test_io_disp_logical_scalar (brief) : ', brief=.true.) - call disp(l(1,1), unit=unit, header='Test_io_disp_logical_scalar (brief) : ', brief=.true.) + open (newunit=unit, status='scratch') + call disp(l(1, 1), header='Test_io_disp_logical_scalar (brief) : ', brief=.true.) + call disp(l(1, 1), unit=unit, header='Test_io_disp_logical_scalar (brief) : ', brief=.true.) - call disp(l(1,:), header='Test_io_disp_logical_vector (brief) : ', brief=.true.) - call disp(l(1,:), unit=unit, header='Test_io_disp_logical_vector (brief) : ', brief=.true.) + call disp(l(1, :), header='Test_io_disp_logical_vector (brief) : ', brief=.true.) + call disp(l(1, :), unit=unit, header='Test_io_disp_logical_vector (brief) : ', brief=.true.) - call disp(l(:,1), header='Test_io_disp_logical_vector : ', brief=.false.) - call disp(l(:,1), unit=unit, header='Test_io_disp_logical_vector : ', brief=.false.) + call disp(l(:, 1), header='Test_io_disp_logical_vector : ', brief=.false.) + call disp(l(:, 1), unit=unit, header='Test_io_disp_logical_vector : ', brief=.false.) - call disp(l(1:2,1:2), header='Test_io_disp_logical_matrix : ', brief=.false.) - call disp(l(1:2,1:2), unit=unit, header='Test_io_disp_logical_matrix : ', brief=.false.) + call disp(l(1:2, 1:2), header='Test_io_disp_logical_matrix : ', brief=.false.) + call disp(l(1:2, 1:2), unit=unit, header='Test_io_disp_logical_matrix : ', brief=.false.) + + call disp(l(:, :), header='Test_io_disp_logical_matrix (brief) : ', brief=.true.) + call disp(l(:, :), unit=unit, header='Test_io_disp_logical_matrix (brief) : ', brief=.true.) - call disp(l(:,:), header='Test_io_disp_logical_matrix (brief) : ', brief=.true.) - call disp(l(:,:), unit=unit, header='Test_io_disp_logical_matrix (brief) : ', brief=.true.) - !! Checks - rewind(unit) - read(unit, '(A200)') string + rewind (unit) + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_scalar (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'T', 'Value') - - read(unit, '(A200)') string + + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_vector (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T T ... T', 'Brief Vector') + 'T T T .. T', 'Brief Vector') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_vector :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[vector size: 6]', 'Vector Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T T T T T', 'Brief Vector') + 'T T T T T T', 'Brief Vector') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_matrix :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 2×2]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T', 'Matrix Vector 1') - read(unit, '(A200)') string + 'T T', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T', 'Matrix Vector 2') + 'T T', 'Matrix Vector 2') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_logical_matrix (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), '[matrix size: 6×6]', 'Matrix Info') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T T ... T', 'Matrix Vector 1') - read(unit, '(A200)') string + 'T T T .. T', 'Matrix Vector 1') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T T ... T', 'Matrix Vector 2') - read(unit, '(A200)') string + 'T T T .. T', 'Matrix Vector 2') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T T ... T', 'Matrix Vector 3') - read(unit, '(A200)') string + 'T T T .. T', 'Matrix Vector 3') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - ': : : : :', 'Matrix Vector ..') - read(unit, '(A200)') string + ': : : : :', 'Matrix Vector ..') + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), & - 'T T T ... T', 'Matrix Vector Size(Matrix, 1)') - close(unit) + 'T T T .. T', 'Matrix Vector Size(Matrix, 1)') + close (unit) end subroutine test_io_disp_logical @@ -353,46 +348,75 @@ subroutine test_io_disp_character character(*), parameter :: str = 'It is a character.' ! unit = open(filenanme, 'w+t') - open(newunit=unit, status='scratch') + open (newunit=unit, status='scratch') call disp(str, header='Test_io_disp_character_scalar (brief) : ', brief=.true.) call disp(str, unit=unit, header='Test_io_disp_character_scalar (brief) : ', brief=.true.) - + !! Checks - rewind(unit) - read(unit, '(A200)') string + rewind (unit) + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_character_scalar (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'It is a character.', 'Value') - close(unit) + close (unit) end subroutine test_io_disp_character subroutine test_io_disp_string_type - type(string_type) :: str - + type(string_type) :: str, s(6, 6) + str = 'It is a string_type.' - open(newunit=unit, status='scratch') + s = 'It is a string_type.' + open (newunit=unit, status='scratch') call disp(str, header='Test_io_disp_string_type_scalar (brief) : ', brief=.true.) call disp(str, unit=unit, header='Test_io_disp_string_type_scalar (brief) : ', brief=.true.) - + call disp(s, header='Test_io_disp_string_type_array (brief) : ', brief=.true.) + call disp(s, unit=unit, header='Test_io_disp_string_type_array (brief) : ', brief=.true.) + call disp(s, header='Test_io_disp_string_type_array : ') + call disp(s, unit=unit, header='Test_io_disp_string_type_array : ') + !! Checks - rewind(unit) - read(unit, '(A200)') string + rewind (unit) + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'Test_io_disp_string_type_scalar (brief) :', 'Header') - read(unit, '(A200)') string + read (unit, '(A200)') string call check_formatter(trim(adjustl(string)), 'It is a string_type.', 'Value') - close(unit) + read (unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_string_type_array (brief) :', 'Header') + read (unit, *) + read (unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'It is a string_type. It is a string_type. It is a string_type. .. It is a string_type.', & + 'Value') + read (unit, *) + read (unit, *) + read (unit, *) + read (unit, *) + read (unit, '(A200)') string + call check_formatter(trim(adjustl(string)), 'Test_io_disp_string_type_array :', 'Header') + read (unit, *) + read (unit, '(A200)') string + call check_formatter(trim(adjustl(string)), & + 'It is a string_type. It is a string_type. It is a string_type. &', 'Value') + close (unit) end subroutine test_io_disp_string_type - + + subroutine larger_matrix + real(4) :: x(51,51) + call disp(x, header="Test_io_disp_real_matrix (51×51)(default) : [10×50]") + call disp(x, header="Test_io_disp_real_matrix (51×51)(brief=.true.) : [5×5]", brief=.true.) + call disp(x, header="Test_io_disp_real_matrix (51×51)(brief=.false.) : [all]", brief=.false.) + end subroutine larger_matrix + end module test_io_disp program tester use test_io_disp - ! real(4) :: x(51,51) - + logical :: test_larger = .false. + call test_io_disp_complex call test_io_disp_real call test_io_disp_integer @@ -402,9 +426,9 @@ program tester !> Content that is difficult to test: The length of the dimension is too large !> to print and check by a test program. - ! x = 0.0 - ! call disp(x, header="Test_io_disp_real_matrix (51×51)(default) : [10×50]") - ! call disp(x, header="Test_io_disp_real_matrix (51×51)(brief=.true.) : [5×5]", brief=.true.) - ! call disp(x, header="Test_io_disp_real_matrix (51×51)(brief=.false.) : [all]", brief=.false.) + + if (test_larger) then + call larger_matrix + end if -end program tester \ No newline at end of file +end program tester From 761dacfca7ab67745b8e3db6f478b90d6125f53b Mon Sep 17 00:00:00 2001 From: zoziha Date: Tue, 9 Nov 2021 20:32:06 +0800 Subject: [PATCH 3/6] Fix CI error: remove `module` keyword in submodule. --- doc/specs/stdlib_io.md | 6 +++--- src/stdlib_io.fypp | 33 ++++++++++++++++----------------- src/stdlib_io_disp.fypp | 10 +++++----- 3 files changed, 24 insertions(+), 25 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index b0a354f7b..cf7941432 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -132,7 +132,7 @@ program demo_savetxt end program demo_savetxt ``` -## `disp` - display the value of the vairable +## `disp` - display the value of the variable ### Status @@ -163,7 +163,7 @@ This argument is `intent(in)` and `optional`. This argument is `intent(in)` and `optional`.
The default value is `output_unit` from `iso_fortran_env` module. -- `brief`: Shall be a `logical` scalar, controls an abridged version of the `x` array to be outputed. +- `brief`: Shall be a `logical` scalar, controls an abridged version of the `x` array to be outputted. This argument is `intent(in)` and `optional`.
The default value is `.false.` @@ -171,7 +171,7 @@ The default value is `.false.` This argument is `intent(in)` and `optional`.
The default value is `g0.4`. -- `width`: Shall be an `integer` scalar, controls the outputed maximum width (`>=80`). +- `width`: Shall be an `integer` scalar, controls the outputted maximum width (`>=80`). This argument is `intent(in)` and `optional`.
The default value is `80`. diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 79bd493be..cd7b3cbed 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -32,30 +32,29 @@ module stdlib_io !> version: experimental !> - !> Display a scalar, vector or matrix. - !> ([Specification](../page/specs/stdlib_io.html#disp-display-your-data)) - #! Displays a scalar or array value nicely + !> Display a scalar, vector or matrix formatted. + !> ([Specification](../page/specs/stdlib_io.html#display-the-value-of-the-variable)) interface disp #:set ALL_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES + STRING_KINDS_TYPES module subroutine disp_char(x, header, unit, brief, format, width, sep) - character(*), intent(in), optional :: x - character(len=*), intent(in), optional :: header - integer, intent(in), optional :: unit - logical, intent(in), optional :: brief - character(len=*), intent(in), optional :: format - integer, intent(in), optional :: width - character(len=*), intent(in), optional :: sep + character(*), intent(in), optional :: x + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep end subroutine disp_char #:for r1 in range(0, 3) #:for k1, t1 in ALL_KINDS_TYPES module subroutine disp_${r1}$_${t1[0]}$${k1}$(x, header, unit, brief, format, width, sep) - ${t1}$, intent(in) :: x${ranksuffix(r1)}$ - character(len=*), intent(in), optional :: header - integer, intent(in), optional :: unit - logical, intent(in), optional :: brief - character(len=*), intent(in), optional :: format - integer, intent(in), optional :: width - character(len=*), intent(in), optional :: sep + ${t1}$, intent(in) :: x${ranksuffix(r1)}$ + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep end subroutine disp_${r1}$_${t1[0]}$${k1}$ #:endfor #:endfor diff --git a/src/stdlib_io_disp.fypp b/src/stdlib_io_disp.fypp index c8d51fb66..0888d797e 100644 --- a/src/stdlib_io_disp.fypp +++ b/src/stdlib_io_disp.fypp @@ -32,7 +32,7 @@ contains integer :: unit_, width_#{if r1 == 2}#, max_elem_len#{endif}# logical :: brief_ character(len=:), allocatable :: format_, sep_ - #{if r1 != 0 or (r1 == 1 and k1 != "string_type")}#integer :: i#{endif}# + #{if r1 != 0 and not(r1 == 1 and k1 == "string_type")}#integer :: i#{endif}# #{if r1 == 2 and k1 != "string_type"}#integer :: j#{endif}# #{if k1 != "string_type"}#type(string_type), allocatable :: x_str${ranksuffix(r1)}$#{endif}# #{if r1 != 0}#type(string_type) :: array_info#{endif}# @@ -146,7 +146,7 @@ contains #:endfor !> Format output string - pure module function format_output_string(x, width, brief, sep, max_elem_len) result(str) + pure function format_output_string(x, width, brief, sep, max_elem_len) result(str) type(string_type), intent(in) :: x(:) integer, intent(in) :: width @@ -204,7 +204,7 @@ contains num1 = merge(width/elem_len, 1, elem_len <= width) num2 = size(x, 1)/num1 - if (num2 > 1 .or. size(x, 1) /= 0) then + if (num2 > 1 .or. size(x, 1) > 1) then allocate(str(merge(num2, num2 + 1, mod(size(x, 1), num1)==0))) do i = 1, size(str) - 1 @@ -262,8 +262,8 @@ contains end function format_output_string - !> Print array infomation - pure type(string_type) module function array_info_maker(m, n) result(info) + !> Print array information + pure type(string_type) function array_info_maker(m, n) result(info) integer, intent(in) :: m integer, intent(in), optional :: n From 575c9449733f0e1db9db1722e8ca07870b275980 Mon Sep 17 00:00:00 2001 From: zoziha Date: Tue, 9 Nov 2021 22:11:05 +0800 Subject: [PATCH 4/6] Fix CI error: remove `module` keyword in submodule. --- doc/specs/stdlib_io.md | 6 +++--- src/stdlib_io.fypp | 33 ++++++++++++++++----------------- src/stdlib_io_disp.fypp | 20 ++++++++++---------- 3 files changed, 29 insertions(+), 30 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index b0a354f7b..cf7941432 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -132,7 +132,7 @@ program demo_savetxt end program demo_savetxt ``` -## `disp` - display the value of the vairable +## `disp` - display the value of the variable ### Status @@ -163,7 +163,7 @@ This argument is `intent(in)` and `optional`. This argument is `intent(in)` and `optional`.
The default value is `output_unit` from `iso_fortran_env` module. -- `brief`: Shall be a `logical` scalar, controls an abridged version of the `x` array to be outputed. +- `brief`: Shall be a `logical` scalar, controls an abridged version of the `x` array to be outputted. This argument is `intent(in)` and `optional`.
The default value is `.false.` @@ -171,7 +171,7 @@ The default value is `.false.` This argument is `intent(in)` and `optional`.
The default value is `g0.4`. -- `width`: Shall be an `integer` scalar, controls the outputed maximum width (`>=80`). +- `width`: Shall be an `integer` scalar, controls the outputted maximum width (`>=80`). This argument is `intent(in)` and `optional`.
The default value is `80`. diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 79bd493be..cd7b3cbed 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -32,30 +32,29 @@ module stdlib_io !> version: experimental !> - !> Display a scalar, vector or matrix. - !> ([Specification](../page/specs/stdlib_io.html#disp-display-your-data)) - #! Displays a scalar or array value nicely + !> Display a scalar, vector or matrix formatted. + !> ([Specification](../page/specs/stdlib_io.html#display-the-value-of-the-variable)) interface disp #:set ALL_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES + STRING_KINDS_TYPES module subroutine disp_char(x, header, unit, brief, format, width, sep) - character(*), intent(in), optional :: x - character(len=*), intent(in), optional :: header - integer, intent(in), optional :: unit - logical, intent(in), optional :: brief - character(len=*), intent(in), optional :: format - integer, intent(in), optional :: width - character(len=*), intent(in), optional :: sep + character(*), intent(in), optional :: x + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep end subroutine disp_char #:for r1 in range(0, 3) #:for k1, t1 in ALL_KINDS_TYPES module subroutine disp_${r1}$_${t1[0]}$${k1}$(x, header, unit, brief, format, width, sep) - ${t1}$, intent(in) :: x${ranksuffix(r1)}$ - character(len=*), intent(in), optional :: header - integer, intent(in), optional :: unit - logical, intent(in), optional :: brief - character(len=*), intent(in), optional :: format - integer, intent(in), optional :: width - character(len=*), intent(in), optional :: sep + ${t1}$, intent(in) :: x${ranksuffix(r1)}$ + character(len=*), intent(in), optional :: header + integer, intent(in), optional :: unit + logical, intent(in), optional :: brief + character(len=*), intent(in), optional :: format + integer, intent(in), optional :: width + character(len=*), intent(in), optional :: sep end subroutine disp_${r1}$_${t1[0]}$${k1}$ #:endfor #:endfor diff --git a/src/stdlib_io_disp.fypp b/src/stdlib_io_disp.fypp index c8d51fb66..acdf57f43 100644 --- a/src/stdlib_io_disp.fypp +++ b/src/stdlib_io_disp.fypp @@ -32,7 +32,7 @@ contains integer :: unit_, width_#{if r1 == 2}#, max_elem_len#{endif}# logical :: brief_ character(len=:), allocatable :: format_, sep_ - #{if r1 != 0 or (r1 == 1 and k1 != "string_type")}#integer :: i#{endif}# + #{if r1 != 0 and not(r1 == 1 and k1 == "string_type")}#integer :: i#{endif}# #{if r1 == 2 and k1 != "string_type"}#integer :: j#{endif}# #{if k1 != "string_type"}#type(string_type), allocatable :: x_str${ranksuffix(r1)}$#{endif}# #{if r1 != 0}#type(string_type) :: array_info#{endif}# @@ -51,7 +51,7 @@ contains #! Prints header if (present(header)) then - write(unit_, *) format_output_string([string_type(header)], width_, brief_, "", len(header)) + write(unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header)) end if #:if k1 != "string_type" @@ -63,7 +63,7 @@ contains #:elif r1 == 1 array_info = array_info_maker(size(x, 1)) - write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + write(unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info)) allocate(x_str(size(x, 1))) do i = 1, size(x, 1) @@ -74,7 +74,7 @@ contains #:elif r1 == 2 array_info = array_info_maker(size(x, 1), size(x, 2)) - write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + write(unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info)) allocate(x_str(size(x, 1), size(x, 2))) do i = 1, size(x, 1) @@ -110,14 +110,14 @@ contains #:elif r1 == 1 array_info = array_info_maker(size(x, 1)) - write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + write(unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info)) write(unit_, "(*(A))") format_output_string(x, width_, brief_, sep_, maxval(len(x))) #:elif r1 == 2 array_info = array_info_maker(size(x, 1), size(x, 2)) - write(unit_, *) format_output_string([array_info], width_, brief_, "", len(array_info)) + write(unit_, "(A)") format_output_string([array_info], width_, brief_, "", len(array_info)) max_elem_len = maxval(len(x)) @@ -146,7 +146,7 @@ contains #:endfor !> Format output string - pure module function format_output_string(x, width, brief, sep, max_elem_len) result(str) + pure function format_output_string(x, width, brief, sep, max_elem_len) result(str) type(string_type), intent(in) :: x(:) integer, intent(in) :: width @@ -204,7 +204,7 @@ contains num1 = merge(width/elem_len, 1, elem_len <= width) num2 = size(x, 1)/num1 - if (num2 > 1 .or. size(x, 1) /= 0) then + if (num2 > 1 .or. size(x, 1) > 1) then allocate(str(merge(num2, num2 + 1, mod(size(x, 1), num1)==0))) do i = 1, size(str) - 1 @@ -262,8 +262,8 @@ contains end function format_output_string - !> Print array infomation - pure type(string_type) module function array_info_maker(m, n) result(info) + !> Print array information + pure type(string_type) function array_info_maker(m, n) result(info) integer, intent(in) :: m integer, intent(in), optional :: n From fd00762690816ba37e104afda3a51aa3be6b1c86 Mon Sep 17 00:00:00 2001 From: zoziha Date: Tue, 9 Nov 2021 22:49:33 +0800 Subject: [PATCH 5/6] Minor fix. --- doc/specs/stdlib_io.md | 30 +++++++++++++++--------------- src/stdlib_io_disp.fypp | 2 +- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index cf7941432..6fd7d2838 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -214,40 +214,40 @@ end program test_io_disp ``` **Results:** ```fortran - disp(string): +disp(string): string It is a note. - disp(r): - [matrix size: 2×3] +disp(r): +[matrix size: 2×3] 1.000 1.000 1.000 1.000 1.000 1.000 - disp(r(1,:)) - [vector size: 3] +disp(r(1,:)) +[vector size: 3] 1.00 1.00 1.00 - disp(c): - [matrix size: 2×3] +disp(c): +[matrix size: 2×3] (1.000,0.000) (1.000,0.000) (1.000,0.000) (1.000,0.000) (1.000,0.000) (1.000,0.000) - disp(i): - [matrix size: 2×3] +disp(i): +[matrix size: 2×3] 1, 1, 1, 1, 1, 1, - disp(l): - [matrix size: 10×10] +disp(l): +[matrix size: 10×10] T T T .. T T T T .. T T T T .. T : : : : : T T T .. T - disp(c_3d(:,:,3)): - [matrix size: 2×10] +disp(c_3d(:,3,1:10)): +[matrix size: 2×10] (1000.,0.1000E-2) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) & (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) & (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) - disp(c_3d(2,:,:)): - [matrix size: 100×20] +disp(c_3d(2,:,:)): +[matrix size: 100×20] (2.000,0.000) (2.000,0.000) (2.000,0.000) .. (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) .. (2.000,0.000) (2.000,0.000) (2.000,0.000) (2.000,0.000) .. (2.000,0.000) diff --git a/src/stdlib_io_disp.fypp b/src/stdlib_io_disp.fypp index acdf57f43..d2cbf10cc 100644 --- a/src/stdlib_io_disp.fypp +++ b/src/stdlib_io_disp.fypp @@ -299,7 +299,7 @@ contains sep_ = optval(sep, " ") if (present(header)) then - write(unit_, *) format_output_string([string_type(header)], width_, brief_, "", len(header)) + write(unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header)) end if coloum(1) = string_type(x_) From 710e1156e7a41f4b701f1fb973cadc91e7f6b374 Mon Sep 17 00:00:00 2001 From: zoziha Date: Wed, 10 Nov 2021 13:55:20 +0800 Subject: [PATCH 6/6] Ensure multi-thread safety. --- src/stdlib_io_disp.fypp | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/stdlib_io_disp.fypp b/src/stdlib_io_disp.fypp index d2cbf10cc..70193e451 100644 --- a/src/stdlib_io_disp.fypp +++ b/src/stdlib_io_disp.fypp @@ -8,8 +8,6 @@ submodule (stdlib_io) stdlib_io_disp use stdlib_strings, only: to_string implicit none - type(string_type) :: coloum(5) - contains #! | string | data elem 1 | unknown width | sep | string | line 1 | defined width | @@ -47,7 +45,6 @@ contains width_ = merge(width_, 80, width_ > 80) sep_ = optval(sep, " ") - coloum = string_type(":") #! Prints header if (present(header)) then @@ -91,7 +88,8 @@ contains write(unit_, "(*(A))") format_output_string(x_str(i, :), width_, brief_, sep_, max_elem_len) end do - write(unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2)<=5)), & + write(unit_, "(*(A))") format_output_string( & + string_type(spread(":", 1, merge(size(x, 2), 5, size(x, 2) < 5))), & width_, brief_, sep_, max_elem_len) write(unit_, "(*(A))") format_output_string(x_str(size(x, 1), :), width_, brief_, sep_, max_elem_len) @@ -127,7 +125,8 @@ contains write(unit_, "(*(A))") format_output_string(x(i, :), width_, brief_, sep_, max_elem_len) end do - write(unit_, "(*(A))") format_output_string(coloum(1:merge(size(x, 2), 5, size(x, 2)<=5)), & + write(unit_, "(*(A))") format_output_string( & + string_type(spread(":", 1, merge(size(x, 2), 5, size(x, 2) < 5))), & width_, brief_, sep_, max_elem_len) write(unit_, "(*(A))") format_output_string(x(size(x, 1), :), width_, brief_, sep_, max_elem_len) @@ -302,8 +301,7 @@ contains write(unit_, "(A)") format_output_string([string_type(header)], width_, brief_, "", len(header)) end if - coloum(1) = string_type(x_) - write(unit_, "(A)") format_output_string(coloum(1:1), width_, brief_, sep_, len(coloum(1))) + write(unit_, "(A)") format_output_string([string_type(x_)], width_, brief_, sep_, len(x_)) end subroutine disp_char