diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index b3fa9c3a4..79188d65c 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -287,26 +287,85 @@ integer function open(filename, mode) result(u) character(*), intent(in) :: filename character(*), intent(in), optional :: mode -character(:), allocatable :: mode_ -mode_ = "rt" -if (present(mode)) mode_ = mode -! Note: the Fortran standard says that the default values for `status` and -! `action` are processor dependent, so we have to explicitly set them below -if (mode_ == "r" .or. mode_ == 'rt') then - open(newunit=u, file=filename, status="old", action="read", & - access='sequential', form='formatted') -else if (mode_ == "w" .or. mode_ == "wt") then - open(newunit=u, file=filename, status="replace", action="write", & - access='sequential', form='formatted') -else if (mode_ == "a" .or. mode_ == "at") then - open(newunit=u, file=filename, position="append", status="old", & - action="write", access='sequential', form='formatted') -else if (mode_ == "x" .or. mode_ == "xt") then - open(newunit=u, file=filename, status="new", & - action="write", access='sequential', form='formatted') +integer :: io +character(3):: mode_ +character(:),allocatable :: action_, position_, status_, access_, form_ + + +mode_ = "r t" +if (present(mode)) mode_ = parse_mode(mode) + +if (mode_(1:2) == 'r ') then + action_='read' + position_='asis' + status_='old' +else if (mode_(1:2) == 'w ') then + action_='write' + position_='asis' + status_='replace' +else if (mode_(1:2) == 'a ') then + action_='write' + position_='append' + status_='old' +else if (mode_(1:2) == 'x ') then + action_='write' + position_='asis' + status_='new' +else if (mode_(1:2) == 'r+') then + action_='readwrite' + position_='asis' + status_='old' +else if (mode_(1:2) == 'w+') then + action_='readwrite' + position_='asis' + status_='replace' +else if (mode_(1:2) == 'a+') then + action_='readwrite' + position_='append' + status_='old' +else if (mode_(1:2) == 'x+') then + action_='readwrite' + position_='asis' + status_='new' else - call error_stop("Unsupported mode") + call error_stop("Unsupported mode: "//mode_(1:2)) end if + +if (mode_(3:3) == 't') then + access_='sequential' + form_='formatted' +else if (mode_(3:3) == 'b' .or. mode_(3:3) == 's') then + access_='stream' + form_='unformatted' +else + call error_stop("Unsupported mode: "//mode_(3:3)) +endif + +open(newunit=u, file=filename, & + action = action_, position = position_, status = status_, & + access = access_, form = form_, & + iostat = io) + +end function + +character(3) function parse_mode(mode) result(mode_) +character(*), intent(in) :: mode + +mode_ = 'r t' +mode_(1:1) = mode(1:1) + +if (len_trim(adjustl(mode)) > 1) then + if (mode(2:2) == '+' )then + mode_(2:2) = '+' + else + mode_(3:3) = mode(2:2) + endif +end if + +if (len_trim(adjustl(mode)) > 2) then + mode_(3:3) = mode(3:3) +end if + end function end module diff --git a/src/tests/io/Makefile.manual b/src/tests/io/Makefile.manual index 716f41678..b3df0f5d8 100644 --- a/src/tests/io/Makefile.manual +++ b/src/tests/io/Makefile.manual @@ -5,7 +5,7 @@ OBJS = ../../stdlib_experimental_error.o \ .PHONY: all clean .SUFFIXES: .f90 .o -all: test_loadtxt test_savetxt +all: test_loadtxt test_savetxt test_open test_loadtxt: test_loadtxt.f90 $(OBJS) $(FC) $(FCFLAGS) $(CPPFLAGS) $< -o $@ $(OBJS) @@ -13,8 +13,11 @@ test_loadtxt: test_loadtxt.f90 $(OBJS) test_savetxt: test_savetxt.f90 $(OBJS) $(FC) $(FCFLAGS) $(CPPFLAGS) $< -o $@ $(OBJS) +test_open: test_open.f90 $(OBJS) + $(FC) $(FCFLAGS) $(CPPFLAGS) $< -o $@ $(OBJS) + %.o: %.mod clean: - $(RM) test_loadtxt test_savetxt + $(RM) test_loadtxt test_savetxt test_open $(RM) *.o *.mod diff --git a/src/tests/io/test_open.f90 b/src/tests/io/test_open.f90 index eb66af519..2169d0861 100644 --- a/src/tests/io/test_open.f90 +++ b/src/tests/io/test_open.f90 @@ -6,6 +6,7 @@ program test_open character(:), allocatable :: filename integer :: u, a(3) +! Text file filename = get_outpath() // "/io_open.dat" ! Test mode "w" @@ -31,6 +32,32 @@ program test_open close(u) + +! Stream file +filename = get_outpath() // "/io_open.stream" + +! Test mode "w" +u = open(filename, "wb") +write(u) 1, 2, 3 +close(u) + +! Test mode "r" +u = open(filename, "rb") +read(u) a +call assert(all(a == [1, 2, 3])) +close(u) + +! Test mode "a" +u = open(filename, "ab") +write(u) 4, 5, 6 +close(u) +u = open(filename, "rb") +read(u) a +call assert(all(a == [1, 2, 3])) +read(u) a +call assert(all(a == [4, 5, 6])) +close(u) + contains function get_outpath() result(outpath)