Tests crash on Strawberry Perl 5.38

[greggmorris]

I manually built Tk-804.036 in an MSYS2 environment using Strawberry Perl SP 5.38.0.1-64bit-portable on a Windows 10 Enterprise v21H2 machine. The tests in the PNG directory fail:

Test Summary Report
-------------------
t/basic.t (Wstat: 1280 (exited 5) Tests: 2 Failed: 0)
  Non-zero exit status: 5
  Parse errors: Bad plan.  You planned 5 tests but ran 2.
t/crash.t (Wstat: 1280 (exited 5) Tests: 0 Failed: 0)
  Non-zero exit status: 5
  Parse errors: Bad plan.  You planned 1 tests but ran 0.
Files=2, Tests=2,  3 wallclock secs ( 0.08 usr +  0.03 sys =  0.11 CPU)
Result: FAIL
Failed 2/2 test programs. 0/2 subtests failed.
gmake[1]: *** [makefile:867: test_dynamic] Error 5
gmake[1]: Leaving directory 'C:/SP538/mod_bld/Tk-804.036/PNG'
gmake: *** [makefile:1453: subdirs-test_dynamic] Error 2

The actual failure is a segfault that is reproducible in gdb. This is not a debug build so the stack trace doesn't tell me much:

(gdb) set disable-randomization off
(gdb) r t/basic.t
Starting program: C:\SP538\perl\bin\perl.exe t/basic.t
[New Thread 1036.0x27d0]
[New Thread 1036.0x1fec]
[New Thread 1036.0x248c]
[New Thread 1036.0x28b8]
1..5
ok 1 - use Tk::PNG;
ok 2 - Loaded PNG image from C:/sp538/mod_bld/Tk-804.036/PNG/t/../pngtest.png

Thread 1 received signal SIGSEGV, Segmentation fault.
0x00007ffc66a6099a in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
(gdb) bt
#0  0x00007ffc66a6099a in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#1  0x00007ffc66a6b5a3 in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#2  0x00007ffc66a26ce5 in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#3  0x00007ffc66a26e8e in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#4  0x00007ffc66a276bc in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#5  0x00007ffc66a27d1e in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#6  0x00007ffc66a280d3 in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#7  0x00007ffc66a0f7c0 in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#8  0x00007ffc66a12028 in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#9  0x00007ffc66a12214 in boot_Tk () from C:\SP538\perl\site\lib\auto\Tk\Tk.xs.dll
#10 0x00007ffc4c3b2fec in perl538!Perl_clear_defarray () from C:\SP538\perl\bin\perl538.dll
#11 0x00007ffc4c407932 in perl538!Perl_runops_standard () from C:\SP538\perl\bin\perl538.dll
#12 0x00007ffc4c3c363a in perl_run () from C:\SP538\perl\bin\perl538.dll
#13 0x00007ffc4c416e23 in perl538!RunPerl () from C:\SP538\perl\bin\perl538.dll
#14 0x00007ff753bb1340 in ?? ()
#15 0x00007ff753bb1146 in ?? ()
#16 0x00007ffcaa767614 in KERNEL32!BaseThreadInitThunk () from C:\WINDOWS\System32\kernel32.dll
#17 0x00007ffcac2426f1 in ntdll!RtlUserThreadStart () from C:\WINDOWS\SYSTEM32\ntdll.dll
#18 0x0000000000000000 in ?? ()

