From d9eb60c63a46381a993cd1aa1e07fa14d384b53e Mon Sep 17 00:00:00 2001
From: Per Bothner <per@bothner.com>
Date: Fri, 1 Dec 1995 19:05:52 +0000
Subject: [PATCH] * tests1.exp, tests2.exp (test_print_reject): Remove;
causes conflicts with later tests using test_print_reject in
../lib/gdb.exp. (passcount): Remove. * tests2.exp
(test_print_accept): Removed. (test_write): Re-write to use
gdb_test rather than test_print_accept. * tests1.exp
(test_print_accept_exact): Removed. (tests_locations): Rewrite to use
gdb_test and not above proc.
---
gdb/testsuite/gdb.chill/ChangeLog | 8 ++
gdb/testsuite/gdb.chill/tests1.exp | 145 ++++++-----------------------
gdb/testsuite/gdb.chill/tests2.exp | 116 +----------------------
3 files changed, 40 insertions(+), 229 deletions(-)
diff --git a/gdb/testsuite/gdb.chill/ChangeLog b/gdb/testsuite/gdb.chill/ChangeLog
index aff2ce3446a..dfe4e07b5e7 100644
--- a/gdb/testsuite/gdb.chill/ChangeLog
+++ b/gdb/testsuite/gdb.chill/ChangeLog
@@ -1,5 +1,13 @@
Fri Dec 1 00:08:37 1995 Per Bothner <bothner@kalessin.cygnus.com>
+ * tests1.exp, tests2.exp (test_print_reject): Remove; causes
+ conflicts with later tests using test_print_reject in ../lib/gdb.exp.
+ (passcount): Remove.
+ * tests2.exp (test_print_accept): Removed.
+ (test_write): Re-write to use gdb_test rather than test_print_accept.
+ * tests1.exp (test_print_accept_exact): Removed.
+ (tests_locations): Rewrite to use gdb_test and not above proc.
+
* tests1.ch, tests1.exp, tests2.ch, tests2.exp, Makefile.in:
New (extensive) test cases.
* chexp.exp: Fix relations to return TRUE or FALSE.
diff --git a/gdb/testsuite/gdb.chill/tests1.exp b/gdb/testsuite/gdb.chill/tests1.exp
index 41976081a44..1fc82a73106 100644
--- a/gdb/testsuite/gdb.chill/tests1.exp
+++ b/gdb/testsuite/gdb.chill/tests1.exp
@@ -106,49 +106,6 @@ proc test_print_accept { args } {
return $result
}
-
-#
-# same function as above but $expectthis has to match exactly (no '=' is
-# appended in regexp
-#
-proc test_print_accept_exact { args } {
- global prompt
- global passcount
- global verbose
-
- if [llength $args]==3 then {
- set message [lindex $args 2]
- } else {
- set message [lindex $args 0]
- }
- set sendthis [lindex $args 0]
- set expectthis [lindex $args 1]
- if $verbose>2 then {
- send_user "Sending \"$sendthis\" to gdb\n"
- send_user "Looking to match \"$expectthis\"\n"
- send_user "Message is \"$message\"\n"
- }
- send "$sendthis\n"
- expect {
- -re "$expectthis\r\n$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$prompt $" {
- if ![string match "" $message] then {
- fail "$sendthis ($message)"
- } else {
- fail "$sendthis"
- }
- return 1
- }
- timeout {
- fail "$sendthis (timeout)"
- return 0
- }
- }
-}
-
# Testing printing of a specific value. Increment passcount for
# success or issue fail message for failure. In both cases, return
# a 1 to indicate that more tests can proceed. However a timeout
@@ -156,50 +113,6 @@ proc test_print_accept_exact { args } {
# a 0 to be returned to indicate that more tests are likely to fail
# as well.
-proc test_print_reject { args } {
- global prompt
- global passcount
- global verbose
-
- if [llength $args]==2 then {
- set expectthis [lindex $args 1]
- } else {
- set expectthis "should never match this bogus string"
- }
- set sendthis [lindex $args 0]
- if $verbose>2 then {
- send_user "Sending \"$sendthis\" to gdb\n"
- send_user "Looking to match \"$expectthis\"\n"
- }
- send "$sendthis\n"
- expect {
- -re ".*A .* in expression.*\\.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*Junk after end of expression.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*No symbol table is loaded.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$expectthis.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$prompt $" {
- fail "$sendthis not properly rejected"
- return 1
- }
- timeout {
- fail "$sendthis (timeout)"
- return 0
- }
- }
-}
-
# various tests if modes are treated correctly
# using ptype
proc test_modes {} {
@@ -614,7 +527,7 @@ proc test_locations {} {
gdb_test "print strl1(-1:5)" \
".*slice.*out of range.*" \
"print invalid string slice"
- test_print_accept_exact "print strl1(-1:7)" \
+ gdb_test "print strl1(-1:7)" \
".*slice.*out of range.*" \
"print invalid string slice"
gdb_test "print strl1(0 up -1)" \
@@ -717,53 +630,53 @@ proc test_locations {} {
# reject the following range fails
# FIXME: adjust error messages
- test_print_accept_exact "print arrl3(-1)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(-1)" \
+ ".*out of range.*" \
"check invalid array indices 1"
- test_print_accept_exact "print arrl3(6)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(6)" \
+ ".*out of range.*" \
"check invalid array indices 2"
- test_print_accept_exact "print arrl3(0,0)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(0,0)" \
+ ".*out of range.*" \
"check invalid array indices 3"
- test_print_accept_exact "print arrl3(1,0)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(1,0)" \
+ ".*out of range.*" \
"check invalid array indices 4"
- test_print_accept_exact "print arrl3(1,4)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(1,4)" \
+ ".*out of range.*" \
"check invalid array indices 5"
- test_print_accept_exact "print arrl3(6,4)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(6,4)" \
+ ".*out of range.*" \
"check invalid array indices 6"
- test_print_accept_exact "print arrl3(1,1,0)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(1,1,0)" \
+ ".*out of range.*" \
"check invalid array indices 7"
- test_print_accept_exact "print arrl3(6,4,0)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(6,4,0)" \
+ ".*out of range.*" \
"check invalid array indices 8"
- test_print_accept_exact "print arrl3(1,1,3)" \
- ".* array or string index out of range.*" \
+ gdb_test "print arrl3(1,1,3)" \
+ ".*out of range.*" \
"check invalid array indices 9"
- test_print_accept_exact "print arrl3(0)(0)" \
+ gdb_test "print arrl3(0)(0)" \
".* array or string index out of range.*" \
"check invalid array indices 10"
- test_print_accept_exact "print arrl3(1)(0)" \
+ gdb_test "print arrl3(1)(0)" \
".* array or string index out of range.*" \
"check invalid array indices 11"
- test_print_accept_exact "print arrl3(1)(4)" \
+ gdb_test "print arrl3(1)(4)" \
".* array or string index out of range.*" \
"check invalid array indices 12"
- test_print_accept_exact "print arrl3(6)(4)" \
+ gdb_test "print arrl3(6)(4)" \
".* array or string index out of range.*" \
"check invalid array indices 13"
- test_print_accept_exact "print arrl3(1)(1)(0)" \
+ gdb_test "print arrl3(1)(1)(0)" \
".* array or string index out of range.*" \
"check invalid array indices 14"
- test_print_accept_exact "print arrl3(6)(4)(0)" \
+ gdb_test "print arrl3(6)(4)(0)" \
".* array or string index out of range.*" \
"check invalid array indices 15"
- test_print_accept_exact "print arrl3(1)(1)(3)" \
+ gdb_test "print arrl3(1)(1)(3)" \
".* array or string index out of range.*" \
"check invalid array indices 16"
@@ -791,13 +704,13 @@ proc test_locations {} {
# "print array slice 4"
# reject invalid slices
# FIXME: adjust error messages
- test_print_accept_exact "print arrl4(5:6)" \
+ gdb_test "print arrl4(5:6)" \
".*slice out of range.*" \
"check invalid range 1"
- test_print_accept_exact "print arrl4(0:1)" \
+ gdb_test "print arrl4(0:1)" \
".*slice out of range.*" \
"check invalid range 2"
- test_print_accept_exact "print arrl4(0:6)" \
+ gdb_test "print arrl4(0:6)" \
".*slice out of range.*" \
"check invalid range 3"
gdb_test "print arrl4(3:2)" \
diff --git a/gdb/testsuite/gdb.chill/tests2.exp b/gdb/testsuite/gdb.chill/tests2.exp
index dcc29cefd1a..9023a9c5b02 100644
--- a/gdb/testsuite/gdb.chill/tests2.exp
+++ b/gdb/testsuite/gdb.chill/tests2.exp
@@ -71,112 +71,9 @@ proc set_lang_chill {} {
}
}
-# Testing printing of a specific value. Increment passcount for
-# success or issue fail message for failure. In both cases, return
-# a 1 to indicate that more tests can proceed. However a timeout
-# is a serious error, generates a special fail message, and causes
-# a 0 to be returned to indicate that more tests are likely to fail
-# as well.
-#
-# Args are:
-#
-# First one is string to send to gdb
-# Second one is string to match gdb result to
-# Third one is an optional message to be printed
-
-proc test_print_accept { args } {
- global prompt
- global passcount
- global verbose
-
- if [llength $args]==3 then {
- set message [lindex $args 2]
- } else {
- set message [lindex $args 0]
- }
- set sendthis [lindex $args 0]
- set expectthis [lindex $args 1]
- if $verbose>2 then {
- send_user "Sending \"$sendthis\" to gdb\n"
- send_user "Looking to match \"$expectthis\"\n"
- send_user "Message is \"$message\"\n"
- }
- send "$sendthis\n"
- expect {
- -re ".* = $expectthis\r\n$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$prompt $" {
- if ![string match "" $message] then {
- fail "$sendthis ($message)"
- } else {
- fail "$sendthis"
- }
- return 1
- }
- timeout {
- fail "$sendthis (timeout)"
- return 0
- }
- }
-}
-
-# Testing printing of a specific value. Increment passcount for
-# success or issue fail message for failure. In both cases, return
-# a 1 to indicate that more tests can proceed. However a timeout
-# is a serious error, generates a special fail message, and causes
-# a 0 to be returned to indicate that more tests are likely to fail
-# as well.
-
-proc test_print_reject { args } {
- global prompt
- global passcount
- global verbose
-
- if [llength $args]==2 then {
- set expectthis [lindex $args 1]
- } else {
- set expectthis "should never match this bogus string"
- }
- set sendthis [lindex $args 0]
- if $verbose>2 then {
- send_user "Sending \"$sendthis\" to gdb\n"
- send_user "Looking to match \"$expectthis\"\n"
- }
- send "$sendthis\n"
- expect {
- -re ".*A .* in expression.*\\.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*Junk after end of expression.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*No symbol table is loaded.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$expectthis.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$prompt $" {
- fail "$sendthis not properly rejected"
- return 1
- }
- timeout {
- fail "$sendthis (timeout)"
- return 0
- }
- }
-}
-
# checks if structure was accessed correctly
proc test_write { args } {
global prompt
- global passcount
if [llength $args]==5 then {
set message [lindex $args 4]
@@ -204,16 +101,14 @@ proc test_write { args } {
verbose "setting var $value..."
send "set var $location.m$extended := $value\n"
expect -re ".*$prompt $" {}
- test_print_accept "print $location" \
- "\[\[\]\\.p1: 2863311530, \\.m: $matchval, \\.p2: 1431655765\[\]\]" \
- "$message"
+ gdb_test "print $location" \
+ ".*= \[\[\]\\.p1: 2863311530, \\.m: $matchval, \\.p2: 1431655765\[\]\]"\
+ "$message"
}
# test write access from gdb (setvar x:=y) from gdb
proc write_access { } {
- global passcount
- set passcount 0
verbose "testing write access to locations"
# discrete modes
@@ -338,16 +233,11 @@ proc write_access { } {
"structure write 6"
test_write strul1 \"HUGO\" {\[\.a: 0, \.b: 0, \.ch: \"HUGO\"\]} \
{.ch} "structure write 7"
-
- if $passcount then {
- pass "$passcount correct write access tests"
- }
}
# Start with a fresh gdb.
set binfile "tests2.exe"
-global passcount
gdb_exit
gdb_start