diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-03 01:32:56 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-03 01:32:56 +0200 |
| commit | 010a8fa2c4205850ea3517a0523d727adbc33354 (patch) | |
| tree | 3ff7f0fe6783d7392b505ccbe026631c207a60f2 | |
| parent | Move <events> methods to own module for easier loading. (diff) | |
| download | calp-010a8fa2c4205850ea3517a0523d727adbc33354.tar.gz calp-010a8fa2c4205850ea3517a0523d727adbc33354.tar.xz | |
Fixed stack overflow on event deletion!
Equal? on vcomponents was a bad idea. The bug most likely came from two
objects where they pointed to themseves, or recursively to one another,
and guile couldn't figure out that they where eq? each other. Change to
use eq? comparison directly, and now everything just seems to work.
| -rw-r--r-- | module/vcomponent/instance/methods.scm | 24 |
1 files changed, 4 insertions, 20 deletions
diff --git a/module/vcomponent/instance/methods.scm b/module/vcomponent/instance/methods.scm index 49cc3ed2..4baf9409 100644 --- a/module/vcomponent/instance/methods.scm +++ b/module/vcomponent/instance/methods.scm @@ -23,21 +23,6 @@ (define-public (load-calendars calendar-files) (map parse-cal-path calendar-files)) -;;; TODO both add- and remove-event sometimes crash with -;;;;; Warning: Unwind-only `stack-overflow' exception; skipping pre-unwind handler. -;;; I belive this is due to how getf and setf work. - - - -;; == vcomponent == -;; - calendar -;; - events -;; - repeating-events -;; - fixed-events -;; - event-set -;; - uid-map - - (define-class <events> () (calendar-files init-keyword: calendar-files:) @@ -127,14 +112,13 @@ (prop event 'UID)) - - (define-method (remove-event (this <events>) event) - (slot-set! this 'events (delete event (slot-ref this 'events))) + ;; cons #f so delq1! can delete the first element + + (delq1! event (cons #f (slot-ref this 'events))) (let ((slot-name (if (repeating? event) 'repeating-events 'fixed-events))) - (slot-set! this slot-name - (delete event (slot-ref this slot-name)))) + (delq1! event (cons #f (slot-ref this slot-name)))) (slot-set! this 'event-set (stream-remove |