#!/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 $/; }; 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; }