Data-Dumper-Interp

 view release on metacpan or  search on metacpan

t/50_shebang.t  view on Meta::CPAN

#    mycheck $code_display, qr/$exp/, $doeval->($code, $item) ;
#  }
#}#checkstringy()

# Run a variety of tests on non-string item, i.e. something which is a
# number or structured object (which might contain strings within, e.g.
# values or quoted keys in a hash).
#
# The given regexp specifies the expected result with Useqq(1), i.e.
# double-quoted; a single-quoted version is derived internally.
sub mychecklit(&$$) {
  my ($doeval, $item, $dq_expected_re) = @_;
  (my $sq_expected_re = $dq_expected_re)
    =~ s{ ( [^\\"]++|(\\.) )*+ \K " }{'}xsg
       or do{ confess "bug" if $dq_expected_re =~ /(?<![^\\])'/; }; #probably
  foreach (
    [ "Data::Dumper::Interp->new()->vis(\$_[1])",  '_Q_' ],
    [ 'vis($_[1])',              '_Q_' ],
    [ 'visq($_[1])',             '_q_' ],
    [ 'avis($_[1])',             '(_Q_)' ],
    [ 'avisq($_[1])',            '(_q_)' ],

t/t_TestCommon.pm  view on Meta::CPAN

  close STDOUT;
  open(STDOUT, ">", \$inmem_stdOUT) or die "redir STDOUT: $!";
  binmode(STDOUT); binmode(STDOUT, ":utf8");

  my @ERR_layers = grep{ $_ ne "unix" } PerlIO::get_layers(*STDERR, output=>1);
  open($orig_stdERR, ">&", \*STDERR) or die "dup STDERR: $!";
  close STDERR;
  open(STDERR, ">", \$inmem_stdERR) or die "redir STDERR: $!";
  binmode(STDERR); binmode(STDERR, ":utf8");
}
sub silent(&) {
  my $wantarray = wantarray;
  my $code = shift;
  _start_silent();
  my @result = do{
    if (defined $wantarray) {
      return( $wantarray ? $code->() : scalar($code->()) );
    }
    $code->();
    my $dummy_result; # so previous call has null context
  };

t/t_TestCommon.pm  view on Meta::CPAN

  dprint "Got expected err: $ex\n";
}

sub insert_loc_in_evalstr($) {
  my $orig = shift;
  my ($fn, $lno) = (caller(0))[1,2];
#use Data::Dumper::Interp; say dvis '###insert_loc_in_evalstr $fn $lno';
  "# line $lno \"$fn\"\n".$orig
}

sub timed_run(&$@) {
  my ($code, $maxcpusecs, @codeargs) = @_;

  my $getcpu = eval {do{
    require Time::HiRes;
    () = (&Time::HiRes::clock());
    \&Time::HiRes::clock;
  }} // sub{ my @t = times; $t[0]+$t[1] };
  dprint("Note: $@") if $@;
  $@ = ""; # avoid triggering "Eval error" in mycheck();

t/t_TestCommon.pm  view on Meta::CPAN

sub clean_capture_output($) {
  my $str = shift;
  # For some reason I can not track down, tests on Windows in VirtualBox sometimes emit
  # this message.  I think (unproven) that this occurs because the current directory
  # is a VBox host-shared directory mounted read-only.   But nobody should be writing
  # to the cwd!
  $str =~ s/The media is write protected\S*\R//gs;
  $str
}

sub my_capture(&) {
  my ($out, $err, @results) = &capture($_[0]);
  return( clean_capture_output($out), clean_capture_output($err), @results );
}
sub my_capture_merged(&) {
  my ($merged, @results) = &capture_merged($_[0]);
  return( clean_capture_output($merged), @results );
}
sub my_tee_merged(&) {
  my ($merged, @results) = &tee_merged($_[0]);
  return( clean_capture_output($merged), @results );
}

1;