![]() ![]() | ![]() |
added another crash-bug to the regexp tests
1: \ regexp test 2: 3: \ Copyright (C) 2005,2007,2009 Free Software Foundation, Inc. 4: 5: \ This file is part of Gforth. 6: 7: \ Gforth is free software; you can redistribute it and/or 8: \ modify it under the terms of the GNU General Public License 9: \ as published by the Free Software Foundation, either version 3 10: \ of the License, or (at your option) any later version. 11: 12: \ This program is distributed in the hope that it will be useful, 13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of 14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15: \ GNU General Public License for more details. 16: 17: \ You should have received a copy of the GNU General Public License 18: \ along with this program. If not, see http://www.gnu.org/licenses/. 19: 20: charclass [bl-] blanks +class '-' +char 21: charclass [0-9(] '(' +char '0' '9' ..char 22: 23: : telnum ( addr u -- flag ) 24: (( {{ ` ( \( \d \d \d \) ` ) || \( \d \d \d \) }} blanks c? 25: \( \d \d \d \) [bl-] c? 26: \( \d \d \d \d \) {{ \$ || -\d }} )) ; 27: 28: : ?tel ( addr u -- ) telnum 29: IF '(' emit \1 type ." ) " \2 type '-' emit \3 type ." succeeded" 30: ELSE \0 type ." failed " THEN ; 31: 32: : ?tel-s ( addr u -- ) ?tel ." should succeed" space depth . cr ; 33: : ?tel-f ( addr u -- ) ?tel ." should fail" space depth . cr ; 34: 35: ." --- Telephone number match ---" cr 36: s" (123) 456-7890" ?tel-s 37: s" (123) 456-7890 " ?tel-s 38: s" (123)-456 7890" ?tel-f 39: s" (123) 456 789" ?tel-f 40: s" 123 456-7890" ?tel-s 41: s" 123 456-78909" ?tel-f 42: 43: : telnum2 ( addr u -- flag ) 44: (( // {{ [0-9(] -c? || \^ }} 45: {{ ` ( \( \d \d \d \) ` ) || \( \d \d \d \) }} blanks c? 46: \( \d \d \d \) [bl-] c? 47: \( \d \d \d \d \) {{ \$ || -\d }} )) ; 48: 49: : ?tel2 ( addr u -- ) telnum2 50: IF '(' emit \1 type ." ) " \2 type '-' emit \3 type ." succeeded" 51: ELSE \0 type ." failed " THEN cr ; 52: ." --- Telephone number search ---" cr 53: s" blabla (123) 456-7890" ?tel2 54: s" blabla (123) 456-7890 " ?tel2 55: s" blabla (123)-456 7890" ?tel2 56: s" blabla (123) 456 789" ?tel2 57: s" blabla 123 456-7890" ?tel2 58: s" blabla 123 456-78909" ?tel2 59: s" (123) 456-7890" ?tel2 60: s" (123) 456-7890 " ?tel2 61: s" a (123)-456 7890" ?tel2 62: s" la (123) 456 789" ?tel2 63: s" bla 123 456-7890" ?tel2 64: s" abla 123 456-78909" ?tel2 65: 66: ." --- Number extraction test ---" cr 67: 68: charclass [0-9,./:] '0' '9' ..char ',' +char '.' +char '/' +char ':' +char 69: 70: : ?num 71: (( // \( {++ [0-9,./:] c? ++} \) )) 72: IF \1 type ELSE \0 type ." failed" THEN cr ; 73: 74: s" 1234" ?num 75: s" 12,345abc" ?num 76: s" foobar12/345:678.9abc" ?num 77: s" blafasel" ?num 78: 79: ." --- String test --- " cr 80: 81: : ?string 82: (( // \( {{ =" foo" || =" bar" || =" test" }} \) )) 83: IF \1 type cr THEN ; 84: s" dies ist ein test" ?string 85: s" foobar" ?string 86: s" baz bar foo" ?string 87: s" Hier kommt nichts vor" ?string 88: 89: ." --- longer matches test --- " cr 90: 91: : ?foos 92: (( \( {** =" foo" **} \) )) 93: IF \1 type ELSE \0 type ." failed" THEN cr ; 94: 95: : ?foobars 96: (( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) )) 97: IF \1 type ',' emit \2 type ELSE \0 type ." failed" THEN cr ; 98: 99: : ?foos1 100: (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) )) 101: IF \1 type ',' emit \2 type ELSE \0 type ." failed" THEN cr ; 102: 103: s" foobar" ?foos 104: s" foofoofoobar" ?foos 105: s" fofoofoofofooofoobarbar" ?foos 106: s" bla baz bar" ?foos 107: s" foofoofoo" ?foos 108: 109: s" foobar" ?foobars 110: s" foofoofoobar" ?foobars 111: s" fofoofoofofooofoobarbar" ?foobars 112: s" bla baz bar" ?foobars 113: s" foofoofoo" ?foobars 114: 115: s" foobar" ?foos1 116: s" foofoofoobar" ?foos1 117: s" fofoofoofofooofoobarbar" ?foos1 118: s" bla baz bar" ?foos1 119: s" foofoofoo" ?foos1 120: 121: \ buffer overrun test (bug in =") 122: 123: : ?long-string 124: (( // \( =" abcdefghi" \) )) 125: IF \1 type cr THEN ; 126: 127: here 4096 allocate throw 4096 + 8 - constant test-string 128: s" abcdefgh" test-string swap cmove> 129: .( provoking overflow [i.e. see valgrind output]) cr 130: test-string . cr 131: test-string 8 ?long-string 132: .( done) cr 133: 134: \ simple replacement test 135: 136: ." --- simple replacement test ---" cr 137: 138: : delnum ( addr u -- addr' u' ) s// \d s" " //g ; 139: : test-delnum ( addr u addr' u' -- ) 140: 2swap delnum 2over 2over str= 0= IF 141: ." test-delnum: got '" type ." ', expected '" type ." '" 142: ELSE 2drop 2drop THEN ; 143: s" 0" s" " test-delnum 144: s" 00" s" " test-delnum 145: s" 0a" s" a" test-delnum 146: s" a0" s" a" test-delnum 147: s" aa" s" aa" test-delnum 148: 149: : delcomment ( addr u -- addr' u' ) s// ` # {** .? **} s" " //g ; 150: s" hello # test " delcomment type cr 151: 152: \ replacement tests 153: 154: ." --- replacement tests ---" cr 155: 156: : hms>s ( addr u -- addr' u' ) 157: s// \( \d \d \) ` : \( \d \d \) ` : \( \d \d \) 158: \1 s>number drop 60 * 159: \2 s>number drop + 60 * 160: \3 s>number drop + 0 <# 's' hold #s #> //g ; 161: 162: s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s 163: ." replaced by " 2dup type 164: s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr 165: 166: script? [IF] bye [THEN]