DBD-SQLeet

 view release on metacpan or  search on metacpan

t/rt_26775_distinct.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use DBI;
use Test::More;
use lib "t/lib";
use SQLeetTest;

BEGIN {
  requires_sqleet_sqlite('3.6.3')
}

plan tests => 22;

use_ok('DBD::SQLeet');

my $noprintquerymsg = '(Set ENV{PRINT_QUERY} to true value to see query)';
my $tinfo;

my $dbh = DBI->connect('dbi:SQLeet::memory:');
ok( ref $dbh, "create new db" );

#
# First we create our schema (attached in __DATA__)
#
my $slurp;
while (my $line = <DATA>) {
  $slurp .= $line;
}

QUERY:
for my $query (split m/ ; /xms, $slurp) {

  # remove newline + leading and trailing whitespace.
  chomp $query;
  $query =~ s/^ \s+  //xms;
  $query =~ s/  \s+ $//xms;
  next QUERY if not $query;

  # execute the query.
  my $sth = $dbh->prepare($query);
  $tinfo  = $ENV{PRINT_QUERY}  ?  "prepare: $query"
                               :  "prepare: $noprintquerymsg";
  ok( ref $sth, $tinfo);
  my $ret = $sth->execute( );
  $tinfo  = $ENV{PRINT_QUERY}  ?  "execute: $query"
                               :  "execute: $noprintquerymsg";
  ok( $ret, $tinfo);

  $sth->finish( );
}

#
# Then we test the bug.
#
# We test with both 'DISTINCT(t.name) [..]' and 'DISTINCT t.name [..]'
#
my $query_with_parens = trim(q{
    SELECT DISTINCT(t.name), t.tagid
      FROM objtagmap m,tags t
    WHERE (m.objid = 1)
    AND   (t.tagid = m.tagid)
});

my $query_without_parens = trim(q{
    SELECT DISTINCT t.name, t.tagid
      FROM objtagmap m,tags t
    WHERE (m.objid = 1)
    AND   (t.tagid = m.tagid)
});

foreach my $query (($query_with_parens, $query_without_parens)) {
  # just to print readable test descriptions.
  my $abbrev = substr $query, 0, 25;

  my $sth = $dbh->prepare($query);
  ok( ref $sth, "prepare $abbrev" );
  my $ret = $sth->execute( );
  ok( $ret, "execute $abbrev" );

  while (my $hres = $sth->fetchrow_hashref) {
    # Here we should get two hash keys: 'name' and 'tagid'.
    ok( exists $hres->{name}, 'exists $hres->{name}' );
    ok( exists $hres->{tagid}, 'exists $hres->{tagid}' );
    if (! exists $hres->{name}) {
      $Data::Dumper::Varname = '';
      eval 'require Data::Dumper;';
      if (! $@) {
        $Data::Dumper::Varname = 'fetchrow_hashref';
        print {*STDERR} "#[RT #26775] The keys we got was: ",
          Data::Dumper::Dumper($hres), "\n";
      }



( run in 1.304 second using v1.01-cache-2.11-cpan-5511b514fd6 )