Changeset 11961 in project


Ignore:
Timestamp:
09/18/08 13:01:47 (11 years ago)
Author:
felix winkelmann
Message:

henrietta test-case handling stuff - untested

Location:
chicken/branches/hygienic
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/hygienic/TODO

    r11941 r11961  
    5555*** connect timeout and alternative download location
    5656*** only download tests on demand (-test option)
     57**** implemented - test
    5758** chicken-install
    5859*** handle needs/depends of builtin extension
     
    6061    necessary?
    6162** henrietta
    62 *** parameter "withtests=BOOL" controls whether tests should be downloaded
     63*** parameter "tests=BOOL" controls whether tests should be downloaded
     64*** remove "test" parameter
    6365
    6466* documentation
     
    8587   warning on compilation
    8688   (might be fixed with force-finalizers not imported - test with optimizations on)
     89** test sassy (needs henrietta+test thing!)
  • chicken/branches/hygienic/chicken-install.scm

    r11941 r11961  
    140140                       (dir (retrieve-extension
    141141                             name *default-transport* *default-location*
    142                              version #f
    143                              (and *retrieve-only* (current-directory))
    144                              *username* *password*)))
     142                             version: version
     143                             destination: (and *retrieve-only* (current-directory))
     144                             tests: *run-tests*
     145                             username: *username*
     146                             password: *password*)))
    145147                  (unless dir
    146148                    (error "extension or version not found"))
  • chicken/branches/hygienic/henrietta.scm

    r11776 r11961  
    3535  (define *default-transport* 'svn)
    3636  (define *default-location* (current-directory))
    37   (define *test* #f)
    3837  (define *username* #f)
    3938  (define *password* #f)
     39  (define *tests* #f)
    4040
    4141  (define (headers)
     
    5252      (remove-directory tmpdir)))
    5353
     54  (define (test-file? path)
     55    (string-match "(\\./)?tests/.*" path))
     56
    5457  (define (retrieve name version)
    5558    (let ((dir (handle-exceptions ex
     
    5861                 (retrieve-extension
    5962                  name *default-transport* *default-location*
    60                   version #t #f
    61                   *username* *password*))))
     63                  version: version
     64                  quiet: #t
     65                  destination: #f
     66                  tests: *tests*
     67                  username: *username*
     68                  password: *password*))))
    6269      (unless dir
    6370        (fail "no such extension or version" name version))
     
    6673          (for-each
    6774           (lambda (f)
    68              (let ((ff (string-append dir "/" f))
    69                    (pf (string-append prefix "/" f)))
    70                (cond ((directory? ff)
    71                       (print "\n#|--------------------|# \"" pf "/\" 0")
    72                       (walk ff pf))
    73                      (else
    74                       (print "\n#|--------------------|# \"" pf "\" " (file-size ff))
    75                       (display (read-all ff))))))
     75             (unless (test-file? f)
     76               (let ((ff (string-append dir "/" f))
     77                     (pf (string-append prefix "/" f)))
     78                 (cond ((directory? ff)
     79                        (print "\n#|--------------------|# \"" pf "/\" 0")
     80                        (walk ff pf))
     81                       (else
     82                        (print "\n#|--------------------|# \"" pf "\" " (file-size ff))
     83                        (display (read-all ff)))))))
    7684           files)))
    7785      (print "\n#!eof") ) )
     
    93101            (cond ((not m)
    94102                   (headers)            ; from here on use `fail'
    95                    (cond (*test*
    96                           (fail "test"))
    97                          (egg
     103                   (cond (egg
    98104                          (retrieve egg version)
    99105                          (cleanup) )
     
    105111                   (set! egg (apply substring qs (caddr m)))
    106112                   (loop rest))
    107                   ((string=? ms "test")
    108                    (set! *test* #t)
     113                  ((string=? ms "tests")
     114                   (set! *tests* #t)
    109115                   (loop rest))
    110116                  (else
  • chicken/branches/hygienic/setup-download.scm

    r11776 r11961  
    3636
    3737  (import scheme chicken)
    38   (import extras regex posix utils setup-utils srfi-1 data-structures tcp srfi-13 files)
     38  (import extras regex posix utils setup-utils srfi-1 data-structures tcp
     39          srfi-13 files)
    3940
    4041  (define *quiet* #f)
     
    5354          dir)))
    5455
    55   (define (locate-egg/local egg dir #!optional version destination username password)
     56  (define (locate-egg/local egg dir #!optional version destination)
    5657    (let* ((eggdir (make-pathname dir egg))
    5758           (files (directory eggdir))
     
    7475                eggdir)))))
    7576 
    76   (define (locate-egg/svn egg repo #!optional version destination username password)
     77  (define (locate-egg/svn egg repo #!optional version destination username
     78                          password)
    7779    (call/cc
    7880     (lambda (k)
     
    113115           tmpdir)) )))
    114116
    115   (define (locate-egg/http egg url #!optional version destination username password)
     117  (define (locate-egg/http egg url #!optional version destination tests)
    116118    (let* ((tmpdir (or destination (get-temporary-directory)))
    117119           (m (string-match "(http://)?([^/:]+)(:([^:/]+))?(/.+)" url))
     
    126128                 (if version
    127129                     (string-append "&version=" version)
     130                     "")
     131                 (if tests
     132                     "&tests=yes"
    128133                     "")))
    129134           (eggdir (make-pathname tmpdir egg)))
    130135      (create-directory eggdir)
    131       (http-fetch host port loc eggdir)
     136      (http-fetch host port loc eggdir tests)
    132137      eggdir))
    133138
     
    141146      (let ((chunked #f))
    142147        (let* ((h1 (read-line in))
    143                (m (and (string? h1) (string-match "HTTP/[0-9.]+\\s+([0-9]+)\\s+.*" h1))))
     148               (m (and (string? h1)
     149                       (string-match "HTTP/[0-9.]+\\s+([0-9]+)\\s+.*" h1))))
    144150          (print h1)
    145151          ;;*** handle redirects here
     
    194200              (loop (cons chunk data)))))))
    195201
    196   (define (retrieve-extension name transport location #!optional version quiet
    197                               destination username password)
     202  (define (retrieve-extension name transport location #!key version quiet
     203                              destination username password tests)
    198204    (fluid-let ((*quiet* quiet))
    199205      (case transport
     
    205211         (locate-egg/svn name location version destination username password))
    206212        ((http)
    207          (locate-egg/http name location version destination))
     213         (locate-egg/http name location version destination tests))
    208214        (else (error "unsupported transport" transport)))) )
    209215
Note: See TracChangeset for help on using the changeset viewer.