Skip to content

Commit 7961658

Browse files
nshaffernshaffer
committed
Merge branch 'master' of https://github.com/fortran-lang/stdlib 
2 parents f83a935 + a1b9a91 commit 7961658

File tree

14 files changed

+116
-94
lines changed

14 files changed

+116
-94
lines changed

‎CMakeLists.txt‎

Lines changed: 20 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,27 @@ include(${CMAKE_SOURCE_DIR}/cmake/stdlib.cmake)
77
# --- compiler options
88
if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU)
99
add_compile_options(-fimplicit-none)
10+
add_compile_options(-ffree-line-length-132)
11+
add_compile_options(-Wall)
12+
add_compile_options(-Wextra)
13+
add_compile_options(-Wimplicit-procedure)
14+
add_compile_options(-Wconversion-extra)
15+
# -pedantic-errors triggers a false positive for optional arguments of elemental functions,
16+
# see test_optval and https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95446
17+
add_compile_options(-pedantic-errors)
18+
if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 8.0)
19+
add_compile_options(-std=f2018)
20+
else()
21+
add_compile_options(-std=f2008ts)
22+
endif()
1023
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel)
11-
add_compile_options(-warn declarations)
24+
add_compile_options(-warn declarations,general,usage,interfaces,unused)
25+
add_compile_options(-standard-semantics)
26+
if(CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 18.0)
27+
add_compile_options(-stand f15)
28+
else()
29+
add_compile_options(-stand f18)
30+
endif()
1231
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL PGI)
1332
add_compile_options(-Mdclchk)
1433
endif()

‎WORKFLOW.md‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,9 @@ experienced contributors will help it through all 5 steps.
4040
people involved in prior steps of the workflow. Other contributors (not
4141
explicitly invited) are encouraged to provide reviews and suggestions as
4242
well. Iterate until all (or most) participants are on the same page.
43-
We can merge when there is vast majority approval of the PR.
43+
A merge is permitted if there are unit tests for a majority of the possible
44+
calling scenarios (with or without optional arguments, with arguments that
45+
trigger an error) and if there is vast majority approval of the PR.
4446

4547
5. **Release**: Moving from experimental to release. The experimental
4648
"namespace" contains new functionality together with its specification. In

‎cmake/stdlib.cmake‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,8 +28,8 @@ endfunction()
2828
# Preprocesses fortran files with fypp.
2929
#
3030
# It assumes that source files have the ".fypp" extension. Target files will be
31-
# created the extension ".f90". The FYPP variable must contain the path to the
32-
# fypp-preprocessor.
31+
# created with the extension ".f90". The FYPP variable must contain the path to
32+
# the fypp-preprocessor.
3333
#
3434
# Args:
3535
# fyppopts [in]: Options to pass to fypp.

‎src/stdlib_experimental_ascii.f90‎

Lines changed: 41 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -15,39 +15,39 @@ module stdlib_experimental_ascii
1515
public :: to_lower, to_upper
1616

