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