'if' module: clarify documentation and test more thoroughly.

The documentation for 'if' made certain claims about the need to quote or not
quote a module name preceding a "fat arrow" ('=>') operator.  These claims
were shown to be unfounded in most cases when "use strict 'subs'" was in
effect.

In the course of writing better documentation, it was observed that the "no
if" case was very under-tested, poorly documented and hence poorly understood.
Hence, more tests have been added and the documentation has been extensively
revised.  However, there have been no changes in source code or functionality.

Make porting/podcheck.t happy.  Compensate for functions not available on
older perls.  Documentation touch-ups suggested by sisyphus.

For:  RT # 132732.

diff --git a/dist/if/if.pm b/dist/if/if.pm
index d1cbd00..166de7b 100644 (file)
--- a/dist/if/if.pm
+++ b/dist/if/if.pm
@@ -1,6 +1,6 @@
 package if;
 
-$VERSION = '0.0607';
+$VERSION = '0.0608';
 
 sub work {
   my $method = shift() ? 'import' : 'unimport';
@@ -25,76 +25,70 @@ __END__
 
 =head1 NAME
 
-if - C<use> a Perl module if a condition holds (also can C<no> a module)
+if - C<use> a Perl module if a condition holds
 
 =head1 SYNOPSIS
 
-  use if CONDITION, MODULE => ARGUMENTS;
-  no if CONDITION, MODULE => ARGUMENTS;
+    use if CONDITION, "MODULE", ARGUMENTS;
+    no  if CONDITION, "MODULE", ARGUMENTS;
 
 =head1 DESCRIPTION
 
-The C<if> module is used to conditionally load or unload another module.
-The construct
+=head2 C<use if>
 
-  use if CONDITION, MODULE => ARGUMENTS;
+The C<if> module is used to conditionally load another module.  The construct:
 
-will load MODULE only if CONDITION evaluates to true.
-The above statement has no effect unless C<CONDITION> is true.
-If the CONDITION does evaluate to true, then the above line has
-the same effect as:
+    use if CONDITION, "MODULE", ARGUMENTS;
 
-  use MODULE ARGUMENTS;
+... will load C<MODULE> only if C<CONDITION> evaluates to true; it has no
+effect if C<CONDITION> evaluates to false.  (The module name, assuming it
+contains at least one C<::>, must be quoted when C<'use strict "subs";'> is in
+effect.)  If the CONDITION does evaluate to true, then the above line has the
+same effect as:
 
-The use of C<< => >> above provides necessary quoting of C<MODULE>.
-If you don't use the fat comma (eg you don't have any ARGUMENTS),
-then you'll need to quote the MODULE.
+    use MODULE ARGUMENTS;
 
-If you wanted ARGUMENTS to be an empty list, i.e. have the effect of:
+For example, the F<Unicode::UCD> module's F<charinfo> function will use two functions from F<Unicode::Normalize> only if a certain condition is met:
+
+    use if defined &DynaLoader::boot_DynaLoader,
+        "Unicode::Normalize" => qw(getCombinClass NFD);
+
+Suppose you wanted C<ARGUMENTS> to be an empty list, I<i.e.>, to have the
+effect of:
 
     use MODULE ();
 
-you can't do this with the C<if> pragma; however, you can achieve
+You can't do this with the C<if> pragma; however, you can achieve
 exactly this effect, at compile time, with:
 
     BEGIN { require MODULE if CONDITION }
 
-=head2 EXAMPLES
-
-The following line is taken from the testsuite for L<File::Map>:
-
-  use if $^O ne 'MSWin32', POSIX => qw/setlocale LC_ALL/;
-
-If run on any operating system other than Windows,
-this will import the functions C<setlocale> and C<LC_ALL> from L<POSIX>.
-On Windows it does nothing.
-
-The following is used to L<deprecate> core modules beyond a certain version of Perl:
+=head2 C<no if>
 
