fix certificate problems related to module-begin

svn: r3553

collects/errortrace/errortrace-lib.ss

@@ -266,6 +266,8 @@
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+  (define orig-inspector (current-code-inspector))
+
   (define errortrace-annotate
     (lambda (top-e)
       (define (normal e)
@@ -280,13 +282,17 @@
                  [(module name init-import (#%plain-module-begin body ...))
                   (normal
                    #`(module name init-import
-                       (#%plain-module-begin
+                       #,(syntax-recertify
-                        #,((make-syntax-introducer)
+			  #`(#%plain-module-begin
-                           #'(require (lib "errortrace-key.ss" "errortrace")))
+			     #,((make-syntax-introducer)
-                        #,((make-syntax-introducer)
+				#'(require (lib "errortrace-key.ss" "errortrace")))
-                           #'(require-for-syntax
+			     #,((make-syntax-introducer)
-                              (lib "errortrace-key.ss" "errortrace")))
+				#'(require-for-syntax
-                        body ...)))])))]
+				   (lib "errortrace-key.ss" "errortrace")))
+			     body ...)
+			  (list-ref (syntax->list top-e) 3)
+			  orig-inspector
+			  #f)))])))]
         [_else
          (normal top-e)])))
 

collects/errortrace/stacktrace.ss

@@ -397,13 +397,20 @@
              ;; Just wrap body expressions
              [(module name init-import (#%plain-module-begin body ...))
               top?
-              (let ([bodys (syntax->list (syntax (body ...)))])
+              (let ([bodys (syntax->list (syntax (body ...)))]
+		    [mb (list-ref (syntax->list expr) 3)])
                 (let ([bodyl (map (lambda (b)
                                     (annotate-top b trans?))
                                   bodys)])
-                  (certify
+		  (certify
-                   expr
+		   expr
-                   (rebuild expr (map cons bodys bodyl)))))]
+		   (rebuild
+		    expr
+		    (list (cons
+			   mb
+			   (certify
+			    mb
+			    (rebuild mb (map cons bodys bodyl)))))))))]
 		   
              ;; No way to wrap
              [(require i ...) expr]

collects/setup/configtab.ss

@@ -77,11 +77,13 @@
                  (if (memq id syms)
                    '()
                    (list #`(define #,(datum->syntax-object stx id stx) #,v))))
-               #`(#%plain-module-begin
+	       (syntax-property
-                  (provide #,@path-exports #,@flag-exports)
+		#`(#%plain-module-begin
-                  (define name expr) ...
+		   (provide #,@path-exports #,@flag-exports)
-                  #,@(apply append (map (mkdef #'use-default) path-exports))
+		   (define name expr) ...
-                  #,@(apply append (map (mkdef #'#f) flag-exports))))))])))
+		   #,@(apply append (map (mkdef #'use-default) path-exports))
+		   #,@(apply append (map (mkdef #'#f) flag-exports)))
+		'certify-mode 'transparent))))])))
 
   (provide (rename config-module-begin #%module-begin)
 	   define