view release on metacpan or  search on metacpan

t/EscStatus.t  view on Meta::CPAN

# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with PerlIO-via-EscStatus.  If not, see <http://www.gnu.org/licenses/>.

use 5.006;
use strict;
use warnings;
use PerlIO::via::EscStatus;
use Test::More tests => 860;

use lib 't';
use MyTestHelpers;
MyTestHelpers::nowarnings();

my $want_version = 12;
is ($PerlIO::via::EscStatus::VERSION, $want_version,
    'VERSION variable');
is (PerlIO::via::EscStatus->VERSION,  $want_version,
    'VERSION class method');
ok (eval { PerlIO::via::EscStatus->VERSION($want_version); 1 },
    "VERSION class check $want_version");
{ my $check_version = $want_version + 1000;
  ok (! eval { PerlIO::via::EscStatus->VERSION($check_version); 1 },
      "VERSION class check $check_version");
}

## no critic (ProtectPrivateSubs)


sub printable {
  my ($str) = @_;
  $str =~ s{([^[:ascii:]])}
           {sprintf('\\x{%02X}',ord($1))}ge;
  return $str;
}

#------------------------------------------------------------------------------
# IsZero

## no critic (ProhibitEscapedCharacters)
my $_81_str = "\x{81}";
my $_9B_str = "\x{9B}";
my $_9F_str = "\x{9F}";
my $AD_str  = "\x{AD}";

diag 'IsZero';
ok ("\a"       =~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ("\r"       =~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ("\t"       !~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ("\e"       !~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ("X"        !~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ($_81_str   !~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ($_9B_str   !~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ($_9F_str   !~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ($AD_str    !~ /\p{PerlIO::via::EscStatus::IsZero}/);
ok ("\x{0300}" =~ /\p{PerlIO::via::EscStatus::IsZero}/); # Mn
ok ("\x{0488}" =~ /\p{PerlIO::via::EscStatus::IsZero}/); # Me
ok ("\x{1100}" !~ /\p{PerlIO::via::EscStatus::IsZero}/); # W
ok ("\x{FF10}" !~ /\p{PerlIO::via::EscStatus::IsZero}/); # F
ok ("\x{FEFF}" =~ /\p{PerlIO::via::EscStatus::IsZero}/); # BOM


#------------------------------------------------------------------------------
# IsDouble

diag 'IsDouble';
ok ("\a"       !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ("\r"       !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ("\t"       !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ("\e"       !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ("X"        !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ($AD_str    !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ($_81_str   !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ($_9B_str   !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ($_9F_str   !~ /\p{PerlIO::via::EscStatus::IsDouble}/);
ok ("\x{0300}" !~ /\p{PerlIO::via::EscStatus::IsDouble}/); # Mn
ok ("\x{0488}" !~ /\p{PerlIO::via::EscStatus::IsDouble}/); # Me
ok ("\x{1100}" =~ /\p{PerlIO::via::EscStatus::IsDouble}/); # W
ok ("\x{FF10}" =~ /\p{PerlIO::via::EscStatus::IsDouble}/); # F
ok ("\x{FEFF}" !~ /\p{PerlIO::via::EscStatus::IsDouble}/); # BOM


#------------------------------------------------------------------------------
# IsOther

diag 'IsOther';
ok ("\a"       !~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ("\r"       !~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ("\t"       !~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ("\e"       !~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ("X"        =~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ($AD_str    =~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ($_81_str   !~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ($_9B_str   !~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ($_9F_str   !~ /\p{PerlIO::via::EscStatus::IsOther}/);
ok ("\x{0300}" !~ /\p{PerlIO::via::EscStatus::IsOther}/); # Mn
ok ("\x{0488}" !~ /\p{PerlIO::via::EscStatus::IsOther}/); # Me
ok ("\x{1100}" !~ /\p{PerlIO::via::EscStatus::IsOther}/); # W
ok ("\x{FF10}" !~ /\p{PerlIO::via::EscStatus::IsOther}/); # F
ok ("\x{FEFF}" !~ /\p{PerlIO::via::EscStatus::IsOther}/); # BOM


#------------------------------------------------------------------------------
# _truncate

diag '_truncate';

foreach my $elem (
                  # singles
                  ["", 0, "", 0 ],
                  ["xyz", 0, "", 0 ],

                  ["x", 1, "x", 1 ],
                  ["xy", 2, "xy", 2 ],
                  ["xyz", 3, "xyz", 3 ],
                  ["xyz", 4, "xyz", 3 ],

                  # doubles
                  ["\x{1101}\x{1102}\x{1103}\x{1104}", 5,
                   "\x{1101}\x{1102}", 4 ],

                  ["\x{1101}\x{1102}\x{1103}\x{1104}\r", 8,
                   "\x{1101}\x{1102}\x{1103}\x{1104}\r", 8 ],

                  # tabs
                  [ "\tAB\a", 9, "\tA", 9 ],
                  [ "ZZ\tAB\a", 9, "ZZ\tA", 9 ],

                 ) {
  my ($str, $cols_limit, $want_trunc, $want_cols) = @$elem;

  my ($got_trunc, $got_cols) = PerlIO::via::EscStatus::_truncate
    ($str, $cols_limit);

  my $name = "on limit $cols_limit str ".printable($str);
  is ($got_trunc, $want_trunc, "string $name");
  is ($got_cols,  $want_cols,  "cols $name");
}

# ANSI
{ my ($trunc, $cols) = PerlIO::via::EscStatus::_truncate ("\e[34mfoo\e[0m", 3);
  is ($trunc, "\e[34mfoo\e[0m");
  is ($cols, 3);
}
{ my ($trunc, $cols) = PerlIO::via::EscStatus::_truncate ("\e[34mfoobar\e[0m", 3);
  is ($trunc, "\e[34mfoo\e[0m");
  is ($cols, 3);
}
{ my ($trunc, $cols) = PerlIO::via::EscStatus::_truncate ("\x{9B}35mfoobar\x{9B}30m", 3);
  is ($trunc, "\x{9B}35mfoo\x{9B}30m");
  is ($cols, 3);
}
{ my ($trunc, $cols) = PerlIO::via::EscStatus::_truncate ("\e[34m\e[0mfoobar", 3);
  is ($trunc, "\e[34m\e[0mfoo");
  is ($cols, 3);
}

# non-ANSI Esc, counted as width one
{ my ($trunc, $cols) = PerlIO::via::EscStatus::_truncate ("\eXYZ", 3);
  is ($trunc, "\eXY");