#!perl # autoprint => 1 causes EzDD obj to print to STDOUT if called in void # context. autoprint => 2 sends output STDERR use strict; use Test::More (tests => 24); pass "test void-context calls"; use_ok qw( Data::Dumper::EasyOO ); my $ddez = Data::Dumper::EasyOO->new(indent=>1); isa_ok ($ddez, 'Data::Dumper::EasyOO', "new() retval"); cleanup(); $!=0; sub content_matches { # Mojo, the helper monkey my ($fname, $rex) = @_; open (my $fh, $fname) or die "$!: $fname"; local $/ = undef; my $buf = <$fh>; return 1 if $buf =~ m/$rex/; print "failed content-check, got: $buf, expected $rex\n"; return 0; } sub write2it { my ($it, $i, $tag, $what) = @_; my $ddez = Data::Dumper::EasyOO->new(indent=>1); $ddez->Set(indent => $i, autoprint => $it); $ddez->($tag => $what); } SKIP: { eval "use Test::Output"; skip "need Test::Output to test autoprint to stdout,stderr", 9 if $@; stdout_is(sub{write2it(0, 1, 'foo','to stdout')}, '', "stdout is empty, as expected"); stdout_is(sub{write2it(1, 1, 'foo','to stdout')}, qq{\$foo = 'to stdout';\n}, "stdout has expected output"); stderr_is(sub{write2it(2,1, 'foo','to stderr')}, qq{\$foo = 'to stderr';\n}, "stderr has expected output"); stdout_is(sub{write2it(\*STDOUT,1, 'foo','to stdout')}, qq{\$foo = 'to stdout';\n}, '\*STDOUT has expected output'); stderr_is(sub{write2it(\*STDERR,1, 'foo','to stderr')}, qq{\$foo = 'to stderr';\n}, '\*STDERR has expected output'); stdout_is(sub{write2it(1, 1, 'bar',{a=>1, b=>2})}, <<'EORef', "stdout has expected hashdump"); $bar = { 'a' => 1, 'b' => 2 }; EORef stdout_is(sub{write2it(1, 2, 'bar',{a=>1, b=>2})}, <<'EORef', "stdout has expected hashdump"); $bar = { 'a' => 1, 'b' => 2 }; EORef stderr_is(sub{write2it(2, 1, 'baz',[qw(foo bar bum)])}, <<'EORef', "stderr has expected arraydump"); $baz = [ 'foo', 'bar', 'bum' ]; EORef stderr_is(sub{write2it(2, 2, 'baz',[qw(foo bar bum)])}, <<'EORef', "stderr has expected arraydump"); $baz = [ 'foo', 'bar', 'bum' ]; EORef } SKIP: { skip "- open(my \$fh) not in 5.00503", 3 unless $] >= 5.006; pass "testing autoprint to open filehandle (ie GLOB)"; open (my $fh, ">out.autoprint") or die "cant open out.autoprint: $!"; $ddez->Set(autoprint => $fh); $ddez->(foo => 'to file'); close $fh; # diag ("Note: expecting \$! warning: print() on closed filehandle \$fh"); local $SIG{__WARN__} = sub {}; # silence the warning eval { $ddez->(foo => 'to file') }; like ($!, qr/Bad file (number|descriptor)/, "got expected err writing to closed file: $!"); ok (content_matches("out.autoprint", qr/^\$foo = 'to file';$/), "out.autoprint has expected content"); } SKIP: { eval "use IO::String"; skip "these tests need IO::String", 2 if $@; pass "testing autoprint => IO using IO::string"; my $io = IO::String->new(my $var); $ddez->Set(autoprint => $io); $ddez->(foo => 'bar to iostring obj'); is ($var, "\$foo = 'bar to iostring obj';\n", "autoprint to IO::string storage"); } SKIP: { skip "these tests need 5.8.0", 2 if $] < 5.008; pass "testing autoprint => IO using 5.8 open (H, '>', \\\$scalar)"; my ($var,$io); # w/o eval, this breaks compile under 5.5.3 eval "open (\$io, '>', \\\$var)"; warn $@ if $@; $ddez->Set(autoprint => $io); $ddez->(foo => 'bar to opened scalar-ref'); is ($var, "\$foo = 'bar to opened scalar-ref';\n", "autoprint to opened scalar ref"); } SKIP: { eval "use Test::Warn"; skip("these tests need Test::Warn", 5) if $@; pass("testing autoprint invocation w.o setup"); my $ddez = Data::Dumper::EasyOO->new(indent=>1); # warning_like is more relaxed vs carp vs warn warning_like ( sub { $ddez->(foo=>'bar') }, qr/called in void context, without autoprint defined/, "expected warning b4 setup"); open (my $fh, ">out.autoprint") or die "cant open out.autoprint: $!"; $ddez->Set(autoprint => $fh); $ddez->(ok => 'yeah'); $ddez->(foo => 'to file'); close $fh; ok (content_matches("out.autoprint", qr/^\$ok = 'yeah';\n\$foo = 'to file';$/), "out.autoprint has expected content"); $ddez->Set(autoprint => undef); warning_like ( sub { $ddez->(foo=>'bar') }, qr/called in void context, without autoprint defined/, "expected warning after autoprint reset to undef"); { # test package, which cannot print package Foo; sub new { bless {}, shift} } $ddez->Set(autoprint => new Foo); local $SIG{__WARN__} = sub {}; # silence the warning to the terminal $ddez->(\%INC); warning_like ( sub { $ddez->(foo=>'bar') }, qr/illegal autoprint value: Foo=HASH/, "expected warning when autoprinting to un-capable object"); } unless ($ENV{TEST_VERBOSE}) { cleanup(); } else { diag "to see output files (normally deleted), set TEST_VERBOSE b4 test"; } sub cleanup { unlink "auto.stderr2","auto.stdout2"; unlink "auto.stderr1","auto.stdout1"; unlink "auto.stderr","auto.stdout"; unlink "out.autoprint"; } __END__