From 385adbd9bd138d4133799dedca3eff392ac72867 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 31 Aug 2025 16:38:23 +0000
Subject: Add testcases for out-of-range Unicode characters

---
 generic/tclTest.c | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 tests/utf.test    | 24 ++++++++++++++++++
 2 files changed, 100 insertions(+)

diff --git a/generic/tclTest.c b/generic/tclTest.c
index 441b11f..e2a219e 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -281,6 +281,7 @@ static Tcl_ObjCmdProc	TestSizeCmd;
 static Tcl_ObjCmdProc	TeststaticlibraryCmd;
 static Tcl_ObjCmdProc	TesttranslatefilenameCmd;
 static Tcl_ObjCmdProc	TestfstildeexpandCmd;
+static Tcl_ObjCmdProc	TestuniClassCmd;
 static Tcl_ObjCmdProc	TestupvarCmd;
 static Tcl_ObjCmdProc2	TestWrongNumArgsCmd;
 static Tcl_ObjCmdProc	TestGetIndexFromObjStructCmd;
@@ -715,6 +716,7 @@ Tcltest_Init(
     Tcl_CreateObjCommand(interp, "testfstildeexpand",
 	    TestfstildeexpandCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testuniclass", TestuniClassCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
 	    NULL);
     Tcl_CreateObjCommand(interp, "testsetmainloop", TestsetmainloopCmd,
@@ -5096,6 +5098,80 @@ TestupvarCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestuniClassCmd --
+ *
+ *	This procedure implements the "testuniclass" command.  It is used
+ *	to test Tcl_UniCharToXXXX and Tcl_UniCharIsXXXX.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Return information about the unicode class.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestuniClassCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* Arguments. */
+{
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "integer");
+	return TCL_ERROR;
+    }
+
+    int value;
+    if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
+    	return TCL_ERROR;
+    }
+    Tcl_Obj *result = Tcl_NewObj();
+    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(Tcl_UniCharToLower(value)));
+    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(Tcl_UniCharToUpper(value)));
+    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(Tcl_UniCharToTitle(value)));
+    if (Tcl_UniCharIsLower(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("lower", -1));
+    }
+    if (Tcl_UniCharIsUpper(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("upper", -1));
+    }
+    if (Tcl_UniCharIsAlnum(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("alnum", -1));
+    }
+    if (Tcl_UniCharIsAlpha(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("alpha", -1));
+    }
+    if (Tcl_UniCharIsDigit(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("digit", -1));
+    }
+    if (Tcl_UniCharIsSpace(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("space", -1));
+    }
+    if (Tcl_UniCharIsWordChar(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("word", -1));
+    }
+    if (Tcl_UniCharIsControl(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("control", -1));
+    }
+    if (Tcl_UniCharIsGraph(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("graph", -1));
+    }
+    if (Tcl_UniCharIsPrint(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("print", -1));
+    }
+    if (Tcl_UniCharIsPunct(value)) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj("punct", -1));
+    }
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestseterrorcodeCmd --
  *
  *	This procedure implements the "testseterrorcodeCmd".  This tests up to
diff --git a/tests/utf.test b/tests/utf.test
index fb0824f..1ce8156 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -24,6 +24,7 @@ testConstraint teststringobj [llength [info commands teststringobj]]
 testConstraint testutfnext [llength [info commands testutfnext]]
 testConstraint testutfprev [llength [info commands testutfprev]]
 testConstraint testgetunichar [llength [info commands testgetunichar]]
+testConstraint testuniclass [llength [info commands testuniclass]]
 
 testConstraint tip413 [expr {[string trim \x00] eq {}}]
 
@@ -1127,6 +1128,29 @@ test utf-24.6 {unicode space char in regc_locale.c} tip413 {
     list [regexp {^[[:space:]]+$} \x85\u1680\u180E\u200B\u202F\u2060] [regexp {^\s+$} \x85\u1680\u180E\u200B\u202F\u2060]
 } {1 1}
 
+test utf-25.1 {tupper/tolower/totitle out of range values} testuniclass {
+    list [testuniclass 0x11FFFF] \
+	[testuniclass 0x1FFFFF] \
+	[testuniclass 0x200041] \
+	[testuniclass 0x200061] \
+	[testuniclass 0x20005F] \
+	[testuniclass 0x200030] \
+	[testuniclass 0x200020] \
+	[testuniclass 0x200001] \
+	[testuniclass 0x20002C] \
+	[testuniclass -1]
+} [list {1179647 1179647 1179647} \
+    {2097151 2097151 2097151} \
+    {97 65 65 upper alnum alpha word graph print} \
+    {97 65 65 lower alnum alpha word graph print} \
+    {95 95 95 word graph print punct} \
+    {48 48 48 alnum digit word graph print} \
+    {32 32 32 space print} \
+    {1 1 1 control} \
+    {44 44 44 graph print punct} \
+    {2097151 2097151 2097151}
+]
+
 proc UniCharCaseCmpTest {order one two {constraints {}}} {
     variable count
     test utf-25.$count {Tcl_UniCharNcasecmp} -setup {
-- 
cgit v0.12