Merge pull request #353 from tbrowder/fix-rt-128221

Fix rt 128221

S26-documentation/07-tables.t

@@ -1,8 +1,9 @@
 use v6;
 use Test;
 my $r;
+my $p = 0; # use as an index for the pod chunks
 
-plan 42;
+plan 34;
 
 =begin table
         The Shoveller   Eddie Stevens     King Arthur's singing shovel
@@ -11,7 +12,7 @@ plan 42;
         The Bowler      Carol Pinnsler    Haunted bowling ball
 =end table
 
-$r = $=pod[0];
+$r = $=pod[$p++];
 isa-ok $r, Pod::Block::Table;
 is $r.contents.elems, 4;
 is $r.contents[0].join('|'),
@@ -29,7 +30,7 @@ is $r.contents[3].join('|'),
     Subroutines         33
     Everything else     57
 
-$r = $=pod[1];
+$r = $=pod[$p++];
 is $r.contents.elems, 4;
 is $r.contents[0].join('|'), "Constants|1";
 is $r.contents[1].join('|'), "Variables|10";
@@ -41,7 +42,7 @@ is $r.contents[3].join('|'), "Everything else|57";
     horse    | horses
     elephant | elephants
 
-$r = $=pod[2];
+$r = $=pod[$p++];
 is $r.contents.elems, 3;
 is $r.contents[0].join('|'), "mouse|mice";
 is $r.contents[1].join('|'), "horse|horses";
@@ -54,7 +55,7 @@ is $r.contents[2].join('|'), "elephant|elephants";
     Human  +   2  +   Pizza
     Shark  +   0  +    Fish
 
-$r = $=pod[3];
+$r = $=pod[$p++];
 is $r.headers.join('|'), "Animal|Legs|Eats";
 is $r.contents.elems, 3;
 is $r.contents[0].join('|'), "Zebra|4|Cookies";
@@ -67,7 +68,7 @@ is $r.contents[2].join('|'), "Shark|0|Fish";
         ==============|=================|================================
         The Shoveller | Eddie Stevens   | King Arthur's singing shovel
 
-$r = $=pod[4];
+$r = $=pod[$p++];
 is $r.headers.join('|'), "Superhero|Secret Identity|Superpower";
 is $r.contents.elems, 1;
 is $r.contents[0].join('|'),
@@ -90,7 +91,7 @@ is $r.contents[0].join('|'),
 
 =end table
 
-$r = $=pod[5];
+$r = $=pod[$p++];
 is $r.headers.join('|'), "Superhero|Secret Identity|Superpower";
 is $r.contents.elems, 4;
 is $r.contents[0].join('|'),
@@ -109,28 +110,10 @@ is $r.contents[3].join('|'),
    ---+---+---
       |   | X
 
-$r = $=pod[6];
-is $r.contents.elems, 3;
-is $r.contents[0].join(','), 'X,O,',
-    'ensure trailing whitespace counts as a cell (WARNING: this test will'
-    ~ ' fail if you modified this file and your editor auto-stripped'
-    ~ ' trailing whitespace)';
-is $r.contents[1].join(','), ',X,O';
-is $r.contents[2].join(','), ',,X';
 
-=table
-    X   O    
-   ===========
-        X   O
-   ===========
-            X
-
-$r = $=pod[7];
+$r = $=pod[$p++];
 is $r.contents.elems, 3;
-is $r.contents[0].join(','), 'X,O,',
-    'ensure trailing whitespace counts as a cell (WARNING: this test will'
-    ~ ' fail if you modified this file and your editor auto-stripped'
-    ~ ' trailing whitespace)';
+is $r.contents[0].join(','), 'X,O,';
 is $r.contents[1].join(','), ',X,O';
 is $r.contents[2].join(','), ',,X';
 
@@ -141,24 +124,5 @@ bar
 
 =end table
 
-$r = $=pod[8];
+$r = $=pod[$p++];
 is $r.contents.elems, 2;
-
-# test for issue #129862
-# uneven rows
-
-# NOTE: This test may need to change after planned table pod fixes are
-# made because this is a malformed table and the user should be warned
-# of that fact.
-
-=begin table
-a | b | c
-l | m | n
-x | y
-=end table
-
-$r = $=pod[9];
-is $r.contents.elems, 3;
-is $r.contents[0].join(','), 'a,b,c';
-is $r.contents[1].join(','), 'l,m,n';
-is $r.contents[2].join(','), 'x,y';

S26-documentation/07a-tables.t

