Fix regression in column level { not => undef } op

In 3cdadcbe we stopped considering a bare 'not' being an inequality op.
However there is code in the wild relying on this, so add an extra
compat shim (cheap)

diff --git a/Changes b/Changes
index c2dc760..665da01 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for SQL::Abstract
 
+    - Reintroduce { -not => undef } column operator (regression from 1.75)
+
 revision 1.75  2013-12-27
 ----------------------------
     - *UPCOMING INCOMPATIBLE BUGFIX*: SQLA used to generate incorrect SQL

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 91de6a9..5cdc47f 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -805,7 +805,8 @@ sub _where_hashpair_HASHREF {
 
         UNDEF => sub {          # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
           my $is =
-            $op =~ $self->{equality_op}   ? 'is'
+            $op =~ /^not$/i               ? 'is not'  # legacy
+          : $op =~ $self->{equality_op}   ? 'is'
           : $op =~ $self->{like_op}       ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
           : $op =~ $self->{inequality_op} ? 'is not'
           : $op =~ $self->{not_like_op}   ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'

diff --git a/t/01generate.t b/t/01generate.t
index 7e641f7..245ca55 100644 (file)
--- a/t/01generate.t
+++ b/t/01generate.t
@@ -555,16 +555,22 @@ my @tests = (
 );
 
 # check is( not) => undef
-for my $op (qw( is is_not), 'is not' ) {
+for my $op ( qw(not is is_not), 'is not' ) {
   (my $sop = uc $op) =~ s/_/ /gi;
 
-  push @tests, {
-    func => 'where',
-    args => [{ a => { "$_$op" => undef } }],
-    stmt => "WHERE a $sop NULL",
-    stmt_q => "WHERE `a` $sop NULL",
-    bind => [],
-  } for ('', '-');  # with and without -
+  $sop = 'IS NOT' if $sop eq 'NOT';
+
+  for my $uc (0, 1) {
+    for my $prefix ('', '-') {
+      push @tests, {
+        func => 'where',
+        args => [{ a => { ($prefix . ($uc ? uc $op : lc $op) ) => undef } }],
+        stmt => "WHERE a $sop NULL",
+        stmt_q => "WHERE `a` $sop NULL",
+        bind => [],
+      };
+    }
+  }
 }
 
 # check single-element inequality ops for no warnings