Merge branch 'master' into dev-optval

Author: certik

.github/workflows/CI.yml

@@ -7,6 +7,7 @@ env:
   CMAKE_BUILD_PARALLEL_LEVEL: "2" # 2 cores on each GHA VM, enable parallel builds
   CTEST_OUTPUT_ON_FAILURE: "ON" # This way we don't need a flag to ctest
   CTEST_PARALLEL_LEVEL: "2"
+  CTEST_TIME_TIMEOUT: "5"  # some failures hang forever
   HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker
   HOMEBREW_NO_AUTO_UPDATE: "ON"
   HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON"
@@ -55,10 +56,15 @@ jobs:
       run: cmake -Wdev -DCMAKE_BUILD_TYPE=Release -S . -B build
 
     - name: Build and compile
-      run: cmake --build build || cmake --build build --verbose --parallel 1
+      run: cmake --build build
+
+    - name: catch build fail
+      run: cmake --build build --verbose --parallel 1
+      if: failure()
 
     - name: test
-      run: cmake --build build --target test
+      run: ctest --parallel --output-on-failure
+      working-directory: build
 
     - name: Test in-tree builds
       if: contains( matrix.gcc_v, '9') # Only test one compiler on each platform

.github/workflows/ci_windows.yml

@@ -4,6 +4,7 @@ on: [push, pull_request]
 
 env:
   CI: "ON"
+  CTEST_TIME_TIMEOUT: "5"  # some failures hang forever
 
 jobs:
   Build:
@@ -24,7 +25,8 @@ jobs:
     - name: CMake build
       run: cmake --build build --parallel
 
-    - run: cmake --build build --verbose --parallel 1
+    - name: catch build fail
+      run: cmake --build build --verbose --parallel 1
       if: failure()
 
     - name: CTest

CMakeLists.txt

@@ -1,12 +1,25 @@
-cmake_minimum_required(VERSION 3.5.0)
+cmake_minimum_required(VERSION 3.14.0)
 project(stdlib Fortran)
 enable_testing()
 
 # this avoids stdlib and projects using stdlib from having to introspect stdlib's directory structure
+# FIXME: this eventually needs to be handled more precisely, as this spills all .mod/.smod into one directory
+#  and thereby can clash if module/submodule names are the same in different parts of library
 set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR})
 
-# compiler feature checks
+# --- compiler options
+if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU)
+  add_compile_options(-fimplicit-none)
+elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel)
+  add_compile_options(-warn declarations)
+elseif(CMAKE_Fortran_COMPILER_ID STREQUAL PGI)
+  add_compile_options(-Mdclchk)
+endif()
+
+# --- compiler feature checks
 include(CheckFortranSourceCompiles)
+include(CheckFortranSourceRuns)
 check_fortran_source_compiles("error stop i; end" f18errorstop SRC_EXT f90)
+check_fortran_source_runs("use, intrinsic :: iso_fortran_env, only : real128; real(real128) :: x; x = x+1; end" f03real128)
 
 add_subdirectory(src)

src/CMakeLists.txt

@@ -3,6 +3,7 @@ set(SRC
     stdlib_experimental_io.f90
     stdlib_experimental_error.f90
     stdlib_experimental_optval.f90
+    stdlib_experimental_kinds.f90
 )
 
 add_library(fortran_stdlib ${SRC})

src/Makefile.manual

@@ -2,6 +2,7 @@ SRC = stdlib_experimental_ascii.f90 \
       stdlib_experimental_error.f90 \
       stdlib_experimental_io.f90 \
       stdlib_experimental_optval.f90 \
+      stdlib_experimental_kinds.f90 \
       f18estop.f90
 
 LIB = libstdlib.a
@@ -28,3 +29,8 @@ clean:
 
 # Fortran module dependencies
 f18estop.o: stdlib_experimental_error.o
+stdlib_experimental_io.o: \
+	stdlib_experimental_error.o \
+	stdlib_experimental_optval.o \
+	stdlib_experimental_kinds.o
+stdlib_experimental_optval.o: stdlib_experimental_kinds.o

