view release on metacpan or  search on metacpan

test_eng/Testout.pm  view on Meta::CPAN

  @_ = grep {!/^$/} @_;		# remove empty lines
  return join("\t", @_) if grep {!/^\s*\[.*\]\s*$/} @_;	# Not matrix
  #return join("\t", @_) if grep {!/^\s*\([^,]*,\s*$/} @_; # Extra commas
  map {s/^\s*\[\s*(.*?)\s*\]\s*$/$1/} @_;
  my @arr = map { join ', ', split } @_;
  '[' . join('; ', @arr) . ']';
}

sub mformat_transp {
  return join("\t", @_) unless @_ > 1 and $_[0] =~ /^\[/;
  @_ = grep {!/^$/} @_;
  return join("\t", @_) if grep {!/^\s*\[.*\]\s*$/} @_;	# Not matrix
  #return join("\t", @_) if grep {!/^\s*\([^,]*,\s*$/} @_; # Extra commas
  map {s/^\s*\[(.*)\]\s*$/$1/} @_;
  my @arr = map { [split] } @_;
  my @out;
  my @dummy = ('') x @{$arr[0]};
  for my $ind (0..$#{$arr[0]}) {
    for my $subarr (@arr) {
      @$subarr > $ind or $subarr->[$ind] = '';
    }
    push @out, join ', ', map {$_->[$ind]} @arr;
  }
  '[' . join('; ', @out) . ']';
}

sub massage_floats {
  my $in = CORE::shift;
  my $pre = CORE::shift || "16g";
  $in =~ s/(.\d*)\s+e/$1E/gi;	# 1.74 E-78
  $in =~ s/\b(\d+\.\d*(e[-+]?\d+)?|\d{10,})\b/sprintf "%.${pre}", $1/gei;
  $in;
}

sub o_format {
  my ($var,$power) = @_;
  return " PARI('O($var^$power)') " if defined $power;
  return " PARI('O($var)') ";
}

sub process_cond {
  my ($what, $cond, $then, $else, $initial) = @_;
  die if $initial =~ /Skip this/;
  # warn "Converting `$in'\n`$what', `$cond', `$then', `$else'\n";
  if (($what eq 'if') ne (defined $else)) {
    return "Skip this `$initial'";
  } elsif ($what eq 'if') {
    return "( ($cond) ? ($then) : ($else) )";
  } else {
    return "do { $what ($cond) { $then } }";
  }
}

sub nok_print {
  my ($n, $in) = (CORE::shift, CORE::shift);
  print(@_), return unless $ENV{AUTOMATED_TESTING};
  warn("# in = `$in'\n", @_);
  print("not ok $n\n");
}

sub update_seen ($) {
  my $seen_now = CORE::shift;
  @seen{keys %$seen_now} = values %$seen_now;
#  my @VARS = map "\$$_", keys %$seen_now;
#  eval 'use vars @VARS; 1' or die "use vars: $@";
}

sub pre_update_seen ($) {
  my $sym = CORE::shift;
#  @seen{keys %$seen_now} = values %$seen_now;
#  my @VARS = map "\$$_", keys %$seen_now;
  eval "use vars '\$$sym'; 1" or die "use vars: $@";
}

sub subify_iterators ($$) {
  my($pre, $code, $subargs, $subdecl) = (CORE::shift, CORE::shift, '', '');
  if ($use_dollars_in_argsign) {
    $subargs = ' ($) ';
    if ($pre =~ /^(v?vector|fordiv|sumdiv|plothexport)\(/) {
      $pre =~ /^\w+\s*\([^,]*,\s*([\$\w]+)\s*,/ or die "Cannot find iterator variable in `$pre\{\{\{$code\}\}\}'";
      $subdecl = "my $1 = CORE::shift;"
    } else {
      $pre =~ /^\w+\s*\(\s*([\$\w]+)\s*,/ or die "Cannot find iterator variable in `$pre\{\{\{$code\}\}\}'";
      $subdecl = "my $1 = CORE::shift;"
    }
  }
#	      /$1 sub$subargs\{$2}/xg;
  "$pre sub$subargs\{$subdecl$code\}";
}

sub filter_res ($) { # In PARI’s Mod() output there is an extra space comparing to ours
  my $r = CORE::shift;
  $r =~ s/(\bmatrix\([^\s,]+)\s+/$1,/g;
#  	warn "### ->\t$r\n";
  return $r unless $r =~ /\bMod\(/;
  $r =~ s/,\s+/,/g;
  return $r;
}

my $prev;
sub process_test {
  my ($in, $noans, $out) = @_;
#	warn("<<<$in>>>, $noans, <<<@$out>>>");
  my($IN, $res, $rres, $rout) = $in;
  my $ini_time = time;
  my $doprint;
  $doprint = 1 if $noans eq 'print';
  my $was_prev = $prev;
  undef $prev;
  $current_num++;
  # First a trivial processing:
  $in =~ s/^\s*gettime\s*;//;		# Starting lines of tests...
  $in =~ s/\b(\d+|[a-z]+\(\))\s*\\\s*(\d+(\^\d+)?)/ gdivent($1,$2)/g; # \
  $in =~ s/\b(\d+)\s*\\\/\s*(\d+)/ gdivround($1,$2)/g; # \/
  $in =~ s/\b(\w+)\s*!/ ifact($1)/g; # !
  $in =~ s/,\s*(?=,)/, \$DEFAULT /g;	# Default arguments?
  $in =~ s/^default\(realprecision,(.*)\)/\\p $1/; # Some cases of default()
  $in =~ s/^default\(realbitprecision,(.*)\)/\\pb $1/; # Some cases of default()
  $in =~ s/^default\(seriesprecision,(.*)\)/\\ps $1/; # Some cases of default()
  $in =~ s/(\w+)\s*\\(\w+(\s*\^\s*\w+)?)/gdivent($1,$2)/g; # random\10^8
  $in =~ s/%(?!\s*[\[_\w])/\$was_prev/g; # foo(%)