Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
cb551b07 |
2 | use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mssql_odbc'; |
3 | |
c1cac633 |
4 | use strict; |
b9a2c3a5 |
5 | use warnings; |
c1cac633 |
6 | |
7 | use Test::More; |
893403c8 |
8 | use Test::Exception; |
d3a2e424 |
9 | use Test::Warn; |
5e724964 |
10 | |
c1cac633 |
11 | use DBICTest; |
e2741c7f |
12 | use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); |
fcb7fcbb |
13 | |
c1cac633 |
14 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; |
15 | |
77c7628c |
16 | { |
17 | my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version}; |
18 | ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') ); |
19 | } |
20 | |
ca791b95 |
21 | DBICTest::Schema->load_classes('ArtistGUID'); |
42e5b103 |
22 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
c1cac633 |
23 | |
8c0104fe |
24 | { |
25 | no warnings 'redefine'; |
26 | my $connect_count = 0; |
27 | my $orig_connect = \&DBI::connect; |
28 | local *DBI::connect = sub { $connect_count++; goto &$orig_connect }; |
29 | |
30 | $schema->storage->ensure_connected; |
31 | |
32 | is( $connect_count, 1, 'only one connection made'); |
33 | } |
9b3e916d |
34 | |
c1cac633 |
35 | isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' ); |
36 | |
cf89555e |
37 | { |
a9ee4be9 |
38 | my $schema2 = $schema->connect (@{$schema->storage->connect_info}); |
cf89555e |
39 | ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected'); |
40 | } |
ecdf1ac8 |
41 | $schema->storage->_dbh->disconnect; |
42 | |
43 | lives_ok { |
44 | $schema->storage->dbh_do(sub { $_[1]->do('select 1') }) |
45 | } '_ping works'; |
46 | |
384b8bce |
47 | my %opts = ( |
48 | use_mars => |
9ffaf8a3 |
49 | { opts => { on_connect_call => 'use_mars' } }, |
384b8bce |
50 | use_dynamic_cursors => |
25d3127d |
51 | { opts => { on_connect_call => 'use_dynamic_cursors' }, |
aca3b4c3 |
52 | required => $schema->storage->_using_freetds ? 0 : 1, |
25d3127d |
53 | }, |
384b8bce |
54 | use_server_cursors => |
9ffaf8a3 |
55 | { opts => { on_connect_call => 'use_server_cursors' } }, |
94f9fbef |
56 | plain => |
9ffaf8a3 |
57 | { opts => {}, required => 1 }, |
384b8bce |
58 | ); |
59 | |
60 | for my $opts_name (keys %opts) { |
61 | SKIP: { |
9ffaf8a3 |
62 | my $opts = $opts{$opts_name}{opts}; |
384b8bce |
63 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
64 | |
e2741c7f |
65 | dbic_internal_try { |
384b8bce |
66 | $schema->storage->ensure_connected |
67 | } |
e2741c7f |
68 | dbic_internal_catch { |
9ffaf8a3 |
69 | if ($opts{$opts_name}{required}) { |
e81b50f4 |
70 | die "on_connect_call option '$opts_name' is not functional: $_"; |
9ffaf8a3 |
71 | } |
72 | else { |
73 | skip |
94f9fbef |
74 | "on_connect_call option '$opts_name' not functional in this configuration: $_", |
75 | 1 |
76 | ; |
9ffaf8a3 |
77 | } |
384b8bce |
78 | }; |
79 | |
e56b1c2d |
80 | $schema->storage->dbh_do (sub { |
81 | my ($storage, $dbh) = @_; |
82 | eval { $dbh->do("DROP TABLE artist") }; |
83 | $dbh->do(<<'SQL'); |
c1cac633 |
84 | CREATE TABLE artist ( |
85 | artistid INT IDENTITY NOT NULL, |
a0dd8679 |
86 | name VARCHAR(100), |
39da2a2b |
87 | rank INT NOT NULL DEFAULT '13', |
2eebd801 |
88 | charfield CHAR(10) NULL, |
c1cac633 |
89 | primary key(artistid) |
90 | ) |
c5f77f6c |
91 | SQL |
e56b1c2d |
92 | }); |
c5f77f6c |
93 | |
384b8bce |
94 | # test Auto-PK |
95 | $schema->resultset('Artist')->search({ name => 'foo' })->delete; |
c1cac633 |
96 | |
384b8bce |
97 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
7b1b2582 |
98 | |
384b8bce |
99 | ok(($new->artistid||0) > 0, "Auto-PK worked for $opts_name"); |
7b1b2582 |
100 | |
d3a2e424 |
101 | # Test graceful error handling if not supporting multiple active statements |
102 | if( $opts_name eq 'plain' ) { |
103 | |
104 | # keep the first cursor alive (as long as $rs is alive) |
105 | my $rs = $schema->resultset("Artist"); |
106 | |
107 | my $a1 = $rs->next; |
108 | |
109 | my $a2; |
110 | |
111 | warnings_are { |
112 | # second cursor, invalidates $rs, but it doesn't |
113 | # matter as long as we do not try to use it |
114 | $a2 = $schema->resultset("Artist")->next; |
115 | } [], 'No warning on retry due to previous cursor invalidation'; |
41dd5d30 |
116 | |
d3a2e424 |
117 | is_deeply( |
118 | { $a1->get_columns }, |
119 | { $a2->get_columns }, |
120 | 'Same data', |
121 | ); |
122 | |
123 | dies_ok { |
124 | $rs->next; |
125 | } 'Invalid cursor did not silently return garbage'; |
126 | } |
127 | |
128 | # Test multiple active statements |
129 | else { |
94f9fbef |
130 | $schema->storage->ensure_connected; |
41dd5d30 |
131 | |
94f9fbef |
132 | lives_ok { |
c1cac633 |
133 | |
94f9fbef |
134 | no warnings 'redefine'; |
135 | local *DBI::connect = sub { die "NO RECONNECTS!!!" }; |
ca791b95 |
136 | |
94f9fbef |
137 | my $artist_rs = $schema->resultset('Artist'); |
384b8bce |
138 | |
94f9fbef |
139 | $artist_rs->delete; |
384b8bce |
140 | |
94f9fbef |
141 | $artist_rs->create({ name => "Artist$_" }) for (1..3); |
142 | |
143 | my $forward = $artist_rs->search({}, |
144 | { order_by => { -asc => 'artistid' } }); |
145 | my $backward = $artist_rs->search({}, |
146 | { order_by => { -desc => 'artistid' } }); |
147 | |
148 | my @map = ( |
149 | [qw/Artist1 Artist3/], [qw/Artist2 Artist2/], [qw/Artist3 Artist1/] |
150 | ); |
151 | my @result; |
152 | |
153 | while (my $forward_row = $forward->next) { |
154 | my $backward_row = $backward->next; |
155 | push @result, [$forward_row->name, $backward_row->name]; |
156 | } |
384b8bce |
157 | |
94f9fbef |
158 | is_deeply \@result, \@map, "multiple active statements in $opts_name"; |
384b8bce |
159 | |
94f9fbef |
160 | $artist_rs->delete; |
25d3127d |
161 | |
94f9fbef |
162 | is($artist_rs->count, 0, '$dbh still viable'); |
163 | } "Multiple active statements survive $opts_name"; |
384b8bce |
164 | } |
ca791b95 |
165 | |
a54bd479 |
166 | # Test populate |
f6b185e1 |
167 | |
e56b1c2d |
168 | { |
169 | $schema->storage->dbh_do (sub { |
170 | my ($storage, $dbh) = @_; |
171 | eval { $dbh->do("DROP TABLE owners") }; |
172 | eval { $dbh->do("DROP TABLE books") }; |
173 | $dbh->do(<<'SQL'); |
02495deb |
174 | CREATE TABLE books ( |
b9a2c3a5 |
175 | id INT IDENTITY (1, 1) NOT NULL, |
176 | source VARCHAR(100), |
177 | owner INT, |
178 | title VARCHAR(10), |
179 | price INT NULL |
180 | ) |
181 | |
02495deb |
182 | CREATE TABLE owners ( |
b9a2c3a5 |
183 | id INT IDENTITY (1, 1) NOT NULL, |
42e5b103 |
184 | name VARCHAR(100), |
b9a2c3a5 |
185 | ) |
b9a2c3a5 |
186 | SQL |
a54bd479 |
187 | }); |
188 | |
e56b1c2d |
189 | lives_ok ( sub { |
190 | # start a new connection, make sure rebless works |
191 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
192 | $schema->populate ('Owners', [ |
193 | [qw/id name /], |
194 | [qw/1 wiggle/], |
195 | [qw/2 woggle/], |
196 | [qw/3 boggle/], |
197 | [qw/4 fRIOUX/], |
198 | [qw/5 fRUE/], |
199 | [qw/6 fREW/], |
200 | [qw/7 fROOH/], |
201 | [qw/8 fISMBoC/], |
202 | [qw/9 station/], |
203 | [qw/10 mirror/], |
204 | [qw/11 dimly/], |
205 | [qw/12 face_to_face/], |
206 | [qw/13 icarus/], |
207 | [qw/14 dream/], |
208 | [qw/15 dyrstyggyr/], |
209 | ]); |
210 | }, 'populate with PKs supplied ok' ); |
211 | |
212 | |
213 | lives_ok (sub { |
214 | # start a new connection, make sure rebless works |
215 | # test an insert with a supplied identity, followed by one without |
216 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
217 | for (2, 1) { |
218 | my $id = $_ * 20 ; |
219 | $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" }); |
220 | $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) }); |
221 | } |
222 | }, 'create with/without PKs ok' ); |
223 | |
224 | is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' ); |
225 | |
226 | lives_ok ( sub { |
227 | # start a new connection, make sure rebless works |
228 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
229 | $schema->populate ('BooksInLibrary', [ |
230 | [qw/source owner title /], |
231 | [qw/Library 1 secrets0/], |
232 | [qw/Library 1 secrets1/], |
233 | [qw/Eatery 1 secrets2/], |
234 | [qw/Library 2 secrets3/], |
235 | [qw/Library 3 secrets4/], |
236 | [qw/Eatery 3 secrets5/], |
237 | [qw/Library 4 secrets6/], |
238 | [qw/Library 5 secrets7/], |
239 | [qw/Eatery 5 secrets8/], |
240 | [qw/Library 6 secrets9/], |
241 | [qw/Library 7 secrets10/], |
242 | [qw/Eatery 7 secrets11/], |
243 | [qw/Library 8 secrets12/], |
244 | ]); |
245 | }, 'populate without PKs supplied ok' ); |
a54bd479 |
246 | } |
fb7cd45f |
247 | |
e56b1c2d |
248 | # test simple, complex LIMIT and limited prefetch support, with both dialects and quote combinations (if possible) |
249 | for my $dialect ( |
250 | 'Top', |
251 | ($schema->storage->_server_info->{normalized_dbms_version} || 0 ) >= 9 |
252 | ? ('RowNumberOver') |
253 | : () |
254 | , |
255 | ) { |
256 | for my $quoted (0, 1) { |
257 | |
258 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, { |
259 | limit_dialect => $dialect, |
260 | %$opts, |
261 | $quoted |
262 | ? ( quote_char => [ qw/ [ ] / ], name_sep => '.' ) |
263 | : () |
264 | , |
265 | }); |
266 | |
267 | my $test_type = "Dialect:$dialect Quoted:$quoted"; |
268 | |
269 | # basic limit support |
4ca1fd6f |
270 | { |
e56b1c2d |
271 | my $art_rs = $schema->resultset ('Artist'); |
272 | $art_rs->delete; |
273 | $art_rs->create({ name => 'Artist ' . $_ }) for (1..6); |
274 | |
275 | my $it = $schema->resultset('Artist')->search( {}, { |
276 | rows => 4, |
277 | offset => 3, |
278 | order_by => 'artistid', |
279 | }); |
280 | |
281 | is( $it->count, 3, "$test_type: LIMIT count ok" ); |
282 | |
283 | local $TODO = "Top-limit does not work when your limit ends up past the resultset" |
284 | if $dialect eq 'Top'; |
285 | |
286 | is( $it->next->name, 'Artist 4', "$test_type: iterator->next ok" ); |
287 | $it->next; |
288 | is( $it->next->name, 'Artist 6', "$test_type: iterator->next ok" ); |
289 | is( $it->next, undef, "$test_type: next past end of resultset ok" ); |
290 | } |
f0bd60fc |
291 | |
e56b1c2d |
292 | # plain ordered subqueries throw |
293 | throws_ok (sub { |
294 | $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query |
295 | }, qr/ordered subselect encountered/, "$test_type: Ordered Subselect detection throws ok"); |
a54bd479 |
296 | |
e56b1c2d |
297 | # make sure ordered subselects *somewhat* work |
298 | { |
299 | my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 }); |
300 | my $sealed_owners = $owners->as_subselect_rs; |
301 | |
302 | is_deeply ( |
1b658919 |
303 | [ sort map { $_->name } ($sealed_owners->all) ], |
304 | [ sort map { $_->name } ($owners->all) ], |
e56b1c2d |
305 | "$test_type: Sort preserved from within a subquery", |
306 | ); |
307 | } |
a54bd479 |
308 | |
e56b1c2d |
309 | # still even with lost order of IN, we should be getting correct |
310 | # sets |
311 | { |
312 | my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 }); |
313 | my $corelated_owners = $owners->result_source->resultset->search ( |
314 | { |
315 | id => { -in => $owners->get_column('id')->as_query }, |
316 | }, |
317 | { |
318 | order_by => 'name' #reorder because of what is shown above |
319 | }, |
320 | ); |
321 | |
322 | is ( |
323 | join ("\x00", map { $_->name } ($corelated_owners->all) ), |
324 | join ("\x00", map { $_->name } ($owners->all) ), |
325 | "$test_type: With an outer order_by, everything still matches", |
326 | ); |
327 | } |
a54bd479 |
328 | |
e56b1c2d |
329 | # make sure right-join-side single-prefetch ordering limit works |
330 | { |
331 | my $rs = $schema->resultset ('BooksInLibrary')->search ( |
332 | { |
333 | 'owner.name' => { '!=', 'woggle' }, |
334 | }, |
335 | { |
336 | prefetch => 'owner', |
337 | order_by => 'owner.name', |
338 | } |
339 | ); |
340 | # this is the order in which they should come from the above query |
341 | my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/; |
342 | |
343 | is ($rs->all, 8, "$test_type: Correct amount of objects from right-sorted joined resultset"); |
344 | is_deeply ( |
345 | [map { $_->owner->name } ($rs->all) ], |
346 | \@owner_names, |
347 | "$test_type: Prefetched rows were properly ordered" |
348 | ); |
349 | |
350 | my $limited_rs = $rs->search ({}, {rows => 6, offset => 2, unsafe_subselect_ok => 1}); |
351 | is ($limited_rs->count, 6, "$test_type: Correct count of limited right-sorted joined resultset"); |
352 | is ($limited_rs->count_rs->next, 6, "$test_type: Correct count_rs of limited right-sorted joined resultset"); |
353 | |
49eeb48d |
354 | $schema->is_executed_querycount( sub { |
355 | is_deeply ( |
356 | [map { $_->owner->name } ($limited_rs->all) ], |
357 | [@owner_names[2 .. 7]], |
358 | "$test_type: Prefetch-limited rows were properly ordered" |
359 | ); |
360 | }, 1, "$test_type: Only one query with prefetch" ); |
e56b1c2d |
361 | |
362 | is_deeply ( |
363 | [map { $_->name } ($limited_rs->search_related ('owner')->all) ], |
364 | [@owner_names[2 .. 7]], |
365 | "$test_type: Rows are still properly ordered after search_related", |
366 | ); |
367 | } |
a54bd479 |
368 | |
e56b1c2d |
369 | # try a ->has_many direction with duplicates |
370 | my $owners = $schema->resultset ('Owners')->search ( |
371 | { |
372 | 'books.id' => { '!=', undef }, |
373 | 'me.name' => { '!=', 'somebogusstring' }, |
374 | }, |
375 | { |
376 | prefetch => 'books', |
86bb5a27 |
377 | order_by => [ { -asc => \['name + ?', [ test => 'xxx' ]] }, 'me.id' ], # test bindvar propagation |
e56b1c2d |
378 | group_by => [ map { "me.$_" } $schema->source('Owners')->columns ], # the literal order_by requires an explicit group_by |
379 | rows => 3, # 8 results total |
380 | unsafe_subselect_ok => 1, |
381 | }, |
382 | ); |
a54bd479 |
383 | |
e56b1c2d |
384 | is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows"); |
385 | is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count"); |
a54bd479 |
386 | |
e56b1c2d |
387 | is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count"); |
4ca1fd6f |
388 | { |
e56b1c2d |
389 | local $TODO = "Top-limit does not work when your limit ends up past the resultset" |
390 | if $dialect eq 'Top'; |
391 | is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows"); |
392 | is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs"); |
a54bd479 |
393 | } |
a54bd479 |
394 | |
a54bd479 |
395 | |
e56b1c2d |
396 | # try a ->belongs_to direction (no select collapse, group_by should work) |
397 | my $books = $schema->resultset ('BooksInLibrary')->search ( |
398 | { |
399 | 'owner.name' => [qw/wiggle woggle/], |
400 | }, |
401 | { |
402 | distinct => 1, |
403 | having => \['1 = ?', [ test => 1 ] ], #test having propagation |
404 | prefetch => 'owner', |
405 | rows => 2, # 3 results total |
86bb5a27 |
406 | order_by => [{ -desc => 'me.owner' }, 'me.id'], |
e56b1c2d |
407 | unsafe_subselect_ok => 1, |
408 | }, |
409 | ); |
6de07ea3 |
410 | |
e56b1c2d |
411 | is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows"); |
412 | is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count"); |
a54bd479 |
413 | |
e56b1c2d |
414 | is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count"); |
4ca1fd6f |
415 | { |
e56b1c2d |
416 | local $TODO = "Top-limit does not work when your limit ends up past the resultset" |
417 | if $dialect eq 'Top'; |
418 | is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows"); |
419 | is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs"); |
420 | } |
421 | } |
a54bd479 |
422 | } |
6de07ea3 |
423 | |
424 | |
a54bd479 |
425 | # test GUID columns |
e56b1c2d |
426 | { |
427 | $schema->storage->dbh_do (sub { |
428 | my ($storage, $dbh) = @_; |
429 | eval { $dbh->do("DROP TABLE artist_guid") }; |
430 | $dbh->do(<<'SQL'); |
b1bdb76d |
431 | CREATE TABLE artist_guid ( |
a54bd479 |
432 | artistid UNIQUEIDENTIFIER NOT NULL, |
433 | name VARCHAR(100), |
434 | rank INT NOT NULL DEFAULT '13', |
435 | charfield CHAR(10) NULL, |
436 | a_guid UNIQUEIDENTIFIER, |
437 | primary key(artistid) |
438 | ) |
439 | SQL |
e56b1c2d |
440 | }); |
8ff60918 |
441 | |
e56b1c2d |
442 | # start disconnected to make sure insert works on an un-reblessed storage |
443 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
8ff60918 |
444 | |
e56b1c2d |
445 | my $row; |
446 | lives_ok { |
447 | $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' }) |
448 | } 'created a row with a GUID'; |
8ff60918 |
449 | |
e56b1c2d |
450 | ok( |
451 | eval { $row->artistid }, |
452 | 'row has GUID PK col populated', |
453 | ); |
454 | diag $@ if $@; |
8ff60918 |
455 | |
e56b1c2d |
456 | ok( |
457 | eval { $row->a_guid }, |
458 | 'row has a GUID col with auto_nextval populated', |
459 | ); |
460 | diag $@ if $@; |
8ff60918 |
461 | |
e56b1c2d |
462 | my $row_from_db = $schema->resultset('ArtistGUID') |
463 | ->search({ name => 'mtfnpy' })->first; |
f0bd60fc |
464 | |
e56b1c2d |
465 | is $row_from_db->artistid, $row->artistid, |
466 | 'PK GUID round trip'; |
b9a2c3a5 |
467 | |
e56b1c2d |
468 | is $row_from_db->a_guid, $row->a_guid, |
469 | 'NON-PK GUID round trip'; |
470 | } |
02d133f0 |
471 | |
a54bd479 |
472 | # test MONEY type |
e56b1c2d |
473 | { |
474 | $schema->storage->dbh_do (sub { |
475 | my ($storage, $dbh) = @_; |
476 | eval { $dbh->do("DROP TABLE money_test") }; |
477 | $dbh->do(<<'SQL'); |
a54bd479 |
478 | CREATE TABLE money_test ( |
479 | id INT IDENTITY PRIMARY KEY, |
480 | amount MONEY NULL |
481 | ) |
482 | SQL |
e56b1c2d |
483 | }); |
9010bab8 |
484 | |
4ca1fd6f |
485 | { |
35af31a1 |
486 | my $freetds_and_dynamic_cursors = 1 |
487 | if $opts_name eq 'use_dynamic_cursors' && |
aca3b4c3 |
488 | $schema->storage->_using_freetds; |
35af31a1 |
489 | |
8273e845 |
490 | local $TODO = |
9ffaf8a3 |
491 | 'these tests fail on freetds with dynamic cursors for some reason' |
35af31a1 |
492 | if $freetds_and_dynamic_cursors; |
493 | local $ENV{DBIC_NULLABLE_KEY_NOWARN} = 1 |
494 | if $freetds_and_dynamic_cursors; |
56d2561e |
495 | |
9ffaf8a3 |
496 | my $rs = $schema->resultset('Money'); |
497 | my $row; |
6bc666a5 |
498 | |
9ffaf8a3 |
499 | lives_ok { |
500 | $row = $rs->create({ amount => 100 }); |
501 | } 'inserted a money value'; |
b9a2c3a5 |
502 | |
e2741c7f |
503 | cmp_ok ( |
504 | ( eval { $rs->find($row->id)->amount } ) || 0, |
505 | '==', |
506 | 100, |
507 | 'money value round-trip' |
508 | ); |
fc85215b |
509 | |
9ffaf8a3 |
510 | lives_ok { |
511 | $row->update({ amount => 200 }); |
512 | } 'updated a money value'; |
b1e1d073 |
513 | |
e2741c7f |
514 | cmp_ok ( |
515 | ( eval { $rs->find($row->id)->amount } ) || 0, |
516 | '==', |
517 | 200, |
518 | 'updated money value round-trip' |
519 | ); |
b1e1d073 |
520 | |
9ffaf8a3 |
521 | lives_ok { |
522 | $row->update({ amount => undef }); |
523 | } 'updated a money value to NULL'; |
524 | |
e2741c7f |
525 | lives_ok { |
526 | is( |
527 | $rs->find($row->id)->amount, |
528 | undef, |
529 | 'updated money value to NULL round-trip' |
530 | ); |
531 | } |
9ffaf8a3 |
532 | } |
e56b1c2d |
533 | } |
7305f6f9 |
534 | |
535 | # Test leakage of PK on implicit retrieval |
536 | { |
537 | |
538 | my $next_owner = $schema->resultset('Owners')->get_column('id')->max + 1; |
539 | my $next_book = $schema->resultset('BooksInLibrary')->get_column('id')->max + 1; |
540 | |
541 | cmp_ok( |
542 | $next_owner, |
543 | '!=', |
544 | $next_book, |
545 | 'Preexisting auto-inc PKs staggered' |
546 | ); |
547 | |
548 | my $yet_another_owner = $schema->resultset('Owners')->create({ name => 'YAO' }); |
549 | my $yet_another_book; |
550 | warnings_exist { |
551 | $yet_another_book = $yet_another_owner->create_related( books => { title => 'YAB' }) |
552 | } qr/Missing value for primary key column 'id' on BooksInLibrary - perhaps you forgot to set its 'is_auto_increment'/; |
553 | |
554 | is( |
555 | $yet_another_owner->id, |
556 | $next_owner, |
557 | 'Expected Owner id' |
558 | ); |
559 | |
560 | is( |
561 | $yet_another_book->id, |
562 | $next_book, |
563 | 'Expected Book id' |
564 | ); |
565 | } |
e56b1c2d |
566 | } |
384b8bce |
567 | } |
c1cac633 |
568 | |
afcfff01 |
569 | done_testing; |
570 | |
c1cac633 |
571 | # clean up our mess |
572 | END { |
ca791b95 |
573 | if (my $dbh = eval { $schema->storage->_dbh }) { |
574 | eval { $dbh->do("DROP TABLE $_") } |
b1bdb76d |
575 | for qw/artist artist_guid money_test books owners/; |
ca791b95 |
576 | } |
65d35121 |
577 | undef $schema; |
c1cac633 |
578 | } |
fc85215b |
579 | # vim:sw=2 sts=2 |