view release on metacpan or  search on metacpan

t/1010_fixes.t  view on Meta::CPAN

######################################################################
#
# Tests for three bug fixes:
#
#   Fix 1: CHECK constraint is now evaluated on UPDATE (not INSERT only)
#   Fix 2: Index used for AND two-sided range and BETWEEN queries
#   Fix 3: fetchrow_arrayref / NAME reflect SELECT column order
#
# All tests use Perl 5.005_03-compatible syntax (no 'our', no say,
# no given/when, no //, no qr with modifiers unavailable in 5.005).
#
######################################################################

use strict;
BEGIN { $INC{'warnings.pm'} = '' if $] < 5.006 }; use warnings; local $^W=1;
BEGIN { pop @INC if $INC[-1] eq '.' }
use FindBin ();
use lib "$FindBin::Bin/../lib";
use DB::Handy;

###############################################################################
# Embedded test harness (no Test::More dependency)
###############################################################################
my ($PASS, $FAIL, $T) = (0, 0, 0);
sub ok  { my($c,$n)=@_; $T++; $c ? ($PASS++,print "ok $T - $n\n")
                                  : ($FAIL++,print "not ok $T - $n\n") }
sub is  { my($g,$e,$n)=@_; $T++;
          defined($g) && ("$g" eq "$e")
            ? ($PASS++, print "ok $T - $n\n")
            : ($FAIL++, print "not ok $T - $n  (got='${\ (defined $g?$g:'undef')}', exp='$e')\n") }

print "1..60\n";

use File::Path ();
my $BASE = "/tmp/test_fixes_$$";
File::Path::rmtree($BASE) if -d $BASE;

###############################################################################
# Setup
###############################################################################
my $db = DB::Handy->new(base_dir => $BASE);
$db->create_database('ftest');
$db->use_database('ftest');

###############################################################################
# Fix 1 -- CHECK constraint enforced on UPDATE
###############################################################################
$db->execute("CREATE TABLE ck (id INT NOT NULL, salary INT CHECK (salary >= 0), score INT CHECK (score <= 100))");
my $r = $db->execute("INSERT INTO ck (id,salary,score) VALUES (1,50000,80)");
# ok 1
ok($r->{type} eq 'ok', "Fix1: INSERT valid row ok");

$r = $db->execute("INSERT INTO ck (id,salary,score) VALUES (2,-1,50)");
# ok 2
ok($r->{type} eq 'error', "Fix1: INSERT negative salary blocked");

# UPDATE violation: salary goes negative
$r = $db->execute("UPDATE ck SET salary=-1 WHERE id=1");
# ok 3
ok($r->{type} eq 'error', "Fix1: UPDATE salary=-1 blocked by CHECK");
# ok 4
ok($r->{message} =~ /CHECK/, "Fix1: UPDATE error mentions CHECK");

# UPDATE violation: score exceeds limit
$r = $db->execute("UPDATE ck SET score=101 WHERE id=1");
# ok 5
ok($r->{type} eq 'error', "Fix1: UPDATE score=101 blocked by CHECK");

# UPDATE to boundary value: allowed
$r = $db->execute("UPDATE ck SET salary=0 WHERE id=1");
# ok 6
ok($r->{type} eq 'ok', "Fix1: UPDATE salary=0 (boundary) ok");
$r = $db->execute("SELECT salary FROM ck WHERE id=1");
# ok 7
is($r->{data}[0]{salary}+0, 0, "Fix1: salary=0 stored correctly");

# UPDATE to boundary score: allowed
$r = $db->execute("UPDATE ck SET score=100 WHERE id=1");
# ok 8
ok($r->{type} eq 'eq' || $r->{type} eq 'ok', "Fix1: UPDATE score=100 (boundary) ok");
$r = $db->execute("UPDATE ck SET score=100 WHERE id=1");
# ok 9
ok($r->{type} eq 'ok', "Fix1: UPDATE score=100 ok");

# UPDATE valid positive salary
$r = $db->execute("UPDATE ck SET salary=99000 WHERE id=1");
# ok 10
ok($r->{type} eq 'ok', "Fix1: UPDATE salary=99000 ok");
$r = $db->execute("SELECT salary FROM ck WHERE id=1");
# ok 11
is($r->{data}[0]{salary}+0, 99000, "Fix1: salary=99000 verified");

