345 lines
8.5 KiB
Perl
Executable File
345 lines
8.5 KiB
Perl
Executable File
#! /usr/bin/perl -w
|
||
# Test suite on the functional interface for the behavior when something goes wrong
|
||
# Copyright (c) 2003-2008 imacat. All rights reserved. This program is free
|
||
# software; you can redistribute it and/or modify it under the same terms
|
||
# as Perl itself.
|
||
|
||
use 5.008;
|
||
use strict;
|
||
use warnings;
|
||
use Test;
|
||
|
||
BEGIN { plan tests => 39 }
|
||
|
||
use Encode qw();
|
||
use FindBin;
|
||
use File::Basename qw(basename);
|
||
use File::Spec::Functions qw(catdir catfile);
|
||
use lib $FindBin::Bin;
|
||
use vars qw($THIS_FILE $LOCALEDIR $r);
|
||
$THIS_FILE = basename($0);
|
||
$LOCALEDIR = catdir($FindBin::Bin, "locale");
|
||
sub find_system_mo();
|
||
|
||
# find_system_mo: Find a safe system MO to be tested
|
||
sub find_system_mo() {
|
||
local ($_, %_);
|
||
my %cands;
|
||
use Locale::Maketext::Gettext::Functions;
|
||
# Find all the system MO files
|
||
%cands = qw();
|
||
foreach my $dir (@Locale::Maketext::Gettext::Functions::SYSTEM_LOCALEDIRS) {
|
||
my ($DH, @langs);
|
||
next unless -d $dir;
|
||
|
||
@langs = qw();
|
||
opendir $DH, $dir or die "$THIS_FILE: $dir: $!";
|
||
while (defined($_ = readdir $DH)) {
|
||
my $dir1;
|
||
$dir1 = catfile($dir, $_, "LC_MESSAGES");
|
||
push @langs, $_ if -d $dir1 && -r $dir1;
|
||
}
|
||
closedir $DH or die "$THIS_FILE: $dir: $!";
|
||
|
||
foreach my $lang (sort @langs) {
|
||
my $dir1;
|
||
$dir1 = catfile($dir, $lang, "LC_MESSAGES");
|
||
opendir $DH, $dir1 or die "$THIS_FILE: $dir1: $!";
|
||
while (defined($_ = readdir $DH)) {
|
||
my ($file, $domain);
|
||
$file = catfile($dir1, $_);
|
||
next unless -f $file && -r $file && /^(.+)\.mo$/;
|
||
$domain = $1;
|
||
$cands{$file} = [$lang, $domain];
|
||
}
|
||
closedir $DH or die "$THIS_FILE: $dir1: $!";
|
||
}
|
||
}
|
||
# Check each MO file, from the newest
|
||
foreach my $file (sort { (stat $b)[9] <=> (stat $a)[9] } keys %cands) {
|
||
my ($FH, $size, $content, $charset, $lang, $domain);
|
||
$size = (stat $file)[7];
|
||
open $FH, $file or die "$THIS_FILE: $file: $!";
|
||
read $FH, $content, $size or die "$THIS_FILE: $file: $!";
|
||
close $FH or die "$THIS_FILE: $file: $!";
|
||
next unless $content =~ /Project-Id-Version:/;
|
||
next unless $content =~ /\s+charset=([^\n]+)/;
|
||
$charset = $1;
|
||
next unless defined Encode::resolve_alias($charset);
|
||
# OK. We take this one
|
||
($lang, $domain) = @{$cands{$file}};
|
||
$lang = lc $lang;
|
||
$lang =~ s/_/-/g;
|
||
$lang = "i-default" if $lang eq "c";
|
||
return ($lang, $domain);
|
||
}
|
||
# Not found
|
||
return (undef, undef);
|
||
}
|
||
|
||
# When something goes wrong
|
||
use vars qw($dir $domain $lang $skip);
|
||
# GNU gettext never fails!
|
||
# bindtextdomain
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
$_ = bindtextdomain("test");
|
||
return 1;
|
||
};
|
||
# 1
|
||
ok($r, 1);
|
||
# 2
|
||
ok($_, undef);
|
||
|
||
# textdomain
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
$_ = textdomain;
|
||
return 1;
|
||
};
|
||
# 3
|
||
ok($r, 1);
|
||
# 4
|
||
ok($_, undef);
|
||
|
||
# No text domain claimed yet
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 5
|
||
ok($r, 1);
|
||
# 6
|
||
ok($_, "Hello, world!");
|
||
|
||
# Non-existing LOCALEDIR
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("test", "/dev/null");
|
||
textdomain("test");
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 7
|
||
ok($r, 1);
|
||
# 8
|
||
ok($_, "Hello, world!");
|
||
|
||
# Not-registered DOMAIN
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
textdomain("not_registered");
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 9
|
||
ok($r, 1);
|
||
# 10
|
||
ok($_, "Hello, world!");
|
||
|
||
# PO file not exists
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("no_such_domain", $LOCALEDIR);
|
||
textdomain("no_such_domain");
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 11
|
||
ok($r, 1);
|
||
# 12
|
||
ok($_, "Hello, world!");
|
||
|
||
# PO file invalid
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("bad", $LOCALEDIR);
|
||
textdomain("bad");
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 13
|
||
ok($r, 1);
|
||
# 14
|
||
ok($_, "Hello, world!");
|
||
|
||
# No such message
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
@_ = qw();
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
textdomain("test");
|
||
get_handle("en");
|
||
$_[0] = __("[*,_1,non-existing message,non-existing messages]", 1);
|
||
$_[1] = __("[*,_1,non-existing message,non-existing messages]", 3);
|
||
$_[2] = pmaketext("Menu|View|", "[*,_1,non-existing message,non-existing messages]", 1);
|
||
$_[3] = pmaketext("Menu|View|", "[*,_1,non-existing message,non-existing messages]", 3);
|
||
$_[4] = pmaketext("Menu|None|", "Hello, world!");
|
||
return 1;
|
||
};
|
||
# 15
|
||
ok($r, 1);
|
||
# 16
|
||
ok($_[0], "1 non-existing message");
|
||
# 17
|
||
ok($_[1], "3 non-existing messages");
|
||
# 18
|
||
ok($_[2], "1 non-existing message");
|
||
# 19
|
||
ok($_[3], "3 non-existing messages");
|
||
# 20
|
||
ok($_[4], "Hello, world!");
|
||
|
||
# get_handle before textdomain
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
get_handle("en");
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
textdomain("test");
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 21
|
||
ok($r, 1);
|
||
# 22
|
||
ok($_, "Hiya :)");
|
||
|
||
# bindtextdomain after textdomain
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
get_handle("en");
|
||
textdomain("test2");
|
||
bindtextdomain("test2", $LOCALEDIR);
|
||
$_ = __("Every story has a happy ending.");
|
||
return 1;
|
||
};
|
||
# 23
|
||
ok($r, 1);
|
||
# 24
|
||
ok($_, "Pray it.");
|
||
|
||
# multibyte keys
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
textdomain("test");
|
||
get_handle("zh-tw");
|
||
key_encoding("Big5");
|
||
$_ = maketext("<22>]<5D><><EFBFBD>]<5D>w<EFBFBD>^");
|
||
return 1;
|
||
};
|
||
# 25
|
||
ok($r, 1);
|
||
# 26
|
||
ok($_, "<22>]<5D><><EFBFBD>]<5D>w<EFBFBD>^");
|
||
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("test", "/dev/null");
|
||
textdomain("test");
|
||
get_handle("zh-tw");
|
||
key_encoding("Big5");
|
||
$_ = maketext("<22>]<5D><><EFBFBD>]<5D>w<EFBFBD>^");
|
||
return 1;
|
||
};
|
||
# 27
|
||
ok($r, 1);
|
||
# 28
|
||
ok($_, "<22>]<5D><><EFBFBD>]<5D>w<EFBFBD>^");
|
||
|
||
# Maketext before and after binding text domain
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
__("Hello, world!");
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
textdomain("test");
|
||
get_handle("en");
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 29
|
||
ok($r, 1);
|
||
# 30
|
||
ok($_, "Hiya :)");
|
||
|
||
# Switch to a domain that is not binded yet
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
get_handle("en");
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
textdomain("test");
|
||
textdomain("test2");
|
||
$_ = __("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 31
|
||
ok($r, 1);
|
||
# 32
|
||
ok($_, "Hello, world!");
|
||
|
||
# N_: different context - string to array
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
textdomain("test");
|
||
get_handle("en");
|
||
@_ = N_("Hello, world!");
|
||
return 1;
|
||
};
|
||
# 33
|
||
ok($r, 1);
|
||
# 34
|
||
ok($_[0], "Hello, world!");
|
||
# 35
|
||
ok($_[1], undef);
|
||
|
||
# N_: different context - array to string
|
||
$r = eval {
|
||
use Locale::Maketext::Gettext::Functions;
|
||
Locale::Maketext::Gettext::Functions::_reset();
|
||
bindtextdomain("test", $LOCALEDIR);
|
||
textdomain("test");
|
||
get_handle("en");
|
||
$_ = N_("Hello, world!", "Cool!", "Big watermelon");
|
||
return 1;
|
||
};
|
||
# 36
|
||
ok($r, 1);
|
||
# 37
|
||
ok($_, "Hello, world!");
|
||
|
||
# Search system locale directories
|
||
($lang, $domain) = find_system_mo;
|
||
$skip = defined $domain? 0: 1;
|
||
$r = eval {
|
||
return if $skip;
|
||
use Locale::Maketext::Gettext::Functions;
|
||
textdomain($domain);
|
||
get_handle($lang);
|
||
$_ = maketext("");
|
||
# Skip if $Lexicon{""} does not exists
|
||
$skip = 1 if $_ eq "";
|
||
return 1;
|
||
};
|
||
# 38
|
||
skip($skip, $r, 1, $@);
|
||
# 39
|
||
skip($skip, $_, qr/Project-Id-Version:/);
|