I submitted an issue to the Strawberry Perl tracker (StrawberryPerl/Perl-Dist-Strawberry#122) and it was suggested to submit an issue to this tracker as well. One of the suggestions was pointer incompatibilities, and in the build output I see around 150 occurrences of "warning: cast from pointer to integer of different size" (I can post the full build output if that would be helpful). For example,

gcc -c -I. -I./pTk/mTk/xlib  -I.. -I.. -I../pTk/mTk/xlib -I. -Ibitmaps -I.. -I../pTk/mTk/xlib -DWIN32 -DWIN64
-D__USE_MINGW_ANSI_STDIO -DPERL_TEXTMODE_SCRIPTS -DMULTIPLICITY -DPERL_IMPLICIT_SYS -DUSE_PERLIO -D__USE_MINGW_ANSI_STDIO
-fwrapv -fno-strict-aliasing -mms-bitfields -DPERLDLL -Os   -DVERSION=\"804.036\" -DXS_VERSION=\"804.036\"  "-IC:\SP538\perl\lib\CORE"    imgXPM.c
In file included from Lang.h:19,
                 from tkPort.h:24,
                 from tk.h:87,
                 from imgXPM.c:26:
imgXPM.c: In function 'CommonReadXPM':
imgXPM.c:405:49: warning: cast to pointer from integer of different size [-Wint-to-pointer-cast]
  405 |         hPtr = Tcl_CreateHashEntry(&colorTable, (char *) color1, &found);
      |                                                 ^
tcl.h:1396:47: note: in definition of macro 'Tcl_CreateHashEntry'
 1396 |         (*((tablePtr)->createProc))(tablePtr, key, newPtr)
      |                                               ^~~
imgXPM.c:406:32: warning: cast to pointer from integer of different size [-Wint-to-pointer-cast]
  406 |         Tcl_SetHashValue(hPtr, (char *) data);
      |                                ^
tcl.h:1373:69: note: in definition of macro 'Tcl_SetHashValue'
 1373 | #define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
      |                                                                     ^~~~~
imgXPM.c:457:51: warning: cast to pointer from integer of different size [-Wint-to-pointer-cast]
  457 |             hPtr = Tcl_FindHashEntry(&colorTable, (char *) color1);
      |                                                   ^
tcl.h:1394:45: note: in definition of macro 'Tcl_FindHashEntry'
 1394 |         (*((tablePtr)->findProc))(tablePtr, key)
      |                                             ^~~
imgXPM.c:464:23: warning: cast from pointer to integer of different size [-Wpointer-to-int-cast]
  464 |                 col = (int)Tcl_GetHashValue(hPtr);
      |                       ^
imgXPM.c:486:63: warning: cast to pointer from integer of different size [-Wint-to-pointer-cast]
  486 |                         hPtr = Tcl_FindHashEntry(&colorTable, (char *) color1);
      |                                                               ^
tcl.h:1394:45: note: in definition of macro 'Tcl_FindHashEntry'
 1394 |         (*((tablePtr)->findProc))(tablePtr, key)
      |                                             ^~~
imgXPM.c:488:35: warning: cast from pointer to integer of different size [-Wpointer-to-int-cast]
  488 |                             col = (int)Tcl_GetHashValue(hPtr);
      |                                   ^

Has anyone else encountered this? Is there a workaround or patch available to fix it?

[sisyphus]

Has anyone else encountered this?

Yes.
If the [-Wpointer-to-int-cast] and [-Wint-to-pointer-cast] warnings are indicative of the problem, then I would expect that the same issue would arise with Tk-804.036 on 64-bit Strawberry Perl 5.32.1.
However, Tk-804.036 builds and tests fine for me on Strawberry Perl-5.32.1 (on both 32-bit and 64-bit builds).

I think the 5.32.1 build produces the same warnings as the 5.38.0 build - but I haven't checked on that properly.
(If you can find some warning(s) that exists on one build, but not the other, then that could be significant.)

So, I guess that if you want to run Tk-804.036 on Strawberry Perl, then one workaround is to use Strawberry Perl 5.32.1.
(Not sure if that actually qualifies as a "workaround", but it's all that I can come up with at the moment ;-)

Cheers,
Rob

[chrstphrchvz]

I would suggest putting typedef unsigned long long XID in pTk/mTk/xlib/X11/X.h as a simple workaround. Currently typedef unsigned long XID is being used instead, which is causing pointers wider than 32 bits to get truncated.

[chrstphrchvz]

I am not familiar with the proper way to get debugging symbols for the Strawberry Perl build environment, so I run perl Makefile.PL but then edit any Makefiles so that -Os optimize flags are instead -Og -g -ggdb and any -mdll -s … linker flags are instead -mdll …. I can then reproduce a more useful example in gdb. Notice how twdPtr was 0x1679bc50cf0 when allocated, but was 0x9bc50cf0 when dereferenced later elsewhere:

(gdb) set disable-randomization off
(gdb) b tkWinX.c:515
No symbol table is loaded.  Use the "file" command.
Make breakpoint pending on future shared library load? (y or [n]) y
Breakpoint 1 (tkWinX.c:515) pending.
(gdb) r
Starting program: C:\Users\user\Downloads\strawberry-perl-5.38.0.1-64bit-portable\perl\bin\perl.exe -Mblib t\button.t
[New Thread 4268.0x17cc]
[New Thread 4268.0x30a0]
[New Thread 4268.0x2a50]
1..5

Thread 1 hit Breakpoint 1, TkpOpenDisplay (display_name=display_name@entry=0x167993fd9a0 ":0") at tkWinX.c:515
515         if (twdPtr == NULL) {
(gdb) p twdPtr
$1 = (TkWinDrawable *) 0x1679bc50cf0
(gdb) c
Continuing.

Thread 1 received signal SIGSEGV, Segmentation fault.
Tk_GetPixmap (display=display@entry=0x16799426040, d=2613382384, width=width@entry=16, height=height@entry=16, depth=depth@entry=1) at tkWinPixmap.c:52
52          if (twdPtr->type != TWD_BITMAP) {
(gdb) p twdPtr
$2 = (TkWinDrawable *) 0x9bc50cf0
(gdb) bt
#0  Tk_GetPixmap (display=display@entry=0x16799426040, d=2613382384, width=width@entry=16, height=height@entry=16, depth=depth@entry=1) at tkWinPixmap.c:52
#1  0x00007ffae060dd53 in XCreateBitmapFromData (display=0x16799426040, d=<optimized out>,
    data=0x7ffae062fda0 <gray50_bits> "UUªªUUªªUUªªUUªªUUªªUUªªUUªªUUªª", width=16, height=16) at ximage.c:50
#2  0x00007ffae05be186 in GetBitmap (interp=0x0, tkwin=0x1679bcae540, string=0x7ffae06449c1 <flagArray+10433> "gray50") at tkBitmap.c:410
#3  0x00007ffae05be2a2 in Tk_GetBitmap (interp=<optimized out>, tkwin=<optimized out>, string=<optimized out>) at tkBitmap.c:267
#4  0x00007ffae05becc9 in TkButtonWorldChanged (instanceData=instanceData@entry=0x1679bcb0e70) at tkButton.c:1361
#5  0x00007ffae05bf1e0 in ConfigureButton (interp=interp@entry=0x1679941c190, butPtr=butPtr@entry=0x1679bcb0e70, objc=objc@entry=2,
    objv=objv@entry=0x167995c44c8) at tkButton.c:1279
#6  0x00007ffae05bf812 in ButtonCreate (clientData=<optimized out>, interp=0x1679941c190, objc=4, objv=0x167995c44b8, type=type@entry=2) at tkButton.c:744
#7  0x00007ffae05bf89a in Tk_CheckbuttonObjCmd (clientData=<optimized out>, interp=<optimized out>, objc=<optimized out>, objv=<optimized out>)
    at tkButton.c:578
#8  0x00007ffae05a2d06 in Call_Tk (info=info@entry=0x49dcbff4e0, items=items@entry=4, args=args@entry=0x167995c44b8) at tkGlue.c:2277
#9  0x00007ffae05a59b9 in XSTkCommand (cv=0x1679b0b56c0, mwcd=mwcd@entry=0, proc=0x7ffae05bf889 <Tk_CheckbuttonObjCmd>, items=4, args=0x167995c44b8)
    at tkGlue.c:3042
#10 0x00007ffae05a5ccc in XStoTclCmdNull (my_perl=0x167995c4fd0, cv=<optimized out>) at tkGlue.c:3056
#11 0x00007ffae05a5d37 in XS_Tk_checkbutton (my_perl=0x0, cv=0x1679bcd8b40) at C:/Users/user/Documents/GitHub/perl-tk/TkXSUB.def:46
#12 0x00007ffaeb372fec in perl538!Perl_clear_defarray () from C:\Users\user\Downloads\strawberry-perl-5.38.0.1-64bit-portable\perl\bin\perl538.dll
#13 0x00007ffaeb3c7932 in perl538!Perl_runops_standard () from C:\Users\user\Downloads\strawberry-perl-5.38.0.1-64bit-portable\perl\bin\perl538.dll
#14 0x00007ffaeb38363a in perl_run () from C:\Users\user\Downloads\strawberry-perl-5.38.0.1-64bit-portable\perl\bin\perl538.dll
#15 0x00007ffaeb3d6e23 in perl538!RunPerl () from C:\Users\user\Downloads\strawberry-perl-5.38.0.1-64bit-portable\perl\bin\perl538.dll
#16 0x00007ff6bf081340 in ?? ()
#17 0x00007ff6bf081146 in ?? ()
#18 0x00007ffb37a17614 in KERNEL32!BaseThreadInitThunk () from C:\WINDOWS\System32\kernel32.dll
#19 0x00007ffb393c26b1 in ntdll!RtlUserThreadStart () from C:\WINDOWS\SYSTEM32\ntdll.dll
#20 0x0000000000000000 in ?? ()
Backtrace stopped: previous frame inner to this frame (corrupt stack?)

In this example crash, GetBitmap() is doing:

perl-tk/pTk/mTk/generic/tkBitmap.c

Lines 410 to 413 in 71fb7bb

	bitmap = XCreateBitmapFromData(Tk_Display(tkwin),
	RootWindowOfScreen(Tk_Screen(tkwin)),
	predefPtr->source,
	(unsigned) width, (unsigned) height);

RootWindowOfScreen() had retrieved the .root member of a Screen:

perl-tk/pTk/mTk/xlib/X11/Xlib.h

Line 115 in 71fb7bb

#define RootWindowOfScreen(s) ((s)->root)

but .root is defined as type Window a.k.a. XID:

perl-tk/pTk/mTk/xlib/X11/Xlib.h

Line 236 in 71fb7bb

Window root; /* Root window id. */

perl-tk/pTk/mTk/xlib/X11/X.h

Line 49 in 71fb7bb

typedef XID Window;

[greggmorris]

@chrstphrchvz, thanks so much for this information. Your suggestion to use unsigned long long for XID has fixed the problem. All the Tk tests pass now. Thanks also for the debugging tips. I was trying to figure out the best way to add debugging information to the Tk build but your solution is perfect. Your documentation of the gdb session is very helpful, but honestly I hope I don't need it in the future!

[sisyphus]

Nice work @chrstphrchvz.
I was puzzled as to how the perl-5.32.1 build of Tk-804.036 (on the very same computer) was not similarly afflicted.
I guess there must simply be something about that 5.32.1 environment that ensures that pointers wider than 32 bits are avoided - which was a difference in behaviour that I had not even considered.

Cheers,
Rob