[ruby-dev:32402] Re: Proc 内の self の値が化ける？

永井＠知能．九工大です．

From: SASADA Koichi <[e-mail]>
Subject: [ruby-dev:32399] Re: Proc 内の self の値が化ける？
Date: Thu, 29 Nov 2007 19:42:13 +0900
Message-ID: <[e-mail]>
> Hidetoshi NAGAI wrote:
> > 発生条件がよく分からないのですが，Proc オブジェクト内部の self の値が
> > いつの間にか化けてしまう現象が出てしまい，困っています．
> 
> 　うーん．不思議．「何らかの処理」がわからないとデバッグのしようが無
> い感じですねぇ．GC のマーク漏れかもしれません．

それはそうですよねぇ．．．
とりあえず，現象を確認できるかもしれないスクリプトを末尾に添付します．
現在の trunk の Ruby/Tk は色々な意味でまともには動きませんが，
このスクリプト程度はなんとか動くはずです．
マウスカーソルをウィジェット上に持っていくとコールバックが呼ばれ，
正常な結果や化けた結果を出力したり，SEGV を生じたりすると思います．

----<ここより余談>--------------------------------------------------
Ruby/Tk を 1.9 にきちんと対応させるには大幅な変更が必要です．
実装の方針はほぼ決まったのですが，12 月のリリースに間に合わせるのは
かなり難しいと思ってます．

そこで 12 月のリリースには，現状のものに手を入れて
ある程度までは動くものにするという形を考えています．
その上で，きちんと対応したものを作っていくつもりです．

正式対応版では，Tk のコア部分は独立した native thread で動き，
Ruby の thread switching や GC に煩わされないものになる予定です．
Ruby VM が model 3 になった場合でもそのままで大丈夫なものに
なるだろうと思ってます．

ちなみに 12 月中旬には Tcl/Tk 8.5 のβが取れて
正式版がリリースされるという話もあるようですから，
これにきちんと対応したものにしたいとも思ってます．
----<ここまで余談>--------------------------------------------------

スクリプトにはゴミのような出力をする行が含まれていますが，
うちの環境ではその行を削ると即座に SEGV してしまうので残してます．
環境が違えば全く違った動作になってしまう可能性があります．

うちの環境で添付のスクリプトを動作させると
  +-------------+
  |  button-1   |
  +-------------+
  |  button-2   |
  +-------------+
  |  listbox-1  |
  |             |
  +-------------+
  |  listbox-2  |
  |             |
  +-------------+
というように表示され，各ウィジェットにマウスカーソルが入ると

   button-1  --> SEGV
   button-2  --> 異常: self は "eql?" という String オブジェクト
   listbox-1 --> 正常: self は TkBalloonHelp オブジェクト
   listbox-2 --> 正常: self は TkBalloonHelp オブジェクト

というような出力がなされます．
スクリプトを少しいじると listbox でも SEGV するようになったり，
button-2 が別の文字列 (例えば "===") に化けるようになったり
という状況が生じます．

一体全体何がどうなっているやらという感じです．

> > ところで，Proc#binding ってなくなったんですか？
> > 今回の現象を調べる際に使おうとしたら存在しなかったもので．
> 
> 　はい．あったほうがいいですかね？

少なくとも今回はそれがあった方がうれしかったわけですが，
実際のところ，どの程度の需要があるのかはわかりません．
どのような議論の結果でそうなったのかは知らないのですが，
実装が難しかったりセキュリティ上の穴になったりとかの問題でしょうか？
特に問題がないのであればという条件下で，
あった方が変なこと(^_^)ができて楽しいかもしれません．

------------<ここからスクリプト>-----------------------------------
require 'tk'

class TkBalloonHelp<TkLabel
  @@count = 0
  def _balloon_binding(interval)
    @timer = TkAfter.new(interval, 1, proc{show})
    def @timer.interval(val)
      @sleep_time = val
    end
    @bindtag = TkBindTag.new
#    @bindtag.bind('Enter',  proc{@timer.start})
    x = binding()
    cnt = (@@count += 1)
    p [:init, cnt, self.class, eval('self.class', x), self]
    @bindtag.bind('Enter',  proc{
                    p [:callback, cnt, self.class, eval('self.class', x), self]
                  })
