From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 7 Jan 2011 09:05:06 +0000 (+0100)
Subject: Fix recursion warnings while parsing extremely long lists
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0f9a26cb13f772fe0813987a0641baf193fa9782;p=scpubgit%2FQ-Branch.git

Fix recursion warnings while parsing extremely long lists
---

diff --git a/Changes b/Changes
index 3f1e7fc..13b7b1b 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for SQL::Abstract
 
     - Fix parsing of NOT EXISTS
+    - Fix deep recursion warnings while parsing obnoxiously long sql statements
 
 revision 1.72  2010-12-21
 ----------------------------
diff --git a/lib/SQL/Abstract/Tree.pm b/lib/SQL/Abstract/Tree.pm
index 5b7b704..8d7a36a 100644
--- a/lib/SQL/Abstract/Tree.pm
+++ b/lib/SQL/Abstract/Tree.pm
@@ -309,6 +309,10 @@ sub parse {
   $self->_recurse_parse($tokens, PARSE_TOP_LEVEL);
 }
 
+{
+# this is temporary, lists can be parsed *without* recursing, but
+# it requires a massive rewrite of the AST generator
+no warnings qw/recursion/;
 sub _recurse_parse {
   my ($self, $tokens, $state) = @_;
 
@@ -405,6 +409,7 @@ sub _recurse_parse {
     }
   }
 }
+}
 
 sub format_keyword {
   my ($self, $keyword) = @_;
diff --git a/t/11unparse.t b/t/11parser.t
similarity index 95%
rename from t/11unparse.t
rename to t/11parser.t
index f45b5e4..7f4dae7 100644
--- a/t/11unparse.t
+++ b/t/11parser.t
@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Deep;
+use Test::Warn;
 use SQL::Abstract::Tree;
 
 my $sqlat = SQL::Abstract::Tree->new;
@@ -699,4 +700,37 @@ cmp_deeply($sqlat->parse("SELECT x, y FROM foo WHERE x IN (?, ?, ?, ?)"), [
   ]
 ], 'Lists parsed correctly');
 
+# test for recursion warnings on huge selectors
+warnings_are {
+  my $sql = sprintf 'SELECT %s FROM foo', join (', ',  map { qq|"$_"| } 'aa' .. 'zz' );
+  my $tree = $sqlat->parse($sql);
+
+  is_deeply( $tree, [
+    [
+      "SELECT",
+      [
+        [
+          "LIST",
+          [
+            map { [ "LITERAL", [ qq|"$_"| ] ] } ('aa' .. 'zz')
+          ]
+        ]
+      ]
+    ],
+    [
+      "FROM",
+      [
+        [
+          "LITERAL",
+          [
+            "foo"
+          ]
+        ]
+      ]
+    ]
+  ], 'long list parsed correctly');
+
+  is( $sqlat->unparse($tree), $sql, 'roundtrip ok');
+} [], 'no recursion warnings on insane SQL';
+
 done_testing;