t/Boolean.t

   1 #!/usr/bin/perl
   2 #
   3
   4 use strict;
   5 #use warnings; FIXME - Bug 2505
   6 use C4::Boolean;
   7
   8 use vars qw( @tests );
   9 use vars qw( $loaded );
  10
  11 sub f ($) {
  12    my($x) = @_;
  13    my $it;
  14    # Returns either the value returned prefixed with 'OK:',
  15    # or the caught exception (string expected)
  16    local($@);
  17    eval {
  18       $it = 'OK:' . C4::Boolean::true_p($x);
  19    };
  20    if ($@) {
  21       $it = $@;
  22       $it =~ s/ at \S+ line \d+\.\n//s;
  23    }
  24    return $it;
  25 }
  26
  27 BEGIN {
  28    @tests = (
  29    [
  30       'control',
  31       sub { C4::Boolean::INVALID_BOOLEAN_STRING_EXCEPTION },
  32       'The given value does not seem to be interpretable as a Boolean value',
  33       undef
  34
  35    # False strings
  36    ], [
  37       '"0"',     \&f, 'OK:0', '0'
  38    ], [
  39       '"false"', \&f, 'OK:0', 'false'
  40    ], [
  41       '"off"',   \&f, 'OK:0', 'off'
  42    ], [
  43       '"no"',    \&f, 'OK:0', 'no'
  44
  45    # True strings
  46    ], [
  47       '"1"',     \&f, 'OK:1', '1'
  48    ], [
  49       '"true"',  \&f, 'OK:1', 'true'
  50    ], [
  51       '"on"',    \&f, 'OK:1', 'on'
  52    ], [
  53       '"yes"',   \&f, 'OK:1', 'yes'
  54    ], [
  55       '"YES"',   \&f, 'OK:1', 'YES'     # verify case insensitivity
  56
  57    # Illegal strings
  58    ], [
  59       'undef',   \&f, 'OK:', undef
  60    ], [
  61       '"foo"',   \&f, 'OK:', 'foo'
  62    ],
  63 );
  64 }
  65
  66 BEGIN { $| = 1; printf "1..%d\n", scalar(@tests); }
  67 END {print "not ok 1\n" unless $loaded;}
  68 $loaded = 1;
  69
  70
  71 # Run all tests in sequence
  72 for (my $i = 1; $i <= scalar @tests; $i += 1) {
  73    my $test = $tests[$i - 1];
  74    my($title, $f, $expected, $input) = @$test;
  75    die "not ok $i (malformed test case)\n"
  76       unless @$test == 4 && ref $f eq 'CODE';
  77
  78    my $output = &$f($input);
  79    if (
  80          (!defined $output && !defined $expected)
  81       || (defined $output && defined $expected && $output eq $expected)
  82    ) {
  83       print "ok $i - $title\n";
  84    } else {
  85       print "not ok $i - $title: got ",
  86             (defined $output? "\"$output\"": 'undef'),
  87             ', expected ',
  88             (defined $expected? "\"$expected\"": 'undef'),
  89             "\n";
  90    }
  91 }
  92
  93
  94
  95
  96