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