version 1.2, 2005/12/31 15:46:10
|
version 1.11, 2010/09/04 22:27:22
|
Line 1
|
Line 1
|
\ regexp test |
\ regexp test |
|
|
\ Copyright (C) 2005 Free Software Foundation, Inc. |
\ Copyright (C) 2005,2007,2009 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
charclass [bl-] blanks +class '- +char |
charclass [bl-] blanks +class '-' +char |
charclass [0-9(] '( +char '0 '9 ..char |
charclass [0-9(] '(' +char '0' '9' ..char |
|
|
: telnum ( addr u -- flag ) |
: telnum ( addr u -- flag ) |
(( {{ ` ( \( \d \d \d \) ` ) || \( \d \d \d \) }} blanks c? |
(( {{ ` ( \( \d \d \d \) ` ) || \( \d \d \d \) }} blanks c? |
Line 27 charclass [0-9(] '( +char '0 '9 ..char
|
Line 26 charclass [0-9(] '( +char '0 '9 ..char
|
\( \d \d \d \d \) {{ \$ || -\d }} )) ; |
\( \d \d \d \d \) {{ \$ || -\d }} )) ; |
|
|
: ?tel ( addr u -- ) telnum |
: ?tel ( addr u -- ) telnum |
IF '( emit \1 type ." ) " \2 type '- emit \3 type ." succeeded" |
IF '(' emit \1 type ." ) " \2 type '-' emit \3 type ." succeeded" |
ELSE \0 type ." failed " THEN ; |
ELSE \0 type ." failed " THEN ; |
|
|
: ?tel-s ( addr u -- ) ?tel ." should succeed" space depth . cr ; |
: ?tel-s ( addr u -- ) ?tel ." should succeed" space depth . cr ; |
Line 48 s" 123 456-78909" ?tel-f
|
Line 47 s" 123 456-78909" ?tel-f
|
\( \d \d \d \d \) {{ \$ || -\d }} )) ; |
\( \d \d \d \d \) {{ \$ || -\d }} )) ; |
|
|
: ?tel2 ( addr u -- ) telnum2 |
: ?tel2 ( addr u -- ) telnum2 |
IF '( emit \1 type ." ) " \2 type '- emit \3 type ." succeeded" |
IF '(' emit \1 type ." ) " \2 type '-' emit \3 type ." succeeded" |
ELSE \0 type ." failed " THEN cr ; |
ELSE \0 type ." failed " THEN cr ; |
." --- Telephone number search ---" cr |
." --- Telephone number search ---" cr |
s" blabla (123) 456-7890" ?tel2 |
s" blabla (123) 456-7890" ?tel2 |
Line 66 s" abla 123 456-78909" ?tel2
|
Line 65 s" abla 123 456-78909" ?tel2
|
|
|
." --- Number extraction test ---" cr |
." --- Number extraction test ---" cr |
|
|
charclass [0-9,./:] '0 '9 ..char ', +char '. +char '/ +char ': +char |
charclass [0-9,./:] '0' '9' ..char ',' +char '.' +char '/' +char ':' +char |
|
|
: ?num |
: ?num |
(( // \( {++ [0-9,./:] c? ++} \) )) |
(( // \( {++ [0-9,./:] c? ++} \) )) |
Line 95 s" Hier kommt nichts vor" ?string
|
Line 94 s" Hier kommt nichts vor" ?string
|
|
|
: ?foobars |
: ?foobars |
(( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) )) |
(( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) )) |
IF \1 type ', emit \2 type ELSE \0 type ." failed" THEN cr ; |
IF \1 type ',' emit \2 type ELSE \0 type ." failed" THEN cr ; |
|
|
: ?foos1 |
: ?foos1 |
(( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) )) |
(( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) )) |
IF \1 type ', emit \2 type ELSE \0 type ." failed" THEN cr ; |
IF \1 type ',' emit \2 type ELSE \0 type ." failed" THEN cr ; |
|
|
s" foobar" ?foos |
s" foobar" ?foos |
s" foofoofoobar" ?foos |
s" foofoofoobar" ?foos |
Line 119 s" fofoofoofofooofoobarbar" ?foos1
|
Line 118 s" fofoofoofofooofoobarbar" ?foos1
|
s" bla baz bar" ?foos1 |
s" bla baz bar" ?foos1 |
s" foofoofoo" ?foos1 |
s" foofoofoo" ?foos1 |
|
|
|
\ buffer overrun test (bug in =") |
|
|
|
: ?long-string |
|
(( // \( =" abcdefghi" \) )) |
|
IF \1 type cr THEN ; |
|
|
|
here 4096 allocate throw 4096 + 8 - constant test-string |
|
s" abcdefgh" test-string swap cmove> |
|
.( provoking overflow [i.e. see valgrind output]) cr |
|
test-string . cr |
|
test-string 8 ?long-string |
|
.( done) cr |
|
|
|
\ simple replacement test |
|
|
|
." --- simple replacement test ---" cr |
|
|
|
: delnum ( addr u -- addr' u' ) s// \d s" " //g ; |
|
: test-delnum ( addr u addr' u' -- ) |
|
2swap delnum 2over 2over str= 0= IF |
|
." test-delnum: got '" type ." ', expected '" type ." '" |
|
ELSE 2drop 2drop THEN ; |
|
s" 0" s" " test-delnum |
|
s" 00" s" " test-delnum |
|
s" 0a" s" a" test-delnum |
|
s" a0" s" a" test-delnum |
|
s" aa" s" aa" test-delnum |
|
|
|
: delcomment ( addr u -- addr' u' ) s// ` # {** .? **} s" " //g ; |
|
s" hello # test " delcomment type cr |
|
|
|
\ replacement tests |
|
|
|
." --- replacement tests ---" cr |
|
|
|
: hms>s ( addr u -- addr' u' ) |
|
s// \( \d \d \) ` : \( \d \d \) ` : \( \d \d \) |
|
\1 s>number drop 60 * |
|
\2 s>number drop + 60 * |
|
\3 s>number drop + 0 <# 's' hold #s #> //g ; |
|
|
|
s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s |
|
." replaced by " 2dup type |
|
s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr |
|
|
script? [IF] bye [THEN] |
script? [IF] bye [THEN] |