view release on metacpan or  search on metacpan

t/basic.pl  view on Meta::CPAN

      }
    }

    if (defined $err) {
      confess "BUG DETECTED...\n", fmtsheet(), "\n",
              #dvis('$rx $letters $cx $ABC $L $man_v $crow[$cx]\n@crow\n'),
              $err;
    }
  }
}#check_currrow_data

sub check_titles($) {
  my $letters = shift;  # specifies current column order; implies *data* values
  confess "bug" unless length($letters) == $num_cols;
  confess "UNDEF title_row!\n".fmtsheet() unless defined $title_row;
  for (my $cx=0; $cx < length($letters); $cx++) {
    my $L = substr($letters, $cx, 1);
    my ($title_L, $ABC_usable, $title_usable) = title_info($L, $cx);
    # $title_L is a letter which must appear in the title
    #   or "" if the title should be empty
    # $ABC_usable means the column can be accessed via its ABC letter code.
    die "bug" unless $rows[$title_rx]->[$cx] eq $title_row->[$cx];
    my $title = $title_row->[$cx];
    my $err;
    if ($title_L eq "") {
      $err //= ivis 'SHOULD HAVE EMPTY TITLE, not $title'
        unless $title eq "";
    } else {
      if ($title !~ /\Q$title_L\E/) {
        $err //= ivis 'WRONG TITLE $title (expecting to contain $title_L)'
      }
      if (! defined $colx{$title}) {
        $err //= ivis 'colx{$title} is undefined !!!!'
          if $title_usable;
      }
      elsif ($colx{$title} != $cx) {
        $err //= ivis 'colx{$title} wrong (expecting cx $cx)'
      }
    }
    apply_torx {
      if ($crow[$cx] ne $title) {
        $err //= ivis 'apply_torx title_rx : row->[$cx] is WRONG'
          if $title_usable;
      }
    } $title_rx;
    if ($ABC_usable) {
      my $ABC = cx2let($cx);
      my $v = $colx{$ABC};
      $err //= ivis('WRONG colx{ABC=$ABC} : Got $v, expecting $cx')
        unless u($v) eq $cx;
    }
    if (defined $err) {
      confess $err, dvis('\n$L $cx $title_L\n'), fmtsheet();
    }
  }
}#check_titles

sub check_both($) {
  my $letters = shift;  # current column ordering
  my $exp_nc = length($letters);
#warn "---check_both($letters) at ", (caller)[1], " line ", (caller)[2], "\n";
  croak "Expected $exp_nc columns (got $num_cols)" unless $exp_nc == $num_cols;

  my %oldoptions  = options();
  my %oldoptions2 = options(verbose => 0);
  eq_deeply(\%oldoptions, \%oldoptions2)
    or die "MISMATCH: ", dvis('%oldoptions\n%oldoptions2');
  scope_guard { options(verbose => $oldoptions2{verbose}) };

  check_titles $letters;
  apply {
    die "rx wrong" unless $rx > $title_rx;
    check_currow_data($letters)
  };
}

# Verify %colx entries, e.g. aliases.  Arguments are any mixture of
# [ $Ident, $CxorABC] or "Ident_CxorABC".
sub check_colx(@) {
  my $colx = sheet()->colx;
  foreach (@_) {
    my ($ident, $cx_or_abc);
    if (ref) {
      ($ident, $cx_or_abc) = @$_
    } else {
      ($ident, $cx_or_abc) = (/^(\w+)_(.*)$/);
    }
    my $cx = ($cx_or_abc =~ /\d/ ? $cx_or_abc : let2cx($cx_or_abc));
    my $actual_cx = $colx->{$ident};
    croak ivis 'colx{$ident}=$actual_cx, expecting $cx'
      unless u($cx) eq u($actual_cx);
    my $exp_celldata_rx2 = cx2let($cx)."2";
    die "bug" unless sheet()->[2]{$ident} eq $exp_celldata_rx2;
  }
}

####### MAIN ######

# Column variables named after (trimmed) titles or auto-aliases
# "A title  ",Btitle,"  Multi-Word Title C",,H,F,Gtitle,Z,"0","003","999","-1"
# A=0         B=1       C=2                  E F G=6    H  I   J     K     L
our ($A_title, $Btitle, $Multi_Word_Title_C, $H, $F, $Gtitle, $Z, $_0, $_003, $_999, $_1);
# And column letter codes (if they aren't titles)
our ($A,$B,$C,$D,$E,   $G,   $I,$J,$K,$L);

check_no_sheet;

# Auto-tie all columns, current and future.
# Note that tie_column_vars has it's own separate comprehensive test
tie_column_vars ':all';

options silent => $silent, verbose => $verbose, debug => $debug;

# Verify options() actually works
{ my @keys = qw/debug verbose silent/;
  my $s = sheet();
  my %orig = (map{$_ => $$s->{$_}} @keys);
  for my $key (@keys) {
    # Note: Setting debug or verbose affects silent...
    #warn dvis '###START $key';
    my $old = $$s->{$key};