Skip to content

Commit b76e540

Browse files
jalveszjalvesz
committed
Fixes for extended and quad precision checking. Add CI cheks with fpm
1 parent 42182b0 commit b76e540

File tree

8 files changed

+173
-529
lines changed

8 files changed

+173
-529
lines changed

‎.github/workflows/fpm-deployment.yml‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,8 +35,11 @@ jobs:
3535
with:
3636
fpm-version: 'v0.10.0'
3737

38-
- run: |
38+
- run: | # Just for deployment: create stdlib-fpm folder
3939
python config/fypp_deployment.py --deploy_stdlib_fpm
40+
41+
- run: | # Use fpm gnu ci to check xdp and qp
42+
python config/fypp_deployment.py --with_xdp --with_qp
4043
fpm test --profile release
4144
4245
# Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch.

‎src/stdlib_specialfunctions_gamma.fypp‎

Lines changed: 35 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
1-
#:set WITH_QP = False
2-
#:set WITH_XDP = False
31
#:include "common.fypp"
4-
#:set CI_KINDS_TYPES = INT_KINDS_TYPES + CMPLX_KINDS_TYPES
2+
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES[0:2]
3+
#:set CI_KINDS_TYPES = INT_KINDS_TYPES + CMPLX_KINDS_TYPES[0:2]
54
module stdlib_specialfunctions_gamma
65
use iso_fortran_env, only : qp => real128
76
use stdlib_kinds, only : sp, dp, int8, int16, int32, int64
@@ -15,7 +14,7 @@ module stdlib_specialfunctions_gamma
1514
integer(int32), parameter :: max_fact_int32 = 13_int32
1615
integer(int64), parameter :: max_fact_int64 = 21_int64
1716

18-
#:for k1, t1 in REAL_KINDS_TYPES
17+
#:for k1, t1 in RC_KINDS_TYPES
1918
${t1}$, parameter :: tol_${k1}$ = epsilon(1.0_${k1}$)
2019
#:endfor
2120
real(qp), parameter :: tol_qp = epsilon(1.0_qp)
@@ -63,12 +62,12 @@ module stdlib_specialfunctions_gamma
6362
!! Lower incomplete gamma function
6463
!!
6564
#:for k1, t1 in INT_KINDS_TYPES
66-
#:for k2, t2 in REAL_KINDS_TYPES
65+
#:for k2, t2 in RC_KINDS_TYPES
6766
module procedure ingamma_low_${t1[0]}$${k1}$${k2}$
6867
#:endfor
6968
#:endfor
7069

71-
#:for k1, t1 in REAL_KINDS_TYPES
70+
#:for k1, t1 in RC_KINDS_TYPES
7271
module procedure ingamma_low_${t1[0]}$${k1}$
7372
#:endfor
7473
end interface lower_incomplete_gamma
@@ -79,12 +78,12 @@ module stdlib_specialfunctions_gamma
7978
!! Logarithm of lower incomplete gamma function
8079
!!
8180
#:for k1, t1 in INT_KINDS_TYPES
82-
#:for k2, t2 in REAL_KINDS_TYPES
81+
#:for k2, t2 in RC_KINDS_TYPES
8382
module procedure l_ingamma_low_${t1[0]}$${k1}$${k2}$
8483
#:endfor
8584
#:endfor
8685

87-
#:for k1, t1 in REAL_KINDS_TYPES
86+
#:for k1, t1 in RC_KINDS_TYPES
8887
module procedure l_ingamma_low_${t1[0]}$${k1}$
8988
#:endfor
9089
end interface log_lower_incomplete_gamma
@@ -95,12 +94,12 @@ module stdlib_specialfunctions_gamma
9594
!! Upper incomplete gamma function
9695
!!
9796
#:for k1, t1 in INT_KINDS_TYPES
98-
#:for k2, t2 in REAL_KINDS_TYPES
97+
#:for k2, t2 in RC_KINDS_TYPES
9998
module procedure ingamma_up_${t1[0]}$${k1}$${k2}$
10099
#:endfor
101100
#:endfor
102101

