Home | History | Annotate | Line # | Download | only in gdb.ada 
      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 # Note we don't test the "none" (no -fgnat-encodings option) scenario
     23 # here, because "all" and "minimal" cover the cases, and this way we
     24 # don't have to update the test when gnat changes its default.
     25 foreach_gnat_encoding scenario flags {all minimal} {
     26     lappend flags debug
     27 
     28     if {[gdb_compile_ada "${srcfile}" "${binfile}-${scenario}" executable $flags] != ""} {
     29 	return -1
     30     }
     31 
     32     clean_restart ${testfile}-${scenario}
     33 
     34     set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
     35     runto "foo.adb:$bp_location"
     36 
     37     # Test printing and type-printing of a discriminated record that a function
     38     # returns by reference.
     39 
     40     # Currently, GCC describes such functions as returning pointers (instead of
     41     # references).
     42     set pass_re [multi_line "type = <ref> record" \
     43 		     "    n: natural;" \
     44 		     "    s: array \\(1 \\.\\. n\\) of character;" \
     45 		     "end record"]
     46     # With DWARF we get debuginfo that could in theory show "1..n" for
     47     # the range:
     48     #     <3><1230>: Abbrev Number: 15 (DW_TAG_member)
     49     #     <1231>   DW_AT_name        : n
     50     # ...
     51     #  <4><1257>: Abbrev Number: 18 (DW_TAG_subrange_type)
     52     #     <1258>   DW_AT_type        : <0x126e>
     53     #     <125c>   DW_AT_upper_bound : <0x1230>
     54     # However, we don't currently record the needed information in the
     55     # location batons.  In the meantime, we accept and kfail the
     56     # compromise output.
     57     set dwarf_kfail_re [multi_line "type = <ref> record" \
     58 			    "    n: natural;" \
     59 			    "    s: array \\(<>\\) of character;" \
     60 			    "end record"]
     61     set unsupported_re [multi_line "type = access record" \
     62 			    "    n: natural;" \
     63 			    "    s: access array \\(1 \\.\\. n\\) of character;" \
     64 			    "end record"]
     65     set supported 1
     66     gdb_test_multiple "ptype get(\"Hello world!\")" "" {
     67 	-re -wrap $pass_re {
     68 	    pass $gdb_test_name
     69 	}
     70 	-re -wrap $dwarf_kfail_re {
     71 	    if {$scenario == "minimal"} {
     72 		setup_kfail "symbolic names in location batons" *-*-*
     73 	    }
     74 	    fail $gdb_test_name
     75 	    set supported 0
     76 	}
     77 	-re -wrap $unsupported_re {
     78 	    unsupported $gdb_test_name
     79 	    set supported 0
     80 	}
     81     }
     82 
     83     if { $supported == 0 } {
     84 	return 0
     85     }
     86 
     87     gdb_test "p get(\"Hello world!\")" \
     88 	"= \\(n => 12, s => \"Hello world!\"\\)"
     89 }
     90