Changeset 38245 in project


Ignore:
Timestamp:
03/14/20 18:19:15 (2 weeks ago)
Author:
Kon Lovett
Message:

string-longest-common-prefixes is buggy

Location:
release/5/string-utils/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/string-utils/trunk/string-utils.scm

    r38017 r38245  
    77(;export
    88  string-longest-common-prefix
    9   string-longest-common-prefixes
     9  #;string-longest-common-prefixes
    1010  string-fixed-length)
    1111
     
    1414  (chicken sort)
    1515  (chicken type)
    16   (only (srfi 1) append! reverse!)
     16  (only (srfi 1) append! reverse! append-map filter)
    1717  (only (srfi 13) string-null? string-take string-prefix-length)
    1818  (only memoized-string make-string+)
     
    2525;;
    2626
    27 (: string-longest-common-prefix (string (list-of string) -> (or boolean string)))
     27(: *string-longest-common-prefix (string (list-of string) procedure --> *))
    2828;
    29 (define (string-longest-common-prefix cand others)
    30   ;
     29(define (*string-longest-common-prefix cand others handler)
     30  ;-> (<prefix-length> <∈ others>)
    3131  (define (prelength-tag item)
    3232    (cons (string-longest-common-prefix-length cand item) item) )
    33   ;
    34   (define (prelength-tag< a b)
     33  ;NOTE descending sort order!
     34  (define (prelength-tag> a b)
    3535    (assume (
    3636      (a (pair fixnum string))
    3737      (b (pair fixnum string)) )
    3838      (> (car a) (car a)) ) )
    39   ;
    40   (define (prelength-coalesced< a b)
     39  ;NOTE descending sort order!
     40  (define (prelength-coalesced> a b)
    4141    (assume (
    4242      (a (pair fixnum list))
     
    5050      (map prelength-tag others))
    5151    (cells
    52       (sort cells prelength-tag<))
     52      (sort cells prelength-tag>))
    5353    (coalesced
    5454      (foldl
     
    7272                    (cons (cons len strs) coalesced) ) ) ) ) ) )
    7373        '()
    74         cells))
    75     (coalesced
    76       (sort coalesced prelength-coalesced<)) )
     74        cells)) )
    7775    ;longest
    78     (if (null? coalesced)
    79       #f
     76    (handler (sort coalesced prelength-coalesced>)) ) )
     77
     78;;
     79
     80(: string-longest-common-prefix (string (list-of string) --> (or boolean string)))
     81;
     82(define (string-longest-common-prefix cand others)
     83  (define (longest coalesced)
     84    (and
     85      (not (null? coalesced))
    8086      (let* (
    8187        (cell (car coalesced))
     88        (len (car cell))
    8289        (strs (cdr cell)) )
    83         (string-take (car strs) (car cell)) ) ) ) )
     90        (and (not (zero? len)) (string-take (car strs) len) ) ) ) )
     91  (*string-longest-common-prefix cand others longest) )
     92
     93#| ;BUG '("ba" "bar" "fooba") should be '(bar" "fooba") !
     94
     95==== string-longest-common-prefixes
     96
     97<procedure>(string-longest-common-prefixes STRINGS) --> (list-of string)</procedure>
     98
     99Returns the longest comment prefixes amongst the {{STRINGS}}.
     100
     101; STRINGS : {{(list-of string)}}
    84102
    85103;;
     
    94112        (pre (string-longest-common-prefix (car strs) (cdr strs)))
    95113        (pres
    96           (if (or (not pre) (string-null? pre))
     114          (if (not pre)
    97115            pres
    98116            (cons pre pres))) )
    99117          (loop (cdr strs) pres) ) ) ) )
     118|#
     119
     120#| ;this just a complicated scratchpad dump!
     121;;
     122
     123(: string-longest-common-prefix+ (string (list-of string) --> (list-of string)))
     124;
     125(define (string-longest-common-prefix+ cand others)
     126  (define (longest coalesced)
     127    (filter
     128      identity
     129      (append-map
     130        (lambda (cell)
     131          (let (
     132            (len (car cell))
     133            (strs (cdr cell)) )
     134            (if (zero? len) `(#f) (map (cut string-take <> len) strs) ) ) )
     135        coalesced)) )
     136  (*string-longest-common-prefix cand others longest) )
     137|#
    100138
    101139;;
  • release/5/string-utils/trunk/tests/string-utils-test.scm

    r38244 r38245  
    7070;;
    7171
    72 (import (prefix utf8-string-interpolator utf8:))
     72(import string-interpolation)
    7373
    74 (test-group "String Interpolator (UTF-8)"
    75   (let ((res '(##sys#print-to-string (list "听诎䞊海的 " (+ 1 2) " 䞜西埈莵"))))
    76     (test res (utf8:string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
    77     (test res (utf8:string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
    78     (test res (utf8:string-interpolate "听诎䞊海的 ${(+ 1 2)} 䞜西埈莵" eval-tag: #\$))
    79     (test res (utf8:string-interpolate "听诎䞊海的 $(+ 1 2) 䞜西埈莵" eval-tag: #\$)) )
    80 )
    81 
    82 ;;
    83 
    84 (import string-interpolator)
    85 
    86 (test-group "String Interpolator"
     74(test-group "String Interpolation"
    8775  (let ((res '(##sys#print-to-string (list "foo " (+ 1 2) " bar"))))
    8876    (test res (string-interpolate "foo #(+ 1 2) bar"))
     
    9280)
    9381
    94 ;;
     82(import (prefix utf8-string-interpolation utf8::))
     83
     84(test-group "String Interpolation (UTF-8)"
     85  (let ((res '(##sys#print-to-string (list "听诎䞊海的 " (+ 1 2) " 䞜西埈莵"))))
     86    (test res (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
     87    (test res (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
     88    (test res (utf8::string-interpolate "听诎䞊海的 ${(+ 1 2)} 䞜西埈莵" eval-tag: #\$))
     89    (test res (utf8::string-interpolate "听诎䞊海的 $(+ 1 2) 䞜西埈莵" eval-tag: #\$)) )
     90)
    9591
    9692(import string-interpolation-syntax (chicken port))
     
    9894;must be "top level"; cannot be test-group
    9995(test-begin "String Interpolation Syntax")
    100   ;
    10196  (set-sharp-string-interpolation-syntax string-interpolate)
    102   (test
    103     '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
    104     (list (call-with-input-string "#\"foo #(+ 1 2) bar\"" read)))
    10597  (test
    10698    '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
    10799    (list (call-with-input-string "#\"foo #{(+ 1 2)} bar\"" read)))
    108100  (set-sharp-string-interpolation-syntax #f)
    109   ;
    110   (set-sharp-string-interpolation-syntax (cute string-interpolate <> eval-tag: #\$))
    111   (test
    112     '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
    113     (list (call-with-input-string "#\"foo $(+ 1 2) bar\"" read)))
     101
     102  (set-sharp-string-interpolation-syntax
     103    (cute string-interpolate <> eval-tag: #\$))
    114104  (test
    115105    '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
    116106    (list (call-with-input-string "#\"foo ${(+ 1 2)} bar\"" read)))
    117107  (set-sharp-string-interpolation-syntax #f)
    118   ;
    119108(test-end "String Interpolation Syntax")
    120109
     
    130119  (let ((strs '("foobaz" "foobar" "barbaz" "barfoo" "bazfoo")))
    131120    (test "foobar" (string-longest-common-prefix "foobarbaz" strs))
     121    #; ;BUG '("ba" "bar" "fooba") should be '(bar" "fooba") !
    132122    (test '("ba" "bar" "fooba") (string-longest-common-prefixes strs)) )
    133123)
Note: See TracChangeset for help on using the changeset viewer.