#    @bindtag.bind('Motion', proc{@timer.restart; erase})
#    @bindtag.bind('Any-ButtonPress', proc{@timer.restart; erase})
#    @bindtag.bind('Leave',  proc{@timer.stop; erase})
    tags = @parent.bindtags
    idx = tags.index(@parent)
    unless idx
      ppath = TkComm.window(@parent.path)
      idx = tags.index(ppath) || 0
    end
    tags[idx,0] = @bindtag
    @parent.bindtags(tags)
  end
  private :_balloon_binding

  def initialize(parent=nil, keys={})
    @parent = parent || Tk.root

    @frame = TkToplevel.new(@parent)
    @frame.withdraw
    @frame.overrideredirect(true)
    @frame.transient(TkWinfo.toplevel(@parent))
    @epath = @frame.path

    if keys
      keys = _symbolkey2str(keys)
    else
      keys = {}
    end

    @command = keys.delete('command')

    @interval = keys.delete('interval'){1000}
    _balloon_binding(@interval)

    @label = TkLabel.new(@frame, 'background'=>'bisque').pack
    @label.configure(_symbolkey2str(keys)) unless keys.empty?
    @path = @label
  end

  def epath
    @epath
  end

  def interval(val)
    if val
      @timer.interval(val)
    else
      @interval
    end
  end

  def command(cmd = Proc.new)
    @command = cmd
    self
  end

  def show
    x = TkWinfo.pointerx(@parent)
    y = TkWinfo.pointery(@parent)
    @frame.geometry("+#{x+1}+#{y+1}")

    if @command
      case @command.arity
      when 0
        @command.call
      when 2
        @command.call(x - TkWinfo.rootx(@parent), y - TkWinfo.rooty(@parent))
      when 3
        @command.call(x - TkWinfo.rootx(@parent), y - TkWinfo.rooty(@parent), 
                      self)
      else
        @command.call(x - TkWinfo.rootx(@parent), y - TkWinfo.rooty(@parent), 
                      self, @parent)
      end
    end

    @frame.deiconify
    @frame.raise

    @org_cursor = @parent['cursor']
    @parent.cursor('crosshair') 
  end

  def erase
    @parent.cursor(@org_cursor) 
    @frame.withdraw
  end

  def destroy
    @frame.destroy
  end
end

################################################
# test
################################################
if __FILE__ == $0
  TkButton.new('text'=>'This button has a balloon help') {|b|
    pack('fill'=>'x')
    TkBalloonHelp.new(b, 'text'=>' Message ')
  }

x =  TkButton.new('text'=>'This button has another balloon help') {|b|
    pack('fill'=>'x')
    TkBalloonHelp.new(b, 'text'=>'configured message', 
                      'interval'=>200, 'font'=>'courier', 
                      'background'=>'gray', 'foreground'=>'red')
  }
puts '1 ---------------------------------------------------------'
p tag = x.bindtags[0]
p tag.methods.sort
p cmd_id = Tk.tk_call('bind', tag.to_eval, '<Enter>').split(' ')[1]
p TkCore::INTERP.tk_cmd_tbl[cmd_id]
p cmd_proc = TkCore::INTERP.tk_cmd_tbl[cmd_id].instance_variable_get('@cmd')
cmd_proc.call
puts '1 **********************************************************'

  sb = TkScrollbox.new.pack(:fill=>:x)
  sb.insert(:end, *%w(aaa bbb ccc ddd eee fff ggg hhh iii jjj kkk lll mmm))

puts '2 ---------------------------------------------------------'
p tag = x.bindtags[0]
p tag.methods.sort
p cmd_id = Tk.tk_call('bind', tag.to_eval, '<Enter>').split(' ')[1]
p TkCore::INTERP.tk_cmd_tbl[cmd_id]
p cmd_proc = TkCore::INTERP.tk_cmd_tbl[cmd_id].instance_variable_get('@cmd')
cmd_proc.call
puts '2 **********************************************************'

  # CASE4b : command is a Method object and takes 4 arguemnts
  def set_msg(x, y, bhelp, parent)
    bhelp.text "current index == #{parent.nearest(y)}"
  end
  cmd = self.method(:set_msg)

puts '3 ---------------------------------------------------------'
p tag = x.bindtags[0]
p tag.methods.sort
p cmd_id = Tk.tk_call('bind', tag.to_eval, '<Enter>').split(' ')[1]
p TkCore::INTERP.tk_cmd_tbl[cmd_id]
p cmd_proc = TkCore::INTERP.tk_cmd_tbl[cmd_id].instance_variable_get('@cmd')
cmd_proc.call
puts '3 **********************************************************'

  TkBalloonHelp.new(sb, :interval=>500, 
                    :relief=>:ridge, :background=>'white', 
                    :command=>cmd)

  sb2 = TkScrollbox.new.pack(:fill=>:x)
  sb2.insert(:end, *%w(AAA BBB CCC DDD EEE FFF GGG HHH III JJJ KKK LLL MMM))
  TkBalloonHelp.new(sb2, :interval=>500, 
                    :padx=>5, :relief=>:raised, 
                    :background=>'gray25', :foreground=>'white',
                    :command=>cmd)

  Tk.mainloop
end
------------<ここまでスクリプト>-----------------------------------
-- 
                                       永井 秀利 （九工大 知能情報）
                                           [e-mail]