aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.chill/tests1.exp
blob: 7aa882507f3b0162cac58968bac05b9092495650 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
# Copyright 1995, 1996, 1997 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  

# Please email any bugs, comments, and/or additions to this file to:
# bug-gdb@prep.ai.mit.edu

# This file tests various Chill values, expressions, and types.

if $tracelevel then {
	strace $tracelevel
}

if [skip_chill_tests] then { continue }

set testfile "tests1"
set srcfile ${srcdir}/$subdir/${testfile}.ch
set binfile ${objdir}/${subdir}/${testfile}.exe
if  { [compile "${srcfile} -g -w -o ${binfile} ${CHILL_RT0} ${CHILL_LIB}"] != "" } {
    perror "Couldn't compile ${srcfile}"
    return -1
}

# 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 gdb_prompt
    global binfile objdir subdir

    verbose "loading file '$binfile'"
    gdb_load $binfile
    send_gdb "set language chill\n"
    gdb_expect {
	-re ".*$gdb_prompt $" {}
	timeout { fail "set language chill (timeout)" ; return 0 }
    }

    send_gdb "show language\n"
    gdb_expect {
	-re ".* source language is \"chill\".*$gdb_prompt $" {
	    pass "set language to \"chill\""
	    send_gdb "break dummyfunc\n"
	    gdb_expect {
		-re ".*$gdb_prompt $" {
		    send_gdb "run\n" 
		    gdb_expect -re ".*$gdb_prompt $" {}
		    return 1
		}
		timeout {
		    fail "can't set breakpoint (timeout)"
		    return 0
		}
	    }
	}
	-re ".*$gdb_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_gdb 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 gdb_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]
    set result [gdb_test $sendthis ".* = ${expectthis}" $message]
    if $result==0 {incr passcount}
    return $result
}

# 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.

