Changeset 10357


Ignore:
Timestamp:
11/04/05 20:07:15 (16 years ago)
Author:
piso
Message:

Work in progress.

Location:
trunk/j/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/Java.java

    r10277 r10357  
    33 *
    44 * Copyright (C) 2002-2005 Peter Graves, Andras Simon
    5  * $Id: Java.java,v 1.63 2005-10-29 19:04:40 asimon Exp $
     5 * $Id: Java.java,v 1.64 2005-11-04 20:06:58 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2929import java.lang.reflect.Modifier;
    3030import java.util.Map;
    31 import java.util.WeakHashMap;
     31import java.util.HashMap;
    3232
    3333public final class Java extends Lisp
    3434{
    35     private static final Map registeredExceptions = new WeakHashMap();
     35    private static final Map registeredExceptions = new HashMap();
    3636
    3737    // ### register-java-exception exception-name condition-symbol => T
     
    6565    };
    6666
    67 
    6867    private static Symbol getCondition(Class cl) throws ConditionThrowable
    6968    {
     
    7978    private static final Primitive JCLASS =
    8079        new Primitive(Symbol.JCLASS, "name-or-class-ref",
    81                       "Returns a reference to the Java class designated by NAME-OR-CLASS-REF.")
     80"Returns a reference to the Java class designated by NAME-OR-CLASS-REF.")
    8281    {
    8382        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    368367                Class tClass = t.getClass();
    369368                Symbol condition = getCondition(t.getClass());
    370                 if (condition == null) 
     369                if (condition == null)
    371370                    signal(new JavaException(t));
    372371                else
     
    379378
    380379    // ### jnew constructor &rest args
    381     private static final Primitive JNEW = new Primitive("jnew", PACKAGE_JAVA, true,
    382                                                         "constructor &rest args")
     380    private static final Primitive JNEW =
     381        new Primitive("jnew", PACKAGE_JAVA, true, "constructor &rest args")
    383382    {
    384383        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    402401            }
    403402            catch (Throwable t) {
    404                 if (t instanceof InvocationTargetException) 
     403                if (t instanceof InvocationTargetException)
    405404                    t = t.getCause();
    406405                Symbol condition = getCondition(t.getClass());
    407                 if (condition == null) 
     406                if (condition == null)
    408407                    signal(new JavaException(t));
    409408                else
     
    439438    };
    440439
    441     // ### jarray-ref
    442     // jarray-ref java-array &rest indices
    443     private static final Primitive JARRAY_REF = new Primitive("jarray-ref", PACKAGE_JAVA, true,
    444                                                               "java-array &rest indices")
     440    // ### jarray-ref java-array &rest indices
     441    private static final Primitive JARRAY_REF =
     442        new Primitive("jarray-ref", PACKAGE_JAVA, true,
     443                      "java-array &rest indices")
    445444    {
    446445        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    450449    };
    451450
    452     // ### jarray-ref-raw
    453     // jarray-ref-raw java-array &rest indices
    454     private static final Primitive JARRAY_REF_RAW = new Primitive("jarray-ref-raw", PACKAGE_JAVA, true,
    455                                                                   "java-array &rest indices")
     451    // ### jarray-ref-raw java-array &rest indices
     452    private static final Primitive JARRAY_REF_RAW =
     453        new Primitive("jarray-ref-raw", PACKAGE_JAVA, true,
     454                      "java-array &rest indices")
    456455    {
    457456        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    468467                Class tClass = t.getClass();
    469468                Symbol condition = getCondition(t.getClass());
    470                 if (condition == null) 
     469                if (condition == null)
    471470                    signal(new JavaException(t));
    472471                else
     
    478477    };
    479478
    480     // ### jarray-set
    481     // jarray-set java-array new-value &rest indices
    482     private static final Primitive JARRAY_SET = new Primitive("jarray-set", PACKAGE_JAVA, true,
    483                                                               "java-array new-value &rest indices")
     479    // ### jarray-set java-array new-value &rest indices
     480    private static final Primitive JARRAY_SET =
     481        new Primitive("jarray-set", PACKAGE_JAVA, true,
     482                      "java-array new-value &rest indices")
    484483    {
    485484        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    498497                Class tClass = t.getClass();
    499498                Symbol condition = getCondition(t.getClass());
    500                 if (condition == null) 
     499                if (condition == null)
    501500                    signal(new JavaException(t));
    502501                else
     
    577576        catch (Throwable t) {
    578577            Symbol condition = getCondition(t.getClass());
    579             if (condition == null) 
     578            if (condition == null)
    580579                signal(new JavaException(t));
    581580            else
     
    753752    private static final String getMessage(Throwable t)
    754753    {
    755         if (t instanceof InvocationTargetException) {
    756             try {
    757                 Method method =
    758                     Throwable.class.getMethod("getCause", new Class[0]);
    759                 if (method != null) {
    760                     Throwable cause = (Throwable) method.invoke(t,
    761                                                                 new Object[0]);
    762                     if (cause != null)
    763                         t = cause;
    764                 }
    765             }
    766             catch (NoSuchMethodException e) {
    767                 Debug.trace(e);
    768             }
    769             catch (Exception e) {
    770                 Debug.trace(e);
    771             }
    772         }
    773754        String message = t.getMessage();
    774755        if (message == null || message.length() == 0)
  • trunk/j/src/org/armedbear/lisp/tests/java-tests.lisp

    r10288 r10357  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: java-tests.lisp,v 1.14 2005-10-30 12:37:11 piso Exp $
     4;;; $Id: java-tests.lisp,v 1.15 2005-11-04 20:07:15 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1818;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1919
    20 (load "test-utilities.lisp")
     20(load (merge-pathnames "test-utilities.lisp" *load-truename*))
    2121
    2222(in-package #:test)
     
    3434(use-package '#:javatools.jlinker '#:cg-user) ;; For convenience only.
    3535#+allegro
    36 (load "jl-config.cl")
     36(load (merge-pathnames "jl-config.cl" *load-truename*))
    3737#+allegro
    3838(or (jlinker-query) (jlinker-init))
     
    4242  `(unwind-protect
    4343       (progn
    44          (java:register-java-exception ,exception ,condition)
     44         (register-java-exception ,exception ,condition)
    4545         ,@body)
    46     (java:unregister-java-exception ,exception)))
     46     (unregister-java-exception ,exception)))
    4747
    4848#+abcl
     
    251251  nil)
    252252
    253 
    254 
    255253#+abcl
    256254(deftest register-java-exception.1
     
    265263
    266264#+abcl
     265(deftest register-java-exception.1a
     266  (progn
     267    (define-condition throwable (java-exception) ())
     268    (with-registered-exception "java.lang.Throwable" 'throwable
     269      (handler-case
     270          (jnew (jconstructor "java.lang.String" "java.lang.String")
     271                (make-immediate-object nil :ref))
     272        (condition (c) (values (type-of c) (princ-to-string c))))))
     273  throwable
     274  "java.lang.NullPointerException")
     275
     276#+abcl
    267277(deftest register-java-exception.2
    268278  (progn
     
    275285
    276286#+abcl
     287;; Behavior is non-deterministic.
     288(deftest register-java-exception.2a
     289  (progn
     290    (define-condition throwable (java-exception) ())
     291    (with-registered-exception "java.lang.Throwable" 'throwable
     292      (handler-case
     293          (jnew (jconstructor "java.lang.String" "java.lang.String") 42)
     294        (condition (c) (let* ((s (princ-to-string c)))
     295                         ;; The actual string returned by Throwable.getMessage()
     296                         ;; is either "argument type mismatch" or something
     297                         ;; like "java.lang.ClassCastException@9d0366".
     298                         (or (string= s "argument type mismatch")
     299                             (and (> (length s) (length "java.lang.ClassCastException"))
     300                                  (string= (subseq s 0 (length "java.lang.ClassCastException"))
     301                                           "java.lang.ClassCastException"))))))))
     302  t)
     303
     304#+abcl
    277305(deftest register-java-exception.3
    278306  (progn
     
    282310       (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
    283311       'throwable)))
     312  t)
     313
     314#+abcl
     315;; Behavior is non-deterministic.
     316(deftest register-java-exception.3a
     317  (progn
     318    (define-condition throwable (java-exception) ())
     319    (with-registered-exception "java.lang.Throwable" 'throwable
     320      (handler-case
     321          (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
     322        (condition (c) (let ((s (princ-to-string c)))
     323                         (or (string= s "argument type mismatch")
     324                             (string= s "java.lang.IllegalArgumentException")))))))
    284325  t)
    285326
Note: See TracChangeset for help on using the changeset viewer.