Commit 86dcc1fe authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Fixed bug with last nil value in expression progn (thanks to Daniel Gackle for the bug report)

parent ea299916
(in-package #:parenscript)
(in-readtable :parenscript)
(defparameter %compiling-reserved-forms-p% t
"Used to issue warnings when replacing PS special operators or macros.")
......
(in-package #:parenscript)
(in-readtable :parenscript)
(define-condition simple-style-warning (simple-condition style-warning)
())
......
(in-package #:parenscript)
(in-readtable :parenscript)
(macrolet ((define-trivial-mappings (&rest mappings)
`(progn
......
(in-package #:parenscript)
(in-readtable :parenscript)
(defvar *obfuscated-packages* (make-hash-table))
......
(in-package #:parenscript)
(in-readtable :parenscript)
;;; PS operators and macros that aren't present in the Common Lisp
;;; standard but exported by Parenscript, and their Common Lisp
......@@ -17,6 +18,8 @@
delete ps-js:delete
in ps-js:in ;; maybe rename to slot-boundp?
break ps-js:break
<< ps-js:<<
>> ps-js:>>
)
;; Common Lisp Hyperspec, 11.1.2.1.2
......
(in-package #:parenscript)
(in-readtable :parenscript)
(defvar *ps-print-pretty* t)
(defvar *indent-num-spaces* 4)
......
(in-package #:parenscript)
(in-readtable :parenscript)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; arithmetic and logic
......@@ -16,9 +17,6 @@
logior ps-js:\|
logxor ps-js:^
lognot ps-js:~
;; << and >> are not exported, but for use by ash macro
<< ps-js:<<
>> ps-js:>>
throw ps-js:throw
aref ps-js:aref
......@@ -93,17 +91,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; blocks and control flow
(defun flatten-blocks (body)
(when body
(if (and (listp (car body)) (eq 'ps-js:block (caar body)))
(append (cdr (car body)) (flatten-blocks (cdr body)))
(cons (car body) (flatten-blocks (cdr body))))))
(defun compile-progn (body)
(labels ((flatten-blocks (body)
(when body
(if (and (listp (car body)) (eq 'ps-js:block (caar body)))
(append (cdr (car body)) (flatten-blocks (cdr body)))
(cons (car body) (flatten-blocks (cdr body)))))))
(let ((block (flatten-blocks (remove nil (mapcar #'ps-compile body)))))
(append (remove-if #'constantp (butlast block))
(unless (and (eq *compilation-level* :toplevel)
(not (car (last block))))
(last block))))))
(let ((block (flatten-blocks (mapcar #'ps-compile body))))
(append (remove-if #'constantp (butlast block))
(unless (and (or (eq *compilation-level* :toplevel)
(not compile-expression?))
(not (car (last block))))
(last block)))))
(define-expression-operator progn (&rest body)
(if (cdr body)
......
......@@ -292,8 +292,8 @@ _js2.style.left = _js1;")
(test-ps-js nil-block-return-1
(block nil (return))
"nilblock: {
break nilblock;
"nilBlock: {
break nilBlock;
};")
(test-ps-js single-argument-statements-2
......@@ -2538,8 +2538,8 @@ foo = 3;")
(test-ps-js explicit-nil-block
(block nil (return) (+ 1 2))
"nilblock: {
break nilblock;
"nilBlock: {
break nilBlock;
1 + 2;
};")
......@@ -2561,14 +2561,14 @@ foo = 3;")
(test-ps-js block-dynamic-return
(block nil ((lambda () (return))) (+ 1 2))
"nilblock: {
"nilBlock: {
try {
(function () {
throw { 'ps-block-tag' : 'nilblock', 'ps-return-value' : null };
throw { 'ps-block-tag' : 'nilBlock', 'ps-return-value' : null };
})();
1 + 2;
} catch (err) {
if (err && 'nilblock' === err['ps-block-tag']) {
if (err && 'nilBlock' === err['ps-block-tag']) {
err['ps-return-value'];
} else {
throw err;
......@@ -2594,3 +2594,14 @@ foo = 3;")
(test-ps-js simple-ash
(+ (ash 4 1) (ash 4 -1))
"(4 << 1) + (4 >> 1);")
(test-ps-js progn-nil-expression
(bar (progn (foo) nil))
"bar((foo(), null));")
(test-ps-js other-progn-nil-exp
(defun blah ()
(or (foo) (progn (bar) nil)))
"function blah() {
return foo() || (bar(), null);
};")
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment