Merge pull request #821 from jalvesz/master

Fixes for extended and quad precision checking. Add CI cheks with fpm
fortran-lang · Jun 13, 2024 · c79c8b9 · c79c8b9
2 parents 627d72c + be667e3
commit c79c8b9
Show file tree

Hide file tree

Showing 4 changed files with 147 additions and 507 deletions.
diff --git a/.github/workflows/fpm-deployment.yml b/.github/workflows/fpm-deployment.yml
@@ -35,9 +35,12 @@ jobs:
         with:
           fpm-version: 'v0.10.0'
 
-      - run: |
+      - run: | # Just for deployment: create stdlib-fpm folder
           python config/fypp_deployment.py --deploy_stdlib_fpm
-          fpm test --profile release
+
+      - run: | # Use fpm gnu ci to check xdp and qp 
+          python config/fypp_deployment.py --with_xdp --with_qp
+          fpm test --profile release --flag '-DWITH_XDP -DWITH_QP'
 
     # Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch.
       - name: Deploy 🚀

diff --git a/src/stdlib_specialfunctions_gamma.fypp b/src/stdlib_specialfunctions_gamma.fypp
@@ -1,7 +1,7 @@
-#:set WITH_QP = False
-#:set WITH_XDP = False
 #:include "common.fypp"
-#:set CI_KINDS_TYPES = INT_KINDS_TYPES + CMPLX_KINDS_TYPES
+#:set R_KINDS_TYPES = [KT for KT in REAL_KINDS_TYPES if KT[0] in ["sp","dp"]]
+#:set C_KINDS_TYPES = [KT for KT in CMPLX_KINDS_TYPES if KT[0] in ["sp","dp"]]
+#:set CI_KINDS_TYPES = INT_KINDS_TYPES + C_KINDS_TYPES
 module stdlib_specialfunctions_gamma
     use iso_fortran_env, only : qp => real128
     use stdlib_kinds, only :  sp, dp, int8, int16, int32, int64
@@ -15,7 +15,7 @@ module stdlib_specialfunctions_gamma
     integer(int32), parameter :: max_fact_int32 = 13_int32
     integer(int64), parameter :: max_fact_int64 = 21_int64
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
     ${t1}$, parameter :: tol_${k1}$ = epsilon(1.0_${k1}$)
     #:endfor
     real(qp), parameter :: tol_qp = epsilon(1.0_qp)
@@ -63,12 +63,12 @@ module stdlib_specialfunctions_gamma
     !! Lower incomplete gamma function
     !!
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
         module procedure ingamma_low_${t1[0]}$${k1}$${k2}$
           #:endfor
         #:endfor
 
-        #:for k1, t1 in REAL_KINDS_TYPES
+        #:for k1, t1 in R_KINDS_TYPES
         module procedure ingamma_low_${t1[0]}$${k1}$
         #:endfor
     end interface lower_incomplete_gamma
@@ -79,12 +79,12 @@ module stdlib_specialfunctions_gamma
     !! Logarithm of lower incomplete gamma function
     !!
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
         module procedure l_ingamma_low_${t1[0]}$${k1}$${k2}$
           #:endfor
         #:endfor
 
-        #:for k1, t1 in REAL_KINDS_TYPES
+        #:for k1, t1 in R_KINDS_TYPES
         module procedure l_ingamma_low_${t1[0]}$${k1}$
         #:endfor
     end interface log_lower_incomplete_gamma
@@ -95,12 +95,12 @@ module stdlib_specialfunctions_gamma
     !! Upper incomplete gamma function
     !!
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
         module procedure ingamma_up_${t1[0]}$${k1}$${k2}$
           #:endfor
         #:endfor
 
-        #:for k1, t1 in REAL_KINDS_TYPES
+        #:for k1, t1 in R_KINDS_TYPES
         module procedure ingamma_up_${t1[0]}$${k1}$
         #:endfor
     end interface upper_incomplete_gamma
@@ -111,12 +111,12 @@ module stdlib_specialfunctions_gamma
     !! Logarithm of upper incomplete gamma function
     !!
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
         module procedure l_ingamma_up_${t1[0]}$${k1}$${k2}$
           #:endfor
         #:endfor
 
-        #:for k1, t1 in REAL_KINDS_TYPES
+        #:for k1, t1 in R_KINDS_TYPES
         module procedure l_ingamma_up_${t1[0]}$${k1}$
         #:endfor
     end interface log_upper_incomplete_gamma
@@ -127,12 +127,12 @@ module stdlib_specialfunctions_gamma
     !! Regularized (normalized) lower incomplete gamma function, P
     !!
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
         module procedure regamma_p_${t1[0]}$${k1}$${k2}$
           #:endfor
         #:endfor
 
-        #:for k1, t1 in REAL_KINDS_TYPES
+        #:for k1, t1 in R_KINDS_TYPES
         module procedure regamma_p_${t1[0]}$${k1}$
         #:endfor
     end interface regularized_gamma_p
@@ -143,12 +143,12 @@ module stdlib_specialfunctions_gamma
     !! Regularized (normalized) upper incomplete gamma function, Q
     !!
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
         module procedure regamma_q_${t1[0]}$${k1}$${k2}$
           #:endfor
         #:endfor
 
