Changeset 35169 in project


Ignore:
Timestamp:
02/20/18 06:31:10 (7 months ago)
Author:
kon
Message:

add tests , simplify

Location:
release/4/posix-utils/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/posix-utils/trunk/posix-utils.scm

    r35168 r35169  
    99
    1010(;export
     11  ;
    1112  string-trim-eol software-eol-string
    12   qs* qs-item
    13   environment-variables->environment-list
     13  ;
     14  qs* qs-quote qs-evaluate qs-argument
     15  ;
     16  environment-string environment-variables->environment-list
     17  ;
    1418  environment-variable-bound?
    1519  environment-variable-true?
    1620  register-environment-variable-feature!
     21  ;
    1722  get-commandline-result
    1823  get-command-result get-echo-result
     24  ;
    1925  get-shell-variable
    2026  shell-variable-bound?
    2127  shell-variable-true?
    22   register-shell-variable-feature!)
     28  register-shell-variable-feature! )
    2329
    2430(import scheme chicken)
    2531(use
    2632  (only (srfi 1) member)
    27   (only data-structures string-intersperse o identity ->string)
     33  (only data-structures conc string-intersperse o identity ->string)
    2834  (only posix process process-wait)
    2935  (only utils qs read-all)
     
    8086(define char-set:software-eol (list->char-set software-eol-sequence))
    8187
     88(: string-trim-string string)
     89;
    8290(define software-eol-string (list->string software-eol-sequence))
     91
    8392(define software-eol-length (string-length software-eol-string))
    8493
     94(: string-trim-eol (string --> string))
     95;
    8596(define (string-trim-eol str)
    8697  (let* (
     
    103114
    104115(: qs* (string string #!optional (or string char) -> string))
     116;
    105117(define (qs* str #!optional (delim DOUBLE-QUOTE))
    106118  (let ((delim (qs-delimiter delim)))
    107119    (string-append delim str delim) ) )
    108120
    109 (: qs-item (* #!optional boolean (or string char) -> string))
    110 (define (qs-item item #!optional literal? (delim DOUBLE-QUOTE))
     121(: qs-quote (* -> string))
     122;
     123(define (qs-quote item)
     124  (qs-argument item #t SINGLE-QUOTE)
     125  #;
     126  (qs-argument (quote item)) )
     127
     128(: qs-evaluate (* -> string))
     129;
     130(define (qs-evaluate item)
     131  (qs-argument item #t DOUBLE-QUOTE)
     132  #;
     133  (qs-argument (quasiquote (unquote item))) )
     134
     135(: qs-argument (* #!optional boolean (or string char) -> string))
     136;
     137(define (qs-argument item #!optional literal? (delim DOUBLE-QUOTE))
    111138  (cond
    112139    ;
    113140    ;' item '
    114141    ((and (not literal?) (pair? item) (eq? 'quote (car item)))
    115       (qs-item (cdr item) #t SINGLE-QUOTE) )
    116     ;
    117     ;` item ... ` : quasi-interpret qs-item
     142      (qs-argument (cadr item) #t SINGLE-QUOTE) )
     143    ;
     144    ;` item ... ` : quasi-interpret qs-argument
    118145    ;   , - " item "
    119146    ;   ,@ - " ->string(item) ... "
    120147    ((and (not literal?) (pair? item) (eq? 'quasiquote (car item)))
    121       (qs-item (quasi-eval (cdr item)) #t BACK-QUOTE) )
     148      (qs-argument (qs-quasiquote (cadr item)) #t BACK-QUOTE) )
    122149    ;
    123150    ;< item >
     
    129156      (qs* (->string item) delim)) ) )
    130157
    131 (define (quasi-eval item)
     158(: qs-quasiquote (* --> string))
     159;
     160(define (qs-quasiquote item)
    132161  (cond
    133162    ;
    134163    ;" item "
    135164    ((and (pair? item) (eq? 'unquote (car item)))
    136       (let ((evaled (cdr item)))
    137         (qs-item evaled) ) )
     165      (qs-unquote (cadr item)) )
    138166    ;
    139167    ;" item ... "
    140168    ((and (pair? item) (eq? 'unquote-splicing (car item)))
    141       (let* (
    142         (evaled
    143           (cdr item) )
    144         (evaled
    145           (if (list? evaled)
    146             (string-intersperse (map ->string evaled) " ")
    147             (->string evaled) ) ) )
    148         (qs-item evaled) ) )
     169      (qs-unquote-splicing (cadr item)) )
    149170    ;
    150171    ;' item '
    151172    (else
    152       (qs-item item #t SINGLE-QUOTE) ) ) )
    153 
    154 ;;
    155 
     173      (qs-argument item #t SINGLE-QUOTE) ) ) )
     174
     175(: qs-unquote-splicing (* --> string))
     176;
     177(define (qs-unquote-splicing item)
     178  (qs-unquote item #t) )
     179
     180(: qs-unquote (* #!optional boolean --> string))
     181;
     182(define (qs-unquote item #!optional splicing?)
     183  (let* (
     184    (evaled
     185      (if (and splicing? (list? item))
     186        (string-intersperse (map ->string item) " ")
     187        (->string item) ) ) )
     188    (qs-argument evaled #t DOUBLE-QUOTE) ) )
     189
     190;;
     191
     192(: environment-string (pair -> string))
     193;
     194(define (environment-string pare)
     195  (string-append (car pare) "=" (->string (cdr pare))) )
     196
     197(: environment-variables->environment-list (list -> list))
     198;
    156199(define (environment-variables->environment-list al)
    157   (map
    158     (lambda (pare)
    159       (let ((nam (check-string 'environment-variables->environment-list (car pare) "item variable name")))
    160         (string-append nam "=" (->string (cdr pare))) ) )
    161     al) )
     200  (map environment-string al) )
    162201
    163202;;
    164203
    165204(: environment-variable-bound? (string -> (or boolean string)))
     205;
    166206(define (environment-variable-bound? nam)
    167207  (shell-value-bound? (get-environment-variable nam)) )
    168208
    169209(: environment-variable-true? (string #!optional (or boolean (list-of string)) -> boolean))
     210;
    170211(define (environment-variable-true? nam #!optional truedat)
    171212  (shell-value-true? (get-environment-variable nam) truedat) )
    172213
    173214(: register-environment-variable-feature! (string -> (or boolean symbol)))
     215;
    174216(define (register-environment-variable-feature! nam #!optional (filter identity))
    175217  (register-shell-value-feature! (get-environment-variable nam) filter) )
     
    178220
    179221(: get-commandline-result (string string -> string))
     222;
    180223(define (get-commandline-result cmnd line)
    181224  (let ((in (void)) (out (void)) (pid (void)))
    182225    (dynamic-wind
    183226      (lambda ()
    184         (set!-values (in out pid) (process (string-append (qs cmnd) " " line))) )
     227        (let ((cmndline (string-append (qs cmnd) " " line)))
     228          (set!-values (in out pid) (process cmndline)) ) )
    185229      (lambda ()
    186230        (read-all in) )
     
    190234
    191235(: get-command-result (string #!rest -> string))
     236;
    192237(define (get-command-result cmnd . args)
    193   (let ((line (string-intersperse (map qs-item args) " ")))
     238  (let ((line (string-intersperse (map qs-argument args) " ")))
    194239    (get-commandline-result cmnd line) ) )
    195240
    196241(: get-echo-result (#!rest -> string))
     242;
    197243(define (get-echo-result . exps)
    198244  (let ((res (apply get-command-result "echo" exps)))
     
    203249
    204250(: get-shell-variable (string -> string))
     251;
    205252(define (get-shell-variable name)
    206253  (get-echo-result (string-append "$" name)) )
    207254
    208255(: shell-variable-bound? (string -> (or boolean string)))
     256;
    209257(define (shell-variable-bound? name)
    210258  (shell-value-bound? (get-shell-variable name)) )
    211259
    212260(: shell-variable-true? (string #!optional (or boolean (list-of string)) -> boolean))
     261;
    213262(define (shell-variable-true? name #!optional truedat)
    214263  (shell-value-true? (get-shell-variable name) truedat) )
    215264
    216265(: register-shell-variable-feature! (string -> (or boolean symbol)))
     266;
    217267(define (register-shell-variable-feature! name #!optional (filter identity))
    218268  (register-shell-value-feature! (get-shell-variable name) filter) )
  • release/4/posix-utils/trunk/tests/posix-utils-test.scm

    r35164 r35169  
    44(use posix posix-utils)
    55
    6 (test-group "misc"
     6(test-group "eol"
    77  ;
    88  (define eol
     
    1818  (test "" (string-trim-eol eol))
    1919  (test "foo" (string-trim-eol "foo"))
     20)
     21
     22(test-group "qs"
     23  (test "\"foo\"" (qs* "foo"))
     24  (test "'foo'" (qs* "foo" #\'))
     25  (test "\"$((1 + 2))\"" (qs-evaluate "$((1 + 2))"))
     26  (test "'$((1 + 2))'" (qs-quote "$((1 + 2))"))
     27  (test "'$((1 + 2))'" (qs-argument '(quote "$((1 + 2))")))
     28  ;(test "`\"$ ((1 + 2))\"`" (qs-argument '`,@($(( 1 + 2 )))))
     29  (test "`\"\"`" (qs-argument '`,@()))
     30  (test "`\"result is 3\"`" (qs-argument '`,@(result is 3)))
     31  (test "`\"3\"`" (qs-argument '`,3))
    2032)
    2133
Note: See TracChangeset for help on using the changeset viewer.