fivedev/five
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(rtl,tests): pre-release UX round (Wave 5)

Browse Source 
Three audit findings around polish + a release-readiness commit:

  * #UX1 LIST/DISPLAY output: dropped \r\n (unix terminals showed a
    stray ^M), moved the newline to AFTER each row (no more leading
    blank line), and added the `*` deleted-record marker after the
    record number — matches xBase LIST/DISPLAY convention. With
    SET DELETED ON the marker is unreachable since the row would
    have been skipped at Area.Skip level; with SET DELETED OFF the
    user now sees which rows are tombstoned.

  * #26 temp aliases: `__copytmp` / `__sorttmp` / `__totaltmp` /
    `__jointmp` were process-global string constants. A nested
    invocation (e.g., COPY inside a FOR clause whose expression
    runs another COPY) collided on the alias and the inner Open
    failed with "alias already in use" — surfacing as `.F.` with
    no clear cause. Each Open now goes through a new helper
    `nextTmpAlias(prefix)` backed by an atomic counter, so every
    call gets `__copytmp_1`, `__copytmp_2`, etc. — no collisions.

  * #J test coverage gap: the 13 std.ch regression tests were all
    sitting in `/tmp` — lost on tmpfs reboot, never in git, never
    in CI. Move them into `tests/std_ch/` and add a simple
    `run.sh` runner that builds + executes each one in a temp
    scratch directory and grep-asserts on FAIL / NOT REJECTED /
    expectation-mismatch markers. 13/13 pass against the current
    head:

       PASS  test_pp_stdch       PASS  test_count
       PASS  test_sum_avg        PASS  test_sum_multi
       PASS  test_copy           PASS  test_sort
       PASS  test_list           PASS  test_total
       PASS  test_join           PASS  test_update
       PASS  test_set_deleted    PASS  test_unsupported
       PASS  test_block_comma

    test_block_comma in particular guards the gengo SeqExpr fix
    from Wave 1 — without it the comma-in-block miscompile would
    silently come back.

Gates green:
  go test ./...      : PASS
  FiveSql2 SQL:1999  : 43/43
  Harbour compat     : 56/56
  std.ch suite       : 13/13

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
CharlesKWON
2026-05-01 08:07:50 +09:00
parent 1a9e509ee2
commit 3a7f1dea72
15 changed files with 698 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
hbrtl/database.go
View File

