t/snippets15.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 gnu5.gnu
   5 #2 wngnu1.def
   6 #3 olbs.def
   7 #4 olbs.olbs0
   8 #5 olbs.olbs2
   9 #6 break_old_methods.break_old_methods
  10 #7 break_old_methods.def
  11 #8 bom1.bom
  12 #9 bom1.def
  13
  14 # To locate test #13 you can search for its name or the string '#13'
  15
  16 use strict;
  17 use Test;
  18 use Carp;
  19 use Perl::Tidy;
  20 my $rparams;
  21 my $rsources;
  22 my $rtests;
  23
  24 BEGIN {
  25
  26     ###########################################
  27     # BEGIN SECTION 1: Parameter combinations #
  28     ###########################################
  29     $rparams = {
  30         'bom'               => "-bom -wn",
  31         'break_old_methods' => "--break-at-old-method-breakpoints",
  32         'def'               => "",
  33         'gnu'               => "-gnu",
  34         'olbs0'             => "-olbs=0",
  35         'olbs2'             => "-olbs=2",
  36     };
  37
  38     ############################
  39     # BEGIN SECTION 2: Sources #
  40     ############################
  41     $rsources = {
  42
  43         'bom1' => <<'----------',
  44 # keep cuddled call chain with -bom
  45 return Mojo::Promise->resolve(
  46     $query_params
  47 )->then(
  48     &_reveal_event
  49 )->then(sub ($code) {
  50     return $c->render(text => '', status => $code);
  51 })->catch(sub {
  52     # 1. return error
  53     return $c->render(json => {}, status => 400);
  54 });
  55 ----------
  56
  57         'break_old_methods' => <<'----------',
  58 my $q = $rs
  59    ->related_resultset('CDs')
  60    ->related_resultset('Tracks')
  61    ->search({
  62       'track.id' => { -ident => 'none_search.id' },
  63    })
  64    ->as_query;
  65 ----------
  66
  67         'gnu5' => <<'----------',
  68         # side comments limit gnu type formatting with l=80; note extra comma
  69         push @tests, [
  70             "Lowest code point requiring 13 bytes to represent",    # 2**36
  71             "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
  72             ($::is64bit) ? 0x1000000000 : -1,    # overflows on 32bit
  73           ],
  74           ;
  75 ----------
  76
  77         'olbs' => <<'----------',
  78 for $x ( 1, 2 ) { s/(.*)/+$1/ }
  79 for $x ( 1, 2 ) { s/(.*)/+$1/ }    # side comment
  80 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" }
  81 for $x ( 1, 2 ) { s/(.*)/+$1/; }
  82 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
  83 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
  84 ----------
  85
  86         'wngnu1' => <<'----------',
  87     # test with -wn -gnu
  88     foreach my $parameter (
  89         qw(
  90         set_themes
  91         add_themes
  92         severity
  93         maximum_violations_per_document
  94         _non_public_data
  95         )
  96       )
  97     {
  98         is(
  99             $config->get($parameter),
 100             undef,
 101             qq<"$parameter" is not defined via get() for $policy_short_name.>,
 102         );
 103     }
 104 ----------
 105     };
 106
 107     ####################################
 108     # BEGIN SECTION 3: Expected output #
 109     ####################################
 110     $rtests = {
 111
 112         'gnu5.gnu' => {
 113             source => "gnu5",
 114             params => "gnu",
 115             expect => <<'#1...........',
 116         # side comments limit gnu type formatting with l=80; note extra comma
 117         push @tests, [
 118             "Lowest code point requiring 13 bytes to represent",      # 2**36
 119             "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
 120             ($::is64bit) ? 0x1000000000 : -1,    # overflows on 32bit
 121                      ],
 122           ;
 123 #1...........
 124         },
 125
 126         'wngnu1.def' => {
 127             source => "wngnu1",
 128             params => "def",
 129             expect => <<'#2...........',
 130     # test with -wn -gnu
 131     foreach my $parameter (
 132         qw(
 133         set_themes
 134         add_themes
 135         severity
 136         maximum_violations_per_document
 137         _non_public_data
 138         )
 139       )
 140     {
 141         is(
 142             $config->get($parameter),
 143             undef,
 144             qq<"$parameter" is not defined via get() for $policy_short_name.>,
 145         );
 146     }
 147 #2...........
 148         },
 149
 150         'olbs.def' => {
 151             source => "olbs",
 152             params => "def",
 153             expect => <<'#3...........',
 154 for $x ( 1, 2 ) { s/(.*)/+$1/ }
 155 for $x ( 1, 2 ) { s/(.*)/+$1/ }    # side comment
 156 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" }
 157 for $x ( 1, 2 ) { s/(.*)/+$1/; }
 158 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
 159 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 160 #3...........
 161         },
 162
 163         'olbs.olbs0' => {
 164             source => "olbs",
 165             params => "olbs0",
 166             expect => <<'#4...........',
 167 for $x ( 1, 2 ) { s/(.*)/+$1/ }
 168 for $x ( 1, 2 ) { s/(.*)/+$1/ }    # side comment
 169 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" }
 170 for $x ( 1, 2 ) { s/(.*)/+$1/ }
 171 for $x ( 1, 2 ) { s/(.*)/+$1/ }    # side comment
 172 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 173 #4...........
 174         },
 175
 176         'olbs.olbs2' => {
 177             source => "olbs",
 178             params => "olbs2",
 179             expect => <<'#5...........',
 180 for $x ( 1, 2 ) { s/(.*)/+$1/; }
 181 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
 182 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 183 for $x ( 1, 2 ) { s/(.*)/+$1/; }
 184 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
 185 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 186 #5...........
 187         },
 188
 189         'break_old_methods.break_old_methods' => {
 190             source => "break_old_methods",
 191             params => "break_old_methods",
 192             expect => <<'#6...........',
 193 my $q = $rs
 194   ->related_resultset('CDs')
 195   ->related_resultset('Tracks')
 196   ->search(
 197     {
 198         'track.id' => { -ident => 'none_search.id' },
 199     }
 200 )->as_query;
 201 #6...........
 202         },
 203
 204         'break_old_methods.def' => {
 205             source => "break_old_methods",
 206             params => "def",
 207             expect => <<'#7...........',
 208 my $q = $rs->related_resultset('CDs')->related_resultset('Tracks')->search(
 209     {
 210         'track.id' => { -ident => 'none_search.id' },
 211     }
 212 )->as_query;
 213 #7...........
 214         },
 215
 216         'bom1.bom' => {
 217             source => "bom1",
 218             params => "bom",
 219             expect => <<'#8...........',
 220 # keep cuddled call chain with -bom
 221 return Mojo::Promise->resolve(
 222     $query_params
 223 )->then(
 224     &_reveal_event
 225 )->then( sub ($code) {
 226     return $c->render( text => '', status => $code );
 227 } )->catch( sub {
 228
 229     # 1. return error
 230     return $c->render( json => {}, status => 400 );
 231 } );
 232 #8...........
 233         },
 234
 235         'bom1.def' => {
 236             source => "bom1",
 237             params => "def",
 238             expect => <<'#9...........',
 239 # keep cuddled call chain with -bom
 240 return Mojo::Promise->resolve($query_params)->then(&_reveal_event)->then(
 241     sub ($code) {
 242         return $c->render( text => '', status => $code );
 243     }
 244 )->catch(
 245     sub {
 246         # 1. return error
 247         return $c->render( json => {}, status => 400 );
 248     }
 249 );
 250 #9...........
 251         },
 252     };
 253
 254     my $ntests = 0 + keys %{$rtests};
 255     plan tests => $ntests;
 256 }
 257
 258 ###############
 259 # EXECUTE TESTS
 260 ###############
 261
 262 foreach my $key ( sort keys %{$rtests} ) {
 263     my $output;
 264     my $sname  = $rtests->{$key}->{source};
 265     my $expect = $rtests->{$key}->{expect};
 266     my $pname  = $rtests->{$key}->{params};
 267     my $source = $rsources->{$sname};
 268     my $params = defined($pname) ? $rparams->{$pname} : "";
 269     my $stderr_string;
 270     my $errorfile_string;
 271     my $err = Perl::Tidy::perltidy(
 272         source      => \$source,
 273         destination => \$output,
 274         perltidyrc  => \$params,
 275         argv        => '',             # for safety; hide any ARGV from perltidy
 276         stderr      => \$stderr_string,
 277         errorfile => \$errorfile_string,    # not used when -se flag is set
 278     );
 279     if ( $err || $stderr_string || $errorfile_string ) {
 280         if ($err) {
 281             print STDERR
 282 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 283             ok( !$err );
 284         }
 285         if ($stderr_string) {
 286             print STDERR "---------------------\n";
 287             print STDERR "<<STDERR>>\n$stderr_string\n";
 288             print STDERR "---------------------\n";
 289             print STDERR
 290 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 291             ok( !$stderr_string );
 292         }
 293         if ($errorfile_string) {
 294             print STDERR "---------------------\n";
 295             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 296             print STDERR "---------------------\n";
 297             print STDERR
 298 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 299             ok( !$errorfile_string );
 300         }
 301     }
 302     else {
 303         ok( $output, $expect );
 304     }
 305 }