fix for expired fonts, inference unit test failure

library/generic/tuple.factor

@@ -125,9 +125,22 @@ kernel-internals math hashtables errors ;
 : add-tuple-dispatch ( word vtable -- )
     >r unit [ car tuple-dispatch ] cons tuple r> set-vtable ;
 
-M: tuple clone ( tuple -- tuple )
+: clone-tuple ( tuple -- tuple )
+    #! Make a shallow copy of a tuple, without cloning its
+    #! delegate.
     dup array-capacity dup <tuple> [ -rot copy-array ] keep ;
 
+: clone-delegate ( tuple -- )
+    dup class "delegate-field" word-property dup [
+        [ >fixnum slot clone ] 2keep set-slot
+    ] [
+        2drop
+    ] ifte ;
+
+M: tuple clone ( tuple -- tuple )
+    #! Clone a tuple and its delegate.
+    clone-tuple dup clone-delegate ;
+
 : tuple>list ( tuple -- list )
     dup array-capacity swap array>list ;
 

library/sdl/sdl-utils.factor

@@ -132,9 +132,14 @@ global [
     }} logical-fonts set
 ] bind
 
+: (lookup-font) ( [[ name ptsize ]] -- font )
+    unswons logical-font swons dup get dup alien-address 0 = [
+        drop f
+    ] when ;
+
 : lookup-font ( [[ name ptsize ]] -- font )
     fonts get [
-        unswons logical-font swons dup get [
+        (lookup-font) [
             nip
         ] [
             [ uncons <font> dup ] keep set

library/words.factor

@@ -66,5 +66,10 @@ PREDICATE: compound promise ( obj -- ? )
     "name" word-property >string ;
 
 : word-vocabulary ( word -- str ) "vocabulary" word-property ;
-: stack-effect    ( word -- str ) "stack-effect" word-property ;
+
+: stack-effect    ( word -- str )
+    dup "stack-effect" word-property [
+        
+    ] ?unless ;
+
 : documentation   ( word -- str ) "documentation" word-property ;

native/string.c

@@ -183,22 +183,20 @@ void primitive_string_compare(void)
 	dpush(tag_fixnum(string_compare(s1,s2)));
 }
 
-bool string_eq(F_STRING* s1, F_STRING* s2)
-{
-	if(s1 == s2)
-		return true;
-	else if(s1->hashcode != s2->hashcode)
-		return false;
-	else
-		return (string_compare(s1,s2) == 0);
-}
-
 void primitive_string_eq(void)
 {
 	F_STRING* s1 = untag_string(dpop());
 	CELL with = dpop();
 	if(type_of(with) == STRING_TYPE)
-		dpush(tag_boolean(string_eq(s1,(F_STRING*)UNTAG(with))));
+	{
+		F_STRING* s2 = (F_STRING*)UNTAG(with);
+		if(s1->hashcode != s2->hashcode)
+			dpush(F);
+		else if(s1 == s2)
+			dpush(T);
+		else
+			dpush(tag_boolean((string_compare(s1,s2) == 0)));
+	}
 	else
 		dpush(F);
 }