From 7609ecebac86e6fd1dea5082a1e8395dac76ff50 Mon Sep 17 00:00:00 2001 From: Wilfried Moser Date: Thu, 7 Dec 1995 13:18:08 +0000 Subject: [PATCH] * builtins.ch, builtins.exp, Makefile.in: New test case. --- gdb/testsuite/gdb.chill/.Sanitize | 2 + gdb/testsuite/gdb.chill/ChangeLog | 4 + gdb/testsuite/gdb.chill/Makefile.in | 4 +- gdb/testsuite/gdb.chill/builtins.ch | 76 ++++++ gdb/testsuite/gdb.chill/builtins.exp | 369 +++++++++++++++++++++++++++ 5 files changed, 453 insertions(+), 2 deletions(-) create mode 100644 gdb/testsuite/gdb.chill/builtins.ch create mode 100644 gdb/testsuite/gdb.chill/builtins.exp diff --git a/gdb/testsuite/gdb.chill/.Sanitize b/gdb/testsuite/gdb.chill/.Sanitize index 70034b4b5a9..53393075892 100644 --- a/gdb/testsuite/gdb.chill/.Sanitize +++ b/gdb/testsuite/gdb.chill/.Sanitize @@ -25,6 +25,8 @@ Things-to-keep: ChangeLog Makefile.in +builtins.ch +builtins.exp callch.ch callch.exp chexp.exp diff --git a/gdb/testsuite/gdb.chill/ChangeLog b/gdb/testsuite/gdb.chill/ChangeLog index 680097a0534..6ca7cab986c 100644 --- a/gdb/testsuite/gdb.chill/ChangeLog +++ b/gdb/testsuite/gdb.chill/ChangeLog @@ -1,3 +1,7 @@ +Thu Dec 7 05:16:34 1995 Wilfried Moser (Alcatel) + + * builtins.ch, builtins.exp, Makefile.in: New test case. + Tue Dec 5 01:51:45 1995 Wilfried Moser (Alcatel) * tests2.exp: Add compiling of the test case. diff --git a/gdb/testsuite/gdb.chill/Makefile.in b/gdb/testsuite/gdb.chill/Makefile.in index 23f12518433..ecf23ae6e9e 100644 --- a/gdb/testsuite/gdb.chill/Makefile.in +++ b/gdb/testsuite/gdb.chill/Makefile.in @@ -1,8 +1,8 @@ srcdir = @srcdir@ VPATH = @srcdir@ -PROGS = callch.exe chillvars.exe misc.exe result.exe string.exe \ - tests1.exe tests2.exe tuples.exe \ +PROGS = builtins.exe callch.exe chillvars.exe misc.exe result.exe \ + string.exe tests1.exe tests2.exe tuples.exe \ pr-4975.exe pr-5016.exe pr-5020.exe pr-5022.exe pr-5646.exe \ pr-5984.exe pr-6292.exe pr-6632.exe pr-8136.exe pr-8405.exe diff --git a/gdb/testsuite/gdb.chill/builtins.ch b/gdb/testsuite/gdb.chill/builtins.ch new file mode 100644 index 00000000000..6a94b762000 --- /dev/null +++ b/gdb/testsuite/gdb.chill/builtins.ch @@ -0,0 +1,76 @@ +xx: MODULE + +DCL v_bool BOOL INIT := FALSE; +DCL v_char CHAR INIT := 'X'; +DCL v_byte BYTE INIT := -30; +DCL v_ubyte UBYTE INIT := 30; +DCL v_int INT INIT := -333; +DCL v_uint UINT INIT := 333; +DCL v_long LONG INIT := -4444; +DCL v_ulong ULONG INIT := 4444; +DCL v_ptr PTR; + +SYNMODE m_set = SET (e1, e2, e3, e4, e5, e6); +DCL v_set m_set INIT := e3; + +SYNMODE m_set_range = m_set(e2:e5); +DCL v_set_range m_set_range INIT := e3; + +SYNMODE m_char_range = CHAR('A':'Z'); +DCL v_char_range m_char_range INIT := 'G'; + +SYNMODE m_bool_range = BOOL(FALSE:FALSE); +DCL v_bool_range m_bool_range; + +SYNMODE m_long_range = LONG(255:3211); +DCL v_long_range m_long_range INIT := 1000; + +SYNMODE m_range = RANGE(12:28); +DCL v_range m_range INIT := 23; + +SYNMODE m_chars = CHARS(20); +SYNMODE m_chars_v = CHARS(20) VARYING; +DCL v_chars CHARS(20); +DCL v_chars_v CHARS(20) VARYING INIT := "foo bar"; + +SYNMODE m_bits = BOOLS(10); +DCL v_bits BOOLS(10); + +SYNMODE m_arr = ARRAY(1:10) BYTE; +DCL v_arr ARRAY(1:10) BYTE; + +SYNMODE m_char_arr = ARRAY (CHAR) BYTE; +DCL v_char_arr ARRAY(CHAR) BYTE; + +SYNMODE m_bool_arr = ARRAY (BOOL) BYTE; +DCL v_bool_arr ARRAY (BOOL) BYTE; + +SYNMODE m_int_arr = ARRAY (INT) BYTE; +DCL v_int_arr ARRAY (INT) BYTE; + +SYNMODE m_set_arr = ARRAY (m_set) BYTE; +DCL v_set_arr ARRAY (m_set) BYTE; + +SYNMODE m_char_range_arr = ARRAY (m_char_range) BYTE; +DCL v_char_range_arr ARRAY (m_char_range) BYTE; + +SYNMODE m_set_range_arr = ARRAY (m_set_range) BYTE; +DCL v_set_range_arr ARRAY (m_set_range) BYTE; + +SYNMODE m_bool_range_arr = ARRAY (m_bool_range) BYTE; +DCL v_bool_range_arr ARRAY (m_bool_range) BYTE; + +SYNMODE m_long_range_arr = ARRAY (m_long_range) BYTE; +DCL v_long_range_arr ARRAY (m_long_range) BYTE; + +SYNMODE m_range_arr = ARRAY (m_range) BYTE; +DCL v_range_arr ARRAY (m_range) BYTE; + +SYNMODE m_struct = STRUCT (i LONG, + c CHAR, + s CHARS(30)); +DCL v_struct m_struct; + +v_bool := TRUE; + +END xx; diff --git a/gdb/testsuite/gdb.chill/builtins.exp b/gdb/testsuite/gdb.chill/builtins.exp new file mode 100644 index 00000000000..6248bba466b --- /dev/null +++ b/gdb/testsuite/gdb.chill/builtins.exp @@ -0,0 +1,369 @@ +# 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 "builtins" +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_lower {} { + global passcount + + verbose "testing builtin LOWER" + set passcount 0 + + # discrete mode names + test_print_accept "print lower(bool)" "FALSE" + test_print_accept "print lower(char)" "C'00'" + test_print_accept "print lower(byte)" "-128" + test_print_accept "print lower(ubyte)" "0" + test_print_accept "print lower(int)" "-32768" + test_print_accept "print lower(uint)" "0" + test_print_accept "print lower(long)" "-2147483648" + test_print_accept "print lower(ulong)" "0" + test_print_accept "print lower(m_set)" "e1" + test_print_accept "print lower(m_set_range)" "e2" + test_print_accept "print lower(m_char_range)" "'A'" + test_print_accept "print lower(m_bool_range)" "FALSE" + test_print_accept "print lower(m_long_range)" "255" + test_print_accept "print lower(m_range)" "12" + + # 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_byte)" "-128" + test_print_accept "print lower(v_ubyte)" "0" + test_print_accept "print lower(v_int)" "-32768" + test_print_accept "print lower(v_uint)" "0" + test_print_accept "print lower(v_long)" "-2147483648" + test_print_accept "print lower(v_ulong)" "0" + test_print_accept "print lower(v_set)" "e1" + test_print_accept "print lower(v_set_range)" "e2" + test_print_accept "print lower(v_char_range)" "'A'" + test_print_accept "print lower(v_bool_range)" "FALSE" + test_print_accept "print lower(v_long_range)" "255" + test_print_accept "print lower(v_range)" "12" + + # string mode names + test_print_accept "print lower(m_chars)" "0" + test_print_accept "print lower(m_chars_v)" "0" + test_print_accept "print lower(m_bits)" "0" + + # string locations + test_print_accept "print lower(v_chars)" "0" + test_print_accept "print lower(v_chars_v)" "0" + test_print_accept "print lower(v_bits)" "0" + + # string expressions + test_print_accept "print lower(\"abcd\")" "0" + test_print_accept "print lower(B'010101')" "0" + + # 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_bool_arr)" "FALSE" + test_print_accept "print lower(m_int_arr)" "-32768" + test_print_accept "print lower(m_set_arr)" "e1" + test_print_accept "print lower(m_set_range_arr)" "e2" + test_print_accept "print lower(m_char_range_arr)" "'A'" + test_print_accept "print lower(m_bool_range_arr)" "FALSE" + test_print_accept "print lower(m_long_range_arr)" "255" + test_print_accept "print lower(m_range_arr)" "12" + + # 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_bool_arr)" "FALSE" + test_print_accept "print lower(v_int_arr)" "-32768" + test_print_accept "print lower(v_set_arr)" "e1" + test_print_accept "print lower(v_set_range_arr)" "e2" + test_print_accept "print lower(v_char_range_arr)" "'A'" + test_print_accept "print lower(v_bool_range_arr)" "FALSE" + test_print_accept "print lower(v_long_range_arr)" "255" + test_print_accept "print lower(v_range_arr)" "12" +} + +proc test_upper {} { + global passcount + + verbose "testing builtin UPPER" + set passcount 0 + + # discrete mode names + test_print_accept "print upper(bool)" "TRUE" + test_print_accept "print upper(char)" "C'ff'" + test_print_accept "print upper(byte)" "127" + test_print_accept "print upper(ubyte)" "255" + test_print_accept "print upper(int)" "32767" + test_print_accept "print upper(uint)" "65535" + test_print_accept "print upper(long)" "2147483647" + test_print_accept "print upper(ulong)" "4294967295" + test_print_accept "print upper(m_set)" "e6" + test_print_accept "print upper(m_set_range)" "e5" + test_print_accept "print upper(m_char_range)" "'Z'" + test_print_accept "print upper(m_bool_range)" "FALSE" + test_print_accept "print upper(m_long_range)" "3211" + test_print_accept "print upper(m_range)" "28" + + # 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_byte)" "127" + test_print_accept "print upper(v_ubyte)" "255" + test_print_accept "print upper(v_int)" "32767" + test_print_accept "print upper(v_uint)" "65535" + test_print_accept "print upper(v_long)" "2147483647" + test_print_accept "print upper(v_ulong)" "4294967295" + test_print_accept "print upper(v_set)" "e6" + test_print_accept "print upper(v_set_range)" "e5" + test_print_accept "print upper(v_char_range)" "'Z'" + test_print_accept "print upper(v_bool_range)" "FALSE" + test_print_accept "print upper(v_long_range)" "3211" + test_print_accept "print upper(v_range)" "28" + + # string mode names + test_print_accept "print upper(m_chars)" "19" + test_print_accept "print upper(m_chars_v)" "19" + test_print_accept "print upper(m_bits)" "9" + + # string locations + test_print_accept "print upper(v_chars)" "19" + test_print_accept "print upper(v_chars_v)" "19" + test_print_accept "print upper(v_bits)" "9" + + # string expressions + test_print_accept "print upper(\"abcd\")" "3" + test_print_accept "print upper(B'010101')" "5" + + # 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_bool_arr)" "TRUE" + test_print_accept "print upper(m_int_arr)" "32767" + test_print_accept "print upper(m_set_arr)" "e6" + test_print_accept "print upper(m_set_range_arr)" "e5" + test_print_accept "print upper(m_char_range_arr)" "'Z'" + test_print_accept "print upper(m_bool_range_arr)" "FALSE" + test_print_accept "print upper(m_long_range_arr)" "3211" + test_print_accept "print upper(m_range_arr)" "28" + + # 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_bool_arr)" "TRUE" + test_print_accept "print upper(v_int_arr)" "32767" + test_print_accept "print upper(v_set_arr)" "e6" + test_print_accept "print upper(v_set_range_arr)" "e5" + test_print_accept "print upper(v_char_range_arr)" "'Z'" + test_print_accept "print upper(v_bool_range_arr)" "FALSE" + test_print_accept "print upper(v_long_range_arr)" "3211" + test_print_accept "print upper(v_range_arr)" "28" +} + +proc test_length {} { + global passcount + + verbose "testing builtin LENGTH" + set passcount 0 + + # string locations + test_print_accept "print length(v_chars)" "20" + test_print_accept "print length(v_chars_v)" "7"; + test_print_accept "print length(v_bits)" "10"; + + # string expressions + test_print_accept "print length(\"the quick brown fox ...\")" "23" + test_print_accept "print length(B'010101010101')" "12" + + # check some failures + setup_xfail "*-*-*" + test_print_accept "print length(m_chars)" "typename in invalid context" + setup_xfail "*-*-*" + test_print_accept "print length(v_byte)" "bad argument to LENGTH builtin" +} + +proc test_size {} { + global passcount + + verbose "testing builtin SIZE" + set passcount 0 + + # modes + test_print_accept "print size(bool)" "1" + test_print_accept "print size(char)" "1" + test_print_accept "print size(byte)" "1" + test_print_accept "print size(int)" "2" + test_print_accept "print size(ulong)" "4" + test_print_accept "print size(ptr)" "4" + test_print_accept "print size(m_set)" "1" + test_print_accept "print size(m_char_range)" "1" + test_print_accept "print size(m_range_arr)" "17" + test_print_accept "print size(m_chars)" "20" + test_print_accept "print size(m_chars_v)" "22" + test_print_accept "print size(m_bits)" "2" + test_print_accept "print size(m_struct)" "36" + + # locations + test_print_accept "print size(v_bool)" "1" + test_print_accept "print size(v_char)" "1" + test_print_accept "print size(v_byte)" "1" + test_print_accept "print size(v_int)" "2" + test_print_accept "print size(v_ulong)" "4" + test_print_accept "print size(v_ptr)" "4" + test_print_accept "print size(v_set)" "1" + test_print_accept "print size(v_char_range)" "1" + test_print_accept "print size(v_range_arr)" "17" + test_print_accept "print size(v_chars)" "20" + test_print_accept "print size(v_chars_v)" "22" + test_print_accept "print size(v_bits)" "2" + test_print_accept "print size(v_struct)" "36" +} + +proc test_num {} { + global passcount + + verbose "testing builtin NUM" + set passcount 0 + + # constants + test_print_accept "print num(false)" "0" + test_print_accept "print num(true)" "1" + test_print_accept "print num(10)" "10" + test_print_accept "print num(33-34)" "-1" + test_print_accept "print num('X')" "88" + test_print_accept "print num(e5)" "4" + + # locations + test_print_accept "print num(v_bool)" "0" + test_print_accept "print num(v_char)" "88" + test_print_accept "print num(v_byte)" "-30" + test_print_accept "print num(v_ubyte)" "30" + test_print_accept "print num(v_int)" "-333" + test_print_accept "print num(v_uint)" "333" + test_print_accept "print num(v_long)" "-4444" + test_print_accept "print num(v_ulong)" "4444" + test_print_accept "print num(v_set)" "2" + test_print_accept "print num(v_set_range)" "2" + test_print_accept "print num(v_char_range)" "71" + test_print_accept "print num(v_long_range)" "1000" + test_print_accept "print num(v_range)" "23" +} + +# 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_num + test_size + test_lower + test_upper + test_length +} else { + warning "$test_name tests suppressed." +} -- 2.30.2