1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
# -*- perl -*-
# utf8_binary.t --- Term::ReadLine::Gnu UTF-8 binary string test script
#
# Copyright (c) 2016-2019 Hiroo Hayashi. All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
# The GNU Readline Library start supporting multibyte characters since
# version 4.3, and is still improving the support. You should use the
# latest GNU Readline Library for UTF-8 support.
# If you just want to read strings including mutibyte charactors
# (e.g. UTF-8), you may simply treat them as binary strings as shown
# this test.
# But if you want to process UTF-8 strings in your perl script (see
# reverse test below), take a look at t/utf8_text.t.
use strict;
use warnings;
use constant NTEST => 13;
use Test::More tests => NTEST;
use Data::Dumper;
# redefine Test::Mode::note due to it requires Perl 5.10.1.
{
no warnings 'redefine';
sub note {
my $msg = join('', @_);
$msg =~ s{\n(?!\z)}{\n# }sg;
print "# $msg" . ($msg =~ /\n$/ ? '' : "\n");
}
}
BEGIN {
# $ENV{PERL_RL} = 'Gnu'; # force to use Term::ReadLine::Gnu
}
use Term::ReadLine;
ok(1, 'load done');
note "I'm testing Term::ReadLine::Gnu version $Term::ReadLine::Gnu::VERSION";
my $verbose = scalar @ARGV && ($ARGV[0] eq 'verbose');
# skip on Perl 5.8
if ($] < '5.010') {
diag "Perl version $] may not support UTF-8 properly. Skipped...";
ok(1, 'skip') for 1..(NTEST-1);
exit 0;
}
ok(1, 'Perl version > 5.8');
# skip when PERL_UNICODE is set
# https://rt.cpan.org/Public/Bug/Display.html?id=114185
if (${^UNICODE} != 0) {
diag "PERL_UNICODE is defined or -C option is specified. Skipped...";
ok(1, 'skip') for 1..(NTEST-2);
exit 0;
}
ok(1, 'PERL_UNICODE is not defined');
my ($in, $line, @layers);
open ($in, "<", "t/utf8.txt") or die "cannot open utf8.txt: $!";
if (0) { # This may cause a fail.
$line = <$in>; chomp($line);
note $line;
note Dumper($line, "🐪");
ok($line eq "🐪", 'pre-read');
}
my $expected = $^O eq 'MSWin32' ? ['unix', 'crlf'] : $] >= 5.010 ? ['unix', 'perlio'] : ['stdio'];
@layers = PerlIO::get_layers($in);
note 'i: ', join(':', @layers);
is_deeply(\@layers, $expected, "input layers before 'new'");
@layers = PerlIO::get_layers(\*STDOUT);
note 'o: ', join(':', @layers);
is_deeply(\@layers, $expected, "output layers before 'new'");
my $t;
if ($verbose) {
#$t = new Term::ReadLine 'ReadLineTest', \*STDIN, \*STDOUT;
$t = new Term::ReadLine 'ReadLineTest';
} else {
$t = new Term::ReadLine 'ReadLineTest', $in, \*STDOUT;
}
print "\n"; # rl_initialize() outputs some escape characters in Term-ReadLine-Gnu less than 6.3,
isa_ok($t, 'Term::ReadLine');
$expected = $^O eq 'MSWin32' ? ['unix', 'crlf', 'stdio'] : $] >= 5.010 ? ['unix', 'perlio', 'stdio'] : ['stdio'];
@layers = PerlIO::get_layers($t->IN);
note 'i: ', join(':', @layers);
is_deeply(\@layers, $expected, "input layers after 'new'");
@layers = PerlIO::get_layers($t->OUT);
note 'o: ', join(':', @layers);
is_deeply(\@layers, $expected, "output layers after 'new'");
# force the GNU Readline 8 bit through
if ($t->ReadLine eq 'Term::ReadLine::Gnu') {
$t->parse_and_bind('set input-meta on');
$t->parse_and_bind('set convert-meta off');
$t->parse_and_bind('set output-meta on');
}
my $a = $t->Attribs;
# verbose mode
if ($verbose) {
$a->{do_expand} = 1;
while ($line = $t->readline("🐪🐪> ")) {
print {$t->OUT} $line, "\n";
print {$t->OUT} Dumper($line), "\n";
}
exit 0;
}
# UTF8 string input
$line = $t->readline("🐪🐪> ");
note $line;
note Dumper($line, "🐪");
ok($line eq "🐪", 'UTF-8 binary string read');
ok(!utf8::is_utf8($line), 'not UTF-8 text string: function');
# output stream
print {$t->OUT} "# output stream test: 🐪 🐪🐪 🐪🐪🐪\n";
# UTF8 string variable access
$a->{readline_name} = '🐪 🐪🐪 🐪🐪🐪';
$line = $a->{readline_name};
note $line;
note Dumper($line);
ok($line eq '🐪 🐪🐪 🐪🐪🐪', 'UTF-8 binary string variable');
ok(!utf8::is_utf8($line), 'not UTF-8 text string: variable');
# UTF-8 binary string does not work.
ok(reverse $line ne '🐪🐪🐪 🐪🐪 🐪', 'This does not work.');
if (0) { # This may cause a fail.
$line = <$in>; chomp($line);
note $line;
note Dumper($line, "🐪🐪");
ok($line eq "🐪🐪");
$line = $t->readline("🐪🐪🐪> ");
note $line;
note Dumper($line, "🐪🐪🐪");
ok($line eq "🐪🐪🐪");
@layers = PerlIO::get_layers($in); note 'i: ', join(':', @layers);
@layers = PerlIO::get_layers(\*STDOUT); note 'o: ', join(':', @layers);
}
exit 0;
|
