From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x330.google.com (mail-wm1-x330.google.com [IPv6:2a00:1450:4864:20::330]) by sourceware.org (Postfix) with ESMTPS id 539A93850409 for ; Thu, 19 Nov 2020 11:56:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 539A93850409 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=embecosm.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=andrew.burgess@embecosm.com Received: by mail-wm1-x330.google.com with SMTP id a65so6506021wme.1 for ; Thu, 19 Nov 2020 03:56:19 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=date:from:to:subject:message-id:references:mime-version :content-disposition:in-reply-to; bh=Zr5bJajkXM7nHj3nSnA5Ai5oFgHLK7d71XRMTNLliyM=; b=hoetaYII7TQsTAc2z8N+S8BpC1tjR3FK7OQUuoHkfbmxidTKvAWSIYB1+gTYncS1EN S/2d7wlVR7yKxIWAahjWA75Pkkt7fZvRcCt3jhWdZPDpssc4V54O3RNSW5tic82L5H8R Ntlwg5aa9MVUdIuLzvQSp3riu/YW44sXwAWhHEOHBjIO9U77VPyoc1s7vGCDR8AJDUjW zZbgoVwejeNiGMQYWip0do+g5iJwuwwbuR/BhoHDgqjfNsowH+oXTZ0GKOAjEWa2DuEF UIBMDbK29iof/bqGsP69mYtijdz4WVpWkVyGOkJn5yTWRTqe7up/raE+SrJfGYlNHnJf r94w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:date:from:to:subject:message-id:references :mime-version:content-disposition:in-reply-to; bh=Zr5bJajkXM7nHj3nSnA5Ai5oFgHLK7d71XRMTNLliyM=; b=t8edwqvwQFkI3cXsxqNSl9zptmIkjNoE4PChVILMRauuieAaFKOtk7t5Te3PVo83Nt 1l8yXMc9CvNgL7iqYebIQQLvsohbMl4JVz3mjIcUsrhIW4De69OYD+p34w16Wm1a5zBO ZJeDb0C//EI6AmNcusLx2y6YWqKZkZg5r+ugC1mEzq8qHma8omQwi61618p7D8TXkqU5 HRjQfK4Hxp9C+02fpOBs5h+dF7eA9vL0UpCUDSGBVURUHPN0LIeebMjp8rRGhJa6Wk3b K9HQg4XeYAW/KY/VNqvxHwY2ZQ6qXOEGDGq9RU4DBn0NafMe72EuzwkHfj1fgMq3Jy9A +HGQ== X-Gm-Message-State: AOAM531iKE5oLKticqIF1bwYju6EhXLCvEB4ktlwJUIVgCv4+CfHWXfj KhkUYZA24JKcBV+bqhUmzo0I8xyr4jWdAA== X-Google-Smtp-Source: ABdhPJxkvMMHSn0fP0u3hMLj7qgZWQfXOaKfmlYbzi8vZ8hDl2LP46UkPwBwcJfIjG2hB3do+3/V8g== X-Received: by 2002:a1c:9c56:: with SMTP id f83mr4382051wme.49.1605786974743; Thu, 19 Nov 2020 03:56:14 -0800 (PST) Received: from localhost (host86-128-12-89.range86-128.btcentralplus.com. [86.128.12.89]) by smtp.gmail.com with ESMTPSA id u5sm8742127wml.13.2020.11.19.03.56.13 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 19 Nov 2020 03:56:13 -0800 (PST) Date: Thu, 19 Nov 2020 11:56:12 +0000 From: Andrew Burgess To: gdb-patches@sourceware.org Subject: Re: [PATCHv6] gdb/fortran: Add support for Fortran array slices at the GDB prompt Message-ID: <20201119115612.GV2729@embecosm.com> References: <7832c05de858cfc8bf4b6abba4332523d0547805.1602439661.git.andrew.burgess@embecosm.com> <20201031221621.GD2729@embecosm.com> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <20201031221621.GD2729@embecosm.com> X-Operating-System: Linux/5.8.13-100.fc31.x86_64 (x86_64) X-Uptime: 11:55:25 up 25 days, 2:58, X-Editor: GNU Emacs [ http://www.gnu.org/software/emacs ] X-Spam-Status: No, score=-10.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_BARRACUDACENTRAL, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 19 Nov 2020 11:56:27 -0000 I've now pushed this patch. Let me know if you see any problems. Thanks, Andrew * Andrew Burgess [2020-10-31 22:16:21 +0000]: > The changes in v6 are: > > - Rebase on current master, > - Have addressed the typos and minor issues pointed out by Simon and > Tom, > - The f-array-walker.h logic has been rewritten slightly after > Simon's feedback. Hopefully the logic is slightly clearer now. > This did actually improve the code a little, the outer parenthesis > are now printed as part of the fortran_print_array logic, rather > than being printed elsewhere. > > There's still a pending question from Tom > w.r.t. fortran_array_walker_base_impl, but this is what I have for > now. > > Thanks, > Andrew > > --- > > [PATCH] gdb/fortran: Add support for Fortran array slices at the GDB prompt > > This commit brings array slice support to GDB. > > WARNING: This patch contains a rather big hack which is limited to > Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More > details on this below. > > This patch rewrites two areas of GDB's Fortran support, the code to > extract an array slice, and the code to print an array. > > After this commit a user can, from the GDB prompt, ask for a slice of > a Fortran array and should get the correct result back. Slices can > (optionally) have the lower bound, upper bound, and a stride > specified. Slices can also have a negative stride. > > Fortran has the concept of repacking array slices. Within a compiled > Fortran program if a user passes a non-contiguous array slice to a > function then the compiler may have to repack the slice, this involves > copying the elements of the slice to a new area of memory before the > call, and copying the elements back to the original array after the > call. Whether repacking occurs will depend on which version of > Fortran is being used, and what type of function is being called. > > This commit adds support for both packed, and unpacked array slicing, > with the default being unpacked. > > With an unpacked array slice, when the user asks for a slice of an > array GDB creates a new type that accurately describes where the > elements of the slice can be found within the original array, a > value of this type is then returned to the user. The address of an > element within the slice will be equal to the address of an element > within the original array. > > A user can choose to select packed array slices instead using: > > (gdb) set fortran repack-array-slices on|off > (gdb) show fortran repack-array-slices > > With packed array slices GDB creates a new type that reflects how the > elements of the slice would look if they were laid out in contiguous > memory, allocates a value of this type, and then fetches the elements > from the original array and places then into the contents buffer of > the new value. > > One benefit of using packed slices over unpacked slices is the memory > usage, taking a small slice of N elements from a large array will > require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked > array will also include all of the "padding" between the > non-contiguous elements. There are new tests added that highlight > this difference. > > There is also a new debugging flag added with this commit that > introduces these commands: > > (gdb) set debug fortran-array-slicing on|off > (gdb) show debug fortran-array-slicing > > This prints information about how the array slices are being built. > > As both the repacking, and the array printing requires GDB to walk > through a multi-dimensional Fortran array visiting each element, this > commit adds the file f-array-walk.h, which introduces some > infrastructure to support this process. This means the array printing > code in f-valprint.c is significantly reduced. > > The only slight issue with this commit is the "rather big hack" that I > mentioned above. This hack allows us to handle one specific case, > array slices with negative strides. This is something that I don't > believe the current GDB value contents model will allow us to > correctly handle, and rather than rewrite the value contents code > right now, I'm hoping to slip this hack in as a work around. > > The problem is that, as I see it, the current value contents model > assumes that an object base address will be the lowest address within > that object, and that the contents of the object start at this base > address and occupy the TYPE_LENGTH bytes after that. > > ( We do have the embedded_offset, which is used for C++ sub-classes, > such that an object can start at some offset from the content buffer, > however, the assumption that the object then occupies the next > TYPE_LENGTH bytes is still true within GDB. ) > > The problem is that Fortran arrays with a negative stride don't follow > this pattern. In this case the base address of the object points to > the element with the highest address, the contents of the array then > start at some offset _before_ the base address, and proceed for one > element _past_ the base address. > > As the stride for such an array would be negative then, in theory the > TYPE_LENGTH for this type would also be negative. However, in many > places a value in GDB will degrade to a pointer + length, and the > length almost always comes from the TYPE_LENGTH. > > It is my belief that in order to correctly model this case the value > content handling of GDB will need to be reworked to split apart the > value's content buffer (which is a block of memory with a length), and > the object's in memory base address and length, which could be > negative. > > Things are further complicated because arrays with negative strides > like this are always dynamic types. When a value has a dynamic type > and its base address needs resolving we actually store the address of > the object within the resolved dynamic type, not within the value > object itself. > > In short I don't currently see an easy path to cleanly support this > situation within GDB. And so I believe that leaves two options, > either add a work around, or catch cases where the user tries to make > use of a negative stride, or access an array with a negative stride, > and throw an error. > > This patch currently goes with adding a work around, which is that > when we resolve a dynamic Fortran array type, if the stride is > negative, then we adjust the base address to point to the lowest > address required by the array. The printing and slicing code is aware > of this adjustment and will correctly slice and print Fortran arrays. > > Where this hack will show through to the user is if they ask for the > address of an array in their program with a negative array stride, the > address they get from GDB will not match the address that would be > computed within the Fortran program. > > gdb/ChangeLog: > > * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h. > * NEWS: Mention new options. > * f-array-walker.h: New file. > * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'. > (repack_array_slices): New static global. > (show_repack_array_slices): New function. > (fortran_array_slicing_debug): New static global. > (show_fortran_array_slicing_debug): New function. > (value_f90_subarray): Delete. > (skip_undetermined_arglist): Delete. > (class fortran_array_repacker_base_impl): New class. > (class fortran_lazy_array_repacker_impl): New class. > (class fortran_array_repacker_impl): New class. > (fortran_value_subarray): Complete rewrite. > (set_fortran_list): New static global. > (show_fortran_list): Likewise. > (_initialize_f_language): Register new commands. > (fortran_adjust_dynamic_array_base_address_hack): New function. > * f-lang.h (fortran_adjust_dynamic_array_base_address_hack): > Declare. > * f-valprint.c: Include 'f-array-walker.h'. > (class fortran_array_printer_impl): New class. > (f77_print_array_1): Delete. > (f77_print_array): Delete. > (fortran_print_array): New. > (f_value_print_inner): Update to call fortran_print_array. > * gdbtypes.c: Include 'f-lang.h'. > (resolve_dynamic_type_internal): Call > fortran_adjust_dynamic_array_base_address_hack. > > gdb/testsuite/ChangeLog: > > * gdb.fortran/array-slices-bad.exp: New file. > * gdb.fortran/array-slices-bad.f90: New file. > * gdb.fortran/array-slices-sub-slices.exp: New file. > * gdb.fortran/array-slices-sub-slices.f90: New file. > * gdb.fortran/array-slices.exp: Rewrite tests. > * gdb.fortran/array-slices.f90: Rewrite tests. > * gdb.fortran/vla-sizeof.exp: Correct expected results. > > gdb/doc/ChangeLog: > > * gdb.texinfo (Debugging Output): Document 'set/show debug > fortran-array-slicing'. > (Special Fortran Commands): Document 'set/show fortran > repack-array-slices'. > --- > gdb/ChangeLog | 32 + > gdb/Makefile.in | 1 + > gdb/NEWS | 13 + > gdb/doc/ChangeLog | 7 + > gdb/doc/gdb.texinfo | 32 + > gdb/f-array-walker.h | 265 +++++++ > gdb/f-lang.c | 712 ++++++++++++++++-- > gdb/f-lang.h | 19 +- > gdb/f-valprint.c | 187 +++-- > gdb/gdbtypes.c | 12 +- > gdb/testsuite/ChangeLog | 10 + > .../gdb.fortran/array-slices-bad.exp | 69 ++ > .../gdb.fortran/array-slices-bad.f90 | 42 ++ > .../gdb.fortran/array-slices-sub-slices.exp | 111 +++ > .../gdb.fortran/array-slices-sub-slices.f90 | 96 +++ > gdb/testsuite/gdb.fortran/array-slices.exp | 277 +++++-- > gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++- > gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +- > 18 files changed, 1998 insertions(+), 255 deletions(-) > create mode 100644 gdb/f-array-walker.h > create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp > create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90 > create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp > create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 > > diff --git a/gdb/Makefile.in b/gdb/Makefile.in > index 8a160896e2c..1838743a883 100644 > --- a/gdb/Makefile.in > +++ b/gdb/Makefile.in > @@ -1273,6 +1273,7 @@ HFILES_NO_SRCDIR = \ > expression.h \ > extension.h \ > extension-priv.h \ > + f-array-walker.h \ > f-lang.h \ > fbsd-nat.h \ > fbsd-tdep.h \ > diff --git a/gdb/NEWS b/gdb/NEWS > index c99d3181a8b..be4b2956f17 100644 > --- a/gdb/NEWS > +++ b/gdb/NEWS > @@ -153,6 +153,19 @@ maintenance print core-file-backed-mappings > Prints file-backed mappings loaded from a core file's note section. > Output is expected to be similar to that of "info proc mappings". > > +set debug fortran-array-slicing on|off > +show debug fortran-array-slicing > + Print debugging when taking slices of Fortran arrays. > + > +set fortran repack-array-slices on|off > +show fortran repack-array-slices > + When taking slices from Fortran arrays and strings, if the slice is > + non-contiguous within the original value then, when this option is > + on, the new value will be repacked into a single contiguous value. > + When this option is off, then the value returned will consist of a > + descriptor that describes the slice within the memory of the > + original parent value. > + > * Changed commands > > alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...] > diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo > index d779d4a84f1..9e21d65c650 100644 > --- a/gdb/doc/gdb.texinfo > +++ b/gdb/doc/gdb.texinfo > @@ -16989,6 +16989,29 @@ > block whose name is @var{common-name}. With no argument, the names of > all @code{COMMON} blocks visible at the current program location are > printed. > +@cindex arrays slices (Fortran) > +@kindex set fortran repack-array-slices > +@kindex show fortran repack-array-slices > +@item set fortran repack-array-slices [on|off] > +@item show fortran repack-array-slices > +When taking a slice from an array, a Fortran compiler can choose to > +either produce an array descriptor that describes the slice in place, > +or it may repack the slice, copying the elements of the slice into a > +new region of memory. > + > +When this setting is on, then @value{GDBN} will also repack array > +slices in some situations. When this setting is off, then > +@value{GDBN} will create array descriptors for slices that reference > +the original data in place. > + > +@value{GDBN} will never repack an array slice if the data for the > +slice is contiguous within the original array. > + > +@value{GDBN} will always repack string slices if the data for the > +slice is non-contiguous within the original string as @value{GDBN} > +does not support printing non-contiguous strings. > + > +The default for this setting is @code{off}. > @end table > > @node Pascal > @@ -26581,6 +26604,15 @@ > @item show debug fbsd-nat > Show the current state of FreeBSD native target debugging messages. > > +@item set debug fortran-array-slicing > +@cindex fortran array slicing debugging info > +Turns on or off display of @value{GDBN} Fortran array slicing > +debugging info. The default is off. > + > +@item show debug fortran-array-slicing > +Displays the current state of displaying @value{GDBN} Fortran array > +slicing debugging info. > + > @item set debug frame > @cindex frame debugging info > Turns on or off display of @value{GDBN} frame debugging info. The > diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h > new file mode 100644 > index 00000000000..417f9f07980 > --- /dev/null > +++ b/gdb/f-array-walker.h > @@ -0,0 +1,265 @@ > +/* Copyright (C) 2020 Free Software Foundation, Inc. > + > + This file is part of GDB. > + > + 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 . */ > + > +/* Support classes to wrap up the process of iterating over a > + multi-dimensional Fortran array. */ > + > +#ifndef F_ARRAY_WALKER_H > +#define F_ARRAY_WALKER_H > + > +#include "defs.h" > +#include "gdbtypes.h" > +#include "f-lang.h" > + > +/* Class for calculating the byte offset for elements within a single > + dimension of a Fortran array. */ > +class fortran_array_offset_calculator > +{ > +public: > + /* Create a new offset calculator for TYPE, which is either an array or a > + string. */ > + explicit fortran_array_offset_calculator (struct type *type) > + { > + /* Validate the type. */ > + type = check_typedef (type); > + if (type->code () != TYPE_CODE_ARRAY > + && (type->code () != TYPE_CODE_STRING)) > + error (_("can only compute offsets for arrays and strings")); > + > + /* Get the range, and extract the bounds. */ > + struct type *range_type = type->index_type (); > + if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0) > + error ("unable to read array bounds"); > + > + /* Figure out the stride for this array. */ > + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type)); > + m_stride = type->index_type ()->bounds ()->bit_stride (); > + if (m_stride == 0) > + m_stride = type_length_units (elt_type); > + else > + { > + struct gdbarch *arch = get_type_arch (elt_type); > + int unit_size = gdbarch_addressable_memory_unit_size (arch); > + m_stride /= (unit_size * 8); > + } > + }; > + > + /* Get the byte offset for element INDEX within the type we are working > + on. There is no bounds checking done on INDEX. If the stride is > + negative then we still assume that the base address (for the array > + object) points to the element with the lowest memory address, we then > + calculate an offset assuming that index 0 will be the element at the > + highest address, index 1 the next highest, and so on. This is not > + quite how Fortran works in reality; in reality the base address of > + the object would point at the element with the highest address, and > + we would index backwards from there in the "normal" way, however, > + GDB's current value contents model doesn't support having the base > + address be near to the end of the value contents, so we currently > + adjust the base address of Fortran arrays with negative strides so > + their base address points at the lowest memory address. This code > + here is part of working around this weirdness. */ > + LONGEST index_offset (LONGEST index) > + { > + LONGEST offset; > + if (m_stride < 0) > + offset = std::abs (m_stride) * (m_upperbound - index); > + else > + offset = std::abs (m_stride) * (index - m_lowerbound); > + return offset; > + } > + > +private: > + > + /* The stride for the type we are working with. */ > + LONGEST m_stride; > + > + /* The upper bound for the type we are working with. */ > + LONGEST m_upperbound; > + > + /* The lower bound for the type we are working with. */ > + LONGEST m_lowerbound; > +}; > + > +/* A base class used by fortran_array_walker. There's no virtual methods > + here, sub-classes should just override the functions they want in order > + to specialise the behaviour to their needs. The functionality > + provided in these default implementations will visit every array > + element, but do nothing for each element. */ > + > +struct fortran_array_walker_base_impl > +{ > + /* Called when iterating between the lower and upper bounds of each > + dimension of the array. Return true if GDB should continue iterating, > + otherwise, return false. > + > + SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should > + be taken into consideration when deciding what to return. If > + SHOULD_CONTINUE is false then this function must also return false, > + the function is still called though in case extra work needs to be > + done as part of the stopping process. */ > + bool continue_walking (bool should_continue) > + { return should_continue; } > + > + /* Called when GDB starts iterating over a dimension of the array. The > + argument INNER_P is true for the inner most dimension (the dimension > + containing the actual elements of the array), and false for more outer > + dimensions. For a concrete example of how this function is called > + see the comment on process_element below. */ > + void start_dimension (bool inner_p) > + { /* Nothing. */ } > + > + /* Called when GDB finishes iterating over a dimension of the array. The > + argument INNER_P is true for the inner most dimension (the dimension > + containing the actual elements of the array), and false for more outer > + dimensions. LAST_P is true for the last call at a particular > + dimension. For a concrete example of how this function is called > + see the comment on process_element below. */ > + void finish_dimension (bool inner_p, bool last_p) > + { /* Nothing. */ } > + > + /* Called when processing the inner most dimension of the array, for > + every element in the array. ELT_TYPE is the type of the element being > + extracted, and ELT_OFF is the offset of the element from the start of > + array being walked, and LAST_P is true only when this is the last > + element that will be processed in this dimension. > + > + Given this two dimensional array ((1, 2) (3, 4)), the calls to > + start_dimension, process_element, and finish_dimension look like this: > + > + start_dimension (false); > + start_dimension (true); > + process_element (TYPE, OFFSET, false); > + process_element (TYPE, OFFSET, true); > + finish_dimension (true, false); > + start_dimension (true); > + process_element (TYPE, OFFSET, false); > + process_element (TYPE, OFFSET, true); > + finish_dimension (true, true); > + finish_dimension (false, true); */ > + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) > + { /* Nothing. */ } > +}; > + > +/* A class to wrap up the process of iterating over a multi-dimensional > + Fortran array. IMPL is used to specialise what happens as we walk over > + the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the > + methods than can be used to customise the array walk. */ > +template > +class fortran_array_walker > +{ > + /* Ensure that Impl is derived from the required base class. This just > + ensures that all of the required API methods are available and have a > + sensible default implementation. */ > + gdb_static_assert ((std::is_base_of::value)); > + > +public: > + /* Create a new array walker. TYPE is the type of the array being walked > + over, and ADDRESS is the base address for the object of TYPE in > + memory. All other arguments are forwarded to the constructor of the > + template parameter class IMPL. */ > + template > + fortran_array_walker (struct type *type, CORE_ADDR address, > + Args... args) > + : m_type (type), > + m_address (address), > + m_impl (type, address, args...) > + { > + m_ndimensions = calc_f77_array_dims (m_type); > + } > + > + /* Walk the array. */ > + void > + walk () > + { > + walk_1 (1, m_type, 0, false); > + } > + > +private: > + /* The core of the array walking algorithm. NSS is the current > + dimension number being processed, TYPE is the type of this dimension, > + and OFFSET is the offset (in bytes) for the start of this dimension. */ > + void > + walk_1 (int nss, struct type *type, int offset, bool last_p) > + { > + /* Extract the range, and get lower and upper bounds. */ > + struct type *range_type = check_typedef (type)->index_type (); > + LONGEST lowerbound, upperbound; > + if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) > + error ("failed to get range bounds"); > + > + /* CALC is used to calculate the offsets for each element in this > + dimension. */ > + fortran_array_offset_calculator calc (type); > + > + m_impl.start_dimension (nss == m_ndimensions); > + > + if (nss != m_ndimensions) > + { > + /* For dimensions other than the inner most, walk each element and > + recurse while peeling off one more dimension of the array. */ > + for (LONGEST i = lowerbound; > + m_impl.continue_walking (i < upperbound + 1); > + i++) > + { > + /* Use the index and the stride to work out a new offset. */ > + LONGEST new_offset = offset + calc.index_offset (i); > + > + /* Now print the lower dimension. */ > + struct type *subarray_type > + = TYPE_TARGET_TYPE (check_typedef (type)); > + walk_1 (nss + 1, subarray_type, new_offset, (i == upperbound)); > + } > + } > + else > + { > + /* For the inner most dimension of the array, process each element > + within this dimension. */ > + for (LONGEST i = lowerbound; > + m_impl.continue_walking (i < upperbound + 1); > + i++) > + { > + LONGEST elt_off = offset + calc.index_offset (i); > + > + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type)); > + if (is_dynamic_type (elt_type)) > + { > + CORE_ADDR e_address = m_address + elt_off; > + elt_type = resolve_dynamic_type (elt_type, {}, e_address); > + } > + > + m_impl.process_element (elt_type, elt_off, (i == upperbound)); > + } > + } > + > + m_impl.finish_dimension (nss == m_ndimensions, last_p || nss == 1); > + } > + > + /* The array type being processed. */ > + struct type *m_type; > + > + /* The address in target memory for the object of M_TYPE being > + processed. This is required in order to resolve dynamic types. */ > + CORE_ADDR m_address; > + > + /* An instance of the template specialisation class. */ > + Impl m_impl; > + > + /* The total number of dimensions in M_TYPE. */ > + int m_ndimensions; > +}; > + > +#endif /* F_ARRAY_WALKER_H */ > diff --git a/gdb/f-lang.c b/gdb/f-lang.c > index 52493743031..d9b2e715442 100644 > --- a/gdb/f-lang.c > +++ b/gdb/f-lang.c > @@ -36,9 +36,36 @@ > #include "c-lang.h" > #include "target-float.h" > #include "gdbarch.h" > +#include "gdbcmd.h" > +#include "f-array-walker.h" > > #include > > +/* Whether GDB should repack array slices created by the user. */ > +static bool repack_array_slices = false; > + > +/* Implement 'show fortran repack-array-slices'. */ > +static void > +show_repack_array_slices (struct ui_file *file, int from_tty, > + struct cmd_list_element *c, const char *value) > +{ > + fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"), > + value); > +} > + > +/* Debugging of Fortran's array slicing. */ > +static bool fortran_array_slicing_debug = false; > + > +/* Implement 'show debug fortran-array-slicing'. */ > +static void > +show_fortran_array_slicing_debug (struct ui_file *file, int from_tty, > + struct cmd_list_element *c, > + const char *value) > +{ > + fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"), > + value); > +} > + > /* Local functions */ > > /* Return the encoding that should be used for the character type > @@ -114,57 +141,6 @@ enum f_primitive_types { > nr_f_primitive_types > }; > > -/* Called from fortran_value_subarray to take a slice of an array or a > - string. ARRAY is the array or string to be accessed. EXP, POS, and > - NOSIDE are as for evaluate_subexp_standard. Return a value that is a > - slice of the array. */ > - > -static struct value * > -value_f90_subarray (struct value *array, > - struct expression *exp, int *pos, enum noside noside) > -{ > - int pc = (*pos) + 1; > - LONGEST low_bound, high_bound, stride; > - struct type *range = check_typedef (value_type (array)->index_type ()); > - enum range_flag range_flag > - = (enum range_flag) longest_to_int (exp->elts[pc].longconst); > - > - *pos += 3; > - > - if (range_flag & RANGE_LOW_BOUND_DEFAULT) > - low_bound = range->bounds ()->low.const_val (); > - else > - low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); > - > - if (range_flag & RANGE_HIGH_BOUND_DEFAULT) > - high_bound = range->bounds ()->high.const_val (); > - else > - high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); > - > - if (range_flag & RANGE_HAS_STRIDE) > - stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); > - else > - stride = 1; > - > - if (stride != 1) > - error (_("Fortran array strides are not currently supported")); > - > - return value_slice (array, low_bound, high_bound - low_bound + 1); > -} > - > -/* Helper for skipping all the arguments in an undetermined argument list. > - This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST > - case of evaluate_subexp_standard as multiple, but not all, code paths > - require a generic skip. */ > - > -static void > -skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, > - enum noside noside) > -{ > - for (int i = 0; i < nargs; ++i) > - evaluate_subexp (nullptr, exp, pos, noside); > -} > - > /* Return the number of dimensions for a Fortran array or string. */ > > int > @@ -189,6 +165,145 @@ calc_f77_array_dims (struct type *array_type) > return ndimen; > } > > +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array > + slices. This is a base class for two alternative repacking mechanisms, > + one for when repacking from a lazy value, and one for repacking from a > + non-lazy (already loaded) value. */ > +class fortran_array_repacker_base_impl > + : public fortran_array_walker_base_impl > +{ > +public: > + /* Constructor, DEST is the value we are repacking into. */ > + fortran_array_repacker_base_impl (struct value *dest) > + : m_dest (dest), > + m_dest_offset (0) > + { /* Nothing. */ } > + > + /* When we start processing the inner most dimension, this is where we > + will be creating values for each element as we load them and then copy > + them into the M_DEST value. Set a value mark so we can free these > + temporary values. */ > + void start_dimension (bool inner_p) > + { > + if (inner_p) > + { > + gdb_assert (m_mark == nullptr); > + m_mark = value_mark (); > + } > + } > + > + /* When we finish processing the inner most dimension free all temporary > + value that were created. */ > + void finish_dimension (bool inner_p, bool last_p) > + { > + if (inner_p) > + { > + gdb_assert (m_mark != nullptr); > + value_free_to_mark (m_mark); > + m_mark = nullptr; > + } > + } > + > +protected: > + /* Copy the contents of array element ELT into M_DEST at the next > + available offset. */ > + void copy_element_to_dest (struct value *elt) > + { > + value_contents_copy (m_dest, m_dest_offset, elt, 0, > + TYPE_LENGTH (value_type (elt))); > + m_dest_offset += TYPE_LENGTH (value_type (elt)); > + } > + > + /* The value being written to. */ > + struct value *m_dest; > + > + /* The byte offset in M_DEST at which the next element should be > + written. */ > + LONGEST m_dest_offset; > + > + /* Set with a call to VALUE_MARK, and then reset after calling > + VALUE_FREE_TO_MARK. */ > + struct value *m_mark = nullptr; > +}; > + > +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array > + slices. This class is specialised for repacking an array slice from a > + lazy array value, as such it does not require the parent array value to > + be loaded into GDB's memory; the parent value could be huge, while the > + slice could be tiny. */ > +class fortran_lazy_array_repacker_impl > + : public fortran_array_repacker_base_impl > +{ > +public: > + /* Constructor. TYPE is the type of the slice being loaded from the > + parent value, so this type will correctly reflect the strides required > + to find all of the elements from the parent value. ADDRESS is the > + address in target memory of value matching TYPE, and DEST is the value > + we are repacking into. */ > + explicit fortran_lazy_array_repacker_impl (struct type *type, > + CORE_ADDR address, > + struct value *dest) > + : fortran_array_repacker_base_impl (dest), > + m_addr (address) > + { /* Nothing. */ } > + > + /* Create a lazy value in target memory representing a single element, > + then load the element into GDB's memory and copy the contents into the > + destination value. */ > + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) > + { > + copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off)); > + } > + > +private: > + /* The address in target memory where the parent value starts. */ > + CORE_ADDR m_addr; > +}; > + > +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array > + slices. This class is specialised for repacking an array slice from a > + previously loaded (non-lazy) array value, as such it fetches the > + element values from the contents of the parent value. */ > +class fortran_array_repacker_impl > + : public fortran_array_repacker_base_impl > +{ > +public: > + /* Constructor. TYPE is the type for the array slice within the parent > + value, as such it has stride values as required to find the elements > + within the original parent value. ADDRESS is the address in target > + memory of the value matching TYPE. BASE_OFFSET is the offset from > + the start of VAL's content buffer to the start of the object of TYPE, > + VAL is the parent object from which we are loading the value, and > + DEST is the value into which we are repacking. */ > + explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address, > + LONGEST base_offset, > + struct value *val, struct value *dest) > + : fortran_array_repacker_base_impl (dest), > + m_base_offset (base_offset), > + m_val (val) > + { > + gdb_assert (!value_lazy (val)); > + } > + > + /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF) > + from the content buffer of M_VAL then copy this extracted value into > + the repacked destination value. */ > + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) > + { > + struct value *elt > + = value_from_component (m_val, elt_type, (elt_off + m_base_offset)); > + copy_element_to_dest (elt); > + } > + > +private: > + /* The offset into the content buffer of M_VAL to the start of the slice > + being extracted. */ > + LONGEST m_base_offset; > + > + /* The parent value from which we are extracting a slice. */ > + struct value *m_val; > +}; > + > /* Called from evaluate_subexp_standard to perform array indexing, and > sub-range extraction, for Fortran. As well as arrays this function > also handles strings as they can be treated like arrays of characters. > @@ -200,51 +315,394 @@ static struct value * > fortran_value_subarray (struct value *array, struct expression *exp, > int *pos, int nargs, enum noside noside) > { > - if (exp->elts[*pos].opcode == OP_RANGE) > - return value_f90_subarray (array, exp, pos, noside); > - > - if (noside == EVAL_SKIP) > + type *original_array_type = check_typedef (value_type (array)); > + bool is_string_p = original_array_type->code () == TYPE_CODE_STRING; > + > + /* Perform checks for ARRAY not being available. The somewhat overly > + complex logic here is just to keep backward compatibility with the > + errors that we used to get before FORTRAN_VALUE_SUBARRAY was > + rewritten. Maybe a future task would streamline the error messages we > + get here, and update all the expected test results. */ > + if (exp->elts[*pos].opcode != OP_RANGE) > + { > + if (type_not_associated (original_array_type)) > + error (_("no such vector element (vector not associated)")); > + else if (type_not_allocated (original_array_type)) > + error (_("no such vector element (vector not allocated)")); > + } > + else > { > - skip_undetermined_arglist (nargs, exp, pos, noside); > - /* Return the dummy value with the correct type. */ > - return array; > + if (type_not_associated (original_array_type)) > + error (_("array not associated")); > + else if (type_not_allocated (original_array_type)) > + error (_("array not allocated")); > } > > - LONGEST subscript_array[MAX_FORTRAN_DIMS]; > - int ndimensions = 1; > - struct type *type = check_typedef (value_type (array)); > + /* First check that the number of dimensions in the type we are slicing > + matches the number of arguments we were passed. */ > + int ndimensions = calc_f77_array_dims (original_array_type); > + if (nargs != ndimensions) > + error (_("Wrong number of subscripts")); > + > + /* This will be initialised below with the type of the elements held in > + ARRAY. */ > + struct type *inner_element_type; > + > + /* Extract the types of each array dimension from the original array > + type. We need these available so we can fill in the default upper and > + lower bounds if the user requested slice doesn't provide that > + information. Additionally unpacking the dimensions like this gives us > + the inner element type. */ > + std::vector dim_types; > + { > + dim_types.reserve (ndimensions); > + struct type *type = original_array_type; > + for (int i = 0; i < ndimensions; ++i) > + { > + dim_types.push_back (type); > + type = TYPE_TARGET_TYPE (type); > + } > + /* TYPE is now the inner element type of the array, we start the new > + array slice off as this type, then as we process the requested slice > + (from the user) we wrap new types around this to build up the final > + slice type. */ > + inner_element_type = type; > + } > + > + /* As we analyse the new slice type we need to understand if the data > + being referenced is contiguous. Do decide this we must track the size > + of an element at each dimension of the new slice array. Initially the > + elements of the inner most dimension of the array are the same inner > + most elements as the original ARRAY. */ > + LONGEST slice_element_size = TYPE_LENGTH (inner_element_type); > + > + /* Start off assuming all data is contiguous, this will be set to false > + if access to any dimension results in non-contiguous data. */ > + bool is_all_contiguous = true; > + > + /* The TOTAL_OFFSET is the distance in bytes from the start of the > + original ARRAY to the start of the new slice. This is calculated as > + we process the information from the user. */ > + LONGEST total_offset = 0; > + > + /* A structure representing information about each dimension of the > + resulting slice. */ > + struct slice_dim > + { > + /* Constructor. */ > + slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx) > + : low (l), > + high (h), > + stride (s), > + index (idx) > + { /* Nothing. */ } > + > + /* The low bound for this dimension of the slice. */ > + LONGEST low; > + > + /* The high bound for this dimension of the slice. */ > + LONGEST high; > + > + /* The byte stride for this dimension of the slice. */ > + LONGEST stride; > + > + struct type *index; > + }; > + > + /* The dimensions of the resulting slice. */ > + std::vector slice_dims; > + > + /* Process the incoming arguments. These arguments are in the reverse > + order to the array dimensions, that is the first argument refers to > + the last array dimension. */ > + if (fortran_array_slicing_debug) > + debug_printf ("Processing array access:\n"); > + for (int i = 0; i < nargs; ++i) > + { > + /* For each dimension of the array the user will have either provided > + a ranged access with optional lower bound, upper bound, and > + stride, or the user will have supplied a single index. */ > + struct type *dim_type = dim_types[ndimensions - (i + 1)]; > + if (exp->elts[*pos].opcode == OP_RANGE) > + { > + int pc = (*pos) + 1; > + enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst; > + *pos += 3; > + > + LONGEST low, high, stride; > + low = high = stride = 0; > + > + if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0) > + low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); > + else > + low = f77_get_lowerbound (dim_type); > + if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0) > + high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); > + else > + high = f77_get_upperbound (dim_type); > + if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE) > + stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); > + else > + stride = 1; > + > + if (stride == 0) > + error (_("stride must not be 0")); > + > + /* Get information about this dimension in the original ARRAY. */ > + struct type *target_type = TYPE_TARGET_TYPE (dim_type); > + struct type *index_type = dim_type->index_type (); > + LONGEST lb = f77_get_lowerbound (dim_type); > + LONGEST ub = f77_get_upperbound (dim_type); > + LONGEST sd = index_type->bit_stride (); > + if (sd == 0) > + sd = TYPE_LENGTH (target_type) * 8; > + > + if (fortran_array_slicing_debug) > + { > + debug_printf ("|-> Range access\n"); > + std::string str = type_to_string (dim_type); > + debug_printf ("| |-> Type: %s\n", str.c_str ()); > + debug_printf ("| |-> Array:\n"); > + debug_printf ("| | |-> Low bound: %ld\n", lb); > + debug_printf ("| | |-> High bound: %ld\n", ub); > + debug_printf ("| | |-> Bit stride: %ld\n", sd); > + debug_printf ("| | |-> Byte stride: %ld\n", sd / 8); > + debug_printf ("| | |-> Type size: %ld\n", > + TYPE_LENGTH (dim_type)); > + debug_printf ("| | '-> Target type size: %ld\n", > + TYPE_LENGTH (target_type)); > + debug_printf ("| |-> Accessing:\n"); > + debug_printf ("| | |-> Low bound: %ld\n", > + low); > + debug_printf ("| | |-> High bound: %ld\n", > + high); > + debug_printf ("| | '-> Element stride: %ld\n", > + stride); > + } > + > + /* Check the user hasn't asked for something invalid. */ > + if (high > ub || low < lb) > + error (_("array subscript out of bounds")); > + > + /* Calculate what this dimension of the new slice array will look > + like. OFFSET is the byte offset from the start of the > + previous (more outer) dimension to the start of this > + dimension. E_COUNT is the number of elements in this > + dimension. REMAINDER is the number of elements remaining > + between the last included element and the upper bound. For > + example an access '1:6:2' will include elements 1, 3, 5 and > + have a remainder of 1 (element #6). */ > + LONGEST lowest = std::min (low, high); > + LONGEST offset = (sd / 8) * (lowest - lb); > + LONGEST e_count = std::abs (high - low) + 1; > + e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride); > + LONGEST new_low = 1; > + LONGEST new_high = new_low + e_count - 1; > + LONGEST new_stride = (sd * stride) / 8; > + LONGEST last_elem = low + ((e_count - 1) * stride); > + LONGEST remainder = high - last_elem; > + if (low > high) > + { > + offset += std::abs (remainder) * TYPE_LENGTH (target_type); > + if (stride > 0) > + error (_("incorrect stride and boundary combination")); > + } > + else if (stride < 0) > + error (_("incorrect stride and boundary combination")); > + > + /* Is the data within this dimension contiguous? It is if the > + newly computed stride is the same size as a single element of > + this dimension. */ > + bool is_dim_contiguous = (new_stride == slice_element_size); > + is_all_contiguous &= is_dim_contiguous; > > - if (nargs > MAX_FORTRAN_DIMS) > - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); > + if (fortran_array_slicing_debug) > + { > + debug_printf ("| '-> Results:\n"); > + debug_printf ("| |-> Offset = %ld\n", offset); > + debug_printf ("| |-> Elements = %ld\n", e_count); > + debug_printf ("| |-> Low bound = %ld\n", new_low); > + debug_printf ("| |-> High bound = %ld\n", new_high); > + debug_printf ("| |-> Byte stride = %ld\n", new_stride); > + debug_printf ("| |-> Last element = %ld\n", last_elem); > + debug_printf ("| |-> Remainder = %ld\n", remainder); > + debug_printf ("| '-> Contiguous = %s\n", > + (is_dim_contiguous ? "Yes" : "No")); > + } > > - ndimensions = calc_f77_array_dims (type); > + /* Figure out how big (in bytes) an element of this dimension of > + the new array slice will be. */ > + slice_element_size = std::abs (new_stride * e_count); > > - if (nargs != ndimensions) > - error (_("Wrong number of subscripts")); > + slice_dims.emplace_back (new_low, new_high, new_stride, > + index_type); > + > + /* Update the total offset. */ > + total_offset += offset; > + } > + else > + { > + /* There is a single index for this dimension. */ > + LONGEST index > + = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside)); > + > + /* Get information about this dimension in the original ARRAY. */ > + struct type *target_type = TYPE_TARGET_TYPE (dim_type); > + struct type *index_type = dim_type->index_type (); > + LONGEST lb = f77_get_lowerbound (dim_type); > + LONGEST ub = f77_get_upperbound (dim_type); > + LONGEST sd = index_type->bit_stride () / 8; > + if (sd == 0) > + sd = TYPE_LENGTH (target_type); > + > + if (fortran_array_slicing_debug) > + { > + debug_printf ("|-> Index access\n"); > + std::string str = type_to_string (dim_type); > + debug_printf ("| |-> Type: %s\n", str.c_str ()); > + debug_printf ("| |-> Array:\n"); > + debug_printf ("| | |-> Low bound: %ld\n", lb); > + debug_printf ("| | |-> High bound: %ld\n", ub); > + debug_printf ("| | |-> Byte stride: %ld\n", sd); > + debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type)); > + debug_printf ("| | '-> Target type size: %ld\n", > + TYPE_LENGTH (target_type)); > + debug_printf ("| '-> Accessing:\n"); > + debug_printf ("| '-> Index: %ld\n", index); > + } > > - gdb_assert (nargs > 0); > + /* If the array has actual content then check the index is in > + bounds. An array without content (an unbound array) doesn't > + have a known upper bound, so don't error check in that > + situation. */ > + if (index < lb > + || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED > + && index > ub) > + || (VALUE_LVAL (array) != lval_memory > + && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED)) > + { > + if (type_not_associated (dim_type)) > + error (_("no such vector element (vector not associated)")); > + else if (type_not_allocated (dim_type)) > + error (_("no such vector element (vector not allocated)")); > + else > + error (_("no such vector element")); > + } > + > + /* Calculate using the type stride, not the target type size. */ > + LONGEST offset = sd * (index - lb); > + total_offset += offset; > + } > + } > > - /* Now that we know we have a legal array subscript expression let us > - actually find out where this element exists in the array. */ > + if (noside == EVAL_SKIP) > + return array; > > - /* Take array indices left to right. */ > - for (int i = 0; i < nargs; i++) > + /* Build a type that represents the new array slice in the target memory > + of the original ARRAY, this type makes use of strides to correctly > + find only those elements that are part of the new slice. */ > + struct type *array_slice_type = inner_element_type; > + for (const auto &d : slice_dims) > { > - /* Evaluate each subscript; it must be a legal integer in F77. */ > - value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); > + /* Create the range. */ > + dynamic_prop p_low, p_high, p_stride; > + > + p_low.set_const_val (d.low); > + p_high.set_const_val (d.high); > + p_stride.set_const_val (d.stride); > + > + struct type *new_range > + = create_range_type_with_stride ((struct type *) NULL, > + TYPE_TARGET_TYPE (d.index), > + &p_low, &p_high, 0, &p_stride, > + true); > + array_slice_type > + = create_array_type (nullptr, array_slice_type, new_range); > + } > > - /* Fill in the subscript array. */ > - subscript_array[i] = value_as_long (arg2); > + if (fortran_array_slicing_debug) > + { > + debug_printf ("'-> Final result:\n"); > + debug_printf (" |-> Type: %s\n", > + type_to_string (array_slice_type).c_str ()); > + debug_printf (" |-> Total offset: %ld\n", total_offset); > + debug_printf (" |-> Base address: %s\n", > + core_addr_to_string (value_address (array))); > + debug_printf (" '-> Contiguous = %s\n", > + (is_all_contiguous ? "Yes" : "No")); > } > > - /* Internal type of array is arranged right to left. */ > - for (int i = nargs; i > 0; i--) > + /* Should we repack this array slice? */ > + if (!is_all_contiguous && (repack_array_slices || is_string_p)) > { > - struct type *array_type = check_typedef (value_type (array)); > - LONGEST index = subscript_array[i - 1]; > + /* Build a type for the repacked slice. */ > + struct type *repacked_array_type = inner_element_type; > + for (const auto &d : slice_dims) > + { > + /* Create the range. */ > + dynamic_prop p_low, p_high, p_stride; > + > + p_low.set_const_val (d.low); > + p_high.set_const_val (d.high); > + p_stride.set_const_val (TYPE_LENGTH (repacked_array_type)); > + > + struct type *new_range > + = create_range_type_with_stride ((struct type *) NULL, > + TYPE_TARGET_TYPE (d.index), > + &p_low, &p_high, 0, &p_stride, > + true); > + repacked_array_type > + = create_array_type (nullptr, repacked_array_type, new_range); > + } > > - array = value_subscripted_rvalue (array, index, > - f77_get_lowerbound (array_type)); > + /* Now copy the elements from the original ARRAY into the packed > + array value DEST. */ > + struct value *dest = allocate_value (repacked_array_type); > + if (value_lazy (array) > + || (total_offset + TYPE_LENGTH (array_slice_type) > + > TYPE_LENGTH (check_typedef (value_type (array))))) > + { > + fortran_array_walker p > + (array_slice_type, value_address (array) + total_offset, dest); > + p.walk (); > + } > + else > + { > + fortran_array_walker p > + (array_slice_type, value_address (array) + total_offset, > + total_offset, array, dest); > + p.walk (); > + } > + array = dest; > + } > + else > + { > + if (VALUE_LVAL (array) == lval_memory) > + { > + /* If the value we're taking a slice from is not yet loaded, or > + the requested slice is outside the values content range then > + just create a new lazy value pointing at the memory where the > + contents we're looking for exist. */ > + if (value_lazy (array) > + || (total_offset + TYPE_LENGTH (array_slice_type) > + > TYPE_LENGTH (check_typedef (value_type (array))))) > + array = value_at_lazy (array_slice_type, > + value_address (array) + total_offset); > + else > + array = value_from_contents_and_address (array_slice_type, > + (value_contents (array) > + + total_offset), > + (value_address (array) > + + total_offset)); > + } > + else if (!value_lazy (array)) > + { > + const void *valaddr = value_contents (array) + total_offset; > + array = allocate_value (array_slice_type); > + memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type)); > + } > + else > + error (_("cannot subscript arrays that are not in memory")); > } > > return array; > @@ -862,11 +1320,50 @@ builtin_f_type (struct gdbarch *gdbarch) > return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data); > } > > +/* Command-list for the "set/show fortran" prefix command. */ > +static struct cmd_list_element *set_fortran_list; > +static struct cmd_list_element *show_fortran_list; > + > void _initialize_f_language (); > void > _initialize_f_language () > { > f_type_data = gdbarch_data_register_post_init (build_fortran_types); > + > + add_basic_prefix_cmd ("fortran", no_class, > + _("Prefix command for changing Fortran-specific settings."), > + &set_fortran_list, "set fortran ", 0, &setlist); > + > + add_show_prefix_cmd ("fortran", no_class, > + _("Generic command for showing Fortran-specific settings."), > + &show_fortran_list, "show fortran ", 0, &showlist); > + > + add_setshow_boolean_cmd ("repack-array-slices", class_vars, > + &repack_array_slices, _("\ > +Enable or disable repacking of non-contiguous array slices."), _("\ > +Show whether non-contiguous array slices are repacked."), _("\ > +When the user requests a slice of a Fortran array then we can either return\n\ > +a descriptor that describes the array in place (using the original array data\n\ > +in its existing location) or the original data can be repacked (copied) to a\n\ > +new location.\n\ > +\n\ > +When the content of the array slice is contiguous within the original array\n\ > +then the result will never be repacked, but when the data for the new array\n\ > +is non-contiguous within the original array repacking will only be performed\n\ > +when this setting is on."), > + NULL, > + show_repack_array_slices, > + &set_fortran_list, &show_fortran_list); > + > + /* Debug Fortran's array slicing logic. */ > + add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance, > + &fortran_array_slicing_debug, _("\ > +Set debugging of Fortran array slicing."), _("\ > +Show debugging of Fortran array slicing."), _("\ > +When on, debugging of Fortran array slicing is enabled."), > + NULL, > + show_fortran_array_slicing_debug, > + &setdebuglist, &showdebuglist); > } > > /* See f-lang.h. */ > @@ -905,3 +1402,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type) > return value_type (arg); > return type; > } > + > +/* See f-lang.h. */ > + > +CORE_ADDR > +fortran_adjust_dynamic_array_base_address_hack (struct type *type, > + CORE_ADDR address) > +{ > + gdb_assert (type->code () == TYPE_CODE_ARRAY); > + > + int ndimensions = calc_f77_array_dims (type); > + LONGEST total_offset = 0; > + > + /* Walk through each of the dimensions of this array type and figure out > + if any of the dimensions are "backwards", that is the base address > + for this dimension points to the element at the highest memory > + address and the stride is negative. */ > + struct type *tmp_type = type; > + for (int i = 0 ; i < ndimensions; ++i) > + { > + /* Grab the range for this dimension and extract the lower and upper > + bounds. */ > + tmp_type = check_typedef (tmp_type); > + struct type *range_type = tmp_type->index_type (); > + LONGEST lowerbound, upperbound, stride; > + if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) > + error ("failed to get range bounds"); > + > + /* Figure out the stride for this dimension. */ > + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type)); > + stride = tmp_type->index_type ()->bounds ()->bit_stride (); > + if (stride == 0) > + stride = type_length_units (elt_type); > + else > + { > + struct gdbarch *arch = get_type_arch (elt_type); > + int unit_size = gdbarch_addressable_memory_unit_size (arch); > + stride /= (unit_size * 8); > + } > + > + /* If this dimension is "backward" then figure out the offset > + adjustment required to point to the element at the lowest memory > + address, and add this to the total offset. */ > + LONGEST offset = 0; > + if (stride < 0 && lowerbound < upperbound) > + offset = (upperbound - lowerbound) * stride; > + total_offset += offset; > + tmp_type = TYPE_TARGET_TYPE (tmp_type); > + } > + > + /* Adjust the address of this object and return it. */ > + address += total_offset; > + return address; > +} > diff --git a/gdb/f-lang.h b/gdb/f-lang.h > index e59fdef1b19..880c07e4473 100644 > --- a/gdb/f-lang.h > +++ b/gdb/f-lang.h > @@ -316,7 +316,6 @@ extern void f77_get_dynamic_array_length (struct type *); > > extern int calc_f77_array_dims (struct type *); > > - > /* Fortran (F77) types */ > > struct builtin_f_type > @@ -374,4 +373,22 @@ extern struct value *fortran_argument_convert (struct value *value, > extern struct type *fortran_preserve_arg_pointer (struct value *arg, > struct type *type); > > +/* Fortran arrays can have a negative stride. When this happens it is > + often the case that the base address for an object is not the lowest > + address occupied by that object. For example, an array slice (10:1:-1) > + will be encoded with lower bound 1, upper bound 10, a stride of > + -ELEMENT_SIZE, and have a base address pointer that points at the > + element with the highest address in memory. > + > + This really doesn't play well with our current model of value contents, > + but could easily require a significant update in order to be supported > + "correctly". > + > + For now, we manually force the base address to be the lowest addressed > + element here. Yes, this will break some things, but it fixes other > + things. The hope is that it fixes more than it breaks. */ > + > +extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack > + (struct type *type, CORE_ADDR address); > + > #endif /* F_LANG_H */ > diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c > index 95630a76d7d..83242f5ed47 100644 > --- a/gdb/f-valprint.c > +++ b/gdb/f-valprint.c > @@ -35,6 +35,7 @@ > #include "dictionary.h" > #include "cli/cli-style.h" > #include "gdbarch.h" > +#include "f-array-walker.h" > > static void f77_get_dynamic_length_of_aggregate (struct type *); > > @@ -100,100 +101,103 @@ f77_get_dynamic_length_of_aggregate (struct type *type) > * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type))); > } > > -/* Actual function which prints out F77 arrays, Valaddr == address in > - the superior. Address == the address in the inferior. */ > +/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array > + walking template. This specialisation prints Fortran arrays. */ > > -static void > -f77_print_array_1 (int nss, int ndimensions, struct type *type, > - const gdb_byte *valaddr, > - int embedded_offset, CORE_ADDR address, > - struct ui_file *stream, int recurse, > - const struct value *val, > - const struct value_print_options *options, > - int *elts) > +class fortran_array_printer_impl : public fortran_array_walker_base_impl > { > - struct type *range_type = check_typedef (type)->index_type (); > - CORE_ADDR addr = address + embedded_offset; > - LONGEST lowerbound, upperbound; > - LONGEST i; > - > - get_discrete_bounds (range_type, &lowerbound, &upperbound); > - > - if (nss != ndimensions) > - { > - struct gdbarch *gdbarch = get_type_arch (type); > - size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type)); > - int unit_size = gdbarch_addressable_memory_unit_size (gdbarch); > - size_t byte_stride = type->bit_stride () / (unit_size * 8); > - if (byte_stride == 0) > - byte_stride = dim_size; > - size_t offs = 0; > - > - for (i = lowerbound; > - (i < upperbound + 1 && (*elts) < options->print_max); > - i++) > - { > - struct value *subarray = value_from_contents_and_address > - (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val) > - + offs, addr + offs); > - > - fprintf_filtered (stream, "("); > - f77_print_array_1 (nss + 1, ndimensions, value_type (subarray), > - value_contents_for_printing (subarray), > - value_embedded_offset (subarray), > - value_address (subarray), > - stream, recurse, subarray, options, elts); > - offs += byte_stride; > - fprintf_filtered (stream, ")"); > - > - if (i < upperbound) > - fprintf_filtered (stream, " "); > - } > - if (*elts >= options->print_max && i < upperbound) > - fprintf_filtered (stream, "..."); > - } > - else > - { > - for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max; > - i++, (*elts)++) > - { > - struct value *elt = value_subscript ((struct value *)val, i); > - > - common_val_print (elt, stream, recurse, options, current_language); > - > - if (i != upperbound) > - fprintf_filtered (stream, ", "); > - > - if ((*elts == options->print_max - 1) > - && (i != upperbound)) > - fprintf_filtered (stream, "..."); > - } > - } > -} > +public: > + /* Constructor. TYPE is the array type being printed, ADDRESS is the > + address in target memory for the object of TYPE being printed. VAL is > + the GDB value (of TYPE) being printed. STREAM is where to print to, > + RECOURSE is passed through (and prevents infinite recursion), and > + OPTIONS are the printing control options. */ > + explicit fortran_array_printer_impl (struct type *type, > + CORE_ADDR address, > + struct value *val, > + struct ui_file *stream, > + int recurse, > + const struct value_print_options *options) > + : m_elts (0), > + m_val (val), > + m_stream (stream), > + m_recurse (recurse), > + m_options (options) > + { /* Nothing. */ } > + > + /* Called while iterating over the array bounds. When SHOULD_CONTINUE is > + false then we must return false, as we have reached the end of the > + array bounds for this dimension. However, we also return false if we > + have printed too many elements (after printing '...'). In all other > + cases, return true. */ > + bool continue_walking (bool should_continue) > + { > + bool cont = should_continue && (m_elts < m_options->print_max); > + if (!cont && should_continue) > + fputs_filtered ("...", m_stream); > + return cont; > + } > + > + /* Called when we start iterating over a dimension. If it's not the > + inner most dimension then print an opening '(' character. */ > + void start_dimension (bool inner_p) > + { > + fputs_filtered ("(", m_stream); > + } > + > + /* Called when we finish processing a batch of items within a dimension > + of the array. Depending on whether this is the inner most dimension > + or not we print different things, but this is all about adding > + separators between elements, and dimensions of the array. */ > + void finish_dimension (bool inner_p, bool last_p) > + { > + fputs_filtered (")", m_stream); > + if (!last_p) > + fputs_filtered (" ", m_stream); > + } > + > + /* Called to process an element of ELT_TYPE at offset ELT_OFF from the > + start of the parent object. */ > + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) > + { > + /* Extract the element value from the parent value. */ > + struct value *e_val > + = value_from_component (m_val, elt_type, elt_off); > + common_val_print (e_val, m_stream, m_recurse, m_options, current_language); > + if (!last_p) > + fputs_filtered (", ", m_stream); > + ++m_elts; > + } > + > +private: > + /* The number of elements printed so far. */ > + int m_elts; > + > + /* The value from which we are printing elements. */ > + struct value *m_val; > + > + /* The stream we should print too. */ > + struct ui_file *m_stream; > + > + /* The recursion counter, passed through when we print each element. */ > + int m_recurse; > + > + /* The print control options. Gives us the maximum number of elements to > + print, and is passed through to each element that we print. */ > + const struct value_print_options *m_options = nullptr; > +}; > > -/* This function gets called to print an F77 array, we set up some > - stuff and then immediately call f77_print_array_1(). */ > +/* This function gets called to print a Fortran array. */ > > static void > -f77_print_array (struct type *type, const gdb_byte *valaddr, > - int embedded_offset, > - CORE_ADDR address, struct ui_file *stream, > - int recurse, > - const struct value *val, > - const struct value_print_options *options) > +fortran_print_array (struct type *type, CORE_ADDR address, > + struct ui_file *stream, int recurse, > + const struct value *val, > + const struct value_print_options *options) > { > - int ndimensions; > - int elts = 0; > - > - ndimensions = calc_f77_array_dims (type); > - > - if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0) > - error (_("\ > -Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"), > - ndimensions, MAX_FORTRAN_DIMS); > - > - f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset, > - address, stream, recurse, val, options, &elts); > + fortran_array_walker p > + (type, address, (struct value *) val, stream, recurse, options); > + p.walk (); > } > > > @@ -237,12 +241,7 @@ f_language::value_print_inner (struct value *val, struct ui_file *stream, > > case TYPE_CODE_ARRAY: > if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR) > - { > - fprintf_filtered (stream, "("); > - f77_print_array (type, valaddr, 0, > - address, stream, recurse, val, options); > - fprintf_filtered (stream, ")"); > - } > + fortran_print_array (type, address, stream, recurse, val, options); > else > { > struct type *ch_type = TYPE_TARGET_TYPE (type); > diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c > index 0940fa597fb..6a4037dd077 100644 > --- a/gdb/gdbtypes.c > +++ b/gdb/gdbtypes.c > @@ -39,6 +39,7 @@ > #include "dwarf2/loc.h" > #include "gdbcore.h" > #include "floatformat.h" > +#include "f-lang.h" > #include > > /* Initialize BADNESS constants. */ > @@ -2627,7 +2628,16 @@ resolve_dynamic_type_internal (struct type *type, > prop = TYPE_DATA_LOCATION (resolved_type); > if (prop != NULL > && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) > - prop->set_const_val (value); > + { > + /* Start of Fortran hack. See comment in f-lang.h for what is going > + on here.*/ > + if (current_language->la_language == language_fortran > + && resolved_type->code () == TYPE_CODE_ARRAY) > + value = fortran_adjust_dynamic_array_base_address_hack (resolved_type, > + value); > + /* End of Fortran hack. */ > + prop->set_const_val (value); > + } > > return resolved_type; > } > diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp > new file mode 100644 > index 00000000000..2583cdecc94 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp > @@ -0,0 +1,69 @@ > +# Copyright 2020 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 . > + > +# Test invalid element and slice array accesses. > + > +if {[skip_fortran_tests]} { return -1 } > + > +standard_testfile ".f90" > +load_lib fortran.exp > + > +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90}]} { > + return -1 > +} > + > +if ![fortran_runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] > +gdb_breakpoint [gdb_get_line_number "First Breakpoint"] > +gdb_breakpoint [gdb_get_line_number "Second Breakpoint"] > +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] > + > +gdb_continue_to_breakpoint "First Breakpoint" > + > +# Access not yet allocated array. > +gdb_test "print other" " = " > +gdb_test "print other(0:4,2:3)" "array not allocated" > +gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)" > + > +# Access not yet associated pointer. > +gdb_test "print pointer2d" " = " > +gdb_test "print pointer2d(1:2,1:2)" "array not associated" > +gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)" > + > +gdb_continue_to_breakpoint "Second Breakpoint" > + > +# Accessing just outside the arrays. > +foreach name {array pointer2d other} { > + gdb_test "print $name (0:,:)" "array subscript out of bounds" > + gdb_test "print $name (:11,:)" "array subscript out of bounds" > + gdb_test "print $name (:,0:)" "array subscript out of bounds" > + gdb_test "print $name (:,:11)" "array subscript out of bounds" > + > + gdb_test "print $name (0,:)" "no such vector element" > + gdb_test "print $name (11,:)" "no such vector element" > + gdb_test "print $name (:,0)" "no such vector element" > + gdb_test "print $name (:,11)" "no such vector element" > +} > + > +# Stride in the wrong direction. > +gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination" > +gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination" > +gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination" > +gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination" > diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90 > new file mode 100644 > index 00000000000..0f3d45ab8cd > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90 > @@ -0,0 +1,42 @@ > +! Copyright 2020 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 . > + > +! > +! Start of test program. > +! > +program test > + > + ! Declare variables used in this test. > + integer, dimension (1:10,1:10) :: array > + integer, allocatable :: other (:, :) > + integer, dimension(:,:), pointer :: pointer2d => null() > + integer, dimension(1:10,1:10), target :: tarray > + > + print *, "" ! First Breakpoint. > + > + ! Allocate or associate any variables as needed. > + allocate (other (1:10, 1:10)) > + pointer2d => tarray > + array = 0 > + > + print *, "" ! Second Breakpoint. > + > + ! All done. Deallocate. > + deallocate (other) > + > + ! GDB catches this final breakpoint to indicate the end of the test. > + print *, "" ! Final Breakpoint. > + > +end program test > diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp > new file mode 100644 > index 00000000000..05b4802c678 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp > @@ -0,0 +1,111 @@ > +# Copyright 2020 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 . > + > +# Create a slice of an array, then take a slice of that slice. > + > +if {[skip_fortran_tests]} { return -1 } > + > +standard_testfile ".f90" > +load_lib fortran.exp > + > +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90}]} { > + return -1 > +} > + > +if ![fortran_runto_main] { > + untested "could not run to main" > + return -1 > +} > + > +# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] > +gdb_breakpoint [gdb_get_line_number "Stop Here"] > +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] > + > +# We're going to print some reasonably large arrays. > +gdb_test_no_output "set print elements unlimited" > + > +gdb_continue_to_breakpoint "Stop Here" > + > +# Print a slice, capture the convenience variable name created. > +set cmd "print array (1:10:2, 1:10:2)" > +gdb_test_multiple $cmd $cmd { > + -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" { > + set varname "\$$expect_out(1,string)" > + } > +} > + > +# Now check that we can correctly extract all the elements from this > +# slice. > +for { set j 1 } { $j < 6 } { incr j } { > + for { set i 1 } { $i < 6 } { incr i } { > + set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1] > + gdb_test "print ${varname} ($i,$j)" " = $val" > + } > +} > + > +# Now take a slice of the slice. > +gdb_test "print ${varname} (3:5, 3:5)" \ > + " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)" > + > +# Now take a different slice of a slice. > +set cmd "print ${varname} (1:5:2, 1:5:2)" > +gdb_test_multiple $cmd $cmd { > + -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" { > + set varname "\$$expect_out(1,string)" > + pass $gdb_test_name > + } > +} > + > +# Now take a slice from the slice, of a slice! > +set cmd "print ${varname} (1:3:2, 1:3:2)" > +gdb_test_multiple $cmd $cmd { > + -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" { > + set varname "\$$expect_out(1,string)" > + pass $gdb_test_name > + } > +} > + > +# And again! > +set cmd "print ${varname} (1:2:2, 1:2:2)" > +gdb_test_multiple $cmd $cmd { > + -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" { > + set varname "\$$expect_out(1,string)" > + pass $gdb_test_name > + } > +} > + > +# Test taking a slice with stride of a string. This isn't actually > +# supported within gfortran (at least), but naturally drops out of how > +# GDB models arrays and strings in a similar way, so we may as well > +# test that this is still working. > +gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'" > +gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'" > +gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'" > + > +# Now test the memory requirements of taking a slice from an array. > +# The idea is that we shouldn't require more memory to extract a slice > +# than the size of the slice. > +# > +# This will only work if array repacking is turned on, otherwise GDB > +# will create the slice by generating a new type that sits over the > +# existing value in memory. > +gdb_test_no_output "set fortran repack-array-slices on" > +set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"] > +set slice_size [expr $element_size * 4] > +gdb_test_no_output "set max-value-size $slice_size" > +gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)" > +gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)" > +gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)" > diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 > new file mode 100644 > index 00000000000..c3530f567d4 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 > @@ -0,0 +1,96 @@ > +! Copyright 2020 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 . > + > +! > +! Start of test program. > +! > +program test > + integer, dimension (1:10,1:11) :: array > + character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz" > + > + call fill_array_2d (array) > + > + ! GDB catches this final breakpoint to indicate the end of the test. > + print *, "" ! Stop Here > + > + print *, array > + print *, str > + > + ! GDB catches this final breakpoint to indicate the end of the test. > + print *, "" ! Final Breakpoint. > + > +contains > + > + ! Fill a 1D array with a unique positive integer in each element. > + subroutine fill_array_1d (array) > + integer, dimension (:) :: array > + integer :: counter > + > + counter = 1 > + do j=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (j) = counter > + counter = counter + 1 > + end do > + end subroutine fill_array_1d > + > + ! Fill a 2D array with a unique positive integer in each element. > + subroutine fill_array_2d (array) > + integer, dimension (:,:) :: array > + integer :: counter > + > + counter = 1 > + do i=LBOUND (array, 2), UBOUND (array, 2), 1 > + do j=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (j,i) = counter > + counter = counter + 1 > + end do > + end do > + end subroutine fill_array_2d > + > + ! Fill a 3D array with a unique positive integer in each element. > + subroutine fill_array_3d (array) > + integer, dimension (:,:,:) :: array > + integer :: counter > + > + counter = 1 > + do i=LBOUND (array, 3), UBOUND (array, 3), 1 > + do j=LBOUND (array, 2), UBOUND (array, 2), 1 > + do k=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (k, j,i) = counter > + counter = counter + 1 > + end do > + end do > + end do > + end subroutine fill_array_3d > + > + ! Fill a 4D array with a unique positive integer in each element. > + subroutine fill_array_4d (array) > + integer, dimension (:,:,:,:) :: array > + integer :: counter > + > + counter = 1 > + do i=LBOUND (array, 4), UBOUND (array, 4), 1 > + do j=LBOUND (array, 3), UBOUND (array, 3), 1 > + do k=LBOUND (array, 2), UBOUND (array, 2), 1 > + do l=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (l, k, j,i) = counter > + counter = counter + 1 > + end do > + end do > + end do > + end do > + print *, "" > + end subroutine fill_array_4d > +end program test > diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp > index aa6bc6327eb..ff00fae886f 100644 > --- a/gdb/testsuite/gdb.fortran/array-slices.exp > +++ b/gdb/testsuite/gdb.fortran/array-slices.exp > @@ -18,6 +18,21 @@ > # the subroutine. This should exercise GDB's ability to handle > # different strides for the different dimensions. > > +# Testing GDB's ability to print array (and string) slices, including > +# slices that make use of array strides. > +# > +# In the Fortran code various arrays of different ranks are filled > +# with data, and slices are passed to a series of show functions. > +# > +# In this test script we break in each of the show functions, print > +# the array slice that was passed in, and then move up the stack to > +# the parent frame and check GDB can manually extract the same slice. > +# > +# This test also checks that the size of the array slice passed to the > +# function (so as extracted and described by the compiler and the > +# debug information) matches the size of the slice manually extracted > +# by GDB. > + > if {[skip_fortran_tests]} { return -1 } > > standard_testfile ".f90" > @@ -28,60 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > return -1 > } > > -if ![fortran_runto_main] { > - untested "could not run to main" > - return -1 > +# Takes the name of an array slice as used in the test source, and extracts > +# the base array name. For example: 'array (1,2)' becomes 'array'. > +proc array_slice_to_var { slice_str } { > + regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname > + return $varname > } > > -gdb_breakpoint "show" > -gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] > - > -set array_contents \ > - [list \ > - " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \ > - " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \ > - " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \ > - " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \ > - " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \ > - " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \ > - " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \ > - " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ] > - > -set message_strings \ > - [list \ > - " = 'array'" \ > - " = 'array \\(1:5,1:5\\)'" \ > - " = 'array \\(1:10:2,1:10:2\\)'" \ > - " = 'array \\(1:10:3,1:10:2\\)'" \ > - " = 'array \\(1:10:5,1:10:3\\)'" \ > - " = 'other'" \ > - " = 'other \\(-5:0, -2:0\\)'" \ > - " = 'other \\(-5:4:2, -2:7:3\\)'" ] > - > -set i 0 > -foreach result $array_contents msg $message_strings { > - incr i > - with_test_prefix "test $i" { > - gdb_continue_to_breakpoint "show" > - gdb_test "p array" $result > - gdb_test "p message" "$msg" > +proc run_test { repack } { > + global binfile gdb_prompt > + > + clean_restart ${binfile} > + > + if ![fortran_runto_main] { > + untested "could not run to main" > + return -1 > } > -} > > -gdb_continue_to_breakpoint "continue to Final Breakpoint" > + gdb_test_no_output "set fortran repack-array-slices $repack" > + > + # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] > + gdb_breakpoint [gdb_get_line_number "Display Element"] > + gdb_breakpoint [gdb_get_line_number "Display String"] > + gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"] > + gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"] > + gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"] > + gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"] > + gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] > + > + # We're going to print some reasonably large arrays. > + gdb_test_no_output "set print elements unlimited" > + > + set found_final_breakpoint false > + > + # We place a limit on the number of tests that can be run, just in > + # case something goes wrong, and GDB gets stuck in an loop here. > + set test_count 0 > + while { $test_count < 500 } { > + with_test_prefix "test $test_count" { > + incr test_count > + > + set found_final_breakpoint false > + set expected_result "" > + set func_name "" > + gdb_test_multiple "continue" "continue" { > + -re ".*GDB = (\[^\r\n\]+)\r\n" { > + set expected_result $expect_out(1,string) > + exp_continue > + } > + -re "! Display Element" { > + set func_name "show_elem" > + exp_continue > + } > + -re "! Display String" { > + set func_name "show_str" > + exp_continue > + } > + -re "! Display Array Slice (.)D" { > + set func_name "show_$expect_out(1,string)d" > + exp_continue > + } > + -re "! Final Breakpoint" { > + set found_final_breakpoint true > + exp_continue > + } > + -re "$gdb_prompt $" { > + # We're done. > + } > + } > > -# Next test that asking for an array with stride at the CLI gives an > -# error. > -clean_restart ${testfile} > + if ($found_final_breakpoint) { > + break > + } > > -if ![fortran_runto_main] then { > - perror "couldn't run to main" > - continue > + # We want to take a look at the line in the previous frame that > + # called the current function. I couldn't find a better way of > + # doing this than 'up', which will print the line, then 'down' > + # again. > + # > + # I don't want to fill the log with passes for these up/down > + # commands, so we don't report any. If something goes wrong then we > + # should get a fail from gdb_test_multiple. > + set array_slice_name "" > + set unique_id "" > + array unset replacement_vars > + array set replacement_vars {} > + gdb_test_multiple "up" "up" { > + -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" { > + set array_slice_name $expect_out(1,string) > + } > + -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" { > + set array_slice_name $expect_out(1,string) > + set unique_id $expect_out(2,string) > + } > + } > + if {$unique_id != ""} { > + set str "" > + foreach v [split $unique_id ,] { > + set val [get_integer_valueof "${v}" "??"\ > + "get variable '$v' for '$array_slice_name'"] > + set replacement_vars($v) $val > + if {$str != ""} { > + set str "Str," > + } > + set str "$str$v=$val" > + } > + set unique_id " $str" > + } > + gdb_test_multiple "down" "down" { > + -re "\r\n$gdb_prompt $" { > + # Don't issue a pass here. > + } > + } > + > + # Check we have all the information we need to successfully run one > + # of these tests. > + if { $expected_result == "" } { > + perror "failed to extract expected results" > + return 0 > + } > + if { $array_slice_name == "" } { > + perror "failed to extract array slice name" > + return 0 > + } > + > + # Check GDB can correctly print the array slice that was passed into > + # the current frame. > + set pattern [string_to_regexp " = $expected_result"] > + gdb_test "p array" "$pattern" \ > + "check value of '$array_slice_name'$unique_id" > + > + # Get the size of the slice. > + set size_in_show \ > + [get_integer_valueof "sizeof (array)" "show_unknown" \ > + "get sizeof '$array_slice_name'$unique_id in show"] > + set addr_in_show \ > + [get_hexadecimal_valueof "&array" "show_unknown" \ > + "get address '$array_slice_name'$unique_id in show"] > + > + # Now move into the previous frame, and see if GDB can extract the > + # array slice from the original parent object. Again, use of > + # gdb_test_multiple to avoid filling the logs with unnecessary > + # passes. > + gdb_test_multiple "up" "up" { > + -re "\r\n$gdb_prompt $" { > + # Do nothing. > + } > + } > + > + # Print the array slice, this will force GDB to manually extract the > + # slice from the parent array. > + gdb_test "p $array_slice_name" "$pattern" \ > + "check array slice '$array_slice_name'$unique_id can be extracted" > + > + # Get the size of the slice in the calling frame. > + set size_in_parent \ > + [get_integer_valueof "sizeof ($array_slice_name)" \ > + "parent_unknown" \ > + "get sizeof '$array_slice_name'$unique_id in parent"] > + > + # Figure out the start and end addresses of the full array in the > + # parent frame. > + set full_var_name [array_slice_to_var $array_slice_name] > + set start_addr [get_hexadecimal_valueof "&${full_var_name}" \ > + "start unknown"] > + set end_addr [get_hexadecimal_valueof \ > + "(&${full_var_name}) + sizeof (${full_var_name})" \ > + "end unknown"] > + > + # The Fortran compiler can choose to either send a descriptor that > + # describes the array slice to the subroutine, or it can repack the > + # slice into an array section and send that. > + # > + # We find the address range of the original array in the parent, > + # and the address of the slice in the show function, if the > + # address of the slice (from show) is in the range of the original > + # array then repacking has not occurred, otherwise, the slice is > + # outside of the parent, and repacking must have occurred. > + # > + # The goal here is to compare the sizes of the slice in show with > + # the size of the slice extracted by GDB. So we can only compare > + # sizes when GDB's repacking setting matches the repacking > + # behaviour we got from the compiler. > + if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \ > + == ($repack == "on") } { > + gdb_assert {$size_in_show == $size_in_parent} \ > + "check sizes match" > + } elseif { $repack == "off" } { > + # GDB's repacking is off (so slices are left unpacked), but > + # the compiler did pack this one. As a result we can't > + # compare the sizes between the compiler's slice and GDB's > + # slice. > + verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared" > + } else { > + # Like the above, but the reverse, GDB's repacking is on, but > + # the compiler didn't repack this slice. > + verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared" > + } > + > + # If the array name we just tested included variable names, then > + # test again with all the variables expanded. > + if {$unique_id != ""} { > + foreach v [array names replacement_vars] { > + set val $replacement_vars($v) > + set array_slice_name \ > + [regsub "\\y${v}\\y" $array_slice_name $val] > + } > + gdb_test "p $array_slice_name" "$pattern" \ > + "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded" > + } > + } > + } > + > + # Ensure we reached the final breakpoint. If more tests have been added > + # to the test script, and this starts failing, then the safety 'while' > + # loop above might need to be increased. > + gdb_assert {$found_final_breakpoint} "ran all tests" > } > > -gdb_breakpoint "show" > -gdb_continue_to_breakpoint "show" > -gdb_test "up" ".*" > -gdb_test "p array (1:10:2, 1:10:2)" \ > - "Fortran array strides are not currently supported" \ > - "using array stride gives an error" > +foreach_with_prefix repack { on off } { > + run_test $repack > +} > diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90 > index a66fa6ba784..6d75a385699 100644 > --- a/gdb/testsuite/gdb.fortran/array-slices.f90 > +++ b/gdb/testsuite/gdb.fortran/array-slices.f90 > @@ -13,58 +13,368 @@ > ! You should have received a copy of the GNU General Public License > ! along with this program. If not, see . > > -subroutine show (message, array) > - character (len=*) :: message > +subroutine show_elem (array) > + integer :: array > + > + print *, "" > + print *, "Expected GDB Output:" > + print *, "" > + > + write(*, fmt="(A)", advance="no") "GDB = " > + write(*, fmt="(I0)", advance="no") array > + write(*, fmt="(A)", advance="yes") "" > + > + print *, "" ! Display Element > +end subroutine show_elem > + > +subroutine show_str (array) > + character (len=*) :: array > + > + print *, "" > + print *, "Expected GDB Output:" > + print *, "" > + write (*, fmt="(A)", advance="no") "GDB = '" > + write (*, fmt="(A)", advance="no") array > + write (*, fmt="(A)", advance="yes") "'" > + > + print *, "" ! Display String > +end subroutine show_str > + > +subroutine show_1d (array) > + integer, dimension (:) :: array > + > + print *, "Array Contents:" > + print *, "" > + > + do i=LBOUND (array, 1), UBOUND (array, 1), 1 > + write(*, fmt="(i4)", advance="no") array (i) > + end do > + > + print *, "" > + print *, "Expected GDB Output:" > + print *, "" > + > + write(*, fmt="(A)", advance="no") "GDB = (" > + do i=LBOUND (array, 1), UBOUND (array, 1), 1 > + if (i > LBOUND (array, 1)) then > + write(*, fmt="(A)", advance="no") ", " > + end if > + write(*, fmt="(I0)", advance="no") array (i) > + end do > + write(*, fmt="(A)", advance="no") ")" > + > + print *, "" ! Display Array Slice 1D > +end subroutine show_1d > + > +subroutine show_2d (array) > integer, dimension (:,:) :: array > > - print *, message > + print *, "Array Contents:" > + print *, "" > + > do i=LBOUND (array, 2), UBOUND (array, 2), 1 > do j=LBOUND (array, 1), UBOUND (array, 1), 1 > write(*, fmt="(i4)", advance="no") array (j, i) > end do > print *, "" > - end do > - print *, array > - print *, "" > + end do > > -end subroutine show > + print *, "" > + print *, "Expected GDB Output:" > + print *, "" > > -program test > + write(*, fmt="(A)", advance="no") "GDB = (" > + do i=LBOUND (array, 2), UBOUND (array, 2), 1 > + if (i > LBOUND (array, 2)) then > + write(*, fmt="(A)", advance="no") " " > + end if > + write(*, fmt="(A)", advance="no") "(" > + do j=LBOUND (array, 1), UBOUND (array, 1), 1 > + if (j > LBOUND (array, 1)) then > + write(*, fmt="(A)", advance="no") ", " > + end if > + write(*, fmt="(I0)", advance="no") array (j, i) > + end do > + write(*, fmt="(A)", advance="no") ")" > + end do > + write(*, fmt="(A)", advance="yes") ")" > + > + print *, "" ! Display Array Slice 2D > +end subroutine show_2d > + > +subroutine show_3d (array) > + integer, dimension (:,:,:) :: array > + > + print *, "" > + print *, "Expected GDB Output:" > + print *, "" > + > + write(*, fmt="(A)", advance="no") "GDB = (" > + do i=LBOUND (array, 3), UBOUND (array, 3), 1 > + if (i > LBOUND (array, 3)) then > + write(*, fmt="(A)", advance="no") " " > + end if > + write(*, fmt="(A)", advance="no") "(" > + do j=LBOUND (array, 2), UBOUND (array, 2), 1 > + if (j > LBOUND (array, 2)) then > + write(*, fmt="(A)", advance="no") " " > + end if > + write(*, fmt="(A)", advance="no") "(" > + do k=LBOUND (array, 1), UBOUND (array, 1), 1 > + if (k > LBOUND (array, 1)) then > + write(*, fmt="(A)", advance="no") ", " > + end if > + write(*, fmt="(I0)", advance="no") array (k, j, i) > + end do > + write(*, fmt="(A)", advance="no") ")" > + end do > + write(*, fmt="(A)", advance="no") ")" > + end do > + write(*, fmt="(A)", advance="yes") ")" > + > + print *, "" ! Display Array Slice 3D > +end subroutine show_3d > + > +subroutine show_4d (array) > + integer, dimension (:,:,:,:) :: array > + > + print *, "" > + print *, "Expected GDB Output:" > + print *, "" > + > + write(*, fmt="(A)", advance="no") "GDB = (" > + do i=LBOUND (array, 4), UBOUND (array, 4), 1 > + if (i > LBOUND (array, 4)) then > + write(*, fmt="(A)", advance="no") " " > + end if > + write(*, fmt="(A)", advance="no") "(" > + do j=LBOUND (array, 3), UBOUND (array, 3), 1 > + if (j > LBOUND (array, 3)) then > + write(*, fmt="(A)", advance="no") " " > + end if > + write(*, fmt="(A)", advance="no") "(" > + > + do k=LBOUND (array, 2), UBOUND (array, 2), 1 > + if (k > LBOUND (array, 2)) then > + write(*, fmt="(A)", advance="no") " " > + end if > + write(*, fmt="(A)", advance="no") "(" > + do l=LBOUND (array, 1), UBOUND (array, 1), 1 > + if (l > LBOUND (array, 1)) then > + write(*, fmt="(A)", advance="no") ", " > + end if > + write(*, fmt="(I0)", advance="no") array (l, k, j, i) > + end do > + write(*, fmt="(A)", advance="no") ")" > + end do > + write(*, fmt="(A)", advance="no") ")" > + end do > + write(*, fmt="(A)", advance="no") ")" > + end do > + write(*, fmt="(A)", advance="yes") ")" > + > + print *, "" ! Display Array Slice 4D > +end subroutine show_4d > > +! > +! Start of test program. > +! > +program test > interface > - subroutine show (message, array) > - character (len=*) :: message > + subroutine show_str (array) > + character (len=*) :: array > + end subroutine show_str > + > + subroutine show_1d (array) > + integer, dimension (:) :: array > + end subroutine show_1d > + > + subroutine show_2d (array) > integer, dimension(:,:) :: array > - end subroutine show > + end subroutine show_2d > + > + subroutine show_3d (array) > + integer, dimension(:,:,:) :: array > + end subroutine show_3d > + > + subroutine show_4d (array) > + integer, dimension(:,:,:,:) :: array > + end subroutine show_4d > end interface > > + ! Declare variables used in this test. > + integer, dimension (-10:-1,-10:-2) :: neg_array > integer, dimension (1:10,1:10) :: array > integer, allocatable :: other (:, :) > + character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz" > + integer, dimension (-2:2,-2:2,-2:2) :: array3d > + integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d > + integer, dimension (10:20) :: array1d > + integer, dimension(:,:), pointer :: pointer2d => null() > + integer, dimension(-1:9,-1:9), target :: tarray > > + ! Allocate or associate any variables as needed. > allocate (other (-5:4, -2:7)) > + pointer2d => tarray > > - do i=LBOUND (array, 2), UBOUND (array, 2), 1 > - do j=LBOUND (array, 1), UBOUND (array, 1), 1 > - array (j,i) = ((i - 1) * UBOUND (array, 2)) + j > - end do > - end do > + ! Fill arrays with contents ready for testing. > + call fill_array_1d (array1d) > + > + call fill_array_2d (neg_array) > + call fill_array_2d (array) > + call fill_array_2d (other) > + call fill_array_2d (tarray) > + > + call fill_array_3d (array3d) > + call fill_array_4d (array4d) > + > + ! The tests. Each call to a show_* function must have a unique set > + ! of arguments as GDB uses the arguments are part of the test name > + ! string, so duplicate arguments will result in duplicate test > + ! names. > + ! > + ! If a show_* line ends with VARS=... where '...' is a comma > + ! separated list of variable names, these variables are assumed to > + ! be part of the call line, and will be expanded by the test script, > + ! for example: > + ! > + ! do x=1,9,1 > + ! do y=x,10,1 > + ! call show_1d (some_array (x,y)) ! VARS=x,y > + ! end do > + ! end do > + ! > + ! In this example the test script will automatically expand 'x' and > + ! 'y' in order to better test different aspects of GDB. Do take > + ! care, the expansion is not very "smart", so try to avoid clashing > + ! with other text on the line, in the example above, avoid variables > + ! named 'some' or 'array', as these will likely clash with > + ! 'some_array'. > + call show_str (str_1) > + call show_str (str_1 (1:20)) > + call show_str (str_1 (10:20)) > > - do i=LBOUND (other, 2), UBOUND (other, 2), 1 > - do j=LBOUND (other, 1), UBOUND (other, 1), 1 > - other (j,i) = ((i - 1) * UBOUND (other, 2)) + j > + call show_elem (array1d (11)) > + call show_elem (pointer2d (2,3)) > + > + call show_1d (array1d) > + call show_1d (array1d (13:17)) > + call show_1d (array1d (17:13:-1)) > + call show_1d (array (1:5,1)) > + call show_1d (array4d (1,7,3,:)) > + call show_1d (pointer2d (-1:3, 2)) > + call show_1d (pointer2d (-1, 2:4)) > + > + ! Enclosing the array slice argument in (...) causess gfortran to > + ! repack the array. > + call show_1d ((array (1:5,1))) > + > + call show_2d (pointer2d) > + call show_2d (array) > + call show_2d (array (1:5,1:5)) > + do i=1,10,2 > + do j=1,10,3 > + call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j > + call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j > + call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j > + call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j > end do > end do > + call show_2d (array (6:2:-1,3:9)) > + call show_2d (array (1:10:2, 1:10:2)) > + call show_2d (other) > + call show_2d (other (-5:0, -2:0)) > + call show_2d (other (-5:4:2, -2:7:3)) > + call show_2d (neg_array) > + call show_2d (neg_array (-10:-3,-8:-4:2)) > + > + ! Enclosing the array slice argument in (...) causess gfortran to > + ! repack the array. > + call show_2d ((array (1:10:3, 1:10:2))) > + call show_2d ((neg_array (-10:-3,-8:-4:2))) > > - call show ("array", array) > - call show ("array (1:5,1:5)", array (1:5,1:5)) > - call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2)) > - call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2)) > - call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3)) > + call show_3d (array3d) > + call show_3d (array3d(-1:1,-1:1,-1:1)) > + call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1)) > > - call show ("other", other) > - call show ("other (-5:0, -2:0)", other (-5:0, -2:0)) > - call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3)) > + ! Enclosing the array slice argument in (...) causess gfortran to > + ! repack the array. > + call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1))) > > + call show_4d (array4d) > + call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1)) > + call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1)) > + > + ! Enclosing the array slice argument in (...) causess gfortran to > + ! repack the array. > + call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1))) > + > + ! All done. Deallocate. > deallocate (other) > + > + ! GDB catches this final breakpoint to indicate the end of the test. > print *, "" ! Final Breakpoint. > + > +contains > + > + ! Fill a 1D array with a unique positive integer in each element. > + subroutine fill_array_1d (array) > + integer, dimension (:) :: array > + integer :: counter > + > + counter = 1 > + do j=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (j) = counter > + counter = counter + 1 > + end do > + end subroutine fill_array_1d > + > + ! Fill a 2D array with a unique positive integer in each element. > + subroutine fill_array_2d (array) > + integer, dimension (:,:) :: array > + integer :: counter > + > + counter = 1 > + do i=LBOUND (array, 2), UBOUND (array, 2), 1 > + do j=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (j,i) = counter > + counter = counter + 1 > + end do > + end do > + end subroutine fill_array_2d > + > + ! Fill a 3D array with a unique positive integer in each element. > + subroutine fill_array_3d (array) > + integer, dimension (:,:,:) :: array > + integer :: counter > + > + counter = 1 > + do i=LBOUND (array, 3), UBOUND (array, 3), 1 > + do j=LBOUND (array, 2), UBOUND (array, 2), 1 > + do k=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (k, j,i) = counter > + counter = counter + 1 > + end do > + end do > + end do > + end subroutine fill_array_3d > + > + ! Fill a 4D array with a unique positive integer in each element. > + subroutine fill_array_4d (array) > + integer, dimension (:,:,:,:) :: array > + integer :: counter > + > + counter = 1 > + do i=LBOUND (array, 4), UBOUND (array, 4), 1 > + do j=LBOUND (array, 3), UBOUND (array, 3), 1 > + do k=LBOUND (array, 2), UBOUND (array, 2), 1 > + do l=LBOUND (array, 1), UBOUND (array, 1), 1 > + array (l, k, j,i) = counter > + counter = counter + 1 > + end do > + end do > + end do > + end do > + print *, "" > + end subroutine fill_array_4d > end program test > diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp > index 04296ac80c9..0ab74fbbe90 100644 > --- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp > +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp > @@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated" > gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" > gdb_test "print sizeof(vla1(3,2,1))" "4" \ > "print sizeof element from allocated vla1" > -gdb_test "print sizeof(vla1(3:4,2,1))" "800" \ > +gdb_test "print sizeof(vla1(3:4,2,1))" "8" \ > "print sizeof sliced vla1" > > # Try to access values in undefined pointer to VLA (dangling) > @@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated" > gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla" > gdb_test "print sizeof(pvla(3,2,1))" "4" \ > "print sizeof element from associated pvla" > -gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla" > +gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla" > > gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"] > gdb_continue_to_breakpoint "vla1-neg-bounds-v1" > -- > 2.25.4 >