* 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').
This commit is contained in:
Wilfried Moser
parent
b4692cbc5e
commit
6bf53072e9
10 changed files with 459 additions and 21 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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\[)\]+"
|
||||
|
|
|
|||
23
gdb/testsuite/gdb.chill/gch922.ch
Normal file
23
gdb/testsuite/gdb.chill/gch922.ch
Normal file
|
|
@ -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;
|
||||
183
gdb/testsuite/gdb.chill/gch922.exp
Normal file
183
gdb/testsuite/gdb.chill/gch922.exp
Normal file
|
|
@ -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."
|
||||
}
|
||||
|
|
@ -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" \
|
||||
|
|
|
|||
33
gdb/testsuite/gdb.chill/powerset.ch
Normal file
33
gdb/testsuite/gdb.chill/powerset.ch
Normal file
|
|
@ -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;
|
||||
184
gdb/testsuite/gdb.chill/powerset.exp
Normal file
184
gdb/testsuite/gdb.chill/powerset.exp
Normal file
|
|
@ -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."
|
||||
}
|
||||
|
|
@ -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)" \
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue