* Refactored TXPathLocationPathNode.Evaluate(), split that awful 3-level nested procedure into

  TStep.SelectNodes, TStep.ApplyPredicates and the remaining part.
* Since predicates contained in a location path are evaluated within separate contexts of their own,
  evaluation of the location path itself does not require a full context (only need context nodes).
  This simplifies things quite a bit.
+ Added support for evaluating filter expressions follwed by location path. Things like
  "id('foo')/bar" work now.

git-svn-id: trunk@13244 -

packages/fcl-xml/src/xpath.pp

@@ -240,7 +240,12 @@ type
   TNodeTestType = (ntAnyPrincipal, ntName, ntTextNode,
     ntCommentNode, ntPINode, ntAnyNode);
 
+  TNodeSet = TFPList;
+
   TStep = class
+  private
+    procedure SelectNodes(ANode: TDOMNode; out ResultNodes: TNodeSet);
+    procedure ApplyPredicates(Nodes: TNodeSet; AEnvironment: TXPathEnvironment);
   public
     NextStep: TStep;
     Axis: TAxis;
@@ -263,9 +268,6 @@ type
       AEnvironment: TXPathEnvironment): TXPathVariable; override;
   end;
 
-
-  TNodeSet = TFPList;
-
 { Exceptions }
 
   EXPathEvaluationError = class(Exception);
@@ -1067,262 +1069,259 @@ begin
   inherited destroy;
 end;
 
-constructor TXPathLocationPathNode.Create(ALeft: TXPathExprNode; AIsAbsolutePath: Boolean);
-begin
-  inherited Create;
-  FLeft := ALeft;
-  FIsAbsolutePath := AIsAbsolutePath;
-end;
-
-function TXPathLocationPathNode.Evaluate(AContext: TXPathContext;
-  AEnvironment: TXPathEnvironment): TXPathVariable;
+procedure TStep.SelectNodes(ANode: TDOMNode; out ResultNodes: TNodeSet);
 var
-  ResultNodeSet: TNodeSet;
-
-  procedure EvaluateStep(AStep: TStep; AContext: TXPathContext);
-  var
-    StepNodes: TFPList;
+  Node, Node2: TDOMNode;
+  Attr: TDOMNamedNodeMap;
+  i: Integer;
+  TempList: TFPList;
 
-    procedure DoNodeTest(Node: TDOMNode);
-    begin
-      case AStep.NodeTestType of
-        ntAnyPrincipal:
-          // !!!: Probably this isn't ready for namespace support yet
-          if (AStep.Axis <> axisAttribute) and
-            (Node.NodeType <> ELEMENT_NODE) then
-            exit;
-        ntName:
-          if Node.NodeName <> AStep.NodeTestString then
-            exit;
-        ntTextNode:
-          if not Node.InheritsFrom(TDOMCharacterData) then
-            exit;
-        ntCommentNode:
-          if Node.NodeType <> COMMENT_NODE then
-            exit;
-        ntPINode:
-          if Node.NodeType <> PROCESSING_INSTRUCTION_NODE then
-            exit;
-      end;
-      if StepNodes.IndexOf(Node) < 0 then
-        StepNodes.Add(Node);
+  procedure DoNodeTest(Node: TDOMNode);
+  begin
+    case NodeTestType of
+      ntAnyPrincipal:
+        // !!!: Probably this isn't ready for namespace support yet
+        if (Axis <> axisAttribute) and
+          (Node.NodeType <> ELEMENT_NODE) then
+          exit;
+      ntName:
+        if Node.NodeName <> NodeTestString then
+          exit;
+      ntTextNode:
+        if not Node.InheritsFrom(TDOMCharacterData) then
+          exit;
+      ntCommentNode:
+        if Node.NodeType <> COMMENT_NODE then
+          exit;
+      ntPINode:
+        if Node.NodeType <> PROCESSING_INSTRUCTION_NODE then
+          exit;
     end;
+    if ResultNodes.IndexOf(Node) < 0 then
+      ResultNodes.Add(Node);
+  end;
 
-    procedure AddDescendants(CurNode: TDOMNode);
-    var
-      Child: TDOMNode;
+  procedure AddDescendants(CurNode: TDOMNode);
+  var
+    Child: TDOMNode;
+  begin
+    Child := CurNode.FirstChild;
+    while Assigned(Child) do
     begin
