mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[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:
parent
45cb454bdc
commit
85a4baeb21
@ -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) ", ")))
|
||||||
|
@ -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"
|
||||||
|
Loading…
Reference in New Issue
Block a user