1#!/usr/bin/perl 2use strict; 3use warnings; 4use Test::More tests => 32; 5BEGIN { use_ok('contract') } 6require_ok('contract'); 7 8# adapted from ../python/contract_runme.py 9{ 10 ok(contract::test_preassert(1,2), "good preassertion"); 11 eval { contract::test_preassert(-1) }; 12 like($@, qr/\bRuntimeError\b/, "bad preassertion"); 13 14 ok(contract::test_postassert(3), "good postassertion"); 15 eval { contract::test_postassert(-3) }; 16 like($@, qr/\bRuntimeError\b/, "bad postassertion"); 17 18 ok(contract::test_prepost(2,3), "good prepost"); 19 ok(contract::test_prepost(5,-4), "good prepost"); 20 eval { contract::test_prepost(-3,4); }; 21 like($@, qr/\bRuntimeError\b/, "bad preassertion"); 22 eval { contract::test_prepost(4,-10) }; 23 like($@, qr/\bRuntimeError\b/, "bad postassertion"); 24} 25{ 26 my $f = contract::Foo->new(); 27 ok($f->test_preassert(4,5), "method pre"); 28 eval { $f->test_preassert(-2,3) }; 29 like($@, qr/\bRuntimeError\b/, "method pre bad"); 30 31 ok($f->test_postassert(4), "method post"); 32 eval { $f->test_postassert(-4) }; 33 like($@, qr/\bRuntimeError\b/, "method post bad"); 34 35 ok($f->test_prepost(3,4), "method prepost"); 36 ok($f->test_prepost(4,-3), "method prepost"); 37 eval { $f->test_prepost(-4,2) }; 38 like($@, qr/\bRuntimeError\b/, "method pre bad"); 39 eval { $f->test_prepost(4,-10) }; 40 like($@, qr/\bRuntimeError\b/, "method post bad"); 41} 42{ 43 ok(contract::Foo::stest_prepost(4,0), "static method prepost"); 44 eval { contract::Foo::stest_prepost(-4,2) }; 45 like($@, qr/\bRuntimeError\b/, "static method pre bad"); 46 eval { contract::Foo::stest_prepost(4,-10) }; 47 like($@, qr/\bRuntimeError\b/, "static method post bad"); 48} 49{ 50 my $b = contract::Bar->new(); 51 eval { $b->test_prepost(2,-4) }; 52 like($@, qr/\bRuntimeError\b/, "inherit pre bad"); 53} 54{ 55 my $d = contract::D->new(); 56 eval { $d->foo(-1,1,1,1,1) }; 57 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 58 eval { $d->foo(1,-1,1,1,1) }; 59 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 60 eval { $d->foo(1,1,-1,1,1) }; 61 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 62 eval { $d->foo(1,1,1,-1,1) }; 63 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 64 eval { $d->foo(1,1,1,1,-1) }; 65 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 66 67 eval { $d->bar(-1,1,1,1,1) }; 68 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 69 eval { $d->bar(1,-1,1,1,1) }; 70 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 71 eval { $d->bar(1,1,-1,1,1) }; 72 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 73 eval { $d->bar(1,1,1,-1,1) }; 74 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 75 eval { $d->bar(1,1,1,1,-1) }; 76 like($@, qr/\bRuntimeError\b/, "inherit pre D"); 77} 78 79