[pascal patch] Use case_sensitive_off [Re: Regression for gdb.pascal/* [Re: [RFA 4/4] Constify parse_linesepc]]

Jan Kratochvil jan.kratochvil@redhat.com
Fri Oct 18 19:09:00 GMT 2013


On Fri, 18 Oct 2013 19:20:32 +0200, Jan Kratochvil wrote:
> Case insensitive symbols should be supported (originally written for Fortran)
> since:
> 	commit 5b7743a275e4610fe6ea57f0c61e317490ee6854
> 	Date:   Wed Apr 27 20:03:03 2011 +0000
> 		Case insensitive lookups implementation.
> (+about one fallout later)
> 
> While f_language_defn has case_sensitive_off
> I see that pascal_language_defn has case_sensitive_on.

p-exp.y currently contains:
      sym = lookup_symbol (tmp, expression_context_block,
    /* second chance uppercased (as Free Pascal does).  */
         sym = lookup_symbol (tmp, expression_context_block,
    /* Third chance Capitalized (as GPC does).  */
         sym = lookup_symbol (tmp, expression_context_block,

which works for fpc -g or fpc -gw2 capitalizing the symbols.

But it no longer works for -gw3 or -gw4 where fpc keeps the original case:
 <1><83>: Abbrev Number: 2 (DW_TAG_variable)
    <84>   DW_AT_name        : st       

with "set case-sensitive off" it works fine:

(gdb) p st
$1 = 0x626700 #13'Hello, world!'
(gdb) p sT
No symbol "sT" in current context.
(gdb) set case-sensitive off 
warning: the current case sensitivity setting does not match the language.
(gdb) p sT
$2 = 0x626700 #13'Hello, world!'

I do not know much about Pascal in GDB but do you think this is OK?

The patch is on top of Keith's one.


Thanks,
Jan


gdb/
2013-10-18  Jan Kratochvil  <jan.kratochvil@redhat.com>

	* p-exp.y (uptok): Remove variable i, remove the uppercasing.
	Update function comment.
	(yylex): Replace strcmp calls for strcasecmp.  Remove uppercasing and
	capitalizing of symbols.
	* p-lang.c (pascal_language_defn): Use case_sensitive_off.

diff --git a/gdb/p-exp.y b/gdb/p-exp.y
index 8cb98c0..af338e1 100644
--- a/gdb/p-exp.y
+++ b/gdb/p-exp.y
@@ -1102,20 +1102,14 @@ static const struct token tokentab2[] =
     {":=", ASSIGN, BINOP_END},
     {"::", COLONCOLON, BINOP_END} };
 
-/* Allocate uppercased var: */
-/* make an uppercased copy of tokstart.  */
+/* Allocate a duplicate of NAMELEN length. */
+
 static char *
 uptok (const char *tokstart, int namelen)
 {
-  int i;
   char *uptokstart = (char *)malloc(namelen+1);
-  for (i = 0;i <= namelen;i++)
-    {
-      if ((tokstart[i]>='a' && tokstart[i]<='z'))
-        uptokstart[i] = tokstart[i]-('a'-'A');
-      else
-        uptokstart[i] = tokstart[i];
-    }
+
+  memcpy (uptokstart, tokstart, namelen);
   uptokstart[namelen]='\0';
   return uptokstart;
 }
@@ -1448,29 +1442,29 @@ yylex (void)
   switch (namelen)
     {
     case 6:
-      if (strcmp (uptokstart, "OBJECT") == 0)
+      if (strcasecmp (uptokstart, "OBJECT") == 0)
 	{
 	  free (uptokstart);
 	  return CLASS;
 	}
-      if (strcmp (uptokstart, "RECORD") == 0)
+      if (strcasecmp (uptokstart, "RECORD") == 0)
 	{
 	  free (uptokstart);
 	  return STRUCT;
 	}
-      if (strcmp (uptokstart, "SIZEOF") == 0)
+      if (strcasecmp (uptokstart, "SIZEOF") == 0)
 	{
 	  free (uptokstart);
 	  return SIZEOF;
 	}
       break;
     case 5:
-      if (strcmp (uptokstart, "CLASS") == 0)
+      if (strcasecmp (uptokstart, "CLASS") == 0)
 	{
 	  free (uptokstart);
 	  return CLASS;
 	}
-      if (strcmp (uptokstart, "FALSE") == 0)
+      if (strcasecmp (uptokstart, "FALSE") == 0)
 	{
           yylval.lval = 0;
 	  free (uptokstart);
@@ -1478,13 +1472,13 @@ yylex (void)
         }
       break;
     case 4:
-      if (strcmp (uptokstart, "TRUE") == 0)
+      if (strcasecmp (uptokstart, "TRUE") == 0)
 	{
           yylval.lval = 1;
 	  free (uptokstart);
   	  return TRUEKEYWORD;
         }
-      if (strcmp (uptokstart, "SELF") == 0)
+      if (strcasecmp (uptokstart, "SELF") == 0)
         {
           /* Here we search for 'this' like
              inserted in FPC stabs debug info.  */
@@ -1542,44 +1536,6 @@ yylex (void)
     else
       sym = lookup_symbol (tmp, expression_context_block,
 			   VAR_DOMAIN, &is_a_field_of_this);
-    /* second chance uppercased (as Free Pascal does).  */
-    if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
-      {
-       for (i = 0; i <= namelen; i++)
-         {
-           if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
-             tmp[i] -= ('a'-'A');
-         }
-       if (search_field && current_type)
-	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
-       if (is_a_field || parse_completion)
-	 sym = NULL;
-       else
-	 sym = lookup_symbol (tmp, expression_context_block,
-			      VAR_DOMAIN, &is_a_field_of_this);
-      }
-    /* Third chance Capitalized (as GPC does).  */
-    if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
-      {
-       for (i = 0; i <= namelen; i++)
-         {
-           if (i == 0)
-             {
-              if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
-                tmp[i] -= ('a'-'A');
-             }
-           else
-           if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
-             tmp[i] -= ('A'-'a');
-          }
-       if (search_field && current_type)
-	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
-       if (is_a_field || parse_completion)
-	 sym = NULL;
-       else
-	 sym = lookup_symbol (tmp, expression_context_block,
-			      VAR_DOMAIN, &is_a_field_of_this);
-      }
 
     if (is_a_field)
       {
diff --git a/gdb/p-lang.c b/gdb/p-lang.c
index 07006cd..a26c0c4 100644
--- a/gdb/p-lang.c
+++ b/gdb/p-lang.c
@@ -417,7 +417,7 @@ const struct language_defn pascal_language_defn =
   "pascal",			/* Language name */
   language_pascal,
   range_check_on,
-  case_sensitive_on,
+  case_sensitive_off,
   array_row_major,
   macro_expansion_no,
   &exp_descriptor_standard,



More information about the Gdb-patches mailing list