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