Skip to content

Commit c8bf44f

Browse files
committed
test: stdlib + external blas
1 parent b71cb19 commit c8bf44f

File tree

6 files changed

+110
-3
lines changed

6 files changed

+110
-3
lines changed
Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
! fortran-lang stdlib test case
2+
! This test program will only run if stdlib is properly built and linked to this project.
3+
program test_stdlib_metapackage
4+
5+
! These USEs would not be possible if stdlib is not found
6+
use metapackage_stdlib, only: external_blas_test,external_lapack_test
7+
implicit none
8+
9+
logical :: ext_blas,ext_lapack
10+
11+
call external_blas_test(ext_blas)
12+
call external_lapack_test(ext_lapack)
13+
14+
if (.not.ext_blas) then
15+
stop 1
16+
elseif (.not.ext_lapack) then
17+
stop 2
18+
else
19+
stop 0
20+
end if
21+
22+
end program test_stdlib_metapackage
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
name = "test_stdlib_ext_blas"
2+
dependencies.blas = "*"
3+
dependencies.stdlib = "*"
Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
module metapackage_stdlib
2+
use stdlib_linalg_constants, only: sp,dp,ilp
3+
implicit none
4+
private
5+
6+
public :: external_blas_test
7+
public :: external_lapack_test
8+
9+
contains
10+
11+
!> Test availability of the external BLAS interface
12+
subroutine external_blas_test(external_blas)
13+
!> Error handling
14+
logical, intent(out) :: external_blas
15+
16+
#ifdef STDLIB_EXTERNAL_BLAS
17+
interface
18+
subroutine saxpy(n,sa,sx,incx,sy,incy)
19+
import sp,ilp
20+
implicit none(type,external)
21+
real(sp), intent(in) :: sa,sx(*)
22+
integer(ilp), intent(in) :: incx,incy,n
23+
real(sp), intent(inout) :: sy(*)
24+
end subroutine saxpy
25+
end interface
26+
27+
integer(ilp), parameter :: n = 5, inc=1
28+
real(sp) :: a,x(n),y(n)
29+
30+
x = 1.0_sp
31+
y = 2.0_sp
32+
a = 3.0_sp
33+
34+
call saxpy(n,a,x,inc,y,inc)
35+
36+
! Result must also be correct
37+
external_blas = all(abs(y-5.0_sp)<sqrt(epsilon(0.0_sp)))
38+
39+
#else
40+
external_blas = .false.
41+
#endif
42+
43+
end subroutine external_blas_test
44+
45+
!> Test availability of the external BLAS interface
46+
subroutine external_lapack_test(external_lapack)
47+
!> Error handling
48+
logical, intent(out) :: external_lapack
49+
50+
#ifdef STDLIB_EXTERNAL_LAPACK
51+
interface
52+
subroutine dgetrf( m, n, a, lda, ipiv, info )
53+
import dp,ilp
54+
implicit none(type,external)
55+
integer(ilp), intent(out) :: info,ipiv(*)
56+
integer(ilp), intent(in) :: lda,m,n
57+
real(dp), intent(inout) :: a(lda,*)
58+
end subroutine dgetrf
59+
end interface
60+
61+
integer(ilp), parameter :: n = 3
62+
real(dp) :: A(n,n)
63+
integer(ilp) :: ipiv(n),info
64+
65+
66+
A = reshape([1,0,0, 0,1,0, 0,0,1],[3,3])
67+
info = 123
68+
69+
! Factorize matrix
70+
call dgetrf(n,n,A,n,ipiv,info)
71+
72+
! Result must be correct
73+
external_lapack = info==0
74+
75+
#else
76+
external_lapack = .false.
77+
#endif
78+
79+
end subroutine external_lapack_test
80+
81+
end module metapackage_stdlib
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
program cpp
2+
use preprocess_cpp
3+
call say_hello()
4+
end program

src/fpm.f90

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -78,8 +78,6 @@ subroutine build_model(model, settings, package, error)
7878
call resolve_metapackages(model,package,settings,error)
7979
if (allocated(error)) return
8080

81-
if (allocated(package%preprocess)) call package%preprocess(1)%info(6,3)
82-
8381
! Create dependencies
8482
call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml"), &
8583
& path_to_config=settings%path_to_config)

src/metapackage/fpm_meta_base.f90

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -206,7 +206,6 @@ subroutine resolve_package_config(self,package,error)
206206
end if
207207
else
208208
! Copy configuration
209-
call self%preprocess%info(6,2)
210209
allocate(package%preprocess(1),source=self%preprocess)
211210

212211
end if

0 commit comments

Comments
 (0)