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