diff options
author | Wilfried Moser <moser@cygnus> | 1996-03-06 07:44:46 +0000 |
---|---|---|
committer | Wilfried Moser <moser@cygnus> | 1996-03-06 07:44:46 +0000 |
commit | 6bf53072e9bb76a53b38c1be4226de67af3adba2 (patch) | |
tree | 2d3c78d4d0ec8e4e642677b5db9e6487ed71e1eb | |
parent | b4692cbc5e7a32aa7d87428771ad7a3436aef666 (diff) | |
download | gdb-6bf53072e9bb76a53b38c1be4226de67af3adba2.zip gdb-6bf53072e9bb76a53b38c1be4226de67af3adba2.tar.gz gdb-6bf53072e9bb76a53b38c1be4226de67af3adba2.tar.bz2 |
* gch922.{ch,exp}, powerset.{ch,exp}: New test cases.
* builtins.exp, chillvars.exp, misc.exp, tests1.exp: Updated
due to new format of nonprintable characters (control sequence
instead of C'xx').
-rw-r--r-- | gdb/testsuite/gdb.chill/.Sanitize | 4 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/ChangeLog | 8 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/builtins.exp | 16 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/chillvars.exp | 18 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/gch922.ch | 23 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/gch922.exp | 183 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/misc.exp | 3 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/powerset.ch | 33 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/powerset.exp | 184 | ||||
-rw-r--r-- | gdb/testsuite/gdb.chill/tests1.exp | 8 |
10 files changed, 459 insertions, 21 deletions
diff --git a/gdb/testsuite/gdb.chill/.Sanitize b/gdb/testsuite/gdb.chill/.Sanitize index 9631aaa..a60b78d 100644 --- a/gdb/testsuite/gdb.chill/.Sanitize +++ b/gdb/testsuite/gdb.chill/.Sanitize @@ -40,8 +40,12 @@ extstruct.ch extstruct-grt.ch extstruct.exp func1.ch +gch922.ch +gch922.exp misc.ch misc.exp +powerset.ch +powerset.exp pr-4975.ch pr-4975-grt.ch pr-4975.exp diff --git a/gdb/testsuite/gdb.chill/ChangeLog b/gdb/testsuite/gdb.chill/ChangeLog index 7d5f943..720d4b4 100644 --- a/gdb/testsuite/gdb.chill/ChangeLog +++ b/gdb/testsuite/gdb.chill/ChangeLog @@ -1,3 +1,11 @@ +Tue Mar 5 23:41:39 1996 Wilfried Moser (Alcatel) <moser@rtl.cygnus.com> + + * gch922.{ch,exp}, powerset.{ch,exp}: New test cases. + + * builtins.exp, chillvars.exp, misc.exp, tests1.exp: Updated + due to new format of nonprintable characters (control sequence + instead of C'xx'). + Tue Mar 5 00:09:17 1996 Per Bothner <bothner@kalessin.cygnus.com> * string.ch, string.exp: Add tests (from Cygnus PR chill/9078). diff --git a/gdb/testsuite/gdb.chill/builtins.exp b/gdb/testsuite/gdb.chill/builtins.exp index f588fe2..3fbf989 100644 --- a/gdb/testsuite/gdb.chill/builtins.exp +++ b/gdb/testsuite/gdb.chill/builtins.exp @@ -114,7 +114,7 @@ proc test_lower {} { # discrete mode names test_print_accept "print lower(bool)" "FALSE" - test_print_accept "print lower(char)" "C'00'" + test_print_accept "print lower(char)" {'\^[(]0[)]'} test_print_accept "print lower(byte)" "-128" test_print_accept "print lower(ubyte)" "0" if [istarget "alpha-*-*"] then { @@ -136,7 +136,7 @@ proc test_lower {} { # discrete locations test_print_accept "print lower(v_bool)" "FALSE" - test_print_accept "print lower(v_char)" "C'00'" + test_print_accept "print lower(v_char)" {'\^[(]0[)]'} test_print_accept "print lower(v_byte)" "-128" test_print_accept "print lower(v_ubyte)" "0" if [istarget "alpha-*-*"] then { @@ -172,7 +172,7 @@ proc test_lower {} { # array mode name test_print_accept "print lower(m_arr)" "1"; - test_print_accept "print lower(m_char_arr)" "C'00'" + test_print_accept "print lower(m_char_arr)" {'\^[(]0[)]'} test_print_accept "print lower(m_bool_arr)" "FALSE" if [istarget "alpha-*-*"] then { test_print_accept "print lower(m_int_arr)" "-2147483648" @@ -189,7 +189,7 @@ proc test_lower {} { # array locations test_print_accept "print lower(v_arr)" "1"; - test_print_accept "print lower(v_char_arr)" "C'00'" + test_print_accept "print lower(v_char_arr)" {'\^[(]0[)]'} test_print_accept "print lower(v_bool_arr)" "FALSE" if [istarget "alpha-*-*"] then { test_print_accept "print lower(v_int_arr)" "-2147483648" @@ -213,7 +213,7 @@ proc test_upper {} { # discrete mode names test_print_accept "print upper(bool)" "TRUE" - test_print_accept "print upper(char)" "C'ff'" + test_print_accept "print upper(char)" {'\^[(]255[)]'} test_print_accept "print upper(byte)" "127" test_print_accept "print upper(ubyte)" "255" if [istarget "alpha-*-*"] then { @@ -238,7 +238,7 @@ proc test_upper {} { # discrete locations test_print_accept "print upper(v_bool)" "TRUE" - test_print_accept "print upper(v_char)" "C'ff'" + test_print_accept "print upper(v_char)" {'\^[(]255[)]'} test_print_accept "print upper(v_byte)" "127" test_print_accept "print upper(v_ubyte)" "255" if [istarget "alpha-*-*"] then { @@ -277,7 +277,7 @@ proc test_upper {} { # array mode name test_print_accept "print upper(m_arr)" "10"; - test_print_accept "print upper(m_char_arr)" "C'ff'" + test_print_accept "print upper(m_char_arr)" {'\^[(]255[)]'} test_print_accept "print upper(m_bool_arr)" "TRUE" if [istarget "alpha-*-*"] then { test_print_accept "print upper(m_int_arr)" "2147483647" @@ -294,7 +294,7 @@ proc test_upper {} { # array locations test_print_accept "print upper(v_arr)" "10"; - test_print_accept "print upper(v_char_arr)" "C'ff'" + test_print_accept "print upper(v_char_arr)" {'\^[(]255[)]'} test_print_accept "print upper(v_bool_arr)" "TRUE" if [istarget "alpha-*-*"] then { test_print_accept "print upper(v_int_arr)" "2147483647" diff --git a/gdb/testsuite/gdb.chill/chillvars.exp b/gdb/testsuite/gdb.chill/chillvars.exp index 72c7ff9..c11ebc3 100644 --- a/gdb/testsuite/gdb.chill/chillvars.exp +++ b/gdb/testsuite/gdb.chill/chillvars.exp @@ -89,13 +89,13 @@ proc test_BOOL {} { proc test_CHAR {} { gdb_test "ptype control_char" "type = (CHAR|char)" gdb_test "whatis control_char" "type = (CHAR|char)" - gdb_test "print control_char" " = C'07'" + gdb_test "print control_char" { = '\^[(]7[)]'} gdb_test "ptype printable_char" "type = (CHAR|char)" gdb_test "whatis printable_char" "type = (CHAR|char)" gdb_test "print printable_char" " = 'a'" - gdb_test "print lower(char)" " = C'00'" - gdb_test "print upper(char)" " = C'ff'" + gdb_test "print lower(char)" { = '\^[(]0[)]'} + gdb_test "print upper(char)" { = '\^[(]255[)]'} } proc test_BYTE {} { @@ -181,11 +181,11 @@ proc test_arrays {} { gdb_test_exact "print booltable2" { = [(4): TRUE, (5:6): FALSE, (7): TRUE]} gdb_test "ptype chartable1" "type = ARRAY \\(+0:2\\)+ (CHAR|char)" - gdb_test_exact "print chartable1" {= [(0): C'00', (1): C'01', (2): C'02']} + gdb_test_exact "print chartable1" {= [(0): '^(0)', (1): '^(1)', (2): '^(2)']} gdb_test "ptype chartable2" "type = ARRAY \\(+3:5\\)+ (CHAR|char)" gdb_test_exact "print chartable2" \ - {= [(3): C'00', (4): C'01', (5): C'02']} + {= [(3): '^(0)', (4): '^(1)', (5): '^(2)']} gdb_test "ptype bytetable1" "type = ARRAY \\(+0:4\\)+ (BYTE|byte)" gdb_test_exact "print bytetable1" \ @@ -271,23 +271,23 @@ proc test_strings {} { gdb_test "print string1" " = \"abcd\"" gdb_test "ptype string2" "type = CHARS \[(\]+5\[)\]+" - gdb_test "print string2" " = \"ef\"//c\"00\"//\"gh\"" + gdb_test "print string2" { = \"ef\^\(0\)gh\"} gdb_test "ptype string3" "type = CHARS \[(\]+6\[)\]+" gdb_test "print string3" " = \"efghij\"" gdb_test "ptype string4" "type = CHARS \[(\]+7\[)\]+" - gdb_test "print string4" " = \"zzzzzz\"//c\"00\"" + gdb_test "print string4" { = \"zzzzzz\^\(0\)\"} # These tests require a running process, so run to one of the procs # and then do the tests. if [runto scalar_arithmetic] then { gdb_test "ptype string1//string2" "type = CHARS \\(9\\)" - gdb_test "print string1//string2" " = \"abcdef\"//c\"00\"//\"gh\"" + gdb_test "print string1//string2" { = \"abcdef\^\(0\)gh\"} gdb_test_exact {ptype "a chill string"} {type = CHARS (14)} gdb_test "print 'a chill string'" " = \"a chill string\"" - gdb_test "print \"ef\"//c'00'//\"gh\"" " = \"ef\"//c\"00\"//\"gh\"" + gdb_test "print \"ef\"//c'00'//\"gh\"" { = \"ef\^\(0\)gh\"} gdb_test "print string1 // \"efgh\"" " = \"abcdefgh\"" gdb_test "print (6) 'z'" " = \"zzzzzz\"" gdb_test "ptype (6) 'z'" "type = CHARS \[(\]+6\[)\]+" diff --git a/gdb/testsuite/gdb.chill/gch922.ch b/gdb/testsuite/gdb.chill/gch922.ch new file mode 100644 index 0000000..b3e8a23 --- /dev/null +++ b/gdb/testsuite/gdb.chill/gch922.ch @@ -0,0 +1,23 @@ +xx : module + +dcl a chars(200) varying init := (70)'^(0)' // "Jason""^(0,5)""Hugo^(10)" // (70)'^(1)'; +dcl b chars(20) varying init := "Jason""^(0,5)""Hugo^(10)"; +dcl c chars(256) varying init := (70)'a' // "^(0,5)Jason" // (70)'b'; +dcl d char init := '^(11)'; + +bulk: PROC (); +END bulk; + +a := (50) '^(255,0,222,127)'; +b := (1)'^(200)'; +d := 'a'; + +c:= (256)" "; + +DO FOR i:= 0 BY 1 TO 255; + c (255-i) := char (i); +OD; + +bulk (); + +end xx;
\ No newline at end of file diff --git a/gdb/testsuite/gdb.chill/gch922.exp b/gdb/testsuite/gdb.chill/gch922.exp new file mode 100644 index 0000000..8b63309 --- /dev/null +++ b/gdb/testsuite/gdb.chill/gch922.exp @@ -0,0 +1,183 @@ +# Copyright (C) 1995 Free Software Foundation, 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 tests various Chill values, expressions, and types. + +# This file was written by Wilfried Moser (moser@aut.alcatel.at) +# Kurt Fuchs (fuchs_k@aut.alcatel.at) +# + +if $tracelevel then { + strace $tracelevel +} + +if [skip_chill_tests] then { continue } + +set testfile "gch922" +set srcfile ${srcdir}/$subdir/${testfile}.ch +set binfile ${objdir}/${subdir}/${testfile}.exe +if { [compile "${srcfile} -g -w -o ${binfile} ${CHILL_RT0} ${CHILL_LIB}"] != "" } { + perror "Couldn't compile ${srcfile}" + return -1 +} + +# Set the current language to chill. This counts as a test. If it +# fails, then we skip the other tests. + +proc set_lang_chill {} { + global prompt + global binfile objdir subdir + + verbose "loading file '$binfile'" + gdb_load $binfile + send "set language chill\n" + expect { + -re ".*$prompt $" {} + timeout { fail "set language chill (timeout)" ; return 0 } + } + + send "show language\n" + expect { + -re ".* source language is \"chill\".*$prompt $" { + pass "set language to \"chill\"" + send "break xx_\n" + expect { + -re ".*$prompt $" { + send "run\n" + expect -re ".*$prompt $" {} + return 1 + } + timeout { + fail "can't set breakpoint (timeout)" + return 0 + } + } + } + -re ".*$prompt $" { + fail "setting language to \"chill\"" + return 0 + } + timeout { + fail "can't show language (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. +# +# 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] + set result [gdb_test $sendthis ".* = ${expectthis}" $message] + if $result==0 {incr passcount} + return $result +} + + +proc test_chars {} { + global passcount prompt + + verbose "Testing Chars" + set passcount 0 + + test_print_accept "print a" {'\^\(0\)'<repeats 70 times>//"Jason""\^\(0,5\)""Hugo\^\(10\)"//'\^\(1\)'<repeats 70 times>} + test_print_accept "print b" {"Jason""\^\(0,5\)""Hugo\^\(10\)"} + test_print_accept "print c" {'a'<repeats 70 times>//"\^\(0,5\)Jason"//'b'<repeats 70 times>} + test_print_accept "print d" {'\^\(11\)'} + + send "set var a := (100)'\^(0,255)'\n" ; expect -re "$prompt $" + test_print_accept "print a" {"\^\(0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255\)"} + + send "set var a := (10)'\^(1)'//(26)\"\^(66,67)\"//\" \"//'I'//' '//'a'//'m'//\" Hugo\" \n" ; expect -re "$prompt $" + test_print_accept "print a" {"\^\(1,1,1,1,1,1,1,1,1,1\)BCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBC I am Hugo"} + send "set var b := \"Hugo \"\"\^(3,4)\"\"Otto\^(17)\" \n" ; expect -re "$prompt $" + test_print_accept "print b" {"Hugo ""\^\(3,4\)""Otto\^\(17\)"} + send "set var c := (70)'b' // \"\^(2,3)Hugo \" // (70)'c' \n" ; expect -re "$prompt $" + test_print_accept "print c" {'b'<repeats 70 times>//"\^\(2,3\)Hugo "//'c'<repeats 70 times>} + send "set var d := '\^(199)'\n" ; expect -re "$prompt $" + test_print_accept "print d" {'\^\(199\)'} + + test_print_accept "print (10)'\^(0)'//(26)\"\^(66,67)\"//\" \"//'I'//' '//'a'//'m'//\" Hugo\"" {"\^\(0,0,0,0,0,0,0,0,0,0\)BCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBC I am Hugo"} + test_print_accept "print \"Jason\"\"\^(0,5)\"\"Hugo\^(10)\"" {"Jason""\^\(0,5\)""Hugo\^\(10\)"} + + send "set var a := \"\" \n" ; expect -re "$prompt $" + test_print_accept "print a" {""} + send "set var a := \"\"\"\" \n" ; expect -re "$prompt $" + test_print_accept "print a" {""""} + send "set var a := \" \"\"\" \n" ; expect -re "$prompt $" + test_print_accept "print a" {" """} + send "set var a := \"\^\^\" \n" ; expect -re "$prompt $" + test_print_accept "print a" {"\^\^"} + send "set var a := \"'\" \n" ; expect -re "$prompt $" + test_print_accept "print a" {"'"} +} + + +proc test_code {} { + global passcount prompt + + verbose "Testing Chars" + set passcount 0 + + runto bulk + test_print_accept "print a" {"\^\(255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127\)"} + test_print_accept "print b" {"\^\(200\)"} +# test_print_accept "print c" {'a'<repeats 70 times>//"\^\(0,5\)Jason"//'b'<repeats 70 times>} + test_print_accept "print d" {'a'} +} + + +# Start with a fresh gdb. + +gdb_exit +gdb_start +gdb_reinitialize_dir $srcdir/$subdir + +send "set print sevenbit-strings\n" ; expect -re ".*$prompt $" + + +if [set_lang_chill] then { + # test builtins as described in chapter 6.20.3 Z.200 + + test_chars +# test_code +} else { + warning "$test_name tests suppressed." +} diff --git a/gdb/testsuite/gdb.chill/misc.exp b/gdb/testsuite/gdb.chill/misc.exp index 41405bd..da59bb2 100644 --- a/gdb/testsuite/gdb.chill/misc.exp +++ b/gdb/testsuite/gdb.chill/misc.exp @@ -80,6 +80,9 @@ if ![set_lang_chill] then { # This tests PR 8496. gdb_test {printf "%d %d.\n", 3+4,2} "7 2." "printf with 2 arguments" + # This tests GCH/924 + gdb_test {print (h'23)} { = 35} "print parantised integer literal" + # Linux thinks this is at line 6, but is otherwise ok. setup_xfail "i*86-*-linux*" gdb_test "info line" \ diff --git a/gdb/testsuite/gdb.chill/powerset.ch b/gdb/testsuite/gdb.chill/powerset.ch new file mode 100644 index 0000000..dd3172d --- /dev/null +++ b/gdb/testsuite/gdb.chill/powerset.ch @@ -0,0 +1,33 @@ +-- +-- check powerset operators and built-ins +-- + +ps: MODULE + +SYNMODE m_ps1 = POWERSET ULONG (0:8); +DCL v_ps1 m_ps1 INIT := [1,3,5,7]; + +SYNMODE m_ps2 = POWERSET LONG (-100:100); +DCL v_ps2 m_ps2 INIT := [ -100:-95, -1:1, 95:100]; + +SYNMODE m_set = SET (aa, bb, cc, dd, ee, ff, gg, hh, ii, jj); +SYNMODE m_ps3 = POWERSET m_set; +DCL v_ps3 m_ps3 INIT := [bb, dd, ff, ii]; + +SYNMODE m_ps4 = POWERSET CHAR(' ':'z'); +DCL v_ps4 m_ps4 INIT := [ '.', ',', 'A':'F', 'x':'z' ]; + +SYNMODE m_ps5 = POWERSET BOOL; +DCL v_ps5 m_ps5 INIT := [ FALSE ]; +DCL v_ps51 m_ps5 INIT := [ ]; + +SYNMODE m_int_range = INT(-100:100); +SYNMODE m_int_subrange = m_int_range(-50:50); +SYNMODE m_ps6 = POWERSET m_int_subrange; +DCL v_ps6 m_ps6 INIT := [ LOWER(m_int_subrange):UPPER(m_int_subrange) ]; + +DCL x INT; + +x := 25; + +END ps; diff --git a/gdb/testsuite/gdb.chill/powerset.exp b/gdb/testsuite/gdb.chill/powerset.exp new file mode 100644 index 0000000..2d56b7f --- /dev/null +++ b/gdb/testsuite/gdb.chill/powerset.exp @@ -0,0 +1,184 @@ +# Copyright (C) 1995 Free Software Foundation, 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 tests various Chill values, expressions, and types. + +if $tracelevel then { + strace $tracelevel +} + +if [skip_chill_tests] then { continue } + +set testfile "powerset" +set srcfile ${srcdir}/$subdir/${testfile}.ch +set binfile ${objdir}/${subdir}/${testfile}.exe +if { [compile "${srcfile} -g -w -o ${binfile} ${CHILL_RT0} ${CHILL_LIB}"] != "" } { + perror "Couldn't compile ${srcfile}" + return -1 +} + +# Set the current language to chill. This counts as a test. If it +# fails, then we skip the other tests. + +proc set_lang_chill {} { + global prompt + global binfile objdir subdir + + verbose "loading file '$binfile'" + gdb_load $binfile + send "set language chill\n" + expect { + -re ".*$prompt $" {} + timeout { fail "set language chill (timeout)" ; return 0 } + } + + send "show language\n" + expect { + -re ".* source language is \"chill\".*$prompt $" { + pass "set language to \"chill\"" + send "break xx_\n" + expect { + -re ".*$prompt $" { + send "run\n" + expect -re ".*$prompt $" {} + return 1 + } + timeout { + fail "can't set breakpoint (timeout)" + return 0 + } + } + } + -re ".*$prompt $" { + fail "setting language to \"chill\"" + return 0 + } + timeout { + fail "can't show language (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. +# +# 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] + set result [gdb_test $sendthis ".* = ${expectthis}" $message] + if $result==0 {incr passcount} + return $result +} + +proc test_card {} { + global passcount + + verbose "testing builtin CARD" + set passcount 0 + + # discrete mode names + test_print_accept "print card(v_ps1)" "4" + test_print_accept "print card(v_ps2)" "15" + test_print_accept "print card(v_ps3)" "4" + test_print_accept "print card(v_ps4)" "11" + test_print_accept "print card(v_ps5)" "1" + test_print_accept "print card(v_ps51)" "0" + test_print_accept "print card(v_ps6)" "101" + + # a failure + setup_xfail "*-*-*" + test_print_accept "print card(m_ps1)" "typename in invalid context" +} + +proc test_min {} { + global passcount + + verbose "testing builtin MIN" + set passcount 0 + + # discrete mode names + test_print_accept "print min(v_ps1)" "1" + test_print_accept "print min(v_ps2)" "-100" + test_print_accept "print min(v_ps3)" "bb" + test_print_accept "print min(v_ps4)" "','" + test_print_accept "print min(v_ps5)" "FALSE" + test_print_accept "print min(v_ps6)" "-50" + + # a failure + setup_xfail "*-*-*" + test_print_accept "print min(v_ps51)" "MIN for empty powerset" + setup_xfail "*-*-*" + test_print_accept "print min(m_ps1)" "typename in invalid context" +} + +proc test_max {} { + global passcount + + verbose "testing builtin MIN" + set passcount 0 + + # discrete mode names + test_print_accept "print max(v_ps1)" "7" + test_print_accept "print max(v_ps2)" "100" + test_print_accept "print max(v_ps3)" "ii" + test_print_accept "print max(v_ps4)" "'z'" + test_print_accept "print max(v_ps5)" "FALSE" + test_print_accept "print max(v_ps6)" "50" + + # a failure + setup_xfail "*-*-*" + test_print_accept "print max(v_ps51)" "MAX for empty powerset" +} + +# Start with a fresh gdb. + +gdb_exit +gdb_start +gdb_reinitialize_dir $srcdir/$subdir + +send "set print sevenbit-strings\n" ; expect -re ".*$prompt $" + +if [set_lang_chill] then { + # test builtins as described in chapter 6.20.3 Z.200 + test_card + test_min + test_max +} else { + warning "$test_name tests suppressed." +} diff --git a/gdb/testsuite/gdb.chill/tests1.exp b/gdb/testsuite/gdb.chill/tests1.exp index 6b0c172..5eea425 100644 --- a/gdb/testsuite/gdb.chill/tests1.exp +++ b/gdb/testsuite/gdb.chill/tests1.exp @@ -505,12 +505,12 @@ proc test_locations {} { test_print_accept "whatis strl1" "strm2" \ "print string locationa mode name" test_print_accept "print strl1" \ - "\"hansi\"//c\"00\"" \ + {\"hansi\^\(0\)\"} \ "print string location" # string elements test_print_accept "print strl1(0)" "\'h\'" \ "print string element 1" - test_print_accept "print strl1(5)" "C\'00\'" \ + test_print_accept "print strl1(5)" {'\^[(]0[)]'} \ "print string element 2" test_print_accept "print strl1(3)" "\'s\'" \ "print string element 3" @@ -520,12 +520,12 @@ proc test_locations {} { test_print_accept "print strl1(3:4)" "\"si\"" \ "print string slice 1" test_print_accept "print strl1(0:5)" \ - "\"hansi\"//c\"00\"" \ + {\"hansi\^\(0\)\"} \ "print string slice 2" test_print_accept "print strl1(0:0)" "\"h\"" \ "print string slice 3" test_print_accept "print strl1(0 up 6)" \ - "\"hansi\"//c\"00\"" \ + {\"hansi\^\(0\)\"} \ "print string slice 4" # FIXME: adjust error message, when implented gdb_test "print strl1(6 up 1)" \ |