xpath.pp:

* Progress with namespace support. Resolve namespace prefixed while parsing, compare namespaceURI/localNames while evaluating. Existing tests for namespace-uri(), local-name() and name() now all pass, but resolving interface isn't ready for general use yet.
* Fixed name() to default to context node if argument is omitted.

xpathts.pp:
+ support for prefix resolving while testing.

git-svn-id: trunk@13846 -

packages/fcl-xml/src/xpath.pp

@@ -251,6 +251,7 @@ type
     Axis: TAxis;
     NodeTestType: TNodeTestType;
     NodeTestString: DOMString;
+    NSTestString: DOMString;
     Predicates: TXPathNodeArray;
     constructor Create(aAxis: TAxis; aTest: TNodeTestType);
     destructor Destroy; override;
@@ -344,6 +345,8 @@ type
   end;
 
 
+  TXPathNSResolver = TDOMNode {!!! experimental};
+
 { XPath lexical scanner }
 
   TXPathScanner = class
@@ -354,6 +357,7 @@ type
     FTokenStart: DOMPChar;
     FTokenLength: Integer;
     FPrefixLength: Integer;
+    FResolver: TXPathNSResolver;
     procedure Error(const Msg: String);
     procedure ParsePredicates(var Dest: TXPathNodeArray);
     procedure ParseStep(Dest: TStep);          // [4]
@@ -470,8 +474,9 @@ type
   public
     { CompleteExpresion specifies wether the parser should check for gargabe
       after the recognised part. True => Throw exception if there is garbage }
-    constructor Create(AScanner: TXPathScanner; CompleteExpression: Boolean);
-    destructor destroy;override;
+    constructor Create(AScanner: TXPathScanner; CompleteExpression: Boolean;
+      AResolver: TXPathNSResolver = nil);
+    destructor Destroy; override;
     function Evaluate(AContextNode: TDOMNode): TXPathVariable;
     function Evaluate(AContextNode: TDOMNode;
       AEnvironment: TXPathEnvironment): TXPathVariable;
@@ -479,7 +484,7 @@ type
 
 
 function EvaluateXPathExpression(const AExpressionString: DOMString;
-  AContextNode: TDOMNode): TXPathVariable;
+  AContextNode: TDOMNode; AResolver: TXPathNSResolver = nil): TXPathVariable;
 
 
 // ===================================================================
@@ -1095,7 +1100,14 @@ var
           (Node.NodeType <> ELEMENT_NODE) then
           exit;
       ntName:
-        if Node.NodeName <> NodeTestString then
+        if NSTestString <> '' then
+        begin
+          if Node.namespaceURI <> NSTestString then
+            exit;
+          if (NodeTestString <> '') and (Node.localName <> NodeTestString) then
+            exit;
+        end
+        else if Node.NodeName <> NodeTestString then
           exit;
       ntTextNode:
         if not Node.InheritsFrom(TDOMCharacterData) then
@@ -1908,7 +1920,12 @@ begin
     else if CurToken = tkNSNameTest then // [37] NameTest, second case
     begin
       NextToken;
-      // TODO: resolve the prefix and set Dest properties
+      if Assigned(FResolver) then
+        Dest.NSTestString := FResolver.lookupNamespaceURI(CurTokenString);
+      if Dest.NSTestString = '' then
+        // !! localization disrupted by DOM exception specifics
+        raise EDOMNamespace.Create('TXPathScanner.ParseStep');
+      Dest.NodeTestType := ntName;
     end
     else if CurToken = tkIdentifier then
     begin
@@ -1949,14 +1966,17 @@ begin
       end
       else  // [37] NameTest, third case
       begin
-        // !!!: Doesn't support namespaces yet
-        // (this will have to wait until the DOM unit supports them)
         Dest.NodeTestType := ntName;
-        Dest.NodeTestString := CurTokenString;
         if FPrefixLength > 0 then
         begin
-          // TODO: resolve the prefix and set Dest properties
-        end;
+          if Assigned(FResolver) then
+            Dest.NSTestString := FResolver.lookupNamespaceURI(Copy(CurTokenString, 1, FPrefixLength));
+          if Dest.NSTestString = '' then
+            raise EDOMNamespace.Create('TXPathScanner.ParseStep');
+          Dest.NodeTestString := Copy(CurTokenString, FPrefixLength+2, MaxInt);
+        end
+        else
+          Dest.NodeTestString := CurTokenString;
         NextToken;
       end;
     end
@@ -2547,17 +2567,27 @@ end;
 
 function TXPathEnvironment.xpName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
 var
