1use Digest::MD5; 2use Test::More tests => 6; 3 4$^W = 0; # No warnings 5{ 6 local *STDERR; 7 my $stderr_seen = ""; 8 open STDERR, '>', \$stderr_seen; 9 $str = Digest::MD5->md5_hex("foo"); 10 is($stderr_seen,'','No warnings'); 11} 12 13{ 14 $^W = 1; # magic turn on warnings 15 local *STDERR; 16 my $stderr_seen = ""; 17 open STDERR, '>', \$stderr_seen; 18 $str = Digest::MD5->md5_hex("foo"); 19 like($stderr_seen,qr/Digest::MD5::md5_hex function probably called as class method/, 20 'Lexical warning passed to XSUB'); 21} 22 23{ 24 $^W = 0; # No warnings 25 local *STDERR; 26 my $stderr_seen = ""; 27 open STDERR, '>', \$stderr_seen; 28 $str = Digest::MD5->md5_hex("foo"); 29 is($stderr_seen,'','No warnings again'); 30} 31 32{ 33 use warnings; 34 local *STDERR; 35 my $stderr_seen = ""; 36 open STDERR, '>', \$stderr_seen; 37 $str = Digest::MD5->md5_hex("foo"); 38 like($stderr_seen,qr/Digest::MD5::md5_hex function probably called as class method/, 39 'use warnings passed to XSUB'); 40} 41 42{ 43 use strict; 44 $^W = 0; # No warnings 45 local *STDERR; 46 my $stderr_seen = ""; 47 open STDERR, '>', \$stderr_seen; 48 my $str = Digest::MD5->md5_hex("foo"); 49 is($stderr_seen,'','No warnings and strict'); 50} 51 52{ 53 use strict; 54 use warnings; 55 local *STDERR; 56 my $stderr_seen = ""; 57 open STDERR, '>', \$stderr_seen; 58 my $str = Digest::MD5->md5_hex("foo"); 59 like($stderr_seen, qr/Digest::MD5::md5_hex function probably called as class method/, 60 'use warnings passed to XSUB while use strict'); 61} 62 63