Tcl Source Code: View Ticket

Ticket UUID:	6cf568a21bd8fc9b1f63543efe92cbedaa5a7160
Title:	Tcl_Eval() causes new segfault
Type:	Bug	Version:	core-8-branch
Submitter:	hypnotoad	Created on:	2017-11-27 16:51:22
Subsystem:	45. Parsing and Eval	Assigned To:	pooryorick
Priority:	5 Medium	Severity:	Critical
Status:	Closed	Last Modified:	2017-11-29 11:35:31
Resolution:	Fixed	Closed By:	pooryorick
		Closed on:	2017-11-29 11:35:31
Description:	Ever since checkin e76a04e48fb1b8500f44c11120b8c8f42ed08b35, toadkits segfault on startup. An lldb trace yields the following: <BEGIN SNIPPET> (lldb) bt * thread #1, queue = 'com.apple.main-thread', stop reason = EXC_BAD_ACCESS (code=1, address=0xe8) * frame #0: 0x000000010001546e toadkit`TclCreateObjCommandInNs + 56 frame #1: 0x00000001000fdb7d toadkit`AllocObject + 410 frame #2: 0x00000001000fdf29 toadkit`TclNRNewObjectInstance + 177 frame #3: 0x000000010010076e toadkit`TclOO_Class_Create + 456 frame #4: 0x00000001000fefad toadkit`TclOOObjectCmdCore + 676 frame #5: 0x0000000100016ac9 toadkit`TclNRRunCallbacks + 80 frame #6: 0x0000000100017d36 toadkit`TclEvalEx + 2012 frame #7: 0x0000000100018619 toadkit`Tcl_Eval + 39 frame #8: 0x00000001001f23a9 toadkit`Odielibc_Init + 108 frame #9: 0x000000010000580e toadkit`Tclkit_AppInit + 101 frame #10: 0x00000001000bec0d toadkit`Tcl_MainEx + 403 frame #11: 0x00000001000020d0 toadkit`main + 68 frame #12: 0x00007fff61e30145 libdyld.dylib`start + 1 frame #13: 0x00007fff61e30145 libdyld.dylib`start + 1 <END SNIPPET> The offending statement in C is: <BEGIN SNIPPET> if(interp) { if(Tcl_Eval(interp, "\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/polygon.tcl\n" \ "namespace eval ::polygon {}\n" \ "###\n" \ "# Decompose a concave polygon into a set of convex polygons\n" \ "###\n" \ "proc ::polygon::convex_decompose POLY {\n" \ " if {[is_convex $POLY]} {\n" \ " return [list $POLY]\n" \ " }\n" \ " set SEGMENTS [::odielib::segset new]\n" \ " $SEGMENTS polygon_add 1 $POLY\n" \ " $SEGMENTS make_convex\n" \ " set result [$SEGMENTS polygons]\n" \ " $SEGMENTS destroy\n" \ " return $result\n" \ "}\n" \ "\n" \ "proc ::polygon::set_union args {\n" \ " set SEGMENTS [::odielib::segset new]\n" \ " set polycount 0\n" \ " foreach poly $args {\n" \ " incr polycount\n" \ " set POLYGONS($polycount) $poly\n" \ " $SEGMENTS polygon_add $polycount $POLYGONS($polycount)\n" \ " }\n" \ " set cleanup [$SEGMENTS cleanup]\n" \ " set cleanup [$SEGMENTS cleanup]\n" \ " set connections {}\n" \ " set newseg {}\n" \ " for {set i 1} {$i <= $polycount} {incr i} {\n" \ " set COORDS [coords $POLYGONS($i)]\n" \ " for {set j 1} {$j <= $polycount} {incr j} {\n" \ " if {$i==$j} continue\n" \ " foreach vertex $COORDS {\n" \ " if {$vertex in $connections} continue\n" \ " set within [within $vertex $POLYGONS($j)]\n" \ " if {$within>0} {\n" \ " set connection [$SEGMENTS edge_connection $vertex $j]\n" \ " if {![::vector::is_null $connection]} {\n" \ " lappend newseg $vertex $connection\n" \ " lappend connections $vertex\n" \ " }\n" \ " }\n" \ " }\n" \ " }\n" \ " }\n" \ " foreach {v c} $newseg {\n" \ " $SEGMENTS segment_add_virtual $v $c\n" \ " }\n" \ " $SEGMENTS make_convex\n" \ " set result [$SEGMENTS polygons]\n" \ " $SEGMENTS destroy\n" \ " return $result\n" \ "}\n" \ "\n" \ "proc ::polygon::set_intersection {UNION args} {\n" \ " set result {}\n" \ " set id 0\n" \ " set result {}\n" \ " foreach poly $UNION {\n" \ " set match 1\n" \ " set center [center $poly]\n" \ " foreach ipoly $args {\n" \ " if {[within {}[::vectorxy::flatten $center] $ipoly]<0} {\n" \ " set match 0\n" \ " break\n" \ " }\n" \ " }\n" \ " if {$match} {\n" \ " lappend result $poly\n" \ " }\n" \ " }\n" \ " return $result\n" \ "}\n" \ "\n" \ "proc ::polygon::set_difference {UNION args} {\n" \ " set result {}\n" \ " set id 0\n" \ " set result {}\n" \ " foreach poly $UNION {\n" \ " set match 1\n" \ " set center [center $poly]\n" \ " foreach ipoly $args {\n" \ " if {[within {}[vectorxy::flatten $center] $ipoly]>=0} {\n" \ " set match 0\n" \ " break\n" \ " }\n" \ " }\n" \ " if {$match} {\n" \ " lappend result $poly\n" \ " }\n" \ " }\n" \ " return $result\n" \ "}\n" \ "\n" \ "proc ::polygon::within_concave {A POLY} {\n" \ " if {[is_convex $POLY]} {\n" \ " return [within {}[vectorxy::flatten $A] $POLY]\n" \ " }\n" \ " set polylist [convex_decompose $POLY]\n" \ " return [within {}[vectorxy::flatten $A] {}$polylist]\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/polygon.tcl\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/polygonxyz.tcl\n" \ "namespace eval ::polygonxyz {}\n" \ "###\n" \ "# Decompose a concave polygon into a set of convex polygons\n" \ "###\n" \ "proc ::polygonxyz::convex_decompose POLY {\n" \ " if {[is_convex $POLY]} {\n" \ " return [list $POLY]\n" \ " }\n" \ " set SEGMENTS [::odielib::segset new]\n" \ " $SEGMENTS uv_transform polygon $POLY\n" \ " $SEGMENTS polygon_add 1 $POLY\n" \ " $SEGMENTS make_convex\n" \ " set result [$SEGMENTS polygons]\n" \ " $SEGMENTS destroy\n" \ " return $result \n" \ "}\n" \ "\n" \ "proc ::polygonxyz::set_union args {\n" \ " set SEGMENTS [::odielib::segset new]\n" \ " $SEGMENTS uv_transform polygon [lindex $args 0]\n" \ " set polycount 0\n" \ " foreach poly $args {\n" \ " incr polycount\n" \ " set POLYGONS($polycount) $poly\n" \ " $SEGMENTS polygon_add $polycount $POLYGONS($polycount)\n" \ " }\n" \ " set cleanup [$SEGMENTS cleanup]\n" \ " set cleanup [$SEGMENTS cleanup]\n" \ " set connections {}\n" \ " set newseg {}\n" \ " for {set i 1} {$i <= $polycount} {incr i} {\n" \ " set COORDS [coords $POLYGONS($i)]\n" \ " for {set j 1} {$j <= $polycount} {incr j} {\n" \ " if {$i==$j} continue\n" \ " foreach vertex $COORDS {\n" \ " if {$vertex in $connections} continue\n" \ " set within [within $vertex $POLYGONS($j)]\n" \ " if {$within>0} {\n" \ " set connection [$SEGMENTS edge_connection $vertex $j]\n" \ " if {![::vector::is_null $connection]} {\n" \ " lappend newseg $vertex $connection\n" \ " lappend connections $vertex\n" \ " }\n" \ " }\n" \ " }\n" \ " }\n" \ " }\n" \ " foreach {v c} $newseg {\n" \ " $SEGMENTS segment_add_virtual $v $c\n" \ " }\n" \ " $SEGMENTS make_convex\n" \ " set result [$SEGMENTS polygons]\n" \ " $SEGMENTS destroy\n" \ " return $result\n" \ "}\n" \ "\n" \ "proc ::polygonxyz::set_intersection {UNION args} {\n" \ " set result {}\n" \ " set id 0\n" \ " set result {}\n" \ " foreach poly $UNION {\n" \ " set match 1\n" \ " set center [center $poly]\n" \ " foreach ipoly $args {\n" \ " if {[within $center $ipoly]<0} {\n" \ " set match 0\n" \ " break\n" \ " }\n" \ " }\n" \ " if {$match} {\n" \ " lappend result $poly\n" \ " } \n" \ " }\n" \ " return $result\n" \ "}\n" \ "\n" \ "proc ::polygonxyz::set_difference {UNION args} {\n" \ " set result {}\n" \ " set id 0\n" \ " set result {}\n" \ " foreach poly $UNION {\n" \ " set match 1\n" \ " set center [center $poly]\n" \ " foreach ipoly $args {\n" \ " if {[within $center $ipoly]>=0} {\n" \ " set match 0\n" \ " break\n" \ " }\n" \ " }\n" \ " if {$match} {\n" \ " lappend result $poly\n" \ " } \n" \ " }\n" \ " return $result\n" \ "}\n" \ "\n" \ "proc ::polygonxyz::within_concave {A POLY} {\n" \ " if {[is_convex $POLY]} {\n" \ " return [within $A $POLY]\n" \ " }\n" \ " set polylist [convex_decompose $POLY]\n" \ " return [within_set $A {}$polylist]\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/polygonxyz.tcl\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/segset.tcl\n" \ "if {[info command ::odielib::segset] eq {}} {\n" \ "::oo::class create ::odielib::segset {\n" \ " constructor {} {\n" \ " my SegmentSet_Init\n" \ " }\n" \ "\n" \ " method fix_coincident {} {\n" \ " set fixes 0\n" \ " for {set count 0} {$count < 1000} {incr count} {\n" \ " my modified 0\n" \ " foreach problem [my check_coincident] {\n" \ " my vertex_add [dict get $problem intercept1:] [dict get $problem intercept2:]\n" \ " }\n" \ " if {![my modified]} break\n" \ " incr fixes\n" \ " }\n" \ " return $fixes\n" \ " }\n" \ "\n" \ " # Break up oblique angles\n" \ " method make_convex {} {\n" \ " set newseg 0\n" \ " my fix_coincident\n" \ " for {set count 0} {$count < 128} {incr count} {\n" \ " my modified 0\n" \ " foreach {vertex connection} [my check_oblique] {\n" \ " set c [my segment_add_virtual $vertex $connection]\n" \ " incr newseg $c\n" \ " }\n" \ " if {![my modified]} break\n" \ " }\n" \ " return $newseg\n" \ " }\n" \ "}\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/segset.tcl\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/plotter.tcl\n" \ "if {[info command ::odielib::plotter] eq {}} {\n" \ "::oo::class create ::odielib::plotter {\n" \ "}\n" \ "}\n" \ "proc ::plotter name {\n" \ " ::odielib::plotter create $name\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/plotter.tcl\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/slicer.tcl\n" \ "if {[info command ::odielib::slicer] eq {}} {\n" \ "::oo::class create ::odielib::slicer {\n" \ " superclass ::odielib::plotter\n" \ " \n" \ " constructor {} {\n" \ " my Slicer_Init\n" \ " }\n" \ "}\n" \ "}\n" \ "\n" \ "proc ::slicer name {\n" \ " ::odielib::slicer create $name\n" \ " return $name\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/slicer.tcl\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/wallset.tcl\n" \ "if {[info command ::odielib::wallset] eq {}} {\n" \ "::oo::class create ::odielib::wallset {\n" \ "}\n" \ "}\n" \ "\n" \ "proc ::wallset name {\n" \ " return [::odielib::wallset create $name]\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/wallset.tcl\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/faceset.tcl\n" \ "if {[info command ::odielib::polygonhull] eq {}} {\n" \ "::oo::class create ::odielib::polygonhull {\n" \ " constructor {} {\n" \ " my PolygonHull_Init\n" \ " }\n" \ "\n" \ " method SimplifyStep {} {\n" \ " puts [list SimplifyStep]\n" \ " set vol_list [my volume_list]\n" \ " foreach vid $vol_list {\n" \ " if {$vid<=0} continue\n" \ " set volume_center($vid) [my volume_center $vid]\n" \ " }\n" \ " set changes 0\n" \ " set face_list [lsort -integer [my face_list]]\n" \ " set face_mod {}\n" \ " foreach id $face_list {\n" \ " set facepolygon($id) [my face_polygon $id]\n" \ " set facesides($id) [my face_volume $id]\n" \ " }\n" \ " ###\n" \ " # WHY IS THIS AN INFINITE LOOP?!?!?\n" \ " ###\n" \ " foreach i $face_list {\n" \ " foreach j $face_list {\n" \ " #if {$j>=$i} continue\n" \ " if {![::polygon::coplaner $facepolygon($i) $facepolygon($j)]} continue\n" \ "\n" \ " set union [::polygon::union $facepolygon($i) $facepolygon($j)]\n" \ " set intersect [::polygon::intersection $union $facepolygon($i) $facepolygon($j)]\n" \ " if {![llength $intersect]} continue\n" \ " incr changes\n" \ " lappend face_mod $i $j\n" \ " my face_delete $i\n" \ " my face_delete $j\n" \ " set vola [lindex $facesides($i) 1]\n" \ " set volb [lindex $facesides($j) 1]\n" \ " foreach poly $intersect {\n" \ " set id [my face_create $i {}[::polygon::coords $poly]]\n" \ " if {$vola>0} {\n" \ " set sidea [my face_side $id $volume_center($vola)]\n" \ " my face_volume $id $sidea $vola\n" \ " }\n" \ " if {$volb>0} {\n" \ " set sideb [my face_side $id $volume_center($volb)]\n" \ " my face_volume $id $sideb $volb\n" \ " }\n" \ " }\n" \ " foreach poly [::polygon::clip $union $facepolygon($i) $facepolygon($j)] {\n" \ " set id [my face_create -1 {}[::polygon::coords $poly]]\n" \ " if {$vola>0} {\n" \ " set side [my face_side $id $volume_center($vola)]\n" \ " my face_volume $id $side $vola\n" \ " }\n" \ " }\n" \ " foreach poly [::polygon::clip $union $facepolygon($j) $facepolygon($i)] {\n" \ " set id [my face_create -1 {*}[::polygon::coords $poly]]\n" \ " if {$volb>0} {\n" \ " set side [my face_side $id $volume_center($volb)]\n" \ " my face_volume $id $side $volb\n" \ " }\n" \ " }\n" \ " return 1\n" \ " }\n" \ " }\n" \ " return $changes\n" \ " }\n" \ "\n" \ " method simplify {} {\n" \ " puts [list [self] simplify]\n" \ " set changes 1\n" \ " set count 0\n" \ " while {$changes>0} {\n" \ " if {[incr count]>1000} {\n" \ " error \"Infinite loop\"\n" \ " }\n" \ " set changes [my SimplifyStep]\n" \ " puts [list [self] simplify $count $changes]\n" \ " }\n" \ " }\n" \ "}\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/geometry/faceset.tcl\n" \ "# BEGIN /Users/seandeelywoods/dev/dirt/odielib/cmodules/typespec/simulator.tcl\n" \ "if {[info command ::odielib::simulator] eq {}} {\n" \ "::oo::class create ::odielib::simulator {\n" \ " constructor {} {\n" \ " my C_Init\n" \ " }\n" \ "}\n" \ "}\n" \ "if {[info command ::odielib::entity] eq {}} {\n" \ "::oo::class create ::odielib::entity {\n" \ " constructor {simulatorObj} {\n" \ " my C_Init $simulatorObj\n" \ " }\n" \ "}\n" \ "}\n" \ "if {[info command ::odielib::simtype] eq {}} {\n" \ "::oo::class create ::odielib::simtype {\n" \ " constructor {simulatorObj} {\n" \ " my C_Init $simulatorObj\n" \ " }\n" \ "}\n" \ "}\n" \ "# END /Users/seandeelywoods/dev/dirt/odielib/cmodules/typespec/simulator.tcl\n" \ "\n" )) return TCL_ERROR; } </END SNIPPET>
User Comments:	pooryorick added on 2017-11-29 11:35:31: A more simple example to reproduce the issue: `oo::object create ::one::two::three.` Apparently there was previously no test to detect failure to create an object command having one or more namespace components in the given name. Thanks to dgp for zeroing right in on the possible issue after glancing at the stack trace. hypnotoad added on 2017-11-29 01:56:07: Fixed in [93c437ef370480b3c80fb63726a3e460467df37]. Thanks Nathan! --Sean hypnotoad added on 2017-11-28 18:03:54: I have replicated the problem on Debian linux. 2017-11-25 16:36:22 046a5af026d82a5c - No crash 2017-11-25 16:53:59 e76a04e48fb1b850 - Crash 2017-11-25 18:24:10 17b5266ffc231b0e - Crash My test procedure: cd /opt/build/odie/build rm -rf * cd /opt/build/odie/tcl fossil update TAG cd /opt/build/odie/build tclsh ../odie/make.tcl toadkit # Get coffee ./toadkit hypnotoad added on 2017-11-28 17:32:25: I performed a fossil bisect systematically blowing away taodkit, recompiling, and trying to start the ./toadkit in macos Here are the results: 1 BAD 2017-11-28 15:43:41 a2bfd20d2c764c42 10 BAD 2017-11-27 14:11:16 80508cab57c02191 11 BAD 2017-11-25 18:24:10 17b5266ffc231b0e 12 BAD 2017-11-25 16:53:59 e76a04e48fb1b850 CURRENT 9 GOOD 2017-11-25 16:36:22 046a5af026d82a5c 2 GOOD 2017-11-25 10:54:15 4aeb610c78744432 8 GOOD 2017-11-16 08:45:54 e0e3d7c4ab4d0fa5 7 GOOD 2017-11-07 13:29:28 84de05583b063164 6 GOOD 2017-09-22 08:48:23 4fcc04a34810ac3f 5 GOOD 2017-06-22 21:50:08 0ae0df068580dd16 4 GOOD 2017-02-26 15:33:04 6b926caddb01a992 3 GOOD 2016-03-27 16:40:28 e8a61012f611d76a dgp added on 2017-11-28 13:15:40: That would be a drastic remedy indeed. Emergency use only. chw added on 2017-11-27 19:15:25: May I suggest a little definery to remedy: #undef Tcl_Eval #define Tcl_Eval(a,b) Tcl_EvalEx(a,b,-1,0)