Add Rafael's example user pragma, and convert his demo to a test.

p4raw-id: //depot/perl@27663

diff --git a/MANIFEST b/MANIFEST
index 944449f..1d1868d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3221,6 +3221,8 @@ t/lib/Math/BigInt/BareCalc.pm     Bigint's simulation of Calc
 t/lib/Math/BigInt/Scalar.pm    Pure Perl module to support Math::BigInt
 t/lib/Math/BigInt/Subclass.pm  Empty subclass of BigInt for test
 t/lib/Math/BigRat/Test.pm              Math::BigRat test helper
+t/lib/mypragma.pm              An example user pragma
+t/lib/mypragma.t               Test the example user pragma
 t/lib/NoExporter.pm                    Part of Test-Simple
 t/lib/sample-tests/bailout             Test data for Test::Harness
 t/lib/sample-tests/bignum              Test data for Test::Harness

diff --git a/t/lib/mypragma.pm b/t/lib/mypragma.pm
new file mode 100644 (file)
index 0000000..d1f52c6
--- /dev/null
+++ b/t/lib/mypragma.pm
@@ -0,0 +1,46 @@
+=head1 NAME
+
+mypragma - an example of a user pragma
+
+=head1 SYNOPSIS
+
+In your code
+
+    use mypragma; # Enable the pragma
+    
+    mypragma::in_effect() # returns true; pragma is enabled
+
+    no mypragma;
+    
+    mypragma::in_effect() # returns false; pragma is not enabled
+
+=head1 DESCRIPTION
+
+An example of how to write a pragma.
+
+=head1 AUTHOR
+
+Rafael Garcia-Suarez
+
+=cut
+
+package mypragma;
+
+use strict;
+use warnings;
+
+sub import {
+    $^H{mypragma} = 1;
+    $^H |= 0x00020000;
+}
+
+sub unimport {
+    $^H{mypragma} = 0;
+}
+
+sub in_effect {
+    my $hinthash = (caller(0))[10];
+    return $hinthash->{mypragma};
+}
+
+1;

diff --git a/t/lib/mypragma.t b/t/lib/mypragma.t
new file mode 100644 (file)
index 0000000..b7a312c
--- /dev/null
+++ b/t/lib/mypragma.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't';
+    @INC = ('../lib', 'lib');
+}
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+use mypragma (); # don't enable this pragma yet
+
+BEGIN {
+   is($^H{mypragma}, undef, "Shouldn't be in %^H yet");
+}
+
+is(mypragma::in_effect(), undef, "pragma not in effect yet");
+{
+    use mypragma;
+    is(mypragma::in_effect(), 1, "pragma is in effect within this block");
+}
+is(mypragma::in_effect(), undef, "pragma no longer in effect");
+
+
+BEGIN {
+   is($^H{mypragma}, undef, "Should no longer be in %^H");
+}