Skip to content

Commit 48b28e8

Browse files
certikcertik
authored
Merge pull request fortran-lang#205 from MarDiehl/standard-checks
test for standard conformance
2 parents f754a3d + 0abec4b commit 48b28e8

File tree

5 files changed

+77
-54
lines changed

5 files changed

+77
-54
lines changed

‎CMakeLists.txt

+20-1
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()

‎cmake/stdlib.cmake

+2-2
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

+41-41
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/tests/linalg/test_linalg.f90

+10-10
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)) < sptol, &
77+
msg="abs(trace(cye) - cmplx(7.0_sp,0.0_sp)) < sptol failed.",warn=warn)
7878
end subroutine
7979

8080
subroutine test_diag_rsp
@@ -153,7 +153,7 @@ subroutine test_diag_rqp
153153
subroutine test_diag_csp
154154
integer, parameter :: n = 3
155155
complex(sp) :: v(n), a(n,n), b(n,n)
156-
complex(sp), parameter :: i_ = complex(0,1)
156+
complex(sp), parameter :: i_ = cmplx(0,1)
157157
integer :: i,j
158158
write(*,*) "test_diag_csp"
159159
a = diag([(i,i=1,n)]) + diag([(i_,i=1,n)])
@@ -170,7 +170,7 @@ subroutine test_diag_csp
170170
subroutine test_diag_cdp
171171
integer, parameter :: n = 3
172172
complex(dp) :: v(n), a(n,n), b(n,n)
173-
complex(dp), parameter :: i_ = complex(0,1)
173+
complex(dp), parameter :: i_ = cmplx(0,1)
174174
integer :: i,j
175175
write(*,*) "test_diag_cdp"
176176
a = diag([i_],-2) + diag([i_],2)
@@ -181,7 +181,7 @@ subroutine test_diag_cdp
181181
subroutine test_diag_cqp
182182
integer, parameter :: n = 3
183183
complex(qp) :: v(n), a(n,n), b(n,n)
184-
complex(qp), parameter :: i_ = complex(0,1)
184+
complex(qp), parameter :: i_ = cmplx(0,1)
185185
integer :: i,j
186186
write(*,*) "test_diag_cqp"
187187
a = diag([i_,i_],-1) + diag([i_,i_],1)
@@ -333,7 +333,7 @@ subroutine test_trace_csp
333333
integer, parameter :: n = 5
334334
real(sp) :: re(n,n), im(n,n)
335335
complex(sp) :: a(n,n), b(n,n)
336-
complex(sp), parameter :: i_ = complex(0,1)
336+
complex(sp), parameter :: i_ = cmplx(0,1)
337337
write(*,*) "test_trace_csp"
338338

339339
call random_number(re)
@@ -352,12 +352,12 @@ subroutine test_trace_csp
352352
subroutine test_trace_cdp
353353
integer, parameter :: n = 3
354354
complex(dp) :: a(n,n), ans
355-
complex(dp), parameter :: i_ = complex(0,1)
355+
complex(dp), parameter :: i_ = cmplx(0,1)
356356
integer :: j
357357
write(*,*) "test_trace_cdp"
358358

359359
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
360+
ans = cmplx(15,15) !(1 + 5 + 9) + (9 + 5 + 1)i
361361

362362
call check(abs(trace(a) - ans) < dptol, &
363363
msg="abs(trace(a) - ans) < dptol failed.",warn=warn)
@@ -366,7 +366,7 @@ subroutine test_trace_cdp
366366
subroutine test_trace_cqp
367367
integer, parameter :: n = 3
368368
complex(qp) :: a(n,n)
369-
complex(qp), parameter :: i_ = complex(0,1)
369+
complex(qp), parameter :: i_ = cmplx(0,1)
370370
write(*,*) "test_trace_cqp"
371371
a = 3*eye(n) + 4*eye(n)*i_ ! pythagorean triple
372372
call check(abs(trace(a)) - 3*5.0_qp < qptol, &
@@ -442,4 +442,4 @@ pure recursive function catalan_number(n) result(value)
442442
end if
443443
end function
444444

445-
end program
445+
end program

‎src/tests/optval/CMakeLists.txt

+4
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()

0 commit comments

Comments
 (0)