# various tests if modes are treated correctly
# using ptype
proc test_modes {} {
    global passcount

    verbose "testing chill modes"
    set passcount 0

    # discrete modes
    test_print_accept "ptype BYTE" "byte"
    test_print_accept "ptype UBYTE" "ubyte"
    test_print_accept "ptype INT" "int"
    test_print_accept "ptype UINT" "uint"
    test_print_accept "ptype LONG" "long"
    test_print_accept "ptype ULONG" "ulong"
    test_print_accept "ptype BOOL" "bool"
    test_print_accept "ptype CHAR" "char"

    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"

    # mp:
    # display maybe in hex values ?
    #
    test_print_accept "ptype r11" "ubyte \\(0:255\\)" \
	"print ubyte range mode"
    test_print_accept "ptype r12" "uint \\(0:65535\\)" \
	"print uint range mode"
#    test_print_accept "ptype r13" "ulong \\(0:4294967295\\)" \
#	"print ulong range mode"
    test_print_accept "ptype r14" "byte \\(-128:127\\)" \
	"print byte range mode"
    test_print_accept "ptype r15" "int \\(-32768:32767\\)" \
	"print int range mode"
    test_print_accept "ptype r16" "long \\(-2147483648:2147483647\\)" \
	"print long range mode"

    test_print_accept "ptype r2" "set1 \\(bbb:ccc\\)" \
	"print unnumbered set range mode"
    test_print_accept "ptype r3" "nset1 \\(na:na\\)" \
	"print numbered set range mode"
    # really this order ?
    # I'm not sure what should happen for the next two tests.
    setup_xfail "*-*-*"
    test_print_accept "ptype r4" "nset1 \\(nb = 34:nc = 20\\)" \
	"print numbered set range mode"
    setup_xfail "*-*-*"
    test_print_accept "ptype r5" "nset1 \\(na = 1, nb = 34, nc = 20\\)" \
	"print numbered set range mode"

    # powerset modes
    test_print_accept "ptype pm1" \
	"POWERSET SET \[(\]p1, p2, p3, p4, p5, p6, p7, p8, p9, p10\[)\]" \
	"print powerset mode 1"
    test_print_accept "ptype pm2" "POWERSET byte \\(1:8\\)" \
	"print powerset mode 2"
    test_print_accept "ptype pm3" "POWERSET int \\(-32768:32767\\)" \
	"print powerset mode 3"
    test_print_accept "ptype pm4" "POWERSET long \\(-32768:32768\\)" \
	"print powerset mode 4"
    test_print_accept "ptype pm5" \
	"POWERSET long \\(-2147483648:2147483647\\)" \
	"print powerset mode 5"
    
    # reference modes
    test_print_accept "ptype ref1" "REF pm1" \
	"print reference to powerset mode"
    test_print_accept "ptype ref2" "REF byte" \
	"print reference to byte"
    test_print_accept "ptype ref3" "PTR" \
	"print free reference type"

    # procedure modes
    # FIXME: we have to talk about this ... 
    test_print_accept "ptype prm1" \
	"REF PROC \[(\]\[)\]" \
	"print procedure mode 1"
    setup_xfail "*-*-*"
    test_print_accept "ptype prm2" \
	"REF PROC \[(\]bool in, int out long inout\[)\] RETURNS \[(\]char\[)\]" \
	"print procedure mode 2"
    setup_xfail "*-*-*"
    test_print_accept "ptype prm3" \
	"REF PROC \[(\]pm1, ref loc\[)\] RETURNS \[(\]ref3\[)\]" \
	"print procedure mode 3"
    setup_xfail "*-*-*"
    test_print_accept "ptype prm4" \
	"\[(\] \[)\] EXCEPTIONS \[(\]ex1, ex2, ex3\[)\]" \
	"print procedure mode 4"
    setup_xfail "*-*-*"
    test_print_accept "ptype prm5" \
	"REF PROC \[(\]r11, r16 inout, r5 out\[)\] RETURNS \[(\]r2\[)\] EXCEPTIONS \[(\]ex1\[)\]" \
	"print procedure mode 5"

    # synchronization modes
    # FIXME: since gdb doesn't process events & buffers so far, this has be 
    #        filled later...
    xfail "synchronization mode handling"

    # timing modes
    test_print_accept "ptype DURATION" "duration"
    test_print_accept "ptype TIME" "time"

    # string modes
    # some tests are done in chillvars.exp
    test_print_accept "ptype strm1" "CHARS \\(5\\)" "print char string mode"
    test_print_accept "ptype strm2" "CHARS \[(\]7\[)\] VARYING" \
	"print varying char string mode"
    test_print_accept "ptype bstr1" "BOOLS \\(20\\)" "print bit string mode"

    test_print_accept "ptype B'000'" "BOOLS \\(3\\)" "bit string literal"
    test_print_accept "ptype B'11110000'" "BOOLS \\(8\\)" "bit string literal"
    # FIXME: adjust error message
    gdb_test "ptype B'00110211'" {.*Too-large digit.*[.]} \
	"reject invalid bitstring"

    # array modes
    # some tests are done in chillvars.exp
    test_print_accept "ptype arr1m" "ARRAY \\(1:100\\) set1" \
	"print array mode 1"
    test_print_accept "ptype arr2m" "ARRAY \\(1:100\\) ARRAY \\(1:100\\) set1"\
	"print array mode 2"
    test_print_accept "ptype arr3m" "ARRAY \\(0:255\\) ARRAY \\(0:65535\\) ARRAY \\(-128:127\\) set1" \
	"print array mode 3"
    setup_xfail "*-*-*"
    test_print_accept "ptype arr4m" "ARRAY \\(b:c\\) ARRAY \\(na = 1:na = 1\\) ARRAY \\(nc:nb\\) ARRAY \\(na = 1:nc = 20\\) POWERSET SET \[(\]p1, p2, p3, p4, p5, p6, p7, p8, p9, p10\[)\]" \
	"print array mode 4"
    
    # structure modes
    # some checks are in chillvars.exp
    # setup_xfail "*-*-*"
    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 "*-*-*"
    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 "*-*-*"
    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 {
	pass "$passcount correct modes printed"
    }
}

