* Patch by Sergei Gorelkin:

  xmlread.pp:
  * As a step towards SAX-based validation, element content validator is
  rewritten from scratch, so it now accepts child elements one by
  one. This also enables reporting location of validation errors (however,
  most locations aren't reported correctly yet).
  * More straightforward handling of comments and PIs in internal subset.
  * Attribute text is handled separately from element text.
  * Unified handling of fatal and validation errors.

  xmlutils.pp:
  * Removed auto widechar->char conversions. These should have been a part
  of fix for #9528, but were not noticed at that moment.

  dom.pp:
  * Reworked 'ugly workarounds' in node removal code.
  + Element nodes remove themselves from document list of IDs, so no invalid pointers are left around.

  xmlts.pp:
  * Corrected validation diagnostics (display the first message and ingore subsequent ones).
  * Validation error alone in a not-well-formed case is a test failure.




git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@8896 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 34 insertions, 23 deletions

diff --git a/packages/fcl-xml/tests/xmlts.pp b/packages/fcl-xml/tests/xmlts.pp
index 62903d8a0a..e3e0c7b299 100644
--- a/packages/fcl-xml/tests/xmlts.pp
+++ b/packages/fcl-xml/tests/xmlts.pp
@@ -139,7 +139,8 @@ procedure TTestSuite.ErrorHandler(Error: EXMLReadError);
 begin
   if Error.Severity = esError then
   begin
-    FValError := Error.Message;
+    if FValError = '' then // fetch the _first_ message
+      FValError := Error.Message;
 { uncomment the line below to verify that the suite correctly handles
   exception raised from the handler }    
 //  Abort;  
@@ -351,16 +352,11 @@ begin
 
   table := nil;
   outURI := '';
+  Positive := False;
   if TestType = 'not-wf' then
-  begin
-    table := table_not_wf;
-    Positive := False;
-  end
+    table := table_not_wf
   else if TestType = 'error' then
-  begin
-    table := table_informative;
-    Positive := False;
-  end
+    table := table_informative
   else if TestType = 'valid' then
   begin
     if Element.hasAttribute('OUTPUT') then
@@ -393,30 +389,45 @@ begin
         if E.ClassType <> EAbort then
           FailMsg := E.Message;
     end;
-    if FailMsg <> '' then  // fatal errors take precedence
-      FValError := '';
+
+    if table = table_informative then
+    begin
+      if FailMsg <> '' then
+        Diagnose(element, table, dcInfo, '(fatal) ' + FailMsg)
+      else if FValError <> '' then
+        Diagnose(element, table, dcInfo, '(error) ' + FValError)
+      else
+        Diagnose(Element, table, dcInfo, '');
+      Exit;
+    end;
 
     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
+      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)
+        if FailMsg <> '' then  // Fatal error
+        begin
+          Inc(FFalsePasses);
+          Diagnose(Element, table, dcPass, FailMsg);
+        end
         else
-          Diagnose(Element, table, dcPass, FValError);
+        begin
+          if table = table_not_wf then  // validation error here is a test failure!
+          begin
+            Inc(FFailCount);
+            Diagnose(Element, table, dcFail, FValError);
+          end
+          else
+          begin
+            Inc(FFalsePasses);
+            Diagnose(Element, table, dcPass, FValError);
+          end;
+        end;
       end;
       Exit;
     end