gdb/testsuite/gdb.base/paginate-execution-startup.exp

   1 # Copyright (C) 2014-2023 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 # A collection of tests related to pagination resulting from running
  17 # execution commands directly from the command line, with "-ex".
  18
  19 standard_testfile
  20
  21 if {[build_executable "failed to prepare" $testfile $srcfile debug] == -1} {
  22     return -1
  23 }
  24
  25 set file_arg $binfile
  26 if [is_remote host] {
  27   set file_arg [remote_download host $file_arg]
  28 }
  29
  30 global GDBFLAGS
  31 set saved_gdbflags $GDBFLAGS
  32
  33 # Returns true if the board can 'gdb -ex "start"', false otherwise.
  34
  35 proc probe_can_run_cmdline  {} {
  36     global srcfile file_arg
  37     global saved_gdbflags GDBFLAGS
  38     global gdb_prompt
  39
  40     set GDBFLAGS $saved_gdbflags
  41     append GDBFLAGS " -ex \"set height 0\""
  42     append GDBFLAGS " -ex \"start\""
  43     append GDBFLAGS " --args \"$file_arg\""
  44
  45     with_test_prefix "probe support" {
  46         set test "run to main"
  47
  48         gdb_exit
  49         set res [gdb_spawn]
  50         if { $res != 0} {
  51             fail $test
  52             return -1
  53         }
  54
  55         set res -1
  56         gdb_test_multiple "" $test {
  57             -re "main .* at .*$srcfile.*$gdb_prompt $" {
  58                 set res 1
  59                 pass $test
  60             }
  61             -re "Don't know how to run.*$gdb_prompt $" {
  62                 set res 0
  63                 unsupported $test
  64             }
  65         }
  66
  67         # In case the board file wants to send further commands.
  68         gdb_test_no_output "set height unlimited"
  69         return $res
  70     }
  71 }
  72
  73 # Check that we handle pagination correctly when it triggers due to an
  74 # execution command entered directly on the command line.
  75
  76 proc test_fg_execution_pagination_return {} {
  77     global file_arg
  78     global saved_gdbflags GDBFLAGS
  79     global gdb_prompt pagination_prompt
  80
  81     set GDBFLAGS $saved_gdbflags
  82     append GDBFLAGS " -ex \"set height 2\""
  83     append GDBFLAGS " -ex \"start\""
  84     append GDBFLAGS " --args \"$file_arg\""
  85
  86     with_test_prefix "return" {
  87         set test "run to pagination"
  88
  89         gdb_exit
  90         set res [gdb_spawn]
  91         if { $res != 0} {
  92             fail $test
  93             return $res
  94         }
  95         gdb_test_multiple "" $test {
  96             -re "$pagination_prompt$" {
  97                 pass $test
  98             }
  99             -re "$gdb_prompt $" {
 100                 fail $test
 101             }
 102         }
 103
 104         send_gdb "\n"
 105
 106         set saw_pagination_prompt 0
 107         set test "send \\n to GDB"
 108         gdb_test_multiple "" $test {
 109             -re "$pagination_prompt$" {
 110                 set saw_pagination_prompt 1
 111                 send_gdb "\n"
 112                 exp_continue
 113             }
 114             -re "$gdb_prompt $" {
 115                 gdb_assert $saw_pagination_prompt $test
 116             }
 117         }
 118
 119         gdb_test "p 1" " = 1" "GDB accepts further input"
 120
 121         # In case the board file wants to send further commands.
 122         gdb_test_no_output "set height unlimited"
 123     }
 124 }
 125
 126 # Check that we handle canceling pagination correctly when it triggers
 127 # due to an execution command entered directly on the command line.
 128
 129 proc test_fg_execution_pagination_cancel { how } {
 130     global file_arg
 131     global saved_gdbflags GDBFLAGS
 132     global gdb_prompt pagination_prompt
 133
 134     set GDBFLAGS $saved_gdbflags
 135
 136     append GDBFLAGS " -ex \"set height 2\""
 137     append GDBFLAGS " -ex \"start\""
 138     append GDBFLAGS " --args \"$file_arg\""
 139
 140     with_test_prefix "cancel with $how" {
 141         set test "run to pagination"
 142
 143         gdb_exit
 144         set res [gdb_spawn]
 145         if { $res != 0} {
 146             fail $test
 147             return $res
 148         }
 149         gdb_test_multiple "" $test {
 150             -re "$pagination_prompt$" {
 151                 pass $test
 152             }
 153         }
 154
 155         set test "cancel pagination"
 156         if { $how == "ctrl-c" } {
 157             send_gdb "\003"
 158         } else {
 159             send_gdb "q\n"
 160
 161         }
 162         gdb_test_multiple "" $test {
 163             -re "Quit\r\n$gdb_prompt $" {
 164                 pass $test
 165             }
 166         }
 167
 168         gdb_test "p 1" " = 1" "GDB accepts further input"
 169
 170         # In case the board file wants to send further commands.
 171         gdb_test_no_output "set height unlimited"
 172     }
 173 }
 174
 175 save_vars { INTERNAL_GDBFLAGS } {
 176     set INTERNAL_GDBFLAGS [string map {"-q" ""} $INTERNAL_GDBFLAGS]
 177
 178     if {[probe_can_run_cmdline] > 0} {
 179         test_fg_execution_pagination_return
 180         if ![target_info exists gdb,nointerrupts] {
 181             test_fg_execution_pagination_cancel "ctrl-c"
 182         }
 183         test_fg_execution_pagination_cancel "quit"
 184     }
 185 }
 186
 187 set GDBFLAGS $saved_gdbflags