Changeset 35819 in project
- Timestamp:
- 07/08/18 23:57:36 (8 months ago)
- Location:
- release/5/apropos/trunk
- Files:
-
- 1 added
- 7 deleted
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/apropos/trunk/apropos.scm
r35806 r35819 1 ;;;; apropos.scm 1 ;;;; apropos.scm -*- Scheme -*- 2 ;;;; Kon Lovett, Jul '18 2 3 ;;;; Kon Lovett, Oct '17 3 4 ;;;; Kon Lovett, Mar '09 … … 26 27 (declare 27 28 (bound-to-procedure 29 ##sys#fast-reverse 28 30 ##sys#symbol-has-toplevel-binding? 29 31 ##sys#macro-environment … … 44 46 ) 45 47 46 (import scheme chicken foreign) 47 (import (only csi toplevel-command)) ;wtf? 48 (use 49 (only data-structures 50 atom? 51 sort! any? 52 alist-ref alist-update! 53 butlast 54 string-split) 55 (only ports with-input-from-string) 56 (only extras read-file read-line) 57 (only srfi-1 cons* reverse! append! last-pair) 58 (only srfi-13 48 (import scheme 49 (chicken base) 50 (chicken foreign) 51 (chicken platform) 52 (chicken io) 53 (chicken syntax) 54 (chicken keyword) 55 (chicken fixnum) 56 (chicken port) 57 (chicken sort) 58 (chicken type) 59 (only (chicken csi) toplevel-command) 60 (only (srfi 1) cons* reverse! append! last-pair) 61 (only (srfi 13) 59 62 string-join 60 63 string-trim-both 61 64 string-contains string-contains-ci 62 65 string-drop string-take string-index) 63 (only irregex66 (only (chicken irregex) 64 67 sre->irregex 65 68 irregex irregex? … … 79 82 80 83 ;;; Support 84 85 ;;; File Utilities 86 87 (define (read-file #!optional (port (current-input-port))) 88 (let loop ((xs '())) 89 (let ((x (read port))) 90 (if (eof-object? x) 91 (##sys#fast-reverse xs) 92 (loop (cons x xs)) ) ) ) ) 93 94 ;; 95 96 (define (any? x) 97 #t ) 81 98 82 99 ;; Raw Access Renames … … 1216 1233 (let* ( 1217 1234 (cmdlin (read-line)) 1218 (istr (string-trim-both cmdlin)) 1219 (iargs (with-input-from-string istr read-file)) 1235 (iargs (with-input-from-string cmdlin read-file)) 1220 1236 (aargs (parse-csi-apropos-arguments iargs)) ) 1221 1237 ;NOTE will not dump the symbol-table unless explicit ; use '(: (* any)) -
release/5/apropos/trunk/tests/apropos-test.scm
r35806 r35819 1 (use apropos) 2 (use test) 1 ;;;; apropos-test.scm -*- Scheme -*- 2 ;;;; Kon Lovett, Jul '18 3 4 (import test) 5 6 (test-begin "Apropos") 7 8 ;;; 9 10 (import 11 (chicken syntax) 12 (chicken sort) 13 apropos) 3 14 4 15 ;FIXME need #:split tests … … 11 22 12 23 ;;; 13 14 (test-begin "apropos")15 24 16 25 ;; build test symbols … … 26 35 (declare (compile-syntax)) 27 36 28 (define-syntax (foobarmacro1 f r c) 29 'foobarmacro1 ) 37 (define-syntax foobarmacro1 38 (er-macro-transformer 39 (lambda (f r c) 40 'foobarmacro1 ) ) ) 30 41 31 42 (define-syntax foobarmacro2 … … 144 155 |# 145 156 146 (test-end)147 148 157 ;;; 149 158 159 (test-end "Apropos") 160 150 161 (test-exit) -
release/5/apropos/trunk/tests/run.scm
r35806 r35819 4 4 ;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>" 5 5 6 (use files) 6 (import 7 (only (chicken pathname) make-pathname) 8 (only (chicken process) system) 9 (only (chicken process-context) argv) 10 (only (chicken format) format)) 11 12 (define *args* (argv)) 7 13 8 14 ;no -disable-interrupts 9 (define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2") 10 11 (define *args* (argv)) 15 (define *csc-options* "-inline-global \ 16 -specialize -optimize-leaf-routines -clustering -lfa2 \ 17 -local -inline \ 18 -no-trace -no-lambda-info \ 19 -unsafe") 12 20 13 21 (define (test-name #!optional (eggnam EGG-NAME)) … … 29 37 (define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*)) 30 38 (let ((tstnam (test-name eggnam))) 31 ( print "*** csi ***")39 (format #t "*** csi ***~%") 32 40 (system (string-append "csi -s " (make-pathname #f tstnam "scm"))) 33 41 (newline) 34 ( print "*** csc (" cscopts ") ***")42 (format #t "*** csc ~s ***~%" cscopts) 35 43 (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm"))) 36 44 (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) ) … … 42 50 43 51 (run-test) 44 45 (run-test "apropos-srfi")
Note: See TracChangeset
for help on using the changeset viewer.