The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More tests => 25;
use strict;
use warnings;

# check output of Devel::DumpTrace module, compare with reference output.

my $dmodule = "-d:DumpTrace::noPPI";

open T, '>', "$0.pl";
print T <<'EO_T;';

# test program for t/83-smoke.t, t/ppi/83-smoke.t
our @u = '_';
for my $v (15,13,1) {
    push @u, ($v) x $v;
}

EO_T;





# levels 1,2,3 can be distinguished by which lines are abbreviated.
# level 1: two lines should have abbrev
# level 2: one line
# level 3: no lines

for my $level (1, 2, 3) {

  my $file = "$0.out.$level";
  $ENV{DUMPTRACE_FH} = $file;
  $ENV{DUMPTRACE_LEVEL} = $level;
  my $c1 = system($^X, $dmodule, "-Iblib/lib", "-Ilib", "$0.pl");
  my $keep = 0;

  ok($c1 == 0, "ran level $level") or $keep++;

  open XH, '<', $file;
  my @xh = <XH>;
  close XH;

  ok(@xh == 5, "smoke output has 5 lines level=$level")
	or diag(@xh, " ", scalar @xh) or $keep++;
  my (@abbrevs) = grep { /\.\.\./ } @xh;
  ok(@abbrevs = 3 - $level,
     "smoke output has 3-$level lines abbreviated") or $keep++;
  ok(5 == grep { /\>+\s+$0.pl:\d+\S*:\s+\S/ } @xh,
     "smoke output displays file and line on all output") or $keep++;

  unlink $file unless $keep;
}


my @xh4;

for my $level (4, 5) {

  my $file = "$0.out.$level";
  $ENV{DUMPTRACE_FH} = $file;
  $ENV{DUMPTRACE_LEVEL} = $level;
  my $c1 = system($^X, $dmodule, "-Iblib/lib", "-Ilib", "$0.pl");
  my $keep = 0;

  ok($c1 == 0, "ran level $level") or $keep++;

  open XH, '<', $file;
  my @xh = <XH>;
  close XH;

  ok(@xh == 20, "smoke output has 20 lines level=$level") or $keep++;

  my $separate_line_for_line_and_file = qr{^>>\s+$0.pl:\d+:};
  my $uneval_lhs = qr#^>{3,4}\s+[\$\@]\w+.*=#;
  my $uneval_rhs = qr{=.*[\$\@]};

  ok($xh[0] =~ $separate_line_for_line_and_file
     && $xh[4] =~ $separate_line_for_line_and_file
     && $xh[8] =~ $separate_line_for_line_and_file
     && $xh[12] =~ $separate_line_for_line_and_file,
     "level $level separate line for line & file") or $keep++;

  ok($xh[2] !~ $uneval_lhs 
     && $xh[6] !~ $uneval_lhs
     && $xh[10] !~ $uneval_lhs,
     "level $level seperate line for evaluate lhs") or $keep++;

  ok($xh[3] eq $xh[7] && $xh[3] eq $xh[11] && $xh[3] eq $xh[15]
     && substr($xh[3],0,10) eq '-' x 10,
     "level $level output has separator lines") or $keep++;

  if (@xh4) {
    # expect @xh, @xh4 to be identical except for one
    # abbreviated line
    my $diff = 0;
    for my $i (0..$#xh4) {
      if ($diff==0 && $xh[$i] ne $xh4[$i]) {
        ok($xh4[$i] =~ /\.\.\./, "level 4 has abbreviation") or $keep++;
        ok(length($xh4[$i]) < length($xh[$i]),
           "level 4/5 diff line shorter in level 4") or $keep++;
        $diff++;
      }
    }
    ok($diff==1, "one difference between level 4 & 5") or $keep++;
  } else {
    @xh4 = @xh;
  }

  unlink $file unless $keep;
}

unlink "$0.pl";