From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-io1-xd2d.google.com (mail-io1-xd2d.google.com [IPv6:2607:f8b0:4864:20::d2d]) by sourceware.org (Postfix) with ESMTPS id 99D4E3858CDA for ; Wed, 16 Aug 2023 17:49:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 99D4E3858CDA Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-io1-xd2d.google.com with SMTP id ca18e2360f4ac-77acb04309dso294393239f.2 for ; Wed, 16 Aug 2023 10:49:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1692208193; x=1692812993; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=1R4lg8mM6CGI6/oxEZehMBsdjA4EXpZ9Cf/mSc4ZqCQ=; b=jMWuamEsDfIxTHk8y1Rq7ZcjbFfyLCk1eU9Uiqay1kKKrIWFOmfp7l/elN1pdGrEG2 0yWXqbB629ib4j5gJn+904hmzR6VN210NWGP1SpjLYd2QC3eWN9HhZBFW5VRlyiMQ9BX nyC6iqKHue8atSFjYJ7CUWL3PDhAgSKkNdFkTr3dG98Jqxe31rNBZ7lsl0yHRQUrojOS OKtxEt2oYh3+ZlRAfN52kDDnHvLWj/0bWJpMx95FbrVgNhN6MdBsj24Io7Hf2O8WmX8U JiuYiqKATdKsL0yFGWV8f+JnG+TDwtmn6NUkoBux3VW74bhBbU/I5rPSvNccqMee+2jL C4IQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1692208193; x=1692812993; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=1R4lg8mM6CGI6/oxEZehMBsdjA4EXpZ9Cf/mSc4ZqCQ=; b=Cen/ZoB4zWsV3RsZDBmGdOdabD/1AnjItAISiLJAjmZsumf3pgJ56pIPOsPntpBn6f JdhwBSWeCy1cPr8VVBSBsx/TEBbtoTgh9D3F8wjZlMW8nwpEYK2gdwkaSlDTo3RuhKcy 3V/87KON9WYd5Bz13TggURgKacoWjXWQzf0LrqVLQm3HoGtCfbfVXjAQ9H8pdObT1Fyv iEpTFEotRnMTu8sweqSDVf7bx98FT0OsvNnnlxgCb+rQ/NRxzQCBGs9TmH3fD4gP5kcY YnaL8A7wQlPVNTh5+qOsh0sWJycbxznysQAHugUd37aGGrWXfCEz2ml2kgPt0ALWjBFq IJJA== X-Gm-Message-State: AOJu0Yw/DuC2rXAfD2gvp1s4K6gJmWE7BpJ5zK64JSEZ8JsXpdYJZr4b wEEyEAT+eJ+KNBGvL0Vc6/UriWCWfQcY8XC+DMAg2w== X-Google-Smtp-Source: AGHT+IFr044SyhWCRG/AK+zIKwDsUWDVhECiCc7Cf7f9ksBjAOpp++JYgJJ6HAix2+DtGHLrA0YSNA== X-Received: by 2002:a5d:9602:0:b0:783:6eef:1496 with SMTP id w2-20020a5d9602000000b007836eef1496mr3930479iol.19.1692208193637; Wed, 16 Aug 2023 10:49:53 -0700 (PDT) Received: from localhost.localdomain (75-166-142-177.hlrn.qwest.net. [75.166.142.177]) by smtp.gmail.com with ESMTPSA id f4-20020a5ec604000000b00786fd8e764bsm4675012iok.0.2023.08.16.10.49.52 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 16 Aug 2023 10:49:53 -0700 (PDT) From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [pushed] Fix obvious bug in aggregate expression Date: Wed, 16 Aug 2023 11:49:38 -0600 Message-Id: <20230816174938.884997-1-tromey@adacore.com> X-Mailer: git-send-email 2.40.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-11.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,KAM_SHORT,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: I found an obvious bug in Ada aggregate expression handling: if (vvo != nullptr) error (_("Invalid record component association.")); name = vvo->get_symbol ()->natural_name (); Here the code errors when vvo is not null -- and then proceeds to use vvo. This hasn't caused a crash because, I believe, there's currently no way to reach this code in the null case. However, I'm not really willing to assert this... Fixing this shows another bug, which is that due to the way the parser works, a field name in an aggregate expression might erroneously be fully qualified if some global variable with the same base name exists. The included test case triggers both bugs. Note that the test includes a confounding case for array aggregates as well, but as these are harder to fix, I've left it as kfail. As this is Ada-specific, and has already been tested internally at AdaCore, I am checking it in. --- gdb/ada-lang.c | 9 +++++- gdb/testsuite/gdb.ada/assoc.exp | 43 ++++++++++++++++++++++++++++ gdb/testsuite/gdb.ada/assoc/main.adb | 22 ++++++++++++++ gdb/testsuite/gdb.ada/assoc/pck.ads | 29 +++++++++++++++++++ gdb/testsuite/gdb.ada/assoc/xtra.adb | 21 ++++++++++++++ gdb/testsuite/gdb.ada/assoc/xtra.ads | 24 ++++++++++++++++ 6 files changed, 147 insertions(+), 1 deletion(-) create mode 100644 gdb/testsuite/gdb.ada/assoc.exp create mode 100644 gdb/testsuite/gdb.ada/assoc/main.adb create mode 100644 gdb/testsuite/gdb.ada/assoc/pck.ads create mode 100644 gdb/testsuite/gdb.ada/assoc/xtra.adb create mode 100644 gdb/testsuite/gdb.ada/assoc/xtra.ads diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 1261ee8fa05..4a9a6e0f38f 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -9575,9 +9575,16 @@ ada_name_association::assign (struct value *container, { ada_var_value_operation *vvo = dynamic_cast (m_val.get ()); - if (vvo != nullptr) + if (vvo == nullptr) error (_("Invalid record component association.")); name = vvo->get_symbol ()->natural_name (); + /* In this scenario, the user wrote (name => expr), but + write_name_assoc found some fully-qualified name and + substituted it. This happens because, at parse time, the + meaning of the expression isn't known; but here we know + that just the base name was supplied and it refers to the + name of a field. */ + name = ada_unqualified_name (name); } index = 0; diff --git a/gdb/testsuite/gdb.ada/assoc.exp b/gdb/testsuite/gdb.ada/assoc.exp new file mode 100644 index 00000000000..9ed1a671816 --- /dev/null +++ b/gdb/testsuite/gdb.ada/assoc.exp @@ -0,0 +1,43 @@ +# Copyright 2023 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 . + +load_lib "ada.exp" + +require allow_ada_tests + +standard_ada_testfile main + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable debug] != ""} { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "BREAK" ${testdir}/main.adb] +runto "main.adb:$bp_location" + +gdb_test_multiple "print pck.value := (Left => 3, Center => 7, Pck.Right => 2)" \ + "assign to value" { + -wrap -re " = \\(3, 7, 2\\)" { + pass $gdb_test_name + } + -wrap -re " = \\(3, 2, 2\\)" { + setup_kfail "aggregate expression bug" *-*-* + fail $gdb_test_name + } + } + +gdb_test "print pck.svalue := (center => 99)" \ + [string_to_regexp " = (center => 99)"] diff --git a/gdb/testsuite/gdb.ada/assoc/main.adb b/gdb/testsuite/gdb.ada/assoc/main.adb new file mode 100644 index 00000000000..3eda932f0c2 --- /dev/null +++ b/gdb/testsuite/gdb.ada/assoc/main.adb @@ -0,0 +1,22 @@ +-- Copyright 2023 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 . + +With Pck; +with Xtra; + +procedure Main is +begin + Xtra.Do_Nothing (Pck.Value); -- BREAK +end Main; diff --git a/gdb/testsuite/gdb.ada/assoc/pck.ads b/gdb/testsuite/gdb.ada/assoc/pck.ads new file mode 100644 index 00000000000..8140beac0b6 --- /dev/null +++ b/gdb/testsuite/gdb.ada/assoc/pck.ads @@ -0,0 +1,29 @@ +-- Copyright 2023 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 . + +package Pck is + type Posn is (Left, Center, Right); + type My_Array is array (Posn) of Integer; + + Value : My_Array := (Left => 1, Center => 2, Right => 3); + + type Structured is + record + Center : Integer; + end record; + + SValue : Structured := (Center => 23); + +end Pck; diff --git a/gdb/testsuite/gdb.ada/assoc/xtra.adb b/gdb/testsuite/gdb.ada/assoc/xtra.adb new file mode 100644 index 00000000000..e0a16c017d0 --- /dev/null +++ b/gdb/testsuite/gdb.ada/assoc/xtra.adb @@ -0,0 +1,21 @@ +-- Copyright 2023 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 . + +package body Xtra is + procedure Do_Nothing (Buffer: in out Pck.My_Array) is + begin + null; + end Do_Nothing; +end Xtra; diff --git a/gdb/testsuite/gdb.ada/assoc/xtra.ads b/gdb/testsuite/gdb.ada/assoc/xtra.ads new file mode 100644 index 00000000000..c42d1972c83 --- /dev/null +++ b/gdb/testsuite/gdb.ada/assoc/xtra.ads @@ -0,0 +1,24 @@ +-- Copyright 2023 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 . + +with Pck; + +package Xtra is + -- Confounding. + Center : Pck.Posn := Pck.Right; + Right : Pck.Posn := Pck.Left; + + procedure Do_Nothing (Buffer: in out Pck.My_Array); +end Xtra; -- 2.40.1