dslinux/user/perl/lib/Locale/Maketext/t 01_about_verbose.t 10_make.t 20_get.t 40_super.t 50_super.t 60_super.t 90_utf8.t

[cayenne]

Update of /cvsroot/dslinux/dslinux/user/perl/lib/Locale/Maketext/t
In directory antilope:/tmp/cvs-serv7729/lib/Locale/Maketext/t

Added Files:
	01_about_verbose.t 10_make.t 20_get.t 40_super.t 50_super.t 
	60_super.t 90_utf8.t 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: 20_get.t ---

require 5;
use Test;
BEGIN { plan tests => 11; }
use Locale::Maketext 1.01;
print "# Hi there...\n";
ok 1;

print "# --- Making sure that get_handle works ---\n";

# declare some classes...
{
  package Woozle;
  @ISA = ('Locale::Maketext');
  sub dubbil   { return $_[1] * 2 }
  sub numerate { return $_[2] . 'en' }
}
{
  package Woozle::eu_mt;
  @ISA = ('Woozle');
  %Lexicon = (
   'd2' => 'hum [dubbil,_1]',
   'd3' => 'hoo [quant,_1,zaz]',
   'd4' => 'hoo [*,_1,zaz]',
  );
  keys %Lexicon; # dodges the 'used only once' warning
}

my $lh;
print "# Basic sanity:\n";
ok defined( $lh = Woozle->get_handle('eu-mt') ) && ref($lh);
ok $lh && $lh->maketext('d2', 7), "hum 14"      ;



print "# Make sure we can assign to ENV entries\n",
      "# (Otherwise we can't run the subsequent tests)...\n";
$ENV{'MYORP'}   = 'Zing';
ok $ENV{'MYORP'}, 'Zing';
$ENV{'SWUZ'}   = 'KLORTHO HOOBOY';
ok $ENV{'SWUZ'}, 'KLORTHO HOOBOY';

delete $ENV{'MYORP'};
delete $ENV{'SWUZ'};


print "# Test LANG...\n";
$ENV{'LC_ALL'} = '';
$ENV{'LC_MESSAGES'} = '';
$ENV{'REQUEST_METHOD'} = '';
$ENV{'LANG'}     = 'Eu_MT';
$ENV{'LANGUAGE'} = '';
ok defined( $lh = Woozle->get_handle() ) && ref($lh);

print "# Test LANGUAGE...\n";
$ENV{'LANG'}     = '';
$ENV{'LANGUAGE'} = 'Eu-MT';
ok defined( $lh = Woozle->get_handle() ) && ref($lh);

print "# Test HTTP_ACCEPT_LANGUAGE...\n";
$ENV{'REQUEST_METHOD'}       = 'GET';
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'eu-MT';
ok defined( $lh = Woozle->get_handle() ) && ref($lh);
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eu-MT, i-klung';
ok defined( $lh = Woozle->get_handle() ) && ref($lh);
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eU-Mt, i-klung';
ok defined( $lh = Woozle->get_handle() ) && ref($lh);


print "# Byebye!\n";
ok 1;


--- NEW FILE: 01_about_verbose.t ---

require 5;
# Time-stamp: "2004-03-30 17:02:53 AST"

# Summary of, well, things.

use Test;
BEGIN {plan tests => 2};

ok 1;

use Locale::Maketext;

#chdir "t" if -e "t";

{
  my @out;
  push @out,
    "\n\nPerl v",
    defined($^V) ? sprintf('%vd', $^V) : $],
    " under $^O ",
    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
    (defined $MacPerl::Version)
      ? ("(MacPerl version $MacPerl::Version)") : (),
    "\n"
  ;

  # Ugly code to walk the symbol tables:
  my %v;
  my @stack = ('');  # start out in %::
  my $this;
  my $count = 0;
  my $pref;
  while(@stack) {
    $this = shift @stack;
    die "Too many packages?" if ++$count > 1000;
    next if exists $v{$this};
    next if $this eq 'main'; # %main:: is %::

    #print "Peeking at $this => ${$this . '::VERSION'}\n";
    
    if(defined ${$this . '::VERSION'} ) {
      $v{$this} = ${$this . '::VERSION'}
    } elsif(
       defined *{$this . '::ISA'} or defined &{$this . '::import'}
       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
       # If it has an ISA, an import, or any subs...
    ) {
      # It's a class/module with no version.
      $v{$this} = undef;
    } else {
      # It's probably an unpopulated package.
      ## $v{$this} = '...';
    }
    
    $pref = length($this) ? "$this\::" : '';
    push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
    #print "Stack: @stack\n";
  }
  push @out, " Modules in memory:\n";
  delete @v{'', '[none]'};
  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
    $indent = ' ' x (2 + ($p =~ tr/:/:/));
    push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
  }
  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
    scalar(gmtime), scalar(localtime);
  my $x = join '', @out;
  $x =~ s/^/#/mg;
  print $x;
}

