The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#-------------------------------------------------------------------
#
#   $Id: 07_test_error_messages.t,v 1.6 2009/06/01 20:43:06 erwan_lemonnier Exp $
#

package main;

use strict;
use warnings;
use lib "../lib/", "t/", "lib/";
use Test::More;
use Data::Dumper;
use Carp qw(croak confess longmess);

BEGIN {

    use check_requirements;
    plan tests => 9;

    use_ok("Sub::Contract",'contract');
};

#------------------------------------------------------------
#
# test errors in condition code
#
#------------------------------------------------------------

sub foo {
    return 1;
}

sub _die {
    die "whatever";
}

# test die from a sub
my $c = contract('foo')
    ->invariant(\&_die)
    ->enable;

eval { foo(); };
ok($@ =~ /whatever at .*07_test_error_messages.t line 34/, "condition dies with correct error message (called sub)");

# test die called from contract def
$c->reset
    ->invariant(sub {
	die "enough!!";
    })
    ->enable;

eval { foo(); };
ok($@ =~ /enough!! at .*07_test_error_messages.t line 48/, "condition dies with correct error message (anonymous sub)");

# test croak
$c->reset
    ->invariant(sub {
	croak "croaking now";
    })
    ->enable;

eval { foo(); };
ok($@ =~ /croaking now at .*07_test_error_messages.t line 62/, "condition croaks with correct error message (anonymous sub)");

# test confess
$c->reset
    ->invariant(sub {
	confess "confessing now";
    })
    ->enable;

eval { foo(); };

ok($@ =~ /confessing now at .*07_test_error_messages.t line 72/, "condition confesses with correct error message (anonymous sub)");

#------------------------------------------------------------
#
# test constraint failures
#
#------------------------------------------------------------

# invariant before
$c->reset->invariant( sub { return 0; } )->enable;
eval { foo(); };
ok($@ =~ /invariant fails before calling main::foo at .*\n.*main::contract_foo\(\) called at .*07_test_error_messages.t line 84\n.*at .*07_test_error_messages.t line 84/, "invariant fails before");

# invariant after
my $count = 0;
$c->reset->invariant( sub { $count++; return $count != 1; } )->enable;
eval { foo(); };
ok($@ =~ /invariant fails before calling main::foo at .*\n.*main::contract_foo\(\) called at .*07_test_error_messages.t line/, "invariant fails before");

# pre fails
$c->reset->pre( sub { return 0; } )->enable;
eval { foo(); };
ok($@ =~ /pre-condition fails before calling main::foo at .*\n.*main::contract_foo\(\) called at .*07_test_error_messages.t line/, "pre condition fails");

# post fails
$c->reset->post( sub { return 0; } )->enable;
eval { foo(); };
ok($@ =~ /post-condition fails after calling main::foo at .*\n.*main::contract_foo\(\) called at .*07_test_error_messages.t line 100.*\n.*07_test_error_messages.t line 100/mg, "post condition fails");

# TODO: add more tests