Reorganized GDB tests - Chill
This commit is contained in:
Stan Shebs
parent
ef44eed173
commit
16def8c8a0
|
|
@ -0,0 +1,40 @@
|
|||
# .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
|
||||
|
|
@ -0,0 +1,173 @@
|
|||
# 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
|
||||
|
||||
|
|
@ -0,0 +1,592 @@
|
|||
# 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."
|
||||
}
|
||||
|
|
@ -0,0 +1,216 @@
|
|||
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;
|
||||
|
|
@ -0,0 +1,301 @@
|
|||
# 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
|
||||
}
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
# 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:
|
||||
|
|
@ -0,0 +1,84 @@
|
|||
# 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
|
||||
}
|
||||
Loading…
Reference in New Issue