view release on metacpan or  search on metacpan

t/t_Common.pm  view on Meta::CPAN

# Common setup stuff, not specifically for test cases.
# This file is intended to be identical in all my module distributions.

package t_Common;

sub hash2str($) { my $h=shift; join("",map{" ${_}=>".($h->{$_}//"u")} sort keys %$h) }
my ($default_warnbits, $default_pragmas);
BEGIN {
  $default_warnbits = ${^WARNING_BITS}//"u";
  $default_pragmas = ($^H//"u").":".hash2str(\%^H);
}

use strict;

# Do not fatalize decode warnings (under category 'utf8') because various smokers
# can have restrictive stdout encodings.
use warnings  FATAL => 'all';
use warnings  NONFATAL => qw(
        utf8
        exec
        recursion
        internal
        malloc
        newline
        experimental
        deprecated
        portable
      );
#no warnings "once";

use feature qw/say state/;

require Exporter;
use parent 'Exporter';
our @EXPORT = qw/mytempfile mytempdir/;
our @EXPORT_OK = qw/oops btw btwN/;

use Import::Into;
use Carp;

sub oops(@) {
  my $pkg = caller;
  my $pfx = "\noops";
  $pfx .= " in pkg '$pkg'" unless $pkg eq 'main';
  $pfx .= ":\n";
  if (defined(&Spreadsheet::Edit::logmsg)) {
    # Show current apply sheet & row if any.
    @_=($pfx, &Spreadsheet::Edit::logmsg(@_));
  } else {
    @_=($pfx, @_);
  }
  push @_,"\n" unless $_[-1] =~ /\R\z/;
  goto &Carp::confess
}

# "By The Way" messages showing file:linenum of the call
sub btw(@) { unshift @_,0; goto &btwN }
sub btwN($@) {
  my $N=shift;
  my ($fn, $lno) = (caller($N))[1,2];
  $fn =~ s/.*[\\\/]//;
  $fn =~ s/(.)\.[a-z]+$/$1/a;
  local $_ = join("",@_);
  s/\n\z//s;
  printf STDERR "%s:%d: %s\n", $fn, $lno, $_;
}

sub import {
  my $target = caller;

  state $imported_previously;
  unless ($imported_previously++) {
    # It seems like test cases using Test::More are re-started from
    # the beginning when Test::More is first loaded, and at that point
    # some non-default pragma is in effect.  I can't figure any other
    # reason why we would be imported twice, with non-default settings
    # the 2nd time.

    # Check that the user did not already say "no warnings ..." or somesuch
    # I was previously confused about how to do this,
    # see https://rt.cpan.org/Ticket/Display.html?id=147618
    my $users_warnbits = ${^WARNING_BITS}//"u";
    my $users_pragmas = ($^H//"u").":".hash2str(\%^H);
    carp "Detected 'use/no warnings/strict' done before importing ",
          __PACKAGE__, "\n(they might be un-done)\n"
      if ($users_pragmas ne $default_pragmas
            || $users_warnbits ne $default_warnbits);
  }
  strict->import::into($target);
  #warnings->import::into($target);
  warnings->import::into($target, FATAL => 'all'); # blowing up a test is ok

  #As of perl 5.39.8 multiple 'use' specifying Perl version is deprecated
  #use 5.010;  # say, state
  #use 5.011;  # cpantester gets warning that 5.11 is the minimum acceptable
  use 5.018;  # lexical_subs
  require feature;
  # Perl 5.18.0 seems to require the "no experimental..." before the "use feature"
  warnings->unimport::out_of($target, "experimental::lexical_subs");
  feature->import::into($target, qw/state say current_sub lexical_subs fc/);

  # die if obsolete or dangerous syntax is used
  require indirect;
  indirect->unimport::out_of($target);

  require multidimensional;
  multidimensional->unimport::out_of($target);

  require autovivification;
  # A bug makes
  #   "no autovivification warn anything..." wrongly flag
  #   "my %hash; delete $hash{nonexistentkey}"
  # This happens with Perl 5.24.0 and autovivification v0.18
  # but not with Perl5.34.0 and same autovivification.
  # So just disable autoviv but don't enable warnings...
  autovivification->unimport::out_of($target, qw/fetch store exists delete/);

  # Avoid regex performance penalty in Perl <= 5.18 if
  # $PREMATCH $MATCH or $POSTMATCH are imported (fixed in perl 5.20).
  require English;