1717
! All control characters in the ASCII table (see www.asciitable.com).
18-
character(len=1), public, parameter :: NUL = achar(z'00') !! Null
19-
character(len=1), public, parameter :: SOH = achar(z'01') !! Start of heading
20-
character(len=1), public, parameter :: STX = achar(z'02') !! Start of text
21-
character(len=1), public, parameter :: ETX = achar(z'03') !! End of text
22-
character(len=1), public, parameter :: EOT = achar(z'04') !! End of transmission
23-
character(len=1), public, parameter :: ENQ = achar(z'05') !! Enquiry
24-
character(len=1), public, parameter :: ACK = achar(z'06') !! Acknowledge
25-
character(len=1), public, parameter :: BEL = achar(z'07') !! Bell
26-
character(len=1), public, parameter :: BS = achar(z'08') !! Backspace
27-
character(len=1), public, parameter :: TAB = achar(z'09') !! Horizontal tab
28-
character(len=1), public, parameter :: LF = achar(z'0A') !! NL line feed, new line
29-
character(len=1), public, parameter :: VT = achar(z'0B') !! Vertical tab
30-
character(len=1), public, parameter :: FF = achar(z'0C') !! NP form feed, new page
31-
character(len=1), public, parameter :: CR = achar(z'0D') !! Carriage return
32-
character(len=1), public, parameter :: SO = achar(z'0E') !! Shift out
33-
character(len=1), public, parameter :: SI = achar(z'0F') !! Shift in
34-
character(len=1), public, parameter :: DLE = achar(z'10') !! Data link escape
35-
character(len=1), public, parameter :: DC1 = achar(z'11') !! Device control 1
36-
character(len=1), public, parameter :: DC2 = achar(z'12') !! Device control 2
37-
character(len=1), public, parameter :: DC3 = achar(z'13') !! Device control 3
38-
character(len=1), public, parameter :: DC4 = achar(z'14') !! Device control 4
39-
character(len=1), public, parameter :: NAK = achar(z'15') !! Negative acknowledge
40-
character(len=1), public, parameter :: SYN = achar(z'16') !! Synchronous idle
41-
character(len=1), public, parameter :: ETB = achar(z'17') !! End of transmission block
42-
character(len=1), public, parameter :: CAN = achar(z'18') !! Cancel
43-
character(len=1), public, parameter :: EM = achar(z'19') !! End of medium
44-
character(len=1), public, parameter :: SUB = achar(z'1A') !! Substitute
45-
character(len=1), public, parameter :: ESC = achar(z'1B') !! Escape
46-
character(len=1), public, parameter :: FS = achar(z'1C') !! File separator
47-
character(len=1), public, parameter :: GS = achar(z'1D') !! Group separator
48-
character(len=1), public, parameter :: RS = achar(z'1E') !! Record separator
49-
character(len=1), public, parameter :: US = achar(z'1F') !! Unit separator
50-
character(len=1), public, parameter :: DEL = achar(z'7F') !! Delete
18+
character(len=1), public, parameter :: NUL = achar(int(z'00')) !! Null
19+
character(len=1), public, parameter :: SOH = achar(int(z'01')) !! Start of heading
20+
character(len=1), public, parameter :: STX = achar(int(z'02')) !! Start of text
21+
character(len=1), public, parameter :: ETX = achar(int(z'03')) !! End of text
22+
character(len=1), public, parameter :: EOT = achar(int(z'04')) !! End of transmission
23+
character(len=1), public, parameter :: ENQ = achar(int(z'05')) !! Enquiry
24+
character(len=1), public, parameter :: ACK = achar(int(z'06')) !! Acknowledge
25+
character(len=1), public, parameter :: BEL = achar(int(z'07')) !! Bell
26+
character(len=1), public, parameter :: BS = achar(int(z'08')) !! Backspace
27+
character(len=1), public, parameter :: TAB = achar(int(z'09')) !! Horizontal tab
28+
character(len=1), public, parameter :: LF = achar(int(z'0A')) !! NL line feed, new line
29+
character(len=1), public, parameter :: VT = achar(int(z'0B')) !! Vertical tab
30+
character(len=1), public, parameter :: FF = achar(int(z'0C')) !! NP form feed, new page
31+
character(len=1), public, parameter :: CR = achar(int(z'0D')) !! Carriage return
32+
character(len=1), public, parameter :: SO = achar(int(z'0E')) !! Shift out
33+
character(len=1), public, parameter :: SI = achar(int(z'0F')) !! Shift in
34+
character(len=1), public, parameter :: DLE = achar(int(z'10')) !! Data link escape
35+
character(len=1), public, parameter :: DC1 = achar(int(z'11')) !! Device control 1
36+
character(len=1), public, parameter :: DC2 = achar(int(z'12')) !! Device control 2
37+
character(len=1), public, parameter :: DC3 = achar(int(z'13')) !! Device control 3
38+
character(len=1), public, parameter :: DC4 = achar(int(z'14')) !! Device control 4
39+
character(len=1), public, parameter :: NAK = achar(int(z'15')) !! Negative acknowledge
40+
character(len=1), public, parameter :: SYN = achar(int(z'16')) !! Synchronous idle
41+
character(len=1), public, parameter :: ETB = achar(int(z'17')) !! End of transmission block
42+
character(len=1), public, parameter :: CAN = achar(int(z'18')) !! Cancel
43+
character(len=1), public, parameter :: EM = achar(int(z'19')) !! End of medium
44+
character(len=1), public, parameter :: SUB = achar(int(z'1A')) !! Substitute
45+
character(len=1), public, parameter :: ESC = achar(int(z'1B')) !! Escape
46+
character(len=1), public, parameter :: FS = achar(int(z'1C')) !! File separator
47+
character(len=1), public, parameter :: GS = achar(int(z'1D')) !! Group separator
48+
character(len=1), public, parameter :: RS = achar(int(z'1E')) !! Record separator
49+
character(len=1), public, parameter :: US = achar(int(z'1F')) !! Unit separator
50+
character(len=1), public, parameter :: DEL = achar(int(z'7F')) !! Delete
5151

