diff --git a/compiler/pp/std.ch b/compiler/pp/std.ch index 57dc86f..cd762ba 100644 --- a/compiler/pp/std.ch +++ b/compiler/pp/std.ch @@ -101,18 +101,25 @@ /* --- console output --- LIST emits every record matching the filter; DISPLAY without ALL shows just the current record. Both share __dbList — lAll - distinguishes them. TO PRINTER / TO FILE redirection is not yet - implemented; the stub rules below surface a clear error rather - than silently sending output to stdout when a printer/file was - requested. Order matters: more specific rules first. */ + distinguishes them. TO FILE redirects to a freshly-truncated text + file; TO PRINTER is rejected at PP-time (Five doesn't drive a + printer port). Order matters: more specific rules first. */ #command LIST [] TO PRINTER [<*tail*>] => ; __dbNotImpl("LIST ... TO PRINTER") -#command LIST [] TO FILE <(f)> [<*tail*>] => ; - __dbNotImpl("LIST ... TO FILE") #command DISPLAY [] TO PRINTER [<*tail*>] => ; __dbNotImpl("DISPLAY ... TO PRINTER") -#command DISPLAY [] TO FILE <(f)> [<*tail*>] => ; - __dbNotImpl("DISPLAY ... TO FILE") + +#command LIST [] TO FILE <(f)> [] ; + [FOR ] [WHILE ] [NEXT ] ; + [RECORD ] [] [ALL] => ; + __dbList( <.off.>, { <{v}> }, .T., ; + <{for}>, <{while}>, , , <.rest.>, <(f)> ) + +#command DISPLAY [] TO FILE <(f)> [] ; + [FOR ] [WHILE ] [NEXT ] ; + [RECORD ] [] [] => ; + __dbList( <.off.>, { <{v}> }, <.all.>, ; + <{for}>, <{while}>, , , <.rest.>, <(f)> ) #command LIST [] [] ; [FOR ] [WHILE ] [NEXT ] ; diff --git a/hbrtl/database.go b/hbrtl/database.go index e9a8a41..ce17d98 100644 --- a/hbrtl/database.go +++ b/hbrtl/database.go @@ -1214,20 +1214,21 @@ func rtlDbSort(t *hbrt.Thread) { } // rtlDbList implements __dbList(lOff, aBlocks, lAll, bFor, bWhile, -// nNext, nRec, lRest, lPrn, cFile) — output visible records to -// stdout. aBlocks is an array of column-evaluation code blocks (one -// per LIST / DISPLAY column expression). If aBlocks is empty or -// contains only NIL placeholders, every field of the current -// workarea is emitted. +// nNext, nRec, lRest, cFile) — output visible records to stdout, or +// to the named file when cFile is non-empty. aBlocks is an array of +// column-evaluation code blocks (one per LIST / DISPLAY column +// expression). If aBlocks is empty or contains only NIL placeholders, +// every field of the current workarea is emitted. // // Used by both `LIST []` and `DISPLAY []` in std.ch. // lAll distinguishes them: LIST always passes .T. (all matching // records); DISPLAY passes .T. only for `DISPLAY ALL`, otherwise .F. // (just the current record). // -// TO PRINTER / TO FILE redirection (lPrn / cFile) is accepted but -// not yet implemented — both paths still write to stdout. OFF (lOff) -// suppresses the record-number prefix. +// TO FILE <(f)> redirects output into a freshly-truncated text file +// (one record per line, fields space-separated). TO PRINTER is +// rejected at PP-time via __dbNotImpl — Five doesn't drive a +// printer port. OFF (lOff) suppresses the record-number prefix. func rtlDbList(t *hbrt.Thread) { nParams := t.ParamCount() t.Frame(nParams, 0) @@ -1298,6 +1299,28 @@ func rtlDbList(t *hbrt.Thread) { srcArea.GoTop() } + // param 9: cFile — when non-empty, redirect output into the named + // text file. The previous file is truncated. We deliberately keep + // the file open across the loop so the OS doesn't see N opens for + // N rows; close on exit. On open failure: fall back to stdout + // rather than producing partial output to nowhere. + var sink interface { + Write([]byte) (int, error) + } = os.Stdout + if nParams >= 9 && t.Local(9).IsString() { + if cFile := strings.TrimSpace(t.Local(9).AsString()); cFile != "" { + f, err := os.Create(cFile) + if err != nil { + panic(&hbrt.HbError{ + Description: "LIST/DISPLAY TO FILE: cannot create " + cFile + " — " + err.Error(), + SubSystem: "BASE", + }) + } + defer f.Close() + sink = f + } + } + nFields := srcArea.FieldCount() scanned := 0 for !srcArea.EOF() { @@ -1344,8 +1367,10 @@ func rtlDbList(t *hbrt.Thread) { } // 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, " ")) + // terminals handle CR conversion themselves. Goes to the + // chosen sink (stdout by default, the file when TO FILE + // was used). + fmt.Fprintln(sink, strings.Join(parts, " ")) } srcArea.Skip(1) scanned++ diff --git a/tests/std_ch/run.sh b/tests/std_ch/run.sh index acbf05a..5b68c60 100755 --- a/tests/std_ch/run.sh +++ b/tests/std_ch/run.sh @@ -23,6 +23,7 @@ TESTS=( test_copy test_sort test_list + test_list_to_file test_total test_join test_update diff --git a/tests/std_ch/test_list_to_file.prg b/tests/std_ch/test_list_to_file.prg new file mode 100644 index 0000000..cc271a8 --- /dev/null +++ b/tests/std_ch/test_list_to_file.prg @@ -0,0 +1,73 @@ +/* LIST / DISPLAY TO FILE — text output redirected to a file. */ + +PROCEDURE Main() + LOCAL aStruct, cBuf, e + + FErase("p.dbf") + FErase("out.txt") + + aStruct := { ; + { "ID", "N", 4, 0 }, ; + { "NAME", "C", 10, 0 }, ; + { "AGE", "N", 3, 0 } } + dbCreate("p.dbf", aStruct) + USE p.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 TO FILE — full table */ + dbGoTop() + LIST TO FILE out.txt + + cBuf := MemoRead("out.txt") + ? "1. file size:", Len(cBuf), "bytes (expect > 0)" + IF Len(cBuf) == 0 + ? "FAIL: empty output file" + RETURN + ENDIF + ? "1. file content:" + ? cBuf + + /* 2. DISPLAY TO FILE — single record */ + FErase("out.txt") + dbGoto(2) + DISPLAY TO FILE out.txt + + cBuf := MemoRead("out.txt") + ? "2. DISPLAY single-row file:" + ? cBuf + IF !("Bob" $ cBuf) + ? "FAIL: Bob row missing" + RETURN + ENDIF + + /* 3. LIST TO FILE with OFF + FOR — std.ch pattern order is + `[] [FOR ]`, same as Harbour. */ + FErase("out.txt") + dbGoTop() + LIST p->id, p->name TO FILE out.txt OFF FOR p->age >= 25 + + cBuf := MemoRead("out.txt") + ? "3. selective+OFF file:" + ? cBuf + IF "Alice" $ cBuf + ? "FAIL: Alice (age 18) shouldn't be in FOR age>=25 output" + RETURN + ENDIF + + /* 4. TO PRINTER — should still reject */ + e := .F. + BEGIN SEQUENCE + LIST TO PRINTER + RECOVER + e := .T. + END SEQUENCE + ? "4. TO PRINTER rejected:", e, "(expect .T.)" + + dbCloseArea() + FErase("p.dbf") + FErase("out.txt") + ? "DONE" + RETURN