-  use if $] > 5.016, 'deprecate';
+The C<no if> construct is mainly used to deactivate categories of warnings
+when those categories would produce superfluous output under specified
+versions of F<perl>.
 
-This line is taken from L<Text::Soundex> 3.04,
-and marks it as deprecated beyond Perl 5.16.
-If you C<use Text::Soundex> in Perl 5.18, for example,
-and you have used L<warnings>,
-then you'll get a warning message
-(the deprecate module looks to see whether the
-calling module was C<use>'d from a core library directory,
-and if so, generates a warning),
-unless you've installed a more recent version of L<Text::Soundex> from CPAN.
+For example, the C<redundant> category of warnings was introduced in
+Perl-5.22.  This warning flags certain instances of superfluous arguments to
+C<printf> and C<sprintf>.  But if your code was running warnings-free on
+earlier versions of F<perl> and you don't care about C<redundant> warnings in
+more recent versions, you can call:
 
-You can also specify to NOT use something:
+    use warnings;
+    no if $] >= 5.022, q|warnings|, qw(redundant);
 
- no if $] ge 5.021_006, warnings => "locale";
+    my $test    = { fmt  => "%s", args => [ qw( x y ) ] };
+    my $result  = sprintf $test->{fmt}, @{$test->{args}};
 
-This warning category was added in the specified Perl version (a development
-release).  Without the C<'if'>, trying to use it in an earlier release would
-generate an unknown warning category error.
+The C<no if> construct assumes that a module or pragma has correctly
+implemented an C<unimport()> method -- but most modules and pragmata have not.
+That explains why the C<no if> construct is of limited applicability.
 
 =head1 BUGS
 
-The current implementation does not allow specification of the
-required version of the module.
+The current implementation does not allow specification of the required
+version of the module.
 
 =head1 SEE ALSO
 
@@ -105,8 +99,8 @@ Unlike C<if> though, L<Module::Requires> is not a core module.
 L<Module::Load::Conditional> provides a number of functions you can use to
 query what modules are available, and then load one or more of them at runtime.
 
-L<provide> can be used to select one of several possible modules to load,
-based on what version of Perl is running.
+The L<provide> module from CPAN can be used to select one of several possible
+modules to load based on the version of Perl that is running.
 
 =head1 AUTHOR
 

diff --git a/dist/if/t/if.t b/dist/if/t/if.t
index 4a2b351..827d93c 100644 (file)
--- a/dist/if/t/if.t
+++ b/dist/if/t/if.t
@@ -1,9 +1,9 @@
 #!./perl
 
 use strict;
-use Test::More tests => 10;
+use Test::More tests => 18;
 
