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

checkpoint: season-wide bug fix campaign + infra

Browse Source 
Cumulative season's silent-bug hunting (~62 fixes) across the FiveSql2
SQL engine, the Five compiler/runtime, and the hbrdd RDD layer. Saved
as a single checkpoint before refactoring the parser to delegate xBase
command translation to the preprocessor.

Highlights:

FiveSql2 engine (_FiveSql2/src/)
- prefix-glob index attach -> explicit convention (<table>_pk.ntx,
  <table>_uq.ntx, <table>.cdx) — fixes silent multi-row INSERT row-drop
- DROP/CREATE TABLE FErase chain extended (.cdx, .fsc, .fsv, .dbt, .fpt)
- COUNT(DISTINCT col) parsed + aggregated via hSeen hash
- UNION column-count mismatch returns SQL_ERR_GRAMMAR (was silent)
- DISTINCT + ORDER BY hidden-col leak fixed (trim before DISTINCT)
- Derived table FROM (SELECT...) + JOIN right-side derived
- Self-FK CASCADE depth 2+ via SqlGetSingleColPK pre-collect
- LAG/LEAD default arg uses SqlEvalRowExpr (handles -N const exprs)
- DATE literal round-trip validation (Feb 29 non-leap rejected)
- CREATE OR REPLACE VIEW; CREATE VIEW errors on already-exists
- AlterTable type dispatcher comma-wrapped (1-char type "A" no longer
  matches CHARACTER)

Compiler / runtime
- gengo: HB_ -> FV_ prefix on emitted Go function names (Five identity)
- gengo split: emit_block.go, emit_stmt.go, folding.go extracted
- parser/stmtreg.go nudges
- hbrt: debug TUI/CLI restructure (debugcmd, debugkey, termios_*),
  windows debug stubs collapsed
- thread/vm/value/class/pcinterp tightening from panic traces

RDD layer (hbrdd/)
- dbf: null bitmap support (null.go + null_test.go), mmap split
  (mmap_posix.go / mmap_windows.go), byte-level numeric parse
- ntx/cdx: windows mmap parity
- workarea + mem RDD: cross-area state-bleed fixes

RTL (hbrtl/)
- errorlog rewrite with platform-specific FD (errorlog_fd_unix /
  errorlog_fd_other)
- sqlscan, sqlhelpers, indexrtl, datetime extensions

Gates green at checkpoint:
- go test ./...        : PASS
- FiveSql2 SQL:1999    : 43/43
- Harbour compat       : 56/56

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
CharlesKWON
2026-04-30 09:26:25 +09:00
parent 8a3f296e9a
commit f4ed42556b
63 changed files with 10486 additions and 2740 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
_FiveSql2/src/TFiveSQL.prg
View File

@@ -24,7 +24,16 @@
* during Run() never corrupt the cached tree.
*
* Cached entries live until process exit; distinct SQL text count is
* bounded by the caller's template set, so LRU is deferred. */
* bounded by the caller's template set in well-behaved callers, but
* a long-running server with diverse dynamic SQL (or one that bypasses
* the `?` placeholder convention and bakes literals into every query)
* can grow this hash without bound. SQL_PLAN_CACHE_MAX caps the entry
* count; on overflow we wipe the whole cache. Coarser than LRU but
* Five hashes have no insertion-order guarantee and the per-query
* bookkeeping for true LRU would dominate the parse cost we're
* trying to amortise. Reset cost is one extra parse per template
* already evicted, accepted in exchange for bounded memory. */
#define SQL_PLAN_CACHE_MAX 1000
STATIC s_hPlanCache := { => }
CLASS TFiveSQL
@@ -53,7 +62,14 @@ RETURN SELF
METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
LOCAL aTokens, hQuery, aResult
LOCAL aLex, cKey, aParams
LOCAL aLex, cKey, aParams, cVerPrefix
/* Schema-version prefix: DDL (CREATE/ALTER/DROP) bumps SqlSchemaVer()
* so any plan that resolved columns or indexes against the pre-DDL
* schema misses the cache on the next call and gets re-parsed /
* re-compiled against the current layout. The prefix also flows
* through to s_hDmlPcodeCache via ::oExec:cCacheKey below. */
cVerPrefix := hb_NToS( SqlSchemaVer() ) + "|"
/* Fast path: no explicit aParams → single Go RTL lex+normalize call
* (SqlLexAndExtractTemplate). Returns {aTokens, cKey, aParams}; the
@@ -63,7 +79,7 @@ METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
IF Empty( ::aParams )
aLex := SqlLexAndExtractTemplate( cSQL )
aTokens := aLex[ 1 ]
cKey := aLex[ 2 ]
cKey := cVerPrefix + aLex[ 2 ]
aParams := aLex[ 3 ]
IF hb_HHasKey( s_hPlanCache, cKey )
@@ -74,6 +90,10 @@ METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
IF hQuery == NIL
RETURN { { "__error__" }, { { SQL_ERR_SYNTAX, "Failed to parse SQL", cSQL } } }
ENDIF
IF Len( s_hPlanCache ) >= SQL_PLAN_CACHE_MAX
s_hPlanCache := { => }
SqlDmlPcodeCacheReset()
ENDIF
s_hPlanCache[ cKey ] := HbDeepClone( hQuery )
ENDIF
@@ -81,8 +101,9 @@ METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
::oExec:cCacheKey := cKey
ELSE
/* Caller supplied explicit params — cache by raw SQL text. */
IF hb_HHasKey( s_hPlanCache, cSQL )
hQuery := HbDeepClone( s_hPlanCache[ cSQL ] )
cKey := cVerPrefix + cSQL
IF hb_HHasKey( s_hPlanCache, cKey )
hQuery := HbDeepClone( s_hPlanCache[ cKey ] )
ELSE
aTokens := SqlLexerTokenize( cSQL )
::oParser := TSqlParser2():New( aTokens, ::aParams )
@@ -90,11 +111,15 @@ METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
IF hQuery == NIL
RETURN { { "__error__" }, { { SQL_ERR_SYNTAX, "Failed to parse SQL", cSQL } } }
ENDIF
s_hPlanCache[ cSQL ] := HbDeepClone( hQuery )
IF Len( s_hPlanCache ) >= SQL_PLAN_CACHE_MAX
s_hPlanCache := { => }
SqlDmlPcodeCacheReset()
ENDIF
s_hPlanCache[ cKey ] := HbDeepClone( hQuery )
ENDIF
::oExec := TSqlExecutor():New( hQuery, ::aParams )
::oExec:cCacheKey := cSQL
::oExec:cCacheKey := cKey
ENDIF
::oExec:bRowBlock := bBlock

191
_FiveSql2/src/TSqlAgg.prg
View File