103-
#:for k1, t1 in REAL_KINDS_TYPES
102+
#:for k1, t1 in RC_KINDS_TYPES
104103
module procedure ingamma_up_${t1[0]}$${k1}$
105104
#:endfor
106105
end interface upper_incomplete_gamma
@@ -111,12 +110,12 @@ module stdlib_specialfunctions_gamma
111110
!! Logarithm of upper incomplete gamma function
112111
!!
113112
#:for k1, t1 in INT_KINDS_TYPES
114-
#:for k2, t2 in REAL_KINDS_TYPES
113+
#:for k2, t2 in RC_KINDS_TYPES
115114
module procedure l_ingamma_up_${t1[0]}$${k1}$${k2}$
116115
#:endfor
117116
#:endfor
118117

119-
#:for k1, t1 in REAL_KINDS_TYPES
118+
#:for k1, t1 in RC_KINDS_TYPES
120119
module procedure l_ingamma_up_${t1[0]}$${k1}$
121120
#:endfor
122121
end interface log_upper_incomplete_gamma
@@ -127,12 +126,12 @@ module stdlib_specialfunctions_gamma
127126
!! Regularized (normalized) lower incomplete gamma function, P
128127
!!
129128
#:for k1, t1 in INT_KINDS_TYPES
130-
#:for k2, t2 in REAL_KINDS_TYPES
129+
#:for k2, t2 in RC_KINDS_TYPES
131130
module procedure regamma_p_${t1[0]}$${k1}$${k2}$
132131
#:endfor
133132
#:endfor
134133

135-
#:for k1, t1 in REAL_KINDS_TYPES
134+
#:for k1, t1 in RC_KINDS_TYPES
136135
module procedure regamma_p_${t1[0]}$${k1}$
137136
#:endfor
138137
end interface regularized_gamma_p
@@ -143,12 +142,12 @@ module stdlib_specialfunctions_gamma
143142
!! Regularized (normalized) upper incomplete gamma function, Q
144143
!!
145144
#:for k1, t1 in INT_KINDS_TYPES
146-
#:for k2, t2 in REAL_KINDS_TYPES
145+
#:for k2, t2 in RC_KINDS_TYPES
147146
module procedure regamma_q_${t1[0]}$${k1}$${k2}$
148147
#:endfor
149148
#:endfor
150149

151-
#:for k1, t1 in REAL_KINDS_TYPES
150+
#:for k1, t1 in RC_KINDS_TYPES
152151
module procedure regamma_q_${t1[0]}$${k1}$
153152
#:endfor
154153
end interface regularized_gamma_q
@@ -159,12 +158,12 @@ module stdlib_specialfunctions_gamma
159158
! Incomplete gamma G function.
160159
! Internal use only
161160
!
162-
#:for k1, t1 in REAL_KINDS_TYPES
161+
#:for k1, t1 in RC_KINDS_TYPES
163162
module procedure gpx_${t1[0]}$${k1}$ !for real p and x
164163
#:endfor
165164

166165
#:for k1, t1 in INT_KINDS_TYPES
167-
#:for k2, t2 in REAL_KINDS_TYPES
166+
#:for k2, t2 in RC_KINDS_TYPES
168167
module procedure gpx_${t1[0]}$${k1}$${k2}$ !for integer p and real x
169168
#:endfor
170169
#:endfor
@@ -177,7 +176,7 @@ module stdlib_specialfunctions_gamma
177176
! Internal use only
178177
!
179178
#:for k1, t1 in INT_KINDS_TYPES
180-
#:for k2, t2 in REAL_KINDS_TYPES
179+
#:for k2, t2 in RC_KINDS_TYPES
181180
module procedure l_gamma_${t1[0]}$${k1}$${k2}$
182181
#:endfor
183182
#:endfor
@@ -218,7 +217,7 @@ contains
218217

219218

220219

221-
#:for k1, t1 in CMPLX_KINDS_TYPES
220+
#:for k1, t1 in CMPLX_KINDS_TYPES[0:2]
222221
#:if k1 == "sp"
223222
#:set k2 = "dp"
224223
#:elif k1 == "dp"
@@ -373,7 +372,7 @@ contains
373372

374373

375374
#:for k1, t1 in INT_KINDS_TYPES
376-
#:for k2, t2 in REAL_KINDS_TYPES
375+
#:for k2, t2 in RC_KINDS_TYPES
377376

378377
impure elemental function l_gamma_${t1[0]}$${k1}$${k2}$(z, x) result(res)
379378
!
@@ -414,7 +413,7 @@ contains
414413

415414

416415

