From: Pierre Muller Date: Tue, 21 Apr 2015 20:10:08 +0000 (+0200) Subject: Fix pascal behavior for class fields with testcase X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8aae434443df61440ff5228f5c8fe3e5d4a38798;p=binutils-gdb.git 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 --git a/gdb/ChangeLog b/gdb/ChangeLog index f5ef884c017..27f7fdf0297 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,9 @@ +2015-04-21 Pierre Muller + + PR pascal/17815 + p-exp.y (yylex): Reorganize code to return the matched pattern + for a field of this. + 2015-04-21 Gary Benson * common/fileio.h (fileio_to_host_openflags): New declaration. diff --git a/gdb/p-exp.y b/gdb/p-exp.y index c214cf1aa90..9e2dc829d7f 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 8692a0b8925..04ec209e4ee 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2015-04-21 Pierre Muller + + 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-20 Gary Benson * gdb.base/attach.exp: Fix three extended remote failures. 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 00000000000..4f1d1502e97 --- /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 . + +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 00000000000..74abea498ec --- /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 . +} + + +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 da724f3e518..b6eb90c90bc 100644 --- a/gdb/testsuite/lib/pascal.exp +++ b/gdb/testsuite/lib/pascal.exp @@ -93,6 +93,13 @@ proc gpc_compile {source destfile 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 $destfile --automake $add_flags $source"] @@ -124,6 +131,13 @@ proc fpc_compile {source destfile 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$destfile $add_flags $source"]