* builtins.exp, pr-5016.{ch,exp}, result.{ch,exp},

tests1.{ch,exp}: Enhance test cases.

gdb/testsuite/gdb.chill/ChangeLog

@@ -1,3 +1,8 @@
+Mon Dec 11 06:57:07 1995  Wilfried Moser (Alcatel)  <moser@rtl.cygnus.com>
+
+	* builtins.exp, pr-5016.{ch,exp}, result.{ch,exp},
+	tests1.{ch,exp}: Enhance test cases.
+
 Thu Dec  7 05:16:34 1995  Wilfried Moser (Alcatel)  <moser@rtl.cygnus.com>
 
 	* builtins.ch, builtins.exp, Makefile.in: New test case.

gdb/testsuite/gdb.chill/builtins.exp

@@ -274,12 +274,15 @@ proc test_length {} {
     # string expressions
     test_print_accept "print length(\"the quick brown fox ...\")" "23"
     test_print_accept "print length(B'010101010101')" "12"
+    test_print_accept "print length(\"foo \" // \"bar\")" "7"
 
     # check some failures
     setup_xfail "*-*-*"
     test_print_accept "print length(m_chars)" "typename in invalid context"
     setup_xfail "*-*-*"
     test_print_accept "print length(v_byte)" "bad argument to LENGTH builtin"
+    setup_xfail "*-*-*"
+    test_print_accept "print length(b'000000' // b'111111')" "12"
 }
 
 proc test_size {} {

gdb/testsuite/gdb.chill/pr-5016.ch

@@ -6,7 +6,7 @@ NEWMODE vector = ARRAY (m_index) INT;
 DCL a, b, c vector;
 
 dump: PROC( a vector LOC, c CHAR );
-  DCL i m_index;
+  DCL i m_index := 5;
   DO FOR i IN m_index;
     WRITETEXT( STDOUT, "%C(%C)=%C ", c, i, a(i) );
   OD;

gdb/testsuite/gdb.chill/pr-5016.exp

@@ -50,11 +50,13 @@ proc do_tests {} {
 
     runto dump
     # Linux thinks type is "_cint" (and so does sparc-sun-sunos4, alpha-dec-osf2.0)
-    setup_xfail "i*86-*-linux*" "sparc-sun-sunos4*" "alpha-dec-osf2*"
+    #setup_xfail "i*86-*-linux*" "sparc-sun-sunos4*" "alpha-dec-osf2*"
     gdb_test "whatis i" "type = m_index" "whatis int-range"
     gdb_test_exact "ptype m_index" "type = RANGE (1:10)" "ptype m_index"
     gdb_test_exact "whatis a" "type = /*LOC*/ vector"
     gdb_test "ptype a" "type = /\\*LOC\\*/ ARRAY \\(1:10\\) (INT|int)"
+    send "step\n"; expect -re "$prompt $"
+    gdb_test_exact "whatis i" "type = long" "whatis loop counter i"
 }
 
 do_tests

gdb/testsuite/gdb.chill/result.ch

@@ -2,6 +2,9 @@ test_result:  MODULE
 
   DCL i INT := 5;
 
+  SYNMODE m_struct = STRUCT (l LONG, b BOOL);
+  DCL v_struct m_struct := [ 20, TRUE ];
+
   simple_func: PROC () RETURNS (INT);
     DCL j INT := i;
     RESULT 10;
@@ -10,7 +13,17 @@ test_result:  MODULE
     i + := 2;
   END simple_func;
 
+  ret_struct: PROC () RETURNS (m_struct)
+    DCL v m_struct := [ 33, FALSE ];
+    RESULT v;
+    v.l := 18;
+  END ret_struct;
+
   i := simple_func ();
   i := simple_func ();
   i * := 10;
+
+  v_struct := ret_struct ();
+
+  i := 33; -- for gdb
 END test_result;

gdb/testsuite/gdb.chill/result.exp

@@ -52,6 +52,7 @@ proc do_tests {} {
     send "set print sevenbit-strings\n" ; expect -re "$prompt $"
     send "set print address off\n" ; expect -re "$prompt $"
 
+    # simple function
     runto simple_func
     send "step 2\n" ; expect -re "$prompt $"
     gdb_test "print j" "= 5"
@@ -63,6 +64,14 @@ proc do_tests {} {
     send "finish\n" ; expect -re "$prompt $"
     send "step\n" ; expect -re "$prompt $"
     gdb_test "print i" "= 50"
+
+    # returning a structure
+    runto ret_struct
+    send "step 2\n"; expect -re "$prompt $"
+    gdb_test "p result" {\[.l: 33, .b: FALSE\]}
+    send "set var result := \[383, TRUE\]\n"; expect -re "$prompt $"
+    send "finish\n"; expect -re "$prompt $"
+    gdb_test "p v_struct" {\[.l: 383, .b: TRUE\]}
 }
 
 do_tests

gdb/testsuite/gdb.chill/tests1.ch

@@ -38,7 +38,7 @@ tests1: module;
 seize 	__print_event,
 	__print_buffer;
 
-newmode	set1 = set(a, b, c);
+newmode	set1 = set(aaa, bbb, ccc);
 newmode	nset1 = set(na = 1, nb = 34, nc = 20);
 newmode r11 = range (0 : upper(ubyte));
 newmode r12 = range (0 : upper(uint));
@@ -46,7 +46,7 @@ newmode r12 = range (0 : upper(uint));
 newmode r14 = range (lower(byte) : upper(byte));
 newmode r15 = range (lower(int) : upper(int));
 newmode r16 = range (lower(long): upper(long));
-newmode r2 = set1(b : c);
+newmode r2 = set1(bbb : ccc);
 newmode r3 = nset1(na : na);
 newmode r4 = nset1(nc : nb);
 newmode r5 = nset1(lower(nset1) : upper(nset1));
@@ -89,24 +89,41 @@ newmode arr6m = array(1:5, 1:3, 1:2) long;
 
 newmode stru1m = struct (a, b long, 
 			 case b of 
-			   (42): ch1 char(20),
+			   (42): ch1 chars(20),
-			   (52): ch2 char(10)
+			   (52): ch2 chars(10)
-			   else  ch3 char(1)
+			   else  ch3 chars(1)
   			 esac);
 
 newmode stru2m = struct (f set1,
 			 case f of
-			    (a): ch1 char(20),
+			    (aaa): ch1 char(20),
-			    (b): ch2 char(10) varying
+			    (bbb): ch2 char(10) varying
 			 else	ch3 char(0) varying
 			 esac);
 newmode stru3m = struct (f r3,
 			 case f of
 			    (na): ch1 char(20)
 			 esac);
+newmode stru4m = struct (i long,
+			 case of
+			   : i1, i11 int,
+			     b1 bool,
+			     c1 char,
+			   : i2, i22 long,
+			     bs2 bools (10),
+			   :
+			     s3 struct (i3 int,
+					case of
+					  : foo long
+					  else bar char
+					esac)
+			   else
+                             x stru2m
+                         esac,
+                         y stru3m);
 
 -- set mode locations
-dcl s1l set1 := c;
+dcl s1l set1 := ccc;
 dcl s2l nset1 := nb;
 
 -- range mode locations

gdb/testsuite/gdb.chill/tests1.exp

@@ -131,7 +131,7 @@ proc test_modes {} {
     test_print_accept "ptype BOOL" "bool"
     test_print_accept "ptype CHAR" "char"
 
-    test_print_accept "ptype set1" "SET \[(\]a, b, c\[)\]" \
+    test_print_accept "ptype set1" "SET \[(\]aaa, bbb, ccc\[)\]" \
 	"print unnumbered set mode"
     test_print_accept "ptype nset1" "SET \[(\]na = 1, nb = 34, nc = 20\[)\]" \
 	"print numbered set mode"
@@ -152,8 +152,9 @@ proc test_modes {} {
     test_print_accept "ptype r16" "long \\(-2147483648:2147483647\\)" \
 	"print long range mode"
 
-    test_print_accept "ptype r2" "set1 \\(b:c\\)" \
+    test_print_accept "ptype r2" "set1 \\(bbb:ccc\\)" \
 	"print unnumbered set range mode"
+    setup_xfail "*-*-*"
     test_print_accept "ptype r3" "nset1 \\(na:na\\)" \
 	"print numbered set range mode"
     # really this order ?
@@ -245,15 +246,18 @@ proc test_modes {} {
     
     # structure modes
     # some checks are in chillvars.exp
-    setup_xfail "*-*-*"
+    # setup_xfail "*-*-*"
-    test_print_accept "ptype stru1m" "STRUCT \\(.*a long,.*b long,.*CASE b OF.*\\(42\\):.*ch1 CHARS\\(20\\),.*\\(52\\):.*ch2 CHARS\\(10\\).*ELSE.*ch3 CHARS\\(1\\).*ESAC.*\\)" \
+    test_print_accept "ptype stru1m" "STRUCT \\(.*a long,.*b long,.*CASE OF.*:.*ch1 CHARS \\(20\\).*:.*ch2 CHARS \\(10\\).*ELSE.*ch3 CHARS \\(1\\).*ESAC.*\\)" \
 	"print structure mode 1"
-    setup_xfail "*-*-*"
+    #setup_xfail "*-*-*"
-    test_print_accept "ptype stru2m" "STRUCT \\(.*f set1\\(a, b, c\\),.*CASE f OF.*\\(a\\):.*ch1 CHARS\\(20\\),.*\\(b\\):.*ch2 CHARS\\(10\\) VARYING.*ELSE.*ch3 CHARS\\(0\\) VARYING.*ESAC.*\\)" \
+    test_print_accept "ptype stru2m" "STRUCT \\(.*f set1,.*CASE OF.*:.*ch1 CHARS \\(20\\).*:.*ch2 CHARS \\(10\\) VARYING.*ELSE.*ch3 CHARS \\(0\\) VARYING.*ESAC.*\\)" \
 	"print structure mode 2"
-    setup_xfail "*-*-*"
+    #setup_xfail "*-*-*"
-    test_print_accept "ptype stru3m" "STRUCT \\(.*f nset1\\(na = 1, na = 1\\),.*CASE f OF.*\\(na\\):.*ch1 CHARS\\(20\\).*ESAC.*\\)" \
+    test_print_accept "ptype stru3m" "STRUCT \\(.*f r3,.*CASE OF.*:.*ch1 CHARS \\(20\\).*ESAC.*\\)" \
 	"print structure mode 3"
+    # setup_xfail "*-*-*"
+    test_print_accept "ptype stru4m" "STRUCT \\(.*i long,.*CASE OF.*:.*i1 int,.*i11 int,.*b1 bool,.*c1 char.*:.*i2 long,.*i22 long,.*bs2 BOOLS \\(10\\).*:.*s3 STRUCT \\(.*i3 int,.*CASE OF.*:.*foo long.*ELSE.*bar char.*ESAC.*\\).*ELSE.*x stru2m.*ESAC,.*y stru3m.*\\)" \
+	"print structure mode 4"
    
     
     if $passcount then {
@@ -271,11 +275,11 @@ proc test_locations {} {
     # various location tests can be found in chillvars.exp
 
     # set locations
-    test_print_accept "ptype s1l" "SET \\(a, b, c\\)" \
+    test_print_accept "ptype s1l" "SET \\(aaa, bbb, ccc\\)" \
 	"print mode of set location"
     test_print_accept "whatis s1l" "set1" \
 	"print modename of set location"
-    test_print_accept "print s1l" "c" "print set location"
+    test_print_accept "print s1l" "ccc" "print set location"
     test_print_accept "ptype s2l" "SET \\(na = 1, nb = 34, nc = 20\\)" \
 	"print mode of numbered set location"
     test_print_accept "whatis s2l" "nset1" \
@@ -455,13 +459,17 @@ proc test_locations {} {
     
     # reference modes
     test_print_accept "ptype ref3l" "PTR" "print mode of reference location"
+    setup_xfail "*-*-*"
     test_print_accept "whatis ref3l" "ref3" \
 	"print modename of reference location"
+    setup_xfail "*-*-*"
     test_print_accept "print ref3l" "ref3\\(H'.*\\)" \
 	"print reference location"
     test_print_accept "ptype ref4l" "PTR" "print mode of reference location"
+    setup_xfail "*-*-*"
     test_print_accept "whatis ref4l" "ref4" \
 	"print modename of reference location"
+    setup_xfail "*-*-*"
     test_print_accept "print ref4l" "ref4\\(H'.*\\)" \
 	"print reference location"
     test_print_accept "ptype ref5l" "PTR" "print mode of reference location"
@@ -592,10 +600,10 @@ proc test_locations {} {
 	"print mode of array location"
     gdb_test "whatis arrl1" "arr1m" \
 	"print mode name of array location"
-    gdb_test_exact "print arrl1" {[(1:100): a]} \
+    gdb_test_exact "print arrl1" {[(1:100): aaa]} \
 	"print array location"
     test_print_accept "ptype arrl1(1)" \
-	"SET \\(a, b, c\\)" \
+	"SET \\(aaa, bbb, ccc\\)" \
 	"print mode of array element"
     gdb_test_exact "print arrl3" \
 	{[(1:5): [(1:3): [(1:2): -2147483648]]]} \