From d9eb60c63a46381a993cd1aa1e07fa14d384b53e Mon Sep 17 00:00:00 2001 From: Per Bothner 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 + * 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 -- 2.30.2