blob: dd67459239be118aca96b85ffb4ef5eee4fd836f (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!/bin/sh
exec scsh -e main -s "$0" "$@"
!#
;; Script to perform the nightly test/build of Scala.
;;
;; Always make sure that the latest version of this file is copied to
;; ~scalatest/bin/scala2-nightly-test.scm
;;
;; $Id$
;; SVN repository containing the Scala compiler.
(define scala-svn-repository-dir
"http://lampsvn.epfl.ch/svn-repos/scala/scala/trunk")
;; SVN module containing the compiler.
(define scala-svn-module-name "scala")
;; E-mail address to which the failure notification should be sent.
(define notify-email "scala-devel@groupes.epfl.ch")
;;(define notify-email "stephane.micheloud@epfl.ch") ; DEBUG
;;(define notify-email "lex.spoon@epfl.ch") ; DEBUG
;; Directory in which the distribution should be built.
(define nightly-build-dir
;; (expand-file-name "~lex/scala/nightly")) ; DEBUG
(expand-file-name "~linuxsoft/archives/scala/nightly"))
;; End of configuration section.
(define (main cmd-line)
(let ((prog (car cmd-line))
(args (cdr cmd-line)))
(if (= 1 (length args))
(scala-test (first args))
(display-usage-and-exit prog))))
(define (display-usage-and-exit prog)
(format #t "Usage: ~a <result-dir>\n" prog)
(exit 1))
(define (get-public-link file)
(temp-file-iterate (lambda (link) (create-symlink file link) link)
(expand-file-name "~/public_html/log-scala2-~a.txt")))
(define (get-checkout-dir base-dir date)
(expand-file-name (string-append (format-date "~Y-~m-~d" date) "-scala2") base-dir))
(define (start-section title)
(format #t "\n* ~a\n\n" title))
(define (scala-test base-dir)
(let* ((checkout-dir (get-checkout-dir base-dir (date)))
(log-file (expand-file-name "log-scala2" checkout-dir)))
(create-directory checkout-dir)
(call-with-output-file log-file
(lambda (log-port)
(with-current-output-port log-port
(with-current-error-port log-port
(stdports->stdio)
(with-cwd checkout-dir
(if (not (call-with-current-continuation scala-do-test))
(let ((link (get-public-link log-file)))
(send-warning-mail log-file
(file-name-nondirectory link)))))))))))
(define (scala-do-test return)
(dynamic-wind
(lambda ()
(display "In Emacs, read this file in -*- Outline -*- mode\n")
(start-section "Starting time")
(display (format-date "~Y-~m-~d ~H:~M ~Z\n" (date))))
(lambda ()
(let ((fail-if-error (lambda (code) (if (not (zero? code))
(return #f)))))
(start-section "Checking out Scala module")
(fail-if-error (run (svn co ,scala-svn-repository-dir
,scala-svn-module-name)))
(with-cwd scala-svn-module-name
(start-section "Creating small Scala distribution")
(fail-if-error (run (ant pack)))
(fail-if-error (run (ant docs.compiler)))
(start-section "Testing Scala compiler")
(fail-if-error
(run (./test/scalatest --color=none
--show-log)))
;; (start-section "Creating nightly distribution")
;; (run (rm -rf ,nightly-build-dir))
;; (create-directory nightly-build-dir)
;; (fail-if-error (run (ant dist) (< /dev/null)))
#t)))
(lambda ()
(start-section "Ending time")
(display (format-date "~Y-~m-~d ~H:~M ~Z\n" (date))))))
(define (send-warning-mail log-file-name link-name)
(send-mail
notify-email
`(("Subject" . "Failure of nightly Scala 2 test")
("To" . ,notify-email)
("Reply-To" . ,notify-email))
(string-append
"Tonight's automatic Scala test failed. More details can be found\n"
"in file "log-file-name"\n"
"which is available through the following URL:\n\n"
" http://lamp.epfl.ch/~scalatest/"link-name"\n"
"\n"
(run/string (fgrep "[FAILED]" ,log-file-name)))))
(define (send-mail to headers body)
(let ((mail-port (make-string-output-port)))
(for-each (lambda (name/contents)
(format mail-port "~a: ~a\n"
(car name/contents)
(cdr name/contents)))
headers)
(newline mail-port)
(write-string body mail-port)
(newline mail-port)
(run (sendmail "-i" ,to)
(<< ,(string-output-port-output mail-port)))))
;;; Local Variables:
;;; mode:scheme
;;; End:
|
