[binutils-gdb/gdb-7.9-branch] Subject: [PATCH] Fix pascal behavior for class fields with testcase

[Pierre Muller <muller at sourceware dot org>]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=6ed34db8858cc18a5a941f32f22bb250017c3d48

commit 6ed34db8858cc18a5a941f32f22bb250017c3d48
Author: Pierre Muller <muller@ics.u-strasbg.fr>
Date:   Sat May 2 18:21:50 2015 +0200

    Subject: [PATCH] Fix pascal behavior for class fields with testcase
    
      Problem reported as PR pascal/17815
    
    Part 1/3: Remember the case pattern that allowed finding a field of this.
    File gdb/p-exp.y modified
    
      This is the fix in the pascal parser (p-exp.y),
    to avoid the error that GDB does find normal variables
    case insensitively, but not fields of this,
    inside a class or object method.
    
    Part 2/3: Add "class" option for pascal compiler
    File gdb/testsuite/lib/pascal.exp
    
    This part of the patch series is unchanged.
    It adds class option to pascal compiler
    which adds the required command line option to
    accept pascal class types.
    
    Part 3/3:
    New file: gdb/testsuite/gdb.pascal/case-insensitive-symbols.exp
    New file: gdb/testsuite/gdb.pascal/case-insensitive-symbols.pas
    
      Here is an updated version of this test, using Pedro's suggestions.
    Test to check that PR 17815 is fixed.

Diff:
---
 gdb/ChangeLog                                      |  6 +++
 gdb/p-exp.y                                        | 12 +++--
 gdb/testsuite/ChangeLog                            |  8 +++
 .../gdb.pascal/case-insensitive-symbols.exp        | 58 ++++++++++++++++++++
 .../gdb.pascal/case-insensitive-symbols.pas        | 63 ++++++++++++++++++++++
 gdb/testsuite/lib/pascal.exp                       | 14 +++++
 6 files changed, 157 insertions(+), 4 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 1666b5c..ff6fd50 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2015-05-02  Pierre Muller  <muller@sourceware.org>
+
+	PR pascal/17815
+	p-exp.y (yylex): Reorganize code to return the matched pattern
+	for a field of this.
+
 2015-04-28  Doug Evans  <dje@google.com>
 
 	PR python/18299
diff --git a/gdb/p-exp.y b/gdb/p-exp.y
index a1c78bf..101de09 100644
--- a/gdb/p-exp.y
+++ b/gdb/p-exp.y
@@ -1551,7 +1551,7 @@ yylex (void)
     int is_a_field = 0;
     int hextype;
 
-
+    is_a_field_of_this.type = NULL;
     if (search_field && current_type)
       is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
     if (is_a_field)
@@ -1598,15 +1598,20 @@ yylex (void)
 			      VAR_DOMAIN, &is_a_field_of_this);
       }
 
-    if (is_a_field)
+    if (is_a_field || (is_a_field_of_this.type != NULL))
       {
 	tempbuf = (char *) realloc (tempbuf, namelen + 1);
 	strncpy (tempbuf, tmp, namelen);
 	tempbuf [namelen] = 0;
 	yylval.sval.ptr = tempbuf;
 	yylval.sval.length = namelen;
+	yylval.ssym.sym = NULL;
 	free (uptokstart);
-	return FIELDNAME;
+        yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
+	if (is_a_field)
+	  return FIELDNAME;
+	else
+	  return NAME;
       }
     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
        no psymtabs (coff, xcoff, or some future change to blow away the
@@ -1739,7 +1744,6 @@ yylex (void)
     free(uptokstart);
     /* Any other kind of symbol.  */
     yylval.ssym.sym = sym;
-    yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
     return NAME;
   }
 }
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index e408252..727afe3 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2015-05-02  Pierre Muller  <muller@sourceware.org>
+
+	PR pascal/17815
+	* lib/pascal.exp (gpc_compile): Add new option "class".
+	(fpc_compile): Likewise.
+	* gdb.pascal/case-insensitive-symbols.pas: New file.
+	* gdb.pascal/case-insensitive-symbols.exp: New file.
+
 2015-04-28  Doug Evans  <dje@google.com>
 
 	* gdb.python/py-pp-maint.py: Move "replace" testing to ...
