fix JuliaLang#28244, segfault on @macroexpand with macro returning …

…an invalid expr (JuliaLang#28247)

src/ast.c

@@ -1121,7 +1121,7 @@ JL_DLLEXPORT jl_value_t *jl_macroexpand(jl_value_t *expr, jl_module_t *inmodule)
  JL_GC_PUSH1(&expr);
  expr = jl_copy_ast(expr);
  expr = jl_expand_macros(expr, inmodule, NULL, 0);
- expr = jl_call_scm_on_ast("julia-expand-macroscope", expr, inmodule);
+ expr = jl_call_scm_on_ast("jl-expand-macroscope", expr, inmodule);
  JL_GC_POP();
  return expr;
 }
@@ -1132,7 +1132,7 @@ JL_DLLEXPORT jl_value_t *jl_macroexpand1(jl_value_t *expr, jl_module_t *inmodule
  JL_GC_PUSH1(&expr);
  expr = jl_copy_ast(expr);
  expr = jl_expand_macros(expr, inmodule, NULL, 1);
- expr = jl_call_scm_on_ast("julia-expand-macroscope", expr, inmodule);
+ expr = jl_call_scm_on_ast("jl-expand-macroscope", expr, inmodule);
  JL_GC_POP();
  return expr;
 }

src/jlfrontend.scm

@@ -8,9 +8,9 @@
 (load "julia-syntax.scm")
 
 
