OpenE2K
/
binutils-gdb
12
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Pierre Muller 2015-04-21 22:10:08 +02:00
parent 819843c702
commit 8aae434443
6 changed files with 157 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gdb/ChangeLog
View File

@ -1,3 +1,9 @@
2015-04-21 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-21 Gary Benson <gbenson@redhat.com>
* common/fileio.h (fileio_to_host_openflags): New declaration.

12
gdb/p-exp.y
View File

@ -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;
}
}

8
gdb/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2015-04-21 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-20 Gary Benson <gbenson@redhat.com>
* gdb.base/attach.exp: Fix three extended remote failures.

58
gdb/testsuite/gdb.pascal/case-insensitive-symbols.exp Normal file
View File

@ -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

63
gdb/testsuite/gdb.pascal/case-insensitive-symbols.pas Normal file
View File

@ -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.

14
gdb/testsuite/lib/pascal.exp
View File

@ -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"]