diff --git a/gdb/testsuite/gdb.pascal/case-insensitive-symbols.exp b/gdb/testsuite/gdb.pascal/case-insensitive-symbols.exp
new file mode 100644
index 0000000..4f1d150
--- /dev/null
+++ b/gdb/testsuite/gdb.pascal/case-insensitive-symbols.exp
@@ -0,0 +1,58 @@
+# Copyright 2015 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib "pascal.exp"
+
+standard_testfile .pas
+
+if {[gdb_compile_pascal "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug class]] != "" } {
+    untested $testfile.exp
+    return -1
+}
+
+clean_restart ${testfile}
+set bp_location [gdb_get_line_number "set breakpoint here"]
+
+if { ![runto ${srcfile}:${bp_location}] } {
+    return 0
+}
+
+# We are now inside CHECK method.
+gdb_test "p X" " = 67"
+gdb_test "p B.X" " = 11"
+gdb_test "p Y" " = 33"
+gdb_test "p B.Y" " = 35"
+# As A is global, we can also check its value.
+gdb_test "p A.X" " = 67"
+gdb_test "p A.Y" " = 33"
+# Now test lowercase version.
+gdb_test "p x" " = 67"
+gdb_test "p y" " = 33"
+gdb_test "p B.x" " = 11"
+gdb_test "p B.y" " = 35"
+# As A is global, we can also check its value, with lowercase.
+gdb_test "p A.x" " = 67"
+gdb_test "p A.y" " = 33"
+# Also test lowercase class names.
+gdb_test "p b.X" " = 11"
+gdb_test "p b.x" " = 11"
+gdb_test "p b.Y" " = 35"
+gdb_test "p b.y" " = 35"
+gdb_test "p a.X" " = 67"
+gdb_test "p a.x" " = 67"
+gdb_test "p a.Y" " = 33"
+gdb_test "p a.y" " = 33"
+
+gdb_exit
diff --git a/gdb/testsuite/gdb.pascal/case-insensitive-symbols.pas b/gdb/testsuite/gdb.pascal/case-insensitive-symbols.pas
new file mode 100644
index 0000000..74abea4
--- /dev/null
+++ b/gdb/testsuite/gdb.pascal/case-insensitive-symbols.pas
@@ -0,0 +1,63 @@
+{
+ Copyright 2015 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program.  If not, see <http://www.gnu.org/licenses/>.
+}
+
+
+program test_gdb_17815;
+
+
+type
+  TA = class
+  public
+  x, y : integer;
+  constructor Create;
+  function check(b : TA) : boolean;
+  destructor Done; virtual;
+end;
+
+constructor TA.Create;
+begin
+  x:=-1;
+  y:=-1;
+end;
+
+destructor TA.Done;
+begin
+end;
+
+function TA.check (b : TA) : boolean;
+begin
+  check:=(x < b.x); { set breakpoint here }
+end;
+
+
+
+var
+  a, b : TA;
+
+begin
+  a:=TA.Create;
+  b:=TA.Create;
+  a.x := 67;
+  a.y := 33;
+  b.x := 11;
+  b.y := 35;
+  if a.check (b) then
+    writeln('Error in check')
+  else
+    writeln('check OK');
+end.
+
diff --git a/gdb/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp
index 994e3da..0a2aa75 100644
--- a/gdb/testsuite/lib/pascal.exp
+++ b/gdb/testsuite/lib/pascal.exp
@@ -91,6 +91,13 @@ proc gpc_compile {source dest type options} {
 		append add_flags " -g"
 	    }
 	}
+	if { $i == "class" } {
+	    if [board_info $dest exists pascal_class_flags] {
+		append add_flags " [board_info $dest pascal_class_flags]"
+	    } else {
+		append add_flags " --extended-syntax"
+	    }
+	}
     }
 
     set result [remote_exec host $gpc_compiler "-o $dest --automake $add_flags $source"]
@@ -120,6 +127,13 @@ proc fpc_compile {source dest type options} {
 		append add_flags " -g"
 	    }
 	}
+	if { $i == "class" } {
+	    if [board_info $dest exists pascal_class_flags] {
+		append add_flags " [board_info $dest pascal_class_flags]"
+	    } else {
+		append add_flags " -Mobjfpc"
+	    }
+	}
     }
 
     set result [remote_exec host $fpc_compiler "-o$dest $add_flags $source"]