Changeset 40266 in project


Ignore:
Timestamp:
07/07/21 08:44:49 (3 weeks ago)
Author:
Kon Lovett
Message:

updated test runner, comments, reflow

Location:
release/5/apropos/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/5/apropos/trunk/apropos-api.scm

    r39779 r40266  
    613613        `(procedure . ,(canonical-identifier-name info raw?)) ) ) ) )
    614614
    615 ; => 'macro | 'keyword | 'variable | <procedure-details>
     615; <symbol>|<keyword> => <identifier>
     616; <identifier> => 'macro | 'keyword | 'variable | <procedure-details>
    616617;
    617618(define (identifier-type-details sym #!optional macenv raw?)
    618619  (cond
    619     ((and sym macenv (macro-symbol-in-environment? sym macenv))
    620       'macro )
    621620    ((keyword? sym)
    622621      'keyword )
     622    #; ;HUH?
     623    ((not sym)
     624      (error 'identifier-type-details "invalid symbol" sym) )
     625    ((and macenv (macro-symbol-in-environment? sym macenv))
     626      'macro )
    623627    (else
    624628      (let ((val (global-symbol-ref sym)))
  • release/5/apropos/trunk/apropos.egg

    r39779 r40266  
    33
    44((synopsis "CHICKEN apropos")
    5  (version "3.6.1")
     5 (version "3.6.2")
    66 (category misc)
    77 (author "Kon Lovett")
  • release/5/apropos/trunk/symbol-environment-access.scm

    r39779 r40266  
    1919  search-macro-environment-symbols
    2020  search-system-environment-symbols
     21  search-environments-symbols
    2122  ;
    2223  search-interaction-environment-symbols
    23   search-list-environment-symbols
    24   ;
    25   search-environments-symbols)
     24  search-list-environment-symbols)
    2625
    2726(import scheme
     
    3433
    3534;opaque
    36 (define-type macro-environment *)
     35(define-type macro-environment list)
    3736
    3837(: system-current-environment (-> list))
     
    5857;;
    5958
    60 (define (search-list-environment-symbols test? env #!optional (itemref car))
    61   (define (cons-if-symbol syms cell) (cons-if test? (itemref cell) syms))
     59(define (search-list-environment-symbols test? env #!optional (elmref car))
     60  (define (cons-if-symbol syms cell) (cons-if test? (elmref cell) syms))
    6261  (foldl cons-if-symbol '() env) )
    6362
     
    8180;;
    8281
     82;UNUSED
    8383(define (search-environments-symbols test?)
    8484  (append!
     85    (search-macro-environment-symbols test? (system-macro-environment))
    8586    (search-system-environment-symbols test? (system-current-environment))
    86     (search-system-environment-symbols test? (system-macro-environment))
    8787    (search-system-environment-symbols test?)) )
    8888
  • release/5/apropos/trunk/symbol-table-access.scm

    r38992 r40266  
    4949;;
    5050
    51 (define-type symbol-table-cursor pair)
     51(define-type symbol-table-cursor (pair fixnum list))
     52
     53(: cursor-next (symbol-table-cursor --> (or false symbol-table-cursor)))
     54(: cursor-first (--> (or false symbol-table-cursor)))
     55(: cursor-current (symbol-table-cursor --> (or false symbol)))
    5256
    5357(: root-symbol-table-size (-> fixnum))
     
    5559(: bucket-symbol (pair -> symbol))
    5660(: bucket-link (pair -> list))
     61
    5762(: bucket-last? (list --> boolean))
    5863(: bucket-symbol-ref (list -> (or false symbol)))
     
    6671(: set-cursor-bucket! (symbol-table-cursor * -> void))
    6772(: symbol-table-cursor (-> symbol-table-cursor))
    68 (: cursor-next (symbol-table-cursor -> (or false symbol-table-cursor)))
    69 (: cursor-first (-> (or false symbol-table-cursor)))
    70 (: cursor-current (symbol-table-cursor -> (or false symbol)))
    7173
    7274;; Symbol Table
     
    7779
    7880(define root-symbol-table-element
    79   (foreign-lambda* scheme-object ((int i))
     81  (foreign-lambda* scheme-object ((unsigned-integer i))
    8082    "return( raw_symbol_table_chain( use_root_symbol_table(), i ) );") )
    8183
     
    118120  (and
    119121    (cursor-active? cursor)
    120     (let loop (
    121       (bkt (bucket-link-ref (cursor-bucket cursor)))
    122       (idx (cursor-index cursor)) )
     122    (let loop ( (bkt (bucket-link-ref (cursor-bucket cursor)))
     123                (idx (cursor-index cursor)) )
    123124      ;gotta bucket ?
    124125      (if (and bkt (not (bucket-last? bkt)))
  • release/5/apropos/trunk/tests/run.scm

    r39779 r40266  
    77    make-pathname pathname-file pathname-replace-directory pathname-strip-extension)
    88  (only (chicken process) system)
    9   (only (chicken process-context) command-line-arguments)
     9  (only (chicken process-context) command-line-arguments get-environment-variable)
    1010  (only (chicken format) format)
    1111  (only (chicken file) file-exists? find-files)
     
    1313
    1414;; Globals
     15
     16(define *csi* (or (get-environment-variable "CHICKEN_CSI") "csi"))
     17(define *csc* (or (get-environment-variable "CHICKEN_CSC") "csc"))
    1518
    1619(define *csc-init-options* '(
     
    7982
    8083(define (run-test-evaluated source)
    81   (format #t "*** csi ~A ***~%" (pathname-file source))
    82   (system-must (string-append "csi -s " source)) )
     84  (format #t "*** ~A ~A ***~%" *csi* (pathname-file source))
     85  (system-must (string-append *csi* " -s " source)) )
    8386
    8487(define (run-test-compiled source csc-options)
    8588  (let ((optstr (apply string-append (intersperse csc-options " "))))
    86     (format #t "*** csc ~A ~A ***~%" (pathname-file source) optstr)
     89    (format #t "*** ~A ~A ~A ***~%" *csc* (pathname-file source) optstr)
    8790    ;csc output is in current directory
    88     (system-must (string-append "csc" " " optstr " " source)) )
     91    (system-must (string-append *csc* " " optstr " " source)) )
    8992  (system-must (pathname-replace-directory (pathname-strip-extension source) *test-directory*)) )
    9093
Note: See TracChangeset for help on using the changeset viewer.