[RFC] Pascal language: case insensitivity!

[Pierre Muller <muller at cerbere dot u-strasbg dot fr>]

   I have code in my local source tree that allow GDB to cope with the 
case insensitivity of pascal language (at least partially).

  The diffs are at the bottom of this file.
The way I implemented is to define a new function
extern int re_iexec _RE_ARGS ((char *,int));
that does a case sensitive (normal) search if the second arg is zero
while the search becomes insensitive if the second arg is non zero
in practice the second arg is
  (current_language.language == language_pascal)
for now, but there might be other case insensitive languages supported.
(I even don't know if Modula 2 is case sensitive or not).

  Practically I added also
extern int create_case_insensitive_translate_buffer _RE_ARGS (());
extern int reset_translate_buffer _RE_ARGS (());
functions to create the translations.

  I already talked a while ago about this and someone (can't remember who)
said that there is a much simpler way to get this result.
I would of course really like to know more about this possibility.

  The diffs below are not a patch as such, I only append them to show 
the amont of code that is involved in this feature,
which isn't that huge in fact.

  By the way, gnu-regex still has PARAMS stuff in it !
is the  _RE_ARGS macro still to be kept  or should it be removed as 
PARAMS ?
 


Index: gnu-regex.c
===================================================================
RCS file: /cvs/src/src/gdb/gnu-regex.c,v
retrieving revision 1.4
diff -c -r1.4 gnu-regex.c
*** gnu-regex.c	2000/05/31 21:26:47	1.4
--- gnu-regex.c	2000/06/19 10:34:44
***************
*** 5480,5485 ****
--- 5480,5486 ----
  
  /* BSD has one and only one pattern buffer.  */
  static struct re_pattern_buffer re_comp_buf;
+ static RE_TRANSLATE_TYPE case_insensitive_buffer;
  
  char *
  #ifdef _LIBC
***************
*** 5538,5543 ****
--- 5539,5616 ----
    const int len = strlen (s);
    return
      0 <= re_search (&re_comp_buf, s, len, 0, len, (struct re_registers *)
0);
+ }
+ 
+ /* allocates a unique translation buffer for insensitive search */
+ /* FIXME this buffer is never disposed */
+ 
+ int create_case_insensitive_translate_buffer ()
+ {
+   int i;
+       if (!case_insensitive_buffer)
+    {
+     case_insensitive_buffer = (RE_TRANSLATE_TYPE) malloc (CHAR_SET_SIZE
+ 				      * sizeof (*(RE_TRANSLATE_TYPE)0));
+     if (case_insensitive_buffer == NULL)
+       return (int) REG_ESPACE;
+ 
+     /* Map uppercase characters to corresponding lowercase ones.  */
+     for (i = 0; i < CHAR_SET_SIZE; i++)
+       case_insensitive_buffer[i] = ISLOWER (i) ? toupper (i) : i;
+    }
+ 
+   /* Use this for re_comp called after */
+   re_comp_buf.translate = case_insensitive_buffer;
+ 
+   return 0;
+ }
+ 
+ int reset_translate_buffer ()
+ {
+   int i;
+   if (case_insensitive_buffer)
+     free(case_insensitive_buffer);
+   /* Use this for re_comp called after */
+   re_comp_buf.translate = NULL;
+   return 0;
+ }
+ 
+ int
+ re_iexec (s,insensitive)
+     char *s;
+     int insensitive;
+ {
+   RE_TRANSLATE_TYPE store_translate;
+   struct re_pattern_buffer  private_preg;
+   const int len = strlen (s);
+   int res;
+   if (insensitive)
+     {
+       unsigned i;
+       if (!case_insensitive_buffer)
+         {
+           int res = create_case_insensitive_translate_buffer();
+           if (res)
+             return res;
+         }
+       store_translate = re_comp_buf.translate;
+       re_comp_buf.translate = case_insensitive_buffer;
+ 
+       for (i = 0; i < len; i++)
+         if (ISLOWER(s[i]))
+           s[i] = toupper (s[i]);
+     }
+   else
+     {
+       store_translate = re_comp_buf.translate;
+       re_comp_buf.translate = case_insensitive_buffer;
+ 
+     }
+   res = re_search (&re_comp_buf, s, len, 0, len, (struct re_registers *) 0);
+ 
+   re_comp_buf.translate = store_translate;
+   return
+      0 <= res;
  }
  
  #endif /* _REGEX_RE_COMP */
Index: gnu-regex.h
===================================================================
RCS file: /cvs/src/src/gdb/gnu-regex.h,v
retrieving revision 1.1.1.4
diff -c -r1.1.1.4 gnu-regex.h
*** gnu-regex.h	1999/10/12 04:37:21	1.1.1.4
--- gnu-regex.h	2000/06/19 10:34:45
***************
*** 536,543 ****
--- 536,547 ----
  #ifdef _REGEX_RE_COMP
  # ifndef _CRAY
  /* 4.2 bsd compatibility.  */
+ extern int create_case_insensitive_translate_buffer _RE_ARGS (());
+ extern int reset_translate_buffer _RE_ARGS (());
  extern char *re_comp _RE_ARGS ((const char *));
  extern int re_exec _RE_ARGS ((const char *));
+ extern int re_iexec _RE_ARGS ((char *,int));
+ 
  # endif
  #endif
Index: source.c
===================================================================
RCS file: /cvs/src/src/gdb/source.c,v
retrieving revision 1.3
diff -c -r1.3 source.c
*** source.c	2000/05/28 01:12:29	1.3
--- source.c	2000/06/19 10:34:52
*************
*** 1587,1593 ****
  
        /* we now have a source line in buf, null terminate and match */
        *p = 0;
!       if (re_exec (buf) > 0)
  	{
  	  /* Match! */
  	  fclose (stream);
--- 1587,1593 ----
  
        /* we now have a source line in buf, null terminate and match */
        *p = 0;
!     if (re_iexec (buf,(int) (current_language->la_language ==
language_pascal)) > 0)
  	{
  	  /* Match! */
  	  fclose (stream);
***************
*** 1697,1703 ****
  
        /* We now have a source line in buf; null terminate and match.  */
        *p = 0;
!       if (re_exec (buf) > 0)
  	{
  	  /* Match! */
  	  fclose (stream);
--- 1697,1703 ----
  
        /* We now have a source line in buf; null terminate and match.  */
        *p = 0;
!       if (re_iexec (buf,(int) (current_language->la_language ==
language_pascal)) > 0)
  	{
  	  /* Match! */
  	  fclose (stream);
Index: symtab.c
===================================================================
RCS file: /cvs/src/src/gdb/symtab.c,v
retrieving revision 1.8
diff -c -r1.8 symtab.c
*** symtab.c	2000/06/14 00:59:07	1.8
--- symtab.c	2000/06/19 10:35:10
***************
*** 3677,3682 ****
--- 3677,3690 ----
  	    }
  	}
  
+       if (current_language->la_language == language_pascal)
+         {
+           create_case_insensitive_translate_buffer();
+         }
+       else
+         {
+           reset_translate_buffer();
+         }
        if (0 != (val = re_comp (regexp)))
  	error ("Invalid regexp (%s): %s", val, regexp);
      }
***************



Pierre Muller
Institut Charles Sadron
6,rue Boussingault
F 67083 STRASBOURG CEDEX (France)
mailto:muller@ics.u-strasbg.fr
Phone : (33)-3-88-41-40-07  Fax : (33)-3-88-41-40-99