Posted to tcl by patthoyts at Wed May 13 21:09:36 GMT 2009view pretty

Index: generic/tkFont.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkFont.c,v
retrieving revision 1.53
diff -u -r1.53 tkFont.c
--- generic/tkFont.c	3 Feb 2009 23:55:47 -0000	1.53
+++ generic/tkFont.c	13 May 2009 21:06:01 -0000
@@ -3608,6 +3608,20 @@
 	if (result == TCL_OK) {
 	    return TCL_OK;
 	}
+
+	/*
+	 * If the string failed to parse but was considered to be a XLFD
+	 * then it may be a "-option value" string with a hyphenated family
+	 * name as per bug 2791352
+	 */
+
+	if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
+	if (ConfigAttributesObj(interp, tkwin, objc, objv, faPtr) == TCL_OK) {
+	    return TCL_OK;
+	}
     }
 
     /*
Index: tests/font.test
===================================================================
RCS file: /cvsroot/tktoolkit/tk/tests/font.test,v
retrieving revision 1.19
diff -u -r1.19 font.test
--- tests/font.test	15 Aug 2008 01:10:03 -0000	1.19
+++ tests/font.test	13 May 2009 21:08:29 -0000
@@ -2221,6 +2221,12 @@
 test font-38.12 {ParseFontNameObj procedure: stylelist error} -body {
     font actual {times 12 bold xyz}
 } -returnCodes error -result {unknown font style "xyz"}
+test font-38.13 "ParseFontNameObj: options with hyphenated family: bug #2791352" -body {
+    font actual {-family sans-serif -size 12 -weight bold -slant roman -underline 0 -overstrike 0}
+} -returnCodes ok -result [font actual {sans-serif 12 bold}]
+test font-38.14 "ParseFontNameObj: bug #2791352" -body {
+    font actual {-invalidfont 8 bold}
+} -returnCodes error -match glob -result {bad option "-invalidfont": *}
 
 
 test font-39.1 {NewChunk procedure: test realloc} -setup {

Comments

Posted by Emiliano at Wed May 13 21:19:42 GMT 2009 [text] [code]

Warning: ttkStubInit.c may be out of date. Developers may want to run "make genstubs" to regenerate. This warning can be safely ignored, do not report as a bug! LD_LIBRARY_PATH="`pwd`:/home/emiliano/src/tcl/unix:${LD_LIBRARY_PATH}"; export LD_LIBRARY_PATH; TCL_LIBRARY=/home/emiliano/src/tcl/library; export TCL_LIBRARY; TK_LIBRARY=/home/emiliano/src/tk/library; export TK_LIBRARY; ./tktest /home/emiliano/src/tk/unix/../tests/all.tcl -geometry +0+0 -file font.test Tests running in interp: /home/emiliano/src/tk/unix/tktest Tests located in: /home/emiliano/src/tk/tests Tests running in: /home/emiliano/src/tk/unix Temporary files stored in /home/emiliano/src/tk/unix Test files sourced into current interpreter Running tests that match: * Skipping test files that match: l.*.test Only running test files that match: font.test Tests began at Wed May 13 18:19:22 ART 2009 font.test ==== font-17.5 Tk_FreeFont procedure: named font FAILED ==== Contents of test case: # not (fontPtr->refCount == 0) font create xyz -underline 1 .t.f config -font xyz font delete xyz set x [font actual xyz -underline] destroy .t.f list [font actual xyz -underline] $x ---- Result was: 0 0 ---- Result should have been (exact matching): 0 1 ==== font-17.5 FAILED ==== font-24.5 Tk_ComputeTextLayout: break line FAILED ==== Contents of test case: .t.l config -text "000\t00000" -wrap [expr 9 * $ax] update list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] ---- Result was: 0 1 ---- Result should have been (exact matching): 1 1 ==== font-24.5 FAILED ==== font-38.11 ParseFontNameObj procedure: stylelist loop FAILED ==== Contents of test case: lrange [font actual {times 12 bold italic overstrike underline}] 4 end ---- Result was: -weight bold -slant italic -underline 0 -overstrike 0 ---- Result should have been (exact matching): -weight bold -slant italic -underline 1 -overstrike 1 ==== font-38.11 FAILED ==== font-44.1 TkFontGetPixels: size < 0 FAILED ==== Contents of test case: tk scaling 0.5 font actual {times -12} -size ---- Result was: -12 ---- Result should have been (exact matching): 24 ==== font-44.1 FAILED ==== font-45.3 TkFontGetAliasList: match FAILED ==== Contents of test case: # can fail on Unix systems that have a real "times new roman" font font actual {{times new roman} 10} -family ---- Result was: Liberation Serif ---- Result should have been (exact matching): Times ==== font-45.3 FAILED Tests ended at Wed May 13 18:19:29 ART 2009 all.tcl: Total 282 Passed 251 Skipped 26 Failed 5 Sourced 1 Test Files. Files with failing tests: font.test Number of tests skipped for each constraint: 26 win LD_LIBRARY_PATH="`pwd`:/home/emiliano/src/tcl/unix:${LD_LIBRARY_PATH}"; export LD_LIBRARY_PATH; TCL_LIBRARY=/home/emiliano/src/tcl/library; export TCL_LIBRARY; TK_LIBRARY=/home/emiliano/src/tk/library; export TK_LIBRARY; ./tktest /home/emiliano/src/tk/unix/../tests/ttk/all.tcl -geometry +0+0 \ -file font.test Tests running in interp: /home/emiliano/src/tk/unix/tktest Tests located in: /home/emiliano/src/tk/tests/ttk Tests running in: /home/emiliano/src/tk/unix Temporary files stored in /home/emiliano/src/tk/unix Test files sourced into current interpreter Running tests that match: * Skipping test files that match: l.*.test Only running test files that match: font.test Tests began at Wed May 13 18:19:29 ART 2009 Tests ended at Wed May 13 18:19:29 ART 2009 all.tcl: Total 0 Passed 0 Skipped 0 Failed 0 Sourced 0 Test Files.