+  n: TDOMNode;
   NodeSet: TNodeSet;
+  s: DOMString;
 begin
-// TODO: arg is optional, omission case must be handled
-  if Args.Count <> 1 then
+  if Args.Count > 1 then
     EvaluationError(SEvalInvalidArgCount);
-  NodeSet := TXPathVariable(Args[0]).AsNodeSet;
-  if NodeSet.Count = 0 then
-    Result := TXPathStringVariable.Create('')
+  n := nil;
+  if Args.Count = 0 then
+    n := Context.ContextNode
+  else
+  begin
+    NodeSet := TXPathVariable(Args[0]).AsNodeSet;
+    if NodeSet.Count > 0 then
+      n := TDOMNode(NodeSet[0]);
+  end;
+  // TODO: probably this isn't correct. XPath name() isn't the same as DOM nodeName.
+  if Assigned(n) then
+    s := n.nodeName
   else
-    // !!!: Probably not really correct regarding namespaces...
-    Result := TXPathStringVariable.Create(TDOMNode(NodeSet[0]).NodeName);
+    s := '';
+  Result := TXPathStringVariable.Create(s);
 end;
 
 function TXPathEnvironment.xpString(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
@@ -2838,9 +2868,10 @@ end;
 { TXPathExpression }
 
 constructor TXPathExpression.Create(AScanner: TXPathScanner;
-  CompleteExpression: Boolean);
+  CompleteExpression: Boolean; AResolver: TXPathNSResolver);
 begin
   inherited Create;
+  AScanner.FResolver := AResolver;
   FRootNode := AScanner.ParseOrExpr;
   if CompleteExpression and (AScanner.CurToken <> tkEndOfStream) then
     EvaluationError(SParserGarbageAfterExpression);
@@ -2886,14 +2917,14 @@ begin
 end;
 
 function EvaluateXPathExpression(const AExpressionString: DOMString;
-  AContextNode: TDOMNode): TXPathVariable;
+  AContextNode: TDOMNode; AResolver: TXPathNSResolver): TXPathVariable;
 var
   Scanner: TXPathScanner;
   Expression: TXPathExpression;
 begin
   Scanner := TXPathScanner.Create(AExpressionString);
   try
-    Expression := TXPathExpression.Create(Scanner, True);
+    Expression := TXPathExpression.Create(Scanner, True, AResolver);
     try
       Result := Expression.Evaluate(AContextNode);
     finally

packages/fcl-xml/tests/xpathts.pp

@@ -33,6 +33,16 @@ type
     rtBool:   (b: Boolean);
   end;
 
