add inspector-superior?

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "6.5.0.5")
+(define version "6.5.0.6")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl

@@ -44,6 +44,15 @@ as @racket[inspector]. That is, @racket[inspector] and the result
 inspector control mutually disjoint sets of structure types.}
 
 
+@defproc[(inspector-superior? [inspector inspector?]
+                              [maybe-subinspector inspector?])
+         boolean?]{
+Returns @racket[#t] if @racket[inspector] is an ancestor of
+@racket[maybe-subinspector] (and not equal to
+@racket[maybe-subinspector]), @racket[#f] otherwise.
+
+@history[#:added "6.5.0.6"]}
+
 @defparam[current-inspector insp inspector?]{
 
 A @tech{parameter} that determines the default inspector for newly created

pkgs/racket-test-core/tests/racket/optimize.rktl

@@ -3867,6 +3867,18 @@
                (a? (a-x (a 1 2)))
                5)))
 
+(test-comp '(module m racket/base
+              (require racket/unsafe/undefined)
+              (struct a (x y) #:omit-define-syntaxes
+                      #:property prop:chaperone-unsafe-undefined '(y x))
+              (list (begin (a? 1) 2)))
+           '(module m racket/base
+              (require racket/unsafe/undefined)
+              (struct a (x y) #:omit-define-syntaxes
+                      #:property prop:chaperone-unsafe-undefined '(y x))
+              (list 2))
+           #f)
+
 (module struct-a-for-optimize racket/base
   (provide (struct-out a)
            (struct-out b))

pkgs/racket-test-core/tests/racket/struct.rktl

@@ -635,6 +635,18 @@
 		two132-a x132 6
 		one32-y x132 4))))
 
+;; ------------------------------------------------------------
+;; Inspectors
+
+(test #t inspector? (make-inspector))
+(test #t inspector? (current-inspector))
+(test #f inspector? (list (make-inspector)))
+
+(test #f inspector-superior? (current-inspector) (current-inspector))
+(test #t inspector-superior? (current-inspector) (make-inspector))
+(test #f inspector-superior? (make-inspector) (make-inspector))
+(test #t inspector-superior? (current-inspector) (make-inspector (make-inspector (make-inspector))))
+
 ;; ------------------------------------------------------------
 ;; Property accessor errors
 

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1149
+#define EXPECTED_PRIM_COUNT 1150
 #define EXPECTED_UNSAFE_COUNT 126
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.5.0.5"
+#define MZSCHEME_VERSION "6.5.0.6"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 5
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 5
+#define MZSCHEME_VERSION_W 6
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

racket/src/racket/src/struct.c

@@ -98,6 +98,7 @@ typedef struct {
 static Scheme_Object *make_inspector(int argc, Scheme_Object *argv[]);
 static Scheme_Object *make_sibling_inspector(int argc, Scheme_Object *argv[]);
 static Scheme_Object *inspector_p(int argc, Scheme_Object *argv[]);
+static Scheme_Object *inspector_superior_p(int argc, Scheme_Object *argv[]);
 static Scheme_Object *current_inspector(int argc, Scheme_Object *argv[]);
 static Scheme_Object *current_code_inspector(int argc, Scheme_Object *argv[]);
 
@@ -744,6 +745,11 @@ scheme_init_struct (Scheme_Env *env)
 						      "inspector?",
 						      1, 1, 1),
 			     env);
+  scheme_add_global_constant("inspector-superior?",
+			     scheme_make_folding_prim(inspector_superior_p,
+						      "inspector-superior?",
+						      2, 2, 1),
+			     env);
   
   REGISTER_SO(scheme_current_inspector_proc);
   scheme_current_inspector_proc = scheme_register_parameter(current_inspector,
@@ -979,6 +985,18 @@ static Scheme_Object *inspector_p(int argc, Scheme_Object **argv)
 	  : scheme_false);
 }
 
+static Scheme_Object *inspector_superior_p(int argc, Scheme_Object *argv[])
+{
+  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_inspector_type))
+      scheme_wrong_contract("inspector-superior?", "inspector?", 0, argc, argv);
+  if (!SAME_TYPE(SCHEME_TYPE(argv[1]), scheme_inspector_type))
+      scheme_wrong_contract("inspector-superior?", "inspector?", 1, argc, argv);
+
+  return ((!SAME_OBJ(argv[1], argv[0]) && scheme_is_subinspector(argv[1], argv[0]))
+          ? scheme_true
+          : scheme_false);
+}
+
 int scheme_is_subinspector(Scheme_Object *i, Scheme_Object *sup)
 {
   Scheme_Inspector *ins, *superior;