|
|
@@ -0,0 +1,778 @@
|
|
|
+{
|
|
|
+ This file is part of the Free Component Library (FCL)
|
|
|
+
|
|
|
+ FCL test runner for OASIS/NIST XML test suite
|
|
|
+ It is somewhat based on 'harness.js' script
|
|
|
+ (see http://xmlconf.sourceforge.net)
|
|
|
+ Copyright (c) 2006 by Sergei Gorelkin, [email protected]
|
|
|
+
|
|
|
+ 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 xmlts;
|
|
|
+
|
|
|
+{$IFDEF FPC}
|
|
|
+{$MODE OBJFPC}{$H+}
|
|
|
+{$ENDIF}
|
|
|
+{$APPTYPE CONSOLE}
|
|
|
+
|
|
|
+uses
|
|
|
+ SysUtils,
|
|
|
+ Classes,
|
|
|
+ DOM,
|
|
|
+ XMLRead,
|
|
|
+ XMLWrite,
|
|
|
+ UriParser;
|
|
|
+
|
|
|
+const
|
|
|
+ harness = 'Pascal version';
|
|
|
+ version = '0.0.1 alpha :)';
|
|
|
+ parser = 'FCL XML parser';
|
|
|
+ parserName = parser;
|
|
|
+ os = 'Unknown OS';
|
|
|
+ runtime = 'FPC RTL';
|
|
|
+
|
|
|
+
|
|
|
+type
|
|
|
+ TDiagCategory = (dcInfo, dcNegfail, dcFail, dcPass);
|
|
|
+
|
|
|
+ TTestSuite = class
|
|
|
+ private
|
|
|
+ FTemplate: TXMLDocument;
|
|
|
+ FParser: TDOMParser;
|
|
|
+ FPassed, FFailCount: Integer;
|
|
|
+ FFalsePasses: Integer;
|
|
|
+ FRootUri: string;
|
|
|
+ FTemplateName: string;
|
|
|
+ FSuiteName: string;
|
|
|
+ FDoc: TXMLDocument;
|
|
|
+ FValidating: Boolean;
|
|
|
+ FSuiteTitle: DOMString;
|
|
|
+ FState: DOMString;
|
|
|
+ FSkipped: Integer;
|
|
|
+ FTotal: Integer;
|
|
|
+ table_valid: TDOMNode;
|
|
|
+ table_output: TDOMNode;
|
|
|
+ table_invalid: TDOMNode;
|
|
|
+ table_not_wf: TDOMNode;
|
|
|
+ table_informative: TDOMNode;
|
|
|
+ FValError: string;
|
|
|
+ FTestID: DOMString;
|
|
|
+ procedure LoadTemplate(const Name: string);
|
|
|
+ procedure HandleTemplatePIs(Element: TDOMNode);
|
|
|
+ procedure Diagnose(Element, Table: TDOMNode; Category: TDiagCategory; const Error: DOMString);
|
|
|
+ procedure DiagnoseOut(const ErrorMsg: DOMString);
|
|
|
+ function CompareNodes(actual, correct: TDOMNode; out Msg: string): Boolean;
|
|
|
+ procedure Canonicalize(node: TDOMNode);
|
|
|
+ procedure ErrorHandler(Error: EXMLReadError);
|
|
|
+ public
|
|
|
+ constructor Create;
|
|
|
+ procedure Run(const Tests: string);
|
|
|
+ procedure RunTest(Element: TDOMElement);
|
|
|
+ destructor Destroy; override;
|
|
|
+ end;
|
|
|
+
|
|
|
+function GetBaseURI(Element: TDOMNode; const DocumentURI: string): string;
|
|
|
+var
|
|
|
+ Ent: TDOMNode;
|
|
|
+ Uri1, Uri2, s: WideString;
|
|
|
+begin
|
|
|
+ case Element.NodeType of
|
|
|
+ ELEMENT_NODE, TEXT_NODE, CDATA_SECTION_NODE,
|
|
|
+ PROCESSING_INSTRUCTION_NODE, COMMENT_NODE, DOCUMENT_TYPE_NODE:
|
|
|
+ if Assigned(Element.ParentNode)
|
|
|
+ then Result := GetBaseURI(Element.ParentNode, DocumentURI)
|
|
|
+ else Result := '';
|
|
|
+
|
|
|
+ ATTRIBUTE_NODE: begin
|
|
|
+ Result := '';
|
|
|
+ if Assigned(TDomAttr(Element).OwnerElement) then
|
|
|
+ begin
|
|
|
+ Result := GetBaseURI(TDomAttr(Element).OwnerElement, DocumentURI);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ ENTITY_REFERENCE_NODE: begin
|
|
|
+ Ent := Element.OwnerDocument.DocType.Entities.GetNamedItem(Element.NodeName);
|
|
|
+ if Assigned(Ent) and (TDOMEntity(Ent).SystemID <> '') then
|
|
|
+ begin
|
|
|
+ Uri1 := TDOMEntity(Ent).SystemID;
|
|
|
+ if IsAbsoluteURI(Uri1) then
|
|
|
+ begin
|
|
|
+ Result := Uri1;
|
|
|
+ end else begin
|
|
|
+ Uri2 := GetBaseURI(Element.ParentNode, DocumentUri);
|
|
|
+ ResolveRelativeUri(Uri2, Uri1, s);
|
|
|
+ Result := s;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if Assigned(Element.ParentNode)
|
|
|
+ then Result := GetBaseURI(Element.ParentNode, DocumentURI)
|
|
|
+ else Result := '';
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ DOCUMENT_NODE: Result := DocumentURI;
|
|
|
+ else
|
|
|
+ Result := '';
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{ TTestSuite }
|
|
|
+
|
|
|
+constructor TTestSuite.Create;
|
|
|
+begin
|
|
|
+ inherited Create;
|
|
|
+ FParser := TDOMParser.Create;
|
|
|
+ FParser.Options.PreserveWhitespace := True;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestSuite.ErrorHandler(Error: EXMLReadError);
|
|
|
+begin
|
|
|
+ if Error.Severity = esError then
|
|
|
+ begin
|
|
|
+ FValError := Error.Message;
|
|
|
+{ uncomment the line below to verify that the suite correctly handles
|
|
|
+ exception raised from the handler }
|
|
|
+// Abort;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestSuite.LoadTemplate(const Name: string);
|
|
|
+var
|
|
|
+ tables: TDOMNodeList;
|
|
|
+ I: Integer;
|
|
|
+ id: DOMString;
|
|
|
+ el: TDOMElement;
|
|
|
+begin
|
|
|
+ ReadXMLFile(FTemplate, Name);
|
|
|
+ tables := FTemplate.DocumentElement.GetElementsByTagName('table');
|
|
|
+ try
|
|
|
+ for I := 0 to tables.Count-1 do
|
|
|
+ begin
|
|
|
+ el := TDOMElement(tables.Item[I]);
|
|
|
+ id := el['id'];
|
|
|
+ if id = 'valid' then
|
|
|
+ table_valid := el
|
|
|
+ else if ((id = 'invalid-negative') and FValidating) or ((id = 'invalid-positive') and not FValidating) then
|
|
|
+ table_invalid := el
|
|
|
+ else if id = 'valid-output' then
|
|
|
+ table_output := el
|
|
|
+ else if id = 'not-wf' then
|
|
|
+ table_not_wf := el
|
|
|
+ else if id = 'error' then
|
|
|
+ table_informative := el;
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ tables.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TTestSuite.Destroy;
|
|
|
+begin
|
|
|
+ FDoc.Free;
|
|
|
+ FTemplate.Free;
|
|
|
+ FParser.Free;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestSuite.HandleTemplatePIs(Element: TDOMNode);
|
|
|
+var
|
|
|
+ Children: TDOMNodeList;
|
|
|
+ Child: TDOMNode;
|
|
|
+ NewChild: TDOMNode;
|
|
|
+ Remove: Boolean;
|
|
|
+ Index: Integer;
|
|
|
+ Data: DOMString;
|
|
|
+begin
|
|
|
+ Children := element.childNodes;
|
|
|
+ Remove := False;
|
|
|
+ Index := 0;
|
|
|
+
|
|
|
+ repeat
|
|
|
+ Child := Children.Item[Index];
|
|
|
+ if Child = nil then Break;
|
|
|
+ Inc(index);
|
|
|
+
|
|
|
+ // inside a rejected <?if ...?>...<?endif?>
|
|
|
+ if Remove and (child.nodeType <> PROCESSING_INSTRUCTION_NODE) then
|
|
|
+ begin
|
|
|
+ Element.removeChild(child);
|
|
|
+ Dec(Index);
|
|
|
+ Continue;
|
|
|
+ end;
|
|
|
+ if Child.hasChildNodes then
|
|
|
+ begin
|
|
|
+ HandleTemplatePIs(Child);
|
|
|
+ Continue;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if Child.nodeType <> PROCESSING_INSTRUCTION_NODE then
|
|
|
+ Continue;
|
|
|
+
|
|
|
+ Data := Child.NodeValue;
|
|
|
+
|
|
|
+ if Child.NodeName = 'run-id' then
|
|
|
+ begin
|
|
|
+ if Data = 'name' then
|
|
|
+ newChild := FTemplate.createTextNode(parser)
|
|
|
+ else if Data = 'description' then
|
|
|
+ newChild := FTemplate.createTextNode (parserName)
|
|
|
+ else if Data = 'general-entities' then
|
|
|
+ newChild := FTemplate.createTextNode('included')
|
|
|
+ else if Data = 'parameter-entities' then
|
|
|
+ newChild := FTemplate.createTextNode ('included')
|
|
|
+ else if Data = 'type' then
|
|
|
+ begin
|
|
|
+ if FValidating then
|
|
|
+ Data := 'Validating'
|
|
|
+ else
|
|
|
+ Data := 'Non-Validating';
|
|
|
+ newChild := FTemplate.createTextNode(Data);
|
|
|
+ end
|
|
|
+ // ... test run description
|
|
|
+ else if Data = 'date' then
|
|
|
+ newChild := FTemplate.createTextNode(DateTimeToStr(Now))
|
|
|
+ else if Data = 'harness' then
|
|
|
+ newChild := FTemplate.createTextNode(harness)
|
|
|
+ else if Data = 'java' then
|
|
|
+ newChild := FTemplate.createTextNode(runtime)
|
|
|
+ else if Data = 'os' then
|
|
|
+ newChild := FTemplate.createTextNode(os)
|
|
|
+ else if Data = 'testsuite' then
|
|
|
+ newChild := FTemplate.createTextNode(FSuiteTitle)
|
|
|
+ else if Data = 'version' then
|
|
|
+ newChild := FTemplate.createTextNode(version)
|
|
|
+ // ... test result info
|
|
|
+ else if Data = 'failed' then
|
|
|
+ newChild := FTemplate.createTextNode(IntToStr(FFailCount))
|
|
|
+ else if Data = 'passed' then
|
|
|
+ newChild := FTemplate.createTextNode(IntToStr(FPassed))
|
|
|
+ else if Data = 'passed-negative' then
|
|
|
+ newChild := FTemplate.createTextNode(IntToStr(FFalsePasses))
|
|
|
+ else if Data = 'skipped' then
|
|
|
+ newChild := FTemplate.createTextNode(IntToStr(FSkipped))
|
|
|
+ else if Data = 'status' then
|
|
|
+ newChild := FTemplate.createTextNode (FState);
|
|
|
+
|
|
|
+ Element.replaceChild (newChild, child);
|
|
|
+ Continue;
|
|
|
+ end
|
|
|
+
|
|
|
+ // if/endif don't nest, and always have the same parent
|
|
|
+ // we rely on those facts here!
|
|
|
+ else if Child.NodeName = 'if' then
|
|
|
+ begin
|
|
|
+ Remove := not (((Data = 'validating') and FValidating) or
|
|
|
+ ((Data = 'nonvalidating') and not FValidating));
|
|
|
+ element.removeChild(child);
|
|
|
+ Dec(Index);
|
|
|
+ Continue;
|
|
|
+ end
|
|
|
+ else if Child.NodeName = 'endif' then
|
|
|
+ begin
|
|
|
+ Remove := False;
|
|
|
+ element.removeChild(child);
|
|
|
+ Dec(Index);
|
|
|
+ Continue;
|
|
|
+ end;
|
|
|
+ until False;
|
|
|
+ Children.Free;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure TTestSuite.Run(const Tests: string);
|
|
|
+var
|
|
|
+ Cases: TDOMNodeList;
|
|
|
+ I: Integer;
|
|
|
+begin
|
|
|
+ FRootURI := FilenameToURI(Tests);
|
|
|
+ ReadXMLFile(FDoc, Tests);
|
|
|
+ FSuiteTitle := FDoc.DocumentElement['PROFILE'];
|
|
|
+ Cases := FDoc.DocumentElement.GetElementsByTagName('TEST');
|
|
|
+ writeln('Using test suite: ', Tests);
|
|
|
+ writeln;
|
|
|
+ writeln('Testing, validation = ', FValidating);
|
|
|
+ try
|
|
|
+ for I := 0 to Cases.Count-1 do
|
|
|
+ RunTest(Cases.Item[I] as TDOMElement);
|
|
|
+ I := Cases.Count;
|
|
|
+ finally
|
|
|
+ Cases.Free;
|
|
|
+ end;
|
|
|
+
|
|
|
+ FPassed := FTotal-FFailCount;
|
|
|
+ Dec(FPassed, FSkipped);
|
|
|
+
|
|
|
+ writeln('Found ', I, ' basic test cases.');
|
|
|
+ writeln('Found ', FTotal, ' overall test cases.');
|
|
|
+ writeln('Skipped: ', FSkipped);
|
|
|
+ writeln('Passed: ', FPassed);
|
|
|
+ writeln('Failed: ', FFailCount);
|
|
|
+ writeln('Negative passes: ', FFalsePasses, ' (need examination).');
|
|
|
+ writeln;
|
|
|
+
|
|
|
+ if FPassed = 0 then
|
|
|
+ FState := 'N/A'
|
|
|
+ else if FPassed = FTotal then
|
|
|
+ FState := 'CONFORMS (provisionally)'
|
|
|
+ else
|
|
|
+ FState := 'DOES NOT CONFORM';
|
|
|
+
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestSuite.RunTest(Element: TDOMElement);
|
|
|
+var
|
|
|
+ s: UTF8string;
|
|
|
+ TestType: DOMString;
|
|
|
+ TempDoc, RefDoc: TXMLDocument;
|
|
|
+ table: TDOMNode;
|
|
|
+ Positive: Boolean;
|
|
|
+ outURI: UTF8string;
|
|
|
+ FailMsg: string;
|
|
|
+ docNode, refNode: TDOMNode;
|
|
|
+ docMap, refMap: TDOMNamedNodeMap;
|
|
|
+ docN, refN: TDOMNotation;
|
|
|
+ I: Integer;
|
|
|
+ root: UTF8String;
|
|
|
+begin
|
|
|
+ FTestID := Element['ID'];
|
|
|
+ TestType := Element['TYPE'];
|
|
|
+ root := GetBaseURI(Element, FRootUri);
|
|
|
+ ResolveRelativeURI(root, UTF8Encode(Element['URI']), s);
|
|
|
+
|
|
|
+ table := nil;
|
|
|
+ outURI := '';
|
|
|
+ if TestType = 'not-wf' then
|
|
|
+ begin
|
|
|
+ table := table_not_wf;
|
|
|
+ Positive := False;
|
|
|
+ end
|
|
|
+ else if TestType = 'error' then
|
|
|
+ begin
|
|
|
+ table := table_informative;
|
|
|
+ Positive := False;
|
|
|
+ end
|
|
|
+ else if TestType = 'valid' then
|
|
|
+ begin
|
|
|
+ if Element.hasAttribute('OUTPUT') then
|
|
|
+ ResolveRelativeURI(root, UTF8Encode(Element['OUTPUT']), outURI);
|
|
|
+ table := table_valid;
|
|
|
+ Positive := True;
|
|
|
+ end
|
|
|
+ else if TestType = 'invalid' then
|
|
|
+ begin
|
|
|
+ table := table_invalid;
|
|
|
+ Positive := not FValidating;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if TestType <> 'error' then
|
|
|
+ begin
|
|
|
+ Inc(FTotal);
|
|
|
+ if outURI <> '' then Inc(FTotal);
|
|
|
+ end;
|
|
|
+
|
|
|
+ FailMsg := '';
|
|
|
+ FValError := '';
|
|
|
+ TempDoc := nil;
|
|
|
+ try
|
|
|
+ try
|
|
|
+ FParser.Options.Validate := FValidating;
|
|
|
+ FParser.OnError := {$IFDEF FPC}@{$ENDIF}ErrorHandler;
|
|
|
+ FParser.ParseUri(s, TempDoc);
|
|
|
+ except
|
|
|
+ on E: Exception do
|
|
|
+ if E.ClassType <> EAbort then
|
|
|
+ FailMsg := E.Message;
|
|
|
+ end;
|
|
|
+ if FailMsg <> '' then // fatal errors take precedence
|
|
|
+ FValError := '';
|
|
|
+
|
|
|
+ if not Positive then // must have been failed
|
|
|
+ begin
|
|
|
+ if TestType = 'error' then
|
|
|
+ begin
|
|
|
+ if FailMsg <> '' then
|
|
|
+ Diagnose(element, table, dcInfo, FailMsg)
|
|
|
+ else
|
|
|
+ Diagnose(element, table, dcInfo, FValError);
|
|
|
+ end
|
|
|
+ else if (FailMsg = '') and (FValError = '') then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ Diagnose(element, table, dcNegfail, '');
|
|
|
+ end
|
|
|
+ else // FailMsg <> '' or FValError <> '' -> actually failed
|
|
|
+ begin
|
|
|
+ Inc(FFalsePasses);
|
|
|
+ if FailMsg <> '' then
|
|
|
+ Diagnose(Element, table, dcPass, FailMsg)
|
|
|
+ else
|
|
|
+ Diagnose(Element, table, dcPass, FValError);
|
|
|
+ end;
|
|
|
+ Exit;
|
|
|
+ end
|
|
|
+ else // must have been succeeded
|
|
|
+ if (FailMsg <> '') or (FValError <> '') then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ if FailMsg <> '' then
|
|
|
+ Diagnose(Element, table, dcFail, FailMsg)
|
|
|
+ else
|
|
|
+ Diagnose(Element, table, dcFail, FValError);
|
|
|
+ if (outURI <> '') and (FailMsg <> '') then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut('[ input failed, no output to test ]');
|
|
|
+ end;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if outURI = '' then Exit;
|
|
|
+ Canonicalize(TempDoc);
|
|
|
+ TempDoc.DocumentElement.Normalize;
|
|
|
+ try
|
|
|
+ // reference data must be parsed in non-validating mode because it contains DTDs
|
|
|
+ // only when Notations need to be reported
|
|
|
+ FParser.Options.Validate := False;
|
|
|
+ FParser.ParseUri(outURI, RefDoc);
|
|
|
+ try
|
|
|
+ docNode := TempDoc.FirstChild;
|
|
|
+ refNode := RefDoc.FirstChild;
|
|
|
+ repeat
|
|
|
+ if refNode = nil then
|
|
|
+ begin
|
|
|
+ if docNode <> nil then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut('Extra data: ' + docNode.NodeName + ' / ' + docNode.NodeValue);
|
|
|
+ end;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if docNode = nil then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut('Missing data: ' + refNode.NodeName + ' / ' + refNode.NodeValue);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if refNode.NodeType = DOCUMENT_TYPE_NODE then
|
|
|
+ begin
|
|
|
+ if docNode.NodeType <> DOCUMENT_TYPE_NODE then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut('[ no doctype from parsing testcase ]');
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ refMap := TDOMDocumentType(refNode).Notations;
|
|
|
+ docMap := TDOMDocumentType(docNode).Notations;
|
|
|
+
|
|
|
+ for I := 0 to refMap.Length-1 do
|
|
|
+ begin
|
|
|
+ refN := TDOMNotation(refMap[I]);
|
|
|
+ docN := TDOMNotation(docMap.GetNamedItem(refMap[I].NodeName));
|
|
|
+ if not Assigned(docN) then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut('missing notation declaration: ' + refN.NodeName);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if (refN.PublicID <> docN.PublicID) or (refN.SystemID <> docN.SystemID) then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut('incorrect notation declaration: ' + refN.NodeName);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ refNode := refNode.NextSibling;
|
|
|
+ docNode := docNode.NextSibling;
|
|
|
+ Continue;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if docNode.NodeType = DOCUMENT_TYPE_NODE then // skip DocType
|
|
|
+ docNode := docNode.NextSibling;
|
|
|
+
|
|
|
+ if not CompareNodes(docNode, refNode, FailMsg) then
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut(FailMsg);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ docNode := docNode.NextSibling;
|
|
|
+ refNode := refNode.NextSibling;
|
|
|
+ until False;
|
|
|
+ finally
|
|
|
+ RefDoc.Free;
|
|
|
+ end;
|
|
|
+ except
|
|
|
+ on E: Exception do
|
|
|
+ begin
|
|
|
+ Inc(FFailCount);
|
|
|
+ DiagnoseOut('[ can''t read reference data: '+E.Message+' ]');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ TempDoc.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure TTestSuite.Diagnose(Element, Table: TDOMNode; Category: TDiagCategory;
|
|
|
+ const Error: DOMString);
|
|
|
+var
|
|
|
+ tr, td, txt, tmp: TDOMNode;
|
|
|
+ s: DOMString;
|
|
|
+begin
|
|
|
+ tr := FTemplate.CreateElement('tr');
|
|
|
+ if Assigned(Element) then // column 1: section/chapter, if known
|
|
|
+ begin
|
|
|
+ s := TDOMElement(Element)['SECTIONS'];
|
|
|
+ td := FTemplate.CreateElement('td');
|
|
|
+ td.AppendChild(FTemplate.CreateTextNode(s));
|
|
|
+ tr.AppendChild(td);
|
|
|
+ end;
|
|
|
+
|
|
|
+ td := FTemplate.CreateElement('td'); // column 2: test ID
|
|
|
+ td.AppendChild(FTemplate.CreateTextNode(FTestID));
|
|
|
+ tr.AppendChild(td);
|
|
|
+ // third column is description
|
|
|
+ if Assigned(Element) then
|
|
|
+ begin
|
|
|
+ td := FTemplate.CreateElement('td');
|
|
|
+ txt := Element.FirstChild;
|
|
|
+ while Assigned(txt) do
|
|
|
+ begin
|
|
|
+ td.AppendChild(txt.CloneNode(true, FTemplate));
|
|
|
+ txt := txt.NextSibling;
|
|
|
+ end;
|
|
|
+ tr.AppendChild(td);
|
|
|
+ end;
|
|
|
+ // fourth column is reason
|
|
|
+ td := FTemplate.CreateElement('td');
|
|
|
+ if Element = nil then
|
|
|
+ s := Error
|
|
|
+ else if Category <> dcInfo then
|
|
|
+ begin
|
|
|
+ if Error <> '' then
|
|
|
+ begin
|
|
|
+ if FValError <> '' then
|
|
|
+ s := '(error) ' + Error
|
|
|
+ else
|
|
|
+ s := '(fatal) ' + Error;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ s := '[wrongly accepted]';
|
|
|
+ end
|
|
|
+ else // informative
|
|
|
+ begin
|
|
|
+ if Error <> '' then
|
|
|
+ s := Error
|
|
|
+ else
|
|
|
+ s := '[accepted]';
|
|
|
+ end;
|
|
|
+ // TODO: use   if text is empty
|
|
|
+ txt := FTemplate.CreateTextNode(s);
|
|
|
+
|
|
|
+ if (Category <> dcPass) and (Category <> dcInfo) then
|
|
|
+ begin
|
|
|
+ tmp := FTemplate.CreateElement('em');
|
|
|
+ tmp.AppendChild(txt);
|
|
|
+ txt := tmp;
|
|
|
+ TDOMElement(td)['bgcolor'] := '#ffaacc';
|
|
|
+ end;
|
|
|
+ td.AppendChild(txt);
|
|
|
+ tr.AppendChild(td);
|
|
|
+
|
|
|
+ table.AppendChild(tr);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestSuite.DiagnoseOut(const ErrorMsg: DOMString);
|
|
|
+var
|
|
|
+ tr, td, txt: TDOMNode;
|
|
|
+begin
|
|
|
+ tr := FTemplate.CreateElement('tr');
|
|
|
+
|
|
|
+ td := FTemplate.CreateElement('td');
|
|
|
+ td.AppendChild(FTemplate.CreateTextNode(FTestID));
|
|
|
+ tr.AppendChild(td);
|
|
|
+
|
|
|
+ td := FTemplate.CreateElement('td');
|
|
|
+ txt := FTemplate.CreateElement('em');
|
|
|
+ txt.AppendChild(FTemplate.CreateTextNode(ErrorMsg));
|
|
|
+ td.AppendChild(txt);
|
|
|
+ TDOMElement(td)['bgcolor'] := '#ffaacc';
|
|
|
+ tr.AppendChild(td);
|
|
|
+ table_output.AppendChild(tr);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure TTestSuite.Canonicalize(node: TDOMNode);
|
|
|
+var
|
|
|
+ child, work: TDOMNode;
|
|
|
+ Frag: TDOMDocumentFragment;
|
|
|
+begin
|
|
|
+ child := node.FirstChild;
|
|
|
+ while Assigned(child) do
|
|
|
+ begin
|
|
|
+ if child.NodeType = CDATA_SECTION_NODE then
|
|
|
+ begin
|
|
|
+ work := node.OwnerDocument.CreateTextNode(child.NodeValue);
|
|
|
+ node.ReplaceChild(work, child);
|
|
|
+ child := work;
|
|
|
+ end
|
|
|
+ else if child.NodeType = COMMENT_NODE then
|
|
|
+ begin
|
|
|
+ work := child.NextSibling;
|
|
|
+ node.RemoveChild(child);
|
|
|
+ child := work;
|
|
|
+ Continue;
|
|
|
+ end
|
|
|
+ else if child.NodeType = ENTITY_REFERENCE_NODE then
|
|
|
+ begin
|
|
|
+ Frag := node.OwnerDocument.CreateDocumentFragment;
|
|
|
+ try
|
|
|
+ work := child.FirstChild;
|
|
|
+ while Assigned(work) do
|
|
|
+ begin
|
|
|
+ Frag.AppendChild(work.CloneNode(true));
|
|
|
+ work := work.NextSibling;
|
|
|
+ end;
|
|
|
+ work := Frag.FirstChild; // references may be nested
|
|
|
+ if work = nil then
|
|
|
+ work := Child.PreviousSibling;
|
|
|
+
|
|
|
+ node.ReplaceChild(Frag, child);
|
|
|
+ child := work;
|
|
|
+ finally
|
|
|
+ Frag.Free;
|
|
|
+ end;
|
|
|
+ Continue;
|
|
|
+ end;
|
|
|
+ if child.HasChildNodes then
|
|
|
+ Canonicalize(child);
|
|
|
+ child := child.NextSibling;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestSuite.CompareNodes(actual, correct: TDOMNode;
|
|
|
+ out Msg: string): Boolean;
|
|
|
+var
|
|
|
+ actAtts, refAtts: TDOMNamedNodeMap;
|
|
|
+ actList, refList: TDOMNodeList;
|
|
|
+ I: Integer;
|
|
|
+ s1, s2: DOMString;
|
|
|
+begin
|
|
|
+ Msg := '';
|
|
|
+ Result := False;
|
|
|
+ if actual.NodeType <> correct.NodeType then
|
|
|
+ FmtStr(Msg, 'actual.NodeType (%d) != correct.NodeType (%d)', [actual.NodeType, correct.NodeType])
|
|
|
+ else if actual.NodeName <> correct.NodeName then
|
|
|
+ FmtStr(Msg, 'actual.NodeName (%s) != correct.NodeName (%s)', [actual.NodeName, correct.NodeName])
|
|
|
+ else if actual.NodeValue <> correct.NodeValue then
|
|
|
+ FmtStr(Msg, 'actual.NodeValue (%s) != correct.NodeValue (%s)', [actual.NodeValue, correct.NodeValue]);
|
|
|
+ if Msg <> '' then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ if actual.NodeType = ELEMENT_NODE then
|
|
|
+ begin
|
|
|
+ // first, compare attributes
|
|
|
+ actAtts := actual.Attributes;
|
|
|
+ refAtts := correct.Attributes;
|
|
|
+ if actAtts.Length <> refAtts.Length then
|
|
|
+ begin
|
|
|
+ FmtStr(Msg, 'Element ''%s'': attributes.length (%d) != %d', [actual.NodeName, actAtts.Length, refAtts.Length]);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ for I := 0 to actAtts.Length -1 do
|
|
|
+ begin
|
|
|
+ s1 := refAtts.GetNamedItem(actAtts[I].NodeName).NodeValue;
|
|
|
+ s2 := actAtts[I].NodeValue;
|
|
|
+ if s1 <> s2 then
|
|
|
+ begin
|
|
|
+ FmtStr(Msg, 'Element ''%s'', attribute ''%s'': actual.AttValue (%s) != correct.AttValue (%s)', [actual.NodeName, actAtts[I].NodeName, s2, s1]);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ // next, compare children
|
|
|
+ actList := actual.ChildNodes;
|
|
|
+ refList := correct.ChildNodes;
|
|
|
+ try
|
|
|
+ if actList.Count <> refList.Count then
|
|
|
+ begin
|
|
|
+ FmtStr(Msg, 'Element ''%s'': actual.ChildNodeCount (%d) != correct.ChildNodeCount (%d)', [actual.NodeName, actList.Count, refList.Count]);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ for I := 0 to actList.Count -1 do
|
|
|
+ if not CompareNodes(actList[I], refList[I], Msg) then
|
|
|
+ Exit;
|
|
|
+ finally
|
|
|
+ actList.Free;
|
|
|
+ refList.Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Result := True;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+var
|
|
|
+ i: Integer;
|
|
|
+ s: string;
|
|
|
+ SuiteName, ReportName, TemplateName: string;
|
|
|
+ Validation: Boolean;
|
|
|
+begin
|
|
|
+ writeln('FCL driver for OASIS/NIST XML Test Suite');
|
|
|
+ writeln('Copyright (c) 2006 by Sergei Gorelkin');
|
|
|
+ TemplateName := ExtractFilePath(ParamStr(0)) + 'template.xml';
|
|
|
+ if ParamCount < 2 then
|
|
|
+ begin
|
|
|
+ writeln;
|
|
|
+ writeln('Usage: ', ParamStr(0), ' <suite> <report> [-t template][-v]');
|
|
|
+ writeln(' -t: specify report template');
|
|
|
+ writeln(' -v: validating mode');
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ SuiteName := ExpandFilename(ParamStr(1));
|
|
|
+ ReportName := ExpandFilename(ParamStr(2));
|
|
|
+ i := 3;
|
|
|
+ Validation := False;
|
|
|
+ while i <= ParamCount do
|
|
|
+ begin
|
|
|
+ s := Lowercase(ParamStr(i));
|
|
|
+ if s = '-v' then
|
|
|
+ Validation := True
|
|
|
+ else if s = '-t' then
|
|
|
+ TemplateName := ExpandFileName(ParamStr(i+1));
|
|
|
+ Inc(i);
|
|
|
+ end;
|
|
|
+
|
|
|
+ with TTestSuite.Create do
|
|
|
+ try
|
|
|
+ FSuiteName := SuiteName;
|
|
|
+ FTemplateName := TemplateName;
|
|
|
+ FValidating := Validation;
|
|
|
+ LoadTemplate(FTemplateName);
|
|
|
+ if Assigned(FTemplate) then
|
|
|
+ begin
|
|
|
+ Run(FSuiteName);
|
|
|
+ HandleTemplatePIs(FTemplate.DocumentElement);
|
|
|
+ writeln('Writing report to: ', ReportName);
|
|
|
+ WriteXMLFile(FTemplate, ReportName);
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ Free;
|
|
|
+ end;
|
|
|
+
|
|
|
+end.
|
michael