X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fhl_mod.t;h=a88f6c0372bd2d1fcbbc0cd5bba482b3c22b37c5;hb=2f8d15b1170b137a0512a4f3163b236a5dcbf0b8;hp=b8b8eb9d3a459185c06e365cacb3285868b6a7a6;hpb=0a04fa7bd38c8f491b429dc7d8578735ca7ca3f4;p=public-inbox.git diff --git a/t/hl_mod.t b/t/hl_mod.t index b8b8eb9d..a88f6c03 100644 --- a/t/hl_mod.t +++ b/t/hl_mod.t @@ -1,32 +1,34 @@ #!/usr/bin/perl -w -# Copyright (C) 2019 all contributors +# Copyright (C) 2019-2021 all contributors # License: AGPL-3.0+ -use strict; -use warnings; -use Test::More; -eval { require highlight } or - plan skip_all => 'failed to load highlight.pm'; +use strict; use v5.10.1; use PublicInbox::TestCommon; use IO::Handle; # ->autoflush +use Fcntl qw(:seek); +require_mods 'highlight'; use_ok 'PublicInbox::HlMod'; my $hls = PublicInbox::HlMod->new; ok($hls, 'initialized OK'); is($hls->_shebang2lang(\"#!/usr/bin/perl -w\n"), 'perl', 'perl shebang OK'); is($hls->{-ext2lang}->{'pm'}, 'perl', '.pm suffix OK'); is($hls->{-ext2lang}->{'pl'}, 'perl', '.pl suffix OK'); -is($hls->_path2lang('Makefile'), 'make', 'Makefile OK'); +like($hls->_path2lang('Makefile'), qr/\Amake/, 'Makefile OK'); my $str = do { local $/; open(my $fh, __FILE__); <$fh> }; my $orig = $str; { my $ref = $hls->do_hl(\$str, 'foo.perl'); is(ref($ref), 'SCALAR', 'got a scalar reference back'); + ok(utf8::valid($$ref), 'resulting string is utf8::valid'); like($$ref, qr/I can see you!/, 'we can see ourselves in output'); + like($$ref, qr/&&/, 'escaped &&'); + my $lref = $hls->do_hl_lang(\$str, 'perl'); + is($$ref, $$lref, 'do_hl_lang matches do_hl'); - use PublicInbox::Spawn qw(which); - if (eval { require IPC::Run } && which('w3m')) { - require File::Temp; - my $cmd = [ qw(w3m -T text/html -dump -config /dev/null) ]; - my ($out, $err) = ('', ''); - IPC::Run::run($cmd, $ref, \$out, \$err); + SKIP: { + my $w3m = require_cmd('w3m', 1) or + skip('w3m(1) missing to check output', 1); + my $cmd = [ $w3m, qw(-T text/html -dump -config /dev/null) ]; + my $in = '
' . $$ref . '
'; + my $out = xqx($cmd, undef, { 0 => \$in }); # expand tabs and normalize whitespace, # w3m doesn't preserve tabs $orig =~ s/\t/ /gs; @@ -36,19 +38,24 @@ my $orig = $str; } } -my $nr = $ENV{TEST_MEMLEAK}; -if ($nr && -r "/proc/$$/status") { - my $fh; - open $fh, '<', "/proc/$$/status"; - diag "starting at memtest at ".join('', grep(/VmRSS:/, <$fh>)); - PublicInbox::HlMod->new->do_hl(\$orig) for (1..$nr); - open $fh, '<', "/proc/$$/status"; - diag "creating $nr instances: ".join('', grep(/VmRSS:/, <$fh>)); - my $hls = PublicInbox::HlMod->new; - $hls->do_hl(\$orig) for (1..$nr); - $hls = undef; - open $fh, '<', "/proc/$$/status"; - diag "reused instance $nr times: ".join('', grep(/VmRSS:/, <$fh>)); +if ('experimental, only for help text') { + my $tmp = <<'EOF'; +:> +```perl +my $foo = 1 & 2; +``` +:< +EOF + $hls->do_hl_text(\$tmp); + my @hl = split(/^/m, $tmp); + is($hl[0], ":>\n", 'first line escaped'); + is($hl[1], "```perl\n", '2nd line preserved'); + like($hl[2], qr/