ext/POSIX/t/mb.t

   1 #!./perl
   2
   3 # These tests are in a separate file, because they use fresh_perl_is()
   4 # from test.pl.
   5
   6 # The mb* functions use the "underlying locale" that is not affected by
   7 # the Perl one.  So we run the tests in a separate "fresh_perl" process
   8 # with the correct LC_CTYPE set in the environment.
   9
  10 BEGIN {
  11     require Config; import Config;
  12     if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
  13         print "1..0\n";
  14         exit 0;
  15     }
  16     unshift @INC, "../../t";
  17     require 'loc_tools.pl';
  18     require 'charset_tools.pl';
  19     require 'test.pl';
  20 }
  21
  22 plan tests => 4;
  23
  24 use POSIX qw();
  25
  26 SKIP: {
  27     skip("mblen() not present", 4) unless $Config{d_mblen};
  28
  29     is(&POSIX::mblen("a", &POSIX::MB_CUR_MAX), 1, 'mblen() basically works');
  30
  31     skip("LC_CTYPE locale support not available", 3)
  32       unless locales_enabled('LC_CTYPE');
  33
  34     my $utf8_locale = find_utf8_ctype_locale();
  35     skip("no utf8 locale available", 3) unless $utf8_locale;
  36
  37     # Here we need to influence LC_CTYPE, but it's not enough to just
  38     # set this because LC_ALL could override it. It's also not enough
  39     # to delete LC_ALL because it could be used to override other
  40     # variables such as LANG in the underlying test environment.
  41     # Continue to set LC_CTYPE just in case...
  42     local $ENV{LC_CTYPE} = $utf8_locale;
  43     local $ENV{LC_ALL} = $utf8_locale;
  44
  45     fresh_perl_like(
  46         'use POSIX; print &POSIX::MB_CUR_MAX',
  47       qr/[4-6]/, {}, 'MB_CUR_MAX is at least 4 in a UTF-8 locale');
  48
  49   SKIP: {
  50     my ($major, $minor, $rest) = $Config{osvers} =~ / (\d+) \. (\d+) .* /x;
  51     skip("mblen() broken (at least for c.utf8) on early HP-UX", 2)
  52         if   $Config{osname} eq 'hpux'
  53           && $major < 11 || ($major == 11 && $minor < 31);
  54     fresh_perl_is(
  55         'use POSIX; print &POSIX::mblen("'
  56       . I8_to_native("\x{c3}\x{28}")
  57       . '", 2)',
  58       -1, {}, 'mblen() recognizes invalid multibyte characters');
  59
  60     fresh_perl_is(
  61      'use POSIX; print &POSIX::mblen("\N{GREEK SMALL LETTER SIGMA}", 2)',
  62      2, {}, 'mblen() works on UTF-8 characters');
  63   }
  64 }