* [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support
@ 2016-02-08 13:47 Walfred Tedeschi
2016-02-09 11:36 ` Joel Brobecker
0 siblings, 1 reply; 18+ messages in thread
From: Walfred Tedeschi @ 2016-02-08 13:47 UTC (permalink / raw)
To: qiyaoltc, Joel Brobecker, Heckel, Bernhard, Walfred Tedeschi,
keven.boell
Cc: gdb-patches
> Keven Boell <keven.boell@linux.intel.com> writes:
>
>> Fortran provide types whose values may be dynamically allocated
>> or associated with a variable under explicit program control.
>> The purpose of this commit is
>> * to read allocated/associated DWARF tags and store them in
>> the dynamic property list of main_type.
>> * enable GDB to print the value of a dynamic array in Fortran
>> in case the type is allocated or associated (pointer to
>> dynamic array).
>>
>> Examples:
>> (gdb) p vla_not_allocated
>> $1 = <not allocated>
>>
>> (gdb) p vla_allocated
>> $1 = (1, 2, 3)
>>
>> (gdb) p vla_ptr_not_associated
>> $1 = <not associated>
>>
>> (gdb) p vla_ptr_associated
>> $1 = (1, 2, 3)
>>
>> Add basic test coverage for most dynamic array use-cases
>> in Fortran.
>> The commit contains the following tests:
>> * Ensure that values of Fortran dynamic arrays
>> can be evaluated correctly in various ways and states.
>> * Ensure that Fortran primitives can be evaluated
>> correctly when used as a dynamic array.
>> * Dynamic arrays passed to subroutines and handled
>> in different ways inside the routine.
>> * Ensure that the ptype of dynamic arrays in
>> Fortran can be printed in GDB correctly.
>> * Ensure that dynamic arrays in different states
>> (allocated/associated) can be evaluated.
>> * Dynamic arrays passed to functions and returned from
>> functions.
>> * History values of dynamic arrays can be accessed and
>> printed again with the correct values.
>> * Dynamic array evaluations using MI protocol.
>> * Sizeof output of dynamic arrays in various states.
>>
>> The patch was tested using the test suite on Ubuntu 12.04 64bit.
>
> Hi Keven,
> The test cases added by this commit fail on some other OS and targets,
> see this thread,
https://sourceware.org/ml/gdb-testers/2015-q4/msg02136.html
> can you take a look?
>
Hi Yao, Joel,
I don't think I will be able to fix the failures on the mentioned
hosts/targets before you
create the branch, as I need to replicate the environment on my end
first to start investigating.
Therefore I suggest to revert the change for now. Sorry if this caused
any inconvenience.
Joel and Yao,
Bernhard and I we have investigated the issues reported. Issues were
reproduced by using the newest GCC. Looks like the issues are
independent from the target at first sight.
Issues could be divided into 3 categories:
1. Issue root causes to GCC 5.x and Fortran "associated" intrinsic.
Compiler is not reporting the “Associated property correctly. (see test
case 1)
Affected tests:
gdb.fortran/vla-ptype.exp: ptype pvla not initialized
gdb.fortran/vla-value.exp: print undefined pvla
gdb.fortran/vla-value.exp: print non-associated &pvla
gdb.fortran/vla-value.exp: print undefined pvla(1,3,8)
gdb.mi/mi-vla-fortran.exp: evaluate not associated vla
gdb.mi/mi-vla-fortran.exp: create local variable pvla2_not_associated
gdb.mi/mi-vla-fortran.exp: info type variable pvla2_not_associated
2. Test issues. Test take into account that array created is
initialized by default. Initialization depends on the compiler also
Fortran standard does not state the need for initialization.
Affected tests:
gdb.mi/mi-vla-fortran.exp: evaluate allocated vla
3. GCC or GDB error. Breakpoint is completely off, breakpoint on return
line is triggered before the execution of the functions body. Deeper
investigation should be done to define the real issue.
Affected tests:
gdb.cp/vla-cxx.exp
Snippets of what is not working properly are presented below:
---------------------
1.
program vla
real, target, allocatable :: vla1 (:, :, :)
real, pointer :: pvla (:, :, :)
logical :: l
logical :: is_associated
integer location
allocate (vla1 (10,10,10))
l = allocated(vla1)
vla1(:, :, :) = 1311
is_associated = .FALSE.
is_associated = associated(pvla) !!! <-- HERE: Compiler reports
pvla as associated, it should not be.
location = LOC(pvla)
write (*,*) "pvla is associated: ", is_associated
write (*,*) "Location of pvla is: ",location
pvla => vla1 ! is associated here!
l = associated(pvla)
end program vla
We intend to add a GCC defect in bugzilla. Do you agree?
---------------------
2.
Source file: gdb.mi/VLA.F90
real, pointer :: pvla2 (:, :)
logical :: l
allocate (vla1 (5))
vla1(:) = 0; !!! Missing line: Test consider that array is
initialized, but standard does not enforce that.
l = allocated(vla1)
vla1(:) = 1
vla1(2) = 42
vla1(4) = 24
-> We are going to prepare a patch for that.
---------------------
3.
Compile & run: gdb.cp/vlx-cxx
Execute in GDB
break 48
run
next
Next shows beginning of “main” and not the code where the
breakpoint was hit.
Reading symbols from ../gdb/testsuite/gdb.cp/vla-cxx...done.
(gdb) b 48
Breakpoint 1 at 0x4005ae: file ../../../gdb/testsuite/gdb.cp/vla-cxx.cc,
line 48.
(gdb) r
Starting program: ../gdb/testsuite/gdb.cp/vla-cxx
Breakpoint 1, main (argc=1, argv=0x7fffffffda28)
at ../../../gdb/testsuite/gdb.cp/vla-cxx.cc:48
48 return vla[2];
(gdb) n
36 int z = 3;
(gdb) n
38 int vla[z];
->We will investigate the root cause here. GDB or debug information is
wrong here.
Thanks and regards,
Bernhard & Fred
Intel Deutschland GmbH
Registered Address: Am Campeon 10-12, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de
Managing Directors: Christin Eisenschmid, Christian Lamprechter
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928
^ permalink raw reply [flat|nested] 18+ messages in thread* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2016-02-08 13:47 [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support Walfred Tedeschi @ 2016-02-09 11:36 ` Joel Brobecker 2016-02-09 15:14 ` Walfred Tedeschi 0 siblings, 1 reply; 18+ messages in thread From: Joel Brobecker @ 2016-02-09 11:36 UTC (permalink / raw) To: Walfred Tedeschi; +Cc: qiyaoltc, Heckel, Bernhard, keven.boell, gdb-patches > I don't think I will be able to fix the failures on the mentioned > hosts/targets before you > create the branch, as I need to replicate the environment on my end first to > start investigating. > Therefore I suggest to revert the change for now. Sorry if this caused any > inconvenience. We need a good reason for reverting (Eg: regressions in pre-existing features). From what i read below: > Bernhard and I we have investigated the issues reported. Issues were > reproduced by using the newest GCC. Looks like the issues are independent > from the target at first sight. > > Issues could be divided into 3 categories: > > 1. Issue root causes to GCC 5.x and Fortran "associated" intrinsic. > Compiler is not reporting the “Associated property correctly. (see test case > 1) > Affected tests: > gdb.fortran/vla-ptype.exp: ptype pvla not initialized > gdb.fortran/vla-value.exp: print undefined pvla > gdb.fortran/vla-value.exp: print non-associated &pvla > gdb.fortran/vla-value.exp: print undefined pvla(1,3,8) > gdb.mi/mi-vla-fortran.exp: evaluate not associated vla > gdb.mi/mi-vla-fortran.exp: create local variable pvla2_not_associated > gdb.mi/mi-vla-fortran.exp: info type variable pvla2_not_associated > > 2. Test issues. Test take into account that array created is initialized by > default. Initialization depends on the compiler also Fortran standard does > not state the need for initialization. > Affected tests: > gdb.mi/mi-vla-fortran.exp: evaluate allocated vla > > 3. GCC or GDB error. Breakpoint is completely off, breakpoint on return > line is triggered before the execution of the functions body. Deeper > investigation should be done to define the real issue. > Affected tests: > gdb.cp/vla-cxx.exp Are these regressions? Or just showing that the new feature are not working well with the newer GCC? I fear that, reverting central changes at this stage could destabilize the branch, and therefore we need to be very careful as to what we do. -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2016-02-09 11:36 ` Joel Brobecker @ 2016-02-09 15:14 ` Walfred Tedeschi 0 siblings, 0 replies; 18+ messages in thread From: Walfred Tedeschi @ 2016-02-09 15:14 UTC (permalink / raw) To: Joel Brobecker; +Cc: qiyaoltc, Heckel, Bernhard, keven.boell, gdb-patches Am 2/9/2016 um 12:36 PM schrieb Joel Brobecker: >> I don't think I will be able to fix the failures on the mentioned >> hosts/targets before you >> create the branch, as I need to replicate the environment on my end first to >> start investigating. >> Therefore I suggest to revert the change for now. Sorry if this caused any >> inconvenience. > > We need a good reason for reverting (Eg: regressions in pre-existing > features). From what i read below: > >> Bernhard and I we have investigated the issues reported. Issues were >> reproduced by using the newest GCC. Looks like the issues are independent >> from the target at first sight. >> >> Issues could be divided into 3 categories: >> >> 1. Issue root causes to GCC 5.x and Fortran "associated" intrinsic. >> Compiler is not reporting the “Associated property correctly. (see test case >> 1) >> Affected tests: >> gdb.fortran/vla-ptype.exp: ptype pvla not initialized >> gdb.fortran/vla-value.exp: print undefined pvla >> gdb.fortran/vla-value.exp: print non-associated &pvla >> gdb.fortran/vla-value.exp: print undefined pvla(1,3,8) >> gdb.mi/mi-vla-fortran.exp: evaluate not associated vla >> gdb.mi/mi-vla-fortran.exp: create local variable pvla2_not_associated >> gdb.mi/mi-vla-fortran.exp: info type variable pvla2_not_associated >> >> 2. Test issues. Test take into account that array created is initialized by >> default. Initialization depends on the compiler also Fortran standard does >> not state the need for initialization. >> Affected tests: >> gdb.mi/mi-vla-fortran.exp: evaluate allocated vla >> >> 3. GCC or GDB error. Breakpoint is completely off, breakpoint on return >> line is triggered before the execution of the functions body. Deeper >> investigation should be done to define the real issue. >> Affected tests: >> gdb.cp/vla-cxx.exp > > Are these regressions? Or just showing that the new feature are > not working well with the newer GCC? > > I fear that, reverting central changes at this stage could > destabilize the branch, and therefore we need to be very careful > as to what we do. > Joel, What we have seen is that the GCC 5.x is causing the issue. On Fedora 22 we used a Vanilla GCC version 5.3.1 testing mainline GDB and Fedora GDB (7.9.1-20.fc22) we run only the Fortran testsuite. Results were: GDB mainline: 463 passes and 6 fails. GDB Fedora: 449 passes and 20 fails. A bit more about the categories: 1. Associate intrinsic does not work even from the compiler itself. I.e. When one adds the associated (pvla) in the code where test stops to evaluate it returns true. No chance for the debugger here. (we will add a defect for GFORTRAN) 2. Test issue still there. Testing for initialized array where it is not needed. 3. GDB Fedora has the same behavior when the breakpoint at the last line is hit, function's body was still not executed. However, this has to be further investigated. Is really the Compiler which is generating bad information? In this sense we do not see any of the issues as regressions from the debugger point of view. Thanks and regards, Fred & Bernhard. Intel Deutschland GmbH Registered Address: Am Campeon 10-12, 85579 Neubiberg, Germany Tel: +49 89 99 8853-0, www.intel.de Managing Directors: Christin Eisenschmid, Christian Lamprechter Chairperson of the Supervisory Board: Nicole Lau Registered Office: Munich Commercial Register: Amtsgericht Muenchen HRB 186928 ^ permalink raw reply [flat|nested] 18+ messages in thread
* [PATCH 0/2] fort_dyn_array: Enable basic Fortran dynamic array support @ 2015-07-01 12:42 Keven Boell 2015-07-01 12:42 ` [PATCH 1/2] fort_dyn_array: add basic fortran dyn " Keven Boell 0 siblings, 1 reply; 18+ messages in thread From: Keven Boell @ 2015-07-01 12:42 UTC (permalink / raw) To: gdb-patches; +Cc: Keven Boell This patch series add basic Fortran dynamic array support to gdb. It allows the user to evaluate a dynamic array like an ordinary static array e.g. print its elements instead of printing the pointer to the array. In addition the size of a dynamic array can be retrieved with gdbs builtin sizeof operator. 1| integer, allocatable :: ary(:) 2| allocate(ary(5)) 3| ary(:) = 42 (gdb) print ary $1 = (42, 42, 42, 42, 42) (gdb) print sizeof (ary) $2 = 20 (gdb) ptype ary type = integer(kind=4) (5) This series is a follow up for the following C99 variable length array support series: https://sourceware.org/ml/gdb-patches/2013-12/msg00625.html Keven Boell (2): fort_dyn_array: add basic fortran dyn array support fort_dyn_array: add basic test coverage gdb/dwarf2loc.c | 11 ++ gdb/dwarf2loc.h | 4 + gdb/dwarf2read.c | 16 ++ gdb/f-typeprint.c | 20 +++ gdb/gdbtypes.c | 33 +++- gdb/gdbtypes.h | 28 +++ gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 ++++++++++++++++++++ gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ gdb/valarith.c | 9 +- gdb/valprint.c | 36 ++++ gdb/valprint.h | 4 + 25 files changed, 1360 insertions(+), 6 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp create mode 100644 gdb/testsuite/gdb.mi/vla.f90 -- 1.7.9.5 ^ permalink raw reply [flat|nested] 18+ messages in thread
* [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-07-01 12:42 [PATCH 0/2] fort_dyn_array: Enable basic Fortran dynamic " Keven Boell @ 2015-07-01 12:42 ` Keven Boell 2015-07-21 18:05 ` Joel Brobecker 0 siblings, 1 reply; 18+ messages in thread From: Keven Boell @ 2015-07-01 12:42 UTC (permalink / raw) To: gdb-patches; +Cc: Keven Boell Fortran provide types whose values may be dynamically allocated or associated with a variable under explicit program control. The purpose of this commit is * to read allocated/associated DWARF tags and store them in the dynamic property list of main_type. * enable GDB to print the value of a dynamic array in Fortran in case the type is allocated or associated (pointer to dynamic array). Examples: (gdb) p vla_not_allocated $1 = <not allocated> (gdb) p vla_allocated $1 = (1, 2, 3) (gdb) p vla_ptr_not_associated $1 = <not associated> (gdb) p vla_ptr_associated $1 = (1, 2, 3) 2015-03-13 Keven Boell <keven.boell@intel.com> * dwarf2loc.c (dwarf2_address_data_valid): New function. * dwarf2loc.h (dwarf2_address_data_valid): New function. * dwarf2read.c (set_die_type): Add read of DW_AT_allocated and DW_AT_associated. * f-typeprint.c (f_print_type): Add check for allocated/associated status of type. (f_type_print_varspec_suffix): Add check for allocated/associated status of type. * gdbtypes.c (create_array_type_with_stride): Add check for valid data location of type in case allocated or associated attributes are set. Length of an array should be only calculated if allocated or associated is resolved as true. (is_dynamic_type_internal): Add check for allocated/ associated. (resolve_dynamic_array): Evaluate allocated/associated properties. Since at the end of the function a new array type will be created where the length is calculated the properties need to be resolved before. * gdbtypes.h (enum dynamic_prop_node_kind): Add allocated/associated. Add convenient macros to handle allocated/associated. * valarith.c (value_subscripted_rvalue): Add check for allocated/associated. * valprint.c (valprint_check_validity): Add check for allocated/associated. (val_print_not_allocated): New function. (val_print_not_associated): New function. (value_check_printable): Add check for allocated/ associated. * valprint.h (val_print_not_allocated): New function. (val_print_not_associated): New function. --- gdb/dwarf2loc.c | 11 +++++++++++ gdb/dwarf2loc.h | 4 ++++ gdb/dwarf2read.c | 16 ++++++++++++++++ gdb/f-typeprint.c | 20 ++++++++++++++++++++ gdb/gdbtypes.c | 33 ++++++++++++++++++++++++++++----- gdb/gdbtypes.h | 28 ++++++++++++++++++++++++++++ gdb/valarith.c | 9 ++++++++- gdb/valprint.c | 36 ++++++++++++++++++++++++++++++++++++ gdb/valprint.h | 4 ++++ 9 files changed, 155 insertions(+), 6 deletions(-) diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c index c75767e..c4a43ca 100644 --- a/gdb/dwarf2loc.c +++ b/gdb/dwarf2loc.c @@ -2576,6 +2576,17 @@ dwarf2_compile_property_to_c (struct ui_file *stream, data, data + size, per_cu); } +int +dwarf2_address_data_valid (const struct type *type) +{ + if (TYPE_NOT_ASSOCIATED (type)) + return 0; + + if (TYPE_NOT_ALLOCATED (type)) + return 0; + + return 1; +} \f /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */ diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h index f3630ac..c664c4d 100644 --- a/gdb/dwarf2loc.h +++ b/gdb/dwarf2loc.h @@ -155,6 +155,10 @@ void dwarf2_compile_property_to_c (struct ui_file *stream, CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu, unsigned int addr_index); +/* Checks if a dwarf location definition is valid. + Returns 1 if valid; 0 otherwise. */ +extern int dwarf2_address_data_valid (const struct type *type); + /* The symbol location baton types used by the DWARF-2 reader (i.e. SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct dwarf2_locexpr_baton" is for a symbol with a single location diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index 496b74f..69caa04 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -22263,6 +22263,22 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) && !HAVE_GNAT_AUX_INFO (type)) INIT_GNAT_SPECIFIC (type); + /* Read DW_AT_allocated and set in type. */ + attr = dwarf2_attr (die, DW_AT_allocated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); + } + + /* Read DW_AT_associated and set in type. */ + attr = dwarf2_attr (die, DW_AT_associated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); + } + /* Read DW_AT_data_location and set in type. */ attr = dwarf2_attr (die, DW_AT_data_location, cu); if (attr_to_dynamic_prop (attr, die, cu, &prop)) diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 4957e1f..50efbdb 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -30,6 +30,7 @@ #include "gdbcore.h" #include "target.h" #include "f-lang.h" +#include "valprint.h" #if 0 /* Currently unused. */ static void f_type_print_args (struct type *, struct ui_file *); @@ -53,6 +54,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, enum type_code code; int demangled_args; + if (TYPE_NOT_ASSOCIATED (type)) + { + val_print_not_associated (stream); + return; + } + + if (TYPE_NOT_ALLOCATED (type)) + { + val_print_not_allocated (stream); + return; + } + f_type_print_base (type, stream, show, level); code = TYPE_CODE (type); if ((varstring != NULL && *varstring != '\0') @@ -167,6 +180,12 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, if (arrayprint_recurse_level == 1) fprintf_filtered (stream, "("); + if (TYPE_NOT_ASSOCIATED (type)) + val_print_not_associated (stream); + else if (TYPE_NOT_ALLOCATED (type)) + val_print_not_allocated (stream); + else + { if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, arrayprint_recurse_level); @@ -189,6 +208,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, arrayprint_recurse_level); + } if (arrayprint_recurse_level == 1) fprintf_filtered (stream, ")"); else diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index ca86fbd..05cd795 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1068,7 +1068,8 @@ create_array_type_with_stride (struct type *result_type, TYPE_CODE (result_type) = TYPE_CODE_ARRAY; TYPE_TARGET_TYPE (result_type) = element_type; - if (has_static_range (TYPE_RANGE_DATA (range_type))) + if (has_static_range (TYPE_RANGE_DATA (range_type)) + && dwarf2_address_data_valid (result_type)) { LONGEST low_bound, high_bound; @@ -1806,6 +1807,12 @@ is_dynamic_type_internal (struct type *type, int top_level) || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) return 1; + if (TYPE_ASSOCIATED_PROP (type)) + return 1; + + if (TYPE_ALLOCATED_PROP (type)) + return 1; + switch (TYPE_CODE (type)) { case TYPE_CODE_RANGE: @@ -1923,6 +1930,8 @@ resolve_dynamic_array (struct type *type, struct type *elt_type; struct type *range_type; struct type *ary_dim; + struct type *copy = copy_type (type); + struct dynamic_prop *prop; gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); @@ -1930,16 +1939,30 @@ resolve_dynamic_array (struct type *type, range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); range_type = resolve_dynamic_range (range_type, addr_stack); + /* Resolve allocated/associated here before creating a new array type, which + will update the length of the array accordingly. */ + prop = TYPE_ALLOCATED_PROP (copy); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + prop = TYPE_ASSOCIATED_PROP (copy); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) - elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack); + elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr_stack); else elt_type = TYPE_TARGET_TYPE (type); - return create_array_type_with_stride (copy_type (type), - elt_type, range_type, - TYPE_FIELD_BITSIZE (type, 0)); + return create_array_type_with_stride (copy, + elt_type, range_type, TYPE_FIELD_BITSIZE (type, 0)); } /* Resolve dynamic bounds of members of the union TYPE to static diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index fd3bc0e..ebed54c 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -440,6 +440,16 @@ enum dynamic_prop_node_kind /* A property providing a type's data location. Evaluating this field yields to the location of an object's data. */ DYN_PROP_DATA_LOCATION, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicates that the object of the type can be allocated/deallocated. + The value can be a dwarf expression, reference, or a constant. */ + DYN_PROP_ALLOCATED, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicated that the object of the type can be associated. The value can be + a dwarf expression, reference, or a constant.*/ + DYN_PROP_ASSOCIATED, }; /* * List for dynamic type attributes. */ @@ -1266,6 +1276,24 @@ extern void allocate_gnat_aux_type (struct type *); #define TYPE_DATA_LOCATION_KIND(thistype) \ TYPE_DATA_LOCATION (thistype)->kind +/* Property accessors for the type allocated/associated. */ +#define TYPE_ALLOCATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) +#define TYPE_ASSOCIATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) + +/* Allocated status of type object. If set to non-zero it means the object + is allocated. A zero value means it is not allocated. */ +#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \ + && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (t)) == PROP_CONST \ + && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (t))) + +/* Associated status of type object. If set to non-zero it means the object + is associated. A zero value means it is not associated. */ +#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \ + && TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (t)) == PROP_CONST \ + && !TYPE_DYN_PROP_ADDR (TYPE_ASSOCIATED_PROP (t))) + /* Attribute accessors for dynamic properties. */ #define TYPE_DYN_PROP_LIST(thistype) \ TYPE_MAIN_TYPE(thistype)->dyn_prop_list diff --git a/gdb/valarith.c b/gdb/valarith.c index df1e8c3..9c959b3 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) && elt_offs >= TYPE_LENGTH (array_type))) - error (_("no such vector element")); + { + if (TYPE_NOT_ASSOCIATED (array_type)) + error (_("no such vector element because not associated")); + else if (TYPE_NOT_ALLOCATED (array_type)) + error (_("no such vector element because not allocated")); + else + error (_("no such vector element")); + } if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) v = allocate_value_lazy (elt_type); diff --git a/gdb/valprint.c b/gdb/valprint.c index 294c6a8..55bd59f 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -303,6 +303,18 @@ valprint_check_validity (struct ui_file *stream, { CHECK_TYPEDEF (type); + if (TYPE_NOT_ASSOCIATED (type)) + { + val_print_not_associated (stream); + return 0; + } + + if (TYPE_NOT_ALLOCATED (type)) + { + val_print_not_allocated (stream); + return 0; + } + if (TYPE_CODE (type) != TYPE_CODE_UNION && TYPE_CODE (type) != TYPE_CODE_STRUCT && TYPE_CODE (type) != TYPE_CODE_ARRAY) @@ -359,6 +371,18 @@ val_print_invalid_address (struct ui_file *stream) fprintf_filtered (stream, _("<invalid address>")); } +void +val_print_not_allocated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not allocated>")); +} + +void +val_print_not_associated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not associated>")); +} + /* A generic val_print that is suitable for use by language implementations of the la_val_print method. This function can handle most type codes, though not all, notably exception @@ -833,6 +857,18 @@ value_check_printable (struct value *val, struct ui_file *stream, return 0; } + if (TYPE_NOT_ASSOCIATED (value_type (val))) + { + val_print_not_associated (stream); + return 0; + } + + if (TYPE_NOT_ALLOCATED (value_type (val))) + { + val_print_not_allocated (stream); + return 0; + } + return 1; } diff --git a/gdb/valprint.h b/gdb/valprint.h index ed4964f..1210b83 100644 --- a/gdb/valprint.h +++ b/gdb/valprint.h @@ -232,4 +232,8 @@ extern void print_command_parse_format (const char **expp, const char *cmdname, struct format_data *fmtp); extern void print_value (struct value *val, const struct format_data *fmtp); +extern void val_print_not_allocated (struct ui_file *stream); + +extern void val_print_not_associated (struct ui_file *stream); + #endif -- 1.7.9.5 ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-07-01 12:42 ` [PATCH 1/2] fort_dyn_array: add basic fortran dyn " Keven Boell @ 2015-07-21 18:05 ` Joel Brobecker 2015-08-05 13:41 ` Keven Boell 2015-08-05 13:47 ` Keven Boell 0 siblings, 2 replies; 18+ messages in thread From: Joel Brobecker @ 2015-07-21 18:05 UTC (permalink / raw) To: Keven Boell; +Cc: gdb-patches Keven, First off, please merge the patch modifying the code and the patch addings tests. On Wed, Jul 01, 2015 at 02:42:11PM +0200, Keven Boell wrote: > Fortran provide types whose values may be dynamically allocated > or associated with a variable under explicit program control. > The purpose of this commit is > * to read allocated/associated DWARF tags and store them in > the dynamic property list of main_type. > * enable GDB to print the value of a dynamic array in Fortran > in case the type is allocated or associated (pointer to > dynamic array). > > Examples: > (gdb) p vla_not_allocated > $1 = <not allocated> > > (gdb) p vla_allocated > $1 = (1, 2, 3) > > (gdb) p vla_ptr_not_associated > $1 = <not associated> > > (gdb) p vla_ptr_associated > $1 = (1, 2, 3) > > 2015-03-13 Keven Boell <keven.boell@intel.com> > > * dwarf2loc.c (dwarf2_address_data_valid): New > function. > * dwarf2loc.h (dwarf2_address_data_valid): New > function. > * dwarf2read.c (set_die_type): Add read of > DW_AT_allocated and DW_AT_associated. > * f-typeprint.c (f_print_type): Add check for > allocated/associated status of type. > (f_type_print_varspec_suffix): Add check for > allocated/associated status of type. > * gdbtypes.c (create_array_type_with_stride): > Add check for valid data location of type in > case allocated or associated attributes are set. > Length of an array should be only calculated if > allocated or associated is resolved as true. > (is_dynamic_type_internal): Add check for allocated/ > associated. > (resolve_dynamic_array): Evaluate allocated/associated > properties. Since at the end of the function a new > array type will be created where the length is > calculated the properties need to be resolved before. > * gdbtypes.h (enum dynamic_prop_node_kind): Add > allocated/associated. > Add convenient macros to handle allocated/associated. > * valarith.c (value_subscripted_rvalue): Add check for > allocated/associated. > * valprint.c (valprint_check_validity): Add check for > allocated/associated. > (val_print_not_allocated): New function. > (val_print_not_associated): New function. > (value_check_printable): Add check for allocated/ > associated. > * valprint.h (val_print_not_allocated): New function. > (val_print_not_associated): New function. > --- > gdb/dwarf2loc.c | 11 +++++++++++ > gdb/dwarf2loc.h | 4 ++++ > gdb/dwarf2read.c | 16 ++++++++++++++++ > gdb/f-typeprint.c | 20 ++++++++++++++++++++ > gdb/gdbtypes.c | 33 ++++++++++++++++++++++++++++----- > gdb/gdbtypes.h | 28 ++++++++++++++++++++++++++++ > gdb/valarith.c | 9 ++++++++- > gdb/valprint.c | 36 ++++++++++++++++++++++++++++++++++++ > gdb/valprint.h | 4 ++++ > 9 files changed, 155 insertions(+), 6 deletions(-) > > diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c > index c75767e..c4a43ca 100644 > --- a/gdb/dwarf2loc.c > +++ b/gdb/dwarf2loc.c > @@ -2576,6 +2576,17 @@ dwarf2_compile_property_to_c (struct ui_file *stream, > data, data + size, per_cu); > } > > +int > +dwarf2_address_data_valid (const struct type *type) All function definitions should have an introductory comment. If the function documentation is provided alongside a declaration, please add a trivial comment saying that. That way, we know the function is documentation, and we know where. For instance, in this case, just add: /* See dwarf2loc.h. */ Also, I don't find the function name very descriptive. Can we come up with something a little more expressive? I tried to come up with some suggestions such as maybe "dwarf2_type_data_has_valid_address", but even then it's not very satisfactory, because, really, it's about two concepts combined together into one name, and the name doesn't really give a clue about those concepts. Perhaps it's might be just as easy to get rid of this function, and just inline its contents in the one location where it is being used? > +{ > + if (TYPE_NOT_ASSOCIATED (type)) > + return 0; > + > + if (TYPE_NOT_ALLOCATED (type)) > + return 0; > + > + return 1; > +} > \f > /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */ > > diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h > index f3630ac..c664c4d 100644 > --- a/gdb/dwarf2loc.h > +++ b/gdb/dwarf2loc.h > @@ -155,6 +155,10 @@ void dwarf2_compile_property_to_c (struct ui_file *stream, > CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu, > unsigned int addr_index); > > +/* Checks if a dwarf location definition is valid. > + Returns 1 if valid; 0 otherwise. */ > +extern int dwarf2_address_data_valid (const struct type *type); If the function stays, then the description will need to be updated to give a little more information. "a dwarf location definition" doesn't say which. It's actually two possible attributes, etc etc. > + > /* The symbol location baton types used by the DWARF-2 areader (i.e. > SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct > dwarf2_locexpr_baton" is for a symbol with a single location > diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c > index 496b74f..69caa04 100644 > --- a/gdb/dwarf2read.c > +++ b/gdb/dwarf2read.c > @@ -22263,6 +22263,22 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) > && !HAVE_GNAT_AUX_INFO (type)) > INIT_GNAT_SPECIFIC (type); > > + /* Read DW_AT_allocated and set in type. */ > + attr = dwarf2_attr (die, DW_AT_allocated, cu); > + if (attr_form_is_block (attr)) > + { > + if (attr_to_dynamic_prop (attr, die, cu, &prop)) > + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); > + } > + > + /* Read DW_AT_associated and set in type. */ > + attr = dwarf2_attr (die, DW_AT_associated, cu); > + if (attr_form_is_block (attr)) > + { > + if (attr_to_dynamic_prop (attr, die, cu, &prop)) > + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); > + } Why the check for attr_form_is_block, here? If that's important, what should we do if it's not a block? At the very least, if we are going to ignore non-block attributes, we typically issue a complaint... > + > /* Read DW_AT_data_location and set in type. */ > attr = dwarf2_attr (die, DW_AT_data_location, cu); > if (attr_to_dynamic_prop (attr, die, cu, &prop)) > diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c > index 4957e1f..50efbdb 100644 > --- a/gdb/f-typeprint.c > +++ b/gdb/f-typeprint.c > @@ -30,6 +30,7 @@ > #include "gdbcore.h" > #include "target.h" > #include "f-lang.h" > +#include "valprint.h" > > #if 0 /* Currently unused. */ > static void f_type_print_args (struct type *, struct ui_file *); > @@ -53,6 +54,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, > enum type_code code; > int demangled_args; > > + if (TYPE_NOT_ASSOCIATED (type)) > + { > + val_print_not_associated (stream); > + return; > + } > + > + if (TYPE_NOT_ALLOCATED (type)) > + { > + val_print_not_allocated (stream); > + return; > + } > + > f_type_print_base (type, stream, show, level); > code = TYPE_CODE (type); > if ((varstring != NULL && *varstring != '\0') > @@ -167,6 +180,12 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, > if (arrayprint_recurse_level == 1) > fprintf_filtered (stream, "("); > > + if (TYPE_NOT_ASSOCIATED (type)) > + val_print_not_associated (stream); > + else if (TYPE_NOT_ALLOCATED (type)) > + val_print_not_allocated (stream); > + else > + { > if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) > f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, > arrayprint_recurse_level); > @@ -189,6 +208,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, > if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) > f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, > arrayprint_recurse_level); > + } You will need to re-indent the code you put in the "else" block. > if (arrayprint_recurse_level == 1) > fprintf_filtered (stream, ")"); > else > diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c > index ca86fbd..05cd795 100644 > --- a/gdb/gdbtypes.c > +++ b/gdb/gdbtypes.c > @@ -1068,7 +1068,8 @@ create_array_type_with_stride (struct type *result_type, > > TYPE_CODE (result_type) = TYPE_CODE_ARRAY; > TYPE_TARGET_TYPE (result_type) = element_type; > - if (has_static_range (TYPE_RANGE_DATA (range_type))) > + if (has_static_range (TYPE_RANGE_DATA (range_type)) > + && dwarf2_address_data_valid (result_type)) > { > LONGEST low_bound, high_bound; > > @@ -1806,6 +1807,12 @@ is_dynamic_type_internal (struct type *type, int top_level) > || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) > return 1; > > + if (TYPE_ASSOCIATED_PROP (type)) > + return 1; > + > + if (TYPE_ALLOCATED_PROP (type)) > + return 1; > + > switch (TYPE_CODE (type)) > { > case TYPE_CODE_RANGE: > @@ -1923,6 +1930,8 @@ resolve_dynamic_array (struct type *type, > struct type *elt_type; > struct type *range_type; > struct type *ary_dim; > + struct type *copy = copy_type (type); > + struct dynamic_prop *prop; This is causing an extra copy to every singly array type that happens to be dynamic, including the ones that do not have either of the allocated/associated properties. We cannot do that. > > gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); > > @@ -1930,16 +1939,30 @@ resolve_dynamic_array (struct type *type, > range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); > range_type = resolve_dynamic_range (range_type, addr_stack); > > + /* Resolve allocated/associated here before creating a new array type, which > + will update the length of the array accordingly. */ > + prop = TYPE_ALLOCATED_PROP (copy); > + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) > + { > + TYPE_DYN_PROP_ADDR (prop) = value; > + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; > + } > + prop = TYPE_ASSOCIATED_PROP (copy); > + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) > + { > + TYPE_DYN_PROP_ADDR (prop) = value; > + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; > + } > + > ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); > > if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) > - elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack); > + elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr_stack); > else > elt_type = TYPE_TARGET_TYPE (type); Since we're doing all the work on the "copy", now, I suggest we change the reference to "type" by "copy" instead. In fact, I'm thinking we can just get rid of the local variable "copy" and just overwrite "type". That way, no risk of confusion about which one to use. > > - return create_array_type_with_stride (copy_type (type), > - elt_type, range_type, > - TYPE_FIELD_BITSIZE (type, 0)); > + return create_array_type_with_stride (copy, > + elt_type, range_type, TYPE_FIELD_BITSIZE (type, 0)); > } > > /* Resolve dynamic bounds of members of the union TYPE to static > diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h > index fd3bc0e..ebed54c 100644 > --- a/gdb/gdbtypes.h > +++ b/gdb/gdbtypes.h > @@ -440,6 +440,16 @@ enum dynamic_prop_node_kind > /* A property providing a type's data location. > Evaluating this field yields to the location of an object's data. */ > DYN_PROP_DATA_LOCATION, > + > + /* A property representing DW_AT_allocated. The presence of this attribute > + indicates that the object of the type can be allocated/deallocated. > + The value can be a dwarf expression, reference, or a constant. */ > + DYN_PROP_ALLOCATED, > + > + /* A property representing DW_AT_allocated. The presence of this attribute > + indicated that the object of the type can be associated. The value can be > + a dwarf expression, reference, or a constant.*/ > + DYN_PROP_ASSOCIATED, I would simply drop the explanation of these new properties, since you explicitly reference DWARF attributes, for which documentation is already available. That way, we won't have to update that if things change on the DWARF side. > }; > > /* * List for dynamic type attributes. */ > @@ -1266,6 +1276,24 @@ extern void allocate_gnat_aux_type (struct type *); > #define TYPE_DATA_LOCATION_KIND(thistype) \ > TYPE_DATA_LOCATION (thistype)->kind > > +/* Property accessors for the type allocated/associated. */ > +#define TYPE_ALLOCATED_PROP(thistype) \ > + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) > +#define TYPE_ASSOCIATED_PROP(thistype) \ > + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) > + > +/* Allocated status of type object. If set to non-zero it means the object > + is allocated. A zero value means it is not allocated. */ > +#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \ > + && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (t)) == PROP_CONST \ > + && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (t))) Please create a function for this. > +/* Associated status of type object. If set to non-zero it means the object > + is associated. A zero value means it is not associated. */ > +#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \ > + && TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (t)) == PROP_CONST \ > + && !TYPE_DYN_PROP_ADDR (TYPE_ASSOCIATED_PROP (t))) Same here. > /* Attribute accessors for dynamic properties. */ > #define TYPE_DYN_PROP_LIST(thistype) \ > TYPE_MAIN_TYPE(thistype)->dyn_prop_list > diff --git a/gdb/valarith.c b/gdb/valarith.c > index df1e8c3..9c959b3 100644 > --- a/gdb/valarith.c > +++ b/gdb/valarith.c > @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) > > if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) > && elt_offs >= TYPE_LENGTH (array_type))) > - error (_("no such vector element")); > + { > + if (TYPE_NOT_ASSOCIATED (array_type)) > + error (_("no such vector element because not associated")); Suggest "no such vector element (vector not associated)" instead. > + else if (TYPE_NOT_ALLOCATED (array_type)) > + error (_("no such vector element because not allocated")); Same idea: Suggest "no such vector element (vector not allocated)" instead. > + else > + error (_("no such vector element")); > + } > > if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) > v = allocate_value_lazy (elt_type); > diff --git a/gdb/valprint.c b/gdb/valprint.c > index 294c6a8..55bd59f 100644 > --- a/gdb/valprint.c > +++ b/gdb/valprint.c > @@ -303,6 +303,18 @@ valprint_check_validity (struct ui_file *stream, > { > CHECK_TYPEDEF (type); > > + if (TYPE_NOT_ASSOCIATED (type)) > + { > + val_print_not_associated (stream); > + return 0; > + } > + > + if (TYPE_NOT_ALLOCATED (type)) > + { > + val_print_not_allocated (stream); > + return 0; > + } > + > if (TYPE_CODE (type) != TYPE_CODE_UNION > && TYPE_CODE (type) != TYPE_CODE_STRUCT > && TYPE_CODE (type) != TYPE_CODE_ARRAY) > @@ -359,6 +371,18 @@ val_print_invalid_address (struct ui_file *stream) > fprintf_filtered (stream, _("<invalid address>")); > } > > +void > +val_print_not_allocated (struct ui_file *stream) > +{ > + fprintf_filtered (stream, _("<not allocated>")); > +} > + > +void > +val_print_not_associated (struct ui_file *stream) > +{ > + fprintf_filtered (stream, _("<not associated>")); > +} Missing introductory comment for each functioino. I don't think these functions belong in valprint.c. Suggest typeprint.h instead. You probably followed the example of val_print_unavailable, but this function isn't used in typeprint, unlike yours. > /* A generic val_print that is suitable for use by language > implementations of the la_val_print method. This function can > handle most type codes, though not all, notably exception > @@ -833,6 +857,18 @@ value_check_printable (struct value *val, struct ui_file *stream, > return 0; > } > > + if (TYPE_NOT_ASSOCIATED (value_type (val))) > + { > + val_print_not_associated (stream); > + return 0; > + } > + > + if (TYPE_NOT_ALLOCATED (value_type (val))) > + { > + val_print_not_allocated (stream); > + return 0; > + } > + > return 1; > } > > diff --git a/gdb/valprint.h b/gdb/valprint.h > index ed4964f..1210b83 100644 > --- a/gdb/valprint.h > +++ b/gdb/valprint.h > @@ -232,4 +232,8 @@ extern void print_command_parse_format (const char **expp, const char *cmdname, > struct format_data *fmtp); > extern void print_value (struct value *val, const struct format_data *fmtp); > > +extern void val_print_not_allocated (struct ui_file *stream); > + > +extern void val_print_not_associated (struct ui_file *stream); Please move to typeprint.h. > + > #endif > -- > 1.7.9.5 -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-07-21 18:05 ` Joel Brobecker @ 2015-08-05 13:41 ` Keven Boell 2015-08-05 13:47 ` Keven Boell 1 sibling, 0 replies; 18+ messages in thread From: Keven Boell @ 2015-08-05 13:41 UTC (permalink / raw) To: Joel Brobecker, Keven Boell; +Cc: gdb-patches Thanks Joel for taking the time to review this. On 21.07.2015 20:05, Joel Brobecker wrote: > Keven, > > First off, please merge the patch modifying the code and the patch > addings tests. Done. > > On Wed, Jul 01, 2015 at 02:42:11PM +0200, Keven Boell wrote: >> Fortran provide types whose values may be dynamically allocated >> or associated with a variable under explicit program control. >> The purpose of this commit is >> * to read allocated/associated DWARF tags and store them in >> the dynamic property list of main_type. >> * enable GDB to print the value of a dynamic array in Fortran >> in case the type is allocated or associated (pointer to >> dynamic array). >> >> Examples: >> (gdb) p vla_not_allocated >> $1 = <not allocated> >> >> (gdb) p vla_allocated >> $1 = (1, 2, 3) >> >> (gdb) p vla_ptr_not_associated >> $1 = <not associated> >> >> (gdb) p vla_ptr_associated >> $1 = (1, 2, 3) >> >> 2015-03-13 Keven Boell <keven.boell@intel.com> >> >> * dwarf2loc.c (dwarf2_address_data_valid): New >> function. >> * dwarf2loc.h (dwarf2_address_data_valid): New >> function. >> * dwarf2read.c (set_die_type): Add read of >> DW_AT_allocated and DW_AT_associated. >> * f-typeprint.c (f_print_type): Add check for >> allocated/associated status of type. >> (f_type_print_varspec_suffix): Add check for >> allocated/associated status of type. >> * gdbtypes.c (create_array_type_with_stride): >> Add check for valid data location of type in >> case allocated or associated attributes are set. >> Length of an array should be only calculated if >> allocated or associated is resolved as true. >> (is_dynamic_type_internal): Add check for allocated/ >> associated. >> (resolve_dynamic_array): Evaluate allocated/associated >> properties. Since at the end of the function a new >> array type will be created where the length is >> calculated the properties need to be resolved before. >> * gdbtypes.h (enum dynamic_prop_node_kind): Add >> allocated/associated. >> Add convenient macros to handle allocated/associated. >> * valarith.c (value_subscripted_rvalue): Add check for >> allocated/associated. >> * valprint.c (valprint_check_validity): Add check for >> allocated/associated. >> (val_print_not_allocated): New function. >> (val_print_not_associated): New function. >> (value_check_printable): Add check for allocated/ >> associated. >> * valprint.h (val_print_not_allocated): New function. >> (val_print_not_associated): New function. >> --- >> gdb/dwarf2loc.c | 11 +++++++++++ >> gdb/dwarf2loc.h | 4 ++++ >> gdb/dwarf2read.c | 16 ++++++++++++++++ >> gdb/f-typeprint.c | 20 ++++++++++++++++++++ >> gdb/gdbtypes.c | 33 ++++++++++++++++++++++++++++----- >> gdb/gdbtypes.h | 28 ++++++++++++++++++++++++++++ >> gdb/valarith.c | 9 ++++++++- >> gdb/valprint.c | 36 ++++++++++++++++++++++++++++++++++++ >> gdb/valprint.h | 4 ++++ >> 9 files changed, 155 insertions(+), 6 deletions(-) >> >> diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c >> index c75767e..c4a43ca 100644 >> --- a/gdb/dwarf2loc.c >> +++ b/gdb/dwarf2loc.c >> @@ -2576,6 +2576,17 @@ dwarf2_compile_property_to_c (struct ui_file *stream, >> data, data + size, per_cu); >> } >> >> +int >> +dwarf2_address_data_valid (const struct type *type) > > All function definitions should have an introductory comment. If > the function documentation is provided alongside a declaration, > please add a trivial comment saying that. That way, we know the > function is documentation, and we know where. For instance, in > this case, just add: > > /* See dwarf2loc.h. */ > > Also, I don't find the function name very descriptive. Can we come up > with something a little more expressive? I tried to come up with some > suggestions such as maybe "dwarf2_type_data_has_valid_address", but > even then it's not very satisfactory, because, really, it's about two > concepts combined together into one name, and the name doesn't really > give a clue about those concepts. Perhaps it's might be just as > easy to get rid of this function, and just inline its contents in > the one location where it is being used? I've inlined the functionality as it was used at only one location. Initially I thought it might be a good idea to have a dedicated function. > >> +{ >> + if (TYPE_NOT_ASSOCIATED (type)) >> + return 0; >> + >> + if (TYPE_NOT_ALLOCATED (type)) >> + return 0; >> + >> + return 1; >> +} >> \f >> /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */ >> >> diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h >> index f3630ac..c664c4d 100644 >> --- a/gdb/dwarf2loc.h >> +++ b/gdb/dwarf2loc.h >> @@ -155,6 +155,10 @@ void dwarf2_compile_property_to_c (struct ui_file *stream, >> CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu, >> unsigned int addr_index); >> >> +/* Checks if a dwarf location definition is valid. >> + Returns 1 if valid; 0 otherwise. */ >> +extern int dwarf2_address_data_valid (const struct type *type); > > If the function stays, then the description will need to be updated > to give a little more information. "a dwarf location definition" > doesn't say which. It's actually two possible attributes, etc etc. > >> + >> /* The symbol location baton types used by the DWARF-2 areader (i.e. >> SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct >> dwarf2_locexpr_baton" is for a symbol with a single location >> diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c >> index 496b74f..69caa04 100644 >> --- a/gdb/dwarf2read.c >> +++ b/gdb/dwarf2read.c >> @@ -22263,6 +22263,22 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) >> && !HAVE_GNAT_AUX_INFO (type)) >> INIT_GNAT_SPECIFIC (type); >> >> + /* Read DW_AT_allocated and set in type. */ >> + attr = dwarf2_attr (die, DW_AT_allocated, cu); >> + if (attr_form_is_block (attr)) >> + { >> + if (attr_to_dynamic_prop (attr, die, cu, &prop)) >> + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); >> + } >> + >> + /* Read DW_AT_associated and set in type. */ >> + attr = dwarf2_attr (die, DW_AT_associated, cu); >> + if (attr_form_is_block (attr)) >> + { >> + if (attr_to_dynamic_prop (attr, die, cu, &prop)) >> + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); >> + } > > Why the check for attr_form_is_block, here? If that's important, > what should we do if it's not a block? At the very least, if we are > going to ignore non-block attributes, we typically issue a complaint... Added a complaint in the other cases as only block values are supported at the moment. No other real use-case comes into my mind at the moment. > >> + >> /* Read DW_AT_data_location and set in type. */ >> attr = dwarf2_attr (die, DW_AT_data_location, cu); >> if (attr_to_dynamic_prop (attr, die, cu, &prop)) >> diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c >> index 4957e1f..50efbdb 100644 >> --- a/gdb/f-typeprint.c >> +++ b/gdb/f-typeprint.c >> @@ -30,6 +30,7 @@ >> #include "gdbcore.h" >> #include "target.h" >> #include "f-lang.h" >> +#include "valprint.h" >> >> #if 0 /* Currently unused. */ >> static void f_type_print_args (struct type *, struct ui_file *); >> @@ -53,6 +54,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, >> enum type_code code; >> int demangled_args; >> >> + if (TYPE_NOT_ASSOCIATED (type)) >> + { >> + val_print_not_associated (stream); >> + return; >> + } >> + >> + if (TYPE_NOT_ALLOCATED (type)) >> + { >> + val_print_not_allocated (stream); >> + return; >> + } >> + >> f_type_print_base (type, stream, show, level); >> code = TYPE_CODE (type); >> if ((varstring != NULL && *varstring != '\0') >> @@ -167,6 +180,12 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, >> if (arrayprint_recurse_level == 1) >> fprintf_filtered (stream, "("); >> >> + if (TYPE_NOT_ASSOCIATED (type)) >> + val_print_not_associated (stream); >> + else if (TYPE_NOT_ALLOCATED (type)) >> + val_print_not_allocated (stream); >> + else >> + { >> if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) >> f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, >> arrayprint_recurse_level); >> @@ -189,6 +208,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, >> if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) >> f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, >> arrayprint_recurse_level); >> + } > > You will need to re-indent the code you put in the "else" block. Done. > >> if (arrayprint_recurse_level == 1) >> fprintf_filtered (stream, ")"); >> else >> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c >> index ca86fbd..05cd795 100644 >> --- a/gdb/gdbtypes.c >> +++ b/gdb/gdbtypes.c >> @@ -1068,7 +1068,8 @@ create_array_type_with_stride (struct type *result_type, >> >> TYPE_CODE (result_type) = TYPE_CODE_ARRAY; >> TYPE_TARGET_TYPE (result_type) = element_type; >> - if (has_static_range (TYPE_RANGE_DATA (range_type))) >> + if (has_static_range (TYPE_RANGE_DATA (range_type)) >> + && dwarf2_address_data_valid (result_type)) >> { >> LONGEST low_bound, high_bound; >> >> @@ -1806,6 +1807,12 @@ is_dynamic_type_internal (struct type *type, int top_level) >> || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) >> return 1; >> >> + if (TYPE_ASSOCIATED_PROP (type)) >> + return 1; >> + >> + if (TYPE_ALLOCATED_PROP (type)) >> + return 1; >> + >> switch (TYPE_CODE (type)) >> { >> case TYPE_CODE_RANGE: >> @@ -1923,6 +1930,8 @@ resolve_dynamic_array (struct type *type, >> struct type *elt_type; >> struct type *range_type; >> struct type *ary_dim; >> + struct type *copy = copy_type (type); >> + struct dynamic_prop *prop; > > This is causing an extra copy to every singly array type that > happens to be dynamic, including the ones that do not have > either of the allocated/associated properties. We cannot do that. The copy is created also without my patch, see end of this function: return create_array_type_with_stride (copy_type (type), elt_type, range_type, TYPE_FIELD_BITSIZE (type, 0)); So I don't quite understand why it makes a difference now. > > >> >> gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); >> >> @@ -1930,16 +1939,30 @@ resolve_dynamic_array (struct type *type, >> range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); >> range_type = resolve_dynamic_range (range_type, addr_stack); >> >> + /* Resolve allocated/associated here before creating a new array type, which >> + will update the length of the array accordingly. */ >> + prop = TYPE_ALLOCATED_PROP (copy); >> + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) >> + { >> + TYPE_DYN_PROP_ADDR (prop) = value; >> + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; >> + } >> + prop = TYPE_ASSOCIATED_PROP (copy); >> + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) >> + { >> + TYPE_DYN_PROP_ADDR (prop) = value; >> + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; >> + } >> + >> ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); >> >> if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) >> - elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack); >> + elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr_stack); >> else >> elt_type = TYPE_TARGET_TYPE (type); > > Since we're doing all the work on the "copy", now, I suggest we change > the reference to "type" by "copy" instead. In fact, I'm thinking we can > just get rid of the local variable "copy" and just overwrite "type". > That way, no risk of confusion about which one to use. Done, overwrite "type" with its copy now. > >> >> - return create_array_type_with_stride (copy_type (type), >> - elt_type, range_type, >> - TYPE_FIELD_BITSIZE (type, 0)); >> + return create_array_type_with_stride (copy, >> + elt_type, range_type, TYPE_FIELD_BITSIZE (type, 0)); >> } >> >> /* Resolve dynamic bounds of members of the union TYPE to static >> diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h >> index fd3bc0e..ebed54c 100644 >> --- a/gdb/gdbtypes.h >> +++ b/gdb/gdbtypes.h >> @@ -440,6 +440,16 @@ enum dynamic_prop_node_kind >> /* A property providing a type's data location. >> Evaluating this field yields to the location of an object's data. */ >> DYN_PROP_DATA_LOCATION, >> + >> + /* A property representing DW_AT_allocated. The presence of this attribute >> + indicates that the object of the type can be allocated/deallocated. >> + The value can be a dwarf expression, reference, or a constant. */ >> + DYN_PROP_ALLOCATED, >> + >> + /* A property representing DW_AT_allocated. The presence of this attribute >> + indicated that the object of the type can be associated. The value can be >> + a dwarf expression, reference, or a constant.*/ >> + DYN_PROP_ASSOCIATED, > > I would simply drop the explanation of these new properties, since > you explicitly reference DWARF attributes, for which documentation > is already available. That way, we won't have to update that if things > change on the DWARF side. > I see your point. But removing the comments forces others to look-up the attribute in the DWARF standard. By just trying to understand what the attribute is all about the comment might be still useful. Do you think these attributes will change so frequently that they get out of sync? >> }; >> >> /* * List for dynamic type attributes. */ >> @@ -1266,6 +1276,24 @@ extern void allocate_gnat_aux_type (struct type *); >> #define TYPE_DATA_LOCATION_KIND(thistype) \ >> TYPE_DATA_LOCATION (thistype)->kind >> >> +/* Property accessors for the type allocated/associated. */ >> +#define TYPE_ALLOCATED_PROP(thistype) \ >> + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) >> +#define TYPE_ASSOCIATED_PROP(thistype) \ >> + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) >> + >> +/* Allocated status of type object. If set to non-zero it means the object >> + is allocated. A zero value means it is not allocated. */ >> +#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \ >> + && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (t)) == PROP_CONST \ >> + && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (t))) > > Please create a function for this. Done. > >> +/* Associated status of type object. If set to non-zero it means the object >> + is associated. A zero value means it is not associated. */ >> +#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \ >> + && TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (t)) == PROP_CONST \ >> + && !TYPE_DYN_PROP_ADDR (TYPE_ASSOCIATED_PROP (t))) > > Same here. Done. > >> /* Attribute accessors for dynamic properties. */ >> #define TYPE_DYN_PROP_LIST(thistype) \ >> TYPE_MAIN_TYPE(thistype)->dyn_prop_list >> diff --git a/gdb/valarith.c b/gdb/valarith.c >> index df1e8c3..9c959b3 100644 >> --- a/gdb/valarith.c >> +++ b/gdb/valarith.c >> @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) >> >> if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) >> && elt_offs >= TYPE_LENGTH (array_type))) >> - error (_("no such vector element")); >> + { >> + if (TYPE_NOT_ASSOCIATED (array_type)) >> + error (_("no such vector element because not associated")); > > Suggest "no such vector element (vector not associated)" instead. Done. > >> + else if (TYPE_NOT_ALLOCATED (array_type)) >> + error (_("no such vector element because not allocated")); > > Same idea: Suggest "no such vector element (vector not allocated)" instead. Done. > >> + else >> + error (_("no such vector element")); >> + } >> >> if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) >> v = allocate_value_lazy (elt_type); >> diff --git a/gdb/valprint.c b/gdb/valprint.c >> index 294c6a8..55bd59f 100644 >> --- a/gdb/valprint.c >> +++ b/gdb/valprint.c >> @@ -303,6 +303,18 @@ valprint_check_validity (struct ui_file *stream, >> { >> CHECK_TYPEDEF (type); >> >> + if (TYPE_NOT_ASSOCIATED (type)) >> + { >> + val_print_not_associated (stream); >> + return 0; >> + } >> + >> + if (TYPE_NOT_ALLOCATED (type)) >> + { >> + val_print_not_allocated (stream); >> + return 0; >> + } >> + >> if (TYPE_CODE (type) != TYPE_CODE_UNION >> && TYPE_CODE (type) != TYPE_CODE_STRUCT >> && TYPE_CODE (type) != TYPE_CODE_ARRAY) >> @@ -359,6 +371,18 @@ val_print_invalid_address (struct ui_file *stream) >> fprintf_filtered (stream, _("<invalid address>")); >> } >> >> +void >> +val_print_not_allocated (struct ui_file *stream) >> +{ >> + fprintf_filtered (stream, _("<not allocated>")); >> +} >> + >> +void >> +val_print_not_associated (struct ui_file *stream) >> +{ >> + fprintf_filtered (stream, _("<not associated>")); >> +} > > Missing introductory comment for each functioino. > > I don't think these functions belong in valprint.c. Suggest typeprint.h > instead. You probably followed the example of val_print_unavailable, > but this function isn't used in typeprint, unlike yours. > Moved to typeprint. >> /* A generic val_print that is suitable for use by language >> implementations of the la_val_print method. This function can >> handle most type codes, though not all, notably exception >> @@ -833,6 +857,18 @@ value_check_printable (struct value *val, struct ui_file *stream, >> return 0; >> } >> >> + if (TYPE_NOT_ASSOCIATED (value_type (val))) >> + { >> + val_print_not_associated (stream); >> + return 0; >> + } >> + >> + if (TYPE_NOT_ALLOCATED (value_type (val))) >> + { >> + val_print_not_allocated (stream); >> + return 0; >> + } >> + >> return 1; >> } >> >> diff --git a/gdb/valprint.h b/gdb/valprint.h >> index ed4964f..1210b83 100644 >> --- a/gdb/valprint.h >> +++ b/gdb/valprint.h >> @@ -232,4 +232,8 @@ extern void print_command_parse_format (const char **expp, const char *cmdname, >> struct format_data *fmtp); >> extern void print_value (struct value *val, const struct format_data *fmtp); >> >> +extern void val_print_not_allocated (struct ui_file *stream); >> + >> +extern void val_print_not_associated (struct ui_file *stream); > > Please move to typeprint.h. Done. > >> + >> #endif >> -- >> 1.7.9.5 > Thanks, Keven ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-07-21 18:05 ` Joel Brobecker 2015-08-05 13:41 ` Keven Boell @ 2015-08-05 13:47 ` Keven Boell 2015-08-05 20:23 ` Joel Brobecker 1 sibling, 1 reply; 18+ messages in thread From: Keven Boell @ 2015-08-05 13:47 UTC (permalink / raw) To: Joel Brobecker, Keven Boell; +Cc: gdb-patches Updated patch: --- Fortran provide types whose values may be dynamically allocated or associated with a variable under explicit program control. The purpose of this commit is * to read allocated/associated DWARF tags and store them in the dynamic property list of main_type. * enable GDB to print the value of a dynamic array in Fortran in case the type is allocated or associated (pointer to dynamic array). Examples: (gdb) p vla_not_allocated $1 = <not allocated> (gdb) p vla_allocated $1 = (1, 2, 3) (gdb) p vla_ptr_not_associated $1 = <not associated> (gdb) p vla_ptr_associated $1 = (1, 2, 3) Add basic test coverage for most dynamic array use-cases in Fortran. The commit contains the following tests: * Ensure that values of Fortran dynamic arrays can be evaluated correctly in various ways and states. * Ensure that Fortran primitives can be evaluated correctly when used as a dynamic array. * Dynamic arrays passed to subroutines and handled in different ways inside the routine. * Ensure that the ptype of dynamic arrays in Fortran can be printed in GDB correctly. * Ensure that dynamic arrays in different states (allocated/associated) can be evaluated. * Dynamic arrays passed to functions and returned from functions. * History values of dynamic arrays can be accessed and printed again with the correct values. * Dynamic array evaluations using MI protocol. * Sizeof output of dynamic arrays in various states. 2015-03-13 Keven Boell <keven.boell@intel.com> * dwarf2loc.c (dwarf2_address_data_valid): New function. * dwarf2loc.h (dwarf2_address_data_valid): New function. * dwarf2read.c (set_die_type): Add read of DW_AT_allocated and DW_AT_associated. * f-typeprint.c (f_print_type): Add check for allocated/associated status of type. (f_type_print_varspec_suffix): Add check for allocated/associated status of type. * gdbtypes.c (create_array_type_with_stride): Add check for valid data location of type in case allocated or associated attributes are set. Length of an array should be only calculated if allocated or associated is resolved as true. (is_dynamic_type_internal): Add check for allocated/ associated. (resolve_dynamic_array): Evaluate allocated/associated properties. Since at the end of the function a new array type will be created where the length is calculated the properties need to be resolved before. * gdbtypes.h (enum dynamic_prop_node_kind): Add allocated/associated. Add convenient macros to handle allocated/associated. * valarith.c (value_subscripted_rvalue): Add check for allocated/associated. * valprint.c (valprint_check_validity): Add check for allocated/associated. (val_print_not_allocated): New function. (val_print_not_associated): New function. (value_check_printable): Add check for allocated/ associated. * valprint.h (val_print_not_allocated): New function. (val_print_not_associated): New function. testsuite/gdb.fortran: * vla-alloc-assoc.exp: New file. * vla-datatypes.exp: New file. * vla-datatypes.f90: New file. * vla-history.exp: New file. * vla-ptype-sub.exp: New file. * vla-ptype.exp: New file. * vla-sizeof.exp: New file. * vla-sub.f90: New file. * vla-value-sub-arbitrary.exp: New file. * vla-value-sub-finish.exp: New file. * vla-value-sub.exp: New file. * vla-value.exp: New file. * vla-ptr-info.exp: New file. * vla.f90: New file. testsuite/gdb.mi: * mi-vla-fortran.exp: New file. * vla.f90: New file. --- gdb/dwarf2read.c | 26 +++ gdb/f-typeprint.c | 63 ++++--- gdb/gdbtypes.c | 57 +++++- gdb/gdbtypes.h | 20 +++ gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 ++++++++++++++++++++ gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ gdb/typeprint.c | 17 ++ gdb/typeprint.h | 4 + gdb/valarith.c | 9 +- gdb/valprint.c | 25 +++ 24 files changed, 1399 insertions(+), 27 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp create mode 100644 gdb/testsuite/gdb.mi/vla.f90 diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index b5ffd04..df15a76 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -22300,6 +22300,32 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) && !HAVE_GNAT_AUX_INFO (type)) INIT_GNAT_SPECIFIC (type); + /* Read DW_AT_allocated and set in type. */ + attr = dwarf2_attr (die, DW_AT_allocated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); + } + else + { + complaint (&symfile_complaints, + _("DW_AT_allocated expected to be a block")); + } + + /* Read DW_AT_associated and set in type. */ + attr = dwarf2_attr (die, DW_AT_associated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); + } + else + { + complaint (&symfile_complaints, + _("DW_AT_associated expected to be a block")); + } + /* Read DW_AT_data_location and set in type. */ attr = dwarf2_attr (die, DW_AT_data_location, cu); if (attr_to_dynamic_prop (attr, die, cu, &prop)) diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 590ed73..e34f4f1 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -30,6 +30,8 @@ #include "gdbcore.h" #include "target.h" #include "f-lang.h" +#include "valprint.h" +#include "typeprint.h" #if 0 /* Currently unused. */ static void f_type_print_args (struct type *, struct ui_file *); @@ -53,6 +55,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, enum type_code code; int demangled_args; + if (type_not_associated (type)) + { + val_print_not_associated (stream); + return; + } + + if (type_not_allocated (type)) + { + val_print_not_allocated (stream); + return; + } + f_type_print_base (type, stream, show, level); code = TYPE_CODE (type); if ((varstring != NULL && *varstring != '\0') @@ -167,28 +181,35 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, if (arrayprint_recurse_level == 1) fprintf_filtered (stream, "("); - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, - arrayprint_recurse_level); - - lower_bound = f77_get_lowerbound (type); - if (lower_bound != 1) /* Not the default. */ - fprintf_filtered (stream, "%d:", lower_bound); - - /* Make sure that, if we have an assumed size array, we - print out a warning and print the upperbound as '*'. */ - - if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) - fprintf_filtered (stream, "*"); + if (type_not_associated (type)) + val_print_not_associated (stream); + else if (type_not_allocated (type)) + val_print_not_allocated (stream); else - { - upper_bound = f77_get_upperbound (type); - fprintf_filtered (stream, "%d", upper_bound); - } - - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, - arrayprint_recurse_level); + { + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level); + + lower_bound = f77_get_lowerbound (type); + if (lower_bound != 1) /* Not the default. */ + fprintf_filtered (stream, "%d:", lower_bound); + + /* Make sure that, if we have an assumed size array, we + print out a warning and print the upperbound as '*'. */ + + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "*"); + else + { + upper_bound = f77_get_upperbound (type); + fprintf_filtered (stream, "%d", upper_bound); + } + + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level); + } if (arrayprint_recurse_level == 1) fprintf_filtered (stream, ")"); else diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 125af01..4de8696 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1079,7 +1079,9 @@ create_array_type_with_stride (struct type *result_type, TYPE_CODE (result_type) = TYPE_CODE_ARRAY; TYPE_TARGET_TYPE (result_type) = element_type; - if (has_static_range (TYPE_RANGE_DATA (range_type))) + if (has_static_range (TYPE_RANGE_DATA (range_type)) + && (!type_not_associated (result_type) && + !type_not_allocated (result_type))) { LONGEST low_bound, high_bound; @@ -1817,6 +1819,12 @@ is_dynamic_type_internal (struct type *type, int top_level) || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) return 1; + if (TYPE_ASSOCIATED_PROP (type)) + return 1; + + if (TYPE_ALLOCATED_PROP (type)) + return 1; + switch (TYPE_CODE (type)) { case TYPE_CODE_RANGE: @@ -1934,23 +1942,40 @@ resolve_dynamic_array (struct type *type, struct type *elt_type; struct type *range_type; struct type *ary_dim; + struct dynamic_prop *prop; gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); + type = copy_type (type); + elt_type = type; range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); range_type = resolve_dynamic_range (range_type, addr_stack); + /* Resolve allocated/associated here before creating a new array type, which + will update the length of the array accordingly. */ + prop = TYPE_ALLOCATED_PROP (type); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + prop = TYPE_ASSOCIATED_PROP (type); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) - elt_type = resolve_dynamic_array (ary_dim, addr_stack); + elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack); else elt_type = TYPE_TARGET_TYPE (type); - return create_array_type_with_stride (copy_type (type), - elt_type, range_type, - TYPE_FIELD_BITSIZE (type, 0)); + return create_array_type_with_stride (type, elt_type, range_type, + TYPE_FIELD_BITSIZE (type, 0)); } /* Resolve dynamic bounds of members of the union TYPE to static @@ -3372,6 +3397,28 @@ types_deeply_equal (struct type *type1, struct type *type2) return result; } + +/* Allocated status of type TYPE. Return zero if type TYPE is allocated. + Otherwise return one. */ + +int +type_not_allocated (const struct type *type) +{ + return TYPE_ALLOCATED_PROP (type) + && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type)) == PROP_CONST + && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (type)); +} + +/* Associated status of type TYPE. Return zero if type TYPE is associated. + Otherwise return one. */ + +int +type_not_associated (const struct type *type) +{ + return TYPE_ASSOCIATED_PROP (type) + && TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type)) == PROP_CONST + && !TYPE_DYN_PROP_ADDR (TYPE_ASSOCIATED_PROP (type)); +} \f /* Compare one type (PARM) for compatibility with another (ARG). * PARM is intended to be the parameter type of a function; and diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index f270855..330024a 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -440,6 +440,16 @@ enum dynamic_prop_node_kind /* A property providing a type's data location. Evaluating this field yields to the location of an object's data. */ DYN_PROP_DATA_LOCATION, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicates that the object of the type can be allocated/deallocated. + The value can be a dwarf expression, reference, or a constant. */ + DYN_PROP_ALLOCATED, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicated that the object of the type can be associated. The value can be + a dwarf expression, reference, or a constant.*/ + DYN_PROP_ASSOCIATED, }; /* * List for dynamic type attributes. */ @@ -1258,6 +1268,12 @@ extern void allocate_gnat_aux_type (struct type *); #define TYPE_DATA_LOCATION_KIND(thistype) \ TYPE_DATA_LOCATION (thistype)->kind +/* Property accessors for the type allocated/associated. */ +#define TYPE_ALLOCATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) +#define TYPE_ASSOCIATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) + /* Attribute accessors for dynamic properties. */ #define TYPE_DYN_PROP_LIST(thistype) \ TYPE_MAIN_TYPE(thistype)->dyn_prop_list @@ -1930,4 +1946,8 @@ extern int types_equal (struct type *, struct type *); extern int types_deeply_equal (struct type *, struct type *); +extern int type_not_allocated (const struct type *type); + +extern int type_not_associated (const struct type *type); + #endif /* GDBTYPES_H */ diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp new file mode 100644 index 0000000..ad85977 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp @@ -0,0 +1,65 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the association status of various types of VLA's +# and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla1 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla2 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (re-associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print l" " = \\.FALSE\\." \ + "print pvla allocation status (deassociated)" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print l" " = \\.FALSE\\." \ + "print vla1 allocation status (deallocated)" +gdb_test "print vla1" " = <not allocated>" \ + "print deallocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated" +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp new file mode 100644 index 0000000..006fce6 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp @@ -0,0 +1,82 @@ +# 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/>. + +standard_testfile ".f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +# check that all fortran standard datatypes will be +# handled correctly when using as VLA's + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +gdb_breakpoint [gdb_get_line_number "vlas-allocated"] +gdb_continue_to_breakpoint "vlas-allocated" +gdb_test "next" " = allocated\\\(realvla\\\)" \ + "next to allocation status of intvla" +gdb_test "print l" " = \\.TRUE\\." "intvla allocated" +gdb_test "next" " = allocated\\\(complexvla\\\)" \ + "next to allocation status of realvla" +gdb_test "print l" " = \\.TRUE\\." "realvla allocated" +gdb_test "next" " = allocated\\\(logicalvla\\\)" \ + "next to allocation status of complexvla" +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" +gdb_test "next" " = allocated\\\(charactervla\\\)" \ + "next to allocation status of logicalvla" +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ + "next to allocation status of charactervla" +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" + +gdb_breakpoint [gdb_get_line_number "vlas-initialized"] +gdb_continue_to_breakpoint "vlas-initialized" +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype intvla" +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype realvla" +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype complexvla" +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype logicalvla" +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \ + "ptype charactervla" + +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ + "print realvla(5,5,5) (1st)" +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ + "print complexvla(5,5,5) (1st)" +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ + "print logicalvla(5,5,5) (1st)" +gdb_test "print charactervla(5,5,5)" " = 'K'" \ + "print charactervla(5,5,5) (1st)" + +gdb_breakpoint [gdb_get_line_number "vlas-modified"] +gdb_continue_to_breakpoint "vlas-modified" +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ + "print realvla(5,5,5) (2nd)" +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ + "print complexvla(5,5,5) (2nd)" +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ + "print logicalvla(5,5,5) (2nd)" +gdb_test "print charactervla(5,5,5)" " = 'X'" \ + "print charactervla(5,5,5) (2nd)" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 new file mode 100644 index 0000000..db25695 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 @@ -0,0 +1,51 @@ +! 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +program vla_primitives + integer, allocatable :: intvla(:, :, :) + real, allocatable :: realvla(:, :, :) + complex, allocatable :: complexvla(:, :, :) + logical, allocatable :: logicalvla(:, :, :) + character, allocatable :: charactervla(:, :, :) + logical :: l + + allocate (intvla (11,22,33)) + allocate (realvla (11,22,33)) + allocate (complexvla (11,22,33)) + allocate (logicalvla (11,22,33)) + allocate (charactervla (11,22,33)) + + l = allocated(intvla) ! vlas-allocated + l = allocated(realvla) + l = allocated(complexvla) + l = allocated(logicalvla) + l = allocated(charactervla) + + intvla(:,:,:) = 1 + realvla(:,:,:) = 3.14 + complexvla(:,:,:) = cmplx(2.0,-3.0) + logicalvla(:,:,:) = .TRUE. + charactervla(:,:,:) = char(75) + + intvla(5,5,5) = 42 ! vlas-initialized + realvla(5,5,5) = 4.13 + complexvla(5,5,5) = cmplx(-3.0,2.0) + logicalvla(5,5,5) = .FALSE. + charactervla(5,5,5) = 'X' + + ! dummy statement for bp + l = .FALSE. ! vlas-modified +end program vla_primitives diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp new file mode 100644 index 0000000..5fbffaf --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-history.exp @@ -0,0 +1,62 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Set some breakpoints and print complete vla. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla1 allocated" +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print vla1 filled" + +# Try to access history values for full vla prints. +gdb_test "print \$1" " = <not allocated>" "print \$1" +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$2" +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$3" +gdb_test "print \$4" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)" +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)" + +# Try to access history values for vla values. +gdb_test "print \$9" " = 1311" "print \$9" +gdb_test "print \$10" " = 1001" "print \$10" diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp new file mode 100644 index 0000000..c4cbb03 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp @@ -0,0 +1,32 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the status of a pointer to a dynamic array. +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) \\(10,10,10\\)\\)\\) ${hex}" \ + "print pvla pointer information" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp new file mode 100644 index 0000000..eb704a8 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp @@ -0,0 +1,87 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Pass fixed array to function and handle them as vla in function. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \ + "ptype array1 (passed fixed)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \ + "ptype array2 (passed fixed)" +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(40, 10) (passed fixed)" +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \ + "ptype array2(13, 11, 5) (passed fixed)" + +# Pass sub arrays to function and handle them as vla in function. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \ + "ptype array1 (passed sub-array)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \ + "ptype array2 (passed sub-array)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed sub-array)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed sub-array)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) subarray do not crash (passed sub-array)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)" + +# Pass vla to function. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \ + "ptype array1 (passed vla)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype array2 (passed vla)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed vla)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed vla)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) VLA do not crash (passed vla)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) VLA do not crash (passed vla)" + +# Pass fixed array to function and handle it as VLA of arbitrary length in +# function. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "ptype array1" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \ + "ptype array1 (arbitrary length)" +gdb_test "ptype array2" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \ + "ptype array2 (arbitrary length)" +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(100) (arbitrary length)" +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \ + "ptype array2(4,100) (arbitrary length)" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp new file mode 100644 index 0000000..c95f7b2 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp @@ -0,0 +1,96 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the ptype of various VLA states and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(3, 6, 9) not initialized" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(5, 45, 20) not initialized" + +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 filled" +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 filled" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) filled" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype pvla associated" +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype pvla(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype pvla re-associated" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) re-associated" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" +gdb_test "ptype pvla(5, 45, 20)" \ + "no such vector element \\\(vector not associated\\\)" \ + "ptype pvla(5, 45, 20) not associated" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(3, 6, 9) not allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla2(5, 45, 20) not allocated" diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp new file mode 100644 index 0000000..ee09e98 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp @@ -0,0 +1,46 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Try to access values in non allocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1" + +# Try to access value in allocated VLA +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" + +# Try to access values in pointer to VLA and compare them +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla" diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90 new file mode 100644 index 0000000..dfda411 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sub.f90 @@ -0,0 +1,82 @@ +! 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! Original file written by Jakub Jelinek <jakub@redhat.com> and +! Jan Kratochvil <jan.kratochvil@redhat.com>. +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>. + +subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + + array1(:,:) = 5 ! not-filled + array1(1, 1) = 30 + + array2(:,:,:) = 6 ! array1-filled + array2(:,:,:) = 3 + array2(1,1,1) = 30 + array2(3,3,3) = 90 ! array2-almost-filled +end subroutine + +subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + + array1(5:10) = 1311 + array1(7) = 1 + array1(100) = 100 + array2(4,10) = array1(7) + array2(4,100) = array1(7) + return ! end-of-bar +end subroutine + +program vla_sub + interface + subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + end subroutine + end interface + interface + subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + end subroutine + end interface + + real, allocatable :: vla1 (:, :, :) + integer, allocatable :: vla2 (:, :) + + ! used for subroutine + integer :: sub_arr1(42, 42) + real :: sub_arr2(42, 42, 42) + integer :: sub_arr3(42) + + sub_arr1(:,:) = 1 ! vla2-deallocated + sub_arr2(:,:,:) = 2 + sub_arr3(:) = 3 + + call foo(sub_arr1, sub_arr2) + call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15)) + + allocate (vla1 (10,10,10)) + allocate (vla2 (20,20)) + vla1(:,:,:) = 1311 + vla2(:,:) = 42 + call foo(vla2, vla1) + + call bar(sub_arr3, sub_arr1) +end program vla_sub diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp new file mode 100644 index 0000000..a9f8589 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp @@ -0,0 +1,35 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check VLA with arbitary length and check that elements outside of +# bounds of the passed VLA can be accessed correctly. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)" +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)" +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)" +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)" diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp new file mode 100644 index 0000000..88c6254 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp @@ -0,0 +1,49 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# "up" works with GCC but other Fortran compilers may copy the values into the +# outer function only on the exit of the inner function. +# We need both variants as depending on the arch we optionally may still be +# executing the caller line or not after `finish'. + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger" + +gdb_test "finish" \ + ".*(foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)|foo \\\(array1=..., array2=...\\\).*)" \ + "finish function" +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish" +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish" +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish" +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish" + diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp new file mode 100644 index 0000000..8562ea4 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp @@ -0,0 +1,90 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the values of VLA's in subroutine can be evaluated correctly + +# Try to access values from a fixed array handled as VLA in subroutine. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \ + "print passed array1 in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array1-filled"] +gdb_continue_to_breakpoint "array1-filled (1st)" +gdb_test "print array1(5, 7)" " = 5" \ + "print array1(5, 7) after filled in foo (passed fixed array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled (1st)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed fixed array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed fixed array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed fixed array)" + + +# Try to access values from a fixed sub-array handled as VLA in subroutine. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \ + "print passed array1 in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array1-filled (2nd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed sub-array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array2-almost-filled (2nd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed sub-array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed sub-array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed sub-array)" + + +# Try to access values from a VLA passed to subroutine. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \ + "print passed array1 in foo (passed vla)" + +gdb_continue_to_breakpoint "array1-filled (3rd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed vla)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed vla)" + +gdb_continue_to_breakpoint "array2-almost-filled (3rd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed vla)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed vla)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed vla)" diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp new file mode 100644 index 0000000..24182cc --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value.exp @@ -0,0 +1,148 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Try to access values in non allocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \ + "print non-allocated &vla1" +gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \ + "print member in non-allocated vla1 (1)" +gdb_test "print vla1(101,202,303)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "print member in non-allocated vla1 (2)" +gdb_test "print vla1(5,2,18)=1" "no such vector element \\\(vector not allocated\\\)" \ + "set member in non-allocated vla1" + +# Try to access value in allocated VLA +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+(\\t|\\s)+vla1\\\(3, 6, 9\\\) = 42" \ + "step over value assignment of vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print allocated &vla1" +gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)" +gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)" +gdb_test "print vla1(9, 9, 9) = 999" " = 999" \ + "print allocated vla1(9,9,9)=1" + +# Try to access values in allocated VLA after specific assignment +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1(3, 6, 9)" " = 42" \ + "print allocated vla1(3,6,9) after specific assignment (filled)" +gdb_test "print vla1(1, 3, 8)" " = 1001" \ + "print allocated vla1(1,3,8) after specific assignment (filled)" +gdb_test "print vla1(9, 9, 9)" " = 999" \ + "print allocated vla1(9,9,9) after assignment in debugger (filled)" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_test "print pvla" " = <not associated>" "print undefined pvla" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \ + "print non-associated &pvla" +gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \ + "print undefined pvla(1,3,8)" + +# Try to access values in pointer to VLA and compare them +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print associated &pvla" +gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)" +gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)" +gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)" + +# Fill values to VLA using pointer and check +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print pvla(5, 45, 20)" \ + " = 1" "print pvla(5, 45, 20) after filled using pointer" +gdb_test "print vla2(5, 45, 20)" \ + " = 1" "print vla2(5, 45, 20) after filled using pointer" +gdb_test "print pvla(7, 45, 14)" " = 2" \ + "print pvla(7, 45, 14) after filled using pointer" +gdb_test "print vla2(7, 45, 14)" " = 2" \ + "print vla2(7, 45, 14) after filled using pointer" + +# Try to access values of deassociated VLA pointer +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print pvla(5, 45, 20)" \ + "no such vector element \\\(vector not associated\\\)" \ + "print pvla(5, 45, 20) after deassociated" +gdb_test "print pvla(7, 45, 14)" \ + "no such vector element \\\(vector not associated\\\)" \ + "print pvla(7, 45, 14) after dissasociated" +gdb_test "print pvla" " = <not associated>" \ + "print vla1 after deassociated" + +# Try to access values of deallocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(3,6,9) after specific assignment (deallocated)" +gdb_test "print vla1(1, 3, 8)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(1,3,8) after specific assignment (deallocated)" +gdb_test "print vla1(9, 9, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(9,9,9) after assignment in debugger (deallocated)" + + +# Try to assign VLA to user variable +clean_restart ${testfile} + +if ![runto MAIN__] then { + perror "couldn't run to breakpoint MAIN__" + continue +} +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+.*vla1\\(3, 6, 9\\) = 42" "next (1)" + +gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1" +gdb_test "print \$myvar" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print \$myvar set to vla1" + +gdb_test "next" "\\d+.*vla1\\(1, 3, 8\\) = 1001" "next (2)" +gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla" +gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)" + +# deallocate pointer and make sure user defined variable still has the +# right value. +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print \$mypvar(1,3,8)" " = 1001" \ + "print \$mypvar(1,3,8) after deallocated" diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90 new file mode 100644 index 0000000..61e22b9 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla.f90 @@ -0,0 +1,56 @@ +! 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 vla + real, target, allocatable :: vla1 (:, :, :) + real, target, allocatable :: vla2 (:, :, :) + real, target, allocatable :: vla3 (:, :) + real, pointer :: pvla (:, :, :) + logical :: l + + allocate (vla1 (10,10,10)) ! vla1-init + l = allocated(vla1) + + allocate (vla2 (1:7,42:50,13:35)) ! vla1-allocated + l = allocated(vla2) + + vla1(:, :, :) = 1311 ! vla2-allocated + vla1(3, 6, 9) = 42 + vla1(1, 3, 8) = 1001 + vla1(6, 2, 7) = 13 + + vla2(:, :, :) = 1311 ! vla1-filled + vla2(5, 45, 20) = 42 + + pvla => vla1 ! vla2-filled + l = associated(pvla) + + pvla => vla2 ! pvla-associated + l = associated(pvla) + pvla(5, 45, 20) = 1 + pvla(7, 45, 14) = 2 + + pvla => null() ! pvla-re-associated + l = associated(pvla) + + deallocate (vla1) ! pvla-deassociated + l = allocated(vla1) + + deallocate (vla2) ! vla1-deallocated + l = allocated(vla2) + + allocate (vla3 (2,2)) ! vla2-deallocated + vla3(:,:) = 13 +end program vla diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp new file mode 100644 index 0000000..d191623 --- /dev/null +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp @@ -0,0 +1,182 @@ +# 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/>. + +# Verify that, using the MI, we can evaluate a simple C Variable Length +# Array (VLA). + +load_lib mi-support.exp +set MIFLAGS "-i=mi" + +gdb_exit +if [mi_gdb_start] { + continue +} + +standard_testfile vla.f90 + +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \ + {debug f90}] != "" } { + untested mi-vla-fortran.exp + return -1 +} + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +set bp_lineno [gdb_get_line_number "vla1-not-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \ + ".*vla.f90" $bp_lineno $hex \ + "insert breakpoint at line $bp_lineno (vla not allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "500-data-evaluate-expression vla1" \ + "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ + "create local variable vla1_not_allocated" +mi_gdb_test "501-var-info-type vla1_not_allocated" \ + "501\\^done,type=\"<not allocated>\"" \ + "info type variable vla1_not_allocated" +mi_gdb_test "502-var-show-format vla1_not_allocated" \ + "502\\^done,format=\"natural\"" \ + "show format variable vla1_not_allocated" +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \ + "503\\^done,value=\"\\\[0\\\]\"" \ + "eval variable vla1_not_allocated" +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_not_allocated" + + + +set bp_lineno [gdb_get_line_number "vla1-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "510-data-evaluate-expression vla1" \ + "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla" + +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ + "create local variable vla1_allocated" +mi_gdb_test "511-var-info-type vla1_allocated" \ + "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ + "info type variable vla1_allocated" +mi_gdb_test "512-var-show-format vla1_allocated" \ + "512\\^done,format=\"natural\"" \ + "show format variable vla1_allocated" +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \ + "513\\^done,value=\"\\\[5\\\]\"" \ + "eval variable vla1_allocated" +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_allocated" + + +set bp_lineno [gdb_get_line_number "vla1-filled"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "520-data-evaluate-expression vla1" \ + "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-modified"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "530-data-evaluate-expression vla1" \ + "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla" +mi_gdb_test "540-data-evaluate-expression vla1(1)" \ + "540\\^done,value=\"1\"" "evaluate filled vla" +mi_gdb_test "550-data-evaluate-expression vla1(2)" \ + "550\\^done,value=\"42\"" "evaluate filled vla" +mi_gdb_test "560-data-evaluate-expression vla1(4)" \ + "560\\^done,value=\"24\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-deallocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "570-data-evaluate-expression vla1" \ + "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + + +set bp_lineno [gdb_get_line_number "pvla2-not-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "580-data-evaluate-expression pvla2" \ + "580\\^done,value=\"<not associated>\"" "evaluate not associated vla" + +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ + "create local variable pvla2_not_associated" +mi_gdb_test "581-var-info-type pvla2_not_associated" \ + "581\\^done,type=\"<not associated>\"" \ + "info type variable pvla2_not_associated" +mi_gdb_test "582-var-show-format pvla2_not_associated" \ + "582\\^done,format=\"natural\"" \ + "show format variable pvla2_not_associated" +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \ + "583\\^done,value=\"\\\[0\\\]\"" \ + "eval variable pvla2_not_associated" +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of pvla2_not_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "590-data-evaluate-expression pvla2" \ + "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \ + "evaluate associated vla" + +mi_create_varobj_checked pvla2_associated pvla2 \ + "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" +mi_gdb_test "591-var-info-type pvla2_associated" \ + "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ + "info type variable pvla2_associated" +mi_gdb_test "592-var-show-format pvla2_associated" \ + "592\\^done,format=\"natural\"" \ + "show format variable pvla2_associated" +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \ + "593\\^done,value=\"\\\[2\\\]\"" \ + "eval variable pvla2_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "600-data-evaluate-expression pvla2" \ + "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null" + +mi_gdb_exit +return 0 diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90 new file mode 100644 index 0000000..0b89d34 --- /dev/null +++ b/gdb/testsuite/gdb.mi/vla.f90 @@ -0,0 +1,42 @@ +! 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 vla + real, allocatable :: vla1 (:) + real, target, allocatable :: vla2(:, :) + real, pointer :: pvla2 (:, :) + logical :: l + + allocate (vla1 (5)) ! vla1-not-allocated + l = allocated(vla1) ! vla1-allocated + + vla1(:) = 1 + vla1(2) = 42 ! vla1-filled + vla1(4) = 24 + + deallocate (vla1) ! vla1-modified + l = allocated(vla1) ! vla1-deallocated + + allocate (vla2 (5, 2)) + vla2(:, :) = 2 + + pvla2 => vla2 ! pvla2-not-associated + l = associated(pvla2) ! pvla2-associated + + pvla2(2, 1) = 42 + + pvla2 => null() + l = associated(pvla2) ! pvla2-set-to-null +end program vla diff --git a/gdb/typeprint.c b/gdb/typeprint.c index 9e44225..85a0c6b 100644 --- a/gdb/typeprint.c +++ b/gdb/typeprint.c @@ -725,3 +725,20 @@ Show printing of typedefs defined in classes."), NULL, show_print_type_typedefs, &setprinttypelist, &showprinttypelist); } + +/* Print <not allocated> status to stream STREAM. */ + +void +val_print_not_allocated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not allocated>")); +} + +/* Print <not associated> status to stream STREAM. */ + +void +val_print_not_associated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not associated>")); +} + diff --git a/gdb/typeprint.h b/gdb/typeprint.h index bdff41b..d8225f2 100644 --- a/gdb/typeprint.h +++ b/gdb/typeprint.h @@ -74,4 +74,8 @@ void c_type_print_varspec_suffix (struct type *, struct ui_file *, int, void c_type_print_args (struct type *, struct ui_file *, int, enum language, const struct type_print_options *); +extern void val_print_not_allocated (struct ui_file *stream); + +extern void val_print_not_associated (struct ui_file *stream); + #endif diff --git a/gdb/valarith.c b/gdb/valarith.c index 3e349f2..97145a1 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) && elt_offs >= type_length_units (array_type))) - error (_("no such vector element")); + { + if (type_not_associated (array_type)) + error (_("no such vector element (vector not associated)")); + else if (type_not_allocated (array_type)) + error (_("no such vector element (vector not allocated)")); + else + error (_("no such vector element")); + } if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) v = allocate_value_lazy (elt_type); diff --git a/gdb/valprint.c b/gdb/valprint.c index 713998c..e6c9e50 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -34,6 +34,7 @@ #include "ada-lang.h" #include "gdb_obstack.h" #include "charset.h" +#include "typeprint.h" #include <ctype.h> /* Maximum number of wchars returned from wchar_iterate. */ @@ -303,6 +304,18 @@ valprint_check_validity (struct ui_file *stream, { type = check_typedef (type); + if (type_not_associated (type)) + { + val_print_not_associated (stream); + return 0; + } + + if (type_not_allocated (type)) + { + val_print_not_allocated (stream); + return 0; + } + if (TYPE_CODE (type) != TYPE_CODE_UNION && TYPE_CODE (type) != TYPE_CODE_STRUCT && TYPE_CODE (type) != TYPE_CODE_ARRAY) @@ -1043,6 +1056,18 @@ value_check_printable (struct value *val, struct ui_file *stream, return 0; } + if (type_not_associated (value_type (val))) + { + val_print_not_associated (stream); + return 0; + } + + if (type_not_allocated (value_type (val))) + { + val_print_not_allocated (stream); + return 0; + } + return 1; } -- 1.7.9.5 ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-08-05 13:47 ` Keven Boell @ 2015-08-05 20:23 ` Joel Brobecker 2015-08-06 11:42 ` keven.boell 0 siblings, 1 reply; 18+ messages in thread From: Joel Brobecker @ 2015-08-05 20:23 UTC (permalink / raw) To: Keven Boell; +Cc: Keven Boell, gdb-patches > 2015-03-13 Keven Boell <keven.boell@intel.com> > > * dwarf2loc.c (dwarf2_address_data_valid): New > function. > * dwarf2loc.h (dwarf2_address_data_valid): New > function. > * dwarf2read.c (set_die_type): Add read of > DW_AT_allocated and DW_AT_associated. > * f-typeprint.c (f_print_type): Add check for > allocated/associated status of type. > (f_type_print_varspec_suffix): Add check for > allocated/associated status of type. > * gdbtypes.c (create_array_type_with_stride): > Add check for valid data location of type in > case allocated or associated attributes are set. > Length of an array should be only calculated if > allocated or associated is resolved as true. > (is_dynamic_type_internal): Add check for allocated/ > associated. > (resolve_dynamic_array): Evaluate allocated/associated > properties. Since at the end of the function a new > array type will be created where the length is > calculated the properties need to be resolved before. > * gdbtypes.h (enum dynamic_prop_node_kind): Add > allocated/associated. > Add convenient macros to handle allocated/associated. > * valarith.c (value_subscripted_rvalue): Add check for > allocated/associated. > * valprint.c (valprint_check_validity): Add check for > allocated/associated. > (val_print_not_allocated): New function. > (val_print_not_associated): New function. > (value_check_printable): Add check for allocated/ > associated. > * valprint.h (val_print_not_allocated): New function. > (val_print_not_associated): New function. The ChangeLog needs to be reviewed. In particular, dwarf2_address_data_valid has been removed... You need to also mention the new #include-s (I missed that in the previous review). Also, explicitly mentioning that the patch was tested using the testsuite and citing the platform on which it was tested would be helpful. > > testsuite/gdb.fortran: > > * vla-alloc-assoc.exp: New file. > * vla-datatypes.exp: New file. > * vla-datatypes.f90: New file. > * vla-history.exp: New file. > * vla-ptype-sub.exp: New file. > * vla-ptype.exp: New file. > * vla-sizeof.exp: New file. > * vla-sub.f90: New file. > * vla-value-sub-arbitrary.exp: New file. > * vla-value-sub-finish.exp: New file. > * vla-value-sub.exp: New file. > * vla-value.exp: New file. > * vla-ptr-info.exp: New file. > * vla.f90: New file. > > testsuite/gdb.mi: > > * mi-vla-fortran.exp: New file. > * vla.f90: New file. Comments below. > > diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c > index b5ffd04..df15a76 100644 > --- a/gdb/dwarf2read.c > +++ b/gdb/dwarf2read.c > @@ -22300,6 +22300,32 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) > && !HAVE_GNAT_AUX_INFO (type)) > INIT_GNAT_SPECIFIC (type); > > + /* Read DW_AT_allocated and set in type. */ > + attr = dwarf2_attr (die, DW_AT_allocated, cu); > + if (attr_form_is_block (attr)) > + { > + if (attr_to_dynamic_prop (attr, die, cu, &prop)) > + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); > + } > + else > + { > + complaint (&symfile_complaints, > + _("DW_AT_allocated expected to be a block")); It would be more helpful to the person seeing this complaint if we told them which DIE has this attribute with an unexpected form. I suggest we avoid "expected to be a block" and just say "has the wrong form (<actual form>)". That way, if we ever expand the list lif forms being supported for this attribute, we won't have to remember to update the complaint. So, something like the following: _("DW_AT_allocated attribute has wrong form (%s) at DIE 0x%x"), dwarf_form_name (...), die.offset.sect_off > + } > + > + /* Read DW_AT_associated and set in type. */ > + attr = dwarf2_attr (die, DW_AT_associated, cu); > + if (attr_form_is_block (attr)) > + { > + if (attr_to_dynamic_prop (attr, die, cu, &prop)) > + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); > + } > + else > + { > + complaint (&symfile_complaints, > + _("DW_AT_associated expected to be a block")); Same here... > + } > + > /* Read DW_AT_data_location and set in type. */ > attr = dwarf2_attr (die, DW_AT_data_location, cu); > if (attr_to_dynamic_prop (attr, die, cu, &prop)) > diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c > index 590ed73..e34f4f1 100644 > --- a/gdb/f-typeprint.c > +++ b/gdb/f-typeprint.c > @@ -30,6 +30,8 @@ > #include "gdbcore.h" > #include "target.h" > #include "f-lang.h" > +#include "valprint.h" > +#include "typeprint.h" Do you still need the "valprint.h" include? > #if 0 /* Currently unused. */ > static void f_type_print_args (struct type *, struct ui_file *); > @@ -53,6 +55,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, > enum type_code code; > int demangled_args; > > + if (type_not_associated (type)) > + { > + val_print_not_associated (stream); > + return; > + } > + > + if (type_not_allocated (type)) > + { > + val_print_not_allocated (stream); > + return; > + } > + > f_type_print_base (type, stream, show, level); > code = TYPE_CODE (type); > if ((varstring != NULL && *varstring != '\0') > @@ -167,28 +181,35 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, > if (arrayprint_recurse_level == 1) > fprintf_filtered (stream, "("); > > - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) > - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, > - arrayprint_recurse_level); > - > - lower_bound = f77_get_lowerbound (type); > - if (lower_bound != 1) /* Not the default. */ > - fprintf_filtered (stream, "%d:", lower_bound); > - > - /* Make sure that, if we have an assumed size array, we > - print out a warning and print the upperbound as '*'. */ > - > - if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) > - fprintf_filtered (stream, "*"); > + if (type_not_associated (type)) > + val_print_not_associated (stream); > + else if (type_not_allocated (type)) > + val_print_not_allocated (stream); > else > - { > - upper_bound = f77_get_upperbound (type); > - fprintf_filtered (stream, "%d", upper_bound); > - } > - > - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) > - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, > - arrayprint_recurse_level); > + { > + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, arrayprint_recurse_level); The formatting here is wrong. The second line needs to be aligned just past the opening '(' on the previous line: f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, arrayprint_recurse_level); > + > + lower_bound = f77_get_lowerbound (type); > + if (lower_bound != 1) /* Not the default. */ > + fprintf_filtered (stream, "%d:", lower_bound); > + > + /* Make sure that, if we have an assumed size array, we > + print out a warning and print the upperbound as '*'. */ > + > + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) > + fprintf_filtered (stream, "*"); > + else > + { > + upper_bound = f77_get_upperbound (type); > + fprintf_filtered (stream, "%d", upper_bound); > + } > + > + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) > + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, > + 0, 0, arrayprint_recurse_level); Same here. > + } > if (arrayprint_recurse_level == 1) > fprintf_filtered (stream, ")"); > else > diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c > index 125af01..4de8696 100644 > --- a/gdb/gdbtypes.c > +++ b/gdb/gdbtypes.c > @@ -1079,7 +1079,9 @@ create_array_type_with_stride (struct type *result_type, > > TYPE_CODE (result_type) = TYPE_CODE_ARRAY; > TYPE_TARGET_TYPE (result_type) = element_type; > - if (has_static_range (TYPE_RANGE_DATA (range_type))) > + if (has_static_range (TYPE_RANGE_DATA (range_type)) > + && (!type_not_associated (result_type) && > + !type_not_allocated (result_type))) GNU Coding Style: Binary operators should be at the startt of the line, not at the end. Also, the alignment on the second line is wrong. So: if (has_static_range (TYPE_RANGE_DATA (range_type)) && (!type_not_associated (result_type) && !type_not_allocated (result_type))) > { > LONGEST low_bound, high_bound; > > @@ -1817,6 +1819,12 @@ is_dynamic_type_internal (struct type *type, int top_level) > || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) > return 1; > > + if (TYPE_ASSOCIATED_PROP (type)) > + return 1; > + > + if (TYPE_ALLOCATED_PROP (type)) > + return 1; > + > switch (TYPE_CODE (type)) > { > case TYPE_CODE_RANGE: > @@ -1934,23 +1942,40 @@ resolve_dynamic_array (struct type *type, > struct type *elt_type; > struct type *range_type; > struct type *ary_dim; > + struct dynamic_prop *prop; > > gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); > > + type = copy_type (type); > + > elt_type = type; > range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); > range_type = resolve_dynamic_range (range_type, addr_stack); > > + /* Resolve allocated/associated here before creating a new array type, which > + will update the length of the array accordingly. */ > + prop = TYPE_ALLOCATED_PROP (type); > + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) > + { > + TYPE_DYN_PROP_ADDR (prop) = value; > + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; > + } > + prop = TYPE_ASSOCIATED_PROP (type); > + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) > + { > + TYPE_DYN_PROP_ADDR (prop) = value; > + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; > + } > + > ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); > > if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) > - elt_type = resolve_dynamic_array (ary_dim, addr_stack); > + elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack); This is undoing: commit d0d8478068ae7c01b1a504ca2fba90c1d36c5566 Author: Pierre-Marie de Rodat <derodat@adacore.com> Date: Wed Jul 22 12:25:14 2015 +0200 Subject: gdb/gdbtypes: fix handling of typedef layers between array types I think resolve_dynamic_array should be passed ary_dim, here. > else > elt_type = TYPE_TARGET_TYPE (type); > > - return create_array_type_with_stride (copy_type (type), > - elt_type, range_type, > - TYPE_FIELD_BITSIZE (type, 0)); > + return create_array_type_with_stride (type, elt_type, range_type, > + TYPE_FIELD_BITSIZE (type, 0)); > } > > /* Resolve dynamic bounds of members of the union TYPE to static > @@ -3372,6 +3397,28 @@ types_deeply_equal (struct type *type1, struct type *type2) > > return result; > } > + > +/* Allocated status of type TYPE. Return zero if type TYPE is allocated. > + Otherwise return one. */ Missing second space after the first period (GNU Coding Style). > + > +int > +type_not_allocated (const struct type *type) > +{ > + return TYPE_ALLOCATED_PROP (type) > + && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type)) == PROP_CONST > + && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (type)); > +} The GCS (GNU Coding Style) also asks us to help automatic code formatters in cases like this. So, although not meaningful, we enclose the condition inside "(...)". Also, the indentation of the "return" looks wrong. return (TYPE_ALLOCATED_PROP (type) && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type)) == PROP_CONST && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (type))); Also, why not use a local variable, Eg: struct dynamic_prop *prop = TYPE_ALLOCATED_PROP (type); return (prop != NULL && TYPE_DYN_PROP_KIND (prop) == PROP_CONST && !TYPE_DYN_PROP_ADDR (prop)) ... which seems easier to read to me, but also avoid 3 function identical function calls. > + > +/* Associated status of type TYPE. Return zero if type TYPE is associated. > + Otherwise return one. */ > + > +int > +type_not_associated (const struct type *type) > +{ > + return TYPE_ASSOCIATED_PROP (type) > + && TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type)) == PROP_CONST > + && !TYPE_DYN_PROP_ADDR (TYPE_ASSOCIATED_PROP (type)); > +} Ditto for the function comment and the function implementation. > \f > /* Compare one type (PARM) for compatibility with another (ARG). > * PARM is intended to be the parameter type of a function; and > diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h > index f270855..330024a 100644 > --- a/gdb/gdbtypes.h > +++ b/gdb/gdbtypes.h > @@ -440,6 +440,16 @@ enum dynamic_prop_node_kind > /* A property providing a type's data location. > Evaluating this field yields to the location of an object's data. */ > DYN_PROP_DATA_LOCATION, > + > + /* A property representing DW_AT_allocated. The presence of this attribute > + indicates that the object of the type can be allocated/deallocated. > + The value can be a dwarf expression, reference, or a constant. */ > + DYN_PROP_ALLOCATED, > + > + /* A property representing DW_AT_allocated. The presence of this attribute > + indicated that the object of the type can be associated. The value can be > + a dwarf expression, reference, or a constant.*/ > + DYN_PROP_ASSOCIATED, I don't mind the quick explanation "the object of the type can" if you think it helps, but I think indicating what form it can take is a recipe for this part of the comment one day becoming obsolete. > }; > > /* * List for dynamic type attributes. */ > @@ -1258,6 +1268,12 @@ extern void allocate_gnat_aux_type (struct type *); > #define TYPE_DATA_LOCATION_KIND(thistype) \ > TYPE_DATA_LOCATION (thistype)->kind > > +/* Property accessors for the type allocated/associated. */ > +#define TYPE_ALLOCATED_PROP(thistype) \ > + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) > +#define TYPE_ASSOCIATED_PROP(thistype) \ > + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) > + > /* Attribute accessors for dynamic properties. */ > #define TYPE_DYN_PROP_LIST(thistype) \ > TYPE_MAIN_TYPE(thistype)->dyn_prop_list > @@ -1930,4 +1946,8 @@ extern int types_equal (struct type *, struct type *); > > extern int types_deeply_equal (struct type *, struct type *); > > +extern int type_not_allocated (const struct type *type); > + > +extern int type_not_associated (const struct type *type); > + > #endif /* GDBTYPES_H */ > diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > new file mode 100644 > index 0000000..ad85977 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > @@ -0,0 +1,65 @@ > +# 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/>. > + > +standard_testfile "vla.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} You said: > > I only quickly scanned this patch, as it's really huge (huge > > is good, in this case). > > > > One general comment is that we avoid re-using the same code > > for each test. See: > > https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Make_sure_test_executables_are_unique > > > > Even if all testcases end up using the same code, I suggest > > making one source file for each testcase, and naming the source > > file the same as the .exp files (modulo the extension, of course). > > That's a fairly standard practice that makes it easier to associate > > testcase and code. > > > > The chapter you refered to on the Testcase Cookbook page says > the opposite: > "[...] but if for some reason a new test reuses the sources of > another existing test, the new test shall compile to its own > executable [...]" > This is exactly what I'm doing here. I would like to avoid > code duplications as much as possible. I don't think it says the opposite: It _recommends_ that each test has its own code. And if really you cannot follow that recommendation, then you must make sure that each testcase creates an executable that is unique to the testcase. You are creating doubt in my mind that I may have this one wrong, but it seems to me that "standard_testfile vla.f90" will create an executable called "val". And you have at least two testcases that reuse the same "vla.f90" using standard_testfile, which leads me to believe that you have 2 testcases creating executables with the same name. I really don't think that avoiding code duplication brings us much value, in the case of testcases, as we tend to adjust/augment them as we fix bugs. But I will leave the choice to you, since you will likely be the one living with that choice. What I ask is that you make sure that each testcase create its own executable. -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-08-05 20:23 ` Joel Brobecker @ 2015-08-06 11:42 ` keven.boell 2015-08-20 12:52 ` Joel Brobecker 0 siblings, 1 reply; 18+ messages in thread From: keven.boell @ 2015-08-06 11:42 UTC (permalink / raw) To: Joel Brobecker; +Cc: Keven Boell, gdb-patches Joe, Thanks for the 2nd review. Here is my updated patch addressing your comments. --- Fortran provide types whose values may be dynamically allocated or associated with a variable under explicit program control. The purpose of this commit is * to read allocated/associated DWARF tags and store them in the dynamic property list of main_type. * enable GDB to print the value of a dynamic array in Fortran in case the type is allocated or associated (pointer to dynamic array). Examples: (gdb) p vla_not_allocated $1 = <not allocated> (gdb) p vla_allocated $1 = (1, 2, 3) (gdb) p vla_ptr_not_associated $1 = <not associated> (gdb) p vla_ptr_associated $1 = (1, 2, 3) Add basic test coverage for most dynamic array use-cases in Fortran. The commit contains the following tests: * Ensure that values of Fortran dynamic arrays can be evaluated correctly in various ways and states. * Ensure that Fortran primitives can be evaluated correctly when used as a dynamic array. * Dynamic arrays passed to subroutines and handled in different ways inside the routine. * Ensure that the ptype of dynamic arrays in Fortran can be printed in GDB correctly. * Ensure that dynamic arrays in different states (allocated/associated) can be evaluated. * Dynamic arrays passed to functions and returned from functions. * History values of dynamic arrays can be accessed and printed again with the correct values. * Dynamic array evaluations using MI protocol. * Sizeof output of dynamic arrays in various states. The patch was tested using the test suite on Ubuntu 12.04 64bit. 2015-03-13 Keven Boell <keven.boell@intel.com> * dwarf2read.c (set_die_type): Add read of DW_AT_allocated and DW_AT_associated. * f-typeprint.c (f_print_type): Add check for allocated/associated status of type. (f_type_print_varspec_suffix): Add check for allocated/associated status of type. New include of typeprint.h. * gdbtypes.c (create_array_type_with_stride): Add check for valid data location of type in case allocated or associated attributes are set. Length of an array should be only calculated if allocated or associated is resolved as true. (is_dynamic_type_internal): Add check for allocated/ associated. (resolve_dynamic_array): Evaluate allocated/associated properties. Since at the end of the function a new array type will be created where the length is calculated the properties need to be resolved before. * gdbtypes.h (enum dynamic_prop_node_kind): Add allocated/associated. Add convenient macros to handle allocated/associated. (type_not_allocated): New function. (type_not_associated): New function. * valarith.c (value_subscripted_rvalue): Add check for allocated/associated. * valprint.c (valprint_check_validity): Add check for allocated/associated. (value_check_printable): Add check for allocated/ associated. New include of typeprint.h. * typeprint.h (val_print_not_allocated): New function. (val_print_not_associated): New function. * typeprint.c (val_print_not_allocated): New function. (val_print_not_associated): New function. testsuite/gdb.fortran: * vla-alloc-assoc.exp: New file. * vla-datatypes.exp: New file. * vla-datatypes.f90: New file. * vla-history.exp: New file. * vla-ptype-sub.exp: New file. * vla-ptype.exp: New file. * vla-sizeof.exp: New file. * vla-sub.f90: New file. * vla-value-sub-arbitrary.exp: New file. * vla-value-sub-finish.exp: New file. * vla-value-sub.exp: New file. * vla-value.exp: New file. * vla-ptr-info.exp: New file. * vla.f90: New file. testsuite/gdb.mi: * mi-vla-fortran.exp: New file. * vla.f90: New file. --- gdb/dwarf2read.c | 30 ++++ gdb/f-typeprint.c | 62 ++++--- gdb/gdbtypes.c | 57 +++++- gdb/gdbtypes.h | 18 ++ gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 ++++++++++++++++++++ gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ gdb/typeprint.c | 17 ++ gdb/typeprint.h | 4 + gdb/valarith.c | 9 +- gdb/valprint.c | 25 +++ 24 files changed, 1401 insertions(+), 26 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp create mode 100644 gdb/testsuite/gdb.mi/vla.f90 diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index b5ffd04..c1d187a 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -22300,6 +22300,36 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) && !HAVE_GNAT_AUX_INFO (type)) INIT_GNAT_SPECIFIC (type); + /* Read DW_AT_allocated and set in type. */ + attr = dwarf2_attr (die, DW_AT_allocated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); + } + else + { + complaint (&symfile_complaints, + _("DW_AT_allocated has the wrong form (%s) at DIE 0x%x"), + (attr != NULL ? dwarf_form_name (attr->form) : "n/a"), + die->offset.sect_off); + } + + /* Read DW_AT_associated and set in type. */ + attr = dwarf2_attr (die, DW_AT_associated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); + } + else + { + complaint (&symfile_complaints, + _("DW_AT_associated has the wrong form (%s) at DIE 0x%x"), + (attr != NULL ? dwarf_form_name (attr->form) : "n/a"), + die->offset.sect_off); + } + /* Read DW_AT_data_location and set in type. */ attr = dwarf2_attr (die, DW_AT_data_location, cu); if (attr_to_dynamic_prop (attr, die, cu, &prop)) diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 590ed73..1308a3c 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -30,6 +30,7 @@ #include "gdbcore.h" #include "target.h" #include "f-lang.h" +#include "typeprint.h" #if 0 /* Currently unused. */ static void f_type_print_args (struct type *, struct ui_file *); @@ -53,6 +54,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, enum type_code code; int demangled_args; + if (type_not_associated (type)) + { + val_print_not_associated (stream); + return; + } + + if (type_not_allocated (type)) + { + val_print_not_allocated (stream); + return; + } + f_type_print_base (type, stream, show, level); code = TYPE_CODE (type); if ((varstring != NULL && *varstring != '\0') @@ -167,28 +180,35 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, if (arrayprint_recurse_level == 1) fprintf_filtered (stream, "("); - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, - arrayprint_recurse_level); - - lower_bound = f77_get_lowerbound (type); - if (lower_bound != 1) /* Not the default. */ - fprintf_filtered (stream, "%d:", lower_bound); - - /* Make sure that, if we have an assumed size array, we - print out a warning and print the upperbound as '*'. */ - - if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) - fprintf_filtered (stream, "*"); + if (type_not_associated (type)) + val_print_not_associated (stream); + else if (type_not_allocated (type)) + val_print_not_allocated (stream); else - { - upper_bound = f77_get_upperbound (type); - fprintf_filtered (stream, "%d", upper_bound); - } - - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, - arrayprint_recurse_level); + { + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level); + + lower_bound = f77_get_lowerbound (type); + if (lower_bound != 1) /* Not the default. */ + fprintf_filtered (stream, "%d:", lower_bound); + + /* Make sure that, if we have an assumed size array, we + print out a warning and print the upperbound as '*'. */ + + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "*"); + else + { + upper_bound = f77_get_upperbound (type); + fprintf_filtered (stream, "%d", upper_bound); + } + + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level); + } if (arrayprint_recurse_level == 1) fprintf_filtered (stream, ")"); else diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 125af01..c2486c7 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1079,7 +1079,9 @@ create_array_type_with_stride (struct type *result_type, TYPE_CODE (result_type) = TYPE_CODE_ARRAY; TYPE_TARGET_TYPE (result_type) = element_type; - if (has_static_range (TYPE_RANGE_DATA (range_type))) + if (has_static_range (TYPE_RANGE_DATA (range_type)) + && (!type_not_associated (result_type) + && !type_not_allocated (result_type))) { LONGEST low_bound, high_bound; @@ -1817,6 +1819,12 @@ is_dynamic_type_internal (struct type *type, int top_level) || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) return 1; + if (TYPE_ASSOCIATED_PROP (type)) + return 1; + + if (TYPE_ALLOCATED_PROP (type)) + return 1; + switch (TYPE_CODE (type)) { case TYPE_CODE_RANGE: @@ -1934,13 +1942,31 @@ resolve_dynamic_array (struct type *type, struct type *elt_type; struct type *range_type; struct type *ary_dim; + struct dynamic_prop *prop; gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); + type = copy_type (type); + elt_type = type; range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); range_type = resolve_dynamic_range (range_type, addr_stack); + /* Resolve allocated/associated here before creating a new array type, which + will update the length of the array accordingly. */ + prop = TYPE_ALLOCATED_PROP (type); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + prop = TYPE_ASSOCIATED_PROP (type); + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) @@ -1948,9 +1974,8 @@ resolve_dynamic_array (struct type *type, else elt_type = TYPE_TARGET_TYPE (type); - return create_array_type_with_stride (copy_type (type), - elt_type, range_type, - TYPE_FIELD_BITSIZE (type, 0)); + return create_array_type_with_stride (type, elt_type, range_type, + TYPE_FIELD_BITSIZE (type, 0)); } /* Resolve dynamic bounds of members of the union TYPE to static @@ -3372,6 +3397,30 @@ types_deeply_equal (struct type *type1, struct type *type2) return result; } + +/* Allocated status of type TYPE. Return zero if type TYPE is allocated. + Otherwise return one. */ + +int +type_not_allocated (const struct type *type) +{ + struct dynamic_prop *prop = TYPE_ALLOCATED_PROP (type); + + return (prop && TYPE_DYN_PROP_KIND (prop) == PROP_CONST + && !TYPE_DYN_PROP_ADDR (prop)); +} + +/* Associated status of type TYPE. Return zero if type TYPE is associated. + Otherwise return one. */ + +int +type_not_associated (const struct type *type) +{ + struct dynamic_prop *prop = TYPE_ASSOCIATED_PROP (type); + + return (prop && TYPE_DYN_PROP_KIND (prop) == PROP_CONST + && !TYPE_DYN_PROP_ADDR (prop)); +} \f /* Compare one type (PARM) for compatibility with another (ARG). * PARM is intended to be the parameter type of a function; and diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index f270855..ace87f1 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -440,6 +440,14 @@ enum dynamic_prop_node_kind /* A property providing a type's data location. Evaluating this field yields to the location of an object's data. */ DYN_PROP_DATA_LOCATION, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicates that the object of the type can be allocated/deallocated. */ + DYN_PROP_ALLOCATED, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicated that the object of the type can be associated. */ + DYN_PROP_ASSOCIATED, }; /* * List for dynamic type attributes. */ @@ -1258,6 +1266,12 @@ extern void allocate_gnat_aux_type (struct type *); #define TYPE_DATA_LOCATION_KIND(thistype) \ TYPE_DATA_LOCATION (thistype)->kind +/* Property accessors for the type allocated/associated. */ +#define TYPE_ALLOCATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) +#define TYPE_ASSOCIATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) + /* Attribute accessors for dynamic properties. */ #define TYPE_DYN_PROP_LIST(thistype) \ TYPE_MAIN_TYPE(thistype)->dyn_prop_list @@ -1930,4 +1944,8 @@ extern int types_equal (struct type *, struct type *); extern int types_deeply_equal (struct type *, struct type *); +extern int type_not_allocated (const struct type *type); + +extern int type_not_associated (const struct type *type); + #endif /* GDBTYPES_H */ diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp new file mode 100644 index 0000000..ad85977 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp @@ -0,0 +1,65 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the association status of various types of VLA's +# and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla1 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla2 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (re-associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print l" " = \\.FALSE\\." \ + "print pvla allocation status (deassociated)" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print l" " = \\.FALSE\\." \ + "print vla1 allocation status (deallocated)" +gdb_test "print vla1" " = <not allocated>" \ + "print deallocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated" +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp new file mode 100644 index 0000000..006fce6 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp @@ -0,0 +1,82 @@ +# 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/>. + +standard_testfile ".f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +# check that all fortran standard datatypes will be +# handled correctly when using as VLA's + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +gdb_breakpoint [gdb_get_line_number "vlas-allocated"] +gdb_continue_to_breakpoint "vlas-allocated" +gdb_test "next" " = allocated\\\(realvla\\\)" \ + "next to allocation status of intvla" +gdb_test "print l" " = \\.TRUE\\." "intvla allocated" +gdb_test "next" " = allocated\\\(complexvla\\\)" \ + "next to allocation status of realvla" +gdb_test "print l" " = \\.TRUE\\." "realvla allocated" +gdb_test "next" " = allocated\\\(logicalvla\\\)" \ + "next to allocation status of complexvla" +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" +gdb_test "next" " = allocated\\\(charactervla\\\)" \ + "next to allocation status of logicalvla" +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ + "next to allocation status of charactervla" +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" + +gdb_breakpoint [gdb_get_line_number "vlas-initialized"] +gdb_continue_to_breakpoint "vlas-initialized" +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype intvla" +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype realvla" +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype complexvla" +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype logicalvla" +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \ + "ptype charactervla" + +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ + "print realvla(5,5,5) (1st)" +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ + "print complexvla(5,5,5) (1st)" +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ + "print logicalvla(5,5,5) (1st)" +gdb_test "print charactervla(5,5,5)" " = 'K'" \ + "print charactervla(5,5,5) (1st)" + +gdb_breakpoint [gdb_get_line_number "vlas-modified"] +gdb_continue_to_breakpoint "vlas-modified" +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ + "print realvla(5,5,5) (2nd)" +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ + "print complexvla(5,5,5) (2nd)" +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ + "print logicalvla(5,5,5) (2nd)" +gdb_test "print charactervla(5,5,5)" " = 'X'" \ + "print charactervla(5,5,5) (2nd)" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 new file mode 100644 index 0000000..db25695 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 @@ -0,0 +1,51 @@ +! 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +program vla_primitives + integer, allocatable :: intvla(:, :, :) + real, allocatable :: realvla(:, :, :) + complex, allocatable :: complexvla(:, :, :) + logical, allocatable :: logicalvla(:, :, :) + character, allocatable :: charactervla(:, :, :) + logical :: l + + allocate (intvla (11,22,33)) + allocate (realvla (11,22,33)) + allocate (complexvla (11,22,33)) + allocate (logicalvla (11,22,33)) + allocate (charactervla (11,22,33)) + + l = allocated(intvla) ! vlas-allocated + l = allocated(realvla) + l = allocated(complexvla) + l = allocated(logicalvla) + l = allocated(charactervla) + + intvla(:,:,:) = 1 + realvla(:,:,:) = 3.14 + complexvla(:,:,:) = cmplx(2.0,-3.0) + logicalvla(:,:,:) = .TRUE. + charactervla(:,:,:) = char(75) + + intvla(5,5,5) = 42 ! vlas-initialized + realvla(5,5,5) = 4.13 + complexvla(5,5,5) = cmplx(-3.0,2.0) + logicalvla(5,5,5) = .FALSE. + charactervla(5,5,5) = 'X' + + ! dummy statement for bp + l = .FALSE. ! vlas-modified +end program vla_primitives diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp new file mode 100644 index 0000000..5fbffaf --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-history.exp @@ -0,0 +1,62 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Set some breakpoints and print complete vla. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla1 allocated" +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print vla1 filled" + +# Try to access history values for full vla prints. +gdb_test "print \$1" " = <not allocated>" "print \$1" +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$2" +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$3" +gdb_test "print \$4" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)" +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)" + +# Try to access history values for vla values. +gdb_test "print \$9" " = 1311" "print \$9" +gdb_test "print \$10" " = 1001" "print \$10" diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp new file mode 100644 index 0000000..c4cbb03 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp @@ -0,0 +1,32 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the status of a pointer to a dynamic array. +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) \\(10,10,10\\)\\)\\) ${hex}" \ + "print pvla pointer information" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp new file mode 100644 index 0000000..eb704a8 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp @@ -0,0 +1,87 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Pass fixed array to function and handle them as vla in function. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \ + "ptype array1 (passed fixed)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \ + "ptype array2 (passed fixed)" +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(40, 10) (passed fixed)" +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \ + "ptype array2(13, 11, 5) (passed fixed)" + +# Pass sub arrays to function and handle them as vla in function. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \ + "ptype array1 (passed sub-array)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \ + "ptype array2 (passed sub-array)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed sub-array)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed sub-array)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) subarray do not crash (passed sub-array)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)" + +# Pass vla to function. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \ + "ptype array1 (passed vla)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype array2 (passed vla)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed vla)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed vla)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) VLA do not crash (passed vla)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) VLA do not crash (passed vla)" + +# Pass fixed array to function and handle it as VLA of arbitrary length in +# function. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "ptype array1" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \ + "ptype array1 (arbitrary length)" +gdb_test "ptype array2" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \ + "ptype array2 (arbitrary length)" +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(100) (arbitrary length)" +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \ + "ptype array2(4,100) (arbitrary length)" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp new file mode 100644 index 0000000..c95f7b2 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp @@ -0,0 +1,96 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the ptype of various VLA states and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(3, 6, 9) not initialized" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(5, 45, 20) not initialized" + +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 filled" +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 filled" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) filled" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype pvla associated" +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype pvla(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype pvla re-associated" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) re-associated" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" +gdb_test "ptype pvla(5, 45, 20)" \ + "no such vector element \\\(vector not associated\\\)" \ + "ptype pvla(5, 45, 20) not associated" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(3, 6, 9) not allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla2(5, 45, 20) not allocated" diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp new file mode 100644 index 0000000..ee09e98 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp @@ -0,0 +1,46 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Try to access values in non allocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1" + +# Try to access value in allocated VLA +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" + +# Try to access values in pointer to VLA and compare them +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla" diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90 new file mode 100644 index 0000000..dfda411 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sub.f90 @@ -0,0 +1,82 @@ +! 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! Original file written by Jakub Jelinek <jakub@redhat.com> and +! Jan Kratochvil <jan.kratochvil@redhat.com>. +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>. + +subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + + array1(:,:) = 5 ! not-filled + array1(1, 1) = 30 + + array2(:,:,:) = 6 ! array1-filled + array2(:,:,:) = 3 + array2(1,1,1) = 30 + array2(3,3,3) = 90 ! array2-almost-filled +end subroutine + +subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + + array1(5:10) = 1311 + array1(7) = 1 + array1(100) = 100 + array2(4,10) = array1(7) + array2(4,100) = array1(7) + return ! end-of-bar +end subroutine + +program vla_sub + interface + subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + end subroutine + end interface + interface + subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + end subroutine + end interface + + real, allocatable :: vla1 (:, :, :) + integer, allocatable :: vla2 (:, :) + + ! used for subroutine + integer :: sub_arr1(42, 42) + real :: sub_arr2(42, 42, 42) + integer :: sub_arr3(42) + + sub_arr1(:,:) = 1 ! vla2-deallocated + sub_arr2(:,:,:) = 2 + sub_arr3(:) = 3 + + call foo(sub_arr1, sub_arr2) + call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15)) + + allocate (vla1 (10,10,10)) + allocate (vla2 (20,20)) + vla1(:,:,:) = 1311 + vla2(:,:) = 42 + call foo(vla2, vla1) + + call bar(sub_arr3, sub_arr1) +end program vla_sub diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp new file mode 100644 index 0000000..a9f8589 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp @@ -0,0 +1,35 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check VLA with arbitary length and check that elements outside of +# bounds of the passed VLA can be accessed correctly. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)" +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)" +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)" +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)" diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp new file mode 100644 index 0000000..88c6254 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp @@ -0,0 +1,49 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# "up" works with GCC but other Fortran compilers may copy the values into the +# outer function only on the exit of the inner function. +# We need both variants as depending on the arch we optionally may still be +# executing the caller line or not after `finish'. + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger" + +gdb_test "finish" \ + ".*(foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)|foo \\\(array1=..., array2=...\\\).*)" \ + "finish function" +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish" +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish" +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish" +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish" + diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp new file mode 100644 index 0000000..8562ea4 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp @@ -0,0 +1,90 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the values of VLA's in subroutine can be evaluated correctly + +# Try to access values from a fixed array handled as VLA in subroutine. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \ + "print passed array1 in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array1-filled"] +gdb_continue_to_breakpoint "array1-filled (1st)" +gdb_test "print array1(5, 7)" " = 5" \ + "print array1(5, 7) after filled in foo (passed fixed array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled (1st)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed fixed array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed fixed array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed fixed array)" + + +# Try to access values from a fixed sub-array handled as VLA in subroutine. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \ + "print passed array1 in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array1-filled (2nd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed sub-array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array2-almost-filled (2nd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed sub-array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed sub-array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed sub-array)" + + +# Try to access values from a VLA passed to subroutine. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \ + "print passed array1 in foo (passed vla)" + +gdb_continue_to_breakpoint "array1-filled (3rd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed vla)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed vla)" + +gdb_continue_to_breakpoint "array2-almost-filled (3rd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed vla)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed vla)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed vla)" diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp new file mode 100644 index 0000000..24182cc --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value.exp @@ -0,0 +1,148 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Try to access values in non allocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \ + "print non-allocated &vla1" +gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \ + "print member in non-allocated vla1 (1)" +gdb_test "print vla1(101,202,303)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "print member in non-allocated vla1 (2)" +gdb_test "print vla1(5,2,18)=1" "no such vector element \\\(vector not allocated\\\)" \ + "set member in non-allocated vla1" + +# Try to access value in allocated VLA +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+(\\t|\\s)+vla1\\\(3, 6, 9\\\) = 42" \ + "step over value assignment of vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print allocated &vla1" +gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)" +gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)" +gdb_test "print vla1(9, 9, 9) = 999" " = 999" \ + "print allocated vla1(9,9,9)=1" + +# Try to access values in allocated VLA after specific assignment +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1(3, 6, 9)" " = 42" \ + "print allocated vla1(3,6,9) after specific assignment (filled)" +gdb_test "print vla1(1, 3, 8)" " = 1001" \ + "print allocated vla1(1,3,8) after specific assignment (filled)" +gdb_test "print vla1(9, 9, 9)" " = 999" \ + "print allocated vla1(9,9,9) after assignment in debugger (filled)" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_test "print pvla" " = <not associated>" "print undefined pvla" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \ + "print non-associated &pvla" +gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \ + "print undefined pvla(1,3,8)" + +# Try to access values in pointer to VLA and compare them +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print associated &pvla" +gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)" +gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)" +gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)" + +# Fill values to VLA using pointer and check +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print pvla(5, 45, 20)" \ + " = 1" "print pvla(5, 45, 20) after filled using pointer" +gdb_test "print vla2(5, 45, 20)" \ + " = 1" "print vla2(5, 45, 20) after filled using pointer" +gdb_test "print pvla(7, 45, 14)" " = 2" \ + "print pvla(7, 45, 14) after filled using pointer" +gdb_test "print vla2(7, 45, 14)" " = 2" \ + "print vla2(7, 45, 14) after filled using pointer" + +# Try to access values of deassociated VLA pointer +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print pvla(5, 45, 20)" \ + "no such vector element \\\(vector not associated\\\)" \ + "print pvla(5, 45, 20) after deassociated" +gdb_test "print pvla(7, 45, 14)" \ + "no such vector element \\\(vector not associated\\\)" \ + "print pvla(7, 45, 14) after dissasociated" +gdb_test "print pvla" " = <not associated>" \ + "print vla1 after deassociated" + +# Try to access values of deallocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(3,6,9) after specific assignment (deallocated)" +gdb_test "print vla1(1, 3, 8)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(1,3,8) after specific assignment (deallocated)" +gdb_test "print vla1(9, 9, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(9,9,9) after assignment in debugger (deallocated)" + + +# Try to assign VLA to user variable +clean_restart ${testfile} + +if ![runto MAIN__] then { + perror "couldn't run to breakpoint MAIN__" + continue +} +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+.*vla1\\(3, 6, 9\\) = 42" "next (1)" + +gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1" +gdb_test "print \$myvar" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print \$myvar set to vla1" + +gdb_test "next" "\\d+.*vla1\\(1, 3, 8\\) = 1001" "next (2)" +gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla" +gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)" + +# deallocate pointer and make sure user defined variable still has the +# right value. +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print \$mypvar(1,3,8)" " = 1001" \ + "print \$mypvar(1,3,8) after deallocated" diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90 new file mode 100644 index 0000000..61e22b9 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla.f90 @@ -0,0 +1,56 @@ +! 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 vla + real, target, allocatable :: vla1 (:, :, :) + real, target, allocatable :: vla2 (:, :, :) + real, target, allocatable :: vla3 (:, :) + real, pointer :: pvla (:, :, :) + logical :: l + + allocate (vla1 (10,10,10)) ! vla1-init + l = allocated(vla1) + + allocate (vla2 (1:7,42:50,13:35)) ! vla1-allocated + l = allocated(vla2) + + vla1(:, :, :) = 1311 ! vla2-allocated + vla1(3, 6, 9) = 42 + vla1(1, 3, 8) = 1001 + vla1(6, 2, 7) = 13 + + vla2(:, :, :) = 1311 ! vla1-filled + vla2(5, 45, 20) = 42 + + pvla => vla1 ! vla2-filled + l = associated(pvla) + + pvla => vla2 ! pvla-associated + l = associated(pvla) + pvla(5, 45, 20) = 1 + pvla(7, 45, 14) = 2 + + pvla => null() ! pvla-re-associated + l = associated(pvla) + + deallocate (vla1) ! pvla-deassociated + l = allocated(vla1) + + deallocate (vla2) ! vla1-deallocated + l = allocated(vla2) + + allocate (vla3 (2,2)) ! vla2-deallocated + vla3(:,:) = 13 +end program vla diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp new file mode 100644 index 0000000..d191623 --- /dev/null +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp @@ -0,0 +1,182 @@ +# 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/>. + +# Verify that, using the MI, we can evaluate a simple C Variable Length +# Array (VLA). + +load_lib mi-support.exp +set MIFLAGS "-i=mi" + +gdb_exit +if [mi_gdb_start] { + continue +} + +standard_testfile vla.f90 + +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \ + {debug f90}] != "" } { + untested mi-vla-fortran.exp + return -1 +} + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +set bp_lineno [gdb_get_line_number "vla1-not-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \ + ".*vla.f90" $bp_lineno $hex \ + "insert breakpoint at line $bp_lineno (vla not allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "500-data-evaluate-expression vla1" \ + "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ + "create local variable vla1_not_allocated" +mi_gdb_test "501-var-info-type vla1_not_allocated" \ + "501\\^done,type=\"<not allocated>\"" \ + "info type variable vla1_not_allocated" +mi_gdb_test "502-var-show-format vla1_not_allocated" \ + "502\\^done,format=\"natural\"" \ + "show format variable vla1_not_allocated" +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \ + "503\\^done,value=\"\\\[0\\\]\"" \ + "eval variable vla1_not_allocated" +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_not_allocated" + + + +set bp_lineno [gdb_get_line_number "vla1-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "510-data-evaluate-expression vla1" \ + "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla" + +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ + "create local variable vla1_allocated" +mi_gdb_test "511-var-info-type vla1_allocated" \ + "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ + "info type variable vla1_allocated" +mi_gdb_test "512-var-show-format vla1_allocated" \ + "512\\^done,format=\"natural\"" \ + "show format variable vla1_allocated" +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \ + "513\\^done,value=\"\\\[5\\\]\"" \ + "eval variable vla1_allocated" +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_allocated" + + +set bp_lineno [gdb_get_line_number "vla1-filled"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "520-data-evaluate-expression vla1" \ + "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-modified"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "530-data-evaluate-expression vla1" \ + "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla" +mi_gdb_test "540-data-evaluate-expression vla1(1)" \ + "540\\^done,value=\"1\"" "evaluate filled vla" +mi_gdb_test "550-data-evaluate-expression vla1(2)" \ + "550\\^done,value=\"42\"" "evaluate filled vla" +mi_gdb_test "560-data-evaluate-expression vla1(4)" \ + "560\\^done,value=\"24\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-deallocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "570-data-evaluate-expression vla1" \ + "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + + +set bp_lineno [gdb_get_line_number "pvla2-not-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "580-data-evaluate-expression pvla2" \ + "580\\^done,value=\"<not associated>\"" "evaluate not associated vla" + +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ + "create local variable pvla2_not_associated" +mi_gdb_test "581-var-info-type pvla2_not_associated" \ + "581\\^done,type=\"<not associated>\"" \ + "info type variable pvla2_not_associated" +mi_gdb_test "582-var-show-format pvla2_not_associated" \ + "582\\^done,format=\"natural\"" \ + "show format variable pvla2_not_associated" +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \ + "583\\^done,value=\"\\\[0\\\]\"" \ + "eval variable pvla2_not_associated" +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of pvla2_not_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "590-data-evaluate-expression pvla2" \ + "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \ + "evaluate associated vla" + +mi_create_varobj_checked pvla2_associated pvla2 \ + "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" +mi_gdb_test "591-var-info-type pvla2_associated" \ + "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ + "info type variable pvla2_associated" +mi_gdb_test "592-var-show-format pvla2_associated" \ + "592\\^done,format=\"natural\"" \ + "show format variable pvla2_associated" +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \ + "593\\^done,value=\"\\\[2\\\]\"" \ + "eval variable pvla2_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "600-data-evaluate-expression pvla2" \ + "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null" + +mi_gdb_exit +return 0 diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90 new file mode 100644 index 0000000..0b89d34 --- /dev/null +++ b/gdb/testsuite/gdb.mi/vla.f90 @@ -0,0 +1,42 @@ +! 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 vla + real, allocatable :: vla1 (:) + real, target, allocatable :: vla2(:, :) + real, pointer :: pvla2 (:, :) + logical :: l + + allocate (vla1 (5)) ! vla1-not-allocated + l = allocated(vla1) ! vla1-allocated + + vla1(:) = 1 + vla1(2) = 42 ! vla1-filled + vla1(4) = 24 + + deallocate (vla1) ! vla1-modified + l = allocated(vla1) ! vla1-deallocated + + allocate (vla2 (5, 2)) + vla2(:, :) = 2 + + pvla2 => vla2 ! pvla2-not-associated + l = associated(pvla2) ! pvla2-associated + + pvla2(2, 1) = 42 + + pvla2 => null() + l = associated(pvla2) ! pvla2-set-to-null +end program vla diff --git a/gdb/typeprint.c b/gdb/typeprint.c index 9e44225..85a0c6b 100644 --- a/gdb/typeprint.c +++ b/gdb/typeprint.c @@ -725,3 +725,20 @@ Show printing of typedefs defined in classes."), NULL, show_print_type_typedefs, &setprinttypelist, &showprinttypelist); } + +/* Print <not allocated> status to stream STREAM. */ + +void +val_print_not_allocated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not allocated>")); +} + +/* Print <not associated> status to stream STREAM. */ + +void +val_print_not_associated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not associated>")); +} + diff --git a/gdb/typeprint.h b/gdb/typeprint.h index bdff41b..d8225f2 100644 --- a/gdb/typeprint.h +++ b/gdb/typeprint.h @@ -74,4 +74,8 @@ void c_type_print_varspec_suffix (struct type *, struct ui_file *, int, void c_type_print_args (struct type *, struct ui_file *, int, enum language, const struct type_print_options *); +extern void val_print_not_allocated (struct ui_file *stream); + +extern void val_print_not_associated (struct ui_file *stream); + #endif diff --git a/gdb/valarith.c b/gdb/valarith.c index 3e349f2..97145a1 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) && elt_offs >= type_length_units (array_type))) - error (_("no such vector element")); + { + if (type_not_associated (array_type)) + error (_("no such vector element (vector not associated)")); + else if (type_not_allocated (array_type)) + error (_("no such vector element (vector not allocated)")); + else + error (_("no such vector element")); + } if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) v = allocate_value_lazy (elt_type); diff --git a/gdb/valprint.c b/gdb/valprint.c index 713998c..e6c9e50 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -34,6 +34,7 @@ #include "ada-lang.h" #include "gdb_obstack.h" #include "charset.h" +#include "typeprint.h" #include <ctype.h> /* Maximum number of wchars returned from wchar_iterate. */ @@ -303,6 +304,18 @@ valprint_check_validity (struct ui_file *stream, { type = check_typedef (type); + if (type_not_associated (type)) + { + val_print_not_associated (stream); + return 0; + } + + if (type_not_allocated (type)) + { + val_print_not_allocated (stream); + return 0; + } + if (TYPE_CODE (type) != TYPE_CODE_UNION && TYPE_CODE (type) != TYPE_CODE_STRUCT && TYPE_CODE (type) != TYPE_CODE_ARRAY) @@ -1043,6 +1056,18 @@ value_check_printable (struct value *val, struct ui_file *stream, return 0; } + if (type_not_associated (value_type (val))) + { + val_print_not_associated (stream); + return 0; + } + + if (type_not_allocated (value_type (val))) + { + val_print_not_allocated (stream); + return 0; + } + return 1; } -- 1.7.9.5 ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-08-06 11:42 ` keven.boell @ 2015-08-20 12:52 ` Joel Brobecker 2015-10-09 11:37 ` Keven Boell [not found] ` <5613D0DC.3040908@linux.intel.com> 0 siblings, 2 replies; 18+ messages in thread From: Joel Brobecker @ 2015-08-20 12:52 UTC (permalink / raw) To: keven.boell; +Cc: gdb-patches We are getting there.... One more iteration, I think, and we'll be able to push this code. Something also happened during the sending of the patch, and I think this might be related to the patch being sent inside the email body, which somewhere along the way caused lines to be wrapped around. This means the patch couldn't be applied as is, and also comparision between one version to the next have a few spurious differences. If sending those patches through a mailer (as opposed to "git send-email"), it would be better, I think, to send it as an attachement. > Add basic test coverage for most dynamic array use-cases > in Fortran. > The commit contains the following tests: > * Ensure that values of Fortran dynamic arrays > can be evaluated correctly in various ways and states. > * Ensure that Fortran primitives can be evaluated > correctly when used as a dynamic array. > * Dynamic arrays passed to subroutines and handled > in different ways inside the routine. > * Ensure that the ptype of dynamic arrays in > Fortran can be printed in GDB correctly. > * Ensure that dynamic arrays in different states > (allocated/associated) can be evaluated. > * Dynamic arrays passed to functions and returned from > functions. > * History values of dynamic arrays can be accessed and > printed again with the correct values. > * Dynamic array evaluations using MI protocol. > * Sizeof output of dynamic arrays in various states. > > The patch was tested using the test suite on Ubuntu 12.04 64bit. > > 2015-03-13 Keven Boell <keven.boell@intel.com> > > * dwarf2read.c (set_die_type): Add read of > DW_AT_allocated and DW_AT_associated. > * f-typeprint.c (f_print_type): Add check for > allocated/associated status of type. > (f_type_print_varspec_suffix): Add check for > allocated/associated status of type. > New include of typeprint.h. Please move the "New include of ..." to the start of f-typeprint.c's entry. First because that's the first change that is happening in that file, but also because I think it avoids the possible confusion that the include might be associated to the entry just above "(f_type_print_varspec_suffix)". > * gdbtypes.c (create_array_type_with_stride): > Add check for valid data location of type in > case allocated or associated attributes are set. > Length of an array should be only calculated if > allocated or associated is resolved as true. > (is_dynamic_type_internal): Add check for allocated/ > associated. > (resolve_dynamic_array): Evaluate allocated/associated > properties. Since at the end of the function a new > array type will be created where the length is > calculated the properties need to be resolved before. Please remove the "why" from the ChangeLog. The ChangeLog is only expected to provide the "what". So, just keep: (resolve_dynamic_array): Evaluate allocated/associated properties. > * gdbtypes.h (enum dynamic_prop_node_kind): Add > allocated/associated. > Add convenient macros to handle allocated/associated. You need to be more precise than that, unfortunately, and say exactly what you added. And again, "convenient" provides the "why", which is not what the ChangeLog entry is about. So: * gdbtypes.h (enum dynamic_prop_node_kind) <DYN_PROP_ALLOCATED> <DYN_PROP_ASSOCIATED>: New enums. (TYPE_ALLOCATED_PROP, TYPE_ASSOCIATED_PROP): New macros. (type_not_allocated): New function. (type_not_associated): New function. > * valarith.c (value_subscripted_rvalue): Add check for > allocated/associated. > * valprint.c (valprint_check_validity): Add check for > allocated/associated. > (value_check_printable): Add check for allocated/ > associated. > New include of typeprint.h. Same here about typeprint.h. > * typeprint.h (val_print_not_allocated): New function. > (val_print_not_associated): New function. > * typeprint.c (val_print_not_allocated): New function. > (val_print_not_associated): New function. > > testsuite/gdb.fortran: > > * vla-alloc-assoc.exp: New file. > * vla-datatypes.exp: New file. > * vla-datatypes.f90: New file. > * vla-history.exp: New file. > * vla-ptr-info.exp: New file. > * vla-ptype-sub.exp: New file. > * vla-ptype.exp: New file. > * vla-sizeof.exp: New file. > * vla-sub.f90: New file. > * vla-value-sub-arbitrary.exp: New file. > * vla-value-sub-finish.exp: New file. > * vla-value-sub.exp: New file. > * vla-value.exp: New file. > * vla.f90: New file. > > testsuite/gdb.mi: > > * mi-vla-fortran.exp: New file. > * vla.f90: New file. Comments on the code inline below. > --- > gdb/dwarf2read.c | 30 ++++ > gdb/f-typeprint.c | 62 ++++--- > gdb/gdbtypes.c | 57 +++++- > gdb/gdbtypes.h | 18 ++ > gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ > gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ > gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ > gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ > gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ > gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ > gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ > gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ > gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ > .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ > gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ > gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ > gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ > gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ > gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 > ++++++++++++++++++++ > gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ > gdb/typeprint.c | 17 ++ > gdb/typeprint.h | 4 + > gdb/valarith.c | 9 +- > gdb/valprint.c | 25 +++ > 24 files changed, 1401 insertions(+), 26 deletions(-) > create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 > create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 > create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 > create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp > create mode 100644 gdb/testsuite/gdb.mi/vla.f90 > > diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c > index b5ffd04..c1d187a 100644 > --- a/gdb/dwarf2read.c > +++ b/gdb/dwarf2read.c > @@ -22300,6 +22300,36 @@ set_die_type (struct die_info *die, struct type > *type, struct dwarf2_cu *cu) > && !HAVE_GNAT_AUX_INFO (type)) > INIT_GNAT_SPECIFIC (type); > > + /* Read DW_AT_allocated and set in type. */ > + attr = dwarf2_attr (die, DW_AT_allocated, cu); > + if (attr_form_is_block (attr)) > + { > + if (attr_to_dynamic_prop (attr, die, cu, &prop)) > + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); > + } > + else > + { > + complaint (&symfile_complaints, > + _("DW_AT_allocated has the wrong form (%s) at DIE 0x%x"), > + (attr != NULL ? dwarf_form_name (attr->form) : "n/a"), > + die->offset.sect_off); > + } I missed this on the last review. Here, you are generating a complaint for types that do not have a DW_AT_allocated attribute, which is perfectly normal and therefore does NOT warrant a complaint. So we need to make sure the complaint is generated only when ATTR is not NULL. Also, the indentation is too far - 2 spaces per indentation level. Personally, I would do it this way: attr = dwarf2_attr (die, DW_AT_allocated, cu); if (attr != NULL) { if (attr_form_is_block (attr)) { [...]; } else complaint ([...]); } But if you prefer, you can also just change the "else" above into "else if (attr != NULL)". > + > + /* Read DW_AT_associated and set in type. */ > + attr = dwarf2_attr (die, DW_AT_associated, cu); > + if (attr_form_is_block (attr)) > + { > + if (attr_to_dynamic_prop (attr, die, cu, &prop)) > + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); > + } > + else > + { > + complaint (&symfile_complaints, > + _("DW_AT_associated has the wrong form (%s) at DIE 0x%x"), > + (attr != NULL ? dwarf_form_name (attr->form) : "n/a"), > + die->offset.sect_off); > + } Ditto. > + > /* Read DW_AT_data_location and set in type. */ > attr = dwarf2_attr (die, DW_AT_data_location, cu); > if (attr_to_dynamic_prop (attr, die, cu, &prop)) > diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c > index 590ed73..1308a3c 100644 > --- a/gdb/f-typeprint.c > +++ b/gdb/f-typeprint.c > @@ -30,6 +30,7 @@ > #include "gdbcore.h" > #include "target.h" > #include "f-lang.h" > +#include "typeprint.h" > > #if 0 /* Currently unused. */ > static void f_type_print_args (struct type *, struct ui_file *); > @@ -53,6 +54,18 @@ f_print_type (struct type *type, const char *varstring, > struct ui_file *stream, > enum type_code code; > int demangled_args; > > + if (type_not_associated (type)) > + { > + val_print_not_associated (stream); > + return; > + } > + > + if (type_not_allocated (type)) > + { > + val_print_not_allocated (stream); > + return; > + } > + > f_type_print_base (type, stream, show, level); > code = TYPE_CODE (type); > if ((varstring != NULL && *varstring != '\0') > @@ -167,28 +180,35 @@ f_type_print_varspec_suffix (struct type *type, > struct ui_file *stream, > if (arrayprint_recurse_level == 1) > fprintf_filtered (stream, "("); > > - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) > - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, > - arrayprint_recurse_level); > - > - lower_bound = f77_get_lowerbound (type); > - if (lower_bound != 1) /* Not the default. */ > - fprintf_filtered (stream, "%d:", lower_bound); > - > - /* Make sure that, if we have an assumed size array, we > - print out a warning and print the upperbound as '*'. */ > - > - if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) > - fprintf_filtered (stream, "*"); > + if (type_not_associated (type)) > + val_print_not_associated (stream); > + else if (type_not_allocated (type)) > + val_print_not_allocated (stream); > else > - { > - upper_bound = f77_get_upperbound (type); > - fprintf_filtered (stream, "%d", upper_bound); > - } > - > - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) > - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, > - arrayprint_recurse_level); > + { > + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) > + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, > + 0, 0, arrayprint_recurse_level); > + > + lower_bound = f77_get_lowerbound (type); > + if (lower_bound != 1) /* Not the default. */ > + fprintf_filtered (stream, "%d:", lower_bound); > + > + /* Make sure that, if we have an assumed size array, we > + print out a warning and print the upperbound as '*'. */ > + > + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) > + fprintf_filtered (stream, "*"); > + else > + { > + upper_bound = f77_get_upperbound (type); > + fprintf_filtered (stream, "%d", upper_bound); > + } > + > + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) > + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, > + 0, 0, arrayprint_recurse_level); > + } > if (arrayprint_recurse_level == 1) > fprintf_filtered (stream, ")"); > else > diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c > index 125af01..c2486c7 100644 > --- a/gdb/gdbtypes.c > +++ b/gdb/gdbtypes.c > @@ -1079,7 +1079,9 @@ create_array_type_with_stride (struct type > *result_type, > > TYPE_CODE (result_type) = TYPE_CODE_ARRAY; > TYPE_TARGET_TYPE (result_type) = element_type; > - if (has_static_range (TYPE_RANGE_DATA (range_type))) > + if (has_static_range (TYPE_RANGE_DATA (range_type)) > + && (!type_not_associated (result_type) > + && !type_not_allocated (result_type))) > { > LONGEST low_bound, high_bound; > > @@ -1817,6 +1819,12 @@ is_dynamic_type_internal (struct type *type, int > top_level) > || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) > return 1; > > + if (TYPE_ASSOCIATED_PROP (type)) > + return 1; > + > + if (TYPE_ALLOCATED_PROP (type)) > + return 1; > + > switch (TYPE_CODE (type)) > { > case TYPE_CODE_RANGE: > @@ -1934,13 +1942,31 @@ resolve_dynamic_array (struct type *type, > struct type *elt_type; > struct type *range_type; > struct type *ary_dim; > + struct dynamic_prop *prop; > > gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); > > + type = copy_type (type); > + > elt_type = type; > range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); > range_type = resolve_dynamic_range (range_type, addr_stack); > > + /* Resolve allocated/associated here before creating a new array type, > which > + will update the length of the array accordingly. */ > + prop = TYPE_ALLOCATED_PROP (type); > + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) > + { > + TYPE_DYN_PROP_ADDR (prop) = value; > + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; > + } > + prop = TYPE_ASSOCIATED_PROP (type); > + if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value)) > + { > + TYPE_DYN_PROP_ADDR (prop) = value; > + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; > + } > + > ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); > > if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) > @@ -1948,9 +1974,8 @@ resolve_dynamic_array (struct type *type, > else > elt_type = TYPE_TARGET_TYPE (type); > > - return create_array_type_with_stride (copy_type (type), > - elt_type, range_type, > - TYPE_FIELD_BITSIZE (type, 0)); > + return create_array_type_with_stride (type, elt_type, range_type, > + TYPE_FIELD_BITSIZE (type, 0)); > } > > /* Resolve dynamic bounds of members of the union TYPE to static > @@ -3372,6 +3397,30 @@ types_deeply_equal (struct type *type1, struct type > *type2) > > return result; > } > + > +/* Allocated status of type TYPE. Return zero if type TYPE is allocated. > + Otherwise return one. */ > + > +int > +type_not_allocated (const struct type *type) > +{ > + struct dynamic_prop *prop = TYPE_ALLOCATED_PROP (type); > + > + return (prop && TYPE_DYN_PROP_KIND (prop) == PROP_CONST > + && !TYPE_DYN_PROP_ADDR (prop)); > +} > + > +/* Associated status of type TYPE. Return zero if type TYPE is associated. > + Otherwise return one. */ > + > +int > +type_not_associated (const struct type *type) > +{ > + struct dynamic_prop *prop = TYPE_ASSOCIATED_PROP (type); > + > + return (prop && TYPE_DYN_PROP_KIND (prop) == PROP_CONST > + && !TYPE_DYN_PROP_ADDR (prop)); > +} > \f > /* Compare one type (PARM) for compatibility with another (ARG). > * PARM is intended to be the parameter type of a function; and > diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h > index f270855..ace87f1 100644 > --- a/gdb/gdbtypes.h > +++ b/gdb/gdbtypes.h > @@ -440,6 +440,14 @@ enum dynamic_prop_node_kind > /* A property providing a type's data location. > Evaluating this field yields to the location of an object's data. */ > DYN_PROP_DATA_LOCATION, > + > + /* A property representing DW_AT_allocated. The presence of this > attribute > + indicates that the object of the type can be allocated/deallocated. */ > + DYN_PROP_ALLOCATED, > + > + /* A property representing DW_AT_allocated. The presence of this > attribute > + indicated that the object of the type can be associated. */ > + DYN_PROP_ASSOCIATED, > }; > > /* * List for dynamic type attributes. */ > @@ -1258,6 +1266,12 @@ extern void allocate_gnat_aux_type (struct type *); > #define TYPE_DATA_LOCATION_KIND(thistype) \ > TYPE_DATA_LOCATION (thistype)->kind > > +/* Property accessors for the type allocated/associated. */ > +#define TYPE_ALLOCATED_PROP(thistype) \ > + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) > +#define TYPE_ASSOCIATED_PROP(thistype) \ > + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) > + > /* Attribute accessors for dynamic properties. */ > #define TYPE_DYN_PROP_LIST(thistype) \ > TYPE_MAIN_TYPE(thistype)->dyn_prop_list > @@ -1930,4 +1944,8 @@ extern int types_equal (struct type *, struct type *); > > extern int types_deeply_equal (struct type *, struct type *); > > +extern int type_not_allocated (const struct type *type); > + > +extern int type_not_associated (const struct type *type); > + > #endif /* GDBTYPES_H */ > diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > new file mode 100644 > index 0000000..ad85977 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > @@ -0,0 +1,65 @@ > +# 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/>. > + > +standard_testfile "vla.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Check the association status of various types of VLA's > +# and pointer to VLA's. > +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] > +gdb_continue_to_breakpoint "vla1-allocated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print vla1 allocation status (allocated)" > + > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print vla2 allocation status (allocated)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print pvla associated status (associated)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] > +gdb_continue_to_breakpoint "pvla-re-associated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print pvla associated status (re-associated)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] > +gdb_continue_to_breakpoint "pvla-deassociated" > +gdb_test "print l" " = \\.FALSE\\." \ > + "print pvla allocation status (deassociated)" > + > +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] > +gdb_continue_to_breakpoint "vla1-deallocated" > +gdb_test "print l" " = \\.FALSE\\." \ > + "print vla1 allocation status (deallocated)" > +gdb_test "print vla1" " = <not allocated>" \ > + "print deallocated vla1" > + > +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] > +gdb_continue_to_breakpoint "vla2-deallocated" > +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated" > +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2" > diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp > b/gdb/testsuite/gdb.fortran/vla-datatypes.exp > new file mode 100644 > index 0000000..006fce6 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp > @@ -0,0 +1,82 @@ > +# 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/>. > + > +standard_testfile ".f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +# check that all fortran standard datatypes will be > +# handled correctly when using as VLA's > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +gdb_breakpoint [gdb_get_line_number "vlas-allocated"] > +gdb_continue_to_breakpoint "vlas-allocated" > +gdb_test "next" " = allocated\\\(realvla\\\)" \ > + "next to allocation status of intvla" > +gdb_test "print l" " = \\.TRUE\\." "intvla allocated" > +gdb_test "next" " = allocated\\\(complexvla\\\)" \ > + "next to allocation status of realvla" > +gdb_test "print l" " = \\.TRUE\\." "realvla allocated" > +gdb_test "next" " = allocated\\\(logicalvla\\\)" \ > + "next to allocation status of complexvla" > +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" > +gdb_test "next" " = allocated\\\(charactervla\\\)" \ > + "next to allocation status of logicalvla" > +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" > +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ > + "next to allocation status of charactervla" > +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" > + > +gdb_breakpoint [gdb_get_line_number "vlas-initialized"] > +gdb_continue_to_breakpoint "vlas-initialized" > +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \ > + "ptype intvla" > +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ > + "ptype realvla" > +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) > \\\(11,22,33\\\)" \ > + "ptype complexvla" > +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) > \\\(11,22,33\\\)" \ > + "ptype logicalvla" > +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \ > + "ptype charactervla" > + > +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" > +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ > + "print realvla(5,5,5) (1st)" > +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ > + "print complexvla(5,5,5) (1st)" > +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ > + "print logicalvla(5,5,5) (1st)" > +gdb_test "print charactervla(5,5,5)" " = 'K'" \ > + "print charactervla(5,5,5) (1st)" > + > +gdb_breakpoint [gdb_get_line_number "vlas-modified"] > +gdb_continue_to_breakpoint "vlas-modified" > +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" > +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ > + "print realvla(5,5,5) (2nd)" > +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ > + "print complexvla(5,5,5) (2nd)" > +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ > + "print logicalvla(5,5,5) (2nd)" > +gdb_test "print charactervla(5,5,5)" " = 'X'" \ > + "print charactervla(5,5,5) (2nd)" > diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 > b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 > new file mode 100644 > index 0000000..db25695 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 > @@ -0,0 +1,51 @@ > +! 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 2 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, write to the Free Software > +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. > + > +program vla_primitives > + integer, allocatable :: intvla(:, :, :) > + real, allocatable :: realvla(:, :, :) > + complex, allocatable :: complexvla(:, :, :) > + logical, allocatable :: logicalvla(:, :, :) > + character, allocatable :: charactervla(:, :, :) > + logical :: l > + > + allocate (intvla (11,22,33)) > + allocate (realvla (11,22,33)) > + allocate (complexvla (11,22,33)) > + allocate (logicalvla (11,22,33)) > + allocate (charactervla (11,22,33)) > + > + l = allocated(intvla) ! vlas-allocated > + l = allocated(realvla) > + l = allocated(complexvla) > + l = allocated(logicalvla) > + l = allocated(charactervla) > + > + intvla(:,:,:) = 1 > + realvla(:,:,:) = 3.14 > + complexvla(:,:,:) = cmplx(2.0,-3.0) > + logicalvla(:,:,:) = .TRUE. > + charactervla(:,:,:) = char(75) > + > + intvla(5,5,5) = 42 ! vlas-initialized > + realvla(5,5,5) = 4.13 > + complexvla(5,5,5) = cmplx(-3.0,2.0) > + logicalvla(5,5,5) = .FALSE. > + charactervla(5,5,5) = 'X' > + > + ! dummy statement for bp > + l = .FALSE. ! vlas-modified > +end program vla_primitives > diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp > b/gdb/testsuite/gdb.fortran/vla-history.exp > new file mode 100644 > index 0000000..5fbffaf > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-history.exp > @@ -0,0 +1,62 @@ > +# 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/>. > + > +standard_testfile "vla.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Set some breakpoints and print complete vla. > +gdb_breakpoint [gdb_get_line_number "vla1-init"] > +gdb_continue_to_breakpoint "vla1-init" > +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" > + > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print vla1 allocated" > +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print vla2 allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla1-filled"] > +gdb_continue_to_breakpoint "vla1-filled" > +gdb_test "print vla1" \ > + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ > + "print vla1 filled" > + > +# Try to access history values for full vla prints. > +gdb_test "print \$1" " = <not allocated>" "print \$1" > +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print \$2" > +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print \$3" > +gdb_test "print \$4" \ > + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4" > + > +gdb_breakpoint [gdb_get_line_number "vla2-filled"] > +gdb_continue_to_breakpoint "vla2-filled" > +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)" > +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)" > + > +# Try to access history values for vla values. > +gdb_test "print \$9" " = 1311" "print \$9" > +gdb_test "print \$10" " = 1001" "print \$10" > diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp > b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp > new file mode 100644 > index 0000000..c4cbb03 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp > @@ -0,0 +1,32 @@ > +# 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/>. > + > +standard_testfile "vla.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Check the status of a pointer to a dynamic array. > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) > \\(10,10,10\\)\\)\\) ${hex}" \ > + "print pvla pointer information" > diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp > b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp > new file mode 100644 > index 0000000..eb704a8 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp > @@ -0,0 +1,87 @@ > +# 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/>. > + > +standard_testfile "vla-sub.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Pass fixed array to function and handle them as vla in function. > +gdb_breakpoint [gdb_get_line_number "not-filled"] > +gdb_continue_to_breakpoint "not-filled (1st)" > +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \ > + "ptype array1 (passed fixed)" > +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \ > + "ptype array2 (passed fixed)" > +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(40, 10) (passed fixed)" > +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \ > + "ptype array2(13, 11, 5) (passed fixed)" > + > +# Pass sub arrays to function and handle them as vla in function. > +gdb_continue_to_breakpoint "not-filled (2nd)" > +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \ > + "ptype array1 (passed sub-array)" > +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \ > + "ptype array2 (passed sub-array)" > +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(3, 3) (passed sub-array)" > +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ > + "ptype array2(4, 4, 4) (passed sub-array)" > + > +# Check ptype outside of bounds. This should not crash GDB. > +gdb_test "ptype array1(100, 100)" "no such vector element" \ > + "ptype array1(100, 100) subarray do not crash (passed sub-array)" > +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ > + "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)" > + > +# Pass vla to function. > +gdb_continue_to_breakpoint "not-filled (3rd)" > +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \ > + "ptype array1 (passed vla)" > +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype array2 (passed vla)" > +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(3, 3) (passed vla)" > +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ > + "ptype array2(4, 4, 4) (passed vla)" > + > +# Check ptype outside of bounds. This should not crash GDB. > +gdb_test "ptype array1(100, 100)" "no such vector element" \ > + "ptype array1(100, 100) VLA do not crash (passed vla)" > +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ > + "ptype array2(100, 100, 100) VLA do not crash (passed vla)" > + > +# Pass fixed array to function and handle it as VLA of arbitrary length in > +# function. > +gdb_breakpoint [gdb_get_line_number "end-of-bar"] > +gdb_continue_to_breakpoint "end-of-bar" > +gdb_test "ptype array1" \ > + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \ > + "ptype array1 (arbitrary length)" > +gdb_test "ptype array2" \ > + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) > \\(4:9,10:\\*\\)\\)?" \ > + "ptype array2 (arbitrary length)" > +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(100) (arbitrary length)" > +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \ > + "ptype array2(4,100) (arbitrary length)" > diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp > b/gdb/testsuite/gdb.fortran/vla-ptype.exp > new file mode 100644 > index 0000000..c95f7b2 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp > @@ -0,0 +1,96 @@ > +# 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/>. > + > +standard_testfile "vla.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Check the ptype of various VLA states and pointer to VLA's. > +gdb_breakpoint [gdb_get_line_number "vla1-init"] > +gdb_continue_to_breakpoint "vla1-init" > +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" > +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" > +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" > +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not > allocated\\\)" \ > + "ptype vla1(3, 6, 9) not initialized" > +gdb_test "ptype vla2(5, 45, 20)" \ > + "no such vector element \\\(vector not allocated\\\)" \ > + "ptype vla1(5, 45, 20) not initialized" > + > +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] > +gdb_continue_to_breakpoint "vla1-allocated" > +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype vla1 allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ > + "ptype vla2 allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla1-filled"] > +gdb_continue_to_breakpoint "vla1-filled" > +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype vla1 filled" > +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \ > + "ptype vla1(3, 6, 9)" > + > +gdb_breakpoint [gdb_get_line_number "vla2-filled"] > +gdb_continue_to_breakpoint "vla2-filled" > +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ > + "ptype vla2 filled" > +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ > + "ptype vla1(5, 45, 20) filled" > + > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype pvla associated" > +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \ > + "ptype pvla(3, 6, 9)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] > +gdb_continue_to_breakpoint "pvla-re-associated" > +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ > + "ptype pvla re-associated" > +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ > + "ptype vla1(5, 45, 20) re-associated" > + > +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] > +gdb_continue_to_breakpoint "pvla-deassociated" > +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" > +gdb_test "ptype pvla(5, 45, 20)" \ > + "no such vector element \\\(vector not associated\\\)" \ > + "ptype pvla(5, 45, 20) not associated" > + > +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] > +gdb_continue_to_breakpoint "vla1-deallocated" > +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" > +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not > allocated\\\)" \ > + "ptype vla1(3, 6, 9) not allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] > +gdb_continue_to_breakpoint "vla2-deallocated" > +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" > +gdb_test "ptype vla2(5, 45, 20)" \ > + "no such vector element \\\(vector not allocated\\\)" \ > + "ptype vla2(5, 45, 20) not allocated" > diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp > b/gdb/testsuite/gdb.fortran/vla-sizeof.exp > new file mode 100644 > index 0000000..ee09e98 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp > @@ -0,0 +1,46 @@ > +# 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/>. > + > +standard_testfile "vla.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Try to access values in non allocated VLA > +gdb_breakpoint [gdb_get_line_number "vla1-init"] > +gdb_continue_to_breakpoint "vla1-init" > +gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1" > + > +# Try to access value in allocated VLA > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" > + > +# Try to access values in undefined pointer to VLA (dangling) > +gdb_breakpoint [gdb_get_line_number "vla1-filled"] > +gdb_continue_to_breakpoint "vla1-filled" > +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" > + > +# Try to access values in pointer to VLA and compare them > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla" > diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 > b/gdb/testsuite/gdb.fortran/vla-sub.f90 > new file mode 100644 > index 0000000..dfda411 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-sub.f90 > @@ -0,0 +1,82 @@ > +! 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 2 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, write to the Free Software > +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. > +! > +! Original file written by Jakub Jelinek <jakub@redhat.com> and > +! Jan Kratochvil <jan.kratochvil@redhat.com>. > +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>. > + > +subroutine foo (array1, array2) > + integer :: array1 (:, :) > + real :: array2 (:, :, :) > + > + array1(:,:) = 5 ! not-filled > + array1(1, 1) = 30 > + > + array2(:,:,:) = 6 ! array1-filled > + array2(:,:,:) = 3 > + array2(1,1,1) = 30 > + array2(3,3,3) = 90 ! array2-almost-filled > +end subroutine > + > +subroutine bar (array1, array2) > + integer :: array1 (*) > + integer :: array2 (4:9, 10:*) > + > + array1(5:10) = 1311 > + array1(7) = 1 > + array1(100) = 100 > + array2(4,10) = array1(7) > + array2(4,100) = array1(7) > + return ! end-of-bar > +end subroutine > + > +program vla_sub > + interface > + subroutine foo (array1, array2) > + integer :: array1 (:, :) > + real :: array2 (:, :, :) > + end subroutine > + end interface > + interface > + subroutine bar (array1, array2) > + integer :: array1 (*) > + integer :: array2 (4:9, 10:*) > + end subroutine > + end interface > + > + real, allocatable :: vla1 (:, :, :) > + integer, allocatable :: vla2 (:, :) > + > + ! used for subroutine > + integer :: sub_arr1(42, 42) > + real :: sub_arr2(42, 42, 42) > + integer :: sub_arr3(42) > + > + sub_arr1(:,:) = 1 ! vla2-deallocated > + sub_arr2(:,:,:) = 2 > + sub_arr3(:) = 3 > + > + call foo(sub_arr1, sub_arr2) > + call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15)) > + > + allocate (vla1 (10,10,10)) > + allocate (vla2 (20,20)) > + vla1(:,:,:) = 1311 > + vla2(:,:) = 42 > + call foo(vla2, vla1) > + > + call bar(sub_arr3, sub_arr1) > +end program vla_sub > diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp > b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp > new file mode 100644 > index 0000000..a9f8589 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp > @@ -0,0 +1,35 @@ > +# 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/>. > + > +standard_testfile "vla-sub.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Check VLA with arbitary length and check that elements outside of > +# bounds of the passed VLA can be accessed correctly. > +gdb_breakpoint [gdb_get_line_number "end-of-bar"] > +gdb_continue_to_breakpoint "end-of-bar" > +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)" > +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)" > +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)" > +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)" > diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp > b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp > new file mode 100644 > index 0000000..88c6254 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp > @@ -0,0 +1,49 @@ > +# 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/>. > + > +standard_testfile "vla-sub.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# "up" works with GCC but other Fortran compilers may copy the values > into the > +# outer function only on the exit of the inner function. > +# We need both variants as depending on the arch we optionally may still be > +# executing the caller line or not after `finish'. > + > +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] > +gdb_continue_to_breakpoint "array2-almost-filled" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger" > + > +gdb_test "finish" \ > + ".*(foo\\\(sub_arr1\\\(5:10, 5:10\\\), > sub_arr2\\\(10:15,10:15,10:15\\\)\\\)|foo \\\(array1=..., > array2=...\\\).*)" \ > + "finish function" > +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish" > +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish" > +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish" > +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish" > + > diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp > b/gdb/testsuite/gdb.fortran/vla-value-sub.exp > new file mode 100644 > index 0000000..8562ea4 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp > @@ -0,0 +1,90 @@ > +# 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/>. > + > +standard_testfile "vla-sub.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Check the values of VLA's in subroutine can be evaluated correctly > + > +# Try to access values from a fixed array handled as VLA in subroutine. > +gdb_breakpoint [gdb_get_line_number "not-filled"] > +gdb_continue_to_breakpoint "not-filled (1st)" > +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \ > + "print passed array1 in foo (passed fixed array)" > + > +gdb_breakpoint [gdb_get_line_number "array1-filled"] > +gdb_continue_to_breakpoint "array1-filled (1st)" > +gdb_test "print array1(5, 7)" " = 5" \ > + "print array1(5, 7) after filled in foo (passed fixed array)" > +gdb_test "print array1(1, 1)" " = 30" \ > + "print array1(1, 1) after filled in foo (passed fixed array)" > + > +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] > +gdb_continue_to_breakpoint "array2-almost-filled (1st)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled (passed fixed array)" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine (passed fixed array)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger (passed fixed > array)" > + > + > +# Try to access values from a fixed sub-array handled as VLA in subroutine. > +gdb_continue_to_breakpoint "not-filled (2nd)" > +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \ > + "print passed array1 in foo (passed sub-array)" > + > +gdb_continue_to_breakpoint "array1-filled (2nd)" > +gdb_test "print array1(5, 5)" " = 5" \ > + "print array1(5, 5) after filled in foo (passed sub-array)" > +gdb_test "print array1(1, 1)" " = 30" \ > + "print array1(1, 1) after filled in foo (passed sub-array)" > + > +gdb_continue_to_breakpoint "array2-almost-filled (2nd)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled (passed sub-array)" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine (passed sub-array)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger (passed sub-array)" > + > + > +# Try to access values from a VLA passed to subroutine. > +gdb_continue_to_breakpoint "not-filled (3rd)" > +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \ > + "print passed array1 in foo (passed vla)" > + > +gdb_continue_to_breakpoint "array1-filled (3rd)" > +gdb_test "print array1(5, 5)" " = 5" \ > + "print array1(5, 5) after filled in foo (passed vla)" > +gdb_test "print array1(1, 1)" " = 30" \ > + "print array1(1, 1) after filled in foo (passed vla)" > + > +gdb_continue_to_breakpoint "array2-almost-filled (3rd)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled (passed vla)" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine (passed vla)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger (passed vla)" > diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp > b/gdb/testsuite/gdb.fortran/vla-value.exp > new file mode 100644 > index 0000000..24182cc > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value.exp > @@ -0,0 +1,148 @@ > +# 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/>. > + > +standard_testfile "vla.f90" > + > +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90 quiet}] } { > + return -1 > +} > + > +if ![runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# Try to access values in non allocated VLA > +gdb_breakpoint [gdb_get_line_number "vla1-init"] > +gdb_continue_to_breakpoint "vla1-init" > +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" > +gdb_test "print &vla1" \ > + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not > allocated>\\\)\\\)\\\) $hex" \ > + "print non-allocated &vla1" > +gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not > allocated\\\)" \ > + "print member in non-allocated vla1 (1)" > +gdb_test "print vla1(101,202,303)" \ > + "no such vector element \\\(vector not allocated\\\)" \ > + "print member in non-allocated vla1 (2)" > +gdb_test "print vla1(5,2,18)=1" "no such vector element \\\(vector not > allocated\\\)" \ > + "set member in non-allocated vla1" > + > +# Try to access value in allocated VLA > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "next" "\\d+(\\t|\\s)+vla1\\\(3, 6, 9\\\) = 42" \ > + "step over value assignment of vla1" > +gdb_test "print &vla1" \ > + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ > + "print allocated &vla1" > +gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)" > +gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)" > +gdb_test "print vla1(9, 9, 9) = 999" " = 999" \ > + "print allocated vla1(9,9,9)=1" > + > +# Try to access values in allocated VLA after specific assignment > +gdb_breakpoint [gdb_get_line_number "vla1-filled"] > +gdb_continue_to_breakpoint "vla1-filled" > +gdb_test "print vla1(3, 6, 9)" " = 42" \ > + "print allocated vla1(3,6,9) after specific assignment (filled)" > +gdb_test "print vla1(1, 3, 8)" " = 1001" \ > + "print allocated vla1(1,3,8) after specific assignment (filled)" > +gdb_test "print vla1(9, 9, 9)" " = 999" \ > + "print allocated vla1(9,9,9) after assignment in debugger (filled)" > + > +# Try to access values in undefined pointer to VLA (dangling) > +gdb_test "print pvla" " = <not associated>" "print undefined pvla" > +gdb_test "print &pvla" \ > + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not > associated>\\\)\\\)\\\) $hex" \ > + "print non-associated &pvla" > +gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not > associated\\\)" \ > + "print undefined pvla(1,3,8)" > + > +# Try to access values in pointer to VLA and compare them > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test "print &pvla" \ > + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ > + "print associated &pvla" > +gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)" > +gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)" > +gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)" > + > +# Fill values to VLA using pointer and check > +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] > +gdb_continue_to_breakpoint "pvla-re-associated" > +gdb_test "print pvla(5, 45, 20)" \ > + " = 1" "print pvla(5, 45, 20) after filled using pointer" > +gdb_test "print vla2(5, 45, 20)" \ > + " = 1" "print vla2(5, 45, 20) after filled using pointer" > +gdb_test "print pvla(7, 45, 14)" " = 2" \ > + "print pvla(7, 45, 14) after filled using pointer" > +gdb_test "print vla2(7, 45, 14)" " = 2" \ > + "print vla2(7, 45, 14) after filled using pointer" > + > +# Try to access values of deassociated VLA pointer > +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] > +gdb_continue_to_breakpoint "pvla-deassociated" > +gdb_test "print pvla(5, 45, 20)" \ > + "no such vector element \\\(vector not associated\\\)" \ > + "print pvla(5, 45, 20) after deassociated" > +gdb_test "print pvla(7, 45, 14)" \ > + "no such vector element \\\(vector not associated\\\)" \ > + "print pvla(7, 45, 14) after dissasociated" > +gdb_test "print pvla" " = <not associated>" \ > + "print vla1 after deassociated" > + > +# Try to access values of deallocated VLA > +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] > +gdb_continue_to_breakpoint "vla1-deallocated" > +gdb_test "print vla1(3, 6, 9)" "no such vector element \\\(vector not > allocated\\\)" \ > + "print allocated vla1(3,6,9) after specific assignment (deallocated)" > +gdb_test "print vla1(1, 3, 8)" "no such vector element \\\(vector not > allocated\\\)" \ > + "print allocated vla1(1,3,8) after specific assignment (deallocated)" > +gdb_test "print vla1(9, 9, 9)" "no such vector element \\\(vector not > allocated\\\)" \ > + "print allocated vla1(9,9,9) after assignment in debugger (deallocated)" > + > + > +# Try to assign VLA to user variable > +clean_restart ${testfile} > + > +if ![runto MAIN__] then { > + perror "couldn't run to breakpoint MAIN__" > + continue > +} > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "next" "\\d+.*vla1\\(3, 6, 9\\) = 42" "next (1)" > + > +gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1" > +gdb_test "print \$myvar" \ > + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ > + "print \$myvar set to vla1" > + > +gdb_test "next" "\\d+.*vla1\\(1, 3, 8\\) = 1001" "next (2)" > +gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla" > +gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)" > + > +# deallocate pointer and make sure user defined variable still has the > +# right value. > +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] > +gdb_continue_to_breakpoint "pvla-deassociated" > +gdb_test "print \$mypvar(1,3,8)" " = 1001" \ > + "print \$mypvar(1,3,8) after deallocated" > diff --git a/gdb/testsuite/gdb.fortran/vla.f90 > b/gdb/testsuite/gdb.fortran/vla.f90 > new file mode 100644 > index 0000000..61e22b9 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla.f90 > @@ -0,0 +1,56 @@ > +! 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 vla > + real, target, allocatable :: vla1 (:, :, :) > + real, target, allocatable :: vla2 (:, :, :) > + real, target, allocatable :: vla3 (:, :) > + real, pointer :: pvla (:, :, :) > + logical :: l > + > + allocate (vla1 (10,10,10)) ! vla1-init > + l = allocated(vla1) > + > + allocate (vla2 (1:7,42:50,13:35)) ! vla1-allocated > + l = allocated(vla2) > + > + vla1(:, :, :) = 1311 ! vla2-allocated > + vla1(3, 6, 9) = 42 > + vla1(1, 3, 8) = 1001 > + vla1(6, 2, 7) = 13 > + > + vla2(:, :, :) = 1311 ! vla1-filled > + vla2(5, 45, 20) = 42 > + > + pvla => vla1 ! vla2-filled > + l = associated(pvla) > + > + pvla => vla2 ! pvla-associated > + l = associated(pvla) > + pvla(5, 45, 20) = 1 > + pvla(7, 45, 14) = 2 > + > + pvla => null() ! pvla-re-associated > + l = associated(pvla) > + > + deallocate (vla1) ! pvla-deassociated > + l = allocated(vla1) > + > + deallocate (vla2) ! vla1-deallocated > + l = allocated(vla2) > + > + allocate (vla3 (2,2)) ! vla2-deallocated > + vla3(:,:) = 13 > +end program vla > diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp > b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp > new file mode 100644 > index 0000000..d191623 > --- /dev/null > +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp > @@ -0,0 +1,182 @@ > +# 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/>. > + > +# Verify that, using the MI, we can evaluate a simple C Variable Length > +# Array (VLA). > + > +load_lib mi-support.exp > +set MIFLAGS "-i=mi" > + > +gdb_exit > +if [mi_gdb_start] { > + continue > +} > + > +standard_testfile vla.f90 > + > +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \ > + {debug f90}] != "" } { > + untested mi-vla-fortran.exp > + return -1 > +} > + > +mi_delete_breakpoints > +mi_gdb_reinitialize_dir $srcdir/$subdir > +mi_gdb_load ${binfile} > + > +set bp_lineno [gdb_get_line_number "vla1-not-allocated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \ > + ".*vla.f90" $bp_lineno $hex \ > + "insert breakpoint at line $bp_lineno (vla not allocated)" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "500-data-evaluate-expression vla1" \ > + "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" > + > +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ > + "create local variable vla1_not_allocated" > +mi_gdb_test "501-var-info-type vla1_not_allocated" \ > + "501\\^done,type=\"<not allocated>\"" \ > + "info type variable vla1_not_allocated" > +mi_gdb_test "502-var-show-format vla1_not_allocated" \ > + "502\\^done,format=\"natural\"" \ > + "show format variable vla1_not_allocated" > +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \ > + "503\\^done,value=\"\\\[0\\\]\"" \ > + "eval variable vla1_not_allocated" > +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ > + "real\\\(kind=4\\\)" "get children of vla1_not_allocated" > + > + > + > +set bp_lineno [gdb_get_line_number "vla1-allocated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "510-data-evaluate-expression vla1" \ > + "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla" > + > +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) > \\\(5\\\)" \ > + "create local variable vla1_allocated" > +mi_gdb_test "511-var-info-type vla1_allocated" \ > + "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ > + "info type variable vla1_allocated" > +mi_gdb_test "512-var-show-format vla1_allocated" \ > + "512\\^done,format=\"natural\"" \ > + "show format variable vla1_allocated" > +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \ > + "513\\^done,value=\"\\\[5\\\]\"" \ > + "eval variable vla1_allocated" > +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ > + "real\\\(kind=4\\\)" "get children of vla1_allocated" > + > + > +set bp_lineno [gdb_get_line_number "vla1-filled"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "520-data-evaluate-expression vla1" \ > + "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla" > + > + > +set bp_lineno [gdb_get_line_number "vla1-modified"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "530-data-evaluate-expression vla1" \ > + "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla" > +mi_gdb_test "540-data-evaluate-expression vla1(1)" \ > + "540\\^done,value=\"1\"" "evaluate filled vla" > +mi_gdb_test "550-data-evaluate-expression vla1(2)" \ > + "550\\^done,value=\"42\"" "evaluate filled vla" > +mi_gdb_test "560-data-evaluate-expression vla1(4)" \ > + "560\\^done,value=\"24\"" "evaluate filled vla" > + > + > +set bp_lineno [gdb_get_line_number "vla1-deallocated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "570-data-evaluate-expression vla1" \ > + "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" > + > + > +set bp_lineno [gdb_get_line_number "pvla2-not-associated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "580-data-evaluate-expression pvla2" \ > + "580\\^done,value=\"<not associated>\"" "evaluate not associated vla" > + > +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ > + "create local variable pvla2_not_associated" > +mi_gdb_test "581-var-info-type pvla2_not_associated" \ > + "581\\^done,type=\"<not associated>\"" \ > + "info type variable pvla2_not_associated" > +mi_gdb_test "582-var-show-format pvla2_not_associated" \ > + "582\\^done,format=\"natural\"" \ > + "show format variable pvla2_not_associated" > +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \ > + "583\\^done,value=\"\\\[0\\\]\"" \ > + "eval variable pvla2_not_associated" > +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ > + "real\\\(kind=4\\\)" "get children of pvla2_not_associated" > + > + > +set bp_lineno [gdb_get_line_number "pvla2-associated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "590-data-evaluate-expression pvla2" \ > + "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \ > + "evaluate associated vla" > + > +mi_create_varobj_checked pvla2_associated pvla2 \ > + "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" > +mi_gdb_test "591-var-info-type pvla2_associated" \ > + "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ > + "info type variable pvla2_associated" > +mi_gdb_test "592-var-show-format pvla2_associated" \ > + "592\\^done,format=\"natural\"" \ > + "show format variable pvla2_associated" > +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \ > + "593\\^done,value=\"\\\[2\\\]\"" \ > + "eval variable pvla2_associated" > + > + > +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "600-data-evaluate-expression pvla2" \ > + "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null" > + > +mi_gdb_exit > +return 0 > diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90 > new file mode 100644 > index 0000000..0b89d34 > --- /dev/null > +++ b/gdb/testsuite/gdb.mi/vla.f90 > @@ -0,0 +1,42 @@ > +! 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 vla > + real, allocatable :: vla1 (:) > + real, target, allocatable :: vla2(:, :) > + real, pointer :: pvla2 (:, :) > + logical :: l > + > + allocate (vla1 (5)) ! vla1-not-allocated > + l = allocated(vla1) ! vla1-allocated > + > + vla1(:) = 1 > + vla1(2) = 42 ! vla1-filled > + vla1(4) = 24 > + > + deallocate (vla1) ! vla1-modified > + l = allocated(vla1) ! vla1-deallocated > + > + allocate (vla2 (5, 2)) > + vla2(:, :) = 2 > + > + pvla2 => vla2 ! pvla2-not-associated > + l = associated(pvla2) ! pvla2-associated > + > + pvla2(2, 1) = 42 > + > + pvla2 => null() > + l = associated(pvla2) ! pvla2-set-to-null > +end program vla > diff --git a/gdb/typeprint.c b/gdb/typeprint.c > index 9e44225..85a0c6b 100644 > --- a/gdb/typeprint.c > +++ b/gdb/typeprint.c > @@ -725,3 +725,20 @@ Show printing of typedefs defined in classes."), NULL, > show_print_type_typedefs, > &setprinttypelist, &showprinttypelist); > } > + > +/* Print <not allocated> status to stream STREAM. */ > + > +void > +val_print_not_allocated (struct ui_file *stream) > +{ > + fprintf_filtered (stream, _("<not allocated>")); > +} > + > +/* Print <not associated> status to stream STREAM. */ > + > +void > +val_print_not_associated (struct ui_file *stream) > +{ > + fprintf_filtered (stream, _("<not associated>")); > +} > + > diff --git a/gdb/typeprint.h b/gdb/typeprint.h > index bdff41b..d8225f2 100644 > --- a/gdb/typeprint.h > +++ b/gdb/typeprint.h > @@ -74,4 +74,8 @@ void c_type_print_varspec_suffix (struct type *, struct > ui_file *, int, > void c_type_print_args (struct type *, struct ui_file *, int, enum language, > const struct type_print_options *); > > +extern void val_print_not_allocated (struct ui_file *stream); > + > +extern void val_print_not_associated (struct ui_file *stream); > + > #endif > diff --git a/gdb/valarith.c b/gdb/valarith.c > index 3e349f2..97145a1 100644 > --- a/gdb/valarith.c > +++ b/gdb/valarith.c > @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, > LONGEST index, int lowerbound) > > if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED > (array_type) > && elt_offs >= type_length_units (array_type))) > - error (_("no such vector element")); > + { > + if (type_not_associated (array_type)) > + error (_("no such vector element (vector not associated)")); > + else if (type_not_allocated (array_type)) > + error (_("no such vector element (vector not allocated)")); > + else > + error (_("no such vector element")); > + } > > if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) > v = allocate_value_lazy (elt_type); > diff --git a/gdb/valprint.c b/gdb/valprint.c > index 713998c..e6c9e50 100644 > --- a/gdb/valprint.c > +++ b/gdb/valprint.c > @@ -34,6 +34,7 @@ > #include "ada-lang.h" > #include "gdb_obstack.h" > #include "charset.h" > +#include "typeprint.h" > #include <ctype.h> > > /* Maximum number of wchars returned from wchar_iterate. */ > @@ -303,6 +304,18 @@ valprint_check_validity (struct ui_file *stream, > { > type = check_typedef (type); > > + if (type_not_associated (type)) > + { > + val_print_not_associated (stream); > + return 0; > + } > + > + if (type_not_allocated (type)) > + { > + val_print_not_allocated (stream); > + return 0; > + } > + > if (TYPE_CODE (type) != TYPE_CODE_UNION > && TYPE_CODE (type) != TYPE_CODE_STRUCT > && TYPE_CODE (type) != TYPE_CODE_ARRAY) > @@ -1043,6 +1056,18 @@ value_check_printable (struct value *val, struct > ui_file *stream, > return 0; > } > > + if (type_not_associated (value_type (val))) > + { > + val_print_not_associated (stream); > + return 0; > + } > + > + if (type_not_allocated (value_type (val))) > + { > + val_print_not_allocated (stream); > + return 0; > + } > + > return 1; > } > > -- > 1.7.9.5 > -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-08-20 12:52 ` Joel Brobecker @ 2015-10-09 11:37 ` Keven Boell 2015-10-22 9:59 ` Joel Brobecker 2016-01-20 10:19 ` Yao Qi [not found] ` <5613D0DC.3040908@linux.intel.com> 1 sibling, 2 replies; 18+ messages in thread From: Keven Boell @ 2015-10-09 11:37 UTC (permalink / raw) To: gdb-patches; +Cc: Joel Brobecker Hi Joel, Thanks for the review and sorry for the long delay. Here is the updated patch. --- Fortran provide types whose values may be dynamically allocated or associated with a variable under explicit program control. The purpose of this commit is * to read allocated/associated DWARF tags and store them in the dynamic property list of main_type. * enable GDB to print the value of a dynamic array in Fortran in case the type is allocated or associated (pointer to dynamic array). Examples: (gdb) p vla_not_allocated $1 = <not allocated> (gdb) p vla_allocated $1 = (1, 2, 3) (gdb) p vla_ptr_not_associated $1 = <not associated> (gdb) p vla_ptr_associated $1 = (1, 2, 3) Add basic test coverage for most dynamic array use-cases in Fortran. The commit contains the following tests: * Ensure that values of Fortran dynamic arrays can be evaluated correctly in various ways and states. * Ensure that Fortran primitives can be evaluated correctly when used as a dynamic array. * Dynamic arrays passed to subroutines and handled in different ways inside the routine. * Ensure that the ptype of dynamic arrays in Fortran can be printed in GDB correctly. * Ensure that dynamic arrays in different states (allocated/associated) can be evaluated. * Dynamic arrays passed to functions and returned from functions. * History values of dynamic arrays can be accessed and printed again with the correct values. * Dynamic array evaluations using MI protocol. * Sizeof output of dynamic arrays in various states. The patch was tested using the test suite on Ubuntu 12.04 64bit. 2015-03-13 Keven Boell <keven.boell@intel.com> * dwarf2read.c (set_die_type): Add read of DW_AT_allocated and DW_AT_associated. * f-typeprint.c: New include of typeprint.h (f_print_type): Add check for allocated/associated status of type. (f_type_print_varspec_suffix): Add check for allocated/associated status of type. * gdbtypes.c (create_array_type_with_stride): Add check for valid data location of type in case allocated or associated attributes are set. Length of an array should be only calculated if allocated or associated is resolved as true. (is_dynamic_type_internal): Add check for allocated/ associated. (resolve_dynamic_array): Evaluate allocated/associated properties. * gdbtypes.h (enum dynamic_prop_node_kind): <DYN_PROP_ALLOCATED> <DYN_PROP_ASSOCIATED>: New enums. (TYPE_ALLOCATED_PROP, TYPE_ASSOCIATED_PROP): New macros. (type_not_allocated): New function. (type_not_associated): New function. * valarith.c (value_subscripted_rvalue): Add check for allocated/associated. * valprint.c: New include of typeprint.h. (valprint_check_validity): Add check for allocated/associated. (value_check_printable): Add check for allocated/ associated. * typeprint.h (val_print_not_allocated): New function. (val_print_not_associated): New function. * typeprint.c (val_print_not_allocated): New function. (val_print_not_associated): New function. testsuite/gdb.fortran: * vla-alloc-assoc.exp: New file. * vla-datatypes.exp: New file. * vla-datatypes.f90: New file. * vla-history.exp: New file. * vla-ptype-sub.exp: New file. * vla-ptype.exp: New file. * vla-sizeof.exp: New file. * vla-sub.f90: New file. * vla-value-sub-arbitrary.exp: New file. * vla-value-sub-finish.exp: New file. * vla-value-sub.exp: New file. * vla-value.exp: New file. * vla-ptr-info.exp: New file. * vla.f90: New file. testsuite/gdb.mi: * mi-vla-fortran.exp: New file. * vla.f90: New file. --- gdb/dwarf2read.c | 30 ++++ gdb/f-typeprint.c | 62 ++++--- gdb/gdbtypes.c | 57 +++++- gdb/gdbtypes.h | 18 ++ gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 ++++++++++++++++++++ gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ gdb/typeprint.c | 17 ++ gdb/typeprint.h | 4 + gdb/valarith.c | 9 +- gdb/valprint.c | 25 +++ 24 files changed, 1401 insertions(+), 26 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp create mode 100644 gdb/testsuite/gdb.mi/vla.f90 diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index ddd4a4c..5411bf8 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -22356,6 +22356,36 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) && !HAVE_GNAT_AUX_INFO (type)) INIT_GNAT_SPECIFIC (type); + /* Read DW_AT_allocated and set in type. */ + attr = dwarf2_attr (die, DW_AT_allocated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); + } + else if (attr != NULL) + { + complaint (&symfile_complaints, + _("DW_AT_allocated has the wrong form (%s) at DIE 0x%x"), + (attr != NULL ? dwarf_form_name (attr->form) : "n/a"), + die->offset.sect_off); + } + + /* Read DW_AT_associated and set in type. */ + attr = dwarf2_attr (die, DW_AT_associated, cu); + if (attr_form_is_block (attr)) + { + if (attr_to_dynamic_prop (attr, die, cu, &prop)) + add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); + } + else if (attr != NULL) + { + complaint (&symfile_complaints, + _("DW_AT_associated has the wrong form (%s) at DIE 0x%x"), + (attr != NULL ? dwarf_form_name (attr->form) : "n/a"), + die->offset.sect_off); + } + /* Read DW_AT_data_location and set in type. */ attr = dwarf2_attr (die, DW_AT_data_location, cu); if (attr_to_dynamic_prop (attr, die, cu, &prop)) diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 590ed73..1308a3c 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -30,6 +30,7 @@ #include "gdbcore.h" #include "target.h" #include "f-lang.h" +#include "typeprint.h" #if 0 /* Currently unused. */ static void f_type_print_args (struct type *, struct ui_file *); @@ -53,6 +54,18 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, enum type_code code; int demangled_args; + if (type_not_associated (type)) + { + val_print_not_associated (stream); + return; + } + + if (type_not_allocated (type)) + { + val_print_not_allocated (stream); + return; + } + f_type_print_base (type, stream, show, level); code = TYPE_CODE (type); if ((varstring != NULL && *varstring != '\0') @@ -167,28 +180,35 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, if (arrayprint_recurse_level == 1) fprintf_filtered (stream, "("); - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, - arrayprint_recurse_level); - - lower_bound = f77_get_lowerbound (type); - if (lower_bound != 1) /* Not the default. */ - fprintf_filtered (stream, "%d:", lower_bound); - - /* Make sure that, if we have an assumed size array, we - print out a warning and print the upperbound as '*'. */ - - if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) - fprintf_filtered (stream, "*"); + if (type_not_associated (type)) + val_print_not_associated (stream); + else if (type_not_allocated (type)) + val_print_not_allocated (stream); else - { - upper_bound = f77_get_upperbound (type); - fprintf_filtered (stream, "%d", upper_bound); - } - - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, - arrayprint_recurse_level); + { + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level); + + lower_bound = f77_get_lowerbound (type); + if (lower_bound != 1) /* Not the default. */ + fprintf_filtered (stream, "%d:", lower_bound); + + /* Make sure that, if we have an assumed size array, we + print out a warning and print the upperbound as '*'. */ + + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "*"); + else + { + upper_bound = f77_get_upperbound (type); + fprintf_filtered (stream, "%d", upper_bound); + } + + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level); + } if (arrayprint_recurse_level == 1) fprintf_filtered (stream, ")"); else diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index b406550..86d1d74 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1080,7 +1080,9 @@ create_array_type_with_stride (struct type *result_type, TYPE_CODE (result_type) = TYPE_CODE_ARRAY; TYPE_TARGET_TYPE (result_type) = element_type; - if (has_static_range (TYPE_RANGE_DATA (range_type))) + if (has_static_range (TYPE_RANGE_DATA (range_type)) + && (!type_not_associated (result_type) + && !type_not_allocated (result_type))) { LONGEST low_bound, high_bound; @@ -1819,6 +1821,12 @@ is_dynamic_type_internal (struct type *type, int top_level) || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) return 1; + if (TYPE_ASSOCIATED_PROP (type)) + return 1; + + if (TYPE_ALLOCATED_PROP (type)) + return 1; + switch (TYPE_CODE (type)) { case TYPE_CODE_RANGE: @@ -1936,13 +1944,31 @@ resolve_dynamic_array (struct type *type, struct type *elt_type; struct type *range_type; struct type *ary_dim; + struct dynamic_prop *prop; gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); + type = copy_type (type); + elt_type = type; range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); range_type = resolve_dynamic_range (range_type, addr_stack); + /* Resolve allocated/associated here before creating a new array type, which + will update the length of the array accordingly. */ + prop = TYPE_ALLOCATED_PROP (type); + if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + prop = TYPE_ASSOCIATED_PROP (type); + if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + } + ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) @@ -1950,9 +1976,8 @@ resolve_dynamic_array (struct type *type, else elt_type = TYPE_TARGET_TYPE (type); - return create_array_type_with_stride (copy_type (type), - elt_type, range_type, - TYPE_FIELD_BITSIZE (type, 0)); + return create_array_type_with_stride (type, elt_type, range_type, + TYPE_FIELD_BITSIZE (type, 0)); } /* Resolve dynamic bounds of members of the union TYPE to static @@ -3375,6 +3400,30 @@ types_deeply_equal (struct type *type1, struct type *type2) return result; } + +/* Allocated status of type TYPE. Return zero if type TYPE is allocated. + Otherwise return one. */ + +int +type_not_allocated (const struct type *type) +{ + struct dynamic_prop *prop = TYPE_ALLOCATED_PROP (type); + + return (prop && TYPE_DYN_PROP_KIND (prop) == PROP_CONST + && !TYPE_DYN_PROP_ADDR (prop)); +} + +/* Associated status of type TYPE. Return zero if type TYPE is associated. + Otherwise return one. */ + +int +type_not_associated (const struct type *type) +{ + struct dynamic_prop *prop = TYPE_ASSOCIATED_PROP (type); + + return (prop && TYPE_DYN_PROP_KIND (prop) == PROP_CONST + && !TYPE_DYN_PROP_ADDR (prop)); +}   /* Compare one type (PARM) for compatibility with another (ARG). * PARM is intended to be the parameter type of a function; and diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index 29eec99..9590729 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -440,6 +440,14 @@ enum dynamic_prop_node_kind /* A property providing a type's data location. Evaluating this field yields to the location of an object's data. */ DYN_PROP_DATA_LOCATION, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicates that the object of the type can be allocated/deallocated. */ + DYN_PROP_ALLOCATED, + + /* A property representing DW_AT_allocated. The presence of this attribute + indicated that the object of the type can be associated. */ + DYN_PROP_ASSOCIATED, }; /* * List for dynamic type attributes. */ @@ -1258,6 +1266,12 @@ extern void allocate_gnat_aux_type (struct type *); #define TYPE_DATA_LOCATION_KIND(thistype) \ TYPE_DATA_LOCATION (thistype)->kind +/* Property accessors for the type allocated/associated. */ +#define TYPE_ALLOCATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ALLOCATED, thistype) +#define TYPE_ASSOCIATED_PROP(thistype) \ + get_dyn_prop (DYN_PROP_ASSOCIATED, thistype) + /* Attribute accessors for dynamic properties. */ #define TYPE_DYN_PROP_LIST(thistype) \ TYPE_MAIN_TYPE(thistype)->dyn_prop_list @@ -1930,4 +1944,8 @@ extern int types_equal (struct type *, struct type *); extern int types_deeply_equal (struct type *, struct type *); +extern int type_not_allocated (const struct type *type); + +extern int type_not_associated (const struct type *type); + #endif /* GDBTYPES_H */ diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp new file mode 100644 index 0000000..ad85977 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp @@ -0,0 +1,65 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the association status of various types of VLA's +# and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla1 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla2 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (re-associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print l" " = \\.FALSE\\." \ + "print pvla allocation status (deassociated)" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print l" " = \\.FALSE\\." \ + "print vla1 allocation status (deallocated)" +gdb_test "print vla1" " = <not allocated>" \ + "print deallocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated" +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp new file mode 100644 index 0000000..006fce6 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp @@ -0,0 +1,82 @@ +# 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/>. + +standard_testfile ".f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +# check that all fortran standard datatypes will be +# handled correctly when using as VLA's + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +gdb_breakpoint [gdb_get_line_number "vlas-allocated"] +gdb_continue_to_breakpoint "vlas-allocated" +gdb_test "next" " = allocated\\\(realvla\\\)" \ + "next to allocation status of intvla" +gdb_test "print l" " = \\.TRUE\\." "intvla allocated" +gdb_test "next" " = allocated\\\(complexvla\\\)" \ + "next to allocation status of realvla" +gdb_test "print l" " = \\.TRUE\\." "realvla allocated" +gdb_test "next" " = allocated\\\(logicalvla\\\)" \ + "next to allocation status of complexvla" +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" +gdb_test "next" " = allocated\\\(charactervla\\\)" \ + "next to allocation status of logicalvla" +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ + "next to allocation status of charactervla" +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" + +gdb_breakpoint [gdb_get_line_number "vlas-initialized"] +gdb_continue_to_breakpoint "vlas-initialized" +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype intvla" +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype realvla" +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype complexvla" +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype logicalvla" +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \ + "ptype charactervla" + +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ + "print realvla(5,5,5) (1st)" +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ + "print complexvla(5,5,5) (1st)" +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ + "print logicalvla(5,5,5) (1st)" +gdb_test "print charactervla(5,5,5)" " = 'K'" \ + "print charactervla(5,5,5) (1st)" + +gdb_breakpoint [gdb_get_line_number "vlas-modified"] +gdb_continue_to_breakpoint "vlas-modified" +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ + "print realvla(5,5,5) (2nd)" +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ + "print complexvla(5,5,5) (2nd)" +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ + "print logicalvla(5,5,5) (2nd)" +gdb_test "print charactervla(5,5,5)" " = 'X'" \ + "print charactervla(5,5,5) (2nd)" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 new file mode 100644 index 0000000..db25695 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 @@ -0,0 +1,51 @@ +! 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +program vla_primitives + integer, allocatable :: intvla(:, :, :) + real, allocatable :: realvla(:, :, :) + complex, allocatable :: complexvla(:, :, :) + logical, allocatable :: logicalvla(:, :, :) + character, allocatable :: charactervla(:, :, :) + logical :: l + + allocate (intvla (11,22,33)) + allocate (realvla (11,22,33)) + allocate (complexvla (11,22,33)) + allocate (logicalvla (11,22,33)) + allocate (charactervla (11,22,33)) + + l = allocated(intvla) ! vlas-allocated + l = allocated(realvla) + l = allocated(complexvla) + l = allocated(logicalvla) + l = allocated(charactervla) + + intvla(:,:,:) = 1 + realvla(:,:,:) = 3.14 + complexvla(:,:,:) = cmplx(2.0,-3.0) + logicalvla(:,:,:) = .TRUE. + charactervla(:,:,:) = char(75) + + intvla(5,5,5) = 42 ! vlas-initialized + realvla(5,5,5) = 4.13 + complexvla(5,5,5) = cmplx(-3.0,2.0) + logicalvla(5,5,5) = .FALSE. + charactervla(5,5,5) = 'X' + + ! dummy statement for bp + l = .FALSE. ! vlas-modified +end program vla_primitives diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp new file mode 100644 index 0000000..5fbffaf --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-history.exp @@ -0,0 +1,62 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Set some breakpoints and print complete vla. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla1 allocated" +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print vla1 filled" + +# Try to access history values for full vla prints. +gdb_test "print \$1" " = <not allocated>" "print \$1" +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$2" +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$3" +gdb_test "print \$4" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)" +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)" + +# Try to access history values for vla values. +gdb_test "print \$9" " = 1311" "print \$9" +gdb_test "print \$10" " = 1001" "print \$10" diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp new file mode 100644 index 0000000..c4cbb03 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp @@ -0,0 +1,32 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the status of a pointer to a dynamic array. +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) \\(10,10,10\\)\\)\\) ${hex}" \ + "print pvla pointer information" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp new file mode 100644 index 0000000..eb704a8 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp @@ -0,0 +1,87 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Pass fixed array to function and handle them as vla in function. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \ + "ptype array1 (passed fixed)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \ + "ptype array2 (passed fixed)" +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(40, 10) (passed fixed)" +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \ + "ptype array2(13, 11, 5) (passed fixed)" + +# Pass sub arrays to function and handle them as vla in function. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \ + "ptype array1 (passed sub-array)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \ + "ptype array2 (passed sub-array)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed sub-array)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed sub-array)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) subarray do not crash (passed sub-array)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)" + +# Pass vla to function. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \ + "ptype array1 (passed vla)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype array2 (passed vla)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed vla)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed vla)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) VLA do not crash (passed vla)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) VLA do not crash (passed vla)" + +# Pass fixed array to function and handle it as VLA of arbitrary length in +# function. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "ptype array1" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \ + "ptype array1 (arbitrary length)" +gdb_test "ptype array2" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \ + "ptype array2 (arbitrary length)" +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(100) (arbitrary length)" +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \ + "ptype array2(4,100) (arbitrary length)" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp new file mode 100644 index 0000000..c95f7b2 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp @@ -0,0 +1,96 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the ptype of various VLA states and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(3, 6, 9) not initialized" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(5, 45, 20) not initialized" + +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 filled" +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 filled" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) filled" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype pvla associated" +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype pvla(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype pvla re-associated" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) re-associated" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" +gdb_test "ptype pvla(5, 45, 20)" \ + "no such vector element \\\(vector not associated\\\)" \ + "ptype pvla(5, 45, 20) not associated" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla1(3, 6, 9) not allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "ptype vla2(5, 45, 20) not allocated" diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp new file mode 100644 index 0000000..ee09e98 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp @@ -0,0 +1,46 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Try to access values in non allocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1" + +# Try to access value in allocated VLA +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" + +# Try to access values in pointer to VLA and compare them +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla" diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90 new file mode 100644 index 0000000..dfda411 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sub.f90 @@ -0,0 +1,82 @@ +! 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! Original file written by Jakub Jelinek <jakub@redhat.com> and +! Jan Kratochvil <jan.kratochvil@redhat.com>. +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>. + +subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + + array1(:,:) = 5 ! not-filled + array1(1, 1) = 30 + + array2(:,:,:) = 6 ! array1-filled + array2(:,:,:) = 3 + array2(1,1,1) = 30 + array2(3,3,3) = 90 ! array2-almost-filled +end subroutine + +subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + + array1(5:10) = 1311 + array1(7) = 1 + array1(100) = 100 + array2(4,10) = array1(7) + array2(4,100) = array1(7) + return ! end-of-bar +end subroutine + +program vla_sub + interface + subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + end subroutine + end interface + interface + subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + end subroutine + end interface + + real, allocatable :: vla1 (:, :, :) + integer, allocatable :: vla2 (:, :) + + ! used for subroutine + integer :: sub_arr1(42, 42) + real :: sub_arr2(42, 42, 42) + integer :: sub_arr3(42) + + sub_arr1(:,:) = 1 ! vla2-deallocated + sub_arr2(:,:,:) = 2 + sub_arr3(:) = 3 + + call foo(sub_arr1, sub_arr2) + call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15)) + + allocate (vla1 (10,10,10)) + allocate (vla2 (20,20)) + vla1(:,:,:) = 1311 + vla2(:,:) = 42 + call foo(vla2, vla1) + + call bar(sub_arr3, sub_arr1) +end program vla_sub diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp new file mode 100644 index 0000000..a9f8589 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp @@ -0,0 +1,35 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check VLA with arbitary length and check that elements outside of +# bounds of the passed VLA can be accessed correctly. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)" +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)" +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)" +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)" diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp new file mode 100644 index 0000000..88c6254 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp @@ -0,0 +1,49 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# "up" works with GCC but other Fortran compilers may copy the values into the +# outer function only on the exit of the inner function. +# We need both variants as depending on the arch we optionally may still be +# executing the caller line or not after `finish'. + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger" + +gdb_test "finish" \ + ".*(foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)|foo \\\(array1=..., array2=...\\\).*)" \ + "finish function" +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish" +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish" +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish" +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish" + diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp new file mode 100644 index 0000000..8562ea4 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp @@ -0,0 +1,90 @@ +# 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/>. + +standard_testfile "vla-sub.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Check the values of VLA's in subroutine can be evaluated correctly + +# Try to access values from a fixed array handled as VLA in subroutine. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \ + "print passed array1 in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array1-filled"] +gdb_continue_to_breakpoint "array1-filled (1st)" +gdb_test "print array1(5, 7)" " = 5" \ + "print array1(5, 7) after filled in foo (passed fixed array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled (1st)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed fixed array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed fixed array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed fixed array)" + + +# Try to access values from a fixed sub-array handled as VLA in subroutine. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \ + "print passed array1 in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array1-filled (2nd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed sub-array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array2-almost-filled (2nd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed sub-array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed sub-array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed sub-array)" + + +# Try to access values from a VLA passed to subroutine. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \ + "print passed array1 in foo (passed vla)" + +gdb_continue_to_breakpoint "array1-filled (3rd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed vla)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed vla)" + +gdb_continue_to_breakpoint "array2-almost-filled (3rd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed vla)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed vla)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed vla)" diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp new file mode 100644 index 0000000..24182cc --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value.exp @@ -0,0 +1,148 @@ +# 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/>. + +standard_testfile "vla.f90" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Try to access values in non allocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \ + "print non-allocated &vla1" +gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \ + "print member in non-allocated vla1 (1)" +gdb_test "print vla1(101,202,303)" \ + "no such vector element \\\(vector not allocated\\\)" \ + "print member in non-allocated vla1 (2)" +gdb_test "print vla1(5,2,18)=1" "no such vector element \\\(vector not allocated\\\)" \ + "set member in non-allocated vla1" + +# Try to access value in allocated VLA +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+(\\t|\\s)+vla1\\\(3, 6, 9\\\) = 42" \ + "step over value assignment of vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print allocated &vla1" +gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)" +gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)" +gdb_test "print vla1(9, 9, 9) = 999" " = 999" \ + "print allocated vla1(9,9,9)=1" + +# Try to access values in allocated VLA after specific assignment +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1(3, 6, 9)" " = 42" \ + "print allocated vla1(3,6,9) after specific assignment (filled)" +gdb_test "print vla1(1, 3, 8)" " = 1001" \ + "print allocated vla1(1,3,8) after specific assignment (filled)" +gdb_test "print vla1(9, 9, 9)" " = 999" \ + "print allocated vla1(9,9,9) after assignment in debugger (filled)" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_test "print pvla" " = <not associated>" "print undefined pvla" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \ + "print non-associated &pvla" +gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \ + "print undefined pvla(1,3,8)" + +# Try to access values in pointer to VLA and compare them +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print associated &pvla" +gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)" +gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)" +gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)" + +# Fill values to VLA using pointer and check +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print pvla(5, 45, 20)" \ + " = 1" "print pvla(5, 45, 20) after filled using pointer" +gdb_test "print vla2(5, 45, 20)" \ + " = 1" "print vla2(5, 45, 20) after filled using pointer" +gdb_test "print pvla(7, 45, 14)" " = 2" \ + "print pvla(7, 45, 14) after filled using pointer" +gdb_test "print vla2(7, 45, 14)" " = 2" \ + "print vla2(7, 45, 14) after filled using pointer" + +# Try to access values of deassociated VLA pointer +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print pvla(5, 45, 20)" \ + "no such vector element \\\(vector not associated\\\)" \ + "print pvla(5, 45, 20) after deassociated" +gdb_test "print pvla(7, 45, 14)" \ + "no such vector element \\\(vector not associated\\\)" \ + "print pvla(7, 45, 14) after dissasociated" +gdb_test "print pvla" " = <not associated>" \ + "print vla1 after deassociated" + +# Try to access values of deallocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(3,6,9) after specific assignment (deallocated)" +gdb_test "print vla1(1, 3, 8)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(1,3,8) after specific assignment (deallocated)" +gdb_test "print vla1(9, 9, 9)" "no such vector element \\\(vector not allocated\\\)" \ + "print allocated vla1(9,9,9) after assignment in debugger (deallocated)" + + +# Try to assign VLA to user variable +clean_restart ${testfile} + +if ![runto MAIN__] then { + perror "couldn't run to breakpoint MAIN__" + continue +} +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+.*vla1\\(3, 6, 9\\) = 42" "next (1)" + +gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1" +gdb_test "print \$myvar" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print \$myvar set to vla1" + +gdb_test "next" "\\d+.*vla1\\(1, 3, 8\\) = 1001" "next (2)" +gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla" +gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)" + +# deallocate pointer and make sure user defined variable still has the +# right value. +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print \$mypvar(1,3,8)" " = 1001" \ + "print \$mypvar(1,3,8) after deallocated" diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90 new file mode 100644 index 0000000..61e22b9 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla.f90 @@ -0,0 +1,56 @@ +! 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 vla + real, target, allocatable :: vla1 (:, :, :) + real, target, allocatable :: vla2 (:, :, :) + real, target, allocatable :: vla3 (:, :) + real, pointer :: pvla (:, :, :) + logical :: l + + allocate (vla1 (10,10,10)) ! vla1-init + l = allocated(vla1) + + allocate (vla2 (1:7,42:50,13:35)) ! vla1-allocated + l = allocated(vla2) + + vla1(:, :, :) = 1311 ! vla2-allocated + vla1(3, 6, 9) = 42 + vla1(1, 3, 8) = 1001 + vla1(6, 2, 7) = 13 + + vla2(:, :, :) = 1311 ! vla1-filled + vla2(5, 45, 20) = 42 + + pvla => vla1 ! vla2-filled + l = associated(pvla) + + pvla => vla2 ! pvla-associated + l = associated(pvla) + pvla(5, 45, 20) = 1 + pvla(7, 45, 14) = 2 + + pvla => null() ! pvla-re-associated + l = associated(pvla) + + deallocate (vla1) ! pvla-deassociated + l = allocated(vla1) + + deallocate (vla2) ! vla1-deallocated + l = allocated(vla2) + + allocate (vla3 (2,2)) ! vla2-deallocated + vla3(:,:) = 13 +end program vla diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp new file mode 100644 index 0000000..d191623 --- /dev/null +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp @@ -0,0 +1,182 @@ +# 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/>. + +# Verify that, using the MI, we can evaluate a simple C Variable Length +# Array (VLA). + +load_lib mi-support.exp +set MIFLAGS "-i=mi" + +gdb_exit +if [mi_gdb_start] { + continue +} + +standard_testfile vla.f90 + +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \ + {debug f90}] != "" } { + untested mi-vla-fortran.exp + return -1 +} + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +set bp_lineno [gdb_get_line_number "vla1-not-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \ + ".*vla.f90" $bp_lineno $hex \ + "insert breakpoint at line $bp_lineno (vla not allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "500-data-evaluate-expression vla1" \ + "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ + "create local variable vla1_not_allocated" +mi_gdb_test "501-var-info-type vla1_not_allocated" \ + "501\\^done,type=\"<not allocated>\"" \ + "info type variable vla1_not_allocated" +mi_gdb_test "502-var-show-format vla1_not_allocated" \ + "502\\^done,format=\"natural\"" \ + "show format variable vla1_not_allocated" +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \ + "503\\^done,value=\"\\\[0\\\]\"" \ + "eval variable vla1_not_allocated" +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_not_allocated" + + + +set bp_lineno [gdb_get_line_number "vla1-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "510-data-evaluate-expression vla1" \ + "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla" + +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ + "create local variable vla1_allocated" +mi_gdb_test "511-var-info-type vla1_allocated" \ + "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ + "info type variable vla1_allocated" +mi_gdb_test "512-var-show-format vla1_allocated" \ + "512\\^done,format=\"natural\"" \ + "show format variable vla1_allocated" +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \ + "513\\^done,value=\"\\\[5\\\]\"" \ + "eval variable vla1_allocated" +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_allocated" + + +set bp_lineno [gdb_get_line_number "vla1-filled"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "520-data-evaluate-expression vla1" \ + "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-modified"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "530-data-evaluate-expression vla1" \ + "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla" +mi_gdb_test "540-data-evaluate-expression vla1(1)" \ + "540\\^done,value=\"1\"" "evaluate filled vla" +mi_gdb_test "550-data-evaluate-expression vla1(2)" \ + "550\\^done,value=\"42\"" "evaluate filled vla" +mi_gdb_test "560-data-evaluate-expression vla1(4)" \ + "560\\^done,value=\"24\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-deallocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "570-data-evaluate-expression vla1" \ + "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + + +set bp_lineno [gdb_get_line_number "pvla2-not-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "580-data-evaluate-expression pvla2" \ + "580\\^done,value=\"<not associated>\"" "evaluate not associated vla" + +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ + "create local variable pvla2_not_associated" +mi_gdb_test "581-var-info-type pvla2_not_associated" \ + "581\\^done,type=\"<not associated>\"" \ + "info type variable pvla2_not_associated" +mi_gdb_test "582-var-show-format pvla2_not_associated" \ + "582\\^done,format=\"natural\"" \ + "show format variable pvla2_not_associated" +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \ + "583\\^done,value=\"\\\[0\\\]\"" \ + "eval variable pvla2_not_associated" +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of pvla2_not_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "590-data-evaluate-expression pvla2" \ + "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \ + "evaluate associated vla" + +mi_create_varobj_checked pvla2_associated pvla2 \ + "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" +mi_gdb_test "591-var-info-type pvla2_associated" \ + "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ + "info type variable pvla2_associated" +mi_gdb_test "592-var-show-format pvla2_associated" \ + "592\\^done,format=\"natural\"" \ + "show format variable pvla2_associated" +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \ + "593\\^done,value=\"\\\[2\\\]\"" \ + "eval variable pvla2_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "600-data-evaluate-expression pvla2" \ + "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null" + +mi_gdb_exit +return 0 diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90 new file mode 100644 index 0000000..0b89d34 --- /dev/null +++ b/gdb/testsuite/gdb.mi/vla.f90 @@ -0,0 +1,42 @@ +! 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 vla + real, allocatable :: vla1 (:) + real, target, allocatable :: vla2(:, :) + real, pointer :: pvla2 (:, :) + logical :: l + + allocate (vla1 (5)) ! vla1-not-allocated + l = allocated(vla1) ! vla1-allocated + + vla1(:) = 1 + vla1(2) = 42 ! vla1-filled + vla1(4) = 24 + + deallocate (vla1) ! vla1-modified + l = allocated(vla1) ! vla1-deallocated + + allocate (vla2 (5, 2)) + vla2(:, :) = 2 + + pvla2 => vla2 ! pvla2-not-associated + l = associated(pvla2) ! pvla2-associated + + pvla2(2, 1) = 42 + + pvla2 => null() + l = associated(pvla2) ! pvla2-set-to-null +end program vla diff --git a/gdb/typeprint.c b/gdb/typeprint.c index 8fbd178..377223a 100644 --- a/gdb/typeprint.c +++ b/gdb/typeprint.c @@ -727,3 +727,20 @@ Show printing of typedefs defined in classes."), NULL, show_print_type_typedefs, &setprinttypelist, &showprinttypelist); } + +/* Print <not allocated> status to stream STREAM. */ + +void +val_print_not_allocated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not allocated>")); +} + +/* Print <not associated> status to stream STREAM. */ + +void +val_print_not_associated (struct ui_file *stream) +{ + fprintf_filtered (stream, _("<not associated>")); +} + diff --git a/gdb/typeprint.h b/gdb/typeprint.h index bdff41b..d8225f2 100644 --- a/gdb/typeprint.h +++ b/gdb/typeprint.h @@ -74,4 +74,8 @@ void c_type_print_varspec_suffix (struct type *, struct ui_file *, int, void c_type_print_args (struct type *, struct ui_file *, int, enum language, const struct type_print_options *); +extern void val_print_not_allocated (struct ui_file *stream); + +extern void val_print_not_associated (struct ui_file *stream); + #endif diff --git a/gdb/valarith.c b/gdb/valarith.c index 3e349f2..97145a1 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -198,7 +198,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) && elt_offs >= type_length_units (array_type))) - error (_("no such vector element")); + { + if (type_not_associated (array_type)) + error (_("no such vector element (vector not associated)")); + else if (type_not_allocated (array_type)) + error (_("no such vector element (vector not allocated)")); + else + error (_("no such vector element")); + } if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) v = allocate_value_lazy (elt_type); diff --git a/gdb/valprint.c b/gdb/valprint.c index c053a81..7e74856 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -34,6 +34,7 @@ #include "ada-lang.h" #include "gdb_obstack.h" #include "charset.h" +#include "typeprint.h" #include <ctype.h> /* Maximum number of wchars returned from wchar_iterate. */ @@ -303,6 +304,18 @@ valprint_check_validity (struct ui_file *stream, { type = check_typedef (type); + if (type_not_associated (type)) + { + val_print_not_associated (stream); + return 0; + } + + if (type_not_allocated (type)) + { + val_print_not_allocated (stream); + return 0; + } + if (TYPE_CODE (type) != TYPE_CODE_UNION && TYPE_CODE (type) != TYPE_CODE_STRUCT && TYPE_CODE (type) != TYPE_CODE_ARRAY) @@ -1043,6 +1056,18 @@ value_check_printable (struct value *val, struct ui_file *stream, return 0; } + if (type_not_associated (value_type (val))) + { + val_print_not_associated (stream); + return 0; + } + + if (type_not_allocated (value_type (val))) + { + val_print_not_allocated (stream); + return 0; + } + return 1; } -- 1.7.9.5 ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-10-09 11:37 ` Keven Boell @ 2015-10-22 9:59 ` Joel Brobecker 2016-01-20 10:19 ` Yao Qi 1 sibling, 0 replies; 18+ messages in thread From: Joel Brobecker @ 2015-10-22 9:59 UTC (permalink / raw) To: Keven Boell; +Cc: gdb-patches > Thanks for the review and sorry for the long delay. Here is the updated patch. > > --- > Fortran provide types whose values may be dynamically allocated > or associated with a variable under explicit program control. > The purpose of this commit is > * to read allocated/associated DWARF tags and store them in > the dynamic property list of main_type. > * enable GDB to print the value of a dynamic array in Fortran > in case the type is allocated or associated (pointer to > dynamic array). That's a duplicate of an email you sent shortly after this one. On the other hand, patch #2 seems to still be pending (ie, no email from you since I sent you my last review). So I'm wondering if you meant instead to send patch #2, here... -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2015-10-09 11:37 ` Keven Boell 2015-10-22 9:59 ` Joel Brobecker @ 2016-01-20 10:19 ` Yao Qi 2016-01-22 7:22 ` Keven Boell 1 sibling, 1 reply; 18+ messages in thread From: Yao Qi @ 2016-01-20 10:19 UTC (permalink / raw) To: Keven Boell; +Cc: gdb-patches, Joel Brobecker Keven Boell <keven.boell@linux.intel.com> writes: > Fortran provide types whose values may be dynamically allocated > or associated with a variable under explicit program control. > The purpose of this commit is > * to read allocated/associated DWARF tags and store them in > the dynamic property list of main_type. > * enable GDB to print the value of a dynamic array in Fortran > in case the type is allocated or associated (pointer to > dynamic array). > > Examples: > (gdb) p vla_not_allocated > $1 = <not allocated> > > (gdb) p vla_allocated > $1 = (1, 2, 3) > > (gdb) p vla_ptr_not_associated > $1 = <not associated> > > (gdb) p vla_ptr_associated > $1 = (1, 2, 3) > > Add basic test coverage for most dynamic array use-cases > in Fortran. > The commit contains the following tests: > * Ensure that values of Fortran dynamic arrays > can be evaluated correctly in various ways and states. > * Ensure that Fortran primitives can be evaluated > correctly when used as a dynamic array. > * Dynamic arrays passed to subroutines and handled > in different ways inside the routine. > * Ensure that the ptype of dynamic arrays in > Fortran can be printed in GDB correctly. > * Ensure that dynamic arrays in different states > (allocated/associated) can be evaluated. > * Dynamic arrays passed to functions and returned from > functions. > * History values of dynamic arrays can be accessed and > printed again with the correct values. > * Dynamic array evaluations using MI protocol. > * Sizeof output of dynamic arrays in various states. > > The patch was tested using the test suite on Ubuntu 12.04 64bit. Hi Keven, The test cases added by this commit fail on some other OS and targets, see this thread, https://sourceware.org/ml/gdb-testers/2015-q4/msg02136.html can you take a look? -- Yao (齐尧) ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2016-01-20 10:19 ` Yao Qi @ 2016-01-22 7:22 ` Keven Boell 2016-01-22 12:40 ` Joel Brobecker 0 siblings, 1 reply; 18+ messages in thread From: Keven Boell @ 2016-01-22 7:22 UTC (permalink / raw) To: Yao Qi; +Cc: gdb-patches, Joel Brobecker On 20.01.2016 11:18, Yao Qi wrote: > Keven Boell <keven.boell@linux.intel.com> writes: > >> Fortran provide types whose values may be dynamically allocated >> or associated with a variable under explicit program control. >> The purpose of this commit is >> * to read allocated/associated DWARF tags and store them in >> the dynamic property list of main_type. >> * enable GDB to print the value of a dynamic array in Fortran >> in case the type is allocated or associated (pointer to >> dynamic array). >> >> Examples: >> (gdb) p vla_not_allocated >> $1 = <not allocated> >> >> (gdb) p vla_allocated >> $1 = (1, 2, 3) >> >> (gdb) p vla_ptr_not_associated >> $1 = <not associated> >> >> (gdb) p vla_ptr_associated >> $1 = (1, 2, 3) >> >> Add basic test coverage for most dynamic array use-cases >> in Fortran. >> The commit contains the following tests: >> * Ensure that values of Fortran dynamic arrays >> can be evaluated correctly in various ways and states. >> * Ensure that Fortran primitives can be evaluated >> correctly when used as a dynamic array. >> * Dynamic arrays passed to subroutines and handled >> in different ways inside the routine. >> * Ensure that the ptype of dynamic arrays in >> Fortran can be printed in GDB correctly. >> * Ensure that dynamic arrays in different states >> (allocated/associated) can be evaluated. >> * Dynamic arrays passed to functions and returned from >> functions. >> * History values of dynamic arrays can be accessed and >> printed again with the correct values. >> * Dynamic array evaluations using MI protocol. >> * Sizeof output of dynamic arrays in various states. >> >> The patch was tested using the test suite on Ubuntu 12.04 64bit. > > Hi Keven, > The test cases added by this commit fail on some other OS and targets, > see this thread, https://sourceware.org/ml/gdb-testers/2015-q4/msg02136.html > can you take a look? > Hi Yao, Joel, I don't think I will be able to fix the failures on the mentioned hosts/targets before you create the branch, as I need to replicate the environment on my end first to start investigating. Therefore I suggest to revert the change for now. Sorry if this caused any inconvenience. ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2016-01-22 7:22 ` Keven Boell @ 2016-01-22 12:40 ` Joel Brobecker 2016-01-22 15:25 ` Yao Qi 0 siblings, 1 reply; 18+ messages in thread From: Joel Brobecker @ 2016-01-22 12:40 UTC (permalink / raw) To: Keven Boell; +Cc: Yao Qi, gdb-patches On Fri, Jan 22, 2016 at 08:22:53AM +0100, Keven Boell wrote: > On 20.01.2016 11:18, Yao Qi wrote: > > Keven Boell <keven.boell@linux.intel.com> writes: > > > >> Fortran provide types whose values may be dynamically allocated > >> or associated with a variable under explicit program control. > >> The purpose of this commit is > >> * to read allocated/associated DWARF tags and store them in > >> the dynamic property list of main_type. > >> * enable GDB to print the value of a dynamic array in Fortran > >> in case the type is allocated or associated (pointer to > >> dynamic array). > >> > >> Examples: > >> (gdb) p vla_not_allocated > >> $1 = <not allocated> > >> > >> (gdb) p vla_allocated > >> $1 = (1, 2, 3) > >> > >> (gdb) p vla_ptr_not_associated > >> $1 = <not associated> > >> > >> (gdb) p vla_ptr_associated > >> $1 = (1, 2, 3) > >> > >> Add basic test coverage for most dynamic array use-cases > >> in Fortran. > >> The commit contains the following tests: > >> * Ensure that values of Fortran dynamic arrays > >> can be evaluated correctly in various ways and states. > >> * Ensure that Fortran primitives can be evaluated > >> correctly when used as a dynamic array. > >> * Dynamic arrays passed to subroutines and handled > >> in different ways inside the routine. > >> * Ensure that the ptype of dynamic arrays in > >> Fortran can be printed in GDB correctly. > >> * Ensure that dynamic arrays in different states > >> (allocated/associated) can be evaluated. > >> * Dynamic arrays passed to functions and returned from > >> functions. > >> * History values of dynamic arrays can be accessed and > >> printed again with the correct values. > >> * Dynamic array evaluations using MI protocol. > >> * Sizeof output of dynamic arrays in various states. > >> > >> The patch was tested using the test suite on Ubuntu 12.04 64bit. > > > > Hi Keven, > > The test cases added by this commit fail on some other OS and targets, > > see this thread, https://sourceware.org/ml/gdb-testers/2015-q4/msg02136.html > > can you take a look? > > > > Hi Yao, Joel, > > I don't think I will be able to fix the failures on the mentioned > hosts/targets before you create the branch, as I need to replicate the > environment on my end first to start investigating. Therefore I > suggest to revert the change for now. Sorry if this caused any > inconvenience. I don't think that reverting without more investigation is a good idea. I quickly looked at a good dozen of those reports, and, as far as I know, these are new FAILs, so we don't know that they are regressions. I could also be compiler issues. There is also the fact that reviewing these patches took me not just hours, but actually days in total (I don't know how much time Keven et al also spent answering all my comments). I would prefer re-doing all that work only if we have confirmation that this is causing a critical problem that we can't fix without Keven's help. That being said - it doesn't bode well for the future of this feature if the authors don't have time to look into issues they create... Thanks, -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2016-01-22 12:40 ` Joel Brobecker @ 2016-01-22 15:25 ` Yao Qi 2016-01-26 12:34 ` Joel Brobecker 0 siblings, 1 reply; 18+ messages in thread From: Yao Qi @ 2016-01-22 15:25 UTC (permalink / raw) To: Joel Brobecker; +Cc: Keven Boell, Yao Qi, gdb-patches Joel Brobecker <brobecker@adacore.com> writes: > I don't think that reverting without more investigation is a good > idea. I quickly looked at a good dozen of those reports, and, as > far as I know, these are new FAILs, so we don't know that they are > regressions. I could also be compiler issues. They are fails of tests for the new feature, so they aren't regressions. It could be compiler issues, of course. > > There is also the fact that reviewing these patches took me not > just hours, but actually days in total (I don't know how much time > Keven et al also spent answering all my comments). I would prefer > re-doing all that work only if we have confirmation that this is > causing a critical problem that we can't fix without Keven's help. Your review efforts are not lost if the patch is reverted. Keven or some one else will work on the basis of it, so everything, such as comments and code style, should be still there. The reviewing efforts shouldn't justify keeping something in GDB, which breaks tests at the beginning. Patches are reviewed in the scope of reviewers' knowledge and experience, so nobody knows the effects of patches on the complicated software, such as GDB, on some certain env. It is reasonable to me that patches still cause regressions after several rounds of careful reviews, but it doesn't mean we should take them in source tree. > > That being said - it doesn't bode well for the future of this > feature if the authors don't have time to look into issues they > create... Yes, I agree. In short, I am not strongly against this patch as it doesn't cause critical problem, and I can live up with it. However, it would be nice to revert it. -- Yao (齐尧) P.S. "A feature which is omitted can always be added later, when its design and its implications are well understood. A feature which is included before it is fully understood can never be removed later." -- C.A.R. Hoare, The Emperor's Old Clothes, 1980 Turing Award Lecture ^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support 2016-01-22 15:25 ` Yao Qi @ 2016-01-26 12:34 ` Joel Brobecker 0 siblings, 0 replies; 18+ messages in thread From: Joel Brobecker @ 2016-01-26 12:34 UTC (permalink / raw) To: Yao Qi; +Cc: Keven Boell, gdb-patches > The reviewing efforts shouldn't justify keeping something in GDB, which > breaks tests at the beginning. Patches are reviewed in the scope of > reviewers' knowledge and experience, so nobody knows the effects of > patches on the complicated software, such as GDB, on some certain env. > It is reasonable to me that patches still cause regressions after > several rounds of careful reviews, but it doesn't mean we should take > them in source tree. I hesitated before mentioning the review effort spent on this, and now I see that I shouldn't have. You are right, the review itself should not justify one way or the other what to do with the patch. However,... > They are fails of tests for the new feature, so they aren't > regressions. It could be compiler issues, of course. [...] > In short, I am not strongly against this patch as it doesn't cause > critical problem, and I can live up with it. However, it would be nice > to revert it. I cannot understand why you think that way. If this is just an issue of a new feature whose implementation has bugs, and no evidence that it is impacting something else, why would you recommend that we revert the patch? If we were to revert, no one would be able to use the new feature; but if we keep it, at least a few people will be able to enjoy the work that has been done so far. I don't have a stake in the feature itself, but I disagree on the logic behind proposing the revert. That being said, this is *my* reasoning, and I don't want to argue too much to avoid creating a culture of "once it is in, it is very hard to revert". I'd rather we be revert-easy than the opposite. It would help if others weighed in on this, as I will accept the choice of the majority. > "A feature which is omitted can always be added later, when its design > and its implications are well understood. A feature which is included > before it is fully understood can never be removed later." > > -- C.A.R. Hoare, The Emperor's Old Clothes, 1980 Turing Award Lecture Does not apply here, IMO, because the syntac is dictated by the language, and it's not going to change. The only thing we can do is fix the bugs we find. -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
[parent not found: <5613D0DC.3040908@linux.intel.com>]
* Re: [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support [not found] ` <5613D0DC.3040908@linux.intel.com> @ 2015-10-22 9:59 ` Joel Brobecker 0 siblings, 0 replies; 18+ messages in thread From: Joel Brobecker @ 2015-10-22 9:59 UTC (permalink / raw) To: Keven Boell; +Cc: gdb-patches, keven.boell > Thanks for the review and sorry for the long delay. Here is the updated patch. Not to worry. At this point of the process, the number of changes that were left to be made before making the patch acceptable were very small, so it was easy for me to get back into it. > 2015-03-13 Keven Boell <keven.boell@intel.com> > > * dwarf2read.c (set_die_type): Add read of > DW_AT_allocated and DW_AT_associated. > * f-typeprint.c: New include of typeprint.h > (f_print_type): Add check for allocated/associated > status of type. > (f_type_print_varspec_suffix): Add check for > allocated/associated status of type. > * gdbtypes.c (create_array_type_with_stride): > Add check for valid data location of type in > case allocated or associated attributes are set. > Length of an array should be only calculated if > allocated or associated is resolved as true. > (is_dynamic_type_internal): Add check for allocated/ > associated. > (resolve_dynamic_array): Evaluate allocated/associated > properties. > * gdbtypes.h (enum dynamic_prop_node_kind): <DYN_PROP_ALLOCATED> > <DYN_PROP_ASSOCIATED>: New enums. > (TYPE_ALLOCATED_PROP, TYPE_ASSOCIATED_PROP): New macros. > (type_not_allocated): New function. > (type_not_associated): New function. > * valarith.c (value_subscripted_rvalue): Add check for > allocated/associated. > * valprint.c: New include of typeprint.h. > (valprint_check_validity): Add check for allocated/associated. > (value_check_printable): Add check for allocated/ > associated. > * typeprint.h (val_print_not_allocated): New function. > (val_print_not_associated): New function. > * typeprint.c (val_print_not_allocated): New function. > (val_print_not_associated): New function. > > testsuite/gdb.fortran: > > * vla-alloc-assoc.exp: New file. > * vla-datatypes.exp: New file. > * vla-datatypes.f90: New file. > * vla-history.exp: New file. > * vla-ptype-sub.exp: New file. > * vla-ptype.exp: New file. > * vla-sizeof.exp: New file. > * vla-sub.f90: New file. > * vla-value-sub-arbitrary.exp: New file. > * vla-value-sub-finish.exp: New file. > * vla-value-sub.exp: New file. > * vla-value.exp: New file. > * vla-ptr-info.exp: New file. > * vla.f90: New file. > > testsuite/gdb.mi: > > * mi-vla-fortran.exp: New file. > * vla.f90: New file. The patch is approved, and I have now pushed it. Congratulations! (and thank you for your perseverance :-)). Small note, on something I noticed only at the very end. For the ChangeLog entries, and in particular for the testsuite files, therer is only one ChangeLog file, in gdb/testsuite/ChangeLog. So, all the entries in the testsuite directory should be together, and relative to the testsuite, which means the filenames needed to be prefixed with either gdb.fortran/ or gdb.mi. In other words, I changed it to the following entry in gdb/testsuite/ChangeLog: * gdb.fortran/vla-alloc-assoc.exp: New file. * gdb.fortran/vla-datatypes.exp: New file. * gdb.fortran/vla-datatypes.f90: New file. * gdb.fortran/vla-history.exp: New file. * gdb.fortran/vla-ptype-sub.exp: New file. * gdb.fortran/vla-ptype.exp: New file. * gdb.fortran/vla-sizeof.exp: New file. * gdb.fortran/vla-sub.f90: New file. * gdb.fortran/vla-value-sub-arbitrary.exp: New file. * gdb.fortran/vla-value-sub-finish.exp: New file. * gdb.fortran/vla-value-sub.exp: New file. * gdb.fortran/vla-value.exp: New file. * gdb.fortran/vla-ptr-info.exp: New file. * gdb.mi/mi-vla-fortran.exp: New file. * gdb.mi/vla.f90: New file. -- Joel ^ permalink raw reply [flat|nested] 18+ messages in thread
end of thread, other threads:[~2016-02-09 15:14 UTC | newest]
Thread overview: 18+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-02-08 13:47 [PATCH 1/2] fort_dyn_array: add basic fortran dyn array support Walfred Tedeschi
2016-02-09 11:36 ` Joel Brobecker
2016-02-09 15:14 ` Walfred Tedeschi
-- strict thread matches above, loose matches on Subject: below --
2015-07-01 12:42 [PATCH 0/2] fort_dyn_array: Enable basic Fortran dynamic " Keven Boell
2015-07-01 12:42 ` [PATCH 1/2] fort_dyn_array: add basic fortran dyn " Keven Boell
2015-07-21 18:05 ` Joel Brobecker
2015-08-05 13:41 ` Keven Boell
2015-08-05 13:47 ` Keven Boell
2015-08-05 20:23 ` Joel Brobecker
2015-08-06 11:42 ` keven.boell
2015-08-20 12:52 ` Joel Brobecker
2015-10-09 11:37 ` Keven Boell
2015-10-22 9:59 ` Joel Brobecker
2016-01-20 10:19 ` Yao Qi
2016-01-22 7:22 ` Keven Boell
2016-01-22 12:40 ` Joel Brobecker
2016-01-22 15:25 ` Yao Qi
2016-01-26 12:34 ` Joel Brobecker
[not found] ` <5613D0DC.3040908@linux.intel.com>
2015-10-22 9:59 ` Joel Brobecker
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).