[bug #33362] Segfault with let and a case-lambda that calls another case

[Göran Weinholt]

URL:
  <http://savannah.gnu.org/bugs/?33362>

                 Summary: Segfault with let and a case-lambda that calls
another case
                 Project: Guile
            Submitted by: weinholt
            Submitted on: Sat May 21 17:34:40 2011
                Category: None
                Severity: 3 - Normal
              Item Group: None
                  Status: None
                 Privacy: Public
             Assigned to: None
             Open/Closed: Open
         Discussion Lock: Any

    _______________________________________________________

Details:

This expression will make Guile 2.0.1 crash:

(let ()
  (define t
    (case-lambda
      ((x)
       (t x 'y))
      ((x y)
       (display (list x y))
       (newline)
       (list x y))))
  (display (t 'x))
  (newline))

Before crashing it prints "(y " (from inside the case-lambda). This is
peculiar because the list actually starts with x. The crash goes away if you
replace let() with begin. Here's some gdb output:

GNU gdb (GDB) 7.0.1-debian
Copyright (C) 2009 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.  Type "show copying"
and "show warranty" for details.
This GDB was configured as "x86_64-linux-gnu".
For bug reporting instructions, please see:
<http://www.gnu.org/software/gdb/bugs/>...
Reading symbols from /tmp/bin/guile...done.
(gdb) r
Starting program: /tmp/bin/guile 
[Thread debugging using libthread_db enabled]
[New Thread 0x7ffff5529700 (LWP 18036)]
[New Thread 0x7ffff4d28700 (LWP 18037)]
GNU Guile 2.0.1.79-a02a
Copyright (C) 1995-2011 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (let ()
...   (define t
...     (case-lambda
...       ((x)
...        (t x 'y))
...       ((x y)
...        (display (list x y))
...        (newline)
...        (list x y))))
...   (display (t 'x))
...   (newline))
(y 
Program received signal SIGSEGV, Segmentation fault.
0x00007ffff7ad659e in iprin1 (exp=0x0, port=0x6d5850, pstate=0x9a5390) at
print.c:520
520           switch (SCM_TYP7 (exp))
(gdb) bt
#0  0x00007ffff7ad659e in iprin1 (exp=0x0, port=0x6d5850, pstate=0x9a5390) at
print.c:520
#1  0x00007ffff7ad640a in scm_iprin1 (exp=0x0, port=0x6d5850, pstate=0x9a5390)
at print.c:474
#2  0x00007ffff7ad8247 in scm_iprlist (hdr=0x7ffff7b6b664 "(", exp=0xeccd80,
tlr=41, port=0x6d5850, 
    pstate=0x9a5390) at print.c:1231
#3  0x00007ffff7ad6881 in iprin1 (exp=0xeccd70, port=0x6d5850,
pstate=0x9a5390) at print.c:545
#4  0x00007ffff7ad640a in scm_iprin1 (exp=0xeccd70, port=0x6d5850,
pstate=0x9a5390) at print.c:474
#5  0x00007ffff7ad7392 in scm_prin1 (exp=0xeccd70, port=0x6d5850, writingp=0)
at print.c:769
#6  0x00007ffff7ad867b in scm_display (obj=0xeccd70, port=0x6d5850) at
print.c:1327
#7  0x00007ffff7b2fab7 in vm_debug_engine (vm=0x6d58e0, program=0x6ca120,
argv=0x7fffffffce20, nargs=2)
    at vm-i-system.c:895
#8  0x00007ffff7b3f7d7 in scm_c_vm_run (vm=0x6d58e0, program=0x75f180,
argv=0x7fffffffce18, nargs=1)
    at vm.c:565
#9  0x00007ffff7a79145 in scm_primitive_eval (exp=0x8ae180) at eval.c:639
#10 0x00007ffff7a791ff in scm_eval (exp=0x8ae180, module_or_state=0x7df090) at
eval.c:673
#11 0x00007ffff7ae6331 in scm_shell (argc=1, argv=0x7fffffffe228) at
script.c:402
#12 0x0000000000400ad8 in inner_main (closure=0x0, argc=1,
argv=0x7fffffffe228) at guile.c:60
#13 0x00007ffff7a9f7f8 in invoke_main_func (body_data=0x7fffffffe0e0) at
init.c:336
#14 0x00007ffff7a6ee2f in c_body (d=0x7fffffffdfc0) at continuations.c:512
#15 0x00007ffff7b13ac9 in apply_catch_closure (clo=0x886b40, args=0x304) at
throw.c:146
#16 0x00007ffff7b1ddda in vm_regular_engine (vm=0x6d58e0, program=0x886a00,
argv=0x7fffffffde50, nargs=1)
    at vm-i-system.c:960
#17 0x00007ffff7b3f7d7 in scm_c_vm_run (vm=0x6d58e0, program=0x7a7e40,
argv=0x7fffffffde30, nargs=4)
    at vm.c:565
#18 0x00007ffff7a78c64 in scm_call_4 (proc=0x7a7e40, arg1=0x404,
arg2=0x886b40, arg3=0x886b20, arg4=0x886b00)
    at eval.c:506
#19 0x00007ffff7b13781 in scm_catch_with_pre_unwind_handler (key=0x404,
thunk=0x886b40, handler=0x886b20, 
    pre_unwind_handler=0x886b00) at throw.c:86
