From 3ae7ab999277b5d668d89fed5a7707f7778f5e6b Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Mon, 17 Aug 2020 09:21:40 -0600 Subject: Fix MI crash with Ada string access I happened to notice that using -var-create at a certain spot in an Ada program caused a crash. This happens because ada_get_decoded_value can return NULL -- in particular, deeper in the code it can hit this return in ada_type_of_array: descriptor = desc_bounds (arr); if (value_as_long (descriptor) == 0) return NULL; This patch avoids the crash by handling this NULL return. gdb/ChangeLog 2020-08-17 Tom Tromey * ada-varobj.c (ada_varobj_decode_var): Handle case where ada_get_decoded_value returns NULL. gdb/testsuite/ChangeLog 2020-08-17 Tom Tromey * gdb.ada/mi_var_access.exp: New file. * gdb.ada/mi_var_access/mi_access.adb: New file. * gdb.ada/mi_var_access/pck.adb: New file. * gdb.ada/mi_var_access/pck.ads: New file. --- gdb/ChangeLog | 5 +++ gdb/ada-varobj.c | 8 ++-- gdb/testsuite/ChangeLog | 7 +++ gdb/testsuite/gdb.ada/mi_var_access.exp | 52 +++++++++++++++++++++++ gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb | 37 ++++++++++++++++ gdb/testsuite/gdb.ada/mi_var_access/pck.adb | 26 ++++++++++++ gdb/testsuite/gdb.ada/mi_var_access/pck.ads | 23 ++++++++++ 7 files changed, 154 insertions(+), 4 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/mi_var_access.exp create mode 100644 gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb create mode 100644 gdb/testsuite/gdb.ada/mi_var_access/pck.adb create mode 100644 gdb/testsuite/gdb.ada/mi_var_access/pck.ads diff --git a/gdb/ChangeLog b/gdb/ChangeLog index e15dd15f7be..b097b325a22 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,8 @@ +2020-08-17 Tom Tromey + + * ada-varobj.c (ada_varobj_decode_var): Handle case where + ada_get_decoded_value returns NULL. + 2020-08-17 Tom Tromey * python/py-inferior.c (infpy_search_memory): Use diff --git a/gdb/ada-varobj.c b/gdb/ada-varobj.c index f67fe5002a3..a72653af37a 100644 --- a/gdb/ada-varobj.c +++ b/gdb/ada-varobj.c @@ -63,10 +63,10 @@ static void ada_varobj_decode_var (struct value **value_ptr, struct type **type_ptr) { if (*value_ptr) - { - *value_ptr = ada_get_decoded_value (*value_ptr); - *type_ptr = ada_check_typedef (value_type (*value_ptr)); - } + *value_ptr = ada_get_decoded_value (*value_ptr); + + if (*value_ptr != nullptr) + *type_ptr = ada_check_typedef (value_type (*value_ptr)); else *type_ptr = ada_get_decoded_type (*type_ptr); } diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index f0b7949fd61..9fdbcb8703c 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2020-08-17 Tom Tromey + + * gdb.ada/mi_var_access.exp: New file. + * gdb.ada/mi_var_access/mi_access.adb: New file. + * gdb.ada/mi_var_access/pck.adb: New file. + * gdb.ada/mi_var_access/pck.ads: New file. + 2020-08-16 Tom de Vries PR gdb/25350 diff --git a/gdb/testsuite/gdb.ada/mi_var_access.exp b/gdb/testsuite/gdb.ada/mi_var_access.exp new file mode 100644 index 00000000000..5ffc0ae8772 --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_access.exp @@ -0,0 +1,52 @@ +# 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 . + +load_lib "ada.exp" + +if {[skip_ada_tests]} { + return -1 +} + +standard_ada_testfile mi_access + +load_lib mi-support.exp +set MIFLAGS "-i=mi" + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable debug] != "" } { + return -1 +} + +if {[mi_gdb_start]} { + continue +} + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +if ![mi_run_to_main] then { + fail "cannot run to main, testcase aborted" + return 0 +} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/mi_access.adb] +mi_continue_to_line \ + "mi_access.adb:$bp_location" \ + "stop at start of mi_access" + +# The bug was that creating a varobj for A_String_Access would crash. +mi_gdb_test "-var-create A_String_Access * A_String_Access" \ + "\\^done,name=\"A_String_Access\",numchild=\"1\",.*" \ + "Create varobj" diff --git a/gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb b/gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb new file mode 100644 index 00000000000..d5f5f881463 --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_access/mi_access.adb @@ -0,0 +1,37 @@ +-- 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 . + +with Pck; use Pck; + +procedure Mi_Access is + A_String : String (3 .. 5) := "345"; -- STOP + A_String_Access : String_Access; + A_Pointer : Pointer; +begin + Do_Nothing (A_String'Address); + A_String (4) := '6'; + A_String_Access := Copy (A_String); + A_Pointer.P := A_String_Access; + Do_Nothing (A_String_Access'Address); + A_String_Access (4) := 'a'; + Do_Nothing (A_Pointer'Address); + A_String_Access := Copy("Hi"); + A_Pointer.P := A_String_Access; + Do_Nothing (A_String_Access'Address); + A_String_Access := null; + A_Pointer.P := null; + Do_Nothing (A_Pointer'Address); + Do_Nothing (A_String'Address); +end Mi_Access; diff --git a/gdb/testsuite/gdb.ada/mi_var_access/pck.adb b/gdb/testsuite/gdb.ada/mi_var_access/pck.adb new file mode 100644 index 00000000000..9aff885f65b --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_access/pck.adb @@ -0,0 +1,26 @@ +-- 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 . + +package body Pck is + function Copy (S : String) return String_Access is + begin + return new String'(S); + end Copy; + + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; +end Pck; diff --git a/gdb/testsuite/gdb.ada/mi_var_access/pck.ads b/gdb/testsuite/gdb.ada/mi_var_access/pck.ads new file mode 100644 index 00000000000..307a0aacd6d --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_access/pck.ads @@ -0,0 +1,23 @@ +-- 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 . + +with System; +package Pck is + type String_Access is access all String; + type Pointer is record P : String_Access; end record; + + function Copy (S : String) return String_Access; + procedure Do_Nothing (A : System.Address); +end Pck; -- cgit v1.2.1