diff options
48 files changed, 1163 insertions, 1282 deletions
diff --git a/numpy/f2py/tests/src/abstract_interface/foo.f90 b/numpy/f2py/tests/src/abstract_interface/foo.f90 new file mode 100644 index 000000000..76d16aae2 --- /dev/null +++ b/numpy/f2py/tests/src/abstract_interface/foo.f90 @@ -0,0 +1,34 @@ +module ops_module + + abstract interface + subroutine op(x, y, z) + integer, intent(in) :: x, y + integer, intent(out) :: z + end subroutine + end interface + +contains + + subroutine foo(x, y, r1, r2) + integer, intent(in) :: x, y + integer, intent(out) :: r1, r2 + procedure (op) add1, add2 + procedure (op), pointer::p + p=>add1 + call p(x, y, r1) + p=>add2 + call p(x, y, r2) + end subroutine +end module + +subroutine add1(x, y, z) + integer, intent(in) :: x, y + integer, intent(out) :: z + z = x + y +end subroutine + +subroutine add2(x, y, z) + integer, intent(in) :: x, y + integer, intent(out) :: z + z = x + 2 * y +end subroutine diff --git a/numpy/f2py/tests/src/abstract_interface/gh18403_mod.f90 b/numpy/f2py/tests/src/abstract_interface/gh18403_mod.f90 new file mode 100644 index 000000000..36791e469 --- /dev/null +++ b/numpy/f2py/tests/src/abstract_interface/gh18403_mod.f90 @@ -0,0 +1,6 @@ +module test + abstract interface + subroutine foo() + end subroutine + end interface +end module test diff --git a/numpy/f2py/tests/src/block_docstring/foo.f b/numpy/f2py/tests/src/block_docstring/foo.f new file mode 100644 index 000000000..c8315f12c --- /dev/null +++ b/numpy/f2py/tests/src/block_docstring/foo.f @@ -0,0 +1,6 @@ + SUBROUTINE FOO() + INTEGER BAR(2, 3) + + COMMON /BLOCK/ BAR + RETURN + END diff --git a/numpy/f2py/tests/src/callback/foo.f b/numpy/f2py/tests/src/callback/foo.f new file mode 100644 index 000000000..ba397bb38 --- /dev/null +++ b/numpy/f2py/tests/src/callback/foo.f @@ -0,0 +1,62 @@ + subroutine t(fun,a) + integer a +cf2py intent(out) a + external fun + call fun(a) + end + + subroutine func(a) +cf2py intent(in,out) a + integer a + a = a + 11 + end + + subroutine func0(a) +cf2py intent(out) a + integer a + a = 11 + end + + subroutine t2(a) +cf2py intent(callback) fun + integer a +cf2py intent(out) a + external fun + call fun(a) + end + + subroutine string_callback(callback, a) + external callback + double precision callback + double precision a + character*1 r +cf2py intent(out) a + r = 'r' + a = callback(r) + end + + subroutine string_callback_array(callback, cu, lencu, a) + external callback + integer callback + integer lencu + character*8 cu(lencu) + integer a +cf2py intent(out) a + + a = callback(cu, lencu) + end + + subroutine hidden_callback(a, r) + external global_f +cf2py intent(callback, hide) global_f + integer a, r, global_f +cf2py intent(out) r + r = global_f(a) + end + + subroutine hidden_callback2(a, r) + external global_f + integer a, r, global_f +cf2py intent(out) r + r = global_f(a) + end diff --git a/numpy/f2py/tests/src/callback/gh17797.f90 b/numpy/f2py/tests/src/callback/gh17797.f90 new file mode 100644 index 000000000..49853afd7 --- /dev/null +++ b/numpy/f2py/tests/src/callback/gh17797.f90 @@ -0,0 +1,7 @@ +function gh17797(f, y) result(r) + external f + integer(8) :: r, f + integer(8), dimension(:) :: y + r = f(0) + r = r + sum(y) +end function gh17797 diff --git a/numpy/f2py/tests/src/callback/gh18335.f90 b/numpy/f2py/tests/src/callback/gh18335.f90 new file mode 100644 index 000000000..92b6d7540 --- /dev/null +++ b/numpy/f2py/tests/src/callback/gh18335.f90 @@ -0,0 +1,17 @@ + ! When gh18335_workaround is defined as an extension, + ! the issue cannot be reproduced. + !subroutine gh18335_workaround(f, y) + ! implicit none + ! external f + ! integer(kind=1) :: y(1) + ! call f(y) + !end subroutine gh18335_workaround + + function gh18335(f) result (r) + implicit none + external f + integer(kind=1) :: y(1), r + y(1) = 123 + call f(y) + r = y(1) + end function gh18335 diff --git a/numpy/f2py/tests/src/crackfortran/foo_deps.f90 b/numpy/f2py/tests/src/crackfortran/foo_deps.f90 new file mode 100644 index 000000000..e327b25c8 --- /dev/null +++ b/numpy/f2py/tests/src/crackfortran/foo_deps.f90 @@ -0,0 +1,6 @@ +module foo + type bar + character(len = 4) :: text + end type bar + type(bar), parameter :: abar = bar('abar') +end module foo diff --git a/numpy/f2py/tests/src/crackfortran/gh15035.f b/numpy/f2py/tests/src/crackfortran/gh15035.f new file mode 100644 index 000000000..1bb2e6745 --- /dev/null +++ b/numpy/f2py/tests/src/crackfortran/gh15035.f @@ -0,0 +1,16 @@ + subroutine subb(k) + real(8), intent(inout) :: k(:) + k=k+1 + endsubroutine + + subroutine subc(w,k) + real(8), intent(in) :: w(:) + real(8), intent(out) :: k(size(w)) + k=w+1 + endsubroutine + + function t0(value) + character value + character t0 + t0 = value + endfunction diff --git a/numpy/f2py/tests/src/crackfortran/gh17859.f b/numpy/f2py/tests/src/crackfortran/gh17859.f new file mode 100644 index 000000000..995953845 --- /dev/null +++ b/numpy/f2py/tests/src/crackfortran/gh17859.f @@ -0,0 +1,12 @@ + integer(8) function external_as_statement(fcn) + implicit none + external fcn + integer(8) :: fcn + external_as_statement = fcn(0) + end + + integer(8) function external_as_attribute(fcn) + implicit none + integer(8), external :: fcn + external_as_attribute = fcn(0) + end diff --git a/numpy/f2py/tests/src/crackfortran/gh2848.f90 b/numpy/f2py/tests/src/crackfortran/gh2848.f90 new file mode 100644 index 000000000..31ea9327a --- /dev/null +++ b/numpy/f2py/tests/src/crackfortran/gh2848.f90 @@ -0,0 +1,13 @@ + subroutine gh2848( & + ! first 2 parameters + par1, par2,& + ! last 2 parameters + par3, par4) + + integer, intent(in) :: par1, par2 + integer, intent(out) :: par3, par4 + + par3 = par1 + par4 = par2 + + end subroutine gh2848 diff --git a/numpy/f2py/tests/src/crackfortran/privatemod.f90 b/numpy/f2py/tests/src/crackfortran/privatemod.f90 new file mode 100644 index 000000000..2674c2147 --- /dev/null +++ b/numpy/f2py/tests/src/crackfortran/privatemod.f90 @@ -0,0 +1,11 @@ +module foo + private + integer :: a + public :: setA + integer :: b +contains + subroutine setA(v) + integer, intent(in) :: v + a = v + end subroutine setA +end module foo diff --git a/numpy/f2py/tests/src/crackfortran/publicmod.f90 b/numpy/f2py/tests/src/crackfortran/publicmod.f90 new file mode 100644 index 000000000..1db76e3fe --- /dev/null +++ b/numpy/f2py/tests/src/crackfortran/publicmod.f90 @@ -0,0 +1,10 @@ +module foo + public + integer, private :: a + public :: setA +contains + subroutine setA(v) + integer, intent(in) :: v + a = v + end subroutine setA +end module foo diff --git a/numpy/f2py/tests/src/quoted_character/foo.f b/numpy/f2py/tests/src/quoted_character/foo.f new file mode 100644 index 000000000..9dc1cfa44 --- /dev/null +++ b/numpy/f2py/tests/src/quoted_character/foo.f @@ -0,0 +1,14 @@ + SUBROUTINE FOO(OUT1, OUT2, OUT3, OUT4, OUT5, OUT6) + CHARACTER SINGLE, DOUBLE, SEMICOL, EXCLA, OPENPAR, CLOSEPAR + PARAMETER (SINGLE="'", DOUBLE='"', SEMICOL=';', EXCLA="!", + 1 OPENPAR="(", CLOSEPAR=")") + CHARACTER OUT1, OUT2, OUT3, OUT4, OUT5, OUT6 +Cf2py intent(out) OUT1, OUT2, OUT3, OUT4, OUT5, OUT6 + OUT1 = SINGLE + OUT2 = DOUBLE + OUT3 = SEMICOL + OUT4 = EXCLA + OUT5 = OPENPAR + OUT6 = CLOSEPAR + RETURN + END diff --git a/numpy/f2py/tests/src/return_character/foo77.f b/numpy/f2py/tests/src/return_character/foo77.f new file mode 100644 index 000000000..facae1016 --- /dev/null +++ b/numpy/f2py/tests/src/return_character/foo77.f @@ -0,0 +1,45 @@ + function t0(value) + character value + character t0 + t0 = value + end + function t1(value) + character*1 value + character*1 t1 + t1 = value + end + function t5(value) + character*5 value + character*5 t5 + t5 = value + end + function ts(value) + character*(*) value + character*(*) ts + ts = value + end + + subroutine s0(t0,value) + character value + character t0 +cf2py intent(out) t0 + t0 = value + end + subroutine s1(t1,value) + character*1 value + character*1 t1 +cf2py intent(out) t1 + t1 = value + end + subroutine s5(t5,value) + character*5 value + character*5 t5 +cf2py intent(out) t5 + t5 = value + end + subroutine ss(ts,value) + character*(*) value + character*10 ts +cf2py intent(out) ts + ts = value + end diff --git a/numpy/f2py/tests/src/return_character/foo90.f90 b/numpy/f2py/tests/src/return_character/foo90.f90 new file mode 100644 index 000000000..36182bcf2 --- /dev/null +++ b/numpy/f2py/tests/src/return_character/foo90.f90 @@ -0,0 +1,48 @@ +module f90_return_char + contains + function t0(value) + character :: value + character :: t0 + t0 = value + end function t0 + function t1(value) + character(len=1) :: value + character(len=1) :: t1 + t1 = value + end function t1 + function t5(value) + character(len=5) :: value + character(len=5) :: t5 + t5 = value + end function t5 + function ts(value) + character(len=*) :: value + character(len=10) :: ts + ts = value + end function ts + + subroutine s0(t0,value) + character :: value + character :: t0 +!f2py intent(out) t0 + t0 = value + end subroutine s0 + subroutine s1(t1,value) + character(len=1) :: value + character(len=1) :: t1 +!f2py intent(out) t1 + t1 = value + end subroutine s1 + subroutine s5(t5,value) + character(len=5) :: value + character(len=5) :: t5 +!f2py intent(out) t5 + t5 = value + end subroutine s5 + subroutine ss(ts,value) + character(len=*) :: value + character(len=10) :: ts +!f2py intent(out) ts + ts = value + end subroutine ss +end module f90_return_char diff --git a/numpy/f2py/tests/src/return_complex/foo77.f b/numpy/f2py/tests/src/return_complex/foo77.f new file mode 100644 index 000000000..37a1ec845 --- /dev/null +++ b/numpy/f2py/tests/src/return_complex/foo77.f @@ -0,0 +1,45 @@ + function t0(value) + complex value + complex t0 + t0 = value + end + function t8(value) + complex*8 value + complex*8 t8 + t8 = value + end + function t16(value) + complex*16 value + complex*16 t16 + t16 = value + end + function td(value) + double complex value + double complex td + td = value + end + + subroutine s0(t0,value) + complex value + complex t0 +cf2py intent(out) t0 + t0 = value + end + subroutine s8(t8,value) + complex*8 value + complex*8 t8 +cf2py intent(out) t8 + t8 = value + end + subroutine s16(t16,value) + complex*16 value + complex*16 t16 +cf2py intent(out) t16 + t16 = value + end + subroutine sd(td,value) + double complex value + double complex td +cf2py intent(out) td + td = value + end diff --git a/numpy/f2py/tests/src/return_complex/foo90.f90 b/numpy/f2py/tests/src/return_complex/foo90.f90 new file mode 100644 index 000000000..adc27b470 --- /dev/null +++ b/numpy/f2py/tests/src/return_complex/foo90.f90 @@ -0,0 +1,48 @@ +module f90_return_complex + contains + function t0(value) + complex :: value + complex :: t0 + t0 = value + end function t0 + function t8(value) + complex(kind=4) :: value + complex(kind=4) :: t8 + t8 = value + end function t8 + function t16(value) + complex(kind=8) :: value + complex(kind=8) :: t16 + t16 = value + end function t16 + function td(value) + double complex :: value + double complex :: td + td = value + end function td + + subroutine s0(t0,value) + complex :: value + complex :: t0 +!f2py intent(out) t0 + t0 = value + end subroutine s0 + subroutine s8(t8,value) + complex(kind=4) :: value + complex(kind=4) :: t8 +!f2py intent(out) t8 + t8 = value + end subroutine s8 + subroutine s16(t16,value) + complex(kind=8) :: value + complex(kind=8) :: t16 +!f2py intent(out) t16 + t16 = value + end subroutine s16 + subroutine sd(td,value) + double complex :: value + double complex :: td +!f2py intent(out) td + td = value + end subroutine sd +end module f90_return_complex diff --git a/numpy/f2py/tests/src/return_integer/foo77.f b/numpy/f2py/tests/src/return_integer/foo77.f new file mode 100644 index 000000000..1ab895b9a --- /dev/null +++ b/numpy/f2py/tests/src/return_integer/foo77.f @@ -0,0 +1,56 @@ + function t0(value) + integer value + integer t0 + t0 = value + end + function t1(value) + integer*1 value + integer*1 t1 + t1 = value + end + function t2(value) + integer*2 value + integer*2 t2 + t2 = value + end + function t4(value) + integer*4 value + integer*4 t4 + t4 = value + end + function t8(value) + integer*8 value + integer*8 t8 + t8 = value + end + + subroutine s0(t0,value) + integer value + integer t0 +cf2py intent(out) t0 + t0 = value + end + subroutine s1(t1,value) + integer*1 value + integer*1 t1 +cf2py intent(out) t1 + t1 = value + end + subroutine s2(t2,value) + integer*2 value + integer*2 t2 +cf2py intent(out) t2 + t2 = value + end + subroutine s4(t4,value) + integer*4 value + integer*4 t4 +cf2py intent(out) t4 + t4 = value + end + subroutine s8(t8,value) + integer*8 value + integer*8 t8 +cf2py intent(out) t8 + t8 = value + end diff --git a/numpy/f2py/tests/src/return_integer/foo90.f90 b/numpy/f2py/tests/src/return_integer/foo90.f90 new file mode 100644 index 000000000..ba9249aa2 --- /dev/null +++ b/numpy/f2py/tests/src/return_integer/foo90.f90 @@ -0,0 +1,59 @@ +module f90_return_integer + contains + function t0(value) + integer :: value + integer :: t0 + t0 = value + end function t0 + function t1(value) + integer(kind=1) :: value + integer(kind=1) :: t1 + t1 = value + end function t1 + function t2(value) + integer(kind=2) :: value + integer(kind=2) :: t2 + t2 = value + end function t2 + function t4(value) + integer(kind=4) :: value + integer(kind=4) :: t4 + t4 = value + end function t4 + function t8(value) + integer(kind=8) :: value + integer(kind=8) :: t8 + t8 = value + end function t8 + + subroutine s0(t0,value) + integer :: value + integer :: t0 +!f2py intent(out) t0 + t0 = value + end subroutine s0 + subroutine s1(t1,value) + integer(kind=1) :: value + integer(kind=1) :: t1 +!f2py intent(out) t1 + t1 = value + end subroutine s1 + subroutine s2(t2,value) + integer(kind=2) :: value + integer(kind=2) :: t2 +!f2py intent(out) t2 + t2 = value + end subroutine s2 + subroutine s4(t4,value) + integer(kind=4) :: value + integer(kind=4) :: t4 +!f2py intent(out) t4 + t4 = value + end subroutine s4 + subroutine s8(t8,value) + integer(kind=8) :: value + integer(kind=8) :: t8 +!f2py intent(out) t8 + t8 = value + end subroutine s8 +end module f90_return_integer diff --git a/numpy/f2py/tests/src/return_logical/foo77.f b/numpy/f2py/tests/src/return_logical/foo77.f new file mode 100644 index 000000000..ef530145f --- /dev/null +++ b/numpy/f2py/tests/src/return_logical/foo77.f @@ -0,0 +1,56 @@ + function t0(value) + logical value + logical t0 + t0 = value + end + function t1(value) + logical*1 value + logical*1 t1 + t1 = value + end + function t2(value) + logical*2 value + logical*2 t2 + t2 = value + end + function t4(value) + logical*4 value + logical*4 t4 + t4 = value + end +c function t8(value) +c logical*8 value +c logical*8 t8 +c t8 = value +c end + + subroutine s0(t0,value) + logical value + logical t0 +cf2py intent(out) t0 + t0 = value + end + subroutine s1(t1,value) + logical*1 value + logical*1 t1 +cf2py intent(out) t1 + t1 = value + end + subroutine s2(t2,value) + logical*2 value + logical*2 t2 +cf2py intent(out) t2 + t2 = value + end + subroutine s4(t4,value) + logical*4 value + logical*4 t4 +cf2py intent(out) t4 + t4 = value + end +c subroutine s8(t8,value) +c logical*8 value +c logical*8 t8 +cf2py intent(out) t8 +c t8 = value +c end diff --git a/numpy/f2py/tests/src/return_logical/foo90.f90 b/numpy/f2py/tests/src/return_logical/foo90.f90 new file mode 100644 index 000000000..a4526468e --- /dev/null +++ b/numpy/f2py/tests/src/return_logical/foo90.f90 @@ -0,0 +1,59 @@ +module f90_return_logical + contains + function t0(value) + logical :: value + logical :: t0 + t0 = value + end function t0 + function t1(value) + logical(kind=1) :: value + logical(kind=1) :: t1 + t1 = value + end function t1 + function t2(value) + logical(kind=2) :: value + logical(kind=2) :: t2 + t2 = value + end function t2 + function t4(value) + logical(kind=4) :: value + logical(kind=4) :: t4 + t4 = value + end function t4 + function t8(value) + logical(kind=8) :: value + logical(kind=8) :: t8 + t8 = value + end function t8 + + subroutine s0(t0,value) + logical :: value + logical :: t0 +!f2py intent(out) t0 + t0 = value + end subroutine s0 + subroutine s1(t1,value) + logical(kind=1) :: value + logical(kind=1) :: t1 +!f2py intent(out) t1 + t1 = value + end subroutine s1 + subroutine s2(t2,value) + logical(kind=2) :: value + logical(kind=2) :: t2 +!f2py intent(out) t2 + t2 = value + end subroutine s2 + subroutine s4(t4,value) + logical(kind=4) :: value + logical(kind=4) :: t4 +!f2py intent(out) t4 + t4 = value + end subroutine s4 + subroutine s8(t8,value) + logical(kind=8) :: value + logical(kind=8) :: t8 +!f2py intent(out) t8 + t8 = value + end subroutine s8 +end module f90_return_logical diff --git a/numpy/f2py/tests/src/return_real/foo77.f b/numpy/f2py/tests/src/return_real/foo77.f new file mode 100644 index 000000000..bf43dbf11 --- /dev/null +++ b/numpy/f2py/tests/src/return_real/foo77.f @@ -0,0 +1,45 @@ + function t0(value) + real value + real t0 + t0 = value + end + function t4(value) + real*4 value + real*4 t4 + t4 = value + end + function t8(value) + real*8 value + real*8 t8 + t8 = value + end + function td(value) + double precision value + double precision td + td = value + end + + subroutine s0(t0,value) + real value + real t0 +cf2py intent(out) t0 + t0 = value + end + subroutine s4(t4,value) + real*4 value + real*4 t4 +cf2py intent(out) t4 + t4 = value + end + subroutine s8(t8,value) + real*8 value + real*8 t8 +cf2py intent(out) t8 + t8 = value + end + subroutine sd(td,value) + double precision value + double precision td +cf2py intent(out) td + td = value + end diff --git a/numpy/f2py/tests/src/return_real/foo90.f90 b/numpy/f2py/tests/src/return_real/foo90.f90 new file mode 100644 index 000000000..df9719980 --- /dev/null +++ b/numpy/f2py/tests/src/return_real/foo90.f90 @@ -0,0 +1,48 @@ +module f90_return_real + contains + function t0(value) + real :: value + real :: t0 + t0 = value + end function t0 + function t4(value) + real(kind=4) :: value + real(kind=4) :: t4 + t4 = value + end function t4 + function t8(value) + real(kind=8) :: value + real(kind=8) :: t8 + t8 = value + end function t8 + function td(value) + double precision :: value + double precision :: td + td = value + end function td + + subroutine s0(t0,value) + real :: value + real :: t0 +!f2py intent(out) t0 + t0 = value + end subroutine s0 + subroutine s4(t4,value) + real(kind=4) :: value + real(kind=4) :: t4 +!f2py intent(out) t4 + t4 = value + end subroutine s4 + subroutine s8(t8,value) + real(kind=8) :: value + real(kind=8) :: t8 +!f2py intent(out) t8 + t8 = value + end subroutine s8 + subroutine sd(td,value) + double precision :: value + double precision :: td +!f2py intent(out) td + td = value + end subroutine sd +end module f90_return_real diff --git a/numpy/f2py/tests/src/string/fixed_string.f90 b/numpy/f2py/tests/src/string/fixed_string.f90 new file mode 100644 index 000000000..7fd158543 --- /dev/null +++ b/numpy/f2py/tests/src/string/fixed_string.f90 @@ -0,0 +1,34 @@ +function sint(s) result(i) + implicit none + character(len=*) :: s + integer :: j, i + i = 0 + do j=len(s), 1, -1 + if (.not.((i.eq.0).and.(s(j:j).eq.' '))) then + i = i + ichar(s(j:j)) * 10 ** (j - 1) + endif + end do + return + end function sint + + function test_in_bytes4(a) result (i) + implicit none + integer :: sint + character(len=4) :: a + integer :: i + i = sint(a) + a(1:1) = 'A' + return + end function test_in_bytes4 + + function test_inout_bytes4(a) result (i) + implicit none + integer :: sint + character(len=4), intent(inout) :: a + integer :: i + if (a(1:1).ne.' ') then + a(1:1) = 'E' + endif + i = sint(a) + return + end function test_inout_bytes4 diff --git a/numpy/f2py/tests/src/string/string.f b/numpy/f2py/tests/src/string/string.f new file mode 100644 index 000000000..5210ca4dc --- /dev/null +++ b/numpy/f2py/tests/src/string/string.f @@ -0,0 +1,12 @@ +C FILE: STRING.F + SUBROUTINE FOO(A,B,C,D) + CHARACTER*5 A, B + CHARACTER*(*) C,D +Cf2py intent(in) a,c +Cf2py intent(inout) b,d + A(1:1) = 'A' + B(1:1) = 'B' + C(1:1) = 'C' + D(1:1) = 'D' + END +C END OF FILE STRING.F diff --git a/numpy/f2py/tests/test_abstract_interface.py b/numpy/f2py/tests/test_abstract_interface.py index 7aecf57fc..29e4b0647 100644 --- a/numpy/f2py/tests/test_abstract_interface.py +++ b/numpy/f2py/tests/test_abstract_interface.py @@ -5,63 +5,18 @@ from numpy.f2py import crackfortran class TestAbstractInterface(util.F2PyTest): - suffix = ".f90" + sources = [util.getpath("tests", "src", "abstract_interface", "foo.f90")] skip = ["add1", "add2"] - code = textwrap.dedent(""" - module ops_module - - abstract interface - subroutine op(x, y, z) - integer, intent(in) :: x, y - integer, intent(out) :: z - end subroutine - end interface - - contains - - subroutine foo(x, y, r1, r2) - integer, intent(in) :: x, y - integer, intent(out) :: r1, r2 - procedure (op) add1, add2 - procedure (op), pointer::p - p=>add1 - call p(x, y, r1) - p=>add2 - call p(x, y, r2) - end subroutine - end module - - subroutine add1(x, y, z) - integer, intent(in) :: x, y - integer, intent(out) :: z - z = x + y - end subroutine - - subroutine add2(x, y, z) - integer, intent(in) :: x, y - integer, intent(out) :: z - z = x + 2 * y - end subroutine - """) - def test_abstract_interface(self): assert self.module.ops_module.foo(3, 5) == (8, 13) - def test_parse_abstract_interface(self, tmp_path): + def test_parse_abstract_interface(self): # Test gh18403 - f_path = Path(tmp_path / "gh18403_mod.f90") - f_path.write_text( - textwrap.dedent("""\ - module test - abstract interface - subroutine foo() - end subroutine - end interface - end module test - """)) - mod = crackfortran.crackfortran([str(f_path)]) + fpath = util.getpath("tests", "src", "abstract_interface", + "gh18403_mod.f90") + mod = crackfortran.crackfortran([str(fpath)]) assert len(mod) == 1 assert len(mod[0]["body"]) == 1 assert mod[0]["body"][0]["block"] == "abstract interface" diff --git a/numpy/f2py/tests/test_array_from_pyobj.py b/numpy/f2py/tests/test_array_from_pyobj.py index 78569a8d6..f7c32f068 100644 --- a/numpy/f2py/tests/test_array_from_pyobj.py +++ b/numpy/f2py/tests/test_array_from_pyobj.py @@ -6,7 +6,6 @@ import pytest import numpy as np -from numpy.testing import assert_, assert_equal from numpy.core.multiarray import typeinfo from . import util @@ -188,7 +187,7 @@ class Type: self.NAME = name.upper() info = typeinfo[self.NAME] self.type_num = getattr(wrap, "NPY_" + self.NAME) - assert_equal(self.type_num, info.num) + assert self.type_num == info.num self.dtype = np.dtype(info.type) self.type = info.type self.elsize = info.bits / 8 @@ -238,24 +237,21 @@ class Array: # arr.dtypechar may be different from typ.dtypechar self.arr = wrap.call(typ.type_num, dims, intent.flags, obj) - assert_(isinstance(self.arr, np.ndarray), repr(type(self.arr))) + assert isinstance(self.arr, np.ndarray) self.arr_attr = wrap.array_attrs(self.arr) if len(dims) > 1: if self.intent.is_intent("c"): - assert_(intent.flags & wrap.F2PY_INTENT_C) - assert_( - not self.arr.flags["FORTRAN"], - repr((self.arr.flags, getattr(obj, "flags", None))), - ) - assert_(self.arr.flags["CONTIGUOUS"]) - assert_(not self.arr_attr[6] & wrap.FORTRAN) + assert (intent.flags & wrap.F2PY_INTENT_C) + assert not self.arr.flags["FORTRAN"] + assert self.arr.flags["CONTIGUOUS"] + assert (not self.arr_attr[6] & wrap.FORTRAN) else: - assert_(not intent.flags & wrap.F2PY_INTENT_C) - assert_(self.arr.flags["FORTRAN"]) - assert_(not self.arr.flags["CONTIGUOUS"]) - assert_(self.arr_attr[6] & wrap.FORTRAN) + assert (not intent.flags & wrap.F2PY_INTENT_C) + assert self.arr.flags["FORTRAN"] + assert not self.arr.flags["CONTIGUOUS"] + assert (self.arr_attr[6] & wrap.FORTRAN) if obj is None: self.pyarr = None @@ -263,71 +259,56 @@ class Array: return if intent.is_intent("cache"): - assert_(isinstance(obj, np.ndarray), repr(type(obj))) + assert isinstance(obj, np.ndarray), repr(type(obj)) self.pyarr = np.array(obj).reshape(*dims).copy() else: self.pyarr = np.array( np.array(obj, dtype=typ.dtypechar).reshape(*dims), order=self.intent.is_intent("c") and "C" or "F", ) - assert_(self.pyarr.dtype == typ, repr((self.pyarr.dtype, typ))) + assert self.pyarr.dtype == typ self.pyarr.setflags(write=self.arr.flags["WRITEABLE"]) - assert_(self.pyarr.flags["OWNDATA"], (obj, intent)) + assert self.pyarr.flags["OWNDATA"], (obj, intent) self.pyarr_attr = wrap.array_attrs(self.pyarr) if len(dims) > 1: if self.intent.is_intent("c"): - assert_(not self.pyarr.flags["FORTRAN"]) - assert_(self.pyarr.flags["CONTIGUOUS"]) - assert_(not self.pyarr_attr[6] & wrap.FORTRAN) + assert not self.pyarr.flags["FORTRAN"] + assert self.pyarr.flags["CONTIGUOUS"] + assert (not self.pyarr_attr[6] & wrap.FORTRAN) else: - assert_(self.pyarr.flags["FORTRAN"]) - assert_(not self.pyarr.flags["CONTIGUOUS"]) - assert_(self.pyarr_attr[6] & wrap.FORTRAN) + assert self.pyarr.flags["FORTRAN"] + assert not self.pyarr.flags["CONTIGUOUS"] + assert (self.pyarr_attr[6] & wrap.FORTRAN) - assert_(self.arr_attr[1] == self.pyarr_attr[1]) # nd - assert_(self.arr_attr[2] == self.pyarr_attr[2]) # dimensions + assert self.arr_attr[1] == self.pyarr_attr[1] # nd + assert self.arr_attr[2] == self.pyarr_attr[2] # dimensions if self.arr_attr[1] <= 1: - assert_( - self.arr_attr[3] == self.pyarr_attr[3], - repr(( - self.arr_attr[3], - self.pyarr_attr[3], - self.arr.tobytes(), - self.pyarr.tobytes(), - )), - ) # strides - assert_( - self.arr_attr[5][-2:] == self.pyarr_attr[5][-2:], - repr((self.arr_attr[5], self.pyarr_attr[5])), - ) # descr - assert_( - self.arr_attr[6] == self.pyarr_attr[6], - repr(( - self.arr_attr[6], - self.pyarr_attr[6], - flags2names(0 * self.arr_attr[6] - self.pyarr_attr[6]), - flags2names(self.arr_attr[6]), - intent, - )), - ) # flags + assert self.arr_attr[3] == self.pyarr_attr[3], repr(( + self.arr_attr[3], + self.pyarr_attr[3], + self.arr.tobytes(), + self.pyarr.tobytes(), + )) # strides + assert self.arr_attr[5][-2:] == self.pyarr_attr[5][-2:] # descr + assert self.arr_attr[6] == self.pyarr_attr[6], repr(( + self.arr_attr[6], + self.pyarr_attr[6], + flags2names(0 * self.arr_attr[6] - self.pyarr_attr[6]), + flags2names(self.arr_attr[6]), + intent, + )) # flags if intent.is_intent("cache"): - assert_( - self.arr_attr[5][3] >= self.type.elsize, - repr((self.arr_attr[5][3], self.type.elsize)), - ) + assert self.arr_attr[5][3] >= self.type.elsize else: - assert_( - self.arr_attr[5][3] == self.type.elsize, - repr((self.arr_attr[5][3], self.type.elsize)), - ) - assert_(self.arr_equal(self.pyarr, self.arr)) + assert self.arr_attr[5][3] == self.type.elsize + assert (self.arr_equal(self.pyarr, self.arr)) if isinstance(self.obj, np.ndarray): if typ.elsize == Type(obj.dtype).elsize: if not intent.is_intent("copy") and self.arr_attr[1] <= 1: - assert_(self.has_shared_memory()) + assert self.has_shared_memory() def arr_equal(self, arr1, arr2): if arr1.shape != arr2.shape: @@ -349,12 +330,12 @@ class Array: class TestIntent: def test_in_out(self): - assert_equal(str(intent.in_.out), "intent(in,out)") - assert_(intent.in_.c.is_intent("c")) - assert_(not intent.in_.c.is_intent_exact("c")) - assert_(intent.in_.c.is_intent_exact("c", "in")) - assert_(intent.in_.c.is_intent_exact("in", "c")) - assert_(not intent.in_.is_intent("c")) + assert str(intent.in_.out) == "intent(in,out)" + assert intent.in_.c.is_intent("c") + assert not intent.in_.c.is_intent_exact("c") + assert intent.in_.c.is_intent_exact("c", "in") + assert intent.in_.c.is_intent_exact("in", "c") + assert not intent.in_.is_intent("c") class TestSharedMemory: @@ -369,17 +350,16 @@ class TestSharedMemory: def test_in_from_2seq(self): a = self.array([2], intent.in_, self.num2seq) - assert_(not a.has_shared_memory()) + assert not a.has_shared_memory() def test_in_from_2casttype(self): for t in self.type.cast_types(): obj = np.array(self.num2seq, dtype=t.dtype) a = self.array([len(self.num2seq)], intent.in_, obj) if t.elsize == self.type.elsize: - assert_(a.has_shared_memory(), repr( - (self.type.dtype, t.dtype))) + assert a.has_shared_memory(), repr((self.type.dtype, t.dtype)) else: - assert_(not a.has_shared_memory(), repr(t.dtype)) + assert not a.has_shared_memory() @pytest.mark.parametrize("write", ["w", "ro"]) @pytest.mark.parametrize("order", ["C", "F"]) @@ -396,7 +376,7 @@ class TestSharedMemory: def test_inout_2seq(self): obj = np.array(self.num2seq, dtype=self.type.dtype) a = self.array([len(self.num2seq)], intent.inout, obj) - assert_(a.has_shared_memory()) + assert a.has_shared_memory() try: a = self.array([2], intent.in_.inout, self.num2seq) @@ -411,7 +391,7 @@ class TestSharedMemory: obj = np.array(self.num23seq, dtype=self.type.dtype, order="F") shape = (len(self.num23seq), len(self.num23seq[0])) a = self.array(shape, intent.in_.inout, obj) - assert_(a.has_shared_memory()) + assert a.has_shared_memory() obj = np.array(self.num23seq, dtype=self.type.dtype, order="C") shape = (len(self.num23seq), len(self.num23seq[0])) @@ -429,26 +409,26 @@ class TestSharedMemory: obj = np.array(self.num23seq, dtype=self.type.dtype) shape = (len(self.num23seq), len(self.num23seq[0])) a = self.array(shape, intent.in_.c.inout, obj) - assert_(a.has_shared_memory()) + assert a.has_shared_memory() def test_in_copy_from_2casttype(self): for t in self.type.cast_types(): obj = np.array(self.num2seq, dtype=t.dtype) a = self.array([len(self.num2seq)], intent.in_.copy, obj) - assert_(not a.has_shared_memory(), repr(t.dtype)) + assert not a.has_shared_memory() def test_c_in_from_23seq(self): a = self.array( [len(self.num23seq), len(self.num23seq[0])], intent.in_, self.num23seq) - assert_(not a.has_shared_memory()) + assert not a.has_shared_memory() def test_in_from_23casttype(self): for t in self.type.cast_types(): obj = np.array(self.num23seq, dtype=t.dtype) a = self.array( [len(self.num23seq), len(self.num23seq[0])], intent.in_, obj) - assert_(not a.has_shared_memory(), repr(t.dtype)) + assert not a.has_shared_memory() def test_f_in_from_23casttype(self): for t in self.type.cast_types(): @@ -456,9 +436,9 @@ class TestSharedMemory: a = self.array( [len(self.num23seq), len(self.num23seq[0])], intent.in_, obj) if t.elsize == self.type.elsize: - assert_(a.has_shared_memory(), repr(t.dtype)) + assert a.has_shared_memory() else: - assert_(not a.has_shared_memory(), repr(t.dtype)) + assert not a.has_shared_memory() def test_c_in_from_23casttype(self): for t in self.type.cast_types(): @@ -466,9 +446,9 @@ class TestSharedMemory: a = self.array( [len(self.num23seq), len(self.num23seq[0])], intent.in_.c, obj) if t.elsize == self.type.elsize: - assert_(a.has_shared_memory(), repr(t.dtype)) + assert a.has_shared_memory() else: - assert_(not a.has_shared_memory(), repr(t.dtype)) + assert not a.has_shared_memory() def test_f_copy_in_from_23casttype(self): for t in self.type.cast_types(): @@ -476,7 +456,7 @@ class TestSharedMemory: a = self.array( [len(self.num23seq), len(self.num23seq[0])], intent.in_.copy, obj) - assert_(not a.has_shared_memory(), repr(t.dtype)) + assert not a.has_shared_memory() def test_c_copy_in_from_23casttype(self): for t in self.type.cast_types(): @@ -484,7 +464,7 @@ class TestSharedMemory: a = self.array( [len(self.num23seq), len(self.num23seq[0])], intent.in_.c.copy, obj) - assert_(not a.has_shared_memory(), repr(t.dtype)) + assert not a.has_shared_memory() def test_in_cache_from_2casttype(self): for t in self.type.all_types(): @@ -493,17 +473,17 @@ class TestSharedMemory: obj = np.array(self.num2seq, dtype=t.dtype) shape = (len(self.num2seq), ) a = self.array(shape, intent.in_.c.cache, obj) - assert_(a.has_shared_memory(), repr(t.dtype)) + assert a.has_shared_memory() a = self.array(shape, intent.in_.cache, obj) - assert_(a.has_shared_memory(), repr(t.dtype)) + assert a.has_shared_memory() obj = np.array(self.num2seq, dtype=t.dtype, order="F") a = self.array(shape, intent.in_.c.cache, obj) - assert_(a.has_shared_memory(), repr(t.dtype)) + assert a.has_shared_memory() a = self.array(shape, intent.in_.cache, obj) - assert_(a.has_shared_memory(), repr(t.dtype)) + assert a.has_shared_memory(), repr(t.dtype) try: a = self.array(shape, intent.in_.cache, obj[::-1]) @@ -534,11 +514,11 @@ class TestSharedMemory: def test_cache_hidden(self): shape = (2, ) a = self.array(shape, intent.cache.hide, None) - assert_(a.arr.shape == shape) + assert a.arr.shape == shape shape = (2, 3) a = self.array(shape, intent.cache.hide, None) - assert_(a.arr.shape == shape) + assert a.arr.shape == shape shape = (-1, 3) try: @@ -554,20 +534,20 @@ class TestSharedMemory: def test_hidden(self): shape = (2, ) a = self.array(shape, intent.hide, None) - assert_(a.arr.shape == shape) - assert_(a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype))) + assert a.arr.shape == shape + assert a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype)) shape = (2, 3) a = self.array(shape, intent.hide, None) - assert_(a.arr.shape == shape) - assert_(a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype))) - assert_(a.arr.flags["FORTRAN"] and not a.arr.flags["CONTIGUOUS"]) + assert a.arr.shape == shape + assert a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype)) + assert a.arr.flags["FORTRAN"] and not a.arr.flags["CONTIGUOUS"] shape = (2, 3) a = self.array(shape, intent.c.hide, None) - assert_(a.arr.shape == shape) - assert_(a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype))) - assert_(not a.arr.flags["FORTRAN"] and a.arr.flags["CONTIGUOUS"]) + assert a.arr.shape == shape + assert a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype)) + assert not a.arr.flags["FORTRAN"] and a.arr.flags["CONTIGUOUS"] shape = (-1, 3) try: @@ -583,72 +563,66 @@ class TestSharedMemory: def test_optional_none(self): shape = (2, ) a = self.array(shape, intent.optional, None) - assert_(a.arr.shape == shape) - assert_(a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype))) + assert a.arr.shape == shape + assert a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype)) shape = (2, 3) a = self.array(shape, intent.optional, None) - assert_(a.arr.shape == shape) - assert_(a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype))) - assert_(a.arr.flags["FORTRAN"] and not a.arr.flags["CONTIGUOUS"]) + assert a.arr.shape == shape + assert a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype)) + assert a.arr.flags["FORTRAN"] and not a.arr.flags["CONTIGUOUS"] shape = (2, 3) a = self.array(shape, intent.c.optional, None) - assert_(a.arr.shape == shape) - assert_(a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype))) - assert_(not a.arr.flags["FORTRAN"] and a.arr.flags["CONTIGUOUS"]) + assert a.arr.shape == shape + assert a.arr_equal(a.arr, np.zeros(shape, dtype=self.type.dtype)) + assert not a.arr.flags["FORTRAN"] and a.arr.flags["CONTIGUOUS"] def test_optional_from_2seq(self): obj = self.num2seq shape = (len(obj), ) a = self.array(shape, intent.optional, obj) - assert_(a.arr.shape == shape) - assert_(not a.has_shared_memory()) + assert a.arr.shape == shape + assert not a.has_shared_memory() def test_optional_from_23seq(self): obj = self.num23seq shape = (len(obj), len(obj[0])) a = self.array(shape, intent.optional, obj) - assert_(a.arr.shape == shape) - assert_(not a.has_shared_memory()) + assert a.arr.shape == shape + assert not a.has_shared_memory() a = self.array(shape, intent.optional.c, obj) - assert_(a.arr.shape == shape) - assert_(not a.has_shared_memory()) + assert a.arr.shape == shape + assert not a.has_shared_memory() def test_inplace(self): obj = np.array(self.num23seq, dtype=self.type.dtype) - assert_(not obj.flags["FORTRAN"] and obj.flags["CONTIGUOUS"]) + assert not obj.flags["FORTRAN"] and obj.flags["CONTIGUOUS"] shape = obj.shape a = self.array(shape, intent.inplace, obj) - assert_(obj[1][2] == a.arr[1][2], repr((obj, a.arr))) + assert obj[1][2] == a.arr[1][2], repr((obj, a.arr)) a.arr[1][2] = 54 - assert_( - obj[1][2] == a.arr[1][2] == np.array(54, dtype=self.type.dtype), - repr((obj, a.arr)), - ) - assert_(a.arr is obj) - assert_(obj.flags["FORTRAN"]) # obj attributes are changed inplace! - assert_(not obj.flags["CONTIGUOUS"]) + assert obj[1][2] == a.arr[1][2] == np.array(54, dtype=self.type.dtype) + assert a.arr is obj + assert obj.flags["FORTRAN"] # obj attributes are changed inplace! + assert not obj.flags["CONTIGUOUS"] def test_inplace_from_casttype(self): for t in self.type.cast_types(): if t is self.type: continue obj = np.array(self.num23seq, dtype=t.dtype) - assert_(obj.dtype.type == t.type) - assert_(obj.dtype.type is not self.type.type) - assert_(not obj.flags["FORTRAN"] and obj.flags["CONTIGUOUS"]) + assert obj.dtype.type == t.type + assert obj.dtype.type is not self.type.type + assert not obj.flags["FORTRAN"] and obj.flags["CONTIGUOUS"] shape = obj.shape a = self.array(shape, intent.inplace, obj) - assert_(obj[1][2] == a.arr[1][2], repr((obj, a.arr))) + assert obj[1][2] == a.arr[1][2], repr((obj, a.arr)) a.arr[1][2] = 54 - assert_( - obj[1][2] == a.arr[1][2] == np.array(54, - dtype=self.type.dtype), - repr((obj, a.arr)), - ) - assert_(a.arr is obj) - assert_(obj.flags["FORTRAN"]) # obj attributes changed inplace! - assert_(not obj.flags["CONTIGUOUS"]) - assert_(obj.dtype.type is self.type.type) # obj changed inplace! + assert obj[1][2] == a.arr[1][2] == np.array(54, + dtype=self.type.dtype) + assert a.arr is obj + assert obj.flags["FORTRAN"] # obj attributes changed inplace! + assert not obj.flags["CONTIGUOUS"] + assert obj.dtype.type is self.type.type # obj changed inplace! diff --git a/numpy/f2py/tests/test_assumed_shape.py b/numpy/f2py/tests/test_assumed_shape.py index 0d226cb44..e546c379b 100644 --- a/numpy/f2py/tests/test_assumed_shape.py +++ b/numpy/f2py/tests/test_assumed_shape.py @@ -2,7 +2,6 @@ import os import pytest import tempfile -from numpy.testing import assert_ from . import util @@ -18,16 +17,16 @@ class TestAssumedShapeSumExample(util.F2PyTest): @pytest.mark.slow def test_all(self): r = self.module.fsum([1, 2]) - assert_(r == 3, repr(r)) + assert r == 3 r = self.module.sum([1, 2]) - assert_(r == 3, repr(r)) + assert r == 3 r = self.module.sum_with_use([1, 2]) - assert_(r == 3, repr(r)) + assert r == 3 r = self.module.mod.sum([1, 2]) - assert_(r == 3, repr(r)) + assert r == 3 r = self.module.mod.fsum([1, 2]) - assert_(r == 3, repr(r)) + assert r == 3 class TestF2cmapOption(TestAssumedShapeSumExample): diff --git a/numpy/f2py/tests/test_block_docstring.py b/numpy/f2py/tests/test_block_docstring.py index 36446fe64..e0eacc032 100644 --- a/numpy/f2py/tests/test_block_docstring.py +++ b/numpy/f2py/tests/test_block_docstring.py @@ -2,18 +2,11 @@ import sys import pytest from . import util -from numpy.testing import assert_equal, IS_PYPY +from numpy.testing import IS_PYPY class TestBlockDocString(util.F2PyTest): - code = """ - SUBROUTINE FOO() - INTEGER BAR(2, 3) - - COMMON /BLOCK/ BAR - RETURN - END - """ + sources = [util.getpath("tests", "src", "block_docstring", "foo.f")] @pytest.mark.skipif(sys.platform == "win32", reason="Fails with MinGW64 Gfortran (Issue #9673)") @@ -21,4 +14,4 @@ class TestBlockDocString(util.F2PyTest): reason="PyPy cannot modify tp_doc after PyType_Ready") def test_block_docstring(self): expected = "bar : 'i'-array(2,3)\n" - assert_equal(self.module.block.__doc__, expected) + assert self.module.block.__doc__ == expected diff --git a/numpy/f2py/tests/test_callback.py b/numpy/f2py/tests/test_callback.py index 8682afe05..4e91430fd 100644 --- a/numpy/f2py/tests/test_callback.py +++ b/numpy/f2py/tests/test_callback.py @@ -7,75 +7,12 @@ import traceback import time import numpy as np -from numpy.testing import assert_, assert_equal, IS_PYPY +from numpy.testing import IS_PYPY from . import util class TestF77Callback(util.F2PyTest): - code = """ - subroutine t(fun,a) - integer a -cf2py intent(out) a - external fun - call fun(a) - end - - subroutine func(a) -cf2py intent(in,out) a - integer a - a = a + 11 - end - - subroutine func0(a) -cf2py intent(out) a - integer a - a = 11 - end - - subroutine t2(a) -cf2py intent(callback) fun - integer a -cf2py intent(out) a - external fun - call fun(a) - end - - subroutine string_callback(callback, a) - external callback - double precision callback - double precision a - character*1 r -cf2py intent(out) a - r = 'r' - a = callback(r) - end - - subroutine string_callback_array(callback, cu, lencu, a) - external callback - integer callback - integer lencu - character*8 cu(lencu) - integer a -cf2py intent(out) a - - a = callback(cu, lencu) - end - - subroutine hidden_callback(a, r) - external global_f -cf2py intent(callback, hide) global_f - integer a, r, global_f -cf2py intent(out) r - r = global_f(a) - end - - subroutine hidden_callback2(a, r) - external global_f - integer a, r, global_f -cf2py intent(out) r - r = global_f(a) - end - """ + sources = [util.getpath("tests", "src", "callback", "foo.f")] @pytest.mark.parametrize("name", "t,t2".split(",")) def test_all(self, name): @@ -110,29 +47,29 @@ cf2py intent(out) r Return objects: a : int """) - assert_equal(self.module.t.__doc__, expected) + assert self.module.t.__doc__ == expected def check_function(self, name): t = getattr(self.module, name) r = t(lambda: 4) - assert_(r == 4, repr(r)) + assert r == 4 r = t(lambda a: 5, fun_extra_args=(6, )) - assert_(r == 5, repr(r)) + assert r == 5 r = t(lambda a: a, fun_extra_args=(6, )) - assert_(r == 6, repr(r)) + assert r == 6 r = t(lambda a: 5 + a, fun_extra_args=(7, )) - assert_(r == 12, repr(r)) + assert r == 12 r = t(lambda a: math.degrees(a), fun_extra_args=(math.pi, )) - assert_(r == 180, repr(r)) + assert r == 180 r = t(math.degrees, fun_extra_args=(math.pi, )) - assert_(r == 180, repr(r)) + assert r == 180 r = t(self.module.func, fun_extra_args=(6, )) - assert_(r == 17, repr(r)) + assert r == 17 r = t(self.module.func0) - assert_(r == 11, repr(r)) + assert r == 11 r = t(self.module.func0._cpointer) - assert_(r == 11, repr(r)) + assert r == 11 class A: def __call__(self): @@ -143,9 +80,9 @@ cf2py intent(out) r a = A() r = t(a) - assert_(r == 7, repr(r)) + assert r == 7 r = t(a.mth) - assert_(r == 9, repr(r)) + assert r == 9 @pytest.mark.skipif(sys.platform == "win32", reason="Fails with MinGW64 Gfortran (Issue #9673)") @@ -158,7 +95,7 @@ cf2py intent(out) r f = getattr(self.module, "string_callback") r = f(callback) - assert_(r == 0, repr(r)) + assert r == 0 @pytest.mark.skipif(sys.platform == "win32", reason="Fails with MinGW64 Gfortran (Issue #9673)") @@ -177,7 +114,7 @@ cf2py intent(out) r f = getattr(self.module, "string_callback_array") res = f(callback, cu, len(cu)) - assert_(res == 0, repr(res)) + assert res == 0 def test_threadsafety(self): # Segfaults if the callback handling is not threadsafe @@ -191,7 +128,7 @@ cf2py intent(out) r # Check reentrancy r = self.module.t(lambda: 123) - assert_(r == 123) + assert r == 123 return 42 @@ -199,7 +136,7 @@ cf2py intent(out) r try: for j in range(50): r = self.module.t(cb) - assert_(r == 42) + assert r == 42 self.check_function(name) except Exception: errors.append(traceback.format_exc()) @@ -223,34 +160,34 @@ cf2py intent(out) r try: self.module.hidden_callback(2) except Exception as msg: - assert_(str(msg).startswith("Callback global_f not defined")) + assert str(msg).startswith("Callback global_f not defined") try: self.module.hidden_callback2(2) except Exception as msg: - assert_(str(msg).startswith("cb: Callback global_f not defined")) + assert str(msg).startswith("cb: Callback global_f not defined") self.module.global_f = lambda x: x + 1 r = self.module.hidden_callback(2) - assert_(r == 3) + assert r == 3 self.module.global_f = lambda x: x + 2 r = self.module.hidden_callback(2) - assert_(r == 4) + assert r == 4 del self.module.global_f try: self.module.hidden_callback(2) except Exception as msg: - assert_(str(msg).startswith("Callback global_f not defined")) + assert str(msg).startswith("Callback global_f not defined") self.module.global_f = lambda x=0: x + 3 r = self.module.hidden_callback(2) - assert_(r == 5) + assert r == 5 # reproducer of gh18341 r = self.module.hidden_callback2(2) - assert_(r == 3) + assert r == 3 class TestF77CallbackPythonTLS(TestF77Callback): @@ -263,18 +200,7 @@ class TestF77CallbackPythonTLS(TestF77Callback): class TestF90Callback(util.F2PyTest): - - suffix = ".f90" - - code = textwrap.dedent(""" - function gh17797(f, y) result(r) - external f - integer(8) :: r, f - integer(8), dimension(:) :: y - r = f(0) - r = r + sum(y) - end function gh17797 - """) + sources = [util.getpath("tests", "src", "callback", "gh17797.f90")] def test_gh17797(self): def incr(x): @@ -291,28 +217,7 @@ class TestGH18335(util.F2PyTest): implemented as a separate test class. Do not extend this test with other tests! """ - - suffix = ".f90" - - code = textwrap.dedent(""" - ! When gh18335_workaround is defined as an extension, - ! the issue cannot be reproduced. - !subroutine gh18335_workaround(f, y) - ! implicit none - ! external f - ! integer(kind=1) :: y(1) - ! call f(y) - !end subroutine gh18335_workaround - - function gh18335(f) result (r) - implicit none - external f - integer(kind=1) :: y(1), r - y(1) = 123 - call f(y) - r = y(1) - end function gh18335 - """) + sources = [util.getpath("tests", "src", "callback", "gh18335.f90")] def test_gh18335(self): def foo(x): diff --git a/numpy/f2py/tests/test_common.py b/numpy/f2py/tests/test_common.py index 056ae5ee8..8a4b221ef 100644 --- a/numpy/f2py/tests/test_common.py +++ b/numpy/f2py/tests/test_common.py @@ -5,8 +5,6 @@ import pytest import numpy as np from . import util -from numpy.testing import assert_array_equal - class TestCommonBlock(util.F2PyTest): sources = [util.getpath("tests", "src", "common", "block.f")] @@ -15,8 +13,6 @@ class TestCommonBlock(util.F2PyTest): reason="Fails with MinGW64 Gfortran (Issue #9673)") def test_common_block(self): self.module.initcb() - assert_array_equal(self.module.block.long_bn, - np.array(1.0, dtype=np.float64)) - assert_array_equal(self.module.block.string_bn, - np.array("2", dtype="|S1")) - assert_array_equal(self.module.block.ok, np.array(3, dtype=np.int32)) + assert self.module.block.long_bn == np.array(1.0, dtype=np.float64) + assert self.module.block.string_bn == np.array("2", dtype="|S1") + assert self.module.block.ok == np.array(3, dtype=np.int32) diff --git a/numpy/f2py/tests/test_compile_function.py b/numpy/f2py/tests/test_compile_function.py index e92362d82..3c16f3198 100644 --- a/numpy/f2py/tests/test_compile_function.py +++ b/numpy/f2py/tests/test_compile_function.py @@ -9,7 +9,6 @@ import pytest import numpy.f2py -from numpy.testing import assert_equal from . import util @@ -60,7 +59,7 @@ def test_f2py_init_compile(extra_args): source_fn=source_fn) # check for compile success return value - assert_equal(ret_val, 0) + assert ret_val == 0 # we are not currently able to import the Python-Fortran # interface module on Windows / Appveyor, even though we do get @@ -71,7 +70,7 @@ def test_f2py_init_compile(extra_args): # result of the sum operation return_check = import_module(modname) calc_result = return_check.foo() - assert_equal(calc_result, 15) + assert calc_result == 15 # Removal from sys.modules, is not as such necessary. Even with # removal, the module (dict) stays alive. del sys.modules[modname] @@ -81,7 +80,7 @@ def test_f2py_init_compile_failure(): # verify an appropriate integer status value returned by # f2py.compile() when invalid Fortran is provided ret_val = numpy.f2py.compile(b"invalid") - assert_equal(ret_val, 1) + assert ret_val == 1 def test_f2py_init_compile_bad_cmd(): @@ -97,7 +96,7 @@ def test_f2py_init_compile_bad_cmd(): # the OSError should take precedence over invalid Fortran ret_val = numpy.f2py.compile(b"invalid") - assert_equal(ret_val, 127) + assert ret_val == 127 finally: sys.executable = temp @@ -115,4 +114,4 @@ def test_compile_from_strings(tmpdir, fsource): ret_val = numpy.f2py.compile(fsource, modulename="test_compile_from_strings", extension=".f90") - assert_equal(ret_val, 0) + assert ret_val == 0 diff --git a/numpy/f2py/tests/test_crackfortran.py b/numpy/f2py/tests/test_crackfortran.py index 41d9840ed..0b47264ad 100644 --- a/numpy/f2py/tests/test_crackfortran.py +++ b/numpy/f2py/tests/test_crackfortran.py @@ -1,6 +1,5 @@ import pytest import numpy as np -from numpy.testing import assert_array_equal, assert_equal from numpy.f2py.crackfortran import markinnerspaces from . import util from numpy.f2py import crackfortran @@ -10,53 +9,22 @@ import textwrap class TestNoSpace(util.F2PyTest): # issue gh-15035: add handling for endsubroutine, endfunction with no space # between "end" and the block name - code = """ - subroutine subb(k) - real(8), intent(inout) :: k(:) - k=k+1 - endsubroutine - - subroutine subc(w,k) - real(8), intent(in) :: w(:) - real(8), intent(out) :: k(size(w)) - k=w+1 - endsubroutine - - function t0(value) - character value - character t0 - t0 = value - endfunction - """ + sources = [util.getpath("tests", "src", "crackfortran", "gh15035.f")] def test_module(self): k = np.array([1, 2, 3], dtype=np.float64) w = np.array([1, 2, 3], dtype=np.float64) self.module.subb(k) - assert_array_equal(k, w + 1) + assert np.allclose(k, w + 1) self.module.subc([w, k]) - assert_array_equal(k, w + 1) + assert np.allclose(k, w + 1) assert self.module.t0(23) == b"2" class TestPublicPrivate: - def test_defaultPrivate(self, tmp_path): - f_path = tmp_path / "mod.f90" - f_path.write_text( - textwrap.dedent("""\ - module foo - private - integer :: a - public :: setA - integer :: b - contains - subroutine setA(v) - integer, intent(in) :: v - a = v - end subroutine setA - end module foo - """)) - mod = crackfortran.crackfortran([str(f_path)]) + def test_defaultPrivate(self): + fpath = util.getpath("tests", "src", "crackfortran", "privatemod.f90") + mod = crackfortran.crackfortran([str(fpath)]) assert len(mod) == 1 mod = mod[0] assert "private" in mod["vars"]["a"]["attrspec"] @@ -67,22 +35,8 @@ class TestPublicPrivate: assert "public" in mod["vars"]["seta"]["attrspec"] def test_defaultPublic(self, tmp_path): - f_path = tmp_path / "mod.f90" - with f_path.open("w") as ff: - ff.write( - textwrap.dedent("""\ - module foo - public - integer, private :: a - public :: setA - contains - subroutine setA(v) - integer, intent(in) :: v - a = v - end subroutine setA - end module foo - """)) - mod = crackfortran.crackfortran([str(f_path)]) + fpath = util.getpath("tests", "src", "crackfortran", "publicmod.f90") + mod = crackfortran.crackfortran([str(fpath)]) assert len(mod) == 1 mod = mod[0] assert "private" in mod["vars"]["a"]["attrspec"] @@ -93,20 +47,7 @@ class TestPublicPrivate: class TestExternal(util.F2PyTest): # issue gh-17859: add external attribute support - code = """ - integer(8) function external_as_statement(fcn) - implicit none - external fcn - integer(8) :: fcn - external_as_statement = fcn(0) - end - - integer(8) function external_as_attribute(fcn) - implicit none - integer(8), external :: fcn - external_as_attribute = fcn(0) - end - """ + sources = [util.getpath("tests", "src", "crackfortran", "gh17859.f")] def test_external_as_statement(self): def incr(x): @@ -124,24 +65,8 @@ class TestExternal(util.F2PyTest): class TestCrackFortran(util.F2PyTest): - - suffix = ".f90" - - code = textwrap.dedent(""" - subroutine gh2848( & - ! first 2 parameters - par1, par2,& - ! last 2 parameters - par3, par4) - - integer, intent(in) :: par1, par2 - integer, intent(out) :: par3, par4 - - par3 = par1 - par4 = par2 - - end subroutine gh2848 - """) + # gh-2848: commented lines between parameters in subroutine parameter lists + sources = [util.getpath("tests", "src", "crackfortran", "gh2848.f90")] def test_gh2848(self): r = self.module.gh2848(1, 2) @@ -149,26 +74,24 @@ class TestCrackFortran(util.F2PyTest): class TestMarkinnerspaces: - # issue #14118: markinnerspaces does not handle multiple quotations + # gh-14118: markinnerspaces does not handle multiple quotations def test_do_not_touch_normal_spaces(self): test_list = ["a ", " a", "a b c", "'abcdefghij'"] for i in test_list: - assert_equal(markinnerspaces(i), i) + assert markinnerspaces(i) == i def test_one_relevant_space(self): - assert_equal(markinnerspaces("a 'b c' \\' \\'"), "a 'b@_@c' \\' \\'") - assert_equal(markinnerspaces(r'a "b c" \" \"'), r'a "b@_@c" \" \"') + assert markinnerspaces("a 'b c' \\' \\'") == "a 'b@_@c' \\' \\'" + assert markinnerspaces(r'a "b c" \" \"') == r'a "b@_@c" \" \"' def test_ignore_inner_quotes(self): - assert_equal(markinnerspaces("a 'b c\" \" d' e"), - "a 'b@_@c\"@_@\"@_@d' e") - assert_equal(markinnerspaces("a \"b c' ' d\" e"), - "a \"b@_@c'@_@'@_@d\" e") + assert markinnerspaces("a 'b c\" \" d' e") == "a 'b@_@c\"@_@\"@_@d' e" + assert markinnerspaces("a \"b c' ' d\" e") == "a \"b@_@c'@_@'@_@d\" e" def test_multiple_relevant_spaces(self): - assert_equal(markinnerspaces("a 'b c' 'd e'"), "a 'b@_@c' 'd@_@e'") - assert_equal(markinnerspaces(r'a "b c" "d e"'), r'a "b@_@c" "d@_@e"') + assert markinnerspaces("a 'b c' 'd e'") == "a 'b@_@c' 'd@_@e'" + assert markinnerspaces(r'a "b c" "d e"') == r'a "b@_@c" "d@_@e"' class TestDimSpec(util.F2PyTest): @@ -273,17 +196,7 @@ class TestDimSpec(util.F2PyTest): class TestModuleDeclaration: def test_dependencies(self, tmp_path): - f_path = tmp_path / "mod.f90" - with f_path.open("w") as ff: - ff.write( - textwrap.dedent("""\ - module foo - type bar - character(len = 4) :: text - end type bar - type(bar), parameter :: abar = bar('abar') - end module foo - """)) - mod = crackfortran.crackfortran([str(f_path)]) + fpath = util.getpath("tests", "src", "crackfortran", "foo_deps.f90") + mod = crackfortran.crackfortran([str(fpath)]) assert len(mod) == 1 assert mod[0]["vars"]["abar"]["="] == "bar('abar')" diff --git a/numpy/f2py/tests/test_kind.py b/numpy/f2py/tests/test_kind.py index 78a11fc6c..f0cb61fb6 100644 --- a/numpy/f2py/tests/test_kind.py +++ b/numpy/f2py/tests/test_kind.py @@ -1,7 +1,6 @@ import os import pytest -from numpy.testing import assert_ from numpy.f2py.crackfortran import ( _selected_int_kind_func as selected_int_kind, _selected_real_kind_func as selected_real_kind, @@ -12,21 +11,16 @@ from . import util class TestKind(util.F2PyTest): sources = [util.getpath("tests", "src", "kind", "foo.f90")] - @pytest.mark.slow def test_all(self): selectedrealkind = self.module.selectedrealkind selectedintkind = self.module.selectedintkind for i in range(40): - assert_( - selectedintkind(i) in [selected_int_kind(i), -1], - "selectedintkind(%s): expected %r but got %r" % - (i, selected_int_kind(i), selectedintkind(i)), - ) + assert selectedintkind(i) == selected_int_kind( + i + ), f"selectedintkind({i}): expected {selected_int_kind(i)!r} but got {selectedintkind(i)!r}" for i in range(20): - assert_( - selectedrealkind(i) in [selected_real_kind(i), -1], - "selectedrealkind(%s): expected %r but got %r" % - (i, selected_real_kind(i), selectedrealkind(i)), - ) + assert selectedrealkind(i) == selected_real_kind( + i + ), f"selectedrealkind({i}): expected {selected_real_kind(i)!r} but got {selectedrealkind(i)!r}" diff --git a/numpy/f2py/tests/test_mixed.py b/numpy/f2py/tests/test_mixed.py index 95444bea5..80653b7d2 100644 --- a/numpy/f2py/tests/test_mixed.py +++ b/numpy/f2py/tests/test_mixed.py @@ -2,7 +2,7 @@ import os import textwrap import pytest -from numpy.testing import assert_, assert_equal, IS_PYPY +from numpy.testing import IS_PYPY from . import util @@ -14,9 +14,9 @@ class TestMixed(util.F2PyTest): ] def test_all(self): - assert_(self.module.bar11() == 11) - assert_(self.module.foo_fixed.bar12() == 12) - assert_(self.module.foo_free.bar13() == 13) + assert self.module.bar11() == 11 + assert self.module.foo_fixed.bar12() == 12 + assert self.module.foo_free.bar13() == 13 @pytest.mark.xfail(IS_PYPY, reason="PyPy cannot modify tp_doc after PyType_Ready") @@ -30,4 +30,4 @@ class TestMixed(util.F2PyTest): ------- a : int """) - assert_equal(self.module.bar11.__doc__, expected) + assert self.module.bar11.__doc__ == expected diff --git a/numpy/f2py/tests/test_module_doc.py b/numpy/f2py/tests/test_module_doc.py index b66cff000..28822d405 100644 --- a/numpy/f2py/tests/test_module_doc.py +++ b/numpy/f2py/tests/test_module_doc.py @@ -4,7 +4,7 @@ import pytest import textwrap from . import util -from numpy.testing import assert_equal, IS_PYPY +from numpy.testing import IS_PYPY class TestModuleDocString(util.F2PyTest): @@ -18,13 +18,10 @@ class TestModuleDocString(util.F2PyTest): @pytest.mark.xfail(IS_PYPY, reason="PyPy cannot modify tp_doc after PyType_Ready") def test_module_docstring(self): - assert_equal( - self.module.mod.__doc__, - textwrap.dedent("""\ + assert self.module.mod.__doc__ == textwrap.dedent("""\ i : 'i'-scalar x : 'i'-array(4) a : 'f'-array(2,3) b : 'f'-array(-1,-1), not allocated\x00 foo()\n - Wrapper for ``foo``.\n\n"""), - ) + Wrapper for ``foo``.\n\n""") diff --git a/numpy/f2py/tests/test_parameter.py b/numpy/f2py/tests/test_parameter.py index 4ea102e84..2f620eaa0 100644 --- a/numpy/f2py/tests/test_parameter.py +++ b/numpy/f2py/tests/test_parameter.py @@ -2,7 +2,6 @@ import os import pytest import numpy as np -from numpy.testing import assert_raises, assert_equal from . import util @@ -21,93 +20,93 @@ class TestParameters(util.F2PyTest): def test_constant_real_single(self): # non-contiguous should raise error x = np.arange(6, dtype=np.float32)[::2] - assert_raises(ValueError, self.module.foo_single, x) + pytest.raises(ValueError, self.module.foo_single, x) # check values with contiguous array x = np.arange(3, dtype=np.float32) self.module.foo_single(x) - assert_equal(x, [0 + 1 + 2 * 3, 1, 2]) + assert np.allclose(x, [0 + 1 + 2 * 3, 1, 2]) @pytest.mark.slow def test_constant_real_double(self): # non-contiguous should raise error x = np.arange(6, dtype=np.float64)[::2] - assert_raises(ValueError, self.module.foo_double, x) + pytest.raises(ValueError, self.module.foo_double, x) # check values with contiguous array x = np.arange(3, dtype=np.float64) self.module.foo_double(x) - assert_equal(x, [0 + 1 + 2 * 3, 1, 2]) + assert np.allclose(x, [0 + 1 + 2 * 3, 1, 2]) @pytest.mark.slow def test_constant_compound_int(self): # non-contiguous should raise error x = np.arange(6, dtype=np.int32)[::2] - assert_raises(ValueError, self.module.foo_compound_int, x) + pytest.raises(ValueError, self.module.foo_compound_int, x) # check values with contiguous array x = np.arange(3, dtype=np.int32) self.module.foo_compound_int(x) - assert_equal(x, [0 + 1 + 2 * 6, 1, 2]) + assert np.allclose(x, [0 + 1 + 2 * 6, 1, 2]) @pytest.mark.slow def test_constant_non_compound_int(self): # check values x = np.arange(4, dtype=np.int32) self.module.foo_non_compound_int(x) - assert_equal(x, [0 + 1 + 2 + 3 * 4, 1, 2, 3]) + assert np.allclose(x, [0 + 1 + 2 + 3 * 4, 1, 2, 3]) @pytest.mark.slow def test_constant_integer_int(self): # non-contiguous should raise error x = np.arange(6, dtype=np.int32)[::2] - assert_raises(ValueError, self.module.foo_int, x) + pytest.raises(ValueError, self.module.foo_int, x) # check values with contiguous array x = np.arange(3, dtype=np.int32) self.module.foo_int(x) - assert_equal(x, [0 + 1 + 2 * 3, 1, 2]) + assert np.allclose(x, [0 + 1 + 2 * 3, 1, 2]) @pytest.mark.slow def test_constant_integer_long(self): # non-contiguous should raise error x = np.arange(6, dtype=np.int64)[::2] - assert_raises(ValueError, self.module.foo_long, x) + pytest.raises(ValueError, self.module.foo_long, x) # check values with contiguous array x = np.arange(3, dtype=np.int64) self.module.foo_long(x) - assert_equal(x, [0 + 1 + 2 * 3, 1, 2]) + assert np.allclose(x, [0 + 1 + 2 * 3, 1, 2]) @pytest.mark.slow def test_constant_both(self): # non-contiguous should raise error x = np.arange(6, dtype=np.float64)[::2] - assert_raises(ValueError, self.module.foo, x) + pytest.raises(ValueError, self.module.foo, x) # check values with contiguous array x = np.arange(3, dtype=np.float64) self.module.foo(x) - assert_equal(x, [0 + 1 * 3 * 3 + 2 * 3 * 3, 1 * 3, 2 * 3]) + assert np.allclose(x, [0 + 1 * 3 * 3 + 2 * 3 * 3, 1 * 3, 2 * 3]) @pytest.mark.slow def test_constant_no(self): # non-contiguous should raise error x = np.arange(6, dtype=np.float64)[::2] - assert_raises(ValueError, self.module.foo_no, x) + pytest.raises(ValueError, self.module.foo_no, x) # check values with contiguous array x = np.arange(3, dtype=np.float64) self.module.foo_no(x) - assert_equal(x, [0 + 1 * 3 * 3 + 2 * 3 * 3, 1 * 3, 2 * 3]) + assert np.allclose(x, [0 + 1 * 3 * 3 + 2 * 3 * 3, 1 * 3, 2 * 3]) @pytest.mark.slow def test_constant_sum(self): # non-contiguous should raise error x = np.arange(6, dtype=np.float64)[::2] - assert_raises(ValueError, self.module.foo_sum, x) + pytest.raises(ValueError, self.module.foo_sum, x) # check values with contiguous array x = np.arange(3, dtype=np.float64) self.module.foo_sum(x) - assert_equal(x, [0 + 1 * 3 * 3 + 2 * 3 * 3, 1 * 3, 2 * 3]) + assert np.allclose(x, [0 + 1 * 3 * 3 + 2 * 3 * 3, 1 * 3, 2 * 3]) diff --git a/numpy/f2py/tests/test_quoted_character.py b/numpy/f2py/tests/test_quoted_character.py index efb9ad08b..82671cd8e 100644 --- a/numpy/f2py/tests/test_quoted_character.py +++ b/numpy/f2py/tests/test_quoted_character.py @@ -4,29 +4,13 @@ import sys import pytest -from numpy.testing import assert_equal from . import util class TestQuotedCharacter(util.F2PyTest): - code = """ - SUBROUTINE FOO(OUT1, OUT2, OUT3, OUT4, OUT5, OUT6) - CHARACTER SINGLE, DOUBLE, SEMICOL, EXCLA, OPENPAR, CLOSEPAR - PARAMETER (SINGLE="'", DOUBLE='"', SEMICOL=';', EXCLA="!", - 1 OPENPAR="(", CLOSEPAR=")") - CHARACTER OUT1, OUT2, OUT3, OUT4, OUT5, OUT6 -Cf2py intent(out) OUT1, OUT2, OUT3, OUT4, OUT5, OUT6 - OUT1 = SINGLE - OUT2 = DOUBLE - OUT3 = SEMICOL - OUT4 = EXCLA - OUT5 = OPENPAR - OUT6 = CLOSEPAR - RETURN - END - """ + sources = [util.getpath("tests", "src", "quoted_character", "foo.f")] @pytest.mark.skipif(sys.platform == "win32", reason="Fails with MinGW64 Gfortran (Issue #9673)") def test_quoted_character(self): - assert_equal(self.module.foo(), (b"'", b'"', b";", b"!", b"(", b")")) + assert self.module.foo() == (b"'", b'"', b";", b"!", b"(", b")") diff --git a/numpy/f2py/tests/test_regression.py b/numpy/f2py/tests/test_regression.py index 682b9e98c..40b9d4327 100644 --- a/numpy/f2py/tests/test_regression.py +++ b/numpy/f2py/tests/test_regression.py @@ -2,7 +2,6 @@ import os import pytest import numpy as np -from numpy.testing import assert_, assert_raises, assert_equal, assert_string_equal from . import util @@ -15,12 +14,12 @@ class TestIntentInOut(util.F2PyTest): def test_inout(self): # non-contiguous should raise error x = np.arange(6, dtype=np.float32)[::2] - assert_raises(ValueError, self.module.foo, x) + pytest.raises(ValueError, self.module.foo, x) # check values with contiguous array x = np.arange(3, dtype=np.float32) self.module.foo(x) - assert_equal(x, [3, 1, 2]) + assert np.allclose(x, [3, 1, 2]) class TestNumpyVersionAttribute(util.F2PyTest): @@ -32,19 +31,13 @@ class TestNumpyVersionAttribute(util.F2PyTest): def test_numpy_version_attribute(self): # Check that self.module has an attribute named "__f2py_numpy_version__" - assert_( - hasattr(self.module, "__f2py_numpy_version__"), - msg="Fortran module does not have __f2py_numpy_version__", - ) + assert hasattr(self.module, "__f2py_numpy_version__") # Check that the attribute __f2py_numpy_version__ is a string - assert_( - isinstance(self.module.__f2py_numpy_version__, str), - msg="__f2py_numpy_version__ is not a string", - ) + assert isinstance(self.module.__f2py_numpy_version__, str) # Check that __f2py_numpy_version__ has the value numpy.__version__ - assert_string_equal(np.__version__, self.module.__f2py_numpy_version__) + assert np.__version__ == self.module.__f2py_numpy_version__ def test_include_path(): diff --git a/numpy/f2py/tests/test_return_character.py b/numpy/f2py/tests/test_return_character.py index 3c3a43e1b..21055faef 100644 --- a/numpy/f2py/tests/test_return_character.py +++ b/numpy/f2py/tests/test_return_character.py @@ -1,7 +1,6 @@ import pytest from numpy import array -from numpy.testing import assert_ from . import util import platform @@ -11,135 +10,36 @@ IS_S390X = platform.machine() == "s390x" class TestReturnCharacter(util.F2PyTest): def check_function(self, t, tname): if tname in ["t0", "t1", "s0", "s1"]: - assert_(t(23) == b"2") + assert t(23) == b"2" r = t("ab") - assert_(r == b"a", repr(r)) + assert r == b"a" r = t(array("ab")) - assert_(r == b"a", repr(r)) + assert r == b"a" r = t(array(77, "u1")) - assert_(r == b"M", repr(r)) - # assert_(_raises(ValueError, t, array([77,87]))) - # assert_(_raises(ValueError, t, array(77))) + assert r == b"M" elif tname in ["ts", "ss"]: - assert_(t(23) == b"23", repr(t(23))) - assert_(t("123456789abcdef") == b"123456789a") + assert t(23) == b"23" + assert t("123456789abcdef") == b"123456789a" elif tname in ["t5", "s5"]: - assert_(t(23) == b"23", repr(t(23))) - assert_(t("ab") == b"ab", repr(t("ab"))) - assert_(t("123456789abcdef") == b"12345") + assert t(23) == b"23" + assert t("ab") == b"ab" + assert t("123456789abcdef") == b"12345" else: raise NotImplementedError -class TestF77ReturnCharacter(TestReturnCharacter): - code = """ - function t0(value) - character value - character t0 - t0 = value - end - function t1(value) - character*1 value - character*1 t1 - t1 = value - end - function t5(value) - character*5 value - character*5 t5 - t5 = value - end - function ts(value) - character*(*) value - character*(*) ts - ts = value - end - - subroutine s0(t0,value) - character value - character t0 -cf2py intent(out) t0 - t0 = value - end - subroutine s1(t1,value) - character*1 value - character*1 t1 -cf2py intent(out) t1 - t1 = value - end - subroutine s5(t5,value) - character*5 value - character*5 t5 -cf2py intent(out) t5 - t5 = value - end - subroutine ss(ts,value) - character*(*) value - character*10 ts -cf2py intent(out) ts - ts = value - end - """ +class TestFReturnCharacter(TestReturnCharacter): + sources = [ + util.getpath("tests", "src", "return_character", "foo77.f"), + util.getpath("tests", "src", "return_character", "foo90.f90"), + ] @pytest.mark.xfail(IS_S390X, reason="callback returns ' '") @pytest.mark.parametrize("name", "t0,t1,t5,s0,s1,s5,ss".split(",")) - def test_all(self, name): + def test_all_f77(self, name): self.check_function(getattr(self.module, name), name) - -class TestF90ReturnCharacter(TestReturnCharacter): - suffix = ".f90" - code = """ -module f90_return_char - contains - function t0(value) - character :: value - character :: t0 - t0 = value - end function t0 - function t1(value) - character(len=1) :: value - character(len=1) :: t1 - t1 = value - end function t1 - function t5(value) - character(len=5) :: value - character(len=5) :: t5 - t5 = value - end function t5 - function ts(value) - character(len=*) :: value - character(len=10) :: ts - ts = value - end function ts - - subroutine s0(t0,value) - character :: value - character :: t0 -!f2py intent(out) t0 - t0 = value - end subroutine s0 - subroutine s1(t1,value) - character(len=1) :: value - character(len=1) :: t1 -!f2py intent(out) t1 - t1 = value - end subroutine s1 - subroutine s5(t5,value) - character(len=5) :: value - character(len=5) :: t5 -!f2py intent(out) t5 - t5 = value - end subroutine s5 - subroutine ss(ts,value) - character(len=*) :: value - character(len=10) :: ts -!f2py intent(out) ts - ts = value - end subroutine ss -end module f90_return_char - """ - @pytest.mark.xfail(IS_S390X, reason="callback returns ' '") @pytest.mark.parametrize("name", "t0,t1,t5,ts,s0,s1,s5,ss".split(",")) - def test_all(self, name): + def test_all_f90(self, name): self.check_function(getattr(self.module.f90_return_char, name), name) diff --git a/numpy/f2py/tests/test_return_complex.py b/numpy/f2py/tests/test_return_complex.py index ae0e3ab25..dc5592899 100644 --- a/numpy/f2py/tests/test_return_complex.py +++ b/numpy/f2py/tests/test_return_complex.py @@ -1,7 +1,6 @@ import pytest from numpy import array -from numpy.testing import assert_, assert_raises from . import util @@ -11,153 +10,56 @@ class TestReturnComplex(util.F2PyTest): err = 1e-5 else: err = 0.0 - assert_(abs(t(234j) - 234.0j) <= err) - assert_(abs(t(234.6) - 234.6) <= err) - assert_(abs(t(234) - 234.0) <= err) - assert_(abs(t(234.6 + 3j) - (234.6 + 3j)) <= err) - # assert_( abs(t('234')-234.)<=err) - # assert_( abs(t('234.6')-234.6)<=err) - assert_(abs(t(-234) + 234.0) <= err) - assert_(abs(t([234]) - 234.0) <= err) - assert_(abs(t((234, )) - 234.0) <= err) - assert_(abs(t(array(234)) - 234.0) <= err) - assert_(abs(t(array(23 + 4j, "F")) - (23 + 4j)) <= err) - assert_(abs(t(array([234])) - 234.0) <= err) - assert_(abs(t(array([[234]])) - 234.0) <= err) - assert_(abs(t(array([234], "b")) + 22.0) <= err) - assert_(abs(t(array([234], "h")) - 234.0) <= err) - assert_(abs(t(array([234], "i")) - 234.0) <= err) - assert_(abs(t(array([234], "l")) - 234.0) <= err) - assert_(abs(t(array([234], "q")) - 234.0) <= err) - assert_(abs(t(array([234], "f")) - 234.0) <= err) - assert_(abs(t(array([234], "d")) - 234.0) <= err) - assert_(abs(t(array([234 + 3j], "F")) - (234 + 3j)) <= err) - assert_(abs(t(array([234], "D")) - 234.0) <= err) + assert abs(t(234j) - 234.0j) <= err + assert abs(t(234.6) - 234.6) <= err + assert abs(t(234) - 234.0) <= err + assert abs(t(234.6 + 3j) - (234.6 + 3j)) <= err + # assert abs(t('234')-234.)<=err + # assert abs(t('234.6')-234.6)<=err + assert abs(t(-234) + 234.0) <= err + assert abs(t([234]) - 234.0) <= err + assert abs(t((234, )) - 234.0) <= err + assert abs(t(array(234)) - 234.0) <= err + assert abs(t(array(23 + 4j, "F")) - (23 + 4j)) <= err + assert abs(t(array([234])) - 234.0) <= err + assert abs(t(array([[234]])) - 234.0) <= err + assert abs(t(array([234], "b")) + 22.0) <= err + assert abs(t(array([234], "h")) - 234.0) <= err + assert abs(t(array([234], "i")) - 234.0) <= err + assert abs(t(array([234], "l")) - 234.0) <= err + assert abs(t(array([234], "q")) - 234.0) <= err + assert abs(t(array([234], "f")) - 234.0) <= err + assert abs(t(array([234], "d")) - 234.0) <= err + assert abs(t(array([234 + 3j], "F")) - (234 + 3j)) <= err + assert abs(t(array([234], "D")) - 234.0) <= err - # assert_raises(TypeError, t, array([234], 'a1')) - assert_raises(TypeError, t, "abc") + # pytest.raises(TypeError, t, array([234], 'a1')) + pytest.raises(TypeError, t, "abc") - assert_raises(IndexError, t, []) - assert_raises(IndexError, t, ()) + pytest.raises(IndexError, t, []) + pytest.raises(IndexError, t, ()) - assert_raises(TypeError, t, t) - assert_raises(TypeError, t, {}) + pytest.raises(TypeError, t, t) + pytest.raises(TypeError, t, {}) try: r = t(10**400) - assert_(repr(r) in ["(inf+0j)", "(Infinity+0j)"], repr(r)) + assert repr(r) in ["(inf+0j)", "(Infinity+0j)"] except OverflowError: pass -class TestF77ReturnComplex(TestReturnComplex): - code = """ - function t0(value) - complex value - complex t0 - t0 = value - end - function t8(value) - complex*8 value - complex*8 t8 - t8 = value - end - function t16(value) - complex*16 value - complex*16 t16 - t16 = value - end - function td(value) - double complex value - double complex td - td = value - end - - subroutine s0(t0,value) - complex value - complex t0 -cf2py intent(out) t0 - t0 = value - end - subroutine s8(t8,value) - complex*8 value - complex*8 t8 -cf2py intent(out) t8 - t8 = value - end - subroutine s16(t16,value) - complex*16 value - complex*16 t16 -cf2py intent(out) t16 - t16 = value - end - subroutine sd(td,value) - double complex value - double complex td -cf2py intent(out) td - td = value - end - """ +class TestFReturnComplex(TestReturnComplex): + sources = [ + util.getpath("tests", "src", "return_complex", "foo77.f"), + util.getpath("tests", "src", "return_complex", "foo90.f90"), + ] @pytest.mark.parametrize("name", "t0,t8,t16,td,s0,s8,s16,sd".split(",")) - def test_all(self, name): + def test_all_f77(self, name): self.check_function(getattr(self.module, name), name) - -class TestF90ReturnComplex(TestReturnComplex): - suffix = ".f90" - code = """ -module f90_return_complex - contains - function t0(value) - complex :: value - complex :: t0 - t0 = value - end function t0 - function t8(value) - complex(kind=4) :: value - complex(kind=4) :: t8 - t8 = value - end function t8 - function t16(value) - complex(kind=8) :: value - complex(kind=8) :: t16 - t16 = value - end function t16 - function td(value) - double complex :: value - double complex :: td - td = value - end function td - - subroutine s0(t0,value) - complex :: value - complex :: t0 -!f2py intent(out) t0 - t0 = value - end subroutine s0 - subroutine s8(t8,value) - complex(kind=4) :: value - complex(kind=4) :: t8 -!f2py intent(out) t8 - t8 = value - end subroutine s8 - subroutine s16(t16,value) - complex(kind=8) :: value - complex(kind=8) :: t16 -!f2py intent(out) t16 - t16 = value - end subroutine s16 - subroutine sd(td,value) - double complex :: value - double complex :: td -!f2py intent(out) td - td = value - end subroutine sd -end module f90_return_complex - """ - @pytest.mark.parametrize("name", "t0,t8,t16,td,s0,s8,s16,sd".split(",")) - def test_all(self, name): + def test_all_f90(self, name): self.check_function(getattr(self.module.f90_return_complex, name), name) diff --git a/numpy/f2py/tests/test_return_integer.py b/numpy/f2py/tests/test_return_integer.py index 9c2bdbce2..a43c677fd 100644 --- a/numpy/f2py/tests/test_return_integer.py +++ b/numpy/f2py/tests/test_return_integer.py @@ -1,175 +1,55 @@ import pytest from numpy import array -from numpy.testing import assert_, assert_raises from . import util class TestReturnInteger(util.F2PyTest): def check_function(self, t, tname): - assert_(t(123) == 123, repr(t(123))) - assert_(t(123.6) == 123) - assert_(t("123") == 123) - assert_(t(-123) == -123) - assert_(t([123]) == 123) - assert_(t((123, )) == 123) - assert_(t(array(123)) == 123) - assert_(t(array([123])) == 123) - assert_(t(array([[123]])) == 123) - assert_(t(array([123], "b")) == 123) - assert_(t(array([123], "h")) == 123) - assert_(t(array([123], "i")) == 123) - assert_(t(array([123], "l")) == 123) - assert_(t(array([123], "B")) == 123) - assert_(t(array([123], "f")) == 123) - assert_(t(array([123], "d")) == 123) - - # assert_raises(ValueError, t, array([123],'S3')) - assert_raises(ValueError, t, "abc") - - assert_raises(IndexError, t, []) - assert_raises(IndexError, t, ()) - - assert_raises(Exception, t, t) - assert_raises(Exception, t, {}) + assert t(123) == 123 + assert t(123.6) == 123 + assert t("123") == 123 + assert t(-123) == -123 + assert t([123]) == 123 + assert t((123, )) == 123 + assert t(array(123)) == 123 + assert t(array([123])) == 123 + assert t(array([[123]])) == 123 + assert t(array([123], "b")) == 123 + assert t(array([123], "h")) == 123 + assert t(array([123], "i")) == 123 + assert t(array([123], "l")) == 123 + assert t(array([123], "B")) == 123 + assert t(array([123], "f")) == 123 + assert t(array([123], "d")) == 123 + + # pytest.raises(ValueError, t, array([123],'S3')) + pytest.raises(ValueError, t, "abc") + + pytest.raises(IndexError, t, []) + pytest.raises(IndexError, t, ()) + + pytest.raises(Exception, t, t) + pytest.raises(Exception, t, {}) if tname in ["t8", "s8"]: - assert_raises(OverflowError, t, 100000000000000000000000) - assert_raises(OverflowError, t, 10000000011111111111111.23) - + pytest.raises(OverflowError, t, 100000000000000000000000) + pytest.raises(OverflowError, t, 10000000011111111111111.23) -class TestF77ReturnInteger(TestReturnInteger): - code = """ - function t0(value) - integer value - integer t0 - t0 = value - end - function t1(value) - integer*1 value - integer*1 t1 - t1 = value - end - function t2(value) - integer*2 value - integer*2 t2 - t2 = value - end - function t4(value) - integer*4 value - integer*4 t4 - t4 = value - end - function t8(value) - integer*8 value - integer*8 t8 - t8 = value - end - subroutine s0(t0,value) - integer value - integer t0 -cf2py intent(out) t0 - t0 = value - end - subroutine s1(t1,value) - integer*1 value - integer*1 t1 -cf2py intent(out) t1 - t1 = value - end - subroutine s2(t2,value) - integer*2 value - integer*2 t2 -cf2py intent(out) t2 - t2 = value - end - subroutine s4(t4,value) - integer*4 value - integer*4 t4 -cf2py intent(out) t4 - t4 = value - end - subroutine s8(t8,value) - integer*8 value - integer*8 t8 -cf2py intent(out) t8 - t8 = value - end - """ +class TestFReturnInteger(TestReturnInteger): + sources = [ + util.getpath("tests", "src", "return_integer", "foo77.f"), + util.getpath("tests", "src", "return_integer", "foo90.f90"), + ] @pytest.mark.parametrize("name", "t0,t1,t2,t4,t8,s0,s1,s2,s4,s8".split(",")) - def test_all(self, name): + def test_all_f77(self, name): self.check_function(getattr(self.module, name), name) - -class TestF90ReturnInteger(TestReturnInteger): - suffix = ".f90" - code = """ -module f90_return_integer - contains - function t0(value) - integer :: value - integer :: t0 - t0 = value - end function t0 - function t1(value) - integer(kind=1) :: value - integer(kind=1) :: t1 - t1 = value - end function t1 - function t2(value) - integer(kind=2) :: value - integer(kind=2) :: t2 - t2 = value - end function t2 - function t4(value) - integer(kind=4) :: value - integer(kind=4) :: t4 - t4 = value - end function t4 - function t8(value) - integer(kind=8) :: value - integer(kind=8) :: t8 - t8 = value - end function t8 - - subroutine s0(t0,value) - integer :: value - integer :: t0 -!f2py intent(out) t0 - t0 = value - end subroutine s0 - subroutine s1(t1,value) - integer(kind=1) :: value - integer(kind=1) :: t1 -!f2py intent(out) t1 - t1 = value - end subroutine s1 - subroutine s2(t2,value) - integer(kind=2) :: value - integer(kind=2) :: t2 -!f2py intent(out) t2 - t2 = value - end subroutine s2 - subroutine s4(t4,value) - integer(kind=4) :: value - integer(kind=4) :: t4 -!f2py intent(out) t4 - t4 = value - end subroutine s4 - subroutine s8(t8,value) - integer(kind=8) :: value - integer(kind=8) :: t8 -!f2py intent(out) t8 - t8 = value - end subroutine s8 -end module f90_return_integer - """ - @pytest.mark.parametrize("name", "t0,t1,t2,t4,t8,s0,s1,s2,s4,s8".split(",")) - def test_all(self, name): + def test_all_f90(self, name): self.check_function(getattr(self.module.f90_return_integer, name), name) diff --git a/numpy/f2py/tests/test_return_logical.py b/numpy/f2py/tests/test_return_logical.py index c1a365c7a..6f64745ee 100644 --- a/numpy/f2py/tests/test_return_logical.py +++ b/numpy/f2py/tests/test_return_logical.py @@ -1,184 +1,64 @@ import pytest from numpy import array -from numpy.testing import assert_, assert_raises from . import util class TestReturnLogical(util.F2PyTest): def check_function(self, t): - assert_(t(True) == 1, repr(t(True))) - assert_(t(False) == 0, repr(t(False))) - assert_(t(0) == 0) - assert_(t(None) == 0) - assert_(t(0.0) == 0) - assert_(t(0j) == 0) - assert_(t(1j) == 1) - assert_(t(234) == 1) - assert_(t(234.6) == 1) - assert_(t(234.6 + 3j) == 1) - assert_(t("234") == 1) - assert_(t("aaa") == 1) - assert_(t("") == 0) - assert_(t([]) == 0) - assert_(t(()) == 0) - assert_(t({}) == 0) - assert_(t(t) == 1) - assert_(t(-234) == 1) - assert_(t(10**100) == 1) - assert_(t([234]) == 1) - assert_(t((234, )) == 1) - assert_(t(array(234)) == 1) - assert_(t(array([234])) == 1) - assert_(t(array([[234]])) == 1) - assert_(t(array([234], "b")) == 1) - assert_(t(array([234], "h")) == 1) - assert_(t(array([234], "i")) == 1) - assert_(t(array([234], "l")) == 1) - assert_(t(array([234], "f")) == 1) - assert_(t(array([234], "d")) == 1) - assert_(t(array([234 + 3j], "F")) == 1) - assert_(t(array([234], "D")) == 1) - assert_(t(array(0)) == 0) - assert_(t(array([0])) == 0) - assert_(t(array([[0]])) == 0) - assert_(t(array([0j])) == 0) - assert_(t(array([1])) == 1) - assert_raises(ValueError, t, array([0, 0])) + assert t(True) == 1 + assert t(False) == 0 + assert t(0) == 0 + assert t(None) == 0 + assert t(0.0) == 0 + assert t(0j) == 0 + assert t(1j) == 1 + assert t(234) == 1 + assert t(234.6) == 1 + assert t(234.6 + 3j) == 1 + assert t("234") == 1 + assert t("aaa") == 1 + assert t("") == 0 + assert t([]) == 0 + assert t(()) == 0 + assert t({}) == 0 + assert t(t) == 1 + assert t(-234) == 1 + assert t(10**100) == 1 + assert t([234]) == 1 + assert t((234, )) == 1 + assert t(array(234)) == 1 + assert t(array([234])) == 1 + assert t(array([[234]])) == 1 + assert t(array([234], "b")) == 1 + assert t(array([234], "h")) == 1 + assert t(array([234], "i")) == 1 + assert t(array([234], "l")) == 1 + assert t(array([234], "f")) == 1 + assert t(array([234], "d")) == 1 + assert t(array([234 + 3j], "F")) == 1 + assert t(array([234], "D")) == 1 + assert t(array(0)) == 0 + assert t(array([0])) == 0 + assert t(array([[0]])) == 0 + assert t(array([0j])) == 0 + assert t(array([1])) == 1 + pytest.raises(ValueError, t, array([0, 0])) -class TestF77ReturnLogical(TestReturnLogical): - code = """ - function t0(value) - logical value - logical t0 - t0 = value - end - function t1(value) - logical*1 value - logical*1 t1 - t1 = value - end - function t2(value) - logical*2 value - logical*2 t2 - t2 = value - end - function t4(value) - logical*4 value - logical*4 t4 - t4 = value - end -c function t8(value) -c logical*8 value -c logical*8 t8 -c t8 = value -c end - - subroutine s0(t0,value) - logical value - logical t0 -cf2py intent(out) t0 - t0 = value - end - subroutine s1(t1,value) - logical*1 value - logical*1 t1 -cf2py intent(out) t1 - t1 = value - end - subroutine s2(t2,value) - logical*2 value - logical*2 t2 -cf2py intent(out) t2 - t2 = value - end - subroutine s4(t4,value) - logical*4 value - logical*4 t4 -cf2py intent(out) t4 - t4 = value - end -c subroutine s8(t8,value) -c logical*8 value -c logical*8 t8 -cf2py intent(out) t8 -c t8 = value -c end - """ +class TestFReturnLogical(TestReturnLogical): + sources = [ + util.getpath("tests", "src", "return_logical", "foo77.f"), + util.getpath("tests", "src", "return_logical", "foo90.f90"), + ] @pytest.mark.slow @pytest.mark.parametrize("name", "t0,t1,t2,t4,s0,s1,s2,s4".split(",")) - def test_all(self, name): + def test_all_f77(self, name): self.check_function(getattr(self.module, name)) - -class TestF90ReturnLogical(TestReturnLogical): - suffix = ".f90" - code = """ -module f90_return_logical - contains - function t0(value) - logical :: value - logical :: t0 - t0 = value - end function t0 - function t1(value) - logical(kind=1) :: value - logical(kind=1) :: t1 - t1 = value - end function t1 - function t2(value) - logical(kind=2) :: value - logical(kind=2) :: t2 - t2 = value - end function t2 - function t4(value) - logical(kind=4) :: value - logical(kind=4) :: t4 - t4 = value - end function t4 - function t8(value) - logical(kind=8) :: value - logical(kind=8) :: t8 - t8 = value - end function t8 - - subroutine s0(t0,value) - logical :: value - logical :: t0 -!f2py intent(out) t0 - t0 = value - end subroutine s0 - subroutine s1(t1,value) - logical(kind=1) :: value - logical(kind=1) :: t1 -!f2py intent(out) t1 - t1 = value - end subroutine s1 - subroutine s2(t2,value) - logical(kind=2) :: value - logical(kind=2) :: t2 -!f2py intent(out) t2 - t2 = value - end subroutine s2 - subroutine s4(t4,value) - logical(kind=4) :: value - logical(kind=4) :: t4 -!f2py intent(out) t4 - t4 = value - end subroutine s4 - subroutine s8(t8,value) - logical(kind=8) :: value - logical(kind=8) :: t8 -!f2py intent(out) t8 - t8 = value - end subroutine s8 -end module f90_return_logical - """ - @pytest.mark.slow @pytest.mark.parametrize("name", "t0,t1,t2,t4,t8,s0,s1,s2,s4,s8".split(",")) - def test_all(self, name): + def test_all_f90(self, name): self.check_function(getattr(self.module.f90_return_logical, name)) diff --git a/numpy/f2py/tests/test_return_real.py b/numpy/f2py/tests/test_return_real.py index d5e5ee482..d9fecef1a 100644 --- a/numpy/f2py/tests/test_return_real.py +++ b/numpy/f2py/tests/test_return_real.py @@ -2,7 +2,6 @@ import platform import pytest from numpy import array -from numpy.testing import assert_, assert_raises from . import util @@ -12,38 +11,38 @@ class TestReturnReal(util.F2PyTest): err = 1e-5 else: err = 0.0 - assert_(abs(t(234) - 234.0) <= err) - assert_(abs(t(234.6) - 234.6) <= err) - assert_(abs(t("234") - 234) <= err) - assert_(abs(t("234.6") - 234.6) <= err) - assert_(abs(t(-234) + 234) <= err) - assert_(abs(t([234]) - 234) <= err) - assert_(abs(t((234, )) - 234.0) <= err) - assert_(abs(t(array(234)) - 234.0) <= err) - assert_(abs(t(array([234])) - 234.0) <= err) - assert_(abs(t(array([[234]])) - 234.0) <= err) - assert_(abs(t(array([234], "b")) + 22) <= err) - assert_(abs(t(array([234], "h")) - 234.0) <= err) - assert_(abs(t(array([234], "i")) - 234.0) <= err) - assert_(abs(t(array([234], "l")) - 234.0) <= err) - assert_(abs(t(array([234], "B")) - 234.0) <= err) - assert_(abs(t(array([234], "f")) - 234.0) <= err) - assert_(abs(t(array([234], "d")) - 234.0) <= err) + assert abs(t(234) - 234.0) <= err + assert abs(t(234.6) - 234.6) <= err + assert abs(t("234") - 234) <= err + assert abs(t("234.6") - 234.6) <= err + assert abs(t(-234) + 234) <= err + assert abs(t([234]) - 234) <= err + assert abs(t((234, )) - 234.0) <= err + assert abs(t(array(234)) - 234.0) <= err + assert abs(t(array([234])) - 234.0) <= err + assert abs(t(array([[234]])) - 234.0) <= err + assert abs(t(array([234], "b")) + 22) <= err + assert abs(t(array([234], "h")) - 234.0) <= err + assert abs(t(array([234], "i")) - 234.0) <= err + assert abs(t(array([234], "l")) - 234.0) <= err + assert abs(t(array([234], "B")) - 234.0) <= err + assert abs(t(array([234], "f")) - 234.0) <= err + assert abs(t(array([234], "d")) - 234.0) <= err if tname in ["t0", "t4", "s0", "s4"]: - assert_(t(1e200) == t(1e300)) # inf + assert t(1e200) == t(1e300) # inf - # assert_raises(ValueError, t, array([234], 'S1')) - assert_raises(ValueError, t, "abc") + # pytest.raises(ValueError, t, array([234], 'S1')) + pytest.raises(ValueError, t, "abc") - assert_raises(IndexError, t, []) - assert_raises(IndexError, t, ()) + pytest.raises(IndexError, t, []) + pytest.raises(IndexError, t, ()) - assert_raises(Exception, t, t) - assert_raises(Exception, t, {}) + pytest.raises(Exception, t, t) + pytest.raises(Exception, t, {}) try: r = t(10**400) - assert_(repr(r) in ["inf", "Infinity"], repr(r)) + assert repr(r) in ["inf", "Infinity"] except OverflowError: pass @@ -90,113 +89,16 @@ end python module c_ext_return_real self.check_function(getattr(self.module, name), name) -class TestF77ReturnReal(TestReturnReal): - code = """ - function t0(value) - real value - real t0 - t0 = value - end - function t4(value) - real*4 value - real*4 t4 - t4 = value - end - function t8(value) - real*8 value - real*8 t8 - t8 = value - end - function td(value) - double precision value - double precision td - td = value - end - - subroutine s0(t0,value) - real value - real t0 -cf2py intent(out) t0 - t0 = value - end - subroutine s4(t4,value) - real*4 value - real*4 t4 -cf2py intent(out) t4 - t4 = value - end - subroutine s8(t8,value) - real*8 value - real*8 t8 -cf2py intent(out) t8 - t8 = value - end - subroutine sd(td,value) - double precision value - double precision td -cf2py intent(out) td - td = value - end - """ +class TestFReturnReal(TestReturnReal): + sources = [ + util.getpath("tests", "src", "return_real", "foo77.f"), + util.getpath("tests", "src", "return_real", "foo90.f90"), + ] @pytest.mark.parametrize("name", "t0,t4,t8,td,s0,s4,s8,sd".split(",")) - def test_all(self, name): + def test_all_f77(self, name): self.check_function(getattr(self.module, name), name) - -class TestF90ReturnReal(TestReturnReal): - suffix = ".f90" - code = """ -module f90_return_real - contains - function t0(value) - real :: value - real :: t0 - t0 = value - end function t0 - function t4(value) - real(kind=4) :: value - real(kind=4) :: t4 - t4 = value - end function t4 - function t8(value) - real(kind=8) :: value - real(kind=8) :: t8 - t8 = value - end function t8 - function td(value) - double precision :: value - double precision :: td - td = value - end function td - - subroutine s0(t0,value) - real :: value - real :: t0 -!f2py intent(out) t0 - t0 = value - end subroutine s0 - subroutine s4(t4,value) - real(kind=4) :: value - real(kind=4) :: t4 -!f2py intent(out) t4 - t4 = value - end subroutine s4 - subroutine s8(t8,value) - real(kind=8) :: value - real(kind=8) :: t8 -!f2py intent(out) t8 - t8 = value - end subroutine s8 - subroutine sd(td,value) - double precision :: value - double precision :: td -!f2py intent(out) td - td = value - end subroutine sd -end module f90_return_real - """ - @pytest.mark.parametrize("name", "t0,t4,t8,td,s0,s4,s8,sd".split(",")) - def test_all(self, name): + def test_all_f90(self, name): self.check_function(getattr(self.module.f90_return_real, name), name) diff --git a/numpy/f2py/tests/test_semicolon_split.py b/numpy/f2py/tests/test_semicolon_split.py index 745c472f8..5375543e0 100644 --- a/numpy/f2py/tests/test_semicolon_split.py +++ b/numpy/f2py/tests/test_semicolon_split.py @@ -2,7 +2,6 @@ import platform import pytest from . import util -from numpy.testing import assert_equal @pytest.mark.skipif( @@ -31,7 +30,7 @@ end python module {module_name} """ def test_multiline(self): - assert_equal(self.module.foo(), 42) + assert self.module.foo() == 42 @pytest.mark.skipif( @@ -63,4 +62,4 @@ end python module {module_name} """ def test_callstatement(self): - assert_equal(self.module.foo(), 42) + assert self.module.foo() == 42 diff --git a/numpy/f2py/tests/test_size.py b/numpy/f2py/tests/test_size.py index 3360e2a3d..bd2c349df 100644 --- a/numpy/f2py/tests/test_size.py +++ b/numpy/f2py/tests/test_size.py @@ -1,7 +1,7 @@ import os import pytest +import numpy as np -from numpy.testing import assert_equal from . import util @@ -11,35 +11,35 @@ class TestSizeSumExample(util.F2PyTest): @pytest.mark.slow def test_all(self): r = self.module.foo([[]]) - assert_equal(r, [0], repr(r)) + assert r == [0] r = self.module.foo([[1, 2]]) - assert_equal(r, [3], repr(r)) + assert r == [3] r = self.module.foo([[1, 2], [3, 4]]) - assert_equal(r, [3, 7], repr(r)) + assert np.allclose(r, [3, 7]) r = self.module.foo([[1, 2], [3, 4], [5, 6]]) - assert_equal(r, [3, 7, 11], repr(r)) + assert np.allclose(r, [3, 7, 11]) @pytest.mark.slow def test_transpose(self): r = self.module.trans([[]]) - assert_equal(r.T, [[]], repr(r)) + assert np.allclose(r.T, np.array([[]])) r = self.module.trans([[1, 2]]) - assert_equal(r, [[1], [2]], repr(r)) + assert np.allclose(r, [[1.], [2.]]) r = self.module.trans([[1, 2, 3], [4, 5, 6]]) - assert_equal(r, [[1, 4], [2, 5], [3, 6]], repr(r)) + assert np.allclose(r, [[1, 4], [2, 5], [3, 6]]) @pytest.mark.slow def test_flatten(self): r = self.module.flatten([[]]) - assert_equal(r, [], repr(r)) + assert np.allclose(r, []) r = self.module.flatten([[1, 2]]) - assert_equal(r, [1, 2], repr(r)) + assert np.allclose(r, [1, 2]) r = self.module.flatten([[1, 2, 3], [4, 5, 6]]) - assert_equal(r, [1, 2, 3, 4, 5, 6], repr(r)) + assert np.allclose(r, [1, 2, 3, 4, 5, 6]) diff --git a/numpy/f2py/tests/test_string.py b/numpy/f2py/tests/test_string.py index 1a6d59610..9e937188c 100644 --- a/numpy/f2py/tests/test_string.py +++ b/numpy/f2py/tests/test_string.py @@ -1,7 +1,6 @@ import os import pytest import textwrap -from numpy.testing import assert_array_equal import numpy as np from . import util @@ -14,29 +13,14 @@ class TestString(util.F2PyTest): strings = np.array(["ab", "cd", "ef"], dtype="c").T inp, out = self.module.char_test.change_strings( strings, strings.shape[1]) - assert_array_equal(inp, strings) + assert inp == pytest.approx(strings) expected = strings.copy() expected[1, :] = "AAA" - assert_array_equal(out, expected) + assert out == pytest.approx(expected) class TestDocStringArguments(util.F2PyTest): - suffix = ".f" - - code = """ -C FILE: STRING.F - SUBROUTINE FOO(A,B,C,D) - CHARACTER*5 A, B - CHARACTER*(*) C,D -Cf2py intent(in) a,c -Cf2py intent(inout) b,d - A(1:1) = 'A' - B(1:1) = 'B' - C(1:1) = 'C' - D(1:1) = 'D' - END -C END OF FILE STRING.F - """ + sources = [util.getpath("tests", "src", "string", "string.f")] def test_example(self): a = np.array(b"123\0\0") @@ -53,44 +37,7 @@ C END OF FILE STRING.F class TestFixedString(util.F2PyTest): - suffix = ".f90" - - code = textwrap.dedent(""" - function sint(s) result(i) - implicit none - character(len=*) :: s - integer :: j, i - i = 0 - do j=len(s), 1, -1 - if (.not.((i.eq.0).and.(s(j:j).eq.' '))) then - i = i + ichar(s(j:j)) * 10 ** (j - 1) - endif - end do - return - end function sint - - function test_in_bytes4(a) result (i) - implicit none - integer :: sint - character(len=4) :: a - integer :: i - i = sint(a) - a(1:1) = 'A' - return - end function test_in_bytes4 - - function test_inout_bytes4(a) result (i) - implicit none - integer :: sint - character(len=4), intent(inout) :: a - integer :: i - if (a(1:1).ne.' ') then - a(1:1) = 'E' - endif - i = sint(a) - return - end function test_inout_bytes4 - """) + sources = [util.getpath("tests", "src", "string", "fixed_string.f90")] @staticmethod def _sint(s, start=0, end=None): diff --git a/numpy/f2py/tests/test_symbolic.py b/numpy/f2py/tests/test_symbolic.py index 4b8993886..e8dec72f0 100644 --- a/numpy/f2py/tests/test_symbolic.py +++ b/numpy/f2py/tests/test_symbolic.py @@ -1,4 +1,5 @@ -from numpy.testing import assert_raises +import pytest + from numpy.f2py.symbolic import ( Expr, Op, @@ -464,7 +465,7 @@ class TestSymbolic(util.F2PyTest): assert ((z + y) * x + y).linear_solve(x) == (z + y, y) assert (z * y * x + y).linear_solve(x) == (z * y, y) - assert_raises(RuntimeError, lambda: (x * x).linear_solve(x)) + pytest.raises(RuntimeError, lambda: (x * x).linear_solve(x)) def test_as_numer_denom(self): x = as_symbol("x") |
