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
CommitLineData
cd16c24c
IZ
1#!./perl
2
80b774e4 3use strict;
1654584e 4use Test::More tests => 18;
cd16c24c 5
1654584e 6my $v_plus = $] + 1;
cd16c24c
IZ
7my $v_minus = $] - 1;
8
2f761939
NC
9unless (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
1654584e
JK
15{
16 no strict;
cd16c24c 17
1654584e
JK
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');
cd16c24c 22
1654584e
JK
23 is( eval "use if ($v_plus > \$]), strict => 'subs'; \${'f'} = 12", 12,
24 '"use if" with a true condition, fake pragma');
cd16c24c 25
1654584e
JK
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'),
cd16c24c 29
1654584e
JK
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');
14735530 34
1654584e
JK
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");
14735530 38
1654584e
JK
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}