--- /dev/null
+# .Sanitize for gdb/testsuite/gdb.chill.
+
+# Each directory to survive its way into a release will need a file
+# like this one called "./.Sanitize". All keyword lines must exist,
+# and must exist in the order specified by this file. Each directory
+# in the tree will be processed, top down, in the following order.
+
+# Hash started lines like this one are comments and will be deleted
+# before anything else is done. Blank lines will also be squashed
+# out.
+
+# The lines between the "Do-first:" line and the "Things-to-keep:"
+# line are executed as a /bin/sh shell script before anything else is
+# done in this directory.
+
+Do-first:
+
+# All files listed between the "Things-to-keep:" line and the
+# "Do-last:" line will be kept. All other files will be removed.
+# Directories listed in this section will have their own Sanitize
+# called. Directories not listed will be removed in their entirety
+# with rm -rf.
+
+Things-to-keep:
+
+Makefile.in
+chexp.exp
+chillvars.ch
+chillvars.exp
+configure.in
+
+Things-to-lose:
+
+# The lines between the "Do-last:" line and the end of the file
+# are executed as a /bin/sh shell script after everything else is
+# done.
+
+Do-last:
+
+# eof
--- /dev/null
+# Makefile for regression testing Chill support for the GNU debugger.
+# Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+
+# This file is part of GDB.
+
+# GDB 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, or (at your option)
+# any later version.
+
+# GDB 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; see the file COPYING. If not, write to
+# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+srcdir = .
+prefix = /usr/local
+program_transform_name =
+
+exec_prefix = $(prefix)
+bindir = $(exec_prefix)/bin
+libdir = $(exec_prefix)/lib
+tooldir = $(libdir)/$(target_alias)
+
+datadir = $(exec_prefix)/lib/dejagnu
+mandir = $(prefix)/man
+man1dir = $(mandir)/man1
+man2dir = $(mandir)/man2
+man3dir = $(mandir)/man3
+man4dir = $(mandir)/man4
+man5dir = $(mandir)/man5
+man6dir = $(mandir)/man6
+man7dir = $(mandir)/man7
+man8dir = $(mandir)/man8
+man9dir = $(mandir)/man9
+infodir = $(prefix)/info
+includedir = $(prefix)/include
+gxx_includedir = $(tooldir)/g++-include
+docdir = $(datadir)/doc
+targetdir = $(datadir)/$(target_alias)
+
+SHELL = /bin/sh
+
+INSTALL = install -c
+INSTALL_PROGRAM = $(INSTALL)
+INSTALL_DATA = $(INSTALL)
+
+RUNTEST = runtest
+
+RUNTESTFLAGS =
+
+EXPECT = `if [ -f $${rootme}/../../expect/expect ] ; then \
+ echo $${rootme}/../../expect/expect ; \
+ else echo expect ; fi`
+
+RUNTEST_FOR_TARGET = ` \
+ if [ -f $${rootme}/../../dejagnu/site.exp ] ; then \
+ echo $${rootme}/../../dejagnu/runtest ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(RUNTEST); \
+ else \
+ t='$(program_transform_name)'; echo runtest | sed -e '' $$t; \
+ fi; \
+ fi`
+
+CHILLFLAGS = $(CFLAGS)
+
+CHILL_FOR_TARGET = ` \
+ if [ -f $${rootme}/../../gcc/Makefile ] ; then \
+ echo $${rootme}/../../gcc/xgcc -B$${rootme}../../gcc/; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo gcc; \
+ else \
+ t='$(program_transform_name)'; echo gcc | sed -e '' $$t; \
+ fi; \
+ fi`
+
+CHILL = $(CHILL_FOR_TARGET)
+
+CHILL_LIB = ` \
+ if [ -f $${rootme}/../../gcc/ch/runtime/libchill.a ] ; then \
+ echo $${rootme}/../../gcc/ch/runtime/chillrt0.o \
+ $${rootme}/../../gcc/ch/runtime/libchill.a; \
+ else \
+ echo -lchill; \
+ fi`
+
+GDB = ` \
+ if [ -f $${rootme}/../gdb ] ; \
+ then echo $${rootme}|sed -e 's@/[^/]*$$@@'|sed -e 's@$$@/gdb@' ; \
+ else echo gdb; \
+ fi`
+
+GDBFLAGS = -nx
+
+#### host, target, and site specific Makefile frags come in here.
+
+EXECUTABLES = chillvars
+
+all: $(EXECUTABLES)
+
+chillvars: chillvars.o
+ $(CHILL_FOR_TARGET) $(CHILLFLAGS) $(LDFLAGS) -o chillvars chillvars.o $(CHILL_LIB) $(LIBS)
+
+chillvars.o: chillvars.ch
+ $(CHILL_FOR_TARGET) $(CHILLFLAGS) -fspecial_UC -c $(srcdir)/chillvars.ch
+
+.NOEXPORT:
+INFODIRS=doc
+info:
+install-info:
+dvi:
+
+install:
+
+uninstall: force
+
+site.exp: ./config.status Makefile
+ @echo "Making a new config file..."
+ -@rm -f ./tmp?
+ @touch site.exp
+ -@mv site.exp site.bak
+ @echo "## these variables are automatically generated by make ##" > ./tmp0
+ @echo "# Do not edit here. If you wish to override these values" >> ./tmp0
+ @echo "# add them to the last section" >> ./tmp0
+ @echo "set GDBFLAGS \"${GDBFLAGS}\"" >> ./tmp0
+ @echo "set host_os ${host_os}" >> ./tmp0
+ @echo "set host_alias ${host_alias}" >> ./tmp0
+ @echo "set host_cpu ${host_cpu}" >> ./tmp0
+ @echo "set host_vendor ${host_vendor}" >> ./tmp0
+ @echo "set target_os ${target_os}" >> ./tmp0
+ @echo "set target_alias ${target_alias}" >> ./tmp0
+ @echo "set target_cpu ${target_cpu}" >> ./tmp0
+ @echo "set target_vendor ${target_vendor}" >> ./tmp0
+ @echo "set host_triplet ${host_canonical}" >> ./tmp0
+ @echo "set target_triplet ${target_canonical}" >> ./tmp0
+ @echo "set srcdir ${srcdir}" >> ./tmp0
+ @echo "set objdir `pwd`" >> ./tmp0
+ @echo "set tool gdb" >> ./tmp0
+ @echo "## All variables above are generated by configure. Do Not Edit ##" >> ./tmp0
+ @cat ./tmp0 > site.exp
+ @cat site.bak | sed \
+ -e '1,/^## All variables above are.*##/ d' >> site.exp
+ -@rm -f ./tmp?
+
+installcheck:
+check: site.exp all just-check
+just-check:
+ rootme=`pwd`; export rootme; \
+ srcdir=${srcdir} ; export srcdir ; \
+ EXPECT=${EXPECT} ; export EXPECT ; \
+ if [ -f $${rootme}/../../expect/expect ] ; then \
+ TCL_LIBRARY=$${srcdir}/../../tcl/library ; \
+ export TCL_LIBRARY ; fi ; \
+ $(RUNTEST_FOR_TARGET) $(RUNTESTFLAGS) --tool gdb GDB=$(GDB) --srcdir $(srcdir)
+
+clean mostlyclean:
+ -rm -f *~ core *.o a.out xgdb *.x $(EXECUTABLES)
+
+distclean realclean: clean
+ -rm -f *~ core *.log *.plog *.sum *.psum site.*
+ -rm -f Makefile config.status *-init.exp
+ -rm -fr *.log summary detail *.plog *.sum *.psum site.*
+
+Makefile : $(srcdir)/Makefile.in $(srcdir)/configure.in $(host_makefile_frag) $(target_makefile_frag)
+ $(SHELL) ./config.status
+
--- /dev/null
+# Copyright (C) 1992 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-gdb@prep.ai.mit.edu
+
+# This file was written by Fred Fish. (fnf@cygnus.com)
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+set prms_id 0
+set bug_id 0
+
+# 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
+
+ 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\""
+ return 1
+ }
+ -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]
+ 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
+ }
+ }
+}
+
+proc test_integer_literals_accepted {} {
+ global prompt
+ global passcount
+
+ set passcount 0
+
+ # Test various decimal values.
+
+ test_print_accept "p 123" "123"
+ test_print_accept "p -123" "-123"
+ test_print_accept "p D'123" "123"
+ test_print_accept "p d'123" "123"
+ test_print_accept "p -D'123" "-123"
+ test_print_accept "p -d'123" "-123"
+ test_print_accept "p 123_456" "123456"
+ test_print_accept "p __1_2_3__" "123"
+ test_print_accept "p/d 123" "D'123"
+
+ # Test various binary values.
+
+ test_print_accept "p B'111" "7"
+ test_print_accept "p b'111" "7"
+ test_print_accept "p -B'111" "-7"
+ test_print_accept "p B'0111" "7"
+ test_print_accept "p b'0111" "7"
+ test_print_accept "p -b'0111" "-7"
+ test_print_accept "p B'_0_1_1_1_" "7"
+ test_print_accept "p b'_0_1_1_1_" "7"
+ test_print_accept "p -b'_0_1_1_1_" "-7"
+ test_print_accept "p/t B'111" "B'111"
+
+ # Test various octal values.
+
+ test_print_accept "p O'123" "83"
+ test_print_accept "p o'123" "83"
+ test_print_accept "p -o'0123" "-83"
+ test_print_accept "p O'0123" "83"
+ test_print_accept "p o'0123" "83"
+ test_print_accept "p -o'123" "-83"
+ test_print_accept "p O'_1_2_3_" "83"
+ test_print_accept "p o'_1_2_3_" "83"
+ test_print_accept "p -o'_1_2_3_" "-83"
+ test_print_accept "p/o O'123" "O'123"
+
+ # Test various hexadecimal values.
+
+ test_print_accept "p H'123" "291"
+ test_print_accept "p h'123" "291"
+ test_print_accept "p -h'123" "-291"
+ test_print_accept "p H'0123" "291"
+ test_print_accept "p h'0123" "291"
+ test_print_accept "p -h'0123" "-291"
+ test_print_accept "p H'_1_2_3_" "291"
+ test_print_accept "p h'_1_2_3_" "291"
+ test_print_accept "p -h'_1_2_3_" "-291"
+ test_print_accept "p H'ABCDEF" "11259375"
+ test_print_accept "p H'abcdef" "11259375"
+ test_print_accept "p H'AbCdEf" "11259375"
+ test_print_accept "p H'_A_b_C_d_E_f_" "11259375"
+ test_print_accept "p/x H'123" "H'123"
+
+ if $passcount then {
+ pass "$passcount correct integer literals printed"
+ }
+}
+
+proc test_character_literals_accepted {} {
+ global prompt
+ global passcount
+
+ set passcount 0
+
+ # Test various decimal values.
+
+ test_print_accept "p 'a'" "'a'"
+ test_print_accept "p/x 'a'" "H'61"
+ test_print_accept "p/d 'a'" "D'97"
+ test_print_accept "p/t 'a'" "B'1100001"
+ # test_print_accept "p '^(97)'" "'a'" (not in GNU Chill)
+ test_print_accept "p C'61'" "'a'"
+ test_print_accept "p c'61'" "'a'"
+ test_print_accept "p/x C'FF'" "H'ff"
+ # test_print_accept "p/x '^(H'FF)'" "H'ff" (not in GNU Chill)
+ # test_print_accept "p/x '^(D'255)'" "H'ff" (not in GNU Chill)
+
+ if $passcount then {
+ pass "$passcount correct character literals printed"
+ }
+}
+
+# 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 ".*Invalid syntax 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
+ }
+ }
+}
+
+proc test_integer_literals_rejected {} {
+ global prompt
+ global passcount
+
+ set passcount 0
+
+ # These are valid integer literals in Z.200, but not GNU-Chill.
+
+ test_print_reject "p _"
+ test_print_reject "p __"
+
+ test_print_reject "p D'"
+ test_print_reject "p D'_"
+ test_print_reject "p D'__"
+
+ test_print_reject "p B'"
+ test_print_reject "p B'_"
+ test_print_reject "p B'__"
+
+ test_print_reject "p O'"
+ test_print_reject "p O'_"
+ test_print_reject "p O'__"
+
+ test_print_reject "p H'"
+ test_print_reject "p H'_"
+ test_print_reject "p H'__"
+
+ # Test various decimal values.
+
+ test_print_reject "p D'DEADBEEF"
+ test_print_reject "p D'123DEADBEEF"
+
+ # Test various binary values.
+
+ test_print_reject "p B'2"
+ test_print_reject "p B'12"
+
+ # Test various octal values.
+
+ test_print_reject "p O'9"
+ test_print_reject "p O'79"
+
+ # Test various hexadecimal values.
+
+ test_print_reject "p H'G"
+ test_print_reject "p H'AG"
+
+ if $passcount then {
+ pass "$passcount incorrect integer literals rejected"
+ }
+}
+
+proc test_boolean_literals_accepted {} {
+ global prompt
+ global passcount
+
+ set passcount 0
+
+ # Test the only possible values for a boolean, TRUE and FALSE.
+
+ test_print_accept "p TRUE" "TRUE"
+ test_print_accept "p FALSE" "FALSE"
+
+ if $passcount then {
+ pass "$passcount correct boolean literals printed"
+ }
+}
+
+proc test_float_literals_accepted {} {
+ global prompt
+ global passcount
+
+ set passcount 0
+
+ # Test various floating point formats
+
+ test_print_accept "p .44 < .45" "1"
+ test_print_accept "p .44 > .45" "0"
+ test_print_accept "p 0.44 < 0.45" "1"
+ test_print_accept "p 0.44 > 0.45" "0"
+ test_print_accept "p 44. < 45." "1"
+ test_print_accept "p 44. > 45." "0"
+ test_print_accept "p 44.0 < 45.0" "1"
+ test_print_accept "p 44.0 > 45.0" "0"
+ test_print_accept "p 10D20 < 10D21" "1"
+ test_print_accept "p 10D20 > 10D21" "0"
+ test_print_accept "p 10d20 < 10d21" "1"
+ test_print_accept "p 10d20 > 10d21" "0"
+ test_print_accept "p 10E20 < 10E21" "1"
+ test_print_accept "p 10E20 > 10E21" "0"
+ test_print_accept "p 10e20 < 10e21" "1"
+ test_print_accept "p 10e20 > 10e21" "0"
+ test_print_accept "p 10.D20 < 10.D21" "1"
+ test_print_accept "p 10.D20 > 10.D21" "0"
+ test_print_accept "p 10.d20 < 10.d21" "1"
+ test_print_accept "p 10.d20 > 10.d21" "0"
+ test_print_accept "p 10.E20 < 10.E21" "1"
+ test_print_accept "p 10.E20 > 10.E21" "0"
+ test_print_accept "p 10.e20 < 10.e21" "1"
+ test_print_accept "p 10.e20 > 10.e21" "0"
+ test_print_accept "p 10.0D20 < 10.0D21" "1"
+ test_print_accept "p 10.0D20 > 10.0D21" "0"
+ test_print_accept "p 10.0d20 < 10.0d21" "1"
+ test_print_accept "p 10.0d20 > 10.0d21" "0"
+ test_print_accept "p 10.0E20 < 10.0E21" "1"
+ test_print_accept "p 10.0E20 > 10.0E21" "0"
+ test_print_accept "p 10.0e20 < 10.0e21" "1"
+ test_print_accept "p 10.0e20 > 10.0e21" "0"
+ test_print_accept "p 10.0D+20 < 10.0D+21" "1"
+ test_print_accept "p 10.0D+20 > 10.0D+21" "0"
+ test_print_accept "p 10.0d+20 < 10.0d+21" "1"
+ test_print_accept "p 10.0d+20 > 10.0d+21" "0"
+ test_print_accept "p 10.0E+20 < 10.0E+21" "1"
+ test_print_accept "p 10.0E+20 > 10.0E+21" "0"
+ test_print_accept "p 10.0e+20 < 10.0e+21" "1"
+ test_print_accept "p 10.0e+20 > 10.0e+21" "0"
+ test_print_accept "p 10.0D-11 < 10.0D-10" "1"
+ test_print_accept "p 10.0D-11 > 10.0D-10" "0"
+ test_print_accept "p 10.0d-11 < 10.0d-10" "1"
+ test_print_accept "p 10.0d-11 > 10.0d-10" "0"
+ test_print_accept "p 10.0E-11 < 10.0E-10" "1"
+ test_print_accept "p 10.0E-11 > 10.0E-10" "0"
+ test_print_accept "p 10.0e-11 < 10.0e-10" "1"
+ test_print_accept "p 10.0e-11 > 10.0e-10" "0"
+ # looks funny, but apparently legal
+ test_print_accept "p _.1e+10 < _.1e+11" "1"
+ test_print_accept "p _.1e+10 > _.1e+11" "0"
+ test_print_accept "p __.1e-12 < __.1e-11" "1"
+ test_print_accept "p __.1e-12 > __.1e-11" "0"
+
+ if $passcount then {
+ pass "$passcount correct float literal comparisons"
+ }
+}
+
+proc test_convenience_variables {} {
+ global prompt
+
+ gdb_test "set \\\$foo := 101" " := 101" \
+ "Set a new convenience variable"
+
+ gdb_test "print \\\$foo" " = 101" \
+ "Print contents of new convenience variable"
+
+ gdb_test "set \\\$foo := 301" " := 301" \
+ "Set convenience variable to a new value"
+
+ gdb_test "print \\\$foo" " = 301" \
+ "Print new contents of convenience variable"
+
+ gdb_test "set \\\$_ := 11" " := 11" \
+ "Set convenience variable \$_"
+
+ gdb_test "print \\\$_" " = 11" \
+ "Print contents of convenience variable \$_"
+
+ gdb_test "print \\\$foo + 10" " = 311" \
+ "Use convenience variable in arithmetic expression"
+
+ gdb_test "print (\\\$foo := 32) + 4" " = 36" \
+ "Use convenience variable assignment in arithmetic expression"
+
+ gdb_test "print \\\$bar" " = void" \
+ "Print contents of uninitialized convenience variable"
+}
+
+proc test_value_history {} {
+ global prompt
+
+ gdb_test "print 101" "\\\$1 = 101" \
+ "Set value-history\[1\] using \$1"
+
+ gdb_test "print 102" "\\\$2 = 102" \
+ "Set value-history\[2\] using \$2"
+
+ gdb_test "print 103" "\\\$3 = 103" \
+ "Set value-history\[3\] using \$3"
+
+ gdb_test "print \\\$\\\$" "\\\$4 = 102" \
+ "Print value-history\[MAX-1\] using inplicit index \$\$"
+
+ gdb_test "print \\\$\\\$" "\\\$5 = 103" \
+ "Print value-history\[MAX-1\] again using implicit index \$\$"
+
+ gdb_test "print \\\$" "\\\$6 = 103" \
+ "Print value-history\[MAX\] using implicit index \$"
+
+ gdb_test "print \\\$\\\$2" "\\\$7 = 102" \
+ "Print value-history\[MAX-2\] using explicit index \$\$2"
+
+ gdb_test "print \\\$0" "\\\$8 = 102" \
+ "Print value-history\[MAX\] using explicit index \$0"
+
+ gdb_test "print 108" "\\\$9 = 108" ""
+
+ gdb_test "print \\\$\\\$0" "\\\$10 = 108" \
+ "Print value-history\[MAX\] using explicit index \$\$0"
+
+ gdb_test "print \\\$1" "\\\$11 = 101" \
+ "Print value-history\[1\] using explicit index \$1"
+
+ gdb_test "print \\\$2" "\\\$12 = 102" \
+ "Print value-history\[2\] using explicit index \$2"
+
+ gdb_test "print \\\$3" "\\\$13 = 103" \
+ "Print value-history\[3\] using explicit index \$3"
+
+ gdb_test "print \\\$-3" "\\\$14 = 100" \
+ "Print (value-history\[MAX\] - 3) using implicit index \$"
+
+ gdb_test "print \\\$1 + 3" "\\\$15 = 104" \
+ "Use value-history element in arithmetic expression"
+}
+
+proc test_arithmetic_expressions {} {
+ global prompt
+ global passcount
+
+ set passcount 0
+
+ # Test unary minus with various operands
+
+# test_print_accept "p -(TRUE)" "-1" "unary minus applied to bool"
+# test_print_accept "p -('a')" "xxx" "unary minus applied to char"
+ test_print_accept "p -(1)" "-1" "unary minus applied to int"
+ test_print_accept "p -(1.0)" "-1" "unary minus applied to real"
+
+ # Test addition with various operands
+
+ test_print_accept "p TRUE + 1" "2" "bool plus int"
+ test_print_accept "p 'a' + 1" "98" "char plus int"
+ test_print_accept "p 1 + 1" "2" "int plus int"
+ test_print_accept "p 1.0 + 1" "2" "real plus int"
+ test_print_accept "p 1.0 + 2.0" "3" "real plus real"
+
+ # Test subtraction with various operands
+
+ test_print_accept "p TRUE - 1" "0" "bool minus int"
+ test_print_accept "p 'b' - 1" "97" "char minus int"
+ test_print_accept "p 3 - 1" "2" "int minus int"
+ test_print_accept "p 3.0 - 1" "2" "real minus int"
+ test_print_accept "p 5.0 - 2.0" "3" "real minus real"
+
+ # Test multiplication with various operands
+
+ test_print_accept "p TRUE * 1" "1" "bool times int"
+ test_print_accept "p 'a' * 2" "194" "char times int"
+ test_print_accept "p 2 * 3" "6" "int times int"
+ test_print_accept "p 2.0 * 3" "6" "real times int"
+ test_print_accept "p 2.0 * 3.0" "6" "real times real"
+
+ # Test division with various operands
+
+ test_print_accept "p TRUE / 1" "1" "bool divided by int"
+ test_print_accept "p 'a' / 2" "48" "char divided by int"
+ test_print_accept "p 6 / 3" "2" "int divided by int"
+ test_print_accept "p 6.0 / 3" "2" "real divided by int"
+ test_print_accept "p 6.0 / 3.0" "2" "real divided by real"
+
+ # Test modulo with various operands
+
+ test_print_accept "p TRUE MOD 1" "0" "bool modulo int"
+ test_print_accept "p 'a' MOD 2" "1" "char modulo int"
+ test_print_accept "p -5 MOD 3" "1" "negative int modulo int"
+ test_print_accept "p 5 MOD 1" "0" "int modulo int"
+ test_print_accept "p 5 MOD 2" "1" "int modulo int"
+ test_print_accept "p 5 MOD 3" "2" "int modulo int"
+ test_print_accept "p 5 MOD 4" "1" "int modulo int"
+ test_print_accept "p 5 MOD 5" "0" "int modulo int"
+ test_print_accept "p 0 MOD 1" "0" "int modulo int"
+ test_print_accept "p 0 MOD 2" "0" "int modulo int"
+ test_print_accept "p 0 MOD 3" "0" "int modulo int"
+ test_print_accept "p 0 MOD 4" "0" "int modulo int"
+ test_print_accept "p -5 MOD 1" "0" "int modulo int"
+ test_print_accept "p -5 MOD 2" "1" "int modulo int"
+ test_print_accept "p -5 MOD 3" "1" "int modulo int"
+ test_print_accept "p -5 MOD 4" "3" "int modulo int"
+ test_print_accept "p -5 MOD 5" "0" "int modulo int"
+ test_print_accept "p -5 MOD 5" "0" "int modulo int"
+ test_print_reject "p 6.0 MOD 3" \
+ "Integer-only operation on floating point number.*"
+ test_print_reject "p 6.0 MOD 3.0" \
+ "Integer-only operation on floating point number.*"
+ test_print_reject "p -5 MOD -1" \
+ "Second operand of MOD must be greater than zero.*"
+ test_print_reject "p -5 MOD 0" \
+ "Second operand of MOD must be greater than zero.*"
+
+ # Test remainder with various operands
+
+ test_print_accept "p TRUE REM 1" "0" "bool remainder int"
+ test_print_accept "p 'a' REM 2" "1" "char remainder int"
+ test_print_accept "p 5 REM 5" "0" "int remainder int"
+ test_print_accept "p 5 REM 4" "1" "int remainder int"
+ test_print_accept "p 5 REM 3" "2" "int remainder int"
+ test_print_accept "p 5 REM 2" "1" "int remainder int"
+ test_print_accept "p 5 REM 1" "0" "int remainder int"
+ test_print_accept "p 5 REM -1" "0" "int remainder int"
+ test_print_accept "p 5 REM -2" "1" "int remainder int"
+ test_print_accept "p 5 REM -3" "2" "int remainder int"
+ test_print_accept "p 5 REM -4" "1" "int remainder int"
+ test_print_accept "p 5 REM -5" "0" "int remainder int"
+ test_print_accept "p -5 REM 5" "0" "int remainder int"
+ test_print_accept "p -5 REM 4" "-1" "int remainder int"
+ test_print_accept "p -5 REM 3" "-2" "int remainder int"
+ test_print_accept "p -5 REM 2" "-1" "int remainder int"
+ test_print_accept "p -5 REM 1" "0" "int remainder int"
+ test_print_accept "p -5 REM -1" "0" "int remainder int"
+ test_print_accept "p -5 REM -2" "-1" "int remainder int"
+ test_print_accept "p -5 REM -3" "-2" "int remainder int"
+ test_print_accept "p -5 REM -4" "-1" "int remainder int"
+ test_print_accept "p -5 REM -5" "0" "int remainder int"
+ test_print_accept "p 6 REM 3" "0" "int remainder int"
+ test_print_reject "p 6.0 REM 3" \
+ "Integer-only operation on floating point number.*"
+ test_print_reject "p 6.0 REM 3.0" \
+ "Integer-only operation on floating point number.*"
+
+ if $passcount then {
+ pass "$passcount correct arithmetic expressions"
+ }
+}
+
+# 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_value_history
+ test_convenience_variables
+ test_integer_literals_accepted
+ test_integer_literals_rejected
+ test_boolean_literals_accepted
+ test_character_literals_accepted
+ test_float_literals_accepted
+ test_arithmetic_expressions
+} else {
+ warning "$test_name tests suppressed."
+}
--- /dev/null
+testvars: MODULE
+
+DCL bool_true BOOL := TRUE;
+DCL bool_false BOOL := FALSE;
+DCL booltable1 ARRAY (0:3) BOOL INIT := [ TRUE, FALSE, FALSE, TRUE ];
+DCL booltable2 ARRAY (4:7) BOOL INIT := [ TRUE, FALSE, FALSE, TRUE ];
+
+DCL control_char CHAR := C'07';
+DCL printable_char CHAR := 'a';
+DCL chartable1 ARRAY (0:2) CHAR INIT := [ C'00', C'01', C'02' ];
+DCL chartable2 ARRAY (3:5) CHAR INIT := [ C'00', C'01', C'02' ];
+
+DCL string1 CHARS (4) := 'abcd';
+DCL string2 CHARS (5) := 'ef' // C'00' // 'gh';
+DCL string3 CHARS (6) := 'ef' // 'gh' // 'ij';
+DCL string4 CHARS (7) := (6) 'z' // C'00';
+
+DCL byte_low BYTE := -128;
+DCL byte_high BYTE := 127;
+DCL bytetable1 ARRAY (0:4) BYTE INIT := [ -2, -1, 0, 1, 2 ];
+DCL bytetable2 ARRAY (5:9) BYTE INIT := [ -2, -1, 0, 1, 2 ];
+DCL bytetable3 ARRAY (1:2,'c':'d',FALSE:TRUE) BYTE
+ INIT := [ [ [ 0, 1 ], [ 2, 3 ] ], [ [ 4, 5 ], [ 6, 7 ] ] ];
+DCL bytetable4 ARRAY (1:2) ARRAY ('c':'d') ARRAY (FALSE:TRUE) BYTE
+ INIT := [ [ [ 0, 1 ], [ 2, 3 ] ], [ [ 4, 5 ], [ 6, 7 ] ] ];
+
+DCL ubyte_low UBYTE := 0;
+DCL ubyte_high UBYTE := 255;
+DCL ubytetable1 ARRAY (0:4) UBYTE INIT := [ 0, 1, 2, 3, 4 ];
+DCL ubytetable2 ARRAY (5:9) UBYTE INIT := [ 0, 1, 2, 3, 4 ];
+
+DCL int_low INT := -32_768;
+DCL int_high INT := 32_767;
+DCL inttable1 ARRAY (0:4) INT INIT := [ -2, -1, 0, 1, 2 ];
+DCL inttable2 ARRAY (5:9) INT INIT := [ -2, -1, 0, 1, 2 ];
+
+DCL uint_low UINT := 0;
+DCL uint_high UINT := 65_535;
+DCL uinttable1 ARRAY (0:4) UINT INIT := [ 0, 1, 2, 3, 4 ];
+DCL uinttable2 ARRAY (5:9) UINT INIT := [ 0, 1, 2, 3, 4 ];
+
+DCL long_low LONG := -2_147_483_648;
+DCL long_high LONG := 2_147_483_647;
+DCL longtable1 ARRAY (0:4) LONG INIT := [ -2, -1, 0, 1, 2 ];
+DCL longtable2 ARRAY (5:9) LONG INIT := [ -2, -1, 0, 1, 2 ];
+
+DCL ulong_low ULONG := 0;
+DCL ulong_high ULONG := 4_294_967_295;
+DCL ulongtable1 ARRAY (0:4) ULONG INIT := [ 0, 1, 2, 3, 4 ];
+DCL ulongtable2 ARRAY (5:9) ULONG INIT := [ 0, 1, 2, 3, 4 ];
+
+DCL real1 FLOAT := 3.14159265358;
+DCL real2 FLOAT := -3.14159265358;
+DCL realtable1 ARRAY (0:4) FLOAT INIT := [ -2.0, -1.0, 0.0, 1.0, 2.0 ];
+DCL realtable2 ARRAY (5:9) FLOAT INIT := [ -2.0, -1.0, 0.0, 1.0, 2.0 ];
+
+DCL long_real1 DOUBLE := 3.14e300;
+DCL long_real2 DOUBLE := -3.14e-300;
+DCL longrealtable1 ARRAY (0:4) DOUBLE INIT := [ -2.0, -1.0, 0.0, 1.0, 2.0 ];
+DCL longrealtable2 ARRAY (5:9) DOUBLE INIT := [ -2.0, -1.0, 0.0, 1.0, 2.0 ];
+
+/* DCL powerset1 POWERSET INT(0:7);*/
+/* DCL chars1 CHAR (16) INIT := (16)'b'; */
+/* DCL bits1 BIT(20) := B'11111111000010101011'; */
+
+NEWMODE simple_struct = STRUCT (abool BOOL, aint INT, astring CHARS (8));
+DCL struct1 simple_struct := [ TRUE, 123, "a string" ];
+
+NEWMODE nested_struct = STRUCT (abool BOOL, nstruct simple_struct, aint INT);
+DCL struct2 nested_struct := [ TRUE, [ FALSE, 456, "deadbeef" ], 789 ];
+
+/* This table is used as a source for every ascii character. */
+
+DCL asciitable ARRAY (0:255) CHAR INIT := [
+ C'00', C'01', C'02', C'03', C'04', C'05', C'06', C'07',
+ C'08', C'09', C'0a', C'0b', C'0c', C'0d', C'0e', C'0f',
+ C'10', C'11', C'12', C'13', C'14', C'15', C'16', C'17',
+ C'18', C'19', C'1a', C'1b', C'1c', C'1d', C'1e', C'1f',
+ C'20', C'21', C'22', C'23', C'24', C'25', C'26', C'27',
+ C'28', C'29', C'2a', C'2b', C'2c', C'2d', C'2e', C'2f',
+ C'30', C'31', C'32', C'33', C'34', C'35', C'36', C'37',
+ C'38', C'39', C'3a', C'3b', C'3c', C'3d', C'3e', C'3f',
+ C'40', C'41', C'42', C'43', C'44', C'45', C'46', C'47',
+ C'48', C'49', C'4a', C'4b', C'4c', C'4d', C'4e', C'4f',
+ C'50', C'51', C'52', C'53', C'54', C'55', C'56', C'57',
+ C'58', C'59', C'5a', C'5b', C'5c', C'5d', C'5e', C'5f',
+ C'60', C'61', C'62', C'63', C'64', C'65', C'66', C'67',
+ C'68', C'69', C'6a', C'6b', C'6c', C'6d', C'6e', C'6f',
+ C'70', C'71', C'72', C'73', C'74', C'75', C'76', C'77',
+ C'78', C'79', C'7a', C'7b', C'7c', C'7d', C'7e', C'7f',
+ C'80', C'81', C'82', C'83', C'84', C'85', C'86', C'87',
+ C'88', C'89', C'8a', C'8b', C'8c', C'8d', C'8e', C'8f',
+ C'90', C'91', C'92', C'93', C'94', C'95', C'96', C'97',
+ C'98', C'99', C'9a', C'9b', C'9c', C'9d', C'9e', C'9f',
+ C'a0', C'a1', C'a2', C'a3', C'a4', C'a5', C'a6', C'a7',
+ C'a8', C'a9', C'aa', C'ab', C'ac', C'ad', C'ae', C'af',
+ C'b0', C'b1', C'b2', C'b3', C'b4', C'b5', C'b6', C'b7',
+ C'b8', C'b9', C'ba', C'bb', C'bc', C'bd', C'be', C'bf',
+ C'c0', C'c1', C'c2', C'c3', C'c4', C'c5', C'c6', C'c7',
+ C'c8', C'c9', C'ca', C'cb', C'cc', C'cd', C'ce', C'cf',
+ C'd0', C'd1', C'd2', C'd3', C'd4', C'd5', C'd6', C'd7',
+ C'd8', C'd9', C'da', C'db', C'dc', C'dd', C'de', C'df',
+ C'e0', C'e1', C'e2', C'e3', C'e4', C'e5', C'e6', C'e7',
+ C'e8', C'e9', C'ea', C'eb', C'ec', C'ed', C'ee', C'ef',
+ C'f0', C'f1', C'f2', C'f3', C'f4', C'f5', C'f6', C'f7',
+ C'f8', C'f9', C'fa', C'fb', C'fc', C'fd', C'fe', C'ff'
+];
+
+DCL charmatrix ARRAY (0:255) CHAR INIT := [
+ 'a','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X',
+ 'a','a','X','X','X','X','X','X','X','X','X','X','X','X','X','X',
+ 'a','a','a','X','X','X','X','X','X','X','X','X','X','X','X','X',
+ 'a','a','a','a','X','X','X','X','X','X','X','X','X','X','X','X',
+ 'a','a','a','a','a','X','X','X','X','X','X','X','X','X','X','X',
+ 'a','a','a','a','a','a','X','X','X','X','X','X','X','X','X','X',
+ 'a','a','a','a','a','a','a','X','X','X','X','X','X','X','X','X',
+ 'a','a','a','a','a','a','a','a','X','X','X','X','X','X','X','X',
+ 'a','a','a','a','a','a','a','a','a','X','X','X','X','X','X','X',
+ 'a','a','a','a','a','a','a','a','a','a','X','X','X','X','X','X',
+ 'a','a','a','a','a','a','a','a','a','a','a','X','X','X','X','X',
+ 'a','a','a','a','a','a','a','a','a','a','a','a','X','X','X','X',
+ 'a','a','a','a','a','a','a','a','a','a','a','a','a','X','X','X',
+ 'a','a','a','a','a','a','a','a','a','a','a','a','a','a','X','X',
+ 'a','a','a','a','a','a','a','a','a','a','a','a','a','a','a','X',
+ 'a','a','a','a','a','a','a','a','a','a','a','a','a','a','a','a'
+];
+
+booleans: PROC ();
+
+ DCL val1 BOOL := TRUE;
+ DCL val2 BOOL := FALSE;
+ DCL val3 BOOL := TRUE;
+
+ val1 := TRUE XOR TRUE;
+ val1 := TRUE XOR FALSE;
+ val1 := FALSE XOR TRUE;
+ val1 := FALSE XOR FALSE;
+ val1 := val2 XOR val3;
+
+ val1 := TRUE AND TRUE;
+ val1 := TRUE AND FALSE;
+ val1 := FALSE AND TRUE;
+ val1 := FALSE AND FALSE;
+ val1 := val2 AND val3;
+
+ val1 := TRUE ANDIF TRUE;
+ val1 := TRUE ANDIF FALSE;
+ val1 := FALSE ANDIF TRUE;
+ val1 := FALSE ANDIF FALSE;
+ val1 := val2 ANDIF val3;
+
+ val1 := TRUE OR TRUE;
+ val1 := TRUE OR FALSE;
+ val1 := FALSE OR TRUE;
+ val1 := FALSE OR FALSE;
+ val1 := val2 OR val3;
+
+-- val1 := NOT TRUE;
+-- val1 := NOT FALSE;
+-- val1 := NOT val2;
+-- val1 := NOT val3;
+
+END booleans;
+
+scalar_arithmetic: PROC ();
+
+ DCL val1 INT := 1;
+ DCL val2 INT := 2;
+ DCL val3 INT := 3;
+
+ val1 := -val2;
+ val1 := val2 + val3;
+ val1 := val2 - val3;
+ val1 := val2 * val3;
+ val1 := val2 / val3;
+ val1 := val2 MOD val3;
+ val1 := val2 REM val3;
+
+END scalar_arithmetic;
+
+write_arrays: PROC ();
+
+ inttable1(0) := 0;
+ inttable1(1) := 1;
+ inttable1(2) := 2;
+ inttable1(3) := 3;
+ inttable1(4) := 4;
+ inttable2(5) := 5;
+ inttable2(6) := 6;
+ inttable2(7) := 7;
+ inttable2(8) := 8;
+ inttable2(9) := 9;
+
+END write_arrays;
+
+uint_low := 0;
+
+scalar_arithmetic ();
+write_arrays ();
+booleans ();
+
+END;
+
+PR_5020: MODULE
+ dummy_pr_5020: PROC ();
+ END;
+ NEWMODE x = STRUCT (l LONG, b BOOL);
+
+ DCL y ARRAY ('a':'b') x;
+
+ y('a').l := 10;
+ y('a').b := TRUE;
+ y('b').l := 111;
+ y('b').b := FALSE;
+ dummy_pr_5020 ();
+END;
--- /dev/null
+# Copyright (C) 1992 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-gdb@prep.ai.mit.edu
+
+# This file was written by Fred Fish. (fnf@cygnus.com)
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+proc do_tests {} {
+ global prms_id bug_id subdir objdir srcdir binfile prompt
+
+ set prms_id 0
+ set bug_id 0
+
+ # Start with a fresh gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load $objdir/$subdir/$binfile
+
+ send "set language chill\n" ; expect -re "$prompt $"
+
+ # This is needed (at least on SunOS4) to make sure the
+ # the symbol table is read.
+ send "break chillvars.ch:3\n" ; expect -re "$prompt $"
+ send "delete 1\n" ; expect -re "$prompt $"
+
+ send "set width 0\n" ; expect -re "$prompt $"
+ send "set print sevenbit-strings\n" ; expect -re "$prompt $"
+ send "set print address off\n" ; expect -re "$prompt $"
+
+ test_BOOL
+ test_CHAR
+ test_BYTE
+ test_UBYTE
+ test_INT
+ test_UINT
+ test_LONG
+ test_ULONG
+ test_REAL
+ test_LONG_REAL
+ test_POWERSET
+ test_arrays
+ test_strings
+ test_structs
+}
+
+proc test_BOOL {} {
+
+ gdb_test "ptype bool_true" "type = BOOL"
+ gdb_test "ptype bool_false" "type = BOOL"
+ gdb_test "whatis bool_true" "type = BOOL"
+ gdb_test "whatis bool_false" "type = BOOL"
+ gdb_test "print bool_false" " = FALSE"
+ gdb_test "print bool_true" " = TRUE"
+
+}
+
+proc test_CHAR {} {
+ gdb_test "ptype control_char" "type = CHAR"
+ gdb_test "whatis control_char" "type = CHAR"
+ gdb_test "print control_char" " = C'07'"
+ gdb_test "ptype printable_char" "type = CHAR"
+ gdb_test "whatis printable_char" "type = CHAR"
+ gdb_test "print printable_char" " = 'a'"
+}
+
+proc test_BYTE {} {
+ gdb_test "ptype byte_low" "type = BYTE"
+ gdb_test "whatis byte_low" "type = BYTE"
+ gdb_test "print byte_low" " = -128"
+ gdb_test "ptype byte_high" "type = BYTE"
+ gdb_test "whatis byte_high" "type = BYTE"
+ gdb_test "print byte_high" " = 127"
+}
+
+proc test_UBYTE {} {
+ gdb_test "ptype ubyte_low" "type = UBYTE"
+ gdb_test "whatis ubyte_low" "type = UBYTE"
+ gdb_test "print ubyte_low" " = 0"
+ gdb_test "ptype ubyte_high" "type = UBYTE"
+ gdb_test "whatis ubyte_high" "type = UBYTE"
+ gdb_test "print ubyte_high" " = 255"
+}
+
+proc test_INT {} {
+ gdb_test "ptype int_low" "type = INT"
+ gdb_test "whatis int_low" "type = INT"
+ gdb_test "print int_low" " = -32768"
+ gdb_test "ptype int_high" "type = INT"
+ gdb_test "whatis int_high" "type = INT"
+ gdb_test "print int_high" " = 32767"
+}
+
+proc test_UINT {} {
+ gdb_test "ptype uint_low" "type = UINT"
+ gdb_test "whatis uint_low" "type = UINT"
+ gdb_test "print uint_low" " = 0"
+ gdb_test "ptype uint_high" "type = UINT"
+ gdb_test "whatis uint_high" "type = UINT"
+ gdb_test "print uint_high" " = 65535"
+}
+
+proc test_LONG {} {
+ gdb_test "ptype long_low" "type = LONG"
+ gdb_test "whatis long_low" "type = LONG"
+ gdb_test "print long_low" " = -2147483648"
+ gdb_test "ptype long_high" "type = LONG"
+ gdb_test "whatis long_high" "type = LONG"
+ gdb_test "print long_high" " = 2147483647"
+}
+
+proc test_ULONG {} {
+ gdb_test "ptype ulong_low" "type = ULONG"
+ gdb_test "whatis ulong_low" "type = ULONG"
+ gdb_test "print ulong_low" " = 0"
+ gdb_test "ptype ulong_high" "type = ULONG"
+ gdb_test "whatis ulong_high" "type = ULONG"
+ gdb_test "print ulong_high" " = 4294967295"
+}
+
+proc test_REAL {} {
+ gdb_test "ptype real1" "type = FLOAT"
+ gdb_test "whatis real1" "type = FLOAT"
+ gdb_test "print real1" " = 3.14159274"
+}
+
+proc test_LONG_REAL {} {
+ gdb_test "ptype long_real1" "type = DOUBLE"
+ gdb_test "whatis long_real1" "type = DOUBLE"
+ gdb_test "print long_real1" " = 3\\.1400000000000001e\\+300"
+}
+
+proc test_POWERSET {} {
+}
+
+proc test_arrays {} {
+ gdb_test "ptype booltable1" "type = ARRAY \[(\]+0:3\[)\]+ BOOL"
+ gdb_test_exact "print booltable1" \
+ { = [(0): TRUE, (1:2): FALSE, (3): TRUE]}
+
+ gdb_test "ptype booltable2" "type = ARRAY \[(\]+4:7\[)\]+ BOOL"
+ gdb_test_exact "print booltable2" { = [(4): TRUE, (5:6): FALSE, (7): TRUE]}
+
+ gdb_test "ptype chartable1" "type = ARRAY \[(\]+0:2\[)\]+ CHAR"
+ gdb_test_exact "print chartable1" {= [(0): C'00', (1): C'01', (2): C'02']}
+
+ gdb_test "ptype chartable2" "type = ARRAY \[(\]+3:5\[)\]+ CHAR"
+ gdb_test_exact "print chartable2" \
+ {= [(3): C'00', (4): C'01', (5): C'02']}
+
+ gdb_test "ptype bytetable1" "type = ARRAY \[(\]+0:4\[)\]+ BYTE"
+ gdb_test_exact "print bytetable1" \
+ {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
+
+ gdb_test "ptype bytetable2" "type = ARRAY \[(\]+5:9\[)\]+ BYTE"
+ gdb_test_exact "print bytetable2" \
+ {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
+
+ gdb_test_exact "ptype bytetable3" \
+ {type = ARRAY (1:2) ARRAY ('c':'d') ARRAY (FALSE:TRUE) BYTE}
+ gdb_test_exact "print bytetable3" \
+ {= [(1): [('c'): [(FALSE): 0, (TRUE): 1], ('d'): [(FALSE): 2, (TRUE): 3]], (2): [('c'): [(FALSE): 4, (TRUE): 5], ('d'): [(FALSE): 6, (TRUE): 7]]]}
+ gdb_test_exact "ptype bytetable4" \
+ {type = ARRAY (1:2) ARRAY ('c':'d') ARRAY (FALSE:TRUE) BYTE}
+ gdb_test_exact "print bytetable4" \
+ {= [(1): [('c'): [(FALSE): 0, (TRUE): 1], ('d'): [(FALSE): 2, (TRUE): 3]], (2
+): [('c'): [(FALSE): 4, (TRUE): 5], ('d'): [(FALSE): 6, (TRUE): 7]]]}
+
+ gdb_test "ptype ubytetable1" "type = ARRAY \[(\]+0:4\[)\]+ UBYTE"
+ gdb_test_exact "print ubytetable1" \
+ {= [(0): 0, (1): 1, (2): 2, (3): 3, (4): 4]}
+
+ gdb_test "ptype ubytetable2" "type = ARRAY \[(\]+5:9\[)\]+ UBYTE"
+ gdb_test_exact "print ubytetable2" \
+ {= [(5): 0, (6): 1, (7): 2, (8): 3, (9): 4]}
+
+ gdb_test "ptype inttable1" "type = ARRAY \[(\]+0:4\[)\]+ INT"
+ gdb_test_exact "print inttable1" \
+ {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
+
+ gdb_test "ptype inttable2" "type = ARRAY \[(\]+5:9\[)\]+ INT"
+ gdb_test_exact "print inttable2" \
+ {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
+
+ gdb_test "ptype uinttable1" "type = ARRAY \[(\]+0:4\[)\]+ UINT"
+ gdb_test_exact "print uinttable1" \
+ {= [(0): 0, (1): 1, (2): 2, (3): 3, (4): 4]}
+
+ gdb_test "ptype uinttable2" "type = ARRAY \[(\]+5:9\[)\]+ UINT"
+ gdb_test_exact "print uinttable2" \
+ {= [(5): 0, (6): 1, (7): 2, (8): 3, (9): 4]}
+
+ gdb_test "ptype longtable1" "type = ARRAY \[(\]+0:4\[)\]+ LONG"
+ gdb_test_exact "print longtable1" \
+ {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
+
+ gdb_test "ptype longtable2" "type = ARRAY \[(\]+5:9\[)\]+ LONG"
+ gdb_test_exact "print longtable2" \
+ {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
+
+ gdb_test "ptype ulongtable1" "type = ARRAY \[(\]+0:4\[)\]+ ULONG"
+ gdb_test_exact "print ulongtable1" \
+ {= [(0): 0, (1): 1, (2): 2, (3): 3, (4): 4]}
+
+ gdb_test "ptype ulongtable2" "type = ARRAY \[(\]+5:9\[)\]+ ULONG"
+ gdb_test_exact "print ulongtable2" \
+ {= [(5): 0, (6): 1, (7): 2, (8): 3, (9): 4]}
+
+ gdb_test "ptype realtable1" "type = ARRAY \[(\]+0:4\[)\]+ FLOAT"
+ gdb_test_exact "print realtable1" \
+ {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
+
+ gdb_test "ptype realtable2" "type = ARRAY \[(\]+5:9\[)\]+ FLOAT"
+ gdb_test_exact "print realtable2" \
+ {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
+
+ gdb_test "ptype longrealtable1" "type = ARRAY \[(\]+0:4\[)\]+ DOUBLE"
+ gdb_test_exact "print longrealtable1" \
+ {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
+
+ gdb_test "ptype longrealtable2" "type = ARRAY \[(\]+5:9\[)\]+ DOUBLE"
+ gdb_test_exact "print longrealtable2" \
+ {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
+}
+
+proc test_strings {} {
+
+ gdb_test "ptype string1" "type = CHARS \[(\]4\[)\]+"
+ gdb_test "print string1" " = \"abcd\""
+
+ gdb_test "ptype string2" "type = CHARS \[(\]+5\[)\]+"
+ gdb_test "print string2" " = \"ef\"//c\"00\"//\"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\""
+
+ # 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_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 string1 // \"efgh\"" " = \"abcdefgh\""
+ gdb_test "print (6) 'z'" " = \"zzzzzz\""
+ gdb_test "ptype (6) 'z'" "type = CHARS \[(\]+6\[)\]+"
+ gdb_test "print (1+2*3) 'x'" " = \"xxxxxxx\""
+ gdb_test "ptype (1+2*3) 'x'" "type = CHARS \[(\]+7\[)\]+"
+ }
+
+}
+
+proc test_structs {} {
+ gdb_test "ptype struct1" \
+ "type = STRUCT \[(\]+.*abool BOOL,.*aint INT,.*astring CHARS \[(\]+8\[)\]+.*\[)\]+"
+ gdb_test "print struct1" \
+ ".* = \\\[\.abool: TRUE, \.aint: 123, \.astring: \"a string\"\\\]"
+ gdb_test "ptype struct2" \
+ "type = STRUCT \[(\]+.*abool BOOL,.*nstruct simple_struct,.*aint INT.*\[)\]+"
+ gdb_test "print struct2" \
+ ".* = \\\[.abool: TRUE, \.nstruct: \\\[\.abool: FALSE, \.aint: 456, \.astring: \"deadbeef\"\\\], \.aint: 789\\\]"
+}
+
+# Check to see if we have an executable to test. If not, then either we
+# haven't tried to compile one, or the compilation failed for some reason.
+# In either case, just notify the user and skip the tests in this file.
+
+set binfile "chillvars"
+set srcfile $binfile.ch
+
+if ![file exists $objdir/$subdir/$binfile] then {
+ if $all_flag then {
+ warning "$binfile does not exist; tests suppressed."
+ }
+} else {
+ do_tests
+}
--- /dev/null
+# This file is a shell script fragment that supplies the information
+# necessary to tailor a template configure script into the configure
+# script appropriate for this directory. For more information, check
+# any existing configure script.
+
+srctrigger="Makefile.in"
+srcname="gdb.chill"
+
+# per-host:
+
+# per-target:
+
+ # everything defaults to unix for a target
+target_abbrev=unix
+target_makefile_frag=config/mt-unix
+
+ # this section is for all targets
+case "${target}" in
+ i386-*-aout) target_makefile_frag=config/mt-i386-aout ;;
+ *-*-lynx) target_makefile_frag=config/mt-lynx ;;
+ *-*-vxworks) target_makefile_frag=config/mt-vxworks ;;
+ m68k-*-*) target_makefile_frag=config/mt-m68k ;;
+ i960-*-nindy) target_makefile_frag=config/mt-i960-nindy ;;
+ a29k-*-udi) target_makefile_frag=config/mt-a29k-udi ;;
+ sparclite-*-*) target_makefile_frag=config/mt-slite ;;
+ sparc-*-aout) target_makefile_frag=config/mt-sparc-aout ;;
+ mips-*-ecoff) target_makefile_frag=config/mt-mips-ecoff ;;
+esac
+
+# post-target:
--- /dev/null
+# Copyright (C) 1992, 1994 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-gdb@prep.ai.mit.edu
+
+# This file was written by Per Bothner. (bothner@cygnus.com)
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+proc do_tests {} {
+ global prms_id bug_id subdir objdir srcdir binfile prompt
+
+ set prms_id 0
+ set bug_id 0
+
+ # Start with a fresh gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load $objdir/$subdir/$binfile
+
+ send "set language chill\n" ; expect -re "$prompt $"
+
+ # This is needed (at least on SunOS4) to make sure the
+ # the symbol table is read.
+ send "break chillvars.ch:3\n" ; expect -re "$prompt $"
+ send "delete 1\n" ; expect -re "$prompt $"
+
+ send "set width 0\n" ; expect -re "$prompt $"
+ send "set print sevenbit-strings\n" ; expect -re "$prompt $"
+ send "set print address off\n" ; expect -re "$prompt $"
+
+ test_pr_5020
+}
+
+proc test_pr_5020 {} {
+ global prompt
+ runto dummy_pr_5020
+ gdb_test_exact "print y" \
+ {= [ ('a') [.l: 10, .b: TRUE], ('b') [.l: 111, .b: FALSE]]}
+ send "set print pretty\n" ; expect -re "$prompt $"
+ gdb_test_exact "print y" \
+{= [
+ (`a`) [
+ .l: 10,
+ .b: TRUE
+ ],
+ ('b') [
+ .l: 111,
+ .b: FALSE
+ ]]} "print y pretty"
+}
+
+# Check to see if we have an executable to test. If not, then either we
+# haven't tried to compile one, or the compilation failed for some reason.
+# In either case, just notify the user and skip the tests in this file.
+
+set binfile "chillvars"
+set srcfile $binfile.ch
+
+if ![file exists $objdir/$subdir/$binfile] then {
+ if $all_flag then {
+ warning "$binfile does not exist; tests suppressed."
+ }
+} else {
+ do_tests
+}
projects / binutils-gdb.git / commitdiff