From 1cb16f6c36acec8486d2683077a9a19717bccccd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 29 Aug 2014 14:09:31 -0600 Subject: [PATCH] ffi/unsafe/objc: fix `objc-is-a?` to recognize subclass instances This repair turns out to matter for Mac OS X 10.10, where creating a list box in a frame somehow makes the frame an instance of a subclass (that implements notifications of some sort, I think). That subclassing broke an `(objc-is-a? ... RacketWindow)` test to recognize windows that belong to a particular eventspace. --- .../racket-doc/scribblings/foreign/objc.scrbl | 19 ++++++++++++++++++- racket/collects/ffi/unsafe/objc.rkt | 13 +++++++++++-- 2 files changed, 29 insertions(+), 3 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/objc.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/objc.scrbl index ca0b6431d9..56a18d406f 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/objc.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/objc.scrbl @@ -258,7 +258,16 @@ Returns a selector (of FFI type @racket[_SEL]) for the string form of @defproc[(objc-is-a? [obj _id] [cls _Class]) boolean?]{ Check whether @racket[obj] is an instance of the Objective-C class -@racket[cls].} +@racket[cls] or a subclass. + +@history[#:changed "6.1.0.5" @elem{Recognize subclasses, instead of requiring an + exact class match.}]} + +@defproc[(objc-subclass? [subcls _Class] [cls _Class]) boolean?]{ + +Check whether @racket[subcls] is @racket[cls] or a subclass. + +@history[#:added "6.1.0.5"]} @; ---------------------------------------------------------------------- @@ -289,6 +298,14 @@ Registers an Objective-C class.} Returns the class of an object (or the meta-class of a class).} +@defproc[(class_getSuperclass [cls _Class]) + _Class]{ + +Returns the superclass of @racket[cls] or @racket[#f] if @racket[cls] +has no superclass. + +@history[#:added "6.1.0.5"]} + @defproc[(class_addMethod [cls _Class] [sel _SEL] [imp procedure?] [type ctype?] diff --git a/racket/collects/ffi/unsafe/objc.rkt b/racket/collects/ffi/unsafe/objc.rkt index c283116309..6eed6ea1a3 100644 --- a/racket/collects/ffi/unsafe/objc.rkt +++ b/racket/collects/ffi/unsafe/objc.rkt @@ -876,10 +876,19 @@ ;; -------------------------------------------------- -(provide objc-is-a?) +(provide objc-is-a? + objc-subclass?) + +(define-objc class_getSuperclass (_fun _Class -> _Class)) (define (objc-is-a? v c) - (ptr-equal? (object-get-class v) c)) + (objc-subclass? (object-get-class v) c)) + +(define (objc-subclass? vc c) + (or (ptr-equal? vc c) + (let ([pc (class_getSuperclass vc)]) + (and pc + (objc-subclass? pc c))))) ;; --------------------------------------------------