capture t/01-pptest.t test into t/slice.t as only needs op with 2 [o,…

…phys]
PDLPorters · Feb 8, 2024 · 6b9a486 · 6b9a486
1 parent a92cbf5
commit 6b9a486
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 20 deletions.
diff --git a/Basic/Core/pdlapi.c b/Basic/Core/pdlapi.c
@@ -84,9 +84,9 @@ pdl_error pdl__ensure_trans(pdl_trans *trans,int what,int *wd, int recurse_count
 		if (!PDL_VAFFOK(child) || (child->state & PDL_ALLOCATED))
 		    child->state &= ~PDL_ANYCHANGED;
 		if (!wd) continue;
-		PDLDEBUG_f(printf("   pdl__ensure_trans wd="); pdl_dump_flags_fixspace(wd[j], 0, PDL_FLAGS_PDL));
 		char isvaffine = (PDL_VAFFOK(child) &&
 		    VAFFINE_FLAG_OK(vtable->per_pdl_flags,j));
+		PDLDEBUG_f(printf("   pdl__ensure_trans isvaffine=%d wd=", (int)isvaffine); pdl_dump_flags_fixspace(wd[j], 0, PDL_FLAGS_PDL));
 		if (!isvaffine || (wd[j] & PDL_PARENTDIMSCHANGED))
 		    CHANGED(child,wd[j],0);
 		if (isvaffine)

diff --git a/t/01-pptest.t b/t/01-pptest.t
@@ -122,12 +122,6 @@ pp_addhdr << 'EOH';
 void tinplace_c2(int n, PDL_Float* data1, PDL_Float* data2);
 EOH
 
-pp_def('fooflow2',
-	Pars => '[io]a(n);[io]b(n)',
-        GenericTypes => ['F'],
-	Code => 'tinplace_c2($SIZE(n),$P(a),$P(b));',
-	);
-
 pp_def( 'broadcastloop_continue',
 	 Pars => 'in(); [o] out()',
 	 Code => q[
@@ -489,19 +483,6 @@ is_deeply \@msg, [], 'no warnings' or diag explain \@msg;
 eval { _flatten_into(null, 2) };
 ok 1; #was also segfaulting
 
-# test the bug alluded to in the comments in pdl_changed (pdlapi.c)
-# used to segfault
-my $xx=ones(float,3,4);
-my $sl1 = $xx->slice('(0)');
-my $sl11 = $sl1->slice('');
-my $sl2 = $xx->slice('(1)');
-my $sl22 = $sl2->slice('');
-
-fooflow2($sl11, $sl22);
-
-ok(all $xx->slice('(0)') == 599);
-ok(all $xx->slice('(1)') == 699);
-
 # test that continues in a broadcastloop work
 {
     my $in = sequence(10);

diff --git a/t/slice.t b/t/slice.t
@@ -318,6 +318,18 @@ for ([0,1], [1,0], [1,1]) {
   $got = $y->unpdl;
   is_deeply $got, $exp, "mv=$mv mult=$mult clump" or diag explain $got;
 }
+# test the bug alluded to in the comments in pdl_changed (pdlapi.c)
+# used to segfault
+my $xx=ones(double,3,4);
+my $sl1 = $xx->slice('(0)');
+my $sl11 = $sl1->slice('');
+my $sl2 = $xx->slice('(1)');
+my $sl22 = $sl2->slice('');
+my $roots = pdl '[1 -2396-2796i -778800+5024412i 2652376792-1643494392i -684394069604-217389559200i]'; # gives 4 roots of 599+699i
+PDL::polyroots($roots->re, $roots->im, $sl11, $sl22);
+my $got;
+ok all(approx $got=$xx->slice('(0)'), 599), "col=0" or diag "got=$got";
+ok all(approx $got=$xx->slice('(1)'), 699), "col=1" or diag "got=$got";
 }
 
 # captured from https://www.perlmonks.org/?node_id=11153348