gdb/testsuite/gdb.fortran/mixed-lang-stack.exp

   1 # Copyright 2020-2021 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 # This test covers some basic functionality for debugging mixed
  17 # Fortran, C, and C++ applications.  Features tested include examining
  18 # the backtrace, and printing frame arguments in frames of different
  19 # languages.
  20 #
  21 # One important aspect of this test is that we set the language in
  22 # turn to auto, fortran, c, and c++, and carry out the full test in
  23 # each case to ensure that trying to print objects or types from one
  24 # language, while GDB's language is set to another, doesn't crash GDB.
  25
  26 if {[skip_fortran_tests]} { return -1 }
  27
  28 standard_testfile mixed-lang-stack.c mixed-lang-stack.cpp mixed-lang-stack.f90
  29
  30 if {[prepare_for_testing_full "failed to prepare" \
  31          [list ${binfile} {debug f90 additional_flags=-lstdc++} \
  32               $srcfile {debug} \
  33               $srcfile2 {debug c++} \
  34               $srcfile3 {debug f90}]]} {
  35     return -1
  36 }
  37
  38 set have_index [exec_has_index_section $binfile]
  39
  40 # Runs the test program and examins the stack.  LANG is a string, the
  41 # value to pass to GDB's 'set language ...' command.
  42 proc run_tests { lang } {
  43     with_test_prefix "lang=${lang}" {
  44         global binfile hex have_index
  45
  46         clean_restart ${binfile}
  47
  48         if ![runto_main] {
  49             untested "could not run to main"
  50             return -1
  51         }
  52
  53         gdb_breakpoint "breakpt"
  54         gdb_continue_to_breakpoint "breakpt"
  55
  56         if { $lang == "c" || $lang == "c++" } {
  57             gdb_test "set language c" \
  58                 "Warning: the current language does not match this frame."
  59         } else {
  60             gdb_test_no_output "set language $lang"
  61         }
  62
  63         # Check the backtrace.
  64         set e_arg "\['\"\]abcdef\['\"\]"
  65         set 1b_args "\[^\r\n\]+$e_arg\[^\r\n\]+"
  66         set 1g_args "obj=\[^\r\n\]+"
  67         set bt_stack \
  68             [multi_line \
  69                  "#0\\s+breakpt \\(\\) at \[^\r\n\]+" \
  70                  "#1\\s+$hex in mixed_func_1h \\(\\) at \[^\r\n\]+" \
  71                  "#2\\s+$hex in mixed_func_1g \\($1g_args\\) at \[^\r\n\]+" \
  72                  "#3\\s+$hex in mixed_func_1f \\(\\) at \[^\r\n\]+" \
  73                  "#4\\s+$hex in mixed_func_1e \\(\\) at \[^\r\n\]+" \
  74                  "#5\\s+$hex in mixed_func_1d \\(\[^\r\n\]+\\) at \[^\r\n\]+" \
  75                  "#6\\s+$hex in mixed_func_1c \\(\[^\r\n\]+\\) at \[^\r\n\]+" \
  76                  "#7\\s+$hex in mixed_func_1b \\($1b_args\\) at \[^\r\n\]+" \
  77                  "#8\\s+$hex in mixed_func_1a \\(\\) at \[^\r\n\]+" \
  78                  "#9\\s+$hex in mixed_stack_main \\(\\) at \[^\r\n\]+" ]
  79         set main_args "argc=1, argv=${hex}( \[^\r\n\]+)?"
  80         set bt_stack_kfail \
  81             [multi_line \
  82                  $bt_stack \
  83                  "#10\\s+$hex in main \\($main_args\\) at \[^\r\n\]+"]
  84         gdb_test_multiple "bt -frame-arguments all" "" {
  85             -re -wrap $bt_stack {
  86                 pass $gdb_test_name
  87             }
  88             -re -wrap $bt_stack_kfail {
  89                 if { $have_index } {
  90                     setup_kfail "gdb/24549" *-*-*
  91                 }
  92                 fail $gdb_test_name
  93             }
  94         }
  95
  96         # Check the language for frame #0.
  97         gdb_test "info frame" "source language fortran\..*" \
  98             "info frame in frame #0"
  99
 100         # Move up to the C++ frames and check the frame state, print a
 101         # C++ object.
 102         gdb_test "frame 2" "#2\\s+$hex in mixed_func_1g .*" \
 103             "select frame #2"
 104         gdb_test "info frame" "source language c\\+\\+\..*" \
 105             "info frame in frame #2"
 106         if { $lang == "fortran" } {
 107             set obj_pattern " = \\( base_one = \\( num1 = 1, num2 = 2, num3 = 3 \\), base_two = \\( string = $hex 'Something in C\\+\\+\\\\000', val = 3.5 \\), xxx = 9, yyy = 10.5 \\)"
 108         } else {
 109             set obj_pattern " = \\{<base_one> = \\{num1 = 1, num2 = 2, num3 = 3\\}, <base_two> = \\{string = $hex \"Something in C\\+\\+\", val = 3.5\\}, xxx = 9, yyy = 10.5\\}"
 110         }
 111         gdb_test "print obj" "${obj_pattern}"
 112
 113         # Move up the stack a way, and check frame and the frame
 114         # arguments.
 115         gdb_test "frame 5" "#5\\s+$hex in mixed_func_1d .*" \
 116             "select frame #5"
 117         gdb_test "info frame" "source language fortran\..*" \
 118             "info frame in frame #5"
 119
 120         gdb_test "up" "#6\\s+$hex in mixed_func_1c .*" \
 121             "up to frame #6"
 122         gdb_test "info frame" "source language c\..*" \
 123             "info frame in frame #6"
 124
 125         if { $lang == "fortran" } {
 126             set d_pattern "\\(4,5\\)"
 127             set f_pattern "$hex 'abcdef\\\\000'"
 128         } else {
 129             set d_pattern "4 \\+ 5i"
 130             set f_pattern "$hex \"abcdef\""
 131         }
 132
 133         set args_pattern [multi_line \
 134                               "a = 1" \
 135                               "b = 2" \
 136                               "c = 3" \
 137                               "d = ${d_pattern}" \
 138                               "f = ${f_pattern}" \
 139                               "g = $hex" ]
 140
 141         gdb_test "info args" $args_pattern \
 142             "info args in frame #6"
 143         if { $lang == "fortran" } {
 144             set g_pattern " = \\( a = 1\\.5, b = 2\\.5 \\)"
 145         } else {
 146             set g_pattern " = \\{a = 1\\.5, b = 2\\.5\\}"
 147         }
 148         gdb_test "print *g" "${g_pattern}" \
 149             "print object pointed to by g"
 150
 151         gdb_test "up" "#7\\s+$hex in mixed_func_1b .*" \
 152             "up to frame #7"
 153         gdb_test "info frame" "source language fortran\..*" \
 154             "info frame in frame #7"
 155
 156         if { $lang == "c" || $lang == "c++" } {
 157             set d_pattern "4 \\+ 5i"
 158             set e_pattern "\"abcdef\""
 159             set g_pattern "\{a = 1.5, b = 2.5\}"
 160         } else {
 161             set d_pattern "\\(4,5\\)"
 162             set e_pattern "'abcdef'"
 163             set g_pattern "\\( a = 1.5, b = 2.5 \\)"
 164         }
 165
 166         set args_pattern [multi_line \
 167                               "a = 1" \
 168                               "b = 2" \
 169                               "c = 3" \
 170                               "d = ${d_pattern}" \
 171                               "e = ${e_pattern}" \
 172                               "g = ${g_pattern}" \
 173                               "_e = 6" ]
 174
 175         gdb_test "info args" $args_pattern \
 176             "info args in frame #7"
 177     }
 178 }
 179
 180 run_tests "auto"
 181 run_tests "fortran"
 182 run_tests "c"
 183 run_tests "c++"