5252
! Constant character sequences
5353
character(len=*), public, parameter :: fullhex_digits = "0123456789ABCDEFabcdef" !! 0 .. 9A .. Fa .. f
@@ -79,15 +79,15 @@ pure logical function is_alphanum(c)
7979
! i.e. in the range 0 .. 0x7F.
8080
pure logical function is_ascii(c)
8181
character(len=1), intent(in) :: c !! The character to test.
82-
is_ascii = iachar(c) <= z'7F'
82+
is_ascii = iachar(c) <= int(z'7F')
8383
end function
8484

8585
!> Checks whether `c` is a control character.
8686
pure logical function is_control(c)
8787
character(len=1), intent(in) :: c !! The character to test.
8888
integer :: ic
8989
ic = iachar(c)
90-
is_control = ic < z'20' .or. ic == z'7F'
90+
is_control = ic < int(z'20') .or. ic == int(z'7F')
9191
end function
9292

9393
!> Checks whether `c` is a digit (0 .. 9).
@@ -116,7 +116,7 @@ pure logical function is_punctuation(c)
116116
character(len=1), intent(in) :: c !! The character to test.
117117
integer :: ic
118118
ic = iachar(c) ! '~' '!'
119-
is_punctuation = (ic <= z'7E') .and. (ic >= z'21') .and. &
119+
is_punctuation = (ic <= int(z'7E')) .and. (ic >= int(z'21')) .and. &
120120
(.not. is_alphanum(c))
121121
end function
122122

@@ -126,7 +126,7 @@ pure logical function is_graphical(c)
126126
character(len=1), intent(in) :: c !! The character to test.
127127
integer :: ic
128128
ic = iachar(c) ! '!' '~'
129-
is_graphical = (z'21' <= ic) .and. (ic <= z'7E')
129+
is_graphical = (int(z'21') <= ic) .and. (ic <= int(z'7E'))
130130
end function
131131

132132
!> Checks whether or not `c` is a printable character - including the
@@ -135,7 +135,7 @@ pure logical function is_printable(c)
135135
character(len=1), intent(in) :: c !! The character to test.
136136
integer :: ic
137137
ic = iachar(c) ! '~'
138-
is_printable = c >= ' ' .and. ic <= z'7E'
138+
is_printable = c >= ' ' .and. ic <= int(z'7E')
139139
end function
140140

141141
!> Checks whether `c` is a lowercase ASCII letter (a .. z).
@@ -157,7 +157,7 @@ pure logical function is_white(c)
157157
character(len=1), intent(in) :: c !! The character to test.
158158
integer :: ic
159159
ic = iachar(c) ! TAB, LF, VT, FF, CR
160-
is_white = (c == ' ') .or. (ic >= z'09' .and. ic <= z'0D');
160+
is_white = (c == ' ') .or. (ic >= int(z'09') .and. ic <= int(z'0D'));
161161
end function
162162

163163
!> Checks whether or not `c` is a blank character. That includes the
@@ -166,7 +166,7 @@ pure logical function is_blank(c)
166166
character(len=1), intent(in) :: c !! The character to test.
167167
integer :: ic
168168
ic = iachar(c) ! TAB
169-
is_blank = (c == ' ') .or. (ic == z'09');
169+
is_blank = (c == ' ') .or. (ic == int(z'09'));
170170
end function
171171

172172
!> Returns the corresponding lowercase letter, if `c` is an uppercase
@@ -193,4 +193,4 @@ pure function to_upper(c) result(t)
193193
if (is_lower(t)) t = achar(iachar(t) + diff)
194194
end function
195195

196-
end module
196+
end module

‎src/stdlib_experimental_stats_mean.fypp‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ contains
1919
${t1}$ :: res
2020

2121
if (.not.optval(mask, .true.)) then
22-
res = ieee_value(real(res, kind=${k1}$), ieee_quiet_nan)
22+
res = ieee_value(1._${k1}$, ieee_quiet_nan)
2323
return
2424
end if
2525

