jPrettypl : Pretty-printer for Perl

Synopsis:

prettypl.bat

@rem = '
@perl -S "%0" %1 %2 %3 %4 %5
@goto _perldone
@rem ';
#!perl -w
use PrettyPl;

sub usage
  {
  print "usage: $0 filename\n";
  exit(0);
  }

usage unless defined $ARGV[0];

my $rc = PrettyPl::reformat($ARGV[0]);

!$rc or die ($rc);

print "Done!\n";

__END__
:_perldone

prettypl.pm

Synopsis

#!perl -w
package PrettyPl;

use strict;
use Text::Tabs;

my $gSpacing = 1;
my $cInc   = '  ';

##---------------------------------------------------
#private:
sub spew($)
  {
  print OUT shift, "\n";
  }

##---------------------------------------------------
#public:
sub Spacing
  {
  my ($s) = @_;
  $gSpacing = $s if (defined($s));
  return $gSpacing;
  }

##---------------------------------------------------
#public:
sub reformat($)
  {
  my ($f) = @_;
  
  return "file $f not found\n" if (!-e $f);
  
  rename $f, "$f.orig";
  open FH, "<$f.orig" or return "Can't open file: $!\n";
  open OUT, ">$f" or return "Can't open file: $!\n";

  my @lines1 = <FH>;
  close FH;

  my $rc = reformatlinelist(\&spew, @lines1);

  close OUT;
  return $rc;
  }

#-----
#public:
sub reformatstr($$)
  {
  my ($rspew, $s) = @_;
  my @lines = split /\n/, $s;
   
  return reformatlinelist($rspew, @lines);
  }

