From 1da5a277188a954d881316cb605962ee66053285 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 17 Mar 2022 22:14:18 +0100 Subject: Normalize errors. --- config.scm | 3 ++- module/base64.scm | 5 ++++- module/c/cpp.scm | 8 +++++--- module/c/parse.scm | 20 +++++++++++++------- module/calp/entry-points/convert.scm | 4 ++-- module/calp/entry-points/html.scm | 2 +- module/calp/html/components.scm | 5 ++++- module/calp/html/util.scm | 1 + module/calp/html/view/calendar.scm | 4 ++-- module/calp/main.scm | 12 +++++++++--- module/calp/repl.scm | 5 +++-- module/calp/util/config.scm | 19 +++++++++++++++---- module/crypto.scm | 4 +++- module/datetime.scm | 8 ++++++-- module/datetime/zic.scm | 29 +++++++++++++++++++++-------- module/glob.scm | 11 ++++++++--- module/hnh/util.scm | 26 ++++++++++++++------------ module/hnh/util/graph.scm | 9 +++++---- module/text/numbers.scm | 1 + module/vcomponent/duration.scm | 16 ++++++++++++---- module/vcomponent/formats/common/types.scm | 3 ++- module/vcomponent/formats/ical/parse.scm | 12 ++++++++---- module/vcomponent/formats/xcal/parse.scm | 14 ++++++++------ module/vcomponent/recurrence/generate.scm | 4 +++- module/vcomponent/recurrence/parse.scm | 8 +++++--- module/vcomponent/util/parse-cal-path.scm | 5 ++++- tests/test/base64.scm | 2 +- tests/test/recurrence-simple.scm | 2 +- tests/test/util.scm | 2 +- 29 files changed, 164 insertions(+), 80 deletions(-) diff --git a/config.scm b/config.scm index e03cef0b..641b3050 100644 --- a/config.scm +++ b/config.scm @@ -30,8 +30,9 @@ (define (parse-html str) (catch 'misc-error + ;; resolve-interface throws misc-error on missing module. + ;; TODO what does html->sxml throw? (lambda () - ;; resolve interface throws on missing module (let* ((gumbo (resolve-interface '(sxml gumbo))) (html->sxml (module-ref gumbo 'html->sxml))) (html->sxml str))) diff --git a/module/base64.scm b/module/base64.scm index 594edf1f..c0080581 100644 --- a/module/base64.scm +++ b/module/base64.scm @@ -39,7 +39,10 @@ (+ 26 (- byte a))] [(<= zero byte nine) (+ 26 26 (- byte zero))] - [else (error "Invalid encoded value" byte (integer->char byte))])) + [else (scm-error 'decoding-error + "encoded->real" + "Invalid character in Base64 string: ~s" + (list byte) #f)])) (define ref (make-procedure-with-setter diff --git a/module/c/cpp.scm b/module/c/cpp.scm index 8710fdd2..3f50fb87 100644 --- a/module/c/cpp.scm +++ b/module/c/cpp.scm @@ -5,7 +5,6 @@ :use-module (ice-9 match) :use-module (ice-9 regex) :use-module ((rnrs io ports) :select (call-with-port)) - :use-module (ice-9 pretty-print) ; used by one error handler :use-module (ice-9 format) :use-module ((hnh util io) :select (read-lines)) :use-module (hnh util graph) @@ -26,7 +25,10 @@ (aif (regexp-exec define-re header-line) (cons (match:substring it 1) (match:substring it 4)) - (error "Line dosen't match" header-line))) + (scm-error 'c-parse-error + "tokenize-define-line" + "Line dosen't match: ~s" + (list header-line) #f))) (define-public (do-funcall function arguments) @@ -100,7 +102,7 @@ (map (lambda (line) (catch #t (lambda () (parse-cpp-define line)) - (lambda (err caller fmt args . _) + (lambda (err caller fmt args data) (format #t "~a ~?~%" fmt args) #f))) lines)) diff --git a/module/c/parse.scm b/module/c/parse.scm index 3e3d8024..8030da77 100644 --- a/module/c/parse.scm +++ b/module/c/parse.scm @@ -34,7 +34,9 @@ [(LL) '(long-long)] [(L) '(long)] [(U) '(unsigned)]) - (error "Invalid integer suffix"))) + (scm-error 'c-parse-error "parse-integer-suffix" + "Invalid integer suffix ~s" + (list str) #f))) (define (parse-lexeme-tree tree) (match tree @@ -113,11 +115,11 @@ `(funcall ,(parse-lexeme-tree function) ,(parse-lexeme-tree arguments))] - [bare (throw 'parse-error - 'parse-lexeme-tree - "Naked literal in lex-tree. How did that get there?" - '() - bare)])) + [bare (scm-error 'c-parse-error + "parse-lexeme-tree" + "Naked literal in lex-tree: ~s" + (list bare) + #f)])) ;; https://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B @@ -175,7 +177,11 @@ (parse-lexeme-tree op) (mark-other (parse-lexeme-tree right)))] - [other (error "Not an infix tree ~a" other)])) + [other (scm-error 'c-parse-error + "flatten-infix" + "Not an infix tree ~a" + (list other) + #f)])) diff --git a/module/calp/entry-points/convert.scm b/module/calp/entry-points/convert.scm index 3f602b07..1ce33d9c 100644 --- a/module/calp/entry-points/convert.scm +++ b/module/calp/entry-points/convert.scm @@ -68,7 +68,7 @@ (@ (vcomponent formats xcal parse) sxcal->vcomponent) ;; TODO strip *TOP* xml->sxml)] - [else (error "")] + [else (scm-error 'misc-error "convert-main" "Unexpected parser type: ~a" (list from) #f)] )) (define writer @@ -85,7 +85,7 @@ (sxml->xml ((@ (vcomponent formats xcal output) vcomponent->sxcal) component) port))] - [else (error "")])) + [else (scm-error 'misc-error "convert-main" "Unexpected writer type: ~a" (list to) #f)])) (call-with-output-file outfile diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm index 61489a85..37b0285b 100644 --- a/module/calp/entry-points/html.scm +++ b/module/calp/entry-points/html.scm @@ -173,7 +173,7 @@ pre-start: (start-of-week start) post-end: (end-of-week (end-of-month start)))] [else - (error "Unknown html style: ~a" style)]) + (scm-error 'misc-error "html-main" "Unknown html style: ~a" (list style) #f)]) ((@ (calp util time) report-time!) "all done") ) diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm index 2f8c85ec..37d50697 100644 --- a/module/calp/html/components.scm +++ b/module/calp/html/components.scm @@ -57,7 +57,10 @@ allow-other-keys: rest: args) (when (and onclick href) - (error "Only give one of onclick, href and submit.")) + (scm-error 'wrong-type-arg "btn" + "href, onclick, and submit mutually exclusive. href = ~s, onclick = ~s, submit = ~s." + (list href onclick submit) + #f)) (let ((body #f)) `(,(cond [href 'a] diff --git a/module/calp/html/util.scm b/module/calp/html/util.scm index 75137d4e..54c92e92 100644 --- a/module/calp/html/util.scm +++ b/module/calp/html/util.scm @@ -17,6 +17,7 @@ ;; Returns a color with good contrast to the given background color. ;; https://stackoverflow.com/questions/1855884/determine-font-color-based-on-background-color/1855903#1855903 (define-public (calculate-fg-color c) + ;; TODO what errors can actually appear here? (catch #t (lambda () (define (str->num c n) (string->number (substring/shared c n (+ n 2)) 16)) diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index 670ad9b6..5a8e977e 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -74,10 +74,10 @@ ,display))) (unless next-start - (error 'html-generate "Next-start needs to be a procedure")) + (scm-error 'misc-error "html-generate" "Next-start needs to be a procedure" #f #f)) (unless prev-start - (error 'html-generate "Prev-start needs to be a procedure")) + (scm-error 'misc-error "html-generate" "Prev-start needs to be a procedure" #f #f)) (xhtml-doc (@ (lang sv)) diff --git a/module/calp/main.scm b/module/calp/main.scm index 18b8b731..607b9f1b 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -120,8 +120,11 @@ (cond [altconfig (if (file-exists? altconfig) altconfig - (throw 'option-error - "Configuration file ~a missing" altconfig))] + (scm-error 'misc-error + "wrapped-main" + "Configuration file ~a missing" + (list altconfig) + #f))] ;; altconfig could be placed in the list below. But I want to raise an error ;; if an explicitly given config is missing. [(find file-exists? @@ -213,7 +216,10 @@ (when (option-ref opts 'update-zoneinfo #f) (let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "tzget"))) (filename (or (find file-exists? locations) - (error "tzget not installed, please put it in one of ~a" locations))) + (scm-error 'missing-helper "wrapped-main" + "tzget not installed, please put it in one of ~a" + (list locations) + (list "tzget" locations)))) (pipe (open-input-pipe filename))) ;; (define path (read-line pipe)) diff --git a/module/calp/repl.scm b/module/calp/repl.scm index e25c2649..47c35a40 100644 --- a/module/calp/repl.scm +++ b/module/calp/repl.scm @@ -21,8 +21,9 @@ [else 'UNIX]) [(UNIX) (add-hook! shutdown-hook (lambda () (catch 'system-error (lambda () (delete-file address)) - (lambda (err proc fmt . args) - (warning "Failed to unlink ~a" address args) + (lambda (err proc fmt args data) + (warning (format #f "Failed to unlink ~a: ~?" + address fmt args)) err)))) (make-unix-domain-server-socket path: address)] [(IPv4) (apply (case-lambda diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm index e1417d86..4862bbda 100644 --- a/module/calp/util/config.scm +++ b/module/calp/util/config.scm @@ -39,7 +39,11 @@ (for (key value) in (group kwargs 2) (aif (hashq-ref config-properties key) (set! (it name) value) - (error "Missing config protperty slot " key))) + (scm-error 'configuration-error + "define-config" + "No configuration slot named ~s, when defining ~s" + (list key name) + #f))) (set-config! name (get-config name default-value))) (define-syntax define-config @@ -52,7 +56,12 @@ (define-public (set-config! name value) (hashq-set! config-values name (aif (pre name) - (or (it value) (error "Pre crashed for" name)) + (or (it value) + (scm-error 'configuration-error + "set-config!" + "Pre-property failed when setting ~s to ~s" + (list name value) + #f)) value)) (awhen (post name) (it value))) @@ -63,8 +72,10 @@ (if (eq? default %uniq) (let ((v (hashq-ref config-values key %uniq))) (when (eq? v %uniq) - ;; TODO throw descript error - (error "Missing config" key)) + (scm-error 'configuration-error + "get-config" + "No configuration item named ~s" + (list key) #f)) v) (hashq-ref config-values key default))) diff --git a/module/crypto.scm b/module/crypto.scm index 79eaaf89..477014e9 100644 --- a/module/crypto.scm +++ b/module/crypto.scm @@ -22,7 +22,9 @@ (define bv (cond ((bytevector? msg) msg) ((string? msg) (string->utf8 msg)) - (else (throw 'value-error "Invalid type")))) + (else (scm-error 'wrong-type-arg "sha256" + "Wrong type argument. Expected string or bytevector, got ~s" + (list msg) (list msg))))) (SHA256 ((@ (system foreign) bytevector->pointer) bv) (bytevector-length bv) ((@ (system foreign) bytevector->pointer) md)) diff --git a/module/datetime.scm b/module/datetime.scm index 75cffdab..8cffb755 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -735,11 +735,15 @@ Returns -1 on failure" (let* ((head post (cond ((null? (cddr fmt)) (values str '())) ((eqv? #\~ (caddr fmt)) (cond ((null? (cdddr fmt)) - (error "Unexpected ~ at end of fmt")) + (scm-error 'misc-error "string->datetime" + "Unexpected ~ at end of fmt" + #f #f)) ((eqv? #\~ (cadddr fmt)) (span (lambda (c) (not (eqv? #\~ c))) str)) - (else (error "Can't have format specifier directly after month by name")))) + (else (scm-error 'misc-error "string->datetime" + "Can't have format specifier directly after month by name" + #f #f)))) (else (span (lambda (c) (not (eqv? c (caddr fmt)))) str))))) (loop post diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm index b07c2bfa..b0630f3e 100644 --- a/module/datetime/zic.scm +++ b/module/datetime/zic.scm @@ -91,14 +91,14 @@ ;; @end example (define-public (get-zone zoneinfo name) (or (hash-ref (zoneinfo-zones zoneinfo) name) - (error "No zone ~a" name))) + (scm-error 'misc-error "get-zone" "No zone ~a" (list name) #f))) ;; @example ;; (get-rule zoneinfo 'EU) ;; @end example (define-public (get-rule zoneinfo name) (or (hashq-ref (zoneinfo-rules zoneinfo) name) - (error "No rule ~a" name))) + (scm-error 'misc-error "get-rule" "No rule ~a" (list name) #f))) @@ -118,7 +118,9 @@ [(string-prefix? name "October") 10] [(string-prefix? name "November") 11] [(string-prefix? name "December") 12] - [else (error "Unknown month" name)])) + [else (scm-error 'misc-error "month-name->number" + "Unknown month ~s" (list name) + #f)])) (define (string->weekday name) @@ -130,7 +132,9 @@ [(string-prefix? name "Friday") fri] [(string-prefix? name "Saturday") sat] [(string-prefix? name "Sunday") sun] - [else (error "Unknown week day" name)])) + [else (scm-error 'misc-error "string->weekday" + "Unknown week day ~s" + (list name) #f)])) (define (parse-from str) @@ -258,8 +262,10 @@ ;; NOTE an earlier version of the code the parsers for those. ;; They were removed since they were unused, uneeded, and was ;; technical dept. - (error "Invalid key ~a. Note that leap seconds and -expries rules aren't yet implemented." type)] + (scm-error 'misc-error "parse-zic-file" + "Invalid key ~s. Note that leap seconds and expries rules aren't yet implemented." + (list type) + #f)] ))])))))) @@ -356,7 +362,9 @@ expries rules aren't yet implemented." type)] until: (let ((to (rule-to rule))) (case to ((maximum) #f) - ((minimum) (error "Check your input")) + ((minimum) (scm-error 'misc-error "rule->rrule" + "Check your input" + #f #f)) ((only) (datetime date: (date year: (rule-from rule) month: 1 day: 1))) @@ -401,4 +409,9 @@ expries rules aren't yet implemented." type)] (warning "%z not yet implemented") fmt-string] - [else (error "Invalid format char")]))) + [else (scm-error 'misc-error "zone-format" + "Invalid format char ~s in ~s at position ~a" + (list (string-index fmt-string (1+ idx)) + fmt-string + (1+ idx)) + #f)]))) diff --git a/module/glob.scm b/module/glob.scm index a436b810..82489565 100644 --- a/module/glob.scm +++ b/module/glob.scm @@ -6,8 +6,10 @@ (define (glob-err epath eerrno) - (error "Glob errored on ~s with errno = ~a" - (pointer->string epath) eerrno)) + (scm-error 'misc-error "glob-err" + "Glob errored on ~s with errno = ~a" + (list (pointer->string epath) eerrno) + #f)) ;; NOTE there really should be an (c eval) module, to resolve symbols such as ;; @var{<<}. @@ -29,7 +31,10 @@ (procedure->pointer int glob-err (list '* int)) (bytevector->pointer bv)))) (unless (zero? globret) - (error "Globret errror ~a" globret)) + (scm-error 'misc-error "glob" + "Globret errror ~a" + (list globret) + #f)) (let* ((globstr (parse-c-struct (bytevector->pointer bv) (list size_t '* size_t))) (strvec (pointer->bytevector (cadr globstr) (car globstr) 0 (string->symbol (format #f "u~a" (* 8 (sizeof '*)))))) diff --git a/module/hnh/util.scm b/module/hnh/util.scm index 1b5ceeab..e766cd0a 100644 --- a/module/hnh/util.scm +++ b/module/hnh/util.scm @@ -247,18 +247,20 @@ ;; and the other items in some order. ;; Ord b => (list a) [, (b, b -> bool), (a -> b)] -> a, (list a) (define*-public (find-extreme items optional: (< <) (access identity)) - (if (null? items) - (error "Can't find extreme in an empty list") - (fold-values - (lambda (c min other) - (if (< (access c) (access min)) - ;; Current stream head is smaller that previous min - (values c (cons min other)) - ;; Previous min is still smallest - (values min (cons c other)))) - (cdr items) - ;; seeds: - (car items) '()))) + (when (null? items) + (scm-error 'wrong-type-arg "find-extreme" + "Can't find extreme in an empty list" + #f #f)) + (fold-values + (lambda (c min other) + (if (< (access c) (access min)) + ;; Current stream head is smaller that previous min + (values c (cons min other)) + ;; Previous min is still smallest + (values min (cons c other)))) + (cdr items) + ;; seeds: + (car items) '())) (define*-public (find-min list optional: (access identity)) (find-extreme list < access)) diff --git a/module/hnh/util/graph.scm b/module/hnh/util/graph.scm index 912f9612..03c2ae3c 100644 --- a/module/hnh/util/graph.scm +++ b/module/hnh/util/graph.scm @@ -73,8 +73,9 @@ (define-public (find-and-remove-node-without-dependencies graph) (let ((node (find-node-without-dependencies graph))) (unless node - (throw 'graph-error 'find-and-remove-node-without-dependencies - "No node without dependencies in graph" '() graph)) + (scm-error 'graph-error "find-and-remove-node-without-dependencies" + "No node without dependencies in graph" + #f (list graph))) (values node (remove-node graph node)))) ;; Assumes that the edges of the graph are dependencies. @@ -89,5 +90,5 @@ '() (let* ((node graph* (find-and-remove-node-without-dependencies graph))) (cons node (loop graph*)))))) - (lambda (err caller fmt args graph . data) - graph))) + (lambda (err caller fmt args data) + (car graph)))) diff --git a/module/text/numbers.scm b/module/text/numbers.scm index aceb82cc..ba44a495 100644 --- a/module/text/numbers.scm +++ b/module/text/numbers.scm @@ -1,4 +1,5 @@ +;; TODO this is bad, but this file is replaced once translations are merged (eval-when (load) (throw 'do-not-load-me "Import (text numbers ) instead") diff --git a/module/vcomponent/duration.scm b/module/vcomponent/duration.scm index 786675b8..637d7db4 100644 --- a/module/vcomponent/duration.scm +++ b/module/vcomponent/duration.scm @@ -20,7 +20,9 @@ key: (sign '+) week day time) (when (and week (or day time)) - (error "Can't give week together with day or time")) + (scm-error 'misc-error "duration" + "Can't give week together with day or time" + #f #f)) (make-duration sign week day time)) @@ -64,7 +66,10 @@ (define (parse-duration str) (let ((m (match-pattern dur-pattern str))) (unless m - (throw 'parse-error "~a doesn't appar to be a duration" str)) + (scm-error 'parse-error "parse-duration" + "~s doesn't appar to be a duration" + (list str) + #f)) (unless (= (peg:end m) (string-length str)) (warning "Garbage at end of duration")) @@ -83,9 +88,12 @@ [(H) `(hour: ,n)] [(M) `(minute: ,n)] [(S) `(second: ,n)] - [else (error "Invalid key")]))] + [else (scm-error 'misc-error "parse-duration" + "Invalid key ~a" type #f)]))] [a - (error "~a not on form ((number ) type)" a)]) + (scm-error 'misc-error "parse-duration" + "~s not on expected form ((number ) type)" + (list a) #f)]) (context-flatten (lambda (x) (and (pair? (car x)) (eq? 'number (caar x)))) (cdr (member "P" tree))) diff --git a/module/vcomponent/formats/common/types.scm b/module/vcomponent/formats/common/types.scm index efe17f36..97980e1a 100644 --- a/module/vcomponent/formats/common/types.scm +++ b/module/vcomponent/formats/common/types.scm @@ -136,4 +136,5 @@ (define-public (get-parser type) (or (hashq-ref type-parsers type #f) - (error "No parser for type" type))) + (scm-error 'misc-error "get-parser" "No parser for type ~a" + (list type) #f))) diff --git a/module/vcomponent/formats/ical/parse.scm b/module/vcomponent/formats/ical/parse.scm index 30a1837f..08f31ae7 100644 --- a/module/vcomponent/formats/ical/parse.scm +++ b/module/vcomponent/formats/ical/parse.scm @@ -121,7 +121,9 @@ (lambda (params value) (let ((vv (parser params value))) (when (list? vv) - (throw 'parse-error "List in enum field")) + (scm-error 'parse-error "enum-parser" + "List in enum field" + #f #f)) (let ((v (string->symbol vv))) (unless (memv v enum) (warning "~a ∉ { ~{~a~^, ~} }" @@ -193,7 +195,9 @@ DRAFT FINAL CANCELED))] [(memv key '(REQUEST-STATUS)) - (throw 'parse-error "TODO Implement REQUEST-STATUS")] + (scm-error 'parse-error "build-vline" + "TODO Implement REQUEST-STATUS" + #f #f)] [(memv key '(ACTION)) (enum-parser '(AUDIO DISPLAY EMAIL @@ -319,7 +323,7 @@ (set! (prop* (car stack) key) vline)))))) (loop (cdr lst) stack)]))) - (lambda (err fmt . args) + (lambda (err proc fmt fmt-args data) (let ((linedata (get-metadata head*))) (display (format #f "ERROR parse error around ~a @@ -327,7 +331,7 @@ line ~a ~a Defaulting to string~%" (get-string linedata) - fmt args + fmt fmt-args (get-line linedata) (get-file linedata)) (current-error-port)) diff --git a/module/vcomponent/formats/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm index 7dee8d67..b21e72b5 100644 --- a/module/vcomponent/formats/xcal/parse.scm +++ b/module/vcomponent/formats/xcal/parse.scm @@ -81,10 +81,10 @@ bymonthday byyearday byweekno bymonth bysetpos) (string->number value)) - (else (throw - 'key-error + (else (scm-error 'key-error "handle-value" "Invalid type ~a, with value ~a" - type value)))))) + (list type value) + #f)))))) ;; freq until count interval wkst @@ -108,9 +108,11 @@ byyearday byweekno bymonth bysetpos) (list (symbol->keyword key) (map (lambda (v) (parse-value-of-that-type key v)) - (map car values))) - ) - (else (throw 'error)))))))))] + (map car values)))) + (else (scm-error 'misc-error "handle-value" + "Invalid key ~s" + (list key) + #f)))))))))] [(time) (parse-iso-time (car value))] diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index b498e033..33f86e3d 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -217,7 +217,9 @@ [(BYHOUR) (to-dt (set (hour t) value))] [(BYMINUTE) (to-dt (set (minute t) value))] [(BYSECOND) (to-dt (set (second t) value))] - [else (error "Unrecognized by-extender" key)]))) + [else (scm-error 'wrong-type-arg "update" + "Unrecognized by-extender ~s" + key #f)]))) date-object extension-rule)) diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm index c2e3a10f..65d44331 100644 --- a/module/vcomponent/recurrence/parse.scm +++ b/module/vcomponent/recurrence/parse.scm @@ -51,7 +51,9 @@ (define-macro (quick-case key . cases) (let ((else-clause (or (assoc-ref cases 'else) - '(error "Guard failed")))) + '(scm-error 'misc-error "quick-case" + "Guard failed" + #f #f)))) `(case ,key ,@(map (match-lambda ((key guard '=> body ...) @@ -74,10 +76,10 @@ (define* (string->number/throw string optional: (radix 10)) (or (string->number string radix) - (scm-error 'wrong-type-argument + (scm-error 'wrong-type-arg "string->number/throw" "Can't parse ~s as number in base ~a" - '(string radix) #f))) + (list string radix) (list string radix)))) ;; RFC 5545, Section 3.3.10. Recurrence Rule, states that the UNTIL value MUST have ;; the same type as the DTSTART of the event (date or datetime). I have seen events diff --git a/module/vcomponent/util/parse-cal-path.scm b/module/vcomponent/util/parse-cal-path.scm index 11a32064..df3fbf75 100644 --- a/module/vcomponent/util/parse-cal-path.scm +++ b/module/vcomponent/util/parse-cal-path.scm @@ -25,7 +25,10 @@ (prop comp '-X-HNH-DIRECTORY) path) comp)] [(block-special char-special fifo socket unknown symlink) - => (lambda (t) (error "Can't parse file of type " t))])) + => (lambda (t) (scm-error 'misc-error "parse-cal-path" + "Can't parse file of type ~s" + (list t) + #f))])) (unless (prop cal "NAME") (set! (prop cal "NAME") diff --git a/tests/test/base64.scm b/tests/test/base64.scm index 64abd2c3..788e7093 100644 --- a/tests/test/base64.scm +++ b/tests/test/base64.scm @@ -31,7 +31,7 @@ ;; TODO normalize base64 errors (test-error "Invalid base64" - 'misc-error + 'decoding-error (base64decode "@@@@")) (test-error "To short base64" diff --git a/tests/test/recurrence-simple.scm b/tests/test/recurrence-simple.scm index 6ded68ba..3ddcb5ad 100644 --- a/tests/test/recurrence-simple.scm +++ b/tests/test/recurrence-simple.scm @@ -42,7 +42,7 @@ 'warning (parse-recurrence-rule "FREQ=HOURLY;COUNT=-1")) (test-error "Invalid COUNT" - 'wrong-type-argument + 'wrong-type-arg (parse-recurrence-rule "FREQ=HOURLY;COUNT=err"))) ;;; Test that basic recurrence works diff --git a/tests/test/util.scm b/tests/test/util.scm index a7f0cd00..325ca992 100644 --- a/tests/test/util.scm +++ b/tests/test/util.scm @@ -61,7 +61,7 @@ "Other members left 2" (member "Test" rest)))) -(test-error 'misc-error (find-extreme '())) +(test-error 'wrong-type-arg (find-extreme '())) (call-with-values (lambda () -- cgit v1.2.3