1use strict; 2use warnings; 3use utf8; 4 5use Test::Builder::Tester; 6use Test::More 0.95; 7use Test::File; 8 9# Hello world from utf8 test file: 10# http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt 11my $string1 = 'Καλημέρα κόσμε'; 12my $string2 = 'コンニチハ'; 13 14require "./t/setup_common"; 15 16my $file = 'utf8_file'; 17open my $fh, '>', $file or print "bail out! Could not write to utf8_file: $!"; 18binmode($fh, ':encoding(UTF-8)'); 19$fh->print("$string1$/$/$/"); 20$fh->print("$string2$/"); 21$fh->close; 22 23my $contents = do { 24 open $fh, '<', $file; 25 binmode($fh, ':encoding(UTF-8)'); 26 local $/; 27 <$fh>; 28}; 29$fh->close; 30 31my $pattern1 = qr/(?m:^$string1$)/; 32my $pattern2 = qr/(?m:^$string2$)/; 33my $bad_pattern = 'x' x 20; $bad_pattern = qr/(?m:^$bad_pattern$)/; 34 35# like : single pattern 36 37test_out( "ok 1 - utf8_file contains $pattern1" ); 38file_contains_utf8_like( $file, $pattern1 ); 39test_test(); 40 41test_out( "not ok 1 - utf8_file contains $bad_pattern" ); 42test_fail(+2); 43like_diag($contents, $bad_pattern, "doesn't match"); 44file_contains_utf8_like( 'utf8_file', $bad_pattern ); 45test_test(); 46 47# unlike : single pattern 48 49test_out( "ok 1 - utf8_file doesn't contain $bad_pattern" ); 50file_contains_utf8_unlike( $file, $bad_pattern ); 51test_test(); 52 53test_out( "not ok 1 - utf8_file doesn't contain $pattern1" ); 54test_fail(+2); 55like_diag($contents, $pattern1, "matches"); 56file_contains_utf8_unlike( 'utf8_file', $pattern1 ); 57test_test(); 58 59# like : multiple patterns 60 61test_out( "ok 1 - utf8_file contains $pattern1" ); 62test_out( "ok 2 - utf8_file contains $pattern2" ); 63file_contains_utf8_like( $file, [ $pattern1, $pattern2 ] ); 64test_test(); 65 66test_out( "ok 1 - file has the goods" ); 67test_out( "ok 2 - file has the goods" ); 68file_contains_utf8_like( $file, [ $pattern1, $pattern2 ], 'file has the goods' ); 69test_test(); 70 71test_out( "ok 1 - utf8_file contains $pattern1" ); 72test_out( "not ok 2 - utf8_file contains $bad_pattern" ); 73test_fail(+2); 74like_diag($contents, $bad_pattern, "doesn't match"); 75file_contains_utf8_like( 'utf8_file', [ $pattern1, $bad_pattern ] ); 76test_test(); 77 78# unlike : multiple patterns 79 80test_out( "ok 1 - utf8_file doesn't contain $bad_pattern" ); 81test_out( "ok 2 - utf8_file doesn't contain $bad_pattern" ); 82file_contains_utf8_unlike( $file, [ $bad_pattern, $bad_pattern ] ); 83test_test(); 84 85test_out( "ok 1 - file has the goods" ); 86test_out( "ok 2 - file has the goods" ); 87file_contains_utf8_unlike( $file, [ $bad_pattern, $bad_pattern ], 'file has the goods' ); 88test_test(); 89 90test_out( "ok 1 - utf8_file doesn't contain $bad_pattern" ); 91test_out( "not ok 2 - utf8_file doesn't contain $pattern1" ); 92test_fail(+2); 93like_diag($contents, $pattern1, "matches"); 94file_contains_utf8_unlike( 'utf8_file', [ $bad_pattern, $pattern1 ] ); 95test_test(); 96 97done_testing(); 98 99 100# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 101 102sub like_diag 103{ 104 my ($string, $pattern, $verb) = @_; 105 106 my $diag = ' ' x 18 . "'$string'\n"; 107 $diag .= sprintf("%17s '%s'", $verb, $pattern); 108 $diag =~ s/^/# /mg; 109 110 test_err($diag); 111} 112