App-diff_spreadsheets

 view release on metacpan or  search on metacpan

t/t_Common.pm  view on Meta::CPAN

    @_=($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;

t/t_TestCommon.pm  view on Meta::CPAN

    print STDERR decode("utf8", $inmem_stdERR, FB_PERLQQ|LEAVE_SRC);
    $errmsg = $errmsg ? "$errmsg and STDERR" : "Silence expected on STDERR";
  }
  defined($errmsg) ? $errmsg." at $start_silent_loc\n" : undef;
}
sub _start_silent() {
  confess "nested silent treatments not supported" if $silent_mode;
  $silent_mode = 1;

  for (my $N=0; ;++$N) {
    my ($pkg, $file, $line) = caller($N);
    $start_silent_loc = "$file line $line", last if $pkg ne __PACKAGE__;
  }

  $orig_DIE_trap = $SIG{__DIE__};
  $SIG{__DIE__} = sub{
    return if $^S or !defined($^S);  # executing an eval, or Perl compiler
    my @diemsg = @_;
    my $err=_finish_silent(); warn $err if $err;
    die @diemsg;
  };

t/t_TestCommon.pm  view on Meta::CPAN

      ++$vposn;
    }
  }
  @_ = ( "\n**************************************\n"
        .($desc ? "${desc}\n" : "")
        ."Expected:\n".displaystr($exp)."\n"
        ."Actual:\n".displaystr($act)."\n"
        # + for opening « or << in the displayed str
        .(" " x ($hposn+length($quotes[0])))."^"
                          .($vposn > 0 ? "(line ".($vposn+1).")\n" : "\n")
        ." at line ", (caller(0))[2]."\n"
       ) ;
  goto &Carp::confess;
  #Carp::confess(@_);
}
sub expect1($$) {
  @_ = ("", @_);
  goto &mycheckeq_literal;
}

# Convert a literal "expected" string which contains things which are

t/t_TestCommon.pm  view on Meta::CPAN

      unless ($expected eq $actual) {
        @_ = ("TESTc FAILED: $desc", $expected, $actual);
        goto &mycheckeq_literal
      }
    }
  }
}

sub verif_eval_err(;$) {  # MUST be called on same line as the 'eval'
  my ($msg_regex) = @_;
  my @caller = caller(0);
  my $ln = $caller[2];
  my $fn = $caller[1];
  my $ex = $@;
  confess "expected error did not occur at $fn line $ln\n",
    unless $ex;

  if ($ex !~ / at \Q$fn\E line $ln\.?(?:$|\R)/s) {
    confess "Got UN-expected err (not ' at $fn line $ln'):\n«$ex»\n",
            "\n";
  }
  if ($msg_regex && $ex !~ qr/$msg_regex/) {
    confess "Got UN-expected err (not matching $msg_regex) at $fn line $ln'):\n«$ex»\n",
            "\n";
  }
  verif_no_internals_mentioned($ex) if defined $testee_top_module;
  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());

t/t_dsUtils.pm  view on Meta::CPAN

    };
  } else {
    ($out, $err, $wstat) = Capture::Tiny::capture {
      run_perlscript $progpath, @extraargs, $in1, $in2;
    };
  }

  # We can only use the 'goto &somewhere' trick for one check; so other
  # check(s) must be done here and will unhelpfully report the file/linenum
  # in here; so include the caller's file/lno in the description.
  my ($file, $lno) = (caller(0))[1,2];
  $file = basename($file);
  my $diag = "COMMAND: ".qshlist($progpath, @extraargs, $in1, $in2)."\n"
             .($show_output ? "" : "OUT:<<$out>>\nERR:<<$err>>\n");

  # If $exp_exit > 0xFF then assume an abort from signal is expected
  # and compare $exp_exit directly with $wstat.
  #
  # Otherwise assume a normal exit (not abort) is expected and compare
  # $exp_exit with the exit value in the upper 8 bits of $wstat; but
  # if the process aborted, fail with a special message.

tlib/xmlstuff.pl  view on Meta::CPAN

      unless $encoding;
    $chars = decode($encoding, $octets, Encode::FB_CROAK);
  }
  wantarray ? ($chars, $encoding) : $chars
}

sub new {
  my ($class, $path, %opts) = @_;
  my $self = bless {%opts}, $class;
  my $zip = $self->{zip} = $self->SUPER::new(); # Archive::Zip->new();
  note "> Opening ",qsh($path)," at ",(caller(0))[2] if $self->{debug};
  confess "Error reading $path ($!)"
    unless $zip->read($path) == AZ_OK;
  $self->{orig_path} //= $path;
  $self
}

sub get_raw_content {
  my $self = shift;
  my $member_name = $_[0] // DEFAULT_MEMBER_NAME;

tlib/xmlstuff.pl  view on Meta::CPAN

    // confess "No such member ",visq($member_name);
  $zip->removeMember($member_name);
  my $new_member = $zip->addString($octets, $member_name);
  $new_member->desiredCompressionMethod( COMPRESSION_DEFLATED );
}

sub store {
  my ($self, $dest_path) = @_;
  confess "Destination path missing" unless $dest_path;
  my $zip = $self->{zip};
  note "> Writing ",qsh($dest_path)," at ",(caller(0))[2] if $self->{debug};
  $zip->writeToFileNamed($dest_path) == AZ_OK
    or confess "Write error ($!)";
}
sub memberNames { my $s=shift; $s->{zip}->memberNames(@_) }
sub members     { my $s=shift; $s->{zip}->members(@_) }
sub contents    { my $s=shift; $s->{zip}->contents(@_) }

#-----------------------------------------------------
package main;