source: project/chicken/trunk/chicken-bug.scm @ 6252

Last change on this file since 6252 was 6252, checked in by felix winkelmann, 12 years ago

chicken-bug fixes

File size: 3.6 KB
Line 
1;;;; chicken-bug.scm - Bug report-generator
2
3
4(use posix utils)
5
6
7#>
8#ifndef C_TARGET_CC
9# define C_TARGET_CC  C_INSTALL_CC
10#endif
11
12#ifndef C_TARGET_CXX
13# define C_TARGET_CXX  C_INSTALL_CXX
14#endif
15<#
16
17
18(define-constant +bug-report-file+ "chicken-bug-report.~a-~a-~a")
19
20(define-constant +destinations+ 
21  "chicken-janitors@nongnu.org\nchicken-hackers@nongnu.org\nchicken-users@nongnu.org\nfelix@call-with-current-continuation.org")
22
23
24(define-foreign-variable +cc+ c-string "C_TARGET_CC")
25(define-foreign-variable +cxx+ c-string "C_TARGET_CXX")
26(define-foreign-variable +c-include-path+ c-string "C_INSTALL_INCLUDE_HOME")
27
28
29(define (collect-info)
30  (print "This is a bug report generated by chicken-bug(1).\n")
31  (print "Date:\t" (seconds->string (current-seconds)) "\n")
32  (printf "User information:\t~s~%~%" (user-information (current-user-id)))
33  (print "Host information:\n")
34  (print "\tmachine type:\t" (machine-type))
35  (print "\tsoftware type:\t" (software-type))
36  (print "\tsoftware version:\t" (software-version))
37  (print "\tbuild platform:\t" (build-platform) "\n")
38  (print "CHICKEN version is:\t" (chicken-version #t) "\n")
39  (print "Home directory:\t" (chicken-home) "\n")
40  (printf "Include path:\t~s~%~%" ##sys#include-pathnames)
41  (print "Features:")
42  (for-each
43   (lambda (lst) 
44     (display "\n  ")
45     (for-each
46      (lambda (f)
47        (printf "~a~a" f (make-string (fxmax 1 (fx- 16 (string-length f))) #\space)) )
48      lst) )
49   (chop (sort (map keyword->string ##sys#features) string<?) 5))
50  (print "\n\nchicken-config.h:\n")
51  (with-input-from-file (make-pathname +c-include-path+ "chicken-config.h")
52    (lambda ()
53      (display (read-all)) ) )
54  (newline)
55  (when (and (string=? +cc+ "gcc") (feature? 'unix))
56    (print "CC seems to be gcc, trying to obtain version...\n")
57    (with-input-from-pipe "gcc -v 2>&1"
58      (lambda ()
59        (display (read-all)))))
60  (newline) )
61
62(define (usage code)
63  (print #<<EOF
64usage: chicken-bug [FILENAME ...]
65
66  -help  -h            show this message
67  -to-stdout           write bug report to standard output
68  -                    read description from standard input
69
70EOF
71) 
72  (exit code) )
73
74(define (user-input)
75  (when (##sys#tty-port? (current-input-port))
76    (print #<<EOF
77This is the CHICKEN bug report generator. Please enter a detailed
78description of the problem you have encountered and enter CTRL-D (EOF)
79once you have finished. Presss CTRL-C to abort the program:
80
81EOF
82) )
83  (read-all) )
84
85(define (justify n)
86  (let ((s (number->string n)))
87    (if (> (string-length s) 1)
88        s
89        (string-append "0" s))))
90
91(define (main args)
92  (let ((msg "")
93        (files #f)
94        (stdout #f))
95    (for-each
96     (lambda (arg)
97       (cond ((string=? "-" arg) 
98              (set! files #t)
99              (set! msg (string-append msg "\n\nUser input:\n\n" (user-input))) )
100             ((member arg '("--help" "-h" "-help"))
101              (usage 0) )
102             ((string=? "-to-stdout" arg)
103              (set! stdout #t) )
104             (else
105              (set! files #t)
106              (set! msg 
107                (string-append
108                 msg
109                 "\n\nFile added: " arg "\n\n"
110                 (read-all arg) ) ) ) ) )
111     args)
112    (unless files
113      (set! msg (string-append msg "\n\n" (user-input))))
114    (match-let ((#(_ _ _ day mon yr _ _ _ _) (seconds->local-time (current-seconds))))
115      (let* ((file (sprintf +bug-report-file+ (+ 1900 yr) (justify mon) (justify day)))
116             (port (if stdout (current-output-port) (open-output-file file))))
117        (with-output-to-port port
118          (lambda ()
119            (print msg)
120            (collect-info) ) )
121        (unless stdout
122          (close-output-port port)
123          (print "\nA bug report has been written to `" file "'. Please send it to")
124          (print "one of the following addresses:\n\n" +destinations+) ) ) ) ) )
125
126(main (command-line-arguments))
Note: See TracBrowser for help on using the repository browser.