botclient/botnetclient/lisp/ui/swing/misc/java_example_helpers.lisp

   1 ;;; java-tests.lisp
   2 ;;;
   3 ;;; Copyright (C) 2005 Peter Graves
   4 ;;; $Id: java-tests.lisp,v 1.17 2005/11/07 19:49:36 asimon Exp $
   5 ;;;
   6 ;;; This program is free software; you can redistribute it and/or
   7 ;;; modify it under the terms of the GNU General Public License
   8 ;;; as published by the Free Software Foundation; either version 2
   9 ;;; of the License, or (at your option) any later version.
  10 ;;;
  11 ;;; This program is distributed in the hope that it will be useful,
  12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with this program; if not, write to the Free Software
  18 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  19
  20 (load (merge-pathnames "test-utilities.lisp" *load-truename*))
  21
  22 (in-package #:test)
  23
  24 #+abcl
  25 (use-package '#:java)
  26
  27 #+allegro
  28 (require :jlinker)
  29 #+allegro
  30 (use-package '#:javatools.jlinker)
  31 #+allegro
  32 (use-package '#:javatools.jlinker '#:cl-user) ;; For convenience only.
  33 #+(and allegro mswindows)
  34 (use-package '#:javatools.jlinker '#:cg-user) ;; For convenience only.
  35 #+allegro
  36 (load (merge-pathnames "jl-config.cl" *load-truename*))
  37 #+allegro
  38 (or (jlinker-query) (jlinker-init))
  39
  40 #+abcl
  41 (defmacro with-registered-exception (exception condition &body body)
  42   `(unwind-protect
  43        (progn
  44          (register-java-exception ,exception ,condition)
  45          ,@body)
  46      (unregister-java-exception ,exception)))
  47
  48 #+abcl
  49 (deftest java-object.1
  50   (class-name (find-class 'java-object nil))
  51   java-object)
  52
  53 (deftest jclass.1
  54   (jcall (jmethod "java.lang.Object" "toString") (jclass "java.lang.String"))
  55   "class java.lang.String")
  56
  57 (deftest jclass.2
  58   (equal (jcall (jmethod "java.lang.Object" "getClass") "foo")
  59          (jclass "java.lang.String"))
  60   #+abcl    t
  61   #+allegro nil)
  62
  63 (deftest jclass.3
  64   (equal (jclass '|java.lang.String|) (jclass "java.lang.String"))
  65   t)
  66
  67 (deftest jclass.4
  68   (let ((class1 (jcall (jmethod "java.lang.Object" "getClass") "foo"))
  69         (class2 (jclass "java.lang.String")))
  70     (jcall (jmethod "java.lang.Object" "equals" "java.lang.Object")
  71            class1 class2))
  72   t)
  73
  74 (deftest jclass.5
  75   (jcall (jmethod "java.lang.Object" "toString") (jclass "int"))
  76   "int")
  77
  78 (deftest jclass.6
  79   (equal (jclass '|int|) (jclass "int"))
  80   t)
  81
  82 ;; No such class.
  83 (deftest jclass.error.1
  84   (signals-error (jclass "foo") 'error)
  85   t)
  86
  87 ;; Silly argument.
  88 (deftest jclass.error.2
  89   (signals-error (jclass 42) 'error)
  90   t)
  91
  92 (deftest jclass-of.1
  93   (jclass-of "foo")
  94   "java.lang.String"
  95   "java.lang.String")
  96
  97 (deftest jclass-of.2
  98   (jclass-of "foo" "java.lang.String")
  99   t
 100   "java.lang.String")
 101
 102 (deftest jclass-of.3
 103   (jclass-of "foo" "bar")
 104   nil
 105   "java.lang.String")
 106
 107 (deftest jclass-of.4
 108   (jclass-of 42)
 109   nil
 110   nil)
 111
 112 (deftest jclass-of.5
 113   (jclass-of 'foo)
 114   nil
 115   nil)
 116
 117 (deftest jclass-name.1
 118   (jclass-name "java.lang.String")
 119   "java.lang.String")
 120
 121 (deftest jclass-name.2
 122   (signals-error (jclass-name "foo") 'error)
 123   t)
 124
 125 (deftest jclass-name.3
 126   (signals-error (jclass-name 42) 'error)
 127   t)
 128
 129 (deftest jclass-name.4
 130   (jclass-name (jclass "java.lang.String"))
 131   "java.lang.String")
 132
 133 (deftest jclass-name.5
 134   (jclass-name (jclass "java.lang.String") "java.lang.String")
 135   t
 136   "java.lang.String")
 137
 138 (deftest jclass-name.6
 139   (jclass-name (jclass "java.lang.String") "java.lang.Object")
 140   nil
 141   "java.lang.String")
 142
 143 (deftest jclass-name.7
 144   (jclass-name (jclass "java.lang.String") "foo")
 145   nil
 146   "java.lang.String")
 147
 148 (deftest jclass-name.8
 149   (jclass-name (jclass "int"))
 150   "int")
 151
 152 (deftest jconstructor.1
 153   (jclass-of (jconstructor "java.lang.String" "java.lang.String"))
 154   "java.lang.reflect.Constructor"
 155   "java.lang.reflect.Constructor")
 156
 157 (deftest jnew.1
 158   (let ((constructor (jconstructor "java.lang.String" "java.lang.String")))
 159     (jclass-of (jnew constructor "foo")))
 160   "java.lang.String"
 161   "java.lang.String")
 162
 163 (deftest jnew.2
 164   (jclass-of (jnew (jconstructor "java.awt.Point")))
 165   "java.awt.Point"
 166   "java.awt.Point")
 167
 168 #-abcl
 169 (deftest jnew.3
 170   (jclass-of (jnew "java.awt.Point") "java.awt.Point")
 171   t
 172   "java.awt.Point")
 173
 174 (deftest jnew.error.1
 175   (signals-error (jnew (jconstructor "java.lang.String" "java.lang.String")
 176                        (make-immediate-object nil :ref))
 177                  #+abcl    'java-exception
 178                  #+allegro 'jlinker-error)
 179   t)
 180
 181 (deftest jcall.1
 182   (let ((method (jmethod "java.lang.String" "length")))
 183     (jcall method "test"))
 184   4)
 185
 186 (deftest jcall.2
 187   (jcall "length" "test")
 188   4)
 189
 190 (deftest jcall.3
 191   (let ((method (jmethod "java.lang.String" "regionMatches" 4)))
 192     (jcall method "test" 0 "this is a test" 10 4))
 193   t)
 194
 195 (deftest jcall.4
 196   (let ((method (jmethod "java.lang.String" "regionMatches" 5)))
 197     (jcall method "test" (make-immediate-object nil :boolean) 0 "this is a test" 10 4))
 198   t)
 199
 200 (deftest jfield.1
 201   (type-of (jfield "java.lang.Integer" "TYPE"))
 202   #+abcl    java-object
 203   #+allegro tran-struct)
 204
 205 (deftest jmethod.1
 206   (jcall (jmethod "java.lang.Object" "toString")
 207          (jmethod "java.lang.String" "substring" 1))
 208   "public java.lang.String java.lang.String.substring(int)")
 209
 210 (deftest jmethod.2
 211   (jcall (jmethod "java.lang.Object" "toString")
 212          (jmethod "java.lang.String" "substring" 2))
 213   "public java.lang.String java.lang.String.substring(int,int)")
 214
 215 (deftest jmethod.3
 216   (signals-error (jmethod "java.lang.String" "substring" 3) 'error)
 217   t)
 218
 219 #+abcl
 220 (deftest jmethod-return-type.1
 221   (jclass-name (jmethod-return-type (jmethod "java.lang.String" "length")))
 222   "int")
 223
 224 #+abcl
 225 (deftest jmethod-return-type.2
 226   (jclass-name (jmethod-return-type (jmethod "java.lang.String" "substring" 1)))
 227   "java.lang.String")
 228
 229 #+abcl
 230 (deftest jmethod-return-type.error.1
 231   (signals-error (jmethod-return-type (jclass "java.lang.String")) 'error)
 232   t)
 233
 234 #+abcl
 235 (deftest jmethod-return-type.error.2
 236   (signals-error (jmethod-return-type 42) 'error)
 237   t)
 238
 239 #+abcl
 240 (deftest define-condition.1
 241   (progn
 242     (define-condition throwable (java-exception) ())
 243     (let ((c (make-condition 'throwable)))
 244       (signals-error (simple-condition-format-control c) 'unbound-slot)))
 245   t)
 246
 247 #+abcl
 248 (deftest define-condition.2
 249   (progn
 250     (define-condition throwable (java-exception) ())
 251     (let ((c (make-condition 'throwable)))
 252       (simple-condition-format-arguments c)))
 253   nil)
 254
 255 #+abcl
 256 (deftest define-condition.3
 257   (progn
 258     (define-condition throwable (java-exception) ())
 259     (let ((c (make-condition 'throwable
 260                              :format-control "The bear is armed.")))
 261       (simple-condition-format-control c)))
 262   "The bear is armed.")
 263
 264 #+abcl
 265 (deftest define-condition.4
 266   (progn
 267     (define-condition throwable (java-exception) ())
 268     (let ((c (make-condition 'throwable
 269                              :format-control "The bear is armed.")))
 270       (simple-condition-format-arguments c)))
 271   nil)
 272
 273 #+abcl
 274 (deftest java-exception-cause.1
 275   (progn
 276     (define-condition throwable (java-exception) ())
 277     (signals-error (java-exception-cause (make-condition 'throwable))
 278                    'unbound-slot))
 279   t)
 280
 281 #+abcl
 282 (deftest java-exception-cause.2
 283   (progn
 284     (define-condition throwable (java-exception) ())
 285     (java-exception-cause (make-condition 'throwable :cause 42)))
 286   42)
 287
 288 #+abcl
 289 (deftest unregister-java-exception.1
 290   (progn
 291     (define-condition throwable (java-exception) ())
 292     (register-java-exception "java.lang.Throwable" 'throwable)
 293     (unregister-java-exception "java.lang.Throwable"))
 294   t)
 295
 296 #+abcl
 297 (deftest unregister-java-exception.2
 298   (unregister-java-exception "java.lang.Throwable")
 299   nil)
 300
 301 #+abcl
 302 (deftest register-java-exception.1
 303   (progn
 304     (define-condition throwable (java-exception) ())
 305     (with-registered-exception "java.lang.Throwable" 'throwable
 306       (signals-error
 307        (jnew (jconstructor "java.lang.String" "java.lang.String")
 308              (make-immediate-object nil :ref))
 309        'throwable)))
 310   t)
 311
 312 #+abcl
 313 (deftest register-java-exception.1a
 314   (progn
 315     (define-condition throwable (java-exception) ())
 316     (with-registered-exception "java.lang.Throwable" 'throwable
 317       (handler-case
 318           (jnew (jconstructor "java.lang.String" "java.lang.String")
 319                 (make-immediate-object nil :ref))
 320         (condition (c) (values (type-of c) (princ-to-string c))))))
 321   throwable
 322   "java.lang.NullPointerException")
 323
 324 #+abcl
 325 (deftest register-java-exception.2
 326   (progn
 327     (define-condition throwable (java-exception) ())
 328     (with-registered-exception "java.lang.Throwable" 'throwable
 329       (signals-error
 330        (jnew (jconstructor "java.lang.String" "java.lang.String") 42)
 331        'throwable)))
 332   t)
 333
 334 #+abcl
 335 ;; Behavior is non-deterministic.
 336 (deftest register-java-exception.2a
 337   (progn
 338     (define-condition throwable (java-exception) ())
 339     (with-registered-exception "java.lang.Throwable" 'throwable
 340       (handler-case
 341           (jnew (jconstructor "java.lang.String" "java.lang.String") 42)
 342         (condition (c) (let* ((s (princ-to-string c)))
 343                          ;; The actual string returned by Throwable.getMessage()
 344                          ;; is either "argument type mismatch" or something
 345                          ;; like "java.lang.ClassCastException@9d0366".
 346                          (or (string= s "argument type mismatch")
 347                              (and (> (length s) (length "java.lang.ClassCastException"))
 348                                   (string= (subseq s 0 (length "java.lang.ClassCastException"))
 349                                            "java.lang.ClassCastException"))))))))
 350   t)
 351
 352 #+abcl
 353 (deftest register-java-exception.3
 354   (progn
 355     (define-condition throwable (java-exception) ())
 356     (with-registered-exception "java.lang.Throwable" 'throwable
 357       (signals-error
 358        (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
 359        'throwable)))
 360   t)
 361
 362 #+abcl
 363 ;; Behavior is non-deterministic.
 364 (deftest register-java-exception.3a
 365   (progn
 366     (define-condition throwable (java-exception) ())
 367     (with-registered-exception "java.lang.Throwable" 'throwable
 368       (handler-case
 369           (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
 370         (condition (c) (let ((s (princ-to-string c)))
 371                          (or (string= s "argument type mismatch")
 372                              (string= s "java.lang.IllegalArgumentException")))))))
 373   t)
 374
 375 #+abcl
 376 (deftest register-java-exception.4
 377   (progn
 378     (define-condition throwable (java-exception) ())
 379     (define-condition illegal-argument-exception (java-exception) ())
 380     (with-registered-exception "java.lang.Throwable" 'throwable
 381       (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
 382         (signals-error
 383          (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
 384          'throwable))))
 385   nil)
 386
 387 #+abcl
 388 (deftest register-java-exception.5
 389   (progn
 390     (define-condition throwable (java-exception) ())
 391     (define-condition illegal-argument-exception (java-exception) ())
 392     (with-registered-exception "java.lang.Throwable" 'throwable
 393       (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
 394         (signals-error
 395          (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
 396          'illegal-argument-exception))))
 397   t)
 398
 399
 400 #+abcl
 401 (deftest register-java-exception.6
 402   (progn
 403     (define-condition foo () ())
 404     (register-java-exception "java.lang.Throwable" 'foo))
 405   nil)
 406
 407 #+abcl
 408 (deftest register-java-exception.7
 409   (progn
 410     (define-condition throwable (java-exception) ())
 411     (register-java-exception "java.lang.Throwable" 'throwable))
 412   t)
 413
 414 #+abcl
 415 (deftest register-java-exception.8
 416   (progn
 417     (define-condition throwable (java-exception) ())
 418     (with-registered-exception "java.lang.Throwable" 'throwable
 419       (define-condition throwable () ())
 420       (signals-error
 421        (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
 422        'java-exception)))
 423   t)
 424
 425 #+abcl
 426 (deftest register-java-exception.9
 427   (progn
 428     (define-condition throwable (java-exception) ())
 429     (define-condition illegal-argument-exception (throwable) ())
 430     (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
 431       (signals-error
 432        (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
 433        'illegal-argument-exception)))
 434   t)
 435
 436 (do-tests)
 437
 438 ;;#+allegro
 439 ;;(jlinker-end)