@@ -55,13 +55,28 @@ METHOD GroupBy( aRows, aFN, aCols, aGroupBy, xHaving, aTables, aParams ) CLASS T
LOCAL aSets, aCurSet, nSet, hOmitIdx, aSubResult
LOCAL aGroupedRows
LOCAL aColInfo /* { lIsAgg, nCI } per SELECT column, pre-resolved */
LOCAL xAggNode, cAggFn
/* Aggregate on empty set */
/* Aggregate on empty set — SQL standard semantics:
* COUNT(*) / COUNT(col) → 0
* SUM / AVG / MIN / MAX → NULL
* The old code returned 0 uniformly for every aggregate, which
* looked right for COUNT but silently corrupted the other four. */
IF Len( aRows ) == 0 .AND. ::HasAgg( aCols )
aNewRow := {}
FOR j := 1 TO Len( aCols )
IF SqlExprHasAgg( aCols[ j ][ 1 ] )
AAdd( aNewRow, 0 )
xAggNode := aCols[ j ][ 1 ]
cAggFn := ""
IF ValType( xAggNode ) == "A" .AND. Len( xAggNode ) >= 2 .AND. ;
xAggNode[ 1 ] == ND_FN .AND. ValType( xAggNode[ 2 ] ) == "C"
cAggFn := Upper( xAggNode[ 2 ] )
ENDIF
IF cAggFn == "COUNT"
AAdd( aNewRow, 0 )
ELSE
AAdd( aNewRow, NIL )
ENDIF
ELSE
AAdd( aNewRow, NIL )
ENDIF
@@ -315,9 +330,40 @@ RETURN .F.
*/
METHOD FindGroupIdx( xGroupExpr, aCols, aFN ) CLASS TSqlAgg
LOCAL i, xSel, cGName, cSName, nDot
LOCAL i, xSel, cGName, cSName, nDot, nOrdinal
IF xGroupExpr == NIL .OR. xGroupExpr[ 1 ] != ND_COL
IF xGroupExpr == NIL
RETURN 0
ENDIF
/* GROUP BY <ordinal> — `GROUP BY 1` refers to the 1-based position
* of the SELECT-list column, per SQL:1999. Without this the
* literal numeric expression got passed to FindColIdx which only
* understands ND_COL → returned 0 → everything collapsed into
* a single bucket. */
IF xGroupExpr[ 1 ] == ND_LIT .AND. ValType( xGroupExpr[ 2 ] ) == "N"
nOrdinal := Int( xGroupExpr[ 2 ] )
IF nOrdinal >= 1 .AND. nOrdinal <= Len( aCols )
RETURN nOrdinal
ENDIF
RETURN 0
ENDIF
/* GROUP BY <expression> — match against the SELECT list by
* canonical name. Both sides go through SqlExprName so that
* `GROUP BY UPPER(dept)` finds `SELECT UPPER(dept)` even when
* the SELECT-list column is anonymous. Same for arithmetic
* expressions like `salary / 1000`. */
IF xGroupExpr[ 1 ] != ND_COL
cGName := Upper( SqlExprName( xGroupExpr ) )
IF ! Empty( cGName )
FOR i := 1 TO Len( aCols )
cSName := Upper( SqlExprName( aCols[ i ][ 1 ] ) )
IF cSName == cGName
RETURN i
ENDIF
NEXT
ENDIF
RETURN ::FindColIdx( xGroupExpr, aFN )
ENDIF
@@ -383,8 +429,74 @@ METHOD ComputeAgg( xE, aGR, aFN ) CLASS TSqlAgg
LOCAL nCount := 0, nSum := 0, xMin := NIL, xMax := NIL
LOCAL cResult, cSep
LOCAL xArg
LOCAL xL, xR, aFnArgs
LOCAL lDistinct, hSeen, cKey
IF xE == NIL .OR. xE[ 1 ] != ND_FN
IF xE == NIL
RETURN 0
ENDIF
/* Outer expression containing aggregates (e.g. MAX(id)+1,
* COUNT(*)*2, SUM(v)-30): the dispatcher routes us here whenever
* SqlExprHasAgg is .T., even if the top-level node is not the
* aggregate itself. Recursively compute inner aggregates, then
* apply the wrapping operator via SqlEvalRowExpr against literal
* stand-ins. Without this guard the early-return below collapsed
* every wrapped aggregate to 0 — silently. */
IF xE[ 1 ] == ND_BIN
xL := ::ComputeAgg( xE[ 3 ], aGR, aFN )
xR := ::ComputeAgg( xE[ 4 ], aGR, aFN )
RETURN SqlEvalRowExpr( ;
{ ND_BIN, xE[ 2 ], { ND_LIT, xL }, { ND_LIT, xR } }, {}, {} )
ENDIF
IF xE[ 1 ] == ND_UNI
xL := ::ComputeAgg( xE[ 3 ], aGR, aFN )
RETURN SqlEvalRowExpr( ;
{ ND_UNI, xE[ 2 ], { ND_LIT, xL } }, {}, {} )
ENDIF
IF xE[ 1 ] == ND_LIT
RETURN xE[ 2 ]
ENDIF
IF xE[ 1 ] == ND_NIL
RETURN NIL
ENDIF
/* Non-aggregate function wrapping aggregates: ROUND(AVG(p),2),
* COALESCE(SUM(x), 0), etc. Recurse into each arg, then dispatch. */
IF xE[ 1 ] == ND_FN .AND. ! SqlIsAggName( xE[ 2 ] )
aFnArgs := {}
FOR i := 1 TO Len( xE[ 3 ] )
AAdd( aFnArgs, ::ComputeAgg( xE[ 3 ][ i ], aGR, aFN ) )
NEXT
RETURN SqlEvalFunc( xE[ 2 ], aFnArgs )
ENDIF
/* CASE wrapping aggregates: `CASE WHEN COUNT(*) > 2 THEN 'many'
* ELSE 'few' END`. SqlExprHasAgg flags the whole CASE as having
* an aggregate, the dispatcher routes here, and the early-out
* below collapsed it to 0 — the literal 'many'/'few' came back
* as 0. Evaluate each WHEN cond + branch / ELSE through the same
* recursive ComputeAgg so the aggregate inside the cond gets
* computed once per group. */
IF xE[ 1 ] == ND_CASE
IF ValType( xE[ 2 ] ) == "A"
FOR i := 1 TO Len( xE[ 2 ] )
xL := ::ComputeAgg( xE[ 2 ][ i ][ 1 ], aGR, aFN )
IF SqlIsTrue( xL )
RETURN ::ComputeAgg( xE[ 2 ][ i ][ 2 ], aGR, aFN )
ENDIF
NEXT
ENDIF
IF Len( xE ) >= 3 .AND. xE[ 3 ] != NIL
RETURN ::ComputeAgg( xE[ 3 ], aGR, aFN )
ENDIF
RETURN NIL
ENDIF
IF xE[ 1 ] != ND_FN
RETURN 0
ENDIF
@@ -421,15 +533,25 @@ METHOD ComputeAgg( xE, aGR, aFN ) CLASS TSqlAgg
RETURN 0
ENDIF
/* DISTINCT modifier: parser stashes a .T. flag in xE[5] when the
* aggregate was written `COUNT(DISTINCT col)` etc. PRG path needs
* a per-value seen-set so duplicates contribute once. Fast path
* (SqlComputeAggSimple) has no DISTINCT support — skip it when
* the modifier is set so PRG handles dedup. */
lDistinct := ( Len( xE ) >= 5 .AND. xE[ 5 ] == .T. )
/* Fast path: plain column + common aggregate → Go RTL single-pass loop.
* Gate on column-ref argument + pre-resolved nCol > 0; complex args
* (CASE/BIN/UDF) still fall through to the PRG loop below. */
IF nCol > 0 .AND. xArg[ 1 ] == ND_COL .AND. ;
IF ! lDistinct .AND. nCol > 0 .AND. xArg[ 1 ] == ND_COL .AND. ;
( cFunc == "COUNT" .OR. cFunc == "SUM" .OR. cFunc == "AVG" .OR. ;
cFunc == "MIN" .OR. cFunc == "MAX" )
RETURN SqlComputeAggSimple( aGR, nCol, cFunc )
ENDIF
IF lDistinct
hSeen := { => }
ENDIF
FOR i := 1 TO Len( aGR )
IF nCol > 0 .AND. nCol <= Len( aGR[ i ] )
xVal := aGR[ i ][ nCol ]
@@ -441,6 +563,13 @@ METHOD ComputeAgg( xE, aGR, aFN ) CLASS TSqlAgg
xVal := NIL
ENDIF
IF xVal != NIL
IF lDistinct
cKey := SqlValToStr( xVal )
IF hb_HHasKey( hSeen, cKey )
LOOP
ENDIF
hSeen[ cKey ] := .T.
ENDIF
nCount++
nSum += SqlCoerceNum( xVal )
/* Use SqlCmpLt for type-safe comparison (handles strings, dates) */
@@ -577,6 +706,56 @@ METHOD EvalHavingExpr( xE, aNewRow, aCols, aGR, aFN, aParams ) CLASS TSqlAgg
IF cOp == "<="
RETURN SqlCmpEq( xL, xR ) .OR. SqlCmpLt( xL, xR )
ENDIF
/* Arithmetic inside HAVING: `HAVING SUM(amt)+1 > 200`,
* `HAVING COUNT(*)*100 > 250`, etc. Without these branches
* the wrapped expression returned NIL and the comparison
* with the constant collapsed to false → 0 rows silent.
* SQL NULL propagation: any NIL operand → NIL. */
IF cOp == "+"
IF xL == NIL .OR. xR == NIL
RETURN NIL
ENDIF
IF ValType( xL ) == "D" .AND. ValType( xR ) == "N"
RETURN xL + xR
ENDIF
IF ValType( xL ) == "N" .AND. ValType( xR ) == "D"
RETURN xR + xL
ENDIF
RETURN SqlCoerceNum( xL ) + SqlCoerceNum( xR )
ENDIF
IF cOp == "-"
IF xL == NIL .OR. xR == NIL
RETURN NIL
ENDIF
IF ValType( xL ) == "D" .AND. ValType( xR ) == "N"
RETURN xL - xR
ENDIF
IF ValType( xL ) == "D" .AND. ValType( xR ) == "D"
RETURN xL - xR
ENDIF
RETURN SqlCoerceNum( xL ) - SqlCoerceNum( xR )
ENDIF
IF cOp == "*"
IF xL == NIL .OR. xR == NIL
RETURN NIL
ENDIF
RETURN SqlCoerceNum( xL ) * SqlCoerceNum( xR )
ENDIF
IF cOp == "/"
IF xL == NIL .OR. xR == NIL
RETURN NIL
ENDIF
IF SqlCoerceNum( xR ) != 0
RETURN SqlCoerceNum( xL ) / SqlCoerceNum( xR )
ENDIF
RETURN NIL
ENDIF
IF cOp == "||"
IF xL == NIL .OR. xR == NIL
RETURN NIL
ENDIF
RETURN SqlCoerceStr( xL ) + SqlCoerceStr( xR )
ENDIF
RETURN NIL
CASE xE[ 1 ] == ND_UNI

