#   Copyright (C) 1998, 1999, 2002 Red Hat, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

# Please email any bugs, comments, and/or additions to this file to:
# bug-gdb@prep.ai.mit.edu

# This file was written by Keith Seitz (keiths@cygnus.com)

# Read in the standard defs file

if {![gdbtk_read_defs]} {
  break
}

global objdir test_ran
global console text
set console [ManagedWin::open Console]
set text [$console test set _twin]

#####                            #####
#                                    #
#  Helper functions for this module  #
#                                    #
#####                            #####

# console_command --
#      Invoke STRING as a command in the console window and
#      return the result
proc console_command {string} { 
  global console text

  # Save current position
  set line [lindex [split [$text index cmdmark] .] 0]
  incr line 1

  # Insert and invoke command
  $text insert end $string
  $console invoke
  update

  # Get the result
  set end [lindex [split [$text index cmdmark] .] 0]
  incr end -1
  return [$text get $line.0 [list $end.0 lineend]]
} 

# get_cmd_line --
#     Return the command line
proc get_cmd_line {} {
  global text

  update
  set index [$text index cmdmark]
  return [$text get [list $index linestart] [list $index lineend]]
}

# clear_command_line --
#     Clear the command line
proc clear_command_line {} {
  global text
  $text delete {cmdmark + 1 char} insert
}

#####         #####
#                 #
#  CONSOLE TESTS  #
#                 #
#####         #####

#
# Miscellaneous tests
#

# Test:  console-misc-1
# Desc:  Change console prompt
gdbtk_test console-misc-1 {change console prompt} {
  # Insert the "set prompt" command into the text widget
  console_command {set prompt (test) }

  $text get {cmdmark linestart} {cmdmark lineend}
} {(test) }
if {$test_ran} {
  console_command {set prompt (gdb) }
}

#
# Paste tests
#

# Test:  console-paste-1
# Desc:  Paste the X selection into console window
gdbtk_test console-paste-1 {paste X text} {
  # This is cheesy, but it works... Create a text widget
  # which holds the current selection...
  text .test_text
  .test_text insert end "this is some pasted text"
  .test_text tag add sel 1.0 {1.0 lineend}
  event generate .test_text <<Copy>>
  event generate $text <<Paste>>
  get_cmd_line
} {(gdb) this is some pasted text}
if {$test_ran} {
  destroy .test_text
  clear_command_line
}

#
# Test for errors
#

# Test:  console-error-1
# Desc:  Check if console window reports internal gdb errors
gdbtk_test console-error-1 {invoke unknown command} {
  console_command {this_command_doesn't_exist}
} {Error: Undefined command: "this".  Try "help".
}

#
# History tests
#

# Test:  console-history-1.1
# Desc:  Exercise the up-history functionality
gdbtk_test console-history-1.1 {up history once} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}
  # this doesn't seem to work reliably: event generate $text <Up>
  $console test _previous
  get_cmd_line
} {(gdb) help si}
if {$test_ran} {
  clear_command_line
}

# Test:  console-history-1.2
# Desc:  Exercise the up-history functionality
gdbtk_test console-history-1.2 {up history twice} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}
  # this doesn't seem to work reliably: event generate $text <Up>
  # this doesn't seem to work reliably: event generate $text <Up>
  $console test _previous
  $console test _previous
  get_cmd_line
} {(gdb) help quit}
if {$test_ran} {
  clear_command_line
}

# Test:  console-history-1.3
# Desc:  Exercise the up-history functionality
gdbtk_test console-history-1.3 {up history four times} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}

  for {set i 0} {$i < 4} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Up>
    $console test _previous
  }
  get_cmd_line
} {(gdb) show remotedevice}
if {$test_ran} {
  clear_command_line
}

# Test:  console-history-1.4
# Desc:  Exercise the up-history functionality
gdbtk_test console-history-1.4 {up fourteen times} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}
  for {set i 0} {$i < 14} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Up>
    $console test _previous
  }
  get_cmd_line
} {(gdb) show annotate}
if {$test_ran} {
  clear_command_line
}

# Test:  console-history-1.5
# Desc:  Exercise the up-history search functionality
gdbtk_test console-history-1.5 {up search} {
 # Add some commands into the command buffer
  console_command {show height}
  console_command {show annotate}
  console_command {show complaints}
  console_command {print main}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}

  $text insert end "sh"
  # this doesn't seem to work reliably: event generate $text <Shift-Up>
  # this doesn't seem to work reliably: event generate $text <Shift-Up>
  # this doesn't seem to work reliably: event generate $text <Shift-Up>
  $console test _search_history
  $console test _search_history
  $console test _search_history
  get_cmd_line
} {(gdb) show annotate}


