Commit | Line | Data |
fd1182b6 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
4 | |
5 | # XXX obviously, the guts of this test haven't been written yet --blblack |
6 | |
7 | use lib qw(t/lib); |
8 | |
9 | plan skip_all => 'Set $ENV{DBICTEST_STORAGE_STRESS} to run this test' |
10 | . ' (it is very resource intensive!)' |
11 | unless $ENV{DBICTEST_STORAGE_STRESS}; |
12 | |
13 | my $NKIDS = 20; |
14 | my $CYCLES = 5; |
15 | my @KILL_RATES = qw/0 0.001 0.01 0.1 0.2 0.5 0.75 1.0/; |
16 | |
17 | # Stress the storage with these parameters... |
18 | sub stress_storage { |
19 | my ($connect_info, $num_kids, $cycles, $kill_rate) = @_; |
20 | |
21 | foreach my $cycle (1..$cycles) { |
22 | my $schema = DBICTest::Schema->connection(@$connect_info, { AutoCommit => 1 }); |
23 | foreach my $kidno (1..$num_kids) { |
24 | ok(1); |
25 | } |
26 | } |
27 | } |
28 | |
29 | # Get a set of connection information - |
30 | # whatever the user has supplied for the vendor-specific tests |
31 | sub get_connect_infos { |
32 | my @connect_infos; |
33 | foreach my $db_prefix (qw/PG MYSQL DB2 MSSQL ORA/) { |
34 | my @conn_info = @ENV{ |
35 | map { "DBICTEST_${db_prefix}_${_}" } qw/DSN USER PASS/ |
36 | }; |
37 | push(@connect_infos, \@conn_info) if $conn_info[0]; |
38 | } |
39 | \@connect_infos; |
40 | } |
41 | |
42 | my $connect_infos = get_connect_infos(); |
43 | |
44 | plan skip_all => 'This test needs some non-sqlite connect info!' |
45 | unless @$connect_infos; |
46 | |
47 | plan tests => (1 * @$connect_infos * $NKIDS * $CYCLES * @KILL_RATES) + 1; |
48 | |
49 | use_ok('DBICTest::Schema'); |
50 | |
51 | foreach my $connect_info (@$connect_infos) { |
52 | foreach my $kill_rate (@KILL_RATES) { |
53 | stress_storage($connect_info, $NKIDS, $CYCLES, $kill_rate); |
54 | } |
55 | } |