view release on metacpan or  search on metacpan

t/tlib/AssertTest.pm  view on Meta::CPAN

package AssertTest;

use strict;
use warnings;

use ExceptionChecker;
use TestObject;
use Test::Unit::TestCase;
use Test::Unit::Failure;
use Test::Unit::Error;

use Error qw/:try/;
use Class::Inner;

our @ISA = qw(Test::Unit::TestCase ExceptionChecker);

sub test_assert_equals {
    my $self = shift;
    my $o = TestObject->new();
    $self->assert_equals($o, $o);

    $self->check_failures
      ("expected 'start o:MyClass=HASH(0x1404343f0) | any o:MyClass=HASH(0x1404343f0) e:start | any o:MyClass=HASH(0x1404343f0) e:in', got 'start o: e: | any o:start e: | any o:in e:'" =>
       # A false-negative that burned me; problem with is_numeric
       # Test must be all on one line
       [ __LINE__, sub { shift->assert_equals("start o:MyClass=HASH(0x1404343f0) | any o:MyClass=HASH(0x1404343f0) e:start | any o:MyClass=HASH(0x1404343f0) e:in", "start o: e: | any o:start e: | any o:in e:"); } ],
      );
}

# ...and the root of that problem in test_assert_equals
sub test_numericness {
    my $self = shift;
    my %tests =
      ( 1 => 't',
        0 => 't',

        '15e7' => 't',
        '15E7' => 't',
        "not 0" => 'f',
        "not 4" => 'f',
        "  \n 5E2" => 't',
        "  \t 0E0  " => 't',
      );
    foreach my $str (keys %tests) {
      my $expect = $tests{$str};
      my $actual = Test::Unit::Assert::is_numeric($str) ? 't' : 'f';
      $self->fail("For string '$str', expect $expect but got $actual")
        unless $expect eq $actual;
    }

    if ($] gt '5.029001' && $] lt '5.031004') {
        # https://github.com/Perl/perl5/issues/17062
        # skipping test, broken around v5.30 because of bug in perl
    } else {
        my $actual = Test::Unit::Assert::is_numeric('0xF00') ? 't' : 'f';
        $self->fail("For string '0xF00', expect f but got $actual")
          unless 'f' eq $actual;
    }
}


sub test_assert {
    my $self = shift;
    $self->assert(1);
    $self->assert(1, 'should be true');
    $self->assert(qr/foo/, 'foobar');
    $self->assert(qr/foo/, 'foobar', 'should match /foo/');
    my $coderef = sub {
        $_[0] eq $_[1] or $self->fail("$_[0] ne $_[1]");
    };
    $self->assert($coderef, 'a', 'a');
    $self->assert([]);
    $self->assert([ 'foo', 7 ]);

    my $qr_string = "" . qr/foo/; # for use in tests below
    $self->check_failures(
        'Boolean assertion failed' => [ __LINE__, sub { shift->assert(undef) } ],
        'Boolean assertion failed' => [ __LINE__, sub { shift->assert(0)   } ],
        'Boolean assertion failed' => [ __LINE__, sub { shift->assert('')  } ],

        'bang'  => [ __LINE__, sub { shift->assert(0, 'bang')              } ],
        'bang'  => [ __LINE__, sub { shift->assert('', 'bang')             } ],
        "'qux' did not match /$qr_string/"
                => [ __LINE__, sub { shift->assert(qr/foo/, 'qux')         } ],
        'bang'  => [ __LINE__, sub { shift->assert(qr/foo/, 'qux', 'bang') } ],
        'a ne b'=> [ __LINE__, sub { shift->assert($coderef, 'a', 'b')     } ],
    );
}

sub test_assert_str_equals {
    my $self = shift;
    my @pass = (
        ['', ''],
        [0, 0],
        [1, 1],
        ['foo', 'foo'],
    );
    foreach my $pair (@pass) {
        my ($expected, $got) = @$pair;
        $self->assert_str_equals($expected, $got);
        $self->assert_str_equals($expected, $got, 'failure message');
    }
    $self->check_failures(
        'expected value was undef; should be using assert_null?' =>
          [ __LINE__, sub { shift->assert_str_equals(undef, undef) } ],
        'expected value was undef; should be using assert_null?' =>
          [ __LINE__, sub { shift->assert_str_equals(undef, 0)     } ],
        'expected value was undef; should be using assert_null?' =>
          [ __LINE__, sub { shift->assert_str_equals(undef, '')    } ],
        'expected value was undef; should be using assert_null?' =>
          [ __LINE__, sub { shift->assert_str_equals(undef, 'foo') } ],