Bug 251552 - lang/perl5-5.32: Test::More like()
Summary: lang/perl5-5.32: Test::More like()
Status: Closed Works As Intended
Alias: None
Product: Ports & Packages
Classification: Unclassified
Component: Individual Port(s) (show other bugs)
Version: Latest
Hardware: amd64 Any
: --- Affects Some People
Assignee: Mathieu Arnold
URL:
Keywords: needs-qa
Depends on:
Blocks:
 
Reported: 2020-12-03 04:10 UTC by David Christensen
Modified: 2021-01-06 17:19 UTC (History)
2 users (show)

See Also:
fernape: maintainer-feedback? (mat)


Attachments
tarball containing hello and bug.t scripts (761 bytes, application/gzip)
2020-12-03 04:10 UTC, David Christensen
no flags Details

Note You need to log in before you can comment on or make changes to this bug.
Description David Christensen 2020-12-03 04:10:31 UTC
Created attachment 220202 [details]
tarball containing hello and bug.t scripts

As I understand it, Test::More is included with Perl 5.


like() works as expected on Debian GNU/Linux and Windows 7/ Cygwin:

2020-12-02 19:56:33 dpchrist@dipsy ~/sandbox/perl/capture-system-like
$ cat /etc/debian_version
10.6

2020-12-02 19:56:51 dpchrist@dipsy ~/sandbox/perl/capture-system-like
$ uname -a
Linux dipsy 4.19.0-12-amd64 #1 SMP Debian 4.19.152-1 (2020-10-18) x86_64 GNU/Linux

2020-12-02 19:56:54 dpchrist@dipsy ~/sandbox/perl/capture-system-like
$ perl -v

This is perl 5, version 28, subversion 1 (v5.28.1) built for x86_64-linux-gnu-thread-multi
(with 65 registered patches, see perl -V for more detail)

Copyright 1987-2018, Larry Wall

Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.

Complete documentation for Perl, including FAQ lists, should be found on
this system using "man perl" or "perldoc perl".  If you have access to the
Internet, point your browser at http://www.perl.org/, the Perl Home Page.


2020-12-02 19:56:56 dpchrist@dipsy ~/sandbox/perl/capture-system-like
$ perl -MCapture::Tiny -e 'print $Capture::Tiny::VERSION, "\n"'
0.48

2020-12-02 19:57:00 dpchrist@dipsy ~/sandbox/perl/capture-system-like
$ cat hello 
#!/usr/bin/env perl
# $Id: hello,v 1.1 2020/12/03 03:18:56 dpchrist Exp $

use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;

our %opt;

GetOptions(\%opt, 'man') or die;

pod2usage(-exitstatus => 0, -verbose => 2) if $opt{man};

print "hello, world!\n";

__END__

=head1 NAME

 hello - "hello, world!" with manual page option

=head1 SYNOPSIS

 hello [--man]

=head1 AUTHOR

David Paul Christensen dpchrist@holgerdanske.com

=head1 LICENSE

Public Domain

=cut

2020-12-02 19:57:03 dpchrist@dipsy ~/sandbox/perl/capture-system-like
$ cat bug.t 
# $Id: bug.t,v 1.1 2020/12/03 03:18:56 dpchrist Exp $
# by David Paul Christensen dpchrist@holgerdanske.com
# Public Domain.

use strict;
use warnings;

use Capture::Tiny qw(
    capture
);
use File::Basename;
use File::Spec::Functions;
use FindBin qw(
    $Bin
);
use Test::More;

my $script = catfile $Bin, 'hello';

my $basename = basename $script;
my $stderr;
my $stdout;
my $retval;

($stdout, $stderr, $retval)  = capture {
    system $^X, "-I$FindBin::Bin/../lib", $script, '--man'
};
like
    $stdout,
    qr{NAME.+$basename.+SYNOPSIS}s,
    "case " . __LINE__;
is $stderr, '', "case " . __LINE__;
is $retval, 0, "case " . __LINE__;

done_testing;

2020-12-02 19:57:05 dpchrist@dipsy ~/sandbox/perl/capture-system-like
$ perl bug.t 
ok 1 - case 31
ok 2 - case 32
ok 3 - case 33
1..3


like() does not work as expected on FreeBSD (and macOS/Darwin):

2020-12-02 19:59:05 toor@vf1 ~/sandbox/perl/capture-system-like
# freebsd-version 
12.1-RELEASE-p10

2020-12-02 19:59:12 toor@vf1 ~/sandbox/perl/capture-system-like
# uname -a
FreeBSD vf1.tracy.holgerdanske.com 12.1-RELEASE-p10 FreeBSD 12.1-RELEASE-p10 GENERIC  amd64

2020-12-02 19:59:13 toor@vf1 ~/sandbox/perl/capture-system-like
# perl -v

This is perl 5, version 32, subversion 0 (v5.32.0) built for amd64-freebsd-thread-multi

