Wish aborts: unfreed fonts exist

A few days ago I reported in comp.lang.tcl that in my app wish aborts during exiting.
I have managed at last to find out what is happening.
The bug can be reproduced at least under unix&windows, with tk8.4a3:

#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec wish "$0" ${1+"$@"}

## Create a named font:
font create MyFont -family arial -size 16 -weight bold

## Create a canvas...
canvas .x -bg white -width 440 -height 240
## Place some items...
.x create rectangle 30 30 400 200 -tags rect -fill yellow
.x create text 220 90 -tags text -text {Click on me to abort :-)} -font MyFont \
-anchor c

## Place some bindings. Just a simple pop-up...
.x bind rect <1> {my_popup .x}
.x bind text <1> {my_popup .x}

pack .x -fill both -expand 1 -padx 2 -pady 2

## Here is all nice work done:-)
## I create the popup, but I wait until it is destroyed. But this will happen
## only when the canvas is destroyed. But I keep and add new items (in the
## destroyed but kept internally by tk?) canvas. Then on exit, my defined font
## will exist :-). A bad situation, but working ok on tk8.4a2 :-)
proc my_popup {canvas} {
set menu $canvas.menu
catch {destroy $menu}
menu $menu -tearoff 0

$menu add command -label {Now exit wish and... ????}
$menu add separator
$menu add command -label Exit -command exit -background red -foreground white

tk_popup $menu [winfo pointerx .] [winfo pointery .]
tkwait window $menu
destroy $menu
$canvas delete all
.x create rectangle 30 30 400 200 -tags rect -fill yellow
.x create text 220 90 -tags text -text {Click on me to abort :-)} \
-font MyFont -anchor c
}

############################################################
## END
############################################################