diff --git a/Basic/Core/pdlapi.c b/Basic/Core/pdlapi.c index 4a68ebd0d..ef7ea015c 100644 --- 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 index 23beec53b..a0c563f37 100644 --- 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 index b31c82aaa..75c740490 100644 --- 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