+  TTestRec3 = record
+    data: string;                // UTF-8 encoded
+    re: string;
+    expr: DOMString;
+  case rt: TResultType of
+    rtString, rtNodeStr: (s: DOMPChar);   // cannot use DOMString here
+    rtNumber: (n: Extended);
+    rtBool:   (b: Boolean);
+  end;
+
 {$warnings off}
 const
   BaseTests: array[0..4] of TTestRec = (
@@ -542,7 +552,7 @@ const
   '<b ns1:attrib2="test"/>'#10+
   '</doc>';
 
-  StringTests: array[0..84] of TTestRec = (             // numbers refer to xalan/string/stringXX
+  StringTests: array[0..74] of TTestRec = (             // numbers refer to xalan/string/stringXX
     (expr: 'string(0)';       rt: rtString; s: '0'),
     (expr: 'string(5)';       rt: rtString; s: '5'),    // #38/39
     (expr: 'string(0.5)';     rt: rtString; s: '0.5'),
@@ -573,8 +583,6 @@ const
     (expr: 'starts-with("", "")';            rt: rtBool; b: True),     // #49
     (expr: 'starts-with(true(), "tr")';      rt: rtBool; b: True),     // #50
 
-
-
     (expr: 'contains("tititototata","titi")'; rt: rtBool; b: True),
     (expr: 'contains("tititototata","toto")'; rt: rtBool; b: True),
     (expr: 'contains("tititototata","tata")'; rt: rtBool; b: True),
@@ -625,18 +633,6 @@ const
     (expr: 'translate("--aaa--","abc-","ABC")'; rt: rtString; s: 'AAA'),
     (expr: 'translate("ddaaadddd","abcd","ABCxy")'; rt: rtString; s: 'xxAAAxxxx'),   // #96
 
-    (data: str30; expr: 'namespace-uri(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''), // #30
-    (data: str30; expr: 'namespace-uri(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'http://xsl.lotus.com/ns1'), // #31
-    (data: str30; expr: 'name(*)'; rt: rtString; s: 'ns1:a'),       // #32
-    (data: str30; expr: 'name(baz1:a)'; rt: rtString; s: 'ns1:a'),  // #33
-    (data: str30; expr: 'name(baz2:b)'; rt: rtString; s: 'b'),      // #34
-    (data: str30; expr: 'name(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''),            // #35
-    (data: str30; expr: 'name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'ns1:attrib2'), // #36
-
-    (data: str30; expr: 'local-name(baz2:b)'; rt: rtString; s: 'b'), // namespace07
-    (data: str30; expr: 'local-name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'attrib2'), // namespace09
-    (data: str30; expr: 'local-name()'; rt: rtString; s: 'doc'),      // namespace26
-    
     // tests for number->string conversions at boundary conditions
     (expr: 'string(123456789012345678)';     rt: rtString; s: '123456789012345680'),    // #132.1
     (expr: 'string(-123456789012345678)';    rt: rtString; s: '-123456789012345680'),   // #132.2
@@ -650,7 +646,23 @@ const
     (expr: 'string(-.0000000000000000000000000000000000000000123456789)'; rt: rtString; // #135.2
       s: '-0.0000000000000000000000000000000000000000123456789')
   );
-  
+
+  res1 = '<foo xmlns:baz1="http://xsl.lotus.com/ns1" xmlns:baz2="http://xsl.lotus.com/ns2"/>';
+
+  nameTests: array[0..9] of TTestRec3 = (
+    (data: str30; re: res1; expr: 'namespace-uri(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''), // #30
+    (data: str30; re: res1; expr: 'namespace-uri(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'http://xsl.lotus.com/ns1'), // #31
+    (data: str30; re: res1; expr: 'name(*)'; rt: rtString; s: 'ns1:a'),       // #32
+    (data: str30; re: res1; expr: 'name(baz1:a)'; rt: rtString; s: 'ns1:a'),  // #33
+    (data: str30; re: res1; expr: 'name(baz2:b)'; rt: rtString; s: 'b'),      // #34
+    (data: str30; re: res1; expr: 'name(baz1:a/@baz2:attrib1)'; rt: rtString; s: ''),            // #35
+    (data: str30; re: res1; expr: 'name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'ns1:attrib2'), // #36
+
+    (data: str30; re: res1; expr: 'local-name(baz2:b)'; rt: rtString; s: 'b'), // namespace07
+    (data: str30; re: res1; expr: 'local-name(baz2:b/@baz1:attrib2)'; rt: rtString; s: 'attrib2'), // namespace09
+    (data: str30; re: res1; expr: 'local-name()'; rt: rtString; s: 'doc')      // namespace26
+  );
+
   ax114='<doc>'+
   '<foo att1="c">'+
   '  <foo att1="b">'+
@@ -814,8 +826,47 @@ begin
   end;
 end;
 
+procedure DoSuite3(const tests: array of TTestRec3);
+var
+  i: Integer;
+  doc: TXMLDocument;
+  rslt: TXPathVariable;
+  nsdoc: TXMLDocument;
+  temp: TTestRec;
+begin
+  for i := 0 to High(tests) do
+  begin
+    doc := ParseString(tests[i].data);
+    try
+      nsdoc := ParseString(tests[i].re);
+      try
+        try
+          rslt := EvaluateXPathExpression(tests[i].expr, doc.DocumentElement, nsdoc.DocumentElement);
+          try
+            temp.data := tests[i].data;
+            temp.expr := tests[i].expr;
+            temp.rt := tests[i].rt;
+            temp.n := tests[i].n;
+            CheckResult(temp, rslt);
+          finally
+            rslt.Free;
+          end;
+        except
+          writeln;
+          writeln('Failed: ', tests[i].expr);
+          SysUtils.ShowException(ExceptObject, ExceptAddr);
+          Inc(FailCount);
+        end;
+      finally
+        nsdoc.Free;
+      end;
+    finally
+      doc.Free;
+    end;
+  end;
+end;
+
 begin
-  DecimalSeparator := '.';
   DoSuite(BaseTests);
   DoSuite(CompareTests);
   DoSuite(NodesetCompareTests);  
@@ -825,6 +876,8 @@ begin
   DoSuite(StringTests);
   DoSuite(AxesTests);
 
+  DoSuite3(nameTests);
+
   writeln;
   writeln('Total failed tests: ', FailCount);
 end.