1#!./perl 2 3use strict; 4use Test::More tests => 18; 5 6my $v_plus = $] + 1; 7my $v_minus = $] - 1; 8 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 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 captured"); 93 } 94 } 95 } 96} 97