;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id: tests.lisp,v 1.15 2003/06/06 21:59:30 kevin Exp $
+;;;; $Id: tests.lisp,v 1.16 2003/06/07 03:51:42 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
(kmrcl::xml-tag-contents-old "tag1" "<tag>Test</tag>")
nil nil)
+(deftest fss.1
+ (kmrcl::fast-string-search "" "" 0 0 0) 0)
+
+(deftest fss.2
+ (kmrcl::fast-string-search "" "abc" 0 0 2) 0)
+
+(deftest fss.3
+ (kmrcl::fast-string-search "abc" "" 3 0 0) nil)
+
+(deftest fss.4
+ (kmrcl::fast-string-search "abc" "abcde" 3 0 4) 0)
+
+(deftest fss.5
+ (kmrcl::fast-string-search "abc" "012abcde" 3 0 7) 3)
+
+(deftest fss.6
+ (kmrcl::fast-string-search "abc" "012abcde" 3 0 7) 3)
+
+(deftest fss.7
+ (kmrcl::fast-string-search "abc" "012abcde" 3 3 7) 3)
+
+(deftest fss.8
+ (kmrcl::fast-string-search "abc" "012abcde" 3 4 7) nil)
+
+(deftest fss.9
+ (kmrcl::fast-string-search "abcde" "012abcde" 5 3 8) 3)
+
+(deftest fss.10
+ (kmrcl::fast-string-search "abcde" "012abcde" 5 3 7) nil)
+
;;; MOP Testing
(eval-when (:compile-toplevel :load-toplevel :execute)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: xml-utils.lisp,v 1.8 2003/06/06 21:59:30 kevin Exp $
+;;;; $Id: xml-utils.lisp,v 1.9 2003/06/07 03:51:42 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(setq done t))))
(values startpos endpos nextpos)))
+(defun fast-string-search (substr str substr-length startpos endpos)
+ (declare (simple-string substr str)
+ (fixnum substr-length startpos endpos)
+ (optimize (speed 3) (space 0) (safety 0)))
+ (do* ((pos startpos (1+ pos))
+ (lastpos (- endpos substr-length)))
+ ((> pos lastpos) nil)
+ (declare (fixnum pos lastpos))
+ (do ((i 0 (1+ i)))
+ ((= i substr-length)
+ (return-from fast-string-search pos))
+ (declare (fixnum i))
+ (unless (char= (schar str (+ i pos)) (schar substr i))
+ (return nil)))))
+
(defun find-start-tag (tag taglen xmlstr start-pos end-xmlstr)
- (let ((bracketpos (position-char #\< xmlstr start-pos end-xmlstr)))
+ (let ((bracketpos (seaposition-char #\< xmlstr start-pos end-xmlstr)))
(when bracketpos
(let* ((starttag (1+ bracketpos))
(endtag (+ starttag taglen)))