Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

string-eval code more than once

by LANTI (Sexton)
on May 17, 2010 at 09:50 UTC ( #840308=perlquestion: print w/replies, xml ) Need Help??
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; }

Output

Just for completeness the output:
$ ./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
    Somehow this problem is by design
    Indeed.
    but I wonder if there is a way to avoid this.
    My favourite solution is to make the script such a shallow and simple wrapper around a module (and put all the logic into the module) that it doesn't really need any testing. Consider
    #!/usr/bin/perl use NaServer qw(run); run(@ARGV);

    And then do all the testing on NaServer::run instead. Since it's located in a module, you just use it once in the test script, apply the monkey patching you need, and just test as usual.

    Other solution:

    1) put a package YourPackage; in front of the string you eval, and after the run clean the namespace with an appropriate CPAN module

    2) just as 1), but use a separate package name for each run, thus avoidng name collisions.

    Perl 6 - links to (nearly) everything that is Perl 6.

      Thanks for the input which seems to have brought me a huge step forward. I did some tests and tries and following the code and my findings for future reference.

      Since there was such a strong bias towards putting anything into a module, I tried your quiet radical way of

      #!/usr/bin/perl use NaServer qw(run); run(@ARGV);

      First I had to rewrite my example, adopting it towards real-life in order to have something on which I can prove, that I can test what I want to test even if it is wrapped into module. The background was, that I wanted to write an integration-test, which takes some command-line arguments, feeds them to the tested script and checks, if the output is what I expect. Here comes the script-version, which is the common way of handling user-input but is hard to test.

      Script Version

      The test-stcript; the tested script is beneath the DATA-token. This code does not run, due to a redefinition of a sub_say. (At least not the testing-code, the tested script just runs fine.)
      #!/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 = ( { name => 'wrong_threshold', argv => 'hudriwudri', expected_stdout => qr'invalid argument', expected_stderr => '', expected_exit => 3, }, { name => 'high_threshold', argv => 1000, expected_stdout => qr'OK', expected_stderr => '', expected_exit => 0, } ); foreach my $case (@cases) { use_ok('NaServer'); can_ok( 'NaServer', 'new'); can_ok( 'NaServer', 'get_val'); my @r = trap { $ARGV[0] = $case->{'argv'}; #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, $case->{'expected_stdout'}, "$case->{'name'}: stdout as expected" ); is ( $trap->stderr, $case->{'expected_stderr'}, "$case->{'name'}: stderr as expected" ); is ( $trap->exit, $case->{'expected_exit'}, "$case->{'name'}: exit-value as expected" ); } __DATA__ # ================== # = Script to Test = # ================== #!/usr/bin/perl -w use warnings; use strict; use feature qw(switch say); use NaServer; my $threshold = $ARGV[0] || exit 3; if ($threshold =~ /\d+/) { my $session = NaServer->new(); my $val = $session->get_val(); if ($val > $threshold ) { say_it ("Value to high: " . $val); exit 2; } else { say_it ("Value OK ($val)"); exit 0; } } else { say 'invalid argument'; exit 3; } sub say_it { my $msg = shift; say $msg; return; }

      Module-Version of the same logic and functionality.

      As suggested by moritz I put all logic into a module. This should be easier to test.

      Extension-Module (NaServerExt.pm, replacement for the "Script to Test" in the above example)

      package NaServerExt; # this is a wrapper around the *dummy version* of NaServer !! use strict; use warnings; use feature qw( say ); use Carp; use NaServer; sub run { my ($self, @argv) = @_; my $threshold = $argv[0] || croak 'no arguments'; if ($threshold =~ /\d+/) { my $session = NaServer->new(); my $val = $session->get_val(); if ($val > $threshold ) { _say_it ("Value to high: " . $val); exit 2; } else { _say_it ("Value OK ($val)"); exit 0; } } else { say 'invalid argument'; exit 3; } } sub _say_it { my $msg = shift; say $msg; return; } 1; __END__ =pod =head1 USAGE This module substitutes a script using NaServer.pm (the dummy-version +only!). This way it is easier to test. It could be used by a script like this: #!/usr/bin/perl -w use warnings; use strict; use NaServerExt; NaServerExt->run(@ARGV); __END__ Do not forget: This is just for demonstrating something about testing +and has nearly to nothing to do with NetApps NaServer modules!! =cut

      Testscript (NaServerExt.t)

      The above module allows to write a clean and relatively simple test, with mocking and various user-input simulated.
      #!/usr/bin/perl -w use warnings; use strict; use feature qw( say ); use English; use Test::More tests => 26; #'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 module start here = # ================================== my @cases = ( { name => 'wrong_threshold', argv => 'hudriwudri', expected_stdout => qr'invalid argument', expected_stderr => '', expected_exit => 3, }, { name => 'high_threshold', argv => 1000, expected_stdout => qr'OK', expected_stderr => '', expected_exit => 0, }, { name => 'low_threshold', argv => 20, expected_stdout => qr'Value\ to\ high', expected_stderr => '', expected_exit => 2, } ); foreach my $case (@cases) { use_ok('NaServer'); can_ok( 'NaServer', 'new'); can_ok( 'NaServer', 'get_val'); use_ok('NaServerExt'); can_ok('NaServerExt', 'run'); my @r = trap { NaServerExt->run($case->{'argv'}); }; if ($trap->die) { croak $trap->die; } if ($trap->warn) { foreach (@{$trap->warn}) { warn $_ . "\n"; } } like ( $trap->stdout, $case->{'expected_stdout'}, "$case->{'name'}: stdout as expected" ); is ( $trap->stderr, $case->{'expected_stderr'}, "$case->{'name'}: stderr as expected" ); is ( $trap->exit, $case->{'expected_exit'}, "$case->{'name'}: exit-value as expected" ); }

      Conclusion

      Since the radical approach of writing minimal scripts and several layers of modules makes the code easier to test, I will try to redesign the script in this direction. Thanks again!

      Appendix

      The NaServer.pm, if someone wants to play with the examples above:

      package NaServer; # this is just a dummy version of NetApps NaServer !! use strict; use warnings; use Carp; sub new { my $class = shift; my $self = {}; bless \$self, $class; } sub get_val { return rand 1000; } 1;
Re: string-eval code more than once
by JavaFan (Canon) on May 17, 2010 at 11:46 UTC
    If you're certain the evalling of code is the way to go, then turn of the warning. Warning are not by definition things you do wrong - otherwise, they would be errors. Warnings are Perls way of saying "it may be that you are wrong here, but it may also be that I am wrong assuming you are wrong". Clearly, if you want to re-eval the code, you intent to redefine the sub, and the correct thing to do is to shut off the warning.
Re: string-eval code more than once
by Anonymous Monk on May 17, 2010 at 10:17 UTC
    Turn off warnings

    or

    write better scripts, write modules :)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://840308]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2018-06-24 00:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?



    Results (126 votes). Check out past polls.

    Notices?