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