diff --git a/lib/Red/Cli.rakumod b/lib/Red/Cli.rakumod index fe3ba234..128dc59c 100644 --- a/lib/Red/Cli.rakumod +++ b/lib/Red/Cli.rakumod @@ -24,7 +24,7 @@ sub gen-stub(:@includes, :@models, :$driver, :%pars) { for @includes.unique { @stub.push: "use $_;" } - @stub.push: "\nred-defaults \"{ $driver }\", { %pars.map(*.perl) };"; + @stub.push: "\nred-defaults \"{ $driver }\", { %pars.map(*.raku) };"; @stub.push: ""; for @models { @stub.push: ".say for { $_ }.^all;" diff --git a/lib/Red/Column.rakumod b/lib/Red/Column.rakumod index 62efb783..f0e49188 100644 --- a/lib/Red/Column.rakumod +++ b/lib/Red/Column.rakumod @@ -71,7 +71,7 @@ multi method perl(::?CLASS:D:) { "{ self.^name }.new({ self.Hash.pairs.sort.map(-> (:$key, :$value) { next if $key eq .one; - "$key.Str() => $value.perl()" + "$key.Str() => $value.raku()" }).join: ", " })" } diff --git a/lib/Red/Driver.rakumod b/lib/Red/Driver.rakumod index e1e28acd..24091a4e 100644 --- a/lib/Red/Driver.rakumod +++ b/lib/Red/Driver.rakumod @@ -122,7 +122,7 @@ method optimize(Red::AST $in --> Red::AST) { $in } multi method debug(@bind) { if $*RED-DEBUG { - note "BIND: @bind.perl()"; + note "BIND: @bind.raku()"; } } @@ -135,6 +135,6 @@ multi method debug($sql) { multi method debug($sql, @binds) { if $*RED-DEBUG { note "SQL : $sql"; - note "BIND: @binds.perl()"; + note "BIND: @binds.raku()"; } } diff --git a/lib/Red/Driver/Mock.rakumod b/lib/Red/Driver/Mock.rakumod index 7dedd083..4de895ca 100644 --- a/lib/Red/Driver/Mock.rakumod +++ b/lib/Red/Driver/Mock.rakumod @@ -132,7 +132,7 @@ method verify { #is test-assertion { for %!when-re.kv -> Regex $re, % (:$counter = 0, :$times, |) { ok ($times == Inf or $counter == $times), - "Query that matches '$re.perl()' should be called $times times and was called $counter time(s)"; + "Query that matches '$re.raku()' should be called $times times and was called $counter time(s)"; } }, "Red Mock verify" } diff --git a/lib/Red/Model.rakumod b/lib/Red/Model.rakumod index 5f0e114a..d1855ff9 100644 --- a/lib/Red/Model.rakumod +++ b/lib/Red/Model.rakumod @@ -12,7 +12,7 @@ multi method perl(::?CLASS:D:) { self.raku } multi method raku(::?CLASS:D:) { my @attrs = self.^attributes.grep({ !.^can("relationship-ast") && .has_accessor}).map: { - "{ .name.substr(2) } => { .get_value(self).perl }" + "{ .name.substr(2) } => { .get_value(self).raku }" } "{ self.^name }.new({ @attrs.join: ", " })" } diff --git a/lib/X/Red/Exceptions.rakumod b/lib/X/Red/Exceptions.rakumod index 5a6cf8d3..1dfb05fd 100644 --- a/lib/X/Red/Exceptions.rakumod +++ b/lib/X/Red/Exceptions.rakumod @@ -89,7 +89,7 @@ class X::Red::Driver::Mapped::UnknownError is X::Red::Driver::Mapped { Unknown Error!!! Please, copy this backtrace and open an issue on https://github.com/FCO/Red/issues/new Driver: { $.driver } - Original error: { $.orig-exception.perl } + Original error: { $.orig-exception.raku } END } } diff --git a/t/87-coverage-gaps.rakutest b/t/87-coverage-gaps.rakutest new file mode 100644 index 00000000..aa2ca904 --- /dev/null +++ b/t/87-coverage-gaps.rakutest @@ -0,0 +1,298 @@ +use Test; +use Red; + +# Test plan: fills coverage gaps that the 86 existing test files miss. +# Targets: between, like/ilike, sort multi-column, modulo, tail, delete cascade + +my $*RED-DEBUG = $_ with %*ENV; +my $*RED-DEBUG-RESPONSE = $_ with %*ENV; +my @conf = (%*ENV // "SQLite").split(" "); +my $driver = @conf.shift; +my $*RED-DB = database $driver, |%( @conf.map: { do given .split: "=" { .[0] => val .[1] } } ); + +# ── Models ─────────────────────────────────────────────────────── + +model Gadget { + has UInt $.id is serial; + has Str $.name is column; + has Int $.price is column; + has Str $.color is column; + has @.tags is column{ :type }; +} + +model Appliance { + has UInt $.id is serial; + has Str $.name is column; + has Int $.watts is column; + has Bool $.active is column = True; + has Str $.code is column; +} + +model Item { + has UInt $.id is serial; + has Str $.name is column; + has Int $.qty is column; + has Bool $.on-sale is column = False; +} + +model DateItem { + has UInt $.id is serial; + has Str $.label is column; + has Date $.start-date is column; + has Date $.end-date is column; +} + +model Deletable { + has UInt $.id is serial; + has Str $.name is column; + has Int $.cat is column; + has Bool $.flag is column = False; +} + +# ── Setup ──────────────────────────────────────────────────────── + +schema(Gadget, Appliance, Item, DateItem, Deletable).drop.create; + +# Populate Gadgets +my @gadgets = Gadget.^create: :name, :price(10), :color; + Gadget.^create: :name, :price(50), :color; + Gadget.^create: :name, :price(100), :color; + Gadget.^create: :name, :price(75), :color; + +# Populate Appliances +Appliance.^create: :name, :watts(800), :active, :code; +Appliance.^create: :name, :watts(2000), :active, :code; +Appliance.^create: :name, :watts(50), :!active, :code; +Appliance.^create: :name, :watts(60), :active, :code; + +# Populate Items +Item.^create: :name, :qty(5), :on-sale; +Item.^create: :name, :qty(12), :!on-sale; +Item.^create: :name, :qty(7), :on-sale; +Item.^create: :name, :qty(3), :!on-sale; + +# Populate DateItems +DateItem.^create: :label, :start-date(Date.today.earlier(months => 1)), :end-date(Date.today.later(months => 1)); +DateItem.^create: :label, :start-date(Date.today.earlier(years => 2)), :end-date(Date.today.earlier(years => 1)); +DateItem.^create: :label, :start-date(Date.today.earlier(days => 5)), :end-date(Date.today.later(days => 5)); +DateItem.^create: :label, :start-date(Date.today.later(months => 1)), :end-date(Date.today.later(months => 3)); + +# Populate Deletables +Deletable.^create: :name, :cat(1), :flag; +Deletable.^create: :name, :cat(1), :!flag; +Deletable.^create: :name, :cat(2), :flag; +Deletable.^create: :name, :cat(2), :!flag; + +# ══════════════════════════════════════════════════════════════════ +# 1. BETWEEN — previously completely untested +# ══════════════════════════════════════════════════════════════════ +subtest "BETWEEN on Int column", { + my @r = Gadget.^all.grep(*.price between 20, 90).Seq; + is @r.elems, 2, "two gadgets in 20..90 range"; + ok @r.map(*.name).sort eqv .Seq, "names match: B and D"; +} + +subtest "BETWEEN with variables", { + my $lo = 40; + my $hi = 80; + my $r = Gadget.^all.first(*.price between $lo, $hi); + is $r.name, "B", "price 50 is between 40 and 80"; +} + +subtest "BETWEEN exclusive-ish (NOT between)", { + my @r = Gadget.^all.grep(not *.price between 20, 90).Seq; + is @r.elems, 2, "two gadgets outside 20..90"; + ok @r.map(*.name).sort eqv .Seq, "names match: A and C"; +} + +# ══════════════════════════════════════════════════════════════════ +# 2. SORT with multiple columns / mixed direction +# ══════════════════════════════════════════════════════════════════ +subtest "SORT multi-column", { + my @by-price-color = Gadget.^all.sort(*.price, *.color).map({ $_.name }).Seq; + is-deeply @by-price-color, .Seq, "sort by price asc (primary), color asc (secondary)"; +} + +subtest "SORT with explicit DESC/ASC on columns", { + my @desc = Gadget.^all.sort({ .price.desc }).map({ $_.name }).Seq; + is-deeply @desc, .Seq, "sort by price descending"; +} + +subtest "SORT with mixed direction", { + my @mixed = Gadget.^all.sort({ .color.asc, .price.desc }).map({ $_.name }).Seq; + is-deeply @mixed, .Seq, "sort: color asc (blue→green→red), price desc within same color (C=100 before A=10)"; +} + +# ══════════════════════════════════════════════════════════════════ +# 3. LIKE / ILIKE — previously completely untested +# ══════════════════════════════════════════════════════════════════ +subtest "LIKE operator", { + skip "like not supported on SQLite" if $driver eq "SQLite"; + my @r = Appliance.^all.grep(*.code like "T%").Seq; + is @r.elems, 1, "one code starts with T"; + is @r.head.name, "Toaster", "T% matches Toaster's code T800"; +} + +subtest "ILIKE operator (case insensitive)", { + skip "ilike not supported on SQLite" if $driver eq "SQLite"; + my @r = Appliance.^all.grep(*.code ilike "t%").Seq; + is @r.elems, 1, "iliKE T% matches same as LIKE T%"; +} + +# ══════════════════════════════════════════════════════════════════ +# 4. MODULO (%) — previously completely untested +# ══════════════════════════════════════════════════════════════════ +subtest "MODULO operator on column", { + my @r = Appliance.^all.grep(*.watts % 100 == 0).Seq; + is @r.elems, 2, "two appliances with watts divisible by 100: Toaster(800), Kettle(2000)"; + ok @r.map(*.name).sort eqv .Seq, "names match"; +} + +subtest "MODULO with variable", { + my $mod = 50; + my @r = Appliance.^all.grep(*.watts % $mod == 0).Seq; + is @r.elems, 2, "watts divisible by 50: Toaster(800), Kettle(2000)"; +} + +# ══════════════════════════════════════════════════════════════════ +# 5. TAIL — previously barely tested +# ══════════════════════════════════════════════════════════════════ +subtest "TAIL on sorted ResultSeq", { + my @r = Item.^all.sort(*.qty).tail(2).map(*.name).Seq; + is @r.elems, 2, "two items with highest qty"; + ok @r.sort eqv .Seq, "highest qty items: Gizmo(12), Doodad(7)"; +} + +subtest "TAIL single", { + my $r = Gadget.^all.sort(*.price).tail; + is $r.name, "C", "tail on price-sorted = most expensive (C=100)"; +} + +# ══════════════════════════════════════════════════════════════════ +# 6. DATE BETWEEN (two-column) +# ══════════════════════════════════════════════════════════════════ +my $today = Date.today; + +subtest "Date BETWEEN using two columns", { + my @r = DateItem.^all.grep(*.start-date <= $today and *.end-date >= $today).Seq; + is @r.elems, 2, "two date items span today: Recent, Current"; + ok @r.map(*.label).sort eqv .Seq, "labels match"; +} + +subtest "Date comparison with ranges", { + my $near-past = Date.today.earlier(days => 10); + my $near-future = Date.today.later(days => 10); + my @r = DateItem.^all.grep( + *.start-date between $near-past, $near-future + ).Seq; + is @r.elems, 1, "Current starts within ±10 days of today"; + is @r.head.label, "Current"; +} + +# ══════════════════════════════════════════════════════════════════ +# 7. Complex AND/OR in grep +# ══════════════════════════════════════════════════════════════════ +subtest "AND condition chain", { + my @r = Gadget.^all.grep(*.color eq "red" and *.price > 20).Seq; + is @r.elems, 1, "one red gadget above 20"; + is @r.head.name, "C", "C is red at price 100"; +} + +subtest "OR condition", { + my @r = Gadget.^all.grep(*.color eq "blue" or *.color eq "green").Seq; + is @r.elems, 2, "two blue-or-green gadgets"; + ok @r.map(*.name).sort eqv .Seq; +} + +subtest "NOT AND complex", { + my @r = Gadget.^all.grep(not (*.color eq "red" and *.price < 50)).Seq; + is @r.elems, 3, "all except red and cheap (A is red/10 → excluded; C=red/100 → included)"; + ok @r.map(*.name).sort eqv .Seq; +} + +# ══════════════════════════════════════════════════════════════════ +# 8. .^update with conditions +# ══════════════════════════════════════════════════════════════════ +subtest "Batch UPDATE with grep filter", { + lives-ok { Item.^all.grep(*.on-sale).update(:qty(99)) }, "batch update on sale items"; + my @updated = Item.^all.grep(*.qty == 99).Seq; + is @updated.elems, 2, "two items updated to qty=99"; + ok @updated.map(*.name).sort eqv .Seq, "Widget and Doodad were on sale"; + # Restore + Item.^all.grep(*.qty == 99).update(:qty(1)); +} + +subtest "Single UPDATE on found row", { + my $g = Gadget.^all.first(*.name eq "A"); + lives-ok { $g.update(:price(15)) }, "update single gadget"; + is Gadget.^all.first(*.name eq "A").price, 15, "price updated to 15"; + $g.update(:price(10)); # restore +} + +# ══════════════════════════════════════════════════════════════════ +# 9. .^delete with filter +# ══════════════════════════════════════════════════════════════════ +subtest "DELETE with grep", { + Deletable.^create: :name, :cat(9), :flag; + my $before = Deletable.^all.elems; + lives-ok { Deletable.^all.grep(*.cat == 9).delete }, "delete with grep filter"; + is Deletable.^all.elems, $before - 1, "one row deleted"; + is Deletable.^all.grep(*.cat == 9).elems, 0, "category 9 is now empty"; +} + +subtest "DELETE single row", { + Deletable.^create: :name, :cat(10); + my $row = Deletable.^all.first(*.cat == 10); + lives-ok { $row.delete }, "delete single row by object"; + is Deletable.^all.grep(*.cat == 10).elems, 0, "row gone"; +} + +# ══════════════════════════════════════════════════════════════════ +# 10. .^all with chained methods (head, first, map) +# ══════════════════════════════════════════════════════════════════ +subtest "Chained: sort + head + map", { + my @r = Gadget.^all.sort(*.price).head(2).map(*.name).Seq; + is-deeply @r, .Seq, "cheapest two: A(10), B(50)"; +} + +subtest "Chained: grep + sort + first", { + my $r = Gadget.^all.grep(*.color ne "red").sort(*.price.desc).first; + is $r.name, "D", "most expensive non-red = D(75, green)"; +} + +subtest "Bool coercion of ResultSeq", { + ok Gadget.^all.grep(*.name eq "A"), "grep result is truthy"; + nok Gadget.^all.grep(*.name eq "Z"), "empty grep is falsy"; +} + +subtest ".elems on filtered ResultSeq", { + is Gadget.^all.grep(*.color eq "red").elems, 2, "two red gadgets"; + is Appliance.^all.grep(*.active == False).elems, 1, "one inactive appliance"; +} + +# ══════════════════════════════════════════════════════════════════ +# 11. Column .in / ⊂ with more edge cases +# ══════════════════════════════════════════════════════════════════ +subtest "IN with empty set", { + my @r = Gadget.^all.grep(*.name ⊂ []).Seq; + is @r.elems, 0, "IN empty list returns nothing"; +} + +subtest "IN with single element", { + my $r = Gadget.^all.grep(*.name ⊂ ["D"]).first; + is $r.name, "D"; +} + +# ══════════════════════════════════════════════════════════════════ +# 12. .^save (update or create) +# ══════════════════════════════════════════════════════════════════ +subtest "save existing object (update path)", { + my $g = Gadget.^all.first(*.name eq "B"); + $g.price = 55; + lives-ok { $g.^save }, "save updated object"; + is Gadget.^all.first(*.name eq "B").price, 55, "price updated via save"; + $g.price = 50; + $g.^save; +} + +done-testing; diff --git a/tools/ci-coverage.raku b/tools/ci-coverage.raku new file mode 100644 index 00000000..a01f3966 --- /dev/null +++ b/tools/ci-coverage.raku @@ -0,0 +1,32 @@ +#!/usr/bin/env raku +# CI-friendly coverage runner — uses prove6 as single runner for ALL tests +use Code::Coverage; + +my $root = "/home/runner/work/Red/Red".IO; # GitHub Actions path + +# All lib modules +my @targets = do for dir($root.add("lib"), :recursive, test => / '.rakumod' $/) { + .absolute +} + +say "Measuring coverage for {@targets.elems} modules..."; + +my $cov = Code::Coverage.new( + :@targets, + :runners["prove6"], + :extra["-I", $root.add("lib").absolute, "-l", "-j1", $root.add("t").absolute], +); + +$cov.run; + +my $coverable = $cov.num-coverable-lines; +my $covered = $cov.num-covered-lines; + +if $coverable { + my $pct = (100 * $covered / $coverable).round; + say "Coverage: $pct% ($covered/$coverable lines)"; + $root.add(".coverage").spurt($pct.Str); +} else { + note "No coverable lines found!"; + exit 1; +} diff --git a/tools/run-coverage.raku b/tools/run-coverage.raku new file mode 100644 index 00000000..e3761aea --- /dev/null +++ b/tools/run-coverage.raku @@ -0,0 +1,64 @@ +#!/usr/bin/env raku +# Run ALL Red tests with Code::Coverage and update .coverage file + +use Code::Coverage; + +my $red-dir = "/root/forks/Red".IO; + +# Collect ALL .rakutest files +my @tests = dir($red-dir.add("t"), test => / '.rakutest' $/).map(*.absolute).sort; + +# Collect ALL .rakumod files under lib/ +my @targets = do for dir($red-dir.add("lib"), :recursive, test => / '.rakumod' | '.pm6' $/) { + .absolute +} + +# Filter targets: only files that actually exist and have coverable lines +@targets = @targets.grep(*.IO.f); + +say "Targets: {@targets.elems} lib files"; +say "Tests: {@tests.elems} test files"; + +# Use prove6-style runner — run each test file individually +my $cov = Code::Coverage.new( + :@targets, + :runners(@tests), + :extra["-I", $red-dir.add("lib").absolute], +); + +$cov.run; + +# Calculate total coverage +my $coverable = $cov.num-coverable-lines; +my $covered = $cov.num-covered-lines; + +say ""; +say "═" x 50; +say "Coverable lines: $coverable"; +say "Covered lines: $covered"; +say "Coverage: {sprintf '%.1f%%', 100 * $covered / $coverable}" if $coverable; + +# Show per-file coverage +say ""; +say "═" x 50; +say "Per-file coverage:"; +for $cov.coverage.sort(*.key) -> (:$key, :$value) { + say " {$value // 'N/A'} $key"; +} + +# Show missed lines summary +say ""; +say "═" x 50; +say "Files with missed lines:"; +for $cov.missed.sort(*.value.elems).reverse -> (:$key, :$value) { + next unless $value.elems; + say " {$value.elems} missed — $key"; +} + +# Write the percentage to .coverage (numeric only) +if $coverable { + my $pct = (100 * $covered / $coverable).round; + $red-dir.add(".coverage").spurt($pct.Str); + say ""; + say "Updated .coverage → $pct%"; +}