Commit | Line | Data |
a964a928 |
1 | use strict; |
68de9438 |
2 | use warnings; |
d867eeda |
3 | no warnings 'uninitialized'; |
a964a928 |
4 | |
5 | use Test::More; |
e0b2344f |
6 | use Test::Exception; |
199fbc45 |
7 | use DBIx::Class::Optional::Dependencies (); |
a964a928 |
8 | use lib qw(t/lib); |
9 | use DBICTest; |
2baff5da |
10 | |
6d5679b2 |
11 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; |
12 | if (not ($dsn && $user)) { |
13 | plan skip_all => join ' ', |
14 | 'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test.', |
15 | 'Warning: This test drops and creates the tables:', |
16 | "'artist', 'money_test' and 'bindtype_test'", |
17 | ; |
18 | }; |
19 | |
199fbc45 |
20 | plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ase') |
21 | unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ase'); |
22 | |
d867eeda |
23 | my @storage_types = ( |
95787afe |
24 | 'DBI::Sybase::ASE', |
25 | 'DBI::Sybase::ASE::NoBindVars', |
d867eeda |
26 | ); |
5ce107ad |
27 | eval "require DBIx::Class::Storage::$_;" for @storage_types; |
95787afe |
28 | |
d867eeda |
29 | my $schema; |
30 | my $storage_idx = -1; |
31 | |
2c2bc4e5 |
32 | require DBICTest::Schema; |
d867eeda |
33 | sub get_schema { |
34 | DBICTest::Schema->connect($dsn, $user, $pass, { |
35 | on_connect_call => [ |
36 | [ blob_setup => log_on_update => 1 ], # this is a safer option |
37 | ], |
38 | }); |
39 | } |
40 | |
41 | my $ping_count = 0; |
42 | { |
95787afe |
43 | my $ping = DBIx::Class::Storage::DBI::Sybase::ASE->can('_ping'); |
44 | *DBIx::Class::Storage::DBI::Sybase::ASE::_ping = sub { |
d867eeda |
45 | $ping_count++; |
46 | goto $ping; |
47 | }; |
48 | } |
49 | |
50 | for my $storage_type (@storage_types) { |
51 | $storage_idx++; |
52 | |
95787afe |
53 | unless ($storage_type eq 'DBI::Sybase::ASE') { # autodetect |
d867eeda |
54 | DBICTest::Schema->storage_type("::$storage_type"); |
55 | } |
61cfaef7 |
56 | |
d867eeda |
57 | $schema = get_schema(); |
a964a928 |
58 | |
d867eeda |
59 | $schema->storage->ensure_connected; |
a964a928 |
60 | |
d867eeda |
61 | if ($storage_idx == 0 && |
95787afe |
62 | $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars')) { |
6d5679b2 |
63 | # no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS) |
64 | skip "Skipping entire test for $storage_type - no placeholder support", 1; |
d867eeda |
65 | next; |
66 | } |
5703eb14 |
67 | |
d867eeda |
68 | isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" ); |
6b1f5ef7 |
69 | |
d867eeda |
70 | $schema->storage->_dbh->disconnect; |
71 | lives_ok (sub { $schema->storage->dbh }, 'reconnect works'); |
64f4e691 |
72 | |
d867eeda |
73 | $schema->storage->dbh_do (sub { |
74 | my ($storage, $dbh) = @_; |
75 | eval { $dbh->do("DROP TABLE artist") }; |
76 | $dbh->do(<<'SQL'); |
a964a928 |
77 | CREATE TABLE artist ( |
d867eeda |
78 | artistid INT IDENTITY PRIMARY KEY, |
a964a928 |
79 | name VARCHAR(100), |
80 | rank INT DEFAULT 13 NOT NULL, |
d867eeda |
81 | charfield CHAR(10) NULL |
a964a928 |
82 | ) |
26283ee3 |
83 | SQL |
d867eeda |
84 | }); |
a964a928 |
85 | |
d867eeda |
86 | my %seen_id; |
a964a928 |
87 | |
d867eeda |
88 | # so we start unconnected |
89 | $schema->storage->disconnect; |
fcc2ec11 |
90 | |
26283ee3 |
91 | # test primary key handling |
d867eeda |
92 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
044f5b3e |
93 | like $new->artistid, qr/^\d+\z/, 'Auto-PK returned a number'; |
d867eeda |
94 | ok($new->artistid > 0, "Auto-PK worked"); |
fcc2ec11 |
95 | |
d867eeda |
96 | $seen_id{$new->artistid}++; |
fcc2ec11 |
97 | |
d867eeda |
98 | # check redispatch to storage-specific insert when auto-detected storage |
95787afe |
99 | if ($storage_type eq 'DBI::Sybase::ASE') { |
d867eeda |
100 | DBICTest::Schema->storage_type('::DBI'); |
101 | $schema = get_schema(); |
102 | } |
103 | |
104 | $new = $schema->resultset('Artist')->create({ name => 'Artist 1' }); |
105 | is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' ); |
106 | $seen_id{$new->artistid}++; |
107 | |
108 | # inserts happen in a txn, so we make sure it still works inside a txn too |
109 | $schema->txn_begin; |
110 | |
111 | for (2..6) { |
a964a928 |
112 | $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); |
113 | is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" ); |
114 | $seen_id{$new->artistid}++; |
d867eeda |
115 | } |
a964a928 |
116 | |
d867eeda |
117 | $schema->txn_commit; |
a964a928 |
118 | |
d867eeda |
119 | # test simple count |
120 | is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok'); |
121 | |
122 | # test LIMIT support |
123 | my $it = $schema->resultset('Artist')->search({ |
124 | artistid => { '>' => 0 } |
125 | }, { |
a0348159 |
126 | rows => 3, |
a0348159 |
127 | order_by => 'artistid', |
d867eeda |
128 | }); |
af9e4a5e |
129 | |
d867eeda |
130 | is( $it->count, 3, "LIMIT count ok" ); |
e19677ad |
131 | |
d867eeda |
132 | is( $it->next->name, "foo", "iterator->next ok" ); |
133 | $it->next; |
134 | is( $it->next->name, "Artist 2", "iterator->next ok" ); |
135 | is( $it->next, undef, "next past end of resultset ok" ); |
136 | |
137 | # now try with offset |
138 | $it = $schema->resultset('Artist')->search({}, { |
139 | rows => 3, |
140 | offset => 3, |
141 | order_by => 'artistid', |
142 | }); |
143 | |
144 | is( $it->count, 3, "LIMIT with offset count ok" ); |
145 | |
146 | is( $it->next->name, "Artist 3", "iterator->next ok" ); |
147 | $it->next; |
148 | is( $it->next->name, "Artist 5", "iterator->next ok" ); |
149 | is( $it->next, undef, "next past end of resultset ok" ); |
150 | |
151 | # now try a grouped count |
152 | $schema->resultset('Artist')->create({ name => 'Artist 6' }) |
153 | for (1..6); |
154 | |
155 | $it = $schema->resultset('Artist')->search({}, { |
156 | group_by => 'name' |
157 | }); |
158 | |
159 | is( $it->count, 7, 'COUNT of GROUP_BY ok' ); |
160 | |
2baff5da |
161 | # do an IDENTITY_INSERT |
d867eeda |
162 | { |
163 | no warnings 'redefine'; |
164 | |
165 | my @debug_out; |
166 | local $schema->storage->{debug} = 1; |
167 | local $schema->storage->debugobj->{callback} = sub { |
168 | push @debug_out, $_[1]; |
169 | }; |
170 | |
171 | my $txn_used = 0; |
172 | my $txn_commit = \&DBIx::Class::Storage::DBI::txn_commit; |
173 | local *DBIx::Class::Storage::DBI::txn_commit = sub { |
174 | $txn_used = 1; |
175 | goto &$txn_commit; |
176 | }; |
177 | |
178 | $schema->resultset('Artist') |
179 | ->create({ artistid => 999, name => 'mtfnpy' }); |
180 | |
2baff5da |
181 | ok((grep /IDENTITY_INSERT/i, @debug_out), 'IDENTITY_INSERT used'); |
d867eeda |
182 | |
183 | SKIP: { |
184 | skip 'not testing lack of txn on IDENTITY_INSERT with NoBindVars', 1 |
185 | if $storage_type =~ /NoBindVars/i; |
186 | |
187 | is $txn_used, 0, 'no txn on insert with IDENTITY_INSERT'; |
188 | } |
189 | } |
190 | |
2baff5da |
191 | # do an IDENTITY_UPDATE |
192 | { |
193 | my @debug_out; |
194 | local $schema->storage->{debug} = 1; |
195 | local $schema->storage->debugobj->{callback} = sub { |
196 | push @debug_out, $_[1]; |
197 | }; |
198 | |
199 | lives_and { |
200 | $schema->resultset('Artist') |
201 | ->find(999)->update({ artistid => 555 }); |
202 | ok((grep /IDENTITY_UPDATE/i, @debug_out)); |
203 | } 'IDENTITY_UPDATE used'; |
204 | $ping_count-- if $@; |
205 | } |
d867eeda |
206 | |
207 | my $bulk_rs = $schema->resultset('Artist')->search({ |
208 | name => { -like => 'bulk artist %' } |
209 | }); |
210 | |
2a6dda4b |
211 | # test _insert_bulk using populate. |
2baff5da |
212 | SKIP: { |
2a6dda4b |
213 | skip '_insert_bulk not supported', 4 |
d390bd3c |
214 | unless $storage_type !~ /NoBindVars/i; |
e06ad5d5 |
215 | |
2baff5da |
216 | lives_ok { |
217 | $schema->resultset('Artist')->populate([ |
218 | { |
219 | name => 'bulk artist 1', |
220 | charfield => 'foo', |
221 | }, |
222 | { |
223 | name => 'bulk artist 2', |
224 | charfield => 'foo', |
225 | }, |
226 | { |
227 | name => 'bulk artist 3', |
228 | charfield => 'foo', |
229 | }, |
230 | ]); |
2a6dda4b |
231 | } '_insert_bulk via populate'; |
2baff5da |
232 | |
2a6dda4b |
233 | is $bulk_rs->count, 3, 'correct number inserted via _insert_bulk'; |
2baff5da |
234 | |
235 | is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3, |
2a6dda4b |
236 | 'column set correctly via _insert_bulk'); |
2baff5da |
237 | |
238 | my %bulk_ids; |
239 | @bulk_ids{map $_->artistid, $bulk_rs->all} = (); |
240 | |
241 | is ((scalar keys %bulk_ids), 3, |
2a6dda4b |
242 | 'identities generated correctly in _insert_bulk'); |
2baff5da |
243 | |
244 | $bulk_rs->delete; |
245 | } |
e06ad5d5 |
246 | |
2a6dda4b |
247 | # make sure _insert_bulk works a second time on the same connection |
0a9a9955 |
248 | SKIP: { |
2a6dda4b |
249 | skip '_insert_bulk not supported', 3 |
d390bd3c |
250 | unless $storage_type !~ /NoBindVars/i; |
0a9a9955 |
251 | |
252 | lives_ok { |
253 | $schema->resultset('Artist')->populate([ |
254 | { |
255 | name => 'bulk artist 1', |
256 | charfield => 'bar', |
257 | }, |
258 | { |
259 | name => 'bulk artist 2', |
260 | charfield => 'bar', |
261 | }, |
262 | { |
263 | name => 'bulk artist 3', |
264 | charfield => 'bar', |
265 | }, |
266 | ]); |
2a6dda4b |
267 | } '_insert_bulk via populate called a second time'; |
0a9a9955 |
268 | |
269 | is $bulk_rs->count, 3, |
2a6dda4b |
270 | 'correct number inserted via _insert_bulk'; |
0a9a9955 |
271 | |
272 | is ((grep $_->charfield eq 'bar', $bulk_rs->all), 3, |
2a6dda4b |
273 | 'column set correctly via _insert_bulk'); |
0a9a9955 |
274 | |
275 | $bulk_rs->delete; |
276 | } |
277 | |
2a6dda4b |
278 | # test invalid _insert_bulk (missing required column) |
0a9a9955 |
279 | # |
2a6dda4b |
280 | # There should be a rollback, reconnect and the next valid _insert_bulk should |
0a9a9955 |
281 | # succeed. |
282 | throws_ok { |
283 | $schema->resultset('Artist')->populate([ |
284 | { |
285 | charfield => 'foo', |
286 | } |
287 | ]); |
288 | } qr/no value or default|does not allow null|placeholders/i, |
289 | # The second pattern is the error from fallback to regular array insert on |
290 | # incompatible charset. |
291 | # The third is for ::NoBindVars with no syb_has_blk. |
2a6dda4b |
292 | '_insert_bulk with missing required column throws error'; |
0a9a9955 |
293 | |
2a6dda4b |
294 | # now test _insert_bulk with IDENTITY_INSERT |
2baff5da |
295 | SKIP: { |
2a6dda4b |
296 | skip '_insert_bulk not supported', 3 |
d390bd3c |
297 | unless $storage_type !~ /NoBindVars/i; |
e19677ad |
298 | |
2baff5da |
299 | lives_ok { |
300 | $schema->resultset('Artist')->populate([ |
301 | { |
302 | artistid => 2001, |
303 | name => 'bulk artist 1', |
304 | charfield => 'foo', |
305 | }, |
306 | { |
307 | artistid => 2002, |
308 | name => 'bulk artist 2', |
309 | charfield => 'foo', |
310 | }, |
311 | { |
312 | artistid => 2003, |
313 | name => 'bulk artist 3', |
314 | charfield => 'foo', |
315 | }, |
316 | ]); |
2a6dda4b |
317 | } '_insert_bulk with IDENTITY_INSERT via populate'; |
2baff5da |
318 | |
319 | is $bulk_rs->count, 3, |
2a6dda4b |
320 | 'correct number inserted via _insert_bulk with IDENTITY_INSERT'; |
2baff5da |
321 | |
322 | is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3, |
2a6dda4b |
323 | 'column set correctly via _insert_bulk with IDENTITY_INSERT'); |
2baff5da |
324 | |
325 | $bulk_rs->delete; |
326 | } |
d867eeda |
327 | |
328 | # test correlated subquery |
329 | my $subq = $schema->resultset('Artist')->search({ artistid => { '>' => 3 } }) |
330 | ->get_column('artistid') |
331 | ->as_query; |
332 | my $subq_rs = $schema->resultset('Artist')->search({ |
333 | artistid => { -in => $subq } |
334 | }); |
335 | is $subq_rs->count, 11, 'correlated subquery'; |
336 | |
337 | # mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t |
338 | SKIP: { |
587daa97 |
339 | skip 'TEXT/IMAGE support does not work with FreeTDS', 22 |
aca3b4c3 |
340 | if $schema->storage->_using_freetds; |
d867eeda |
341 | |
342 | my $dbh = $schema->storage->_dbh; |
343 | { |
344 | local $SIG{__WARN__} = sub {}; |
345 | eval { $dbh->do('DROP TABLE bindtype_test') }; |
346 | |
347 | $dbh->do(qq[ |
8273e845 |
348 | CREATE TABLE bindtype_test |
d867eeda |
349 | ( |
f3a9ea3d |
350 | id INT IDENTITY PRIMARY KEY, |
351 | bytea IMAGE NULL, |
352 | blob IMAGE NULL, |
353 | clob TEXT NULL, |
354 | a_memo IMAGE NULL |
d867eeda |
355 | ) |
356 | ],{ RaiseError => 1, PrintError => 0 }); |
357 | } |
358 | |
359 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
360 | $binstr{'large'} = $binstr{'small'} x 1024; |
361 | |
362 | my $maxloblen = length $binstr{'large'}; |
8273e845 |
363 | |
aca3b4c3 |
364 | if (not $schema->storage->_using_freetds) { |
d867eeda |
365 | $dbh->{'LongReadLen'} = $maxloblen * 2; |
366 | } else { |
367 | $dbh->do("set textsize ".($maxloblen * 2)); |
368 | } |
369 | |
370 | my $rs = $schema->resultset('BindType'); |
371 | my $last_id; |
372 | |
373 | foreach my $type (qw(blob clob)) { |
374 | foreach my $size (qw(small large)) { |
375 | no warnings 'uninitialized'; |
376 | |
0a9a9955 |
377 | my $created; |
378 | lives_ok { |
379 | $created = $rs->create( { $type => $binstr{$size} } ) |
380 | } "inserted $size $type without dying"; |
d867eeda |
381 | |
382 | $last_id = $created->id if $created; |
383 | |
0a9a9955 |
384 | lives_and { |
385 | ok($rs->find($last_id)->$type eq $binstr{$size}) |
386 | } "verified inserted $size $type"; |
d867eeda |
387 | } |
388 | } |
389 | |
689819e1 |
390 | $rs->delete; |
391 | |
0a9a9955 |
392 | # blob insert with explicit PK |
393 | # also a good opportunity to test IDENTITY_INSERT |
394 | lives_ok { |
395 | $rs->create( { id => 1, blob => $binstr{large} } ) |
396 | } 'inserted large blob without dying with manual PK'; |
d867eeda |
397 | |
0a9a9955 |
398 | lives_and { |
399 | ok($rs->find(1)->blob eq $binstr{large}) |
400 | } 'verified inserted large blob with manual PK'; |
d867eeda |
401 | |
402 | # try a blob update |
403 | my $new_str = $binstr{large} . 'mtfnpy'; |
404 | |
405 | # check redispatch to storage-specific update when auto-detected storage |
95787afe |
406 | if ($storage_type eq 'DBI::Sybase::ASE') { |
d867eeda |
407 | DBICTest::Schema->storage_type('::DBI'); |
408 | $schema = get_schema(); |
409 | } |
410 | |
0a9a9955 |
411 | lives_ok { |
412 | $rs->search({ id => 1 })->update({ blob => $new_str }) |
413 | } 'updated blob successfully'; |
414 | |
415 | lives_and { |
416 | ok($rs->find(1)->blob eq $new_str) |
417 | } 'verified updated blob'; |
d867eeda |
418 | |
2baff5da |
419 | # try a blob update with IDENTITY_UPDATE |
420 | lives_and { |
421 | $new_str = $binstr{large} . 'hlagh'; |
422 | $rs->find(1)->update({ id => 999, blob => $new_str }); |
423 | ok($rs->find(999)->blob eq $new_str); |
424 | } 'verified updated blob with IDENTITY_UPDATE'; |
7ef97d26 |
425 | |
d867eeda |
426 | ## try multi-row blob update |
427 | # first insert some blobs |
d867eeda |
428 | $new_str = $binstr{large} . 'foo'; |
0a9a9955 |
429 | lives_and { |
430 | $rs->delete; |
431 | $rs->create({ blob => $binstr{large} }) for (1..2); |
432 | $rs->update({ blob => $new_str }); |
433 | is((grep $_->blob eq $new_str, $rs->all), 2); |
434 | } 'multi-row blob update'; |
435 | |
436 | $rs->delete; |
437 | |
2a6dda4b |
438 | # now try _insert_bulk with blobs and only blobs |
0a9a9955 |
439 | $new_str = $binstr{large} . 'bar'; |
440 | lives_ok { |
441 | $rs->populate([ |
442 | { |
0a9a9955 |
443 | blob => $binstr{large}, |
444 | clob => $new_str, |
445 | }, |
446 | { |
0a9a9955 |
447 | blob => $binstr{large}, |
448 | clob => $new_str, |
449 | }, |
450 | ]); |
2a6dda4b |
451 | } '_insert_bulk with blobs does not die'; |
0a9a9955 |
452 | |
453 | is((grep $_->blob eq $binstr{large}, $rs->all), 2, |
2a6dda4b |
454 | 'IMAGE column set correctly via _insert_bulk'); |
0a9a9955 |
455 | |
456 | is((grep $_->clob eq $new_str, $rs->all), 2, |
2a6dda4b |
457 | 'TEXT column set correctly via _insert_bulk'); |
2baff5da |
458 | |
2a6dda4b |
459 | # now try _insert_bulk with blobs and a non-blob which also happens to be an |
587daa97 |
460 | # identity column |
461 | SKIP: { |
2a6dda4b |
462 | skip 'no _insert_bulk without placeholders', 4 |
587daa97 |
463 | if $storage_type =~ /NoBindVars/i; |
464 | |
465 | $rs->delete; |
466 | $new_str = $binstr{large} . 'bar'; |
467 | lives_ok { |
468 | $rs->populate([ |
469 | { |
470 | id => 1, |
471 | bytea => 1, |
472 | blob => $binstr{large}, |
473 | clob => $new_str, |
f3a9ea3d |
474 | a_memo => 2, |
587daa97 |
475 | }, |
476 | { |
477 | id => 2, |
478 | bytea => 1, |
479 | blob => $binstr{large}, |
480 | clob => $new_str, |
f3a9ea3d |
481 | a_memo => 2, |
587daa97 |
482 | }, |
483 | ]); |
2a6dda4b |
484 | } '_insert_bulk with blobs and explicit identity does NOT die'; |
587daa97 |
485 | |
486 | is((grep $_->blob eq $binstr{large}, $rs->all), 2, |
2a6dda4b |
487 | 'IMAGE column set correctly via _insert_bulk with identity'); |
587daa97 |
488 | |
489 | is((grep $_->clob eq $new_str, $rs->all), 2, |
2a6dda4b |
490 | 'TEXT column set correctly via _insert_bulk with identity'); |
587daa97 |
491 | |
492 | is_deeply [ map $_->id, $rs->all ], [ 1,2 ], |
2a6dda4b |
493 | 'explicit identities set correctly via _insert_bulk with blobs'; |
587daa97 |
494 | } |
495 | |
d390bd3c |
496 | lives_and { |
497 | $rs->delete; |
498 | $rs->create({ blob => $binstr{large} }) for (1..2); |
499 | $rs->update({ blob => undef }); |
500 | is((grep !defined($_->blob), $rs->all), 2); |
501 | } 'blob update to NULL'; |
d867eeda |
502 | } |
503 | |
cd048330 |
504 | # test MONEY column support (and some other misc. stuff) |
d867eeda |
505 | $schema->storage->dbh_do (sub { |
506 | my ($storage, $dbh) = @_; |
507 | eval { $dbh->do("DROP TABLE money_test") }; |
508 | $dbh->do(<<'SQL'); |
509 | CREATE TABLE money_test ( |
510 | id INT IDENTITY PRIMARY KEY, |
cd048330 |
511 | amount MONEY DEFAULT $999.99 NULL |
d867eeda |
512 | ) |
513 | SQL |
514 | }); |
515 | |
cd048330 |
516 | my $rs = $schema->resultset('Money'); |
517 | |
518 | # test insert with defaults |
519 | lives_and { |
520 | $rs->create({}); |
521 | is((grep $_->amount == 999.99, $rs->all), 1); |
522 | } 'insert with all defaults works'; |
523 | $rs->delete; |
524 | |
d867eeda |
525 | # test insert transaction when there's an active cursor |
2baff5da |
526 | { |
d867eeda |
527 | my $artist_rs = $schema->resultset('Artist'); |
528 | $artist_rs->first; |
529 | lives_ok { |
530 | my $row = $schema->resultset('Money')->create({ amount => 100 }); |
531 | $row->delete; |
532 | } 'inserted a row with an active cursor'; |
533 | $ping_count-- if $@; # dbh_do calls ->connected |
534 | } |
535 | |
536 | # test insert in an outer transaction when there's an active cursor |
4ca1fd6f |
537 | { |
d867eeda |
538 | local $TODO = 'this should work once we have eager cursors'; |
539 | |
540 | # clear state, or we get a deadlock on $row->delete |
541 | # XXX figure out why this happens |
542 | $schema->storage->disconnect; |
543 | |
544 | lives_ok { |
545 | $schema->txn_do(sub { |
546 | my $artist_rs = $schema->resultset('Artist'); |
547 | $artist_rs->first; |
548 | my $row = $schema->resultset('Money')->create({ amount => 100 }); |
549 | $row->delete; |
550 | }); |
551 | } 'inserted a row with an active cursor in outer txn'; |
552 | $ping_count-- if $@; # dbh_do calls ->connected |
553 | } |
554 | |
555 | # Now test money values. |
d867eeda |
556 | my $row; |
557 | lives_ok { |
558 | $row = $rs->create({ amount => 100 }); |
559 | } 'inserted a money value'; |
560 | |
cdf7f026 |
561 | cmp_ok eval { $rs->find($row->id)->amount }, '==', 100, |
562 | 'money value round-trip'; |
d867eeda |
563 | |
564 | lives_ok { |
565 | $row->update({ amount => 200 }); |
566 | } 'updated a money value'; |
567 | |
cdf7f026 |
568 | cmp_ok eval { $rs->find($row->id)->amount }, '==', 200, |
569 | 'updated money value round-trip'; |
d867eeda |
570 | |
571 | lives_ok { |
572 | $row->update({ amount => undef }); |
573 | } 'updated a money value to NULL'; |
574 | |
46891041 |
575 | lives_and { |
ca507a2f |
576 | my $null_amount = $rs->find($row->id)->amount; |
46891041 |
577 | is $null_amount, undef; |
578 | } 'updated money value to NULL round-trip'; |
6469dabf |
579 | |
580 | # Test computed columns and timestamps |
581 | $schema->storage->dbh_do (sub { |
582 | my ($storage, $dbh) = @_; |
583 | eval { $dbh->do("DROP TABLE computed_column_test") }; |
584 | $dbh->do(<<'SQL'); |
585 | CREATE TABLE computed_column_test ( |
586 | id INT IDENTITY PRIMARY KEY, |
587 | a_computed_column AS getdate(), |
588 | a_timestamp timestamp, |
8273e845 |
589 | charfield VARCHAR(20) DEFAULT 'foo' |
6469dabf |
590 | ) |
591 | SQL |
592 | }); |
593 | |
594 | require DBICTest::Schema::ComputedColumn; |
595 | $schema->register_class( |
596 | ComputedColumn => 'DBICTest::Schema::ComputedColumn' |
597 | ); |
598 | |
599 | ok (($rs = $schema->resultset('ComputedColumn')), |
600 | 'got rs for ComputedColumn'); |
601 | |
602 | lives_ok { $row = $rs->create({}) } |
603 | 'empty insert for a table with computed columns survived'; |
604 | |
605 | lives_ok { |
606 | $row->update({ charfield => 'bar' }) |
607 | } 'update of a table with computed columns survived'; |
d867eeda |
608 | } |
609 | |
610 | is $ping_count, 0, 'no pings'; |
f1358489 |
611 | |
72933b15 |
612 | # if tests passed and did so under a non-C lang - let's rerun the test |
613 | if (Test::Builder->new->is_passing and $ENV{LANG} and $ENV{LANG} ne 'C') { |
614 | my $oldlang = $ENV{LANG}; |
615 | local $ENV{LANG} = 'C'; |
616 | |
617 | pass ("Your lang is set to $oldlang - retesting with C"); |
618 | |
f3ec358e |
619 | local $ENV{PATH}; |
620 | my @cmd = map { $_ =~ /(.+)/ } ($^X, __FILE__); |
72933b15 |
621 | |
622 | # this is cheating, and may even hang here and there (testing on windows passed fine) |
623 | # will be replaced with Test::SubExec::Noninteractive in due course |
624 | require IPC::Open2; |
625 | IPC::Open2::open2(my $out, undef, @cmd); |
626 | while (my $ln = <$out>) { |
627 | print " $ln"; |
628 | } |
629 | |
630 | wait; |
631 | ok (! $?, "Wstat $? from: @cmd"); |
632 | } |
633 | |
6d5679b2 |
634 | done_testing; |
635 | |
a964a928 |
636 | # clean up our mess |
637 | END { |
d867eeda |
638 | if (my $dbh = eval { $schema->storage->_dbh }) { |
639 | eval { $dbh->do("DROP TABLE $_") } |
6469dabf |
640 | for qw/artist bindtype_test money_test computed_column_test/; |
d867eeda |
641 | } |
65d35121 |
642 | |
643 | undef $schema; |
a964a928 |
644 | } |