From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 22942 invoked by alias); 6 May 2010 23:05:23 -0000 Mailing-List: contact archer-help@sourceware.org; run by ezmlm Sender: Precedence: bulk List-Post: List-Help: List-Subscribe: List-Id: Received: (qmail 22931 invoked by uid 22791); 6 May 2010 23:05:21 -0000 X-SWARE-Spam-Status: No, hits=-4.3 required=5.0 tests=AWL,BAYES_50,RCVD_IN_DNSWL_HI,SPF_HELO_PASS,T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Date: Thu, 06 May 2010 23:05:00 -0000 From: Jan Kratochvil To: Joost van der Sluis Cc: Project Archer Subject: Re: Patch for pascal-dynamic arrays Message-ID: <20100506230504.GA21919@host0.dyn.jankratochvil.net> References: <1252939529.28930.33.camel@wsjoost.cnoc.lan> <20090916154453.GA23913@host0.dyn.jankratochvil.net> <1254326374.2755.14.camel@wsjoost.cnoc.lan> <20091004141705.GA18527@host0.dyn.jankratochvil.net> <1256751286.31305.24.camel@wsjoost.cnoc.lan> <20091030094726.GA29758@host0.dyn.jankratochvil.net> <1257630529.27675.26.camel@wsjoost.cnoc.lan> <1271071502.27845.15.camel@wsjoost.cnoc.lan> <20100412195106.GA32767@host0.dyn.jankratochvil.net> <1271241292.21465.18.camel@wsjoost.cnoc.lan> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <1271241292.21465.18.camel@wsjoost.cnoc.lan> User-Agent: Mutt/1.5.20 (2009-08-17) X-SW-Source: 2010-q2/txt/msg00020.txt.bz2 On Wed, 14 Apr 2010 12:34:52 +0200, Joost van der Sluis wrote: > On Mon, 2010-04-12 at 21:51 +0200, Jan Kratochvil wrote: > > Going to try some alternative adjustment of this part. > > Another approach could be to do a full check_typedef before the > code-block above. But then the OBJECT_ADDRESS (as used by check_typedef > to evaluate all dynamic properties) has to be set to the right > (=value_data_address) value. Iirc I've already tried that in an earlier > patch I've send. Attached patch should match it I hope. It is on top of gdb-7.1-18.fc13. No regressions on {x86_64,x86_64-m32,i686}-fedora13-linux-gnu. The gdb.pascal/arrays.exp full-PASS has been tested only for x86_64-fedora14-linux-gnu. gdb.pascal/arrays.exp requires fpc-2.4.0-1.fc14 with your FPC upstream patch r15038 as requested in Fedora Bug 589495. Do you agree with this patch or would you like some changes? I would push it only for F-14 (=Rawhide) as fpc-2.4.0+ is only there anyway. Thanks, Jan gdb/ 2010-05-07 Jan Kratochvil Joost van der Sluis * p-valprint.c: Include dwarf2loc.h. (pascal_val_print): New variables back_to, saved_type and saved_address. Initialize them. Call object_address_get_data instead of CHECK_TYPEDEF, return on its failure. Reread valaddr content if ADDRESS has changed. Pass SAVED_TYPE and SAVED_ADDRESS to val_print_array_elements. Cleanup to BACK_TO on any return code path. Never print TYPE_CODE_INT array for language_pascal as a string. * valprint.c: Include dwarf2loc.h. (val_print_array_elements): New variables back_to, saved_type and saved_address. Initialize them. Call object_address_get_data, return on its failure. Reread valaddr content if ADDRESS has changed. Cleanup to BACK_TO on any return code path. Protect ELTTYPE against check_typedef. Initialize ELTLEN by the byte stride now. Remove the TYPE_LENGTH bounds initialization possibility. * valops.c (object_address_get_data): Return now struct type *. Adjust the function comment and function code. * value.h (object_address_get_data): Likewise. gdb/testsuite/ 2010-04-12 Joost van der Sluis * gdb.pascal/arrays.exp, gdb.pascal/arrays.pas: New. * lib/pascal.exp: Added variables fpcversion_major, fpcversion_minor and fpcversion_release with the version of the used compiler. --- ./gdb/p-valprint.c 2010-01-14 09:03:36.000000000 +0100 +++ ./gdb/p-valprint.c 2010-05-07 00:17:16.000000000 +0200 @@ -38,6 +38,7 @@ #include "p-lang.h" #include "cp-abi.h" #include "cp-support.h" +#include "dwarf2loc.h" @@ -66,8 +67,27 @@ pascal_val_print (struct type *type, con struct type *char_type; LONGEST val; CORE_ADDR addr; + struct cleanup *back_to; + struct type *saved_type = type; + CORE_ADDR saved_address = address; + + back_to = make_cleanup (null_cleanup, 0); + type = object_address_get_data (type, &address); + if (type == NULL) + { + fputs_filtered (object_address_data_not_valid (saved_type), stream); + gdb_flush (stream); + do_cleanups (back_to); + return 0; + } + if (address != saved_address) + { + size_t length = TYPE_LENGTH (type); - CHECK_TYPEDEF (type); + valaddr = xmalloc (length); + make_cleanup (xfree, (gdb_byte *) valaddr); + read_memory (address, (gdb_byte *) valaddr, length); + } switch (TYPE_CODE (type)) { case TYPE_CODE_ARRAY: @@ -82,9 +102,10 @@ pascal_val_print (struct type *type, con } /* For an array of chars, print with string syntax. */ if ((eltlen == 1 || eltlen == 2 || eltlen == 4) - && ((TYPE_CODE (elttype) == TYPE_CODE_INT) - || ((current_language->la_language == language_pascal) - && (TYPE_CODE (elttype) == TYPE_CODE_CHAR))) + && ((current_language->la_language != language_pascal + && TYPE_CODE (elttype) == TYPE_CODE_INT) + || (current_language->la_language == language_pascal + && TYPE_CODE (elttype) == TYPE_CODE_CHAR)) && (options->format == 0 || options->format == 's')) { /* If requested, look for the first null char and only print @@ -122,8 +143,9 @@ pascal_val_print (struct type *type, con { i = 0; } - val_print_array_elements (type, valaddr + embedded_offset, address, stream, - recurse, options, i); + val_print_array_elements (saved_type, valaddr + embedded_offset, + saved_address, stream, recurse, options, + i); fprintf_filtered (stream, "}"); } break; @@ -161,6 +183,7 @@ pascal_val_print (struct type *type, con /* Try to print what function it points to. */ print_address_demangle (gdbarch, addr, stream, demangle); /* Return value is irrelevant except for string pointers. */ + do_cleanups (back_to); return (0); } @@ -248,6 +271,7 @@ pascal_val_print (struct type *type, con /* Return number of characters printed, including the terminating '\0' if we reached the end. val_print_string takes care including the terminating '\0' if necessary. */ + do_cleanups (back_to); return i; } break; @@ -535,6 +559,7 @@ pascal_val_print (struct type *type, con error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type)); } gdb_flush (stream); + do_cleanups (back_to); return (0); } --- ./gdb/testsuite/gdb.pascal/arrays.exp 1970-01-01 01:00:00.000000000 +0100 +++ ./gdb/testsuite/gdb.pascal/arrays.exp 2010-05-07 00:17:13.000000000 +0200 @@ -0,0 +1,104 @@ +# Copyright 2008, 2009 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 . + +if $tracelevel then { + strace $tracelevel +} + +load_lib "pascal.exp" + +set testfile "arrays" +set srcfile ${testfile}.pas +set binfile ${objdir}/${subdir}/${testfile}$EXEEXT + +# These tests only work with fpc, using the -gw3 compile-option +pascal_init +if { $pascal_compiler_is_fpc != 1 } { + return -1 +} + +# Detect if the fpc version is below 2.3.0 +set fpc_generates_dwarf_for_dynamic_arrays 1 +if { ($fpcversion_major < 2) || ( ($fpcversion_major == 2) && ($fpcversion_minor < 3))} { + set fpc_generates_dwarf_for_dynamic_arrays 0 +} + + +if {[gdb_compile_pascal "-gw3 ${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } { + return -1 +} + +gdb_exit +gdb_start +gdb_reinitialize_dir $srcdir/$subdir +gdb_load ${binfile} +set bp_location1 [gdb_get_line_number "set breakpoint 1 here"] +set bp_location2 [gdb_get_line_number "set breakpoint 2 here"] + + +if { [gdb_breakpoint ${srcfile}:${bp_location1}] } { + pass "setting breakpoint 1" +} +if { [gdb_breakpoint ${srcfile}:${bp_location2}] } { + pass "setting breakpoint 2" +} + +# Verify that "start" lands inside the right procedure. +if { [gdb_start_cmd] < 0 } { + untested start + return -1 +} + +gdb_test "" ".* at .*${srcfile}.*" "start" + +gdb_test "cont" "Breakpoint .*:${bp_location1}.*" "Going to first breakpoint" + +gdb_test "print StatArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer type" +gdb_test "print StatArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer" + +gdb_test "cont" "Breakpoint .*:${bp_location2}.*" "Going to second breakpoint" + +gdb_test "print StatArrChar" ".* = 'abcdefghijkl'" "Print static array of char" +gdb_test "print Stat2dArrInt" ".* = \\{\\{0, 1, 2, 3, 4\\}, \\{1, 2, 3, 4, 5\\}, \\{2, 3, 4, 5, 6\\}, \\{3, 4, 5, 6, 7\\}, \\{4, 5, 6, 7, 8\\}, \\{5, 6, 7, 8, 9\\}, \\{6, 7, 8, 9, 10\\}, \\{7, 8, 9, 10, 11\\}, \\{8, 9, 10, 11, 12\\}, \\{9, 10, 11, 12, 13\\}, \\{10, 11, 12, 13, 14\\}, \\{11, 12, 13, 14, 15\\}\\}" "Print static 2-dimensional array of integer" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type" +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string" + +if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { + setup_xfail "*-*-*" +} +gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char" + --- ./gdb/testsuite/gdb.pascal/arrays.pas 1970-01-01 01:00:00.000000000 +0100 +++ ./gdb/testsuite/gdb.pascal/arrays.pas 2010-05-07 00:17:13.000000000 +0200 @@ -0,0 +1,82 @@ +{ + Copyright 2008, 2009 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 arrays; + +{$mode objfpc}{$h+} + +uses sysutils; + +type TStatArrInt= array[0..11] of integer; + TDynArrInt= array of integer; + TStatArrStr= array[0..12] of string; + TDynArrStr= array of string; + TDynArrChar = array of char; + TStatArrChar = array [0..11] of char; + + TStat2dArrInt = array[0..11,0..4] of integer; + +var StatArrInt: TStatArrInt; + StatArrInt_: Array[0..11] of integer; + DynArrInt: TDynArrInt; + DynArrInt_: Array of integer; + StatArrStr: TStatArrStr; + DynArrStr: TDynArrStr; + StatArrChar: TStatArrChar; + DynArrChar: TDynArrChar; + + Stat2dArrInt: TStat2dArrInt; + + s: string; + + i,j : integer; + +begin + for i := 0 to 11 do + begin + StatArrInt[i]:= i+50; + StatArrInt_[i]:= i+50; + StatArrChar[i]:= chr(ord('a')+i); + for j := 0 to 4 do + Stat2dArrInt[i,j]:=i+j; + end; + writeln(StatArrInt_[0]); + writeln(StatArrInt[0]); { set breakpoint 1 here } + writeln(StatArrChar[0]); + writeln(Stat2dArrInt[0,0]); + + setlength(DynArrInt,13); + setlength(DynArrInt_,13); + setlength(DynArrStr,13); + setlength(DynArrChar,13); + for i := 0 to 12 do + begin + DynArrInt[i]:= i+50; + DynArrInt_[i]:= i+50; + DynArrChar[i]:= chr(ord('a')+i); + StatArrStr[i]:='str'+inttostr(i); + DynArrStr[i]:='dstr'+inttostr(i); + end; + writeln(DynArrInt_[1]); + writeln(DynArrInt[1]); + writeln(DynArrStr[1]); + writeln(StatArrStr[1]); + writeln(DynArrChar[1]); + + s := 'test'#0'string'; + writeln(s); { set breakpoint 2 here } +end. --- ./gdb/testsuite/lib/pascal.exp 2010-01-01 08:32:07.000000000 +0100 +++ ./gdb/testsuite/lib/pascal.exp 2010-05-07 00:17:13.000000000 +0200 @@ -37,6 +37,9 @@ proc pascal_init {} { global pascal_compiler_is_fpc global gpc_compiler global fpc_compiler + global fpcversion_major + global fpcversion_minor + global fpcversion_release global env if { $pascal_init_done == 1 } { @@ -64,6 +67,20 @@ proc pascal_init {} { set pascal_compiler_is_fpc 1 verbose -log "Free Pascal compiler found" } + + # Detect the fpc-version + if { $pascal_compiler_is_fpc == 1 } { + set fpcversion_major 1 + set fpcversion_minor 0 + set fpcversion_release 0 + set fpcversion [ remote_exec host $fpc_compiler "-iV" ] + if [regexp {.*([0-9]+)\.([0-9]+)\.([0-9]+).?} $fpcversion] { + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\1} fpcversion_major + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\2} fpcversion_minor + regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\3} fpcversion_release + } + verbose -log "Freepascal version: $fpcversion_major.$fpcversion_minor.$fpcversion_release" + } } set pascal_init_done 1 } --- ./gdb/valops.c 2010-05-07 00:16:49.000000000 +0200 +++ ./gdb/valops.c 2010-05-07 00:17:16.000000000 +0200 @@ -868,14 +868,15 @@ object_address_data_not_valid (struct ty return NULL; } -/* Return non-zero if the variable is valid. If it is valid the function - may store the data address (DW_AT_DATA_LOCATION) of TYPE at *ADDRESS_RETURN. - You must set *ADDRESS_RETURN from value_raw_address (VAL) before calling this - function. If no DW_AT_DATA_LOCATION is present for TYPE the address at - *ADDRESS_RETURN is left unchanged. ADDRESS_RETURN must not be NULL, use +/* Return non-NULL check_typedef result on TYPE if the variable is valid. If + it is valid the function may store the data address (DW_AT_DATA_LOCATION) of + TYPE at *ADDRESS_RETURN. You must set *ADDRESS_RETURN from + value_raw_address (VAL) before calling this function. If no + DW_AT_DATA_LOCATION is present for TYPE the address at *ADDRESS_RETURN is + left unchanged. ADDRESS_RETURN must not be NULL, use object_address_data_not_valid () for just the data validity check. */ -int +struct type * object_address_get_data (struct type *type, CORE_ADDR *address_return) { gdb_assert (address_return != NULL); @@ -890,7 +891,7 @@ object_address_get_data (struct type *ty { /* Do not try to evaluate DW_AT_data_location as it may even crash (it would just return the value zero in the gfortran case). */ - return 0; + return NULL; } if (TYPE_DATA_LOCATION_IS_ADDR (type)) @@ -899,7 +900,7 @@ object_address_get_data (struct type *ty *address_return = dwarf_locexpr_baton_eval (TYPE_DATA_LOCATION_DWARF_BLOCK (type)); - return 1; + return type; } /* Helper function for value_at, value_at_lazy, and value_at_lazy_stack. */ --- ./gdb/valprint.c 2010-05-07 00:16:49.000000000 +0200 +++ ./gdb/valprint.c 2010-05-07 00:23:48.000000000 +0200 @@ -35,6 +35,7 @@ #include "exceptions.h" #include "dfp.h" #include "python/python.h" +#include "dwarf2loc.h" #include @@ -1109,6 +1110,7 @@ val_print_array_elements (struct type *t { unsigned int things_printed = 0; unsigned len; + struct type *saved_type = type; struct type *elttype, *index_type; unsigned eltlen; /* Position of the array element we are examining to see @@ -1117,9 +1119,33 @@ val_print_array_elements (struct type *t /* Number of repetitions we have detected so far. */ unsigned int reps; long low_bound_index = 0; + struct cleanup *back_to; + CORE_ADDR saved_address = address; + + back_to = make_cleanup (null_cleanup, 0); + type = object_address_get_data (type, &address); + if (!type) + { + fputs_filtered (object_address_data_not_valid (type), stream); + do_cleanups (back_to); + return; + } + if (address != saved_address) + { + size_t length = TYPE_LENGTH (type); - elttype = TYPE_TARGET_TYPE (type); - eltlen = TYPE_LENGTH (check_typedef (elttype)); + valaddr = xmalloc (length); + make_cleanup (xfree, (gdb_byte *) valaddr); + read_memory (address, (gdb_byte *) valaddr, length); + } + + /* Skip typedefs but do not resolve TYPE_DYNAMIC. */ + elttype = saved_type; + while (TYPE_CODE (elttype) == TYPE_CODE_TYPEDEF) + elttype = TYPE_TARGET_TYPE (elttype); + elttype = TYPE_TARGET_TYPE (elttype); + + eltlen = TYPE_ARRAY_BYTE_STRIDE_VALUE (type); index_type = TYPE_INDEX_TYPE (type); /* Compute the number of elements in the array. On most arrays, @@ -1127,9 +1153,6 @@ val_print_array_elements (struct type *t is simply the size of the array divided by the size of the elements. But for arrays of elements whose size is zero, we need to look at the bounds. */ - if (eltlen != 0) - len = TYPE_LENGTH (type) / eltlen; - else { long low, hi; if (get_array_bounds (type, &low, &hi)) @@ -1203,6 +1226,8 @@ val_print_array_elements (struct type *t { fprintf_filtered (stream, "..."); } + + do_cleanups (back_to); } /* Read LEN bytes of target memory at address MEMADDR, placing the --- ./gdb/value.h 2010-05-07 00:16:49.000000000 +0200 +++ ./gdb/value.h 2010-05-07 00:17:16.000000000 +0200 @@ -349,8 +349,8 @@ extern struct value *value_from_decfloat const gdb_byte *decbytes); extern const char *object_address_data_not_valid (struct type *type); -extern int object_address_get_data (struct type *type, - CORE_ADDR *address_return); +extern struct type *object_address_get_data (struct type *type, + CORE_ADDR *address_return); extern struct value *value_at (struct type *type, CORE_ADDR addr); extern struct value *value_at_lazy (struct type *type, CORE_ADDR addr);