wlan-lanforge-scripts/LANforge/Test.pm

# test utilities for LANforge scripts
package LANforge::Test;
use strict;
use warnings;
use diagnostics;
use Carp;

# Ubuntu: libtest2-suite-perl
use Test2::V0 qw(ok fail done_testing);
use Test2::Tools::Basic qw(plan);


$SIG{ __DIE__  } = sub { Carp::confess( @_ ) };
$SIG{ __WARN__ } = sub { Carp::confess( @_ ) };

# Un-buffer output
$| = 1;
use Data::Dumper;

if (defined $ENV{'DEBUG'}) {
   use Data::Dumper;
   use diagnostics;
   use Carp;
   $SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
}

require Exporter;
our @EXPORT_OK=qw(new test);

#our $FAIL   = 'fail';
#our $OK     = 'pass';
#our $PASS     = 'pass';
our @test_errors = ();

sub new {
   my $class = shift;
   my $self = {};
   my %parm = @_;
   $self->{'Name'} = $parm{'Name'};
   $self->{'Desc'} = $parm{'Desc'};
   $self->{'Errors'} = [];
   $self->{'ExpectedNumber'} = 1;
   $self->{'Test'} = undef;
   if (defined $parm{'Test'}) {
      #print "new: Creating Test $self->{'Name'}\n";
      $self->{'Test'} = $parm{'Test'};
   }
   if (defined $parm{'ExpectedNumber'}) {
      $self->{'ExpectedNumber'} = $parm{'ExpectedNumber'};
   }
   bless $self, $class;
   return $self;
}

sub run {
  plan(1);
  my $self = shift;
  print "Run $self->{Name}\n";
  my $result = shift;
  
  ok($result, $self->{'Name'}) || fail($self->{'Name'});
  done_testing();
}

sub test {
   my $self = shift;
   if (! (defined $self->{'Test'})) {
      print "LANforge::test lacks self->Test, please rewrite your script.\n";
      return $::FAIL;
   }
   return  $self->{'Test'}($self, @_);
}
sub test_err {
  my $self = shift;
  for my $e (@_) {
    my $ref = "".(caller(1))[3].":".(caller(1))[2]."";
    push (@::test_errors, "$ref: $e");
  }
}
1;