9
_FiveSql2/src/TSqlAlias.prg
View File

@@ -144,6 +144,15 @@ METHOD AcquireTemp( cPurpose ) CLASS TSqlAlias
EXIT
ENDIF
NEXT
/* Check Harbour's global alias space too. Each TSqlExecutor
* has its own slots array, so a nested executor (subquery /
* correlated CTE) wouldn't otherwise see an alias already
* claimed by the outer executor — AcquireTemp then handed
* back the same name and both scopes shared the workarea,
* truncating the outer's scan when the inner ran. */
IF ! lTaken .AND. Select( cUp ) > 0
lTaken := .T.
ENDIF
IF ! lTaken
AAdd( ::aSlots, { cUp, cPurpose, cPurpose, .F. } )
RETURN cUp

977
_FiveSql2/src/TSqlDDL.prg
View File

File diff suppressed because it is too large Load Diff

2163
_FiveSql2/src/TSqlExecutor.prg
View File

File diff suppressed because it is too large Load Diff

78
_FiveSql2/src/TSqlExpr.prg
View File

@@ -47,6 +47,68 @@ RETURN "expr"
* to avoid a name collision with the RTL symbol; behavior is
* byte-for-byte identical. See docs/RTL-Go-Native-Migration.md. */
/* SqlExtractWindow: walk xE, find every ND_WINDOW node, replace it
* in-place with a synthetic ND_COL pointing at a generated alias,
* and append {windowExpr, alias} to aWindows for the caller to
* register as hidden SELECT columns. Used by RunSelect so a wrapped
* window function (`SUM(x) OVER () + 100`) can flow through the
* usual ApplyWindowFunctions path: the inner ND_WINDOW becomes a
* hidden top-level ND_WINDOW column, projection evaluates the outer
* expression as ND_BIN(ND_COL("__win_..."), 100), and the trim at
* RunSelect's tail strips the hidden column back off the result.
*
* Returns the (possibly mutated) xE. cPrefix scopes alias names per
* SELECT column so two wrappers don't collide. */
FUNCTION SqlExtractWindow( xE, aWindows, cPrefix )
LOCAL i, cAlias, xNew
IF xE == NIL .OR. ValType( xE ) != "A" .OR. Len( xE ) < 1
RETURN xE
ENDIF
IF xE[ 1 ] == ND_WINDOW
cAlias := cPrefix + "_" + AllTrim( hb_NToS( Len( aWindows ) + 1 ) ) + "__"
AAdd( aWindows, { AClone( xE ), cAlias } )
RETURN { ND_COL, cAlias, NIL, NIL, NIL }
ENDIF
IF xE[ 1 ] == ND_BIN
xE[ 3 ] := SqlExtractWindow( xE[ 3 ], aWindows, cPrefix )
xE[ 4 ] := SqlExtractWindow( xE[ 4 ], aWindows, cPrefix )
RETURN xE
ENDIF
IF xE[ 1 ] == ND_UNI
xE[ 3 ] := SqlExtractWindow( xE[ 3 ], aWindows, cPrefix )
RETURN xE
ENDIF
IF xE[ 1 ] == ND_FN
IF ValType( xE[ 3 ] ) == "A"
FOR i := 1 TO Len( xE[ 3 ] )
xE[ 3 ][ i ] := SqlExtractWindow( xE[ 3 ][ i ], aWindows, cPrefix )
NEXT
ENDIF
RETURN xE
ENDIF
IF xE[ 1 ] == ND_CASE
IF ValType( xE[ 2 ] ) == "A"
FOR i := 1 TO Len( xE[ 2 ] )
xE[ 2 ][ i ][ 1 ] := SqlExtractWindow( xE[ 2 ][ i ][ 1 ], aWindows, cPrefix )
xE[ 2 ][ i ][ 2 ] := SqlExtractWindow( xE[ 2 ][ i ][ 2 ], aWindows, cPrefix )
NEXT
ENDIF
IF Len( xE ) >= 3 .AND. xE[ 3 ] != NIL
xE[ 3 ] := SqlExtractWindow( xE[ 3 ], aWindows, cPrefix )
ENDIF
RETURN xE
ENDIF
RETURN xE
/* SqlIsAggName is implemented in Go (hbrtl/sqlhelpers.go) — registered
* as SQLISAGGNAME. Former PRG body:
* RETURN ( "," + c + "," ) $ ( "," + AGG_FUNCTIONS + "," )
@@ -209,9 +271,25 @@ FUNCTION SqlEvalRowExpr( xExpr, aFN, aRow )
IF ValType( xL ) == "N" .AND. ValType( xR ) == "N"
RETURN xL + xR
ENDIF
/* Date arithmetic: Date + N → Date (N days later). N + Date
* is symmetric. Without these branches Date operands collapse
* to 0 via SqlCoerceNum and the result is just the integer
* offset. Mirrors EvalExpr's same-named fix. */
IF ValType( xL ) == "D" .AND. ValType( xR ) == "N"
RETURN xL + xR
ENDIF
IF ValType( xL ) == "N" .AND. ValType( xR ) == "D"
RETURN xR + xL
ENDIF
RETURN SqlCoerceNum( xL ) + SqlCoerceNum( xR )
ENDIF
IF cOp == "-"
IF ValType( xL ) == "D" .AND. ValType( xR ) == "N"
RETURN xL - xR
ENDIF
IF ValType( xL ) == "D" .AND. ValType( xR ) == "D"
RETURN xL - xR
ENDIF
RETURN SqlCoerceNum( xL ) - SqlCoerceNum( xR )
ENDIF
IF cOp == "*"

