Implementation of XPath function lang() + tests.

git-svn-id: trunk@13060 -

packages/fcl-xml/src/xmlutils.pp

@@ -31,6 +31,8 @@ function IsValidXmlEncoding(const Value: WideString): Boolean;
 function Xml11NamePages: PByteArray;
 procedure NormalizeSpaces(var Value: WideString);
 function Hash(InitValue: LongWord; Key: PWideChar; KeyLen: Integer): LongWord;
+{ beware, works in ASCII range only }
+function WStrLIComp(S1, S2: PWideChar; Len: Integer): Integer;
 
 { a simple hash table with WideString keys }
 
@@ -275,6 +277,33 @@ begin
   end;
 end;
 
+function WStrLIComp(S1, S2: PWideChar; Len: Integer): Integer;
+var
+  counter: Integer;
+  c1, c2: Word;
+begin
+  counter := 0;
+  result := 0;
+  if Len = 0 then
+    exit;
+  repeat
+    c1 := ord(S1[counter]);
+    c2 := ord(S2[counter]);
+    if (c1 = 0) or (c2 = 0) then break;
+    if c1 <> c2 then
+    begin
+      if c1 in [97..122] then
+        Dec(c1, 32);
+      if c2 in [97..122] then
+        Dec(c2, 32);
+      if c1 <> c2 then
+        Break;
+    end;
+    Inc(counter);
+  until counter >= Len;
+  result := c1 - c2;
+end;
+
 function Hash(InitValue: LongWord; Key: PWideChar; KeyLen: Integer): LongWord;
 begin
   Result := InitValue;

packages/fcl-xml/src/xpath.pp

@@ -567,6 +567,28 @@ begin
     end;
 end;
 
+function GetNodeLanguage(aNode: TDOMNode): DOMString;
+var
+  Attr: TDomAttr;
+begin
+  Result := '';
+  if aNode = nil then
+    Exit;
+  case aNode.NodeType of
+    ELEMENT_NODE: begin
+      Attr := TDomElement(aNode).GetAttributeNode('xml:lang');
+      if Assigned(Attr) then
+        Result := Attr.Value
+      else
+        Result := GetNodeLanguage(aNode.ParentNode);
+    end;
+    TEXT_NODE, CDATA_SECTION_NODE, ENTITY_REFERENCE_NODE,
+    PROCESSING_INSTRUCTION_NODE, COMMENT_NODE:
+      Result := GetNodeLanguage(aNode.ParentNode);
+    ATTRIBUTE_NODE:
+      Result := GetNodeLanguage(TDOMAttr(aNode).OwnerElement);
+  end;
+end;
 
 { XPath parse tree classes }
 
@@ -2628,10 +2650,22 @@ begin
 end;
 
 function TXPathEnvironment.xpLang(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
+var
+  L: Integer;
+  TheArg, NodeLang: DOMString;
+  res: Boolean;
 begin
   if Args.Count <> 1 then
     EvaluationError(SEvalInvalidArgCount);
-  EvaluationError(SEvalFunctionNotImplementedYet, ['lang']); // !!!
+  TheArg := TXPathVariable(Args[0]).AsText;
+  NodeLang := GetNodeLanguage(Context.ContextNode);
+
+  L := Length(TheArg);
+  res := (L <= Length(NodeLang)) and
+    (WStrLIComp(DOMPChar(NodeLang), DOMPChar(TheArg), L) = 0) and
+    ((L = Length(NodeLang)) or (NodeLang[L+1] = '-'));
+
+  Result := TXPathBooleanVariable.Create(res);
 end;
 
 function TXPathEnvironment.xpNumber(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;

packages/fcl-xml/tests/xpathts.pp

@@ -394,7 +394,16 @@ const
   '<e>-37</e>'+
   '</doc>';
 
-  FunctionTests: array[0..45] of TTestRec = (
+  expr01='<doc>'+
+  '<para id="1" xml:lang="en">en</para>'+
+  '<div xml:lang="en">'+
+  '  <para>en</para>'+
+  '</div>'+
+  '<para id="3" xml:lang="EN">EN</para>'+
+  '<para id="4" xml:lang="en-us">en-us</para>'+
+  '</doc>';
+
+  FunctionTests: array[0..49] of TTestRec = (
   // last()
   // position()
   // count()
@@ -419,9 +428,13 @@ const
     (expr: 'not(true())';  rt: rtBool; b: False),
     (expr: 'not(false())'; rt: rtBool; b: True),
     (expr: 'not("")';      rt: rtBool; b: True),
-    {
-     lang() -- involves nodes
-    }
+
+    // lang() tests. These ones, however, test much more than lang().
+    // Moreover, I've added string(), otherwise result would be a nodeset
+    (data: expr01; expr: 'string(para[@id="1" and lang("en")])'; rt: rtString; s: 'en'),     // expression01
+    (data: expr01; expr: 'string(para[@id="4" and lang("en")])'; rt: rtString; s: 'en-us'),  // expression03
+    (data: expr01; expr: 'string(div/para[lang("en")])'; rt: rtString; s: 'en'),             // expression04
+    (data: expr01; expr: 'string(para[@id="3" and lang("en")])'; rt: rtString; s: 'EN'),     // expression05
 
     (expr: 'number("1.5")';   rt: rtNumber; n: 1.5),
     (expr: 'number("abc")';   rt: rtNumber; n: NaN),