[report-core] disallow define-report with incomplete export info

if exporting is allowed, 'export-types and 'export-thunk must both be
defined.
This commit is contained in:
Christopher Lam 2021-05-05 08:52:08 +08:00
parent 45cb454bdc
commit 85a4baeb21
2 changed files with 23 additions and 3 deletions

View File

@ -237,6 +237,7 @@ not found.")))
(define report-rec (make-report-template)) (define report-rec (make-report-template))
(define allowable-fields (record-type-fields <report-template>)) (define allowable-fields (record-type-fields <report-template>))
(define (not-a-field? fld) (not (memq fld allowable-fields))) (define (not-a-field? fld) (not (memq fld allowable-fields)))
(define (xor . args) (fold (lambda (a b) (if a (if b #f a) b)) #f args))
(let loop ((args args)) (let loop ((args args))
(match args (match args
@ -252,6 +253,11 @@ not found.")))
((hash-ref *gnc:_report-templates_* report-guid) ((hash-ref *gnc:_report-templates_* report-guid)
(gui-error (string-append rpterr-dupe report-guid))) (gui-error (string-append rpterr-dupe report-guid)))
;; has export-type but no export-thunk. or vice versa.
((xor (gnc:report-template-export-thunk report-rec)
(gnc:report-template-export-types report-rec))
(gui-error (format #f "Export needs both thunk and types: ~a" report-guid)))
;; good: new report definition, store into report-templates hash ;; good: new report definition, store into report-templates hash
(else (else
(hash-set! *gnc:_report-templates_* report-guid report-rec))))) (hash-set! *gnc:_report-templates_* report-guid report-rec)))))
@ -836,10 +842,8 @@ not found.")))
(cond (cond
((not export-thunk) ((not export-thunk)
(stderr-log "Only the following reports have export code:\n") (stderr-log "Only the following reports have export code:\n")
(show-selected-reports (cut gnc:report-template-export-thunk <>) (show-selected-reports gnc:report-template-export-thunk (current-error-port))
(current-error-port))
(stderr-log "Use -R show to describe report\n")) (stderr-log "Use -R show to describe report\n"))
((not export-types) (stderr-log "Report ~s has no export-types\n" report))
((not (assoc export-type export-types)) ((not (assoc export-type export-types))
(stderr-log "Export-type disallowed: ~a. Allowed types: ~a\n" (stderr-log "Export-type disallowed: ~a. Allowed types: ~a\n"
export-type (string-join (map car export-types) ", "))) export-type (string-join (map car export-types) ", ")))

View File

@ -11,6 +11,7 @@
;; will create Testing/Temporary/test-asset-performance.log ;; will create Testing/Temporary/test-asset-performance.log
(test-check1) (test-check1)
(test-check-invalid-field) (test-check-invalid-field)
(test-check-incomplete-export)
(test-check2) (test-check2)
(test-check3) (test-check3)
(test-check4) (test-check4)
@ -31,6 +32,21 @@
1 1
(length (gnc:all-report-template-guids)))) (length (gnc:all-report-template-guids))))
(define (test-check-incomplete-export)
;; it's not legit to define report with ONLY export-thunk or
;; export-types. both must be defined.
(gnc:define-report 'version 3
'name "Test Report Template4"
'export-thunk #t
'report-guid "incomplete-export-guid")
(gnc:define-report 'version 3
'name "Test Report Template4"
'export-types #t
'report-guid "incomplete-export-guid")
(test-equal "report with incomplete export thunk"
1
(length (gnc:all-report-template-guids))))
(define (test-check-invalid-field) (define (test-check-invalid-field)
(gnc:define-report 'version 3 (gnc:define-report 'version 3
'name "Test Report Template4" 'name "Test Report Template4"