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