view release on metacpan or  search on metacpan

t/ppi/88-smoke-decorators.t  view on Meta::CPAN

my $dmodule = "-d:DumpTrace::PPI=normal";

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

# test program for t/ppi/88-smoke-decorators.t
# that contains a C-style for loop,
# a while loop, an until loop, and a
# complex if-elsif-else block.
for (my $i=1; $i<5; $i++) {
    $j += 2 * $i - 1;
    if ($i < 2) {
	$k += $j;
	$j = 0;
    } elsif ($i > 3) {
        $j = 0;
	do {
	   $k += 2 * $j++;
        } until $k > $j;
    } elsif ($i == 2) {
	until ($j > 50) {
	    $k -= $j;
	    $j *= 2;
            $j++ if $j == 0;
	}
        $t = $i * $j * $k;
    } else {
	while ($j > 0) {
	    $k += sqrt($j);
	    $j = $j / 2 - 1;
	}
        $t = $i + $j + $k;
    }
}
$u = $j - $k;

EO_T;





my $level = 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 = $ENV{KEEP} || 0;

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

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

# tests:
#   C-style for loops:
#     for loop statement appears only on first iteration
#     on other iterations, there are lines matching
#          FOR-UPDATE: {.*} FOR-COND: {.*}
#     the FOR-UPDATE ... lines have file/line information
#     the lines _after_ FOR-UPDATE ... do not have file/line information
#     condition statement for last iteration is observed
#
#   while/until loops
#     while / until keyword appears only on first iteration
#     on other iterations, there are lines matching
#         WHILE:\s*(.*)  or   UNTIL:\s*(.*)
#     WHILE:/UNTIL: lines have file/line information
#     lines _after_ WHILE:/UNTIL: ... do not have file/line information
#     condition statement for last iteration observed
#
#   if/elsif/else blocks
#     line with if keyword has file/line info
#     line after if keyword has file/line info
#     line with ELSEIF has a condition clause
#     line with ELSE or ELSIF either
#         has file/line info, or
#         is preceded by an ELSIF line
#     ELSE/ELSIF line with file/line info is preceded by an if line
#
#   do/while do/until
#     line with DO-UNTIL/DO-WHILE does not have file and line information
#     line before DO-UNTIL/DO-WHILE has file line info
#     first iteration, line says "do {"
#         appears before all other DO-UNTIL/DO-WHILE statements

my $FILELINE_INFO = qr/$0.pl:\d+:/;


############### C-style for loops ################

my @for_lines = grep {
  $xh[$_] =~ /for(each)?\s*\(.*;.*;.*\)\s*\{/
} 0 .. $#xh;
my @for_upds = grep {
  $xh[$_] =~ /FOR-UPDATE:\s*\{.*\}\s*FOR-COND:\s*\{.*\}/
} 0 .. $#xh;
my @for_cond = grep {
  $xh[$_] =~ /\s*FOR-COND:\s*\{.*\}/
} 0 .. $#xh;

ok(@for_lines == 1,
   "source for (...;...;...) statement appears only once")
  or $keep++;
ok(@for_upds > 1,
   "for loop decorators appear and appear more than once")
  or $keep++;
ok($for_lines[0] < $for_upds[0],
   "keyword for appears first, before decorators")
  or $keep++;
ok($xh[$for_upds[0]] =~ $FILELINE_INFO &&
   $xh[$for_upds[-1]] =~ $FILELINE_INFO,
   "for loop decorators have file and line information")
  or $keep++;
ok($xh[1+$for_upds[0]] !~ $FILELINE_INFO
   && $xh[1+$for_upds[-1]] !~ $FILELINE_INFO,
   "lines following for loop decoratorrs do not have file/line info")
    or $keep++;
ok(@for_cond == @for_upds + 1,
   "single FOR-COND without FOR-UPDATE found") or $keep++;
ok(" @for_upds " !~ / $for_cond[-1] / && $xh[$for_cond[-1]] !~ /FOR-UPD/,
   "final FOR-COND exits the loop") or do { $keep++; diag $xh[$for_cond[-1]] };

################# while/until loops ##################

my @until_lines = grep {