t/comp/assertions.t

   1 #!./perl
   2
   3 BEGIN { $^W=0 }
   4
   5 use base 'assertions::compat';
   6
   7 sub callme ($ ) : assertion {
   8     return shift;
   9 }
  10
  11 # select STDERR; $|=1;
  12
  13 my @expr=( '1' => 1,
  14            '0' => 0,
  15            '1 && 1' => 1,
  16            '1 && 0' => 0,
  17            '0 && 1' => 0,
  18            '0 && 0' => 0,
  19            '1 || 1' => 1,
  20            '1 || 0' => 1,
  21            '0 || 1' => 1,
  22            '0 || 0' => 0,
  23            '(1)' => 1,
  24            '(0)' => 0,
  25            '1 && ((1) && 1)' => 1,
  26            '1 && (0 || 1)' => 1,
  27            '1 && ( 0' => undef,
  28            '1 &&' => undef,
  29            '&& 1' => undef,
  30            '1 && || 1' => undef,
  31            '(1 && 1) && 1)' => undef,
  32            'one && two' => 1,
  33            '_ && one' => 0,
  34            'one && three' => 0,
  35            '1 ' => 1,
  36            ' 1' => 1,
  37            ' 1 ' => 1,
  38            ' ( 1 && 1 ) ' => 1,
  39            ' ( 1 && 0 ) ' => 0,
  40            '(( 1 && 1) && ( 1 || 0)) || _ && one && ( one || three)' => 1 );
  41
  42 my $supported = assertions::compat::supported();
  43
  44 my $n=@expr/2 + ($supported ? 10 : 0);
  45 my $i=1;
  46 print "1..$n\n";
  47
  48 use assertions::activate 'one', 'two';
  49 require assertions;
  50
  51 while (@expr) {
  52     my $expr=shift @expr;
  53     my $expected=shift @expr;
  54     my $result=eval {assertions::_calc_expr($expr)};
  55     if (defined $expected) {
  56         unless (defined $result and $result == $expected) {
  57             print STDERR "assertions::_calc_expr($expr) failed,".
  58                 " expected '$expected' but '$result' obtained (\$@=$@)\n";
  59             print "not ";
  60         }
  61     }
  62     else {
  63         if (defined $result) {
  64             print STDERR "assertions::_calc_expr($expr) failed,".
  65                 " expected undef but '$result' obtained\n";
  66             print "not ";
  67         }
  68     }
  69     print "ok ", $i++, "\n";
  70 }
  71
  72 if ($supported) {
  73
  74     # @expr/2+1
  75     if (callme(1)) {
  76         print STDERR "assertions called by default\n";
  77         print "not ";
  78     }
  79     print "ok ", $i++, "\n";
  80
  81     # 2
  82     use assertions::activate 'mine';
  83     {
  84         package mine;
  85         use base 'assertions::compat';
  86         sub callme ($) : assertion {
  87             return shift;
  88         }
  89             use assertions;
  90         unless (callme(1)) {
  91             print STDERR "'use assertions;' doesn't active assertions based on package name\n";
  92             print "not ";
  93         }
  94     }
  95     print "ok ", $i++, "\n";
  96
  97     # 3
  98     use assertions 'foo';
  99     if (callme(1)) {
 100         print STDERR "assertion deselection doesn't work\n";
 101         print "not ";
 102     }
 103     print "ok ", $i++, "\n";
 104
 105     # 4
 106     use assertions::activate 'bar', 'doz';
 107     use assertions 'bar';
 108     unless (callme(1)) {
 109         print STDERR "assertion selection doesn't work\n";
 110         print "not ";
 111     }
 112     print "ok ", $i++, "\n";
 113
 114     # 5
 115     use assertions q(_ && doz);
 116     unless (callme(1)) {
 117         print STDERR "assertion activation filtering doesn't work\n";
 118         print "not ";
 119     }
 120     print "ok ", $i++, "\n";
 121
 122     # 6
 123     use assertions q(_ && foo);
 124     if (callme(1)) {
 125         print STDERR "assertion deactivation filtering doesn't work\n";
 126         print "not ";
 127     }
 128     print "ok ", $i++, "\n";
 129
 130     # 7
 131     if (1) {
 132         use assertions 'bar';
 133     }
 134     if (callme(1)) {
 135         print STDERR "assertion scoping doesn't work\n";
 136         print "not ";
 137     }
 138     print "ok ", $i++, "\n";
 139
 140     # 8
 141     use assertions::activate 're.*';
 142     use assertions 'reassert';
 143     unless (callme(1)) {
 144         print STDERR "assertion selection with re failed\n";
 145         print "not ";
 146     }
 147     print "ok ", $i++, "\n";
 148
 149     # 9
 150     my $b=12;
 151     {
 152         use assertions 'bar';
 153         callme(my $b=45);
 154         unless ($b == 45) {
 155             print STDERR "this shouldn't fail ever (b=$b)\n";
 156             print "not ";
 157         }
 158     }
 159     print "ok ", $i++, "\n";
 160
 161     # 10
 162     {
 163         no assertions;
 164         callme(my $b=46);
 165         if (defined $b) {
 166             print STDERR "lexical declaration in assertion arg ignored (b=$b\n";
 167             print "not ";
 168         }
 169     }
 170     print "ok ", $i++, "\n";
 171 }