gdb/testsuite/gdb.ada/enum_idx_packed.exp

   1 # Copyright 2012-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     # GNAT 9 and 10 are known to fail.
  32     if {$scenario == "minimal"
  33         && [gnat_version_compare >= 9]
  34         && [gnat_version_compare <= 10]} {
  35         set old_compiler 1
  36     } else {
  37         set old_compiler 0
  38     }
  39
  40     set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
  41     runto "foo.adb:$bp_location"
  42
  43     gdb_test "ptype full" \
  44         "type = array \\(black \\.\\. white\\) of boolean <packed: 1-bit elements>"
  45
  46     gdb_test "print full" " = \\(false, true, false, true, false\\)"
  47
  48     gdb_test "print full'first" " = black"
  49
  50     gdb_test "ptype primary" \
  51         "type = array \\(red \\.\\. blue\\) of boolean <packed: 1-bit elements>"
  52
  53     gdb_test "print primary" " = \\(red => false, true, false\\)"
  54
  55     gdb_test "print primary'first" " = red"
  56
  57     gdb_test "ptype cold" \
  58         "type = array \\(green \\.\\. blue\\) of boolean <packed: 1-bit elements>"
  59
  60     gdb_test "print cold" " = \\(green => false, true\\)"
  61
  62     gdb_test "print cold'first" " = green"
  63
  64     # Note the bounds values are still not correctly displayed.  So we get
  65     # the enum equivalent of "1 .. 0" (empty range) as the array ranges.
  66     # Accept that for now.
  67     # GNAT >= 11.0 has the needed fix here.
  68     if {$old_compiler} {
  69         setup_kfail "minimal encodings" *-*-*
  70     }
  71     gdb_test "ptype small" \
  72         "array \\(red \\.\\. green\\) of boolean <packed: 1-bit elements>"
  73
  74     if {$old_compiler} {
  75         setup_kfail "minimal encodings" *-*-*
  76     }
  77     gdb_test "print small" " = \\(red => false, true\\)"
  78
  79     if {$old_compiler} {
  80         setup_kfail "minimal encodings" *-*-*
  81     }
  82     gdb_test "print small'first" " = red"
  83
  84     if {$old_compiler} {
  85         setup_kfail "minimal encodings" *-*-*
  86     }
  87     gdb_test "ptype multi" \
  88         "array \\(red \\.\\. green, low .. medium\\) of boolean <packed: 1-bit elements>"
  89
  90     if {$old_compiler} {
  91         setup_kfail "minimal encodings" *-*-*
  92     }
  93     gdb_test "print multi" \
  94         " = \\(red => \\(low => true, false\\), \\(low => true, false\\)\\)"
  95
  96     if {$old_compiler} {
  97         setup_kfail "minimal encodings" *-*-*
  98     }
  99     gdb_test "print multi'first" " = red"
 100
 101     set base "\\(true, false, true, false, true, false, true, false, true, false\\)"
 102     set matrix "\\("
 103     foreach x {1 2 3 4 5 6 7} {
 104         if {$x > 1} {
 105             append matrix ", "
 106         }
 107         append matrix $base
 108     }
 109     append matrix "\\)"
 110
 111     if {$old_compiler} {
 112         setup_kfail "minimal encodings" *-*-*
 113     }
 114     gdb_test "print multi_multi" " = \\($matrix, $matrix\\)"
 115     if {$old_compiler} {
 116         setup_kfail "minimal encodings" *-*-*
 117     }
 118     gdb_test "print multi_multi(1,3)" " = $base"
 119     if {$old_compiler} {
 120         setup_kfail "minimal encodings" *-*-*
 121     }
 122     gdb_test "print multi_multi(2)" " = $matrix"
 123
 124     gdb_test "print multi_access.all" \
 125         " = \\(\\(8, 13, 21, 34, 55\\), \\(1, 1, 2, 3, 5\\)\\)"
 126
 127     gdb_test "print confused_array(red, green)" " = 2"
 128     gdb_test "print confused_array(green, red)" " = 6"
 129 }