From 374887b40863c2ba64ae74c0a1cf7796c474928e Mon Sep 17 00:00:00 2001 From: Per Bothner Date: Sat, 4 Mar 1995 23:15:48 +0000 Subject: [PATCH] * callch.ch, callch.exp, Makefile.in: New test case. Extended testing for PR 6292. --- gdb/testsuite/gdb.chill/.Sanitize | 2 + gdb/testsuite/gdb.chill/ChangeLog | 4 ++ gdb/testsuite/gdb.chill/Makefile.in | 2 +- gdb/testsuite/gdb.chill/callch.ch | 50 +++++++++++++++++++++ gdb/testsuite/gdb.chill/callch.exp | 68 +++++++++++++++++++++++++++++ 5 files changed, 125 insertions(+), 1 deletion(-) create mode 100644 gdb/testsuite/gdb.chill/callch.ch create mode 100644 gdb/testsuite/gdb.chill/callch.exp diff --git a/gdb/testsuite/gdb.chill/.Sanitize b/gdb/testsuite/gdb.chill/.Sanitize index 975dac06458..f0de8f6cc03 100644 --- a/gdb/testsuite/gdb.chill/.Sanitize +++ b/gdb/testsuite/gdb.chill/.Sanitize @@ -24,6 +24,8 @@ Do-first: Things-to-keep: Makefile.in +callch.ch +callch.exp chexp.exp chillvars.ch chillvars.exp diff --git a/gdb/testsuite/gdb.chill/ChangeLog b/gdb/testsuite/gdb.chill/ChangeLog index 049b54f3e08..548e4a84ea6 100644 --- a/gdb/testsuite/gdb.chill/ChangeLog +++ b/gdb/testsuite/gdb.chill/ChangeLog @@ -1,3 +1,7 @@ +Sat Mar 4 15:16:17 1995 Per Bothner + + * callch.ch, callch.exp, Makefile.in: New test case. + Thu Mar 2 06:17:41 1995 Jim Kingdon (kingdon@lioth.cygnus.com) * misc.exp: If executable does not exist, issue warning and skip diff --git a/gdb/testsuite/gdb.chill/Makefile.in b/gdb/testsuite/gdb.chill/Makefile.in index 7d5d8c294d2..4ed891ebfe1 100644 --- a/gdb/testsuite/gdb.chill/Makefile.in +++ b/gdb/testsuite/gdb.chill/Makefile.in @@ -94,7 +94,7 @@ CHILL_LIB = ` \ #### host, target, and site specific Makefile frags come in here. -EXECUTABLES = chillvars.exe misc.exe result.exe tuples.exe \ +EXECUTABLES = callch.exe chillvars.exe misc.exe result.exe tuples.exe \ pr-4975.exe pr-5016.exe pr-5020.exe pr-5022.exe pr-5646.exe pr-5984.exe \ pr-6292.exe diff --git a/gdb/testsuite/gdb.chill/callch.ch b/gdb/testsuite/gdb.chill/callch.ch new file mode 100644 index 00000000000..3c48bb29e8b --- /dev/null +++ b/gdb/testsuite/gdb.chill/callch.ch @@ -0,0 +1,50 @@ +hack : module + +dcl i int; +newmode otto = array (bool, bool) byte; +newmode str1 = struct (f1 int, f2 bool); +newmode str2 = struct (f1 otto); + +dcl a otto := [[1,1],[1,1]]; +dcl b str1 := [10, false]; +dcl c str2; + +fred : proc (a int in, b int loc); + writetext(stdout, "a is '%C'; b is '%C'.%/", a, b); +end fred; + +klaus : proc (); + writetext(stdout, "here's klaus calling.%/"); +end klaus; + +king : proc (p otto loc, x otto in); + dcl i, j bool; + p := [[h'ff,h'ff],[h'ff,h'ff]]; + do for i:= lower(bool) to upper(bool); + do for j:= lower(bool) to upper(bool); + writetext(stdout, "x(%C, %C) = %C.%/", i, j, x(i, j)); + writetext(stdout, "p(%C, %C) = %C.%/", i, j, p(i, j)); + od; + od; +end king; + +ralph : proc (x str1 in); + writetext(stdout, "x.f1 = %C, x.f2 = %C.%/", x.f1, x.f2); +end ralph; + +whitney : proc (x str2 in); + dcl i, j bool; + + do for i:= lower(bool) to upper(bool); + do for j:= lower(bool) to upper(bool); + writetext(stdout, "x.f1(%C, %C) = %C.%/", i, j, x.f1(i, j)); + od; + od; + +end whitney; + +c := [a]; +i:=12; +writetext(stdout, "done.%/"); + +end hack; diff --git a/gdb/testsuite/gdb.chill/callch.exp b/gdb/testsuite/gdb.chill/callch.exp new file mode 100644 index 00000000000..610af194313 --- /dev/null +++ b/gdb/testsuite/gdb.chill/callch.exp @@ -0,0 +1,68 @@ +# 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 tests that gdb can call functions in a Chill inferior. + +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" ; + + send "break callch.ch:48\n"; expect -re "$prompt $" + send "run\n"; expect -re "Breakpoint .*callch.ch:48.*$prompt $" + gdb_test {set fred(10, i)} {a is '10'; b is '12'.} + gdb_test_exact "call klaus()" {here's klaus calling.} + gdb_test_exact "call fred()" {too few arguments in function call} + # Too many arguments are allowed + gdb_test_exact "call klaus(10, 20, 30)" {here's klaus calling.} + test_print_accept "print a" {\[\(FALSE:TRUE\): \[\(FALSE:TRUE\): 1\]\]}\ + "print a before king" + gdb_test {call king(a, otto[[10, 15], [20, 25]])} "x\\(FALSE, FALSE\\) = 10.*p\\(FALSE, FALSE\\) = -1.*x\\(FALSE, TRUE\\) = 15.*p\\(FALSE, TRUE\\) = -1.*x\\(TRUE, FALSE\\) = 20.*p\\(TRUE, FALSE\\) = -1.*x\\(TRUE, TRUE\\) = 25.*p\\(TRUE, TRUE\\) = -1.*" + test_print_accept "print a" {\[\(FALSE:TRUE\): \[\(FALSE:TRUE\): -1\]\]}\ + "print a after king" + gdb_test_exact "call ralph(b)" {x.f1 = 10, x.f2 = FALSE.} + gdb_test "call whitney(c)" "x.f1\\(FALSE, FALSE\\) = 1.*x.f1\\(FALSE, TRUE\\) = 1.*x.f1\\(TRUE, FALSE\\) = 1.*x.f1\\(TRUE, TRUE\\) = 1.*" +} + +# 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 "callch.exe" +set srcfile $binfile.ch + +if ![file exists $objdir/$subdir/$binfile] then { + warning "$binfile does not exist; tests suppressed." +} else { + do_tests +} -- 2.30.2