print "# Running",
  (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
  "#\n",
;

print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";

print "# \%INC:\n";
foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
  print "#   [$x] = [", $INC{$x} || '', "]\n";
}

ok 1;


--- NEW FILE: 90_utf8.t ---

require 5;
use Test;
BEGIN { plan tests => 4; }
use Locale::Maketext 1.01;
print "# Hi there...\n";
ok 1;


print "# --- Making sure that get_handle works with utf8 ---\n";
use utf8;

# declare some classes...
{
  package Woozle;
  @ISA = ('Locale::Maketext');
  sub dubbil   { return $_[1] * 2  .chr(2000)}
  sub numerate { return $_[2] . 'en'  }
}
{
  package Woozle::eu_mt;
  @ISA = ('Woozle');
  %Lexicon = (
   'd2' => chr(1000) . 'hum [dubbil,_1]',
   'd3' => chr(1000) . 'hoo [quant,_1,zaz]',
   'd4' => chr(1000) . 'hoo [*,_1,zaz]',
  );
  keys %Lexicon; # dodges the 'used only once' warning
}

my $lh;
print "# Basic sanity:\n";
ok defined( $lh = Woozle->get_handle('eu-mt') ) && ref($lh);
ok $lh && $lh->maketext('d2', 7), chr(1000)."hum 14".chr(2000)   ;


print "# Byebye!\n";
ok 1;


--- NEW FILE: 60_super.t ---

require 5;
use strict;
use Test;

# use a BEGIN block so we print our plan before MyModule is loaded
BEGIN { plan tests => 3 }

ok 1;
print "# Locale::Maketext version $Locale::Maketext::VERSION\n";

#sub Locale::Maketext::DEBUG () {10};
use Locale::Maketext ();
{ package  Whunk::L10N;  use vars qw(@ISA %Lexicon);  @ISA =  'Locale::Maketext';
  %Lexicon = ("hello" => "SROBLR!");
}
{ package  Whunk::L10N::en;      use vars qw(@ISA %Lexicon);  @ISA =  'Whunk::L10N';
  %Lexicon = ("hello" => "HI AND STUFF!");
}
{  package  Whunk::L10N::zh_tw;  use vars qw(@ISA %Lexicon);  @ISA =  'Whunk::L10N';
  %Lexicon = ("hello" => "NIHAU JOE!");
}

$ENV{'REQUEST_METHOD'} = 'GET';
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'en-US, zh-TW';

my $x = Whunk::L10N->get_handle;
print "# LH object: $x\n";
ok $x->maketext('hello'), "HI AND STUFF!";
print "# OK bye\n";
ok 1;

--- NEW FILE: 50_super.t ---

#sub Locale::Maketext::DEBUG () {10}
use Locale::Maketext;

use Test;
BEGIN { plan tests => 26 };
print "#\n# Testing tight insertion of super-ordinate language tags...\n#\n";

my @in = grep m/\S/, split /[\n\r]/, q{
 NIX => NIX
  sv => sv
  en => en
 hai => hai

          pt-br => pt-br pt
       pt-br fr => pt-br pt fr
    pt-br fr pt => pt-br fr pt

 pt-br fr pt de => pt-br fr pt de
 de pt-br fr pt => de pt-br fr pt
    de pt-br fr => de pt-br pt fr
   hai pt-br fr => hai pt-br pt fr

 # Now test multi-part complicateds:
          pt-br-janeiro => pt-br-janeiro pt-br pt
       pt-br-janeiro fr => pt-br-janeiro pt-br pt fr
    pt-br-janeiro de fr => pt-br-janeiro pt-br pt de fr
 pt-br-janeiro de pt fr => pt-br-janeiro pt-br de pt fr

          pt-br-janeiro pt-br-saopaolo => pt-br-janeiro pt-br pt pt-br-saopaolo
       pt-br-janeiro fr pt-br-saopaolo => pt-br-janeiro pt-br pt fr pt-br-saopaolo
    pt-br-janeiro de pt-br-saopaolo fr => pt-br-janeiro pt-br pt de pt-br-saopaolo fr
    pt-br-janeiro de pt-br fr pt-br-saopaolo => pt-br-janeiro de pt-br pt fr pt-br-saopaolo

 pt-br de en fr pt-br-janeiro => pt-br pt de en fr pt-br-janeiro
 pt-br de en fr               => pt-br pt de en fr

    ja    pt-br-janeiro fr => ja pt-br-janeiro pt-br pt fr
    ja pt-br-janeiro de fr => ja pt-br-janeiro pt-br pt de fr
 ja pt-br-janeiro de pt fr => ja pt-br-janeiro pt-br de pt fr

 pt-br-janeiro de pt-br fr => pt-br-janeiro de pt-br pt fr
# an odd case, since we don't filter for uniqueness in this sub
 
};

sub uniq { my %seen; return grep(!($seen{$_}++), @_); }

