ext/POSIX/t/is.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     require Config; import Config;
   5     if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
   6         print "1..0\n";
   7         exit 0;
   8     }
   9 }
  10
  11 use POSIX;
  12 use strict ;
  13
  14 # E.g. \t might or might not be isprint() depending on the locale,
  15 # so let's reset to the default.
  16 setlocale(LC_ALL, 'C') if $Config{d_setlocale};
  17
  18 $| = 1;
  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    # An empty string. Always true (al least in old days) [bug #24554]
  55    ''     => [ qw(print graph alnum alpha lower upper digit xdigit
  56                   punct cntrl space) ],
  57   );
  58
  59
  60 # Pass 1: convert the above arrays to hashes.  While doing so, obtain
  61 # a complete list of all the 'is<xxx>' functions.  At least, the ones
  62 # listed above.
  63 my %functions;
  64 foreach my $s (keys %classes) {
  65     $classes{$s} = { map {
  66         $functions{"is$_"}++;   # Keep track of all the 'is<xxx>' functions
  67         "is$_" => 1;            # Our return value: is<xxx>($s) should pass.
  68     } @{$classes{$s}} };
  69 }
  70
  71 # Expected number of tests is one each for every combination of a
  72 # known is<xxx> function and string listed above.
  73 require '../../t/test.pl';
  74 plan(tests => keys(%classes) * keys(%functions));
  75
  76
  77 #
  78 # Main test loop: Run all POSIX::is<xxx> tests on each string defined above.
  79 # Only the character classes listed for that string should return 1.  We
  80 # always run all functions on every string, and expect to get 0 for the
  81 # character classes not listed in the given string's hash value.
  82 #
  83 foreach my $s (sort keys %classes) {
  84     foreach my $f (sort keys %functions) {
  85         my $expected = exists $classes{$s}->{$f};
  86         my $actual   = eval "POSIX::$f( \$s )";
  87
  88         ok( $actual == $expected, "$f('$s') == $actual");
  89     }
  90 }