From f3a23b23d6c981302a8ec2a3ddd754baf24a64db Mon Sep 17 00:00:00 2001
From: Ed J <mohawk2@users.noreply.github.com>
Date: Sun, 15 Dec 2024 19:16:25 +0000
Subject: [PATCH] credit report #508, fix #509, update tests to Test::PDL more

---
 Changes    |  1 +
 t/dumper.t | 29 ++++++++---------------------
 2 files changed, 9 insertions(+), 21 deletions(-)

diff --git a/Changes b/Changes
index f979f0962..a343bd464 100644
--- a/Changes
+++ b/Changes
@@ -34,6 +34,7 @@
 - split PDL::Opt::Simplex out to separate distro
 - add Primitive::pchip_{chsp,chic,chim,chfe,chfd,chia,chid,chbs,bvalu}
 - repository directory structure now like a normal Perl distro with lib/ (#119)
+- IO::Dumper fixed to deal with multiple refs to same ndarray (#508,#509) - thanks @d-lamb for report, thanks @shawnlaffan for fix
 
 2.095 2024-11-03
 - add PDL_GENTYPE_IS_{REAL,FLOATREAL,COMPLEX,SIGNED,UNSIGNED}_##ppsym (#502)
diff --git a/t/dumper.t b/t/dumper.t
index 43af432fe..071929365 100644
--- a/t/dumper.t
+++ b/t/dumper.t
@@ -12,7 +12,7 @@ use PDL::LiteF;
 # c: inline
 # d: advanced expr
 
-my ( $s, $x );
+my $s;
 
 #  Need a value greater than the uuencode dump threshold.
 #  Currently 25 but may change in future.
@@ -26,29 +26,21 @@ my @med_dims = ($med_size, $med_size);
 eval { $s = sdump({a=>3,b=>pdl(4),c=>xvals(3,3),d=>xvals(@med_dims)}) };
 is $@, '', 'Call sdump()'
    or diag("Call sdump() output string:\n$s\n");
-$x = eval $s;
+my $x = eval $s;
 is $@, '', 'Can eval dumped data code' or diag("The output string was '$s'\n");
-ok(ref $x eq 'HASH', 'HASH was restored');
-ok(($x->{a}==3), 'SCALAR value restored ok');
-ok(((ref $x->{b} eq 'PDL') && ($x->{b}==4)), '0-d PDL restored ok');
-ok(((ref $x->{c} eq 'PDL') && ($x->{c}->nelem == 9) 
-      && (sum(abs(($x->{c} - xvals(3,3))))<0.0000001)), '3x3 PDL restored ok');
-ok(((ref $x->{d} eq 'PDL') && ($x->{d}->nelem == $med_size ** 2)
-      && (sum(abs(($x->{d} - xvals(@med_dims))))<0.0000001)), '"medium" sized PDL restored ok');
+isa_ok $x, 'HASH', 'HASH was restored';
+cmp_ok $x->{a}, '==', 3, 'SCALAR value restored ok';
+is_pdl $x->{b}, pdl(4), '0-d PDL restored ok';
+is_pdl $x->{c}, xvals(3,3), '3x3 PDL restored ok';
+is_pdl $x->{d}, xvals(@med_dims), '"medium" sized PDL restored ok';
 
 ########## Dump a uuencoded expr and try to get it back...
 # e: uuencoded expr
 eval { $s = sdump({e=>xvals(@big_dims)}) };
 is $@, '', 'sdump() of "big" PDL to test uuencode dumps';
-
-#diag $s,"\n";
-
 $x = eval $s;
 is $@, '', 'Can eval dumped "big" PDL' or diag 'string: ', $s;
-
 ok((ref $x eq 'HASH'), 'HASH structure for uuencoded "big" PDL restored');
-isa_ok $x->{e}, 'PDL';
-is $x->{e}->nelem, $big_size ** 2;
 is_pdl $x->{e}, xvals(@big_dims), 'Verify "big" PDL restored data';
 
 ########## Check header dumping...
@@ -67,8 +59,7 @@ is $@, '', 'Check header dumping';
 $x = eval $s;
 is $@, '', 'ARRAY can restore';
 is ref($x), 'ARRAY' or diag explain $s;
-
-ok eval { $x->[0]->hdrcpy() == 1 && $x->[1]->hdrcpy() == 0 }, 'Check hdrcpy()\'s persist';
+ok eval { $x->[0]->hdrcpy() == 1 && $x->[1]->hdrcpy() == 0 }, 'Check hdrcpy() persist';
 ok eval { ($x->[0]->gethdr()->{ok}==1) && ($x->[1]->gethdr()->{ok}==2) }, 'Check gethdr() values persist';
 
 #  GH508
@@ -89,8 +80,6 @@ ok eval { ($x->[0]->gethdr()->{ok}==1) && ($x->[1]->gethdr()->{ok}==2) }, 'Check
 
     my $restored = eval $as_string;
 
-    # diag $as_string;
-
     my @nulls = grep {!defined $restored->{$_}} sort keys %$restored;
     is_deeply \@nulls, [], 'none of the restored items are undef';
 
@@ -98,11 +87,9 @@ ok eval { ($x->[0]->gethdr()->{ok}==1) && ($x->[1]->gethdr()->{ok}==2) }, 'Check
     my $u = xvals(@big_dims);
     my @ndarrays = ($u, $u);
     $as_string = sdump \@ndarrays;
-    # diag $as_string;
     $restored = eval $as_string;
     @nulls = grep {!defined $_} @$restored;
     is_deeply \@nulls, [], 'none of the restored uuencoded items are undef';
-
 }
 
 done_testing;