X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fhl_mod.t;h=a88f6c0372bd2d1fcbbc0cd5bba482b3c22b37c5;hb=4eee5af6011cc8cdefb66c9729952c7eff5c0b0b;hp=80f88907e4ed577f74ed3e95d5a281cdd84c6d2f;hpb=65323f060a3db731bb9fafa004336eeb4bbb8f00;p=public-inbox.git diff --git a/t/hl_mod.t b/t/hl_mod.t index 80f88907..a88f6c03 100644 --- a/t/hl_mod.t +++ b/t/hl_mod.t @@ -1,33 +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'); + 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; @@ -37,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/