Merge Carsten Rinke's branch 'Bug787401-TestReport-Definition' into maint.

gnucash/report/report-system/report.scm

@@ -72,6 +72,9 @@
 (define gnc:optname-stylesheet (N_ "Stylesheet"))
 (define gnc:menuname-business-reports (N_ "_Business"))
 (define gnc:optname-invoice-number (N_ "Invoice Number"))
+(define test-report-system-flag #f)
+
+(export test-report-system-flag)
 
 ;; We want to warn users if they've got an old-style, non-guid custom
 ;; report-template, but only once
@@ -118,7 +121,7 @@
                           in-report-rec
                           (blank-report))))
       (if (null? args)
-          in-report-rec
+          report-rec
           (let ((id (car args))
                (value (cadr args))
                (remainder (cddr args)))
@@ -139,9 +142,11 @@
 		;; FIXME: We should pass the top-level window
 		;; instead of the '() to gnc-error-dialog, but I
 		;; have no idea where to get it from.
+                (if (not test-report-system-flag)
 		  (gnc-error-dialog '() (string-append
           (_ "One of your reports has a report-guid that is a duplicate. Please check the report system, especially your saved reports, for a report with this report-guid: ")
           report-guid))
+                #f)
 		)))
 	(begin
 	  (if (gnc:report-template-name report-rec)
@@ -157,27 +162,39 @@
 				    (gnc:report-template-renderer report-rec))
 			    (not (gnc:report-template-parent-type rec)))
 		       (begin
-			 (gnc:debug "gnc:define-report: setting parent-type of " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid rec))
+			 (gnc:warn "gnc:define-report: setting parent-type of " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid rec))
 			 (gnc:report-template-set-parent-type! report-rec (gnc:report-template-report-guid rec))
 			 (gnc:debug "done setting, is now " (gnc:report-template-parent-type report-rec))))) 
 		 *gnc:_report-templates_*)
 
-
+                (if (gnc:report-template-parent-type report-rec)
+                  (begin
 		    ;; re-save this old-style report in the new format
 		    (gnc:report-template-save-to-savefile report-rec)
 		    (gnc:debug "complete saving " (gnc:report-template-name report-rec) " in new format")
-		))
-
-
-	  
                     (if (not gnc:old-style-report-warned)
 	              (begin
 		        (set! gnc:old-style-report-warned #t)
-		(gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team.")))))
+                        (if (not test-report-system-flag) ;; do not call this during "make test"
-	  (hash-set! *gnc:_report-templates_*
+		          (gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))))
-		     (gnc:report-template-report-guid report-rec) report-rec)
+	                (hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec)
-	  (gnc:warn "gnc:define-report: old-style report. setting guid for " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid report-rec)))
+                      )
-	)))
+                    )
+                  )
+                  ;;there is no parent -> this is an inital faulty report definition
+                  (if (not test-report-system-flag) ;; do not call this during "make test"
+                    (gnc-error-dialog '() (string-append (_ "Wrong report definition: ")
+                                                            (gnc:report-template-name report-rec)
+                                                         (_ " Report is missing a GUID.")))
+                  )
+                )
+              )
+            )
+          #f ;; report definition is faulty: does not include name
+
+	  ;;(gnc:warn "gnc:define-report: old-style report. setting guid for " (gnc:report-template-name report-rec) " to " (gnc:report-template-report-guid report-rec)) ;; obsolete
+
+	))))
 
 (define gnc:report-template-version
   (record-accessor <report-template> 'version))

gnucash/report/report-system/test/CMakeLists.txt

@@ -18,6 +18,7 @@ set(scm_test_report_system_SOURCES
 
 set (scm_test_report_system_with_srfi64_SOURCES
   test-html-utilities-srfi64.scm
+  test-report-system.scm
   )
 
 set(GUILE_DEPENDS

gnucash/report/report-system/test/test-report-system.scm

@@ -0,0 +1,79 @@
+(use-modules (gnucash gnc-module))
+
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+
+(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report report-system))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+
+(define (run-test)
+    (set! test-report-system-flag #t)
+    (test-runner-factory gnc:test-runner)
+    (test-begin "Testing/Temporary/test-report-system") ;; if (test-runner-factory gnc:test-runner) is commented out, this
+                                                            ;; will create Testing/Temporary/test-asset-performance.log
+    (test-assert "Minimum Report Definition" (test-check1))
+    (test-assert "Missing GUID detection" (test-check2))
+    (test-assert "Detect double GUID" (test-check3))
+    (test-assert "Report with Full Argument Set" (test-check4))
+    (set! test-report-system-flag #f)
+    (test-end "Testing/Temporary/test-report-system")
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check1)
+  (gnc:define-report 'version "1" 'name "Test Report Template" 'report-guid "54c2fc051af64a08ba2334c2e9179e23")
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check2)
+  (not (gnc:define-report 'version "1" 'name "Test Report Template"))
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check3)
+  (if (not (gnc:define-report 'version "1" 'name "Test Report Template" 'report-guid "54c2fc051af64a08ba2334c2e9179e23" 'parent-type "Parent Type" 'options-generator "Options Generator" 'renderer "Renderer" 'options-cleanup-cb "Options Clean-Up" 'options-changed-cb "Options Changed" 'in-menu? #f 'menu-path "Menu Path" 'menu-name "Menu Name" 'menu-tip "Menu Tip" 'export-types "Export Types" 'export-thunk "Export Thunk"))
+    #t
+    #f
+  )
+)
+
+;; -----------------------------------------------------------------------
+
+(define (test-check4)
+  (and
+    (gnc:define-report 'version "1"
+                       'name "Test Report Template"
+                       'report-guid "54c2fc051af64a08ba2334c2e9179e24"
+                       'parent-type "Parent Type"
+                       'options-generator "Options Generator"
+                       'renderer "Renderer"
+                       'options-cleanup-cb "Options Clean-Up"
+                       'options-changed-cb "Options Changed"
+                       'in-menu? #f
+                       'menu-path "Menu Path"
+                       'menu-name "Menu Name"
+                       'menu-tip "Menu Tip"
+                       'export-types "Export Types"
+                       'export-thunk "Export Thunk"
+    )
+    (string=? (gnc:report-template-version (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "1")
+    (string=? (gnc:report-template-name (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Test Report Template")
+    (string=? (gnc:report-template-report-guid
+                (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "54c2fc051af64a08ba2334c2e9179e24")
+    ;; parent type is not exported -> it is used in gnc:make-report
+    (string=? (gnc:report-template-options-generator (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Options Generator")
+    (string=? (gnc:report-template-renderer (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Renderer")
+    (string=? (gnc:report-template-options-cleanup-cb (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Options Clean-Up")
+    (string=? (gnc:report-template-options-changed-cb (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Options Changed")
+    (not (gnc:report-template-in-menu? (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")))
+    (string=? (gnc:report-template-menu-path (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Menu Path")
+    (string=? (gnc:report-template-menu-name (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Menu Name")
+    (string=? (gnc:report-template-menu-tip (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Menu Tip")
+    (string=? (gnc:report-template-export-types (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Export Types")
+    (string=? (gnc:report-template-export-thunk (gnc:find-report-template "54c2fc051af64a08ba2334c2e9179e24")) "Export Thunk")
+  )
+)