clone 348513 -1 -2
reassign -1 tetex-bin 3.0-13
retitle -1 tetex-bin: should at least Suggest xbase-clients
severity -1 minor
owner -1 !
reassign -2 tetex-bin 3.0-13
retitle -2 tetex-bin: texdoctk shouldn't configure Tk::Button with an undef font
severity -2 normal
owner -2 !
tags -2 patch
retitle 348513 perl-tk: segfault when configuring widgets with an undef font
found 348513 1:804.027-3
tags 348513 patch
thanks

On Fri, Feb 03, 2006 at 07:31:16PM +0100, Frank Küster wrote:
 
> > Anyone have any ideas on how to fix the segfault?
> 
> That goes to the perl people.

Hi,

first of all, the segfault manifests when xbase-clients is not installed.
Specifically, texdoctk calls xwininfo to find out the display resolution.
It then uses this info to configure a Tk::Button object with a suitable
font. If xwininfo is not present, it falls back to 

$Qbut->configure(-font=>$deffont);

(/usr/bin/texdoctk:1693) with $deffont undefined. The current version of
perl-tk segfaults here.

Even if there was no segfault, apparently texdoctk would benefit from
xwininfo being present, and thus tetex-bin should at least Suggest
xbase-clients. I'm cloning this as a minor bug against tetex-bin.

The correct perl-tk behaviour is to throw an exception:

font "" doesn't exist at /usr/lib/perl5/Tk/Widget.pm line 196.

This is what the sarge version of perl-tk (1:800.025-2) does.  So, even
with a fixed perl-tk, texdoctk will exit with a fatal error when xwininfo
is not present. I'm cloning this as a normal bug against tetex-bin,
and including a suggested simple fix as the first attached patch.

Now for the perl-tk segfault. A minimal testcase for it is:

#!/usr/bin/perl
use Tk;
my $main = new MainWindow;
my $cmdframe = $main->Frame;
my $b = $cmdframe->Button(-font => undef);

This segfaults for at least the Button, Radiobutton and Text widgets.

After some gdb debugging, I came up with the second attached patch,
which seems to fix this and reverts to the sarge behaviour.

Cheers,
-- 
Niko Tyni       [EMAIL PROTECTED]
--- /usr/bin/texdoctk   2006/02/05 17:08:01     1.1
+++ /usr/bin/texdoctk   2006/02/05 17:08:17
@@ -1690,7 +1690,7 @@
     my @deffont=$Qbut->configure(-font);
 # ensure readability on high-res screens (suggested by R.Kotucha)
     $deffont='Helvetica -16 bold' if &x_resolution > 1200;
-    $Qbut->configure(-font=>$deffont);
+    $Qbut->configure(-font=>$deffont) if $deffont;
     $msgframe->Label(-text=>'FATAL ERROR',
                     -font=>$deffont)->pack(-side=>'top', -fill=>'x');
 #   get size of message text
--- ./pTk/mTk/generic/tkFont.c  2006/02/05 16:44:35     1.1
+++ ./pTk/mTk/generic/tkFont.c  2006/02/05 16:44:36
@@ -1044,6 +1044,7 @@
     TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
     int new, descent;
     NamedFont *nfPtr;
+    char *fontString;
 
     fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
     if (objPtr->typePtr != &tkFontObjType) {
@@ -1077,8 +1078,12 @@
        cacheHashPtr = oldFontPtr->cacheHashPtr;
        FreeFontObjProc(objPtr);
     } else {
+       fontString = Tcl_GetString(objPtr);
+       if (fontString == NULL) {
+               fontString = "";
+       }
        cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
-               Tcl_GetString(objPtr), &new);
+               fontString, &new);
     }
     firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
     for (fontPtr = firstFontPtr; (fontPtr != NULL);
@@ -1095,8 +1100,12 @@
      * The desired font isn't in the table.  Make a new one.
      */
 
+    fontString = Tcl_GetString(objPtr);
+    if (fontString == NULL) {
+           fontString = "";
+    }
     namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
-           Tcl_GetString(objPtr));
+           fontString);
     if (namedHashPtr != NULL) {
        /*
         * Construct a font based on a named font.
@@ -1111,7 +1120,7 @@
         * Native font?
         */
 
-       fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
+       fontPtr = TkpGetNativeFont(tkwin, fontString);
        if (fontPtr == NULL) {
            TkFontAttributes fa;
            Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);
--- ./objGlue.c 2006/02/05 16:39:09     1.1
+++ ./objGlue.c 2006/02/05 16:39:13
@@ -555,6 +555,10 @@
    else
     {
      s = LangString(objPtr);
+     if (!s)
+      {
+       return NULL;
+      }
 #ifdef SvUTF8
      if (!is_utf8_string(s,strlen(s)))
       {

Reply via email to