Patches de Ian Zimmerman (string_partial_match, etc)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2127 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

otherlibs/str/regex-0.12/regex.c

@@ -2261,7 +2261,9 @@ compile_range (p_ptr, pend, translate, syntax, b)
    exactly that if always used MAX_FAILURE_SPACE each time we failed.
    This is a variable only so users of regex can assign to it; we never
    change it ourselves.  */
-int re_max_failures = 2000;
+/* Xavier Leroy 14/10/1998: bumped from 2000 to 8000 because 2000
+   causes failures even with relatively simple patterns */
+int re_max_failures = 8000;
 
 typedef const unsigned char *fail_stack_elt_t;
 
@@ -3065,12 +3067,14 @@ typedef union
 
 /* Call before fetching a character with *d.  This switches over to
    string2 if necessary.  */
+/* itz Mon Sep 21 19:31:55 PDT 1998 set a flag in case we're at the
+   end, to indicate a partial match was possible. */
 #define PREFETCH()							\
   while (d == dend)						    	\
     {									\
       /* End of string2 => fail.  */					\
       if (dend == end_match_2) 						\
-        goto fail;							\
+        { partial = 1; goto fail; }					\
       /* End of string1 => advance to string2.  */ 			\
       d = string2;						        \
       dend = end_match_2;						\
@@ -3260,6 +3264,9 @@ re_match_2 (bufp, string1, size1, string2, size2, pos, regs, stop)
   const char **reg_dummy;
   register_info_type *reg_info_dummy;
 
+  /* itz Mon Sep 21 19:34:09 PDT 1998 record a partial match here */
+  int partial = 0;
+
 #ifdef DEBUG
   /* Counts the total number of registers pushed.  */
   unsigned num_regs_pushed = 0; 	
@@ -4341,7 +4348,7 @@ re_match_2 (bufp, string1, size1, string2, size2, pos, regs, stop)
 
   FREE_VARIABLES ();
 
-  return -1;         			/* Failure to match.  */
+  return (partial ? -3 : -1);   /* Failure to match.  */
 } /* re_match_2 */
 
 /* Subroutine definitions for re_match_2.  */

otherlibs/str/str.ml

@@ -15,6 +15,8 @@ type regexp
 
 external compile_regexp: string -> bool -> regexp = "str_compile_regexp"
 external string_match: regexp -> string -> int -> bool = "str_string_match"
+external string_partial_match: regexp -> string -> int -> bool =
+  "str_string_partial_match"
 external search_forward: regexp -> string -> int -> int = "str_search_forward"
 external search_backward: regexp -> string -> int -> int = "str_search_backward"
 external beginning_group: int -> int = "str_beginning_group"

otherlibs/str/str.mli

@@ -68,6 +68,10 @@ external search_forward: regexp -> string -> int -> int = "str_search_forward"
 external search_backward: regexp -> string -> int -> int = "str_search_backward"
         (* Same as [search_forward], but the search proceeds towards the
            beginning of the string. *)
+external string_partial_match: regexp -> string -> int -> bool = "str_string_partial_match"
+        (* Similar to [string_match], but succeeds whenever the argument
+           string is a prefix of a string that matches.  This includes
+           the case of a true complete match. *)
 
 val matched_string: string -> string
         (* [matched_string s] returns the substring of [s] that was matched

otherlibs/str/strstubs.c

@@ -72,10 +72,32 @@ static struct re_registers match_regs = { 10, start_regs, end_regs };
 
 value str_string_match(regexp expr, value text, value pos) /* ML */
 {
-  switch (re_match(&(expr->re), String_val(text), string_length(text),
-                   Int_val(pos), &match_regs)) {
-  case -2:
+  int len = string_length(text);
+  int start = Int_val(pos);
+  if (start < 0 || start > len)
     invalid_argument("Str.string_match");
+  switch (re_match(&(expr->re), String_val(text), len,
+                   start, &match_regs)) {
+  case -2:
+    failwith("Str.string_match");
+  case -1:
+  case -3:
+    return Val_false;
+  default:
+    return Val_true;
+  }
+}
+
+value str_string_partial_match(regexp expr, value text, value pos) /* ML */
+{
+  int len = string_length(text);
+  int start = Int_val(pos);
+  if (start < 0 || start > len)
+    invalid_argument("Str.string_partial_match");
+  switch (re_match(&(expr->re), String_val(text), len,
+                   start, &match_regs)) {
+  case -2:
+    failwith("Str.string_partial_match");
   case -1:
     return Val_false;
   default:
@@ -85,13 +107,16 @@ value str_string_match(regexp expr, value text, value pos) /* ML */
 
 value str_search_forward(regexp expr, value text, value pos) /* ML */
 {
+  int res;
   int len = string_length(text);
   int start = Int_val(pos);
-  int res = re_search(&(expr->re), String_val(text), len, start, len-start,
-                      &match_regs);
+  if (start < 0 || start > len)
+    invalid_argument("Str.search_forward");
+  res = re_search(&(expr->re), String_val(text), len, start, len-start,
+                  &match_regs);
   switch(res) {
   case -2:
-    invalid_argument("Str.search_forward");
+    failwith("Str.search_forward");
   case -1:
     raise_not_found();
   default:
@@ -101,13 +126,16 @@ value str_search_forward(regexp expr, value text, value pos) /* ML */
 
 value str_search_backward(regexp expr, value text, value pos) /* ML */
 {
+  int res;
   int len = string_length(text);
   int start = Int_val(pos);
-  int res = re_search(&(expr->re), String_val(text), len, start, -start-1,
-                      &match_regs);
+  if (start < 0 || start > len)
+    invalid_argument("Str.search_backward");
+  res = re_search(&(expr->re), String_val(text), len, start, -start-1,
+                  &match_regs);
   switch(res) {
   case -2:
-    invalid_argument("Str.search_backward");
+    failwith("Str.search_backward");
   case -1:
     raise_not_found();
   default: