covertest.pl

• package myObj
  • new
  • set_name
  • set_value
  • set_chars
  • get_name
  • get_value
  • get_chars
• package main
• EOF

#!/usr/bin/perl

use strict;
use warnings;

package myObj;

sub new {
  my $class = shift;
  my %args = @_;
  my $self = {};
  $self->{ name  } = $args{ name  } || 'default';
  $self->{ value } = $args{ value } || '';
  $self->{ chars } = $args{ chars } || qr/^[a-z]+$/;
  return bless $self, $class;
}

sub set_name  {
  my $self = shift;
  $self->{ name  } = shift;
  return;
}
sub set_value {
  my $self = shift;
  $self->{ value } = shift;
  return;
}
sub set_chars {
  my $self = shift;
  $self->{ chars } = shift;
  return;
}
sub get_name  {
  my $self = shift;
  return $self->{ name  };
}
sub get_value {
  my $self = shift;
  return $self->{ value };
}
sub get_chars {
  my $self = shift;
  return $self->{ chars };
}

package main;

use Test::More tests => 11;

ok( my $obj1 = myObj->new( name => 'test1',
                           value => 'myval',
                           chars => qr/^[0-9]$/
                         ), "can create a myObj specifying values" );
isa_ok( $obj1, 'myObj' );

ok( my $obj2 = myObj->new(), "can create a myObj not specifying values" );
isa_ok( $obj2, 'myObj' );

ok( ! $obj2->set_name(  'test1'     ), "can set name"  );
ok( 'test1' eq $obj2->get_name(),      "can get name"  );

ok( ! $obj2->set_value( 'myval'     ), "can set value" );
ok( 'myval' eq $obj2->get_value(),     "can get value" );

ok( ! $obj2->set_chars( qr/^[0-9]$/ ), "can set chars" );
ok( qr/^[0-9]$/ eq $obj2->get_chars(), "can get chars" );

is_deeply( $obj1, $obj2, "obj1 seems deeply similar to obj2" );