Tcl Source Code

View Ticket
Login
2018-02-15
08:53
Fix for issue [6cf568a21b]: Tcl_Eval() causes new segfault (TclOO object creation by qualified name)... check-in: a5d05b97be user: pooryorick tags: pyk-backport-to-8-6
2017-11-29
11:35 Ticket [6cf568a21b] Tcl_Eval() causes new segfault status still Closed with 5 other changes artifact: faca578cef user: pooryorick
11:27 Ticket [16fe1b5807] namespace ensemble command named ":" is mistakenly given the empty string as its name status still Pending with 3 other changes artifact: 77e7a8d1a0 user: pooryorick
01:57 Closed ticket [6cf568a21b]: Tcl_Eval() causes new segfault plus 4 other changes artifact: 8ddc2b2280 user: hypnotoad
01:56 Ticket [6cf568a21b]: 4 changes artifact: 50516da155 user: hypnotoad
2017-11-28
23:33
Fix for issue [6cf568a21b]: Tcl_Eval() causes new segfault (TclOO object creation by qualified name)... check-in: 93c437ef37 user: pooryorick tags: core-8-branch
18:03 Ticket [6cf568a21b] Tcl_Eval() causes new segfault status still Open with 3 other changes artifact: 38f13126da user: hypnotoad
17:32 Ticket [6cf568a21b]: 3 changes artifact: e247acb8bf user: hypnotoad
13:15 Ticket [6cf568a21b]: 3 changes artifact: 5edd8e2bf6 user: dgp
09:12 Pending ticket [16fe1b5807]: namespace ensemble command named ":" is mistakenly given the empty string as its name plus 5 other changes artifact: f602458f3d user: jan.nijtmans
2017-11-27
19:15 Ticket [6cf568a21b] Tcl_Eval() causes new segfault status still Open with 3 other changes artifact: 98e2d3efbf user: chw
18:26 Ticket [6cf568a21b]: 3 changes artifact: 7a67c0cc64 user: dgp
16:51 New ticket [6cf568a21b]. artifact: 83fba72e38 user: hypnotoad

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)