@@ -38,7 +38,7 @@ contains
3838
real(dp) :: res
3939

4040
if (.not.optval(mask, .true.)) then
41-
res = ieee_value(res, ieee_quiet_nan)
41+
res = ieee_value(1._dp, ieee_quiet_nan)
4242
return
4343
end if
4444

@@ -59,7 +59,7 @@ contains
5959
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
6060

6161
if (.not.optval(mask, .true.)) then
62-
res = ieee_value(real(res, kind=${k1}$), ieee_quiet_nan)
62+
res = ieee_value(1._${k1}$, ieee_quiet_nan)
6363
return
6464
end if
6565

@@ -84,7 +84,7 @@ contains
8484
real(dp) :: res${reduced_shape('x', rank, 'dim')}$
8585

8686
if (.not.optval(mask, .true.)) then
87-
res = ieee_value(res, ieee_quiet_nan)
87+
res = ieee_value(1._dp, ieee_quiet_nan)
8888
return
8989
end if
9090

‎src/tests/ascii/test_ascii.f90‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -486,7 +486,6 @@ subroutine test_to_upper_long()
486486
!
487487
subroutine test_ascii_table
488488
integer :: i, j
489-
character(len=1) :: c
490489
logical :: table(15,12)
491490

492491
abstract interface

‎src/tests/io/test_savetxt.f90‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -86,13 +86,13 @@ subroutine test_csp(outpath)
8686
character(*), intent(in) :: outpath
8787
complex(sp) :: d(3, 2), e(2, 3)
8888
complex(sp), allocatable :: d2(:, :)
89-
d = cmplx(1, 1)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
89+
d = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
9090
call savetxt(outpath, d)
9191
call loadtxt(outpath, d2)
9292
call check(all(shape(d2) == [3, 2]))
9393
call check(all(abs(d-d2) < epsilon(1._sp)))
9494