-      Child := CurNode.FirstChild;
-      while Assigned(Child) do
-      begin
-        DoNodeTest(Child);
-        AddDescendants(Child);
-        Child := Child.NextSibling;
-      end;
+      DoNodeTest(Child);
+      AddDescendants(Child);
+      Child := Child.NextSibling;
     end;
+  end;
 
-  var
-    Node, Node2: TDOMNode;
-    Attr: TDOMNamedNodeMap;
-    i, j: Integer;
-
-    NewContext: TXPathContext;
-    Predicate: TXPathExprNode;
-    TempList: TFPList;
-
-  begin
-    StepNodes := TFPList.Create;
-    // !!!: Protect this with an try/finally block
-    case AStep.Axis of
-      axisAncestor:
+begin
+  ResultNodes := TNodeSet.Create;
+  case Axis of
+    axisAncestor:
+      begin
+        Node := ANode.ParentNode;
+        while Assigned(Node) do
         begin
-          Node := AContext.ContextNode.ParentNode;
-          while Assigned(Node) do
-          begin
-            DoNodeTest(Node);
-            Node := Node.ParentNode;
-          end;
+          DoNodeTest(Node);
+          Node := Node.ParentNode;
         end;
-      axisAncestorOrSelf:
+      end;
+    axisAncestorOrSelf:
+      begin
+        Node := ANode;
+        repeat
+          DoNodeTest(Node);
+          Node := Node.ParentNode;
+        until not Assigned(Node);
+      end;
+    axisAttribute:
+      begin
+        Attr := ANode.Attributes;
+        if Assigned(Attr) then
+          for i := 0 to Attr.Length - 1 do
+            DoNodeTest(Attr[i]);
+      end;
+    axisChild:
+      begin
+        Node := ANode.FirstChild;
+        while Assigned(Node) do
         begin
-          Node := AContext.ContextNode;
-          repeat
-            DoNodeTest(Node);
-            Node := Node.ParentNode;
-         until not Assigned(Node);
+          DoNodeTest(Node);
+          Node := Node.NextSibling;
         end;
-      axisAttribute:
+      end;
+    axisDescendant:
+      AddDescendants(ANode);
+    axisDescendantOrSelf:
+      begin
+        DoNodeTest(ANode);
+        AddDescendants(ANode);
+      end;
+    axisFollowing:
+      begin
+        Node := ANode;
+        repeat
+          Node2 := Node.NextSibling;
+          while Assigned(Node2) do
+          begin
+            DoNodeTest(Node2);
+            AddDescendants(Node2);
+            Node2 := Node2.NextSibling;
+          end;
+          Node := Node.ParentNode;
+        until not Assigned(Node);
+      end;
+    axisFollowingSibling:
+      begin
+        Node := ANode.NextSibling;
+        while Assigned(Node) do
         begin
-          Attr := AContext.ContextNode.Attributes;
-          if Assigned(Attr) then
-            for i := 0 to Attr.Length - 1 do
-              DoNodeTest(Attr[i]);
+          DoNodeTest(Node);
+          Node := Node.NextSibling;
         end;
-      axisChild:
-        begin
-          Node := AContext.ContextNode.FirstChild;
+      end;
+    {axisNamespace: !!!: Not supported yet}
+    axisParent:
+      if Assigned(ANode.ParentNode) then
+        DoNodeTest(ANode.ParentNode);
+    axisPreceding:
+      begin
+        TempList := TFPList.Create;
+        try
+          Node := ANode;
+          // build list of ancestors
           while Assigned(Node) do
           begin
-            DoNodeTest(Node);
-            Node := Node.NextSibling;
+            TempList.Add(Node);
+            Node := Node.ParentNode;
           end;
-        end;
-      axisDescendant:
-        AddDescendants(AContext.ContextNode);
-      axisDescendantOrSelf:
-        begin
-          DoNodeTest(AContext.ContextNode);
-          AddDescendants(AContext.ContextNode);
-        end;
-      axisFollowing:
-        begin
-          Node := AContext.ContextNode;
-          repeat
-            Node2 := Node.NextSibling;
-            while Assigned(Node2) do
+          // then process it in reverse order
+          for i := TempList.Count-1 downto 1 do
+          begin
+            Node := TDOMNode(TempList[i]);
+            Node2 := Node.FirstChild;
+            while Assigned(Node2) and (Node2 <> TDOMNode(TempList[i-1])) do
             begin
               DoNodeTest(Node2);
               AddDescendants(Node2);
               Node2 := Node2.NextSibling;
             end;