417-
#:for k1, t1 in CMPLX_KINDS_TYPES
416+
#:for k1, t1 in CMPLX_KINDS_TYPES[0:2]
418417
#:if k1 == "sp"
419418
#:set k2 = "dp"
420419
#:elif k1 == "dp"
@@ -556,7 +555,7 @@ contains
556555

557556

558557

559-
#:for k1, t1 in REAL_KINDS_TYPES
558+
#:for k1, t1 in RC_KINDS_TYPES
560559
#:if k1 == "sp"
561560
#:set k2 = "dp"
562561
#:elif k1 == "dp"
@@ -702,7 +701,7 @@ contains
702701

703702

704703
#:for k1, t1 in INT_KINDS_TYPES
705-
#:for k2, t2 in REAL_KINDS_TYPES
704+
#:for k2, t2 in RC_KINDS_TYPES
706705
impure elemental function gpx_${t1[0]}$${k1}$${k2}$(p, x) result(res)
707706
!
708707
! Approximation of incomplete gamma G function with integer argument p.
@@ -841,7 +840,7 @@ contains
841840

842841

843842

844-
#:for k1, t1 in REAL_KINDS_TYPES
843+
#:for k1, t1 in RC_KINDS_TYPES
845844
impure elemental function ingamma_low_${t1[0]}$${k1}$(p, x) result(res)
846845
!
847846
! Approximation of lower incomplete gamma function with real p.
@@ -878,7 +877,7 @@ contains
878877

879878

880879
#:for k1, t1 in INT_KINDS_TYPES
881-
#:for k2, t2 in REAL_KINDS_TYPES
880+
#:for k2, t2 in RC_KINDS_TYPES
882881
impure elemental function ingamma_low_${t1[0]}$${k1}$${k2}$(p, x) &
883882
result(res)
884883
!
@@ -918,7 +917,7 @@ contains
918917

919918

920919

921-
#:for k1, t1 in REAL_KINDS_TYPES
920+
#:for k1, t1 in RC_KINDS_TYPES
922921
impure elemental function l_ingamma_low_${t1[0]}$${k1}$(p, x) result(res)
923922

924923
${t1}$, intent(in) :: p, x
@@ -955,7 +954,7 @@ contains
955954

956955

957956
#:for k1, t1 in INT_KINDS_TYPES
958-
#:for k2, t2 in REAL_KINDS_TYPES
957+
#:for k2, t2 in RC_KINDS_TYPES
959958
impure elemental function l_ingamma_low_${t1[0]}$${k1}$${k2}$(p, x) &
960959
result(res)
961960

@@ -987,7 +986,7 @@ contains
987986

988987

989988

990-
#:for k1, t1 in REAL_KINDS_TYPES
989+
#:for k1, t1 in RC_KINDS_TYPES
991990
impure elemental function ingamma_up_${t1[0]}$${k1}$(p, x) result(res)
992991
!
993992
! Approximation of upper incomplete gamma function with real p.
@@ -1025,7 +1024,7 @@ contains
10251024

10261025

10271026
#:for k1, t1 in INT_KINDS_TYPES
1028-
#:for k2, t2 in REAL_KINDS_TYPES
1027+
#:for k2, t2 in RC_KINDS_TYPES
10291028
impure elemental function ingamma_up_${t1[0]}$${k1}$${k2}$(p, x) &
10301029
result(res)
10311030
!
@@ -1067,7 +1066,7 @@ contains
10671066

10681067

10691068

1070-
#:for k1, t1 in REAL_KINDS_TYPES
1069+
#:for k1, t1 in RC_KINDS_TYPES
10711070
impure elemental function l_ingamma_up_${t1[0]}$${k1}$(p, x) result(res)
10721071

10731072
${t1}$, intent(in) :: p, x
@@ -1105,7 +1104,7 @@ contains
11051104

11061105

11071106
#:for k1, t1 in INT_KINDS_TYPES
1108-
#:for k2, t2 in REAL_KINDS_TYPES
1107+
#:for k2, t2 in RC_KINDS_TYPES
11091108
impure elemental function l_ingamma_up_${t1[0]}$${k1}$${k2}$(p, x) &
11101109
result(res)
11111110

@@ -1146,7 +1145,7 @@ contains
11461145

11471146

11481147

