Add explicit notes wrt DBI/DBD::SQLite dep versions
[dbsrgits/DBIx-Class.git] / t / 746mssql.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use Test::Exception;
6 use Try::Tiny;
7 use DBIx::Class::SQLMaker::LimitDialects;
8 use DBIx::Class::Optional::Dependencies ();
9 use lib qw(t/lib);
10 use DBICTest;
11 use DBIC::SqlMakerTest;
12
13 plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_odbc')
14   unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_odbc');
15
16 my $OFFSET = DBIx::Class::SQLMaker::LimitDialects->__offset_bindtype;
17 my $TOTAL  = DBIx::Class::SQLMaker::LimitDialects->__total_bindtype;
18
19 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
20
21 plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
22   unless ($dsn && $user);
23
24 {
25   my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version};
26   ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') );
27 }
28
29 DBICTest::Schema->load_classes('ArtistGUID');
30 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
31
32 {
33   no warnings 'redefine';
34   my $connect_count = 0;
35   my $orig_connect = \&DBI::connect;
36   local *DBI::connect = sub { $connect_count++; goto &$orig_connect };
37
38   $schema->storage->ensure_connected;
39
40   is( $connect_count, 1, 'only one connection made');
41 }
42
43 isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
44
45 {
46   my $schema2 = $schema->connect (@{$schema->storage->connect_info});
47   ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
48 }
49 $schema->storage->_dbh->disconnect;
50
51 lives_ok {
52   $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
53 } '_ping works';
54
55 my %opts = (
56   use_mars =>
57     { opts => { on_connect_call => 'use_mars' } },
58   use_dynamic_cursors =>
59     { opts => { on_connect_call => 'use_dynamic_cursors' },
60       required => $schema->storage->_using_freetds ? 0 : 1,
61     },
62   use_server_cursors =>
63     { opts => { on_connect_call => 'use_server_cursors' } },
64   plain =>
65     { opts => {}, required => 1 },
66 );
67
68 for my $opts_name (keys %opts) {
69   SKIP: {
70     my $opts = $opts{$opts_name}{opts};
71     $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
72
73     try {
74       $schema->storage->ensure_connected
75     }
76     catch {
77       if ($opts{$opts_name}{required}) {
78         die "on_connect_call option '$opts_name' is not functional: $_";
79       }
80       else {
81         skip
82           "on_connect_call option '$opts_name' not functional in this configuration: $_",
83           1
84         ;
85       }
86     };
87
88     $schema->storage->dbh_do (sub {
89         my ($storage, $dbh) = @_;
90         eval { $dbh->do("DROP TABLE artist") };
91         $dbh->do(<<'SQL');
92 CREATE TABLE artist (
93    artistid INT IDENTITY NOT NULL,
94    name VARCHAR(100),
95    rank INT NOT NULL DEFAULT '13',
96    charfield CHAR(10) NULL,
97    primary key(artistid)
98 )
99 SQL
100     });
101
102 # test Auto-PK
103     $schema->resultset('Artist')->search({ name => 'foo' })->delete;
104
105     my $new = $schema->resultset('Artist')->create({ name => 'foo' });
106
107     ok(($new->artistid||0) > 0, "Auto-PK worked for $opts_name");
108
109 # Test multiple active statements
110     SKIP: {
111       skip 'not a multiple active statements configuration', 1
112         if $opts_name eq 'plain';
113
114       $schema->storage->ensure_connected;
115
116       lives_ok {
117
118         no warnings 'redefine';
119         local *DBI::connect = sub { die "NO RECONNECTS!!!" };
120
121         my $artist_rs = $schema->resultset('Artist');
122
123         $artist_rs->delete;
124
125         $artist_rs->create({ name => "Artist$_" }) for (1..3);
126
127         my $forward  = $artist_rs->search({},
128           { order_by => { -asc  => 'artistid' } });
129         my $backward = $artist_rs->search({},
130           { order_by => { -desc => 'artistid' } });
131
132         my @map = (
133           [qw/Artist1 Artist3/], [qw/Artist2 Artist2/], [qw/Artist3 Artist1/]
134         );
135         my @result;
136
137         while (my $forward_row = $forward->next) {
138           my $backward_row = $backward->next;
139           push @result, [$forward_row->name, $backward_row->name];
140         }
141
142         is_deeply \@result, \@map, "multiple active statements in $opts_name";
143
144         $artist_rs->delete;
145
146         is($artist_rs->count, 0, '$dbh still viable');
147       } "Multiple active statements survive $opts_name";
148     }
149
150 # Test populate
151
152     {
153       $schema->storage->dbh_do (sub {
154         my ($storage, $dbh) = @_;
155         eval { $dbh->do("DROP TABLE owners") };
156         eval { $dbh->do("DROP TABLE books") };
157         $dbh->do(<<'SQL');
158 CREATE TABLE books (
159    id INT IDENTITY (1, 1) NOT NULL,
160    source VARCHAR(100),
161    owner INT,
162    title VARCHAR(10),
163    price INT NULL
164 )
165
166 CREATE TABLE owners (
167    id INT IDENTITY (1, 1) NOT NULL,
168    name VARCHAR(100),
169 )
170 SQL
171       });
172
173       lives_ok ( sub {
174         # start a new connection, make sure rebless works
175         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
176         $schema->populate ('Owners', [
177           [qw/id  name  /],
178           [qw/1   wiggle/],
179           [qw/2   woggle/],
180           [qw/3   boggle/],
181           [qw/4   fRIOUX/],
182           [qw/5   fRUE/],
183           [qw/6   fREW/],
184           [qw/7   fROOH/],
185           [qw/8   fISMBoC/],
186           [qw/9   station/],
187           [qw/10   mirror/],
188           [qw/11   dimly/],
189           [qw/12   face_to_face/],
190           [qw/13   icarus/],
191           [qw/14   dream/],
192           [qw/15   dyrstyggyr/],
193         ]);
194       }, 'populate with PKs supplied ok' );
195
196
197       lives_ok (sub {
198         # start a new connection, make sure rebless works
199         # test an insert with a supplied identity, followed by one without
200         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
201         for (2, 1) {
202           my $id = $_ * 20 ;
203           $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
204           $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
205         }
206       }, 'create with/without PKs ok' );
207
208       is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
209
210       lives_ok ( sub {
211         # start a new connection, make sure rebless works
212         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
213         $schema->populate ('BooksInLibrary', [
214           [qw/source  owner title   /],
215           [qw/Library 1     secrets0/],
216           [qw/Library 1     secrets1/],
217           [qw/Eatery  1     secrets2/],
218           [qw/Library 2     secrets3/],
219           [qw/Library 3     secrets4/],
220           [qw/Eatery  3     secrets5/],
221           [qw/Library 4     secrets6/],
222           [qw/Library 5     secrets7/],
223           [qw/Eatery  5     secrets8/],
224           [qw/Library 6     secrets9/],
225           [qw/Library 7     secrets10/],
226           [qw/Eatery  7     secrets11/],
227           [qw/Library 8     secrets12/],
228         ]);
229       }, 'populate without PKs supplied ok' );
230     }
231
232 # test simple, complex LIMIT and limited prefetch support, with both dialects and quote combinations (if possible)
233     for my $dialect (
234       'Top',
235       ($schema->storage->_server_info->{normalized_dbms_version} || 0 ) >= 9
236         ? ('RowNumberOver')
237         : ()
238       ,
239     ) {
240       for my $quoted (0, 1) {
241
242         $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
243             limit_dialect => $dialect,
244             %$opts,
245             $quoted
246               ? ( quote_char => [ qw/ [ ] / ], name_sep => '.' )
247               : ()
248             ,
249           });
250
251         my $test_type = "Dialect:$dialect Quoted:$quoted";
252
253         # basic limit support
254         {
255           my $art_rs = $schema->resultset ('Artist');
256           $art_rs->delete;
257           $art_rs->create({ name => 'Artist ' . $_ }) for (1..6);
258
259           my $it = $schema->resultset('Artist')->search( {}, {
260             rows => 4,
261             offset => 3,
262             order_by => 'artistid',
263           });
264
265           is( $it->count, 3, "$test_type: LIMIT count ok" );
266
267           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
268             if $dialect eq 'Top';
269
270           is( $it->next->name, 'Artist 4', "$test_type: iterator->next ok" );
271           $it->next;
272           is( $it->next->name, 'Artist 6', "$test_type: iterator->next ok" );
273           is( $it->next, undef, "$test_type: next past end of resultset ok" );
274         }
275
276         # plain ordered subqueries throw
277         throws_ok (sub {
278           $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query
279         }, qr/ordered subselect encountered/, "$test_type: Ordered Subselect detection throws ok");
280
281         # make sure ordered subselects *somewhat* work
282         {
283           my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
284           my $sealed_owners = $owners->as_subselect_rs;
285
286           is_deeply (
287             [ map { $_->name } ($sealed_owners->all) ],
288             [ map { $_->name } ($owners->all) ],
289             "$test_type: Sort preserved from within a subquery",
290           );
291         }
292
293         # still even with lost order of IN, we should be getting correct
294         # sets
295         {
296           my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
297           my $corelated_owners = $owners->result_source->resultset->search (
298             {
299               id => { -in => $owners->get_column('id')->as_query },
300             },
301             {
302               order_by => 'name' #reorder because of what is shown above
303             },
304           );
305
306           is (
307             join ("\x00", map { $_->name } ($corelated_owners->all) ),
308             join ("\x00", map { $_->name } ($owners->all) ),
309             "$test_type: With an outer order_by, everything still matches",
310           );
311         }
312
313         # make sure right-join-side single-prefetch ordering limit works
314         {
315           my $rs = $schema->resultset ('BooksInLibrary')->search (
316             {
317               'owner.name' => { '!=', 'woggle' },
318             },
319             {
320               prefetch => 'owner',
321               order_by => 'owner.name',
322             }
323           );
324           # this is the order in which they should come from the above query
325           my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
326
327           is ($rs->all, 8, "$test_type: Correct amount of objects from right-sorted joined resultset");
328           is_deeply (
329             [map { $_->owner->name } ($rs->all) ],
330             \@owner_names,
331             "$test_type: Prefetched rows were properly ordered"
332           );
333
334           my $limited_rs = $rs->search ({}, {rows => 6, offset => 2, unsafe_subselect_ok => 1});
335           is ($limited_rs->count, 6, "$test_type: Correct count of limited right-sorted joined resultset");
336           is ($limited_rs->count_rs->next, 6, "$test_type: Correct count_rs of limited right-sorted joined resultset");
337
338           my $queries;
339           my $orig_debug = $schema->storage->debug;
340           $schema->storage->debugcb(sub { $queries++; });
341           $schema->storage->debug(1);
342
343           is_deeply (
344             [map { $_->owner->name } ($limited_rs->all) ],
345             [@owner_names[2 .. 7]],
346             "$test_type: Prefetch-limited rows were properly ordered"
347           );
348           is ($queries, 1, "$test_type: Only one query with prefetch");
349
350           $schema->storage->debugcb(undef);
351           $schema->storage->debug($orig_debug);
352
353           is_deeply (
354             [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
355             [@owner_names[2 .. 7]],
356             "$test_type: Rows are still properly ordered after search_related",
357           );
358         }
359
360         # try a ->has_many direction with duplicates
361         my $owners = $schema->resultset ('Owners')->search (
362           {
363             'books.id' => { '!=', undef },
364             'me.name' => { '!=', 'somebogusstring' },
365           },
366           {
367             prefetch => 'books',
368             order_by => [ { -asc => \['name + ?', [ test => 'xxx' ]] }, 'me.id' ], # test bindvar propagation
369             group_by => [ map { "me.$_" } $schema->source('Owners')->columns ], # the literal order_by requires an explicit group_by
370             rows     => 3,  # 8 results total
371             unsafe_subselect_ok => 1,
372           },
373         );
374
375         is_same_sql_bind (
376           $owners->page(3)->as_query,
377           $dialect eq 'Top'
378             ? '(
379               SELECT TOP 2147483647 [me].[id], [me].[name],
380                                     [books].[id], [books].[source], [books].[owner], [books].[title], [books].[price]
381                 FROM (
382                   SELECT TOP 2147483647 [me].[id], [me].[name]
383                     FROM (
384                       SELECT TOP 3 [me].[id], [me].[name], [ORDER__BY__001]
385                         FROM (
386                           SELECT TOP 9 [me].[id], [me].[name], name + ? AS [ORDER__BY__001]
387                             FROM [owners] [me]
388                             LEFT JOIN [books] [books]
389                               ON [books].[owner] = [me].[id]
390                           WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
391                           GROUP BY [me].[id], [me].[name]
392                           ORDER BY name + ? ASC, [me].[id]
393                         ) [me]
394                       ORDER BY [ORDER__BY__001] DESC, [me].[id] DESC
395                     ) [me]
396                   ORDER BY [ORDER__BY__001] ASC, [me].[id]
397                 ) [me]
398                 LEFT JOIN [books] [books]
399                   ON [books].[owner] = [me].[id]
400               WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
401               ORDER BY name + ? ASC, [me].[id]
402             )'
403             : '(
404               SELECT TOP 2147483647 [me].[id], [me].[name],
405                                     [books].[id], [books].[source], [books].[owner], [books].[title], [books].[price]
406                 FROM (
407                   SELECT TOP 2147483647 [me].[id], [me].[name]
408                     FROM (
409                       SELECT [me].[id], [me].[name],
410                              ROW_NUMBER() OVER( ORDER BY [ORDER__BY__001] ASC, [me].[id] ) AS [rno__row__index]
411                         FROM (
412                           SELECT [me].[id], [me].[name], name + ? AS [ORDER__BY__001]
413                             FROM [owners] [me]
414                             LEFT JOIN [books] [books]
415                               ON [books].[owner] = [me].[id]
416                           WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
417                           GROUP BY [me].[id], [me].[name]
418                         ) [me]
419                     ) [me]
420                   WHERE [rno__row__index] >= ? AND [rno__row__index] <= ?
421                 ) [me]
422                 LEFT JOIN [books] [books]
423                   ON [books].[owner] = [me].[id]
424               WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
425               ORDER BY name + ? ASC, [me].[id]
426             )'
427           ,
428           [
429             [ { dbic_colname => 'test' }
430               => 'xxx' ],
431             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
432               => 'somebogusstring' ],
433
434             ($dialect eq 'Top'
435               ? [ { dbic_colname => 'test' } => 'xxx' ]  # the extra re-order bind
436               : ([ $OFFSET => 7 ], [ $TOTAL => 9 ]) # parameterised RNO
437             ),
438
439             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
440               => 'somebogusstring' ],
441             [ { dbic_colname => 'test' }
442               => 'xxx' ],
443           ],
444         ) if $quoted;
445
446         is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows");
447         is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count");
448
449         is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count");
450         {
451           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
452             if $dialect eq 'Top';
453           is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows");
454           is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs");
455         }
456
457
458         # try a ->belongs_to direction (no select collapse, group_by should work)
459         my $books = $schema->resultset ('BooksInLibrary')->search (
460           {
461             'owner.name' => [qw/wiggle woggle/],
462           },
463           {
464             distinct => 1,
465             having => \['1 = ?', [ test => 1 ] ], #test having propagation
466             prefetch => 'owner',
467             rows     => 2,  # 3 results total
468             order_by => [{ -desc => 'me.owner' }, 'me.id'],
469             unsafe_subselect_ok => 1,
470           },
471         );
472
473         is_same_sql_bind (
474           $books->page(3)->as_query,
475           $dialect eq 'Top'
476             ? '(
477               SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
478                                     [owner].[id], [owner].[name]
479                 FROM (
480                   SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
481                     FROM (
482                       SELECT TOP 2 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
483                         FROM (
484                           SELECT TOP 6 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
485                             FROM [books] [me]
486                             JOIN [owners] [owner]
487                               ON [owner].[id] = [me].[owner]
488                           WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
489                           GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
490                           HAVING 1 = ?
491                           ORDER BY [me].[owner] DESC, [me].[id]
492                         ) [me]
493                       ORDER BY [me].[owner] ASC, [me].[id] DESC
494                     ) [me]
495                   ORDER BY [me].[owner] DESC, [me].[id]
496                 ) [me]
497                 JOIN [owners] [owner]
498                   ON [owner].[id] = [me].[owner]
499               WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
500               ORDER BY [me].[owner] DESC, [me].[id]
501             )'
502             : '(
503               SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
504                                     [owner].[id], [owner].[name]
505                 FROM (
506                   SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
507                     FROM (
508                       SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
509                              ROW_NUMBER() OVER( ORDER BY [me].[owner] DESC, [me].[id] ) AS [rno__row__index]
510                         FROM (
511                           SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
512                             FROM [books] [me]
513                             JOIN [owners] [owner]
514                               ON [owner].[id] = [me].[owner]
515                           WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
516                           GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
517                           HAVING 1 = ?
518                         ) [me]
519                     ) [me]
520                   WHERE [rno__row__index] >= ? AND [rno__row__index] <= ?
521                 ) [me]
522                 JOIN [owners] [owner]
523                   ON [owner].[id] = [me].[owner]
524               WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
525               ORDER BY [me].[owner] DESC, [me].[id]
526             )'
527           ,
528           [
529             # inner
530             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
531               => 'wiggle' ],
532             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
533               => 'woggle' ],
534             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
535               => 'Library' ],
536             [ { dbic_colname => 'test' }
537               => '1' ],
538
539             # top(?)
540             $dialect eq 'Top'
541               ? ()
542               : ( [ $OFFSET => 5 ], [ $TOTAL => 6 ] )
543             ,
544
545             # outer
546             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
547               => 'wiggle' ],
548             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
549               => 'woggle' ],
550             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
551               => 'Library' ],
552           ],
553         ) if $quoted;
554
555         is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows");
556         is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count");
557
558         is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count");
559         {
560           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
561             if $dialect eq 'Top';
562           is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows");
563           is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs");
564         }
565       }
566     }
567
568
569 # test GUID columns
570     {
571       $schema->storage->dbh_do (sub {
572         my ($storage, $dbh) = @_;
573         eval { $dbh->do("DROP TABLE artist_guid") };
574         $dbh->do(<<'SQL');
575 CREATE TABLE artist_guid (
576    artistid UNIQUEIDENTIFIER NOT NULL,
577    name VARCHAR(100),
578    rank INT NOT NULL DEFAULT '13',
579    charfield CHAR(10) NULL,
580    a_guid UNIQUEIDENTIFIER,
581    primary key(artistid)
582 )
583 SQL
584       });
585
586       # start disconnected to make sure insert works on an un-reblessed storage
587       $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
588
589       my $row;
590       lives_ok {
591         $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
592       } 'created a row with a GUID';
593
594       ok(
595         eval { $row->artistid },
596         'row has GUID PK col populated',
597       );
598       diag $@ if $@;
599
600       ok(
601         eval { $row->a_guid },
602         'row has a GUID col with auto_nextval populated',
603       );
604       diag $@ if $@;
605
606       my $row_from_db = $schema->resultset('ArtistGUID')
607         ->search({ name => 'mtfnpy' })->first;
608
609       is $row_from_db->artistid, $row->artistid,
610         'PK GUID round trip';
611
612       is $row_from_db->a_guid, $row->a_guid,
613         'NON-PK GUID round trip';
614     }
615
616 # test MONEY type
617     {
618       $schema->storage->dbh_do (sub {
619         my ($storage, $dbh) = @_;
620         eval { $dbh->do("DROP TABLE money_test") };
621         $dbh->do(<<'SQL');
622 CREATE TABLE money_test (
623    id INT IDENTITY PRIMARY KEY,
624    amount MONEY NULL
625 )
626 SQL
627       });
628
629       {
630         my $freetds_and_dynamic_cursors = 1
631           if $opts_name eq 'use_dynamic_cursors' &&
632             $schema->storage->_using_freetds;
633
634         local $TODO =
635 'these tests fail on freetds with dynamic cursors for some reason'
636           if $freetds_and_dynamic_cursors;
637         local $ENV{DBIC_NULLABLE_KEY_NOWARN} = 1
638           if $freetds_and_dynamic_cursors;
639
640         my $rs = $schema->resultset('Money');
641         my $row;
642
643         lives_ok {
644           $row = $rs->create({ amount => 100 });
645         } 'inserted a money value';
646
647         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 100,
648           'money value round-trip');
649
650         lives_ok {
651           $row->update({ amount => 200 });
652         } 'updated a money value';
653
654         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 200,
655           'updated money value round-trip');
656
657         lives_ok {
658           $row->update({ amount => undef });
659         } 'updated a money value to NULL';
660
661         is try { $rs->find($row->id)->amount }, undef,
662           'updated money value to NULL round-trip';
663       }
664     }
665   }
666 }
667
668 done_testing;
669
670 # clean up our mess
671 END {
672   if (my $dbh = eval { $schema->storage->_dbh }) {
673     eval { $dbh->do("DROP TABLE $_") }
674       for qw/artist artist_guid money_test books owners/;
675   }
676   undef $schema;
677 }
678 # vim:sw=2 sts=2