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