Login
Add a test file for things we want from PPI.
authorElliot Shank <perl@galumph.com>
Sun, 28 Sep 2008 20:06:28 +0000 (20:06 +0000)
committerElliot Shank <perl@galumph.com>
Sun, 28 Sep 2008 20:06:28 +0000 (20:06 +0000)
xt/author/81_ppi_problems.t [new file with mode: 0644]

diff --git a/xt/author/81_ppi_problems.t b/xt/author/81_ppi_problems.t
new file mode 100644 (file)
index 0000000..c3b2d80
--- /dev/null
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+##############################################################################
+#      $URL$
+#     $Date$
+#   $Author$
+# $Revision$
+##############################################################################
+
+use strict;
+use warnings;
+
+use PPI::Document;
+
+use Test::More tests => 1;
+
+#-----------------------------------------------------------------------------
+
+our $VERSION = '1.093_01';
+
+#-----------------------------------------------------------------------------
+
+# Things we're looking for from PPI.
+
+{
+    local $TODO = q<PPI doesn't handle anonymous subroutines.>;
+
+    my $document = PPI::Document->new(\'sub { }');
+
+    # Since we don't know what a correctly parsing PPI would do, simply test
+    # that it doesn't like it does when it doesn't correctly parse.
+    my @children = $document->schildren();
+    if (
+            @children == 1
+        and ( my $statement = $children[0] )->isa('PPI::Statement')
+    ) {
+        @children = $statement->schildren();
+        if (@children == 2) {
+            my ($maybe_sub, $maybe_block) = @children;
+
+            if (
+                    $maybe_sub->isa('PPI::Token::Word')
+                and $maybe_sub->content() eq 'sub'
+                and $maybe_block->isa('PPI::Structure::Block')
+                and $maybe_block->schildren() == 0
+            ) {
+                fail(q<PPI doesn't parse anonymous subroutines.>);
+            }
+            else {
+                pass(q<PPI might be parsing anonymous subroutines.>);
+            }
+        }
+        else {
+            pass(q<PPI might be parsing anonymous subroutines.>);
+        }
+    }
+    else {
+        pass(q<PPI might be parsing anonymous subroutines.>);
+    }
+}
+
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :