Addition of checks and use of stdlib_experimental_ascii (fortran-lang#82

)

* parse_mode: addition of conditionals for checking wrong modes

* stblib_experimental_io: addition of an io variable in the open function

* stdlib_experimental_io: changed whitechar for is_blank provided by stdlib_experimental_ascii

*  correction of a typo

* changed lastwhite to lastblank (proposed by @ivan-pi)

* changes suggested by @certik

* added 1 io in test_open

src/stdlib_experimental_io.f90

@@ -2,6 +2,7 @@ module stdlib_experimental_io
 use stdlib_experimental_kinds, only: sp, dp, qp
 use stdlib_experimental_error, only: error_stop
 use stdlib_experimental_optval, only: optval
+use stdlib_experimental_ascii, only: is_blank
 implicit none
 private
 ! Public API
@@ -231,16 +232,16 @@ integer function number_of_columns(s)
 
  integer :: ios
  character :: c
- logical :: lastwhite
+ logical :: lastblank
 
  rewind(s)
  number_of_columns = 0
- lastwhite = .true.
+ lastblank = .true.
  do
     read(s, '(a)', advance='no', iostat=ios) c
     if (ios /= 0) exit
-    if (lastwhite .and. .not. whitechar(c)) number_of_columns = number_of_columns + 1
-    lastwhite = whitechar(c)
+    if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1
+    lastblank = is_blank(c)
  end do
  rewind(s)
 
@@ -265,17 +266,7 @@ integer function number_of_rows_numeric(s)
 
 end function
 
-pure logical function whitechar(char) ! white character
-! returns .true. if char is space (32) or tab (9), .false. otherwise
-character, intent(in) :: char
-if (iachar(char) == 32 .or. iachar(char) == 9) then
-    whitechar = .true.
-else
-    whitechar = .false.
-end if
-end function
-
-integer function open(filename, mode) result(u)
+integer function open(filename, mode, iostat) result(u)
 ! Open a file
 !
 ! To open a file to read:
@@ -293,8 +284,10 @@ integer function open(filename, mode) result(u)
 
 character(*), intent(in) :: filename
 character(*), intent(in), optional :: mode
-integer :: io
-character(3):: mode_
+integer, intent(out), optional :: iostat
+
+integer :: io_
+character(3) :: mode_
 character(:),allocatable :: action_, position_, status_, access_, form_
 
 
@@ -348,37 +341,51 @@ integer function open(filename, mode) result(u)
     call error_stop("Unsupported mode: "//mode_(3:3))
 end select
 
-open(newunit=u, file=filename, &
-     action = action_, position = position_, status = status_, &
-     access = access_, form = form_, &
-     iostat = io)
+if (present(iostat)) then
+    open(newunit=u, file=filename, &
+         action = action_, position = position_, status = status_, &
+         access = access_, form = form_, &
+         iostat = iostat)
+else
+    open(newunit=u, file=filename, &
+         action = action_, position = position_, status = status_, &
+         access = access_, form = form_)
+end if
 
 end function
 
 character(3) function parse_mode(mode) result(mode_)
 character(*), intent(in) :: mode
 
-integer::i
-character(:),allocatable::a
+integer :: i
+character(:),allocatable :: a
+logical :: lfirst(3)
 
 mode_ = 'r t'
 
 if (len_trim(mode) == 0) return
 a=trim(adjustl(mode))
 
+lfirst = .true.
 do i=1,len(a)
-    select case (a(i:i))
-    case('r', 'w', 'a', 'x')
+    if (lfirst(1) &
+        .and. (a(i:i) == 'r' .or. a(i:i) == 'w' .or. a(i:i) == 'a' .or. a(i:i) == 'x') &
+        ) then
         mode_(1:1) = a(i:i)
-    case('+')
+        lfirst(1)=.false.
+    else if (lfirst(2) .and. a(i:i) == '+') then
         mode_(2:2) = a(i:i)
-    case('t', 'b')
+        lfirst(2)=.false.
+    else if (lfirst(3) .and. (a(i:i) == 't' .or. a(i:i) == 'b')) then
         mode_(3:3) = a(i:i)
-    case(' ')
-        cycle
-    case default
+        lfirst(3)=.false.
+    else if (a(i:i) == ' ') then
+     cycle
+    else if(any(.not.lfirst)) then
+        call error_stop("Wrong mode: "//trim(a))
+    else
         call error_stop("Wrong character: "//a(i:i))
-    end select
+    endif
 end do
 
 end function

src/tests/io/test_open.f90

@@ -4,8 +4,7 @@ program test_open
 implicit none
 
 character(:), allocatable :: filename
-integer :: u, a(3)
-
+integer :: io, u, a(3)
 
 ! Text file
 filename = get_outpath() // "/io_open.dat"
@@ -59,6 +58,29 @@ program test_open
 call assert(all(a == [4, 5, 6]))
 close(u)
 
+
+
+!0 and non-0 open
+filename = get_outpath() // "/io_open.stream"
+
+u = open(filename, "rb", io)
+call assert(io == 0)
+if (io == 0) close(u)
+
+u = open(filename, "ab", io)
+call assert(io == 0)
+if (io == 0) close(u)
+
+
+filename = get_outpath() // "/does_not_exist.error"
+
+u = open(filename, "a", io)
+call assert(io /= 0)
+
+u = open(filename, "r", io)
+call assert(io /= 0)
+
+
 contains
 
     function get_outpath() result(outpath)

src/tests/io/test_parse_mode.f90

@@ -9,6 +9,8 @@ program test_parse_mode
 
 call test_parse_mode_random_order()
 
+!call test_parse_mode_always_fail()
+
 contains
 
     subroutine test_parse_mode_expected_order()
@@ -149,16 +151,16 @@ subroutine test_parse_mode_random_order()
 
     m = parse_mode("tr+ ")
     call assert(m == "r+t")
-    m = parse_mode("wtt + ")
+    m = parse_mode("wt + ")
     call assert(m == "w+t")
     m = parse_mode("a + t")
     call assert(m == "a+t")
     m = parse_mode(" xt + ")
     call assert(m == "x+t")
 
-    m = parse_mode("t + t")
+    m = parse_mode(" + t")
     call assert(m == "r+t")
-    m = parse_mode(" ww + b")
+    m = parse_mode(" +w  b")
     call assert(m == "w+b")
     m = parse_mode("a + b")
     call assert(m == "a+b")
@@ -167,5 +169,19 @@ subroutine test_parse_mode_random_order()
 
     end subroutine
 
+    subroutine test_parse_mode_always_fail()
+    character(3) :: m
+
+    m = parse_mode("r+w")
+    call assert(m /= "r t")
+
+    m = parse_mode("tt")
+    call assert(m /= "r t")
+
+    m = parse_mode("bt")
+    call assert(m /= "r t")
+
+    end subroutine
+
 
 end program