This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
don't recurse infinitely in Data::Dumper
[perl5.git] / dist / Data-Dumper / t / sortkeys.t
diff --git a/dist/Data-Dumper/t/sortkeys.t b/dist/Data-Dumper/t/sortkeys.t
index f4bbcb6..fbd8197 100644 (file)
--- a/dist/Data-Dumper/t/sortkeys.t
+++ b/dist/Data-Dumper/t/sortkeys.t
@@ -15,263 +15,176 @@ BEGIN {
 use strict;
 
 use Data::Dumper;
-use Test::More tests => 23;
+use Test::More tests => 26;
 use lib qw( ./t/lib );
 use Testing qw( _dumptostr );
 
-my %d = (
-    delta   => 'd',
-    beta    => 'b',
-    gamma   => 'c',
-    alpha   => 'a',
-);
-
-{
-    my ($obj, %dumps, $sortkeys, $starting);
-
-    note("\$Data::Dumper::Sortkeys and Sortkeys() set to true value");
-    note("XS implementation");
-    $Data::Dumper::Useperl = 0;
-
-    $starting = $Data::Dumper::Sortkeys;
-    $sortkeys = 1;
-    local $Data::Dumper::Sortkeys = $sortkeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddskone'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys($sortkeys);
-    $dumps{'objskone'} = _dumptostr($obj);
-
-    is($dumps{'ddskone'}, $dumps{'objskone'},
-        "\$Data::Dumper::Sortkeys = 1 and Sortkeys(1) are equivalent");
-    like($dumps{'ddskone'},
-        qr/alpha.*?beta.*?delta.*?gamma/s,
-        "Sortkeys returned hash keys in Perl's default sort order");
-    %dumps = ();
-
-    note("Perl implementation");
-    $Data::Dumper::Useperl = 1;
-
-    $starting = $Data::Dumper::Sortkeys;
-    $sortkeys = 1;
-    local $Data::Dumper::Sortkeys = $sortkeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddskone'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys($sortkeys);
-    $dumps{'objskone'} = _dumptostr($obj);
-
-    is($dumps{'ddskone'}, $dumps{'objskone'},
-        "\$Data::Dumper::Sortkeys = 1 and Sortkeys(1) are equivalent");
-    like($dumps{'ddskone'},
-        qr/alpha.*?beta.*?delta.*?gamma/s,
-        "Sortkeys returned hash keys in Perl's default sort order");
+run_tests_for_sortkeys();
+SKIP: {
+    skip "XS version was unavailable, so we already ran with pure Perl", 13 
+        if $Data::Dumper::Useperl;
+    local $Data::Dumper::Useperl = 1;
+    run_tests_for_sortkeys();
 }
 
-{
-    my ($obj, %dumps, $starting);
-
-    note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef");
-    sub reversekeys { return [ reverse sort keys %{+shift} ]; }
-
-    note("XS implementation");
-    $Data::Dumper::Useperl = 0;
-
-    $starting = $Data::Dumper::Sortkeys;
-    local $Data::Dumper::Sortkeys = \&reversekeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddsksub'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys(\&reversekeys);
-    $dumps{'objsksub'} = _dumptostr($obj);
-
-    is($dumps{'ddsksub'}, $dumps{'objsksub'},
-        "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) are equivalent");
-    like($dumps{'ddsksub'},
-        qr/gamma.*?delta.*?beta.*?alpha/s,
-        "Sortkeys returned hash keys per sorting subroutine");
-    %dumps = ();
-
-    note("Perl implementation");
-    $Data::Dumper::Useperl = 1;
-
-    $starting = $Data::Dumper::Sortkeys;
-    local $Data::Dumper::Sortkeys = \&reversekeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddsksub'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys(\&reversekeys);
-    $dumps{'objsksub'} = _dumptostr($obj);
-
-    is($dumps{'ddsksub'}, $dumps{'objsksub'},
-        "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) are equivalent");
-    like($dumps{'ddsksub'},
-        qr/gamma.*?delta.*?beta.*?alpha/s,
-        "Sortkeys returned hash keys per sorting subroutine");
-}
-
-{
-    my ($obj, %dumps, $starting);
-
-    note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef with filter");
-    sub reversekeystrim {
-        my $hr = shift;
-        my @keys = sort keys %{$hr};
-        shift(@keys);
-        return [ reverse @keys ];
+sub run_tests_for_sortkeys {
+    note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
+
+    my %d = (
+        delta   => 'd',
+        beta    => 'b',
+        gamma   => 'c',
+        alpha   => 'a',
+    );
+    
+    {
+        my ($obj, %dumps, $sortkeys, $starting);
+    
+        note("\$Data::Dumper::Sortkeys and Sortkeys() set to true value");
+    
+        $starting = $Data::Dumper::Sortkeys;
+        $sortkeys = 1;
+        local $Data::Dumper::Sortkeys = $sortkeys;
+        $obj = Data::Dumper->new( [ \%d ] );
+        $dumps{'ddskone'} = _dumptostr($obj);
+        local $Data::Dumper::Sortkeys = $starting;
+    
+        $obj = Data::Dumper->new( [ \%d ] );
+        $obj->Sortkeys($sortkeys);
+        $dumps{'objskone'} = _dumptostr($obj);
+    
+        is($dumps{'ddskone'}, $dumps{'objskone'},
+            "\$Data::Dumper::Sortkeys = 1 and Sortkeys(1) are equivalent");
+        like($dumps{'ddskone'},
+            qr/alpha.*?beta.*?delta.*?gamma/s,
+            "Sortkeys returned hash keys in Perl's default sort order");
+        %dumps = ();
+    
+    }
+    
+    {
+        my ($obj, %dumps, $starting);
+    
+        note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef");
+    
+        $starting = $Data::Dumper::Sortkeys;
+        local $Data::Dumper::Sortkeys = \&reversekeys;
+        $obj = Data::Dumper->new( [ \%d ] );
+        $dumps{'ddsksub'} = _dumptostr($obj);
+        local $Data::Dumper::Sortkeys = $starting;
+    
+        $obj = Data::Dumper->new( [ \%d ] );
+        $obj->Sortkeys(\&reversekeys);
+        $dumps{'objsksub'} = _dumptostr($obj);
+    
+        is($dumps{'ddsksub'}, $dumps{'objsksub'},
+            "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) are equivalent");
+        like($dumps{'ddsksub'},
+            qr/gamma.*?delta.*?beta.*?alpha/s,
+            "Sortkeys returned hash keys per sorting subroutine");
+        %dumps = ();
+    
+    }
+    
+    {
+        my ($obj, %dumps, $starting);
+    
+        note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef with filter");
+        $starting = $Data::Dumper::Sortkeys;
+        local $Data::Dumper::Sortkeys = \&reversekeystrim;
+        $obj = Data::Dumper->new( [ \%d ] );
+        $dumps{'ddsksub'} = _dumptostr($obj);
+        local $Data::Dumper::Sortkeys = $starting;
+    
+        $obj = Data::Dumper->new( [ \%d ] );
+        $obj->Sortkeys(\&reversekeystrim);
+        $dumps{'objsksub'} = _dumptostr($obj);
+    
+        is($dumps{'ddsksub'}, $dumps{'objsksub'},
+            "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) select same keys");
+        like($dumps{'ddsksub'},
+            qr/gamma.*?delta.*?beta/s,
+            "Sortkeys returned hash keys per sorting subroutine");
+        unlike($dumps{'ddsksub'},
+            qr/alpha/s,
+            "Sortkeys filtered out one key per request");
+        %dumps = ();
+    
+    }
+    
+    {
+        my ($obj, %dumps, $sortkeys, $starting);
+    
+        note("\$Data::Dumper::Sortkeys(undef) and Sortkeys(undef)");
+    
+        $starting = $Data::Dumper::Sortkeys;
+        $sortkeys = 0;
+        local $Data::Dumper::Sortkeys = $sortkeys;
+        $obj = Data::Dumper->new( [ \%d ] );
+        $dumps{'ddskzero'} = _dumptostr($obj);
+        local $Data::Dumper::Sortkeys = $starting;
+    
+        $obj = Data::Dumper->new( [ \%d ] );
+        $obj->Sortkeys($sortkeys);
+        $dumps{'objskzero'} = _dumptostr($obj);
+    
+        $sortkeys = undef;
+        local $Data::Dumper::Sortkeys = $sortkeys;
+        $obj = Data::Dumper->new( [ \%d ] );
+        $dumps{'ddskundef'} = _dumptostr($obj);
+        local $Data::Dumper::Sortkeys = $starting;
+    
+        $obj = Data::Dumper->new( [ \%d ] );
+        $obj->Sortkeys($sortkeys);
+        $dumps{'objskundef'} = _dumptostr($obj);
+    
+        is($dumps{'ddskzero'}, $dumps{'objskzero'},
+            "\$Data::Dumper::Sortkeys = 0 and Sortkeys(0) are equivalent");
+        is($dumps{'ddskzero'}, $dumps{'ddskundef'},
+            "\$Data::Dumper::Sortkeys = 0 and = undef equivalent");
+        is($dumps{'objkzero'}, $dumps{'objkundef'},
+            "Sortkeys(0) and Sortkeys(undef) are equivalent");
+        %dumps = ();
+    
+    }
+    
+    note("Internal subroutine _sortkeys");
+    my %e = (
+        nu      => 'n',
+        lambda  => 'l',
+        kappa   => 'k',
+        mu      => 'm',
+        omicron => 'o',
+    );
+    my $rv = Data::Dumper::_sortkeys(\%e);
+    is(ref($rv), 'ARRAY', "Data::Dumper::_sortkeys returned an array ref");
+    is_deeply($rv, [ qw( kappa lambda mu nu omicron ) ],
+        "Got keys in Perl default order");
+    {
+        my $warning = '';
+        local $SIG{__WARN__} = sub { $warning = $_[0] };
+    
+        my ($obj, %dumps, $starting);
+    
+        note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef");
+    
+        $starting = $Data::Dumper::Sortkeys;
+        local $Data::Dumper::Sortkeys = \&badreturnvalue;
+        $obj = Data::Dumper->new( [ \%d ] );
+        $dumps{'ddsksub'} = _dumptostr($obj);
+        like($warning, qr/^Sortkeys subroutine did not return ARRAYREF/,
+            "Got expected warning: sorting routine did not return array ref");
     }
 
-    note("XS implementation");
-    $Data::Dumper::Useperl = 0;
-
-    $starting = $Data::Dumper::Sortkeys;
-    local $Data::Dumper::Sortkeys = \&reversekeystrim;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddsksub'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys(\&reversekeystrim);
-    $dumps{'objsksub'} = _dumptostr($obj);
-
-    is($dumps{'ddsksub'}, $dumps{'objsksub'},
-        "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) select same keys");
-    like($dumps{'ddsksub'},
-        qr/gamma.*?delta.*?beta/s,
-        "Sortkeys returned hash keys per sorting subroutine");
-    unlike($dumps{'ddsksub'},
-        qr/alpha/s,
-        "Sortkeys filtered out one key per request");
-    %dumps = ();
-
-    note("Perl implementation");
-    $Data::Dumper::Useperl = 1;
-
-    $starting = $Data::Dumper::Sortkeys;
-    local $Data::Dumper::Sortkeys = \&reversekeystrim;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddsksub'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys(\&reversekeystrim);
-    $dumps{'objsksub'} = _dumptostr($obj);
-
-    is($dumps{'ddsksub'}, $dumps{'objsksub'},
-        "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) select same keys");
-    like($dumps{'ddsksub'},
-        qr/gamma.*?delta.*?beta/s,
-        "Sortkeys returned hash keys per sorting subroutine");
-    unlike($dumps{'ddsksub'},
-        qr/alpha/s,
-        "Sortkeys filtered out one key per request");
 }
 
-{
-    my ($obj, %dumps, $sortkeys, $starting);
-
-    note("\$Data::Dumper::Sortkeys(undef) and Sortkeys(undef)");
-    note("XS implementation");
-    $Data::Dumper::Useperl = 0;
-
-    $starting = $Data::Dumper::Sortkeys;
-    $sortkeys = 0;
-    local $Data::Dumper::Sortkeys = $sortkeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddskzero'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys($sortkeys);
-    $dumps{'objskzero'} = _dumptostr($obj);
-
-    $sortkeys = undef;
-    local $Data::Dumper::Sortkeys = $sortkeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddskundef'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys($sortkeys);
-    $dumps{'objskundef'} = _dumptostr($obj);
+sub reversekeys { return [ reverse sort keys %{+shift} ]; }
 
-    is($dumps{'ddskzero'}, $dumps{'objskzero'},
-        "\$Data::Dumper::Sortkeys = 0 and Sortkeys(0) are equivalent");
-    is($dumps{'ddskzero'}, $dumps{'ddskundef'},
-        "\$Data::Dumper::Sortkeys = 0 and = undef equivalent");
-    is($dumps{'objkzero'}, $dumps{'objkundef'},
-        "Sortkeys(0) and Sortkeys(undef) are equivalent");
-    %dumps = ();
-
-    note("Perl implementation");
-    $Data::Dumper::Useperl = 1;
-
-    $starting = $Data::Dumper::Sortkeys;
-    $sortkeys = 0;
-    local $Data::Dumper::Sortkeys = $sortkeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddskzero'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys($sortkeys);
-    $dumps{'objskzero'} = _dumptostr($obj);
-
-    $sortkeys = undef;
-    local $Data::Dumper::Sortkeys = $sortkeys;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddskundef'} = _dumptostr($obj);
-    local $Data::Dumper::Sortkeys = $starting;
-
-    $obj = Data::Dumper->new( [ \%d ] );
-    $obj->Sortkeys($sortkeys);
-    $dumps{'objskundef'} = _dumptostr($obj);
-
-    is($dumps{'ddskzero'}, $dumps{'objskzero'},
-        "\$Data::Dumper::Sortkeys = 0 and Sortkeys(0) are equivalent");
-    is($dumps{'ddskzero'}, $dumps{'ddskundef'},
-        "\$Data::Dumper::Sortkeys = 0 and = undef equivalent");
-    is($dumps{'objkzero'}, $dumps{'objkundef'},
-        "Sortkeys(0) and Sortkeys(undef) are equivalent");
+sub reversekeystrim {
+    my $hr = shift;
+    my @keys = sort keys %{$hr};
+    shift(@keys);
+    return [ reverse @keys ];
 }
 
-note("Internal subroutine _sortkeys");
-my %e = (
-    nu      => 'n',
-    lambda  => 'l',
-    kappa   => 'k',
-    mu      => 'm',
-    omicron => 'o',
-);
-my $rv = Data::Dumper::_sortkeys(\%e);
-is(ref($rv), 'ARRAY', "Data::Dumper::_sortkeys returned an array ref");
-is_deeply($rv, [ qw( kappa lambda mu nu omicron ) ],
-    "Got keys in Perl default order");
-
-{
-    my $warning = '';
-    local $SIG{__WARN__} = sub { $warning = $_[0] };
-
-    my ($obj, %dumps, $starting);
-
-    note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef");
-    sub badreturnvalue { return { %{+shift} }; }
-
-    note("Perl implementation");
-    $Data::Dumper::Useperl = 1;
-
-    $starting = $Data::Dumper::Sortkeys;
-    local $Data::Dumper::Sortkeys = \&badreturnvalue;
-    $obj = Data::Dumper->new( [ \%d ] );
-    $dumps{'ddsksub'} = _dumptostr($obj);
-    like($warning, qr/^Sortkeys subroutine did not return ARRAYREF/,
-        "Got expected warning: sorting routine did not return array ref");
-}
+sub badreturnvalue { return { %{+shift} }; }
Unnamed repository; edit this file 'description' to name the repository.