src/f08estop.f90

@@ -1,5 +1,7 @@
 submodule (stdlib_experimental_error) estop
 
+implicit none
+
 contains
 
 module procedure error_stop

src/f18estop.f90

@@ -1,5 +1,7 @@
 submodule (stdlib_experimental_error) estop
 
+implicit none
+
 contains
 
 module procedure error_stop

src/stdlib_experimental_io.f90

@@ -1,8 +1,16 @@
 module stdlib_experimental_io
-use iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128
+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 :: loadtxt, savetxt
+! Public API
+public :: loadtxt, savetxt, open
+
+! Private API that is exposed so that we can test it in tests
+public :: parse_mode
+
 
 interface loadtxt
     module procedure sloadtxt
@@ -46,7 +54,7 @@ subroutine sloadtxt(filename, d)
 integer :: s
 integer :: nrow,ncol,i
 
-open(newunit=s, file=filename, status="old", action="read")
+s = open(filename)
 
 ! determine number of columns
 ncol = number_of_columns(s)
@@ -89,7 +97,7 @@ subroutine dloadtxt(filename, d)
 integer :: s
 integer :: nrow,ncol,i
 
-open(newunit=s, file=filename, status="old", action="read")
+s = open(filename)
 
 ! determine number of columns
 ncol = number_of_columns(s)
@@ -132,7 +140,7 @@ subroutine qloadtxt(filename, d)
 integer :: s
 integer :: nrow,ncol,i
 
-open(newunit=s, file=filename, status="old", action="read")
+s = open(filename)
 
 ! determine number of columns
 ncol = number_of_columns(s)
@@ -164,7 +172,7 @@ subroutine ssavetxt(filename, d)
 ! call savetxt("log.txt", data)
 
 integer :: s, i
-open(newunit=s, file=filename, status="replace", action="write")
+s = open(filename, "w")
 do i = 1, size(d, 1)
     write(s, *) d(i, :)
 end do
@@ -187,7 +195,7 @@ subroutine dsavetxt(filename, d)
 ! call savetxt("log.txt", data)
 
 integer :: s, i
-open(newunit=s, file=filename, status="replace", action="write")
+s = open(filename, "w")
 do i = 1, size(d, 1)
     write(s, *) d(i, :)
 end do
@@ -210,9 +218,12 @@ subroutine qsavetxt(filename, d)
 ! call savetxt("log.txt", data)
 
 integer :: s, i
-open(newunit=s, file=filename, status="replace", action="write")
+character(len=14) :: format_string
+
+write(format_string, '(a1,i06,a7)') '(', size(d, 2), 'f40.34)'
+s = open(filename, "w")
 do i = 1, size(d, 1)
-    write(s, *) d(i, :)
+    write(s, format_string) d(i, :)
 end do
 close(s)
 end subroutine
@@ -224,16 +235,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)
 
@@ -258,14 +269,128 @@ integer function number_of_rows_numeric(s)
 
 end function
 
