From adad95c056f31cd63195cb554ce084546771c9b9 Mon Sep 17 00:00:00 2001 From: Per Bothner Date: Wed, 1 Feb 1995 21:08:52 +0000 Subject: [PATCH] * tuples.ch, tuples.exp, Makefile.in: New test case. --- gdb/testsuite/gdb.chill/.Sanitize | 2 + gdb/testsuite/gdb.chill/ChangeLog | 4 + gdb/testsuite/gdb.chill/Makefile.in | 4 +- gdb/testsuite/gdb.chill/tuples.ch | 33 ++++++++ gdb/testsuite/gdb.chill/tuples.exp | 113 ++++++++++++++++++++++++++++ 5 files changed, 154 insertions(+), 2 deletions(-) create mode 100644 gdb/testsuite/gdb.chill/tuples.ch create mode 100644 gdb/testsuite/gdb.chill/tuples.exp diff --git a/gdb/testsuite/gdb.chill/.Sanitize b/gdb/testsuite/gdb.chill/.Sanitize index 9c9f7f8a6e..ca6e8ee258 100644 --- a/gdb/testsuite/gdb.chill/.Sanitize +++ b/gdb/testsuite/gdb.chill/.Sanitize @@ -42,6 +42,8 @@ pr-5646-grt.ch pr-5646.exp result.ch result.exp +tuples.ch +tuples.exp Things-to-lose: diff --git a/gdb/testsuite/gdb.chill/ChangeLog b/gdb/testsuite/gdb.chill/ChangeLog index d40ec31d63..25ff307be1 100644 --- a/gdb/testsuite/gdb.chill/ChangeLog +++ b/gdb/testsuite/gdb.chill/ChangeLog @@ -1,3 +1,7 @@ +Wed Feb 1 13:09:48 1995 Per Bothner + + * tuples.ch, tuples.exp, Makefile.in: New test case. + Mon Nov 28 18:39:08 1994 Per Bothner * pr-5984.ch, pr-5984.exp, Makefile.in: New test case. diff --git a/gdb/testsuite/gdb.chill/Makefile.in b/gdb/testsuite/gdb.chill/Makefile.in index b7c8e8acc9..c8fe5fb7a2 100644 --- a/gdb/testsuite/gdb.chill/Makefile.in +++ b/gdb/testsuite/gdb.chill/Makefile.in @@ -102,7 +102,7 @@ GDBFLAGS = -nx #### host, target, and site specific Makefile frags come in here. -EXECUTABLES = chillvars.exe result.exe \ +EXECUTABLES = chillvars.exe result.exe tuples.exe \ pr-4975.exe pr-5016.exe pr-5020.exe pr-5022.exe pr-5646.exe pr-5984.exe all: $(EXECUTABLES) @@ -118,7 +118,7 @@ pr-5646.o: pr-5646-grt.o $(CHILL_FOR_TARGET) $(CHILLFLAGS) $(LDFLAGS) -o $*.exe $*.o $(CHILL_LIB) $(LIBS) .ch.o: - $(CHILL_FOR_TARGET) $(CHILLFLAGS) -fspecial_UC -c $< + $(CHILL_FOR_TARGET) $(CHILLFLAGS) -c $< # Do 'make chillvars.check' to run just the chillvars.{ch,exp} test. diff --git a/gdb/testsuite/gdb.chill/tuples.ch b/gdb/testsuite/gdb.chill/tuples.ch new file mode 100644 index 0000000000..e1063f5cd1 --- /dev/null +++ b/gdb/testsuite/gdb.chill/tuples.ch @@ -0,0 +1,33 @@ +x: MODULE + +SYNMODE m_arri = ARRAY(1:5) INT; +DCL v_arri m_arri := [ -1, -2, -3, -4, -5 ]; + +SYNMODE m_arrui = ARRAY(1:5) UINT; +DCL v_arrui m_arrui := [ 1, 2, 3, 4, 5 ]; + +SYNMODE r1 = RANGE (1:5); +SYNMODE m_arrb = ARRAY(r1) BYTE; +DCL v_arrb m_arrb := [ -3, -4, -5, -6, -7 ]; + +SYNMODE m_arrub = ARRAY(r1) UBYTE; +DCL v_arrub m_arrub := [ 3, 4, 5, 6, 7 ]; + +SYNMODE m_arrc = ARRAY (1:5) CHAR; +DCL v_arrc m_arrc := [ '1', '2', '3', '4', '5' ]; + +SYNMODE m_ps = POWERSET r1; +DCL v_ps m_ps := [ 1, 3, 5 ]; + +DCL v_cv CHARS(20) VARYING := "foo"; + +SYNMODE m_arrbool = ARRAY(r1) BOOL; +DCL v_arrbool m_arrbool := [ true, false, true, false, true ]; + +DCL j r1 := 4; + +DCL i INT; + +i := 0; + +END x; diff --git a/gdb/testsuite/gdb.chill/tuples.exp b/gdb/testsuite/gdb.chill/tuples.exp new file mode 100644 index 0000000000..8d5bc2ab4b --- /dev/null +++ b/gdb/testsuite/gdb.chill/tuples.exp @@ -0,0 +1,113 @@ +# Copyright (C) 1995 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 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 $" + + runto tuples.ch:31 + + gdb_test_exact "print v_arri" {= [(1): -1, (2): -2, (3): -3, (4): -4, (5): -5]} + send "set v_arri := \[ 33, 44, 55, 66, 77 \]\n" ; expect -re "$prompt $" + gdb_test_exact "print v_arri" {= [(1): 33, (2): 44, (3): 55, (4): 66, (5): 77]} "after assignment 1 to v_arri" + send "set v_arri := \[-33, -44, -55, -66, -77\]\n"; expect -re "$prompt $" + gdb_test_exact "print v_arri" {= [(1): -33, (2): -44, (3): -55, (4): -66, (5): -77]} {after assignment 2 to v_arri} + + gdb_test_exact "print v_arrui" {= [(1): 1, (2): 2, (3): 3, (4): 4, (5): 5]} + send "set v_arrui := \[ 11, 11, 11, 11, 11 \]\n"; expect -re "$prompt $" + gdb_test_exact "print v_arrui" {= [(1:5): 11]} "after assignment to v_arrui" + + gdb_test_exact "print v_arrb" {= [(1): -3, (2): -4, (3): -5, (4): -6, (5): -7]} + + send "set v_arrb := \[ -9, -8, -7, -6, -5 \]\n"; expect -re "$prompt $" + gdb_test_exact "print v_arrb" {= [(1): -9, (2): -8, (3): -7, (4): -6, (5): -5]} "after assignment to v_arrb" + + gdb_test_exact "print v_arrub" {= [(1): 3, (2): 4, (3): 5, (4): 6, (5): 7]} + send "set v_arrub := \[ 77, 77, 77, 77, 77 \]\n"; expect -re "$prompt $" + gdb_test_exact "print v_arrub" {= [(1:5): 77]} "v_arrub after assignment" + + gdb_test_exact "print j" {= 4} + gdb_test_exact "print j := 3+4" {= 7} + gdb_test_exact "print j := r1(3)" {= 3} + + gdb_test_exact "print v_arrc" {= [(1): '1', (2): '2', (3): '3', (4): '4', (5): '5']} + send "set v_arrc := \[ 'a', 'b', 'c', 'd', 'e' \]\n"; expect -re "$prompt $" + gdb_test_exact "print v_arrc" {= [(1): 'a', (2): 'b', (3): 'c', (4): 'd', (5): 'e']} "v_arrc after assignment" + + gdb_test_exact "print v_ps" {= [1, 3, 5]} + send "set v_ps := \[ 2, 4 \]\n"; expect -re "$prompt $" + gdb_test_exact "print v_ps" {= [2, 4]} + gdb_test_exact "print v_ps := \[\]" {= []} {assign [] to v_ps} + + gdb_test_exact "print m_arri\[1, 2, 3, 4, 5\]" {= [(1): 1, (2): 2, (3): 3, (4): 4, (5): 5]} + gdb_test_exact "print m_arrub\[45, 46, 47, 48, 49\]" {= [(1): 45, (2): 46, (3): 47, (4): 48, (5): 49]} + + gdb_test_exact "print v_cv" {= "foo"} + send "set v_cv := \"foo-bar\"\n"; expect -re "$prompt $" + gdb_test_exact "print v_cv" {= "foo-bar"} "v_cv after assignment" + send "print v_cv(3) := ' '\n"; expect -re "$prompt $" + gdb_test_exact "print v_cv" {= "foo bar"} "v_cv after element assignment" + + gdb_test_exact "print v_arrbool" {= [(1): TRUE, (2): FALSE, (3): TRUE, (4): FALSE, (5): TRUE]} + send "set v_arrbool := \[ false, false, false, false, false \]\n" + expect -re "$prompt $" + gdb_test_exact "print v_arrbool" {= [(1:5): FALSE]} "v_arrbool after assignment 1" + send "set v_arrbool := \[true, true, true, true, true\]\n" + expect -re "$prompt $" + gdb_test_exact "print v_arrbool" {= [(1:5): TRUE]} "v_arrbool after assignment 2" + send "set v_arrbool(3) := false\n"; expect -re "$prompt $" + gdb_test_exact "print v_arrbool" {= [(1:2): TRUE, (3): FALSE, (4:5): TRUE]} "v_arrbool after element assignment" + + send "set v_arrbool(1 up 2) := \[ false, true \]\n" + expect -re "$prompt $" + gdb_test_exact "print v_arrbool" {= [(1): FALSE, (2): TRUE, (3): FALSE, (4:5): TRUE]} "v_arrbool after slice assignment 1" + send "set v_arrbool(3 : 5) := \[ true, true, false \]\n" + expect -re "$prompt $" + gdb_test_exact "print v_arrbool" {= [(1): FALSE, (2:4): TRUE, (5): FALSE]} "v_arrbool after slice assignment 2" +} + +# 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 "tuples.exe" +set srcfile $binfile.ch + +if ![file exists $objdir/$subdir/$binfile] then { + warning "$binfile does not exist; tests suppressed." +} else { + do_tests +} -- 2.34.1