# various tests if locations are treated correctly
# read access using ptype, print, whatis
proc test_locations {} {
    global passcount

    set passcount 0
    verbose "testing read access to locations"
    # various location tests can be found in chillvars.exp

    # set locations
    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" "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" \
	"print mode name of numbered set location"
    test_print_accept "print s2l" "nb" "print numberes set location"

    # range modes
    test_print_accept "ptype rl1" "ubyte \\(0:255\\)" \
	"print mode of range location"
    test_print_accept "whatis rl1" "r11" \
	"print mode name of range location"
    test_print_accept "print rl1" "3" \
	"print range location"

    test_print_accept "ptype rl2" "ubyte \\(0:255\\)" \
	"print mode of range location"
    test_print_accept "whatis rl2" "r11" \
	"print mode name of range location"
    test_print_accept "print rl2" "0" \
	"print range location"

    test_print_accept "ptype rl3" "ubyte \\(0:255\\)" \
	"print mode of range location"
    test_print_accept "whatis rl3" "r11" \
	"print mode name of range location"
    test_print_accept "print rl3" "255" \
	"print range location"

    test_print_accept "ptype rl5" "uint \\(0:65535\\)" \
	"print mode of range location"
    test_print_accept "whatis rl5" "r12" \
	"print mode name of range location"
    test_print_accept "print rl5" "65530" \
	"print range location"

    test_print_accept "ptype rl6" "uint \\(0:65535\\)" \
	"print mode of range location"
    test_print_accept "whatis rl6" "r12" \
	"print mode name of range location"
    test_print_accept "print rl6" "0" \
	"print range location"
	
    test_print_accept "ptype rl7" "uint \\(0:65535\\)" \
	"print mode of range location"
    test_print_accept "whatis rl7" "r12" \
	"print mode name of range location"
    test_print_accept "print rl7" "65535" \
	"print range location"
	
#     test_print_accept "ptype rl9" "ulong \\(0:4294967295\\)" \
# 	"print mode of range location"
#     test_print_accept "whatis rl9" "r13" \
# 	"print mode name of range location"
#     test_print_accept "print rl9" "128" \
# 	"print range location"
	
#     test_print_accept "ptype rl10" "ulong \\(0:4294967295\\)" \
# 	"print mode of range location"
#     test_print_accept "whatis rl10" "r13" \
# 	"print mode name of range location"
#     test_print_accept "print rl10" "0" \
# 	"print range location"
	
#     test_print_accept "ptype rl11" "ulong \\(0:4294967295\\)" \
# 	"print mode of range location"
#     test_print_accept "whatis rl11" "r13" \
# 	"print mode name of range location"
#     test_print_accept "print rl11" "4294967295" \
# 	"print range location"

    test_print_accept "ptype rl13" "byte \\(-128:127\\)" \
	"print mode of range location"
    test_print_accept "whatis rl13" "r14" \
	"print mode name of range location"
    test_print_accept "print rl13" "-121" \
	"print range location"

    test_print_accept "ptype rl14" "byte \\(-128:127\\)" \
	"print mode of range location"
    test_print_accept "whatis rl14" "r14" \
	"print mode name of range location"
    test_print_accept "print rl14" "-128" \
	"print range location"

    test_print_accept "ptype rl15" "byte \\(-128:127\\)" \
	"print mode of range location"
    test_print_accept "whatis rl15" "r14" \
	"print mode name of range location"
    test_print_accept "print rl15" "127" \
	"print range location"

    test_print_accept "ptype rl17" "int \\(-32768:32767\\)" \
	"print mode of range location"
    test_print_accept "whatis rl17" "r15" \
	"print mode name of range location"
    test_print_accept "print rl17" "-32720" \
	"print range location"

    test_print_accept "ptype rl18" "int \\(-32768:32767\\)" \
	"print mode of range location"
    test_print_accept "whatis rl18" "r15" \
	"print mode name of range location"
    test_print_accept "print rl18" "-32768" \
	"print range location"

    test_print_accept "ptype rl19" "int \\(-32768:32767\\)" \
	"print mode of range location"
    test_print_accept "whatis rl19" "r15" \
	"print mode name of range location"
    test_print_accept "print rl19" "32767" \
	"print range location"

    test_print_accept "ptype rl21" "long \\(-2147483648:2147483647\\)" \
	"print mode of range location"
    test_print_accept "whatis rl21" "r16" \
	"print mode name of range location"
    test_print_accept "print rl21" "2147483643" \
	"print range location"

    test_print_accept "ptype rl22" "long \\(-2147483648:2147483647\\)" \
	"print mode of range location"
    test_print_accept "whatis rl22" "r16" \
	"print mode name of range location"
    test_print_accept "print rl22" "-2147483648" \
	"print range location"

    test_print_accept "ptype rl23" "long \\(-2147483648:2147483647\\)" \
	"print mode of range location"
    test_print_accept "whatis rl23" "r16" \
	"print mode name of range location"
    test_print_accept "print rl23" "2147483647" \
	"print range location"
    
    # powerset locations
    test_print_accept "ptype pl1" \
	"POWERSET SET \\(p1, p2, p3, p4, p5, p6, p7, p8, p9, p10\\)" \
	"print mode of powerset location 1"
    test_print_accept "whatis pl1" "pm1" \
	"print mode mode name of powerset location"
    test_print_accept "print pl1" \
	"\[\[\]p1:p10\[\]\]" \
	"print powerset location 1"
    test_print_accept "print pl2" {\[\]} \
	"print powerset location 2"
    test_print_accept "print pl3" "\[\[\]p1, p10\[\]\]" \
    	"print powerset location 3"
    test_print_accept "print pl4" {\[p1:p2, p4:p6, p8:p10\]} \
	"print powerset location 4"
    test_print_accept "print pl5" {\[p1:p4, p6, p8:p10\]} \
	"print powerset location 5"
    test_print_accept "print pl6" {\[p1, p3:p8, p10\]} \
	"print powerset location 6"
    
    test_print_accept "ptype pl7" \
	"POWERSET byte \\(1:8\\)" \
	"print mode of byte powerset location"
    test_print_accept "whatis pl7" "pm2" \
	"print modename of byte powerset location"
    test_print_accept "print pl7" {\[1:8\]} \
	"print powerset location 7"
    
    test_print_accept "ptype pl8" \
	"POWERSET int \\(-32768:32767\\)" \
	"print mode of int powerset location"
    test_print_accept "whatis pl8" "pm3" \
	"print modename of int powerset location"
    test_print_accept "print pl8" {\[-32768:32767\]} \
	"print powerset location 8"
    
#    test_print_accept "ptype pl9" \
#	"POWERSET long \\(-2147483648:2147483647\\)" \
#	"print mode of long powerset location"
#    test_print_accept "whatis pl9" "pm5" \
#	"print modename of long powerset location"
#    test_print_accept "print pl9" {\[-2147483648:2147483647\]} \
#	"print powerset location 9"
    
    # 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"
    test_print_accept "whatis ref5l" "PTR" \
	"print modename of reference location"
    test_print_accept "print ref5l" "PTR\\(H'.*\\)" \
	"print reference location"

    # dereference a little bit..
    test_print_accept "print ref6l->syn_int" "42" \
	"dereference reference to synmode location"
    test_print_accept "print ref7l->int" "-42" \
	"dereference reference to predefined mode location"
    test_print_accept "print ref8l->pm1" \
	"\[\[\]p1:p10\[\]\]" \
	"dereference reference to newmode location"

    # synchronization mode locations
    # FIXME: synchronization modes are not supported so far...
    xfail "no synchronization mode location support, not implemented yet"
    
    # timing mode locations
    # FIXME: callbacks to abstime, inttime not implemented
    xfail "timing modes not implemented properly yet"

    # char string locations
    # some tests are don in chillvars.exp
    test_print_accept "ptype strl1" \
	"CHARS \\(7\\) VARYING" \
	"print varying string location"
    test_print_accept "whatis strl1" "strm2" \
	"print string locationa mode name"
    test_print_accept "print strl1" \
	{\"hansi\^\(0\)\"} \
	"print string location"
    # string elements
    test_print_accept "print strl1(0)" "\'h\'" \
	"print string element 1"
    test_print_accept "print strl1(5)" {'\^[(]0[)]'} \
	"print string element 2"
    test_print_accept "print strl1(3)" "\'s\'" \
	"print string element 3"
    test_print_accept "ptype strl1(0)" "char" \
	"print mode of string element"
    # slices
    test_print_accept "print strl1(3:4)" "\"si\"" \
	"print string slice 1"
    test_print_accept "print strl1(0:5)" \
	{\"hansi\^\(0\)\"} \
	"print string slice 2"
    test_print_accept "print strl1(0:0)" "\"h\"" \
	"print string slice 3"
    test_print_accept "print strl1(0 up 6)" \
	{\"hansi\^\(0\)\"} \
	"print string slice 4"
    # FIXME: adjust error message, when implented
    gdb_test "print strl1(6 up 1)" \
	".*slice.*out of range.*" \
	"print invalid string slice length"
    gdb_test "print strl1(-1 up 5)" \
	".*slice.*out of range.*" \
	"print invalid string slice length"
    gdb_test "print strl1(-1:5)" \
	".*slice.*out of range.*" \
	"print invalid string slice"
    gdb_test "print strl1(-1:7)" \
	".*slice.*out of range.*" \
	"print invalid string slice"
    gdb_test "print strl1(0 up -1)" \
	".*slice.*out of range.*" \
	"print invalid string slice length"
    gdb_test "print strl1(0 up 0)" {""}
    
    # bitstring locations
    test_print_accept "ptype bstr1" \
	"BOOLS \\(20\\)" \
	"print mode of bitstring location"
    test_print_accept "whatis bstrl1" "bstr1" \
	"print mode name of bitstring location"
    test_print_accept "print bstrl1" \
	"B'10101010101010101010'" \
	"print bitstring location"
    
    test_print_accept "ptype bstrl1(0)" "bool|BOOL" \
	"print mode of bitstring element"
    test_print_accept "print bstrl1(0)" "TRUE" \
	"print bitstring element 1"
    test_print_accept "print bstrl1(19)" "FALSE" \
	"print bitstring element 2"
    test_print_accept "print bstrl1(10)" "TRUE" \
	"print bitstring element 3"
    
    test_print_accept "print bstrl1(0:19)" \
	"B'10101010101010101010'" \
	"print bitstring location slice 1"
    test_print_accept "print bstrl1(0:0)" \
	"B'1'" \
	"print bitstring location slice 2"
    test_print_accept "print bstrl1(3:9)" \
	"B'0101010'" \
	"print bitstring location slice 3"
    test_print_accept "print bstrl1(0 up 20)" \
	"B'10101010101010101010'" \
	"print bitstring location slice 4"
    test_print_accept "print bstrl1(19 up 1)" \
	"B'0'" \
	"print bitstring location slice 5"
    gdb_test "print bstrl1(20 up 1)" \
	".*slice out of range.*" \
	"print invalid bitstring slice (20 up 1)"
    gdb_test "print bstrl1(-4:5)" \
	".*slice out of range.*" \
	"print invalid bitstring slice (-4:5)"
    gdb_test "print bstrl1(-1:up 1)" \
	".*invalid expression syntax.*" \
	"print invalid bitstring slice (-1:ip 1)"
    gdb_test "print bstrl1(-1:20)" \
	".*slice out of range.*" \
	"print invalid bitstring slice (-1:20)"
    gdb_test "print bstrl1(0 up -1)" \
	".*slice out of range.*" \
	"print invalid bitstring slice (0 up -1)"
    test_print_accept "print bstrl1(4 up 0)" "B''"
    
    # array mode locations
    gdb_test_exact "ptype arrl1" \
	"ARRAY (1:100) set1" \
	"print mode of array location"
    gdb_test "whatis arrl1" "arr1m" \
	"print mode name of array location"
    gdb_test_exact "print arrl1" {[(1:100): aaa]} \
	"print array location"
    test_print_accept "ptype arrl1(1)" \
	"SET \\(aaa, bbb, ccc\\)" \
	"print mode of array element"
    gdb_test_exact "print arrl3" \
	{[(1:5): [(1:3): [(1:2): -2147483648]]]} \
	"print array location 2"
    gdb_test_exact "print arrl3(1)" \
	{[(1:3): [(1:2): -2147483648]]} \
	"print array location 3"
    gdb_test_exact "ptype arrl3(1)" \
	{ARRAY (1:3) ARRAY (1:2) long} \
	"print mode of array element"
    test_print_accept "print arrl3(5)" \
	{\[\(1:3\): \[\(1:2\): -2147483648\]\]} \
	"print array location 4"
    test_print_accept "print arrl3(1,1)" \
	{\[\(1:2\): -2147483648\]} \
	"print array location 5"
    test_print_accept "ptype arrl3(1,1)" \
	{ARRAY \(1:2\) long} \
	"print mode of array element"
    test_print_accept "print arrl3(5,3)" \
	{\[\(1:2\): -2147483648\]} \
	"print array location 6"
    test_print_accept "print arrl3(1,1,1)" \
	"-2147483648" \
	"print array location 7"
    test_print_accept "print arrl3(5,3,2)" \
	"-2147483648" \
	"print array location 8"
    test_print_accept "print arrl3(1)(3)(2)" \
	"-2147483648" \
	"print array location 9"

    # reject the following range fails
    # FIXME: adjust error messages
    gdb_test "print arrl3(-1)" \
	".*out of range.*" \
	"check invalid array indices 1"
    gdb_test "print arrl3(6)" \
	".*out of range.*" \
	"check invalid array indices 2"
    gdb_test "print arrl3(0,0)" \
	".*out of range.*" \
	"check invalid array indices 3"
    gdb_test "print arrl3(1,0)" \
	".*out of range.*" \
	"check invalid array indices 4"
    gdb_test "print arrl3(1,4)" \
	".*out of range.*" \
	"check invalid array indices 5"
    gdb_test "print arrl3(6,4)" \
	".*out of range.*" \
	"check invalid array indices 6"
    gdb_test "print arrl3(1,1,0)" \
	".*out of range.*" \
	"check invalid array indices 7"
    gdb_test "print arrl3(6,4,0)" \
	".*out of range.*" \
	"check invalid array indices 8"
    gdb_test "print arrl3(1,1,3)" \
	".*out of range.*" \
	"check invalid array indices 9"

    gdb_test "print arrl3(0)(0)" \
	".* array or string index out of range.*" \
	"check invalid array indices 10"
    gdb_test "print arrl3(1)(0)" \
	".* array or string index out of range.*" \
	"check invalid array indices 11"
    gdb_test "print arrl3(1)(4)" \
	".* array or string index out of range.*" \
	"check invalid array indices 12"
    gdb_test "print arrl3(6)(4)" \
	".* array or string index out of range.*" \
	"check invalid array indices 13"
    gdb_test "print arrl3(1)(1)(0)" \
	".* array or string index out of range.*" \
	"check invalid array indices 14"
    gdb_test "print arrl3(6)(4)(0)" \
	".* array or string index out of range.*" \
	"check invalid array indices 15"
    gdb_test "print arrl3(1)(1)(3)" \
	".* array or string index out of range.*" \
	"check invalid array indices 16"
    
    # slices
    test_print_accept "print arrl4(1:3)" \
	{\[\(1:2\): \[\(1:3\): \[\(1:2\): -2147483648\]\], \(3\): \[\(1:3\): \[\(1:2\): 100\]\]\]} \
	"print array slice 1"
    test_print_accept "ptype arrl4(1:3)" \
	{ARRAY \(1:3\) ARRAY \(1:3\) ARRAY \(1:2\) long} \
	"print mode of array slice"
# The next one is bogus:
#    test_print_accept "print arrl4(5, 2:3, 1)" \
#	# FIXME: maybe the '(1): ' in the inner tupel should be omitted ? \
#	{\[(2): \[\(1\): 100\], \(3\):\[\(1\): 100\]\]} \
#	"print array slice 2"
    test_print_accept "print arrl4(1 up 4)" \
	{\[\(1:2\): \[\(1:3\): \[\(1:2\): -2147483648\]\], \(3\): \[\(1:3\): \[\(1:2\): 100\]\], \(4\): \[\(1:3\): \[\(1:2\): -2147483648\]\]\]} \
	"print array slice 3"
# The next two are bogus:
#    test_print_accept "print arrl4(3, 2 up 1)" \
#	{\[\(2:3\): \[\(1:2\): 100\]\]} \
#	"print array slice 4"
#    test_print_accept "print arrl4(1:2, 1 up 1, 2)" \
#	{\[\(1\): \[\(1\): \[\(2\): -2147483648\], \(2\): \[\(2\): -2147483648\]\], \(2\): \[\(1\): \[\(2\): -2147483648\], \(2\): \[\(2\): -2147483648\]\]\]} \
#	"print array slice 4"
    # reject invalid slices
    # FIXME: adjust error messages
    gdb_test "print arrl4(5:6)" \
	".*slice out of range.*" \
	"check invalid range 1"
    gdb_test "print arrl4(0:1)" \
	".*slice out of range.*" \
	"check invalid range 2"
    gdb_test "print arrl4(0:6)" \
	".*slice out of range.*" \
	"check invalid range 3"
    gdb_test "print arrl4(3:2)" \
	".*slice out of range.*" \
	"check invalid range 4"
    gdb_test "print arrl4(1,3:4)" \
	".*syntax error.*" \
	"check invalid range 5"
    gdb_test "print arrl4(1,0:1)" \
	".*syntax error.*" \
	"check invalid range 6"
    gdb_test "print arrl4(1,0:4)" \
	".*syntax error.*" \
	"check invalid range 7"
    gdb_test "print arrl4(1,3:2)" \
	".*syntax error.*" \
	"check invalid range 8"
    gdb_test "print arrl4(5 up 2)" \
	".*slice out of range.*" \
	"check invalid range 9"
    gdb_test "print arrl4(-1 up 1)" \
	".*slice out of range.*" \
	"check invalid range 10"
    gdb_test "print arrl4(-1 up 7)" \
	".*slice out of range.*" \
	"check invalid range 11"
    gdb_test "print arrl4(1 up 0)" \
	".*slice out of range.*" \
	"check invalid range 12"
    gdb_test "print arrl4(1,3 up 1)" \
	".*syntax error.*" \
	"check invalid range 13"
    gdb_test "print arrl4(1,-1 up 1)" \
	".*syntax error.*" \
	"check invalid range 14"
    gdb_test "print arrl4(1,-1 up 5)" \
	".*syntax error.*" \
	"check invalid range 15"
    gdb_test "print arrl4(1,2 up 0)" \
	".*syntax error.*" \
	"check invalid range 16"

    # structure modes
    # some tests are in chillvars.exp
    # FIXME: no tag processing implemented do maybe adjust these tests
    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.*\\)" \
	"print mode of structure location 1"
    test_print_accept "whatis strul1" "stru1m" \
	"print mode name of structure location 1"
    setup_xfail "*-*-*"
    test_print_accept "print strul1" \
	{\[\.a: -2147483648, \.b: 42, \.\(b\): \{\(42\) = \[\.ch1: \"12345678900987654321\"\], \(52\) = \[\.ch2: \"1234567890\"\], (else) = \[\.ch3: \"1\"\]\}\]} \
	"print structure location 1"
    test_print_accept "print strul1.a" \
	"-2147483648" \
	"print field of structure location 1"
    test_print_accept "print strul1.b" "42" \
	"print field of structure location 1"
    test_print_accept "print strul1.ch1" \
	"\"12345678900987654321\"" \
	"print field of structure location 1"
    # setup_xfail "*-*-*"
    test_print_accept "print strul1.ch2" \
	"\"1234567890\"" \
	"print field of structure location 1"
    # setup_xfail "*-*-*"
    test_print_accept "print strul1.ch3" \
	"\"1\"" \
	"print field of structure location 1"
    
    if $passcount then {
	pass "$passcount correct locations printed"
    }
}

# This is chill/9434

proc test_9434 {} {
    global passcount

    verbose "testing pr-9434"

    test_print_accept "ptype m_xyzmode" "STRUCT \\(.*next REF m_xyzmode,.*i long.*\\)"
}

# Start with a fresh gdb.

gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir

gdb_test "set print sevenbit-strings" ".*"

if [set_lang_chill] then {
    test_modes
    test_locations
    test_9434
} else {
    warning "$test_name tests suppressed."
}