Copyright 1987-2020, Larry Wall

Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.

Complete documentation for Perl, including FAQ lists, should be found on
this system using "man perl" or "perldoc perl".  If you have access to the
Internet, point your browser at http://www.perl.org/, the Perl Home Page.


2020-12-02 19:59:15 toor@vf1 ~/sandbox/perl/capture-system-like
# perl -MCapture::Tiny -e 'print $Capture::Tiny::VERSION, "\n"'
0.48

2020-12-02 19:59:17 toor@vf1 ~/sandbox/perl/capture-system-like
# cat hello 
#!/usr/bin/env perl
# $Id: hello,v 1.1 2020/12/03 03:18:56 dpchrist Exp $

use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;

our %opt;

GetOptions(\%opt, 'man') or die;

pod2usage(-exitstatus => 0, -verbose => 2) if $opt{man};

print "hello, world!\n";

__END__

=head1 NAME

 hello - "hello, world!" with manual page option

=head1 SYNOPSIS

 hello [--man]

=head1 AUTHOR

David Paul Christensen dpchrist@holgerdanske.com

=head1 LICENSE

Public Domain

=cut

2020-12-02 19:59:19 toor@vf1 ~/sandbox/perl/capture-system-like
# cat bug.t 
# $Id: bug.t,v 1.1 2020/12/03 03:18:56 dpchrist Exp $
# by David Paul Christensen dpchrist@holgerdanske.com
# Public Domain.

use strict;
use warnings;

use Capture::Tiny qw(
    capture
);
use File::Basename;
use File::Spec::Functions;
use FindBin qw(
    $Bin
);
use Test::More;

my $script = catfile $Bin, 'hello';

my $basename = basename $script;
my $stderr;
my $stdout;
my $retval;

($stdout, $stderr, $retval)  = capture {
    system $^X, "-I$FindBin::Bin/../lib", $script, '--man'
};
like
    $stdout,
    qr{NAME.+$basename.+SYNOPSIS}s,
    "case " . __LINE__;
is $stderr, '', "case " . __LINE__;
is $retval, 0, "case " . __LINE__;

done_testing;

2020-12-02 19:59:20 toor@vf1 ~/sandbox/perl/capture-system-like
# perl bug.t 
not ok 1 - case 31
#   Failed test 'case 31'
#   at bug.t line 28.
#                   'HELLO(1)              User Contributed Perl Documentation             HELLO(1)
# 
# 
# 
# 
# NAME
#         hello - "hello, world!" with manual page option
# 
# SYNOPSIS
#         hello [--man]
# 
# AUTHOR
#        David Paul Christensen dpchrist@holgerdanske.com
# 
# LICENSE
#        Public Domain
# 
# 
# 
# perl v5.32.0                      2020-12-03                          HELLO(1)
# '
#     doesn't match '(?^s:NAME.+hello.+SYNOPSIS)'
ok 2 - case 32
ok 3 - case 33
1..3
# Looks like you failed 1 test of 3.


I have tested like() in isolation, and it works as expected.  Therefore, the combination of Test::More, Capture::Tiny, and/or system may be causing the 
problem (?).


The bug existed on earlier patch levels of FreeBSD 12.1, but I do not have details.


David
Comment 1 Mathieu Arnold freebsd_committer 2021-01-04 15:31:04 UTC
Well, I tried your test, like() works just fine, it is correct in what it tells you.

If you actually look at the content of the `./hello --man`, you will see that it does not actually match your string, on a random freebsd box, it contains:

N^HNA^HAM^HME^HE                                                                                                                                                                                                     
  | ¦ ┆ hello - "hello, world!" with manual page option                                                                                                                                                              
                                                                                                                                                                                                                     
S^HSY^HYN^HNO^HOP^HPS^HSI^HIS^HS                                                                                                                                                                                     
  | ¦ ┆ hello [--man]
Comment 2 Mathieu Arnold freebsd_committer 2021-01-04 15:32:35 UTC
Sorry for the `| ¦ ┆` those are from my text editor, but the problem was not there.
Comment 3 David Christensen 2021-01-05 04:22:51 UTC
You're right, I missed that -- the output of 'hello --man' is different on Linux:

2021-01-04 20:06:17 dpchrist@tinkywinky ~/sandbox/perl/capture-system-like
$ cat /etc/debian_version ; uname -a ; perl -v | head -n 2
9.13
Linux tinkywinky 4.9.0-13-amd64 #1 SMP Debian 4.9.228-1 (2020-07-05) x86_64 GNU/Linux

This is perl 5, version 24, subversion 1 (v5.24.1) built for x86_64-linux-gnu-thread-multi

