bug#56665: Segfault in SRFI-37 when raising ERROR in ARGS-FOLD.

[Ricardo Wurmus <rekado@elephly.net>]

Hi,

I got Guile to segfault in srfi-37.

Here’s a Guile script:

--8<---------------cut here---------------start------------->8---
#!/run/current-system/profile/bin/guile \
--no-auto-compile
!#

(use-modules (srfi srfi-1) (srfi srfi-37) (ice-9 match))

(define %options
  (list (option '("greet") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'greet arg
                              (alist-delete 'greet result))))))

(define %default-options
  `((greet . "hello")))

(define (parse-options args)
  (args-fold
   args %options
   (lambda (opt name arg result)
     (pk 'unrecognized)
     (error "unrecognized option" name))
   (lambda (arg result)
     (pk 'extraneous)
     (error "extraneous argument" arg))
   %default-options))

(match (pk 'args (program-arguments))
  ((_ . rest)
   (let ((config (parse-options rest)))
     (pk 'no-segfault)))
  (_
   (pk 'usage)))
--8<---------------cut here---------------end--------------->8---

And here is how to make it segfault:

--8<---------------cut here---------------start------------->8---
./segfault.scm --greet=no --oh=crud

;;; (args ("./segfault.scm" "--greet=no" "--oh=crud"))

;;; (unrecognized)
Backtrace:
           4 (primitive-load "/path/to/./segfault.scm")
In ice-9/eval.scm:
   293:34  3 (_ #(#(#(#(#<directory (guile-user) 7fee48518c80> ("./segfault.scm" "--greet=no" "--oh=crud")) #<procedure failure ()>) "./segfault.scm" …) …))
In srfi/srfi-37.scm:
   113:18  2 (next-arg)
In unknown file:
           1 Segmentation fault
--8<---------------cut here---------------end--------------->8---

Looks like using ERROR in ARGS-FOLD leads to a segfault.

-- 
Ricardo