-my $v_plus = $] + 1;
+my $v_plus  = $] + 1;
 my $v_minus = $] - 1;
 
 unless (eval 'use open ":std"; 1') {
@@ -12,29 +12,85 @@ unless (eval 'use open ":std"; 1') {
   eval 'sub open::foo{}';              # Just in case...
 }
 
-no strict;
+{
+    no strict;
 
-is( eval "use if ($v_minus > \$]), strict => 'subs'; \${'f'} = 12", 12,
-    '"use if" with a false condition, fake pragma');
-is( eval "use if ($v_minus > \$]), strict => 'refs'; \${'f'} = 12", 12,
-    '"use if" with a false condition and a pragma');
+    is( eval "use if ($v_minus > \$]), strict => 'subs'; \${'f'} = 12", 12,
+        '"use if" with a false condition, fake pragma');
+    is( eval "use if ($v_minus > \$]), strict => 'refs'; \${'f'} = 12", 12,
+        '"use if" with a false condition and a pragma');
 
-is( eval "use if ($v_plus > \$]), strict => 'subs'; \${'f'} = 12", 12,
-    '"use if" with a true condition, fake pragma');
+    is( eval "use if ($v_plus > \$]), strict => 'subs'; \${'f'} = 12", 12,
+        '"use if" with a true condition, fake pragma');
 
-is( eval "use if ($v_plus > \$]), strict => 'refs'; \${'f'} = 12", undef,
-    '"use if" with a true condition and a pragma');
-like( $@, qr/while "strict refs" in use/, 'expected error message'),
+    is( eval "use if ($v_plus > \$]), strict => 'refs'; \${'f'} = 12", undef,
+        '"use if" with a true condition and a pragma');
+    like( $@, qr/while "strict refs" in use/, 'expected error message'),
 
-# Old version had problems with the module name 'open', which is a keyword too
-# Use 'open' =>, since pre-5.6.0 could interpret differently
-is( (eval "use if ($v_plus > \$]), 'open' => IN => ':crlf'; 12" || 0), 12,
-    '"use if" with open');
+    # Old version had problems with the module name 'open', which is a keyword too
+    # Use 'open' =>, since pre-5.6.0 could interpret differently
+    is( (eval "use if ($v_plus > \$]), 'open' => IN => ':crlf'; 12" || 0), 12,
+        '"use if" with open');
 
-is(eval "use if ($v_plus > \$])", undef,
-   "Too few args to 'use if' returns <undef>");
-like($@, qr/Too few arguments to 'use if'/, "  ... and returns correct error");
+    is(eval "use if ($v_plus > \$])", undef,
+       "Too few args to 'use if' returns <undef>");
+    like($@, qr/Too few arguments to 'use if'/, "  ... and returns correct error");
 
-is(eval "no if ($v_plus > \$])", undef,
-   "Too few args to 'no if' returns <undef>");
-like($@, qr/Too few arguments to 'no if'/, "  ... and returns correct error");
+    is(eval "no if ($v_plus > \$])", undef,
+       "Too few args to 'no if' returns <undef>");
+    like($@, qr/Too few arguments to 'no if'/, "  ... and returns correct error");
+}
+
+{
+    note(q|RT 132732: strict 'subs'|);
+    use strict "subs";
+
+    {
+        SKIP: {
+            unless ($] >= 5.018) {
+                skip "bigrat apparently not testable prior to perl-5.18", 4;
+            }
+            note(q|strict "subs" : 'use if' : condition false|);
+            eval "use if (0 > 1), q|bigrat|, qw(hex oct);";
+            ok (! main->can('hex'), "Cannot call bigrat::hex() in importing package");
+            ok (! main->can('oct'), "Cannot call bigrat::oct() in importing package");
+
+            note(q|strict "subs" : 'use if' : condition true|);
+            eval "use if (1 > 0), q|bigrat|, qw(hex oct);";
+            ok (  main->can('hex'), "Can call bigrat::hex() in importing package");
+            ok (  main->can('oct'), "Can call bigrat::oct() in importing package");
+        }
+    }
+
+    {
+        note(q|strict "subs" : 'no if' : condition variable|);
+        note(($] >= 5.022) ? "Recent enough Perl: $]" : "Older Perl: $]");
+        use warnings;
+        SKIP: {
+            unless ($] >= 5.022) {
+                skip "Redundant argument warning not available in pre-5.22 perls", 4;
+            }
+
+            {
+                no if $] >= 5.022, q|warnings|, qw(redundant);
+                my ($test, $result, $warn);
+                local $SIG{__WARN__} = sub { $warn = shift };
+                $test = { fmt  => "%s", args => [ qw( x y ) ] };
+                $result = sprintf $test->{fmt}, @{$test->{args}};
+                is($result, $test->{args}->[0], "Got expected string");
+                ok(! $warn, "Redundant argument warning suppressed");
+            }
+
+            {
+                use if $] >= 5.022, q|warnings|, qw(redundant);
+                my ($test, $result, $warn);
+                local $SIG{__WARN__} = sub { $warn = shift };
+                $test = { fmt  => "%s", args => [ qw( x y ) ] };
+                $result = sprintf $test->{fmt}, @{$test->{args}};
+                is($result, $test->{args}->[0], "Got expected string");
+                like($warn, qr/Redundant argument in sprintf/,
+                    "Redundant argument warning generated and capture");
+            }
+        }
+    }
+}