mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00:19 +02:00
103 lines
3.8 KiB
Scheme
103 lines
3.8 KiB
Scheme
;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
|
|
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
|
|
;;;;
|
|
;;;; Copyright (C) 1999 Free Software Foundation, Inc.
|
|
;;;;
|
|
;;;; This program is free software; you can redistribute it and/or modify
|
|
;;;; it under the terms of the GNU General Public License as published by
|
|
;;;; the Free Software Foundation; either version 2, or (at your option)
|
|
;;;; any later version.
|
|
;;;;
|
|
;;;; This program is distributed in the hope that it will be useful,
|
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;;; GNU General Public License for more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU General Public License
|
|
;;;; along with this software; see the file COPYING. If not, write to
|
|
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
|
;;;; Boston, MA 02111-1307 USA
|
|
|
|
(use-modules (test-suite lib)
|
|
(ice-9 regex))
|
|
|
|
;;; Run a regexp-substitute or regexp-substitute/global test, once
|
|
;;; providing a real port and once providing #f, requesting direct
|
|
;;; string output.
|
|
(define (vary-port func expected . args)
|
|
(pass-if "port is string port"
|
|
(equal? expected
|
|
(call-with-output-string
|
|
(lambda (port)
|
|
(apply func port args)))))
|
|
(pass-if "port is #f"
|
|
(equal? expected
|
|
(apply func #f args))))
|
|
|
|
(define (object->string obj)
|
|
(call-with-output-string
|
|
(lambda (port)
|
|
(write obj port))))
|
|
|
|
(with-test-prefix "regexp-substitute"
|
|
(let ((match
|
|
(string-match "patleft(sub1)patmid(sub2)patright"
|
|
"contleftpatleftsub1patmidsub2patrightcontright")))
|
|
(define (try expected . args)
|
|
(with-test-prefix (object->string args)
|
|
(apply vary-port regexp-substitute expected match args)))
|
|
|
|
(try "")
|
|
(try "string1" "string1")
|
|
(try "string1string2" "string1" "string2")
|
|
(try "patleftsub1patmidsub2patright" 0)
|
|
(try "hi-patleftsub1patmidsub2patright-bye" "hi-" 0 "-bye")
|
|
(try "sub1" 1)
|
|
(try "hi-sub1-bye" "hi-" 1 "-bye")
|
|
(try "hi-sub2-bye" "hi-" 2 "-bye")
|
|
(try "contleft" 'pre)
|
|
(try "contright" 'post)
|
|
(try "contrightcontleft" 'post 'pre)
|
|
(try "contrightcontleftcontrightcontleft" 'post 'pre 'post 'pre)
|
|
(try "contrightsub2sub1contleft" 'post 2 1 'pre)
|
|
(try "foosub1sub1sub1sub1bar" "foo" 1 1 1 1 "bar")))
|
|
|
|
(with-test-prefix "regexp-substitute/global"
|
|
|
|
(define (try expected . args)
|
|
(with-test-prefix (object->string args)
|
|
(apply vary-port regexp-substitute/global expected args)))
|
|
|
|
(try "" "" "" "")
|
|
(try "hi" "a(x*)b" "ab" "hi")
|
|
(try "" "a(x*)b" "ab" 1)
|
|
(try "xx" "a(x*)b" "axxb" 1)
|
|
(try "xx" "a(x*)b" "_axxb_" 1)
|
|
(try "pre" "a(x*)b" "preaxxbpost" 'pre)
|
|
(try "post" "a(x*)b" "preaxxbpost" 'post)
|
|
(try "string" "x" "string" 'pre "y" 'post)
|
|
(try "4" "a(x*)b" "_axxb_" (lambda (m)
|
|
(number->string (match:end m 1))))
|
|
|
|
(try "_aybycyd_" "x+" "_axbxxcxxxd_" 'pre "y" 'post)
|
|
|
|
;; This should not go into an infinite loop, just because the regexp
|
|
;; can match the empty string. This test also kind of beats on our
|
|
;; definition of where a null string can match.
|
|
(try "y_yaybycydy_y" "x*" "_axbxxcxxxd_" 'pre "y" 'post)
|
|
|
|
;; These kind of bother me. The extension from regexp-substitute to
|
|
;; regexp-substitute/global is only natural if your item list
|
|
;; includes both pre and post. If those are required, why bother
|
|
;; to include them at all?
|
|
(try "4:7:12:_" "a(x*)b" "_axxbaxbaxxxb_"
|
|
(lambda (m) (number->string (match:end m 1))) ":"
|
|
'post)
|
|
(try "4:10:19:_:19:10:4" "a(x*)b" "_axxbaxxxxbaxxxxxxxb_"
|
|
(lambda (m) (number->string (match:end m 1))) ":"
|
|
'post
|
|
":" (lambda (m) (number->string (match:end m 1))))
|
|
|
|
;; Jan Nieuwenhuizen's bug, 2 Sep 1999
|
|
(try "" "_" (make-string 500 #\_)
|
|
'post))
|