mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-29 08:10:56 +01:00
* Patch from Sergei Gorelkin:
+ added TXPathBinaryNode as a common ancestor for binary operations;
+ TXPathBooleanOpNode now handles only 'and' and 'or' operators,
the purpose is to not evaluate the second argument if the result can
be determined by the first argument;
* Comparison operations moved to TXPathCompareNode and fixed
to support INFs and NANs correctly;
* Fixed TranslateWideString() that was not deleting characters;
* Fixed 'substring-after' function so its result is empty when argument
string does not contain the pattern;
* Fixed 'round' funcion so it complies to the specs;
* Completed implementation of 'substring' function (but surrogate pairs
are not handled yet);
* Mask exInvalidOp and exZeroDivide FPU exceptions while evaluating
expressions, this ensures correct calculations with respect to INFs
and NANs.
+ Added testsuite for xpath
git-svn-id: trunk@12961 -
This commit is contained in:
michael
parent
40247d2d87
commit
f641281a7e
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1681,6 +1681,7 @@ packages/fcl-xml/tests/domunit.pp svneol=native#text/plain
|
||||
packages/fcl-xml/tests/template.xml svneol=native#text/plain
|
||||
packages/fcl-xml/tests/testgen.pp svneol=native#text/plain
|
||||
packages/fcl-xml/tests/xmlts.pp svneol=native#text/plain
|
||||
packages/fcl-xml/tests/xpathts.pp svneol=native#text/plain
|
||||
packages/fftw/Makefile svneol=native#text/plain
|
||||
packages/fftw/Makefile.fpc svneol=native#text/plain
|
||||
packages/fftw/examples/example.pas svneol=native#text/plain
|
||||
|
||||
@ -149,37 +149,55 @@ type
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
||||
end;
|
||||
|
||||
// common ancestor for binary operations
|
||||
|
||||
TXPathBinaryNode = class(TXPathExprNode)
|
||||
protected
|
||||
FOperand1, FOperand2: TXPathExprNode;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
// Node for (binary) mathematical operation
|
||||
|
||||
TXPathMathOp = (opAdd, opSubtract, opMultiply, opDivide, opMod);
|
||||
|
||||
TXPathMathOpNode = class(TXPathExprNode)
|
||||
TXPathMathOpNode = class(TXPathBinaryNode)
|
||||
private
|
||||
FOperand1, FOperand2: TXPathExprNode;
|
||||
FOperator: TXPathMathOp;
|
||||
public
|
||||
constructor Create(AOperator: TXPathMathOp;
|
||||
AOperand1, AOperand2: TXPathExprNode);
|
||||
destructor Destroy; override;
|
||||
function Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
||||
end;
|
||||
|
||||
// Node for comparison operations
|
||||
|
||||
TXPathCompareOp = (opEqual, opNotEqual, opLess, opLessEqual, opGreater,
|
||||
opGreaterEqual);
|
||||
|
||||
TXPathCompareNode = class(TXPathBinaryNode)
|
||||
private
|
||||
FOperator: TXPathCompareOp;
|
||||
public
|
||||
constructor Create(AOperator: TXPathCompareOp;
|
||||
AOperand1, AOperand2: TXPathExprNode);
|
||||
function Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
||||
end;
|
||||
|
||||
|
||||
// Node for boolean operations
|
||||
// Node for boolean operations (and, or)
|
||||
|
||||
TXPathBooleanOp = (opEqual, opNotEqual, opLess, opLessEqual, opGreater,
|
||||
opGreaterEqual, opOr, opAnd);
|
||||
TXPathBooleanOp = (opOr, opAnd);
|
||||
|
||||
TXPathBooleanOpNode = class(TXPathExprNode)
|
||||
TXPathBooleanOpNode = class(TXPathBinaryNode)
|
||||
private
|
||||
FOperand1, FOperand2: TXPathExprNode;
|
||||
FOperator: TXPathBooleanOp;
|
||||
public
|
||||
constructor Create(AOperator: TXPathBooleanOp;
|
||||
AOperand1, AOperand2: TXPathExprNode);
|
||||
destructor Destroy; override;
|
||||
function Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
||||
end;
|
||||
@ -187,12 +205,9 @@ type
|
||||
|
||||
// Node for unions (see [18])
|
||||
|
||||
TXPathUnionNode = class(TXPathExprNode)
|
||||
private
|
||||
FOperand1, FOperand2: TXPathExprNode;
|
||||
TXPathUnionNode = class(TXPathBinaryNode)
|
||||
public
|
||||
constructor Create(AOperand1, AOperand2: TXPathExprNode);
|
||||
destructor Destroy; override;
|
||||
function Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
||||
end;
|
||||
@ -509,29 +524,33 @@ end;
|
||||
|
||||
procedure TranslateWideString(var S: DOMString; const SrcPat, DstPat: DOMString);
|
||||
var
|
||||
I, J, K, L: Integer;
|
||||
P: DOMPChar;
|
||||
I, J, L: Integer;
|
||||
P, Start: DOMPChar;
|
||||
begin
|
||||
UniqueString(S);
|
||||
L := Length(DstPat);
|
||||
P := DOMPChar(S);
|
||||
if Length(SrcPat) > L then // may remove some chars
|
||||
begin
|
||||
K := 0;
|
||||
Start := P;
|
||||
for I := 1 to Length(S) do
|
||||
begin
|
||||
J := Pos(S[I], SrcPat);
|
||||
if J > 0 then
|
||||
begin
|
||||
if J <= L then
|
||||
begin
|
||||
P^ := DstPat[J];
|
||||
Inc(P);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
P^ := S[I];
|
||||
Inc(P);
|
||||
Inc(K);
|
||||
Inc(P);
|
||||
end;
|
||||
end;
|
||||
SetLength(S, K);
|
||||
SetLength(S, P-Start);
|
||||
end
|
||||
else // no char removal possible
|
||||
for I := 1 to Length(S) do
|
||||
@ -647,6 +666,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TXPathBinaryNode.Destroy;
|
||||
begin
|
||||
FOperand1.Free;
|
||||
FOperand2.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
constructor TXPathMathOpNode.Create(AOperator: TXPathMathOp;
|
||||
AOperand1, AOperand2: TXPathExprNode);
|
||||
@ -657,13 +682,6 @@ begin
|
||||
FOperand2 := AOperand2;
|
||||
end;
|
||||
|
||||
destructor TXPathMathOpNode.Destroy;
|
||||
begin
|
||||
FOperand1.Free;
|
||||
FOperand2.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TXPathMathOpNode.Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable;
|
||||
var
|
||||
@ -684,10 +702,7 @@ begin
|
||||
opMultiply:
|
||||
NumberResult := Op1 * Op2;
|
||||
opDivide:
|
||||
if IsZero(Op2) then
|
||||
NumberResult := NaN
|
||||
else
|
||||
NumberResult := Op1 / Op2;
|
||||
NumberResult := Op1 / Op2;
|
||||
opMod:
|
||||
NumberResult := Trunc(Op1) mod Trunc(Op2);
|
||||
end;
|
||||
@ -701,7 +716,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
constructor TXPathBooleanOpNode.Create(AOperator: TXPathBooleanOp;
|
||||
constructor TXPathCompareNode.Create(AOperator: TXPathCompareOp;
|
||||
AOperand1, AOperand2: TXPathExprNode);
|
||||
begin
|
||||
inherited Create;
|
||||
@ -710,23 +725,20 @@ begin
|
||||
FOperand2 := AOperand2;
|
||||
end;
|
||||
|
||||
destructor TXPathBooleanOpNode.Destroy;
|
||||
begin
|
||||
FOperand1.Free;
|
||||
FOperand2.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TXPathBooleanOpNode.Evaluate(AContext: TXPathContext;
|
||||
function TXPathCompareNode.Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable;
|
||||
var
|
||||
Op1, Op2: TXPathVariable;
|
||||
e1, e2: Extended;
|
||||
BoolResult: Boolean;
|
||||
|
||||
|
||||
function EvalEqual: Boolean;
|
||||
var
|
||||
i, j: Integer;
|
||||
NodeSet1, NodeSet2: TNodeSet;
|
||||
s: DOMString;
|
||||
e1, e2: Extended;
|
||||
begin
|
||||
// !!!: Doesn't handle nodesets yet!
|
||||
if Op1.InheritsFrom(TXPathNodeSetVariable) then
|
||||
@ -773,13 +785,20 @@ var
|
||||
Result := Op1.AsBoolean = Op2.AsBoolean
|
||||
else if Op1.InheritsFrom(TXPathNumberVariable) or
|
||||
Op2.InheritsFrom(TXPathNumberVariable) then
|
||||
Result := Op1.AsNumber = Op2.AsNumber
|
||||
begin
|
||||
e1 := Op1.AsNumber;
|
||||
e2 := Op2.AsNumber;
|
||||
if IsNan(e1) or IsNan(e2) then
|
||||
Result := False
|
||||
else if IsInfinite(e1) or IsInfinite(e2) then
|
||||
Result := e1 = e2
|
||||
else
|
||||
Result := SameValue(e1, e2);
|
||||
end
|
||||
else
|
||||
Result := Op1.AsText = Op2.AsText; // !!!: Attention with Unicode!
|
||||
end;
|
||||
|
||||
var
|
||||
BoolResult: Boolean;
|
||||
begin
|
||||
Op1 := FOperand1.Evaluate(AContext, AEnvironment);
|
||||
try
|
||||
@ -790,18 +809,22 @@ begin
|
||||
BoolResult := EvalEqual;
|
||||
opNotEqual:
|
||||
BoolResult := not EvalEqual;
|
||||
opLess:
|
||||
BoolResult := Op1.AsNumber < Op2.AsNumber;
|
||||
opLessEqual:
|
||||
BoolResult := Op1.AsNumber <= Op2.AsNumber;
|
||||
opGreater:
|
||||
BoolResult := Op1.AsNumber > Op2.AsNumber;
|
||||
opGreaterEqual:
|
||||
BoolResult := Op1.AsNumber >= Op2.AsNumber;
|
||||
opOr:
|
||||
BoolResult := Op1.AsBoolean or Op2.AsBoolean;
|
||||
opAnd:
|
||||
BoolResult := Op1.AsBoolean and Op2.AsBoolean;
|
||||
else
|
||||
e1 := Op1.AsNumber;
|
||||
e2 := Op2.AsNumber;
|
||||
if IsNan(e1) or IsNan(e2) then
|
||||
BoolResult := False
|
||||
else
|
||||
case FOperator of
|
||||
opLess:
|
||||
BoolResult := e1 < e2;
|
||||
opLessEqual:
|
||||
BoolResult := e1 <= e2;
|
||||
opGreater:
|
||||
BoolResult := e1 > e2;
|
||||
opGreaterEqual:
|
||||
BoolResult := e1 >= e2;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Op2.Release;
|
||||
@ -812,6 +835,42 @@ begin
|
||||
Result := TXPathBooleanVariable.Create(BoolResult);
|
||||
end;
|
||||
|
||||
constructor TXPathBooleanOpNode.Create(AOperator: TXPathBooleanOp;
|
||||
AOperand1, AOperand2: TXPathExprNode);
|
||||
begin
|
||||
inherited Create;
|
||||
FOperator := AOperator;
|
||||
FOperand1 := AOperand1;
|
||||
FOperand2 := AOperand2;
|
||||
end;
|
||||
|
||||
function TXPathBooleanOpNode.Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable;
|
||||
var
|
||||
res: Boolean;
|
||||
Op1, Op2: TXPathVariable;
|
||||
begin
|
||||
{ don't evaluate second arg if result is determined by first one }
|
||||
Op1 := FOperand1.Evaluate(AContext, AEnvironment);
|
||||
try
|
||||
res := Op1.AsBoolean;
|
||||
finally
|
||||
Op1.Release;
|
||||
end;
|
||||
if not (((FOperator = opAnd) and (not res)) or ((FOperator = opOr) and res)) then
|
||||
begin
|
||||
Op2 := FOperand2.Evaluate(AContext, AEnvironment);
|
||||
try
|
||||
case FOperator of
|
||||
opAnd: res := res and Op2.AsBoolean;
|
||||
opOr: res := res or Op2.AsBoolean;
|
||||
end;
|
||||
finally
|
||||
Op2.Release;
|
||||
end;
|
||||
end;
|
||||
Result := TXPathBooleanVariable.Create(res);
|
||||
end;
|
||||
|
||||
constructor TXPathUnionNode.Create(AOperand1, AOperand2: TXPathExprNode);
|
||||
begin
|
||||
@ -820,22 +879,16 @@ begin
|
||||
FOperand2 := AOperand2;
|
||||
end;
|
||||
|
||||
destructor TXPathUnionNode.Destroy;
|
||||
begin
|
||||
FOperand1.Free;
|
||||
FOperand2.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TXPathUnionNode.Evaluate(AContext: TXPathContext;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable;
|
||||
var
|
||||
Op1Result, Op2Result: TXPathVariable;
|
||||
NodeSet, NodeSet2: TNodeSet;
|
||||
CurNode: Pointer;
|
||||
i, j: Integer;
|
||||
DoAdd: Boolean;
|
||||
i: Integer;
|
||||
begin
|
||||
{ TODO: result must be sorted by document order, i.e. 'a|b' yields the
|
||||
same nodeset as 'b|a' }
|
||||
Op1Result := FOperand1.Evaluate(AContext, AEnvironment);
|
||||
try
|
||||
Op2Result := FOperand2.Evaluate(AContext, AEnvironment);
|
||||
@ -844,15 +897,8 @@ begin
|
||||
NodeSet2 := Op2Result.AsNodeSet;
|
||||
for i := 0 to NodeSet2.Count - 1 do
|
||||
begin
|
||||
DoAdd := True;
|
||||
CurNode := NodeSet2[i];
|
||||
for j := 0 to NodeSet.Count - 1 do
|
||||
if NodeSet[j] = CurNode then
|
||||
begin
|
||||
DoAdd := False;
|
||||
break;
|
||||
end;
|
||||
if DoAdd then
|
||||
if NodeSet.IndexOf(CurNode) < 0 then
|
||||
NodeSet.Add(CurNode);
|
||||
end;
|
||||
finally
|
||||
@ -1384,11 +1430,7 @@ end;
|
||||
|
||||
function TXPathNumberVariable.AsBoolean: Boolean;
|
||||
begin
|
||||
// !!!: What about NaNs and so on?
|
||||
if FValue = 0 then
|
||||
Result := False
|
||||
else
|
||||
Result := True;
|
||||
Result := not (IsNan(FValue) or IsZero(FValue));
|
||||
end;
|
||||
|
||||
function TXPathNumberVariable.AsNumber: Extended;
|
||||
@ -1398,6 +1440,7 @@ end;
|
||||
|
||||
function TXPathNumberVariable.AsText: DOMString;
|
||||
begin
|
||||
// TODO: Decimal separator!!!
|
||||
Result := FloatToStr(FValue);
|
||||
end;
|
||||
|
||||
@ -1868,6 +1911,7 @@ begin
|
||||
end;
|
||||
else
|
||||
Error(SParserInvalidPrimExpr);
|
||||
Result := nil; // satisfy compiler
|
||||
end;
|
||||
NextToken;
|
||||
end;
|
||||
@ -1956,7 +2000,7 @@ end;
|
||||
|
||||
function TXPathScanner.ParseEqualityExpr: TXPathExprNode; // [23]
|
||||
var
|
||||
op: TXPathBooleanOp;
|
||||
op: TXPathCompareOp;
|
||||
begin
|
||||
Result := ParseRelationalExpr;
|
||||
repeat
|
||||
@ -1967,13 +2011,13 @@ begin
|
||||
Break;
|
||||
end;
|
||||
NextToken;
|
||||
Result := TXPathBooleanOpNode.Create(op, Result, ParseRelationalExpr);
|
||||
Result := TXPathCompareNode.Create(op, Result, ParseRelationalExpr);
|
||||
until False;
|
||||
end;
|
||||
|
||||
function TXPathScanner.ParseRelationalExpr: TXPathExprNode; // [24]
|
||||
var
|
||||
op: TXPathBooleanOp;
|
||||
op: TXPathCompareOp;
|
||||
begin
|
||||
Result := ParseAdditiveExpr;
|
||||
repeat
|
||||
@ -1986,7 +2030,7 @@ begin
|
||||
Break;
|
||||
end;
|
||||
NextToken;
|
||||
Result := TXPathBooleanOpNode.Create(op, Result, ParseAdditiveExpr);
|
||||
Result := TXPathCompareNode.Create(op, Result, ParseAdditiveExpr);
|
||||
until False;
|
||||
end;
|
||||
|
||||
@ -2423,28 +2467,48 @@ end;
|
||||
function TXPathEnvironment.xpSubstringAfter(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
||||
var
|
||||
s, substr: DOMString;
|
||||
i: Integer;
|
||||
begin
|
||||
if Args.Count <> 2 then
|
||||
EvaluationError(SEvalInvalidArgCount);
|
||||
s := TXPathVariable(Args[0]).AsText;
|
||||
substr := TXPathVariable(Args[1]).AsText;
|
||||
Result := TXPathStringVariable.Create(Copy(s, Pos(substr, s) + Length(substr), MaxInt));
|
||||
i := Pos(substr, s);
|
||||
if i <> 0 then
|
||||
Result := TXPathStringVariable.Create(Copy(s, i + Length(substr), MaxInt))
|
||||
else
|
||||
Result := TXPathStringVariable.Create('');
|
||||
end;
|
||||
|
||||
function TXPathEnvironment.xpSubstring(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
||||
var
|
||||
s: DOMString;
|
||||
n1, n2: Integer;
|
||||
i, n1, n2: Integer;
|
||||
e1, e2: Extended;
|
||||
empty: Boolean;
|
||||
begin
|
||||
if (Args.Count < 2) or (Args.Count > 3) then
|
||||
EvaluationError(SEvalInvalidArgCount);
|
||||
s := TXPathVariable(Args[0]).AsText;
|
||||
n1 := round(TXPathVariable(Args[1]).AsNumber);
|
||||
e1 := TXPathVariable(Args[1]).AsNumber;
|
||||
n1 := 1; // satisfy compiler
|
||||
n2 := MaxInt;
|
||||
empty := IsNaN(e1) or IsInfinite(e1);
|
||||
if not empty then
|
||||
n1 := floor(0.5 + e1);
|
||||
if Args.Count = 3 then
|
||||
n2 := round(TXPathVariable(Args[2]).AsNumber)
|
||||
else
|
||||
n2 := MaxInt;
|
||||
Result := TXPathStringVariable.Create(Copy(s, n1, n2));
|
||||
begin
|
||||
e2 := TXPathVariable(Args[2]).AsNumber;
|
||||
if IsNaN(e2) or (IsInfinite(e2) and (e2 < 0)) then
|
||||
empty := True
|
||||
else if not IsInfinite(e2) then
|
||||
n2 := floor(0.5 + e2);
|
||||
end;
|
||||
i := Max(n1, 1);
|
||||
n2 := n2 + n1 - i;
|
||||
if empty then
|
||||
n2 := -1;
|
||||
Result := TXPathStringVariable.Create(Copy(s, i, n2));
|
||||
end;
|
||||
|
||||
function TXPathEnvironment.xpStringLength(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
||||
@ -2546,10 +2610,15 @@ begin
|
||||
end;
|
||||
|
||||
function TXPathEnvironment.xpRound(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
||||
var
|
||||
num: Extended;
|
||||
begin
|
||||
if Args.Count <> 1 then
|
||||
EvaluationError(SEvalInvalidArgCount);
|
||||
Result := TXPathNumberVariable.Create(round(TXPathVariable(Args[0]).AsNumber));
|
||||
num := TXPathVariable(Args[0]).AsNumber;
|
||||
if not (IsNan(num) or IsInfinite(num)) then
|
||||
num := floor(0.5 + num);
|
||||
Result := TXPathNumberVariable.Create(num);
|
||||
end;
|
||||
|
||||
|
||||
@ -2587,14 +2656,18 @@ function TXPathExpression.Evaluate(AContextNode: TDOMNode;
|
||||
AEnvironment: TXPathEnvironment): TXPathVariable;
|
||||
var
|
||||
Context: TXPathContext;
|
||||
mask: TFPUExceptionMask;
|
||||
begin
|
||||
if Assigned(FRootNode) then
|
||||
begin
|
||||
mask := GetExceptionMask;
|
||||
SetExceptionMask(mask + [exInvalidOp, exZeroDivide]);
|
||||
Context := TXPathContext.Create(AContextNode, 1, 1);
|
||||
try
|
||||
Result := FRootNode.Evaluate(Context, AEnvironment);
|
||||
finally
|
||||
Context.Free;
|
||||
SetExceptionMask(mask);
|
||||
end;
|
||||
end else
|
||||
Result := nil;
|
||||
|
||||
403
packages/fcl-xml/tests/xpathts.pp
Normal file
403
packages/fcl-xml/tests/xpathts.pp
Normal file
@ -0,0 +1,403 @@
|
||||
{**********************************************************************
|
||||
|
||||
This file is part of the Free Component Library (FCL)
|
||||
|
||||
Test suite for the xpath.pp unit.
|
||||
Largely based on expressions from libxml2 source tree.
|
||||
Copyright (c) 2009 by Sergei Gorelkin, sergei_gorelkin@mail.ru
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
program xpathts;
|
||||
{$mode objfpc}{$h+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math,
|
||||
dom, xmlread, xmlwrite, xpath;
|
||||
|
||||
type
|
||||
TResultType = (rtString, rtNumber, rtBool, rtNodeset);
|
||||
|
||||
TTestRec = record
|
||||
expr: DOMString;
|
||||
case rt: TResultType of
|
||||
rtString: (s: DOMPChar); // cannot use DOMString here
|
||||
rtNumber: (n: Extended);
|
||||
rtBool: (b: Boolean);
|
||||
end;
|
||||
|
||||
const
|
||||
BaseTests: array[0..4] of TTestRec = (
|
||||
(expr: '1'; rt: rtNumber; n: 1),
|
||||
(expr: '1+2'; rt: rtNumber; n: 3),
|
||||
(expr: '2*3'; rt: rtNumber; n: 6),
|
||||
(expr: '1+2*3+4'; rt: rtNumber; n: 11),
|
||||
(expr: '(1+2)*(3+4)'; rt: rtNumber; n: 21)
|
||||
);
|
||||
|
||||
CompareTests: array[0..45] of TTestRec = (
|
||||
(expr: '0<0'; rt: rtBool; b: False),
|
||||
(expr: '0<=0'; rt: rtBool; b: True),
|
||||
(expr: '0>0'; rt: rtBool; b: False),
|
||||
(expr: '0>=0'; rt: rtBool; b: True),
|
||||
(expr: '0<1'; rt: rtBool; b: True),
|
||||
(expr: '0<=1'; rt: rtBool; b: True),
|
||||
(expr: '0>1'; rt: rtBool; b: False),
|
||||
(expr: '0>=1'; rt: rtBool; b: False),
|
||||
(expr: '1<0'; rt: rtBool; b: False),
|
||||
(expr: '1<=0'; rt: rtBool; b: False),
|
||||
(expr: '1>0'; rt: rtBool; b: True),
|
||||
(expr: '1>=0'; rt: rtBool; b: True),
|
||||
(expr: '1<1'; rt: rtBool; b: False),
|
||||
(expr: '1<=1'; rt: rtBool; b: True),
|
||||
(expr: '1>1'; rt: rtBool; b: False),
|
||||
(expr: '1>=1'; rt: rtBool; b: True),
|
||||
(expr: '"0"<1'; rt: rtBool; b: True),
|
||||
(expr: '"0"<=1'; rt: rtBool; b: True),
|
||||
(expr: '"0">1'; rt: rtBool; b: False),
|
||||
(expr: '"0">=1'; rt: rtBool; b: False),
|
||||
(expr: '0<"1.2"'; rt: rtBool; b: True),
|
||||
(expr: '0<="1.2"'; rt: rtBool; b: True),
|
||||
(expr: '0>"1.2"'; rt: rtBool; b: False),
|
||||
(expr: '0>="1.2"'; rt: rtBool; b: False),
|
||||
(expr: '0<"-0.2"'; rt: rtBool; b: False),
|
||||
(expr: '0<="-0.2"'; rt: rtBool; b: False),
|
||||
(expr: '0>"-0.2"'; rt: rtBool; b: True),
|
||||
(expr: '0>="-0.2"'; rt: rtBool; b: True),
|
||||
(expr: 'false()<1'; rt: rtBool; b: True),
|
||||
(expr: 'false()<=1'; rt: rtBool; b: True),
|
||||
(expr: '0>true()'; rt: rtBool; b: False),
|
||||
(expr: '0>=true()'; rt: rtBool; b: False),
|
||||
(expr: '"a" > "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" > "b"'; rt: rtBool; b: False),
|
||||
(expr: '"b" > "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" < "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" < "b"'; rt: rtBool; b: False),
|
||||
(expr: '"b" < "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" >= "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" >= "b"'; rt: rtBool; b: False),
|
||||
(expr: '"b" >= "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" <= "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" <= "b"'; rt: rtBool; b: False),
|
||||
(expr: '"b" <= "a"'; rt: rtBool; b: False),
|
||||
(expr: '"a" > "0.0"'; rt: rtBool; b: False),
|
||||
(expr: '"a" < "0.0"'; rt: rtBool; b: False)
|
||||
);
|
||||
|
||||
EqualityTests: array[0..25] of TTestRec = (
|
||||
(expr: '1=1'; rt: rtBool; b: True),
|
||||
(expr: '1!=1'; rt: rtBool; b: False),
|
||||
(expr: '1=0'; rt: rtBool; b: False),
|
||||
(expr: '1!=0'; rt: rtBool; b: True),
|
||||
|
||||
(expr: 'true()=true()'; rt: rtBool; b: True),
|
||||
(expr: 'true()!=true()'; rt: rtBool; b: False),
|
||||
(expr: 'true()=false()'; rt: rtBool; b: False),
|
||||
(expr: 'false()!=true()'; rt: rtBool; b: True),
|
||||
|
||||
(expr: '"test"="test"'; rt: rtBool; b: True),
|
||||
(expr: '"test"!="test"'; rt: rtBool; b: False),
|
||||
(expr: '"test2"="test"'; rt: rtBool; b: False),
|
||||
(expr: '"test2"!="test"'; rt: rtBool; b: True),
|
||||
|
||||
(expr: 'false()=0'; rt: rtBool; b: True),
|
||||
(expr: 'false()!=0'; rt: rtBool; b: False),
|
||||
(expr: 'false()=1'; rt: rtBool; b: False),
|
||||
|
||||
(expr: 'false()!=1'; rt: rtBool; b: True),
|
||||
(expr: '0=true()'; rt: rtBool; b: False),
|
||||
(expr: '0!=true()'; rt: rtBool; b: True),
|
||||
(expr: '1=true()'; rt: rtBool; b: True),
|
||||
(expr: '1!=true()'; rt: rtBool; b: False),
|
||||
|
||||
(expr: 'true()="test"'; rt: rtBool; b: True),
|
||||
(expr: 'false()="test"'; rt: rtBool; b: False),
|
||||
(expr: '"test"!=true()'; rt: rtBool; b: False),
|
||||
(expr: '"test"!=false()'; rt: rtBool; b: True),
|
||||
|
||||
(expr: '"a"=0.0'; rt: rtBool; b: False),
|
||||
(expr: '"a"!=0.0'; rt: rtBool; b: True)
|
||||
);
|
||||
|
||||
FloatTests: array[0..60] of TTestRec = (
|
||||
(expr: '1'; rt: rtNumber; n: 1),
|
||||
(expr: '123'; rt: rtNumber; n: 123),
|
||||
(expr: '1.23'; rt: rtNumber; n: 1.23),
|
||||
(expr: '0.123'; rt: rtNumber; n: 0.123),
|
||||
(expr: '4.'; rt: rtNumber; n: 4),
|
||||
(expr: '.4'; rt: rtNumber; n: 0.4),
|
||||
//(expr: '1.23e3'; rt: rtNumber; n: 1230),
|
||||
//(expr: '1.23e-3'; rt: rtNumber; n: 0.00123),
|
||||
(expr: '1 div 0'; rt: rtNumber; n: Infinity),
|
||||
(expr: '-1 div 0'; rt: rtNumber; n: -Infinity),
|
||||
(expr: '0 div 0'; rt: rtNumber; n: NaN),
|
||||
(expr: '1 div -0'; rt: rtNumber; n: -Infinity),
|
||||
|
||||
(expr: '(1 div 0) > 0'; rt: rtBool; b: True),
|
||||
(expr: '(1 div 0) < 0'; rt: rtBool; b: False),
|
||||
(expr: '(-1 div 0) > 0'; rt: rtBool; b: False),
|
||||
(expr: '(-1 div 0) < 0'; rt: rtBool; b: True),
|
||||
(expr: '(0 div 0) > 0'; rt: rtBool; b: False),
|
||||
(expr: '(0 div 0) < 0'; rt: rtBool; b: False),
|
||||
(expr: '(1 div -0) > 0'; rt: rtBool; b: False),
|
||||
(expr: '(1 div -0) < 0'; rt: rtBool; b: True),
|
||||
(expr: '0 div 0 = 0 div 0'; rt: rtBool; b: False),
|
||||
(expr: '0 div 0 != 0 div 0'; rt: rtBool; b: True),
|
||||
(expr: '0 div 0 > 0 div 0'; rt: rtBool; b: False),
|
||||
(expr: '0 div 0 < 0 div 0'; rt: rtBool; b: False),
|
||||
(expr: '0 div 0 >= 0 div 0'; rt: rtBool; b: False),
|
||||
(expr: '0 div 0 <= 0 div 0'; rt: rtBool; b: False),
|
||||
(expr: '1 div 0 = -1 div 0'; rt: rtBool; b: False),
|
||||
(expr: '1 div 0 != -1 div 0'; rt: rtBool; b: True),
|
||||
(expr: '1 div 0 > -1 div 0'; rt: rtBool; b: True),
|
||||
(expr: '1 div 0 < -1 div 0'; rt: rtBool; b: False),
|
||||
(expr: '1 div 0 >= -1 div 0'; rt: rtBool; b: True),
|
||||
(expr: '1 div 0 <= -1 div 0'; rt: rtBool; b: False),
|
||||
(expr: '1 div 0 = 1 div 0'; rt: rtBool; b: True),
|
||||
(expr: '1 div 0 != 1 div 0'; rt: rtBool; b: False),
|
||||
(expr: '1 div 0 > 1 div 0'; rt: rtBool; b: False),
|
||||
(expr: '1 div 0 < 1 div 0'; rt: rtBool; b: False),
|
||||
(expr: '1 div 0 >= -1 div 0'; rt: rtBool; b: True),
|
||||
(expr: '1 div 0 <= -1 div 0'; rt: rtBool; b: False),
|
||||
(expr: '-2 div 0 = -1 div 0'; rt: rtBool; b: True),
|
||||
|
||||
(expr: '1 div floor(0.1)'; rt: rtNumber; n: Infinity),
|
||||
(expr: '1 div floor(-0.1)'; rt: rtNumber; n: -1),
|
||||
(expr: '1 div floor(-0)'; rt: rtNumber; n: -Infinity),
|
||||
(expr: '1 div floor(0)'; rt: rtNumber; n: Infinity),
|
||||
(expr: '1 div ceiling(0.1)'; rt: rtNumber; n: 1),
|
||||
(expr: '1 div ceiling(-0.1)'; rt: rtNumber; n: -Infinity),
|
||||
(expr: '1 div ceiling(-0)'; rt: rtNumber; n: -Infinity),
|
||||
(expr: '1 div ceiling(0)'; rt: rtNumber; n: Infinity),
|
||||
(expr: '1 div round(0.1)'; rt: rtNumber; n: Infinity),
|
||||
(expr: '1 div round(-0.1)'; rt: rtNumber; n: -Infinity),
|
||||
(expr: '1 div round(-0)'; rt: rtNumber; n: -Infinity),
|
||||
(expr: '1 div round(0)'; rt: rtNumber; n: Infinity),
|
||||
(expr: '1 div number("f")'; rt: rtNumber; n: NaN),
|
||||
(expr: 'number("f") div 1'; rt: rtNumber; n: NaN),
|
||||
(expr: '1 div (1 div 0)'; rt: rtNumber; n: 0),
|
||||
(expr: '(1 div 0) div 1'; rt: rtNumber; n: Infinity),
|
||||
(expr: '-(1 div 0) div 1'; rt: rtNumber; n: -Infinity),
|
||||
|
||||
(expr: '5 mod 2'; rt: rtNumber; n: 1),
|
||||
(expr: '5 mod -2'; rt: rtNumber; n: 1),
|
||||
(expr: '-5 mod 2'; rt: rtNumber; n: -1),
|
||||
(expr: '-5 mod -2'; rt: rtNumber; n: -1),
|
||||
(expr: '8 mod 3 = 2'; rt: rtBool; b: True),
|
||||
// test boolean operator short-circuting; "count(5)" acts as an error
|
||||
(expr: '10+30*20 or count(5)'; rt: rtBool; b: True),
|
||||
(expr: '75-50-25 and count(5)'; rt: rtBool; b: False)
|
||||
);
|
||||
|
||||
FunctionTests: array[0..36] of TTestRec = (
|
||||
// last()
|
||||
// position()
|
||||
// count()
|
||||
// id()
|
||||
// local-name()
|
||||
// namespace-uri()
|
||||
// name()
|
||||
|
||||
(expr: 'boolean(0)'; rt: rtBool; b: False),
|
||||
(expr: 'boolean(-0)'; rt: rtBool; b: False),
|
||||
(expr: 'boolean(1 div 0)'; rt: rtBool; b: True),
|
||||
(expr: 'boolean(-1 div 0)'; rt: rtBool; b: True),
|
||||
(expr: 'boolean(0 div 0)'; rt: rtBool; b: False),
|
||||
(expr: 'boolean("")'; rt: rtBool; b: False),
|
||||
(expr: 'boolean("abc")'; rt: rtBool; b: True),
|
||||
{
|
||||
boolean(node-set) -- TODO
|
||||
}
|
||||
(expr: 'true()'; rt: rtBool; b: True),
|
||||
(expr: 'false()'; rt: rtBool; b: False),
|
||||
{
|
||||
not()
|
||||
lang() -- involves nodes
|
||||
}
|
||||
|
||||
(expr: 'number("1.5")'; rt: rtNumber; n: 1.5),
|
||||
(expr: 'number("abc")'; rt: rtNumber; n: NaN),
|
||||
(expr: '-number("abc")'; rt: rtNumber; n: NaN),
|
||||
(expr: 'number(true())'; rt: rtNumber; n: 1.0),
|
||||
(expr: 'number(false())'; rt: rtNumber; n: 0),
|
||||
{
|
||||
sum() -- involves nodes
|
||||
}
|
||||
|
||||
(expr: 'floor(0.1)'; rt: rtNumber; n: 0),
|
||||
(expr: 'floor(-0.1)'; rt: rtNumber; n: -1),
|
||||
(expr: 'floor(-0)'; rt: rtNumber; n: 0),
|
||||
(expr: 'floor(0)'; rt: rtNumber; n: 0),
|
||||
(expr: 'floor(5.2)'; rt: rtNumber; n: 5),
|
||||
(expr: 'floor(-5.2)'; rt: rtNumber; n: -6),
|
||||
|
||||
(expr: 'ceiling(0.1)'; rt: rtNumber; n: 1),
|
||||
(expr: 'ceiling(-0.1)'; rt: rtNumber; n: 0),
|
||||
(expr: 'ceiling(-0)'; rt: rtNumber; n: 0),
|
||||
(expr: 'ceiling(0)'; rt: rtNumber; n: 0),
|
||||
(expr: 'ceiling(5.2)'; rt: rtNumber; n: 6),
|
||||
(expr: 'ceiling(-5.2)'; rt: rtNumber; n: -5),
|
||||
|
||||
(expr: 'round(0.1)'; rt: rtNumber; n: 0),
|
||||
(expr: 'round(5.2)'; rt: rtNumber; n: 5),
|
||||
(expr: 'round(5.5)'; rt: rtNumber; n: 6),
|
||||
(expr: 'round(5.6)'; rt: rtNumber; n: 6),
|
||||
(expr: 'round(-0.1)'; rt: rtNumber; n: 0),
|
||||
(expr: 'round(-5.2)'; rt: rtNumber; n: -5),
|
||||
(expr: 'round(-5.5)'; rt: rtNumber; n: -5),
|
||||
(expr: 'round(-5.6)'; rt: rtNumber; n: -6),
|
||||
(expr: 'round("NaN")'; rt: rtNumber; n: NaN),
|
||||
(expr: 'round(1 div 0)'; rt: rtNumber; n: Infinity),
|
||||
(expr: 'round(-1 div 0)'; rt: rtNumber; n: -Infinity)
|
||||
);
|
||||
|
||||
StringTests: array[0..43] of TTestRec = (
|
||||
(expr: 'string(5)'; rt: rtString; s: '5'),
|
||||
(expr: 'string(0.5)'; rt: rtString; s: '0.5'),
|
||||
(expr: 'string(-0.5)'; rt: rtString; s: '-0.5'),
|
||||
(expr: 'string(true())'; rt: rtString; s: 'true'),
|
||||
(expr: 'string(false())'; rt: rtString; s: 'false'),
|
||||
(expr: 'string(0 div 0)'; rt: rtString; s: 'NaN'),
|
||||
(expr: 'string(1 div 0)'; rt: rtString; s: 'Infinity'),
|
||||
(expr: 'string(-1 div 0)'; rt: rtString; s: '-Infinity'),
|
||||
// maybe other checks for correct numeric formats
|
||||
|
||||
(expr: 'concat("titi","toto")'; rt: rtString; s: 'tititoto'),
|
||||
(expr: 'concat("titi","toto","tata")'; rt: rtString; s: 'tititototata'),
|
||||
(expr: 'concat("titi",''toto'')'; rt: rtString; s: 'tititoto'),
|
||||
(expr: 'concat("titi",''toto'',"tata","last")'; rt: rtString; s: 'tititototatalast'),
|
||||
|
||||
(expr: 'starts-with("tititoto","titi")'; rt: rtBool; b: True),
|
||||
(expr: 'starts-with("tititoto","to")'; rt: rtBool; b: False),
|
||||
|
||||
(expr: 'contains("tititototata","titi")'; rt: rtBool; b: True),
|
||||
(expr: 'contains("tititototata","toto")'; rt: rtBool; b: True),
|
||||
(expr: 'contains("tititototata","tata")'; rt: rtBool; b: True),
|
||||
(expr: 'contains("tititototata","tita")'; rt: rtBool; b: False),
|
||||
|
||||
(expr: 'substring("12345",2,3)'; rt: rtString; s: '234'),
|
||||
(expr: 'substring("12345",2)'; rt: rtString; s: '2345'),
|
||||
(expr: 'substring("12345",-4)'; rt: rtString; s: '12345'),
|
||||
(expr: 'substring("12345",3.4)'; rt: rtString; s: '345'),
|
||||
(expr: 'substring("12345",3.6)'; rt: rtString; s: '45'),
|
||||
|
||||
(expr: 'substring("12345",1.5,2.6)'; rt: rtString; s: '234'),
|
||||
(expr: 'substring("12345",2.2,2.2)'; rt: rtString; s: '23'),
|
||||
(expr: 'substring("12345",0,3)'; rt: rtString; s: '12'),
|
||||
(expr: 'substring("12345",-8,10)'; rt: rtString; s: '1'),
|
||||
(expr: 'substring("12345",4,-10)'; rt: rtString; s: ''),
|
||||
|
||||
(expr: 'substring("12345",0 div 0, 3)'; rt: rtString; s: ''),
|
||||
(expr: 'substring("12345",1, 0 div 0)'; rt: rtString; s: ''),
|
||||
(expr: 'substring("12345",1 div 0, 3)'; rt: rtString; s: ''),
|
||||
(expr: 'substring("12345",3,-1 div 0)'; rt: rtString; s: ''),
|
||||
(expr: 'substring("12345",-42, 1 div 0)'; rt: rtString; s: '12345'),
|
||||
|
||||
(expr: 'substring("12345",-1 div 0, 1 div 0)'; rt: rtString; s: ''),
|
||||
(expr: 'substring("12345",-1 div 0,5)'; rt: rtString; s: ''),
|
||||
|
||||
(expr: 'substring-before("1999/04/01","/")'; rt: rtString; s: '1999'),
|
||||
(expr: 'substring-before("1999/04/01","a")'; rt: rtString; s: ''),
|
||||
(expr: 'substring-after("1999/04/01","/")'; rt: rtString; s: '04/01'),
|
||||
(expr: 'substring-after("1999/04/01","19")'; rt: rtString; s: '99/04/01'),
|
||||
(expr: 'substring-after("1999/04/01","a")'; rt: rtString; s: ''),
|
||||
|
||||
(expr: 'string-length("")'; rt: rtNumber; n: 0),
|
||||
(expr: 'string-length("titi")'; rt: rtNumber; n: 4),
|
||||
{
|
||||
normalize-space()
|
||||
}
|
||||
(expr: 'translate("bar", "abc", "ABC")'; rt: rtString; s: 'BAr'),
|
||||
(expr: 'translate("--aaa--","abc-","ABC")'; rt: rtString; s: 'AAA')
|
||||
);
|
||||
|
||||
var
|
||||
FailCount: Integer = 0;
|
||||
|
||||
procedure CheckResult(const t: TTestRec; r: TXPathVariable);
|
||||
begin
|
||||
case t.rt of
|
||||
rtBool:
|
||||
begin
|
||||
if (r is TXPathBooleanVariable) and (r.AsBoolean = t.b) then
|
||||
Exit;
|
||||
writeln;
|
||||
writeln('Failed: ', t.expr);
|
||||
writeln('Expected: ', t.b, ' got: ', r.AsBoolean);
|
||||
end;
|
||||
|
||||
rtNumber:
|
||||
begin
|
||||
if (r is TXPathNumberVariable) then
|
||||
begin
|
||||
if IsNan(t.n) and IsNan(r.AsNumber) then
|
||||
Exit;
|
||||
if IsInfinite(t.n) and (t.n = r.AsNumber) then
|
||||
Exit;
|
||||
if SameValue(r.AsNumber, t.n) then
|
||||
Exit;
|
||||
end;
|
||||
writeln;
|
||||
writeln('Failed: ', t.expr);
|
||||
writeln('Expected: ', t.n, ' got: ', r.AsNumber);
|
||||
end;
|
||||
|
||||
rtString:
|
||||
begin
|
||||
if (r is TXPathStringVariable) and (r.AsText = DOMString(t.s)) then
|
||||
Exit;
|
||||
writeln;
|
||||
writeln('Failed: ', t.expr);
|
||||
writeln('Expected: ', DOMString(t.s), ' got: ', r.AsText);
|
||||
end;
|
||||
end;
|
||||
Inc(FailCount);
|
||||
end;
|
||||
|
||||
procedure DoSuite(const tests: array of TTestRec);
|
||||
var
|
||||
i: Integer;
|
||||
doc: TXMLDocument;
|
||||
rslt: TXPathVariable;
|
||||
begin
|
||||
doc := TXMLDocument.Create;
|
||||
try
|
||||
for i := 0 to High(tests) do
|
||||
begin
|
||||
try
|
||||
rslt := EvaluateXPathExpression(tests[i].expr, doc);
|
||||
try
|
||||
CheckResult(tests[i], rslt);
|
||||
finally
|
||||
rslt.Free;
|
||||
end;
|
||||
except
|
||||
writeln;
|
||||
writeln('Failed: ', tests[i].expr);
|
||||
SysUtils.ShowException(ExceptObject, ExceptAddr);
|
||||
Inc(FailCount);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
doc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
DecimalSeparator := '.';
|
||||
DoSuite(BaseTests);
|
||||
DoSuite(CompareTests);
|
||||
DoSuite(EqualityTests);
|
||||
DoSuite(FloatTests);
|
||||
DoSuite(FunctionTests);
|
||||
DoSuite(StringTests);
|
||||
|
||||
writeln;
|
||||
writeln('Total failed tests: ', FailCount);
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user