(Retracted by #12185)

Subject: [PATCH MANIFEST lib/warnings/register.t lib/warnings/register.pm]
	Add Tests for warnings::register, Doc Update
Message-Id: <20010922154815.32004.qmail@onion.perl.org>

p4raw-id: //depot/perl@12136

2 files changed, 96 insertions, 0 deletions

diff --git a/lib/warnings/register.pm b/lib/warnings/register.pm
index c5dc1999a0..be8365897d 100644
--- a/lib/warnings/register.pm
+++ b/lib/warnings/register.pm
@@ -18,6 +18,9 @@ Create a warnings category with the same name as the current package.
 
 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 
+=head1 SEE ALSO
+
+L<perllexwarn>
 
 =cut
 
diff --git a/lib/warnings/register.t b/lib/warnings/register.t
new file mode 100644
index 0000000000..f3bd9f07ae
--- /dev/null
+++ b/lib/warnings/register.t
@@ -0,0 +1,93 @@
+#!./perl
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+# this package has to be compiled first
+package WarnTest;
+
+use warnings;
+use warnings::register;
+
+my $status;
+sub report {
+	$status = warnings::enabled() ? 1 : 0;
+}
+
+sub odd_even {
+	my $num = shift;
+	warnings::warn('Odd number') if warnings::enabled() and $num % 2;
+}
+
+sub odd_even_strict {
+	warnings::warnif('numeric', 'Odd number') if $_[0] % 2;
+}
+
+sub disabled {
+	! warnings::enabled();
+}
+
+sub category {
+	warnings::warnif('closure', 'closures are neat');
+	warnings::warnif('misc', 'Larry was here');
+	warnings::warnif('void', '3.2 kilograms');
+}
+
+package main;
+
+use Test::More tests => 10;
+
+use_ok( 'warnings', 'WarnTest' );
+use_ok( 'warnings::register' );
+
+my $err;
+
+# it's nice to trap these
+local $SIG{__WARN__} = sub {
+	$err = $_[0];
+};
+
+# try to trigger warning condition, first should not warn, second should
+WarnTest::odd_even(2);
+is( $err, '', 'no unexpected warning' );
+WarnTest::odd_even(3);
+like( $err, qr/^Odd number/, 'expected warning' );
+
+$err = '';
+
+# now disable warnings
+no warnings 'WarnTest';
+WarnTest::odd_even(5);
+is( $err, '', 'no unexpected warning with disabled warnings' );
+
+# check to see if warnings really are disabled
+ok( WarnTest::disabled(), 'yep, warnings really are disabled' );
+
+# now let's check lexical warnings
+no warnings;
+use warnings 'numeric';
+
+# enable only one category
+{
+	use warnings 'misc';
+	WarnTest::category();
+	like( $err, qr/^Larry/, 'warning category works' );
+
+	# now enable this category, it should overwrite the Larry warning
+	use warnings 'void';
+	WarnTest::category();
+	like( $err, qr/^3.2 kilograms/, 'warning category still works' );
+}
+
+# and outside of the block, we should only get the odd_even warning
+WarnTest::odd_even_strict(7);
+WarnTest::category();
+like( $err, qr/^Odd number/, 'warning scope appears to work' );
+
+# and finally, fatal warnings
+use warnings FATAL => 'WarnTest';
+eval { WarnTest::odd_even(9) };
+like( $@, qr/^Odd number/, 'fatal warnings work too' );
+