t/comp/assertions.t

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