integrate 5.8-maint: changes #18174 18187 18189-92 18202 18209 18214-5

p4raw-link: @18189 on //depot/maint-5.8/perl: 27314835b1b1ea8730d4a0eb871861ac238c63f9
p4raw-link: @18187 on //depot/maint-5.8/perl: 94e81ce4c47784f86829e70129b1d0a3e95ca51c
p4raw-link: @18174 on //depot/maint-5.8/perl: f8d24d869503bcd9df0e86aa5898c89996220bf8

p4raw-id: //depot/perl@18221
p4raw-branched: from //depot/maint-5.8/perl@18220 'branch in'
	ext/POSIX/t/is.t
p4raw-integrated: from //depot/maint-5.8/perl@18220 'copy in'
	README.os2 ext/GDBM_File/GDBM_File.pm ext/GDBM_File/Makefile.PL
	lib/Unicode/UCD.pm t/op/subst.t (@17645..) INSTALL t/op/grep.t
	(@18080..) ext/Fcntl/t/syslfs.t t/op/lfs.t (@18133..) 'merge
	in' t/op/eval.t (@17645..) pod/perldiag.pod (@18146..)
	lib/Unicode/UCD.t (@18156..) MANIFEST (@18173..)

1 files changed, 86 insertions, 0 deletions

diff --git a/ext/POSIX/t/is.t b/ext/POSIX/t/is.t
new file mode 100644
index 0000000000..6aa96f0b7c
--- /dev/null
+++ b/ext/POSIX/t/is.t
@@ -0,0 +1,86 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+
+use POSIX;
+use strict ;
+
+$| = 1;
+
+
+# List of characters (and strings) to feed to the is<xxx> functions.
+#
+# The left-hand side (key) is a character or string.
+# The right-hand side (value) is a list of character classes to which
+# this string belongs.  This is a *complete* list: any classes not
+# listed, are expected to return '0' for the given string.
+my %classes =
+  (
+   'a'    => [ qw(print graph alnum alpha lower xdigit) ],
+   'A'    => [ qw(print graph alnum alpha upper xdigit) ],
+   'z'    => [ qw(print graph alnum alpha lower) ],
+   'Z'    => [ qw(print graph alnum alpha upper) ],
+   '0'    => [ qw(print graph alnum digit xdigit) ],
+   '9'    => [ qw(print graph alnum digit xdigit) ],
+   '.'    => [ qw(print graph punct) ],
+   '?'    => [ qw(print graph punct) ],
+   ' '    => [ qw(print space) ],
+   "\t"   => [ qw(cntrl space) ],
+   "\001" => [ qw(cntrl) ],
+
+   # Multi-character strings.  These are logically ANDed, so the
+   # presence of different types of chars in one string will
+   # reduce the list on the right.
+   'abc'       => [ qw(print graph alnum alpha lower xdigit) ],
+   'az'        => [ qw(print graph alnum alpha lower) ],
+   'aZ'        => [ qw(print graph alnum alpha) ],
+   'abc '      => [ qw(print) ],
+
+   '012aF'     => [ qw(print graph alnum xdigit) ],
+
+   " \t"       => [ qw(space) ],
+
+   "abcde\001" => [],
+  );
+
+
+# Pass 1: convert the above arrays to hashes.  While doing so, obtain
+# a complete list of all the 'is<xxx>' functions.  At least, the ones
+# listed above.
+my %functions;
+foreach my $s (keys %classes) {
+    $classes{$s} = { map {
+	$functions{"is$_"}++;	# Keep track of all the 'is<xxx>' functions
+	"is$_" => 1;		# Our return value: is<xxx>($s) should pass.
+    } @{$classes{$s}} };
+}
+
+# Expected number of tests is one each for every combination of a
+# known is<xxx> function and string listed above.
+require './test.pl';
+plan(tests => keys(%classes) * keys(%functions));
+
+
+#
+# Main test loop: Run all POSIX::is<xxx> tests on each string defined above.
+# Only the character classes listed for that string should return 1.  We
+# always run all functions on every string, and expect to get 0 for the
+# character classes not listed in the given string's hash value.
+#
+foreach my $s (sort keys %classes) {
+    foreach my $f (sort keys %functions) {
+	my $expected = exists $classes{$s}->{$f};
+	my $actual   = eval "POSIX::$f( \$s )";
+
+	ok( $actual == $expected, "$f('$s') == $actual");
+    }
+}