gdb/testsuite/gdb.ada/arrayptr.exp

   1 # Copyright 2008-2024 Free Software Foundation, Inc.
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 load_lib "ada.exp"
  17
  18 require allow_ada_tests
  19
  20 standard_ada_testfile foo
  21
  22 foreach_gnat_encoding scenario flags {all minimal} {
  23     lappend flags debug
  24
  25     if {[gdb_compile_ada "${srcfile}" "${binfile}-${scenario}" executable $flags] != ""} {
  26         return -1
  27     }
  28
  29     clean_restart ${testfile}-${scenario}
  30
  31     set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
  32     if {![runto "foo.adb:$bp_location"]} {
  33         return
  34     }
  35
  36     gdb_test "print string_p" \
  37         "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+"
  38
  39     gdb_test "print string_p(3..4)" "= \"ll\""
  40
  41     gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0"
  42
  43     gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+"
  44
  45     gdb_test "print arr_ptr(2)" "= 22"
  46
  47     gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)"
  48
  49     gdb_test "ptype arr_ptr" \
  50         [string_to_regexp "type = access array (1 .. 10) of integer"]
  51     gdb_test "ptype arr_ptr.all" \
  52         [string_to_regexp "type = array (1 .. 10) of integer"]
  53
  54     gdb_test "ptype string_access" "= access array \\(<>\\) of character"
  55
  56     # GNAT >= 12.0 has the needed fix here.
  57     set xfail_expected 0
  58     if {$scenario == "minimal" && [gnat_version_compare < 12]} {
  59         set xfail_expected 1
  60     }
  61
  62     gdb_test_multiple "print pa_ptr.all" "" {
  63         -re -wrap " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)" {
  64             pass $gdb_test_name
  65         }
  66         -re -wrap " = \[0-9\]+" {
  67             if { $xfail_expected } {
  68                 xfail $gdb_test_name
  69             } else {
  70                 fail $gdb_test_name
  71             }
  72         }
  73     }
  74
  75     set xfail_cannot_subscript_re \
  76         "cannot subscript or call something of type `foo__packed_array_ptr'"
  77
  78     gdb_test_multiple "print pa_ptr(3)" "" {
  79         -re -wrap " = 30" {
  80             pass $gdb_test_name
  81
  82         }
  83         -re -wrap $xfail_cannot_subscript_re {
  84             if { $xfail_expected } {
  85                 xfail $gdb_test_name
  86             } else {
  87                 fail $gdb_test_name
  88             }
  89         }
  90     }
  91
  92     set xfail_attempt_to_index_re \
  93         "Attempt to index or call something other than an array or function"
  94
  95     gdb_test_multiple "print pa_ptr.all(3)" "" {
  96         -re -wrap " = 30" {
  97             pass $gdb_test_name
  98
  99         }
 100         -re -wrap $xfail_attempt_to_index_re {
 101             if { $xfail_expected } {
 102                 xfail $gdb_test_name
 103             } else {
 104                 fail $gdb_test_name
 105             }
 106         }
 107     }
 108 }