[Gd-chatter] r10997 - in trunk/src: common/regular-expressions tests

[andreas at gwydiondylan.org]

Author: andreas
Date: Tue Nov 28 22:08:37 2006
New Revision: 10997

Modified:
   trunk/src/common/regular-expressions/interface.dylan
   trunk/src/common/regular-expressions/library.dylan
   trunk/src/tests/regexp-test.dylan
Log:
job: minor

Implementation of regexp-matches by Danny Milosavljevic. This gives a more
convenient API than regexp-position, which just returns offsets, not
substrings.


Modified: trunk/src/common/regular-expressions/interface.dylan
==============================================================================
--- trunk/src/common/regular-expressions/interface.dylan	(original)
+++ trunk/src/common/regular-expressions/interface.dylan	Tue Nov 28 22:08:37 2006
@@ -201,59 +201,37 @@
 end function make-regexp-positioner;
 
 
-#if (have-free-time)
 // regexp-matches -- exported
 //
-// A more convenient form of regexp-position.  Usually you want
-// substrings that were matched by a group rather than the marks for
-// the group.  How you use this is you give the group numbers you
-// want, and it'll give you the strings.  (#f if that group wasn't
-// matched)
+// A more convenient form of regexp-position. 
+// Usually you want substrings that were matched by a group rather than the marks for the group.  
 //
 define function regexp-matches
     (big :: <string>, regexp :: <string>,
      #key start: start-index :: <integer> = 0,
           end: end-index :: false-or(<integer>),
-          case-sensitive :: <boolean> = #f,
-          groups :: false-or(<sequence>))
- => (#rest group-strings :: false-or(<string>));
-  if (~groups)
-    error("Mandatory keyword groups: not used in call to regexp-matches");
-  end if;
-  let (#rest marks)
+          case-sensitive :: <boolean> = #f)
+
+  let (regexp-start, lemon, #rest marks)
     = regexp-position(big, regexp, start: start-index, end: end-index, 
 		      case-sensitive: case-sensitive);
-  let return-val = make(<vector>, size: groups.size, fill: #f);
-  for (index from 0 below return-val.size)
-    let group-start = groups[index] * 2;
-    let group-end = group-start + 1;
-    if (element(marks, group-start, default: #f))
-      return-val[index] := copy-sequence(big, start: 
-
-  let sz = floor/(marks.size, 2);
-  let return = make(<vector>, size: sz, fill: #f);
-  for (index from 0 below sz)
-    let pos = index * 2;
-    if (element(marks, pos, default: #f))
-      return[index] := copy-sequence(big, start: marks[pos],
-				     end: marks[pos + 1]);
-    end if;
-  end for;
-  if (matches)
-    let return = make(<vector>, size: matches.size * 2);
-    for (raw-pos in matches, index from 0)
-      let src-pos = raw-pos * 2;
-      let dest-pos = index * 2;
-      return[dest-pos] := element(marks, src-pos, default: #f);
-      return[dest-pos + 1] := element(marks, src-pos + 1, default: #f);
+
+  let return-size = floor/(marks.size, 2);
+  let return = make(<vector>, size: return-size, fill: #f);
+  if (regexp-start)
+    // all groups associate by index in the result
+
+    for (index from 0 below return-size)
+      let pos = index * 2;
+      if (element(marks, pos, default: #f))
+        // "14 0", "4 5", "7 8", "9 10" for "this is a test"
+        //return[index] := concatenate(integer-to-string(marks[pos]), concatenate(" ", integer-to-string(marks[pos + 1])));
+        return[index] := copy-sequence(big, start: marks[pos], end: marks[pos + 1]);
+      end if;
     end for;
-    apply(values, return);
-  else
-    
-    apply(values, marks);
   end if;
-
-#endif
+  apply(values, return);
+end function;
 
 
 // Functions based on regexp-position

Modified: trunk/src/common/regular-expressions/library.dylan
==============================================================================
--- trunk/src/common/regular-expressions/library.dylan	(original)
+++ trunk/src/common/regular-expressions/library.dylan	Tue Nov 28 22:08:37 2006
@@ -55,6 +55,7 @@
   export
     regexp-position, make-regexp-positioner,
     regexp-replace, make-regexp-replacer,
+    regexp-matches,
     translate, make-translator,
     split, make-splitter,
     join,

Modified: trunk/src/tests/regexp-test.dylan
==============================================================================
--- trunk/src/tests/regexp-test.dylan	(original)
+++ trunk/src/tests/regexp-test.dylan	Tue Nov 28 22:08:37 2006
@@ -34,6 +34,7 @@
 
 define method main (argv0, #rest ignored)
   format-out("\nRegression test for the regular-expressions library.\n\n");
+  run-several-tests("regexp-matches", matches-test);
   run-several-tests("regexp-positioner", positioner-test);
   run-several-tests("regexp-replace", replace-test);
   run-several-tests("make-regexp-replacer", make-replacer-test);
@@ -118,6 +119,28 @@
 	   "make-substring-replacer");   
 end method substring-search-test;
 
+define method run-matches-test(big :: <string>, regexp :: <string>, expected-result, test-name)
+ => passed? :: <boolean>;
+  let (#rest matches) = regexp-matches(big, regexp);
+
+  if (matches ~= expected-result)
+    has-errors := #t;
+    format-out("Failed!\n", test-name);
+    format-out("     Got %=\n", matches);
+    format-out("     when we expected %=\n", expected-result);
+    #f;
+  else
+    #t;
+  end if;
+end method;
+
+define method matches-test()
+  /*run-test(regexp-matches("", ""), #(#f), "regexp-matches #1");*/
+  //run-test(regexp-matches("", "()"), #(#f), "regexp-matches #2");
+  run-matches-test("this is a test", "(this) (is) (a) (test)", #("this", "is", "a", "test"), "regexp-matches #3");
+  run-matches-test("this is a test", "(this) (is) (a) (x)", #(), "regexp-matches #4");
+
+end method matches-test;
 
 define method replace-test ()
   let big-string = "The rain in spain and some other text";