Examples/test-suite/perl5/contract_runme.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 32;
   5 BEGIN { use_ok('contract') }
   6 require_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