# Test:  console-history-1.6
# Desc:  Exercise the down-history search functionality
gdbtk_test console-history-1.6 {down search} {
  # this doesn't seem to work reliably: event generate $text <Shift-Down>
  # this doesn't seem to work reliably: event generate $text <Shift-Down>
  $console test _rsearch_history
  $console test _rsearch_history
  get_cmd_line
} {(gdb) show remotelogbase}

# Test:  console-history-1.7
# Desc:  Down-history search to bottom
# We go back down until the original partialcommand is displayed
gdbtk_test console-history-1.7 {down search to bottom} {
  # this doesn't seem to work reliably: event generate $text <Shift-Down>
  # this doesn't seem to work reliably: event generate $text <Shift-Down>
  $console test _rsearch_history
  $console test _rsearch_history
  get_cmd_line
} {(gdb) sh}

# Test:  console-history-1.8
# Desc:  Up-history search to top
# We go up until there are no matches
gdbtk_test console-history-1.8 {up search to top} {
  for {set i 0} {$i < 100} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Shift-Up>
    $console test _search_history
  }
  get_cmd_line
} {(gdb) show annotate}

if {$test_ran} {
  clear_command_line
}

# Test:  console-history-2.1
# Desc:  Exercise the down-history functionality
gdbtk_test console-history-2.1 {down once} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}

  for {set i 0} {$i < 14} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Up>
    $console test _previous
  }
  # this doesn't seem to work reliably: event generate $text <Down>
  $console test _next
  get_cmd_line
} {(gdb) show complaints}
if {$test_ran} {
  clear_command_line
}

# Test:  console-history-2.2
# Desc:  Exercise the down-history functionality
gdbtk_test console-history-2.2 {down twice} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}

  for {set i 0} {$i < 14} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Up>
    $console test _previous
  }

  # this doesn't seem to work reliably: event generate $text <Down>
  # this doesn't seem to work reliably: event generate $text <Down>
  $console test _next
  $console test _next
  get_cmd_line
} {(gdb) show confirm}
if {$test_ran} {
  clear_command_line
}

# Test:  console-history-2.3
# Desc:  Exercise the down-history functionality
gdbtk_test console-history-2.3 {down four times} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}

  for {set i 0} {$i < 14} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Up>
    $console test _previous
  }

  for {set i 0} {$i < 4} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Down>
    $console test _next
  }
  get_cmd_line
} {(gdb) show language}
if {$test_ran} {
  clear_command_line
}

# Test:  console-history-2.4
# Desc:  Exercise the down-history functionality
gdbtk_test console-history-2.4 {down infinitely} {
  # Add some commands into the command buffer
  console_command {show annotate}
  console_command {show complaints}
  console_command {show confirm}
  console_command {show height}
  console_command {show language}
  console_command {show print demangle}
  console_command {show remotebaud}
  console_command {show remotebreak}
  console_command {show remotecache}
  console_command {show remotedebug}
  console_command {show remotedevice}
  console_command {show remotelogbase}
  console_command {help quit}
  console_command {help si}
  for {set i 0} {$i < 14} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Up>
    $console test _previous
  }

  for {set i 0} {$i < 20} {incr i} {
    # this doesn't seem to work reliably: event generate $text <Down>
    $console test _next
  }
  get_cmd_line
} {(gdb) }
if {$test_ran} {
  clear_command_line
}

#
# gdb - gdbtk Interface Tests
#

# Test:  console-interface-1.1
# Desc:  Verify that a "file" command in the console window causes
#        gdb to invoke the pre-/post-add-symbol hooks
set file_loaded 0
gdbtk_test console-interface-1.1 {file command goes through hooks} {
  global TEST1_RESULT TEST2_RESULT

  # This is really ugly, but its the only way to do this...
  rename gdbtk_tcl_pre_add_symbol pre_add
  rename gdbtk_tcl_post_add_symbol post_add

  proc gdbtk_tcl_pre_add_symbol {file} {
    global TEST1_RESULT

    set TEST1_RESULT $file
    pre_add $file
  }
  proc gdbtk_tcl_post_add_symbol {} {
    global TEST2_RESULT

    set TEST2_RESULT ok
    post_add
  }

  # load a file and make sure we went through the pre/post_add_symbol hooks
  set TEST1_RESULT {}
  set TEST2_RESULT {}
  set file [file join $objdir simple]
  console_command "file $file"
  if {$TEST1_RESULT != $file} {
    set result "did not go through gdbtk_tcl_pre_add_symbol ($TEST1_RESULT)"
  } elseif {$TEST2_RESULT != "ok"} {
    set result "did not go through gdbtk_tcl_post_add_symbol"
  } else {
    set result {}
    set file_loaded 1
  }

  set result
} {}
if {$test_ran} {
  rename gdbtk_tcl_pre_add_symbol {}
  rename gdbtk_tcl_post_add_symbol {}
  rename pre_add gdbtk_tcl_pre_add_symbol
  rename post_add gdbtk_tcl_post_add_symbol
}

#
#  Exit
#
gdbtk_test_done