Data-Dumper-Interp

 view release on metacpan or  search on metacpan

t/57_numeric_show.t  view on Meta::CPAN

}

my $n_count = 0;
my $s_count = 0;
sub check_numeric($$) { # calls ok(...)
  my ($value, $expected) = @_;
  my $san = Data::Dumper::Interp::_show_as_number($value);
  my $desc = ($expected ? "":"non-")."numeric ".fmt($value);
  my $ok = (!!$san == !!$expected);
  if (!$ok) {
    my $lno = (caller)[2];
    my @msgs = ("----- Failing test at line $lno, got ".u($san)." expecting ".u($expected)."\n",
                "Dump of value:".Data::Dumper::Interp::_dbvis($value)."\n",
                "Repeating with Debug enabled...\n");
    my $san2 = do{
      local $SIG{__WARN__} = sub{ push @msgs, $_[0]; };
      local $Data::Dumper::Interp::Debug = 1;
      Data::Dumper::Interp::_show_as_number($value);
    };
    push @msgs, "Urp! Different result with Debug==1:". u($san2)
      if u($san2) ne u($san);

t/t_TestCommon.pm  view on Meta::CPAN

  my $i; map{ sprintf "%s%2d: %s\n", $prefix,++$i,$_ } (split /\n/,$_[0]);
}

# These wrappers add the caller's line number to the test description
# so they show when successful tests log their name.
# This is only visible with using "perl -Ilib t/xxx.t"
# not with 'prove -l' and so mostly pointless!

sub t_ok($;$) {
  my ($isok, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//"") . " (line $lno)";
  @_ = ( $isok, $test_label );
  goto &Test2::V0::ok;  # show caller's line number
}
sub ok_with_lineno($;$) { goto &t_ok };

sub t_is($$;$) {
  my ($got, $exp, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//$exp//"undef") . " (line $lno)";
  @_ = ( $got, $exp, $test_label );
  goto &Test2::V0::is;  # show caller's line number
}
sub is_with_lineno($$;$) { goto &t_is }

sub t_like($$;$) {
  my ($got, $exp, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//$exp) . " (line $lno)";
  @_ = ( $got, $exp, $test_label );
  goto &Test2::V0::like;  # show caller's line number
}
sub like_with_lineno($$;$) { goto &t_like }

sub _mycheck_end($$$) {
  my ($errmsg, $test_label, $ok_only_if_failed) = @_;
  return
    if $ok_only_if_failed && !$errmsg;
  my $lno = (caller)[2];
  &Test2::V0::diag("**********\n${errmsg}***********\n") if $errmsg;
  @_ = ( !$errmsg, $test_label );
  goto &ok_with_lineno;
}

# Nicer alternative to mycheck() when 'expected' is a literal string, not regex
sub mycheckeq_literal($$$) {
  my ($desc, $exp, $act) = @_;
  #confess "'exp' is not plain string in mycheckeq_literal" if ref($exp); #not re!
  $exp = show_white($exp); # stringifies undef



( run in 2.082 seconds using v1.01-cache-2.11-cpan-1e74a51a04c )