Changeset 35149 in project


Ignore:
Timestamp:
02/18/18 07:36:24 (7 months ago)
Author:
kon
Message:

add csi+csc run , add tests for string-trim-eol & get-shell-variable , faster trim , common style

Location:
release/4/posix-utils/trunk
Files:
1 added
4 edited

Legend:

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

    r23255 r35149  
    99 (depends (setup-helper "1.2.0"))
    1010 (test-depends test)
    11  (files "posix-utils.release-info" "posix-utils.setup" "posix-utils.meta" "posix-utils.scm" "tests/run.scm") )
     11 (files "posix-utils.setup" "posix-utils.meta" "posix-utils.scm" "tests/run.scm" "tests/posix-utils-test.scm") )
  • release/4/posix-utils/trunk/posix-utils.scm

    r35148 r35149  
    1010(;export
    1111  ;
    12   char-set:software-eol
    1312  string-trim-eol
    1413  ;
     
    3029;;
    3130
    32 (define software-eol-chars
     31(define software-eol-sequence
    3332  (cond-expand
    3433    (windows
     
    3938     '(#\return)) ) )
    4039
    41 (define software-eol-chars-length (length software-eol-chars))
     40(define char-set:software-eol (list->char-set software-eol-sequence))
    4241
    43 (define char-set:software-eol (list->char-set software-eol-chars))
     42(define software-eol-string (list->string software-eol-sequence))
     43(define software-eol-length (string-length software-eol-string))
    4444
    4545(define (string-trim-eol str)
    4646  (let* (
    4747    (end (string-length str))
    48     (start (fx- end software-eol-chars-length)) )
    49     (if (or (fx< start 0) (fx>= start end))
     48    (start (fx- end software-eol-length))
     49    (index
     50      (and
     51        (fx<= 0 start) (fx< start end)
     52        (string-index str char-set:software-eol start end))) )
     53    (if (not index)
    5054      str
    51       (let ((eol (string-index str char-set:software-eol start end)))
    52         (if (not eol)
    53           str
    54           (string-take str eol) ) ) ) ) )
     55      (string-take str index) ) ) )
    5556
    5657;;
     
    7879(define (get-shell-variable nam)
    7980  (let-values (((in out pid) (process (string-append "echo $" nam))))
    80     (let* (
    81       (instr (read-all in))
    82       (varval (string-trim-eol instr))
    83       (varval (and (not (string-null? varval)) varval)) )
     81    (let ((instr (read-all in)))
    8482      ;
    8583      (process-wait pid)      ;FIXME timeout
     
    8886      (close-output-port out)
    8987      ;
    90       varval ) ) )
     88      (and-let* (
     89        (varval (string-trim-eol instr))
     90        ((not (string-null? varval))) )
     91        varval ) ) ) )
    9192
    9293;;
  • release/4/posix-utils/trunk/posix-utils.setup

    r33412 r35149  
    55(verify-extension-name "posix-utils")
    66
    7 (setup-shared-extension-module 'posix-utils (extension-version "1.0.1")
     7(setup-shared-extension-module 'posix-utils (extension-version "1.1.0")
    88  #:compile-options '(
    99    -fixnum-arithmetic
  • release/4/posix-utils/trunk/tests/run.scm

    r24131 r35149  
    1 ;;;; posix-utils-test.scm  -*- Hen -*-
    21
    3 (use test)
    4 (use posix)
    5 (use posix-utils)
     2(define EGG-NAME "posix-utils")
    63
    7 (test-group "EnvVars"
    8   (setenv "FOO" "yes")
    9   (setenv "BAR" "")
    10   (setenv "BAZ" "not on your life")
    11   (test-assert (environment-variable-bound? "FOO"))
    12   (test "yes" (environment-variable-bound? "FOO"))
    13   (test-assert (not (environment-variable-bound? "BAR")))
    14   (test-assert (environment-variable-true? "FOO"))
    15   (test-assert (not (environment-variable-true? "BAR")))
    16   (test-assert (not (environment-variable-true? "BAZ"))) )
     4;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    175
    18 (test-exit)
     6(use files)
     7
     8;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))
     12
     13(define (test-name #!optional (eggnam EGG-NAME))
     14  (string-append eggnam "-test") )
     15
     16(define (egg-name #!optional (def EGG-NAME))
     17  (cond
     18    ((<= 4 (length *args*))
     19      (cadddr *args*) )
     20    (def
     21      def )
     22    (else
     23      (error 'test "cannot determine egg-name") ) ) )
     24
     25;;;
     26
     27(set! EGG-NAME (egg-name))
     28
     29(define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
     30  (let ((tstnam (test-name eggnam)))
     31    (print "*** csi ***")
     32    (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
     33    (newline)
     34    (print "*** csc (" cscopts ") ***")
     35    (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
     36    (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
     37
     38(define (run-tests eggnams #!optional (cscopts *csc-options*))
     39  (for-each (cut run-test <> cscopts) eggnams) )
     40
     41;;;
     42
     43(run-test)
Note: See TracChangeset for help on using the changeset viewer.