[Bug 251552] lang/perl5-5.32.0_1 Test::More like()

Thu Dec 3 04:10:32 UTC 2020

https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=251552

            Bug ID: 251552
           Summary: lang/perl5-5.32.0_1 Test::More like()
           Product: Ports & Packages
           Version: Latest
          Hardware: amd64
                OS: Any
            Status: New
          Severity: Affects Some People
          Priority: ---
         Component: Individual Port(s)
          Assignee: ports-bugs at FreeBSD.org
          Reporter: dpchrist at holgerdanske.com

Created attachment 220202
  --> https://bugs.freebsd.org/bugzilla/attachment.cgi?id=220202&action=edit
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 at dipsy ~/sandbox/perl/capture-system-like
$ cat /etc/debian_version
10.6

2020-12-02 19:56:51 dpchrist at 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 at 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 at dipsy ~/sandbox/perl/capture-system-like
$ perl -MCapture::Tiny -e 'print $Capture::Tiny::VERSION, "\n"'
0.48

2020-12-02 19:57:00 dpchrist at 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 at holgerdanske.com

=head1 LICENSE

Public Domain

=cut

2020-12-02 19:57:03 dpchrist at 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 at 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 at 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 at vf1 ~/sandbox/perl/capture-system-like
# freebsd-version 
12.1-RELEASE-p10

2020-12-02 19:59:12 toor at 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 at 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 at vf1 ~/sandbox/perl/capture-system-like
# perl -MCapture::Tiny -e 'print $Capture::Tiny::VERSION, "\n"'
0.48

2020-12-02 19:59:17 toor at 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 at holgerdanske.com

=head1 LICENSE

Public Domain

=cut

2020-12-02 19:59:19 toor at 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 at 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 at 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 at 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

-- 
You are receiving this mail because:
You are the assignee for the bug.