-        #:for k1, t1 in REAL_KINDS_TYPES
+        #:for k1, t1 in R_KINDS_TYPES
         module procedure regamma_q_${t1[0]}$${k1}$
         #:endfor
     end interface regularized_gamma_q
@@ -159,12 +159,12 @@ module stdlib_specialfunctions_gamma
     ! Incomplete gamma G function.
     ! Internal use only
     !
-        #:for k1, t1 in REAL_KINDS_TYPES
+        #:for k1, t1 in R_KINDS_TYPES
         module procedure gpx_${t1[0]}$${k1}$         !for real p and x
         #:endfor
 
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
         module procedure gpx_${t1[0]}$${k1}$${k2}$   !for integer p and real x
           #:endfor
         #:endfor
@@ -177,7 +177,7 @@ module stdlib_specialfunctions_gamma
     ! Internal use only
     !
         #:for k1, t1 in INT_KINDS_TYPES
-          #:for k2, t2 in REAL_KINDS_TYPES
+          #:for k2, t2 in R_KINDS_TYPES
           module procedure l_gamma_${t1[0]}$${k1}$${k2}$
           #:endfor
         #:endfor
@@ -218,7 +218,7 @@ contains
 
 
 
-    #:for k1, t1 in CMPLX_KINDS_TYPES
+    #:for k1, t1 in C_KINDS_TYPES
       #:if k1 == "sp"
           #:set k2 = "dp"
       #:elif k1 == "dp"
@@ -373,7 +373,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
 
     impure elemental function l_gamma_${t1[0]}$${k1}$${k2}$(z, x) result(res)
     !
@@ -414,7 +414,7 @@ contains
 
 
 
-    #:for k1, t1 in CMPLX_KINDS_TYPES
+    #:for k1, t1 in C_KINDS_TYPES
       #:if k1 == "sp"
           #:set k2 = "dp"
       #:elif k1 == "dp"
@@ -556,7 +556,7 @@ contains
 
 
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
       #:if k1 == "sp"
           #:set k2 = "dp"
       #:elif k1 == "dp"
@@ -702,7 +702,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
     impure elemental function gpx_${t1[0]}$${k1}$${k2}$(p, x) result(res)
     !
     ! Approximation of incomplete gamma G function with integer argument p.
@@ -841,7 +841,7 @@ contains
 
 
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
     impure elemental function ingamma_low_${t1[0]}$${k1}$(p, x) result(res)
     !
     ! Approximation of lower incomplete gamma function with real p.
@@ -878,7 +878,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
     impure elemental function ingamma_low_${t1[0]}$${k1}$${k2}$(p, x)          &
         result(res)
     !
@@ -918,7 +918,7 @@ contains
 
 
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
     impure elemental function l_ingamma_low_${t1[0]}$${k1}$(p, x) result(res)
 
         ${t1}$, intent(in) :: p, x
@@ -955,7 +955,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
     impure elemental function l_ingamma_low_${t1[0]}$${k1}$${k2}$(p, x)        &
         result(res)
 
@@ -987,7 +987,7 @@ contains
 
 
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
     impure elemental function ingamma_up_${t1[0]}$${k1}$(p, x) result(res)
     !
     ! Approximation of upper incomplete gamma function with real p.
@@ -1025,7 +1025,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
     impure elemental function ingamma_up_${t1[0]}$${k1}$${k2}$(p, x)           &
         result(res)
     !
@@ -1067,7 +1067,7 @@ contains
 
 
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
     impure elemental function l_ingamma_up_${t1[0]}$${k1}$(p, x) result(res)
 
         ${t1}$, intent(in) :: p, x
@@ -1105,7 +1105,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
     impure elemental function l_ingamma_up_${t1[0]}$${k1}$${k2}$(p, x)         &
         result(res)
 
@@ -1146,7 +1146,7 @@ contains
 
 
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
     impure elemental function regamma_p_${t1[0]}$${k1}$(p, x) result(res)
     !
     ! Approximation of regularized incomplete gamma function P(p,x) for real p
@@ -1181,7 +1181,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
     impure elemental function regamma_p_${t1[0]}$${k1}$${k2}$(p, x) result(res)
     !
     ! Approximation of regularized incomplete gamma function P(p,x) for integer p
@@ -1217,7 +1217,7 @@ contains
 
 
 
-    #:for k1, t1 in REAL_KINDS_TYPES
+    #:for k1, t1 in R_KINDS_TYPES
     impure elemental function regamma_q_${t1[0]}$${k1}$(p, x) result(res)
     !
     ! Approximation of regularized incomplete gamma function Q(p,x) for real p
@@ -1252,7 +1252,7 @@ contains
 
 
     #:for k1, t1 in INT_KINDS_TYPES
-      #:for k2, t2 in REAL_KINDS_TYPES
+      #:for k2, t2 in R_KINDS_TYPES
     impure elemental function regamma_q_${t1[0]}$${k1}$${k2}$(p, x) result(res)
     !
     ! Approximation of regularized incomplet gamma function Q(p,x) for integer p