From 3e9cd1fc1170165299a1fe30c434825444eeab2a Mon Sep 17 00:00:00 2001
From: Christopher Lam <christopher.lck@gmail.com>
Date: Wed, 12 Sep 2018 18:11:06 +0800
Subject: [PATCH] [test-extras] augment (gnc:options->sxml) to allow tag
 stripping

An html render containing a <script>...</script> tag will not
typically be parsable by sxml. This augmentation will strip an html
tag from the render. Therefore we can use

(gnc:options->sxml ... #:strip-tag "script")

which will strip off the whole <script> section from the render, which
should usually then be parsable. Note: this is not foolproof, and does
not support nested <script> tags, and it will strip quoted "</script>"
tags too, but should cover common cases.
---
 .../report/report-system/test/test-extras.scm | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index e6e02bf16e..acfaa61880 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -117,14 +117,27 @@
           (display render)))
       render)))
 
+(define (strip-string s1 s2)
+  (let loop ((str s1))
+    (let ((startpos (string-contains str (format #f "<~a" s2)))
+          (endpos (string-contains str (format #f "</~a>" s2))))
+      (if (and startpos endpos)
+          (loop (string-append
+                 (string-take str startpos)
+                 (string-drop str (+ endpos (string-length s2) 3))))
+          str))))
+
 (export gnc:options->sxml)
-(define (gnc:options->sxml uuid options prefix test-title)
+(define* (gnc:options->sxml uuid options prefix test-title #:key strip-tag)
   ;; This functions calls the above gnc:options->render to render
   ;; report.  Then report is converted to SXML.  It catches XML
-  ;; parsing errors, dumping the options changed.
+  ;; parsing errors, dumping the options changed. Also optionally strip
+  ;; an HTML tag from the render, e.g. <script>...</script>
   (let ((render (gnc:options->render uuid options prefix test-title)))
     (catch 'parser-error
-      (lambda () (xml->sxml render
+      (lambda () (xml->sxml (if strip-tag
+                                (strip-string render strip-tag)
+                                render)
                             #:trim-whitespace? #t
                             #:entities '((nbsp . "\xa0"))))
       (lambda (k . args)