ext/POSIX/t/is.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require Config; import Config;
   7     if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
   8         print "1..0\n";
   9         exit 0;
  10     }
  11 }
  12
  13 use POSIX;
  14 use strict ;
  15
  16 # E.g. \t might or might not be isprint() depending on the locale,
  17 # so let's reset to the default.
  18 setlocale(LC_ALL, 'C') if $Config{d_setlocale};
  19
  20 $| = 1;
  21
  22 # List of characters (and strings) to feed to the is<xxx> functions.
  23 #
  24 # The left-hand side (key) is a character or string.
  25 # The right-hand side (value) is a list of character classes to which
  26 # this string belongs.  This is a *complete* list: any classes not
  27 # listed, are expected to return '0' for the given string.
  28 my %classes =
  29   (
  30    'a'    => [ qw(print graph alnum alpha lower xdigit) ],
  31    'A'    => [ qw(print graph alnum alpha upper xdigit) ],
  32    'z'    => [ qw(print graph alnum alpha lower) ],
  33    'Z'    => [ qw(print graph alnum alpha upper) ],
  34    '0'    => [ qw(print graph alnum digit xdigit) ],
  35    '9'    => [ qw(print graph alnum digit xdigit) ],
  36    '.'    => [ qw(print graph punct) ],
  37    '?'    => [ qw(print graph punct) ],
  38    ' '    => [ qw(print space) ],
  39    "\t"   => [ qw(cntrl space) ],
  40    "\001" => [ qw(cntrl) ],
  41
  42    # Multi-character strings.  These are logically ANDed, so the
  43    # presence of different types of chars in one string will
  44    # reduce the list on the right.
  45    'abc'       => [ qw(print graph alnum alpha lower xdigit) ],
  46    'az'        => [ qw(print graph alnum alpha lower) ],
  47    'aZ'        => [ qw(print graph alnum alpha) ],
  48    'abc '      => [ qw(print) ],
  49
  50    '012aF'     => [ qw(print graph alnum xdigit) ],
  51
  52    " \t"       => [ qw(space) ],
  53
  54    "abcde\001" => [],
  55   );
  56
  57
  58 # Pass 1: convert the above arrays to hashes.  While doing so, obtain
  59 # a complete list of all the 'is<xxx>' functions.  At least, the ones
  60 # listed above.
  61 my %functions;
  62 foreach my $s (keys %classes) {
  63     $classes{$s} = { map {
  64         $functions{"is$_"}++;   # Keep track of all the 'is<xxx>' functions
  65         "is$_" => 1;            # Our return value: is<xxx>($s) should pass.
  66     } @{$classes{$s}} };
  67 }
  68
  69 # Expected number of tests is one each for every combination of a
  70 # known is<xxx> function and string listed above.
  71 require './test.pl';
  72 plan(tests => keys(%classes) * keys(%functions));
  73
  74
  75 #
  76 # Main test loop: Run all POSIX::is<xxx> tests on each string defined above.
  77 # Only the character classes listed for that string should return 1.  We
  78 # always run all functions on every string, and expect to get 0 for the
  79 # character classes not listed in the given string's hash value.
  80 #
  81 foreach my $s (sort keys %classes) {
  82     foreach my $f (sort keys %functions) {
  83         my $expected = exists $classes{$s}->{$f};
  84         my $actual   = eval "POSIX::$f( \$s )";
  85
  86         ok( $actual == $expected, "$f('$s') == $actual");
  87     }
  88 }