From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from simark.ca by simark.ca with LMTP id wLegM7c8pV9AEQAAWB0awg (envelope-from ) for ; Fri, 06 Nov 2020 07:08:23 -0500 Received: by simark.ca (Postfix, from userid 112) id C2ADA1F08B; Fri, 6 Nov 2020 07:08:23 -0500 (EST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on simark.ca X-Spam-Level: X-Spam-Status: No, score=-1.1 required=5.0 tests=DKIM_SIGNED,DKIM_VALID, DKIM_VALID_AU,MAILING_LIST_MULTI,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.2 Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by simark.ca (Postfix) with ESMTPS id C4F841E58F for ; Fri, 6 Nov 2020 07:08:18 -0500 (EST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1EC363857C66; Fri, 6 Nov 2020 12:08:18 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1EC363857C66 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=sourceware.org; s=default; t=1604664498; bh=RA0mS1gIGHeM/t0VbQEt343VacvHIYUdYGXCdaDh/vc=; h=Subject:To:References:Date:In-Reply-To:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To: From; b=nWYjufAiouzuHPY+vMCTMBrB5VHCvsJCsX2//0x+13eNwtOa5eE34QuWNdxtBCIxd HiBRUE7fMxoyCs26Gkw0zqGsHU7vCLEClMJl+wZCHYFG2g38prY7M5c3h8mG2Amj8z Jj9VyDzrag92+8acqdwY6HVGNckJEJRft5ciSdbs= Received: from mail-qk1-x72e.google.com (mail-qk1-x72e.google.com [IPv6:2607:f8b0:4864:20::72e]) by sourceware.org (Postfix) with ESMTPS id D7CBB3857C66 for ; Fri, 6 Nov 2020 12:08:10 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org D7CBB3857C66 Received: by mail-qk1-x72e.google.com with SMTP id x20so790705qkn.1 for ; Fri, 06 Nov 2020 04:08:10 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-language :content-transfer-encoding; bh=RA0mS1gIGHeM/t0VbQEt343VacvHIYUdYGXCdaDh/vc=; b=M+BEOpOLrfP7jzj+nwUbpdB5L8v/l0ueHVKJ214qdp5JbJ62O//7aGxPXMf16JqqJU 9kJNRxszlIx3/LSmgDmEobMazZ3ZoX3M8SAg5JVtYTvg7r++0sh97gLrs9vyQSupVC6s /darNiJAVwiuPEs4hmg848jfYMT/Ga0WgH6IvGouIRTbIReikEc4Fk1oeE9gV2DWIFMj 35yhX8Grov7HtQgHARA8J9jzI7ofUXw7CnriA9bsMla7OmvlRLru0Pqdkm+ExsouKJTS EIqyeCRuvAgb2Dfvrk/C9/bE8QcjSDJhr0ORXjhW7NhbD9LWVeJqh4wFHZFdO5BoAroD CF+Q== X-Gm-Message-State: AOAM531S3MAKNM5+gcKdCnqG6DTcHVosGNBM7VvgaXP943l3aGIRZoqq +ob/NfwkU/PJkwtjjHniNunEUshIxXfSAA== X-Google-Smtp-Source: ABdhPJyXqhd1dU+TmlojIW8E+/mVsjkwHW4ZQf/JfcRlmIhx+uxb+Ny0ioy2FsFBjqWRedALtqGwCA== X-Received: by 2002:ae9:e210:: with SMTP id c16mr1067410qkc.314.1604664489012; Fri, 06 Nov 2020 04:08:09 -0800 (PST) Received: from ?IPv6:2804:7f0:8284:1487:7cad:cc8d:f1fd:af23? ([2804:7f0:8284:1487:7cad:cc8d:f1fd:af23]) by smtp.gmail.com with ESMTPSA id h20sm338185qkh.114.2020.11.06.04.08.06 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 06 Nov 2020 04:08:07 -0800 (PST) Subject: Re: [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal To: Tom Tromey , gdb-patches@sourceware.org References: <20200930200600.1207702-1-tromey@adacore.com> <20200930200600.1207702-4-tromey@adacore.com> Message-ID: Date: Fri, 6 Nov 2020 09:08:04 -0300 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.10.0 MIME-Version: 1.0 In-Reply-To: <20200930200600.1207702-4-tromey@adacore.com> Content-Type: text/plain; charset=utf-8; format=flowed Content-Language: en-US Content-Transfer-Encoding: 7bit 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: , From: Luis Machado via Gdb-patches Reply-To: Luis Machado Errors-To: gdb-patches-bounces@sourceware.org Sender: "Gdb-patches" Hi, I bisected a few regressions on aarch64-linux to this commit: FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three FAIL: gdb.dwarf2/data-loc.exp: print foo.three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five FAIL: gdb.dwarf2/data-loc.exp: ptype foo.array_type FAIL: gdb.dwarf2/data-loc.exp: print foo.five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five_tdef FAIL: gdb.dwarf2/data-loc.exp: print foo__three FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three FAIL: gdb.dwarf2/data-loc.exp: print foo__three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three_tdef FAIL: gdb.dwarf2/data-loc.exp: print foo__five FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five FAIL: gdb.dwarf2/data-loc.exp: print foo__five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__array_type === gdb Summary === # of expected passes 34 # of unexpected failures 16 -- The failures look like the following: -- ptype foo.three^M type = array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three print foo.three_tdef^M $8 = (foo.array_type) 0xaaaaaaabb010 ^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo.three_tdef ptype foo.three_tdef^M type = access array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three_tdef ptype foo.five^M type = array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five ptype foo.array_type^M type = access array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.array_type print foo.five_tdef^M $24 = (foo.array_type) 0xaaaaaaabb028 ^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo.five_tdef ptype foo.five_tdef^M type = access array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five_tdef print foo__three^M $33 = {P_ARRAY = 0xaaaaaaabb010 , P_BOUNDS = 0xaaaaaaabb020 }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__three ptype foo__three^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three print foo__three_tdef^M $34 = {P_ARRAY = 0xaaaaaaabb010 , P_BOUNDS = 0xaaaaaaabb020 }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__three_tdef ptype foo__three_tdef^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three_tdef print foo__five^M $35 = {P_ARRAY = 0xaaaaaaabb028 , P_BOUNDS = 0xaaaaaaabb040 }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__five ptype foo__five^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five print foo__five_tdef^M $36 = {P_ARRAY = 0xaaaaaaabb028 , P_BOUNDS = 0xaaaaaaabb040 }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__five_tdef ptype foo__five_tdef^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five_tdef ptype foo__array_type^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__array_type -- Could you please take a look? On 9/30/20 5:05 PM, Tom Tromey wrote: > When -fgnat-encodings=minimal, the compiler will avoid the special > GNAT-specific "encodings" format, and instead emit ordinary DWARF as > much as possible. > > When emitting DWARF for thick pointers to arrays, the compiler emits > something like: > > <1><11db>: Abbrev Number: 7 (DW_TAG_array_type) > <11dc> DW_AT_name : (indirect string, offset: 0x1bb8): string > <11e0> DW_AT_data_location: 2 byte block: 97 6 > (DW_OP_push_object_address; DW_OP_deref) > <11e3> DW_AT_type : <0x1173> > <11e7> DW_AT_sibling : <0x1201> > <2><11eb>: Abbrev Number: 8 (DW_TAG_subrange_type) > <11ec> DW_AT_type : <0x1206> > <11f0> DW_AT_lower_bound : 6 byte block: 97 23 8 6 94 4 > (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > DW_OP_deref_size: 4) > <11f7> DW_AT_upper_bound : 8 byte block: 97 23 8 6 23 4 94 4 > (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) > > If you read between the lines, the "array" is actually a structure > with two elements. One element is a pointer to the array data, and > the other structure describes the bounds of the array. However, the > compiler doesn't emit this explicitly, but instead hides it behind > these location expressions. > > gdb can print such objects, but currently there is no way to construct > one. So, this patch adds some code to the DWARF reader to recognize > this construct, and then synthesize an array descriptor. This > descriptor is then handled by the existing Ada code. > > Internally, we've modified GCC to emit the structure type explicitly > (we will of course be sending this upstream). In this case, the array > still has the DW_AT_data_location, though. This patch also modifies > gdb to ignore the data location in this case -- this is preferred > because the location only serves to confuse the Ada code that already > knows where to find the data. In the future I hope to move some of > this handling to the gdb core, so that Ada-specific hacks are not > needed; however I have not yet done this. > > Because parallel types are not emitted with -fgnat-encodings=minimal, > some changes to the Ada code were also required. > > The change ina ada-valprint.c was needed to avoid infinite recursion > when trying to print a constrained packed array. And, there didn't > seem to be any need for a recursive call here -- the value could > simply be returned instead. > > Finally, gdb.ada/frame_arg_lang.exp no longer works in C mode, because > we drop back to the structure approach now. As mentioned earlier, > future work should probably fix this again; meanwhile, this doesn't > seem to be a big problem, because it is what is currently done (users > as a rule don't use -fgnat-encodings=minimal -- which is what I am > ultimately trying to fix). > > Note that a couple of tests have an added KFAIL. Some > -fgnat-encodings=minimal changes have landed in GNAT, and you need > something very recent to pass all the tests. I'm using git gcc to > accomplish this. > > gdb/ChangeLog > 2020-09-30 Tom Tromey > > * dwarf2/read.c (recognize_bound_expression) > (quirk_ada_thick_pointer): New functions. > (read_array_type): Call quirk_ada_thick_pointer. > (set_die_type): Add "skip_data_location" parameter. > (quirk_ada_thick_pointer): New function. > (process_structure_scope): Call quirk_ada_thick_pointer. > * ada-lang.c (ada_is_unconstrained_packed_array_type) > (decode_packed_array_bitsize): Handle thick pointers without > parallel types. > (ada_is_gnat_encoded_packed_array_type): Rename from > ada_is_packed_array_type. > (ada_is_constrained_packed_array_type): Update. > * ada-valprint.c (ada_val_print_gnat_array): Remove. > (ada_value_print_1): Use ada_get_decoded_value. > > gdb/testsuite/ChangeLog > 2020-09-30 Tom Tromey > > * gdb.ada/O2_float_param.exp: Test different -fgnat-encodings > values. > * gdb.ada/access_to_unbounded_array.exp: Test different > -fgnat-encodings values. > * gdb.ada/big_packed_array.exp: Test different -fgnat-encodings > values. > * gdb.ada/arr_enum_idx_w_gap.exp: Test different -fgnat-encodings > values. > * gdb.ada/array_ptr_renaming.exp: Test different -fgnat-encodings > values. > * gdb.ada/array_of_variable_length.exp: Test different > -fgnat-encodings values. > * gdb.ada/arrayparam.exp: Test different -fgnat-encodings values. > * gdb.ada/arrayptr.exp: Test different -fgnat-encodings values. > * gdb.ada/frame_arg_lang.exp: Revert -fgnat-encodings=minimal > change. > * gdb.ada/mi_string_access.exp: Test different -fgnat-encodings > values. > * gdb.ada/mod_from_name.exp: Test different -fgnat-encodings values. > * gdb.ada/out_of_line_in_inlined.exp: Test different > -fgnat-encodings values. > * gdb.ada/packed_array.exp: Test different -fgnat-encodings > values. > * gdb.ada/pckd_arr_ren.exp: Test different -fgnat-encodings > values. > * gdb.ada/unc_arr_ptr_in_var_rec.exp: Test different > -fgnat-encodings values. > * gdb.ada/variant_record_packed_array.exp: Test different > -fgnat-encodings values. > --- > gdb/ChangeLog | 17 + > gdb/ada-lang.c | 38 +- > gdb/ada-valprint.c | 46 +-- > gdb/dwarf2/read.c | 328 +++++++++++++++++- > gdb/testsuite/ChangeLog | 32 ++ > gdb/testsuite/gdb.ada/O2_float_param.exp | 20 +- > .../gdb.ada/access_to_unbounded_array.exp | 20 +- > gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp | 26 +- > .../gdb.ada/array_of_variable_length.exp | 52 +-- > gdb/testsuite/gdb.ada/array_ptr_renaming.exp | 36 +- > gdb/testsuite/gdb.ada/arrayparam.exp | 50 +-- > gdb/testsuite/gdb.ada/arrayptr.exp | 46 +-- > gdb/testsuite/gdb.ada/big_packed_array.exp | 24 +- > gdb/testsuite/gdb.ada/frame_arg_lang.exp | 8 +- > gdb/testsuite/gdb.ada/mi_string_access.exp | 74 ++-- > gdb/testsuite/gdb.ada/mod_from_name.exp | 30 +- > .../gdb.ada/out_of_line_in_inlined.exp | 34 +- > gdb/testsuite/gdb.ada/packed_array.exp | 55 +-- > gdb/testsuite/gdb.ada/pckd_arr_ren.exp | 26 +- > .../gdb.ada/unc_arr_ptr_in_var_rec.exp | 92 ++--- > .../gdb.ada/variant_record_packed_array.exp | 66 ++-- > 21 files changed, 785 insertions(+), 335 deletions(-) > > diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c > index 624e4ad702b..c7eabbef2ae 100644 > --- a/gdb/ada-lang.c > +++ b/gdb/ada-lang.c > @@ -170,8 +170,6 @@ static long decode_packed_array_bitsize (struct type *); > > static struct value *decode_constrained_packed_array (struct value *); > > -static int ada_is_packed_array_type (struct type *); > - > static int ada_is_unconstrained_packed_array_type (struct type *); > > static struct value *value_subscript_packed (struct value *, int, > @@ -1983,7 +1981,7 @@ ada_coerce_to_simple_array_type (struct type *type) > /* Non-zero iff TYPE represents a standard GNAT packed-array type. */ > > static int > -ada_is_packed_array_type (struct type *type) > +ada_is_gnat_encoded_packed_array_type (struct type *type) > { > if (type == NULL) > return 0; > @@ -2000,7 +1998,7 @@ ada_is_packed_array_type (struct type *type) > int > ada_is_constrained_packed_array_type (struct type *type) > { > - return ada_is_packed_array_type (type) > + return ada_is_gnat_encoded_packed_array_type (type) > && !ada_is_array_descriptor_type (type); > } > > @@ -2010,8 +2008,26 @@ ada_is_constrained_packed_array_type (struct type *type) > static int > ada_is_unconstrained_packed_array_type (struct type *type) > { > - return ada_is_packed_array_type (type) > - && ada_is_array_descriptor_type (type); > + if (!ada_is_array_descriptor_type (type)) > + return 0; > + > + if (ada_is_gnat_encoded_packed_array_type (type)) > + return 1; > + > + /* If we saw GNAT encodings, then the above code is sufficient. > + However, with minimal encodings, we will just have a thick > + pointer instead. */ > + if (is_thick_pntr (type)) > + { > + type = desc_base_type (type); > + /* The structure's first field is a pointer to an array, so this > + fetches the array type. */ > + type = TYPE_TARGET_TYPE (type->field (0).type ()); > + /* Now we can see if the array elements are packed. */ > + return TYPE_FIELD_BITSIZE (type, 0) > 0; > + } > + > + return 0; > } > > /* Given that TYPE encodes a packed array type (constrained or unconstrained), > @@ -2038,7 +2054,15 @@ decode_packed_array_bitsize (struct type *type) > return 0; > > tail = strstr (raw_name, "___XP"); > - gdb_assert (tail != NULL); > + if (tail == nullptr) > + { > + gdb_assert (is_thick_pntr (type)); > + /* The structure's first field is a pointer to an array, so this > + fetches the array type. */ > + type = TYPE_TARGET_TYPE (type->field (0).type ()); > + /* Now we can see if the array elements are packed. */ > + return TYPE_FIELD_BITSIZE (type, 0); > + } > > if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1) > { > diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c > index 3616711ef09..29cc6cee653 100644 > --- a/gdb/ada-valprint.c > +++ b/gdb/ada-valprint.c > @@ -711,36 +711,6 @@ ada_val_print_string (struct type *type, const gdb_byte *valaddr, > eltlen, options); > } > > -/* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers, > - thin pointers, etc). */ > - > -static void > -ada_val_print_gnat_array (struct value *val, > - struct ui_file *stream, int recurse, > - const struct value_print_options *options) > -{ > - scoped_value_mark free_values; > - > - struct type *type = ada_check_typedef (value_type (val)); > - > - /* If this is a reference, coerce it now. This helps taking care > - of the case where ADDRESS is meaningless because original_value > - was not an lval. */ > - val = coerce_ref (val); > - if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */ > - val = ada_coerce_to_simple_array_ptr (val); > - else > - val = ada_coerce_to_simple_array (val); > - if (val == NULL) > - { > - gdb_assert (type->code () == TYPE_CODE_TYPEDEF); > - fprintf_filtered (stream, "0x0"); > - } > - else > - common_val_print (val, stream, recurse, options, > - language_def (language_ada)); > -} > - > /* Implement Ada value_print'ing for the case where TYPE is a > TYPE_CODE_PTR. */ > > @@ -1028,11 +998,21 @@ ada_value_print_1 (struct value *val, struct ui_file *stream, int recurse, > || (ada_is_constrained_packed_array_type (type) > && type->code () != TYPE_CODE_PTR)) > { > - ada_val_print_gnat_array (val, stream, recurse, options); > - return; > + /* If this is a reference, coerce it now. This helps taking > + care of the case where ADDRESS is meaningless because > + original_value was not an lval. */ > + val = coerce_ref (val); > + val = ada_get_decoded_value (val); > + if (val == nullptr) > + { > + gdb_assert (type->code () == TYPE_CODE_TYPEDEF); > + fprintf_filtered (stream, "0x0"); > + return; > + } > } > + else > + val = ada_to_fixed_value (val); > > - val = ada_to_fixed_value (val); > type = value_type (val); > struct type *saved_type = type; > > diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c > index c0a89ecbe1e..e3e68fc1f29 100644 > --- a/gdb/dwarf2/read.c > +++ b/gdb/dwarf2/read.c > @@ -1373,6 +1373,9 @@ static void dwarf2_const_value_attr (const struct attribute *attr, > const gdb_byte **bytes, > struct dwarf2_locexpr_baton **baton); > > +static struct type *read_subrange_index_type (struct die_info *die, > + struct dwarf2_cu *cu); > + > static struct type *die_type (struct die_info *, struct dwarf2_cu *); > > static int need_gnat_info (struct dwarf2_cu *); > @@ -1598,7 +1601,7 @@ static void prepare_one_comp_unit (struct dwarf2_cu *cu, > enum language pretend_language); > > static struct type *set_die_type (struct die_info *, struct type *, > - struct dwarf2_cu *); > + struct dwarf2_cu *, bool = false); > > static void create_all_comp_units (dwarf2_per_objfile *per_objfile); > > @@ -15825,6 +15828,48 @@ quirk_gcc_member_function_pointer (struct type *type, struct objfile *objfile) > smash_to_methodptr_type (type, new_type); > } > > +/* While some versions of GCC will generate complicated DWARF for an > + array (see quirk_ada_thick_pointer), more recent versions were > + modified to emit an explicit thick pointer structure. However, in > + this case, the array still has DWARF expressions for its ranges, > + and these must be ignored. */ > + > +static void > +quirk_ada_thick_pointer_struct (struct die_info *die, struct dwarf2_cu *cu, > + struct type *type) > +{ > + gdb_assert (cu->language == language_ada); > + > + /* Check for a structure with two children. */ > + if (type->code () != TYPE_CODE_STRUCT || type->num_fields () != 2) > + return; > + > + /* Check for P_ARRAY and P_BOUNDS members. */ > + if (TYPE_FIELD_NAME (type, 0) == NULL > + || strcmp (TYPE_FIELD_NAME (type, 0), "P_ARRAY") != 0 > + || TYPE_FIELD_NAME (type, 1) == NULL > + || strcmp (TYPE_FIELD_NAME (type, 1), "P_BOUNDS") != 0) > + return; > + > + /* Make sure we're looking at a pointer to an array. */ > + if (type->field (0).type ()->code () != TYPE_CODE_PTR) > + return; > + struct type *ary_type = TYPE_TARGET_TYPE (type->field (0).type ()); > + > + while (ary_type->code () == TYPE_CODE_ARRAY) > + { > + /* The Ada code already knows how to handle these types, so all > + that we need to do is turn the bounds into static bounds. */ > + struct type *index_type = ary_type->index_type (); > + > + index_type->bounds ()->low.set_const_val (1); > + index_type->bounds ()->high.set_const_val (0); > + > + /* Handle multi-dimensional arrays. */ > + ary_type = TYPE_TARGET_TYPE (ary_type); > + } > +} > + > /* If the DIE has a DW_AT_alignment attribute, return its value, doing > appropriate error checking and issuing complaints if there is a > problem. */ > @@ -16400,6 +16445,8 @@ process_structure_scope (struct die_info *die, struct dwarf2_cu *cu) > quirk_gcc_member_function_pointer (type, objfile); > if (cu->language == language_rust && die->tag == DW_TAG_union_type) > cu->rust_unions.push_back (type); > + else if (cu->language == language_ada) > + quirk_ada_thick_pointer_struct (die, cu, type); > > /* NOTE: carlton/2004-03-16: GCC 3.4 (or at least one of its > snapshots) has been known to create a die giving a declaration > @@ -16696,6 +16743,263 @@ process_enumeration_scope (struct die_info *die, struct dwarf2_cu *cu) > new_symbol (die, this_type, cu); > } > > +/* Helper function for quirk_ada_thick_pointer that examines a bounds > + expression for an index type and finds the corresponding field > + offset in the hidden "P_BOUNDS" structure. Returns true on success > + and updates *FIELD, false if it fails to recognize an > + expression. */ > + > +static bool > +recognize_bound_expression (struct die_info *die, enum dwarf_attribute name, > + int *bounds_offset, struct field *field, > + struct dwarf2_cu *cu) > +{ > + struct attribute *attr = dwarf2_attr (die, name, cu); > + if (attr == nullptr || !attr->form_is_block ()) > + return false; > + > + const struct dwarf_block *block = attr->as_block (); > + const gdb_byte *start = block->data; > + const gdb_byte *end = block->data + block->size; > + > + /* The expression to recognize generally looks like: > + > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) > + > + However, the second "plus_uconst" may be missing: > + > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_deref_size: 4) > + > + This happens when the field is at the start of the structure. > + > + Also, the final deref may not be sized: > + > + (DW_OP_push_object_address; DW_OP_plus_uconst: 4; DW_OP_deref; > + DW_OP_deref) > + > + This happens when the size of the index type happens to be the > + same as the architecture's word size. This can occur with or > + without the second plus_uconst. */ > + > + if (end - start < 2) > + return false; > + if (*start++ != DW_OP_push_object_address) > + return false; > + if (*start++ != DW_OP_plus_uconst) > + return false; > + > + uint64_t this_bound_off; > + start = gdb_read_uleb128 (start, end, &this_bound_off); > + if (start == nullptr || (int) this_bound_off != this_bound_off) > + return false; > + /* Update *BOUNDS_OFFSET if needed, or alternatively verify that it > + is consistent among all bounds. */ > + if (*bounds_offset == -1) > + *bounds_offset = this_bound_off; > + else if (*bounds_offset != this_bound_off) > + return false; > + > + if (start == end || *start++ != DW_OP_deref) > + return false; > + > + int offset = 0; > + if (start ==end) > + return false; > + else if (*start == DW_OP_deref_size || *start == DW_OP_deref) > + { > + /* This means an offset of 0. */ > + } > + else if (*start++ != DW_OP_plus_uconst) > + return false; > + else > + { > + /* The size is the parameter to DW_OP_plus_uconst. */ > + uint64_t val; > + start = gdb_read_uleb128 (start, end, &val); > + if (start == nullptr) > + return false; > + if ((int) val != val) > + return false; > + offset = val; > + } > + > + if (start == end) > + return false; > + > + uint64_t size; > + if (*start == DW_OP_deref_size) > + { > + start = gdb_read_uleb128 (start + 1, end, &size); > + if (start == nullptr) > + return false; > + } > + else if (*start == DW_OP_deref) > + { > + size = cu->header.addr_size; > + ++start; > + } > + else > + return false; > + > + SET_FIELD_BITPOS (*field, 8 * offset); > + if (size != TYPE_LENGTH (field->type ())) > + FIELD_BITSIZE (*field) = 8 * size; > + > + return true; > +} > + > +/* With -fgnat-encodings=minimal, gcc will emit some unusual DWARF for > + some kinds of Ada arrays: > + > + <1><11db>: Abbrev Number: 7 (DW_TAG_array_type) > + <11dc> DW_AT_name : (indirect string, offset: 0x1bb8): string > + <11e0> DW_AT_data_location: 2 byte block: 97 6 > + (DW_OP_push_object_address; DW_OP_deref) > + <11e3> DW_AT_type : <0x1173> > + <11e7> DW_AT_sibling : <0x1201> > + <2><11eb>: Abbrev Number: 8 (DW_TAG_subrange_type) > + <11ec> DW_AT_type : <0x1206> > + <11f0> DW_AT_lower_bound : 6 byte block: 97 23 8 6 94 4 > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_deref_size: 4) > + <11f7> DW_AT_upper_bound : 8 byte block: 97 23 8 6 23 4 94 4 > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) > + > + This actually represents a "thick pointer", which is a structure > + with two elements: one that is a pointer to the array data, and one > + that is a pointer to another structure; this second structure holds > + the array bounds. > + > + This returns a new type on success, or nullptr if this didn't > + recognize the type. */ > + > +static struct type * > +quirk_ada_thick_pointer (struct die_info *die, struct dwarf2_cu *cu, > + struct type *type) > +{ > + struct attribute *attr = dwarf2_attr (die, DW_AT_data_location, cu); > + /* So far we've only seen this with block form. */ > + if (attr == nullptr || !attr->form_is_block ()) > + return nullptr; > + > + /* Note that this will fail if the structure layout is changed by > + the compiler. However, we have no good way to recognize some > + other layout, because we don't know what expression the compiler > + might choose to emit should this happen. */ > + struct dwarf_block *blk = attr->as_block (); > + if (blk->size != 2 > + || blk->data[0] != DW_OP_push_object_address > + || blk->data[1] != DW_OP_deref) > + return nullptr; > + > + int bounds_offset = -1; > + int max_align = -1; > + std::vector range_fields; > + for (struct die_info *child_die = die->child; > + child_die; > + child_die = child_die->sibling) > + { > + if (child_die->tag == DW_TAG_subrange_type) > + { > + struct type *underlying = read_subrange_index_type (child_die, cu); > + > + int this_align = type_align (underlying); > + if (this_align > max_align) > + max_align = this_align; > + > + range_fields.emplace_back (); > + range_fields.emplace_back (); > + > + struct field &lower = range_fields[range_fields.size () - 2]; > + struct field &upper = range_fields[range_fields.size () - 1]; > + > + lower.set_type (underlying); > + FIELD_ARTIFICIAL (lower) = 1; > + > + upper.set_type (underlying); > + FIELD_ARTIFICIAL (upper) = 1; > + > + if (!recognize_bound_expression (child_die, DW_AT_lower_bound, > + &bounds_offset, &lower, cu) > + || !recognize_bound_expression (child_die, DW_AT_upper_bound, > + &bounds_offset, &upper, cu)) > + return nullptr; > + } > + } > + > + /* This shouldn't really happen, but double-check that we found > + where the bounds are stored. */ > + if (bounds_offset == -1) > + return nullptr; > + > + struct objfile *objfile = cu->per_objfile->objfile; > + for (int i = 0; i < range_fields.size (); i += 2) > + { > + char name[20]; > + > + /* Set the name of each field in the bounds. */ > + xsnprintf (name, sizeof (name), "LB%d", i / 2); > + FIELD_NAME (range_fields[i]) = objfile->intern (name); > + xsnprintf (name, sizeof (name), "UB%d", i / 2); > + FIELD_NAME (range_fields[i + 1]) = objfile->intern (name); > + } > + > + struct type *bounds = alloc_type (objfile); > + bounds->set_code (TYPE_CODE_STRUCT); > + > + bounds->set_num_fields (range_fields.size ()); > + bounds->set_fields > + ((struct field *) TYPE_ALLOC (bounds, (bounds->num_fields () > + * sizeof (struct field)))); > + memcpy (bounds->fields (), range_fields.data (), > + bounds->num_fields () * sizeof (struct field)); > + > + int last_fieldno = range_fields.size () - 1; > + int bounds_size = (TYPE_FIELD_BITPOS (bounds, last_fieldno) / 8 > + + TYPE_LENGTH (bounds->field (last_fieldno).type ())); > + TYPE_LENGTH (bounds) = align_up (bounds_size, max_align); > + > + /* Rewrite the existing array type in place. Specifically, we > + remove any dynamic properties we might have read, and we replace > + the index types. */ > + struct type *iter = type; > + for (int i = 0; i < range_fields.size (); i += 2) > + { > + gdb_assert (iter->code () == TYPE_CODE_ARRAY); > + iter->main_type->dyn_prop_list = nullptr; > + iter->set_index_type > + (create_static_range_type (NULL, bounds->field (i).type (), 1, 0)); > + iter = TYPE_TARGET_TYPE (iter); > + } > + > + struct type *result = alloc_type (objfile); > + result->set_code (TYPE_CODE_STRUCT); > + > + result->set_num_fields (2); > + result->set_fields > + ((struct field *) TYPE_ZALLOC (result, (result->num_fields () > + * sizeof (struct field)))); > + > + /* The names are chosen to coincide with what the compiler does with > + -fgnat-encodings=all, which the Ada code in gdb already > + understands. */ > + TYPE_FIELD_NAME (result, 0) = "P_ARRAY"; > + result->field (0).set_type (lookup_pointer_type (type)); > + > + TYPE_FIELD_NAME (result, 1) = "P_BOUNDS"; > + result->field (1).set_type (lookup_pointer_type (bounds)); > + SET_FIELD_BITPOS (result->field (1), 8 * bounds_offset); > + > + result->set_name (type->name ()); > + TYPE_LENGTH (result) = (TYPE_LENGTH (result->field (0).type ()) > + + TYPE_LENGTH (result->field (1).type ())); > + > + return result; > +} > + > /* Extract all information from a DW_TAG_array_type DIE and put it in > the DIE's type field. For now, this only handles one dimensional > arrays. */ > @@ -16825,8 +17129,16 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu) > > maybe_set_alignment (cu, die, type); > > + struct type *replacement_type = nullptr; > + if (cu->language == language_ada) > + { > + replacement_type = quirk_ada_thick_pointer (die, cu, type); > + if (replacement_type != nullptr) > + type = replacement_type; > + } > + > /* Install the type in the die. */ > - set_die_type (die, type, cu); > + set_die_type (die, type, cu, replacement_type != nullptr); > > /* set_die_type should be already done. */ > set_descriptive_type (type, die, cu); > @@ -24400,7 +24712,8 @@ per_cu_offset_and_type_eq (const void *item_lhs, const void *item_rhs) > * Make the type as complete as possible before fetching more types. */ > > static struct type * > -set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) > +set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu, > + bool skip_data_location) > { > dwarf2_per_objfile *per_objfile = cu->per_objfile; > struct dwarf2_per_cu_offset_and_type **slot, ofs; > @@ -24443,9 +24756,12 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) > } > > /* Read DW_AT_data_location and set in type. */ > - attr = dwarf2_attr (die, DW_AT_data_location, cu); > - if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ())) > - type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop); > + if (!skip_data_location) > + { > + attr = dwarf2_attr (die, DW_AT_data_location, cu); > + if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ())) > + type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop); > + } > > if (per_objfile->die_type_hash == NULL) > per_objfile->die_type_hash > diff --git a/gdb/testsuite/gdb.ada/O2_float_param.exp b/gdb/testsuite/gdb.ada/O2_float_param.exp > index 09ebeec4059..debc21c407d 100644 > --- a/gdb/testsuite/gdb.ada/O2_float_param.exp > +++ b/gdb/testsuite/gdb.ada/O2_float_param.exp > @@ -19,13 +19,19 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug \ > + optimize=-O2 \ > + additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -runto "increment" > + runto "increment" > > -gdb_test "frame" \ > - "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*" > + gdb_test "frame" \ > + "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*" > +} > diff --git a/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp > index 9830ef732b6..f3fea4abbeb 100644 > --- a/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp > +++ b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp > @@ -19,14 +19,18 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex" > -gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex" > + gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex" > + gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex" > +} > diff --git a/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp b/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp > index f5936df46bb..b3a4c0d3d77 100644 > --- a/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp > +++ b/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp > @@ -19,17 +19,21 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo_q418_043 > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > > -clean_restart ${testfile} > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb] > -if ![runto "foo_q418_043.adb:$bp_location" ] then { > - perror "Couldn't run ${testfile}" > - return > -} > + clean_restart ${testfile} > > -gdb_test "print A" \ > - " = \\(42, 42\\)" > + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb] > + if ![runto "foo_q418_043.adb:$bp_location" ] then { > + perror "Couldn't run ${testfile}" > + return > + } > + > + gdb_test "print A" \ > + " = \\(42, 42\\)" > +} > diff --git a/gdb/testsuite/gdb.ada/array_of_variable_length.exp b/gdb/testsuite/gdb.ada/array_of_variable_length.exp > index 9eb67776299..af9cb6f9d0d 100644 > --- a/gdb/testsuite/gdb.ada/array_of_variable_length.exp > +++ b/gdb/testsuite/gdb.ada/array_of_variable_length.exp > @@ -19,28 +19,32 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { > - return -1 > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > + > + clean_restart ${testfile} > + > + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > + > + # Pck.A is an array that embeds elements with variable size so compilers will > + # emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch > + # individual elements. Array stride is also a way to describe packed arrays: > + # make sure we do not consider Pck.A as a packed array. > + gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type" > + > + # Make sure this also works with a type from a fully evaluated value. During > + # evaluation, dynamic types can be "resolved" so GDB internals could "forget" > + # that elements have variable size. Fortunately, type resolution of array > + # elements happens only when processing individual elements (i.e. the resolved > + # array type is still associated to the dynamic element type), so the following > + # is supposed to work. > + gdb_test "print pck.a" \ > + "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)" > + gdb_test "ptype $"\ > + "array \\(1 \\.\\. 2\\) of pck\\.r_type" > } > - > -clean_restart ${testfile} > - > -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > - > -# Pck.A is an array that embeds elements with variable size so compilers will > -# emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch > -# individual elements. Array stride is also a way to describe packed arrays: > -# make sure we do not consider Pck.A as a packed array. > -gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type" > - > -# Make sure this also works with a type from a fully evaluated value. During > -# evaluation, dynamic types can be "resolved" so GDB internals could "forget" > -# that elements have variable size. Fortunately, type resolution of array > -# elements happens only when processing individual elements (i.e. the resolved > -# array type is still associated to the dynamic element type), so the following > -# is supposed to work. > -gdb_test "print pck.a" \ > - "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)" > -gdb_test "ptype $"\ > - "array \\(1 \\.\\. 2\\) of pck\\.r_type" > diff --git a/gdb/testsuite/gdb.ada/array_ptr_renaming.exp b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp > index 4355508a2f5..81c1a390d23 100644 > --- a/gdb/testsuite/gdb.ada/array_ptr_renaming.exp > +++ b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp > @@ -19,23 +19,27 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print nt" " = \\(10, 20\\)" > -gdb_test "print nt(1)" " = 10" > + gdb_test "print nt" " = \\(10, 20\\)" > + gdb_test "print nt(1)" " = 10" > > -# Accesses to arrays and unconstrained arrays have the same runtime > -# representation with GNAT (fat pointers). In this case, GDB "forgets" that > -# it's dealing with an access and prints directly the array contents. This > -# should be fixed some day. > -setup_kfail "gdb/25883" *-*-* > -gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*" > -gdb_test "print ntp.all" " = \\(3 => 30, 40\\)" > -gdb_test "print ntp(3)" " = 30" > + # Accesses to arrays and unconstrained arrays have the same runtime > + # representation with GNAT (fat pointers). In this case, GDB "forgets" that > + # it's dealing with an access and prints directly the array contents. This > + # should be fixed some day. > + setup_kfail "gdb/25883" *-*-* > + gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*" > + gdb_test "print ntp.all" " = \\(3 => 30, 40\\)" > + gdb_test "print ntp(3)" " = 30" > +} > diff --git a/gdb/testsuite/gdb.ada/arrayparam.exp b/gdb/testsuite/gdb.ada/arrayparam.exp > index dc36499f33d..326c9d4aae8 100644 > --- a/gdb/testsuite/gdb.ada/arrayparam.exp > +++ b/gdb/testsuite/gdb.ada/arrayparam.exp > @@ -19,34 +19,40 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { > - return -1 > -} > +# Note we don't test the "none" (no -fgnat-encodings option) scenario > +# here, because "all" and "minimal" cover the cases, and this way we > +# don't have to update the test when gnat changes its default. > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > > -clean_restart ${testfile} > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + clean_restart ${testfile} > > -# Verify that a call to a function that takes an array as a parameter > -# works without problem. > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print call_me(\"bonjour\")" \ > - "= void" > + # Verify that a call to a function that takes an array as a parameter > + # works without problem. > > -# Verify that the array was passed properly by checking the global > -# variables that Call_Me sets as side-effects. Use the package name to avoid > -# name clash with debug info of system libraries. > + gdb_test "print call_me(\"bonjour\")" \ > + "= void" > > -gdb_test "print pck.first" \ > - "= 98 'b'" \ > - "print first after function call" > + # Verify that the array was passed properly by checking the global > + # variables that Call_Me sets as side-effects. Use the package name to avoid > + # name clash with debug info of system libraries. > > -gdb_test "print pck.last" \ > - "= 114 'r'" \ > - "print last after function call" > + gdb_test "print pck.first" \ > + "= 98 'b'" \ > + "print first after function call" > > -gdb_test "print pck.length" \ > - "= 7" \ > - "print length after function call" > + gdb_test "print pck.last" \ > + "= 114 'r'" \ > + "print last after function call" > > + gdb_test "print pck.length" \ > + "= 7" \ > + "print length after function call" > +} > diff --git a/gdb/testsuite/gdb.ada/arrayptr.exp b/gdb/testsuite/gdb.ada/arrayptr.exp > index 94a5d876bd2..fa84a7a2ff1 100644 > --- a/gdb/testsuite/gdb.ada/arrayptr.exp > +++ b/gdb/testsuite/gdb.ada/arrayptr.exp > @@ -19,36 +19,40 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > -if ![runto "foo.adb:$bp_location" ] then { > - perror "Couldn't run ${testfile}" > - return > -} > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > + if ![runto "foo.adb:$bp_location" ] then { > + perror "Couldn't run ${testfile}" > + return > + } > > -gdb_test "print string_p" \ > - "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+" > + gdb_test "print string_p" \ > + "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+" > > -gdb_test "print string_p(3..4)" "= \"ll\"" > + gdb_test "print string_p(3..4)" "= \"ll\"" > > -gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0" > + gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0" > > -gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+" > + gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+" > > -gdb_test "print arr_ptr(2)" "= 22" > + gdb_test "print arr_ptr(2)" "= 22" > > -gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)" > + gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)" > > -gdb_test "ptype string_access" "= access array \\(<>\\) of character" > + gdb_test "ptype string_access" "= access array \\(<>\\) of character" > > -gdb_test "print pa_ptr.all" \ > - " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)" > + gdb_test "print pa_ptr.all" \ > + " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)" > > -gdb_test "print pa_ptr(3)" " = 30" > + gdb_test "print pa_ptr(3)" " = 30" > > -gdb_test "print pa_ptr.all(3)" " = 30" > + gdb_test "print pa_ptr.all(3)" " = 30" > +} > diff --git a/gdb/testsuite/gdb.ada/big_packed_array.exp b/gdb/testsuite/gdb.ada/big_packed_array.exp > index fe49a1926d6..e24466b9cbe 100644 > --- a/gdb/testsuite/gdb.ada/big_packed_array.exp > +++ b/gdb/testsuite/gdb.ada/big_packed_array.exp > @@ -19,17 +19,21 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo_ra24_010 > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb] > -runto "foo_ra24_010.adb:$bp_location" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb] > + runto "foo_ra24_010.adb:$bp_location" > > -gdb_test "print good" \ > - "= \\(false \\)" \ > + gdb_test "print good" \ > + "= \\(false \\)" \ > > -gdb_test "print bad" \ > - "= \\(false \\)" \ > + gdb_test "print bad" \ > + "= \\(false \\)" > +} > diff --git a/gdb/testsuite/gdb.ada/frame_arg_lang.exp b/gdb/testsuite/gdb.ada/frame_arg_lang.exp > index 9662e359524..9668f0e7d9e 100644 > --- a/gdb/testsuite/gdb.ada/frame_arg_lang.exp > +++ b/gdb/testsuite/gdb.ada/frame_arg_lang.exp > @@ -69,14 +69,8 @@ foreach_with_prefix scenario {all minimal} { > "The current source language is \"c\"." \ > "show language when set to 'c'" > > - # With -fgnat-encodings=minimal, this works properly in C as well. > - if {$scenario == "minimal"} { > - set expected "\"test\"" > - } else { > - set expected "{P_ARRAY = $hex, P_BOUNDS = $hex}" > - } > gdb_test "bt" \ > - "#1 $hex in pck\\.call_me \\(s=$expected\\).*" \ > + "#1 $hex in pck\\.call_me \\(s={P_ARRAY = $hex, P_BOUNDS = $hex}\\).*" \ > "backtrace with language forced to 'c'" > > gdb_test_no_output "set language auto" \ > diff --git a/gdb/testsuite/gdb.ada/mi_string_access.exp b/gdb/testsuite/gdb.ada/mi_string_access.exp > index 5e07f1ebcc0..0b5ab2dfd04 100644 > --- a/gdb/testsuite/gdb.ada/mi_string_access.exp > +++ b/gdb/testsuite/gdb.ada/mi_string_access.exp > @@ -19,48 +19,52 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile bar > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > > -load_lib mi-support.exp > -set MIFLAGS "-i=mi" > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -gdb_exit > -if [mi_gdb_start] { > - continue > -} > + load_lib mi-support.exp > + set MIFLAGS "-i=mi" > > -mi_delete_breakpoints > -mi_gdb_reinitialize_dir $srcdir/$subdir > -mi_gdb_load ${binfile} > + gdb_exit > + if [mi_gdb_start] { > + continue > + } > > -if ![mi_run_to_main] then { > - fail "cannot run to main, testcase aborted" > - return 0 > -} > + mi_delete_breakpoints > + mi_gdb_reinitialize_dir $srcdir/$subdir > + mi_gdb_load ${binfile} > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] > -mi_continue_to_line \ > - "bar.adb:$bp_location" \ > - "stop at start of main Ada procedure" > + if ![mi_run_to_main] then { > + fail "cannot run to main, testcase aborted" > + return 0 > + } > > -mi_gdb_test "-var-create var1 * Aos" \ > - "\\^done,name=\"var1\",numchild=\"2\",.*" \ > - "Create var1 varobj" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] > + mi_continue_to_line \ > + "bar.adb:$bp_location" \ > + "stop at start of main Ada procedure" > > -mi_gdb_test "-var-list-children 1 var1" \ > - "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ > - "list var1's children" > + mi_gdb_test "-var-create var1 * Aos" \ > + "\\^done,name=\"var1\",numchild=\"2\",.*" \ > + "Create var1 varobj" > > -mi_gdb_test "-var-evaluate-expression var1" \ > - "\\^done,value=\"\\\[2\\\]\"" \ > - "Print var1" > + mi_gdb_test "-var-list-children 1 var1" \ > + "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ > + "list var1's children" > > -mi_gdb_test "-var-evaluate-expression var1.1" \ > - "\\^done,value=\"$hex\"" \ > - "Print var1 first child" > + mi_gdb_test "-var-evaluate-expression var1" \ > + "\\^done,value=\"\\\[2\\\]\"" \ > + "Print var1" > > -mi_gdb_test "-var-evaluate-expression var1.2" \ > - "\\^done,value=\"$hex\"" \ > - "Print var1 second child" > + mi_gdb_test "-var-evaluate-expression var1.1" \ > + "\\^done,value=\"$hex\"" \ > + "Print var1 first child" > + > + mi_gdb_test "-var-evaluate-expression var1.2" \ > + "\\^done,value=\"$hex\"" \ > + "Print var1 second child" > +} > diff --git a/gdb/testsuite/gdb.ada/mod_from_name.exp b/gdb/testsuite/gdb.ada/mod_from_name.exp > index dce0f3ac3a6..fec383bb490 100644 > --- a/gdb/testsuite/gdb.ada/mod_from_name.exp > +++ b/gdb/testsuite/gdb.ada/mod_from_name.exp > @@ -19,17 +19,25 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] > -if ![runto "foo.adb:$bp_location" ] then { > - perror "Couldn't run ${testfile}" > - return > -} > + set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] > + if ![runto "foo.adb:$bp_location" ] then { > + perror "Couldn't run ${testfile}" > + return > + } > > -gdb_test "print xp" \ > - "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)" > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + gdb_test "print xp" \ > + "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)" > +} > diff --git a/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp b/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp > index 684a3699245..7ffb7cb7797 100644 > --- a/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp > +++ b/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp > @@ -19,21 +19,27 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo_o224_021 > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug \ > + optimize=-O2 \ > + additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -gdb_test "break foo_o224_021.child1.child2" \ > - "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+." > + gdb_test "break foo_o224_021.child1.child2" \ > + "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+." > > -gdb_run_cmd > -gdb_test "" \ > - "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" > + gdb_run_cmd > + gdb_test "" \ > + "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" > > -set opt_addr_in "($hex in)?" > -gdb_test "bt" \ > - [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \ > - "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \ > - "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ] > + set opt_addr_in "($hex in)?" > + gdb_test "bt" \ > + [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \ > + "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \ > + "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ] > +} > diff --git a/gdb/testsuite/gdb.ada/packed_array.exp b/gdb/testsuite/gdb.ada/packed_array.exp > index 0928b1b3646..96613183f69 100644 > --- a/gdb/testsuite/gdb.ada/packed_array.exp > +++ b/gdb/testsuite/gdb.ada/packed_array.exp > @@ -19,39 +19,42 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile pa > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > > -clean_restart ${testfile} > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/pa.adb] > -runto "pa.adb:$bp_location" > + clean_restart ${testfile} > > -gdb_test "print var" \ > - "= \\(4 => true, false, true, false, true\\)" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/pa.adb] > + runto "pa.adb:$bp_location" > > -# Try printing the value and the type definition of a reference > -# to variable "Var". > + gdb_test "print var" \ > + "= \\(4 => true, false, true, false, true\\)" > > -gdb_test "ptype &var" \ > - "type = access array \\(4 \\.\\. 8\\) of boolean " > + # Try printing the value and the type definition of a reference > + # to variable "Var". > > -gdb_test "print &var" \ > - "= \\(access pa.packed_array\\) 0x.*" > + gdb_test "ptype &var" \ > + "type = access array \\(4 \\.\\. 8\\) of boolean " > > -# Print the value of U_Var, an unconstrainted packed array. > + gdb_test "print &var" \ > + "= \\(access pa.packed_array\\) 0x.*" > > -set test "print u_var" > -gdb_test_multiple "$test" "$test" { > - -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > - } > - -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" { > - # The compiler forgot to emit the packed array's ___XA type, > - # preventing us from determining the what the array bounds > - # are. Observed with (FSF GNU Ada 4.5.3 20110124). > - xfail $test > + # Print the value of U_Var, an unconstrainted packed array. > + > + set test "print u_var" > + gdb_test_multiple "$test" "$test" { > + -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" { > + # The compiler forgot to emit the packed array's ___XA type, > + # preventing us from determining the what the array bounds > + # are. Observed with (FSF GNU Ada 4.5.3 20110124). > + xfail $test > + } > } > } > - > diff --git a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp > index d41de442b5d..13e599b6a58 100644 > --- a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp > +++ b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp > @@ -19,15 +19,23 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print A2" \ > - "= (\\s*)?\\(false, false\\)" \ > - "print var" > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + gdb_test "print A2" \ > + "= (\\s*)?\\(false, false\\)" \ > + "print var" > +} > diff --git a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp > index f7f3485161d..a7fd4655d48 100644 > --- a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp > +++ b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp > @@ -19,68 +19,72 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -# Print My_Object and My_Object.Ptr when Ptr is null... > + # Print My_Object and My_Object.Ptr when Ptr is null... > > -gdb_test "print my_object" \ > - "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > - "print My_Object with null Ptr" > + gdb_test "print my_object" \ > + "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > + "print My_Object with null Ptr" > > -gdb_test "print my_object.ptr" \ > - "= \\(foo.table_access\\) 0x0" \ > - "print My_Object.Ptr when null" > + gdb_test "print my_object.ptr" \ > + "= \\(foo.table_access\\) 0x0" \ > + "print My_Object.Ptr when null" > > -# Same for My_P_Object... > + # Same for My_P_Object... > > -gdb_test "print my_p_object" \ > - "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > - "print My_P_Object with null Ptr" > + gdb_test "print my_p_object" \ > + "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > + "print My_P_Object with null Ptr" > > -gdb_test "print my_p_object.ptr" \ > - "\\(foo.p_table_access\\) 0x0" \ > - "print My_P_Object.Ptr when null" > + gdb_test "print my_p_object.ptr" \ > + "\\(foo.p_table_access\\) 0x0" \ > + "print My_P_Object.Ptr when null" > > -# Continue until the Ptr component of both objects get allocated. > + # Continue until the Ptr component of both objects get allocated. > > -set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb] > + set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb] > > -gdb_breakpoint "foo.adb:$bp_location" > + gdb_breakpoint "foo.adb:$bp_location" > > -gdb_test "continue" \ > - "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \ > - "continue to STOP2" > + gdb_test "continue" \ > + "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \ > + "continue to STOP2" > > -# Inspect My_Object again... > + # Inspect My_Object again... > > -gdb_test "print my_object" \ > - "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > - "print my_object after setting Ptr" > + gdb_test "print my_object" \ > + "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > + "print my_object after setting Ptr" > > -gdb_test "print my_object.ptr" \ > - "\\(foo.table_access\\) $hex" \ > - "print my_object.ptr when no longer null" > + gdb_test "print my_object.ptr" \ > + "\\(foo.table_access\\) $hex" \ > + "print my_object.ptr when no longer null" > > -gdb_test "print my_object.ptr.all" \ > - "= \\(13, 21, 34\\)" > + gdb_test "print my_object.ptr.all" \ > + "= \\(13, 21, 34\\)" > > -# Same with My_P_Object... > + # Same with My_P_Object... > > -gdb_test "print my_p_object" \ > - "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > - "print my_p_object after setting Ptr" > + gdb_test "print my_p_object" \ > + "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > + "print my_p_object after setting Ptr" > > -gdb_test "print my_p_object.ptr" \ > - "= \\(foo.p_table_access\\) $hex" \ > - "print My_P_Object.Ptr when no longer null" > + gdb_test "print my_p_object.ptr" \ > + "= \\(foo.p_table_access\\) $hex" \ > + "print My_P_Object.Ptr when no longer null" > > -gdb_test "print my_p_object.ptr.all" \ > - "\\(13, 21, 34\\)" > + gdb_test "print my_p_object.ptr.all" \ > + "\\(13, 21, 34\\)" > > +} > diff --git a/gdb/testsuite/gdb.ada/variant_record_packed_array.exp b/gdb/testsuite/gdb.ada/variant_record_packed_array.exp > index e10c62b7bbf..7f10d3dfc06 100644 > --- a/gdb/testsuite/gdb.ada/variant_record_packed_array.exp > +++ b/gdb/testsuite/gdb.ada/variant_record_packed_array.exp > @@ -19,35 +19,53 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug additional_flags=-fgnat-encodings=$scenario] > > -clean_restart ${testfile} > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + clean_restart ${testfile} > > -set test "print my_buffer" > -gdb_test_multiple "$test" $test { > - -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > - } > - -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > + set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > + > + set test "print my_buffer" > + gdb_test_multiple "$test" $test { > + -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" { > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + fail $test > + } > } > -} > > -gdb_test "print my_buffer'Address" \ > - "= \\(system\\.address\\) $hex" \ > - "print address" > + gdb_test "print my_buffer'Address" \ > + "= \\(system\\.address\\) $hex" \ > + "print address" > > -set test "print {foo.octal_buffer}($)" > -gdb_test_multiple "$test" $test { > - -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > - } > - -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > + set test "print {foo.octal_buffer}($)" > + gdb_test_multiple "$test" $test { > + -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" { > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + fail $test > + } > } > } >