This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
'if' module: clarify documentation and test more thoroughly.
[perl5.git] / dist / if / t / if.t
1 #!./perl
2
3 use strict;
4 use Test::More tests => 18;
5
6 my $v_plus  = $] + 1;
7 my $v_minus = $] - 1;
8
9 unless (eval 'use open ":std"; 1') {
10   # pretend that open.pm is present
11   $INC{'open.pm'} = 'open.pm';
12   eval 'sub open::foo{}';               # Just in case...
13 }
14
15 {
16     no strict;
17
18     is( eval "use if ($v_minus > \$]), strict => 'subs'; \${'f'} = 12", 12,
19         '"use if" with a false condition, fake pragma');
20     is( eval "use if ($v_minus > \$]), strict => 'refs'; \${'f'} = 12", 12,
21         '"use if" with a false condition and a pragma');
22
23     is( eval "use if ($v_plus > \$]), strict => 'subs'; \${'f'} = 12", 12,
24         '"use if" with a true condition, fake pragma');
25
26     is( eval "use if ($v_plus > \$]), strict => 'refs'; \${'f'} = 12", undef,
27         '"use if" with a true condition and a pragma');
28     like( $@, qr/while "strict refs" in use/, 'expected error message'),
29
30     # Old version had problems with the module name 'open', which is a keyword too
31     # Use 'open' =>, since pre-5.6.0 could interpret differently
32     is( (eval "use if ($v_plus > \$]), 'open' => IN => ':crlf'; 12" || 0), 12,
33         '"use if" with open');
34
35     is(eval "use if ($v_plus > \$])", undef,
36        "Too few args to 'use if' returns <undef>");
37     like($@, qr/Too few arguments to 'use if'/, "  ... and returns correct error");
38
39     is(eval "no if ($v_plus > \$])", undef,
40        "Too few args to 'no if' returns <undef>");
41     like($@, qr/Too few arguments to 'no if'/, "  ... and returns correct error");
42 }
43
44 {
45     note(q|RT 132732: strict 'subs'|);
46     use strict "subs";
47
48     {
49         SKIP: {
50             unless ($] >= 5.018) {
51                 skip "bigrat apparently not testable prior to perl-5.18", 4;
52             }
53             note(q|strict "subs" : 'use if' : condition false|);
54             eval "use if (0 > 1), q|bigrat|, qw(hex oct);";
55             ok (! main->can('hex'), "Cannot call bigrat::hex() in importing package");
56             ok (! main->can('oct'), "Cannot call bigrat::oct() in importing package");
57
58             note(q|strict "subs" : 'use if' : condition true|);
59             eval "use if (1 > 0), q|bigrat|, qw(hex oct);";
60             ok (  main->can('hex'), "Can call bigrat::hex() in importing package");
61             ok (  main->can('oct'), "Can call bigrat::oct() in importing package");
62         }
63     }
64
65     {
66         note(q|strict "subs" : 'no if' : condition variable|);
67         note(($] >= 5.022) ? "Recent enough Perl: $]" : "Older Perl: $]");
68         use warnings;
69         SKIP: {
70             unless ($] >= 5.022) {
71                 skip "Redundant argument warning not available in pre-5.22 perls", 4;
72             }
73
74             {
75                 no if $] >= 5.022, q|warnings|, qw(redundant);
76                 my ($test, $result, $warn);
77                 local $SIG{__WARN__} = sub { $warn = shift };
78                 $test = { fmt  => "%s", args => [ qw( x y ) ] };
79                 $result = sprintf $test->{fmt}, @{$test->{args}};
80                 is($result, $test->{args}->[0], "Got expected string");
81                 ok(! $warn, "Redundant argument warning suppressed");
82             }
83
84             {
85                 use if $] >= 5.022, q|warnings|, qw(redundant);
86                 my ($test, $result, $warn);
87                 local $SIG{__WARN__} = sub { $warn = shift };
88                 $test = { fmt  => "%s", args => [ qw( x y ) ] };
89                 $result = sprintf $test->{fmt}, @{$test->{args}};
90                 is($result, $test->{args}->[0], "Got expected string");
91                 like($warn, qr/Redundant argument in sprintf/,
92                     "Redundant argument warning generated and capture");
93             }
94         }
95     }
96 }