#-----
#public:
sub reformatlinelist($@)
  {
  my $rspew = shift;
  my @lines1 = @_;
  
  my $past_end = 0;  # indicates if we've seen a __END__
  my $in_doc = 0;    # indicates if we're in a doc section bounded by =head ... =cut
  
  my @lines;
  foreach (@lines1)
  {
    if ($past_end || /^\s*__END__\s*$/)
      {
      $past_end = 1;
      push @lines, $_;
      next;
      }
    
    ### convert tabs to spaces: assume 8 char tab stops
    $_ = expand($_);

    if ($in_doc)
      {
      $in_doc = 0 if (/^=cut/);
      push @lines, $_;
      next;
      }
    if (/^=head/)
      {
      $in_doc = 1;
      push @lines, $_;
      next;
      }
  
    ### remove leading whitespace
    s/^\s+//;
  
    ### remove trailing whitespace
    s/\s+$//;
  
    if ($gSpacing == 0)
      {
      push @lines, $_;
      next;
      }
    
    if (/^(while\s*\(.*\)\s*){\s*(.*)$/)
      {
      push @lines, $1;
      push @lines, '{';
      my $x = $2;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (/^(if\s*\(.*\)\s*){\s*(.*)$/)
      {
      push @lines, $1;
      push @lines, '{';
      my $x = $2;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (/^}\s*else\s*{\s*(.*)$/)
      {
      push @lines, '}';
      push @lines, 'else';
      push @lines, '{';
      my $x = $1;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (/^else\s*{\s*(.*)$/)
      {
      push @lines, 'else';
      push @lines, '{';
      my $x = $1;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (/^}\s*(elsif\s*\(.*\))\s*{\s*(.*)$/)
      {
      push @lines, '}';
      push @lines, $1;
      push @lines, '{';
      my $x = $2;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (/^}\s*elsif\s*(.*)$/)
      {
      push @lines, '}';
      push @lines, "elsif $1";
      next;
      }
  
    if (/^for\s+(.*)\s+(.*)\s+\((.*)\)\s*{\s*(.*)$/)
      {
      push @lines, "for $1 $2 ($3)";
      push @lines, '{';
      my $x = $4;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (/^foreach\s*(.*)?\((.*)\)\s*{\s*(.*)$/)
      {
      push @lines, "foreach $1 ($2)";
      push @lines, '{';
      my $x = $3;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (/^sub\s*(.*)\s*{\s*(.*)$/)
      {
      push @lines, "sub $1";
      push @lines, '{';
      my $x = $2;
      push (@lines, $x) unless $x =~ /^\s*$/;
      next;
      }
  
    if (!/^#/ && /^(.*)\s+{\s*(#.*)?$/)
      {
      push @lines, "$1";
      my $x = $2;
      push (@lines, "{ $2");
      next;
      }
  
    if (/^(.*)\s*;\s*}$/)
      {
      push @lines, "$1;";
      push @lines, "}";
      next;
      }
  
    push @lines, $_;
    }

  #my %leadwords;
  
  my $indent = 0;    # current amount of indentation
  my $extra = 0;     # extra amount of indentation
  my $dec = 0;       # decrement of $indent
  my $lastblank = 0; # indicates if the previous line was blank
  my $lastopenbrace = 0; # indicates if the previous line was an open brace
  
  $past_end = 0;  # indicates if we've seen a __END__
  $in_doc = 0;    # indicates if we're in a doc section bounded by =head ... =cut
  foreach (@lines)
    {
    $past_end = 1 if /^\s*__END__\s*$/;
    if ($past_end)
      {
      &$rspew($_);
      next;
      }

    if ($in_doc)
      {
      $in_doc = 0 if (/^=cut/);
      &$rspew($_);
      next;
      }
    if (/^=head/)
      {
      $in_doc = 1;
      &$rspew($_);
      next;
      }
        
    ### remove trailing whitespace
    s/\s+$//;
  
    ### adjust some spacing:
    if ($gSpacing)
      {
      if (!/^#/)  #if we're not in a comment
        {
        s/\s+\((.*)/ ($1/g;      # only one space before an opening parens
        s/^sub\s*(\S)/sub $1/;   # only one space after a 'sub'
        s/^if\s*(\S)/if $1/;     # only one space after an 'if' 
        s/^my\s*(\S)/my $1/;     # only one space after a 'my'
        s/\s+my\s+/ my /;        # only one space before and after an embedded 'my'
        if (/<=>/)
          {
          s/(\S)\s*<=>\s*(\S)/$1 <=> $2/;  # only one space before and after an '<=>'
          }
        elsif (/=>/)
          {
          s/(\S)\s*=>\s*(\S)/$1 => $2/;  # only one space before and after an '=>'
          }
        elsif (/=~/)
          {
          s/(\S)\s*=~\s*(\S)/$1 =~ $2/;  # only one space before and after an '=~'
          }
        elsif (/!~/)
          {
          s/(\S)\s*!~\s*(\S)/$1 !~ $2/;  # only one space before and after an '!~'
          }
        elsif (/==/)
          {
          s/(\S)\s*==\s*(\S)/$1 == $2/;  # only one space before and after an '=='
          }
        elsif (/!=/)
          {
          s/(\S)\s*!=\s*(\S)/$1 != $2/;  # only one space before and after an '!='
          }
        elsif (/<=/)
          {
          s/(\S)\s*<=\s*(\S)/$1 <= $2/;  # only one space before and after an '!='
          }
        elsif (/>=/)
          {
          s/(\S)\s*>=\s*(\S)/$1 >= $2/;  # only one space before and after an '!='
          }
        else
          {
          if (/\+=/)
            {
            s/(\S)\s*\+=\s*(\S)/$1 += $2/;   # only one space before and after an '='
            }
          elsif (/\-=/)
            {
            s/(\S)\s*-=\s*(\S)/$1 -= $2/;   # only one space before and after an '='
            }
          elsif (/\.=/)
            {
            s/(\S)\s*.=\s*(\S)/$1 .= $2/;   # only one space before and after an '='
            }
          elsif (/\*=/)
            {
            s/(\S)\s*\*=\s*(\S)/$1 \*= $2/;   # only one space before and after an '='
            }
          else
            {
            s/(\S)\s*=\s*(\S)/$1 = $2/;   # only one space before and after an '='
            }
          }
        if (/foreach/)
          {
          s/^foreach\s*(\S)/foreach $1/;  # only one space after a 'foreach'
          }
        else
          {
          s/^for\s*(\S)/for $1/;        # only one space after a 'for'
          }
        s/^return\s*(\S)/return $1/;
        s/^while\s*(\S)\(/while $1/;
        s/^elsif\s*(\S)/elsif $1/;
        s/^switch\s*(\S)/switch $1/;
        s/^case\s+(\S)\s*:/case $1:/;
        }
      }
  
    ### get rid of multiple blank lines
    ### get rid of blank lines after an opening brace
    if (/^$/)
      {
      next if $lastblank;
      next if $lastopenbrace;
      $lastblank = 1;
      }
    else
      {
      $lastblank = 0;
      }
  
    if ($gSpacing)
    {
      $lastopenbrace = /^{$/;
    }
    else
    {
      $lastopenbrace = /{\s*$/;
    }

    my $indentdone = 0;    
    if ($gSpacing)
      {
      $indent++ if ( /^{/ );    ## bump increment on opening brace
      $indentdone = 1;
      }
    elsif (!/^[^{]+\s*{/)
      {
      $indent++ if ( /{/ );    ## bump increment on opening brace
      $indentdone = 1;
      }
  
    #if doesn't end in a comment and does end in a brace
    if (! /#.*\s*}\s*$/ && /}$/)
      {
      $dec--;       ## decrement on closing brace
      #$cparens = 0;
      }
  
    ### restore indentation
    s/^/$cInc x $indent . ' ' x $extra/e;

    if (!$indentdone && $gSpacing == 0)
      {
      $indent++ if ( /{/ );    ## bump increment on opening brace
      $indent-- if ( /}[^{]*{/ );    ## ...unless there's a closing brace too.
      }

    $indent += $dec;
    $dec = 0;
    #$indent = 0 if $indent < 0;
    #print "x=$indent\n";
  
    &$rspew($_);
    }
  
  return 0;
  }

1;

test.bat

Synopsis

@rem = '
@perl -S "%0" %1 %2 %3 %4 %5
@goto _perldone
@rem ';
#!perl -w
use PrettyPl;
use ut;

#todo: repeat all the tests: add comments everywhere

my $gOut;
#-----
sub gather($)
  {
  $gOut .= shift;
  $gOut .= "\n";
  }

#-----
sub setup($)
  {
  $gOut = '';
  PrettyPl::Spacing(1);
  PrettyPl::reformatstr(\&gather, shift);
  }

#-----
sub setupns($)
  {
  $gOut = '';
  PrettyPl::Spacing(0);
  PrettyPl::reformatstr(\&gather, shift);
  }

#-----
sub test_simple_file()
  {
  ut::assert(PrettyPl::reformat("test1.pl"), 0);
  }

#------
sub test_nochange()
  {
  my $orig = q {
sub f
  {
  print "usage: $0 filename\n";
  exit(0);
  }
} ;

  my $expected = q {
sub f
  {
  print "usage: $0 filename\n";
  exit(0);
  }
} ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_nochange_ns()
  {
  my $orig = q {
sub f
  {
  print "usage: $0 filename\n";
  exit(0);
  }
} ;

  my $expected = q {
sub f
  {
  print "usage: $0 filename\n";
  exit(0);
  }
} ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }


#------
sub test_simple_sub()
  {
  my $orig = q {
sub    f3
{
my $x = 1;
my $y = 2;
}
my $z = 3;
};

  my $expected = q {
sub f3
  {
  my $x = 1;
  my $y = 2;
  }
my $z = 3;
};
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_sub_ns()
  {
  my $orig = q {
sub    f3
{
my $x = 1;
my $y = 2;
}
my $z = 3;
};

  my $expected = q {
sub    f3
  {
  my $x = 1;
  my $y = 2;
  }
my $z = 3;
};
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_sub()
  {
  my $orig = q {
sub    f3   {
my $y = 2;
}
my $z = 3;
};

  my $expected = q {
sub f3
  {
  my $y = 2;
  }
my $z = 3;
};
  
  setup($orig);
  ut::assert($gOut, $expected);
  }


#------
sub test_sub_ns()
  {
  my $orig = q {
sub    f3   {
my $y = 2;
}
my $z = 3;
};

  my $expected = q {
sub    f3   {
  my $y = 2;
  }
my $z = 3;
};
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if()
  {
  my $orig = q {
if              (1 == 1)
{
next;
}
} ;
  my $expected = q {
if (1 == 1)
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if_ns()
  {
  my $orig = q {
if              (1 == 1)
{
next;
}
} ;
  my $expected = q {
if              (1 == 1)
  {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_if()
  {
  my $orig = q {
if           (1    ==   1) {
next;
}
} ;
  my $expected = q {
if (1 == 1)
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_if_ns()
  {
  my $orig = q {
if           (1    ==   1) {
next;
}
} ;
  my $expected = q {
if           (1    ==   1) {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_ifwithpattern()
  {
  my $orig = q {
  if     (/^\\s*while\\s*/)
{
next;  
}
} ;
  my $expected = q {
if (/^\\s*while\\s*/)
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_ifwithpattern_ns()
  {
  my $orig = q {
  if     (/^\\s*while\\s*/)
{
next;  
}
} ;
  my $expected = q {
if     (/^\\s*while\\s*/)
  {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if_notequals()
  {
  my $orig = q {
if ( $prob    !=   0 )
{
  next;
  }
if              (1     !=     1)
{
next;
}
} ;
  my $expected = q {
if ( $prob != 0 )
  {
  next;
  }
if (1 != 1)
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if_notequals_ns()
  {
  my $orig = q {
if ( $prob    !=   0 )
{
  next;
  }
if              (1     !=     1)
{
next;
}
} ;
  my $expected = q {
if ( $prob    !=   0 )
  {
  next;
  }
if              (1     !=     1)
  {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if_lessequals()
  {
  my $orig = q {
if              (1     <=     1)
{
next;
}
} ;
  my $expected = q {
if (1 <= 1)
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if_lessequals_ns()
  {
  my $orig = q {
if              (1     <=     1)
{
next;
}
} ;
  my $expected = q {
if              (1     <=     1)
  {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if_gtequals()
  {
  my $orig = q {
if              (1     >=     1)
{
next;
}
} ;
  my $expected = q {
if (1 >= 1)
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_if_gtequals_ns()
  {
  my $orig = q {
if              (1     >=     1)
{
next;
}
} ;
  my $expected = q {
if              (1     >=     1)
  {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_arrow()
  {
  my $orig = q {
     -Cachesize   =>   $self->config_('db_cache_size'),
} ;
  my $expected = q {
-Cachesize => $self->config_('db_cache_size'),
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_arrow_ns()
  {
  my $orig = q {
     -Cachesize   =>   $self->config_('db_cache_size'),
} ;
  my $expected = q {
-Cachesize   =>   $self->config_('db_cache_size'),
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compare_arrow()
  {
  my $orig = q {
     @ranked_words = sort {$wordprobs{$ranking[0],$b}   <=>   $wordprobs{$ranking[0],$a}} keys %{$self->{parser__}->{words__}};
} ;
  my $expected = q {
@ranked_words = sort {$wordprobs{$ranking[0],$b} <=> $wordprobs{$ranking[0],$a}} keys %{$self->{parser__}->{words__}};
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compare_arrow_ns()
  {
  my $orig = q {
    @ranked_words = sort {$wordprobs{$ranking[0],$b}   <=>   $wordprobs{$ranking[0],$a}} keys %{$self->{parser__}->{words__}};
} ;
  my $expected = q {
@ranked_words = sort {$wordprobs{$ranking[0],$b}   <=>   $wordprobs{$ranking[0],$a}} keys %{$self->{parser__}->{words__}};
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_equaltilde()
  {
  my $orig = q {
    $bucket   =~   /([[:alpha:]0-9-_]+)$/;
} ;
  my $expected = q {
$bucket =~ /([[:alpha:]0-9-_]+)$/;
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_equaltilde_ns()
  {
  my $orig = q {
     $bucket   =~   /([[:alpha:]0-9-_]+)$/;
} ;
  my $expected = q {
$bucket   =~   /([[:alpha:]0-9-_]+)$/;
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_notequaltilde()
  {
  my $orig = q {
     $bucket   !~   /([[:alpha:]0-9-_]+)$/;
} ;
  my $expected = q {
$bucket !~ /([[:alpha:]0-9-_]+)$/;
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_notequaltilde_ns()
  {
  my $orig = q {
             $bucket   !~   /([[:alpha:]0-9-_]+)$/;
} ;
  my $expected = q {
$bucket   !~   /([[:alpha:]0-9-_]+)$/;
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }


#------
sub test_simple_else()
  {
  my $orig = q {
else 
{
next;
}
} ;
  my $expected = q {
else
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

  #------
sub test_simple_else_ns()
  {
  my $orig = q {
else 
{
next;
}
} ;
  my $expected = q {
else
  {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_else()
  {
  my $orig = q {
else  {
next;
}
} ;
  my $expected = q {
else
  {
  next;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_else_ns()
  {
  my $orig = q {
else  {
next;
}
} ;
  my $expected = q {
else  {
  next;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_else2()
  {
  my $orig = q '
{
    next;
  }  else  {
next;
}
' ;
  my $expected = q '
  {
  next;
  }
else
  {
  next;
  }
' ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_else2_ns()
  {
  my $orig = q '
{
    next;
  }  else  {
next;
}
' ;
  my $expected = q '
  {
  next;
  }  else  {
  next;
  }
' ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_my()
  {
  my $orig = q {
    my     $x    = 1;
  my     $y=2;
} ;
  my $expected = q {
my $x = 1;
my $y = 2;
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_my_ns()
  {
  my $orig = q {
      my     $x    = 1;
   my     $y=2;
} ;
  my $expected = q {
my     $x    = 1;
my     $y=2;
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_for()
  {
  my $orig = q {
for   ($x=1; $x < 10; $x++)
{
$y    = 2;
}
} ;
  my $expected = q {
for ($x = 1; $x < 10; $x++)
  {
  $y = 2;
  }
} ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_for_ns()
  {
  my $orig = q {
for   ($x=1; $x < 10; $x++)
{
$y    = 2;
}
} ;
  my $expected = q {
for   ($x=1; $x < 10; $x++)
  {
  $y    = 2;
  }
} ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_for()
  {
  my $orig = q {
    for   my   $x ($blah{$bob}{$mary}) {
   $y    = 2;
}
} ;
  my $expected = q {
for my $x ($blah{$bob}{$mary})
  {
  $y = 2;
  }
} ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#  #------
#sub test_for_ns()
#  {
#  my $orig = q {
#   for   my   $x ($blah{$bob}{$mary}) {
#  $y    = 2;
#}
#} ;
#  my $expected = q {
#for   my   $x ($blah{$bob}{$mary}) {
#  $y    = 2;
#  }
#} ;
#
#  setupns($orig);
#  ut::assert($gOut, $expected);
#  }

#------
sub test_for2()
  {
  my $orig = q {
    for my $bucket (keys %{$self->{blah}}) 
  {
$y    = 2;
}
} ;
  my $expected = q {
for my $bucket (keys %{$self->{blah}})
  {
  $y = 2;
  }
} ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

##------
#sub test_for2_ns()
#  {
#  my $orig = q {
#for my $bucket (keys %{$self->{blah}}) 
#{
#$y    = 2;
#}
#} ;
#  my $expected = q {
#for my $bucket (keys %{$self->{blah}})
#  {
#  $y    = 2;
#  }
#} ;
#
#  setupns($orig);
#  ut::assert($gOut, $expected);
#  }

#------
sub test_for3()
  {
  my $orig = q {
    for my $bucket (%{self->{bob}{mary}}) {
 $y    = 2;
}
} ;
  my $expected = q {
for my $bucket (%{self->{bob}{mary}})
  {
  $y = 2;
  }
} ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

##------
#sub test_for3_ns()
#  {
#  my $orig = q {
#    for my $bucket (%{self->{bob}{mary}}) {
# $y    = 2;
#}
#} ;
#  my $expected = q {
#for my $bucket (%{self->{bob}{mary}}) {
#  $y    = 2;
#  }
#} ;
#
#  setupns($orig);
#  ut::assert($gOut, $expected);
#  }

#------
sub test_multiline()
  {
  my $orig = q {
if (($x) &&
    ($y) &&
    ($z)) {
$y    = 2;
}
} ;
  my $expected = q {
if (($x) &&
($y) &&
($z))
  {
  $y = 2;
  }
} ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_multiline_ns()
  {
  my $orig = q {
if (($x) &&
    ($y) &&
    ($z)) {
$y    = 2;
}
} ;
  my $expected = q {
if (($x) &&
($y) &&
($z)) {
  $y    = 2;
  }
} ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_multiline2()
  {
  my $orig = q {
if (($x) &&
    ($y) &&
    ($z)) {    #  a comment
$y    = 2;
}
} ;
  my $expected = q {
if (($x) &&
($y) &&
($z))
  { #  a comment
  $y = 2;
  }
} ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

##------
#sub test_multiline2_ns()
#  {
#  my $orig = q {
#if (($x) &&
#    ($y) &&
#    ($z)) {    #  a comment
#$y    = 2;
#}
#} ;
#  my $expected = q {
#if (($x) &&
#($y) &&
#    ($z)) {    #  a comment
#  $y    = 2;
#  }
#} ;
#
#  setupns($orig);
#  ut::assert($gOut, $expected);
#  }


#------
sub test_simple_foreach()
  {
  my $orig = q {
    foreach      $x    (@X)
{
$y    = 2;
}
} ;
  my $expected = q {
foreach $x (@X)
  {
  $y = 2;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

  #------
sub test_simple_foreach_ns()
  {
  my $orig = q {
    foreach      $x    (@X)
{
$y    = 2;
}
} ;
  my $expected = q {
foreach      $x    (@X)
  {
  $y    = 2;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_foreach()
  {
  my $orig = q {
    foreach      $x    (@X) {
$y    = 2;
}
} ;
  my $expected = q {
foreach $x (@X)
  {
  $y = 2;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_foreach_ns()
  {
  my $orig = q {
    foreach      $x    (@X) {
$y    = 2;
}
} ;
  my $expected = q {
foreach      $x    (@X) {
  $y    = 2;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_foreach2()
  {
  my $orig = q {
    foreach   my   $x    (@X) {
$y    = 2;
}
} ;
  my $expected = q {
foreach my $x (@X)
  {
  $y = 2;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_foreach2_ns()
  {
  my $orig = q {
    foreach   my   $x    (@X) {
$y    = 2;
}
} ;
  my $expected = q {
foreach   my   $x    (@X) {
  $y    = 2;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_foreach_withmy()
  {
  my $orig = q {
    foreach   my     $x    (@X)
{
$y    = 2;
}
} ;
  my $expected = q {
foreach my $x (@X)
  {
  $y = 2;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_foreach_withmy_ns()
  {
  my $orig = q {
    foreach   my     $x    (@X)
{
$y    = 2;
}
} ;
  my $expected = q {
foreach   my     $x    (@X)
  {
  $y    = 2;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_return()
  {
  my $orig = q {
    return     $x;
    return      ($x);
} ;
  my $expected = q {
return $x;
return ($x);
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_return_ns()
  {
  my $orig = q {
    return     $x;
    return      ($x);
} ;
  my $expected = q {
return     $x;
return      ($x);
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_elsif()
  {
  my $orig = q {
    elsif     ($x == 1)
} ;
  my $expected = q {
elsif ($x == 1)
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_elsif_ns()
  {
  my $orig = q {
    elsif     ($x == 1)
} ;
  my $expected = q {
elsif     ($x == 1)
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_elsif()
  {
  my $orig = q {
    if ($x == 0)
    {
      }  elsif     ($x == 1)
} ;
  my $expected = q {
if ($x == 0)
  {
  }
elsif ($x == 1)
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_elsif_ns()
  {
  my $orig = q {
    if ($x == 0)
    {
      }  elsif     ($x == 1)
} ;
  my $expected = q {
if ($x == 0)
  {
  }  elsif     ($x == 1)
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_elsif()
  {
  my $orig = q {
    if ($x == 0)
    {
       }  elsif     ($x == 1) {
      }
} ;
  my $expected = q {
if ($x == 0)
  {
  }
elsif ($x == 1)
  {
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_elsif_ns()
  {
  my $orig = q {
    if ($x == 0)
    {
       }  elsif     ($x == 1) {
      }
} ;
  my $expected = q {
if ($x == 0)
  {
  }  elsif     ($x == 1) {
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_switch()
  {
  my $orig = q {
  switch        ($x)
} ;
  my $expected = q {
switch ($x)
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_switch_ns()
  {
  my $orig = q {
  switch        ($x)
} ;
  my $expected = q {
switch        ($x)
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_case()
  {
  my $orig = q {
  case    1   :   
} ;
  my $expected = q {
case 1:
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_case_ns()
  {
  my $orig = q {
  case    1   :   
} ;
  my $expected = q {
case    1   :
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }


#------
sub test_simple_while()
  {
  my $orig = q {
    while   ($x    ==    1)
      {
      return      ($x);
      }
} ;
  my $expected = q {
while ($x == 1)
  {
  return ($x);
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_simple_while_ns()
  {
  my $orig = q {
    while   ($x    ==    1)
      {
      return      ($x);
      }
} ;
  my $expected = q {
while   ($x    ==    1)
  {
  return      ($x);
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_while()
  {
  my $orig = q {
    while   ($x    ==    1)    {
      return      ($x);
      }
} ;
  my $expected = q {
while ($x == 1)
  {
  return ($x);
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_while_ns()
  {
  my $orig = q {
    while   ($x    ==    1)    {
      return      ($x);
      }
} ;
  my $expected = q {
while   ($x    ==    1)    {
  return      ($x);
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_multiblanklines()
  {
  my $orig = q {
    $x   =  1;



    $x =  2;
} ;
  my $expected = q {
$x = 1;

$x = 2;
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_multiblanklines_ns()
  {
  my $orig = q {
    $x   =   1;



    $x = 2;
} ;
  my $expected = q {
$x   =   1;

$x = 2;
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_multiblanklines2()
  {
  my $orig = q '
    if ($x == 1)    {
      
      
       $x = 2;
       }
' ;
  my $expected = q '
if ($x == 1)
  {
  $x = 2;
  }
' ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_multiblanklines2_ns()
  {
  my $orig = q '
    if ($x == 1)    {
      
      
       $x = 2;
       }
' ;
  my $expected = q '
if ($x == 1)    {
  $x = 2;
  }
' ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments()
  {
  my $orig = q {
    #comment1
        #comment1A
    $x = 1;
    if ($x == 1)
     {
#comment 2
    $x = 2;
      }
    #comment 3
} ;
  my $expected = q {
#comment1
#comment1A
$x = 1;
if ($x == 1)
  {
  #comment 2
  $x = 2;
  }
#comment 3
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments_ns()
  {
  my $orig = q {
    #comment1
        #comment1A
    $x = 1;
    if ($x == 1)
     {
#comment 2
    $x = 2;
      }
    #comment 3
} ;
  my $expected = q {
#comment1
#comment1A
$x = 1;
if ($x == 1)
  {
  #comment 2
  $x = 2;
  }
#comment 3
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments1()
  {
  my $orig = q {
    #comment1
        #comment1A
} ;
  my $expected = q {
#comment1
#comment1A
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments1_ns()
  {
  my $orig = q {
    #comment1
        #comment1A
} ;
  my $expected = q {
#comment1
#comment1A
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments2()
  {
  my $orig = q {
    #comment1
        #comment1A
    $x = 1;
    #comment 3
} ;
  my $expected = q {
#comment1
#comment1A
$x = 1;
#comment 3
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments2_ns()
  {
  my $orig = q {
    #comment1
        #comment1A
    $x   =   1;
    #comment 3
} ;
  my $expected = q {
#comment1
#comment1A
$x   =   1;
#comment 3
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments3()
  {
  my $orig = q {
    if ($x == 1)
     {
#comment 2
    $x = 2;
      }
} ;
  my $expected = q {
if ($x == 1)
  {
  #comment 2
  $x = 2;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comments3_ns()
  {
  my $orig = q {
    if ($x   ==   1)
     {
#comment 2
    $x   =   2;
      }
} ;
  my $expected = q {
if ($x   ==   1)
  {
  #comment 2
  $x   =   2;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_code_in_comments()
  {
  my $orig = q {
#    if   ($x   ==   1)
} ;
  my $expected = q {
#    if   ($x   ==   1)
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_code_in_comments_ns()
  {
  my $orig = q {
#    if   ($x   ==   1)
} ;
  my $expected = q {
#    if   ($x   ==   1)
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_leadlingtrailingblanks()
  {
  my $orig = q {
    if ($x == 1)           
     {                
#comment 2                
    $x = 2;     
      }        
} ;
  my $expected = q {
if ($x == 1)
  {
  #comment 2
  $x = 2;
  }
} ;
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_leadlingtrailingblanks_ns()
  {
  my $orig = q {
    if ($x   == 1)           
     {                
#comment 2                
    $x =   2;     
      }        
} ;
  my $expected = q {
if ($x   == 1)
  {
  #comment 2
  $x =   2;
  }
} ;
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_tabs()
  {          
  my $orig = "\n#b\t\$x\t=\t1;\n";
                 #123456781234567812345678 
  my $expected = "\n#b      \$x      =       1;\n";
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_tabs_ns()
  {          
  my $orig = "\n#b\t\$x\t=\t1;\n";
                 #123456781234567812345678 
  my $expected = "\n#b      \$x      =       1;\n";
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compund_assignment()
  {          
  my $orig = '$x    +=   1;';
                 #123456781234567812345678 
  my $expected = '$x += 1;' . "\n";
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compund_assignment_ns()
  {          
  my $orig = '  $x    +=   1;';
                 #123456781234567812345678 
  my $expected = '$x    +=   1;' . "\n";
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compound_assignment2()
  {          
  my $orig = '$x    -=   1;';
                 #123456781234567812345678 
  my $expected = '$x -= 1;' . "\n";
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compound_assignment2_ns()
  {          
  my $orig = '  $x    -=   1;';
                 #123456781234567812345678 
  my $expected = '$x    -=   1;' . "\n";
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compound_assignment3()
  {          
  my $orig = '$x    .=   "1";';
                 #123456781234567812345678 
  my $expected = '$x .= "1";' . "\n";
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compound_assignment3_ns()
  {          
  my $orig = '  $x    .=   "1";';
                 #123456781234567812345678 
  my $expected = '$x    .=   "1";' . "\n";
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compound_assignment4()
  {          
  my $orig = '$x    *=   "1";';
                 #123456781234567812345678 
  my $expected = '$x *= "1";' . "\n";
  
  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_compound_assignment4_ns()
  {          
  my $orig = '  $x    *=   "1";';
                 #123456781234567812345678 
  my $expected = '$x    *=   "1";' . "\n";
  
  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comment_with_ending_brace()
  {
  my $orig = q '
if ($x)
{
  #comment xx}
}
' ;
  my $expected = q '
if ($x)
  {
  #comment xx}
  }
' ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

  #------
sub test_comment_with_ending_brace_ns()
  {
  my $orig = q '
   if   ($x)
{
  #comment xx}
}
' ;
  my $expected = q '
if   ($x)
  {
  #comment xx}
  }
' ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comment_with_ending_brace2()
  {
  my $orig = q '
if ($x)
{
  #comment xx    }            
}
' ;
  my $expected = q '

if ($x)
  {
  #comment xx    }
  }
' ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comment_with_ending_brace2_ns()
  {
  my $orig = q '
if   ($x)
{
  #comment xx    }            
}
' ;
  my $expected = q '
if   ($x)
  {
  #comment xx    }
  }
' ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comment_with_ending_brace2()
  {
  my $orig = q '
  #    if ( $type eq "CLASS" ) {
' ;
  my $expected = q '
#    if ( $type eq "CLASS" ) {
' ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_comment_with_ending_brace2_ns()
  {
  my $orig = q '
  #    if ( $type eq "CLASS" ) {
' ;
  my $expected = q '
#    if ( $type eq "CLASS" ) {
' ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_trailing_closing_brace()
  {
  my $orig = q '
  if (!$pos)
    {
    $pos = 0; }
  if (!$len)
    {
    $len = length($str); }
' ;
  my $expected = q '
if (!$pos)
  {
  $pos = 0;
  }
if (!$len)
  {
  $len = length($str);
  }
' ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

  #------
sub test_trailing_closing_brace_ns()
  {
  my $orig = q '
  if   (!$pos)
    {
    $pos   = 0; }
  if (!$len)
    {
    $len = length($str); }
' ;
  my $expected = q '
if   (!$pos)
  {
  $pos   = 0; }
if (!$len)
  {
  $len = length($str); }
' ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }


#------
sub test_past_end()
  {
  my $orig = q '
  if (!$pos)
    {
    $pos = 0; }
__END__    
  if (!$len) {  $len = length($str); }
' ;
  my $expected = q '
if (!$pos)
  {
  $pos = 0;
  }
__END__    
  if (!$len) {  $len = length($str); }
' ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_past_end_ns()
  {
  my $orig = q '
  if (!$pos)
    {
    $pos  = 0; }
__END__    
  if (!$len) {  $len = length($str); }
' ;
  my $expected = q '
if (!$pos)
  {
  $pos  = 0; }
__END__    
  if (!$len) {  $len = length($str); }
' ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_doc()
  {
  my $orig = q '
=head blah
  if (!$pos) {
    $pos = 0; }
=cut
if (!$pos) {
$pos = 0; 
}
__END__    
  if (!$len) {  $len = length($str); }
' ;
  my $expected = q '
=head blah
  if (!$pos) {
    $pos = 0; }
=cut
if (!$pos)
  {
  $pos = 0;
  }
__END__    
  if (!$len) {  $len = length($str); }
' ;

  setup($orig);
  ut::assert($gOut, $expected);
  }

#------
sub test_doc_ns()
  {
  my $orig = q '
=head blah
  if (!$pos) {
    $pos = 0; }
=cut
if (!$pos) {
$pos   = 0; 
}
__END__    
  if (!$len) {  $len = length($str); }
' ;
  my $expected = q '
=head blah
  if (!$pos) {
    $pos = 0; }
=cut
if (!$pos) {
  $pos   = 0;
  }
__END__    
  if (!$len) {  $len = length($str); }
' ;

  setupns($orig);
  ut::assert($gOut, $expected);
  }


##------
#sub test_code_in_inline_comments()
#  {
#  my $orig = q {
#  if      ($x = 1) #    if   ($x   ==   1)
#} ;
#  my $expected = q {
#if ($x = 1) #    if   ($x   ==   1)
#} ;
#  
#  setup($orig);
#  ut::assert($gOut, $expected);
#  }

##------
#sub test_code_in_comments2()
#  {
#  my $orig = q {
#  my    $x   =   1; #    if   ($x   ==   1)
#} ;
#  my $expected = q {
#my $x = 1; #    if   ($x   ==     1)
#} ;
#  
#  setup($orig);
#  ut::assert($gOut, $expected);
#  }
  


#--- MAIN
ut::run();

__END__
:_perldone

Contact me about content on this page using john_web-at-arrizza-dot-com

For Web Master or site problems contact: webadmin-at-arrizza-dot-com