# UPDATE only non-CHECK column: not blocked
$db->execute("CREATE TABLE ck2 (id INT NOT NULL, val INT CHECK (val >= 10), note VARCHAR(20))");
$db->execute("INSERT INTO ck2 (id,val,note) VALUES (1,50,'ok')");
$r = $db->execute("UPDATE ck2 SET note='updated' WHERE id=1");
# ok 12
ok($r->{type} eq 'ok', "Fix1: UPDATE non-CHECK column not blocked");
$r = $db->execute("UPDATE ck2 SET val=9 WHERE id=1");
# ok 13
ok($r->{type} eq 'error', "Fix1: UPDATE CHECK column to invalid value blocked");

###############################################################################
# Fix 2 -- Index used for AND range and BETWEEN
###############################################################################
$db->execute("CREATE TABLE rng (id INT, v FLOAT)");
$db->execute("CREATE INDEX idx_rng_id ON rng (id)");
$db->execute("CREATE INDEX idx_rng_v  ON rng (v)");
for my $i (1..50) {
    my $v = $i * 0.5;
    $db->execute("INSERT INTO rng (id,v) VALUES ($i,$v)");
}

# AND range: id > 10 AND id < 20  (exclusive: 11..19 = 9 rows)
$r = $db->execute("SELECT id FROM rng WHERE id > 10 AND id < 20");
# ok 14
is(scalar @{$r->{data}}, 9, "Fix2: id > 10 AND id < 20 returns 9 rows");

# AND range: id >= 10 AND id <= 20  (inclusive: 10..20 = 11 rows)
$r = $db->execute("SELECT id FROM rng WHERE id >= 10 AND id <= 20");
# ok 15
is(scalar @{$r->{data}}, 11, "Fix2: id >= 10 AND id <= 20 returns 11 rows");

# AND range reversed: id < 20 AND id > 10
$r = $db->execute("SELECT id FROM rng WHERE id < 20 AND id > 10");
# ok 16
is(scalar @{$r->{data}}, 9, "Fix2: reversed AND (id < 20 AND id > 10) returns 9 rows");

# BETWEEN inclusive: id BETWEEN 10 AND 20  (10..20 = 11 rows)
$r = $db->execute("SELECT id FROM rng WHERE id BETWEEN 10 AND 20");
# ok 17
is(scalar @{$r->{data}}, 11, "Fix2: id BETWEEN 10 AND 20 returns 11 rows");

# BETWEEN single value: id BETWEEN 5 AND 5 (1 row)
$r = $db->execute("SELECT id FROM rng WHERE id BETWEEN 5 AND 5");
# ok 18
is(scalar @{$r->{data}}, 1, "Fix2: id BETWEEN 5 AND 5 returns 1 row");
# ok 19
is($r->{data}[0]{id}+0, 5, "Fix2: BETWEEN 5 AND 5 -> id=5");

# BETWEEN empty range (inverted): id BETWEEN 20 AND 10 (0 rows)
$r = $db->execute("SELECT id FROM rng WHERE id BETWEEN 20 AND 10");
# ok 20
is(scalar @{$r->{data}}, 0, "Fix2: BETWEEN inverted range returns 0 rows");

# Correctness: AND range values match
$r = $db->execute("SELECT id FROM rng WHERE id >= 3 AND id <= 5");
my @ids = sort { $a <=> $b } map { $_->{id}+0 } @{$r->{data}};
# ok 21
is(join(',', @ids), '3,4,5', "Fix2: AND range values correct (3,4,5)");

# FLOAT index with AND
$r = $db->execute("SELECT v FROM rng WHERE v >= 2.5 AND v <= 5.0");
my @vs = sort { $a <=> $b } map { $_->{v}+0 } @{$r->{data}};
# ok 22
is(scalar @vs, 6, "Fix2: FLOAT AND range returns 6 rows");
# ok 23
ok($vs[0] > 2.4 && $vs[0] < 2.6, "Fix2: FLOAT AND range lower bound ~2.5");

# Verify index is used correctly: indexed and non-indexed tables return
# identical results for AND range queries (correctness cross-check).