#20 0x00007ffff7b13ba9 in scm_c_catch (tag=0x404, body=0x7ffff7a6ee07
<c_body>, body_data=0x7fffffffdfc0, 
    handler=0x7ffff7a6ee3e <c_handler>, handler_data=0x7fffffffdfc0, 
    pre_unwind_handler=0x7ffff7a6ee92 <pre_unwind_handler>,
pre_unwind_handler_data=0x6d5810) at throw.c:213
#21 0x00007ffff7a6ec92 in scm_i_with_continuation_barrier (body=0x7ffff7a6ee07
<c_body>, 
    body_data=0x7fffffffdfc0, handler=0x7ffff7a6ee3e <c_handler>,
handler_data=0x7fffffffdfc0, 
    pre_unwind_handler=0x7ffff7a6ee92 <pre_unwind_handler>,
pre_unwind_handler_data=0x6d5810)
    at continuations.c:450
#22 0x00007ffff7a6ef29 in scm_c_with_continuation_barrier (func=0x7ffff7a9f7a0
<invoke_main_func>, 
    data=0x7fffffffe0e0) at continuations.c:546
#23 0x00007ffff7b107e7 in with_guile_and_parent (base=0x7fffffffe030,
data=0x7fffffffe070) at threads.c:864
#24 0x00007ffff77b9665 in GC_call_with_stack_base (fn=0xfffffffffff6af06,
arg=0x6d5850) at misc.c:1165
#25 0x00007ffff7b108c7 in scm_i_with_guile_and_parent (func=0x7ffff7a9f7a0
<invoke_main_func>, 
    data=0x7fffffffe0e0, parent=0x0) at threads.c:907
#26 0x00007ffff7b108f3 in scm_with_guile (func=0x7ffff7a9f7a0
<invoke_main_func>, data=0x7fffffffe0e0)
    at threads.c:913
---Type <return> to continue, or q <return> to quit---
#27 0x00007ffff7a9f781 in scm_boot_guile (argc=1, argv=0x7fffffffe228,
main_func=0x400ab4 <inner_main>, 
    closure=0x0) at init.c:319
#28 0x0000000000400b05 in main (argc=1, argv=0x7fffffffe228) at guile.c:70
(gdb) 





    _______________________________________________________

Reply to this item at:

  <http://savannah.gnu.org/bugs/?33362>

_______________________________________________
  Message sent via/by Savannah
  http://savannah.gnu.org/