-            Node := Node.ParentNode;
-          until not Assigned(Node);
+          end;
+        finally
+          TempList.Free;
         end;
-      axisFollowingSibling:
+      end;
+    axisPrecedingSibling:
+      begin
+        if Assigned(ANode.ParentNode) then
         begin
-          Node := AContext.ContextNode.NextSibling;
-          while Assigned(Node) do
+          Node := ANode.ParentNode.FirstChild;
+          while Assigned(Node) and (Node <> ANode) do
           begin
             DoNodeTest(Node);
             Node := Node.NextSibling;
           end;
         end;
-      {axisNamespace: !!!: Not supported yet}
-      axisParent:
-        if Assigned(AContext.ContextNode.ParentNode) then
-          DoNodeTest(AContext.ContextNode);
-      axisPreceding:
-        begin
-          TempList := TFPList.Create;
-          try
-            Node := AContext.ContextNode;
-            // build list of ancestors
-            while Assigned(Node) do
-            begin
-              TempList.Add(Node);
-              Node := Node.ParentNode;
-            end;
-            // then process it in reverse order
-            for i := TempList.Count-1 downto 1 do
-            begin
-              Node := TDOMNode(TempList[i]);
-              Node2 := Node.FirstChild;
-              while Assigned(Node2) and (Node2 <> TDOMNode(TempList[i-1])) do
-              begin
-                DoNodeTest(Node2);
-                AddDescendants(Node2);
-                Node2 := Node2.NextSibling;
-              end;
-            end;
-          finally
-            TempList.Free;
-          end;
-        end;
-      axisPrecedingSibling:
-        begin
-          if Assigned(AContext.ContextNode.ParentNode) then
-          begin
-            Node := AContext.ContextNode.ParentNode.FirstChild;
-            while Assigned(Node) and (Node <> AContext.ContextNode) do
-            begin
-              DoNodeTest(Node);
-              Node := Node.NextSibling;
-            end;
-          end;
-        end;
-      axisSelf:
-        DoNodeTest(AContext.ContextNode);
-    end;
-
-    { Filter the nodes of this step using the predicates: The current
-      node set (StepNodes) is filtered, nodes not passing the filter
-      are replaced by nil. After one filter has been applied, StepNodes
-      is packed, and the next filter will be processed.
-      The final result will then be passed to the next step, or added
-      to the result of the LocationPath if this is the last step. }
+      end;
+    axisSelf:
+      DoNodeTest(ANode);
+  end;
+end;
 
-    for i := 0 to High(AStep.Predicates) do
-    begin
-      NewContext := TXPathContext.Create(nil, 0, StepNodes.Count);
-      try
-        Predicate := AStep.Predicates[i];
-        for j := 0 to StepNodes.Count - 1 do
-        begin
-          // ContextPosition must honor the axis direction
-          if AStep.Axis in [axisAncestor, axisAncestorOrSelf,
-            axisPreceding, axisPrecedingSibling] then
-            NewContext.ContextPosition := StepNodes.Count - j
-          else
-            NewContext.ContextPosition := j+1;
+{ Filter the nodes of this step using the predicates: The current
+  node set is filtered, nodes not passing the filter are replaced
+  by nil. After one filter has been applied, Nodes is packed, and
+  the next filter will be processed. }
 