@@ -0,0 +1,140 @@
+use v6;
+use Test;
+
+my ($r, $p, $hdrs, @rows);
+$p = -1; # starting index for pod number
+
+plan 37;
+
+# includes tests for fixes for RT bugs:
+#   124403 - incorrect table parse:
+#   128221 - internal error
+#   129862 - uneven rows
+#   132341 - pad rows to add empty cells to ensure all rows have same number of cells
+#   132348 - handle inline Z<> comments on table rows
+
+# test fix for RT #124403 - incorrect table parse:
+=table
++-----+----+---+
+|   a | b  | c |
++-----+----+---+
+| foo | 52 | Y |
+| bar | 17 | N |
+|  dz | 9  | Y |
++-----+----+---+
+
+$r = $=pod[++$p];
+#  tests
+is $r.headers.elems, 3;
+$hdrs = $r.headers.join('*');
+is $hdrs, "a*b*c";
+@rows = $r.contents>>.join('*');
+is $r.contents.elems, 3;
+is @rows[0], "foo*52*Y";
+is @rows[1], "bar*17*N";
+is @rows[2], "dz*9*Y";
+
+# test fix for RT #128221
+#       This test, with a '-r0c0' entry in
+#       the single table row, column 0,
+#       caused an exception.
+=begin table
+-r0c0  r0c1
+=end table
+$r = $=pod[++$p];
+is $r.contents.elems, 1;
+is $r.contents[0][0], "-r0c0"; # <= note leading hyphen which caused the original issue
+is $r.contents[0][1], "r0c1";
+
+# an expanded test (per Zoffix) for issue #128221
+# note expected results have been corrected from that time
+=begin table
+-Col 1 | -Col 2 | _Col 3 | =Col 4
+=======+========+========+=======
+r0Col 1  | -r0Col 2 | _r0Col 3 | =r0Col 4
+-------|--------|--------|-------
+r1Col 1  | -r1Col 2 | _r1Col 3 | =r1Col 4
+r1       |  r1Col 2 | _r1Col 3 | =r1Col 4
+-------|--------|--------|-------
+r2Col  1 | r2Col 2  |  r2Col 3 |  r2Col 4
+=end table
+$r = $=pod[++$p];
+$hdrs = $r.headers.join('|');
+@rows = $r.contents>>.join('|');
+
+is $r.headers.elems, 4;
+is $r.contents.elems, 3;
+is $hdrs, "-Col 1|-Col 2|_Col 3|=Col 4"; # <= note leading hyphen which caused the original issue
+is @rows[0], "r0Col 1|-r0Col 2|_r0Col 3|=r0Col 4";
+is @rows[1], "r1Col 1 r1|-r1Col 2 r1Col 2|_r1Col 3 _r1Col 3|=r1Col 4 =r1Col 4", "test for merged cells";
+is @rows[2], "r2Col 1|r2Col 2|r2Col 3|r2Col 4";
+
+# test fix for issue RT #129862
+# uneven rows
+=begin table
+a | b | c
+l | m | n
+x | y
+=end table
+
+$r = $=pod[++$p];
+is $r.contents.elems, 3;
+is $r.contents[0].join(','), 'a,b,c';
+is $r.contents[1].join(','), 'l,m,n';
+is $r.contents[2].join(','), 'x,y,';
+
+is $r.contents[0].elems, 3;
+is $r.contents[1].elems, 3;
+is $r.contents[2].elems, 3;
+
+# test fix for RT #132341
+# also tests fix for RT #129862
+=table
+    X   O
+   ===========
+        X   O
+   ===========
+            X
+
+$r = $=pod[++$p];
+is $r.contents.elems, 3;
+is $r.contents[0].join(','), 'X,O,', "test for empty cell";
+is $r.contents[1].join(','), ',X,O';
+is $r.contents[2].join(','), ',,X';
+
+is $r.contents[0].elems, 3;
+is $r.contents[1].elems, 3;
+is $r.contents[2].elems, 3;
+
+# test fix for RT #132348 (allow inline Z comments)
+# also tests fix for RT #129862
+=begin table
+a | b | c
+l | m | n
+x | y      Z<a comment> Z<another comment>
+=end table
+$r = $=pod[++$p];
+is $r.contents.elems, 3;
+is $r.contents[0].join(','), 'a,b,c';
+is $r.contents[1].join(','), 'l,m,n';
+is $r.contents[2].join(','), 'x,y,';
+
+# a single column table, no headers
+=begin table
+a
+=end table
+
+$r = $=pod[++$p];
+is $r.headers.elems, 0;
+is $r.contents.elems, 1;
+
+# a single column table, with header
+=begin table
+b
+-
+a
+=end table
+
+$r = $=pod[++$p];
+is $r.headers.elems, 1;
+is $r.contents.elems, 1;

S26-documentation/07b-tables.t

@@ -0,0 +1,37 @@
+use v6;
+use Test;
+
+plan 4;
+
+# test for the three designed fatal table failures
+
+# empty tables should cause an exception
+my $table1 = qq:to/HERE/;
+=begin table
+=end table
+HERE
+
+my $table2 = qq:to/HERE/;
+=table
+HERE
+
+# consecutive row separators should cause an exception
+my $table3 = qq:to/HERE/;
+=table
+1 | 2 | 3
+=========
+=========
+4 | 5 | 6
+HERE
+
+# mixed vis and ws col separators should cause an exception
+my $table4 = qq:to/HERE/;
+=table
+1 | 2 | 3
+4  5  6
+HERE
+
+eval-dies-ok $table1, "dies-ok, empty table";
+eval-dies-ok $table2, "dies-ok, empty table";
+eval-dies-ok $table3, "dies-ok, consecutive row separators";
+eval-dies-ok $table4, "dies-ok, mixed ws and vis col separators";