95-
e = cmplx(1, 1)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
95+
e = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
9696
call savetxt(outpath, e)
9797
call loadtxt(outpath, d2)
9898
call check(all(shape(d2) == [2, 3]))
@@ -103,13 +103,13 @@ subroutine test_cdp(outpath)
103103
character(*), intent(in) :: outpath
104104
complex(dp) :: d(3, 2), e(2, 3)
105105
complex(dp), allocatable :: d2(:, :)
106-
d = cmplx(1._dp, 1._dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
106+
d = cmplx(1._dp, 1._dp,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
107107
call savetxt(outpath, d)
108108
call loadtxt(outpath, d2)
109109
call check(all(shape(d2) == [3, 2]))
110110
call check(all(abs(d-d2) < epsilon(1._dp)))
111111

112-
e = cmplx(1, 1)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
112+
e = cmplx(1, 1,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
113113
call savetxt(outpath, e)
114114
call loadtxt(outpath, d2)
115115
call check(all(shape(d2) == [2, 3]))

‎src/tests/linalg/test_linalg.f90‎

Lines changed: 13 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -73,8 +73,8 @@ subroutine test_eye
7373
msg="sum(rye - diag([(1.0_sp,i=1,6)])) < sptol failed.",warn=warn)
7474

7575
cye = eye(7)
76-
call check(abs(trace(cye) - complex(7.0_sp,0.0_sp)) < sptol, &
77-
msg="abs(trace(cye) - complex(7.0_sp,0.0_sp)) < sptol failed.",warn=warn)
76+
call check(abs(trace(cye) - cmplx(7.0_sp,0.0_sp,kind=sp)) < sptol, &
77+
msg="abs(trace(cye) - cmplx(7.0_sp,0.0_sp,kind=sp)) < sptol failed.",warn=warn)
7878
end subroutine
7979

8080
subroutine test_diag_rsp
@@ -152,8 +152,8 @@ subroutine test_diag_rqp
152152

153153
subroutine test_diag_csp
154154
integer, parameter :: n = 3
155-
complex(sp) :: v(n), a(n,n), b(n,n)
156-
complex(sp), parameter :: i_ = complex(0,1)
155+
complex(sp) :: a(n,n), b(n,n)
156+
complex(sp), parameter :: i_ = cmplx(0,1,kind=sp)
157157
integer :: i,j
158158
write(*,*) "test_diag_csp"
159159
a = diag([(i,i=1,n)]) + diag([(i_,i=1,n)])
@@ -169,9 +169,8 @@ subroutine test_diag_csp
169169

170170
subroutine test_diag_cdp
171171
integer, parameter :: n = 3
172-
complex(dp) :: v(n), a(n,n), b(n,n)
173-
complex(dp), parameter :: i_ = complex(0,1)
174-
integer :: i,j
172+
complex(dp) :: a(n,n)
173+
complex(dp), parameter :: i_ = cmplx(0,1,kind=dp)
175174
write(*,*) "test_diag_cdp"
176175
a = diag([i_],-2) + diag([i_],2)
177176
call check(a(3,1) == i_ .and. a(1,3) == i_, &
@@ -180,9 +179,8 @@ subroutine test_diag_cdp
180179

181180
subroutine test_diag_cqp
182181
integer, parameter :: n = 3
183-
complex(qp) :: v(n), a(n,n), b(n,n)
184-
complex(qp), parameter :: i_ = complex(0,1)
185-
integer :: i,j
182+
complex(qp) :: a(n,n)
183+
complex(qp), parameter :: i_ = cmplx(0,1,kind=qp)
186184
write(*,*) "test_diag_cqp"
187185
a = diag([i_,i_],-1) + diag([i_,i_],1)
188186
call check(all(diag(a,-1) == i_) .and. all(diag(a,1) == i_), &
@@ -333,7 +331,7 @@ subroutine test_trace_csp
333331
integer, parameter :: n = 5
334332
real(sp) :: re(n,n), im(n,n)
335333
complex(sp) :: a(n,n), b(n,n)
336-
complex(sp), parameter :: i_ = complex(0,1)
334+
complex(sp), parameter :: i_ = cmplx(0,1,kind=sp)
337335
write(*,*) "test_trace_csp"
338336

339337
call random_number(re)
@@ -352,12 +350,12 @@ subroutine test_trace_csp
352350
subroutine test_trace_cdp
353351
integer, parameter :: n = 3
354352
complex(dp) :: a(n,n), ans
355-
complex(dp), parameter :: i_ = complex(0,1)
353+
complex(dp), parameter :: i_ = cmplx(0,1,kind=dp)
356354
integer :: j
357355
write(*,*) "test_trace_cdp"
358356

359357
a = reshape([(j + (n**2 - (j-1))*i_,j=1,n**2)],[n,n])
360-
ans = complex(15,15) !(1 + 5 + 9) + (9 + 5 + 1)i
358+
ans = cmplx(15,15,kind=dp) !(1 + 5 + 9) + (9 + 5 + 1)i
361359

362360
call check(abs(trace(a) - ans) < dptol, &
363361
msg="abs(trace(a) - ans) < dptol failed.",warn=warn)
@@ -366,7 +364,7 @@ subroutine test_trace_cdp
366364
subroutine test_trace_cqp
367365
integer, parameter :: n = 3
368366
complex(qp) :: a(n,n)
369-
complex(qp), parameter :: i_ = complex(0,1)
367+
complex(qp), parameter :: i_ = cmplx(0,1,kind=qp)
370368
write(*,*) "test_trace_cqp"
371369
a = 3*eye(n) + 4*eye(n)*i_ ! pythagorean triple
372370
call check(abs(trace(a)) - 3*5.0_qp < qptol, &
@@ -442,4 +440,4 @@ pure recursive function catalan_number(n) result(value)
442440
end if
443441
end function
444442

445-
end program
443+
end program

‎src/tests/optval/CMakeLists.txt‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1 +1,5 @@
11
ADDTEST(optval)
2+
# prevent false positive (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95446)
3+
if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU)
4+
set_source_files_properties("test_optval.f90" PROPERTIES COMPILE_FLAGS "-Wno-error=pedantic")
5+
endif()

‎src/tests/optval/test_optval.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,7 @@ function foo_csp(x) result(z)
100100
subroutine test_optval_cdp
101101
complex(dp) :: z1
102102
print *, "test_optval_cdp"
103-
z1 = cmplx(1.0_dp, 2.0_dp)
103+
z1 = cmplx(1.0_dp, 2.0_dp,kind=dp)
104104
call check(foo_cdp(z1) == z1)
105105
call check(foo_cdp() == z1)
106106
end subroutine test_optval_cdp

0 commit comments

Comments
 (0)