-          Node := TDOMNode(StepNodes[j]);
-          NewContext.ContextNode := Node;
-          if not Predicate.EvalPredicate(NewContext, AEnvironment) then
-            StepNodes[j] := nil;
-        end;
-        StepNodes.Pack;
-      finally
-        NewContext.Free;
+procedure TStep.ApplyPredicates(Nodes: TNodeSet; AEnvironment: TXPathEnvironment);
+var
+  i, j: Integer;
+  NewContext: TXPathContext;
+begin
+  for i := 0 to High(Predicates) do
+  begin
+    NewContext := TXPathContext.Create(nil, 0, Nodes.Count);
+    try
+      for j := 0 to Nodes.Count - 1 do
+      begin
+        // ContextPosition must honor the axis direction
+        if Axis in [axisAncestor, axisAncestorOrSelf,
+          axisPreceding, axisPrecedingSibling] then
+          NewContext.ContextPosition := Nodes.Count - j
+        else
+          NewContext.ContextPosition := j+1;
+        NewContext.ContextNode := TDOMNode(Nodes[j]);
+        if not Predicates[i].EvalPredicate(NewContext, AEnvironment) then
+          Nodes[j] := nil;
       end;
+      Nodes.Pack;
+    finally
+      NewContext.Free;
     end;
+  end;
+end;
 
-    if Assigned(AStep.NextStep) then
-    begin
-      NewContext := TXPathContext.Create(nil, 0, StepNodes.Count);
-      try
+constructor TXPathLocationPathNode.Create(ALeft: TXPathExprNode; AIsAbsolutePath: Boolean);
+begin
+  inherited Create;
+  FLeft := ALeft;
+  FIsAbsolutePath := AIsAbsolutePath;
+end;
+
+function TXPathLocationPathNode.Evaluate(AContext: TXPathContext;
+  AEnvironment: TXPathEnvironment): TXPathVariable;
+var
+  ResultNodeSet: TNodeSet;
+  LeftResult: TXPathVariable;
+  i: Integer;
+
+  procedure EvaluateStep(AStep: TStep; AContextNode: TDOMNode);
+  var
+    StepNodes: TFPList;
+    Node: TDOMNode;
+    i: Integer;
+  begin
+    AStep.SelectNodes(AContextNode, StepNodes);
+    try
+      AStep.ApplyPredicates(StepNodes, AEnvironment);
+
+      if Assigned(AStep.NextStep) then
+      begin
+        for i := 0 to StepNodes.Count - 1 do
+          EvaluateStep(AStep.NextStep, TDOMNode(StepNodes[i]));
+      end else
+      begin
+        // Only add nodes to result if it isn't duplicate
         for i := 0 to StepNodes.Count - 1 do
         begin
-          NewContext.ContextNode := TDOMNode(StepNodes[i]);
-          Inc(NewContext.ContextPosition);
-          EvaluateStep(AStep.NextStep, NewContext);
+          Node := TDOMNode(StepNodes[i]);
+          if ResultNodeSet.IndexOf(Node) < 0 then
+            ResultNodeSet.Add(Node);
         end;
-      finally
-        NewContext.Free;
-      end;
-    end else
-    begin
-      // Only add nodes to result if it isn't duplicate
-      for i := 0 to StepNodes.Count - 1 do
-      begin
-        Node := TDOMNode(StepNodes[i]);
-        if ResultNodeSet.IndexOf(Node) < 0 then
-          ResultNodeSet.Add(Node);
       end;
+    finally
+      StepNodes.Free;
     end;
-
-    StepNodes.Free;
   end;
 
-var
-  NewContext: TXPathContext;
 begin
   ResultNodeSet := TNodeSet.Create;
   try
-    if FIsAbsolutePath then
+    if Assigned(FLeft) then
     begin
-      if AContext.ContextNode.NodeType = DOCUMENT_NODE then
-        NewContext := TXPathContext.Create(AContext.ContextNode, 1, 1)
-      else
-        NewContext := TXPathContext.Create(AContext.ContextNode.OwnerDocument,
-        1, 1);
+      LeftResult := FLeft.Evaluate(AContext, AEnvironment);
       try
-        EvaluateStep(FFirstStep, NewContext);
+        with LeftResult.AsNodeSet do
+          for i := 0 to Count-1 do
+            EvaluateStep(FFirstStep, TDOMNode(Items[i]));
       finally
-        NewContext.Free;
+        LeftResult.Release;
       end;
     end
+    else if FIsAbsolutePath and (AContext.ContextNode.NodeType <> DOCUMENT_NODE) then
+      EvaluateStep(FFirstStep, AContext.ContextNode.OwnerDocument)
     else
-      EvaluateStep(FFirstStep, AContext);
+      EvaluateStep(FFirstStep, AContext.ContextNode);
   except
     ResultNodeSet.Free;
     raise;