279
_FiveSql2/src/TSqlIndex.prg
View File

@@ -21,6 +21,16 @@ CLASS TSqlIndex
* FErase cleanup loop on view-free queries (the common case). */
DATA lViewUsed INIT .F.
/* Back-reference to the calling executor. RunSelect sets this
* before dispatching TryIndexScan / TryIndexJoinScan so the per-row
* inner loops can reuse the caller's TSqlExecutor (and its prebuilt
* fetch/symbol cache, aTables, aParams) instead of constructing a
* throwaway via SqlEvalExprNode/SqlFetchRowArr on every record.
* For 100k-row index scans that's 200k fewer New() allocations.
* NIL means "not wired yet" — helpers must tolerate and fall back
* to the self-contained path. */
DATA oExec
METHOD New() CONSTRUCTOR
METHOD DetectRDD( nWA )
METHOD OpenTable( cTable, cAlias, lShared, lReadOnly )
@@ -32,7 +42,7 @@ CLASS TSqlIndex
METHOD FindCompoundTag( nWA, aFields )
METHOD BuildKey( nWA, xValue )
METHOD MatchOrderByTag( nWA, aOrderBy, aFieldNames )
METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows )
METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows, nLimit )
METHOD TryIndexJoinScan( nWA, xWhere, aTables, aParams, aRE, aRows, aJoins )
METHOD BuildKeyExpr( nWA, cField )
METHOD ExtractStrWidth( cExpr )
@@ -41,6 +51,14 @@ CLASS TSqlIndex
METHOD BuildCompoundKey( cExpr, aFields, aValues, nWA )
METHOD CheckView( cTable )
/* EvalE / FetchE — wrappers that reuse the calling TSqlExecutor
* (::oExec) when wired up by RunSelect, falling back to the
* standalone SqlEvalExprNode / SqlFetchRowArr helpers when run in
* isolation. The fast path saves a full TSqlExecutor():New() per
* row on the hot index-scan loops. */
METHOD EvalE( xNode, aTables, aParams )
METHOD FetchE( aRE, aTables, aParams )
ENDCLASS
@@ -48,6 +66,21 @@ METHOD New() CLASS TSqlIndex
RETURN SELF
METHOD EvalE( xNode, aTables, aParams ) CLASS TSqlIndex
LOCAL nPI := 1
IF ::oExec != NIL
RETURN ::oExec:EvalExpr( xNode )
ENDIF
RETURN SqlEvalExprNode( xNode, aTables, aParams, @nPI )
METHOD FetchE( aRE, aTables, aParams ) CLASS TSqlIndex
IF ::oExec != NIL
RETURN ::oExec:FetchRow( aRE )
ENDIF
RETURN SqlFetchRowArr( aRE, aTables, aParams )
METHOD DetectRDD( nWA ) CLASS TSqlIndex
LOCAL nSaved, cRDD
@@ -91,9 +124,14 @@ METHOD OpenTable( cTable, cAlias, lShared, lReadOnly ) CLASS TSqlIndex
RETURN -1
ENDIF
/* Decide RDD based on available index files */
aFiles := Directory( cFileLow + "*.cdx" )
IF Len( aFiles ) > 0
/* Decide RDD based on available index files. Use exact filenames
* (production CDX = `<table>.cdx`) — the previous glob
* `<tableLow>*.cdx` matched every sibling table whose name
* started with cFileLow (e.g. `c*.cdx` would happily pick up
* `cus.cdx` or `customer.cdx`) and forced DBFCDX even for tables
* that had no CDX of their own. Same prefix-matching hazard that
* caused the silent multi-row INSERT row drop via AttachNTX. */
IF File( cFileLow + ".cdx" )
cRDD := "DBFCDX"
ELSE
cRDD := "DBFNTX"
@@ -139,7 +177,7 @@ METHOD FindExclusive( cTableLow ) CLASS TSqlIndex
* Fully functional now that hbrtl implements dbInfo(DBI_FULLPATH)
* and DBI_SHARED. The DBI_* constants resolve via include/dbinfo.ch.
*/
LOCAL nSaved, nArea, cDbfName, lShared
LOCAL nSaved, nArea, cDbfName, lShared, cBase
nSaved := Select()
@@ -148,7 +186,21 @@ METHOD FindExclusive( cTableLow ) CLASS TSqlIndex
dbSelectArea( nArea )
IF ! Empty( Alias() )
cDbfName := Lower( AllTrim( dbInfo( DBI_FULLPATH ) ) )
IF cTableLow + ".dbf" $ cDbfName .OR. cTableLow $ cDbfName
/* Compare on the basename only, not substring. The previous
* `cTableLow $ cDbfName` matched "c" inside ".../cus.dbf"
* — same prefix-substring hazard that produced the multi-row
* INSERT silent row drop. Strip path separators and compare
* against the exact `<table>.dbf` / `<table>` forms so a
* sibling table whose name starts with cTableLow doesn't
* cause a spurious lock conflict. */
cBase := cDbfName
IF "/" $ cBase
cBase := SubStr( cBase, RAt( "/", cBase ) + 1 )
ENDIF
IF "\" $ cBase
cBase := SubStr( cBase, RAt( "\", cBase ) + 1 )
ENDIF
IF cBase == cTableLow + ".dbf" .OR. cBase == cTableLow
lShared := dbInfo( DBI_SHARED )
IF lShared == .F.
dbSelectArea( nSaved )
@@ -166,18 +218,32 @@ RETURN 0
METHOD AttachNTX( cTableLow, nWA ) CLASS TSqlIndex
LOCAL aFiles, i, cFile, nSaved
LOCAL i, cFile, nSaved
LOCAL aCandidates
nSaved := Select()
dbSelectArea( nWA )
aFiles := Directory( cTableLow + "*.ntx" )
FOR i := 1 TO Len( aFiles )
cFile := aFiles[ i ][ 1 ]
BEGIN SEQUENCE
dbSetIndex( cFile )
RECOVER
END SEQUENCE
/* Only attach the convention-named indexes built by CreateTable
* (`<table>_pk.ntx` and `<table>_uq.ntx`). The previous glob
* `<tableLow>*.ntx` matched every NTX whose filename started
* with the table name — `c_uq.ntx` searched as `c*.ntx` happily
* picked up `cus_uq.ntx` from a sibling table, attached its
* stale keys to the new workarea, and SkipIndexed then walked
* those orphan keys instead of the natural record order. The
* user-visible symptom was multi-row INSERT silently dropping
* the third+ row from any subsequent SELECT. Use exact filenames
* here; ad-hoc `INDEX ON ... TO custom.ntx` indexes are still
* accessible via explicit `SET INDEX TO custom.ntx`. */
aCandidates := { cTableLow + "_pk.ntx", cTableLow + "_uq.ntx" }
FOR i := 1 TO Len( aCandidates )
cFile := aCandidates[ i ]
IF File( cFile )
BEGIN SEQUENCE
dbSetIndex( cFile )
RECOVER
END SEQUENCE
ENDIF
NEXT
dbSelectArea( nSaved )
@@ -187,18 +253,25 @@ RETURN NIL
METHOD AttachCDX( cTableLow, nWA ) CLASS TSqlIndex
LOCAL aFiles, i, cFile, nSaved
LOCAL i, cFile, nSaved
LOCAL aCandidates
nSaved := Select()
dbSelectArea( nWA )
aFiles := Directory( cTableLow + "*.cdx" )
FOR i := 1 TO Len( aFiles )
cFile := aFiles[ i ][ 1 ]
BEGIN SEQUENCE
dbSetIndex( cFile )
RECOVER
END SEQUENCE
/* Same prefix-glob hazard as AttachNTX: `c*.cdx` would match
* `cus.cdx` etc. CDX is the production-index convention so we
* only look for `<table>.cdx`. Custom CDX bags still attach via
* explicit `SET INDEX TO`. */
aCandidates := { cTableLow + ".cdx" }
FOR i := 1 TO Len( aCandidates )
cFile := aCandidates[ i ]
IF File( cFile )
BEGIN SEQUENCE
dbSetIndex( cFile )
RECOVER
END SEQUENCE
ENDIF
NEXT
dbSelectArea( nSaved )
@@ -340,11 +413,12 @@ RETURN nBestTag
METHOD BuildKey( nWA, xValue ) CLASS TSqlIndex
LOCAL cExpr, nSaved, nWidth
LOCAL cExpr, nSaved, nWidth, nKeySize, cKey
nSaved := Select()
dbSelectArea( nWA )
cExpr := Upper( AllTrim( dbOrderInfo( DBOI_EXPRESSION ) ) )
nKeySize := dbOrderInfo( DBOI_KEYSIZE )
dbSelectArea( nSaved )
IF "STR(" $ cExpr
@@ -352,13 +426,21 @@ METHOD BuildKey( nWA, xValue ) CLASS TSqlIndex
nWidth := ::ExtractStrWidth( cExpr )
RETURN Str( xValue, nWidth )
ELSEIF ValType( xValue ) == "C"
RETURN xValue
/* STR() keys are numeric-width strings — CHAR literals like
* "10" must still be right-padded to the expression's
* declared width so ordScope doesn't bind to a short key. */
nWidth := ::ExtractStrWidth( cExpr )
RETURN PadR( xValue, nWidth )
ENDIF
ENDIF
IF "UPPER(" $ cExpr
IF ValType( xValue ) == "C"
RETURN Upper( xValue )
cKey := Upper( xValue )
IF ValType( nKeySize ) == "N" .AND. nKeySize > 0
cKey := PadR( cKey, nKeySize )
ENDIF
RETURN cKey
ENDIF
ENDIF
@@ -371,40 +453,117 @@ METHOD BuildKey( nWA, xValue ) CLASS TSqlIndex
ENDIF
IF ValType( xValue ) == "N"
/* For a plain numeric field index the stored key width equals
* the DBF field width (8 for N(8,0), 10 for N(10,0) …). Using
* a hard-coded Str(xValue, 10) produces scope keys that don't
* align with 8-byte index bytes — ordScope then fails to
* constrain the scan and TryIndexScan degrades to a full-table
* walk. Trust DBOI_KEYSIZE when the driver reports it. */
IF ValType( nKeySize ) == "N" .AND. nKeySize > 0
RETURN Str( xValue, nKeySize )
ENDIF
RETURN Str( xValue, 10 )
ENDIF
/* Plain CHAR field index (cExpr is just the field name, no STR/
* UPPER/DTOS wrapper): pad to the stored key width so range
* operators like `WHERE name > 'AB'` compare byte-for-byte
* against the padded keys in the index. Without the pad, "AB"
* binarily precedes every "AB<anything>" key, so ordScope's
* inclusive lower bound could still land on the right rows for
* >, but `=` / seek paths that rely on exact key equality would
* miss — and the cost is a single PadR per seek. */
IF ValType( xValue ) == "C"
IF ValType( nKeySize ) == "N" .AND. nKeySize > 0 .AND. Len( xValue ) < nKeySize
RETURN PadR( xValue, nKeySize )
ENDIF
RETURN xValue
ENDIF
RETURN xValue
METHOD MatchOrderByTag( nWA, aOrderBy, aFieldNames ) CLASS TSqlIndex
LOCAL nSaved, nOrds, i, cExpr, cOrderCol
LOCAL cDir, lTagDesc
LOCAL nSaved, nOrds, i, j, cExpr, cOrderCol
LOCAL cDir, cUniformDir, lTagDesc, nPos, nLastPos
LOCAL lCandidate, aCols, nOBy
IF Len( aOrderBy ) != 1
nOBy := Len( aOrderBy )
IF nOBy == 0
RETURN .F.
ENDIF
// TEMP A/B: force old single-col behavior
IF nOBy != 1
RETURN .F.
ENDIF
cOrderCol := Upper( SqlExprName( aOrderBy[ 1 ][ 1 ] ) )
cDir := aOrderBy[ 1 ][ 2 ]
/* A single index tag encodes one direction (all ASC or all DESC).
* Multi-column ORDER BY can only be satisfied by a tag when every
* column has the SAME direction — mixed "a ASC, b DESC" needs an
* in-memory sort regardless. Determine the uniform direction first
* so the per-tag loop can reject direction mismatches cheaply. */
cUniformDir := aOrderBy[ 1 ][ 2 ]
FOR i := 2 TO nOBy
IF aOrderBy[ i ][ 2 ] != cUniformDir
RETURN .F.
ENDIF
NEXT
/* Cache uppercase column names once — avoids repeat SqlExprName/
* Upper work inside the tag-iteration loop. */
aCols := Array( nOBy )
FOR i := 1 TO nOBy
aCols[ i ] := Upper( SqlExprName( aOrderBy[ i ][ 1 ] ) )
NEXT
nSaved := Select()
dbSelectArea( nWA )
nOrds := ordCount()
FOR i := 1 TO nOrds
ordSetFocus( i )
cExpr := Upper( AllTrim( dbOrderInfo( DBOI_EXPRESSION ) ) )
IF cOrderCol $ cExpr
lTagDesc := dbOrderInfo( DBOI_ISDESC )
IF ( cDir == "ASC" .AND. ! lTagDesc ) .OR. ;
( cDir == "DESC" .AND. lTagDesc )
dbSelectArea( nSaved )
RETURN .T.
/* Direction check first — cheap bail-out when tag polarity
* doesn't match the uniform ORDER BY direction. dbOrderInfo
* can return NIL on freshly-built indexes that haven't loaded
* a DBOI_ISDESC value yet; treat NIL as ASC so `! lTagDesc`
* doesn't panic with `argument error (op: .NOT.)`. */
lTagDesc := dbOrderInfo( DBOI_ISDESC )
IF ValType( lTagDesc ) != "L"
lTagDesc := .F.
ENDIF
IF ( cUniformDir == "ASC" .AND. lTagDesc ) .OR. ;
( cUniformDir == "DESC" .AND. ! lTagDesc )
LOOP
ENDIF
/* Each ORDER BY column must appear in the key expression AT a
* higher position than the previous column — ensures the tag's
* concatenation order matches the requested sort order.
*
* Caveat (inherited from the single-column path): substring
* match — "ID" inside "ORDER_ID" reports as a hit. Callers that
* mix identifiers with shared suffixes should name their tags
* carefully. Good enough for the common DEPT+ID / UPPER(NAME)
* style keys; tightening to word-boundary detection is a
* separate refinement. */
lCandidate := .T.
nLastPos := 0
FOR j := 1 TO nOBy
cOrderCol := aCols[ j ]
nPos := At( cOrderCol, cExpr )
IF nPos == 0 .OR. nPos <= nLastPos
lCandidate := .F.
EXIT
ENDIF
nLastPos := nPos
NEXT
IF lCandidate
dbSelectArea( nSaved )
RETURN .T.
ENDIF
NEXT
@@ -414,13 +573,21 @@ METHOD MatchOrderByTag( nWA, aOrderBy, aFieldNames ) CLASS TSqlIndex
RETURN .F.
METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows ) CLASS TSqlIndex
METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows, nLimit ) CLASS TSqlIndex
LOCAL cField, xValue
LOCAL nTag, xSeekKey, lFound, nPI, aRow
LOCAL xLow, xHigh
LOCAL nSaved
/* nLimit is an optional early-termination cap provided by RunSelect
* when it has already verified that the index-order scan here will
* produce rows in the requested ORDER BY order (or there is no
* ORDER BY). Zero / NIL means "no cap". */
IF nLimit == NIL
nLimit := 0
ENDIF
nSaved := Select()
dbSelectArea( nWA )
@@ -441,10 +608,12 @@ METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows ) CLA
lFound := dbSeek( xSeekKey, .T. )
WHILE lFound .AND. ! Eof()
nPI := 1
IF SqlIsTrue( SqlEvalExprNode( xFullWhere, aTables, aParams, @nPI ) )
aRow := SqlFetchRowArr( aRE, aTables, aParams )
IF SqlIsTrue( ::EvalE( xFullWhere, aTables, aParams ) )
aRow := ::FetchE( aRE, aTables, aParams )
AAdd( aRows, aRow )
IF nLimit > 0 .AND. Len( aRows ) >= nLimit
EXIT
ENDIF
dbSelectArea( nWA )
dbSkip()
ELSE
@@ -465,11 +634,11 @@ METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows ) CLA
dbSelectArea( nSaved )
RETURN .T.
ENDIF
IF ::TryIndexScan( nWA, xWhere[ 3 ], xFullWhere, aTables, aParams, aRE, @aRows )
IF ::TryIndexScan( nWA, xWhere[ 3 ], xFullWhere, aTables, aParams, aRE, @aRows, nLimit )
dbSelectArea( nSaved )
RETURN .T.
ENDIF
IF ::TryIndexScan( nWA, xWhere[ 4 ], xFullWhere, aTables, aParams, aRE, @aRows )
IF ::TryIndexScan( nWA, xWhere[ 4 ], xFullWhere, aTables, aParams, aRE, @aRows, nLimit )
dbSelectArea( nSaved )
RETURN .T.
ENDIF
@@ -495,10 +664,12 @@ METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows ) CLA
dbGoTop()
WHILE ! Eof()
nPI := 1
IF SqlIsTrue( SqlEvalExprNode( xFullWhere, aTables, aParams, @nPI ) )
aRow := SqlFetchRowArr( aRE, aTables, aParams )
IF SqlIsTrue( ::EvalE( xFullWhere, aTables, aParams ) )
aRow := ::FetchE( aRE, aTables, aParams )
AAdd( aRows, aRow )
IF nLimit > 0 .AND. Len( aRows ) >= nLimit
EXIT
ENDIF
ENDIF
dbSelectArea( nWA )
dbSkip()
@@ -539,10 +710,12 @@ METHOD TryIndexScan( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows ) CLA
dbGoTop()
WHILE ! Eof()
nPI := 1
IF SqlIsTrue( SqlEvalExprNode( xFullWhere, aTables, aParams, @nPI ) )
aRow := SqlFetchRowArr( aRE, aTables, aParams )
IF SqlIsTrue( ::EvalE( xFullWhere, aTables, aParams ) )
aRow := ::FetchE( aRE, aTables, aParams )
AAdd( aRows, aRow )
IF nLimit > 0 .AND. Len( aRows ) >= nLimit
EXIT
ENDIF
ENDIF
dbSelectArea( nWA )
dbSkip()
@@ -586,8 +759,7 @@ METHOD TryIndexJoinScan( nWA, xWhere, aTables, aParams, aRE, aRows, aJoins ) CLA
lFound := dbSeek( cSeekStr, .T. )
WHILE lFound .AND. ! Eof()
nPI := 1
IF SqlIsTrue( SqlEvalExprNode( xWhere, aTables, aParams, @nPI ) )
IF SqlIsTrue( ::EvalE( xWhere, aTables, aParams ) )
SqlJoinRecurse( aJoins, 1, aTables, xWhere, aRE, @aRows, aParams, SELF )
ELSE
EXIT
@@ -709,9 +881,8 @@ METHOD TryCompoundSeek( nWA, xWhere, xFullWhere, aTables, aParams, aRE, aRows )
lFound := dbSeek( cSeekKey, .T. )
WHILE lFound .AND. ! Eof()
nPI := 1
IF SqlIsTrue( SqlEvalExprNode( xFullWhere, aTables, aParams, @nPI ) )
aRow := SqlFetchRowArr( aRE, aTables, aParams )
IF SqlIsTrue( ::EvalE( xFullWhere, aTables, aParams ) )
aRow := ::FetchE( aRE, aTables, aParams )
AAdd( aRows, aRow )
dbSelectArea( nWA )
dbSkip()