-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.
+integer function open(filename, mode, iostat) result(u)
+! Open a file
+!
+! To open a file to read:
+!
+! u = open("somefile.txt")        # The default `mode` is "rt"
+! u = open("somefile.txt", "r")
+!
+! To open a file to write:
+!
+! u = open("somefile.txt", "w")
+
+! To append to the end of the file if it exists:
+!
+! u = open("somefile.txt", "a")
+
+character(*), intent(in) :: filename
+character(*), intent(in), optional :: mode
+integer, intent(out), optional :: iostat
+
+integer :: io_
+character(3) :: mode_
+character(:),allocatable :: action_, position_, status_, access_, form_
+
+
+mode_ = parse_mode(optval(mode, ""))
+
+select case (mode_(1:2))
+case('r')
+    action_='read'
+    position_='asis'
+    status_='old'
+case('w')
+    action_='write'
+    position_='asis'
+    status_='replace'
+case('a')
+    action_='write'
+    position_='append'
+    status_='old'
+case('x')
+    action_='write'
+    position_='asis'
+    status_='new'
+case('r+')
+    action_='readwrite'
+    position_='asis'
+    status_='old'
+case('w+')
+    action_='readwrite'
+    position_='asis'
+    status_='replace'
+case('a+')
+    action_='readwrite'
+    position_='append'
+    status_='old'
+case('x+')
+    action_='readwrite'
+    position_='asis'
+    status_='new'
+case default
+    call error_stop("Unsupported mode: "//mode_(1:2))
+end select
+
+select case (mode_(3:3))
+case('t')
+    form_='formatted'
+case('b')
+    form_='unformatted'
+case default
+    call error_stop("Unsupported mode: "//mode_(3:3))
+end select
+
+access_ = 'stream'
+
+if (present(iostat)) then
+    open(newunit=u, file=filename, &
+         action = action_, position = position_, status = status_, &
+         access = access_, form = form_, &
+         iostat = iostat)
 else
-    whitechar = .false.
+    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
+logical :: lfirst(3)
+
+mode_ = 'r t'
+
+if (len_trim(mode) == 0) return
+a=trim(adjustl(mode))
+
+lfirst = .true.
+do i=1,len(a)
+    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)
+        lfirst(1)=.false.
+    else if (lfirst(2) .and. a(i:i) == '+') then
+        mode_(2:2) = a(i:i)
+        lfirst(2)=.false.
+    else if (lfirst(3) .and. (a(i:i) == 't' .or. a(i:i) == 'b')) then
+        mode_(3:3) = a(i:i)
+        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))
+    endif
+end do
+
 end function
 
 end module

src/stdlib_experimental_kinds.f90

@@ -0,0 +1,10 @@
+module stdlib_experimental_kinds
+use iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128
+use iso_fortran_env, only: int8, int16, int32, int64
+! If we decide later to use iso_fortran_env instead of iso_fortran_env:
+!use iso_c_binding, only: sp=>c_float, dp=>c_double, qp=>c_float128
+!use iso_c_binding, only: int8=>c_int8_t, int16=>c_int16_t, int32=>c_int32_t, int64=>c_int64_t
+implicit none
+private
+public sp, dp, qp, int8, int16, int32, int64
+end module

src/stdlib_experimental_optval.f90

@@ -8,7 +8,7 @@ module stdlib_experimental_optval
   !!
   !! It is an error to call `optval` with a single actual argument.
   !!
-  use iso_fortran_env, only: sp => real32, dp => real64, qp => real128, int8, int16, int32, int64
+  use stdlib_experimental_kinds, only: sp, dp, qp, int8, int16, int32, int64
   implicit none
 
 

src/tests/CMakeLists.txt

@@ -1,13 +1,16 @@
+macro(ADDTEST name)
+    add_executable(test_${name} test_${name}.f90)
+    target_link_libraries(test_${name} fortran_stdlib)
+    add_test(NAME ${name}
+             COMMAND $<TARGET_FILE:test_${name}> ${CMAKE_CURRENT_BINARY_DIR}
+             WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
+endmacro(ADDTEST)
+
 add_subdirectory(ascii)
-add_subdirectory(loadtxt)
+add_subdirectory(io)
 add_subdirectory(optval)
 
-add_executable(test_skip test_skip.f90)
-target_link_libraries(test_skip fortran_stdlib)
-add_test(NAME AlwaysSkip COMMAND $<TARGET_FILE:test_skip>)
-set_tests_properties(AlwaysSkip PROPERTIES SKIP_RETURN_CODE 77)
-
-add_executable(test_fail test_fail.f90)
-target_link_libraries(test_fail fortran_stdlib)
-add_test(NAME AlwaysFail COMMAND $<TARGET_FILE:test_fail>)
-set_tests_properties(AlwaysFail PROPERTIES WILL_FAIL true)
+ADDTEST(always_skip)
+set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77)
+ADDTEST(always_fail)
+set_tests_properties(always_fail PROPERTIES WILL_FAIL true)