From 39bb56cb2a6738433343dc695353e3bd90a79b9b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 May 2020 19:08:26 +0200 Subject: [PATCH 1/9] test for standard conformance MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit also one quick fix: complex => cmplx note that the current code does not compile Intel compiler: /tmp/stdlib/build/src/stdlib_experimental_linalg_diag.f90(7): error #6645: The name of the module procedure conflicts with a name in the encompassing scoping unit. [DIAG_RSP] function diag_rsp(v) result(res) GNU compiler /tmp/stdlib/src/tests/optval/test_optval.f90:252:15: 252 | z = optval(x, [2.0_qp, -2.0_qp]) | 1 Error: ‘x’ at (1) is an array and OPTIONAL; IF IT IS MISSING, it cannot be the actual argument of an ELEMENTAL procedure unless there is a non-optional argument with the same rank (12.4.1.5) [-Werror=pedantic] --- CMakeLists.txt | 16 +++++++++++++++- src/tests/linalg/test_linalg.f90 | 20 ++++++++++---------- 2 files changed, 25 insertions(+), 11 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index c5a179a52..a2d17eb06 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,8 +7,22 @@ include(${CMAKE_SOURCE_DIR}/cmake/stdlib.cmake) # --- compiler options if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) add_compile_options(-fimplicit-none) + add_compile_options(-ffree-line-length-132) + add_compile_options(-Wall) + add_compile_options(-Wextra) + add_compile_options(-Wimplicit-procedure) + add_compile_options(-Wconversion-extra) + add_compile_options(-std=f2018) + add_compile_options(-pedantic-errors) + add_compile_options(-fallow-invalid-boz) # ToDo: hack for invalid code elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) - add_compile_options(-warn declarations) + add_compile_options(-warn declarations,general,usage,interfaces,unused) + add_compile_options(-standard-semantics) + if(CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 18.0) + add_compile_options(-stand f15) + else() + add_compile_options(-stand f18) + endif() elseif(CMAKE_Fortran_COMPILER_ID STREQUAL PGI) add_compile_options(-Mdclchk) endif() diff --git a/src/tests/linalg/test_linalg.f90 b/src/tests/linalg/test_linalg.f90 index fa0c79a6e..976b6bcfb 100644 --- a/src/tests/linalg/test_linalg.f90 +++ b/src/tests/linalg/test_linalg.f90 @@ -73,8 +73,8 @@ subroutine test_eye msg="sum(rye - diag([(1.0_sp,i=1,6)])) < sptol failed.",warn=warn) cye = eye(7) - call check(abs(trace(cye) - complex(7.0_sp,0.0_sp)) < sptol, & - msg="abs(trace(cye) - complex(7.0_sp,0.0_sp)) < sptol failed.",warn=warn) + call check(abs(trace(cye) - cmplx(7.0_sp,0.0_sp)) < sptol, & + msg="abs(trace(cye) - cmplx(7.0_sp,0.0_sp)) < sptol failed.",warn=warn) end subroutine subroutine test_diag_rsp @@ -153,7 +153,7 @@ subroutine test_diag_rqp subroutine test_diag_csp integer, parameter :: n = 3 complex(sp) :: v(n), a(n,n), b(n,n) - complex(sp), parameter :: i_ = complex(0,1) + complex(sp), parameter :: i_ = cmplx(0,1) integer :: i,j write(*,*) "test_diag_csp" a = diag([(i,i=1,n)]) + diag([(i_,i=1,n)]) @@ -170,7 +170,7 @@ subroutine test_diag_csp subroutine test_diag_cdp integer, parameter :: n = 3 complex(dp) :: v(n), a(n,n), b(n,n) - complex(dp), parameter :: i_ = complex(0,1) + complex(dp), parameter :: i_ = cmplx(0,1) integer :: i,j write(*,*) "test_diag_cdp" a = diag([i_],-2) + diag([i_],2) @@ -181,7 +181,7 @@ subroutine test_diag_cdp subroutine test_diag_cqp integer, parameter :: n = 3 complex(qp) :: v(n), a(n,n), b(n,n) - complex(qp), parameter :: i_ = complex(0,1) + complex(qp), parameter :: i_ = cmplx(0,1) integer :: i,j write(*,*) "test_diag_cqp" a = diag([i_,i_],-1) + diag([i_,i_],1) @@ -333,7 +333,7 @@ subroutine test_trace_csp integer, parameter :: n = 5 real(sp) :: re(n,n), im(n,n) complex(sp) :: a(n,n), b(n,n) - complex(sp), parameter :: i_ = complex(0,1) + complex(sp), parameter :: i_ = cmplx(0,1) write(*,*) "test_trace_csp" call random_number(re) @@ -352,12 +352,12 @@ subroutine test_trace_csp subroutine test_trace_cdp integer, parameter :: n = 3 complex(dp) :: a(n,n), ans - complex(dp), parameter :: i_ = complex(0,1) + complex(dp), parameter :: i_ = cmplx(0,1) integer :: j write(*,*) "test_trace_cdp" a = reshape([(j + (n**2 - (j-1))*i_,j=1,n**2)],[n,n]) - ans = complex(15,15) !(1 + 5 + 9) + (9 + 5 + 1)i + ans = cmplx(15,15) !(1 + 5 + 9) + (9 + 5 + 1)i call check(abs(trace(a) - ans) < dptol, & msg="abs(trace(a) - ans) < dptol failed.",warn=warn) @@ -366,7 +366,7 @@ subroutine test_trace_cdp subroutine test_trace_cqp integer, parameter :: n = 3 complex(qp) :: a(n,n) - complex(qp), parameter :: i_ = complex(0,1) + complex(qp), parameter :: i_ = cmplx(0,1) write(*,*) "test_trace_cqp" a = 3*eye(n) + 4*eye(n)*i_ ! pythagorean triple call check(abs(trace(a)) - 3*5.0_qp < qptol, & @@ -442,4 +442,4 @@ pure recursive function catalan_number(n) result(value) end if end function -end program \ No newline at end of file +end program From d2dc3ec074ca137e4b46c9119b27415290508050 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 May 2020 19:16:51 +0200 Subject: [PATCH 2/9] option was only introduced in gfortran 10.0 --- CMakeLists.txt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index a2d17eb06..dca172493 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -14,7 +14,9 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) add_compile_options(-Wconversion-extra) add_compile_options(-std=f2018) add_compile_options(-pedantic-errors) - add_compile_options(-fallow-invalid-boz) # ToDo: hack for invalid code + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10.0) + add_compile_options(-fallow-invalid-boz) # ToDo: hack for invalid code + endif() elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) add_compile_options(-warn declarations,general,usage,interfaces,unused) add_compile_options(-standard-semantics) From 285e3a1e34d1aa522a213f6b26c06c3f034b6d69 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 May 2020 19:24:11 +0200 Subject: [PATCH 3/9] support for older gfortran --- CMakeLists.txt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index dca172493..7e77972bf 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -12,8 +12,12 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) add_compile_options(-Wextra) add_compile_options(-Wimplicit-procedure) add_compile_options(-Wconversion-extra) - add_compile_options(-std=f2018) add_compile_options(-pedantic-errors) + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 8.0) + add_compile_options(-std=f2008ts) + else() + add_compile_options(-std=f2018) + endif() if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10.0) add_compile_options(-fallow-invalid-boz) # ToDo: hack for invalid code endif() From a206e25ee1b28f2ec7783d4b88c7e3442f617123 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 31 May 2020 23:11:07 +0200 Subject: [PATCH 4/9] language --- cmake/stdlib.cmake | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cmake/stdlib.cmake b/cmake/stdlib.cmake index e55ee8f14..9a1fec059 100644 --- a/cmake/stdlib.cmake +++ b/cmake/stdlib.cmake @@ -28,8 +28,8 @@ endfunction() # Preprocesses fortran files with fypp. # # It assumes that source files have the ".fypp" extension. Target files will be -# created the extension ".f90". The FYPP variable must contain the path to the -# fypp-preprocessor. +# created with the extension ".f90". The FYPP variable must contain the path to +# the fypp-preprocessor. # # Args: # fyppopts [in]: Options to pass to fypp. From 022fcf7735343e9c2ae802aa9855fb988f3f5a88 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 31 May 2020 23:11:52 +0200 Subject: [PATCH 5/9] allow non-standard conforming code only selectively where needed --- src/CMakeLists.txt | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 51fd01d62..0771422d4 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -31,7 +31,7 @@ set(SRC stdlib_experimental_ascii.f90 stdlib_experimental_error.f90 stdlib_experimental_kinds.f90 - stdlib_experimental_system.F90 + stdlib_experimental_system.F90 # Captital extension for a reason? ${outFiles} ) @@ -53,6 +53,13 @@ endif() add_subdirectory(tests) +# relax standard checks +if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10.0) + set_source_files_properties("stdlib_experimental_ascii.f90" PROPERTIES COMPILE_FLAGS "-fallow-invalid-boz") + endif() +endif() + install(TARGETS fortran_stdlib RUNTIME DESTINATION bin ARCHIVE DESTINATION lib From 999be0bca7e14bc6cd7d638f0f5ac9fe2e610e56 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 31 May 2020 23:19:05 +0200 Subject: [PATCH 6/9] prevent erroneous rejection of valid code --- src/tests/optval/CMakeLists.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/tests/optval/CMakeLists.txt b/src/tests/optval/CMakeLists.txt index 19193fe1e..bb8291c74 100644 --- a/src/tests/optval/CMakeLists.txt +++ b/src/tests/optval/CMakeLists.txt @@ -1 +1,5 @@ ADDTEST(optval) +# prevent false positive (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95446) +if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) + set_source_files_properties("test_optval.f90" PROPERTIES COMPILE_FLAGS "-Wno-error=pedantic") +endif() From 4378a6794da8dd0c3b35dbcf08ccb4a8bf5d72ff Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 31 May 2020 23:20:02 +0200 Subject: [PATCH 7/9] order was mixed up, no global relaxation of standards --- CMakeLists.txt | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 7e77972bf..4cb859201 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -14,12 +14,9 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) add_compile_options(-Wconversion-extra) add_compile_options(-pedantic-errors) if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 8.0) - add_compile_options(-std=f2008ts) - else() add_compile_options(-std=f2018) - endif() - if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10.0) - add_compile_options(-fallow-invalid-boz) # ToDo: hack for invalid code + else() + add_compile_options(-std=f2008ts) endif() elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) add_compile_options(-warn declarations,general,usage,interfaces,unused) From f5638938b1f807044147dbfd8e6a1bbe880070d8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 1 Jun 2020 09:41:45 +0200 Subject: [PATCH 8/9] polishing thanks for the feedback --- CMakeLists.txt | 2 ++ src/CMakeLists.txt | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4cb859201..6143b5ab5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -12,6 +12,8 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) add_compile_options(-Wextra) add_compile_options(-Wimplicit-procedure) add_compile_options(-Wconversion-extra) + # -pedantic-errors triggers a false positive for optional arguments of elemental functions, + # see test_optval and https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95446 add_compile_options(-pedantic-errors) if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 8.0) add_compile_options(-std=f2018) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 0771422d4..5ddedc932 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -31,7 +31,7 @@ set(SRC stdlib_experimental_ascii.f90 stdlib_experimental_error.f90 stdlib_experimental_kinds.f90 - stdlib_experimental_system.F90 # Captital extension for a reason? + stdlib_experimental_system.F90 ${outFiles} ) From 0abec4bf7d408189b574fc990bdd9d782bb64ce8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 1 Jun 2020 10:01:45 +0200 Subject: [PATCH 9/9] following standard, no exception for gfortran 10 needed --- src/CMakeLists.txt | 7 --- src/stdlib_experimental_ascii.f90 | 82 +++++++++++++++---------------- 2 files changed, 41 insertions(+), 48 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 5ddedc932..51fd01d62 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -53,13 +53,6 @@ endif() add_subdirectory(tests) -# relax standard checks -if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) - if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10.0) - set_source_files_properties("stdlib_experimental_ascii.f90" PROPERTIES COMPILE_FLAGS "-fallow-invalid-boz") - endif() -endif() - install(TARGETS fortran_stdlib RUNTIME DESTINATION bin ARCHIVE DESTINATION lib diff --git a/src/stdlib_experimental_ascii.f90 b/src/stdlib_experimental_ascii.f90 index fd7910790..8fb4d481f 100644 --- a/src/stdlib_experimental_ascii.f90 +++ b/src/stdlib_experimental_ascii.f90 @@ -15,39 +15,39 @@ module stdlib_experimental_ascii public :: to_lower, to_upper ! All control characters in the ASCII table (see www.asciitable.com). - character(len=1), public, parameter :: NUL = achar(z'00') !! Null - character(len=1), public, parameter :: SOH = achar(z'01') !! Start of heading - character(len=1), public, parameter :: STX = achar(z'02') !! Start of text - character(len=1), public, parameter :: ETX = achar(z'03') !! End of text - character(len=1), public, parameter :: EOT = achar(z'04') !! End of transmission - character(len=1), public, parameter :: ENQ = achar(z'05') !! Enquiry - character(len=1), public, parameter :: ACK = achar(z'06') !! Acknowledge - character(len=1), public, parameter :: BEL = achar(z'07') !! Bell - character(len=1), public, parameter :: BS = achar(z'08') !! Backspace - character(len=1), public, parameter :: TAB = achar(z'09') !! Horizontal tab - character(len=1), public, parameter :: LF = achar(z'0A') !! NL line feed, new line - character(len=1), public, parameter :: VT = achar(z'0B') !! Vertical tab - character(len=1), public, parameter :: FF = achar(z'0C') !! NP form feed, new page - character(len=1), public, parameter :: CR = achar(z'0D') !! Carriage return - character(len=1), public, parameter :: SO = achar(z'0E') !! Shift out - character(len=1), public, parameter :: SI = achar(z'0F') !! Shift in - character(len=1), public, parameter :: DLE = achar(z'10') !! Data link escape - character(len=1), public, parameter :: DC1 = achar(z'11') !! Device control 1 - character(len=1), public, parameter :: DC2 = achar(z'12') !! Device control 2 - character(len=1), public, parameter :: DC3 = achar(z'13') !! Device control 3 - character(len=1), public, parameter :: DC4 = achar(z'14') !! Device control 4 - character(len=1), public, parameter :: NAK = achar(z'15') !! Negative acknowledge - character(len=1), public, parameter :: SYN = achar(z'16') !! Synchronous idle - character(len=1), public, parameter :: ETB = achar(z'17') !! End of transmission block - character(len=1), public, parameter :: CAN = achar(z'18') !! Cancel - character(len=1), public, parameter :: EM = achar(z'19') !! End of medium - character(len=1), public, parameter :: SUB = achar(z'1A') !! Substitute - character(len=1), public, parameter :: ESC = achar(z'1B') !! Escape - character(len=1), public, parameter :: FS = achar(z'1C') !! File separator - character(len=1), public, parameter :: GS = achar(z'1D') !! Group separator - character(len=1), public, parameter :: RS = achar(z'1E') !! Record separator - character(len=1), public, parameter :: US = achar(z'1F') !! Unit separator - character(len=1), public, parameter :: DEL = achar(z'7F') !! Delete + character(len=1), public, parameter :: NUL = achar(int(z'00')) !! Null + character(len=1), public, parameter :: SOH = achar(int(z'01')) !! Start of heading + character(len=1), public, parameter :: STX = achar(int(z'02')) !! Start of text + character(len=1), public, parameter :: ETX = achar(int(z'03')) !! End of text + character(len=1), public, parameter :: EOT = achar(int(z'04')) !! End of transmission + character(len=1), public, parameter :: ENQ = achar(int(z'05')) !! Enquiry + character(len=1), public, parameter :: ACK = achar(int(z'06')) !! Acknowledge + character(len=1), public, parameter :: BEL = achar(int(z'07')) !! Bell + character(len=1), public, parameter :: BS = achar(int(z'08')) !! Backspace + character(len=1), public, parameter :: TAB = achar(int(z'09')) !! Horizontal tab + character(len=1), public, parameter :: LF = achar(int(z'0A')) !! NL line feed, new line + character(len=1), public, parameter :: VT = achar(int(z'0B')) !! Vertical tab + character(len=1), public, parameter :: FF = achar(int(z'0C')) !! NP form feed, new page + character(len=1), public, parameter :: CR = achar(int(z'0D')) !! Carriage return + character(len=1), public, parameter :: SO = achar(int(z'0E')) !! Shift out + character(len=1), public, parameter :: SI = achar(int(z'0F')) !! Shift in + character(len=1), public, parameter :: DLE = achar(int(z'10')) !! Data link escape + character(len=1), public, parameter :: DC1 = achar(int(z'11')) !! Device control 1 + character(len=1), public, parameter :: DC2 = achar(int(z'12')) !! Device control 2 + character(len=1), public, parameter :: DC3 = achar(int(z'13')) !! Device control 3 + character(len=1), public, parameter :: DC4 = achar(int(z'14')) !! Device control 4 + character(len=1), public, parameter :: NAK = achar(int(z'15')) !! Negative acknowledge + character(len=1), public, parameter :: SYN = achar(int(z'16')) !! Synchronous idle + character(len=1), public, parameter :: ETB = achar(int(z'17')) !! End of transmission block + character(len=1), public, parameter :: CAN = achar(int(z'18')) !! Cancel + character(len=1), public, parameter :: EM = achar(int(z'19')) !! End of medium + character(len=1), public, parameter :: SUB = achar(int(z'1A')) !! Substitute + character(len=1), public, parameter :: ESC = achar(int(z'1B')) !! Escape + character(len=1), public, parameter :: FS = achar(int(z'1C')) !! File separator + character(len=1), public, parameter :: GS = achar(int(z'1D')) !! Group separator + character(len=1), public, parameter :: RS = achar(int(z'1E')) !! Record separator + character(len=1), public, parameter :: US = achar(int(z'1F')) !! Unit separator + character(len=1), public, parameter :: DEL = achar(int(z'7F')) !! Delete ! Constant character sequences character(len=*), public, parameter :: fullhex_digits = "0123456789ABCDEFabcdef" !! 0 .. 9A .. Fa .. f @@ -79,7 +79,7 @@ pure logical function is_alphanum(c) ! i.e. in the range 0 .. 0x7F. pure logical function is_ascii(c) character(len=1), intent(in) :: c !! The character to test. - is_ascii = iachar(c) <= z'7F' + is_ascii = iachar(c) <= int(z'7F') end function !> Checks whether `c` is a control character. @@ -87,7 +87,7 @@ pure logical function is_control(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) - is_control = ic < z'20' .or. ic == z'7F' + is_control = ic < int(z'20') .or. ic == int(z'7F') end function !> Checks whether `c` is a digit (0 .. 9). @@ -116,7 +116,7 @@ pure logical function is_punctuation(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! '~' '!' - is_punctuation = (ic <= z'7E') .and. (ic >= z'21') .and. & + is_punctuation = (ic <= int(z'7E')) .and. (ic >= int(z'21')) .and. & (.not. is_alphanum(c)) end function @@ -126,7 +126,7 @@ pure logical function is_graphical(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! '!' '~' - is_graphical = (z'21' <= ic) .and. (ic <= z'7E') + is_graphical = (int(z'21') <= ic) .and. (ic <= int(z'7E')) end function !> Checks whether or not `c` is a printable character - including the @@ -135,7 +135,7 @@ pure logical function is_printable(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! '~' - is_printable = c >= ' ' .and. ic <= z'7E' + is_printable = c >= ' ' .and. ic <= int(z'7E') end function !> Checks whether `c` is a lowercase ASCII letter (a .. z). @@ -157,7 +157,7 @@ pure logical function is_white(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! TAB, LF, VT, FF, CR - is_white = (c == ' ') .or. (ic >= z'09' .and. ic <= z'0D'); + is_white = (c == ' ') .or. (ic >= int(z'09') .and. ic <= int(z'0D')); end function !> Checks whether or not `c` is a blank character. That includes the @@ -166,7 +166,7 @@ pure logical function is_blank(c) character(len=1), intent(in) :: c !! The character to test. integer :: ic ic = iachar(c) ! TAB - is_blank = (c == ' ') .or. (ic == z'09'); + is_blank = (c == ' ') .or. (ic == int(z'09')); end function !> Returns the corresponding lowercase letter, if `c` is an uppercase @@ -193,4 +193,4 @@ pure function to_upper(c) result(t) if (is_lower(t)) t = achar(iachar(t) + diff) end function -end module \ No newline at end of file +end module