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 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
|
# -*- perl -*-
# utf8_text.t --- Term::ReadLine::Gnu UTF-8 text 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.
use strict;
use warnings;
# convert into UTF-8 text strings
# use ':encoding(UTF-8)', not ':utf8' nor ':encoding(utf8)'
# http://perldoc.perl.org/PerlIO.html
# http://perldoc.perl.org/Encode.html, 'UTF-8 vs. utf8 vs. UTF8'
use utf8;
use open ':std', ':encoding(UTF-8)';
# This must follow UTF-8 setting.
# See 'CAVEATS and NOTES' in http://perldoc.perl.org/Test/More.html for details.
use constant NTEST => 14;
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
$ENV{LC_ALL} = 'C.UTF-8';
}
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');
# check locale setting because the following tests depend on locale feature.
use Config;
if (!$Config{d_setlocale}) {
diag "d_setlocale is not defined. Skipped...";
ok(1, 'skip') for 1..(NTEST-2);
exit 0;
}
ok(1, '$Config{d_setlocale}');
# http://perldoc.perl.org/perllocale.html
use POSIX qw(locale_h);
use locale;
my $old_locale = setlocale(LC_ALL, 'C.UTF-8');
if (!defined $old_locale) {
diag "The locale 'C.UTF-8' is not supported. Skipped...";
ok(1, 'skip') for 1..(NTEST-3);
exit 0;
}
ok(1, 'setlocale');
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 = $] >= 5.010 ? ['unix', 'perlio', 'encoding(utf-8-strict)', 'utf8']
: ['stdio', 'encoding(utf-8-strict)', 'utf8'];
my $expected_x;
if (${^UNICODE} == 0) {
$expected_x = $expected;
} else {
$expected_x = $] >= 5.010 ? ['unix', 'perlio', 'utf8', 'encoding(utf-8-strict)', 'utf8']
: ['stdio', 'utf8', 'encoding(utf-8-strict)', 'utf8'];
}
@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_x, "output layers before 'new'");
my $t;
if ($verbose) {
#$t = new Term::ReadLine 'ReadLineTest', \*STDIN, \*STDOUT;
#$Term::ReadLine::Gnu::utf8_mode = 1;
$t = new Term::ReadLine 'ReadLineTest';
$t->enableUTF8;
} 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');
@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_x, "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 text string read');
ok(utf8::is_utf8($line), '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), 'UTF-8 text string: variable');
# UTF-8 text string works well.
ok(reverse $line eq '🐪🐪🐪 🐪🐪 🐪', 'This does 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;
|