* tests1.exp, tests2.exp (test_print_reject): Remove; causes
authorPer Bothner <per@bothner.com>
Fri, 1 Dec 1995 19:05:52 +0000 (19:05 +0000)
committerPer Bothner <per@bothner.com>
Fri, 1 Dec 1995 19:05:52 +0000 (19:05 +0000)
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
gdb/testsuite/gdb.chill/tests1.exp
gdb/testsuite/gdb.chill/tests2.exp

index aff2ce3446a2478a8fefdac50235f28ad9cb1296..dfe4e07b5e7abfb82081b1b72ab04ff43c60421c 100644 (file)
@@ -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.
index 41976081a4475083d103555963c1bfaaec069b39..1fc82a7310624fe79b71804eb191f73c5fe21110 100644 (file)
@@ -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)" \
index dcc29cefd1a885d4ad79264e2249184ce9af7a96..9023a9c5b02782da80ff159e20801a934f45473d 100644 (file)
@@ -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