@@ -12,6 +12,7 @@ import (
"os"
"sort"
"strings"
"sync/atomic"
"five/hbrt"
"five/hbrdd"
@@ -771,6 +772,20 @@ func rtlDbAverage(t *hbrt.Thread) {
t.RetDouble(sum/float64(n), 10, 2)
}
// dbCmdTmpSeq generates a unique numeric suffix for temp aliases
// used by COPY/SORT/TOTAL/JOIN. Without this, a nested call (e.g.,
// COPY inside a FOR clause that itself runs COPY) would collide on
// the same `__copytmp` alias and the inner Open would fail with
// "alias already in use". Atomic so concurrent goroutines (each
// owns its own WorkAreaManager but the counter is process-wide)
// don't hand out duplicates.
var dbCmdTmpSeq uint64
func nextTmpAlias(prefix string) string {
n := atomic.AddUint64(&dbCmdTmpSeq, 1)
return fmt.Sprintf("%s_%d", prefix, n)
}
// rtlDbNotImpl raises a runtime error explaining which xBase clause
// the user invoked that Five doesn't yet implement. std.ch routes
// SDF / DELIMITED / TO PRINTER / TO FILE variants here so they fail
@@ -902,7 +917,7 @@ func rtlDbCopy(t *hbrt.Thread) {
return
}
srcSel := wam.CurrentNum()
dstSel, err := wam.Open("DBFNTX", cFile, "__copytmp", false, false)
dstSel, err := wam.Open("DBFNTX", cFile, nextTmpAlias("__copytmp"), false, false)
if err != nil {
// drv.Create wrote the file but Open failed (alias collision,
// area-table full, ...). Without cleanup the user is left
@@ -1175,7 +1190,7 @@ func rtlDbSort(t *hbrt.Thread) {
return
}
srcSel := wam.CurrentNum()
dstSel, err := wam.Open("DBFNTX", cFile, "__sorttmp", false, false)
dstSel, err := wam.Open("DBFNTX", cFile, nextTmpAlias("__sorttmp"), false, false)
if err != nil {
_ = os.Remove(cFile)
t.RetBool(false)
@@ -1305,7 +1320,15 @@ func rtlDbList(t *hbrt.Thread) {
if emit {
parts := []string{}
if !lOff {
parts = append(parts, fmt.Sprintf("%6d", srcArea.RecNo()))
// Deleted records get a `*` after the recno when shown
// (only happens with SET DELETED OFF — DELETED ON
// already skipped them at Area.Skip level). Matches
// Harbour LIST/DISPLAY convention.
marker := " "
if srcArea.Deleted() {
marker = "*"
}
parts = append(parts, fmt.Sprintf("%6d%s", srcArea.RecNo(), marker))
}
if useAllFields {
for i := 0; i < nFields; i++ {
@@ -1319,7 +1342,10 @@ func rtlDbList(t *hbrt.Thread) {
parts = append(parts, valueToDisplay(t.GetRetValue()))
}
}
fmt.Print("\r\n" + strings.Join(parts, " "))
// Newline after the row, not before — avoids the spurious
// leading blank line at the top of the listing. `\n` only;
// terminals handle CR conversion themselves.
fmt.Println(strings.Join(parts, " "))
}
srcArea.Skip(1)
scanned++
@@ -1442,7 +1468,7 @@ func rtlDbTotal(t *hbrt.Thread) {
return
}
srcSel := wam.CurrentNum()
dstSel, err := wam.Open("DBFNTX", cFile, "__totaltmp", false, false)
dstSel, err := wam.Open("DBFNTX", cFile, nextTmpAlias("__totaltmp"), false, false)
if err != nil {
_ = os.Remove(cFile)
t.RetBool(false)
@@ -1721,7 +1747,7 @@ func rtlDbJoin(t *hbrt.Thread) {
t.RetBool(false)
return
}
dstSel, err := wam.Open("DBFNTX", cFile, "__jointmp", false, false)
dstSel, err := wam.Open("DBFNTX", cFile, nextTmpAlias("__jointmp"), false, false)
if err != nil {
_ = os.Remove(cFile)
t.RetBool(false)

71
tests/std_ch/run.sh Executable file
View File

@@ -0,0 +1,71 @@
#!/usr/bin/env bash
#
# std.ch regression runner. Build each PRG against the current Five
# compiler (caller's PWD must be the repo root) and execute it; non-zero
# exit or "FAIL"/"NOT REJECTED" in stdout marks the run as failed.
#
# This deliberately runs in a temp scratch directory so the DBF/NTX
# artifacts don't collide with each other across tests.
set -e
ROOT="$(cd "$(dirname "$0")/../.." && pwd)"
FIVE="$ROOT/five"
if [ ! -x "$FIVE" ]; then
echo "five binary not found at $FIVE — run 'go build -o five ./cmd/five' first" >&2
exit 2
fi
TESTS=(
test_pp_stdch
test_count
test_sum_avg
test_sum_multi
test_copy
test_sort
test_list
test_total
test_join
test_update
test_set_deleted
test_unsupported
test_block_comma
)
work="$(mktemp -d)"
trap 'rm -rf "$work"' EXIT
pass=0
fail=0
for name in "${TESTS[@]}"; do
src="$ROOT/tests/std_ch/${name}.prg"
bin="$work/${name}"
if ! "$FIVE" build "$src" -o "$bin" >/dev/null 2>"$work/${name}.err"; then
echo "FAIL build $name"
cat "$work/${name}.err" | sed 's/^/ /'
fail=$((fail+1))
continue
fi
pushd "$work" >/dev/null
if ! out="$("$bin" 2>&1)"; then
echo "FAIL run $name"
echo "$out" | sed 's/^/ /'
fail=$((fail+1))
popd >/dev/null
continue
fi
popd >/dev/null
if echo "$out" | grep -qE 'FAIL|NOT REJECTED|expect.*got'; then
echo "FAIL assert $name"
echo "$out" | sed 's/^/ /'
fail=$((fail+1))
continue
fi
echo "PASS $name"
pass=$((pass+1))
done
echo
echo "================================================================"
echo " Results: $pass / $((pass+fail)) passed"
echo "================================================================"
[ $fail -eq 0 ]

12
tests/std_ch/test_block_comma.prg Normal file
View File

@@ -0,0 +1,12 @@
PROCEDURE Main()
LOCAL a := 0, b := 0, c := 0, r
LOCAL b1 := {|| a := a + 1, b := b + 1, c := c + 1 }
r := Eval(b1)
? "a=", a, "b=", b, "c=", c, "ret=", r
? "(harbour: a=1, b=1, c=1, ret=1 — last expr)"
/* Same block via inline expression */
a := 0; b := 0; c := 0
r := Eval({|| a := a + 1, b := b + 1, c := c + 1 })
? "inline: a=", a, "b=", b, "c=", c, "ret=", r
RETURN

64
tests/std_ch/test_copy.prg Normal file
View File

@@ -0,0 +1,64 @@
/* COPY TO via PP rule. */
PROCEDURE Main()
LOCAL aStruct, n
FErase( "src.dbf" )
FErase( "dst1.dbf" )
FErase( "dst2.dbf" )
FErase( "dst3.dbf" )
aStruct := { ;
{ "ID", "N", 4, 0 }, ;
{ "NAME", "C", 20, 0 }, ;
{ "AGE", "N", 3, 0 } }
dbCreate( "src.dbf", aStruct )
USE src.dbf NEW EXCLUSIVE ALIAS s
dbAppend() ; FieldPut(1,1) ; FieldPut(2,"Alice") ; FieldPut(3,18)
dbAppend() ; FieldPut(1,2) ; FieldPut(2,"Bob") ; FieldPut(3,25)
dbAppend() ; FieldPut(1,3) ; FieldPut(2,"Carol") ; FieldPut(3,30)
dbAppend() ; FieldPut(1,4) ; FieldPut(2,"Dan") ; FieldPut(3,45)
dbAppend() ; FieldPut(1,5) ; FieldPut(2,"Eve") ; FieldPut(3,60)
dbCommit()
/* 1. plain COPY TO — all rows */
dbGoTop()
COPY TO dst1.dbf
dbCloseArea()
USE dst1.dbf NEW EXCLUSIVE
COUNT TO n
? "1. COPY TO dst1.dbf rows =", n, "(expect 5)"
dbGoTop()
? " first row id/name/age =", FieldGet(1), AllTrim(FieldGet(2)), FieldGet(3)
dbCloseArea()
/* 2. COPY TO ... FOR */
USE src.dbf NEW EXCLUSIVE ALIAS s
dbGoTop()
COPY TO dst2.dbf FOR s->age >= 30
dbCloseArea()
USE dst2.dbf NEW EXCLUSIVE
COUNT TO n
? "2. COPY TO dst2.dbf FOR age>=30 rows =", n, "(expect 3)"
dbCloseArea()
/* 3. COPY TO ... FIELDS subset */
USE src.dbf NEW EXCLUSIVE ALIAS s
dbGoTop()
COPY TO dst3.dbf FIELDS id, name
dbCloseArea()
USE dst3.dbf NEW EXCLUSIVE
COUNT TO n
? "3. COPY TO dst3.dbf FIELDS id,name rows =", n, "(expect 5)"
? " field count =", FCount(), "(expect 2)"
dbGoTop()
? " row1 =", FieldGet(1), AllTrim(FieldGet(2))
dbCloseArea()
FErase( "src.dbf" )
FErase( "dst1.dbf" )
FErase( "dst2.dbf" )
FErase( "dst3.dbf" )
? "DONE"
RETURN

40
tests/std_ch/test_count.prg Normal file
View File

@@ -0,0 +1,40 @@
/* COUNT via PP rule — uses alias-qualified fields. */
PROCEDURE Main()
LOCAL aStruct, n
FErase( "people.dbf" )
aStruct := { { "ID", "N", 4, 0 }, { "AGE", "N", 3, 0 } }
dbCreate( "people.dbf", aStruct )
USE people.dbf NEW EXCLUSIVE ALIAS p
dbAppend() ; FieldPut(1, 1) ; FieldPut(2, 18)
dbAppend() ; FieldPut(1, 2) ; FieldPut(2, 25)
dbAppend() ; FieldPut(1, 3) ; FieldPut(2, 30)
dbAppend() ; FieldPut(1, 4) ; FieldPut(2, 45)
dbAppend() ; FieldPut(1, 5) ; FieldPut(2, 60)
dbCommit()
n := -1
dbGoTop()
COUNT TO n
? "1. COUNT TO n =", n, "(expect 5)"
n := -1
dbGoTop()
COUNT TO n FOR p->age >= 30
? "2. COUNT TO n FOR p->age >= 30 =", n, "(expect 3)"
n := -1
dbGoTop()
COUNT TO n FOR p->age < 25
? "3. COUNT TO n FOR p->age < 25 =", n, "(expect 1)"
n := -1
dbGoTop()
COUNT TO n FOR p->age > 100
? "4. COUNT TO n FOR p->age > 100 =", n, "(expect 0)"
dbCloseArea()
FErase( "people.dbf" )
? "DONE"
RETURN

70
tests/std_ch/test_join.prg Normal file
View File

@@ -0,0 +1,70 @@
/* JOIN WITH ... TO ... FOR ... — uses non-reserved alias names. */
PROCEDURE Main()
LOCAL aStruct, n
FErase( "cust.dbf" )
FErase( "ord.dbf" )
FErase( "out.dbf" )
/* Customers (master) */
aStruct := { ;
{ "CID", "N", 4, 0 }, ;
{ "CNAME", "C", 12, 0 } }
dbCreate( "cust.dbf", aStruct )
USE cust.dbf NEW EXCLUSIVE ALIAS cu
dbAppend() ; FieldPut(1, 1) ; FieldPut(2, "Alice")
dbAppend() ; FieldPut(1, 2) ; FieldPut(2, "Bob")
dbAppend() ; FieldPut(1, 3) ; FieldPut(2, "Carol")
dbCommit()
dbCloseArea()
/* Orders (detail) */
aStruct := { ;
{ "OID", "N", 4, 0 }, ;
{ "CID", "N", 4, 0 }, ;
{ "AMT", "N", 8, 2 } }
dbCreate( "ord.dbf", aStruct )
USE ord.dbf NEW EXCLUSIVE ALIAS od
dbAppend() ; FieldPut(1, 100) ; FieldPut(2, 1) ; FieldPut(3, 50)
dbAppend() ; FieldPut(1, 101) ; FieldPut(2, 1) ; FieldPut(3, 30)
dbAppend() ; FieldPut(1, 102) ; FieldPut(2, 2) ; FieldPut(3, 200)
dbAppend() ; FieldPut(1, 103) ; FieldPut(2, 4) ; FieldPut(3, 99) /* no-match cid */
dbCommit()
dbCloseArea()
/* Open both */
USE cust.dbf NEW EXCLUSIVE ALIAS cu
USE ord.dbf NEW EXCLUSIVE ALIAS od
SELECT cu
? "--- JOIN WITH od TO out FIELDS cid, cname, oid, amt FOR cu->cid = od->cid ---"
JOIN WITH od TO out.dbf FIELDS cid, cname, oid, amt FOR cu->cid = od->cid
/* Close both source areas */
SELECT cu
dbCloseArea()
SELECT od
dbCloseArea()
USE out.dbf NEW EXCLUSIVE
COUNT TO n
? "Joined rows =", n, "(expect 3)"
dbGoTop()
? "Field count =", FCount(), "(expect 4: cid, cname, oid, amt)"
? ""
? "rows:"
DO WHILE !Eof()
? " cid:", FieldGet(1), "name:", AllTrim(FieldGet(2)), "oid:", FieldGet(3), "amt:", FieldGet(4)
dbSkip()
ENDDO
? "(expect: 1 Alice 100 50 / 1 Alice 101 30 / 2 Bob 102 200)"
dbCloseArea()
FErase( "cust.dbf" )
FErase( "ord.dbf" )
FErase( "out.dbf" )
? "DONE"
RETURN

52
tests/std_ch/test_list.prg Normal file
View File

@@ -0,0 +1,52 @@
/* LIST and DISPLAY via PP rules — alias-qualified field references. */
PROCEDURE Main()
LOCAL aStruct
FErase( "people.dbf" )
aStruct := { ;
{ "ID", "N", 4, 0 }, ;
{ "NAME", "C", 10, 0 }, ;
{ "AGE", "N", 3, 0 } }
dbCreate( "people.dbf", aStruct )
USE people.dbf NEW EXCLUSIVE ALIAS p
dbAppend() ; FieldPut(1,1) ; FieldPut(2,"Alice") ; FieldPut(3,18)
dbAppend() ; FieldPut(1,2) ; FieldPut(2,"Bob") ; FieldPut(3,25)
dbAppend() ; FieldPut(1,3) ; FieldPut(2,"Carol") ; FieldPut(3,30)
dbCommit()
? "--- 1. LIST (all rows, all fields) ---"
dbGoTop()
LIST
? ""
? "--- 2. LIST p->id, p->name (selected) ---"
dbGoTop()
LIST p->id, p->name
? ""
? "--- 3. LIST p->id, p->name FOR p->age >= 25 ---"
dbGoTop()
LIST p->id, p->name FOR p->age >= 25
? ""
? "--- 4. LIST p->id, p->name OFF ---"
dbGoTop()
LIST p->id, p->name OFF
? ""
? "--- 5. DISPLAY (current record only) ---"
dbGoto(2)
DISPLAY
? ""
? "--- 6. DISPLAY ALL ---"
dbGoTop()
DISPLAY ALL
? ""
dbCloseArea()
FErase( "people.dbf" )
? "DONE"
RETURN

39
tests/std_ch/test_pp_stdch.prg Normal file
View File

@@ -0,0 +1,39 @@
/* Test that std.ch #command rules expand correctly. */
PROCEDURE Main()
LOCAL cName := "/tmp/__pp_test_std_ch.tmp"
/* Create a junk file so ERASE/RENAME have something to work with. */
hb_MemoWrit( cName, "x" )
? "1. file created exists?", File( cName ), "(expect .T.)"
/* ERASE <(f)> → FErase(<(f)>) */
ERASE ( cName )
? "2. after ERASE exists?", File( cName ), "(expect .F.)"
/* RENAME — recreate, rename, check both. */
hb_MemoWrit( cName, "y" )
RENAME ( cName ) TO ( cName + ".moved" )
? "3. after RENAME orig exists?", File( cName ), "(expect .F.)"
? " moved exists?", File( cName + ".moved" ), "(expect .T.)"
FErase( cName + ".moved" )
/* DELETE FILE <(f)> alias for ERASE */
hb_MemoWrit( cName, "z" )
DELETE FILE ( cName )
? "4. after DELETE FILE exists?", File( cName ), "(expect .F.)"
/* CLOSE / CLOSE ALL / CLOSE DATABASES — should compile without
hardcoded parser support. They each call DbCloseArea or
DbCloseAll. With no open workareas, both are no-ops. */
CLOSE
CLOSE ALL
CLOSE DATABASES
? "5. CLOSE / CLOSE ALL / CLOSE DATABASES compiled OK"
/* COMMIT — DbCommit() with no open area is a no-op too. */
COMMIT
? "6. COMMIT compiled OK"
? "DONE"
RETURN

31
tests/std_ch/test_set_deleted.prg Normal file
View File

@@ -0,0 +1,31 @@
PROCEDURE Main()
LOCAL n
FErase("p.dbf"); FErase("c.dbf")
dbCreate("p.dbf", { {"X","N",4,0} })
USE p.dbf NEW EXCLUSIVE ALIAS p
dbAppend(); FieldPut(1, 1)
dbAppend(); FieldPut(1, 2); dbDelete()
dbAppend(); FieldPut(1, 3)
dbCommit()
dbGoTop()
/* SET DELETED OFF (default) — all 3 included */
COUNT TO n
? "DELETED OFF count =", n, "(expect 3)"
SET DELETED ON
dbGoTop()
COUNT TO n
? "DELETED ON count =", n, "(expect 2)"
COPY TO c.dbf
dbCloseArea()
USE c.dbf NEW EXCLUSIVE
COUNT TO n
? "COPY rows after DELETED ON =", n, "(expect 2)"
dbCloseArea()
FErase("p.dbf"); FErase("c.dbf")
? "DONE"
RETURN

74
tests/std_ch/test_sort.prg Normal file
View File

@@ -0,0 +1,74 @@
/* SORT TO via PP rule. */
PROCEDURE Main()
LOCAL aStruct
FErase( "src.dbf" )
FErase( "dst1.dbf" )
FErase( "dst2.dbf" )
FErase( "dst3.dbf" )
aStruct := { ;
{ "ID", "N", 4, 0 }, ;
{ "NAME", "C", 20, 0 }, ;
{ "AGE", "N", 3, 0 } }
dbCreate( "src.dbf", aStruct )
USE src.dbf NEW EXCLUSIVE ALIAS s
dbAppend() ; FieldPut(1,1) ; FieldPut(2,"Carol") ; FieldPut(3,30)
dbAppend() ; FieldPut(1,2) ; FieldPut(2,"Alice") ; FieldPut(3,18)
dbAppend() ; FieldPut(1,3) ; FieldPut(2,"Eve") ; FieldPut(3,60)
dbAppend() ; FieldPut(1,4) ; FieldPut(2,"Bob") ; FieldPut(3,25)
dbAppend() ; FieldPut(1,5) ; FieldPut(2,"Dan") ; FieldPut(3,45)
dbCommit()
/* 1. SORT ON name asc */
dbGoTop()
SORT TO dst1.dbf ON name
dbCloseArea()
USE dst1.dbf NEW EXCLUSIVE
dbGoTop()
? "1. name asc:"
DO WHILE !Eof()
? " ", FieldGet(1), AllTrim(FieldGet(2)), FieldGet(3)
dbSkip()
ENDDO
? " (expect: Alice, Bob, Carol, Dan, Eve)"
dbCloseArea()
/* 2. SORT ON age/D */
USE src.dbf NEW EXCLUSIVE ALIAS s
dbGoTop()
SORT TO dst2.dbf ON age/D
dbCloseArea()
USE dst2.dbf NEW EXCLUSIVE
dbGoTop()
? "2. age desc:"
DO WHILE !Eof()
? " ", FieldGet(1), AllTrim(FieldGet(2)), FieldGet(3)
dbSkip()
ENDDO
? " (expect: 60, 45, 30, 25, 18)"
dbCloseArea()
/* 3. SORT ON age FOR age >= 30 */
USE src.dbf NEW EXCLUSIVE ALIAS s
dbGoTop()
SORT TO dst3.dbf ON age FOR s->age >= 30
dbCloseArea()
USE dst3.dbf NEW EXCLUSIVE
dbGoTop()
? "3. age asc, FOR age>=30:"
DO WHILE !Eof()
? " ", FieldGet(1), AllTrim(FieldGet(2)), FieldGet(3)
dbSkip()
ENDDO
? " (expect: Carol/30, Dan/45, Eve/60)"
dbCloseArea()
FErase( "src.dbf" )
FErase( "dst1.dbf" )
FErase( "dst2.dbf" )
FErase( "dst3.dbf" )
? "DONE"
RETURN

45
tests/std_ch/test_sum_avg.prg Normal file
View File

@@ -0,0 +1,45 @@
/* SUM and AVERAGE via PP rule. */
PROCEDURE Main()
LOCAL aStruct, nSum, nAvg
FErase( "people.dbf" )
aStruct := { { "ID", "N", 4, 0 }, { "AGE", "N", 3, 0 } }
dbCreate( "people.dbf", aStruct )
USE people.dbf NEW EXCLUSIVE ALIAS p
dbAppend() ; FieldPut(1, 1) ; FieldPut(2, 18)
dbAppend() ; FieldPut(1, 2) ; FieldPut(2, 25)
dbAppend() ; FieldPut(1, 3) ; FieldPut(2, 30)
dbAppend() ; FieldPut(1, 4) ; FieldPut(2, 45)
dbAppend() ; FieldPut(1, 5) ; FieldPut(2, 60)
dbCommit()
/* SUM all ages */
dbGoTop()
SUM p->age TO nSum
? "1. SUM p->age =", nSum, "(expect 178 = 18+25+30+45+60)"
/* SUM with FOR */
dbGoTop()
SUM p->age TO nSum FOR p->age >= 30
? "2. SUM p->age FOR age>=30 =", nSum, "(expect 135 = 30+45+60)"
/* AVERAGE all ages */
dbGoTop()
AVERAGE p->age TO nAvg
? "3. AVERAGE p->age =", nAvg, "(expect 35.6)"
/* AVERAGE with FOR */
dbGoTop()
AVERAGE p->age TO nAvg FOR p->age >= 30
? "4. AVERAGE p->age FOR age>=30 =", nAvg, "(expect 45)"
/* AVERAGE with no matching rows */
dbGoTop()
AVERAGE p->age TO nAvg FOR p->age > 200
? "5. AVERAGE p->age FOR age>200 =", nAvg, "(expect 0)"
dbCloseArea()
FErase( "people.dbf" )
? "DONE"
RETURN

23
tests/std_ch/test_sum_multi.prg Normal file
View File

@@ -0,0 +1,23 @@
PROCEDURE Main()
LOCAL aStruct, sx, sy, sz
FErase("p.dbf")
aStruct := { {"X","N",6,0}, {"Y","N",6,0}, {"Z","N",6,0} }
dbCreate("p.dbf", aStruct)
USE p.dbf NEW EXCLUSIVE ALIAS p
dbAppend(); FieldPut(1, 1); FieldPut(2, 10); FieldPut(3, 100)
dbAppend(); FieldPut(1, 2); FieldPut(2, 20); FieldPut(3, 200)
dbAppend(); FieldPut(1, 3); FieldPut(2, 30); FieldPut(3, 300)
dbCommit()
/* Multi-pair SUM */
dbGoTop()
SUM p->x, p->y, p->z TO sx, sy, sz
? "sx=", sx, "(expect 6)"
? "sy=", sy, "(expect 60)"
? "sz=", sz, "(expect 600)"
dbCloseArea()
FErase("p.dbf")
? "DONE"
RETURN

49
tests/std_ch/test_total.prg Normal file
View File

@@ -0,0 +1,49 @@
/* TOTAL TO ... ON ... FIELDS ... via PP rule. */
PROCEDURE Main()
LOCAL aStruct, n
FErase( "src.dbf" )
FErase( "dst.dbf" )
/* Sales records, sorted by department. */
aStruct := { ;
{ "DEPT", "C", 12, 0 }, ;
{ "EMP", "C", 12, 0 }, ;
{ "AMT", "N", 8, 2 }, ;
{ "QTY", "N", 4, 0 } }
dbCreate( "src.dbf", aStruct )
USE src.dbf NEW EXCLUSIVE ALIAS s
/* engineering: 100+200=300, qty 5+8=13 */
dbAppend() ; FieldPut(1,"engineering"); FieldPut(2,"alice") ; FieldPut(3,100) ; FieldPut(4,5)
dbAppend() ; FieldPut(1,"engineering"); FieldPut(2,"bob") ; FieldPut(3,200) ; FieldPut(4,8)
/* sales: 50+150+25=225, qty 1+3+1=5 */
dbAppend() ; FieldPut(1,"sales") ; FieldPut(2,"carol") ; FieldPut(3,50) ; FieldPut(4,1)
dbAppend() ; FieldPut(1,"sales") ; FieldPut(2,"dan") ; FieldPut(3,150) ; FieldPut(4,3)
dbAppend() ; FieldPut(1,"sales") ; FieldPut(2,"eve") ; FieldPut(3,25) ; FieldPut(4,1)
/* hr: 80, qty 2 */
dbAppend() ; FieldPut(1,"hr") ; FieldPut(2,"frank") ; FieldPut(3,80) ; FieldPut(4,2)
dbCommit()
? "--- TOTAL TO dst ON dept FIELDS amt, qty ---"
dbGoTop()
TOTAL TO dst.dbf ON s->dept FIELDS amt, qty
dbCloseArea()
USE dst.dbf NEW EXCLUSIVE
COUNT TO n
? "Group rows =", n, "(expect 3 = engineering, sales, hr)"
dbGoTop()
? "1.", AllTrim(FieldGet(1)), "amt:", FieldGet(3), "qty:", FieldGet(4), "(expect engineering 300 13)"
dbSkip()
? "2.", AllTrim(FieldGet(1)), "amt:", FieldGet(3), "qty:", FieldGet(4), "(expect sales 225 5)"
dbSkip()
? "3.", AllTrim(FieldGet(1)), "amt:", FieldGet(3), "qty:", FieldGet(4), "(expect hr 80 2)"
dbCloseArea()
FErase( "src.dbf" )
FErase( "dst.dbf" )
? "DONE"
RETURN

29
tests/std_ch/test_unsupported.prg Normal file
View File

@@ -0,0 +1,29 @@
PROCEDURE Main()
LOCAL caught := .F.
FErase("d.dbf")
dbCreate("d.dbf", { {"X","N",4,0} })
USE d.dbf NEW EXCLUSIVE
dbAppend(); FieldPut(1, 1)
dbCommit()
/* Test that SDF / TO PRINTER raise instead of silent no-op */
BEGIN SEQUENCE
COPY TO out.txt SDF
RECOVER
caught := .T.
END SEQUENCE
? "SDF caught:", caught, "(expect .T.)"
caught := .F.
BEGIN SEQUENCE
LIST TO PRINTER
RECOVER
caught := .T.
END SEQUENCE
? "TO PRINTER caught:", caught, "(expect .T.)"
dbCloseArea()
FErase("d.dbf")
? "DONE"
RETURN

67
tests/std_ch/test_update.prg Normal file
View File

@@ -0,0 +1,67 @@
/* UPDATE FROM via PP rule. */
PROCEDURE Main()
LOCAL aStruct
FErase( "mas.dbf" )
FErase( "del.dbf" )
/* Master: id, total. Initially totals are zero. */
aStruct := { ;
{ "ID", "N", 4, 0 }, ;
{ "NAME", "C", 8, 0 }, ;
{ "TOTAL", "N", 8, 2 } }
dbCreate( "mas.dbf", aStruct )
USE mas.dbf NEW EXCLUSIVE ALIAS mas
dbAppend() ; FieldPut(1, 1) ; FieldPut(2, "Alice") ; FieldPut(3, 0)
dbAppend() ; FieldPut(1, 2) ; FieldPut(2, "Bob") ; FieldPut(3, 0)
dbAppend() ; FieldPut(1, 3) ; FieldPut(2, "Carol") ; FieldPut(3, 0)
dbCommit()
dbCloseArea()
/* Delta: same id, amount to apply. Sorted by id. */
aStruct := { ;
{ "ID", "N", 4, 0 }, ;
{ "AMT", "N", 8, 2 } }
dbCreate( "del.dbf", aStruct )
USE del.dbf NEW EXCLUSIVE ALIAS del
dbAppend() ; FieldPut(1, 1) ; FieldPut(2, 100)
dbAppend() ; FieldPut(1, 2) ; FieldPut(2, 200)
dbAppend() ; FieldPut(1, 3) ; FieldPut(2, 300)
dbCommit()
dbCloseArea()
/* Re-open both, sorted on id. */
USE mas.dbf NEW EXCLUSIVE ALIAS mas
USE del.dbf NEW EXCLUSIVE ALIAS del
SELECT mas
? "--- before UPDATE FROM ---"
dbGoTop()
DO WHILE !Eof()
? " ", FieldGet(1), AllTrim(FieldGet(2)), FieldGet(3)
dbSkip()
ENDDO
? ""
? "--- UPDATE FROM del ON id REPLACE total WITH del->amt ---"
dbGoTop()
UPDATE FROM del ON id REPLACE total WITH del->amt
? ""
? "--- after UPDATE FROM ---"
dbGoTop()
DO WHILE !Eof()
? " ", FieldGet(1), AllTrim(FieldGet(2)), FieldGet(3)
dbSkip()
ENDDO
? "(expect: 1 Alice 100, 2 Bob 200, 3 Carol 300)"
SELECT del
dbCloseArea()
SELECT mas
dbCloseArea()
FErase( "mas.dbf" )
FErase( "del.dbf" )
? "DONE"
RETURN