1149-
#:for k1, t1 in REAL_KINDS_TYPES
1148+
#:for k1, t1 in RC_KINDS_TYPES
11501149
impure elemental function regamma_p_${t1[0]}$${k1}$(p, x) result(res)
11511150
!
11521151
! Approximation of regularized incomplete gamma function P(p,x) for real p
@@ -1181,7 +1180,7 @@ contains
11811180

11821181

11831182
#:for k1, t1 in INT_KINDS_TYPES
1184-
#:for k2, t2 in REAL_KINDS_TYPES
1183+
#:for k2, t2 in RC_KINDS_TYPES
11851184
impure elemental function regamma_p_${t1[0]}$${k1}$${k2}$(p, x) result(res)
11861185
!
11871186
! Approximation of regularized incomplete gamma function P(p,x) for integer p
@@ -1217,7 +1216,7 @@ contains
12171216

12181217

12191218

1220-
#:for k1, t1 in REAL_KINDS_TYPES
1219+
#:for k1, t1 in RC_KINDS_TYPES
12211220
impure elemental function regamma_q_${t1[0]}$${k1}$(p, x) result(res)
12221221
!
12231222
! Approximation of regularized incomplete gamma function Q(p,x) for real p
@@ -1252,7 +1251,7 @@ contains
12521251

12531252

12541253
#:for k1, t1 in INT_KINDS_TYPES
1255-
#:for k2, t2 in REAL_KINDS_TYPES
1254+
#:for k2, t2 in RC_KINDS_TYPES
12561255
impure elemental function regamma_q_${t1[0]}$${k1}$${k2}$(p, x) result(res)
12571256
!
12581257
! Approximation of regularized incomplet gamma function Q(p,x) for integer p

‎test/math/test_meshgrid.fypp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -79,7 +79,7 @@ contains
7979
${"".join(f"xm{j}," for j in range(1, rank + 1)).removesuffix(",")}$ &
8080
${OPTIONAL_PART_IN_SIGNATURE(INDEXING)}$ )
8181
#:for j in range(1, rank + 1)
82-
call check(error, maxval(abs(xm${j}$ - xm${j}$_exact)), ZERO)
82+
call check(error, maxval(abs(xm${j}$ - xm${j}$_exact)) == ZERO)
8383
if (allocated(error)) return
8484
#:endfor
8585
end subroutine test_${RName}$

‎test/math/test_stdlib_math.fypp‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -170,9 +170,9 @@ contains
170170
type(error_type), allocatable, intent(out) :: error
171171
! type: real(sp), kind: sp
172172
! valid test case
173-
call check(error, clip(3.025_sp, -5.77_sp, 3.025_sp), 3.025_sp)
173+
call check(error, clip(3.025_sp, -5.77_sp, 3.025_sp) == 3.025_sp)
174174
if (allocated(error)) return
175-
call check(error, clip(0.0_sp, -1578.025_sp, -59.68_sp), -59.68_sp)
175+
call check(error, clip(0.0_sp, -1578.025_sp, -59.68_sp) == -59.68_sp)
176176
if (allocated(error)) return
177177
end subroutine test_clip_rsp
178178

@@ -215,9 +215,9 @@ contains
215215
#:if WITH_QP
216216
! type: real(qp), kind: qp
217217
! valid test case
218-
call check(error, clip(3.025_qp, -5.77_qp, 3.025_qp), 3.025_qp)
218+
call check(error, clip(3.025_qp, -5.77_qp, 3.025_qp) == 3.025_qp)
219219
if (allocated(error)) return
220-
call check(error, clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp), -689712245.23_qp)
220+
call check(error, clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp) == -689712245.23_qp)
221221
if (allocated(error)) return
222222
#:else
223223
call skip_test(error, "Quadruple precision is not enabled")
@@ -230,9 +230,9 @@ contains
230230
type(error_type), allocatable, intent(out) :: error
231231
#:if WITH_QP
232232
! invalid test case
233-
call check(error, clip(3.025_qp, 3.025_qp, -5.77_qp), 3.025_qp)
233+
call check(error, clip(3.025_qp, 3.025_qp, -5.77_qp) == 3.025_qp)
234234
if (allocated(error)) return
235-
call check(error, clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp), -689712245.23_qp)
235+
call check(error, clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp) == 689712245.23_qp)
236236
if (allocated(error)) return
237237
#:else
238238
call skip_test(error, "Quadruple precision is not enabled")

0 commit comments

Comments
 (0)