From 9c4eaa2c229a7d9749c8db0988187fc8de191827 Mon Sep 17 00:00:00 2001
From: Kathy Gray <kathryn.gray@cl.cam.ac.uk>
Date: Wed, 3 Sep 2008 15:11:06 +0000
Subject: [PATCH] bug correction

svn: r11531
---
 collects/profj/libs/java/runtime.ss | 10 +++++-----
 collects/profj/to-scheme.ss         |  4 +---
 collects/profj/tool.ss              | 15 ++++++++-------
 collects/test-engine/java-tests.scm |  2 +-
 4 files changed, 15 insertions(+), 16 deletions(-)

diff --git a/collects/profj/libs/java/runtime.ss b/collects/profj/libs/java/runtime.ss
index 2573757326..8d97144baa 100644
--- a/collects/profj/libs/java/runtime.ss
+++ b/collects/profj/libs/java/runtime.ss
@@ -69,29 +69,29 @@
           ((or) (or left right)))))
 
   ;divide-dynamic: number number -> number
-  (define (divide-dynamic left right)
+  (define (divide-dynamic left right marks)
     (if (or (inexact? left) (inexact? right))
         (divide-float left right)
         (divide-int left right)))
   
   ;divide-int: int int -> int
-  (define (divide-int left right)
+  (define (divide-int left right marks)
     (when (zero? right)
       (raise (create-java-exception ArithmeticException
                                     "Illegal division by zero"
                                     (lambda (exn msg)
                                       (send exn ArithmeticException-constructor-java.lang.String msg))
-                                    (current-continuation-marks))))
+                                    marks)))
     (quotient left right))
   
   ;divide-float: float float -> float
-  (define (divide-float left right)
+  (define (divide-float left right marks)
     (when (zero? right)
       (raise (create-java-exception ArithmeticException
                                     "Illegal division by zero"
                                     (lambda (exn msg)
                                       (send exn ArithmeticException-constructor-java.lang.String msg))
-                                    (current-continuation-marks))))
+                                    marks)))
     (if (and (exact? left) (exact? right))
         (exact->inexact (/ left right))
         (/ left right)))
diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss
index 03b6b05d1a..ec95eed124 100644
--- a/collects/profj/to-scheme.ss
+++ b/collects/profj/to-scheme.ss
@@ -2026,7 +2026,6 @@
                                 (lambda () (error 'descendent-Runtime "Internal Error: class record is not in table")))))
         (member `("java" "lang" "RuntimeException") (class-record-parents class-record)))))
   
-  ;Converted
   ;translate-switch: syntax (list CaseStatements) src type-records -> syntax
   (define translate-switch
     (lambda (expr cases src type-recs)
@@ -2042,7 +2041,6 @@
                              cases))
                    (build-src src))))
   
-  ;Converted
   ;translate-block: (list (U Statement (U var-decl var-init))) src type-recs -> syntax
   (define translate-block
     (lambda (statements src type-recs)
@@ -2414,7 +2412,7 @@
                          'javaRuntime:divide-dynamic)
                         (else
                          'javaRuntime:divide-int))))
-                 (make-syntax #f `(,(create-syntax #f div-op key-src) ,left ,right) source)))
+                 (make-syntax #f `(,(create-syntax #f div-op key-src) ,left ,right (current-continuation-marks)) source)))
               ((%) (make-syntax #f `(,(create-syntax #f 'javaRuntime:mod key-src) ,left ,right) source))
               ;Shift operations
               ((<< >> >>>) 
diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss
index cd5ce670ee..a7acb520bc 100644
--- a/collects/profj/tool.ss
+++ b/collects/profj/tool.ss
@@ -760,7 +760,7 @@
                         (set! compiled? #t)
                         (set! modules (order compilation-units))
                         (when rep (send rep set-user-types execute-types))
-                        (set! extras (process-extras (send execute-types get-interactions-boxes) execute-types))
+                        #;(set! extras (process-extras (send execute-types get-interactions-boxes) execute-types))
                         (set! tests examples))
                       (datum->syntax #f '(void) #f)]
                      [else
@@ -836,15 +836,16 @@
                     eof
                     (begin
                       (set! executed? #t)
-                      (syntax-as-top
-                       (compile-interactions-ast 
-                        (parse-interactions port name level)
-                        name level types  #t)
-                       
+                      (errortrace-annotate 
+                       (syntax-as-top
+                         (compile-interactions-ast 
+                          (parse-interactions port name level)
+                          name level types  #t)
+                        
                        #;(datum->syntax
                         #f
                         `(parse-java-interactions ,(parse-interactions port name level) ,name)
-                        #f)))))))
+                        #f))))))))
           (define/public (front-end/finished-complete-program settings) (void))
           
           (define (get-defn-editor port-name)
diff --git a/collects/test-engine/java-tests.scm b/collects/test-engine/java-tests.scm
index 1f039d794f..81ef2bfc69 100644
--- a/collects/test-engine/java-tests.scm
+++ b/collects/test-engine/java-tests.scm
@@ -174,7 +174,7 @@
       (when current-testcase
         (set-tc-stat-checks!
          current-testcase
-         (cons (make-failed-check src msg)
+         (cons (make-failed-check src msg exn)
                (tc-stat-checks current-testcase))))
       (inner (void) check-failed msg src exn))