LANTI has asked for the wisdom of the Perl Monks concerning the following question:
Hi, I am writing some tests for scripts (not modules). The test mocks some objects to avoid calls to a server and than evaluates the tested script several times. While this works fine now, there are still some nasty warnings about redefined subroutines. Somehow this problem is by design but I wonder if there is a way to avoid this. Following the code. The tested script is located beneath the DATA token.
Thanks in advance, Ingo
#!/usr/bin/perl -w use warnings; use strict; use feature qw(switch say); use English; use Test::More tests => 20; #'no_plan'; use Test::MockObject; use Test::Output; use Test::Trap; my $mock = Test::MockObject->new(); $mock->fake_module ('NaServer', new => sub { return 'NaServer' }, get_val => sub { return 500 }, ); use_ok( 'NaServer' ) or exit; ## includes 'use NaServer;' # Construction of $s just for testing my $s = NaServer->new( 'sim8aXXXXXX', 1, 6 ); isa_ok( $s, 'NaServer'); # ================================== # = Tests of the script start here = # ================================== use File::Slurp; #my $script = 'script_to_test_with_subs.pl'; # used __DATA__ instead my $code_to_test = do { local $/; <DATA> }; my @cases = ('A', 'B', 'C'); foreach my $case (@cases) { use_ok('NaServer'); can_ok( 'NaServer', 'new'); can_ok( 'NaServer', 'get_val'); my @r = trap { push @ARGV, $case; #eval read_file($script); eval $code_to_test; ## no critic (ProhibitStringyEval) if (defined $EVAL_ERROR) { die $EVAL_ERROR }; }; if ($trap->die) { croak $trap->die; } if ($trap->warn) { foreach (@{$trap->warn}) { warn $_ . "\n"; } } like ( $trap->stdout, qr'Value\ for\ [A-Z]\ OK\ \(500\)\n', "$case: stdout as expected (OK 500)" ); like ( $trap->stderr, qr'', "$case: stderr as expected (emtpy)" ); is ( $trap->exit, 0, "$case: exit-value as expected (0)" ); } __DATA__ # ================== # = Script to Test = # ================== #!/usr/bin/perl -w use warnings; use strict; use feature qw(switch say); use NaServer; use Carp; my $dings = $ARGV[0] || 'dummydings'; my $session = NaServer->new(); my $val = $session->get_val(); if ($val > 500 ) { say_it ("Value for $dings to high: " . $val); exit 2; } else { say_it ("Value for $dings OK ($val)"); exit 0; } sub say_it { my $msg = shift; say $msg; return; }
$ ./eval_with_loop.t 1..20 ok 1 - use NaServer; ok 2 - The class isa NaServer ok 3 - use NaServer; ok 4 - NaServer->can('new') ok 5 - NaServer->can('get_val') ok 6 - A: stdout as expected (OK 500) ok 7 - A: stderr as expected (emtpy) ok 8 - A: exit-value as expected (0) ok 9 - use NaServer; ok 10 - NaServer->can('new') ok 11 - NaServer->can('get_val') Subroutine say_it redefined at (eval 35) line 24. ok 12 - B: stdout as expected (OK 500) ok 13 - B: stderr as expected (emtpy) ok 14 - B: exit-value as expected (0) ok 15 - use NaServer; ok 16 - NaServer->can('new') ok 17 - NaServer->can('get_val') Subroutine say_it redefined at (eval 40) line 24. ok 18 - C: stdout as expected (OK 500) ok 19 - C: stderr as expected (emtpy) ok 20 - C: exit-value as expected (0)
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: string-eval code more than once
by moritz (Cardinal) on May 17, 2010 at 10:17 UTC | |
by LANTI (Sexton) on May 18, 2010 at 09:17 UTC | |
|
Re: string-eval code more than once
by JavaFan (Canon) on May 17, 2010 at 11:46 UTC | |
|
Re: string-eval code more than once
by Anonymous Monk on May 17, 2010 at 10:17 UTC |