Rewrite mssql test to verify both types of limit dialects with and without quoting...
Peter Rabbitson [Mon, 3 May 2010 16:34:48 +0000 (16:34 +0000)]
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/SQLAHacks.pm
t/746mssql.t

index a360d3e..c1f6732 100644 (file)
@@ -1271,10 +1271,6 @@ sub _count_subq_rs {
 
   $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $attrs);
 
-  # this is so that the query can be simplified e.g.
-  # * ordering can be thrown away in things like Top limit
-  $sub_attrs->{-for_count_only} = 1;
-
   my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs);
 
   $attrs->{from} = [{
index b5c9f8a..f3fa030 100644 (file)
@@ -46,60 +46,119 @@ sub new {
   $self;
 }
 
+# !!! THIS IS ALSO HORRIFIC !!! /me ashamed
+#
 # generate inner/outer select lists for various limit dialects
 # which result in one or more subqueries (e.g. RNO, Top, RowNum)
 # Any non-root-table columns need to have their table qualifier
-# turned into a column name (otherwise names in subqueries clash
+# turned into a column alias (otherwise names in subqueries clash
 # and/or lose their source table)
-sub _subqueried_selection {
-  my ($self, $rs_attrs) = @_;
+#
+# returns inner/outer strings of SQL QUOTED selectors with aliases
+# (to be used in whatever select statement), and an alias index hashref
+# of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used for string-subst
+# higher up)
+#
+# If the $scan_order option is supplied, it signals that the limit dialect
+# needs to order the outer side of the query, which in turn means that the
+# inner select needs to bring out columns used in implicit (non-selected)
+# orders, and the order condition itself needs to be realiased to the proper
+# names in the outer query.
+#
+# In this case ($scan_order os true) we also return a hashref (order doesn't
+# matter) of QUOTED EXTRA-SEL => QUOTED ALIAS pairs, which is a list of extra
+# selectors that do *not* exist in the original select list
+
+sub _subqueried_limit_attrs {
+  my ($self, $rs_attrs, $scan_order) = @_;
 
-  croak 'Limit usable only in the context of DBIC (missing $rs_attrs)' unless $rs_attrs;
+  croak 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
+    unless ref ($rs_attrs) eq 'HASH';
+
+  my ($re_sep, $re_alias) = map { quotemeta $_ } (
+    $self->name_sep || '.',
+    $rs_attrs->{alias},
+  );
 
-  # correlate select and as
-  my @sel;
+  # correlate select and as, build selection index
+  my (@sel, $in_sel_index);
   for my $i (0 .. $#{$rs_attrs->{select}}) {
+
     my $s = $rs_attrs->{select}[$i];
+    my $sql_sel = $self->_recurse_fields ($s);
+    my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef;
+
+
     push @sel, {
-      sql => $self->_recurse_fields ($s),
+      sql => $sql_sel,
       unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) },
       as =>
-        ( (ref $s) eq 'HASH' ? $s->{-as} : undef)
+        $sql_alias
           ||
         $rs_attrs->{as}[$i]
           ||
         croak "Select argument $i ($s) without corresponding 'as'"
       ,
     };
+
+    $in_sel_index->{$sql_sel}++;
+    $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias;
+
+# this *may* turn out to be necessary, not sure yet
+#    my ($sql_unqualified_sel) = $sql_sel =~ / $re_sep (.+) $/x
+#      if ! ref $s;
+#    $in_sel_index->{$sql_unqualified_sel}++;
   }
 
-  my ($qsep, $qalias) = map { quotemeta $_ } (
-    $self->name_sep || '.',
-    $rs_attrs->{alias},
-  );
 
   # re-alias and remove any name separators from aliases,
   # unless we are dealing with the current source alias
-  # (which will transcend the subqueries and is necessary
+  # (which will transcend the subqueries as it is necessary
   # for possible further chaining)
-  my (@insel, @outsel);
+  my (@in_sel, @out_sel, %renamed);
   for my $node (@sel) {
-    if (List::Util::first { $_ =~ / (?<! $qalias ) $qsep /x } ($node->{as}, $node->{unquoted_sql}) )  {
-      $node->{as} =~ s/ $qsep /__/xg;
-      push @insel, sprintf '%s AS %s', $node->{sql}, $self->_quote($node->{as});
-      push @outsel, $self->_quote ($node->{as});
+    if (List::Util::first { $_ =~ / (?<! $re_alias ) $re_sep /x } ($node->{as}, $node->{unquoted_sql}) )  {
+      $node->{as} =~ s/ $re_sep /__/xg;
+      my $quoted_as = $self->_quote($node->{as});
+      push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as;
+      push @out_sel, $quoted_as;
+      $renamed{$node->{sql}} = $quoted_as;
     }
     else {
-      push @insel, $node->{sql};
-      push @outsel, $self->_quote ($node->{as});
+      push @in_sel, $node->{sql};
+      push @out_sel, $self->_quote ($node->{as});
     }
   }
 
-  return map { join (', ', @$_ ) } (\@insel, \@outsel);
+  my %extra_order_sel;
+  if ($scan_order) {
+    for my $chunk ($self->_order_by_chunks (
+      ref $rs_attrs->{order_by} eq 'ARRAY'
+        ? @{$rs_attrs->{order_by}}
+        : $rs_attrs->{order_by}
+    )) {
+      # order with bind
+      $chunk = $chunk->[0] if (ref $chunk) eq 'ARRAY';
+      $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
+
+      next if $in_sel_index->{$chunk};
+
+      $extra_order_sel{$chunk} ||= $self->_quote (
+        '__ORDER_BY_' . scalar keys %extra_order_sel
+      );
+    }
+  }
+  return (
+    (map { join (', ', @$_ ) } (
+      \@in_sel,
+      \@out_sel)
+    ),
+    \%renamed,
+    keys %extra_order_sel ? \%extra_order_sel : (),
+  );
 }
 
-
-# ANSI standard Limit/Offset implementation. DB2 and MSSQL use this
+# ANSI standard Limit/Offset implementation. DB2 and MSSQL >= 2005 use this
 sub _RowNumberOver {
   my ($self, $sql, $rs_attrs, $rows, $offset ) = @_;
 
@@ -107,26 +166,47 @@ sub _RowNumberOver {
   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
     or croak "Unrecognizable SELECT: $sql";
 
-  # get selectors
-  my ($insel, $outsel) = $self->_subqueried_selection ($rs_attrs);
+  # get selectors, and scan the order_by (if any)
+  my ($in_sel, $out_sel, $alias_map, $extra_order_sel) = $self->_subqueried_limit_attrs (
+    $rs_attrs, 'scan_order_by',
+  );
 
   # make up an order if none exists
-  my $order_by = $self->_order_by(
-    (delete $rs_attrs->{order_by}) || $self->_rno_default_order
-  );
+  my $requested_order = (delete $rs_attrs->{order_by}) || $self->_rno_default_order;
+  my $rno_ord = $self->_order_by ($requested_order);
+
+  # this is the order supplement magic
+  my $mid_sel = $out_sel;
+  if ($extra_order_sel) {
+    for my $extra_col (keys %$extra_order_sel) {
+      $in_sel .= sprintf (', %s AS %s',
+        $extra_col,
+        $extra_order_sel->{$extra_col},
+      );
+
+      $mid_sel .= ', ' . $extra_order_sel->{$extra_col};
+    }
+  }
+
+  # and this is order re-alias magic
+  for ($extra_order_sel, $alias_map) {
+    for my $col (keys %$_) {
+      my $re_col = quotemeta ($col);
+      $rno_ord =~ s/$re_col/$_->{$col}/;
+    }
+  }
 
   # whatever is left of the order_by (only where is processed at this point)
   my $group_having = $self->_parse_rs_attrs($rs_attrs);
 
   my $qalias = $self->_quote ($rs_attrs->{alias});
-
   my $idx_name = $self->_quote ('rno__row__index');
 
   $sql = sprintf (<<EOS, $offset + 1, $offset + $rows, );
 
-SELECT $outsel FROM (
-  SELECT $outsel, ROW_NUMBER() OVER($order_by ) AS $idx_name FROM (
-    SELECT $insel ${sql}${group_having}
+SELECT $out_sel FROM (
+  SELECT $mid_sel, ROW_NUMBER() OVER( $rno_ord ) AS $idx_name FROM (
+    SELECT $in_sel ${sql}${group_having}
   ) $qalias
 ) $qalias WHERE $idx_name BETWEEN %d AND %d
 
@@ -185,7 +265,7 @@ sub _RowNum {
   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
     or croak "Unrecognizable SELECT: $sql";
 
-  my ($insel, $outsel) = $self->_subqueried_selection ($rs_attrs);
+  my ($insel, $outsel) = $self->_subqueried_limit_attrs ($rs_attrs);
 
   my $qalias = $self->_quote ($rs_attrs->{alias});
   my $idx_name = $self->_quote ('rownum__index');
@@ -205,8 +285,7 @@ EOS
   return $sql;
 }
 
-=begin
-# Crappy Top based Limit/Offset support. Legacy from MSSQL.
+# Crappy Top based Limit/Offset support. Legacy for MSSQL < 2005
 sub _Top {
   my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
 
@@ -215,154 +294,102 @@ sub _Top {
     or croak "Unrecognizable SELECT: $sql";
 
   # get selectors
-  my ($insel, $outsel) = $self->_subqueried_selection ($rs_attrs);
+  my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
+    = $self->_subqueried_limit_attrs ($rs_attrs, 'outer_order_by');
 
-  # deal with order
-  my $rs_alias = $rs_attrs->{alias};
-  my $req_order = delete $rs_attrs->{order_by};
-  my $name_sep = $self->name_sep || '.';
+  my $requested_order = delete $rs_attrs->{order_by};
 
-  # examine normalized version, collapses nesting
-  my $limit_order = scalar $self->_order_by_chunks ($req_order)
-    ? $req_order
+  my $order_by_requested = $self->_order_by ($requested_order);
+
+  # make up an order unless supplied
+  my $inner_order = ($order_by_requested
+    ? $requested_order
     : [ map
-      { join ('', $rs_alias, $name_sep, $_ ) }
-      ( $rs_attrs->{_rsroot_source_handle}->resolve->primary_columns )
+      { join ('', $rs_attrs->{alias}, $self->{name_sep}||'.', $_ ) }
+      ( $rs_attrs->{_rsroot_source_handle}->resolve->_pri_cols )
     ]
-  ;
-
-  my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
-  my $order_by_requested = $self->_order_by ($req_order);
-
-
+  );
 
+  my ($order_by_inner, $order_by_reversed);
 
-  my $esc_name_sep = "\Q$name_sep\E";
-  my $col_re = qr/ ^ (?: (.+) $esc_name_sep )? ([^$esc_name_sep]+) $ /x;
+  # localise as we already have all the bind values we need
+  {
+    local $self->{order_bind};
+    $order_by_inner = $self->_order_by ($inner_order);
 
-  my $quoted_rs_alias = $self->_quote ($rs_alias);
+    my @out_chunks;
+    for my $ch ($self->_order_by_chunks ($inner_order)) {
+      $ch = $ch->[0] if ref $ch eq 'ARRAY';
+      $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix;
+      my $dir = uc ($1||'ASC');
 
-  # construct the new select lists, rename(alias) some columns if necessary
-  my (@outer_select, @inner_select, %seen_names, %col_aliases, %outer_col_aliases);
+      push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' );
+    }
 
-  for (@{$rs_attrs->{select}}) {
-    next if ref $_;
-    my ($table, $orig_colname) = ( $_ =~ $col_re );
-    next unless $table;
-    $seen_names{$orig_colname}++;
+    $order_by_reversed = $self->_order_by (@out_chunks);
   }
 
-  for my $i (0 .. $#sql_select) {
-
-    my $colsel_arg = $rs_attrs->{select}[$i];
-    my $colsel_sql = $sql_select[$i];
-
-    # this may or may not work (in case of a scalarref or something)
-    my ($table, $orig_colname) = ( $colsel_arg =~ $col_re );
-
-    my $quoted_alias;
-    # do not attempt to understand non-scalar selects - alias numerically
-    if (ref $colsel_arg) {
-      $quoted_alias = $self->_quote ('column_' . (@inner_select + 1) );
-    }
-    # column name seen more than once - alias it
-    elsif ($orig_colname &&
-          ($seen_names{$orig_colname} && $seen_names{$orig_colname} > 1) ) {
-      $quoted_alias = $self->_quote ("${table}__${orig_colname}");
-    }
-
-    # we did rename - make a record and adjust
-    if ($quoted_alias) {
-      # alias inner
-      push @inner_select, "$colsel_sql AS $quoted_alias";
-
-      # push alias to outer
-      push @outer_select, $quoted_alias;
-
-      # Any aliasing accumulated here will be considered
-      # both for inner and outer adjustments of ORDER BY
-      $self->__record_alias (
-        \%col_aliases,
-        $quoted_alias,
-        $colsel_arg,
-        $table ? $orig_colname : undef,
+  # this is the order supplement magic
+  my $mid_sel = $out_sel;
+  if ($extra_order_sel) {
+    for my $extra_col (keys %$extra_order_sel) {
+      $in_sel .= sprintf (', %s AS %s',
+        $extra_col,
+        $extra_order_sel->{$extra_col},
       );
-    }
 
-    # otherwise just leave things intact inside, and use the abbreviated one outside
-    # (as we do not have table names anymore)
-    else {
-      push @inner_select, $colsel_sql;
-
-      my $outer_quoted = $self->_quote ($orig_colname);  # it was not a duplicate so should just work
-      push @outer_select, $outer_quoted;
-      $self->__record_alias (
-        \%outer_col_aliases,
-        $outer_quoted,
-        $colsel_arg,
-        $table ? $orig_colname : undef,
-      );
+      $mid_sel .= ', ' . $extra_order_sel->{$extra_col};
     }
   }
 
-  my $outer_select = join (', ', @outer_select );
-  my $inner_select = join (', ', @inner_select );
-
-  %outer_col_aliases = (%outer_col_aliases, %col_aliases);
-
-
-
-
-  # generate the rest
-  my $grpby_having = $self->_parse_rs_attrs ($rs_attrs);
-
-  # short circuit for counts - the ordering complexity is needless
-  if ($rs_attrs->{-for_count_only}) {
-    return "SELECT TOP $rows $inner_select $sql $grpby_having $order_by_outer";
-  }
-
-  # we can't really adjust the order_by columns, as introspection is lacking
-  # resort to simple substitution
-  for my $col (keys %outer_col_aliases) {
-    for ($order_by_requested, $order_by_outer) {
-      $_ =~ s/\s+$col\s+/ $outer_col_aliases{$col} /g;
+  # and this is order re-alias magic
+  for my $map ($extra_order_sel, $alias_map) {
+    for my $col (keys %$map) {
+      my $re_col = quotemeta ($col);
+      $_ =~ s/$re_col/$map->{$col}/
+        for ($order_by_reversed, $order_by_requested);
     }
   }
-  for my $col (keys %col_aliases) {
-    $order_by_inner =~ s/\s+$col\s+/ $col_aliases{$col} /g;
-  }
 
+  # generate the rest of the sql
+  my $grpby_having = $self->_parse_rs_attrs ($rs_attrs);
 
-  my $inner_lim = $rows + $offset;
-
-  $sql = "SELECT TOP $inner_lim $inner_select $sql $grpby_having $order_by_inner";
-
-  if ($offset) {
-    $sql = <<"SQL";
-
-    SELECT TOP $rows $outer_select FROM
-    (
-      $sql
-    ) $quoted_rs_alias
-    $order_by_outer
-SQL
+  my $quoted_rs_alias = $self->_quote ($rs_attrs->{alias});
 
-  }
+  $sql = sprintf ('SELECT TOP %d %s %s %s %s',
+    $rows + ($offset||0),
+    $in_sel,
+    $sql,
+    $grpby_having,
+    $order_by_inner,
+  );
 
-  if ($order_by_requested) {
-    $sql = <<"SQL";
+  $sql = sprintf ('SELECT TOP %d %s FROM ( %s ) %s %s',
+    $rows,
+    $mid_sel,
+    $sql,
+    $quoted_rs_alias,
+    $order_by_reversed,
+  ) if $offset;
 
-    SELECT $outer_select FROM
-      ( $sql ) $quoted_rs_alias
-    $order_by_requested
-SQL
+  $sql = sprintf ('SELECT TOP %d %s FROM ( %s ) %s %s',
+    $rows,
+    $mid_sel,
+    $sql,
+    $quoted_rs_alias,
+    $order_by_requested,
+  ) if $order_by_requested;
 
-  }
+  $sql = sprintf ('SELECT TOP %d %s FROM ( %s ) %s',
+    $rows,
+    $out_sel,
+    $sql,
+    $quoted_rs_alias,
+  ) if ($mid_sel ne $out_sel);
 
-  $sql =~ s/\s*\n\s*/ /g; # parsing out multiline statements is harder than a single line
   return $sql;
 }
-=cut
+
 
 # While we're at it, this should make LIMIT queries more efficient,
 #  without digging into things too deeply
index ca92a41..1438cee 100644 (file)
@@ -59,8 +59,6 @@ my @opts = (
   { on_connect_call => 'use_dynamic_cursors' },
   {},
 );
-my $new;
-
 # test Auto-PK with different options
 for my $opts (@opts) {
   SKIP: {
@@ -77,112 +75,18 @@ for my $opts (@opts) {
 
     $schema->resultset('Artist')->search({ name => 'foo' })->delete;
 
-    $new = $schema->resultset('Artist')->create({ name => 'foo' });
+    my $new = $schema->resultset('Artist')->create({ name => 'foo' });
 
     ok($new->artistid > 0, "Auto-PK worked");
   }
 }
 
-$seen_id{$new->artistid}++;
-
-# test LIMIT support
-for (1..6) {
-    $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
-    is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
-    $seen_id{$new->artistid}++;
-}
-
-my $it = $schema->resultset('Artist')->search( {}, {
-    rows => 3,
-    order_by => 'artistid',
-});
-
-is( $it->count, 3, "LIMIT count ok" );
-is( $it->next->name, "foo", "iterator->next ok" );
-$it->next;
-is( $it->next->name, "Artist 2", "iterator->next ok" );
-is( $it->next, undef, "next past end of resultset ok" );
-
-# test GUID columns
-
-$schema->storage->dbh_do (sub {
-    my ($storage, $dbh) = @_;
-    eval { $dbh->do("DROP TABLE artist") };
-    $dbh->do(<<'SQL');
-CREATE TABLE artist (
-   artistid UNIQUEIDENTIFIER NOT NULL,
-   name VARCHAR(100),
-   rank INT NOT NULL DEFAULT '13',
-   charfield CHAR(10) NULL,
-   a_guid UNIQUEIDENTIFIER,
-   primary key(artistid)
-)
-SQL
-});
-
-# start disconnected to make sure insert works on an un-reblessed storage
-$schema = DBICTest::Schema->connect($dsn, $user, $pass);
-
-my $row;
-lives_ok {
-  $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
-} 'created a row with a GUID';
-
-ok(
-  eval { $row->artistid },
-  'row has GUID PK col populated',
-);
-diag $@ if $@;
-
-ok(
-  eval { $row->a_guid },
-  'row has a GUID col with auto_nextval populated',
-);
-diag $@ if $@;
-
-my $row_from_db = $schema->resultset('ArtistGUID')
-  ->search({ name => 'mtfnpy' })->first;
-
-is $row_from_db->artistid, $row->artistid,
-  'PK GUID round trip';
 
-is $row_from_db->a_guid, $row->a_guid,
-  'NON-PK GUID round trip';
 
-# test MONEY type
-$schema->storage->dbh_do (sub {
-    my ($storage, $dbh) = @_;
-    eval { $dbh->do("DROP TABLE money_test") };
-    $dbh->do(<<'SQL');
-CREATE TABLE money_test (
-   id INT IDENTITY PRIMARY KEY,
-   amount MONEY NULL
-)
-SQL
-});
-
-my $rs = $schema->resultset('Money');
-
-lives_ok {
-  $row = $rs->create({ amount => 100 });
-} 'inserted a money value';
-
-cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
-
-lives_ok {
-  $row->update({ amount => 200 });
-} 'updated a money value';
-
-cmp_ok $rs->find($row->id)->amount, '==', 200,
-  'updated money value round-trip';
-
-lives_ok {
-  $row->update({ amount => undef });
-} 'updated a money value to NULL';
+# Test populate
 
-is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
-
-$schema->storage->dbh_do (sub {
+{
+  $schema->storage->dbh_do (sub {
     my ($storage, $dbh) = @_;
     eval { $dbh->do("DROP TABLE owners") };
     eval { $dbh->do("DROP TABLE books") };
@@ -201,260 +105,378 @@ CREATE TABLE owners (
 )
 SQL
 
-});
-
-lives_ok ( sub {
-  # start a new connection, make sure rebless works
-  my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
-  $schema->populate ('Owners', [
-    [qw/id  name  /],
-    [qw/1   wiggle/],
-    [qw/2   woggle/],
-    [qw/3   boggle/],
-    [qw/4   fRIOUX/],
-    [qw/5   fRUE/],
-    [qw/6   fREW/],
-    [qw/7   fROOH/],
-    [qw/8   fISMBoC/],
-    [qw/9   station/],
-    [qw/10   mirror/],
-    [qw/11   dimly/],
-    [qw/12   face_to_face/],
-    [qw/13   icarus/],
-    [qw/14   dream/],
-    [qw/15   dyrstyggyr/],
-  ]);
-}, 'populate with PKs supplied ok' );
-
-
-lives_ok (sub {
-  # start a new connection, make sure rebless works
-  # test an insert with a supplied identity, followed by one without
-  my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
-  for (2, 1) {
-    my $id = $_ * 20 ;
-    $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
-    $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
-  }
-}, 'create with/without PKs ok' );
-
-is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
-
-lives_ok ( sub {
-  # start a new connection, make sure rebless works
-  my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
-  $schema->populate ('BooksInLibrary', [
-    [qw/source  owner title   /],
-    [qw/Library 1     secrets0/],
-    [qw/Library 1     secrets1/],
-    [qw/Eatery  1     secrets2/],
-    [qw/Library 2     secrets3/],
-    [qw/Library 3     secrets4/],
-    [qw/Eatery  3     secrets5/],
-    [qw/Library 4     secrets6/],
-    [qw/Library 5     secrets7/],
-    [qw/Eatery  5     secrets8/],
-    [qw/Library 6     secrets9/],
-    [qw/Library 7     secrets10/],
-    [qw/Eatery  7     secrets11/],
-    [qw/Library 8     secrets12/],
-  ]);
-}, 'populate without PKs supplied ok' );
-
-# plain ordered subqueries throw
-throws_ok (sub {
-  $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query
-}, qr/ordered subselect encountered/, 'Ordered Subselect detection throws ok');
-
-# make sure ordered subselects *somewhat* work
-{
-  my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
-
-  my $al = $owners->current_source_alias;
-  my $sealed_owners = $owners->result_source->resultset->search (
-    {},
-    {
-      alias => $al,
-      from => [{
-        -alias => $al,
-        -source_handle => $owners->result_source->handle,
-        $al => $owners->as_query,
-      }],
-    },
-  );
+  });
 
-  is_deeply (
-    [ map { $_->name } ($sealed_owners->all) ],
-    [ map { $_->name } ($owners->all) ],
-    'Sort preserved from within a subquery',
-  );
+  lives_ok ( sub {
+    # start a new connection, make sure rebless works
+    my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+    $schema->populate ('Owners', [
+      [qw/id  name  /],
+      [qw/1   wiggle/],
+      [qw/2   woggle/],
+      [qw/3   boggle/],
+      [qw/4   fRIOUX/],
+      [qw/5   fRUE/],
+      [qw/6   fREW/],
+      [qw/7   fROOH/],
+      [qw/8   fISMBoC/],
+      [qw/9   station/],
+      [qw/10   mirror/],
+      [qw/11   dimly/],
+      [qw/12   face_to_face/],
+      [qw/13   icarus/],
+      [qw/14   dream/],
+      [qw/15   dyrstyggyr/],
+    ]);
+  }, 'populate with PKs supplied ok' );
+
+
+  lives_ok (sub {
+    # start a new connection, make sure rebless works
+    # test an insert with a supplied identity, followed by one without
+    my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+    for (2, 1) {
+      my $id = $_ * 20 ;
+      $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
+      $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
+    }
+  }, 'create with/without PKs ok' );
+
+  is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
+
+  lives_ok ( sub {
+    # start a new connection, make sure rebless works
+    my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+    $schema->populate ('BooksInLibrary', [
+      [qw/source  owner title   /],
+      [qw/Library 1     secrets0/],
+      [qw/Library 1     secrets1/],
+      [qw/Eatery  1     secrets2/],
+      [qw/Library 2     secrets3/],
+      [qw/Library 3     secrets4/],
+      [qw/Eatery  3     secrets5/],
+      [qw/Library 4     secrets6/],
+      [qw/Library 5     secrets7/],
+      [qw/Eatery  5     secrets8/],
+      [qw/Library 6     secrets9/],
+      [qw/Library 7     secrets10/],
+      [qw/Eatery  7     secrets11/],
+      [qw/Library 8     secrets12/],
+    ]);
+  }, 'populate without PKs supplied ok' );
 }
 
-TODO: {
-  local $TODO = "This porbably will never work, but it isn't critical either afaik";
+# test simple, complex LIMIT and limited prefetch support, with both dialects and quote combinations (if possible)
+for my $dialect (
+  'Top',
+  ($schema->storage->_server_info->{normalized_dbms_version} || 0 ) >= 9
+    ? ('RowNumberOver')
+    : ()
+  ,
+) {
+  for my $quoted (0, 1) {
+
+    $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
+        limit_dialect => $dialect,
+        $quoted
+          ? ( quote_char => [ qw/ [ ] / ], name_sep => '.' )
+          : ()
+        ,
+      });
+
+    my $test_type = "Dialect:$dialect Quoted:$quoted";
+
+    # basic limit support
+    TODO: {
+      my $art_rs = $schema->resultset ('Artist');
+      $art_rs->delete;
+      $art_rs->create({ name => 'Artist ' . $_ }) for (1..6);
+
+      my $it = $schema->resultset('Artist')->search( {}, {
+        rows => 4,
+        offset => 3,
+        order_by => 'artistid',
+      });
+
+      is( $it->count, 3, "$test_type: LIMIT count ok" );
+
+      local $TODO = "Top-limit does not work when your limit ends up past the resultset"
+        if $dialect eq 'Top';
+
+      is( $it->next->name, 'Artist 4', "$test_type: iterator->next ok" );
+      $it->next;
+      is( $it->next->name, 'Artist 6', "$test_type: iterator->next ok" );
+      is( $it->next, undef, "$test_type: next past end of resultset ok" );
+    }
 
-  my $book_owner_ids = $schema->resultset ('BooksInLibrary')
-                               ->search ({}, { join => 'owner', distinct => 1, order_by => 'owner.name', unsafe_subselect_ok => 1 })
-                                ->get_column ('owner');
+    # plain ordered subqueries throw
+    throws_ok (sub {
+      $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query
+    }, qr/ordered subselect encountered/, "$test_type: Ordered Subselect detection throws ok");
 
-  my $book_owners = $schema->resultset ('Owners')->search ({
-    id => { -in => $book_owner_ids->as_query }
-  });
+    # make sure ordered subselects *somewhat* work
+    {
+      my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
+      my $sealed_owners = $owners->as_subselect_rs;
+
+      is_deeply (
+        [ map { $_->name } ($sealed_owners->all) ],
+        [ map { $_->name } ($owners->all) ],
+        "$test_type: Sort preserved from within a subquery",
+      );
+    }
 
-  is_deeply (
-    [ map { $_->id } ($book_owners->all) ],
-    [ $book_owner_ids->all ],
-    'Sort is preserved across IN subqueries',
-  );
-}
+    {
+      my $book_owner_ids = $schema->resultset ('BooksInLibrary')->search ({}, {
+        rows => 6,
+        offset => 2,
+        join => 'owner',
+        distinct => 1,
+        order_by => 'owner.name',
+        unsafe_subselect_ok => 1
+      })->get_column ('owner');
+
+      my @ids = $book_owner_ids->all;
+
+      is (@ids, 6, 'Limit works');
+
+      my $book_owners = $schema->resultset ('Owners')->search ({
+        id => { -in => $book_owner_ids->as_query }
+      });
+
+      TODO: {
+        local $TODO = "Correlated limited IN subqueries will probably never preserve order";
+
+        is_deeply (
+          [ map { $_->id } ($book_owners->all) ],
+          [ $book_owner_ids->all ],
+          "$test_type: Sort is preserved across IN subqueries",
+        );
+      }
+    }
 
-# This is known not to work - thus the negative test
-{
-  my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
-  my $corelated_owners = $owners->result_source->resultset->search (
+    # still even with lost order of IN, we should be getting correct
+    # sets
     {
-      id => { -in => $owners->get_column('id')->as_query },
-    },
+      my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
+      my $corelated_owners = $owners->result_source->resultset->search (
+        {
+          id => { -in => $owners->get_column('id')->as_query },
+        },
+        {
+          order_by => 'name' #reorder because of what is shown above
+        },
+      );
+
+      is (
+        join ("\x00", map { $_->name } ($corelated_owners->all) ),
+        join ("\x00", map { $_->name } ($owners->all) ),
+        "$test_type: With an outer order_by, everything still matches",
+      );
+    }
+
+    # make sure right-join-side single-prefetch ordering limit works
     {
-      order_by => 'name' #reorder because of what is shown above
-    },
-  );
+      my $rs = $schema->resultset ('BooksInLibrary')->search (
+        {
+          'owner.name' => { '!=', 'woggle' },
+        },
+        {
+          prefetch => 'owner',
+          order_by => 'owner.name',
+        }
+      );
+      # this is the order in which they should come from the above query
+      my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
+
+      is ($rs->all, 8, "$test_type: Correct amount of objects from right-sorted joined resultset");
+      is_deeply (
+        [map { $_->owner->name } ($rs->all) ],
+        \@owner_names,
+        "$test_type: Prefetched rows were properly ordered"
+      );
+
+      my $limited_rs = $rs->search ({}, {rows => 6, offset => 2, unsafe_subselect_ok => 1});
+      is ($limited_rs->count, 6, "$test_type: Correct count of limited right-sorted joined resultset");
+      is ($limited_rs->count_rs->next, 6, "$test_type: Correct count_rs of limited right-sorted joined resultset");
+
+      my $queries;
+      $schema->storage->debugcb(sub { $queries++; });
+      $schema->storage->debug(1);
+
+      is_deeply (
+        [map { $_->owner->name } ($limited_rs->all) ],
+        [@owner_names[2 .. 7]],
+        "$test_type: Prefetch-limited rows were properly ordered"
+      );
+      is ($queries, 1, "$test_type: Only one query with prefetch");
+
+      $schema->storage->debugcb(undef);
+      $schema->storage->debug(0);
+
+      is_deeply (
+        [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
+        [@owner_names[2 .. 7]],
+        "$test_type: Rows are still properly ordered after search_related",
+      );
+    }
 
-  cmp_ok (
-    join ("\x00", map { $_->name } ($corelated_owners->all) ),
-      'ne',
-    join ("\x00", map { $_->name } ($owners->all) ),
-    'Sadly sort not preserved from within a corelated subquery',
-  );
+    # try a ->has_many direction with duplicates
+    my $owners = $schema->resultset ('Owners')->search (
+      {
+        'books.id' => { '!=', undef },
+        'me.name' => { '!=', 'somebogusstring' },
+      },
+      {
+        prefetch => 'books',
+        order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
+        rows     => 3,  # 8 results total
+        unsafe_subselect_ok => 1,
+      },
+    );
+
+    my ($sql, @bind) = @${$owners->page(3)->as_query};
+    is_deeply (
+      \@bind,
+      [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ],  # double because of the prefetch subq
+    );
+
+    is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows");
+    is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count");
+
+    is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count");
+    TODO: {
+      local $TODO = "Top-limit does not work when your limit ends up past the resultset"
+        if $dialect eq 'Top';
+      is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows");
+      is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs");
+    }
 
-  cmp_ok (
-    join ("\x00", sort map { $_->name } ($corelated_owners->all) ),
-      'ne',
-    join ("\x00", sort map { $_->name } ($owners->all) ),
-    'Which in fact gives a completely wrong dataset',
-  );
+
+    # try a ->belongs_to direction (no select collapse, group_by should work)
+    my $books = $schema->resultset ('BooksInLibrary')->search (
+      {
+        'owner.name' => [qw/wiggle woggle/],
+      },
+      {
+        distinct => 1,
+        having => \['1 = ?', [ test => 1 ] ], #test having propagation
+        prefetch => 'owner',
+        rows     => 2,  # 3 results total
+        order_by => { -desc => 'me.owner' },
+        unsafe_subselect_ok => 1,
+      },
+    );
+
+    ($sql, @bind) = @${$books->page(3)->as_query};
+    is_deeply (
+      \@bind,
+      [
+        # inner
+        [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
+        # outer
+        [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
+      ],
+    );
+
+    is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows");
+    is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count");
+
+    is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count");
+    TODO: {
+      local $TODO = "Top-limit does not work when your limit ends up past the resultset"
+        if $dialect eq 'Top';
+      is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows");
+      is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs");
+    }
+  }
 }
 
 
-# make sure right-join-side single-prefetch ordering limit works
+# test GUID columns
 {
-  my $rs = $schema->resultset ('BooksInLibrary')->search (
-    {
-      'owner.name' => { '!=', 'woggle' },
-    },
-    {
-      prefetch => 'owner',
-      order_by => 'owner.name',
-    }
-  );
-  # this is the order in which they should come from the above query
-  my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
-
-  is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset');
-  is_deeply (
-    [map { $_->owner->name } ($rs->all) ],
-    \@owner_names,
-    'Rows were properly ordered'
-  );
+  $schema->storage->dbh_do (sub {
+    my ($storage, $dbh) = @_;
+    eval { $dbh->do("DROP TABLE artist") };
+    $dbh->do(<<'SQL');
+CREATE TABLE artist (
+   artistid UNIQUEIDENTIFIER NOT NULL,
+   name VARCHAR(100),
+   rank INT NOT NULL DEFAULT '13',
+   charfield CHAR(10) NULL,
+   a_guid UNIQUEIDENTIFIER,
+   primary key(artistid)
+)
+SQL
+  });
 
-  my $limited_rs = $rs->search ({}, {rows => 7, offset => 2, unsafe_subselect_ok => 1});
-  is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset');
-  is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset');
+  # start disconnected to make sure insert works on an un-reblessed storage
+  $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 
-  my $queries;
-  $schema->storage->debugcb(sub { $queries++; });
-  $schema->storage->debug(1);
+  my $row;
+  lives_ok {
+    $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
+  } 'created a row with a GUID';
 
-  is_deeply (
-    [map { $_->owner->name } ($limited_rs->all) ],
-    [@owner_names[2 .. 7]],
-    'Limited rows were properly ordered'
+  ok(
+    eval { $row->artistid },
+    'row has GUID PK col populated',
   );
-  is ($queries, 1, 'Only one query with prefetch');
-
-  $schema->storage->debugcb(undef);
-  $schema->storage->debug(0);
+  diag $@ if $@;
 
-
-  is_deeply (
-    [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
-    [@owner_names[2 .. 7]],
-    'Rows are still properly ordered after search_related'
+  ok(
+    eval { $row->a_guid },
+    'row has a GUID col with auto_nextval populated',
   );
-}
+  diag $@ if $@;
 
+  my $row_from_db = $schema->resultset('ArtistGUID')
+    ->search({ name => 'mtfnpy' })->first;
 
-#
-# try a prefetch on tables with identically named columns
-#
+  is $row_from_db->artistid, $row->artistid,
+    'PK GUID round trip';
 
-# set quote char - make sure things work while quoted
-$schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
-$schema->storage->_sql_maker->{name_sep} = '.';
+  is $row_from_db->a_guid, $row->a_guid,
+    'NON-PK GUID round trip';
+}
 
+# test MONEY type
 {
-  # try a ->has_many direction
-  my $owners = $schema->resultset ('Owners')->search (
-    {
-      'books.id' => { '!=', undef },
-      'me.name' => { '!=', 'somebogusstring' },
-    },
-    {
-      prefetch => 'books',
-      order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
-      rows     => 3,  # 8 results total
-      unsafe_subselect_ok => 1,
-    },
-  );
-
-  my ($sql, @bind) = @${$owners->page(3)->as_query};
-  is_deeply (
-    \@bind,
-    [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ],  # double because of the prefetch subq
-  );
+  $schema->storage->dbh_do (sub {
+    my ($storage, $dbh) = @_;
+    eval { $dbh->do("DROP TABLE money_test") };
+    $dbh->do(<<'SQL');
+CREATE TABLE money_test (
+   id INT IDENTITY PRIMARY KEY,
+   amount MONEY NULL
+)
+SQL
+  });
 
-  is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
-  is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
+  my $rs = $schema->resultset('Money');
+  my $row;
 
-  is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
-  is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
-  is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
+  lives_ok {
+    $row = $rs->create({ amount => 100 });
+  } 'inserted a money value';
 
+  cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
 
-  # try a ->belongs_to direction (no select collapse, group_by should work)
-  my $books = $schema->resultset ('BooksInLibrary')->search (
-    {
-      'owner.name' => [qw/wiggle woggle/],
-    },
-    {
-      distinct => 1,
-      having => \['1 = ?', [ test => 1 ] ], #test having propagation
-      prefetch => 'owner',
-      rows     => 2,  # 3 results total
-      order_by => { -desc => 'me.owner' },
-      unsafe_subselect_ok => 1,
-    },
-  );
+  lives_ok {
+    $row->update({ amount => 200 });
+  } 'updated a money value';
 
-  ($sql, @bind) = @${$books->page(3)->as_query};
-  is_deeply (
-    \@bind,
-    [
-      # inner
-      [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
-      # outer
-      [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
-    ],
-  );
+  cmp_ok $rs->find($row->id)->amount, '==', 200,
+    'updated money value round-trip';
 
-  is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
-  is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
+  lives_ok {
+    $row->update({ amount => undef });
+  } 'updated a money value to NULL';
 
-  is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
-  is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
-  is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
+  is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
 }
 
+
 done_testing;
 
 # clean up our mess