objc/objc-test.lisp at main · calsys456/objc · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
;;;; P1: The Objective-C to Lisp Bridge with Transparent Layer
;;; Copyright (C) 2025-2026 The Calendrical System
;;; SPDX-License-Identifier: 0BSD

;;; Test of cl-objc

(defpackage objc-test
  (:use :cl :parachute))
(in-package :objc-test)

;;; Test for P2

(define-test test-translate-name-from-foreign
  (let ((sym (cffi:translate-name-from-foreign "stringWithUTF8String:" (find-package "OBJC-METHOD"))))
    (is eq (find-package "OBJC-METHOD") (symbol-package sym))
    (is string= "STRING-WITH-UTF8-STRING." (symbol-name sym))))

(define-test test-translate-name-to-foreign
  (is string= "stringWithUTF8String:"
      (cffi:translate-name-to-foreign 'objc-method:string-with-utf8-string. (find-package "OBJC-METHOD"))))

(define-test test-parse-selector-name-to-arglist
  (let ((lst (objc::parse-selector-name-to-arglist "initWithContentRect:styleMask:backing:defer:")))
    (true (every (lambda (sym) (eq (symbol-package sym) (find-package "OBJC-METHOD"))) lst))
    (is = 4 (length lst))))

;;; [TODO] Test for P3

;;; Test for P4

(define-test test-translate-selector-from-foreign
  (let ((sel (cffi:foreign-funcall "sel_registerName"
                                   :string "initWithContentRect:styleMask:backing:defer:"
                                   objc:selector)))
    (is cffi:pointer-eq (objc-raw::sel-register-name "initWithContentRect:styleMask:backing:defer:")
        (objc:objc-obj sel))))

;;; [TODO] Test for P5

;;; [TODO] Test for P6

;;; Test for P7

(define-test test-ns-object-property
  (is string= "NSObject"
      (slot-value (objc-method:alloc (objc:cls ns-object))
                  'objc-prop:class-name)))

;;; Test for P8 & P9

;; ensure-objc-class

(define-test test-ensure-objc-class-pointer
  (let ((cls (objc:ensure-objc-class (objc-raw::objc-lookup-class "NSObject"))))
    (is cffi:pointer-eq (objc-raw::objc-lookup-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-class:ns-object (class-name cls))))

(define-test test-ensure-objc-class-string
  (let ((cls (objc:ensure-objc-class "NSObject")))
    (is cffi:pointer-eq (objc-raw::objc-lookup-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-class:ns-object (class-name cls))))

(define-test test-ensure-objc-class-object
  (let ((cls (objc:ensure-objc-class (objc:ensure-objc-class "NSObject"))))
    (is cffi:pointer-eq (objc-raw::objc-lookup-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-class:ns-object (class-name cls))))

(define-test test-ensure-objc-class-symbol
  (let ((cls (objc:ensure-objc-class :ns-object)))
    (is cffi:pointer-eq (objc-raw::objc-lookup-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-class:ns-object (class-name cls))))

;; ensure-objc-meta-class

(define-test test-ensure-objc-meta-class-pointer
  (let ((cls (objc:ensure-objc-meta-class (objc-raw::objc-get-meta-class "NSObject"))))
    (is cffi:pointer-eq (objc-raw::objc-get-meta-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-meta:ns-object (class-name cls))))

(define-test test-ensure-objc-meta-class-string
  (let ((cls (objc:ensure-objc-meta-class "NSObject")))
    (is cffi:pointer-eq (objc-raw::objc-get-meta-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-meta:ns-object (class-name cls))))

(define-test test-ensure-objc-meta-class-object
  (let ((cls (objc:ensure-objc-meta-class (objc:ensure-objc-class "NSObject"))))
    (is cffi:pointer-eq (objc-raw::objc-get-meta-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-meta:ns-object (class-name cls))))

(define-test test-ensure-objc-meta-class-symbol
  (let ((cls (objc:ensure-objc-meta-class :ns-object)))
    (is cffi:pointer-eq (objc-raw::objc-get-meta-class "NSObject") (objc:objc-obj cls))
    (true (typep cls 'objc:objc-class))
    (is eq 'objc-meta:ns-object (class-name cls))))

;; subclassing - basic

(define-test test-subclassing-basic
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (defclass test-subclass (objc-class:ns-object)
      ()
      (:metaclass objc:objc-class)))
  (let ((cls (find-class 'test-subclass)))
    (true (typep cls 'objc:objc-class))
    (true (objc-raw::class-is-meta-class (objc-raw::object-get-class (objc:objc-obj cls))))
    (is eq 'test-subclass (class-name cls))))

(define-test test-subclassing-redefine
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (defclass test-subclass (objc-class:ns-object)
      ()
      (:metaclass objc:objc-class)))
  (let ((cls (find-class 'test-subclass)))
    (true (typep cls 'objc:objc-class))
    (true (objc-raw::class-is-meta-class (objc-raw::object-get-class (objc:objc-obj cls))))
    (is eq 'test-subclass (class-name cls)))
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (defclass test-subclass (objc-class:ns-object)
      ()
      (:metaclass objc:objc-class)))
  (let ((cls (find-class 'test-subclass)))
    (true (typep cls 'objc:objc-class))
    (true (objc-raw::class-is-meta-class (objc-raw::object-get-class (objc:objc-obj cls))))
    (is eq 'test-subclass (class-name cls))))