1 # Copyright 2019-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 # Test ptype of an unchecked union. 17 18 load_lib "ada.exp" 19 20 require allow_ada_tests 21 22 standard_ada_testfile unchecked_union 23 24 proc multi_line_string {str} { 25 set result {} 26 foreach line [split $str \n] { 27 lappend result [string_to_regexp $line] 28 } 29 return [eval multi_line $result] 30 } 31 32 set inner_string { case ? is 33 when 0 => 34 small: range 0 .. 255; 35 second: range 0 .. 255; 36 when ? => 37 bval: range 0 .. 255; 38 when others => 39 large: range 255 .. 510; 40 more: range 255 .. 510; 41 end case; 42 } 43 set inner_full "type = record (?) is\n${inner_string}end record" 44 45 set pair_string { case ? is 46 when ? => 47 field_one: range 0 .. 255; 48 when ? => 49 field_two: range 255 .. 510; 50 end case; 51 } 52 set pair_full "type = record\n${inner_string}${pair_string}end record" 53 54 foreach_with_prefix scenario {none all minimal} { 55 set flags {debug} 56 if {$scenario != "none"} { 57 lappend flags additional_flags=-fgnat-encodings=$scenario 58 } 59 60 if {[gdb_compile_ada "${srcfile}" "${binfile}-${scenario}" executable $flags] != ""} { 61 return -1 62 } 63 64 clean_restart ${testfile}-${scenario} 65 66 set bp_location [gdb_get_line_number "BREAK" ${testdir}/unchecked_union.adb] 67 runto "unchecked_union.adb:$bp_location" 68 69 gdb_test "ptype Pair" [multi_line_string $pair_full] 70 gdb_test "ptype Inner" [multi_line_string $inner_full] 71 } 72