suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Bringing up to v4 require specs and tool interface.

Browse Source 
NOTE: testing window is NOT working yet.

svn: r8157
This commit is contained in:
Kathy Gray 2007-12-29 19:39:25 +00:00
parent 643a19d01b
commit 3549e55d5a
5 changed files with 57 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/profj/build-info.ss
View File

@ -45,7 +45,7 @@
(htdch-lib?
`(lib ,name "htdch" ,@(if scheme? (cdddr path) path)))
(scheme-lib? `(lib ,name ,@(cddr path)))
((and local? (not (to-file))) name)
((and local? (not (to-file))) `(quote ,name))
(else `(file ,(path->string (build-path dir name)))))))
(make-name (lambda ()
(let ((n (if scheme? (java-name->scheme name) name)))

82
collects/profj/comb-parsers/parser-units.scm
View File

@ -22,47 +22,47 @@
(define (output-map x)
#;(!!! (printf "in output-map ~a~n" x))
(!!! (when (position-token? x)
(set! x (position-token-token x))))
(!!! (case (token-name x)
[(PIPE) "|"]
[(OR) "||"]
[(OREQUAL) "|="]
[(EQUAL) "="]
[(GT) ">"]
[(LT) "<"]
[(LTEQ) "<="]
[(GTEQ) ">="]
[(PLUS) "+"]
[(MINUS) "-"]
[(TIMES) "*"]
[(DIVIDE) "/"]
[(^T) "^"]
[(O_PAREN) "("]
[(C_PAREN) ")"]
[(O_BRACE) "{"]
[(C_BRACE) "}"]
[(O_BRACKET) "["]
[(C_BRACKET) "]"]
[(SEMI_COLON) ";"]
[(PERIOD) "."]
[(COMMA) ","]
[(NULL_LIT) "null"]
[(TRUE_LIT) "true"]
[(FALSE_LIT) "false"]
[(EOF) "end of input"]
[(caseT) "case"]
[(doT) "do"]
[(elseT) "else"]
[(ifT) "if"]
[(voidT) "void"]
[(STRING_LIT) (format "\"~a\"" (token-value x))]
[(CHAR_LIT) (format "'~a'" (token-value x))]
[(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT
HEX_LIT OCT_LIT HEXL_LIT OCTL_LIT) (token-value x)]
[(IDENTIFIER) (format "identifier ~a" (token-value x))]
[(STRING_ERROR) (format "misformatted string ~a" (token-value x))]
[else (token-name x)])))
(! (when (position-token? x)
(set! x (position-token-token x))))
(! (case (token-name x)
[(PIPE) "|"]
[(OR) "||"]
[(OREQUAL) "|="]
[(EQUAL) "="]
[(GT) ">"]
[(LT) "<"]
[(LTEQ) "<="]
[(GTEQ) ">="]
[(PLUS) "+"]
[(MINUS) "-"]
[(TIMES) "*"]
[(DIVIDE) "/"]
[(^T) "^"]
[(O_PAREN) "("]
[(C_PAREN) ")"]
[(O_BRACE) "{"]
[(C_BRACE) "}"]
[(O_BRACKET) "["]
[(C_BRACKET) "]"]
[(SEMI_COLON) ";"]
[(PERIOD) "."]
[(COMMA) ","]
[(NULL_LIT) "null"]
[(TRUE_LIT) "true"]
[(FALSE_LIT) "false"]
[(EOF) "end of input"]
[(caseT) "case"]
[(doT) "do"]
[(elseT) "else"]
[(ifT) "if"]
[(voidT) "void"]
[(STRING_LIT) (format "\"~a\"" (token-value x))]
[(CHAR_LIT) (format "'~a'" (token-value x))]
[(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT
HEX_LIT OCT_LIT HEXL_LIT OCTL_LIT) (token-value x)]
[(IDENTIFIER) (format "identifier ~a" (token-value x))]
[(STRING_ERROR) (format "misformatted string ~a" (token-value x))]
[else (token-name x)])))
(define (java-keyword? t)
(memq t `(? this super new instanceof while try throw synchronized switch return ifT goto for finally

2
collects/profj/parser.ss
View File

@ -1,4 +1,4 @@
#cs
(module parser mzscheme
(require "parsers/full-parser.ss"
"parsers/advanced-parser.ss"

3
collects/profj/tester.scm
View File

@ -192,6 +192,7 @@
(init-field (current-tab #f))
(define/public (pop-up-window test-results)
(when (and drscheme-frame current-tab)
(let* ((curr-win (send current-tab get-test-window))
(window
(if curr-win
@ -217,7 +218,7 @@
(if (get-preference 'profj:test-window:docked?
(lambda () (put-preferences '(profj:test-window:docked?) '(#f)) #f))
(send drscheme-frame display-test-panel content)
(send window show #t))))
(send window show #t)))))
(define/private (fill-in editor test-results)
(let-values (((tested-classes covered nearly-tested-classes total-tests

21
collects/profj/tool.ss
View File

@ -596,7 +596,7 @@
(let ((end? (eof-object? (peek-char-or-special port))))
(if end?
eof
(datum->syntax #f `(parse-java-full-program ,(parse port name level)
(datum->syntax #f `(parse-java-full-program ,(parse port (quote name) level)
,name) #f)))))))
(define/public (front-end/interaction port settings)
(mred? #t)
@ -769,7 +769,7 @@
(syntax-case exp (parse-java-full-program parse-java-interactions)
((parse-java-full-program ex s)
(let ((exp (old-current-eval (syntax ex)))
(src (old-current-eval (syntax s))))
(src (old-current-eval (syntax (quote s)))))
(execution? #t)
(set! execute-types (create-type-record))
(let* ((compilation-units (compile-ast exp level execute-types))
@ -825,7 +825,7 @@
(require?
(old-current-eval
(syntax-as-top (with-syntax ([name name-to-require])
(syntax (require name)))))
(syntax (require (quote name))))))
(loop mods extras #f))
(else
(let-values (((name syn) (get-module-name (expand (car mods)))))
@ -1031,12 +1031,14 @@
(define (java-comment-box-mixin %)
(class %
(inherit get-special-menu get-edit-target-object register-capability-menu-item)
(inherit
get-insert-menu
get-special-menu get-edit-target-object register-capability-menu-item)
(super-new)
(new menu-item%
(label (string-constant profj-insert-java-comment-box))
(parent (get-special-menu))
(parent (get-insert-menu))
(callback
(lambda (menu event)
(let ([c-box (new java-comment-box%)]
@ -1046,7 +1048,7 @@
(demand-callback
(lambda (mi)
(send mi enable ((get-edit-target-object) . is-a? . text%)))))
(register-capability-menu-item 'profj:special:java-comment-box (get-special-menu))
(register-capability-menu-item 'profj:special:java-comment-box (get-insert-menu))
))
(drscheme:get/extend:extend-unit-frame java-comment-box-mixin)
@ -1134,19 +1136,20 @@
(define (java-interactions-box-mixin %)
(class %
(inherit get-special-menu get-edit-target-object register-capability-menu-item)
(inherit get-insert-menu
get-special-menu get-edit-target-object register-capability-menu-item)
(super-new)
(new menu-item%
(label (string-constant profj-insert-java-interactions-box))
(parent (get-special-menu))
(parent (get-insert-menu))
(callback
(lambda (menu event)
(let ([i-box (new java-interactions-box%)]
[text (get-edit-target-object)])
(send text insert i-box)
(send text set-caret-owner i-box 'global)))))
(register-capability-menu-item 'profj:special:java-interactions-box (get-special-menu))
(register-capability-menu-item 'profj:special:java-interactions-box (get-insert-menu))
))
(drscheme:get/extend:extend-definitions-text defs-text-mixin)