@@ -59,36 +59,36 @@ like $@, qr/only works/, 'polyroots(1,0) throws exception not segfault';
59
59
my $coeffs = pdl(cdouble, 1,-55,1320,-18150,157773,-902055, 3416930,-8409500,12753576,-10628640,3628800);
60
60
my $roots = 1+sequence(10);
61
61
my $got ;
62
- ok all(approx $got = qsort((polyroots $coeffs -> re, $coeffs -> im)[0]), $roots ) , ' polyroots' or diag $got ;
62
+ is_pdl qsort((polyroots $coeffs -> re, $coeffs -> im)[0]), $roots , ' polyroots' ;
63
63
polyroots $coeffs -> re, $coeffs -> im, $got =null; $got -> inplace-> qsort;
64
- ok all(approx $got , $roots ) , ' polyroots with explicit output args' or diag $got ;
65
- ok all(approx $got = qsort(polyroots($coeffs )-> re), $roots ) , ' polyroots native complex no output args' or diag $got ;
64
+ is_pdl $got , $roots , ' polyroots with explicit output args' ;
65
+ is_pdl qsort(polyroots($coeffs )-> re), $roots , ' polyroots native complex no output args' ;
66
66
polyroots $coeffs , $got =null; $got =$got -> re-> qsort;
67
- ok all(approx $got , $roots ) , ' polyroots native complex explicit output args' or diag $got ;
67
+ is_pdl $got , $roots , ' polyroots native complex explicit output args' ;
68
68
eval {polyroots(pdl(" [1 0 0 0 -1]" ),zeroes(5))};
69
69
is $@ , ' ' , ' polyroots no crash on 4 complex roots of 1' ;
70
- ok all(approx $got =( polyfromroots $roots , $roots -> zeroes)[0], $coeffs -> re) , ' polyfromroots legacy no outargs' or diag $got ;
70
+ is_pdl +( polyfromroots $roots , $roots -> zeroes)[0], $coeffs -> re, ' polyfromroots legacy no outargs' ;
71
71
polyfromroots $roots , $roots -> zeroes, $got =null;
72
- ok all(approx $got , $coeffs -> re) , ' polyfromroots legacy with explicit output args' or diag $got ;
73
- ok all(approx $got = polyfromroots(cdouble($roots )), $coeffs -> re) , ' polyfromroots natcom no outargs' or diag $got ;
72
+ is_pdl $got , $coeffs -> re, ' polyfromroots legacy with explicit output args' ;
73
+ is_pdl polyfromroots(cdouble($roots )), $coeffs , ' polyfromroots natcom no outargs' ;
74
74
polyfromroots cdouble($roots ), $got =null;
75
- ok all(approx $got , $coeffs ) , ' polyfromroots natcom explicit outargs' or diag $got ;
75
+ is_pdl $got , $coeffs , ' polyfromroots natcom explicit outargs' ;
76
76
77
77
my ($coeffs2 , $x , $exp_val ) = (cdouble(3,2,1), cdouble(5,7,9), cdouble(86,162,262));
78
- ok all(approx $got = polyval($coeffs2 , $x ), $exp_val ) , ' polyval natcom no output' or diag $got ;
78
+ is_pdl polyval($coeffs2 , $x ), $exp_val , ' polyval natcom no output' ;
79
79
polyval($coeffs2 , $x , $got =null);
80
- ok all(approx $got , $exp_val ) , ' polyval natcom explicit output' or diag $got ;
81
- ok all(approx $got =( polyval($coeffs2 -> re, zeroes(3), $x -> re, zeroes(3)))[0], $exp_val -> re) , ' polyval legacy no output' or diag $got ;
80
+ is_pdl $got , $exp_val , ' polyval natcom explicit output' ;
81
+ is_pdl +( polyval($coeffs2 -> re, zeroes(3), $x -> re, zeroes(3)))[0], $exp_val -> re, ' polyval legacy no output' ;
82
82
polyval($coeffs2 -> re, zeroes(3), $x -> re, zeroes(3), $got =null);
83
- ok all(approx $got , $exp_val -> re) , ' polyval legacy explicit output' or diag $got ;
83
+ is_pdl $got , $exp_val -> re, ' polyval legacy explicit output' ;
84
84
85
85
{
86
86
my $pa = sequence(41) - 20;
87
87
$pa /= 4;
88
88
# do test on quarter-integers, to make sure we're not crazy.
89
89
my $ans_rint = pdl(-5,-5,-4,-4,-4,-4,-4,-3,-3,-3,-2,-2,-2,-2,-2,
90
90
-1,-1,-1,0,0,0,0,0,1,1,1,2,2,2,2,2,3,3,3,4,4,4,4,4,5,5);
91
- ok(all( rint($pa )== $ans_rint ), " rint" ) ;
91
+ is_pdl rint($pa ), $ans_rint , " rint" ;
92
92
}
93
93
94
94
is_pdl sinh(0.3), pdl(0.3045), " sinh" ;
@@ -108,11 +108,11 @@ is_pdl $pa, pdl(0.3045), "sinh inplace";
108
108
if ($Config {cc } ne ' cl' ) {
109
109
# lgamma not implemented for MS compilers
110
110
my @x = lgamma(-0.1);
111
- is(approx( $x [0], 2.36896133272879), 1 );
112
- is( $x [1], -1) ;
111
+ is_pdl $x [0], pdl( 2.36896133272879);
112
+ is $x [1], -1;
113
113
@x = lgamma(1.1);
114
- is(approx( $x [0], -0.0498724412598397), 1 );
115
- is( $x [1], 1) ;
114
+ is_pdl $x [0], pdl( -0.0498724412598397);
115
+ is $x [1], 1;
116
116
my $p = sequence (1);
117
117
$p -> badvalue (0);
118
118
$p -> badflag (1);
0 commit comments