From 4bae1701b40b8caf5cdd161b61a573848d6e1614 Mon Sep 17 00:00:00 2001 From: zoziha Date: Tue, 9 Nov 2021 19:17:56 +0800 Subject: [PATCH] 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