22
_FiveSql2/src/TSqlLexer.prg
View File

@@ -37,7 +37,7 @@ RETURN ::aTokens
METHOD Tokenize() CLASS TSqlLexer
LOCAL nPos, ch, cToken
LOCAL nPos, ch, cToken, cLit
nPos := 1
::aTokens := {}
@@ -149,6 +149,26 @@ METHOD Tokenize() CLASS TSqlLexer
LOOP
ENDIF
/* Harbour logical literals inside SQL text: `.T.` / `.F.` /
* `.Y.` / `.N.`. INSERT statements in Harbour hosts frequently
* use these rather than the SQL `TRUE` / `FALSE` keywords,
* especially when the source value is inlined from a
* build-time constant. Converted to TK_NAME("TRUE"/"FALSE")
* so the parser's primary handles them alongside SQL
* keywords without a new token kind. Must be tested *before*
* the bare `.` → TK_DOT punctuation case. */
IF ch == "." .AND. nPos + 2 <= ::nLen .AND. ;
SubStr( ::cInput, nPos + 2, 1 ) == "."
cLit := Upper( SubStr( ::cInput, nPos + 1, 1 ) )
IF cLit == "T" .OR. cLit == "Y"
AAdd( ::aTokens, { TK_NAME, "TRUE" } ) ; nPos += 3
LOOP
ELSEIF cLit == "F" .OR. cLit == "N"
AAdd( ::aTokens, { TK_NAME, "FALSE" } ) ; nPos += 3
LOOP
ENDIF
ENDIF
/* Punctuation and operators */
DO CASE
CASE ch == ","