2021-01-04 20:06:22 dpchrist@tinkywinky ~/sandbox/perl/capture-system-like
$ ./hello --man | hexdump | head
00000000  1b 5b 31 6d 4e 41 4d 45  1b 5b 30 6d 0a 20 20 20  |.[1mNAME.[0m.   |
00000010  20 20 68 65 6c 6c 6f 20  2d 20 22 68 65 6c 6c 6f  |  hello - "hello|
00000020  2c 20 77 6f 72 6c 64 21  22 20 77 69 74 68 20 6d  |, world!" with m|
00000030  61 6e 75 61 6c 20 70 61  67 65 20 6f 70 74 69 6f  |anual page optio|
00000040  6e 0a 0a 1b 5b 31 6d 53  59 4e 4f 50 53 49 53 1b  |n...[1mSYNOPSIS.|
00000050  5b 30 6d 0a 20 20 20 20  20 68 65 6c 6c 6f 20 5b  |[0m.     hello [|
00000060  2d 2d 6d 61 6e 5d 0a 0a  1b 5b 31 6d 41 55 54 48  |--man]...[1mAUTH|
00000070  4f 52 1b 5b 30 6d 0a 20  20 20 20 44 61 76 69 64  |OR.[0m.    David|
00000080  20 50 61 75 6c 20 43 68  72 69 73 74 65 6e 73 65  | Paul Christense|
00000090  6e 20 64 70 63 68 72 69  73 74 40 68 6f 6c 67 65  |n dpchrist@holge|


Than it is on FreeBSD:

2021-01-04 20:04:41 dpchrist@f3 ~/sandbox/perl/capture-system-like
$ freebsd-version ; uname -a ; perl -v | head -n 2
12.1-RELEASE-p12
FreeBSD f3.tracy.holgerdanske.com 12.1-RELEASE-p11 FreeBSD 12.1-RELEASE-p11 GENERIC  amd64

This is perl 5, version 32, subversion 0 (v5.32.0) built for amd64-freebsd-thread-multi

2021-01-04 20:08:16 dpchrist@f3 ~/sandbox/perl/capture-system-like
$ ./hello --man | hexdump | head
00000000  48 45 4c 4c 4f 28 31 29  20 20 20 20 20 20 20 20  |HELLO(1)        |
00000010  20 20 20 20 20 20 55 73  65 72 20 43 6f 6e 74 72  |      User Contr|
00000020  69 62 75 74 65 64 20 50  65 72 6c 20 44 6f 63 75  |ibuted Perl Docu|
00000030  6d 65 6e 74 61 74 69 6f  6e 20 20 20 20 20 20 20  |mentation       |
00000040  20 20 20 20 20 20 48 45  4c 4c 4f 28 31 29 0a 0a  |      HELLO(1)..|
00000050  0a 0a 0a 4e 08 4e 41 08  41 4d 08 4d 45 08 45 0a  |...N.NA.AM.ME.E.|
00000060  20 20 20 20 20 20 20 20  68 65 6c 6c 6f 20 2d 20  |        hello - |
00000070  22 68 65 6c 6c 6f 2c 20  77 6f 72 6c 64 21 22 20  |"hello, world!" |
00000080  77 69 74 68 20 6d 61 6e  75 61 6c 20 70 61 67 65  |with manual page|
00000090  20 6f 70 74 69 6f 6e 0a  0a 53 08 53 59 08 59 4e  | option..S.SY.YN|


So, Pod::Usage::pod2usage generates different escape sequences for bold text on the two platforms and Test::More::like is working correctly.


I need to adjust the regular expression I pass to like() so that it can deal with the bold text escape sequences on platform;

2021-01-04 20:14:44 dpchrist@f3 ~/sandbox/perl/capture-system-like
$ cat bug.t 
# $Id: bug.t,v 1.2 2021/01/05 04:13:24 dpchrist Exp $
# by David Paul Christensen dpchrist@holgerdanske.com
# Public Domain.

use strict;
use warnings;

use Capture::Tiny qw(
    capture
);
use File::Basename;
use File::Spec::Functions;
use FindBin qw(
    $Bin
);
use Test::More;

my $script = catfile $Bin, 'hello';

my $basename = basename $script;
my $stderr;
my $stdout;
my $retval;

($stdout, $stderr, $retval)  = capture {
    system $^X, "-I$FindBin::Bin/../lib", $script, '--man'
};
like
    $stdout,
    qr{N.*A.*M.*E.*$basename.+S.*Y.*N.*O.*P.*S.*I.*S}s,
    "case " . __LINE__;
is $stderr, '', "case " . __LINE__;
is $retval, 0, "case " . __LINE__;

done_testing;

2021-01-04 20:14:46 dpchrist@f3 ~/sandbox/perl/capture-system-like
$ perl bug.t 
ok 1 - case 31
ok 2 - case 32
ok 3 - case 33
1..3


Thank you.  :-)


David
Comment 4 Mathieu Arnold freebsd_committer 2021-01-06 17:19:22 UTC
This is probably a TERM or termcap difference, (or groff,) there is a chance you can ask Pod::Usage::pod2usage through some env variable to generate vanilla man pages without embellishments.