foreach my $in (@in) {
  $in =~ s/^\s+//s;
  $in =~ s/\s+$//s;
  $in =~ s/#.+//s;
  next unless $in =~ m/\S/;
  
  my(@in, @should);
  {
    die "What kind of line is <$in>?!"
     unless $in =~ m/^(.+)=>(.+)$/s;
  
    my($i,$s) = ($1, $2);
    @in     = ($i =~ m/(\S+)/g);
    @should = ($s =~ m/(\S+)/g);
    #print "{@in}{@should}\n";
  }
  my @out = uniq( Locale::Maketext->_add_supers(
    ("@in" eq 'NIX') ? () : @in
  ) );
  #print "O: ", join(' ', map "<$_>", @out), "\n";
  @out = 'NIX' unless @out;

  
  if( @out == @should
      and lc( join "\e", @out ) eq lc( join "\e", @should )
  ) {
    print "#     Happily got [@out] from [$in]\n";
    ok 1;
  } else {
    ok 0;
    print "#!!Got:         [@out]\n",
          "#!! but wanted: [@should]\n",
          "#!! from \"$in\"\n#\n";
  }
}

print "#\n#\n# Bye-bye!\n";
ok 1;


--- NEW FILE: 40_super.t ---

# Time-stamp: "2004-03-30 18:02:24 AST"
#sub Locale::Maketext::DEBUG () {10}
use Locale::Maketext;

use Test;
BEGIN { plan tests => 19 };

print "#\n# Testing non-tight insertion of super-ordinate language tags...\n#\n";

my @in = grep m/\S/, split /[\n\r]/, q{
 NIX => NIX
  sv => sv
  en => en
 hai => hai

          pt-br => pt-br pt
       pt-br fr => pt-br fr pt
    pt-br fr pt => pt-br fr pt
 pt-br fr pt de => pt-br fr pt de
 de pt-br fr pt => de pt-br fr pt
    de pt-br fr => de pt-br fr pt
   hai pt-br fr => hai pt-br fr  pt

# Now test multi-part complicateds:
   pt-br-janeiro fr => pt-br-janeiro fr pt-br pt 
pt-br-janeiro de fr => pt-br-janeiro de fr pt-br pt
pt-br-janeiro de pt fr => pt-br-janeiro de pt fr pt-br

ja    pt-br-janeiro fr => ja pt-br-janeiro fr pt-br pt 
ja pt-br-janeiro de fr => ja pt-br-janeiro de fr pt-br pt
ja pt-br-janeiro de pt fr => ja pt-br-janeiro de pt fr pt-br

pt-br-janeiro de pt-br fr => pt-br-janeiro de pt-br fr pt
 # an odd case, since we don't filter for uniqueness in this sub
 
};

$Locale::Maketext::MATCH_SUPERS_TIGHTLY = 0;

foreach my $in (@in) {
  $in =~ s/^\s+//s;
  $in =~ s/\s+$//s;
  $in =~ s/#.+//s;
  next unless $in =~ m/\S/;
  
  my(@in, @should);
  {
    die "What kind of line is <$in>?!"
     unless $in =~ m/^(.+)=>(.+)$/s;
  
    my($i,$s) = ($1, $2);
    @in     = ($i =~ m/(\S+)/g);
    @should = ($s =~ m/(\S+)/g);
    #print "{@in}{@should}\n";
  }
  my @out = Locale::Maketext->_add_supers(
    ("@in" eq 'NIX') ? () : @in
  );
  #print "O: ", join(' ', map "<$_>", @out), "\n";
  @out = 'NIX' unless @out;

  
  if( @out == @should
      and lc( join "\e", @out ) eq lc( join "\e", @should )
  ) {
    print "#     Happily got [@out] from [$in]\n";
    ok 1;
  } else {
    ok 0;
    print "#!!Got:         [@out]\n",
          "#!! but wanted: [@should]\n",
          "#!! from \"$in\"\n#\n";
  }
}

print "#\n#\n# Bye-bye!\n";
ok 1;


--- NEW FILE: 10_make.t ---

require 5;
use Test;
BEGIN { plan tests => 6; }
use Locale::Maketext 1.01;
print "# Hi there...\n";
ok 1;

# declare some classes...
{
  package Woozle;
  @ISA = ('Locale::Maketext');
  sub dubbil   { return $_[1] * 2 }
  sub numerate { return $_[2] . 'en' }
}
{
  package Woozle::elx;
  @ISA = ('Woozle');
  %Lexicon = (
   'd2' => 'hum [dubbil,_1]',
   'd3' => 'hoo [quant,_1,zaz]',
   'd4' => 'hoo [*,_1,zaz]',
  );
  keys %Lexicon; # dodges the 'used only once' warning
}

ok defined( $lh = Woozle->get_handle('elx') ) && ref($lh);
ok $lh && $lh->maketext('d2', 7), "hum 14"      ;
ok $lh && $lh->maketext('d3', 7), "hoo 7 zazen" ;
ok $lh && $lh->maketext('d4', 7), "hoo 7 zazen" ;

print "# Byebye!\n";
ok 1;