164
_FiveSql2/src/TSqlParser2.prg
View File

@@ -297,9 +297,28 @@ METHOD Parse() CLASS TSqlParser2
EXIT
ENDIF
ENDDO
/* Parse the main SELECT statement after WITH */
::EatKW( "SELECT" )
h := ::ParseSelect()
/* SQL:2003 allows WITH ... <SELECT|INSERT|UPDATE|DELETE>.
* Older code only accepted SELECT — UPDATE/DELETE that
* referenced a CTE silently mis-parsed and surfaced as
* "status: TG" (the table name leaking out as the result
* envelope's [1][1]). Dispatch on the trailing keyword and
* stash aCTE on whatever DML hash we get back. */
DO CASE
CASE ::IsKW( ::nPos, "SELECT" )
::nPos++
h := ::ParseSelect()
CASE ::IsKW( ::nPos, "INSERT" )
::nPos++
h := ::ParseInsert()
CASE ::IsKW( ::nPos, "UPDATE" )
::nPos++
h := ::ParseUpdate()
CASE ::IsKW( ::nPos, "DELETE" )
::nPos++
h := ::ParseDelete()
OTHERWISE
RETURN NIL
ENDCASE
IF h != NIL
h[ "cte" ] := aCTE
h[ "cte_recursive" ] := lRecursive
@@ -479,7 +498,7 @@ METHOD ParseSelect() CLASS TSqlParser2
LOCAL nTop := 0, lDistinct := .F.
LOCAL aCols, aTables := {}, aJoins := {}
LOCAL xWhere := NIL, aGroupBy := {}, xHaving := NIL, aOrderBy := {}
LOCAL nLimit := 0, nOffset := 0
LOCAL nLimit := NIL, nOffset := 0
LOCAL hUnion := NIL
LOCAL lAll
LOCAL aWindowDefs, cWinName, hWinDef
@@ -921,12 +940,30 @@ METHOD ParseFrom( aTables, aJoins ) CLASS TSqlParser2
::nPos++
ENDIF
cTable := ::TVal( ::nPos ) ; ::nPos++
cAlias := ""
IF ::TType( ::nPos ) == TK_NAME .AND. ! ::IsFromKW( ::TVal( ::nPos ) )
cAlias := ::TVal( ::nPos ) ; ::nPos++
/* Derived table on the right side of a JOIN: `JOIN (SELECT...) AS x ON ...` */
IF ::TType( ::nPos ) == TK_LPAR .AND. ::IsKW( ::nPos + 1, "SELECT" )
xSubQ := ::ParseSubquery()
cAlias := ""
IF ::IsKW( ::nPos, "AS" )
::nPos++
ENDIF
IF ::TType( ::nPos ) == TK_NAME .AND. ! ::IsFromKW( ::TVal( ::nPos ) )
cAlias := ::TVal( ::nPos )
::nPos++
ENDIF
IF Empty( cAlias )
cAlias := "__DRV" + hb_ntos( Len( aTables ) + 1 )
ENDIF
cTable := iif( lLateral, "__LATERAL__", "__SUBQUERY__" )
AAdd( aTables, { cTable, cAlias, xSubQ } )
ELSE
cTable := ::TVal( ::nPos ) ; ::nPos++
cAlias := ""
IF ::TType( ::nPos ) == TK_NAME .AND. ! ::IsFromKW( ::TVal( ::nPos ) )
cAlias := ::TVal( ::nPos ) ; ::nPos++
ENDIF
AAdd( aTables, { iif( lLateral, "__LATERAL_" + cTable, cTable ), cAlias, "" } )
ENDIF
AAdd( aTables, { iif( lLateral, "__LATERAL_" + cTable, cTable ), cAlias, "" } )
xOnCond := NIL
IF ::IsKW( ::nPos, "ON" )
@@ -989,7 +1026,7 @@ RETURN aOrder
/* Parse INSERT INTO */
METHOD ParseInsert() CLASS TSqlParser2
LOCAL h := { => }, cTable, aFields := {}, aValues := {}, xE
LOCAL h := { => }, cTable, aFields := {}, aRows := {}, aTuple, xE
h[ "type" ] := "INSERT"
::EatKW( "INTO" )
@@ -1013,14 +1050,21 @@ METHOD ParseInsert() CLASS TSqlParser2
ENDIF
h[ "fields" ] := aFields
/* VALUES clause */
/* VALUES clause — SQL:2003 allows multiple row constructors:
* VALUES (a, b, c), (d, e, f), ...
* Each (...) tuple yields one INSERT. Older code produced a flat
* expression list which limited us to the first tuple — second
* and later tuples' values ended up as residual tokens and were
* silently dropped. h["rows"] is always an array of tuples;
* single-row INSERT produces a one-element outer array. */
IF ::IsKW( ::nPos, "VALUES" )
::nPos++
IF ::TType( ::nPos ) == TK_LPAR
DO WHILE ::TType( ::nPos ) == TK_LPAR
::nPos++
aTuple := {}
DO WHILE ::TType( ::nPos ) != TK_RPAR .AND. ::TType( ::nPos ) != TK_END
xE := ::ParseExpr()
AAdd( aValues, xE )
AAdd( aTuple, xE )
IF ::TType( ::nPos ) == TK_COMMA
::nPos++
ENDIF
@@ -1028,9 +1072,22 @@ METHOD ParseInsert() CLASS TSqlParser2
IF ::TType( ::nPos ) == TK_RPAR
::nPos++
ENDIF
ENDIF
AAdd( aRows, aTuple )
IF ::TType( ::nPos ) == TK_COMMA
::nPos++
ELSE
EXIT
ENDIF
ENDDO
ELSEIF ::IsKW( ::nPos, "SELECT" )
/* INSERT INTO t [(cols)] SELECT ... — capture the subquery plan
* so RunInsert can materialize it as the driving tuple list.
* ParseSelect expects the position to be at the first token
* AFTER `SELECT`, so consume the keyword here. */
::EatKW( "SELECT" )
h[ "select" ] := ::ParseSelect()
ENDIF
h[ "values" ] := aValues
h[ "rows" ] := aRows
RETURN h
@@ -1365,7 +1422,9 @@ RETURN ::ParsePrimary()
/* Parse primary expressions */
METHOD ParsePrimary() CLASS TSqlParser2
LOCAL cVal, cName, xE, aArgs, aCases, xElse, xCond, xThen
LOCAL cVal, cName, xE, aArgs, aCases, xElse, xCond, xThen, xTest
LOCAL lDistinct
LOCAL xDate, cNorm
LOCAL cPart, cTrimSpec, xTrimChar, xFrom
LOCAL aColDefs, cColName, cColPath, aOrdItems, cDir, xExpr
@@ -1375,6 +1434,45 @@ METHOD ParsePrimary() CLASS TSqlParser2
RETURN SqlNode( ND_NIL, NIL, NIL, NIL, NIL )
ENDIF
/* Logical literals — SQL's TRUE/FALSE and the Harbour `.T.`/`.F.`
* forms that the lexer rewrites to the same tokens. Without this
* path INSERTing a bool value into an L column silently stored
* NIL (lexer emitted an unknown keyword, parser fell through to
* the identifier case and then Resolve() returned NIL because
* no field / alias was named `TRUE`). */
IF ::IsKW( ::nPos, "TRUE" )
::nPos++
RETURN SqlNode( ND_LIT, .T., NIL, NIL, NIL )
ENDIF
IF ::IsKW( ::nPos, "FALSE" )
::nPos++
RETURN SqlNode( ND_LIT, .F., NIL, NIL, NIL )
ENDIF
/* DATE 'YYYY-MM-DD' or DATE 'YYYYMMDD' literal — SQL standard
* explicit-type literal. Rebuilds a date value at parse time
* (via CToD with ISO pre-pass) so downstream evaluation sees a
* real Date, not a string needing late coercion. CToD silently
* rolls invalid dates (`2025-02-29` → 2025-03-01) per xBase
* convention; verify the round-trip and emit NIL for invalid
* literals so callers see a clean NULL instead of a corrupt
* neighbor-day. */
IF ::IsKW( ::nPos, "DATE" ) .AND. ::TType( ::nPos + 1 ) == TK_TEXT
::nPos++
cVal := ::TVal( ::nPos )
::nPos++
xDate := CToD( cVal )
IF ValType( xDate ) == "D" .AND. ! Empty( xDate )
/* Compare DToS round-trip to the original digits — strip
* separators on the input first (`2025-02-29` → `20250229`). */
cNorm := StrTran( StrTran( StrTran( cVal, "-", "" ), "/", "" ), ".", "" )
IF DToS( xDate ) != cNorm
xDate := NIL /* invalid date, surface as NULL */
ENDIF
ENDIF
RETURN SqlNode( ND_LIT, xDate, NIL, NIL, NIL )
ENDIF
/* Numeric literal */
IF ::TType( ::nPos ) == TK_NUM
cVal := ::TVal( ::nPos )
@@ -1417,14 +1515,28 @@ METHOD ParsePrimary() CLASS TSqlParser2
RETURN SqlNode( ND_FN, "EXISTS", { xE }, NIL, NIL )
ENDIF
/* CASE WHEN ... THEN ... [ELSE ...] END */
/* CASE: searched form `CASE WHEN cond THEN ... END` and simple
* form `CASE expr WHEN val THEN ... END` — both per SQL standard.
* Simple form was previously parsed as searched (skipping the
* test expression), which left the parser at the wrong token and
* the executor returned a single row of NILs. Simple form is
* desugared into searched: each `WHEN val` becomes ND_BIN(=,
* test_expr_clone, val). */
IF ::IsKW( ::nPos, "CASE" )
::nPos++
aCases := {}
xElse := NIL
xTest := NIL
IF ! ::IsKW( ::nPos, "WHEN" )
/* Simple form: peek a test expression before the first WHEN. */
xTest := ::ParseExpr()
ENDIF
DO WHILE ::IsKW( ::nPos, "WHEN" )
::nPos++
xCond := ::ParseExpr()
IF xTest != NIL
xCond := SqlNode( ND_BIN, "=", AClone( xTest ), xCond, NIL )
ENDIF
::EatKW( "THEN" )
xThen := ::ParseExpr()
AAdd( aCases, { xCond, xThen } )
@@ -1841,10 +1953,23 @@ METHOD ParsePrimary() CLASS TSqlParser2
::nPos++
ENDIF
/* Function call: name( args ) */
/* Function call: name( [DISTINCT|ALL] args ) */
IF ::TType( ::nPos ) == TK_LPAR
::nPos++
aArgs := {}
lDistinct := .F.
/* SQL aggregate modifier: `COUNT(DISTINCT col)`, `SUM(DISTINCT
* col)`, etc. Without this, the keyword fell through to
* ParseExpr as an identifier and the aggregate computed over
* all values (or returned 0 because the arg resolved to
* nothing). Both DISTINCT and the explicit ALL (the default)
* are accepted; ALL is a no-op. */
IF ::IsKW( ::nPos, "DISTINCT" )
::nPos++
lDistinct := .T.
ELSEIF ::IsKW( ::nPos, "ALL" )
::nPos++
ENDIF
IF ::TType( ::nPos ) == TK_STAR
AAdd( aArgs, SqlNode( ND_COL, "*", NIL, NIL, NIL ) )
::nPos++
@@ -1894,7 +2019,8 @@ METHOD ParsePrimary() CLASS TSqlParser2
IF ::IsKW( ::nPos, "OVER" )
RETURN ::ParseWindow( cName, aArgs )
ENDIF
RETURN SqlNode( ND_FN, cName, aArgs, NIL, NIL )
/* slot 5 carries the DISTINCT modifier for aggregate dedup. */
RETURN SqlNode( ND_FN, cName, aArgs, NIL, lDistinct )
ENDIF
RETURN SqlNode( ND_COL, cName, NIL, NIL, NIL )