-;; exception handler for parser. turns known errors into special expressions,
-;; and prevents throwing an exception past a C caller.
-(define (parser-wrap thk)
+;; exception handler to turn known errors into special expressions,
+;; to prevent throwing an exception past a C caller.
+(define (error-wrap thk)
  (with-exception-catcher
  (lambda (e)
  (if (and (pair? e) (eq? (car e) 'error))
@@ -158,42 +158,42 @@
 (define (jl-parse-one-string s pos0 greedy)
  (let ((inp (open-input-string s)))
  (io.seek inp pos0)
- (let ((expr (parser-wrap (lambda ()
-  (if greedy
-  (julia-parse inp)
-  (julia-parse inp parse-atom))))))
+ (let ((expr (error-wrap (lambda ()
+ (if greedy
+ (julia-parse inp)
+ (julia-parse inp parse-atom))))))
  (cons expr (io.pos inp)))))
 
 (define (jl-parse-string s filename)
  (with-bindings ((current-filename (symbol filename)))
- (parser-wrap (lambda ()
- (let ((inp (make-token-stream (open-input-string s))))
- ;; parse all exprs into a (toplevel ...) form
- (let loop ((exprs '()))
- ;; delay expansion so macros run in the Task executing
- ;; the input, not the task parsing it (issue #2378)
- ;; used to be (expand-toplevel-expr expr)
- (let ((expr (julia-parse inp)))
- (if (eof-object? expr)
- (cond ((null? exprs) expr)
- ((length= exprs 1) (car exprs))
- (else (cons 'toplevel (reverse! exprs))))
- (if (and (pair? expr) (eq? (car expr) 'toplevel))
- (loop (nreconc (cdr expr) exprs))
- (loop (cons expr exprs)))))))))))
+ (error-wrap (lambda ()
+  (let ((inp (make-token-stream (open-input-string s))))
+  ;; parse all exprs into a (toplevel ...) form
+  (let loop ((exprs '()))
+  ;; delay expansion so macros run in the Task executing
+  ;; the input, not the task parsing it (issue #2378)
+  ;; used to be (expand-toplevel-expr expr)
+  (let ((expr (julia-parse inp)))
+  (if (eof-object? expr)
+  (cond ((null? exprs) expr)
+  ((length= exprs 1) (car exprs))
+  (else (cons 'toplevel (reverse! exprs))))
+  (if (and (pair? expr) (eq? (car expr) 'toplevel))
+  (loop (nreconc (cdr expr) exprs))
+  (loop (cons expr exprs)))))))))))
 
 (define (jl-parse-all io filename)
  (unwind-protect
  (with-bindings ((current-filename (symbol filename)))
  (let ((stream (make-token-stream io)))
  (let loop ((exprs '()))
- (let ((lineno (parser-wrap
+ (let ((lineno (error-wrap
  (lambda ()
  (skip-ws-and-comments (ts:port stream))
  (input-port-line (ts:port stream))))))
  (if (pair? lineno)
  (cons 'toplevel (reverse! (cons lineno exprs)))
- (let ((expr (parser-wrap
+ (let ((expr (error-wrap
  (lambda ()
  (julia-parse stream)))))
  (if (eof-object? expr)
@@ -221,14 +221,18 @@
 
 ; expand a piece of raw surface syntax to an executable thunk
 (define (jl-expand-to-thunk expr)
- (parser-wrap (lambda ()
-  (expand-toplevel-expr expr))))
+ (error-wrap (lambda ()
+ (expand-toplevel-expr expr))))
 
 (define (jl-expand-to-thunk-stmt expr)
  (jl-expand-to-thunk (if (toplevel-only-expr? expr)
  expr
  `(block ,expr (null)))))
 
+(define (jl-expand-macroscope expr)
+ (error-wrap (lambda ()
+ (julia-expand-macroscope expr))))
+
 ; run whole frontend on a string. useful for testing.
 (define (fe str)
  (expand-toplevel-expr (julia-parse str)))

src/macroexpand.scm

@@ -353,19 +353,22 @@
  (cdr e)))))
 
  ((kw)
- (if (and (pair? (cadr e))
- (eq? (caadr e) '|::|))
- `(kw (|::|
- ,(if inarg
- (resolve-expansion-vars- (cadr (cadr e)) env m parent-scope inarg)
- ;; in keyword arg A=B, don't transform "A"
- (unescape (cadr (cadr e))))
- ,(resolve-expansion-vars- (caddr (cadr e)) env m parent-scope inarg))
- ,(resolve-expansion-vars- (caddr e) env m parent-scope inarg))
- `(kw ,(if inarg
- (resolve-expansion-vars- (cadr e) env m parent-scope inarg)
- (unescape (cadr e)))
- ,(resolve-expansion-vars- (caddr e) env m parent-scope inarg))))
+ (cond
+ ((not (length> e 2)) e)
+ ((and (pair? (cadr e))
+ (eq? (caadr e) '|::|))
+ `(kw (|::|
+ ,(if inarg
+ (resolve-expansion-vars- (cadr (cadr e)) env m parent-scope inarg)
+ ;; in keyword arg A=B, don't transform "A"
+ (unescape (cadr (cadr e))))
+ ,(resolve-expansion-vars- (caddr (cadr e)) env m parent-scope inarg))
+ ,(resolve-expansion-vars- (caddr e) env m parent-scope inarg)))
+ (else
+ `(kw ,(if inarg
+ (resolve-expansion-vars- (cadr e) env m parent-scope inarg)
+ (unescape (cadr e)))
+ ,(resolve-expansion-vars- (caddr e) env m parent-scope inarg)))))
 
  ((let)
  (let* ((newenv (new-expansion-env-for e env))
@@ -505,22 +508,22 @@
  (cond
  ((or (not (pair? e)) (quoted? e)) e)
  ((eq? (car e) 'hygienic-scope)
-  (let ((parent-scope (list relabels parent-scope))
-  (body (cadr e))
-  (m (caddr e)))
- `(hygienic-scope ,(rename-symbolic-labels- (cadr e) (table) parent-scope) ,m)))
+ (let ((parent-scope (list relabels parent-scope))
+ (body (cadr e))
+ (m (caddr e)))
+  `(hygienic-scope ,(rename-symbolic-labels- (cadr e) (table) parent-scope) ,m)))
  ((and (eq? (car e) 'escape) (not (null? parent-scope)))
-  `(escape ,(apply rename-symbolic-labels- (cadr e) parent-scope)))
+ `(escape ,(apply rename-symbolic-labels- (cadr e) parent-scope)))
  ((or (eq? (car e) 'symbolicgoto) (eq? (car e) 'symboliclabel))
  (let* ((s (cadr e))
  (havelabel (if (or (null? parent-scope) (not (symbol? s))) s (get relabels s #f)))
  (newlabel (if havelabel havelabel (named-gensy s))))
  (if (not havelabel) (put! relabels s newlabel))
  `(,(car e) ,newlabel)))
  (else
-  (cons (car e)
-  (map (lambda (x) (rename-symbolic-labels- x relabels parent-scope))
-  (cdr e))))))
+ (cons (car e)
+ (map (lambda (x) (rename-symbolic-labels- x relabels parent-scope))
+ (cdr e))))))
 
 (define (rename-symbolic-labels e)
  (rename-symbolic-labels- e (table) '()))
@@ -530,12 +533,12 @@
 ;; TODO: delete this file and fold this operation into resolve-scopes
 (define (julia-expand-macroscope e)
  (julia-expand-macroscopes-
-  (rename-symbolic-labels
-  (julia-expand-quotes e))))
+ (rename-symbolic-labels
+ (julia-expand-quotes e))))
 
 (define (contains-macrocall e)
  (and (pair? e)
- (contains (lambda (e) (and (pair? e) (eq? (car e) 'macrocall))) e)))
+  (contains (lambda (e) (and (pair? e) (eq? (car e) 'macrocall))) e)))
 
 (define (julia-bq-macro x)
  (julia-bq-expand x 0))

test/syntax.jl

@@ -1570,3 +1570,12 @@ begin
  Val{code28044} where code28044
 end
 @test f28044(Val(identity)) == 2
+
+# issue #28244
+macro foo28244(sym)
+ x = :(bar())
+ push!(x.args, Expr(sym))
+ x
+end
+@test (@macroexpand @foo28244(kw)) == Expr(:call, GlobalRef(@__MODULE__,:bar), Expr(:kw))
+@test eval(:(@macroexpand @foo28244($(Symbol("let"))))) == Expr(:error, "malformed expression")