# Test the L language.
# Copyright (c) 2007-2009 BitMover, Inc.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
    testConstraint exec [llength [info commands exec]]
}

# Run these tests first, before setting the _L_TEST env variable.

test err-1.1 {test that syntax err causes no code to be run} -body {
catch {L { syntax error }} try {}
L { puts("this should not be run"); }
} -output {}

test err-1.2 {test that compiler warning causes no code to be run} -body {
catch {L { int err_not_used; }} try {}
L { puts("this should not be run"); }
} -output {}

test err-1.3 {test that compiler error causes no code to be run} -body {
catch {L { int err_illegal_type = "bad"; }} try {}
L { puts("this should not be run"); }
} -output {}

test err-1.4 {test that compiler error causes no code to be run 2} -body {
catch {L {
typedef int err1_4;
class err1_4;  // caught in parser; calls L_err() instead of L_errf()
}} try {}
L { puts("this should not be run"); }
} -output {}

# This causes L to keep running L code even after a compile error.
set ::env(_L_TEST) 1

test no-eq-ops-1 {test that old eq ops are now errors} -body {
#lang L --line=1
"s" eq "s";
"s" ne "s";
"s" lt "s";
"s" le "s";
"s" gt "s";
"s" ge "s";
} -returnCodes error -match regexp -result {.*1: L Error: illegal comparison operator
.*2: L Error: illegal comparison operator
.*3: L Error: illegal comparison operator
.*4: L Error: illegal comparison operator
.*5: L Error: illegal comparison operator
.*6: L Error: illegal comparison operator
}

# This tells L to run in a backwards compatibility mode for
# the old eq/ne/le/lt/ge/gt string-comparison operators.
set ::env(_L_ALLOW_EQ_OPS) 1

test lfile-1.0 {Test autowrapping of empty .l file} -setup {
	set fname [makeFile {} lfile-1.0.l]
} -constraints {
	exec
} -body {
	exec [interpreter] $fname
} -cleanup {
	removeFile lfile-1.0.l
} -result {}

test lfile-1.1 {Test autowrapping of .l works} -setup {
	set fname [makeFile {
		void main() {
			printf("hi mom\n");
		}
	} lfile-1.1.l]
} -constraints {
	exec
} -body {
	exec [interpreter] $fname
} -cleanup {
	removeFile lfile-1.1.l
} -result {hi mom}

test lfile-1.1 {Test #lang L wrapping with -L and --L cmd-line options} -setup {
	set fname [makeFile {
		void main() {
			puts("this is L");
		}
	} lfile-1.1.n]
} -constraints {
	exec
} -body {
	set s1 [exec [interpreter] -L $fname]
	set s2 [exec [interpreter] --L $fname]
	puts $s1
	puts $s2
} -cleanup {
	removeFile lfile-1.1.n
} -output {this is L
this is L
}

test lfile-1.3 {Test .l mapping via source command} -setup {
	set fname [makeFile {printf("hello there");} lfile-1.3.l]
} -body {
	source $fname
} -cleanup {
	removeFile lfile-1.3.l
} -output {hello there}

test lfile-1.4 {Test that in a Tcl script L does not call a Tcl main} -body {
proc main {} { puts "bad 1" }
} -output {}

test lfile-1.5 {Test that L mains in multiple interps get invoked} -body {
#lang L --line=1
void lfile_1_5()
{
	// Touch files instead of puts'ing since the slave interps seem
	// to not get tcltest's puts so -output{} doesn't match it.

	string	cmd1 = <<'END'
slave1 eval {#lang L
void main() { fclose(fopen("interp1", "w")); }}
END
	string	cmd2 = <<'END'
slave2 eval {#lang L
void main() { fclose(fopen("interp2", "w")); }}
END
	eval("interp create slave1");
	eval("interp create slave2");
	eval(cmd1);
	eval(cmd2);
	unless (exists("interp1")) puts("bad 1");
	unless (exists("interp2")) puts("bad 2");
}
lfile_1_5();
} -cleanup {
	removeFile "interp1"
	removeFile "interp2"
} -output {}

test lfile-1.6 {Test a Tcl file sourced from an L file} -setup {
	set fname [makeFile {puts "in Tcl"} lfile-1.6.tcl]
} -body {
#lang L --line=1
source("lfile-1.6.tcl");
void lfile_1_6()
{
	puts("in L");
}
lfile_1_6();
} -cleanup {
	removeFile lfile-1.6.tcl
} -output {in Tcl
in L
}

test lhtml-1 {test lhtml in a .lhtml file} -setup {
	set fname [makeFile {<?puts(nonewline: "line=${__LINE__} file=${__FILE__}");?>
line2
<?
int lhtml1 = 4;
?>
line4
<?unless (__LINE__ == 7) puts ("bad __LINE__=${__LINE__}");
while (lhtml1--) puts(nonewline: "[${lhtml1}]");
unless (__LINE__ == 9) puts ("bad __LINE__=${__LINE__}");
?>
this with <?= "an L string" ?> inline
<?=__LINE__?>
} lhtml-1.lhtml]
} -body {
#lang L
void lhtml_1()
{
	int	ret;
	string	got;
	string	tclsh = interpreter();
	string	want = <<'END'
line=1 file=lhtml-1.lhtml
line2

line4
[3][2][1][0]
this with an L string inline
12
END
	ret = system({tclsh, "lhtml-1.lhtml"}, undef, &got, undef);
	unless (ret == 0) puts("bad 1");
	unless (got == want) puts("bad 2 '${got}'");
}
lhtml_1();
} -output {}

test lhtml-2 {test #lang Lhtml} -body {
#lang Lhtml --line=1
line <?=__LINE__?> of Lhtml
#lang tcl
puts "tcl code"
#lang Lhtml
more Lhtml
<?puts(nonewline: 1+2+3);?>
} -output {line 1 of Lhtml
tcl code
more Lhtml
6
}

test lhtml-3 {test errors in Lhtml document} -setup {
	set fname [makeFile {<?puts(1+"bad1");?>
<?puts(1+"bad2");
puts(1+"bad3");
?>
line5
<?
puts(1+"bad4");
?>
} lhtml-3.lhtml]
} -body {
#lang L
void lhtml_3()
{
	int	ret;
	string	err, out;
	string	tclsh = interpreter();
	string	want = <<'END'
lhtml-3.lhtml:1: L Error: expected type int or float but got string in arithmetic operator
lhtml-3.lhtml:2: L Error: expected type int or float but got string in arithmetic operator
lhtml-3.lhtml:3: L Error: expected type int or float but got string in arithmetic operator
lhtml-3.lhtml:7: L Error: expected type int or float but got string in arithmetic operator
END
	ret = system({tclsh, "lhtml-3.lhtml"}, undef, &out, &err);
	if (ret == 0) puts("bad 1");
	unless (err =~ /${want}/) puts("bad 2 '${err}'");
}
lhtml_3();
} -output {}

test lhtml-4 {test lhtml document parsing} -body {
# This test is from Oscar. Check that the Lhtml delims in the
# embedded code are not mistaken for the real delims.
#lang Lhtml
<html>
<head>
<title>The TITLE</title>
</head>
<body>
<h1>Header: <? printf("%s <? foo ?>", 2 + 2); ?></h1>
</body>
</html>
} -output {<html>
<head>
<title>The TITLE</title>
</head>
<body>
<h1>Header: 4 <? foo ?></h1>
</body>
</html>
}

test lhtml-5 {test lhtml with L loops} -body {
#lang Lhtml
<html>
<tr>
<? int lhtml5; ?>
<? for (lhtml5 = 0; lhtml5 < 3; ++lhtml5) { ?>
	<td><? puts(nonewline: lhtml5); ?></td>
<? } ?>
</tr>
</html>
} -output {<html>
<tr>


	<td>0</td>

	<td>1</td>

	<td>2</td>

</tr>
</html>
}

test lhtml-6 {test premature EOF in lhtml document} -body {
#lang Lhtml --line=1
<? // no ending delim
} -returnCodes error -match regexp -result {.*2: L Error: premature EOF
}

test parse-1.0 {Test parsing an empty L script} -body {
#lang L --line=1
}

test parse-1.1 {Test parsing an L script that is just white space} -body {
#lang L --line=1
	


}

test opts-1 {test command options 1} -body {
#lang L -nowarn
void opts_1()
{
	int	not_used;  // not used warning should be suppressed
	printf("good");
}
opts_1();
} -output {good}

test opts-2 {test command options 2} -body {
#lang L --nowarn
void opts_2()
{
	int	not_used;  // not used warning should be suppressed
	printf("good");
}
opts_2();
} -output {good}

test opts-2.1 {test command options 3} -body {
#lang L
#pragma nowarn
void opts_2_1()
{
	int	not_used;  // not used warning should be suppressed
	printf("good");
}
opts_2_1();
} -output {good}

test opts-4 {test command options 4} -body {
#lang L -poly
void opts_4()
{
	string	s = "3";
	printf("%d", s+1);  // would be an err w/o the -poly
}
opts_4();
} -output {4}

test opts-5 {test command options 5} -body {
#lang L --poly
void opts_5()
{
	string	s = "3";
	printf("%d", s+1);  // would be an err w/o the --poly
}
opts_5();
} -output {4}

test opts-6.1.2 {test -norun command option} -body {
#lang L -norun
void opts_6_1_2()
{
	/* -norun means compile but do not run */
	puts("should not see this");
}
opts_6_1_2();
} -output {}

test opts-6.1.3 {test --norun command option} -body {
#lang L --norun
void opts_6_1_3()
{
	/* --norun means compile but do not run */
	puts("should not see this");
}
opts_6_1_3();
} -output {}

test opts-6.2 {test that --norun option compiles} -body {
#lang L --norun
void opts_6_2()
{
	string s = "This is
	an error";
}
opts_6_2();
} -returnCodes error -match regexp -result {.*missing string terminator.*}

test opts-6.3 {test bad command option} -body {
#lang L -bad
void opts_6_3() {}
} -returnCodes error -result {L Error: illegal option '-bad'
}

test opts-7 {test -nowarn command-line option} -setup {
	set file [makeFile {
			private void f() {
				int not_used;
				puts("good");
			}
			f();
		  } opts7.l .]
} -constraints {
	exec
} -body {
	# The script created above should not compile and run unless
	# the command-line options are handled correctly.
	set s1 [exec [interpreter] -nowarn $file]
	set s2 [exec [interpreter] --nowarn $file]
	puts $s1
	puts $s2
} -cleanup {
	removeFile $file
} -output "good\ngood\n"

test opts-7.1 {test -norun command-line option} -setup {
	set file [makeFile {
			puts("should not get run");
		  } opts7.1.l .]
} -constraints {
	exec
} -body {
	# The script created above should be compiled but not run
	# if the command-line options are handled correctly.
	set s1 [exec [interpreter] -norun $file]
	set s2 [exec [interpreter] --norun $file]
	puts $s1
	puts $s2
} -cleanup {
	removeFile $file
} -output "\n\n"

test opts-8 {test -poly command-line option} -setup {
	set file [makeFile {
			private void f() {
				string s = "3";
				printf("%d\n", s+1);
			}
			f();
		  } opts8.l .]
} -constraints {
	exec
} -body {
	# The script created above should not compile and run unless
	# the command-line options are handled correctly.
	set s1 [exec [interpreter] -poly $file]
	set s2 [exec [interpreter] --poly $file]
	puts $s1
	puts $s2
} -cleanup {
	removeFile $file
} -output "4\n4\n"

test opts-9 {test multiple command-line options} -setup {
	set file [makeFile {
			private void f() {
				int	not_used;
				string	s = "3";
				printf("%d\n", s+1);
			}
			f();
		  } opts9.l .]
} -constraints {
	exec
} -body {
	# The script created above should not compile and run unless
	# the command-line options are handled correctly.
	set s1 [exec [interpreter] -poly -nowarn $file]
	set s2 [exec [interpreter] --poly --nowarn $file]
	puts $s1
	puts $s2
} -cleanup {
	removeFile $file
} -output "4\n4\n"

test opts-10 {test multiple command-line options with app args} -setup {
	set file [makeFile {
			void main(int ac, string av[]) {
				int	i;
				string	s;
				for (i = 1; i < ac; ++i) s .= av[i];
				puts(s);
			}
		  } opts10.l .]
} -constraints {
	exec
} -body {
	# Check the application arguments are correctly passed to the L
	# main() even in the presence of tclsh command-line args.
	set s1 [exec [interpreter] $file]
	set s2 [exec [interpreter] $file arg1]
	set s3 [exec [interpreter] $file arg1 arg2]
	set s4 [exec [interpreter] -nowarn $file]
	set s5 [exec [interpreter] -nowarn $file arg1]
	set s6 [exec [interpreter] -nowarn $file arg1 arg2]
	set s7 [exec [interpreter] -nowarn -poly $file]
	set s8 [exec [interpreter] -nowarn -poly $file arg1]
	set s9 [exec [interpreter] -nowarn -poly $file arg1 arg2]
	puts $s1
	puts $s2
	puts $s3
	puts $s4
	puts $s5
	puts $s6
	puts $s7
	puts $s8
	puts $s9
} -cleanup {
	removeFile $file
} -output "\narg1\narg1arg2\n\narg1\narg1arg2\n\narg1\narg1arg2\n"

test opts-11 {test bad command-line option} -setup {
	set file [makeFile {
			void main() {}
		} opts11.l . ]
} -body {
#lang L --line=1
void opts_11()
{
	int	ret;
	string	err, out[];
	string	tclsh = eval("interpreter");

	ret = system({tclsh, "--bad", "opts11.l"}, undef, &out, &err);
	unless (ret == 1) puts("bad 1");
	unless (err =~ /L Error: illegal option '--bad'/) puts("bad 2 ${err}");
}
opts_11();
} -output {}

test parse-1.2 {Test parsing an empty L file} -setup {
	set fName [makeFile {} LFileTest]
} -constraints {
	exec
} -body {
	exec [interpreter] $fName
} -cleanup {
	removeFile LFileTest
} -result {}

test parse-1.3 {Test parsing an L file that just has whitespace} -setup {
	set fName [makeFile {



	} LFileTest]
} -constraints {
	exec
} -body {
	exec [interpreter] $fName
} -cleanup {
	removeFile LFileTest
} -result {}

test parse-1.4 {parse an L function named by a pattern} -body {
#lang L --line=1
poly Parse14Pattern_*(int a, ...rest)
{
	puts("${$1}${a}${rest}");
}
#lang tcl
} -result {}

test parse-1.5 {test handling of illegal character} -body {
#lang L --line=1
@
} -returnCodes error -match glob -result {*1: L Error: illegal character
@
^
}

test parse-1.5.1 {test handling of illegal character in string interpolation} -body {
#lang L --line=1
"${3@}";
} -returnCodes error -match glob -result {*1: L Error: illegal character
"$\{3@
    ^
}
# "  sync up the quotes for emacs

test parse-1.6 {test syntax error message 1} -body {
#lang L --line=1
void parse_1_6()
{
// Test that the err msg indenting is correct.
// No tab.
for()
}
} -returnCodes error -match glob -result {*5: L Error: syntax error, unexpected )
for()
    ^
}

test parse-1.7 {test syntax error message 2} -body {
#lang L --line=1
void parse_1_7()
{
	// Test that the err msg indenting is correct.
	// 1 tab.
	for()
}
} -returnCodes error -match glob -result {*5: L Error: syntax error, unexpected )
	for()
            ^
}

test parse-1.8 {test syntax error message 3} -body {
#lang L --line=1
void parse_1_8()
{
	// Test that the err msg indenting is correct.
	// 1 tab and spaces.
	    for()
}
} -returnCodes error -match glob -result {*5: L Error: syntax error, unexpected )
	    for()
                ^
}

test parse-1.9 {test syntax error message 4} -body {
#lang L --line=1
void parse_1_9()
{
	// Test that the err msg indenting is correct.
	// 2 tabs.
		for()
}
} -returnCodes error -match glob -result {*5: L Error: syntax error, unexpected )
		for()
                    ^
}

test parse-1.10 {test syntax error message 5} -body {
#lang L --line=1
void parse_1_10()
{
	// Test that the err msg indenting is correct.
	// 2 tabs with spaces in between.
		for()
}
} -returnCodes error -match glob -result {*5: L Error: syntax error, unexpected )
		for()
                    ^
}

test parse-1.11 {test syntax error message for error on line 1} -body {
#lang L --line=1
void parse_1_11() { for() }  // syntax error on line 1
} -returnCodes error -match glob -result {*1: L Error: syntax error, unexpected )
void parse_1_11() \{ for()
                        ^
}

test scan-1.1 {test detection of run-away string 1} -body {
#lang L --line=1
void scan_1_1()
{
	string	s = "This is bad
	and should be an error";
	puts(s);
}
} -returnCodes {error} -match regexp -result {.*missing string terminator \"\n}

test scan-1.2 {test detection of run-away string 2} -body {
#lang L --line=1
void scan_1_2()
{
	string	s = "This is bad
}
#"
} -returnCodes {error} -match regexp -result {.*missing string terminator \"\n}

test scan-1.3 {test detection of run-away string 3} -body {
#lang L --line=1
void scan_1_3()
{
	string	s = 'This is bad
	and should be an error';
	puts(s);
}
} -returnCodes {error} -match regexp -result {.*missing string terminator \'\n}

test scan-1.4 {test detection of run-away string 4} -body {
#lang L --line=1
void scan_1_4()
{
	string	s = 'This is bad
}
#'
} -returnCodes {error} -match regexp -result {.*missing string terminator \'\n}

test scan-1.4.2 {test detection of run-away string 5} -body {
#lang L --line=1
void scan_1_4_2()
{
	string	s = `echo this is bad
}
} -returnCodes {error} -match regexp -result {.*missing string terminator `\n}

test scan-1.4.3 {test detection of run-away string 5} -body {
#lang L --line=1
void scan_1_4_3()
{
	string	s = `echo this is bad
>foo`;
}
} -returnCodes {error} -match regexp -result {.*missing string terminator `\n}

test scan-1.4.4 {test detection of run-away regexp 1} -body {
#lang L --line=1
void scan_1_4_4()
{
	string	s = "x";

	s =~ /xbad_no_terminator;
}
} -returnCodes {error} -match regexp -result {.*run-away regular expression\n}

test scan-1.4.5 {test detection of run-away regexp 2} -body {
#lang L --line=1
void scan_1_4_5()
{
	string	s = "x";

	s =~ s/x/bad_no_terminator;
}
} -returnCodes {error} -match regexp -result {.*run-away regular expression\n}

test scan-1.4.6 {test detection of run-away regexp 3} -body {
#lang L --line=1
void scan_1_4_6()
{
	string	s = "x";

	s =~ s/xbad_no_terminator/x;
}
} -returnCodes {error} -match regexp -result {.*run-away regular expression\n}

test scan-1.5 {check escapes in single-quoted strings} -body {
#lang L --line=1
void scan_1_5()
{
	string	s;

	s = '\a\t\n\001';
	unless (length(s) == 10) puts("bad 1.0");
	unless ((s[0] eq "\\") && (s[1] eq "a")) puts("bad 1.1");
	unless ((s[2] eq "\\") && (s[3] eq "t")) puts("bad 1.2");
	unless ((s[4] eq "\\") && (s[5] eq "n")) puts("bad 1.3");
	unless ((s[6] eq "\\") && (s[7] eq "0")) puts("bad 1.4");
	unless ((s[8] eq "0")  && (s[9] eq "1")) puts("bad 1.5");

	s = '\\\'';
	unless (length(s) == 2) puts("bad 2.0");
	unless ((s[0] eq "\\") && (s[1] eq "'")) puts("bad 2.1");

	/*
	 * The following test doesn't work unless run from the
	 * command line.  Perhaps tcltest is munging the string.  ?
	s = 'line\
break';
	unless (s eq "line\nbreak") puts("bad 3.1");
	*/
}
scan_1_5();
} -output {}

test scan-1.6 {check escapes in double-quoted strings} -body {
#lang L --line=1
void scan_1_6()
{
	string	s;

	s = "\a\t\n\r\\\"";
	unless (length(s) == 6) puts("bad 1.0");
	unless ((s[0] eq "a")  && (s[1] eq "\t")) puts("bad 1.1");
	unless ((s[2] eq "\n") && (s[3] eq "\r")) puts("bad 1.2");
	unless ((s[4] eq "\\") && (s[5] eq "\"")) puts("bad 1.3");

	/*
	 * The following test doesn't work unless run from the
	 * command line.  Perhaps tcltest is munging the string.  ?
	s = "line\
break";
	unless (s eq "line\nbreak") puts("bad 2.1");
	*/
}
scan_1_6();
} -output {}

test scan-1.7 {test here documents 1} -body {
#lang L --line=1
void scan_1_7()
{
	/* Vary the whitespace. */

	string	s1,s2,s3,s4,s5,s6,s7,s8,s10,s11;

	s1 = <<'E'
str1
E
	unless (s1 eq "str1\n") puts("bad 1");

	s2 = <<'EN'
str2
EN
	unless (s2 eq "str2\n") puts("bad 2");

	s3 = <<'END'
str3
END
	unless (s3 eq "str3\n") puts("bad 3");

	s4 =<<'END'
str4
END
	unless (s4 eq "str4\n") puts("bad 4");

	s5 =  <<'END'
str5
END
	unless (s5 eq "str5\n") puts("bad 5");

	s6 =	<<'END'
str6
END
	unless (s6 eq "str6\n") puts("bad 6");

	s7 =	 <<'END'
str7
END
	unless (s7 eq "str7\n") puts("bad 7");

	s8 =
<<'END'
str8
END
	unless (s8 eq "str8\n") puts("bad 8");

	/*
	 * These test the patterns in the scanner that check for a ;
	 * after the end delim.  Note that there are spaces after
	 * some of the ; below.
	 */

	s10 = <<'END'
NOTEND;
NOTEND ;
NOTEND; 
NOTEND ; 
END
	unless (s10 eq "NOTEND;\nNOTEND ;\nNOTEND; \nNOTEND ; \n") {
		puts("bad 10");
	}

	s11 = <<END
NOTEND;
NOTEND ;
NOTEND; 
NOTEND ; 
END
	unless (s11 eq "NOTEND;\nNOTEND ;\nNOTEND; \nNOTEND ; \n") {
		puts("bad 11");
	}

	/* Semicolons are allowed after the delim now. */

	s11 = <<END
NOTEND;
END;
	unless (s11 == "NOTEND;\n") puts("bad 12");

	s11 = <<'END'
NOTEND;
END;
	unless (s11 == "NOTEND;\n") puts("bad 13");

	/*
	 * Test whitespace prefix.
	 */

	s11 =
	<<END
	line1

	line2
	ENDNOT
	END;
	unless (s11 == "line1\n\nline2\nENDNOT\n") puts("bad 19.1");

	s11 =
	<<'END'
	line1

	line2
	ENDNOT
	END;
	unless (s11 == "line1\n\nline2\nENDNOT\n") puts("bad 19.2");
}
scan_1_7();
} -output {}

test scan-1.8 {test here documents 2} -body {
#lang L --line=1 -nowarn
string ::scan_1_8a;
void scan_1_8()
{
	string	s;
	string	foo = "foo";

	/* Check string interpolation. */

	s = <<END
interpolated string ${foo}
END
	unless (s eq "interpolated string foo\n") puts("bad 1");

	s = <<'END'
uninterpolated string ${foo}
END
	unless (s eq "uninterpolated string \${foo}\n") puts("bad 2");

	/*
	 * The scanner handles an ID inside a here document
	 * differently than a non-ID, so try both.
	 */

	s = <<END
${foo}
aword
two words
END
	unless (s eq "foo\naword\ntwo words\n") puts("bad 3");

	s = <<'END'
${foo}
aword
two words
END
	unless (s eq "\${foo}\naword\ntwo words\n") puts("bad 4");

	/*
	 * Ensure delimeter isn't found mistakenly.  It isn't
	 * allowed to have leading or trailing whitespace or
	 * anything else.
	 */

	s = <<END
EN
EN D
END 
 ENDx
ENDEND
END
	unless (s eq "EN\nEN D\nEND \n ENDx\nENDEND\n") puts("bad 5");

	s = <<'END'
EN
EN D
END 
 ENDx
ENDEND
END
	unless (s eq "EN\nEN D\nEND \n ENDx\nENDEND\n") puts("bad 6");

	/*
	 * Check escapes:
	 * non-interpolated here doc:
	 *   no escapes
	 * interpolated here doc:
	 *   \\ \$ \`    get escaped
	 *   \<newline>  gets ignored
	 *   \x          for anything else, not escaped
	 *
	 * We can't test \<newline> by simply writing it here because the
	 * tcltest parsing messes with it.
	 */

	s = <<END
$\\\$\`\n\tx
END
	unless (s eq "$\\$`\\n\\tx\n") puts("bad 9.1");

	s = <<'END'
a\tb\nc\\d\x\\\'
END
	unless (s eq "a\\tb\\nc\\\\d\\x\\\\\\'\n") puts("bad 9.2");

	/*
	 * Checking \<newline> is tough since tcltest's parsing of
	 * the test source won't let \<newline> through.  So create
	 * strings of L code and eval those.
	 *
	 * Note: The :: in front of the global scan_1_8a works around
	 * an L bug with global upvar shadows which will be fixed
	 * soon in a different cset.
	 */
	// x\<newline>
	// y
	L("::scan_1_8a = <<END\nx\\\ny\nEND\n");
	unless (::scan_1_8a eq "xy\n") puts("bad 9.3 ${::scan_1_8a}");
	L("::scan_1_8a = <<'END'\nx\\\ny\nEND\n");
	unless (::scan_1_8a eq "x\\\ny\n") puts("bad 9.4");
	// x\<newline>
	// y\<newline>
	L("::scan_1_8a = <<END\nx\\\ny\\\nEND\n");
	unless (::scan_1_8a eq "xy") puts("bad 9.5");
	L("::scan_1_8a = <<'END'\nx\\\ny\\\nEND\n");
	unless (::scan_1_8a eq "x\\\ny\\\n") puts("bad 9.6");
	// \<newline>
	L("::scan_1_8a = <<END\n\\\nEND\n");
	unless (::scan_1_8a eq "") puts("bad 9.7");
	L("::scan_1_8a = <<'END'\n\\\nEND\n");
	unless (::scan_1_8a eq "\\\n") puts("bad 9.8");

	/* Check `cmd` inside interpolated here document. */
	s = <<END
abc
`perl -e 'print "cmd"'`
def
END
	unless (s eq "abc\ncmd\ndef\n") puts("bad 20.1");

	/* Check multiple `cmd` in a here document. */

	s = <<END
abc
`perl -e 'print "cmd1"'``perl -e 'print "cmd2"'`
def
END
	unless (s eq "abc\ncmd1cmd2\ndef\n") puts("bad 21.1");

	s = <<END
abc
`perl -e 'print "cmd1"'``perl -e 'print "cmd2"'``perl -e 'print "cmd3"'`
def
END
	unless (s eq "abc\ncmd1cmd2cmd3\ndef\n") puts("bad 21.2");
}
scan_1_8();
} -output {}

test scan-1.9 {test here document error 1} -body {
#lang L --line=1
void
scan_1_9()
{
	/*
	 * Error, since nothing is allowed after the END except
	 * a newline.
	 */
	string s1 = <<'END'err
END
}
scan_1_9();
} -returnCodes {error} -match regexp -result {.*8: L Error: illegal characters after here-document delimeter
}

test scan-1.10 {test here document error 2} -body {
#lang L --line=1
void
scan_1_10()
{
	/*
	 * Error, since nothing is allowed after the END except
	 * a newline.
	 */
	string s1 = <<END err
END
}
scan_1_10();
} -returnCodes {error} -match regexp -result {.*8: L Error: illegal characters after here-document delimeter
}

test scan-1.11 {test nested here documents error} -body {
#lang L --line=1
void
scan_1_11()
{
	string s1, s2 = <<END
${s1=<<BAD
should be error
BAD
}
END
}
scan_1_11();
} -returnCodes {error} -match regexp -result ".*nested here documents illegal.*"

test scan-1.12 {test here document error 3} -body {
#lang L --line=1
void
scan_1_12()
{
	/*
	 * White space before or after the delim is illegal.
	 */

	string s = <<	END
	END;
}
scan_1_12();
} -returnCodes {error} -match regexp -result {.*8: L Error: illegal characters before here-document delimeter
}

test scan-1.13 {test here document error 4} -body {
#lang L --line=1
void
scan_1_13()
{
	/*
	 * White space before or after the delim is illegal.
	 */

	string s = <<END  
	END;
}
scan_1_13();
} -returnCodes {error} -match regexp -result {.*8: L Error: illegal characters after here-document delimeter
}

test scan-1.14 {test here document error 5} -body {
#lang L --line=1
void
scan_1_14()
{
	/*
	 * <<-END as the delim works in the Bourne shell but is
	 * an error in L.
	 */

	string s = <<-END
	END;
}
scan_1_14();
} -returnCodes {error} -match regexp -result {.*9: L Error: <<- unsupported, use =\\n\\t<<END to strip one leading tab
}

test scan-1.15 {test here document error 6} -body {
#lang L --line=1
void
scan_1_15()
{
	/*
	 * <<-'END' as the delim works in the Bourne shell but is
	 * an error in L.
	 */

	string s = <<-'END'
	END;
}
scan_1_15();
} -returnCodes {error} -match regexp -result {.*9: L Error: <<- unsupported, use =\\n\\t<<END to strip one leading tab
}

test scan-1.16 {check auto string concatenation} -body {
#lang L --line=1
void scan_1_16()
{
	string	s;

	s = "a"
"b"
"c";
	unless (s eq "abc") puts("bad 1");

	s = "d"
	    "e"
	    "f";
	unless (s eq "def") puts("bad 2");

	s = 'a'
'b'
'c';
	unless (s eq "abc") puts("bad 3");

	s = 'd'
	    'e'
	    'f';
	unless (s eq "def") puts("bad 4");
}
scan_1_16();
} -output {}

test scan-1.17 {check \u escapes in strings} -body {
#lang L --line=1
void scan_1_17()
{
	string	s;

	s = "\u3";
	unless (ord(s) == 0x3) puts("bad 1.1");
	s = "\u34";
	unless (ord(s) == 0x34) puts("bad 1.2");
	s = "\u345";
	unless (ord(s) == 0x345) puts("bad 1.3");
	s = "\u3456";
	unless (ord(s) == 0x3456) puts("bad 1.4");

	s = "xy\u3z";
	unless (length(s) == 4) puts("bad 2.1");
	unless ((ord(s[2]) == 0x3) && (s[3] eq "z")) puts("bad 2.2");
	s = "xy\u34z";
	unless (length(s) == 4) puts("bad 2.3");
	unless ((ord(s[2]) == 0x34) && (s[3] eq "z")) puts("bad 2.4");
	s = "xy\u345z";
	unless (length(s) == 4) puts("bad 2.5");
	unless ((ord(s[2]) == 0x345) && (s[3] eq "z")) puts("bad 2.6");
	s = "xy\u3456z";
	unless (length(s) == 4) puts("bad 2.7");
	unless ((ord(s[2]) == 0x3456) && (s[3] eq "z")) puts("bad 2.8");
	s = "xy\u34567";
	unless (length(s) == 4) puts("bad 2.9");
	unless ((ord(s[2]) == 0x3456) && (s[3] eq "7")) puts("bad 2.10");
}
scan_1_17();
} -output {}

test scan-2.1 {test #line directive} -body {
#lang L --line=1
#line 1 "scan2-1.l"
void scan_2_a()
{
	bad1;
}

#line 2 "scan2-2.l"
void scan_2_b()
{
	bad2;
}






#line 13 "scan2-3.l"
void scan_2_c()
{
	bad3;
}
} -returnCodes {error} -match regexp -result {scan2-1.l:3: L Error: undeclared variable: bad1
scan2-2.l:4: L Error: undeclared variable: bad2
scan2-3.l:15: L Error: undeclared variable: bad3
}

# This is test include-1.0 with #line's thrown in.
test scan-2.2 {test #line directive with include files} -setup {
	set fname [makeFile {#line 1 "foo.l"
			++scan_2_2;
			unless (basename(__FILE__) eq "foo.l") puts("bad 1");
			unless (__LINE__ == 3) puts("bad 2");
		   } scan-2.2.l [file dirname [info script]]]
} -body {
#lang L --line=1
unless (__LINE__ == 1) puts("bad 1.1");
int scan_2_2 = 0;
puts(scan_2_2);
unless (__LINE__ == 4) puts("bad 1.2");
#include "scan-2.2.l"
unless (__LINE__ == 6) puts("bad 1.3");
puts(scan_2_2);
// Check variations in spacing and punctation.
// The compiler should include scan-2.2.l only once.
#include "scan-2.2.l"
unless (__LINE__ == 11) puts("bad 1.4");
#include  "scan-2.2.l"
unless (__LINE__ == 13) puts("bad 1.5");
#include  "scan-2.2.l" 
unless (__LINE__ == 15) puts("bad 1.6");
#include"scan-2.2.l"
unless (__LINE__ == 17) puts("bad 1.7");
puts(scan_2_2);
} -cleanup {
	removeFile $fname
} -output {0
1
1
}

# This is test include-1.1 with #line's thrown in.
test scan-2.3 {test #line directive with nested include files} -setup {
#
# The code for these files isn't indented because L recognizes
# include() only when it starts at the beginning of the line.
#
	set fname1 [makeFile {#line 1 "foo1.l"
#include "scan-2.3-2.l"
unless (basename(__FILE__) eq "foo1.l") puts("bad 1");
unless (__LINE__ == 3) puts("bad 2 ${__LINE__}");
} scan-2.3-1.l [file dirname [info script]]]
	set fname2 [makeFile {#line 1 "foo2.l"
int scan_2_3a = 3;
unless (basename(__FILE__) eq "foo2.l") puts("bad 3");
unless (__LINE__ == 3) puts("bad 4");
#include "scan-2.3-3.l"
unless (basename(__FILE__) eq "foo2.l") puts("bad 5");
unless (__LINE__ == 6) puts("bad 6 ${__LINE__}");
} scan-2.3-2.l .]
	set fname3 [makeFile {#line 1 "foo3.l"
int scan_2_3b = 4;
unless (basename(__FILE__) eq "foo3.l") puts("bad 7");
unless (__LINE__ == 3) puts("bad 8");
} scan-2.3-3.l .]
} -body {
#lang L
#line 1 "foo4.l"
unless (__LINE__ == 1) puts("bad 10.0");
unless (__FILE__ eq "foo4.l") puts("bad 10.1");
#include "scan-2.3-1.l"
unless (__LINE__ == 4) puts("bad 10.1.2");
unless (__FILE__ eq "foo4.l") puts("bad 10.2");
unless (scan_2_3a == 3) puts("bad 10.3");
unless (scan_2_3b == 4) puts("bad 10.4");
} -cleanup {
	removeFile $fname1
	removeFile $fname2
	removeFile $fname3
} -output {}

test scan-2.4 {test malformed #line directives} -body {
#lang L --line=1
#line 0
#line
#line xyx
} -returnCodes error -match regexp -result {.*1: L Error: malformed #line
.*2: L Error: malformed #line
.*3: L Error: malformed #line
}

test scan-3.1 {test line numbers in compile- and run-time messages, .l file} -setup {

# This test creates three .l files.  One is given to L, and the other two are
# brought in via #include or source().  Several things are tested with the same
# code.  First, line #s in type errors which the compiler will complain about
# unless compiling with --poly.  Second, line #s in run-time errors which
# selectively can be hit by setting the SCAN31 environment variable.
# Third, __LINE__.

#####################################################
# scan-3.1-1.l
	set fname1 [makeFile {
string g = getenv("SCAN31");
unless (__LINE__ == 3) puts("bad 1.1");
if ("${basename(__FILE__)}:${__LINE__}" == g) g + 1;  // line 4
#include "scan-3.1-2.l"
source("scan-3.1-3.l");
unless (__LINE__ == 7) puts("bad 1.2");
void main()
{
	f1();
	f2();

	if ("${basename(__FILE__)}:${__LINE__}" == g) g + 1;  // line 13
}
puts("test ran");
} scan-3.1-1.l .]

#####################################################
# scan-3.1-2.l
	set fname2 [makeFile {
/*
 * This code conditionally causes a run-time error.
 */
unless (__LINE__ == 5) puts("bad 2.1");
void f1() {
	if ("${basename(__FILE__)}:${__LINE__}" == g) g + 1;  // line 7
}
unless (__LINE__ == 9) puts("bad 2.2");
} scan-3.1-2.l .]

#####################################################
# scan-3.1-3.l
	set fname3 [makeFile {
/*
 * This code conditionally causes a run-time error.
 */
extern string ::g;
unless (__LINE__ == 6) puts("bad 3.1");
void f2() {
	if ("${basename(__FILE__)}:${__LINE__}" == ::g) ::g + 1;  // line 8
}
unless (__LINE__ == 10) puts("bad 3.2");
} scan-3.1-3.l .]

} -body {
#lang L
void scan31_chk(string cmd[], string expected{string}[])
{
	int	bad, ret;
	string	err, exs[], k, out, s;

	foreach (k=>exs in expected) {
		putenv("SCAN31=%s", k);
		ret = system(cmd, undef, &out, &err);
		unless (ret == 1) puts("bad 2.1");
		bad = 0;
		foreach (s in exs) {
			unless (err =~ /${s}/) {
				puts("bad 2.2: expected '${s}'");
				++bad;
			}
		}
		if (bad) {
			puts("Got:");
			puts("-----------------------------------------------");
			puts(err);
			puts("-----------------------------------------------");
		}
	}
}
void scan_3_1()
{
	int	ret;
	string	err, out;
	string	expected{string}[];
	string	tclsh = interpreter();

	/*
	 * The first run gets the compiler error messages.
	 */
	expected = {
		"0" => {
			'scan-3.1-1.l:4: L Error: expected type int',
			'scan-3.1-2.l:7: L Error: expected type int',
			'scan-3.1-1.l:13: L Error: expected type int',
		},
	};
	scan31_chk({tclsh, "scan-3.1-1.l"}, expected);

	/*
	 * The next run gets the run-time error messages.
	 * Use --poly so the type errors in the test code do not
	 * prevent compilation.  Run several times and pass in the
	 * necessary cmd-line options so the code hits each of its
	 * various possible run-time errors.
	 */
	expected = {
		"scan-3.1-1.l:4" => {
			'use non-numeric string as operand of "\+"',
			'procedure "\d+%l_toplevel" line 4',
		},
		"scan-3.1-1.l:13" => {
			'use non-numeric string as operand of "\+"',
			'procedure "main" line 13',
		},
		"scan-3.1-2.l:7" => {
			'use non-numeric string as operand of "\+"',
			'procedure "f1" line 7',
			'procedure "main" line 10',
		},
		"scan-3.1-3.l:8" => {
			'use non-numeric string as operand of "\+"',
			'procedure "f2" line 8',
			'procedure "main" line 11',
		},
	};
	scan31_chk({tclsh, "--poly", "scan-3.1-1.l"}, expected);

	/*
	 * Finally, let the code run without any errors so that the
	 * checks of __LINE__ in it are run.
	 */
	putenv("SCAN31=0");
	ret = system({tclsh, "--poly", "scan-3.1-1.l"}, undef, &out, &err);
	if (ret) puts("bad 3.1");
	unless (out == "test ran\n") puts("bad 3.2");
}
scan_3_1();
} -output {}

test scan-3.2 {test line numbers in compile- and run-time messages, .tcl file} -setup {

# This test is like scan-3.1 but with .tcl files instead of .l files.

#####################################################
# scan-3.2-1.tcl
	set fname1 [makeFile {
#lang L
string g = getenv("SCAN31");
unless (__LINE__ == 4) puts("bad 1.1");
if ("${basename(__FILE__)}:${__LINE__}" == g) g + 1;  // line 5
#lang tcl
# more Tcl code
source scan-3.2-2.tcl
#lang L
unless (__LINE__ == 10) puts("bad 1.2");
if ("${basename(__FILE__)}:${__LINE__}" == g) g + 1;  // line 11
f1();
puts("test ran");
} scan-3.2-1.tcl .]

#####################################################
# scan-3.2-2.tcl
	set fname2 [makeFile {
#lang L
unless (__LINE__ == 3) puts("bad 2.1");
if ("${basename(__FILE__)}:${__LINE__}" == g) g + 1;  // line 4
void f1() {
	if ("${basename(__FILE__)}:${__LINE__}" == g) g + 1;  // line 6
}
unless (__LINE__ == 8) puts("bad 2.2");
} scan-3.2-2.tcl .]

} -body {
#lang L --nowarn
void scan_3_2()
{
	int	ret;
	string	err, out;
	string	expected{string}[];
	string	tclsh = interpreter();

	/*
	 * The first run gets the compiler error messages in the
	 * first block of L code.
	 */
	expected = {
		"0" => {
			'scan-3.2-1.tcl:5: L Error: expected type int',
		},
	};
	scan31_chk({tclsh, "scan-3.2-1.tcl"}, expected);

	/*
	 * The next run gets the run-time error messages.
	 * Use --poly so the type errors in the test code do not
	 * prevent compilation.  Run several times and pass in the
	 * necessary cmd-line options so the code hits each of its
	 * various possible run-time errors.
	 */
	expected = {
		"scan-3.2-1.tcl:5" => {
			'use non-numeric string as operand of "\+"',
			'procedure "\d+%l_toplevel" line 5',
		},
		"scan-3.2-1.tcl:11" => {
			'use non-numeric string as operand of "\+"',
			'procedure "\d+%l_toplevel" line 11',
		},
		"scan-3.2-2.tcl:4" => {
			'use non-numeric string as operand of "\+"',
			'procedure "\d+%l_toplevel" line 4',
		},
		"scan-3.2-2.tcl:6" => {
			'use non-numeric string as operand of "\+"',
			'procedure "f1" line 6',
			'procedure "\d+%l_toplevel" line 12',
		},
	};
	scan31_chk({tclsh, "--poly", "scan-3.2-1.tcl"}, expected);

	/*
	 * Finally, let the code run without any errors so that the
	 * checks of __LINE__ in it are run.
	 */
	putenv("SCAN31=0");
	ret = system({tclsh, "--poly", "scan-3.2-1.tcl"}, undef, &out, &err);
	if (ret) puts("bad 3.1");
	unless (out == "test ran\n") puts("bad 3.2");
}
scan_3_2();
} -output {}

test scan-4 {check for regression if "L" passed as an arg} -body {
#lang L
string scan_4f(...args)
{
	return (join(" ", args));
}
void scan_4()
{
	unless (eval("scan_4f a b") == "a b") puts("bad 1");
	unless (eval("scan_4f L") == "L") puts("bad 2");
	unless (eval("scan_4f L L") == "L L") puts("bad 3");
	unless (eval("scan_4f a L") == "a L") puts("bad 4");
	unless (eval("scan_4f L b") == "L b") puts("bad 5");
	unless (eval("scan_4f a L b") == "a L b") puts("bad 6");
}
scan_4();
} -output {}

test scan-5 {check that trailing newline is scanned} -body {
#lang L
// The L-compiler scanner requires comments to end in a newline.
#lang tcl
# But a past compiler bug would eat them, causing syntax errors.
#lang L
// This test checks that case.
} -output {}

test scan-6 {test 'and','or','xor','not' unimplemented reserved words} -body {
#lang L --line=1
void scan_6()
{
	if (1 and 2) {}
	if (1 or 2) {}
	if (1 or (2 and 3)) {}
	if (not 1 xor 2) {}
}
} -returnCodes error -match regexp -result {.*3: L Error: 'and','or','xor','not' are unimplemented reserved words
.*4: L Error: 'and','or','xor','not' are unimplemented reserved words
.*5: L Error: 'and','or','xor','not' are unimplemented reserved words
.*6: L Error: 'and','or','xor','not' are unimplemented reserved words
}

test unicode-1 {test unicode in string constants and here documents} -body {
#lang L --line=1
void unicode_1()
{
	string	h, j, s;

	// This has twelve Hebrew characters including two ASCII spaces
	// in an interpolated string (double quotes).
	h = "זו השפה שלנו";
	unless (length(h) == 12) puts("bad 1.1");
	unless (ord(h[0]) == 0x05d6) puts("bad 1.2");	// Zayen
	unless (ord(h[1]) == 0x05d5) puts("bad 1.3");	// Vav
	unless (ord(h[2]) == 0x0020) puts("bad 1.4");	// space
	unless (ord(h[3]) == 0x05d4) puts("bad 1.5");	// He
	unless (ord(h[4]) == 0x05e9) puts("bad 1.6");	// Shin
	unless (ord(h[5]) == 0x05e4) puts("bad 1.7");	// Pe
	unless (ord(h[6]) == 0x05d4) puts("bad 1.8");	// He
	unless (ord(h[7]) == 0x0020) puts("bad 1.9");	// space
	unless (ord(h[8]) == 0x05e9) puts("bad 1.10");	// Shin
	unless (ord(h[9]) == 0x05dc) puts("bad 1.11");	// Lamed
	unless (ord(h[10]) == 0x05e0) puts("bad 1.12");	// Hun
	unless (ord(h[11]) == 0x05d5) puts("bad 1.13");	// Vav
	if (defined(h[12])) puts("bad 1.14");

	// Same string as above except in an interpolated here
	// document (and therefore with a trailing ASCII newline.
	h = <<END
זו השפה שלנו
END
	unless (length(h) == 13) puts("bad 2.1");
	unless (ord(h[0]) == 0x05d6) puts("bad 2.2");	// Zayen
	unless (ord(h[1]) == 0x05d5) puts("bad 2.3");	// Vav
	unless (ord(h[2]) == 0x0020) puts("bad 2.4");	// space
	unless (ord(h[3]) == 0x05d4) puts("bad 2.5");	// He
	unless (ord(h[4]) == 0x05e9) puts("bad 2.6");	// Shin
	unless (ord(h[5]) == 0x05e4) puts("bad 2.7");	// Pe
	unless (ord(h[6]) == 0x05d4) puts("bad 2.8");	// He
	unless (ord(h[7]) == 0x0020) puts("bad 2.9");	// space
	unless (ord(h[8]) == 0x05e9) puts("bad 2.10");	// Shin
	unless (ord(h[9]) == 0x05dc) puts("bad 2.11");	// Lamed
	unless (ord(h[10]) == 0x05e0) puts("bad 2.12");	// Hun
	unless (ord(h[11]) == 0x05d5) puts("bad 2.13");	// Vav
	unless (ord(h[12]) == 0x0a)   puts("bad 2.14");	// newline
	if (defined(h[13])) puts("bad 2.15");

	// This has 14 Kanji characters including two Kanji (0x3000) spaces
	// in an uninterpolated string (single quotes).
	j = '私は　日本語が　分かります';
	unless (length(j) == 13) puts("bad 3.1");
	unless (ord(j[0]) == 0x79c1) puts("bad 3.2");
	unless (ord(j[1]) == 0x306f) puts("bad 3.3");
	unless (ord(j[2]) == 0x3000) puts("bad 3.4");
	unless (ord(j[3]) == 0x65e5) puts("bad 3.5");
	unless (ord(j[4]) == 0x672c) puts("bad 3.6");
	unless (ord(j[5]) == 0x8a9e) puts("bad 3.7");
	unless (ord(j[6]) == 0x304c) puts("bad 3.8");
	unless (ord(j[7]) == 0x3000) puts("bad 3.9");
	unless (ord(j[8]) == 0x5206) puts("bad 3.10");
	unless (ord(j[9]) == 0x304b) puts("bad 3.11");
	unless (ord(j[10]) == 0x308a) puts("bad 3.12");
	unless (ord(j[11]) == 0x307e) puts("bad 3.13");
	unless (ord(j[12]) == 0x3059) puts("bad 3.14");
	if (defined(j[13])) puts("bad 3.15");

	// Same as above, but an uninterpolated here document.
	j = <<'END'
私は　日本語が　分かります
END
	unless (length(j) == 14) puts("bad 4.1");
	unless (ord(j[0]) == 0x79c1) puts("bad 4.2");
	unless (ord(j[1]) == 0x306f) puts("bad 4.3");
	unless (ord(j[2]) == 0x3000) puts("bad 4.4");
	unless (ord(j[3]) == 0x65e5) puts("bad 4.5");
	unless (ord(j[4]) == 0x672c) puts("bad 4.6");
	unless (ord(j[5]) == 0x8a9e) puts("bad 4.7");
	unless (ord(j[6]) == 0x304c) puts("bad 4.8");
	unless (ord(j[7]) == 0x3000) puts("bad 4.9");
	unless (ord(j[8]) == 0x5206) puts("bad 4.10");
	unless (ord(j[9]) == 0x304b) puts("bad 4.11");
	unless (ord(j[10]) == 0x308a) puts("bad 4.12");
	unless (ord(j[11]) == 0x307e) puts("bad 4.13");
	unless (ord(j[12]) == 0x3059) puts("bad 4.14");
	unless (ord(j[13]) == 0x0a)   puts("bad 4.15");
	if (defined(j[14])) puts("bad 4.16");

	// Some diacritics.
	s = "Algunos signos diacríticos del español";
	unless (length(s) == 38) puts("bad 5.1");
	unless (ord(s[20]) == 0x00ed) puts("bad 5.2");
	unless (ord(s[35]) == 0x00f1) puts("bad 5.3");
}
unicode_1();
} -output {}

test unicode-2 {test manipulation of unicode strings} -body {
#lang L --line=1
void unicode_2()
{
	string	h = "זו השפה שלנו";
	string	j = '私は　日本語が　分かります';

	h .= j;
	unless (h eq "זו השפה שלנו私は　日本語が　分かります") puts("bad 1.0");
	unless (length(h) == 25) puts("bad 1.1");
	unless (ord(h[0]) == 0x05d6) puts("bad 1.2");
	unless (ord(h[1]) == 0x05d5) puts("bad 1.3");
	unless (ord(h[2]) == 0x0020) puts("bad 1.4");
	unless (ord(h[3]) == 0x05d4) puts("bad 1.5");
	unless (ord(h[4]) == 0x05e9) puts("bad 1.6");
	unless (ord(h[5]) == 0x05e4) puts("bad 1.7");
	unless (ord(h[6]) == 0x05d4) puts("bad 1.8");
	unless (ord(h[7]) == 0x0020) puts("bad 1.9");
	unless (ord(h[8]) == 0x05e9) puts("bad 1.10");
	unless (ord(h[9]) == 0x05dc) puts("bad 1.11");
	unless (ord(h[10]) == 0x05e0) puts("bad 1.12");
	unless (ord(h[11]) == 0x05d5) puts("bad 1.13");
	unless (ord(h[12]) == 0x79c1) puts("bad 1.14");
	unless (ord(h[13]) == 0x306f) puts("bad 1.15");
	unless (ord(h[14]) == 0x3000) puts("bad 1.16");
	unless (ord(h[15]) == 0x65e5) puts("bad 1.17");
	unless (ord(h[16]) == 0x672c) puts("bad 1.18");
	unless (ord(h[17]) == 0x8a9e) puts("bad 1.19");
	unless (ord(h[18]) == 0x304c) puts("bad 1.20");
	unless (ord(h[19]) == 0x3000) puts("bad 1.21");
	unless (ord(h[20]) == 0x5206) puts("bad 1.22");
	unless (ord(h[21]) == 0x304b) puts("bad 1.23");
	unless (ord(h[22]) == 0x308a) puts("bad 1.24");
	unless (ord(h[23]) == 0x307e) puts("bad 1.25");
	unless (ord(h[24]) == 0x3059) puts("bad 1.26");
	if (defined(h[25])) puts("bad 1.27");

	// Delete one of the Kanji characters.
	undef(h[12]);
	unless (h eq "זו השפה שלנוは　日本語が　分かります") puts("bad 2.0");
	unless (length(h) == 24) puts("bad 2.1");
	unless (ord(h[0]) == 0x05d6) puts("bad 2.2");
	unless (ord(h[11]) == 0x05d5) puts("bad 2.3");
	unless (ord(h[12]) == 0x306f) puts("bad 2.4");
	unless (ord(h[23]) == 0x3059) puts("bad 2.5");
	if (defined(h[24])) puts("bad 2.6");

	// Now delete the first space.
	undef(h[2]);
	unless (h eq "זוהשפה שלנוは　日本語が　分かります") puts("bad 3.0");
	unless (length(h) == 23) puts("bad 3.1");
	unless (ord(h[0]) == 0x05d6) puts("bad 3.2");
	unless (ord(h[2]) == 0x05d4) puts("bad 3.3");
	unless (ord(h[22]) == 0x3059) puts("bad 3.4");
	if (defined(h[23])) puts("bad 3.5");
}
unicode_2();
} -output {}

test unicode-3 {test unicode strings in regexp and substitution} -body {
#lang L --line=1
void unicode_3()
{
	string	h = "זו השפה שלנו";
	string	r;

	/* These test wide chars in both regexp and string. */

	unless (h =~ /זו/) puts("bad 1.1");
	if (h =~ /ך/) puts("bad 1.2");
	unless (h =~ /זו השפה שלנו/) puts("bad 1.3");
	unless (h =~ /השפה שלנו/) puts("bad 1.4");
	if (h =~ /^השפה שלנו/) puts("bad 1.5");
	unless (h =~ /זו.*שלנו/) puts("bad 1.6");

	h =~ s/ש//;
	unless (length(h) == 11) puts("bad 2.1");
	unless (h eq "זו הפה שלנו") puts("bad 2.2");
	h = "זו השפה שלנו";
	h =~ s/ש//g;
	unless (length(h) == 10) puts("bad 2.3");
	unless (h eq "זו הפה לנו") puts("bad 2.4");

	h = "זו השפה שלנו";
	r = "ש";
	h =~ s/${r}//;
	unless (length(h) == 11) puts("bad 3.1");
	unless (h eq "זו הפה שלנו") puts("bad 3.2");
	h = "זו השפה שלנו";
	h =~ s/${r}//g;
	unless (length(h) == 10) puts("bad 3.3");
	unless (h eq "זו הפה לנו") puts("bad 3.4");

	h = "זו השפה שלנו";
	unless (h =~ /זו (השפ)ה שלנו/) puts("bad 4.1");
	unless (length($1) == 3) puts("bad 4.2");
	unless ($1 eq "השפ") puts("bad 4.3");

	/* Test an ascii regexp and a wide string. */

	h = "זו השפה שלנו";
	unless (h =~ / /) puts("bad 10.1");
	h =~ s/ //;
	unless (h == "זוהשפה שלנו") puts("bad 10.2");
	h = "זו השפה שלנו";
	h =~ s/ //g;
	unless (h == "זוהשפהשלנו") puts("bad 10.3");
}
unicode_3();
} -output {}

test unicode-4 {test file I/O with unicode strings} -body {
#lang L --line=1
void unicode_4()
{
	string	h = "זו השפה שלנו";
	string	j = '私は　日本語が　分かります';
	string	s;
	FILE	f;

	unless (f = fopen("unicode4", "w")) puts("bad 0.1");
	fconfigure(f, encoding: "utf-8");
	write(f, h, String_bytelength(h));
	write(f, "\n", 1);
	fprintf(f, "%s\n", j);
	fclose(f);

	unless (f = fopen("unicode4", "r")) puts("bad 0.2");
	fconfigure(f, encoding: "utf-8");
	s = <f>;
	unless (length(s) == 12) puts("bad 1.1");
	unless (ord(s[0]) == 0x05d6) puts("bad 1.2");
	unless (ord(s[1]) == 0x05d5) puts("bad 1.3");
	unless (ord(s[2]) == 0x0020) puts("bad 1.4");
	unless (ord(s[3]) == 0x05d4) puts("bad 1.5");
	unless (ord(s[4]) == 0x05e9) puts("bad 1.6");
	unless (ord(s[5]) == 0x05e4) puts("bad 1.7");
	unless (ord(s[6]) == 0x05d4) puts("bad 1.8");
	unless (ord(s[7]) == 0x0020) puts("bad 1.9");
	unless (ord(s[8]) == 0x05e9) puts("bad 1.10");
	unless (ord(s[9]) == 0x05dc) puts("bad 1.11");
	unless (ord(s[10]) == 0x05e0) puts("bad 1.12");
	unless (ord(s[11]) == 0x05d5) puts("bad 1.13");
	if (defined(s[12])) puts("bad 1.14");
	s = <f>;
	unless (length(s) == 13) puts("bad 3.1");
	unless (ord(s[0]) == 0x79c1) puts("bad 3.2");
	unless (ord(s[1]) == 0x306f) puts("bad 3.3");
	unless (ord(s[2]) == 0x3000) puts("bad 3.4");
	unless (ord(s[3]) == 0x65e5) puts("bad 3.5");
	unless (ord(s[4]) == 0x672c) puts("bad 3.6");
	unless (ord(s[5]) == 0x8a9e) puts("bad 3.7");
	unless (ord(s[6]) == 0x304c) puts("bad 3.8");
	unless (ord(s[7]) == 0x3000) puts("bad 3.9");
	unless (ord(s[8]) == 0x5206) puts("bad 3.10");
	unless (ord(s[9]) == 0x304b) puts("bad 3.11");
	unless (ord(s[10]) == 0x308a) puts("bad 3.12");
	unless (ord(s[11]) == 0x307e) puts("bad 3.13");
	unless (ord(s[12]) == 0x3059) puts("bad 3.14");
	if (defined(s[13])) puts("bad 3.15");
	fclose(f);
	unlink("unicode4");
}
unicode_4();
} -output {}

test unicode-5 {test split built-in with unicode strings} -body {
#lang L --line=1
void unicode_5()
{
	string	a[], s;

	// This contains ASCII spaces.
	a = split("זו השפה שלנו");
	unless (length(a) == 3) puts("bad 1.1");
	unless (a[0] eq "זו") puts("bad 1.2");
	unless (a[1] eq "השפה") puts("bad 1.3");
	unless (a[2] eq "שלנו") puts("bad 1.4");

	// Note that these aren't ASCII spaces.
	a = split("私は　日本語が　分かります");
	unless (length(a) == 3) puts("bad 2.1");
	unless (a[0] eq "私は") puts("bad 2.2");
	unless (a[1] eq "日本語が") puts("bad 2.3");
	unless (a[2] eq "分かります") puts("bad 2.4");

	// Split a unicode string with a unicode regexp.
	a = split(/ש/, "זו השפה שלנו");
	unless (length(a) == 3) puts("bad 3.1");
	unless (a[0] eq "זו ה") puts("bad 3.2");
	unless (a[1] eq "פה ") puts("bad 3.3");
	unless (a[2] eq "לנו") puts("bad 3.4");

	// Split a unicode string with an ascii regexp.
	a = split(/ /, "זו השפה שלנו");
	unless (length(a) == 3) puts("bad 4.1");
	unless (a[0] eq "זו") puts("bad 4.2");
	unless (a[1] eq "השפה") puts("bad 4.3");
	unless (a[2] eq "שלנו") puts("bad 4.4");

	// Split a string containing nulls.
	s = Binary_format("a*a2a*", "x", "b", "yd");  // xb\0yd
	a = split(/\0/, s);
	unless (length(a) == 2) puts("bad 5.1");
	unless (a[0] eq "xb") puts("bad 5.2");
	unless (a[1] eq "yd") puts("bad 5.3");
}
unicode_5();
} -output {}

test cmdsubst-1 {test command substitution} -body {
#lang L --line=1
void cmdsubst_1()
{
	string	cmd, s1, s2;

	if (platform() eq "windows") {
		cmd = "sh echo";
	} else {
		cmd = "echo";
	}

	`${cmd} testing1 >foo.txt`;
	s1 = `cat foo.txt`;
	unless (s1 eq "testing1") puts("bad 1.1");
	`rm -f foo.txt`;

	s1 = "testing2";
	`${cmd} ${s1} >foo.txt`;
	s1 = `cat foo.txt`;
	unless (s1 eq "testing2") puts("bad 2.1");
	`rm -f foo.txt`;

	s1 = "testing3";
	s2 = "xyz";
	`${cmd} ${s1}${s2} >foo.txt`;
	s1 = `cat foo.txt`;
	unless (s1 eq "testing3xyz") puts("bad 3.1");
	`rm -f foo.txt`;

	s1 = "testing4";
	s2 = "pdq";
	`${cmd} ${s1}-${s2} >foo.txt`;
	s1 = `cat foo.txt`;
	unless (s1 eq "testing4-pdq") puts("bad 4.1");
	`rm -f foo.txt`;

	s1 = "testing";
	s2 = "xyz";
	`${cmd} ${s1}${5}${s2} ${"zyx"} >foo.txt`;
	s1 = `cat foo.txt`;
	unless (s1 eq "testing5xyz zyx") puts("bad 5.1");
	`rm -f foo.txt`;

	/*
	 * Check escapes:
	 * \$ \` \\      get escaped
	 * \<newline>    gets ignored
	 * \x            for anything else, does not get escaped
	 *
	 * These are a bit confusing.  Once escaped by backtick
	 * processing, the command string undergoes Bourne-shell-style
	 * quoting.  And because tcltest parsing messes with a
	 * \<newline> in the source, we can't simply write one of
	 * those here, so create strings of L code and eval those.
	 */

	`${cmd} \r\n\t\a$x\$\\\\ \`backquote\` >foo.txt`;
	s1 = `cat foo.txt`;
	unless (s1 eq "rnta$x$\\ `backquote`") puts("bad 10.1");
	`rm -f foo.txt`;

	L("`${cmd} x\\\ny >foo.txt`;\n");
	s1 = `cat foo.txt`;
	unless (s1 eq "xy") puts("bad 10.2");
	`rm -f foo.txt`;
}
cmdsubst_1();
} -output {}

test cmdsubst-2 {test command substitution errors} -body {
#lang L --line=1
void cmdsubst_2()
{
	string	s = `a-nonexistent-command arg`;
	if (defined(s)) puts("bad 1");
}
cmdsubst_2();
} -output {}

test proc-1.0 {Test L function definition.} -body {
#lang L --line=1
void proc_1_0(void) {
        puts("foo");
}
#lang tcl
proc_1_0
} -output "foo\n"


test proc-1.1 {Test L function returns.} -body {
#lang L --line=1
void proc_1_1_f1() {
        puts("whiz");
}
string proc_1_1_f2() {
        puts("bang");
        return "foo";
        return "bar";
}
void proc_1_1_f3() {
        return;
}
void proc_1_1(void) {
        puts(proc_1_1_f1());
        puts(proc_1_1_f2());
        puts(proc_1_1_f3());
}
#lang tcl
proc_1_1
} -output "whiz\n\nbang\nfoo\n\n"

test proc-1.2 {Test L function parameters.} -body {
#lang L --line=1
void proc_1_2(string arg1, string arg2) {
        puts(arg1);
        puts(arg2);
} 
#lang tcl
proc_1_2 "val1" "val2" 
} -output "val1\nval2\n"

test proc-1.3 {Test variable arity functions} -body {
#lang L --line=1
void proc_1_3_foo(...stuff) {
	int i;
	for (i=0; defined(stuff[i]); i++) {
		printf("%s ", stuff[i]);
	}
	printf("\n");
}
void proc_1_3_bar(int a, ...stuff) {
	puts(a);
	puts(stuff);
}
void proc_1_3() {
	proc_1_3_foo("a", "b", "c", "d");
	proc_1_3_foo();
	proc_1_3_bar(1, 2, 3, 4);
	proc_1_3_bar(1);
}
#lang tcl
proc_1_3
} -output "a b c d \n\n1\n2 3 4\n1\n\n"

test proc-1.4 {Ensure rest parameter comes last} -body {
#lang L --line=1 -nowarn
void proc_1_4(int a, ...b, int c) {
	puts("oops");
}
#lang tcl
proc_1_4
} -returnCodes {error} -match glob -result "*:1: L Error: Rest parameter must be last\n"

test proc-1.5 {test parameter multiple declaration} -body {
#lang L --line=1 -nowarn
void proc_1_5_1(int a, int a) {}
void proc_1_5_2(int a, int a, int a) {}
} -returnCodes error -match regexp -result {.*1: L Error: multiple declaration of local a
.*2: L Error: multiple declaration of local a
.*2: L Error: multiple declaration of local a
}

test proc-1.6 {check ignored function return value} -body {
#lang L --line=1
int proc_1_6_foo() { return (1); }
void proc_1_6()
{
	/*
	 * This test checks that an ignored function's return value is
	 * properly popped off the run-time stack.  If it's not, the
	 * unbalanced stack will cause a Tcl panic in a debug build.
	 */

	int	i;
	int	n = 100;

	for (i = 0; i < n; ++i) {
		proc_1_6_foo();
	}
}
proc_1_6();
} -output {}

test proc-1.7 {check extern functions} -setup {
	proc proc_1_7 {} { puts "good" }
} -body {
#lang L --line=1
	extern void proc_1_7();
	proc_1_7();
} -output {good
}

test proc-1.8 {test (expand)} -body {
#lang L --line=1
string proc_1_8_concat(...args)
{
	poly	p;
	string	s = "";

	foreach (p in args) s .= p;
	return (s);
}
int proc_1_8_sum(int a, int b, int c)
{
	return (a + b + c);
}
/* Return a string array of n elements, starting at "1" and counting up. */
string[] proc_1_8_arr(int n)
{
	int	i;
	string	s[];

	for (i = 1; i <= n; ++i) push(&s, (string)i);
	return (s);
}
void proc_1_8()
{
	int	i1[] = { 10 };
	int	i2[] = { 20, 30 };
	int	i3[] = { 40, 50, 60 };
	string	s;
	string	sa[] = { "a", "b", "c" };
	string	sb[] = { "d", "e" };
	poly	p = { "a", "b", "c" };

	unless (proc_1_8_concat((expand){}) eq "") puts("bad 0.1");

	unless (proc_1_8_concat((expand)sa) eq "abc") puts("bad 1.1");
	unless (proc_1_8_concat("x", (expand)sa) eq "xabc") puts("bad 2.1");
	unless (proc_1_8_concat((expand)sa, "y") eq "abcy") puts("bad 3.1");
	unless (proc_1_8_concat("x", (expand)sa, "y") eq "xabcy") {
		puts("bad 4.1");
	}
	unless (proc_1_8_concat("x", (expand)sa, (expand)sb, "y") eq "xabcdey") {
		puts("bad 5.1");
	}
	unless (proc_1_8_concat((expand)sa, (expand)sa, (expand)sa)
			eq "abcabcabc") {
		puts("bad 6.1");
	}

	unless (proc_1_8_sum((expand)i1, 2, 3) == 15) puts("bad 10.1");
	unless (proc_1_8_sum((expand)i2, 2) == 52) puts("bad 11.1");
	unless (proc_1_8_sum((expand)i3) == 150) puts("bad 12.1");

	unless (proc_1_8_concat((expand)p) eq "abc") puts("bad 20.1");

	unless (proc_1_8_concat((expand)proc_1_8_arr(1)) eq "1") {
		puts("bad 30.1");
	}
	unless (proc_1_8_concat((expand)proc_1_8_arr(2)) eq "12") {
		puts("bad 31.1");
	}
	unless (proc_1_8_concat((expand)proc_1_8_arr(3)) eq "123") {
		puts("bad 32.1");
	}

	/* These test expand inside of a list {}. */

	unless (proc_1_8_concat((expand){(expand){1}}) eq "1") {
		puts("bad 40.1");
	}
	unless (proc_1_8_concat((expand){(expand){1,2}}) eq "12") {
		puts("bad 40.3");
	}
	unless (proc_1_8_concat((expand){(expand){1,2,3}}) eq "123") {
		puts("bad 40.5");
	}

	sa = { (expand){"1","2"}, "3", (expand){"4"}, "5", (expand){"6","7","8"} };
	unless (length(sa) == 8) puts("bad 41.1");
	unless (proc_1_8_concat((expand)sa) eq "12345678") puts("bad 41.2");

	sa = { (expand)"1" };
	unless ((length(sa) == 1) && (sa[0] eq "1")) puts("bad 42.1");
	sa = { (expand)"1", (expand)"2" };
	unless ((length(sa) == 2) && (sa[0] eq "1") && (sa[1] eq "2")) {
		puts("bad 42.2");
	}

	/*
	 * Test some expands inside of nested calls to verify that
	 * they are not mistakenly caught as errors.
	 */
	s = proc_1_8_concat((expand){"1"},
			    proc_1_8_concat((expand){"2"},
					    proc_1_8_concat((expand){"3","4"}),
					    (expand){"5","6"}),
			    (expand){"7"});
	unless (s eq "1234567") puts("bad 45.1");
}
proc_1_8();
} -output {}

test proc-1.9 {test (expand) errors} -body {
#lang L --line=1 --nowarn
private int foo(...args) { return (0); }
void proc_1_9()
{
	string	a[];

	foo((expand)a + 1);
	foo(1 ? (expand)a : 1);
	{(expand)a + 1};
	{1 ? (expand)a : 1};
	{"x", {1 ? (expand)a : 1}};
	(expand)a;
	foo((expand)a, (expand)a+1);
	foo("x", foo((expand)a+1));
}
} -returnCodes error -match regexp -result {.*6: L Error: \(expand\) illegal in this context
.*7: L Error: \(expand\) illegal in this context
.*8: L Error: \(expand\) illegal in this context
.*9: L Error: \(expand\) illegal in this context
.*10: L Error: \(expand\) illegal in this context
.*11: L Error: \(expand\) illegal in this context
.*12: L Error: \(expand\) illegal in this context
.*13: L Error: \(expand\) illegal in this context
}

test var-1.0 {Test L variable assignment and reference} -body {
#lang L --line=1
void var_1_0(void)
{
	string s;
        s = "Hello";
	puts(s);
}
#lang tcl
var_1_0
} -output "Hello\n"

test var-1.1 {L global variables} -body {
#lang L --line=1
int lglobal1_1 = 1;
void var_1_1(void)
{
        puts(lglobal1_1);
}
#lang tcl
var_1_1
} -output "1\n"


test var-1.2 {L global variables, harder} -body {
#lang L --line=1
int lglobal1_2 = 3;
void var_1_2(void)
{
        puts(lglobal1_2);
        lglobal1_2 = 4;
        var_1_2_aux();
        puts(lglobal1_2);
}

void var_1_2_aux()
{
        puts(lglobal1_2);
        lglobal1_2 = 5;
}
#lang tcl
var_1_2
} -output "3\n4\n5\n"

test var-1.2.2 {L global variable access from inside function} -body {
#lang L --line=1
private int g = 123;
void var_1_2_2()
{
	/*
	 * This tests a past compiler bug where the upvars for the
	 * global shadows were emitted at the point of variable use,
	 * which doesn't work if the use doesn't get executed, like
	 * the first reference to "g" below.
	 */
	for (; 0; g);
	unless (g == 123) puts("bad 1");
}
var_1_2_2();
} -output {}

test var-1.2.3 {L global variable access from inside class} -body {
#lang L --line=1 -nowarn
/*
 * Like the above test (var-1.2.2) but with class variables as well.
 */
private int g = 321;
class class_var_1_2_3a
{
	public int l1 = g;    // should see the global "g"
	public int g  = 654;  // shadows the global
	public int l2 = g;    // should see the local "g"
}
class class_var_1_2_3b
{
	public int l1 = g;    // should see the global "g"
	public int g  = 456;  // shadows the global
	public int l2 = g;    // should see the local "g"
}
void var_1_2_3()
{
	unless (g == 321) puts("bad 1");
	unless (class_var_1_2_3a->l1 == 321) puts("bad 2");
	unless (class_var_1_2_3a->g  == 654) puts("bad 3");
	unless (class_var_1_2_3a->l2 == 654) puts("bad 4");
	unless (class_var_1_2_3b->l1 == 321) puts("bad 5");
	unless (class_var_1_2_3b->g  == 456) puts("bad 6");
	unless (class_var_1_2_3b->l2 == 456) puts("bad 7");
	if (1) {
		int	g = 987;
		unless (g == 987) puts("bad 10");
	}
	unless (g == 321) puts("bad 20");
}
var_1_2_3();
} -output {}

test var-1.3 {A global array of structs} -body {
#lang L --line=1

struct var_1_3_point { int x, y; };
struct var_1_3_point lglobal1_3[5];

void var_1_3(void)
{
        int i = 0;

        puts(lglobal1_3);
        while (i < 5) {
          lglobal1_3[i].x = i * 10;
          lglobal1_3[i].y = i * 20;
          i++;
        }
        puts(lglobal1_3);
        var_1_3_aux(3);
        puts(lglobal1_3);
}

void var_1_3_aux(int i)
{
        lglobal1_3[i].x = i * 35;
        lglobal1_3[i].y = i * 45;
}
#lang tcl
var_1_3
} -output {
{0 0} {10 20} {20 40} {30 60} {40 80}
{0 0} {10 20} {20 40} {105 135} {40 80}
}

test var-1.4 {Test extern variables} -body {
set var_1_4_v1 "extern test 1"
set var_1_4_v2 "extern test 2"
namespace eval var_1_4_ns {
	variable foo "extern test 3"
}
#lang L --line=1
extern string var_1_4_v1;
extern string ::var_1_4_v2;
extern string var_1_4_ns::foo;
extern string ::var_1_4_ns::foo;  // really the same var as var_1_4_ns::foo
void var_1_4()
{
	unless (var_1_4_v1 eq "extern test 1") puts("bad 1");
	unless (::var_1_4_v2 eq "extern test 2") puts("bad 2");
	unless (var_1_4_ns::foo eq "extern test 3") puts("bad 3");
	unless (::var_1_4_ns::foo eq "extern test 3") puts("bad 4");
}
var_1_4();
} -output {}

test var-1.5 {Variable function names} -body {
#lang L --line=1
void var_1_5() {
  /*
   * This used to be supported but is no longer (2/24/09).
   * This is now an error.
   */
  string printfvar = "printf";
  printfvar("Earth calling printf\n");
}
#lang tcl
var_1_5
} -returnCodes error -match regexp -result {.*7: L Error: 'printfvar' is declared but not as a function
}

test var-2 {test taking value of a function name} -body {
#lang L --line=1
void var_2()
{
	/* This used to cause a crash. */
	puts(printf);
}
var_2();
} -returnCodes error -match regexp -result {.*4: L Error: cannot use a function name as a value
}

test lang-1.0 {Test lang parsing} -body {
# These are some Tcl Comments
#lang L --line=1
void lang_1_0(void)
{
	puts("worked");
}

#lang tcl
# More comments
 # starting after first column (space)
	# starting after first column (tab)
	 # starting after first column (tab, space)
#pragm -- not a pragma
#pragmatic -- also not a pragma
 #pragma -- yes, not a pragma
# pragma -- not a pragma
lang_1_0
} -output "worked\n"

test lang-2.0 {Test failure path in lang parsing} -body {
#lang(foo)
void lang_2_0(void)
{
	puts("worked");
}

#lang tcl
lang_2_0
} -returnCodes {error} -result {malformed pragma}

# no output because we're not calling any functions
test lang-3.0 {Test not switching back to Tcl} -body {
#lang L --line=1
void lang_3_0(void)
{
	puts("worked");
}
}

test pragma-1 {test bad #pragma} -body {
#lang L --line=1
#pragma bad
} -returnCodes error -match regexp -result {.*1: L Error: illegal attribute 'bad'
}

test decl-1.0 {Variable and parameter declaration syntax} -body {
#lang L --line=1 -nowarn
void decl_1_0_fun1() { }
void decl_1_0_fun2(void) { }
void decl_1_0_fun3() { }
int fdecl_1_0_un4() { }
void decl_1_0_fun5(int foo) { }
hash decl_1_0_fun6(hash foo, hash bar[], hash baz[23]) { }
void decl_1_0_fun7(int foo, float bar, hash baz, string quux, poly quuux) { }
void decl_1_0_fun8() {
        int foo, bar[], baz[84][42][1];
        string foo1[19], mani[], padmi = "hum";
        hash whee;
        if (0) {
                int bleh = 5;
        } else {
                if (1) {
                        poly padmi1 = "om";
                        puts(padmi1);
                }
        }
}
#lang tcl
decl_1_0_fun8
} -output "om\n";

test decl-1.1 {Hairy literal hash syntax in initializers} -body {
#lang L --line=1 -nowarn
void initmewoo() {
        hash h = { "key" => "val", "key2" => "val" };
}
#lang tcl
}

test decl-1.2 {Undeclared variable error} -body {
#lang L --line=1
void decl_1_2_undecl() {
        foo = "bar";
        puts(cheese);
}
#lang tcl
decl_1_2_undecl
} -returnCodes error -match glob -result {*L Error: undeclared variable: foo
*L Error: undeclared variable: cheese
}

test decl-1.3 {Variable shadowing} -body {
#lang L --line=1
void decl_1_3_shadow() {
        int foo = 1;
        if (1) {
                int foo = 2;
                puts(foo);
        } 
        puts(foo);
}
#lang tcl
decl_1_3_shadow
} -returnCodes error -match glob -result {*L Error: multiple declaration of local foo
}

test decl-1.3.1 {test variable shadowing warnings} -body {
#lang L --line=1
string decl_1_3_1g;
private string decl_1_3_1gp;
class decl_1_3_1cl
{
	public	string	decl_1_3_1cls;
	instance {
		public	string	decl_1_3_1inst;
	};
	public void foo(decl_1_3_1cl self)
	{
		string	decl_1_3_1g = "";
		string	decl_1_3_1gp = "";
		string	decl_1_3_1cls = "";
		string	decl_1_3_1inst = "";
	}
}
void decl_1_3_1()
{
	string	decl_1_3_1g = "";
	string	decl_1_3_1gp = "";
}
} -returnCodes error -match regexp -result {.*11: L Warning: local variable decl_1_3_1g shadows a global declared at.*:1
.*12: L Warning: local variable decl_1_3_1gp shadows a global declared at.*:2
.*13: L Warning: local variable decl_1_3_1cls shadows a class variable declared at.*:5
.*14: L Warning: local variable decl_1_3_1inst shadows a class instance variable declared at.*:7
.*19: L Warning: local variable decl_1_3_1g shadows a global declared at.*:1
.*20: L Warning: local variable decl_1_3_1gp shadows a global declared at.*:2
}

test decl-1.4 {Single dimensional initializers actually initialize} -body {
#lang L --line=1
void decl_1_4 () {
  int foo[] = {4, 5, 6};
  hash bar = {"foo" => 4, "bar" => 5, "baz" => 6};
  struct { int x; int y; } point = { 1024, 768 };

  printf("%s\n", foo);
  printf("%s\n", bar);
  printf("%s\n", point);
}
#lang tcl
decl_1_4
} -output "4 5 6\nfoo 4 bar 5 baz 6\n1024 768\n"

# Test decl-1.5 removed.

test decl-1.6 {Check scoping rule errors for globals and externs} -body {
#lang L --line=1 -nowarn
/*
 * The L scoping rules are as follows:
 *
 * - A name multiply declared at the global scope is illegal.
 * - A name multiply declared in a local scope or any enclosing scopes
 *   is illegal.
 * - A local name hides a global of the same name.
 * - A name is not visible outside the scope in which it is declared.
 * - A name is not visible in a scope before it is declared.
 *
 * This test checks the error cases.
 */
int decl_1_6_g1 = decl_1_6_g2;  // error -- g2 used before being declared
int decl_1_6_g2;
void foo_decl_1_6()
{
	decl_1_6_g3 = 1;  // error -- g3 used before being declared
}
int decl_1_6_g3;
void decl_1_6()
{
	int	l;
	int	l;  // error -- name already declared locally
	puts(decl_1_6_extern);  // error -- extern not yet declared
	if (1) {
		if (1) {
			int decl_1_6_extern;
			decl_1_6_extern = 3;
		}
	}
	if (1) {
		int	l2;
		int	l;  // error -- name already declared locally
		if (1) {
			int	l2;  // error -- name already declared locally
		}
	}
}
int decl_1_6_g2;  // error -- multiply declared at global scope
void decl_1_6_bad()
{
	extern int decl_1_6_g;  // error -- externs illegal in local scopes
}
} -returnCodes error -match regexp -result {.*13: L Error: undeclared variable: decl_1_6_g2
.*17: L Error: undeclared variable: decl_1_6_g3
.*23: L Error: multiple declaration of local l
.*24: L Error: undeclared variable: decl_1_6_extern
.*33: L Error: multiple declaration of local l
.*35: L Error: multiple declaration of local l2
.*39: L Error: multiple declaration of global decl_1_6_g2
.*42: L Error: externs legal only at global scope
}

test decl-1.7 {Check scoping rules for globals and externs} -body {
#lang L --line=1 -nowarn
/*
 * This test checks the non-error cases of the scoping rules described
 * above.
 */
extern string decl_1_7_extern;
string decl_1_7_g1;
string decl_1_7_g2 = "g2";
string decl_1_7_g3;
void decl_1_7()
{
	string	s = decl_1_7_g2;  // read the global
	string	decl_1_7_g2 = "g2local"; // now shadow the global

	unless (s eq "g2") puts("bad 1");
	unless (decl_1_7_g2 eq "g2local") puts("bad 2");

	decl_1_7_extern = "ex";
	unless (decl_1_7_extern eq "ex") puts("bad 3");

	decl_1_7_g1 = "g1";
	unless (decl_1_7_g1 eq "g1") puts("bad 4");

	if (1) {
		string	decl_1_7_g1;  // shadow a global, already referenced
		string	decl_1_7_g3;  // shadow a global, not yet referenced
		decl_1_7_g1 = "local1";   // sets the local
		decl_1_7_g3 = "local3";   // sets the local
		unless (decl_1_7_g1 eq "local1") puts("bad 5");
		unless (decl_1_7_g3 eq "local3") puts("bad 6");
	}
	unless (decl_1_7_g1 eq "g1") puts("bad 7");
}
#lang tcl
decl_1_7
} -output ""

test decl-1.7.5 {check legal multiple extern variable declarations} -body {
set decl_1_7_5_var "extern test"
#lang L --line=1
extern string decl_1_7_5_var;
extern string decl_1_7_5_var;  // legal -- has same type as prior declaration
void decl_1_7_5()
{
	unless (decl_1_7_5_var eq "extern test") puts("bad 1");
}
decl_1_7_5();
} -output {}

test decl-1.7.6 {check illegal multiple extern variable declarations} -body {
#lang L --line=1
extern string decl_1_7_6_var;
extern int decl_1_7_6_var;  // err -- not the same type
} -returnCodes error -match regexp -result {.*2: L Error: extern re-declaration type does not match other declaration
}

test decl-1.8 {Check illegal variable names} -body {
#lang L --line=1 -nowarn
void _decl_1_8()  // err -- function names cannot begin with _
{
	int	_bad;  // err -- locals cannot begin with _
}
} -returnCodes error -match regexp -result {.*1: L Error: function names cannot begin with _
.*3: L Error: local variable names cannot begin with _
}

test decl-1.9 {Check mixing types on single decl line} -body {
#lang L --line=1
void decl_1_9() {
	/*
	 * This is a regression test.  L used to get the types wrong.
	 * This just checks that the compiler issues no type errors.
	 */
	string	h1{int}, s1;
	string	s2;
	string	h2{int};

	s1 = s2;
	h1 = h2;
	s1 = "s1";
	s2 = "s2";
	h1{1} = "one";
	h2{1} = "one";
}
#lang tcl
decl_1_9
} -output {}

test decl-1.10 {multiple declaration of main in same script disallowed} -body {
#lang L --line=1
void main()
{
}
void main()
{
}
void main()
{
}
} -returnCodes error -match regexp -result {.*4: L Error: function main already declared
.*7: L Error: function main already declared
}

test decl-1.10.1 {argc, argv, or env should never cause unused-variable warning} -setup {
	# Put these in their own files since only one main() can be defined.
	makeFile {
		void main(string argv[]) {}
	} decl-1.10.1-1.l
	makeFile {
		void main(int argc, string argv[]) {}
	} decl-1.10.1-2.l
	makeFile {
		void main(int argc, string argv[], string env{string}) {}
	} decl-1.10.1-3.l
} -body {
#lang L --line=1
void decl_1_10_1()
{
	int	ret;
	string	tclsh = interpreter();
	string	out, err;

	ret = system({tclsh, "decl-1.10.1-1.l"}, undef, &out, &err);
	unless (ret == 0) puts("bad 1.1: ${out} ${err}");

	ret = system({tclsh, "decl-1.10.1-2.l"}, undef, &out, &err);
	unless (ret == 0) puts("bad 2.1: ${out} ${err}");

	ret = system({tclsh, "decl-1.10.1-3.l"}, undef, &out, &err);
	unless (ret == 0) puts("bad 3.1: ${out} ${err}");
}
decl_1_10_1();
} -output {}

test decl-1.11.1 {private globals 1} -body {
#lang L --line=1
private string priv_global = "test 1";
private void priv_global_test_fn()
{
	puts(priv_global);
}
void decl_1_11_1()
{
	unless (priv_global eq "test 1") puts("bad decl_1_11_1");
}
priv_global_test_fn();
decl_1_11_1();
} -output "test 1\n"

test decl-1.11.2 {private globals 2} -body {
#lang L --line=1
/*
 * This test declares the same (private) names as the previous test.
 * They should not clash.
 */
private string priv_global = "test 2";
private void priv_global_test_fn()
{
	puts(priv_global);
}
priv_global_test_fn();
/*
 * Call the previous test's function.  It should see the value of its
 * own private global, not ours.
 */
decl_1_11_1();
} -output "test 2\n"

test decl-1.11.3 {test public/private global declaration errors} -body {
#lang L --line=1 -nowarn
private int decl_1_11_3_priv_first;
int decl_1_11_3_priv_first;

int decl_1_11_3_publ_first;
private int decl_1_11_3_publ_first;

private int two_privates;
private int two_privates;

private void decl_1_11_1() {}  // already declared in earlier test

private string stdin;  // already declared in libl

void decl_1_11_3()
{
	public	string bad1;
	private	string bad2;
}
} -returnCodes {error} -match regexp -result {.*2: L Error: multiple declaration of global decl_1_11_3_priv_first
.*5: L Error: multiple declaration of global decl_1_11_3_publ_first
.*8: L Error: multiple declaration of global two_privates
.*10: L Error: function decl_1_11_1 already declared
.*12: L Error: multiple declaration of global stdin
.*16: L Error: public/private qualifiers illegal for locals
.*17: L Error: public/private qualifiers illegal for locals
}

test decl-1.12.1 {public globals 1} -body {
#lang L --line=1
/*
 * This simply tests that the "public" qualifier on a global
 * declaration acts like a no-op.
 */
public string decl_1_12_s = "public decl test";
public void decl_1_12_1()
{
	puts(decl_1_12_s);
}
decl_1_12_1();
} -output "public decl test\n"

test decl-1.12.1 {public globals 2} -body {
#lang L --line=1
/* This is the second half of the test above. */
public void decl_1_12_2()
{
	puts(decl_1_12_s);  // print global defined in the previous test
}
decl_1_12_2();
} -output "public decl test\n"

test if-1.0 {If statements} -body {
#lang L --line=1
void if_1_0() {
        if (1) puts("0 working");
        if (0) {
                puts("1 broken");
        } 
        puts("between");
        if (1) {
                puts("1 working");
        } 
}
#lang tcl
if_1_0
} -output "0 working\nbetween\n1 working\n"


test if-1.1 {If statements with else clauses and multistatement bodies} -body {
#lang L --line=1
void if_1_1() {
        if (1) {
                puts("1 working");
                puts(".");
        } else {
                puts("1 broken");
                puts(".");
        }
        
        if (0) {
                puts("2 broken");
                puts(".");
                puts(".");
        } else {
                puts("2 working");
                puts(".");
                puts(".");
        }
}
#lang tcl
if_1_1
} -output "1 working\n.\n2 working\n.\n.\n"


test if-1.2 {"else if" clauses} -body {
#lang L --line=1
void if_1_2() {
        if (0) {
                puts("1 broken");
        } else if (1) {
                puts("1 working");
        }

        puts("between");

        if (0) {
                puts("2 broken");
        } else if (0) {
                puts("2.2 broken");
        } else {
                puts("2 working");
        }
}
#lang tcl
if_1_2
} -output "1 working\nbetween\n2 working\n"

test if-1.3 {nested if statements} -body {
#lang L --line=1
void if_1_3() {
        if (1) {
                puts("1 before");
                if (0) {
                        puts("1 broken");
                } else {
                        puts("1 working");
                }
                puts("1 after");
        } else {
                puts("1.1 broken");
        }
        puts("1 done");
}
#lang tcl
if_1_3
} -output "1 before\n1 working\n1 after\n1 done\n"

test if-1.4 {else is only allowed with curly braces} -body {
#lang L --line=1
void if_1_4(void)
{
	if (0) puts("1 broken"); else puts("1 even more broken");
}
#lang tcl
} -returnCodes error -match glob -result {*3: L Error: syntax error, unexpected else
	if (0) puts("1 broken"); else
                                 ^
}

test unless-1.0 {unless statements} -body {
#lang L --line=1
void unless_1_0() {
        unless(0) puts("0 working");
        unless(0) {
                puts("1 working");
        }
        unless(1) {
                puts("2 broken");
        } else {
                puts("2 working");
        }
        unless(1) {
                puts("3 broken");
        } else unless (1) {
                puts("3.1 broken");
        } else {
                puts("3 working");
        }
} 
#lang tcl
unless_1_0
} -output "0 working\n1 working\n2 working\n3 working\n"

test unless-1.1 {unless and if statements mixed} -body {
#lang L --line=1
void unless_1_1() {
        unless(1) {
                puts("1 broken");
        } else if (0) {
                puts("1.1 broken");
        } else unless(0) {
                puts("1 working");
        }
        puts("done");
} 
#lang tcl
unless_1_1
} -output "1 working\ndone\n"

test return-1.1 {return from void function allowed} -body {
#lang L --line=1
void return_1_1() { return; }
} -returnCodes normal

test return-1.2 {returning int from void function disallowed} -body {
#lang L --line=1
void return_1_2() { return 0; }
} -returnCodes error -match regexp -result ".*void function cannot return value"

test return-1.3 {returning string from void function disallowed} -body {
#lang L --line=1
void return_1_3() { return "str"; }
} -returnCodes error -match regexp -result ".*void function cannot return value"

test return-1.4 {returning float from void function disallowed} -body {
#lang L --line=1
void return_1_4() { return 2.99792458; }
} -returnCodes error -match regexp -result ".*void function cannot return value"

test return-1.5 {returning array from void function disallowed} -body {
#lang L --line=1
void return_1_5() {
	int	a[3];
	return a;
}
} -returnCodes error -match regexp -result ".*void function cannot return value"

test return-1.6 {returning hash from void function disallowed} -body {
#lang L --line=1
void return_1_6() {
	hash	h;
	return h;
}
} -returnCodes error -match regexp -result ".*void function cannot return value"

test return-1.7 {returning struct from void function disallowed} -body {
#lang L --line=1
void return_1_7() {
	struct { int x,y; } s;
	return s;
}
} -returnCodes error -match regexp -result ".*void function cannot return value"

test return-1.8 {returning poly from void function disallowed} -body {
#lang L --line=1
void return_1_8() {
	poly	p;
	return p;
}
} -returnCodes error -match regexp -result ".*void function cannot return value"

test return-1.9.1 {return from global scope 1} -body {
#lang L --line=1
return;
} -output {}

test return-1.9.2 {return from global scope 2} -body {
#lang L --line=1
return(1);
} -result {1} -output {}

test return-1.9.3 {return from global scope 3} -body {
#lang L --line=1
return("ret");
} -result {ret} -output {}

test return-2.1 {int return value from int function allowed} -body {
#lang L --line=1
int return_2_1_f() { return 123; }
unless (return_2_1_f() == 123) printf("BAD\n");
} -output ""

test return-2.2 {float return value from float function allowed} -body {
#lang L --line=1
float return_2_2_f() { return 123.456; }
unless (return_2_2_f() == 123.456) printf("BAD\n");
} -output ""

test return-2.3 {string return value from string function allowed} -body {
#lang L --line=1
string return_2_3_f() { return "str"; }
unless (return_2_3_f() eq "str") printf("BAD\n");
} -output ""

test return-2.4 {array return value from array function allowed} -body {
#lang L --line=1
int[] return_2_4_f()
{
	int	a[3] = {2,3,5};
	return a;
}
void return_2_4()
{
	int res[] = return_2_4_f();
	unless ((res[0] == 2) && (res[1] == 3) && (res[2] == 5)) {
		printf("BAD\n");
	}
}
#lang tcl
return_2_4
} -output ""

test return-2.5 {hash return value from hash function allowed} -body {
#lang L --line=1
hash return_2_5_f()
{
	hash	h;
	h{"one"} = 1;
	h{"two"} = 2;
	h{"ten"} = 10;
	return h;
}
void return_2_5()
{
	hash res = return_2_5_f();
	unless ((res{"one"} == 1) && (res{"two"} == 2) && (res{"ten"} == 10)) {
		printf("BAD\n");
	}
}
#lang tcl
return_2_5
} -output ""

test return-2.6 {struct return value from struct function allowed} -body {
#lang L --line=1
struct return_2_6_s {
	int x, y, z;
};
struct return_2_6_s return_2_6_f()
{
	struct return_2_6_s s;
	s.x = 1;
	s.y = 2;
	s.z = 3;
	return s;
}
void return_2_6()
{
	struct return_2_6_s res = return_2_6_f();
	unless ((res.x == 1) && (res.y == 2) && (res.z == 3)) printf("BAD\n");
}
#lang tcl
return_2_6
} -output ""

# Spot-check some of the type-checking cases to ensure that return-value
# type checking is being done.  Do not check all possible permutations.

test return-3.1 {int return value from string function disallowed} -body {
#lang L --line=1
string return_3_1() { return 1; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.2 {float return value from string function disallowed} -body {
#lang L --line=1
string return_3_2() { return 1.2; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.3 {int return value from hash function disallowed} -body {
#lang L --line=1
hash return_3_3() { return 1; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.4 {array return value from hash function disallowed} -body {
#lang L --line=1
hash return_3_4() { int a[3]; return a; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.5 {int return value from struct function disallowed} -body {
#lang L --line=1
struct s35 {
	int x, y;
};
struct s35 return_3_5() { return 1; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.6 {hash return value from struct function disallowed} -body {
#lang L --line=1
struct s36 {
	int x, y;
};
struct s36 return_3_6() { hash h; return h; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.7 {int return value from array function disallowed} -body {
#lang L --line=1
int[] return_3_7() { return 1; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.8 {struct return value from array function disallowed} -body {
#lang L --line=1
struct s38 {
	int x, y;
};
int[] return_3_8() { struct s38 s; return s; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.9 {hash return value from array function disallowed} -body {
#lang L --line=1
int[] return_3_9() { hash h; return h; }
} -returnCodes error -match regexp -result ".*incompatible return type"

test return-3.10 {void return value from non-void function disallowed} -body {
#lang L --line=1
int return_3_10_int() { return; }
} -returnCodes error -match regexp -result ".*must specify return value"

test return-3.11 {check not returning a value from functon error} -body {
#lang L --line=1
private string f()
{
	if (0) return ("not taken");
}
void return_3_10()
{
	f();
}
return_3_10();
} -returnCodes error -match regexp -result {no value returned from function}

test syntax-1.0 {single-line comments a la C++} -body {
#lang L --line=1
# this kind of comment valid only on line 1
void syntax_1_0() {
        // single-line comments are 
        puts("working"); //see?
        //////cruftilioucious 
}

#lang tcl
syntax_1_0
} -output "working\n" 

test syntax-1.0.1 {hash-comment errors} -body {
#lang L --line=1
 # err -- starts on column 2
void syntax_1_0_1()
{
# err -- not on line 1
	# err -- same
}
} -returnCodes {error} -match regexp -result {.*1: L Error: # comment must start at first column
.*4: L Error: # comment valid only on line 1
.*5: L Error: # comment valid only on line 1
}

test syntax-1.1 {structure syntax} -body {
#lang L --line=1 -nowarn

struct syntax_1_1_point {
        int x, y;
        string label;
        float froboz[128];
        struct { int m, n; } sub_struct;
};

void syntax_1_1() {
        struct { string firstname; string lastname; } him;
        struct { string firstname; string lastname; } me = {"john", "doe"};
        struct syntax_1_1_point p1, p2 = {
	       1, 2, "label", {1.0}, {1,2} } , p3;
        puts("didn't crash");
}

#lang tcl
syntax_1_1
} -output "didn't crash\n"

test syntax-1.2 {interpolated strings} -body {
#lang L --line=1
void syntax_1_2()
{
	string	s = "xxx";
	int	h{int} = { 1=>1, 3 => 4 };
	int	hh{int}{int} = { 2 => {1=>3,4=>5} };
	string	hs{string} = { "1" => "1" };

	/* Check interpolations at beginning, middle, and end of a string. */
	unless ("${s} start" eq "xxx start") puts("bad 1.1");
	unless ("middle ${s} start" eq "middle xxx start") puts("bad 1.2");
	unless ("end ${s}" eq "end xxx") puts("bad 1.3");
	unless ("1${s}${s}2" eq "1xxxxxx2") puts("bad 1.4");
	unless ("1${s} ${s}2" eq "1xxx xxx2") puts("bad 1.5");
	unless ("1${s}2${s}3${s}" eq "1xxx2xxx3xxx") puts("bad 1.6");

	/* Test that braces are counted properly within an interpolation. */
	unless ("a${h{3}}b" eq "a4b") puts("bad 2.1");
	unless ("a${hh{2}{4}}b" eq "a5b") puts("bad 2.2");
	unless ("a${hh{2}{h{1}}}b" eq "a3b") puts("bad 2.4");
	unless ("a${hh{2}{h{h{1}}}}b" eq "a3b") puts("bad 2.5");
	unless ("a${hh{2}{h{h{h{1}}}}}b" eq "a3b") puts("bad 2.6");

	/*
	 * These have a right brace after the right brace that ends the
	 * interpolation.  The left and right braces are still balanced
	 * because the tcl test parsing dies if they are not, but L does
	 * not require it inside strings.
	 */
	unless ("{a${h{3}}}b" eq "{a4}b") puts("bad 3.1");
	unless ("{a${hh{2}{4}}}b" eq "{a5}b") puts("bad 3.2");
	unless ("{a${hh{2}{h{1}}}}b" eq "{a3}b") puts("bad 3.4");
	unless ("{a${hh{2}{h{h{1}}}}}b" eq "{a3}b") puts("bad 3.5");
	unless ("{a${hh{2}{h{h{h{1}}}}}}b" eq "{a3}b") puts("bad 3.6");

	/* Test nested interpolations. */
	unless ("1 ${"3 ${s} 4"} 2" eq "1 3 xxx 4 2") puts("bad 4.1");
	unless ("1 ${"3 ${"5 ${s} 6"} 4"} 2" eq "1 3 5 xxx 6 4 2") {
		puts("bad 4.2");
	}
	unless ("1 ${"3 ${"5 ${"7 ${s} 8"} 6"} 4"} 2" eq "1 3 5 7 xxx 8 6 4 2") {
		puts("bad 4.3");
	}

	/* Test that braces are counted properly in nested interpolations. */
	unless ("a ${hs{"${1}"}} b" eq "a 1 b") puts("bad 5.1");
	unless ("a ${hs{hs{"${1}"}}} b" eq "a 1 b") puts("bad 5.2");
	unless ("a ${hs{hs{"${h{1}}"}}} b" eq "a 1 b") puts("bad 5.2");
	unless ("a ${hs{hs{"${h{h{1}}}"}}} b" eq "a 1 b") puts("bad 5.3");
	unless ("a ${hs{"${h{h{1}}}"}} b" eq "a 1 b") puts("bad 5.4");
}
syntax_1_2();
} -output {}

test syntax-1.2.1 {check string interpolations nested too deeply} -body {
#lang L --line=1
void syntax_1_2_1()
{
	"1${"2${"3${"4${"5${"6${"7${"8${"9${"10${"11${12}"}"}"}"}"}"}"}"}"}"}";
}
} -returnCodes {error} -match regexp -result {.*3: L Error: string interpolation nesting too deep -- aborting
}

test syntax-1.3 {tcl options short-cut} -body {
#lang L --line=1
private string args(...args)
{
	return(join(" ", args));
}
void syntax_1_3()
{
	/*
	 * Test the Tcl option syntax (option:), and specifically that
	 * it works even with reserved words.  The scanner includes
	 * the colon when scanning these just for this reason.
	 */

	unless (args(one:) eq "-one") puts("bad 1");
	unless (args(one: "x") eq "-one x") puts("bad 2");
	unless (args(one:,"x") eq "-one x") puts("bad 3");
	unless (args(one: "x","y") eq "-one x y") puts("bad 4");
	unless (args(one:,"x","y") eq "-one x y") puts("bad 5");
	unless (args(one: "x", two:) eq "-one x -two") puts("bad 6");
	unless (args(one:,"x", two:) eq "-one x -two") puts("bad 7");
	unless (args(one:,"x", two: "y") eq "-one x -two y") puts("bad 8");
	unless (args(one:,"x", two:,"y") eq "-one x -two y") puts("bad 9");
	unless (args(one:, two:) eq "-one -two") puts("bad 10");
	unless (args(one:, two:, three:) eq "-one -two -three") puts("bad 11");

	unless (args(break:) eq "-break") puts("bad 20");
	unless (args(case:) eq "-case") puts("bad 20.2");
	unless (args(class:) eq "-class") puts("bad 21");
	unless (args(constructor:) eq "-constructor") puts("bad 22");
	unless (args(continue:) eq "-continue") puts("bad 23");
	unless (args(default:) eq "-default") puts("bad 23.2");
	unless (args(destructor:) eq "-destructor") puts("bad 24");
	unless (args(do:) eq "-do") puts("bad 25");
	unless (args(else:) eq "-else") puts("bad 26");
	unless (args(eq:) eq "-eq") puts("bad 27");
	unless (args(expand:) eq "-expand") puts("bad 28");
	unless (args(extern:) eq "-extern") puts("bad 29");
	unless (args(float:) eq "-float") puts("bad 30");
	unless (args(for:) eq "-for") puts("bad 31");
	unless (args(foreach:) eq "-foreach") puts("bad 32");
	unless (args(ge:) eq "-ge") puts("bad 33");
	unless (args(goto:) eq "-goto") puts("bad 34");
	unless (args(gt:) eq "-gt") puts("bad 35");
	unless (args(if:) eq "-if") puts("bad 36");
	unless (args(instance:) eq "-instance") puts("bad 37");
	unless (args(int:) eq "-int") puts("bad 38");
	unless (args(le:) eq "-le") puts("bad 39");
	unless (args(lt:) eq "-lt") puts("bad 40");
	unless (args(ne:) eq "-ne") puts("bad 41");
	unless (args(poly:) eq "-poly") puts("bad 42");
	unless (args(private:) eq "-private") puts("bad 43");
	unless (args(public:) eq "-public") puts("bad 44");
	unless (args(return:) eq "-return") puts("bad 45");
	unless (args(split:) eq "-split") puts("bad 46");
	unless (args(string:) eq "-string") puts("bad 47");
	unless (args(struct:) eq "-struct") puts("bad 48");
	unless (args(switch:) eq "-switch") puts("bad 48.2");
	unless (args(typedef:) eq "-typedef") puts("bad 49");
	unless (args(unless:) eq "-unless") puts("bad 50");
	unless (args(void:) eq "-void") puts("bad 51");
	unless (args(while:) eq "-while") puts("bad 52");
}
syntax_1_3();
} -output {}

test syntax-1.4 {string appendation} -body {
#lang L --line=1
void syntax_1_4() {
	printf("these" "strings"
	    "stick" "together.\n");
}
#lang tcl
syntax_1_4
} -output "thesestringssticktogether.\n"

test errmsg-1 {check cascading err msg avoidance, local var} -body {
#lang L --line=1
void errmsg_1()
{
	errmsg_1_i = 0;
	++errmsg_1_i;
	++errmsg_1_i;
	++errmsg_1_i;
}
int errmsg_1_i;  // should *not* produce a multiply declared variable err
} -returnCodes {error} -match regexp -result {^.*3: L Error: undeclared variable: errmsg_1_i
\s*$}

test errmsg-2 {check cascading err msg avoidance, global var} -body {
#lang L --line=1
++errmsg_2_g;
++errmsg_2_g;
++errmsg_2_g;
int errmsg_2_g;  // should *not* produce a multiply declared variable err
} -returnCodes {error} -match regexp -result {^.*1: L Error: undeclared variable: errmsg_2_g
\s*$}

test errmsg-3 {check cascading err msg avoidance, class var} -body {
#lang L --line=1
class errmsg_3
{
	private	int	v1 = errmsg_3_undecl1+1;
	public	int	errmsg_3_undecl1;
	private	int	v2 = errmsg_3_undecl1+1;

	private	int	v3 = errmsg_3_undecl2+1;
	private	int	v4 = errmsg_3_undecl2+1;
	public	int	errmsg_3_undecl2;
	private	int	v5 = errmsg_3_undecl2+1;
}
int errmsg_3_undecl1;
int errmsg_3_undecl2;
} -returnCodes {error} -match regexp -result {^.*3: L Error: undeclared variable: errmsg_3_undecl1
[^\n]+7: L Error: undeclared variable: errmsg_3_undecl2
\s*$}

test errmsg-4 {check cascading err msg avoidance, class instance var} -body {
#lang L --line=1
class errmsg_4
{
	instance {
		private	int	v1 = errmsg_4_undecl1+1;
		public	int	errmsg_4_undecl1;
		private	int	v2 = errmsg_4_undecl1+1;

		private	int	v3 = errmsg_4_undecl2+1;
		private	int	v4 = errmsg_4_undecl2+1;
		public	int	errmsg_4_undecl2;
		private	int	v5 = errmsg_4_undecl2+1;
	};
}
int errmsg_4_undecl1;
int errmsg_4_undecl2;
} -returnCodes {error} -match regexp -result {^.*4: L Error: undeclared variable: errmsg_4_undecl1
[^\n]+8: L Error: undeclared variable: errmsg_4_undecl2
\s*$}

test op-1.0 {increment and decrement operators} -body {
#lang L --line=1
void op_1_0() {
        int i = 1;

        puts("pre:");
        puts(i);
        ++i;
        puts(i);
        puts(++i);
        --i;
        puts(i);
        puts(--i);

        puts("post:");
        puts(i);
        i++;
        puts(i);
        puts(i++);
        puts(i);
        i--;
        puts(i);
        puts(i--);
        puts(i);
}
#lang tcl
op_1_0
} -output "pre:\n1\n2\n3\n2\n1\npost:\n1\n2\n2\n3\n2\n2\n1\n"

test op-1.0.1 {increment and decrement operator side effects} -body {
#lang L --line=1
class op_1_0_1_cls
{
	instance { public int n; }
}
void op_1_0_1()
{
	/*
	 * This test checks that the argument to ++ or -- is evaluated
	 * exactly once.
	 */

	int	i;
	int	a[];
	op_1_0_1_cls o[] = { op_1_0_1_cls_new(), op_1_0_1_cls_new() };

	i = 0;
	a[0] = 13;
	++(a[i++]);
	unless ((i == 1) && (a[0] == 14)) puts("bad 1");

	i = 0;
	a[0] = 13;
	(a[i++])++;
	unless ((i == 1) && (a[0] == 14)) puts("bad 2");

	i = 0;
	o[0]->n = 13;
	o[1]->n = 13;
	++(o[i++]->n);
	unless ((i == 1) && (o[0]->n == 14)) puts("bad 3");
	unless (o[1]->n == 13) puts("bad 3.1");

	i = 0;
	o[0]->n = 13;
	o[1]->n = 13;
	(o[i++]->n)++;
	unless ((i == 1) && (o[0]->n == 14)) puts("bad 4");
	unless (o[1]->n == 13) puts("bad 4.1");
}
op_1_0_1();
} -output {}

test op-1.1 {plus, minus, multiply, divide, and modulus operators} -body {
#lang L --line=1
void op_1_1() {
        int i = 2;
        puts(i + 5);
        puts(i - 50);
        puts(i * 500);
        puts(i / 2);
        puts(i / 4.0);
        puts((i + 5) % 3);
        // precedence
        puts(i + i / i - i * i % i);
}
#lang tcl
op_1_1
} -output "7\n-48\n1000\n1\n0.5\n1\n3\n"

test op-1.2 {unary plus and minus} -body {
#lang L --line=1
void op_1_2() {
        int i = -2;
        int j = +2;

        puts(i);
        i = i + -100;
        puts(i);
        puts(i * -3);
        puts(-8 - -2);

        puts(j);
        j = j + +100;
        puts(j);
        puts(j * +3);
        puts(+8 - +2);
}
#lang tcl
op_1_2
} -output "-2\n-102\n306\n-6\n2\n102\n306\n6\n"

test op-1.3.1 {numeric comparison operators} -body {
#lang L --line=1
void op_1_3_1()
{
	unless (-1 < 1) puts("bad 1.1");
	unless (1 > -1) puts("bad 1.2");
	unless (1 == 1) puts("bad 1.3");
	unless (1 <= 1) puts("bad 1.4");
	unless (-1 <= 1) puts("bad 1.5");
	unless (1 >= -1) puts("bad 1.6");
	unless (1 >= 0) puts("bad 1.7");
	unless (0 != 1) puts("bad 1.8");

	if (1 < 1) puts("bad 2.1");
	if (1 > 1) puts("bad 2.2");
	if (1 == 0) puts("bad 2.3");
	if (1 != 1) puts("bad 2.4");
	if (1 <= -1) puts("bad 2.5");
	if (-1 >= 1) puts("bad 2.6");

	// Verify that these are numeric compares, not lexicographic.
	unless ((int)"1" == (int)"01") puts("bad 3.1");
	if ((int)"1" != (int)"01") puts("bad 3.2");
	if ((int)"1" > (int)"01") puts("bad 3.3");
	if ((int)"01" < (int)"1") puts("bad 3.4");
	if ((int)" 2" <= (int)"1") puts("bad 3.5");  // note: it's space 2
	if ((int)"1" >= (int)" 2") puts("bad 3.6");
	unless ((int)"00" == (int)"0") puts("bad 3.7");
}
op_1_3_1();
} -output {}

test op-1.3.2 {string comparison operators} -body {
#lang L --line=1
void op_1_3_2()
{
	if ("0" == "00") puts("bad 1.1");
	if ("1" == "01") puts("bad 1.2");
	if (" 1" == "1") puts("bad 1.3");

	unless ("0" < "1") puts("bad 2.1");
	unless ("a" < "b") puts("bad 2.2");
	unless ("2" > "1") puts("bad 2.3");
	unless (" 2" < "1") puts("bad 2.4");
	unless ("b" > "a") puts("bad 2.5");

	unless ("0" <= "0") puts("bad 3.1");
	unless ("0" <= "1") puts("bad 3.2");
	unless ("a" <= "a") puts("bad 3.3");
	unless ("a" <= "b") puts("bad 3.4");
	unless ("1" >= "1") puts("bad 3.5");
	unless ("2" >= "1") puts("bad 3.6");
	unless ("a" >= "a") puts("bad 3.7");
	unless ("b" >= "a") puts("bad 3.8");
}
op_1_3_2();
} -output {}

test op-1.3.3 {composite equality operator} -body {
#lang L --line=1
void op_1_3_3()
{
	string	as1[], as2[];
	int	ai1[], ai2[];
	string	hs1{string}, hs2{string};
	int	hi1{string}, hi2{string};
	string{string}	ahs1[], ahs2[];
	struct {
		string	a;
		string	b;
	} sts1, sts2;
	struct {
		int	a;
		int	b;
	} sti1, sti2;

	/*
	 * Cases to test:
	 * - Type contains only strings.
	 * - Type contains non-strings and that a numeric compare is done.
	 * - Array or hash w/same size, but same or different elts.
	 * - Array or hash that differs in size (w/fewer or greater elts).
	 */

	as1 = { "one", "two", "three" };
	as2 = { "one", "two", "three" };
	unless (eq(as1,as2)) puts("bad 1.1");
	as2 = { "one", "two" };
	if (eq(as1,as2)) puts("bad 1.2");
	as2 = { "one", "two", "three", "four" };
	if (eq(as1,as2)) puts("bad 1.3");
	as2 = { "one", "two", "four" };
	if (eq(as1,as2)) puts("bad 1.4");

	ai1 = { 1, 2, 3 };
	ai2 = { 1, 2, 3 };
	unless (eq(ai1,ai2)) puts("bad 2.1");
	ai2 = { 1, 2 };
	if (eq(ai1,ai2)) puts("bad 2.2");
	ai2 = { 1, 2, 3, 4 };
	if (eq(ai1,ai2)) puts("bad 2.3");
	ai2 = { 1, 2, 4 };
	if (eq(ai1,ai2)) puts("bad 2.4");
	/* Check that a numeric compare is done. */
	ai2 = (poly)"01 2 003";
	unless (eq(ai1,ai2)) puts("bad 2.5");

	hs1 = { "k1"=>"v1", "k2"=>"v2", "k3"=>"v3" };
	hs2 = { "k1"=>"v1", "k2"=>"v2", "k3"=>"v3" };
	unless (eq(hs1,hs2)) puts("bad 10.1");
	hs2 = { "k1"=>"v1", "k2"=>"v2" };
	if (eq(hs1,hs2)) puts("bad 10.2");
	hs2 = { "k1"=>"v1", "k2"=>"v2", "k3"=>"v3", "k4"=>"v4" };
	if (eq(hs1,hs2)) puts("bad 10.3");
	hs2 = { "k1"=>"v1", "k2"=>"v2", "k4"=>"v4" };
	if (eq(hs1,hs2)) puts("bad 10.4");

	hi1 = { "1"=>1, "2"=>2, "3"=>3 };
	hi2 = { "1"=>1, "2"=>2, "3"=>3 };
	unless (eq(hi1,hi2)) puts("bad 11.1");
	hi2 = { "1"=>1, "2"=>2, "3"=>3, "4"=>4 };
	if (eq(hi1,hi2)) puts("bad 11.2");
	hi2 = { "1"=>1, "2"=>2 };
	if (eq(hi1,hi2)) puts("bad 11.3");
	hi2 = { "1"=>1, "2"=>2, "4"=>4 };
	if (eq(hi1,hi2)) puts("bad 11.4");
	/* Check that a numeric compare is done. */
	hi2 = (poly)"1 01 2 2 3 003";
	unless (eq(hi1,hi2)) puts("bad 11.5");

	sts1 = { "a", "b" };
	sts2 = { "a", "b" };
	unless (eq(sts1,sts2)) puts("bad 20.1");
	sts2 = { "a", "c" };
	if (eq(sts1,sts2)) puts("bad 20.1");

	sti1 = { 1, 2 };
	sti2 = { 1, 2 };
	unless (eq(sti1,sti2)) puts("bad 21.1");
	sti2 = { 1, 3 };
	if (eq(sti1,sti2)) puts("bad 21.2");
	/* Check that a numeric compare is done. */
	sti2 = (poly)"01 002";
	unless (eq(sti1,sti2)) puts("bad 21.3");

	/*
	 * More cases (prompted by bugs):
	 * - hash w/underlying dict elements added in different order
	 * - two hashes w/same key but different value
	 */

	hs1 = { "k1"=>"v1", "k2"=>"v2" };
	hs2 = { "k2"=>"v2", "k1"=>"v1" };
	unless (eq(hs1,hs2)) puts("bad 22.1");

	hs1 = { "k"=>"v1" };
	hs2 = { "k"=>"v2" };
	if (eq(hs1,hs2)) puts("bad 22.2");

	push(&ahs1, hs1);
	push(&ahs1, hs2);
	push(&ahs2, hs1);
	push(&ahs2, hs2);
	unless (eq(ahs1,ahs2)) puts("bad 23.1");
}
op_1_3_3();
} -output {}

test op-1.3.4 {composite equality operator 2} -body {
#lang L --line=1
void op_1_3_4()
{
	/*
	 * Test a composite type w/numerics that contains a composite
	 * type without them.  The outer type must be compared element
	 * by element but the inner type can be compared with a single
	 * string comparison of its string rep.
	 */

	struct {
		int	i;
		struct {
			string	a[];
			string	b[];
		} st;
		int	j;
	} st1, st2;

	st1 = { 1, { {"a","b"}, {"c","d"} }, 2 };
	st2 = { 1, { {"a","b"}, {"c","d"} }, 2 };
	unless (eq(st1,st2)) puts("bad 1.1");

	st1 = { 1, { {"a","b"}, {"c","d"} }, 2 };
	st2 = { 1, { {"a","b"}, {"c","e"} }, 2 };
	if (eq(st1,st2)) puts("bad 1.2");

	st1 = { 1, { {"a","b"}, {"c","d"} }, 2 };
	st2 = { 1, { {"a","b"}, {"c","d"} }, 3 };
	if (eq(st1,st2)) puts("bad 1.3");

	st1 = { 1, { {"a","b"}, {"c","d"} }, 2 };
	st2 = (poly)"1 {{a b} {c d}} 2";
	unless (eq(st1,st2)) puts("bad 1.4");
}
op_1_3_4();
} -output {}

test op-1.3.5 {composite comparison errors} -body {
#lang L --line=1
void op_1_3_5()
{
	string	sa[];
	string	ha{string};
	struct {
		int	i, j;
	} st;

	sa != sa;
	sa < sa;
	sa <= sa;
	sa > sa;
	sa >= sa;

	ha != ha;
	ha < ha;
	ha <= ha;
	ha > ha;
	ha >= ha;

	st != st;
	st < st;
	st <= st;
	st > st;
	st >= st;
}
} -returnCodes {error} -match regexp -result {.*9: L Error: only eq\(\) allowed on non-scalar types
.*10: L Error: only eq\(\) allowed on non-scalar types
.*11: L Error: only eq\(\) allowed on non-scalar types
.*12: L Error: only eq\(\) allowed on non-scalar types
.*13: L Error: only eq\(\) allowed on non-scalar types
.*15: L Error: only eq\(\) allowed on non-scalar types
.*16: L Error: only eq\(\) allowed on non-scalar types
.*17: L Error: only eq\(\) allowed on non-scalar types
.*18: L Error: only eq\(\) allowed on non-scalar types
.*19: L Error: only eq\(\) allowed on non-scalar types
.*21: L Error: only eq\(\) allowed on non-scalar types
.*22: L Error: only eq\(\) allowed on non-scalar types
.*23: L Error: only eq\(\) allowed on non-scalar types
.*24: L Error: only eq\(\) allowed on non-scalar types
.*25: L Error: only eq\(\) allowed on non-scalar types
}

test op-1.4 {lexicographic comparison operators} -body {
#lang L --line=1
void op_1_4() {
	// These operators are now obsolete, but with the _L_ALLOW_EQ_OPS env
	// variable set, the compiler will allow them.

        if ("aa" lt "ab") { puts("1okay"); } else { puts("1broken"); }
        if ("ab" gt "aa") { puts("2okay"); } else { puts("2broken"); }
        if ("aa" eq "aa") { puts("3okay"); } else { puts("3broken"); }
        if ("aa" le "aa") { puts("4okay"); } else { puts("4broken"); }
        if ("aa" le "ab") { puts("5okay"); } else { puts("5broken"); }
        if ("aa" ge "aa") { puts("6okay"); } else { puts("6broken"); }
        if ("ab" ge "aa") { puts("7okay"); } else { puts("7broken"); }
        if ("aa" ne "ab") { puts("8okay"); } else { puts("8broken"); }
        // now from the other side
        puts("--");
        if ("aa" lt "aa") { puts("1broken"); } else { puts("1okay"); }
        if ("aa" gt "aa") { puts("2broken"); } else { puts("2okay"); }
        if ("ab" eq "aa") { puts("3broken"); } else { puts("3okay"); }
        if ("aa" ne "aa") { puts("4broken"); } else { puts("4okay"); }
        if ("ab" le "aa") { puts("5broken"); } else { puts("5okay"); }
        if ("aa" ge "ab") { puts("6broken"); } else { puts("6okay"); }

	// Verify that these do not use Tcl's numeric compare.
	// These are exactly the opposite tests to those at the end of
	// op-1.3 above.
	if ("1" eq "01") puts("bad 1");
	unless ("1" ne "01") puts("bad 2");
	unless ("1" gt "01") puts("bad 3");
	unless ("01" lt "1") puts("bad 4");
	unless (" 2" le "1") puts("bad 5");
	unless ("1" ge " 2") puts("bad 6");
}
#lang tcl
op_1_4
} -output "1okay\n2okay\n3okay\n4okay\n5okay\n6okay\n7okay\n8okay
--\n1okay\n2okay\n3okay\n4okay\n5okay\n6okay\n"


test op-1.5 {boolean operators} -body {
#lang L --line=1
void op_1_5() {
        int true = 1, false = 0;
        if (true && true)       { puts("1okay"); } else { puts("1broken"); }
        if (!false)             { puts("2okay"); } else { puts("2broken"); }
        if (false || true)      { puts("3okay"); } else { puts("3broken"); }
        if (true && !false)     { puts("4okay"); } else { puts("4broken"); }
        // && has higher precedence than ||
        if (false && false || true) { puts("5okay"); } else { puts("5broken"); }
        // now from the other side
        puts("--");
        if (true && !true)      { puts("1broken"); } else { puts("1okay"); }
        if (false || false)     { puts("2broken"); } else { puts("2okay"); }
        if (!true)              { puts("3broken"); } else { puts("3okay"); }

}
#lang tcl
op_1_5
} -output "1okay\n2okay\n3okay\n4okay\n5okay\n--\n1okay\n2okay\n3okay\n"


test op-1.6 {bitwise operators} -body {
#lang L --line=1
void op_1_6(){
        int bits = 715827882;

        puts(bits << 1);
        puts(bits >> 1);
        puts(bits >> 29);
        puts(-1 << 10);
        puts(-1024 >> 9);
        puts(~bits);
        puts(bits & ~bits);
        puts(bits | ~bits);
        puts(bits ^ (bits + 1));

}
#lang tcl
op_1_6
} -output "1431655764\n357913941\n1\n-1024\n-2\n-715827883\n0\n-1\n1\n"


test op-1.7 {logical operator short-circuiting} -body {
#lang L --line=1
int
puts_int(string str) {
        puts(str);
        return 9;
}
void op_1_7(){
        puts(0 && puts_int("1"));
        puts(1 && puts_int("2"));
        puts(0 || puts_int("3"));
        puts(1 || puts_int("4"));
}
#lang tcl
op_1_7
} -output "0\n2\n9\n3\n9\n1\n"

test op-1.8 {compound assignment operators, simple lvalues} -body {
#lang L --line=1
void op_1_8() {
  int foo = 0;

  puts(foo += 2);
  puts(foo);
  puts(foo -= 3);
  puts(foo);
  puts(foo *= 4);
  puts(foo);
  puts(foo /= -2);
  puts(foo);
  foo = 17;
  puts(foo %= 7);
  puts(foo);
  puts(foo |= 9);
  puts(foo);
  puts(foo &= 8);
  puts(foo);
  puts(foo ^= 9);
  puts(foo);
  puts(foo <<= 3);
  puts(foo);
  puts(foo >>= 2);
  puts(foo);
}
#lang tcl
op_1_8
} -output "2\n2\n-1\n-1\n-4\n-4\n2\n2\n3\n3\n11\n11\n8\n8\n1\n1\n8\n8\n2\n2\n"

test op-1.9 {compound assignment operators, array lvalues} -body {
#lang L --line=1
void op_1_9() {
  int foo[4] = {0,0,0,0};

  puts(foo[2] += 2);
  puts(foo[2]);
  puts(foo[2] -= 3);
  puts(foo[2]);
  puts(foo[2] *= 4);
  puts(foo[2]);
  puts(foo[2] /= -2);
  puts(foo[2]);
  foo[2] = 17;
  puts(foo[2] %= 7);
  puts(foo[2]);
  puts(foo[2] |= 9);
  puts(foo[2]);
  puts(foo[2] &= 8);
  puts(foo[2]);
  puts(foo[2] ^= 9);
  puts(foo[2]);
  puts(foo[2] <<= 3);
  puts(foo[2]);
  puts(foo[2] >>= 2);
  puts(foo[2]);
  puts(foo);
}
#lang tcl
op_1_9
} -output "2\n2\n-1\n-1\n-4\n-4\n2\n2\n3\n3\n11\n11\n8\n8\n1\n1\n8\n8\n2\n2\n0 0 2 0\n"

test op-1.10 {short-circuit conditionals} -body {
#lang L --line=1
void op_1_10()
{
	/*
	 * Ensure that conditionals of type string are tested properly
	 * in the short-circuited operators (i.e., tested for defined).
	 */

	int	i = 0, j;
	string	s;

	if (s && ++i) j = 1;
	unless (i == 0) puts("bad 1");

	if (s || ++i) j = 1;
	unless (i == 1) puts("bad 2");
}
#lang tcl
op_1_10
} -output {}

test op-1.11 {comma operator} -body {
#lang L --line=1 -nowarn
int op_1_11_f(int a, int b, int c) { return (b); }
string op_1_11_s(string a, string b, string c, string d)
{
	return ((string)concat(a,b,c,d));
}
void op_1_11()
{
	/*
	 * Check precedence and associativity of comma operator.
	 * Should be the lowest and left associative, and not get
	 * confused with comma as an arg seperator.  Also check that
	 * the value of a,b is b.
	 */

	int	i;
	int	j = 2, k = 0;  // declares j & k; is not a comma op
	int	l = (1,2), m = (1,2,3,4,5);
	string	s;

	unless ((j == 2) && (k == 0)) puts("bad d1");
	unless (l == 2) puts("bad d2");
	unless (m == 5) puts("bad d3");

	i = 1,2;
	unless (i == 1) puts("bad 1");
	unless ((i = 1,2) == 2) puts("bad 2");
	unless (op_1_11_f(1, 2, 3) == 2) puts("bad 3");
	unless (op_1_11_f(1, (2,3), 4) == 3) puts("bad 4");
	unless (op_1_11_s("a", "b", kw:"d") eq "a b -kw d") puts("bad 5");
	unless (op_1_11_s("a", kw:"b", "c") eq "a -kw b c") puts("bad 6");
	unless (op_1_11_s(kw:"a", "b", "c") eq "-kw a b c") puts("bad 7");
	unless (op_1_11_s("a", ("b","c"), kw: "d") eq "a c -kw d") {
		puts("bad 8");
	}

	i = (1,2,3);
	unless (i == 3) puts("bad 10");
	i = (1,2,3,4);
	unless (i == 4) puts("bad 11");
	i = (1,2),(3,4);
	unless (i == 2) puts("bad 12");
	i = ((1,2),(3,4));
	unless (i == 4) puts("bad 13");

	/*
	 * Check that the type of a,b is the type of b.
	 */
	i = ("s", 11);
	unless (i == 11) puts("bad t1");
	s = (1, "s");
	unless (s eq "s") puts("bad t2");

	/*
	 * For loops should just automatically get the use of comma op.
	 */
	i = j = -1;
	for (i=0,j=10; i < 10; ++i,j+=10) ;
	unless ((i == 10) && (j == 110)) puts("bad f1");
}
#lang tcl
op_1_11
} -output {}

test op-1.12 {test string concat operator} -body {
#lang L --line=1
void op_1_12()
{
	string	a, b, c;
	string	as[];
	string	hs{string};
	widget	w;
	poly	p;
	struct {
		string	a, b, c;
	} st;

	unless ("a" . "b" eq "ab") puts("bad 1.1");
	unless ("ab" . "cd" eq "abcd") puts("bad 1.2");
	unless ("ab" . "cd" . "ef" eq "abcdef") puts("bad 1.3");
	unless ("ab" . "cd" . "ef" . "gh" eq "abcdefgh") puts("bad 1.4");
	unless ("" . "a" eq "a") puts("bad 1.5");
	unless ("a" . "" eq "a") puts("bad 1.6");
	unless ("" . "a" . "" eq "a") puts("bad 1.7");
	unless ("" . "" . """" . "a" . "" eq "a") puts("bad 1.8");
	unless ("" . "" eq "") puts("bad 1.9");
	unless ("" . "" . "" eq "") puts("bad 1.10");

	a = "a";
	b = "b";
	c = "c";
	unless (a . b . c eq "abc") puts("bad 2.1");

	p = "a";
	unless (p . "b" eq "ab") puts("bad 3.1");

	/* Test precedence. "." should be lower than [], {}, and -> */

	as[0] = "a";
	as[1] = "b";
	as[2] = "c";
	unless (as[0] . as[1] . as[2] eq "abc") puts("bad 10.1");
	hs{"a"} = "a";
	hs{"b"} = "b";
	hs{"c"} = "c";
	unless (hs{"a"} . hs{"b"} . hs{"c"} eq "abc") puts("bad 10.2");
	st.a = "a";
	st.b = "b";
	st.c = "c";
	unless (st.a . st.b . st.c eq "abc") puts("bad 10.3");

	/* Check varying whitespace around the "." */

	unless ("a"  . "b" eq "ab") puts("bad 20.1");
	unless ("a" .  "b" eq "ab") puts("bad 20.2");
	unless ("a"  .  "b" eq "ab") puts("bad 20.3");
	unless ("a"	. "b" eq "ab") puts("bad 20.4");  // tab
	unless ("a" .	"b" eq "ab") puts("bad 20.5");  // tab
	unless ("a" .
		"b" eq "ab") puts("bad 20.6");
	unless ("a"
		. "b" eq "ab") puts("bad 20.7");
	unless ("a" .
		"b" .
		"c" eq "abc") puts("bad 20.8");

	/* Check .= */

	a = "a";
	a .= "bcd";
	unless (a eq "abcd") puts("bad 30.1");
	b = "e";
	unless ((a.=b) eq "abcde") puts("bad 30.2");

	as[0] = "0";
	as[0] .= "123";
	unless (as[0] eq "0123") puts("bad 31.1");

	a = "0234";
	a[0] .= "1";
	unless (a eq "01234") puts("bad 32.1");

	/* String and widget should both work. */

	a = "a";
	w = "w";
	unless ((a . w) eq "aw") puts("bad 33.1");
	unless ((w . a) eq "wa") puts("bad 33.2");
	unless ((w . w) eq "ww") puts("bad 33.3");

	a .= w;
	unless (a eq "aw") puts("bad 34.1");
	a = "a";
	w .= a;
	unless (w eq "wa") puts("bad 34.2");
	w = "w";
	w .= w;
	unless (w eq "ww") puts("bad 34.3");

	w = "abc";
	unless (w =~ /b/) puts("bad 35.1");
	w =~ s/ab/x/;
	unless (w eq "xc") puts("bad 35.2");
}
op_1_12();
} -output {}

test op-1.13 {test string concat type errors} -body {
#lang L --line=1
void op_1_13()
{
	int	i, j;
	string	s;
	float	f;
	int	h{string};

	i . j;
	i . f;
	h{"bad"} . i;
	i . "s";
	"s" . f;
	h{"bad"} . "s";

	i .= "s";
	i .= j;
	s .= i;
}
} -returnCodes {error} -match regexp -result {.*8: L Error: expected type string.*
.*9: L Error: expected type string.*
.*10: L Error: expected type string.*
.*11: L Error: expected type string.*
.*12: L Error: expected type string.*
.*13: L Error: expected type string.*
.*15: L Error: expected type string.*
.*16: L Error: expected type string.*
.*17: L Error: assignment of incompatible types
}

test op-1.14 {test "." and "->" as struct selection operators} -body {
#lang L --line=1
struct op14 {
	int	i, j;
	struct {
		int	k;
	} s;
};
void op_1_14_ref(struct op14 &st)
{
	st->i = 7;
	st->s.k = 8;
}
void op_1_14_val(struct op14 st)
{
	st.i = 8;
	st.s.k = 9;
}
void op_1_14()
{
	struct op14 st = { 5, 6, {7} };

	unless (st.i  == 5) puts("bad 1.1");
	unless (st.j  == 6) puts("bad 1.2");

	op_1_14_ref(&st);
	unless (st.i == 7) puts("bad 2.1");
	unless (st.s.k == 8) puts("bad 2.2");

	op_1_14_val(st);
	unless (st.i == 7) puts("bad 3.1");
	unless (st.s.k == 8) puts("bad 3.2");
}
op_1_14();
} -output {}

test op-1.15 {check "." and "->" usage errors} -body {
#lang L --line=1
struct op15 {
	int	i, j;
	struct {
		int	k;
	} s;
};
void op_1_15_ref(struct op14 &st)
{
	st.i = 7;  // err
	st->s->k = 8;  // the ->k part is an err
}
void op_1_15_val(struct op14 st)
{
	st->i = 8; // err
}
void op_1_15()
{
	struct op14 st;

	st->i = st.j;  // st->i is an err
}
} -returnCodes {error} -match regexp -result {.*9: L Error: \. illegal on call-by-reference parms; use -> instead
.*10: L Error: -> illegal except on call-by-reference parms; use \. instead
.*14: L Error: -> illegal except on call-by-reference parms; use \. instead
.*20: L Error: -> illegal except on call-by-reference parms; use \. instead
}

test op-1.16 {check ? : operator} -body {
#lang L --line=1
string op_1_16_f(...args) { return (join("", args)); }
void op_1_16()
{
	int	i;
	float	f;
	string	s;

	/* Check spacing variations. */

	s = "bad";
	0 ? puts("bad 1.1") : (s = "good");
	unless (s eq "good") puts("bad 1.2");

	s = "bad";
	0? puts("bad 2.1") : (s = "good");
	unless (s eq "good") puts("bad 2.2");

	s = "bad";
	0?puts("bad 3.1") : (s = "good");
	unless (s eq "good") puts("bad 3.2");

	s = "bad";
	0?puts("bad 4.1"): (s = "good");
	unless (s eq "good") puts("bad 4.2");

	s = "bad";
	0?puts("bad 5.1"):(s = "good");
	unless (s eq "good") puts("bad 5.2");

	s = "bad";
	1 ? (s = "good") : puts("bad 6.1");
	unless (s eq "good") puts("bad 6.2");

	/* Check that id: parses properly. */

	i = 0;
	unless ((1?i:1) == 0) puts("bad 6.3");

	/* Exactly one of the expressions must ever be executed. */

	i = 0;
	0 ? ++i : ++i;
	unless (i == 1) puts("bad 7.1");
	i = 0;
	1 ? ++i : ++i;
	unless (i == 1) puts("bad 7.2");

	/* Check value. */

	s = 0 ? "bad" : "good";
	unless (s eq "good") puts("bad 10.1");

	s = 1 ? "good" : "bad";
	unless (s eq "good") puts("bad 11.1");

	/*
	 * Check typing.  If either expr is a float and the other is compatible
	 * with that, we get a float.  If either is a poly, we get a poly.
	 */

	f = 0 ? 0 : 3.14;
	unless (f == 3.14) puts("bad 12.1");
	f = 1 ? 6.28 : 0;
	unless (f == 6.28) puts("bad 12.2");
	f = 1 ? 1.11 : 0.0;
	unless (f == 1.11) puts("bad 12.3");
	f = 1 ? 12 : -1;
	unless (f == 12) puts("bad 12.4");

	s = "bad";
	s = 0 ? "bad" : (poly)13;
	unless (s eq "13") puts("bad 12.5");
	s = "bad";
	s = 1 ? (poly)13 : "bad";
	unless (s eq "13") puts("bad 12.6");

	/*
	 * Check precedence -- ? : should be between = and || in the
	 * precedence hierarchy.
	 */
	i = 1 ? 1 || puts("bad 20.1") : 1 || puts("bad 20.2");

	/* Should have no confusion with the opt: argument syntax. */
	s = op_1_16_f(o1: 0 ? "bad": "good", o2: "3");
	unless (s eq "-o1good-o23") puts("bad 20.3");

	/*
	 * This checks that the run-time stack is kept balanced when
	 * the value of the ternary expression is ignored (if it's
	 * not, we'll probably crash).
	 */
	for (i = 0; i < 10000; ++i) {
		0 ? 1 : 2;
		(0 ? 1 : 2) , (0 ? 1 : 2);
	}

	/* Try some nested ?: */
	i = 0 ? 1 ? 11:12 : 13;
	unless(i == 13) puts("bad 30.1");
	i = 1 ? 1 ? 11:12 : 13;
	unless(i == 11) puts("bad 30.2");
	i = 1 ? 0 ? 11:12 : 13;
	unless(i == 12) puts("bad 30.3");
}
op_1_16();
} -output {}

test op-1.17 {check type errors in ? : operator} -body {
#lang L --line=1
void op_1_17()
{
	int	i;
	float	f;
	string	s;

	s = 0 ? 1 : 2;
	i = 0 ? "a" : "b";
	f = 0 ? "a" : "b";

	/* The type of these ?: is float. */
	i = 0 ? f : i;
	i = 0 ? i : f;
	i = 0 ? f : f;

	/* These have exprs with incompatible types. */
	s = 0 ? 1 : "2";
	s = 0 ? "1" : 2;
}
} -returnCodes {error} -match regexp -result {.*7: L Error: assignment of incompatible types
.*8: L Error: assignment of incompatible types
.*9: L Error: assignment of incompatible types
.*12: L Error: assignment of incompatible types
.*13: L Error: assignment of incompatible types
.*14: L Error: assignment of incompatible types
.*17: L Error: incompatible types in \? : expressions
.*18: L Error: incompatible types in \? : expressions
}

test cast-1.0 { Casts to integer and float } -body {
#lang L --line=1
void cast_1_0() {
    printf("%d\n", (int)1.9);
    printf("%f\n", (float)5);
    (int)1.9;
    (float)5;
}
#lang tcl
cast_1_0
} -output "1\n5.000000\n"

test cast-1.1 {invalid casts from string to int or float} -body {
#lang L --line=1
void cast_1_1()
{
	if (defined((int)"asdf")) puts("bad 1");
	if (defined((float)"asdf")) puts("bad 2");
}
cast_1_1();
} -output {}

test cast-1.3 { Cast to string } -body {
#lang L --line=1
void cast_1_3()
{
	string	s;
	widget	w = "w";
	poly	p = "p";
	int	a[] = { 1, 2 };
	int	h{string} = { "a"=>1, "b"=>2 };
	struct { int i,j; } st = { 5, 6 };

	/* This checks not only cast functionality but also type checking. */

	s = (string)1;
	unless (s eq "1") puts("bad 1");

	s = (string)3.14159;
	unless (s =~ /3.14159/) puts("bad 2");

	s = (string)"ok";
	unless (s eq "ok") puts("bad 3");

	s = (string)w;
	unless (s eq "w") puts("bad 4");

	s = (string)a;
	unless (s eq "1 2") puts("bad 5");

	s = (string)h;
	unless (s eq "a 1 b 2") puts("bad 6");

	s = (string)st;
	unless (s eq "5 6") puts("bad 7");

	s = (string)p;
	unless (s eq "p") puts("bad 8");
}
#lang tcl
cast_1_3
} -output {}

test cast-1.4 { Invalid cast from function } -body {
#lang L --line=1
void cast_1_4()
{
	int	i;
	float	f;
	string	s;
	widget	w;
	int	h{string};

	i = (int)cast_1_4;
	f = (float)cast_1_4;
	s = (string)cast_1_4;
	s = (tcl)cast_1_4;
	w = (widget)cast_1_4;
	h = (hash)cast_1_4;
}
#lang tcl
cast_1_4
} -returnCodes {error} -match regexp -result {.*9: L Error: type function illegal
.*10: L Error: type function illegal
.*11: L Error: type function illegal
.*12: L Error: type function illegal
.*13: L Error: type function illegal
.*14: L Error: type function illegal
}

test cast-1.5 {cast to hash} -body {
#lang L --line=1
void cast_1_5()
{
	int	n = 0;
	string	k;
	string	a[] = { "k1","v1", "k2","v2", "k3","v3" };
	poly	h{poly};

	h = (hash)a;
	unless (h{"k1"} eq "v1") puts("bad 1");
	unless (h{"k2"} eq "v2") puts("bad 2");
	unless (h{"k3"} eq "v3") puts("bad 3");
	foreach (k in h) ++n;
	unless (n == 3) puts("bad 4");
}
#lang tcl
cast_1_5
} -output {}

test cast-1.6 {cast to various structured types} -body {
#lang L --line=1
struct s {
	int	i;
	string	s;
	struct {
		string	h{int};
		int	i;
	} st;
};
void cast_1_6()
{
	struct s	st;
	int		a[], i, n;
	string		h{int};

	/* Cast a string to a struct s. */
	st = (struct s)"1 str { { 1 one 2 two } 33 }";
	unless ((st.i == 1) && (st.s eq "str")) puts("bad 1");
	unless ((st.st.h{1} eq "one") && (st.st.h{2} eq "two")) puts("bad 2");
	unless (st.st.i == 33) puts("bad 3");

	/* Same as above except casting from a composite constant. */
	st = (struct s) {
			  1,
			  "str",
			  {
				  { 1=>"one", 2=>"two" },
				  33
			  }
	};
	unless ((st.i == 1) && (st.s eq "str")) puts("bad 4");
	unless ((st.st.h{1} eq "one") && (st.st.h{2} eq "two")) puts("bad 5");
	unless (st.st.i == 33) puts("bad 6");

	/* Cast a string to a struct s but spell out the entire struct type. */
	st = (struct { int i; string s; struct { string h{int}; int i; } st; })
		"1 str { { 1 one 2 two } 33 }";
	unless ((st.i == 1) && (st.s eq "str")) puts("bad 7");
	unless ((st.st.h{1} eq "one") && (st.st.h{2} eq "two")) puts("bad 8");
	unless (st.st.i == 33) puts("bad 9");

	/* Same as above except casting from a composite constant. */
	st = (struct { int i; string s; struct { string h{int}; int i; } st; })
		{
			  1,
			  "str",
			  {
				  { 1=>"one", 2=>"two" },
				  33
			  }
		};
	unless ((st.i == 1) && (st.s eq "str")) puts("bad 10");
	unless ((st.st.h{1} eq "one") && (st.st.h{2} eq "two")) puts("bad 11");
	unless (st.st.i == 33) puts("bad 12");

	a = (int[])"1 2 3";
	n = 0;
	foreach (i in a) {
		unless (i == (n+1)) puts("bad 10");
		++n;
	}
	if (n != 3) puts("bad 11");

	h = (string{int})"1 one 2 two 3 three";
	unless ((h{1} eq "one") && (h{2} eq "two") && (h{3} eq "three")) {
		puts("bad 20");
	}
	n = 0;
	foreach (i in h) ++n;
	unless (n == 3) puts("bad 21");
}
#lang tcl
cast_1_6
} -output {}

test cast-1.7 {cast an lvalue} -body {
#lang L --line=1
typedef struct {
	string	type;
	poly	val;
} c17_Xml;
void cast_1_7()
{
	int	i;
	float	f;
	c17_Xml	x;

	/*
	 * These used to be various bugs with casts.  There were
	 * problems with casting an l-value.
	 */

	(int)i = 123;
	unless(i == 123) puts("bad 1.1");
	++(int)i;
	unless(i == 124) puts("bad 1.2");

	(float)f = 1.1;
	unless (f == 1.1) puts("bad 2.1");

	x.type = "dict";
	((string{string})(x.val)){"key"} = "val";
	unless (x.type eq "dict") puts("bad 3.1");
	unless ((tcl)x eq "dict {key val}") puts("bad 3.2");

	x.type = "type";
	x.val  = {};
	((string{string})(x.val)){"key"} = "val";
	unless (x.type eq "type") puts("bad 4.1");
	unless ((tcl)x eq "type {key val}") puts("bad 4.2");

	x.type = "integer";
	x.val  = 0;
	++(int)x.val;
	unless (x.type eq "integer") puts("bad 5.1");
	unless (x.val == 1) puts("bad 5.2");
	unless ((tcl)x eq "integer 1") puts("bad 5.3");
}
cast_1_7();
} -output {}

test array-1.0 { Single-dimensional array creation and indexing } -body {
#lang L --line=1
void array_1_0() {
    int array[3];

    array[0] = 1;
    array[1] = 2;
    array[2] = 3;
    puts(array[2]);
}
#lang tcl
array_1_0
} -output "3\n"

test array-1.1 { Multi-dimensional array creation and indexing } -body {
#lang L --line=1
void array_1_1() {
    int array[4][3][2];

    puts(array);
    array[0][0][0] = 1;
    array[1][1][1] = 2;
    array[2][2][0] = 3;
    array[3][0][1] = 4;
    puts(array);
}
#lang tcl
array_1_1
} -output "
1 {{} {{} 2}} {{} {} 3} {{{} 4}}\n"


test array-1.2 {increment and decrement on array elements} -body {
#lang L --line=1
void array_1_2() {
  int foo[5] = {0,0,0,0,0};

  foo[3] = 0;
  for (foo[3]=0; foo[3]<5; foo[3]++);
  puts(foo);

  puts("pre:");
  puts(foo[3]);
  ++foo[3];
  puts(foo[3]);
  puts(++foo[3]);
  --foo[3];
  puts(foo[3]);
  puts(--foo[3]);

  puts("post:");
  puts(foo[3]);
  foo[3]++;
  puts(foo[3]);
  puts(foo[3]++);
  puts(foo[3]);
  foo[3]--;
  puts(foo[3]);
  puts(foo[3]--);
  puts(foo[3]);
  puts(foo);
}
#lang tcl
array_1_2
} -output "0 0 0 5 0\npre:\n5\n6\n7\n6\n5\npost:\n5\n6\n6\n7\n6\n6\n5\n0 0 0 5 0\n"

test array-1.3 {1d arrays with no length auto-extend by one at a time} -body {
#lang L --line=1
void array_1_3() {
  int foo[];

  foo[0] = 4;
  foo[1] = 5;
  foo[2] = 6;
  puts(foo);
}
#lang tcl
array_1_3
} -output "4 5 6\n"

test array-1.4 {extend arrays using push and pop} -body {
#lang L --line=1
void array_1_4() {
  int foo[];

  push(&foo, 1);
  push(&foo, 2);
  push(&foo, 3);
  puts(foo);
  puts(pop(&foo));
  puts(foo);
  puts(pop(&foo));
  puts(foo);
  puts(pop(&foo));
  puts(foo);
  puts(pop(&foo));
  puts(foo);
}
#lang tcl
array_1_4
} -output "1 2 3\n3\n1 2\n2\n1\n1\n\n\n\n"

test strindex-1 {string indexing} -body {
#lang L --line=1
void strindex_1()
{
	int	i;
	string	s, s2;
	struct {
		string	s;
	} st;
	string	sa[];
	string	sh{string};
	widget	w;

	s = "abcd";
	s[0] = "x";
	unless (s eq "xbcd") puts("bad 1.1");
	s[1] = "y";
	unless (s eq "xycd") puts("bad 1.2");
	s[2] = "z";
	unless (s eq "xyzd") puts("bad 1.3");
	s[3] = "q";
	unless (s eq "xyzq") puts("bad 1.4");
	s[3] = "";
	unless (s eq "xyz") puts("bad 1.5");
	s[0] = "";
	unless (s eq "yz") puts("bad 1.6");
	s[0] = "";
	unless (s eq "z") puts("bad 1.7");
	s[0] = "";
	unless (s eq "") puts("bad 1.8");
	s = "abcd";
	if (defined(s[4])) puts("bad 1.9");

	st.s = "abcd";
	st.s[0] = "x";
	unless (st.s eq "xbcd") puts("bad 2.1");
	st.s[1] = "y";
	unless (st.s eq "xycd") puts("bad 2.2");
	st.s[2] = "z";
	unless (st.s eq "xyzd") puts("bad 2.3");
	st.s[3] = "q";
	unless (st.s eq "xyzq") puts("bad 2.4");
	st.s[3] = "";
	unless (st.s eq "xyz") puts("bad 2.5");
	st.s[0] = "";
	unless (st.s eq "yz") puts("bad 2.6");
	st.s[0] = "";
	unless (st.s eq "z") puts("bad 2.7");
	st.s[0] = "";
	unless (st.s eq "") puts("bad 2.8");
	st.s = "abcd";
	if (defined(st.s[4])) puts("bad 2.9");

	sa[0] = "abcd";
	sa[0][0] = "x";
	unless (sa[0] eq "xbcd") puts("bad 3.1");
	sa[0][1] = "y";
	unless (sa[0] eq "xycd") puts("bad 3.2");
	sa[0][2] = "z";
	unless (sa[0] eq "xyzd") puts("bad 3.3");
	sa[0][3] = "q";
	unless (sa[0] eq "xyzq") puts("bad 3.4");
	sa[0][3] = "";
	unless (sa[0] eq "xyz") puts("bad 3.5");
	sa[0][0] = "";
	unless (sa[0] eq "yz") puts("bad 3.6");
	sa[0][0] = "";
	unless (sa[0] eq "z") puts("bad 3.7");
	sa[0][0] = "";
	unless (sa[0] eq "") puts("bad 3.8");
	sa[0] = "abcd";
	if (defined(sa[0][4])) puts("bad 3.9");

	sh{"zero"} = "abcd";
	sh{"zero"}[0] = "x";
	unless (sh{"zero"} eq "xbcd") puts("bad 4.1");
	sh{"zero"}[1] = "y";
	unless (sh{"zero"} eq "xycd") puts("bad 4.2");
	sh{"zero"}[2] = "z";
	unless (sh{"zero"} eq "xyzd") puts("bad 4.3");
	sh{"zero"}[3] = "q";
	unless (sh{"zero"} eq "xyzq") puts("bad 4.4");
	sh{"zero"}[3] = "";
	unless (sh{"zero"} eq "xyz") puts("bad 4.5");
	sh{"zero"}[0] = "";
	unless (sh{"zero"} eq "yz") puts("bad 4.6");
	sh{"zero"}[0] = "";
	unless (sh{"zero"} eq "z") puts("bad 4.7");
	sh{"zero"}[0] = "";
	unless (sh{"zero"} eq "") puts("bad 4.8");
	sh{"zero"} = "abcd";
	if (defined(sh{"zero"}[4])) puts("bad 4.9");

	s = "abcd";
	s[1] =~ s/n/nochange/;
	unless (s eq "abcd") puts("bad 5.1");
	s[0] =~ s/n/nochange/;
	unless (s eq "abcd") puts("bad 5.2");
	s[3] =~ s/n/nochange/;
	unless (s eq "abcd") puts("bad 5.3");
	s[0] =~ s/a/was-a/;
	unless (s eq "was-abcd") puts("bad 5.4");
	s[5] =~ s/b/was-b/;
	unless (s eq "was-awas-bcd") puts("bad 5.5");
	s[11] =~ s/d/was-d/;
	unless (s eq "was-awas-bcwas-d") puts("bad 5.6");
	s[0] =~ s/w//;
	unless (s eq "as-awas-bcwas-d") puts("bad 5.7");
	s[0] =~ s/a//;
	unless (s eq "s-awas-bcwas-d") puts("bad 5.8");
	s[1] =~ s/-//;
	unless (s eq "sawas-bcwas-d") puts("bad 5.9");
	s[12] =~ s/d//;
	unless (s eq "sawas-bcwas-") puts("bad 5.10");

	s = "0123456789";
	for (i = 0; i < 10; ++i) {
		s[i] =~ s/${i}/${i+1}/;
	}
	unless (s eq "12345678910") puts("bad 6.1");

	/*
	 * Ensure that an un-shared copy of the string is made.
	 */
	s = "xyzzy";
	s2 = s;  // s2 and s now share the same Tcl_Obj
	s[1] = "x";
	unless (s eq "xxzzy") puts("bad 7.1");
	unless (s2 eq "xyzzy") puts("bad 7.2");

	/* Should work with widgets too. */
	w = "wid";
	unless ((w[0] eq "w") && (w[END] eq "d")) puts("bad 8.1");
}
strindex_1();
} -output {}

test strindex-2 {string indexing errors 1} -body {
#lang L --line=1
void strindex_2()
{
	string	s = "bad";
	s[-1] = "x";  // run-time error
}
strindex_2();
} -returnCodes error -result {negative string index illegal}

test strindex-3 {string indexing errors 2} -body {
#lang L --line=1
void strindex_3()
{
	string	s = "bad";
	puts (s[-1]);  // run-time error
}
strindex_3();
} -returnCodes error -result {negative string index illegal}

test strindex-4 {string indexing errors 3} -body {
#lang L --line=1
void strindex_4()
{
	string	s = "bad";
	s[-1] =~ s/b/bad/;  // run-time error
}
strindex_4();
} -returnCodes error -result {negative string index illegal}

test strindex-5 {string indexing index using comma expression} -body {
#lang L --line=1
void strindex_5()
{
	/*
	 * This checks an obscure case to ensure that a string index
	 * whose value is discarded -- the first expression in a comma
	 * expression -- is compiled properly.
	 */

	string	s = "abcde";

	/* The value of "fgh"[0] is discarded in the "s" index expression. */
	unless (s[ "fgh"[0], 2 ] eq "c") puts("bad 1");
}
strindex_5();
} -output {}

test strindex-6 {writing to a string index beyond end of string} -body {
#lang L --line=1
void strindex_6()
{
	string	s = "good";
	s[END+2] = "bad";  // run-time error
}
strindex_6();
} -returnCodes error -result {index is more than one past end of string}

test strindex-7 {multi-index string indexing} -body {
#lang L --line=1
void strindex_7()
{
	string	s = "value";

	s[0][0] = "x";
	s[0][0][0] = "x";
}
strindex_7();
} -returnCodes error -match regexp -result {.*5: L Error: cannot index a string index
.*6: L Error: cannot index a string index
}

test slice-1 {string slicing} -body {
#lang L --line=1
string slice_1_f(string s) { return (s); }
void slice_1()
{
	int	i, j;
	string	s;
	widget	w;

	s = "";
	unless (s[0..0] eq "") puts("bad 1.1");

	s = "a";
	unless (s[0..0] eq "a") puts("bad 2.1");

	s = "abcdefg";
	unless (s[0..0] eq "a") puts("bad 3.1");
	unless (s[0..1] eq "ab") puts("bad 3.2");
	unless (s[0..2] eq "abc") puts("bad 3.3");
	unless (s[0..3] eq "abcd") puts("bad 3.4");
	unless (s[0..4] eq "abcde") puts("bad 3.5");
	unless (s[1..1] eq "b") puts("bad 3.6");
	unless (s[1..2] eq "bc") puts("bad 3.7");
	unless (s[1..3] eq "bcd") puts("bad 3.8");
	unless (s[1..4] eq "bcde") puts("bad 3.9");
	unless (s[2..2] eq "c") puts("bad 3.10");
	unless (s[2..3] eq "cd") puts("bad 3.11");
	unless (s[2..4] eq "cde") puts("bad 3.12");
	unless (s[3..3] eq "d") puts("bad 3.13");
	unless (s[3..4] eq "de") puts("bad 3.14");
	unless (s[4..4] eq "e") puts("bad 3.15");
	unless (s[0..10] eq "abcdefg") puts("bad 3.20");
	unless (s[-1..0] eq "a") puts("bad 3.21");
	unless (s[-1..1] eq "ab") puts("bad 3.22");
	unless (s[-1..10] eq "abcdefg") puts("bad 3.23");
	unless (s[2..1] eq "") puts("bad 3.24");

	s = "0123456789";
	unless (s[2..4][0..0] eq "2") puts("bad 4.1");
	unless (s[2..4][1..1] eq "3") puts("bad 4.2");
	unless (s[1..8][1..6][1..4][1..2] eq "45") puts("bad 4.3");

	s = "0123456789";
	unless (slice_1_f(s)[2..4][0..0] eq "2") puts("bad 5.1");
	unless (slice_1_f(s)[2..4][1..1] eq "3") puts("bad 5.2");
	unless (slice_1_f(s)[1..8][1..6][1..4][1..2] eq "45") puts("bad 5.3");

	s = "0123456789";
	i = 2;
	j = 4;
	unless (s[i..j] eq "234") puts("bad 6.1");
	unless (s[i-1..j] eq "1234") puts("bad 6.2");
	unless (s[i-1..j+1] eq "12345") puts("bad 6.3");

	w = "0123456789";
	unless (s[2..4][0..0] eq "2") puts("bad 7.1");
	unless (s[2..4][1..1] eq "3") puts("bad 7.2");
	unless (s[1..8][1..6][1..4][1..2] eq "45") puts("bad 7.3");
}
slice_1();
} -output {}

test slice-2 {array slicing} -body {
#lang L --line=1
string slice_2_tostr(int a[])
{
	int	i;
	string	ret = "";

	foreach (i in a) ret = sprintf("%s<%i>", ret, i);
	return (ret);
}
void slice_2()
{
	int	ai[];
	string	s;

	ai = { 0, 1, 2, 3, 4 };
	unless (slice_2_tostr(ai[0..0]) eq "<0>") puts("bad 1.1");
	unless (slice_2_tostr(ai[0..1]) eq "<0><1>") puts("bad 1.2");
	unless (slice_2_tostr(ai[0..2]) eq "<0><1><2>") puts("bad 1.3");
	unless (slice_2_tostr(ai[0..3]) eq "<0><1><2><3>") puts("bad 1.4");
	unless (slice_2_tostr(ai[0..4]) eq "<0><1><2><3><4>") puts("bad 1.5");
	unless (slice_2_tostr(ai[1..1]) eq "<1>") puts("bad 1.6");
	unless (slice_2_tostr(ai[1..2]) eq "<1><2>") puts("bad 1.7");
	unless (slice_2_tostr(ai[1..3]) eq "<1><2><3>") puts("bad 1.8");
	unless (slice_2_tostr(ai[1..4]) eq "<1><2><3><4>") puts("bad 1.9");
	unless (slice_2_tostr(ai[2..2]) eq "<2>") puts("bad 1.10");
	unless (slice_2_tostr(ai[2..3]) eq "<2><3>") puts("bad 1.11");
	unless (slice_2_tostr(ai[2..4]) eq "<2><3><4>") puts("bad 1.12");
	unless (slice_2_tostr(ai[3..3]) eq "<3>") puts("bad 1.13");
	unless (slice_2_tostr(ai[3..4]) eq "<3><4>") puts("bad 1.14");
	unless (slice_2_tostr(ai[4..4]) eq "<4>") puts("bad 1.15");

	s = slice_2_tostr(ai[0..3][0..2]);
	unless (s eq "<0><1><2>") puts("bad 2.1");
	s = slice_2_tostr(ai[0..3][0..2][0..1]);
	unless (s eq "<0><1>") puts("bad 2.2");
	s = slice_2_tostr(ai[0..3][0..2][0..1][0..0]);
	unless (s eq "<0>") puts("bad 2.3");

	s = slice_2_tostr(ai[1..3][0..2]);
	unless (s eq "<1><2><3>") puts("bad 3.1");
	s = slice_2_tostr(ai[1..3][0..1]);
	unless (s eq "<1><2>") puts("bad 3.2");
	s = slice_2_tostr(ai[1..3][0..2][0..2][0..2][0..2]);
	unless (s eq "<1><2><3>") puts("bad 3.3");

	/* Check expressions as slice indices. */
	s = slice_2_tostr(ai[1-1..2+1][0*10..2]);
	unless (s eq "<0><1><2>") puts("bad 4.1");
	s = slice_2_tostr(ai[1-1..ai[2..2][0]+1][0*10..ai[2]]);
	unless (s eq "<0><1><2>") puts("bad 4.2");

	/* Check slices of lists. */
	s = slice_2_tostr({0,1,2,3,4}[1..3]);
	unless (s eq "<1><2><3>") puts("bad 5.1");
}
slice_2();
} -output {}

test slice-2.1 {array slicing 2} -body {
#lang L --line=1
void slice_2_1()
{
	/*
	 * Althgouh probably not recommended style, these should work.
	 */

	struct s1 {
		int	i1, i2, i3, i4;
	} st1;
	struct s2 {
		int	i1, i2;
	} st2;

	st2 = (struct s2){1,2,3,4}[1..2];
	unless ((st2.i1 == 2) && (st2.i2 == 3)) puts("bad 1");

	st1 = { 5, 6, 7, 8 };
	st2 = (struct s2) ((int[])st1)[1..2];
	unless ((st2.i1 == 6) && (st2.i2 == 7)) puts("bad 2");
}
slice_2_1();
} -output {}

test slice-3 {array slice errors} -body {
#lang L --line=1
void slice_3()
{
	int	i;
	float	f;
	struct {
		int	i, j;
	} st;
	int	h{int};

	i = i[0..1];
	f = f[0..1];
	i = st[0..1];
	i = h[0..1];
}
} -returnCodes error -match regexp -result {.*10: L Error: illegal type for slice
.*11: L Error: illegal type for slice
.*12: L Error: illegal type for slice
.*13: L Error: illegal type for slice
}

test slice-4 {array slice index errors} -body {
#lang L --line=1
void slice_4()
{
	int	a[], i;
	float	f;

	i = a[0.0..1];
	i = a[0..1.0];
	i = a[0.0..1.0];
	i = a[f..1];
	i = a[0..f];
	i = a[f..f];
	i = a[a..a];

	a[0..1] = { 0, 1 };  // invalid l-value
}
} -returnCodes error -match regexp -result {.*6: L Error: first slice index not an int
.*7: L Error: second slice index not an int
.*8: L Error: first slice index not an int
.*8: L Error: second slice index not an int
.*9: L Error: first slice index not an int
.*10: L Error: second slice index not an int
.*11: L Error: first slice index not an int
.*11: L Error: second slice index not an int
.*12: L Error: first slice index not an int
.*12: L Error: second slice index not an int
.*14: L Error: invalid l-value in assignment
}

test end-1 {test END keyword for string indices} -body {
#lang L --line=1
int end_1_f(int end) {
	unless ("abc"[END] eq "c") puts("bad f.1");
	return (end);
}
void end_1()
{
	int	e1, e2, e3;
	string	s, s1, s2, s3;
	string	as[];

	/* Ensure END works and can be used in a full-blown expression. */
	s = "abcde";
	as[0] = "123";
	as[1] = "456";
	as[2] = "789";
	unless (s[END] eq "e") puts("bad 1.1");
	unless (s[END-1] eq "d") puts("bad 1.2");
	unless (s[END-2] eq "c") puts("bad 1.3");
	unless (s[END/2+2] eq "e") puts("bad 1.4");
	unless (s[end_1_f(END)/2+2] eq "e") puts("bad 1.5");
	unless (s[END-END+END-END+END*0+END] eq "e") puts("bad 1.6");
	unless ("xyz123"[END] eq "3") puts("bad 1.7");

	/*
	 * These check END for something that is represented on the
	 * run-time stack as an L deep-ptr (as[0]).
	 */
	unless (as[0][END] eq "3") puts("bad 1.8");
	unless (as[1][END] eq "6") puts("bad 1.9");
	unless (as[2][END] eq "9") puts("bad 1.10");

	/* Grab the value of END and verify it. */
	e1 = -1;
	s = "abcde";
	unless (s[0,e1=END] eq "e") puts("bad 2.1");
	unless (e1 == 4) puts("bad 2.2");
	e1 = -1;
	unless (s[e1=END,0] eq "a") puts("bad 2.3");
	unless (e1 == 4) puts("bad 2.4");

	/* Check nested ENDs. */
	e1 = e2 = -1;
	s1 = "abcde"[ s2="fgh"[e2=END], e1=END ];
	unless ((s1 eq "e") && (s2 eq "h")) puts("bad 3.1");
	unless ((e1 == 4) && (e2 == 2)) puts("bad 3.2");
	e1 = e2 = -1;
	s1 = "abcde"[ s2="fgh"[ s3="pqrstuvwxyz"[e3=END], e2=END ], e1=END ];
	unless ((s1 eq "e") && (s2 eq "h") && (s3 eq "z")) puts("bad 3.3");
	unless ((e1 == 4) && (e2 == 2) && (e3 == 10)) puts("bad 3.4");
}
end_1();
} -output {}

test end-2 {test END keyword for arrays} -body {
#lang L --line=1
int end_2_f(int end) {
	unless ({7,8,9}[END] == 9) puts("bad f.1");
	return (end);
}
int[] end_2_foo(int x) { return ({x,x+1,x+2}); }
void end_2()
{
	int	e1, e2, e3, i1, i2, i3;
	int	a[], aa[][];

	/* Ensure END works and can be used in a full-blown expression. */
	a = {1,2,3};
	unless (a[END] == 3) puts("bad 1.1");
	unless (a[END-1] == 2) puts("bad 1.2");
	unless (a[END-2] == 1) puts("bad 1.3");
	unless (a[END/2] == 2) puts("bad 1.4");
	unless (a[END/2+END/2] == 3) puts("bad 1.5");
	unless (a[END-END-END-END+END+END] == 1) puts("bad 1.6");
	unless (a[end_1_f(END)/2+1] == 3) puts("bad 1.7");
	unless ({1,2,3}[END] == 3) puts("bad 1.8");
	unless ({1,2,3}[END-1] == 2) puts("bad 1.9");
	unless ({1,2,3}[END-2] == 1) puts("bad 1.10");

	/*
	 * These check END for something that is represented on the
	 * run-time stack as an L deep-ptr (aa[0]).
	 */
	aa[0] = {4,5,6};
	aa[1] = {7,8,9};
	aa[2] = {10,11,12};
	unless (aa[0][END] == 6) puts("bad 2.1");
	unless (aa[1][END] == 9) puts("bad 2.2");
	unless (aa[2][END] == 12) puts("bad 2.3");

	/* Grab the value of END and verify it. */
	e1 = -1;
	a = {1,2,3};
	unless (a[0,e1=END] == 3) puts("bad 3.1");
	unless (e1 == 2) puts("bad 3.2");
	e1 = -1;
	unless (a[e1=END,0] == 1) puts("bad 3.3");
	unless (e1 == 2) puts("bad 3.4");
	e1 = -1;
	if (defined({}[e1=END])) puts("bad 3.5");
	unless (e1 == -1) puts("bad 3.6");

	/* Check nested ENDs. */
	e1 = e2 = e3 = -1;
	i1 = {1,2,3}[ i2={4,5,6,7}[e2=END], e1=END ];
	unless ((i1 == 3) && (i2 == 7)) puts("bad 4.1");
	unless ((e1 == 2) && (e2 == 3)) puts("bad 4.2");
	e1 = e2 = e3 = -1;
	i1 = {1,2,3}[ i2={4,5,6,7}[ i3={8,9}[e3=END], e2=END ], e1=END ];
	unless ((i1 == 3) && (i2 == 7) && (i3 == 9)) puts("bad 4.3");
	unless ((e1 == 2) && (e2 == 3) && (e3 == 1)) puts("bad 4.4");

	/* Some multiple ENDs. */
	aa = { {1,2,3}, {4,5,6}, {7,8,9}, {10,11,12} };
	e1 = e2 = -1;
	unless (aa[e1=END][e2=END] == 12) puts("bad 5.1");
	unless ((e1 == 3) && (e2 == 2)) puts("bad 5.2");

	/* Check a[f(END)[b..c]] */
	a = { 1,2,3 };
	e1 = -1;
	a[e1=end_2_foo(END+0)[0..1][0]];
	unless (e1 == 2) puts("bad 7.1");
}
end_2();
} -output {}

test end-3 {test END usage for string append} -body {
#lang L --line=1
void end_3()
{
	int	i;
	string	s;
	string	atoz="abcdefghijklmnopqrstuvwxyz";

	s = "";
	for (i = 0; i < 26; ++i) {
		s[END+1] = atoz[i];
	}
	for (i = 0; i < 26; ++i) {
		unless (s[i] eq atoz[i]) printf("bad 1.1 i=%d", i);
	}
	if (defined(s[i])) puts("bad 1.2");
	unless (s eq "abcdefghijklmnopqrstuvwxyz") puts("bad 1.3");
}
end_3();
} -output {}

test end-4 {test END usage for array append} -body {
#lang L --line=1
void end_4()
{
	int	e1, e2, i;
	int	a[], aa[][];

	a = {};
	for (i = 0; i < 100; ++i) {
		a[END+1] = i;
	}
	for (i = 0; i < 100; ++i) {
		unless (a[i] == i) printf("bad 1.1 i=%d\n", i);
	}
	if (defined(a[i])) puts("bad 1.2");

	aa = {};
	e1 = e2 = -2;
	aa[(e1=END)+1][(e2=END)+1] = 100;
	unless ((e1 == -1) && (e2 == -1)) puts("bad 2.1");
	unless (aa[e1=END][e2=END] == 100) puts("bad 2.2");
	unless ((e1 == 0) && (e2 == 0)) puts("bad 2.3");

	aa = {};
	for (i = 0; i < 10; ++i) {
		aa[END+1][END+1] = i;
		aa[END][END+1]   = 10*i;
	}
	for (i = 0; i < 10; ++i) {
		unless (aa[i][0] == i) puts("bad 3.1");
		unless (aa[i][1] == 10*i) puts("bad 3.2");
		if (defined(aa[i][2])) puts("bad 3.3");
	}
	if (defined(aa[i][0])) puts("bad 3.4");
}
end_4();
} -output {}

test end-5 {test END with recursion} -body {
#lang L --line=1
int end_5_f(int lim, int n)
{
	int	a[], e, i;

	/* Put n things into a[]. */
	for (i = 0; i < n; ++i) a[END+1] = i;

	if (n < lim) {
		/* e should get END+1; i.e., the # of things in a[] */
		a[e = (END+end_5_f(lim,n+1)+END)/2 + 1];
		unless (e == n) printf("bad n=%d, e=%d\n", n, e);
	}
	return (0);
}
void end_5()
{
	/*
	 * This test makes sure we can have lots of different ENDs all
	 * stacked up at once.
	 */
	end_5_f(100, 0);
}
end_5();
} -output {}

test end-6 {test END errors} -body {
#lang L --line=1
int END;  // err -- cannot declare global w/name "END"
void END() {}  // err -- cannot declare function w/name "END"
void end_6()
{
	int	END, i;  // err -- cannot declare variable w/name "END"
	string	h{int};

	i = END;  // err -- cannot use END outside of an array or string index
	h{END};   // err -- cannot use END in a hash index
}
} -returnCodes error -match regexp -result {.*1: L Error: cannot use END.*
.*2: L Error: cannot use END.*
.*5: L Error: cannot use END.*
.*8: L Error: END illegal.*
.*9: L Error: END illegal.*
}

test end-7 {test END in string slices} -body {
#lang L --line=1
void end_7()
{
	string	s;

	s = "123456789";
	unless (s[0..END] eq "123456789") puts("bad 1.0");
	unless (s[0..END] eq s) puts("bad 1.1");
	unless (s[1..END] eq "23456789") puts("bad 1.2");
	unless (s[2..END] eq "3456789") puts("bad 1.3");
	unless (s[2..END-1] eq "345678") puts("bad 1.4");
	unless (s[2..END-2] eq "34567") puts("bad 1.5");
	unless (s[END-1..END] eq "89") puts("bad 1.6");
	unless (s[END-1..END-1] eq "8") puts("bad 1.7");
}
end_7();
} -output {}

test end-8 {test END in array slices} -body {
#lang L --line=1
void end_8()
{
	string	a[];

	a = { "1", "2", "3", "4", "5", "6" };
	unless (join(" ", a[0..END]) eq "1 2 3 4 5 6") puts("bad 1.1");
	unless (join(" ", a[1..END]) eq "2 3 4 5 6") puts("bad 1.2");
	unless (join(" ", a[2..END]) eq "3 4 5 6") puts("bad 1.3");
	unless (join(" ", a[2..END-1]) eq "3 4 5") puts("bad 1.4");
	unless (join(" ", a[2..END-2]) eq "3 4") puts("bad 1.5");
	unless (join(" ", a[END-1..END]) eq "5 6") puts("bad 1.6");
	unless (join(" ", a[END-1..END-1]) eq "5") puts("bad 1.7");
}
end_8();
} -output {}

test end-10 {check END ignored in comma expression} -body {
#lang L --line=1
void end_10()
{
	int	i;
	int	a[] = {1,2,3};

	/*
	 * This tests that an ignored END does not leave anything on
	 * the run-time stack (which would case a crash).
	 */
	for (i = 0; i < 100; ++i) a[END,0];
}
end_10();
} -output {}

test end-11 {check deeply nested ENDs} -body {
#lang L
void end_11()
{
	/*
	 * Test that 40 ENDs can stack up.
	 */

	int	a[] = { 1, 0, 0 };
	int	i;

	i = a[END-1 + a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END-1 + a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END-1 + a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END-1 + a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END-1 + a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END-1 + a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END-1 + a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END-1 + a[END-1 + a[END-1 + a[END-1 +
	    a[END]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]];
	unless (i == 0) puts("bad");
}
end_11();
} -output {}

test end-12 {check END in various contexts} -body {
#lang L
int end_12f(int a, int b)
{
	unless (a == b) {
		puts("bad ${a} ${b}");
	}
	return (a);
}
void end_12()
{
	int	a[] = { 1, 2, 3 };
	int	i;
	struct {
		string	h{string}[];
	} st;

	// END in an arg list
	a[end_12f(END,2)];
	a[end_12f(2,END)];
	a[end_12f(END+0,2)];
	a[end_12f(2,0+END)];

	// END is an id, array index
	i = a[END];
	unless (i == 3) puts("bad 1");

	// END is an id, array slice
	a[0..(i=END)];
	unless (i == 2) puts("bad 2.1");
	a[(i=END)..END];
	unless (i == 2) puts("bad 2.2");

	// END in a unary op
	i = a[+END];
	unless (i == 3) puts("bad 3");

	// END in a binary op
	a[i=END+END];
	unless (i == 4) puts("bad 4");

	// END in a trinary op
	i = 0;
	a[END==2 ? (i=END) : (i=0)];
	unless (i == 2) puts("bad 5");

	// A regression test for a bug that used to crash the compiler
	// when it looked for END in an index expression that has a cast.
	push(&st.h{(string)0}, "x");
	push(&st.h{(string)0}, "y");
	push(&st.h{(string)0}, "z");
	unless (st.h{"0"} == {"x","y","z"}) puts("bad 6");
}
end_12();
} -output {}

test loop-1.0 {while loops} -body {
#lang L --line=1
void loop_1_0() {
        int i = 0;
        while (i++ < 5) puts (i);
        while (i) {
                int j = i--;
                puts(j);
        }
}
#lang tcl
loop_1_0
} -output "1\n2\n3\n4\n5\n6\n5\n4\n3\n2\n1\n"
test loop-1.1 {for loops} -body {
#lang L --line=1
void loop_1_1() {
        int i;
        for (i=1; i<7; i++) {
                puts(i);
        }
        puts("-*-");
        for ( ; i; i--) {
                puts(i);
        }
}
#lang tcl
loop_1_1
} -output "1\n2\n3\n4\n5\n6\n-*-\n7\n6\n5\n4\n3\n2\n1\n"

test loop-1.2 {do loops} -body {
#lang L --line=1
void loop_1_2()
{
	int	i;

	/* Do loops must iterate at least once. */
	i = 0;
	do {
		++i;
	} while (0);
	unless (i == 1) puts("bad 1");

	i = 0;
	do {
		++i;
		puts(i);
	} while (i < 4);
}
#lang tcl
loop_1_2
} -output "1\n2\n3\n4\n"

test loop-1.2.0 {simple foreach loops} -body {
#lang L --line=1
struct sl120 {
	int	i;
	int	j;
	string	s;
};
void
loop_1_2_0()
{
	int	k, vi;
	string	vs;
	float	vf;
	hash	h0 = { };
	hash	h1 = { 0=>1 };
	hash	h2 = { 0=>1, 1=>2 };
	hash	h3 = { 0=>1, 1=>2, 2=>3 };
	int	ai0[];
	int	ai1[1] = { 11 };
	int	ai2[2] = { 22, 23 };
	int	ai3[3] = { 33, 34, 35 };
	string	as0[0];
	string	as1[1] = { "a" };
	string	as2[2] = { "b", "c" };
	string	as3[3] = { "d", "e", "f" };
	float	af0[0];
	float	af1[1] = { 1.1 };
	float	af2[2] = { 2.1, 2.2 };
	float	af3[3] = { 3.1, 3.2, 3.3 };
	struct sl120	vc;
	struct sl120	ac[3];

	printf("start\n");
	foreach (k in h0) {
		printf("h0 has %d\n", k);
	}
	foreach (k in h1) {
		printf("h1 has %d\n", k);
	}
	foreach (k in h2) {
		printf("h2 has %d\n", k);
	}
	foreach (k in h3) {
		printf("h3 has %d\n", k);
	}
	foreach (k=>vi in h0) {
		printf("h0 has %d=>%d\n", k, vi);
	}
	foreach (k=>vi in h1) {
		printf("h1 has %d=>%d\n", k, vi);
	}
	foreach (k=>vi in h2) {
		printf("h2 has %d=>%d\n", k, vi);
	}
	foreach (k=>vi in h3) {
		printf("h3 has %d=>%d\n", k, vi);
	}
	foreach (vi in ai0) {
		printf("ai0 has %d\n", vi);
	}
	foreach (vi in ai1) {
		printf("ai1 has %d\n", vi);
	}
	foreach (vi in ai2) {
		printf("ai2 has %d\n", vi);
	}
	foreach (vi in ai3) {
		printf("ai3 has %d\n", vi);
	}
	foreach (vs in as0) {
		printf("as0 has %s\n", vs);
	}
	foreach (vs in as1) {
		printf("as1 has %s\n", vs);
	}
	foreach (vs in as2) {
		printf("as2 has %s\n", vs);
	}
	foreach (vs in as3) {
		printf("as3 has %s\n", vs);
	}
	foreach (vf in af0) {
		printf("af0 has %1.1f\n", vf);
	}
	foreach (vf in af1) {
		printf("af1 has %1.1f\n", vf);
	}
	foreach (vf in af2) {
		printf("af2 has %1.1f\n", vf);
	}
	foreach (vf in af3) {
		printf("af3 has %1.1f\n", vf);
	}
	foreach (vf in ai0) {
		printf("ai0 has %1.1f\n", vf);
	}
	foreach (vf in ai1) {
		printf("ai1 has %1.1f\n", vf);
	}
	foreach (vf in ai2) {
		printf("ai2 has %1.1f\n", vf);
	}
	foreach (vf in ai3) {
		printf("ai3 has %1.1f\n", vf);
	}
	ac[0].i = 1;
	ac[0].j = 2;
	ac[0].s = "a";
	ac[1].i = 11;
	ac[1].j = 22;
	ac[1].s = "aa";
	ac[2].i = 111;
	ac[2].j = 222;
	ac[2].s = "aaa";
	foreach (vc in ac) {
		printf("ac has %d,%d,%s\n", vc.i, vc.j, vc.s);
	}
	printf("end\n");
}
#lang tcl
loop_1_2_0
} -output "start
h1 has 0
h2 has 0
h2 has 1
h3 has 0
h3 has 1
h3 has 2
h1 has 0=>1
h2 has 0=>1
h2 has 1=>2
h3 has 0=>1
h3 has 1=>2
h3 has 2=>3
ai1 has 11
ai2 has 22
ai2 has 23
ai3 has 33
ai3 has 34
ai3 has 35
as1 has a
as2 has b
as2 has c
as3 has d
as3 has e
as3 has f
af1 has 1.1
af2 has 2.1
af2 has 2.2
af3 has 3.1
af3 has 3.2
af3 has 3.3
ai1 has 11.0
ai2 has 22.0
ai2 has 23.0
ai3 has 33.0
ai3 has 34.0
ai3 has 35.0
ac has 1,2,a
ac has 11,22,aa
ac has 111,222,aaa
end
"

test loop-1.2.1 {foreach loops over arrays of arrays} -body {
#lang L --line=1
void
loop_121_fill2(int d1, int d2, int &a[][])
{
	int	i, j;

	for (i = 0; i < d1; ++i) {
		for (j = 0; j < d2; ++j) {
			a[i][j] = i*10 + j;
		}
	}
}

void
loop_121_fill3(int d1, int d2, int d3, int &a[][][])
{
	int	i, j, k;

	for (i = 0; i < d1; ++i) {
		for (j = 0; j < d2; ++j) {
			for (k = 0; k < d3; ++k) {
				a[i][j][k] = i*100 + j*10 + k;
			}
		}
	}
}

void
loop_1_2_1()
{
	int	vi;
	int	ai[3];
	int	aii[4][3];
	int	aiii[5][4][3];

	loop_121_fill2(4, 3, &aii);
	loop_121_fill3(5, 4, 3, &aiii);

	printf("test 1\n");
	foreach (ai in aii) {
		foreach (vi in ai) {
			printf("aii has %d\n", vi);
		}
	}

	printf("test 2\n");
	foreach (aii in aiii) {
		foreach (ai in aii) {
			foreach (vi in ai) {
				printf("aiii has %d\n", vi);
			}
		}
	}

	printf("end\n");
}
loop_1_2_1();
} -output "test 1
aii has 0
aii has 1
aii has 2
aii has 10
aii has 11
aii has 12
aii has 20
aii has 21
aii has 22
aii has 30
aii has 31
aii has 32
test 2
aiii has 0
aiii has 1
aiii has 2
aiii has 10
aiii has 11
aiii has 12
aiii has 20
aiii has 21
aiii has 22
aiii has 30
aiii has 31
aiii has 32
aiii has 100
aiii has 101
aiii has 102
aiii has 110
aiii has 111
aiii has 112
aiii has 120
aiii has 121
aiii has 122
aiii has 130
aiii has 131
aiii has 132
aiii has 200
aiii has 201
aiii has 202
aiii has 210
aiii has 211
aiii has 212
aiii has 220
aiii has 221
aiii has 222
aiii has 230
aiii has 231
aiii has 232
aiii has 300
aiii has 301
aiii has 302
aiii has 310
aiii has 311
aiii has 312
aiii has 320
aiii has 321
aiii has 322
aiii has 330
aiii has 331
aiii has 332
aiii has 400
aiii has 401
aiii has 402
aiii has 410
aiii has 411
aiii has 412
aiii has 420
aiii has 421
aiii has 422
aiii has 430
aiii has 431
aiii has 432
end
"

test loop-1.2.2 {foreach with int variable lists} -body {
#lang L --line=1
void
loop_1_2_2()
{
	int	i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12;
	int	a[12] = { 1,2,3,4,5,6,7,8,9,10,11,12 };

	printf("test 1\n");
	foreach (i1 in a) {
		printf("a has %d\n", i1);
	}
	printf("test 2\n");
	foreach (i1,i2 in a) {
		printf("a has %d,%d\n", i1, i2);
	}
	printf("test 3\n");
	foreach (i1,i2,i3 in a) {
		printf("a has %d,%d,%d\n", i1, i2, i3);
	}
	printf("test 4\n");
	foreach (i1,i2,i3,i4 in a) {
		printf("a has %d,%d,%d,%d\n", i1, i2, i3, i4);
	}
	printf("test 5\n");
	foreach (i1,i2,i3,i4,i5,i6 in a) {
		printf("a has %d,%d,%d,%d,%d,%d\n", i1, i2, i3, i4, i5, i6);
	}
	printf("test 6\n");
	foreach (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12 in a) {
		printf("a has %d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d\n",
		       i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12);
	}
	printf("end\n");
}
loop_1_2_2();
} -output "test 1
a has 1
a has 2
a has 3
a has 4
a has 5
a has 6
a has 7
a has 8
a has 9
a has 10
a has 11
a has 12
test 2
a has 1,2
a has 3,4
a has 5,6
a has 7,8
a has 9,10
a has 11,12
test 3
a has 1,2,3
a has 4,5,6
a has 7,8,9
a has 10,11,12
test 4
a has 1,2,3,4
a has 5,6,7,8
a has 9,10,11,12
test 5
a has 1,2,3,4,5,6
a has 7,8,9,10,11,12
test 6
a has 1,2,3,4,5,6,7,8,9,10,11,12
end
"

test loop-1.2.3 {foreach with string variable lists} -body {
#lang L --line=1
void
loop_1_2_3()
{
	string	s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14;
	string	a[12] = { "a","b","c","d","e","f","g","h","i","j","k","l" };

	printf("test 1\n");
	foreach (s1 in a) {
		printf("a has %s\n", s1);
	}
	printf("test 2\n");
	foreach (s1,s2 in a) {
		printf("a has %s,%s\n", s1, s2);
	}
	printf("test 3\n");
	foreach (s1,s2,s3 in a) {
		printf("a has %s,%s,%s\n", s1, s2, s3);
	}
	printf("test 4\n");
	foreach (s1,s2,s3,s4 in a) {
		printf("a has %s,%s,%s,%s\n", s1, s2, s3, s4);
	}
	printf("test 5\n");
	foreach (s1,s2,s3,s4,s5,s6 in a) {
		printf("a has %s,%s,%s,%s,%s,%s\n", s1, s2, s3, s4, s5, s6);
	}
	printf("test 6\n");
	foreach (s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12);
	}

	/*
	 * The following tests have a number of loop variables that
	 * isn't divisible by the number of list elements.  On the
	 * last iteration, the stragglers should get undef.
	 */

	printf("test 7\n");
	foreach (s1,s2,s3,s4,s5 in a) {
		printf("a has %s,%s,%s,%s,%s\n", s1, s2, s3, s4, s5);
		if (s1 eq "k") {
			unless (defined(s2)) puts("bad 1.1");
			if (defined(s3)) puts("bad 1.2");
			if (defined(s4)) puts("bad 1.3");
			if (defined(s5)) puts("bad 1.4");
		}
	}

	printf("test 8\n");
	foreach (s1,s2,s3,s4,s5,s6,s7 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7);
		if (s1 eq "h") {
			unless (defined(s2)) puts("bad 2.1");
			unless (defined(s3)) puts("bad 2.2");
			unless (defined(s4)) puts("bad 2.3");
			unless (defined(s5)) puts("bad 2.4");
			if (defined(s6)) puts("bad 2.5");
			if (defined(s7)) puts("bad 2.6");
		}
	}

	printf("test 9\n");
	foreach (s1,s2,s3,s4,s5,s6,s7,s8 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7, s8);
		if (s1 eq "i") {
			unless (defined(s2)) puts("bad 3.1");
			unless (defined(s3)) puts("bad 3.2");
			unless (defined(s4)) puts("bad 3.3");
			if (defined(s5)) puts("bad 3.4");
			if (defined(s6)) puts("bad 3.5");
			if (defined(s7)) puts("bad 3.6");
			if (defined(s8)) puts("bad 3.7");
		}
	}

	printf("test 10\n");
	foreach (s1,s2,s3,s4,s5,s6,s7,s8,s9 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7, s8, s9);
		if (s1 eq "j") {
			unless (defined(s2)) puts("bad 4.1");
			unless (defined(s3)) puts("bad 4.2");
			if (defined(s4)) puts("bad 4.3");
			if (defined(s5)) puts("bad 4.4");
			if (defined(s6)) puts("bad 4.5");
			if (defined(s7)) puts("bad 4.6");
			if (defined(s8)) puts("bad 4.7");
			if (defined(s9)) puts("bad 4.8");
		}
	}

	printf("test 11\n");
	foreach (s1,s2,s3,s4,s5,s6,s7,s8,s9,s10 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7, s8, s9, s10);
		if (s1 eq "k") {
			unless (defined(s2)) puts("bad 4.1");
			if (defined(s3)) puts("bad 4.2");
			if (defined(s4)) puts("bad 4.3");
			if (defined(s5)) puts("bad 4.4");
			if (defined(s6)) puts("bad 4.5");
			if (defined(s7)) puts("bad 4.6");
			if (defined(s8)) puts("bad 4.7");
			if (defined(s9)) puts("bad 4.8");
			if (defined(s10)) puts("bad 4.9");
		}
	}

	printf("test 12\n");
	foreach (s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11);
		if (s1 eq "l") {
			if (defined(s2)) puts("bad 5.1");
			if (defined(s3)) puts("bad 5.2");
			if (defined(s4)) puts("bad 5.3");
			if (defined(s5)) puts("bad 5.4");
			if (defined(s6)) puts("bad 5.5");
			if (defined(s7)) puts("bad 5.6");
			if (defined(s8)) puts("bad 5.7");
			if (defined(s9)) puts("bad 5.8");
			if (defined(s10)) puts("bad 5.9");
			if (defined(s11)) puts("bad 5.10");
		}
	}

	printf("test 13\n");
	foreach (s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13);
		unless (defined(s2)) puts("bad 6.1");
		unless (defined(s3)) puts("bad 6.2");
		unless (defined(s4)) puts("bad 6.3");
		unless (defined(s5)) puts("bad 6.4");
		unless (defined(s6)) puts("bad 6.5");
		unless (defined(s7)) puts("bad 6.6");
		unless (defined(s8)) puts("bad 6.7");
		unless (defined(s9)) puts("bad 6.8");
		unless (defined(s10)) puts("bad 6.9");
		unless (defined(s11)) puts("bad 6.10");
		unless (defined(s12)) puts("bad 6.11");
		if (defined(s13)) puts("bad 6.12");
	}

	printf("test 14\n");
	foreach (s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14 in a) {
		printf("a has %s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s\n",
		       s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13,
		       s14);
		unless (defined(s2)) puts("bad 7.1");
		unless (defined(s3)) puts("bad 7.2");
		unless (defined(s4)) puts("bad 7.3");
		unless (defined(s5)) puts("bad 7.4");
		unless (defined(s6)) puts("bad 7.5");
		unless (defined(s7)) puts("bad 7.6");
		unless (defined(s8)) puts("bad 7.7");
		unless (defined(s9)) puts("bad 7.8");
		unless (defined(s10)) puts("bad 7.9");
		unless (defined(s11)) puts("bad 7.10");
		unless (defined(s12)) puts("bad 7.11");
		if (defined(s13)) puts("bad 7.12");
		if (defined(s14)) puts("bad 7.13");
	}

	printf("end\n");
}
loop_1_2_3();
} -output "test 1
a has a
a has b
a has c
a has d
a has e
a has f
a has g
a has h
a has i
a has j
a has k
a has l
test 2
a has a,b
a has c,d
a has e,f
a has g,h
a has i,j
a has k,l
test 3
a has a,b,c
a has d,e,f
a has g,h,i
a has j,k,l
test 4
a has a,b,c,d
a has e,f,g,h
a has i,j,k,l
test 5
a has a,b,c,d,e,f
a has g,h,i,j,k,l
test 6
a has a,b,c,d,e,f,g,h,i,j,k,l
test 7
a has a,b,c,d,e
a has f,g,h,i,j
a has k,l,,,
test 8
a has a,b,c,d,e,f,g
a has h,i,j,k,l,,
test 9
a has a,b,c,d,e,f,g,h
a has i,j,k,l,,,,
test 10
a has a,b,c,d,e,f,g,h,i
a has j,k,l,,,,,,
test 11
a has a,b,c,d,e,f,g,h,i,j
a has k,l,,,,,,,,
test 12
a has a,b,c,d,e,f,g,h,i,j,k
a has l,,,,,,,,,,
test 13
a has a,b,c,d,e,f,g,h,i,j,k,l,
test 14
a has a,b,c,d,e,f,g,h,i,j,k,l,,
end
"

test loop-1.2.4 {foreach loops with large loop body (>127 bytes of bytecode)} -body {
#lang L --line=1
void
loop_1_2_4()
{
	int	i, k, v;
	int	a[3] = { 1,2,3 };
	hash	h = { 1=>2, 2=>3, 3=>4 };

	printf("start\n");
	foreach (i in a) {
		/* Just do whatever to rack up bytecodes. */
		int	x = 1, y = 1, z = 1;
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19) puts("bad 1.1");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199) puts("bad 1.2");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999) puts("bad 1.3");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999) puts("bad 1.4");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999) puts("bad 1.5");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999) puts("bad 1.6");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999999) puts("bad 1.7");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999999) puts("bad 1.8");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999999) puts("bad 1.9");
		x = y = z = 1;
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19) puts("bad 2.1");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199) puts("bad 2.2");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999) puts("bad 2.3");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999) puts("bad 2.4");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999) puts("bad 2.5");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999) puts("bad 2.6");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999999) puts("bad 2.7");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999999) puts("bad 2.8");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999999) puts("bad 2.9");
		printf("a has %d\n", i);
	}
	foreach (k=>v in h) {
		/* Just do whatever to rack up bytecodes. */
		int	x = 1, y = 1, z = 1;
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19) puts("bad 3.1");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199) puts("bad 3.2");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999) puts("bad 3.3");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999) puts("bad 3.4");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999) puts("bad 3.5");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999) puts("bad 3.6");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999999) puts("bad 3.7");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999999) puts("bad 3.8");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999999) puts("bad 3.9");
		x = y = z = 1;
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19) puts("bad 4.1");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199) puts("bad 4.2");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999) puts("bad 4.3");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999) puts("bad 4.4");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999) puts("bad 4.5");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999) puts("bad 4.6");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 19999999) puts("bad 4.7");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 199999999) puts("bad 4.8");
		x = x+y*z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y+z+x*y;
		unless (x == 1999999999) puts("bad 4.9");
		printf("h has %d=>%d\n", k, v);
	}
	printf("end\n");
}
loop_1_2_4();
} -output "start
a has 1
a has 2
a has 3
h has 1=>2
h has 2=>3
h has 3=>4
end
"

test loop-1.2.5 {check hash foreach type checking} -body {
#lang L --line=1
void loop_1_2_5()
{
	int	i1, i2;
	string	s1, s2;
	string	h{int};

	foreach (s1=>s2 in h) ;
	foreach (s1=>i2 in h) ;
	foreach (i1=>i2 in h) ;
}
#lang tcl
} -returnCodes error -match regexp -result {.*7: L Error: loop index key type incompatible.*
.*8: L Error: loop index value type incompatible.*
.*8: L Error: loop index key type incompatible.*
.*9: L Error: loop index value type incompatible.*
}

test loop-1.2.6 {test foreach over string} -body {
#lang L --line=1
void loop_1_2_6()
{
	int	i;
	string	a, b, c, d;
	string	as[];
	poly	p;

	a = "x";
	foreach (a in "") puts("bad 1.1");
	if (defined(a)) puts("bad 1.2");

	/* as[0] has the value undef */
	a = "x";
	if (defined(as[0])) puts("bad 2.0");
	foreach(a in as[0]) puts("bad 2.1");
	if (defined(a)) puts("bad 2.2");

	i = 0;
	foreach(a in "0123456789") {
		unless (a eq (string)i++) printf("bad 2.1 i=%d\n", i);
	}
	i = 0;
	foreach(p in "0123456789") {
		unless (p eq (string)i++) printf("bad 2.2 i=%d\n", i);
	}
	i = 0;
	foreach(a,b in "0123456789") {
		unless (a eq (string)i++) printf("bad 3.1 i=%d\n", i);
		unless (b eq (string)i++) printf("bad 3.2 i=%d\n", i);
	}
	i = 0;
	foreach(a,b,c in "0123456789") {
		unless (a eq (string)i++) printf("bad 4.1 i=%d\n", i);
		if (i == 10) {
			if (defined(b)) puts("bad 4.2 b undef");
			if (defined(c)) puts("bad 4.2 c undef");
		} else {
			unless (b eq (string)i++) printf("bad 4.3 i=%d\n", i);
			unless (c eq (string)i++) printf("bad 4.4 i=%d\n", i);
		}
	}
	i = 0;
	foreach(a,b,c,d in "0123456789") {
		unless (a eq (string)i++) printf("bad 5.1 i=%d\n", i);
		unless (b eq (string)i++) printf("bad 5.2 i=%d\n", i);
		if (i == 10) {
			if (defined(c)) puts("bad 5.2 b undef");
			if (defined(d)) puts("bad 5.2 c undef");
		} else {
			unless (c eq (string)i++) printf("bad 5.3 i=%d\n", i);
			unless (d eq (string)i++) printf("bad 5.4 i=%d\n", i);
		}
	}
}
loop_1_2_6();
} -output {}

test loop-1.2.7 {test foreach over string type errors} -body {
#lang L --line=1
class loop_1_2_7_class {}
void loop_1_2_7()
{
	int	i;
	float	f;
	int	a[];
	int	h{int};
	loop_1_2_7_class o;
	struct { int i,j; } st;

	foreach(i in "string") {}
	foreach(f in "string") {}
	foreach(h in "string") {}
	foreach(a in "string") {}
	foreach(o in "string") {}
	foreach(st in "string") {}
}
} -returnCodes error -match regexp -result {.*11: L Error: loop index not of string type
.*12: L Error: loop index not of string type
.*13: L Error: loop index not of string type
.*14: L Error: loop index not of string type
.*15: L Error: loop index not of string type
.*16: L Error: loop index not of string type
}

test loop-1.2.7.1 {test foreach over <> errors} -body {
#lang L --line=1
void loop_1_2_7_1()
{
	int	i;
	string	s;
	FILE	f;

	foreach(s in <>) {}
	foreach(s in <f>) {}
	foreach(s in <1>) {}
	foreach(i in <s>) {}
	foreach(s,i in <s>) {}
	foreach(i,s in <s>) {}
	foreach(s,i,s in <s>) {}
}
loop_1_2_7_1();
} -returnCodes error -match regexp -result {.*7: L Error: this form is disallowed; did you mean while \(buf = <>\)\?
.*8: L Error: this form is disallowed; did you mean while \(buf = <F>\)\?
.*9: L Error: in foreach, arg to <> must be a string
.*10: L Error: loop index i not of string type
.*11: L Error: loop index i not of string type
.*12: L Error: loop index i not of string type
}

test loop-1.2.8 {test foreach type errors} -body {
#lang L --line=1 -nowarn
void loop_1_2_8()
{
	int	i;
	float	f;
	string	s;
	poly	p;
	struct { int i,j; } st;

	foreach(s in p) ;
	foreach(s in st) ;
	foreach(s in {1}) ;
	foreach(s in {1,2}) ;
	foreach(s in {"s",1}) ;
	foreach(s in {1,"s"}) ;
	foreach(i,f in {1.0,2.0});
	foreach(f,i in {1.0,2.0});

	/* This could be made to work, but at present it's a type error. */
	foreach(i,s in {1,"a"});
}
} -returnCodes error -match regexp -result {.*9: L Error: foreach expression must be array, hash, or string
.*10: L Error: foreach expression must be array, hash, or string
.*11: L Error: loop index type incompatible with array element type
.*12: L Error: loop index type incompatible with array element type
.*13: L Error: loop index type incompatible with array element type
.*14: L Error: loop index type incompatible with array element type
.*15: L Error: loop index type incompatible with array element type
.*16: L Error: loop index type incompatible with array element type
.*19: L Error: loop index type incompatible with array element type
}

test loop-1.2.9 {test foreach syntax errors} -body {
#lang L --line=1
void loop_1_2_9()
{
	string	k, v;
	string	h{string};

	/*
	 * This test was added after un-reserving the keyword "in",
	 * used in foreach loops.  In the grammar, "in" was replaced
	 * with an id.  Verify that using anything other than "in" is
	 * a syntax error.
	 */

	foreach (k=>v bad h) ;
}
} -returnCodes error -match glob -result {*13: L Error: syntax error*
	foreach (k=>v bad h) ;
                      ^
}

test loop-1.2.10 {test foreach syntax errors} -body {
#lang L --line=1
void loop_1_2_10()
{
	string	k, v;
	string	h{string};

	/*
	 * Second part of above test (we can test only one syntax
	 * error at a time).
	 */

	foreach (k bad "xyz") ;
}
} -returnCodes error -match glob -result {*11: L Error: syntax error*
	foreach (k bad "xyz") ;
                   ^
}

test loop-1.2.10.1 {test foreach usage errors} -body {
#lang L --line=1 -nowarn
void loop_1_2_10_1()
{
	string	k, s, v;
	string	a[];

	/* These are all errors. */

	foreach (k=>v in a) {}
	foreach (k=>v in s) {}
}
} -returnCodes error -match glob -result {*8: L Error: => illegal in foreach over arrays
*9: L Error: => illegal in foreach over strings
}

test loop-1.2.11 {test that "in" is not reserved} -body {
#lang L --line=1
void loop_1_2_11()
{
	/*
	 * Verify that "in" is no longer a reserved word.
	 */

	int	in = 123;
	unless (in == 123) puts("bad");
}
loop_1_2_11();
} -output {}

test loop-1.2.12 {check that loop counter is undef on foreach loop fall-through} -body {
#lang L --line=1
void loop_1_2_12()
{
	int	i;
	string	k, s, t, u, v;
	string	as[];
	string	ah{string};

	s = "abc";
	i = 0;
	t = "xyz";
	unless (defined(t)) puts("bad 1.1");
	foreach (t in s) { ++i; }
	unless (i == 3) puts("bad 1.2");
	if (defined(t)) puts("bad 1.3");

	s = "abcd";
	i = 0;
	t = u = "xyz";
	unless (defined(t) && defined(u)) puts("bad 2.1");
	foreach (t,u in s) { ++i; }
	unless (i == 2) puts("bad 2.2");
	if (defined(t) || defined(u)) puts("bad 2.3");

	as = { "1", "2", "3" };
	i = 0;
	s = "xyz";
	unless (defined(s)) puts("bad 2.1");
	foreach (s in as) { ++i; }
	unless (i == 3) puts("bad 3.2");
	if (defined(s)) puts("bad 3.3");

	as = { "1", "2", "3", "4" };
	i = 0;
	s = t = "xyz";
	unless (defined(s) && defined(t)) puts("bad 4.1");
	foreach (s,t in as) { ++i; }
	unless (i == 2) puts("bad 4.2");
	if (defined(s) || defined(t)) puts("bad 4.3");

	ah = { "k1"=>"1", "k2"=>"2", "k3"=>"3" };
	i = 0;
	k = "xyz";
	unless (defined(k)) puts("bad 5.1");
	foreach (k in ah) { ++i; }
	unless (i == 3) puts("bad 5.2");
	if (defined(k)) puts("bad 5.3");

	i = 0;
	k = "xyz";
	v = "qrs";
	unless (defined(k) && defined(v)) puts("bad 4.1");
	foreach (k=>v in ah) { ++i; }
	unless (i == 3) puts("bad 4.2");
	if (defined(k) || defined(v)) puts("bad 4.3");
}
loop_1_2_12();
} -output {}

test loop-1.2.13 {test foreach over a list type} -body {
#lang L --line=1
private int equals(poly a[], poly b[])
{
	unless (length(a) == length(b)) return (0);
	while (defined(a[0])) {
		unless (defined(a[0]) == defined(b[0])) return (0);
		unless (a[0] == b[0]) return (0);
		// shift
		undef(a[0]);
		undef(b[0]);
	}
	assert(!defined(b[0]));
	return (1);
}

void loop_1_2_13()
{
	int	i, i2, i3, ai[];
	string	s, s2, s3, as[];
	float	f, f2, f3, af[];

	/* First do a quick test of the equals() helper function. */
	ai = {1,2,3};
	unless (equals(ai, {1,2,3})) puts("bad 0.1");
	if (equals(ai, {1,2})) puts("bad 0.2");
	if (equals(ai, {1,2,3,4})) puts("bad 0.3");
	if (equals(ai, {1,3,2})) puts("bad 0.4");
	as = {"a","b","c"};
	unless (equals(as, {"a","b","c"})) puts("bad 0.5");
	if (equals(as, {"a","b"})) puts("bad 0.6");
	if (equals(as, {"a","b","c","d"})) puts("bad 0.7");
	if (equals(as, {"a","c","b"})) puts("bad 0.8");
	af = {1, 2.2, 3};
	unless (equals(af, {1,2.2,3})) puts("bad 0.9");
	if (equals(af, {1,2.2})) puts("bad 0.10");
	if (equals(af, {1,2.2,3,4})) puts("bad 0.11");
	if (equals(af, {1,3,2.2})) puts("bad 0.12");

	undef(ai);
	foreach (i in {1}) push(&ai, i);
	unless (equals(ai, {1})) puts("bad 1.1");

	undef(ai);
	foreach (i in {1,2}) push(&ai, i);
	unless (equals(ai, {1,2})) puts("bad 2.1");

	undef(ai);
	foreach (i in {1,2,3}) push(&ai, i);
	unless (equals(ai, {1,2,3})) puts("bad 3.1");

	undef(ai);
	foreach (i,i2 in {1,2,3}) {
		push(&ai, i);
		if (defined(i2)) push(&ai, i2);
	}
	unless (equals(ai, {1,2,3})) puts("bad 4.1");

	undef(ai);
	foreach (i,i2,i3 in {1,2,3}) {
		push(&ai, i);
		push(&ai, i2);
		push(&ai, i3);
	}
	unless (equals(ai, {1,2,3})) puts("bad 5.1");

	undef(as);
	foreach (s in {"a"}) push(&as, s);
	unless (equals(as, {"a"})) puts("bad 10.1");

	undef(as);
	foreach (s in {"a","b"}) push(&as, s);
	unless (equals(as, {"a","b"})) puts("bad 10.2");

	undef(as);
	foreach (s in {"a","b","c"}) push(&as, s);
	unless (equals(as, {"a","b","c"})) puts("bad 10.3");

	undef(as);
	foreach (s,s2 in {"a","b","c"}) {
		push(&as, s);
		if (defined(s2)) push(&as, s2);
	}
	unless (equals(as, {"a","b","c"})) puts("bad 10.4");

	undef(as);
	foreach (s,s2,s3 in {"a","b","c"}) {
		push(&as, s);
		push(&as, s2);
		push(&as, s3);
	}
	unless (equals(as, {"a","b","c"})) puts("bad 10.5");

	undef(af);
	foreach (f in {1}) push(&af, f);
	unless (equals(af, {1})) puts("bad 20.1");

	undef(af);
	foreach (f in {1.1}) push(&af, f);
	unless (equals(af, {1.1})) puts("bad 20.2");

	undef(af);
	foreach (f in {1.1,2}) push(&af, f);
	unless (equals(af, {1.1,2})) puts("bad 20.3");

	undef(af);
	foreach (f in {1.1,2,3.3}) push(&af, f);
	unless (equals(af, {1.1,2,3.3})) puts("bad 20.4");

	undef(af);
	foreach (f,f2 in {1.1,2,3.3}) {
		push(&af, f);
		if (defined(f2)) push(&af, f2);
	}
	unless (equals(af, {1.1,2,3.3})) puts("bad 20.5");

	undef(af);
	foreach (f,f2,f3 in {1.1,2,3.3}) {
		push(&af, f);
		push(&af, f2);
		push(&af, f3);
	}
	unless (equals(af, {1.1,2,3.3})) puts("bad 20.6");
}
loop_1_2_13();
} -output {}

test loop-1.2.14 {test empty condition in for statement} -body {
#lang L --line=1
void loop_1_2_14()
{
	int	i = 0;

	for (;; ++i) {
		break;
	}
	unless (i == 0) puts("bad 1");

	i = 0;
	for (;;) {
		++i;
		break;
	}
	unless (i == 1) puts("bad 2");
}
loop_1_2_14();
} -output {}

test loop-1.2.15 {test foreach <string>} -body {
#lang L
string l1_2_15(string s)
{
	string	t, ret = "";

	foreach (t in <s>) ret .= "<${t?t:'undef'}>";
	if (t) puts("bad l1_2_15");
	return (ret);
}
string l1_2_15_2(string s)
{
	string	t1, t2, ret = "";

	foreach (t1,t2 in <s>) ret .= "<${t1?t1:'undef'}>[${t2?t2:'undef'}]";
	if (t1 || t2) puts("bad l1_2_15_2");
	return (ret);
}
string l1_2_15_3(string s)
{
	string	t1, t2, t3, ret = "";

	foreach (t1,t2,t3 in <s>) {
		ret .= "<${t1?t1:'undef'}>[${t2?t2:'undef'}]{${t3?t3:'undef'}}";
	}
	if (t1 || t2 || t3) puts("bad l1_2_15_3");
	return (ret);
}
void loop_1_2_15()
{
	string	s, t;

	/* Check a stride of 1, \n line endings. */

	unless (l1_2_15(undef) == "") puts("bad 1.1");
	unless (l1_2_15("") == "") puts("bad 1.2");

	unless (l1_2_15("l1") == "<l1>") puts("bad 2.1");
	unless (l1_2_15("l1\n") == "<l1>") puts("bad 2.2");

	unless (l1_2_15("l1\nl2") == "<l1><l2>") puts("bad 3.1");
	unless (l1_2_15("l1\nl2\n") == "<l1><l2>") puts("bad 3.2");

	unless (l1_2_15("l1\nl2\nl3") == "<l1><l2><l3>") puts("bad 4.1");
	unless (l1_2_15("l1\nl2\nl3\n") == "<l1><l2><l3>") puts("bad 4.2");

	/* Check a stride of 1, \r\n line endings. */

	unless (l1_2_15("l1\r\n") == "<l1>") puts("bad 5.1");

	unless (l1_2_15("l1\r\nl2") == "<l1><l2>") puts("bad 6.1");
	unless (l1_2_15("l1\r\nl2\r\n") == "<l1><l2>") puts("bad 6.2");

	unless (l1_2_15("l1\r\nl2\r\nl3") == "<l1><l2><l3>") puts("bad 7.1");
	unless (l1_2_15("l1\r\nl2\r\nl3\r\n") == "<l1><l2><l3>") puts("bad 7.2");

	/* Check a stride of 2, \n line endings. */

	unless (l1_2_15_2(undef) == "") puts("bad 10.1");
	unless (l1_2_15_2("") == "") puts("bad 10.2");

	unless (l1_2_15_2("l1") == "<l1>[undef]") puts("bad 11.1");
	unless (l1_2_15_2("l1\n") == "<l1>[undef]") puts("bad 11.2");

	unless (l1_2_15_2("l1\nl2") == "<l1>[l2]") puts("bad 12.1");
	unless (l1_2_15_2("l1\nl2\n") == "<l1>[l2]") puts("bad 12.2");

	unless (l1_2_15_2("l1\nl2\nl3") == "<l1>[l2]<l3>[undef]") {
		puts("bad 13.1");
	}
	unless (l1_2_15_2("l1\nl2\nl3\n") == "<l1>[l2]<l3>[undef]") {
		puts("bad 13.2");
	}

	unless (l1_2_15_2("l1\nl2\nl3\nl4") == "<l1>[l2]<l3>[l4]") {
		puts("bad 14.1");
	}
	unless (l1_2_15_2("l1\nl2\nl3\nl4\n") == "<l1>[l2]<l3>[l4]") {
		puts("bad 14.2");
	}

	/* Check a stride of 2, \r\n line endings. */

	unless (l1_2_15_2("l1\r\n") == "<l1>[undef]") puts("bad 15.1");

	unless (l1_2_15_2("l1\r\nl2") == "<l1>[l2]") puts("bad 16.1");
	unless (l1_2_15_2("l1\r\nl2\r\n") == "<l1>[l2]") puts("bad 16.2");

	unless (l1_2_15_2("l1\r\nl2\r\nl3") == "<l1>[l2]<l3>[undef]") {
		puts("bad 17.1");
	}
	unless (l1_2_15_2("l1\r\nl2\r\nl3\r\n") == "<l1>[l2]<l3>[undef]") {
		puts("bad 17.2");
	}

	unless (l1_2_15_2("l1\r\nl2\r\nl3\r\nl4") == "<l1>[l2]<l3>[l4]") {
		puts("bad 18.1");
	}
	unless (l1_2_15_2("l1\r\nl2\r\nl3\r\nl4\r\n") == "<l1>[l2]<l3>[l4]") {
		puts("bad 18.2");
	}

	/* Check a stride of 3, \n line endings. */

	unless (l1_2_15_3(undef) == "") puts("bad 20.1");
	unless (l1_2_15_3("") == "") puts("bad 20.2");

	unless (l1_2_15_3("l1") == "<l1>[undef]{undef}") puts("bad 21.1");
	unless (l1_2_15_3("l1\n") == "<l1>[undef]{undef}") puts("bad 21.2");

	unless (l1_2_15_3("l1\nl2") == "<l1>[l2]{undef}") puts("bad 22.1");
	unless (l1_2_15_3("l1\nl2\n") == "<l1>[l2]{undef}") puts("bad 22.2");

	unless (l1_2_15_3("l1\nl2\nl3") == "<l1>[l2]{l3}") puts("bad 23.1");
	unless (l1_2_15_3("l1\nl2\nl3\n") == "<l1>[l2]{l3}") puts("bad 23.2");

	unless (l1_2_15_3("l1\nl2\nl3\nl4") == "<l1>[l2]{l3}<l4>[undef]{undef}") {
		puts("bad 24.1");
	}
	unless (l1_2_15_3("l1\nl2\nl3\nl4\n") == "<l1>[l2]{l3}<l4>[undef]{undef}") {
		puts("bad 24.2");
	}

	unless (l1_2_15_3("l1\nl2\nl3\nl4\nl5") == "<l1>[l2]{l3}<l4>[l5]{undef}") {
		puts("bad 25.1");
	}
	unless (l1_2_15_3("l1\nl2\nl3\nl4\nl5\n") == "<l1>[l2]{l3}<l4>[l5]{undef}") {
		puts("bad 25.2");
	}

	unless (l1_2_15_3("l1\nl2\nl3\nl4\nl5\nl6") == "<l1>[l2]{l3}<l4>[l5]{l6}") {
		puts("bad 26.1");
	}
	unless (l1_2_15_3("l1\nl2\nl3\nl4\nl5\nl6\n") == "<l1>[l2]{l3}<l4>[l5]{l6}") {
		puts("bad 26.2");
	}

	/* Check a stride of 3, \r\n line endings. */

	unless (l1_2_15_3("l1\r\n") == "<l1>[undef]{undef}") puts("bad 27.1");

	unless (l1_2_15_3("l1\r\nl2") == "<l1>[l2]{undef}") puts("bad 28.1");
	unless (l1_2_15_3("l1\r\nl2\r\n") == "<l1>[l2]{undef}") puts("bad 28.2");

	unless (l1_2_15_3("l1\r\nl2\r\nl3") == "<l1>[l2]{l3}") {
		puts("bad 29.1");
	}
	unless (l1_2_15_3("l1\r\nl2\r\nl3\r\n") == "<l1>[l2]{l3}") {
		puts("bad 29.2");
	}

	unless (l1_2_15_3("l1\r\nl2\r\nl3\r\nl4") == "<l1>[l2]{l3}<l4>[undef]{undef}") {
		puts("bad 30.1");
	}
	unless (l1_2_15_3("l1\r\nl2\r\nl3\r\nl4\r\n") == "<l1>[l2]{l3}<l4>[undef]{undef}") {
		puts("bad 30.2");
	}

	unless (l1_2_15_3("l1\r\nl2\r\nl3\r\nl4\r\nl5") == "<l1>[l2]{l3}<l4>[l5]{undef}") {
		puts("bad 31.1");
	}
	unless (l1_2_15_3("l1\r\nl2\r\nl3\r\nl4\r\nl5\r\n") == "<l1>[l2]{l3}<l4>[l5]{undef}") {
		puts("bad 31.2");
	}

	unless (l1_2_15_3("l1\r\nl2\r\nl3\r\nl4\r\nl5\r\nl6") == "<l1>[l2]{l3}<l4>[l5]{l6}") {
		puts("bad 32.1");
	}
	unless (l1_2_15_3("l1\r\nl2\r\nl3\r\nl4\r\nl5\r\nl6\r\n") == "<l1>[l2]{l3}<l4>[l5]{l6}") {
		puts("bad 32.2");
	}

	/* Check break and continue from inside the foreach. */

	t = "";
	foreach (s in <"l1\nl2\nl3\nl4\n">) {
		t .= "b<${s}>";
		if (s == "l1") continue;
		if (s == "l2") break;
		t .= "a<${s}>";
	}
	unless (t == "b<l1>b<l2>") puts("bad 50.1 ${t}");
	unless (s == "l2") puts("bad 50.2");
}
loop_1_2_15();
} -output {}

test loop-1.2.15.1 {test foreach <string>} -body {
#lang L
void loop_1_2_15_1()
{
	string s = "1\n2\n\3\n4\n";
	string k, v;

	foreach (k => v in <s>) printf("%s,%s\n", k, v);
}
loop_1_2_15_1();
} -returnCodes error -match regexp -result {.*: L Error: => illegal in foreach over strings}

test loop-1.3 {continue statements} -body {
#lang L --line=1
void loop_1_3_for_continue()
{
	int	i;

	for (i = 0; i < 5; i++) {
		if (i == 2) continue;
		puts(i);
	}
}

void loop_1_3_foreach_continue()
{
	string	k, l, v;
	string	as[] = { "1", "2", "3", "4", "5" };
	hash	h;

	h{"a"} = "x";
	h{"b"} = "y";
	h{"c"} = "z";

	printf("foreach test 1\n");
	foreach (k => v in h) {
		if (k eq "b") continue;
		printf("%s => %s\n", k, v);
	}

	printf("foreach test 2\n");
	foreach (l in h) {
		if (l eq "c") continue;
		foreach (k => v in h) {
			if (k eq "b") continue;
			printf("%s: %s => %s\n", l, k, v);
		}
	}

	printf("foreach test 3\n");
	foreach (v in as) {
		if ((v ge "2") && (v le "4")) continue;
		printf("%s\n", v);
	}

	printf("foreach test 4\n");
	foreach (l in "abcdefg") {
		if ((l ge "d") && (l le "f")) continue;
		printf("%s\n", l);
	}
}

void loop_1_3_do_while_continue()
{
	int	i;

	printf("do while test\n");
	i = -1;
	do {
		++i;
		if ((i == 1) || (i == 2)) continue;
		puts(i);
	} while (i < 5);
}

void loop_1_3_while_continue()
{
	int	i;

	printf("while test\n");
	i = -1;
	while (i < 5) {
		++i;
		if ((i == 1) || (i == 2)) continue;
		puts(i);
	};
}

void loop_1_3()
{
	loop_1_3_for_continue();
	loop_1_3_foreach_continue();
	loop_1_3_do_while_continue();
	loop_1_3_while_continue();
}
#lang tcl
loop_1_3
} -output {0
1
3
4
foreach test 1
a => x
c => z
foreach test 2
a: a => x
a: c => z
b: a => x
b: c => z
foreach test 3
1
5
foreach test 4
a
b
c
g
do while test
0
3
4
5
while test
0
3
4
5
}

test loop-1.4 {break statements} -body {
#lang L --line=1
void loop_1_4_foreach_break()
{
	string	k, l, v;
	string	as[] = { "1", "2", "3", "4", "5" };
	hash	h;

	h{"a"} = "x";
	h{"b"} = "y";
	h{"c"} = "z";
	foreach (l in h) {
		foreach (k => v in h) {
			if (k eq "b") break;
		}
	}
	printf("loops over, k is %s, v is %s\n", k, v);

	foreach (l in as) {
		if (l eq "3") break;
	}
	printf("l is %s\n", l);

	foreach (l in "abcdefg") {
		if (l eq "c") break;
	}
	printf("l is %s\n", l);
}

void loop_1_4_for_break()
{
	int	i;

	for (i = 0; i < 10; i++) {
		puts(i);
		if (i == 5) {
			puts("attempting to break");
			break;
		}
	}
	printf("at the end of the day, i is %d\n", i);
}

void loop_1_4_do_while_break()
{
	int	i;

	i = 0;
	do {
		++i;
		if (i == 3) break;
	} while (i < 5);
	printf("do while i = %d\n", i);
}

void loop_1_4_while_break()
{
	int	i;

	i = 0;
	while (i < 5) {
		++i;
		if (i == 3) break;
	}
	printf("while i = %d\n", i);
}

void loop_1_4()
{
	loop_1_4_foreach_break();
	loop_1_4_for_break();
	loop_1_4_do_while_break();
	loop_1_4_while_break();
}

#lang tcl
loop_1_4
} -output {loops over, k is b, v is y
l is 3
l is c
0
1
2
3
4
5
attempting to break
at the end of the day, i is 5
do while i = 3
while i = 3
}

test loop-1.5 {continues in nested foreach loops} -body {
#lang L --line=1
void
loop_1_5_fill3(int d1, int d2, int d3, int &a[][][])
{
	int	i, j, k;

	for (i = 0; i < d1; ++i) {
		for (j = 0; j < d2; ++j) {
			for (k = 0; k < d3; ++k) {
				a[i][j][k] = (i+1)*100 + (j+1)*10 + k+1;
			}
		}
	}
}

void
loop_1_5()
{
	int	d1, d2, vi;
	int	ai[3];
	int	aii[3][3];
	int	aiii[3][3][3];

	loop_1_5_fill3(3, 3, 3, &aiii);

	printf("test 1\n");
	foreach (aii in aiii) {
		foreach (ai in aii) {
			foreach (vi in ai) {
				// Omit all even numbers.
				if ((vi%2) == 0) continue;
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("test 2\n");
	d1 = d2 = 0;
	foreach (aii in aiii) {
		++d1;
		foreach (ai in aii) {
			++d2;
			// Omit 11x.
			if (d2 == 1) continue;
			foreach (vi in ai) {
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("test 3\n");
	d1 = d2 = 0;
	foreach (aii in aiii) {
		++d1;
		// Omit 1xx.
		if (d1 == 1) continue;
		foreach (ai in aii) {
			++d2;
			foreach (vi in ai) {
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("test 4\n");
	d1 = d2 = 0;
	foreach (aii in aiii) {
		++d1;
		// Omit 1xx.
		if (d1 == 1) continue;
		foreach (ai in aii) {
			++d2;
			// Omit 21x.
			if (d2 == 1) continue;
			foreach (vi in ai) {
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("test 5\n");
	d1 = d2 = 0;
	foreach (aii in aiii) {
		++d1;
		// Omit 1xx.
		if (d1 == 1) continue;
		foreach (ai in aii) {
			++d2;
			// Omit 21x.
			if (d2 == 1) continue;
			foreach (vi in ai) {
				// Omit 3xx.
				if (vi >= 300) continue;
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("end\n");
}

loop_1_5();
} -output "test 1
aiii has 111
aiii has 113
aiii has 121
aiii has 123
aiii has 131
aiii has 133
aiii has 211
aiii has 213
aiii has 221
aiii has 223
aiii has 231
aiii has 233
aiii has 311
aiii has 313
aiii has 321
aiii has 323
aiii has 331
aiii has 333
test 2
aiii has 121
aiii has 122
aiii has 123
aiii has 131
aiii has 132
aiii has 133
aiii has 211
aiii has 212
aiii has 213
aiii has 221
aiii has 222
aiii has 223
aiii has 231
aiii has 232
aiii has 233
aiii has 311
aiii has 312
aiii has 313
aiii has 321
aiii has 322
aiii has 323
aiii has 331
aiii has 332
aiii has 333
test 3
aiii has 211
aiii has 212
aiii has 213
aiii has 221
aiii has 222
aiii has 223
aiii has 231
aiii has 232
aiii has 233
aiii has 311
aiii has 312
aiii has 313
aiii has 321
aiii has 322
aiii has 323
aiii has 331
aiii has 332
aiii has 333
test 4
aiii has 221
aiii has 222
aiii has 223
aiii has 231
aiii has 232
aiii has 233
aiii has 311
aiii has 312
aiii has 313
aiii has 321
aiii has 322
aiii has 323
aiii has 331
aiii has 332
aiii has 333
test 5
aiii has 221
aiii has 222
aiii has 223
aiii has 231
aiii has 232
aiii has 233
end
"

test loop-1.6 {breaks in nested foreach loops} -body {
#lang L --line=1
void
loop_1_6_fill3(int d1, int d2, int d3, int &a[][][])
{
	int	i, j, k;

	for (i = 0; i < d1; ++i) {
		for (j = 0; j < d2; ++j) {
			for (k = 0; k < d3; ++k) {
				a[i][j][k] = (i+1)*100 + (j+1)*10 + k+1;
			}
		}
	}
}

void
loop_1_6()
{
	int	d1, d2, vi;
	int	ai[3];
	int	aii[3][3];
	int	aiii[3][3][3];

	loop_1_6_fill3(3, 3, 3, &aiii);

	printf("test 1\n");
	foreach (aii in aiii) {
		foreach (ai in aii) {
			foreach (vi in ai) {
				// Should have no output.
				break;
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("test 2\n");
	d1 = d2 = 0;
	foreach (aii in aiii) {
		++d1;
		foreach (ai in aii) {
			++d2;
			// Omit 13x.
			if (d2 == 3) break;
			foreach (vi in ai) {
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("test 3\n");
	d1 = d2 = 0;
	foreach (aii in aiii) {
		++d1;
		// Omit [23]xx.
		if (d1 == 2) break;
		foreach (ai in aii) {
			++d2;
			foreach (vi in ai) {
				printf("aiii has %d\n", vi);
			}
		}
	}
	printf("end\n");
}

loop_1_6();
} -output "test 1
test 2
aiii has 111
aiii has 112
aiii has 113
aiii has 121
aiii has 122
aiii has 123
aiii has 211
aiii has 212
aiii has 213
aiii has 221
aiii has 222
aiii has 223
aiii has 231
aiii has 232
aiii has 233
aiii has 311
aiii has 312
aiii has 313
aiii has 321
aiii has 322
aiii has 323
aiii has 331
aiii has 332
aiii has 333
test 3
aiii has 111
aiii has 112
aiii has 113
aiii has 121
aiii has 122
aiii has 123
aiii has 131
aiii has 132
aiii has 133
end
"

test loop-1.6.1 {test break and continue errors} -body {
#lang L --line=1
/*
 * Try a break and continue in various (non-loop) constructs
 * that open up a new scope in the compiler.  All of these
 * should be errors.
 */
void loop_1_6_1()
{
	break;
	continue;
	{
		break;
		continue;
	}
	if (1) {
		break;
		continue;
	} else {
		break;
		continue;
	}
	switch (1) {
	    case 1:
		continue;
	}
}
break;
continue;
} -returnCodes error -match regexp -result {.*8: L Error: break allowed only inside switch and loop statements
.*9: L Error: continue allowed only inside loops
.*11: L Error: break allowed only inside switch and loop statements
.*12: L Error: continue allowed only inside loops
.*15: L Error: break allowed only inside switch and loop statements
.*16: L Error: continue allowed only inside loops
.*18: L Error: break allowed only inside switch and loop statements
.*19: L Error: continue allowed only inside loops
.*23: L Error: continue allowed only inside loops
.*26: L Error: break allowed only inside switch and loop statements
.*27: L Error: continue allowed only inside loops
}

test loop-1.7 {test loop condition with regexp captures} -body {
#lang L --line=1
void loop_1_7()
{
	/*
	 * This checks for an earlier compiler bug where the loop
	 * condition was sometimes compiled before the loop body,
	 * causing any regexp capture variable references to possibly
	 * become undeclared-variable references.
	 */

	int	it;

	it = 0;
	while ("abc" =~ /(a)(b)/) {
		++it;
		unless (($1 eq "a") && ($2 eq "b")) {
			puts("bad 1.1");
		}
		break;
	}
	unless (it == 1) puts("bad 1.2");

	/* Use more captures than last time. */
	for (it = 0; "abcd" =~ /(a)(b)(c)(d)/; ) {
		++it;
		unless (($1 eq "a") && ($2 eq "b") && ($3 eq "c") &&
			($4 eq "d")) {
			puts("bad 2.1");
		}
		break;
	}
	unless (it == 1) puts("bad 2.2");
}
loop_1_7();
} -output {}

test switch-1.1 {check switch statement, if-then-else code} -body {
#lang L --line=1
/*
 * This test exercises the case of non-constant case expressions in
 * switch statements, for which the compiler generates if-then-else
 * style code.  Only one case value must be non-constant, which is why
 * you see "0+zero" etc below.
 */
void switch_1_1()
{
	int	a, b, c, d, i;
	int	zero = 0;
	int	ia[] = { 3, 1, 4, 1 };
	string	m, mm, mvar, s, s1, s2, s3, s4, s5;
	string	sa[] = { "abc", "def", "ghi", "JkL" };
	widget	w;

	/* Test empty switch statement. */
	i = 0;
	switch (++i) {}
	unless (i == 1) puts("bad 0.1");

	/* Test string and regexp matching. */
	s = "";
	for (i = 0; i < length(sa); ++i) {
		switch (sa[i]) {
		    case "abc":
			unless (i == 0) puts("bad 1.1");
			s .= "a";
			break;
		    case /de/:
			unless (i == 1) puts("bad 1.2");
			s .= "d";
			break;
		    case /a*c*f*g/:
			unless (i == 2) puts("bad 1.3");
			s .= "g";
			break;
		    case /jkl/:
			puts("bad 1.4");
			break;
		    case /jkl/i:
			unless (i == 3) puts("bad 1.5");
			s .= "j";
			break;
		    case "bad":
			puts("bad 1.6");
			break;
		    case /also bad/:
			puts("bad 1.7");
			break;
		}
	}
	unless (s eq "adgj") puts("bad 1.9");

	/* Test matching on ints. */
	s = "";
	for (i = 0; i < length(ia); ++i) {
		switch (ia[i]) {
		    case 0+zero:  // for a non-constant case value
			puts("bad 2.1");
			break;
		    case 1:
			unless ((i == 1) || (i == 3)) puts("bad 2.2");
			s .= "1";
			break;
		    case 2:
			puts("bad 2.3");
			break;
		    case 3:
			unless (i == 0) puts("bad 2.4");
			s .= "3";
			break;
		    case 4:
			unless (i == 2) puts("bad 2.5");
			s .= "4";
			break;
		}
	}
	unless (s eq "3141") puts("bad 2.9");

	/* Test checking for undef. */

	s = undef;
	i = 0;
	switch (s) {
	    case undef:
		++i;
		break;
	    default:
		puts("bad 2.11");
		break;
	}
	unless (i == 1) puts("bad 2.12");

	s = "";
	i = 0;
	switch (s) {
	    case undef:
		puts("bad 2.13");
		break;
	    default:
		++i;
		break;
	}
	unless (i == 1) puts("bad 2.14");

	s = s1 = undef;
	i = 0;
	switch (s) {
	    case s1:
		puts("bad 2.15");
		break;
	    case undef:
		++i;
	    case "fall through to this one":
		++i;
		break;
	    default:
		puts("bad 2.16");
		break;
	}
	unless (i == 2) puts("bad 2.17");

	s = s1 = undef;
	i = 0;
	switch (s) {
	    case undef:
		++i;
		break;
	    case s1:
		puts("bad 2.18");
		break;
	    default:
		puts("bad 2.19");
		break;
	}
	unless (i == 1) puts("bad 2.20");

	s = undef;
	s1 = "";
	i = 0;
	switch (s) {
	    case s1:
		puts("bad 2.21");
		break;
	    case undef:
		++i;
		break;
	    default:
		puts("bad 2.22");
		break;
	}
	unless (i == 1) puts("bad 2.23");

	/* Test case fall through. */
	s = "";
	switch (1) {
	    case 1+zero:
		s .= "1";
	    case 2:
		s .= "2";
		break;
	    case 3:
		s .= "3";
	}
	unless (s eq "12") puts("bad 3.1");

	/* Test multiple cases per leg. */
	s = "";
	for (i = 0; i < 6; ++i) {
		switch (i) {
		    case 0+zero:
			s .= "0";
			break;
		    case 1:
		    case 2:
			s .= (string)i;
			break;
		    case 3:
		    case 4:
		    case 5:
			s .= (string)i;
			break;
		}
	}
	unless (s eq "012345") puts("bad 4.1");

	/* Test default case in the end, beginning, and middle of the cases. */

	s = "";
	switch (3) {
	    case 0+zero:
		puts("bad 5.1");
		break;
	    default:
		s .= "d";
		break;
	}
	unless (s eq "d") puts("bad 5.2");

	s = "";
	switch (3) {
	    default:
		s .= "d";
		break;
	    case 0+zero:
		puts("bad 5.3");
		break;
	}
	unless (s eq "d") puts("bad 5.4");

	s = "";
	switch (3) {
	    case 1+zero:
		puts("bad 5.5");
		break;
	    default:
		s .= "d";
		break;
	    case 0:
		puts("bad 5.6");
		break;
	}
	unless (s eq "d") puts("bad 5.7");

	/* Test falling thru to and from the default case. */

	s = "";
	switch (3) {
	    case 3+zero:
		s .= "3";
	    default:
		s .= "d";
		break;
	}
	unless (s eq "3d") puts("bad 6.1");

	s = "";
	switch (3) {
	    default:
		s .= "d";
	    case 0+zero:
		s .= "0";
		break;
	}
	unless (s eq "d0") puts("bad 6.2");

	s = "";
	switch (3) {
	    case 0:
		s .= "0";
		break;
	    default:
		s .= "d";
	    case 1+zero:
		s .= "1";
		break;
	}
	unless (s eq "d1") puts("bad 6.3");

	s = "";
	switch (3) {
	    default:
		s .= "d";
	    case 1+zero:
		s .= "1";
	    case 0:
		s .= "0";
	}
	unless (s eq "d10") puts("bad 6.4");

	s = "";
	switch (3) {
	    case 1+zero:
		s .= "1";
	    default:
		s .= "d";
	    case 0:
		s .= "0";
	}
	unless (s eq "d0") puts("bad 6.5");

	/* Test empty case bodies. */

	s = "";
	for (i = 0; i < 4; ++i) {
		switch (i) {
		    case 0+zero:
		    case 1:
		    case 3:
			s .= (string)i;
			break;
		    case 2:
		    default:
		}
	}
	unless (s eq "013") puts("bad 7.2");

	s = "";
	switch (2) {
	    case 2+zero:
	    default:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.3");

	s = "";
	switch (0) {
	    case 2+zero:
	    default:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.4");

	s = "";
	switch (2) {
	    default:
	    case 2+zero:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.5");

	s = "";
	switch (0) {
	    default:
	    case 2+zero:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.6");

	s = "";
	switch (2) {
	    case 2+zero:
	    default:
	    case 1:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.7");

	s = "";
	switch (1) {
	    case 2+zero:
	    default:
	    case 1:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.8");

	s = "";
	switch (0) {
	    case 2+zero:
	    default:
	    case 1:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.9");

	/* Test various whitespace around regexp, and regexp variations. */
	s = "";
	m    = "nn";
	mm   = "oo";
	mvar = "pp";
	foreach (s1 in {"aa","bb","cc","dd","ee","ff","gg","hh","ii",
			"jj","kk","ll","mm","nn","oo","pp"}) {
		switch (s1) {
		    // the next line has a tab after the "case"
		    case	/aa/:	s .= "1"; break;
		    case m|bb|:		s .= "2"; break;
		    case m|Cc|i:	s .= "3"; break;
		    case m#dd#:		s .= "4"; break;
		    case m#eE#i:	s .= "5"; break;
		    case m)ff):		s .= "6"; break;
		    case m)Gg)i:	s .= "7"; break;
		    case m,hh,:		s .= "8"; break;
		    case m,Ii,i:	s .= "9"; break;
		    case m!jj!:		s .= "a"; break;
		    case m!Kk!i:	s .= "b"; break;
		    case m"ll":		s .= "c"; break;
		    case m"Mm"i:	s .= "d"; break;
		    // the next ones aren't regexps
		    case m:		s .= "e"; break;  // variable m
		    case mm:		s .= "f"; break;  // variable mm
		    case mvar:		s .= "g"; break;  // variable mvar
		}
	}
	unless (s eq "123456789abcdefg") puts("bad 8.1");

	/* Test interpolations in regexp's. */
	s = "";
	s1 = "ab";
	s2 = "ef";
	s3 = "g";
	s4 = "i";
	s5 = "jkl";
	for (i = 0; i < length(sa); ++i) {
		switch (sa[i]) {
		    case /${s1}c/:
			s .= "a";
			break;
		    case /d${s2}/:
			s .= "d";
			break;
		    case /${s3}h${s4}/:
			s .= "g";
			break;
		    case /${s5}/i:
			s .= "j";
			break;
		}
	}
	unless (s eq "adgj") puts("bad 9.1");

	/* Test $1 $2 etc available in cases. */
	switch ("This is a test") {
		case /(test)/:
			unless ($1 eq "test") puts("bad 10.1");
			break;
	}
	switch ("This is a test") {
		case /(a) (test)/:
			unless ($1 eq "a") puts("bad 10.2");
			unless ($2 eq "test") puts("bad 10.3");
			break;
	}

	/* Test labeled statements in cases. */

	i = 0;
	switch (1) {
	    case 1+zero:
		lab1: if (i++) break;
		    goto lab1;
	}
	unless (i == 2) puts("bad 11.1");

	i = 0;
	switch (0) {
	    case 1+zero:
		lab2: if (i++) break;
		    goto lab2;
	    default:
		lab3: if (i++) break;
		    goto lab3;
	}
	unless (i == 2) puts("bad 11.2");

	/*
	 * Test goto out of the switch to check that the run-time
	 * stack remains balanced.  This used to crash due to a bug.
	 * However, it's difficult to see the regression as a crash in
	 * a release build.  If we have the loop below iterate only a few
	 * times, the Tcl bytecode engine seems to happily scribble
	 * memory but on some platforms it is in a region where
	 * it does not cause a crash.  I'm hesitant to have the loop
	 * iterate too many times since Larry already doesn't like how
	 * long the L tests take.  But it can easily be seen in a Tcl
	 * debug build.
	 */

	for (i = 1; i < 1000; ++i) {
		switch (i) {
		    case i:
			goto sw_1_1_next;
		}
	sw_1_1_next:
	}

	/*
	 * Test id: at end of case expression.  At one point this used
	 * to cause a syntax error.
	 */

	i = 0;
	switch (0) {
	    case i:
		++i;
		break;
	    default:
		puts("bad 12.1");
		break;
	}
	unless (i == 1) puts("bad 12.2");

	i = 0;
	switch (0) {
	    case 1+i-1-i:
		++i;
		break;
	    default:
		puts("bad 12.3");
		break;
	}
	unless (i == 1) puts("bad 12.4");

	/*
	 * Test that the right comparison bytecode is generated
	 * (string vs numeric).
	 */
	i = 0;
	switch ("0") {
	    case "00":
		puts("bad 13.1");
		break;
	    case /0/:
	    default:
		++i;
		break;
	}
	unless (i == 1) puts("bad 13.2");

	/*
	 * Check that integer switch expressions and the case values
	 * are properly canonicalized.
	 */

	s = "";
	for (i = 0; i <= 3; ++i) {
		switch (i) {
		    case 0:
			s .= "0";
			break;
		    case 0x1:
			s .= "1";
			break;
		    case 0o2:
			s .= "2";
			break;
		    case 000000003:
			s .= "3";
			break;
		    case 99+0:
		    default:
			puts("bad 13.3");
			break;
		}
	}
	unless (s eq "0123") puts("bad 13.4");

	s = "";
	for (i = 100000000000000000000; i <= 100000000000000000003; ++i) {
		switch (i) {
		    case 100000000000000000000:
			s .= "0";
			break;
		    case 0x56bc75e2d63100001:
			s .= "1";
			break;
		    case 0o12657072742654304000002:
			s .= "2";
			break;
		    case 0000000000000100000000000000000003:
			s .= "3";
			break;
		    case 99+0:
		    default:
			puts("bad 13.5");
			break;
		}
	}
	unless (s eq "0123") puts("bad 13.6");

	s = "";
	a = (poly)"100000000000000000000";
	b = (poly)"0x56bc75e2d63100001";	// this is a+1
	c = (poly)"0o12657072742654304000002";	// this is a+2
	d = (poly)"100000000000000000003";	// this is a+3
	for (i = 100000000000000000000; i <= 100000000000000000003; ++i) {
		switch (i) {
		    case a:
			s .= "0";
			break;
		    case b:
			s .= "1";
			break;
		    case c:
			s .= "2";
			break;
		    case d:
			s .= "3";
			break;
		    default:
			puts("bad 13.7");
			break;
		}
	}
	unless (s eq "0123") puts("bad 13.8");

	s = "";
	i = (poly)"0x1";  // don't use (int) since that canonicalizes
	switch (i) {
	    case 1:
		s .= "1";
		break;
	    case 99+0:
	    default:
		puts("bad 13.9");
		break;
	}
	unless (s eq "1") puts("bad 13.10");

	/* Test switching on a widget type. */

	w = "2";
	s = "";
	switch (w) {
	    case "1":
		puts("bad 14.1");
		break;
	    case /2/:
		s .= "1";
		break;
	    default:
		puts("bad 14.2");
		break;
	}
	unless (s eq "1") puts("bad 14.3");
}
switch_1_1();
} -output {}

test switch-1.2 {check switch statement, jump-table code} -body {
#lang L --line=1
/*
 * This test exercises the case of constant case expressions in switch
 * statements, for which the compiler generates a jump table.  This is
 * basically the above test edited to have only constant case values.
 */
void switch_1_2()
{
	int	i;
	int	ia[] = { 3, 1, 4, 1 };
	string	s;
	string	sa[] = { "abc", "def", "ghi", "JkL", "00" };
	widget	w;

	/* Test string matching. */
	s = "";
	for (i = 0; i < length(sa); ++i) {
		switch (sa[i]) {
		    case "abc":
			unless (i == 0) puts("bad 1.1");
			s .= "a";
			break;
		    case "def":
			unless (i == 1) puts("bad 1.2");
			s .= "d";
			break;
		    case "ghi":
			unless (i == 2) puts("bad 1.3");
			s .= "g";
			break;
		    case "jkl":
			puts("bad 1.4");
			break;
		    case "JkL":
			unless (i == 3) puts("bad 1.5");
			s .= "j";
			break;
		    case "bad":
			puts("bad 1.6");
			break;
		    case "also bad":
			puts("bad 1.7");
			break;
		    case "0":  // should not match "00"
			puts("bad 1.8");
			break;
		}
	}
	unless (s eq "adgj") {puts("bad 1.9"); puts(s); }

	/*
	 * Test matching on ints.  The leading zeros check that the
	 * compiler isn't doing a pure string match.
	 */
	s = "";
	for (i = 0; i < length(ia); ++i) {
		switch (ia[i]) {
		    case 0:
			puts("bad 2.1");
			break;
		    case 01:
			unless ((i == 1) || (i == 3)) puts("bad 2.2");
			s .= "1";
			break;
		    case 2:
			puts("bad 2.3");
			break;
		    case 003:
			unless (i == 0) puts("bad 2.4");
			s .= "3";
			break;
		    case 4:
			unless (i == 2) puts("bad 2.5");
			s .= "4";
			break;
		}
	}
	unless (s eq "3141") puts("bad 2.9");

	/* Test case fall through. */
	s = "";
	switch (1) {
	    case 1:
		s .= "1";
	    case 2:
		s .= "2";
		break;
	    case 3:
		s .= "3";
	}
	unless (s eq "12") puts("bad 3.1");

	/* Test multiple cases per leg. */
	s = "";
	for (i = 0; i < 6; ++i) {
		switch (i) {
		    case 0:
			s .= "0";
			break;
		    case 1:
		    case 2:
			s .= (string)i;
			break;
		    case 3:
		    case 4:
		    case 5:
			s .= (string)i;
			break;
		}
	}
	unless (s eq "012345") puts("bad 4.1");

	/* Test default case in the end, beginning, and middle of the cases. */

	s = "";
	switch (3) {
	    case 0:
		puts("bad 5.1");
		break;
	    default:
		s .= "d";
		break;
	}
	unless (s eq "d") puts("bad 5.2");

	s = "";
	switch (3) {
	    default:
		s .= "d";
		break;
	    case 0:
		puts("bad 5.3");
		break;
	}
	unless (s eq "d") puts("bad 5.4");

	s = "";
	switch (3) {
	    case 1:
		puts("bad 5.5");
		break;
	    default:
		s .= "d";
		break;
	    case 0:
		puts("bad 5.6");
		break;
	}
	unless (s eq "d") puts("bad 5.7");

	/* Test lone default clause. */
	s = "";
	switch (3) {
	    default:
		s .= "d";
	}
	unless (s eq "d") puts("bad 5.8");

	/* Test falling thru to and from the default case. */

	s = "";
	switch (3) {
	    case 3:
		s .= "3";
	    default:
		s .= "d";
		break;
	}
	unless (s eq "3d") puts("bad 6.1");

	s = "";
	switch (3) {
	    default:
		s .= "d";
	    case 0:
		s .= "0";
		break;
	}
	unless (s eq "d0") puts("bad 6.2");

	s = "";
	switch (3) {
	    case 0:
		s .= "0";
		break;
	    default:
		s .= "d";
	    case 1:
		s .= "1";
		break;
	}
	unless (s eq "d1") puts("bad 6.3");

	s = "";
	switch (3) {
	    default:
		s .= "d";
	    case 1:
		s .= "1";
	    case 0:
		s .= "0";
	}
	unless (s eq "d10") puts("bad 6.4");

	s = "";
	switch (3) {
	    case 1:
		s .= "1";
	    default:
		s .= "d";
	    case 0:
		s .= "0";
	}
	unless (s eq "d0") puts("bad 6.5");

	/* Test empty case bodies. */

	s = "";
	for (i = 0; i < 4; ++i) {
		switch (i) {
		    case 0:
		    case 1:
		    case 3:
			s .= (string)i;
			break;
		    case 2:
		    default:
		}
	}
	unless (s eq "013") puts("bad 7.2");

	s = "";
	switch (2) {
	    case 2:
	    default:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.3");

	s = "";
	switch (0) {
	    case 2:
	    default:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.4");

	s = "";
	switch (2) {
	    default:
	    case 2:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.5");

	s = "";
	switch (0) {
	    default:
	    case 2:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.6");

	s = "";
	switch (2) {
	    case 2:
	    default:
	    case 1:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.7");

	s = "";
	switch (1) {
	    case 2:
	    default:
	    case 1:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.8");

	s = "";
	switch (0) {
	    case 2:
	    default:
	    case 1:
		s .= "x";
		break;
	}
	unless (s eq "x") puts("bad 7.9");

	/* Test labeled statements in cases. */

	i = 0;
	switch (1) {
	    case 1:
		lab1: if (i++) break;
		    goto lab1;
	}
	unless (i == 2) puts("bad 11.1");

	i = 0;
	switch (0) {
	    case 1:
		lab2: if (i++) break;
		    goto lab2;
	    default:
		lab3: if (i++) break;
		    goto lab3;
	}
	unless (i == 2) puts("bad 11.2");

	/*
	 * Test that the right comparison bytecode is generated
	 * (string vs numeric).
	 */

	i = 0;
	switch ("0") {
	    case "00":
		puts("bad 13.1");
		break;
	    default:
		++i;
		break;
	}
	unless (i == 1) puts("bad 13.2");

	/*
	 * Check that integer switch expressions and the case values
	 * are properly canonicalized.
	 */

	s = "";
	for (i = 0; i <= 3; ++i) {
		switch (i) {
		    case 0:
			s .= "0";
			break;
		    case 0x1:
			s .= "1";
			break;
		    case 0o2:
			s .= "2";
			break;
		    case 000000003:
			s .= "3";
			break;
		    default:
			puts("bad 13.3");
			break;
		}
	}
	unless (s eq "0123") puts("bad 13.4");

	s = "";
	for (i = 100000000000000000000; i <= 100000000000000000003; ++i) {
		switch (i) {
		    case 100000000000000000000:
			s .= "0";
			break;
		    case 0x56bc75e2d63100001:
			s .= "1";
			break;
		    case 0o12657072742654304000002:
			s .= "2";
			break;
		    case 0000000000000100000000000000000003:
			s .= "3";
			break;
		    default:
			puts("bad 13.5");
			break;
		}
	}
	unless (s eq "0123") puts("bad 13.6");

	s = "";
	i = (poly)"0x1";  // don't use (int) since that canonicalizes
	switch (i) {
	    case 1:
		s .= "1";
		break;
	    default:
		puts("bad 13.7");
		break;
	}
	unless (s eq "1") puts("bad 13.8");

	/* Test switching on a widget type. */

	w = "2";
	s = "";
	switch (w) {
	    case "1":
		puts("bad 14.1");
		break;
	    case "2":
		s .= "1";
		break;
	    default:
		puts("bad 14.2");
		break;
	}
	unless (s eq "1") puts("bad 14.3");
}
switch_1_2();
} -output {}

test switch-2 {test multiple-default-clause error in switch stmt} -body {
#lang L --line=1
void switch_2()
{
	switch (0) {
	    default:
		break;
	    default:
		break;
	}
	switch (0) {
	    default:
		break;
	    default:
		break;
	    default:
		break;
	}
	switch (0) {
	    default:
	    default:
		break;
	}
	switch (0) {
	    default:
	    default:
	}
	switch (0) {
	    default:
	    case 0:
		break;
	    default:
	}
}
} -returnCodes error -match regexp -result {.*6: L Error: multiple default cases in switch statement
.*12: L Error: multiple default cases in switch statement
.*14: L Error: multiple default cases in switch statement
.*19: L Error: multiple default cases in switch statement
.*24: L Error: multiple default cases in switch statement
.*30: L Error: multiple default cases in switch statement
}

test switch-3.0 {test case m() function call} -setup {
	makeFile {
		/*
		 * Put this in its own file to avoid polluting
		 * the global name space with a function m().
		 */
		string m(...args)
		{
			string	ret = "", s;

			foreach (s in args) ret .= s;
			return (ret);
		}
		void main()
		{
			string	s, t;

			s = "";
			foreach (t in {"","abc","def","ghi"}) {
				/* Here m() is a function call not a regexp. */
				switch (t) {
				    case m(): s .= "1"; break;
				    case m("abc"): s .= "2"; break;
				    case m("de","f"): s .= "3"; break;
				    case m("g","h","i"): s .= "4"; break;
				}
			}
			unless (s == "1234") puts("bad 1: ${s}");
		}
	} switch-3.0.l
} -body {
#lang L
void switch_3_0()
{
	int	ret;
	string	tclsh = interpreter();
	string	out, err;

	ret = system({tclsh, "switch-3.0.l"}, undef, &out, &err);
	unless (ret == 0) puts("bad 1.1");
	if (out) puts("bad 1.2: ${out}");
	if (err) puts("bad 1.3: ${err}");
}
switch_3_0();
} -output {}

test switch-3.1 {test type errors in switch stmt} -body {
#lang L --line=1
void switch_3_1()
{
	switch (0) {
		case /regexp/:	// type err
	}
	switch ("string") {
		case 0:		// type err
	}
}
} -returnCodes error -match regexp -result {.*4: L Error: case type incompatible with switch expression
.*7: L Error: case type incompatible with switch expression
}

test switch-3.2 {test other errors in switch stmt} -body {
#lang L --line=1
void switch_3_2()
{
	switch ("string") {
		case /re/g:	// bad regexp modifier
		case /re/ig:	// bad regexp modifier
	}
}
} -returnCodes error -match regexp -result {.*4: L Error: illegal regular expression modifier
.*5: L Error: illegal regular expression modifier
}

test switch-3.3 {test duplicate case values in switch stmt} -body {
#lang L --line=1
void switch_3_3()
{
	switch ((poly)0) {
		case 0:
		case 0:
		case 1:
		case 1:
		case 1:
		case "s":
		case "s":
	}
}
} -returnCodes error -match regexp -result {.*5: L Error: duplicate case value
.*7: L Error: duplicate case value
.*8: L Error: duplicate case value
.*10: L Error: duplicate case value
}

test switch-4 {test illegal types in switch stmt} -body {
#lang L --line=1
void switch_4_v() {}
class switch_4_c {}
void switch_4()
{
	int		arr[];
	string		hsh{int};
	switch_4_c	obj;
	struct { int i,j; } st;

	/* These are all errors - only int, string, and poly are legal. */

	/* constant case expressions */
	switch (0.0) {
		case 0:
	}
	switch(arr) {
		case 0:
	}
	switch(hsh) {
		case 0:
	}
	switch(obj) {
		case 0:
	}
	switch(st) {
		case 0:
	}
	switch(switch_4_v()) {
		case 0:
	}

	/* non-constant case expressions */
	switch (0.0) {
		case 1+2:
	}
	switch(arr) {
		case 1+2:
	}
	switch(hsh) {
		case 1+2:
	}
	switch(obj) {
		case 1+2:
	}
	switch(st) {
		case 1+2:
	}
	switch(switch_4_v()) {
		case 1+2:
	}
}
} -returnCodes error -match regexp -result {.*13: L Error: switch expression must be int or string
.*16: L Error: switch expression must be int or string
.*19: L Error: switch expression must be int or string
.*22: L Error: switch expression must be int or string
.*25: L Error: switch expression must be int or string
.*28: L Error: switch expression must be int or string
.*33: L Error: switch expression must be int or string
.*36: L Error: switch expression must be int or string
.*39: L Error: switch expression must be int or string
.*42: L Error: switch expression must be int or string
.*45: L Error: switch expression must be int or string
.*48: L Error: switch expression must be int or string
}

test switch-5 {test break as a label in switch stmt} -body {
#lang L --line=1
void switch_5()
{
	/*
	 * Check that break: is an error.  This used to be allowed
	 * and was the source of a very hard-to-find bug.
	 */
	switch (1) {
	    case 1:
		break:
	    case 2:
		break;
	}

	/* It's illegal anywhere, not just in a switch. */
	break:
}
switch_5();
} -returnCodes error -match regexp -result {.*9: L Error: break is not a legal label
.*15: L Error: break is not a legal label
}

test struct-1.0 {structs} -body {
#lang L --line=1
struct struct_1_0_point {
        int x, y;
        string label;
};

void struct_1_0() {
        struct struct_1_0_point p1, p2;

        p1.x = 1;
        p1.y = 2;
        p1.label = "this is a label";
        puts("p1 is:");
        puts(p1);
        puts(format("p1.x is %d, p1.y is %d, and p1.label is %s", p1.x, p1.y, p1.label));
        p2 = p1;
        p2.label = "this is another label";
        puts("p1 is:");
        puts(p1);
        puts("p2 is:");
        puts(p2);
}
#lang tcl
struct_1_0
} -output "p1 is:
1 2 {this is a label}
p1.x is 1, p1.y is 2, and p1.label is this is a label
p1 is:
1 2 {this is a label}
p2 is:
1 2 {this is another label}
"

test struct-1.1 {struct allocation and arrays of structs} -body {
#lang L --line=1
struct struct_1_1_point {
        int x, y;
        string label;
};

void struct_1_1() {
   int i = 0;
   struct struct_1_1_point s[10];

   while(i < 10) {
      s[i].y = i;
      s[i].x = 42 + i;
      s[i].label = format("%d cows", 10 - i);
      i++;
   }
   for (i=0; i<10; i++) {
     puts(s[i]);
   }
}
#lang tcl
struct_1_1
} -output "42 0 {10 cows}
43 1 {9 cows}
44 2 {8 cows}
45 3 {7 cows}
46 4 {6 cows}
47 5 {5 cows}
48 6 {4 cows}
49 7 {3 cows}
50 8 {2 cows}
51 9 {1 cows}
"

test struct-1.2 {arrays of structs containing arrays} -body {
#lang L --line=1
struct struct_1_2_point {
        int x, y;
        string label;
  int z[4];
};

void struct_1_2() {
   int i = 0;
   struct struct_1_2_point s[10];

   while(i < 10) {
      s[i].y = i;
      s[i].x = 42 + i;
      s[i].label = format("%d cows", 10 - i);
      s[i].z[i%4] = i;
      i++;
   }
   for (i=0; i<10; i++) {
     puts(s[i]);
   }
}
#lang tcl
struct_1_2
} -output "42 0 {10 cows} 0
43 1 {9 cows} {{} 1}
44 2 {8 cows} {{} {} 2}
45 3 {7 cows} {{} {} {} 3}
46 4 {6 cows} 4
47 5 {5 cows} {{} 5}
48 6 {4 cows} {{} {} 6}
49 7 {3 cows} {{} {} {} 7}
50 8 {2 cows} 8
51 9 {1 cows} {{} 9}
"

test struct-1.3 {increment and decrement on struct fields} -body {
#lang L --line=1
struct foo {
  int i;
};

void struct_1_3() {
  struct foo v;

  v.i = 0;
  for (v.i=0; v.i<5; v.i++);
  puts(v);

  puts("pre:");
  puts(v.i);
  ++v.i;
  puts(v.i);
  puts(++v.i);
  --v.i;
  puts(v.i);
  puts(--v.i);

  puts("post:");
  puts(v.i);
  v.i++;
  puts(v.i);
  puts(v.i++);
  puts(v.i);
  v.i--;
  puts(v.i);
  puts(v.i--);
  puts(v.i);
}
#lang tcl
struct_1_3
} -output "5\npre:\n5\n6\n7\n6\n5\npost:\n5\n6\n6\n7\n6\n6\n5\n"

test struct-1.4 {check struct type declarations} -body {
#lang L --line=1
struct struct_1_4_1 {
	int	i;
	int	j;
};
struct struct_1_4_2;
struct struct_1_4_3 {
	int	i;
	int	j;
	struct struct_1_4_2 st;
};
struct struct_1_4_2 {
	string	s;
};
void struct_1_4()
{
	struct struct_1_4_1 st1 = { 2, 3 };
	struct struct_1_4_2 st2 = { "s2" };
	struct struct_1_4_3 st3 = { 4, 5, { "s3" } };
	/* This redeclaration hides the global one. */
	struct struct_1_4_2 { int k,l; } st4 = { 6, 7 };

	unless ((st1.i == 2) && (st1.j == 3)) puts("bad 1");
	unless (st2.s eq "s2") puts("bad 2");
	unless ((st3.i == 4) && (st3.j == 5) && (st3.st.s eq "s3")) {
	       puts("bad 3");
	}
	unless ((st4.k == 6) && (st4.l == 7)) puts("bad 4");

	if (1) {
		/* This redeclaration hides the global one in this scope. */
		struct struct_1_4_1 { string t,u; } st5 = { "t", "u" };
		unless ((st5.t eq "t") && (st5.u eq "u")) puts("bad 5");
	}
	if (1) {
		/* This should reference the global one. */
		struct struct_1_4_1 st6 = { 8, 9 };
		unless ((st6.i == 8) && (st6.j == 9)) puts("bad 7");
	}
}
#lang tcl
struct_1_4
} -output {}

test struct-1.5 {check multiple struct type declarations} -body {
#lang L --line=1
struct struct_1_5_1 { int i,j; };
struct struct_1_5_1 { int i,j; };
struct struct_1_5_2 { int i,j; };
void struct_1_5_1()
{
	struct struct_1_5_2 { string s; } st1;
	struct struct_1_5_2 { string s; } st2;
}
} -returnCodes error -match regexp -result {.*2: L Error: multiple declaration of struct struct_1_5_1.*7: L Error: multiple declaration of struct struct_1_5_2
}

test struct-1.6 {check struct member errors} -body {
#lang L --line=1
void struct_1_6()
{
	struct struct_1_6 { string s; } st;
	st.x = 1;  // err -- x is not a member
}
} -returnCodes error -match regexp -result {.*4: L Error: struct field x not found
}

test hash-1.0 {basic hashtable support} -body {
#lang L --line=1
void hash_1_0() {
  hash foo;
  foo{"key"} = "value";
  puts(foo{"key"});
}
#lang tcl
hash_1_0
} -output "value\n"

test hash-1.1 {array of hashtables} -body {
#lang L --line=1
void hash_1_1() {
  hash foo[10];
  foo[5]{"key"} = "value";
  foo[4]{"key"} = "";
  puts(foo[5]{"key"});
  puts(foo[4]{"key"});
}
#lang tcl
hash_1_1
} -output "value\n\n"

test hash-1.2 {increment and decrement on hash elements} -body {
#lang L --line=1 -poly
void hash_1_2() {
  hash foo;

  foo{"three"} = 0;
  for (foo{"three"}=0; foo{"three"}<5; foo{"three"}++);
  puts(foo);

  puts("pre:");
  puts(foo{"three"});
  ++foo{"three"};
  puts(foo{"three"});
  puts(++foo{"three"});
  --foo{"three"};
  puts(foo{"three"});
  puts(--foo{"three"});

  puts("post:");
  puts(foo{"three"});
  foo{"three"}++;
  puts(foo{"three"});
  puts(foo{"three"}++);
  puts(foo{"three"});
  foo{"three"}--;
  puts(foo{"three"});
  puts(foo{"three"}--);
  puts(foo{"three"});
  puts(foo);
}
#lang tcl
hash_1_2
} -output "three 5\npre:\n5\n6\n7\n6\n5\npost:\n5\n6\n6\n7\n6\n6\n5\nthree 5\n"

# test hash-1.3 removed

test hash-1.4 {basic hash element types} -body {
#lang L --line=1
struct sh14 {
	int	x;
	int	y;
};
void
hash_1_4()
{
	int		ki, vi;
	string		ks, vs;
	float		kf, vf;
	poly		kp, vp;
	struct sh14	vst;
	int		ihi{int};
	int		ihs{string};
	int		ihf{float};
	int		ihp{poly};
	string		shi{int};
	string		shs{string};
	string		shf{float};
	string		shp{poly};
	float		fhi{int};
	float		fhs{string};
	float		fhf{float};
	float		fhp{poly};
	poly		phi{int};
	poly		phs{string};
	poly		phf{float};
	poly		php{poly};
	struct sh14	sthi{int};
	struct sh14	sths{string};
	struct sh14	sthf{float};
	struct sh14	sthp{poly};

	printf("start\n");

	ihi{0} = 100;
	ihi{1} = 101;
	ihi{2} = 102;
	foreach (ki=>vi in ihi) {
		printf("ihi has %d=>%d\n", ki, vi);
	}

	ihs{"zero"} = 100;
	ihs{"one"}  = 101;
	ihs{"two"}  = 102;
	foreach (ks=>vi in ihs) {
		printf("ihs has %s=>%d\n", ks, vi);
	}

	ihf{1.1} = 100;
	ihf{2.2} = 101;
	ihf{3.3} = 102;
	foreach (kf=>vi in ihf) {
		printf("ihf has %3.1f=>%d\n", kf, vi);
	}

	ihp{0}     = 100;
	ihp{"two"} = 101;
	ihp{3.3}   = 102;
	foreach (kp=>vi in ihp) {
		printf("ihp has %s=>%d\n", kp, vi);
	}

	shi{0} = "zero";
	shi{1} = "one";
	shi{2} = "two";
	foreach (ki=>vs in shi) {
		printf("shi has %d=>%s\n", ki, vs);
	}

	shs{"zero"} = "zero0";
	shs{"one"}  = "one1";
	shs{"two"}  = "two2";
	foreach (ks=>vs in shs) {
		printf("shs has %s=>%s\n", ks, vs);
	}

	shf{1.1} = "one.one";
	shf{2.2} = "two.two";
	shf{3.3} = "three.three";
	foreach (kf=>vs in shf) {
		printf("shf has %3.1f=>%s\n", kf, vs);
	}

	shp{0}     = "zero";
	shp{1.1}   = "one.one";
	shp{"two"} = "two2";
	foreach (kp=>vs in shp) {
		printf("shp has %s=>%s\n", kp, vs);
	}

	fhi{0} = 1.1;
	fhi{1} = 2.2;
	fhi{2} = 3.3;
	foreach (ki=>vf in fhi) {
		printf("fhi has %d=>%3.1f\n", ki, vf);
	}

	fhs{"zero"} = 1.1;
	fhs{"one"}  = 2.2;
	fhs{"two"}  = 3.3;
	foreach (ks=>vf in fhs) {
		printf("fhs has %s=>%3.1f\n", ks, vf);
	}

	fhf{1.1} = 11.1;
	fhf{2.2} = 22.2;
	fhf{3.3} = 33.3;
	foreach (kf=>vf in fhf) {
		printf("fhf has %3.1f=>%3.1f\n", kf, vf);
	}

	fhp{0}     = 1.1;
	fhp{1.1}   = 2.2;
	fhp{"two"} = 3.3;
	foreach (kp=>vf in fhp) {
		printf("fhp has %s=>%3.1f\n", kp, vf);
	}

	phi{0} = 1;
	phi{1} = "two";
	phi{2} = 3.3;
	foreach (ki=>vp in phi) {
		printf("phi has %d=>%s\n", ki, vp);
	}

	phs{"zero"} = 1;
	phs{"one"}  = "two";
	phs{"two"}  = 3.3;
	foreach (ks=>vp in phs) {
		printf("phs has %s=>%s\n", ks, vp);
	}

	phf{1.1} = 1;
	phf{2.2} = "two";
	phf{3.3} = 33.33;
	foreach (kf=>vp in phf) {
		printf("phf has %3.1f=>%s\n", kf, vp);
	}

	php{"one"} = 1;
	php{1.1}   = "two";
	php{2}     = 3.3;
	foreach (kp=>vp in php) {
		printf("php has %s=>%s\n", kp, vp);
	}

	sthi{0}.x = 100;
	sthi{0}.y = 101;
	sthi{1}.x = 200;
	sthi{1}.y = 201;
	sthi{2}.x = 300;
	sthi{2}.y = 301;
	foreach (ki=>vst in sthi) {
		printf("sthi has %d=>(%d,%d)\n", ki, vst.x, vst.y);
	}

	sths{"zero"}.x = 100;
	sths{"zero"}.y = 101;
	sths{"one"}.x  = 200;
	sths{"one"}.y  = 201;
	sths{"two"}.x  = 300;
	sths{"two"}.y  = 301;
	foreach (ks=>vst in sths) {
		printf("sths has %s=>(%d,%d)\n", ks, vst.x, vst.y);
	}

	sthf{1.1}.x = 100;
	sthf{1.1}.y = 101;
	sthf{2.2}.x = 200;
	sthf{2.2}.y = 201;
	sthf{3.3}.x = 300;
	sthf{3.3}.y = 301;
	foreach (kf=>vst in sthf) {
		printf("sthf has %3.1f=>(%d,%d)\n", kf, vst.x, vst.y);
	}

	sthp{0}.x     = 100;
	sthp{0}.y     = 101;
	sthp{1.1}.x   = 200;
	sthp{1.1}.y   = 201;
	sthp{"two"}.x = 300;
	sthp{"two"}.y = 301;
	foreach (kp=>vst in sthp) {
		printf("sthp has %s=>(%d,%d)\n", kp, vst.x, vst.y);
	}

	printf("end\n");
}
#lang tcl
hash_1_4
} -output "start
ihi has 0=>100
ihi has 1=>101
ihi has 2=>102
ihs has zero=>100
ihs has one=>101
ihs has two=>102
ihf has 1.1=>100
ihf has 2.2=>101
ihf has 3.3=>102
ihp has 0=>100
ihp has two=>101
ihp has 3.3=>102
shi has 0=>zero
shi has 1=>one
shi has 2=>two
shs has zero=>zero0
shs has one=>one1
shs has two=>two2
shf has 1.1=>one.one
shf has 2.2=>two.two
shf has 3.3=>three.three
shp has 0=>zero
shp has 1.1=>one.one
shp has two=>two2
fhi has 0=>1.1
fhi has 1=>2.2
fhi has 2=>3.3
fhs has zero=>1.1
fhs has one=>2.2
fhs has two=>3.3
fhf has 1.1=>11.1
fhf has 2.2=>22.2
fhf has 3.3=>33.3
fhp has 0=>1.1
fhp has 1.1=>2.2
fhp has two=>3.3
phi has 0=>1
phi has 1=>two
phi has 2=>3.3
phs has zero=>1
phs has one=>two
phs has two=>3.3
phf has 1.1=>1
phf has 2.2=>two
phf has 3.3=>33.33
php has one=>1
php has 1.1=>two
php has 2=>3.3
sthi has 0=>(100,101)
sthi has 1=>(200,201)
sthi has 2=>(300,301)
sths has zero=>(100,101)
sths has one=>(200,201)
sths has two=>(300,301)
sthf has 1.1=>(100,101)
sthf has 2.2=>(200,201)
sthf has 3.3=>(300,301)
sthp has 0=>(100,101)
sthp has 1.1=>(200,201)
sthp has two=>(300,301)
end
"

test hash-1.5 {hashes of hashes and arrays} -body {
#lang L --line=1
void
hash_1_5()
{
	int	k1, k2;
	string	vs;
	string	hai[3]{int};
	string	hia{int}[3];
	string	hii{int}{int};
	string	hi{int};

	printf("start\n");

	// Array of hashes.
	hai[0]{1} = "01";
	hai[0]{6} = "06";
	hai[0]{5} = "05";
	hai[1]{2} = "12";
	hai[1]{3} = "13";
	hai[1]{0} = "10";
	hai[2]{0} = "20";
	hai[2]{1} = "21";
	hai[2]{2} = "22";
	foreach (hi in hai) {
		foreach (k1 in sort(keys(hi))) {
			printf("hai has %d=>%s\n", k1, hi{k1});
		}
	}

	// Hash of arrays.
	hia{1}[0] = "10";
	hia{1}[1] = "11";
	hia{1}[2] = "12";
	hia{0}[0] = "00";
	hia{0}[1] = "01";
	hia{0}[2] = "02";
	hia{2}[0] = "20";
	hia{2}[1] = "21";
	hia{2}[2] = "22";
	foreach (k1 in sort(keys(hia))) {
		foreach (vs in hia{k1}) {
			printf("hia{%d} has %s\n", k1, vs);
		}
	}

	// Hash of hashes.
	hii{0}{2} = "02";
	hii{1}{0} = "10";
	hii{0}{0} = "00";
	hii{2}{1} = "21";
	hii{1}{2} = "12";
	hii{1}{1} = "11";
	hii{0}{1} = "01";
	hii{2}{0} = "20";
	hii{2}{2} = "22";
	foreach (k1 in sort(keys(hii))) {
		foreach (k2 in sort(keys(hii{k1}))) {
			printf("hii{%d}{%d} has %s\n", k1, k2, hii{k1}{k2});
		}
	}

	printf("end\n");
}
#lang tcl
hash_1_5
} -output "start
hai has 1=>01
hai has 5=>05
hai has 6=>06
hai has 0=>10
hai has 2=>12
hai has 3=>13
hai has 0=>20
hai has 1=>21
hai has 2=>22
hia{0} has 00
hia{0} has 01
hia{0} has 02
hia{1} has 10
hia{1} has 11
hia{1} has 12
hia{2} has 20
hia{2} has 21
hia{2} has 22
hii{0}{0} has 00
hii{0}{1} has 01
hii{0}{2} has 02
hii{1}{0} has 10
hii{1}{1} has 11
hii{1}{2} has 12
hii{2}{0} has 20
hii{2}{1} has 21
hii{2}{2} has 22
end
"

test deep-1.1 {deep dive 1} -body {
#lang L --line=1
struct xy {
	string		x;
	string		y;
};
struct sd11 {
	string		a;
	string		b;
	struct xy	h{int};
};

void
deep_1_1()
{
	int		k1, k2;
	struct sd11	s;
	struct xy	xy;
	struct sd11	h{int};

	printf("start\n");

	/*
	 * Test a hash that has a struct that has another hash.
	 */

	h{0}.a = "h{0}.a";
	h{0}.b = "h{0}.b";
	h{0}.h{0}.x = "h{0}.h{0}.x";
	h{0}.h{0}.y = "h{0}.h{0}.y";
	h{1}.a = "h{1}.a";
	h{1}.b = "h{1}.b";
	h{1}.h{0}.x = "h{1}.h{0}.x";
	h{1}.h{0}.y = "h{1}.h{0}.y";
	h{1}.h{2}.x = "h{1}.h{2}.x";
	h{1}.h{2}.y = "h{1}.h{2}.y";

	foreach (k1=>s in h) {
		printf("h{%d}.a = %s\n", k1, s.a);
		printf("h{%d}.b = %s\n", k1, s.b);
		foreach (k2=>xy in s.h) {
			printf("h{%d}.h{%d}.x = %s\n", k1, k2, xy.x);
			printf("h{%d}.h{%d}.y = %s\n", k1, k2, xy.y);
		}
	}

	printf("end\n");
}
#lang tcl
deep_1_1
} -output "start
h{0}.a = h{0}.a
h{0}.b = h{0}.b
h{0}.h{0}.x = h{0}.h{0}.x
h{0}.h{0}.y = h{0}.h{0}.y
h{1}.a = h{1}.a
h{1}.b = h{1}.b
h{1}.h{0}.x = h{1}.h{0}.x
h{1}.h{0}.y = h{1}.h{0}.y
h{1}.h{2}.x = h{1}.h{2}.x
h{1}.h{2}.y = h{1}.h{2}.y
end
"

test deep-1.2 {deep dive with consecutive hash indices} -body {
#lang L --line=1
void
deep_1_2()
{
	int	k1, k2, k3, k4;
	string	v;
	string	h{int};
	string	hh{int}{int};
	string	hhh{int}{int}{int};
	string	hhhh{int}{int}{int}{int};

	printf("start\n");

	/*
	 * Test various cases with consecutive hash indices.
	 */

	hh{0}{0} = "00";
	hh{0}{1} = "01";
	hh{1}{0} = "10";
	foreach (k1=>h in hh) {
		foreach (k2=>v in h) {
			unless (hh{k1}{k2} eq h{k2}) {
				printf("bad 1\n");
			}
			printf("hh{%d}{%d} has %s\n", k1, k2, hh{k1}{k2});
		}
	}

	hhh{0}{0}{0} = "000";
	hhh{0}{0}{1} = "001";
	hhh{0}{1}{0} = "010";
	hhh{1}{0}{0} = "100";
	foreach (k1=>hh in hhh) {
		foreach (k2=>h in hh) {
			foreach (k3=>v in h) {
				unless (hhh{k1}{k2}{k3} eq hh{k2}{k3}) {
					printf("bad 2\n");
				}
				unless (hh{k2}{k3} eq h{k3}) {
					printf("bad 3\n");
				}
				printf("hhh{%d}{%d}{%d} has %s\n", k1, k2, k3,
				       hhh{k1}{k2}{k3});
			}
		}
	}

	hhhh{0}{0}{0}{0} = "0000";
	hhhh{0}{0}{0}{1} = "0001";
	hhhh{0}{0}{1}{0} = "0010";
	hhhh{0}{1}{0}{0} = "0100";
	hhhh{1}{0}{0}{0} = "1000";
	foreach (k1=>hhh in hhhh) {
		foreach (k2=>hh in hhh) {
			foreach (k3=>h in hh) {
				foreach (k4=>v in h) {
					unless (hhhh{k1}{k2}{k3}{k4} eq
						hhh{k2}{k3}{k4}) {
						printf("bad 4\n");
					}
					unless (hhh{k2}{k3}{k4} eq hh{k3}{k4}) {
						printf("bad 5\n");
					}
					unless (hh{k3}{k4} eq h{k4}) {
						printf("bad 6\n");
					}
					printf("hhhh{%d}{%d}{%d}{%d} has %s\n",
					       k1, k2, k3, k4,
					       hhhh{k1}{k2}{k3}{k4});
				}
			}
		}
	}

	printf("end\n");
}
#lang tcl
deep_1_2
} -output "start
hh{0}{0} has 00
hh{0}{1} has 01
hh{1}{0} has 10
hhh{0}{0}{0} has 000
hhh{0}{0}{1} has 001
hhh{0}{1}{0} has 010
hhh{1}{0}{0} has 100
hhhh{0}{0}{0}{0} has 0000
hhhh{0}{0}{0}{1} has 0001
hhhh{0}{0}{1}{0} has 0010
hhhh{0}{1}{0}{0} has 0100
hhhh{1}{0}{0}{0} has 1000
end
"

test deep-1.3 {deep dive with consecutive array indices} -body {
#lang L --line=1
void
deep_1_3()
{
	string	v;
	string	a[3];
	string	aa[2][2];
	string	aaa[2][2][2];
	string	aaaa[2][2][2][2];

	printf("start\n");

	/*
	 * Test various cases with consecutive array indices.
	 */

	a[0] = "0";
	a[1] = "1";
	a[2] = "2";
	foreach (v in a) {
		printf("a has '%s'\n", v);
	}

	aa[0][0] = "00";
	aa[0][1] = "01";
	aa[0][2] = "02";
	aa[1][0] = "10";
	foreach (a in aa) {
		foreach (v in a) {
			printf("aa has '%s'\n", v);
		}
	}

	aaa[0][0][0] = "000";
	aaa[0][0][1] = "001";
	aaa[0][1][0] = "010";
	aaa[0][1][1] = "011";
	aaa[1][0][0] = "100";
	foreach (aa in aaa) {
		foreach (a in aa) {
			foreach (v in a) {
				printf("aaa has '%s'\n", v);
			}
		}
	}

	aaaa[0][0][0][0] = "0000";
	aaaa[0][0][0][1] = "0001";
	aaaa[0][0][1][0] = "0010";
	aaaa[0][1][0][0] = "0100";
	aaaa[1][0][0][0] = "1000";
	foreach (aaa in aaaa) {
		foreach (aa in aaa) {
			foreach (a in aa) {
				foreach (v in a) {
					printf("aaaa has '%s'\n", v);
				}
			}
		}
	}

	printf("end\n");
}
#lang tcl
deep_1_3
} -output "start
a has '0'
a has '1'
a has '2'
aa has '00'
aa has '01'
aa has '02'
aa has '10'
aaa has '000'
aaa has '001'
aaa has '010'
aaa has '011'
aaa has '100'
aaaa has '0000'
aaaa has '0001'
aaaa has '0010'
aaaa has '0100'
aaaa has '1000'
end
"

test deep-1.4 {deep dive with alternating hash and array indices} -body {
#lang L --line=1
void
deep_1_4()
{
	/*
	 * Note that, because of the array auto-extend semantics, if
	 * you write to a[i] but there are values before index i not
	 * yet written, those get automatically set to an undefined
	 * value, which the foreach's will iterate through.  When used
	 * as a string, the undefined value shows up as "".  (Tcl
	 * doesn't let you use it as an integer, which is why the
	 * hashes are string hashes in these tests.)
	 */

	int	i, j, ki, k1, k2;
	string	vs;
	string	a[3];
	string	aa[3][3];
	string	h{int};
	string	hh{int}{int};
	string	ah[3]{int};
	string	ha{int}[3];
	string	aah[3][3]{int};
	string	aha[3]{int}[3];
	string	ahh[3]{int}{int};
	string	haa{int}[3][3];
	string	hah{int}[3]{int};
	string	hha{int}{int}[3];

	printf("start\n");

	ah[0]{0} = "ah[0]{0}";
	ah[2]{0} = "ah[2]{0}";
	ah[2]{1} = "ah[2]{1}";
	i = 0;
	foreach (h in ah) {
		foreach (ki=>vs in h) {
			unless (ah[i]{ki} eq vs) printf("bad 1\n");
			printf("ah[%d]{%d} = '%s'\n", i, ki, vs);
		}
		++i;
	}

	ha{0}[0] = "ha{0}[0]";
	ha{0}[1] = "ha{0}[1]";
	ha{1}[1] = "ha{1}[1]";
	foreach (ki=>a in ha) {
		i = 0;
		foreach (vs in a) {
			unless (ha{ki}[i] eq vs) printf("bad 2\n");
			printf("ha{%d}[%d] = '%s'\n", ki, i, vs);
			++i;
		}
	}

	aah[0][0]{0} = "aah[0][0]{0}";
	aah[0][1]{1} = "aah[0][1]{1}";
	aah[1][0]{2} = "aah[1][0]{2}";
	aah[1][0]{3} = "aah[1][0]{3}";
	i = 0;
	foreach (ah in aah) {
		j = 0;
		foreach (h in ah) {
			foreach (ki=>vs in h) {
				unless (aah[i][j]{ki} eq vs) printf("bad 3\n");
				unless (ah[j]{ki} eq vs) printf("bad 4\n");
				unless (h{ki} eq vs) printf("bad 5\n");
				printf("aah[%d][%d]{%d} = '%s'\n", i, j, ki,
				       aah[i][j]{ki});
			}
			++j;
		}
		++i;
	}

	aha[0]{0}[0] = "aha[0]{0}[0]";
	aha[0]{1}[1] = "aha[0]{1}[1]";
	aha[1]{2}[0] = "aha[1]{2}[0]";
	aha[0]{3}[2] = "aha[0]{3}[2]";
	i = 0;
	foreach (ha in aha) {
		foreach (ki=>a in ha) {
			j = 0;
			foreach (vs in a) {
				unless (aha[i]{ki}[j] eq vs) printf("bad 6\n");
				unless (ha{ki}[j] eq vs) printf("bad 7\n");
				unless (a[j] eq vs) printf("bad 7\n");
				printf("aha[%d]{%d}[%d] = '%s'\n", i, ki, j,
				       aha[i]{ki}[j]);
				++j;
			}
		}
		++i;
	}

	ahh[0]{0}{1} = "ahh[0]{0}{1}";
	ahh[0]{2}{3} = "ahh[0]{2}{3}";
	ahh[1]{4}{5} = "ahh[1]{4}{5}";
	ahh[2]{6}{7} = "ahh[2]{6}{7}";
	i = 0;
	foreach (hh in ahh) {
		foreach (k1=>h in hh) {
			foreach (k2=>vs in h) {
				unless (ahh[i]{k1}{k2} eq vs) printf("bad 7\n");
				unless (hh{k1}{k2} eq vs) printf("bad 8\n");
				unless (h{k2} eq vs) printf("bad 9\n");
			printf("ahh[%d]{%d}{%d} = '%s'\n", i, k1, k2,
			       ahh[i]{k1}{k2});
			}
		}
		++i;
	}

	haa{0}[0][0] = "haa{0}[0][0]";
	haa{0}[1][0] = "haa{0}[1][0]";
	haa{1}[0][0] = "haa{1}[0][0]";
	haa{2}[0][1] = "haa{2}[0][1]";
	foreach (ki=>aa in haa) {
		i = 0;
		foreach (a in aa) {
			j = 0;
			foreach (vs in a) {
				unless (haa{ki}[i][j] eq vs) printf("bad 10\n");
				unless (aa[i][j] eq vs) printf("bad 11\n");
				unless (a[j] eq vs) printf("bad 12\n");
				printf("haa{%d}[%d][%d] = '%s'\n", ki, i, j,
				       haa{ki}[i][j]);
				++j;
			}
			++i;
		}
	}

	hha{0}{1}[0] = "hha{0}{1}[0]";
	hha{2}{3}[0] = "hha{2}{3}[0]";
	hha{4}{5}[1] = "hha{4}{5}[1]";
	hha{6}{7}[2] = "hha{6}{7}[2]";
	foreach (k1=>ha in hha) {
		foreach (k2=>a in ha) {
			i = 0;
			foreach (vs in a) {
				unless (hha{k1}{k2}[i] eq vs) printf("bad13\n");
				unless (ha{k2}[i] eq vs) printf("bad 14n");
				unless (a[i] eq vs) printf("bad 15\n");
				printf("hha{%d}{%d}[%d] = '%s'\n", k1, k2, i,
				       hha{k1}{k2}[i]);
				++i;
			}
		}
	}

	hah{0}[0]{0} = "hah{0}[0]{0}";
	hah{1}[0]{2} = "hah{1}[0]{2}";
	hah{3}[1]{4} = "hah{3}[1]{4}";
	hah{5}[2]{6} = "hah{5}[2]{6}";
	foreach (k1=>ah in hah) {
		i = 0;
		foreach (h in ah) {
			foreach (k2=>vs in h) {
				unless (hah{k1}[i]{k2} eq vs) printf("bad16\n");
				unless (ah[i]{k2} eq vs) printf("bad 17\n");
				unless (h{k2} eq vs) printf("bad 18\n");
				printf("hah{%d}[%d]{%d} = '%s'\n", k1, i, k2,
				       hah{k1}[i]{k2});
			}
			++i;
		}
	}

	printf("end\n");
}

#lang tcl
deep_1_4
} -output {start
ah[0]{0} = 'ah[0]{0}'
ah[2]{0} = 'ah[2]{0}'
ah[2]{1} = 'ah[2]{1}'
ha{0}[0] = 'ha{0}[0]'
ha{0}[1] = 'ha{0}[1]'
ha{1}[0] = ''
ha{1}[1] = 'ha{1}[1]'
aah[0][0]{0} = 'aah[0][0]{0}'
aah[0][1]{1} = 'aah[0][1]{1}'
aah[1][0]{2} = 'aah[1][0]{2}'
aah[1][0]{3} = 'aah[1][0]{3}'
aha[0]{0}[0] = 'aha[0]{0}[0]'
aha[0]{1}[0] = ''
aha[0]{1}[1] = 'aha[0]{1}[1]'
aha[0]{3}[0] = ''
aha[0]{3}[1] = ''
aha[0]{3}[2] = 'aha[0]{3}[2]'
aha[1]{2}[0] = 'aha[1]{2}[0]'
ahh[0]{0}{1} = 'ahh[0]{0}{1}'
ahh[0]{2}{3} = 'ahh[0]{2}{3}'
ahh[1]{4}{5} = 'ahh[1]{4}{5}'
ahh[2]{6}{7} = 'ahh[2]{6}{7}'
haa{0}[0][0] = 'haa{0}[0][0]'
haa{0}[1][0] = 'haa{0}[1][0]'
haa{1}[0][0] = 'haa{1}[0][0]'
haa{2}[0][0] = ''
haa{2}[0][1] = 'haa{2}[0][1]'
hha{0}{1}[0] = 'hha{0}{1}[0]'
hha{2}{3}[0] = 'hha{2}{3}[0]'
hha{4}{5}[0] = ''
hha{4}{5}[1] = 'hha{4}{5}[1]'
hha{6}{7}[0] = ''
hha{6}{7}[1] = ''
hha{6}{7}[2] = 'hha{6}{7}[2]'
hah{0}[0]{0} = 'hah{0}[0]{0}'
hah{1}[0]{2} = 'hah{1}[0]{2}'
hah{3}[1]{4} = 'hah{3}[1]{4}'
hah{5}[2]{6} = 'hah{5}[2]{6}'
end
}

test deep-2.1 {deep dive array auto-extend} -body {
#lang L --line=1
void
deep_2_1()
{
	int	i, j;
	int	a1[];
	int	a2[];
	int	aa1[][];
	int	aa2[][];

	/*
	 * Test that arrays auto-extend properly.
	 */

	a1[0] = 0;
	a1[1] = 1;
	a1[2] = 2;
	unless ((a1[0] == 0) && (a1[1] == 1) && (a1[2] == 2)) {
		puts("a1 bad 1");
	}
	if (defined(a1[3])) puts("a1 bad 2");

	a2[1]  = 1;
	a2[3]  = 3;
	a2[6]  = 6;
	a2[10] = 10;
	unless ((a2[1] == 1) && (a2[3] == 3) && (a2[6] == 6) && (a2[10] == 10)) {
		puts("a2 bad 1");
	}
	if (defined(a2[0])) puts("a2 bad 2");
	if (defined(a2[2])) puts("a2 bad 3");
	if (defined(a2[4])) puts("a2 bad 4");
	if (defined(a2[5])) puts("a2 bad 5");
	if (defined(a2[7])) puts("a2 bad 6");
	if (defined(a2[8])) puts("a2 bad 7");
	if (defined(a2[9])) puts("a2 bad 8");
	if (defined(a2[11])) puts("a2 bad 9");

	/* Now check that the pad elements can be written and used. */
	a2[0] = 0;
	a2[2] = 2;
	a2[4] = 4;
	a2[5] = 5;
	unless ((a2[0] == 0) && (a2[2] == 2)) puts("a2 bad 10");
	unless ((a2[4] == 4) && (a2[5] == 5)) puts("a2 bad 11");
	if (defined(a2[7])) puts("a2 bad 12");
	if (defined(a2[8])) puts("a2 bad 13");
	if (defined(a2[9])) puts("a2 bad 14");
	if (defined(a2[11])) puts("a2 bad 15");

	aa1[0][0] = 100;
	aa1[0][1] = 101;
	aa1[0][2] = 102;
	aa1[1][0] = 110;
	aa1[1][1] = 111;
	aa1[2][0] = 120;
	unless ((aa1[0][0] == 100) && (aa1[0][1] == 101) && (aa1[0][2] == 102) &&
		(aa1[1][0] == 110) && (aa1[1][1] == 111) && (aa1[2][0] == 120)) {
		puts("aa1 bad 1");
	}
	if (defined(aa1[0][3])) puts("aa1 bad 2");
	if (defined(aa1[1][3])) puts("aa1 bad 3");
	if (defined(aa1[2][1])) puts("aa1 bad 4");

	aa2[1][1]   = 111;
	aa2[3][3]   = 133;
	aa2[6][6]   = 166;
	aa2[10][10] = 1010;
	unless ((aa2[1][1] == 111) && (aa2[3][3] == 133) && (aa2[6][6] == 166) &&
		(aa2[10][10] == 1010)) {
		puts("aa2 bad 2");
	}
	for (i = 0; i <= 10; ++i) {
		for (j = 0; j <= i; ++j) {
			if ((i == 1)  && (j == 1))  continue;
			if ((i == 3)  && (j == 3))  continue;
			if ((i == 6)  && (j == 6))  continue;
			if ((i == 10) && (j == 10)) continue;
			if (defined(aa2[i][j])) printf("aa2[%d][%d] defined\n",
						       i, j);
		}
	}
}
#lang tcl
deep_2_1
} -output ""

test deep-2.2 {check that a negative array index is an error} -body {
#lang L --line=1
void
deep_2_2()
{
	int	a[3];
	a[-1] = 0;
}
#lang tcl
deep_2_2
} -returnCodes error -match regexp -result {cannot write to negative array index}

test deep-2.3 {check deep-dive element create/read} -body {
#lang L --line=1
void
deep_2_3()
{
	/*
	 * This checks that an op= works on an undefined deep-dive
	 * element.  A string substitute is the only one we can test;
	 * because undef isn't a valid integer, ++a[0] would cause a
	 * run-time error that you can't use "" in a + operation.
	 */

	string	a[];
	string	h{string};

	h{"undefined"} =~ s//ShouldWork/;
	unless (h{"undefined"} eq "ShouldWork") puts("bad 1");

	a[0] =~ s//ShouldWork/;
	unless (a[0] eq "ShouldWork") puts("bad 2");
}
#lang tcl
deep_2_3
} -output {}

test deep-3.1 {check reading an undefined array index} -body {
#lang L --line=1
void
deep_3_1()
{
	int	i;
	int	a[] = {};

	/*
	 * Reading an array element with an undefined index should
	 * cause a run-time error.
	 */
	a[i];
}
deep_3_1();
} -returnCodes error -match glob -result {cannot read from undefined array index}

test deep-3.2 {check writing an undefined array index} -body {
#lang L --line=1
void
deep_3_2()
{
	int	i;
	int	a[] = {};

	/*
	 * Writing an array element with an undefined index should
	 * cause a run-time error.
	 */
	a[i] = 0;  // run-time error
}
deep_3_2();
} -returnCodes error -match glob -result {cannot write to undefined array index}

test deep-3.2.2 {check reading an undefined hash index} -body {
#lang L
void
deep_3_2_2()
{
	string	idx;
	string	h{string} = {};

	/*
	 * Reading a hash element with an undefined index should
	 * cause a run-time error.
	 */
	h{idx};
}
deep_3_2_2();
} -returnCodes error -match glob -result {cannot read from undefined hash index}

test deep-3.2.2.1 {check back-door reading undefined hash index} -setup {
	makeFile {
		string	s;
		string	deep_3_2_2h{string};

		deep_3_2_2h{s};
		puts("worked");
	} deep-3.2.2.1.l
} -body {
#lang L --line=1
void deep_3_2_2_1()
{
	/*
	 * Test the back door BK_L_ALLOW_UNDEF_HASH_INDEX=YES which
	 * allows using an undef hash index. Do this in its own tclsh
	 * instance since the env variable is read only at the first
	 * undef hash index.
	 */
	int	ret;
	string	err, out, tclsh = interpreter();

	putenv("BK_L_ALLOW_UNDEF_HASH_INDEX=YES");
	ret = system({tclsh, "deep-3.2.2.1.l"}, undef, &out, &err);
	if (ret) puts("bad 1");
	unless (out == "worked\n") puts("bad 2");
	putenv("BK_L_ALLOW_UNDEF_HASH_INDEX=");
}
deep_3_2_2_1();
} -output {}

test deep-3.2.3 {check writing an undefined hash index} -body {
#lang L
void
deep_3_2_3()
{
	string	idx;
	string	h{string} = {};

	/*
	 * Writing a hash element with an undefined index should
	 * cause a run-time error.
	 */
	h{idx} = "bad";
}
deep_3_2_3();
} -returnCodes error -match glob -result {cannot write to undefined hash index}

test deep-3.2.3.1 {check back-door writing undefined array index} -setup {
	makeFile {
		string	s;
		string	deep_3_2_3h{string};

		deep_3_2_3h{s} = "should be ok now";
		puts("worked");
	} deep-3.2.3.1.l
} -body {
#lang L --line=1
void deep_3_2_3_1()
{
	/*
	 * Test the back door BK_L_ALLOW_UNDEF_HASH_INDEX=YES which
	 * allows using an undef hash index. Do this in its own tclsh
	 * instance since the env variable is read only at the first
	 * undef hash index.
	 */
	int	ret;
	string	err, out, tclsh = interpreter();

	putenv("BK_L_ALLOW_UNDEF_HASH_INDEX=YES");
	ret = system({tclsh, "deep-3.2.3.1.l"}, undef, &out, &err);
	if (ret) puts("bad 1");
	unless (out == "worked\n") puts("bad 2");
	putenv("BK_L_ALLOW_UNDEF_HASH_INDEX=");
}
deep_3_2_3_1();
} -output {}

test deep-3.3 {check reading an undefined string index} -body {
#lang L --line=1
void
deep_3_3()
{
	int	i;
	string	s = "";

	/*
	 * Reading a string element with an undefined index should
	 * cause a run-time error.
	 */
	s[i];
}
deep_3_3();
} -returnCodes error -match glob -result {cannot read from undefined string index}

test deep-3.3.1 {check writing an undefined string index} -body {
#lang L
void
deep_3_3_1()
{
	int	i;
	string	s;

	/*
	 * Writing a string element with an undefined index should
	 * cause a run-time error.
	 */
	s[i] = "bad";
}
deep_3_3_1();
} -returnCodes error -match glob -result {cannot write to undefined string index}

test deep-3.4 {check writing an undefined array index} -body {
#lang L --line=1
void
deep_3_4()
{
	int	i;
	string	s = "";

	/*
	 * Writing a string element with an undefined index is
	 * illegal.
	 */

	s[i] = "bad";  // run-time error
}
deep_3_4();
} -returnCodes error -match regexp -result {cannot write to undefined string index}

test deep-3.5 {check compile-time undefined array and hash indices} -body {
#lang L --line=1
void deep_3_5()
{
	int	ia[];
	string	sa[], sh{string};

	/* These should all be compile-time errors. */

	ia[undef];
	sa[undef];
	ia[undef] = 1;
	sa[undef] = "bad";
	sh{undef};
	sh{undef} = "bad";
}
deep_3_5();
} -returnCodes error -match regexp -result {.*8: L Error: cannot use undef as an array/string index
.*9: L Error: cannot use undef as an array/string index
.*10: L Error: cannot use undef as an array/string index
.*11: L Error: cannot use undef as an array/string index
.*12: L Error: cannot use undef as a hash index
.*13: L Error: cannot use undef as a hash index
}

test deep-4.0 {check hash and array indexing of a poly} -body {
#lang L --line=1
void deep_4_0()
{
	poly	p;

	p = {};
	p{"key1"} = "val";
	p{"key2"} = 123;
	unless(p{"key1"} eq "val") puts("bad 1.1");
	unless(p{"key2"} == 123) puts("bad 1.2");

	p = {};
	p[0] = "val";
	p[1] = 123;
	unless(p[0] eq "val") puts("bad 2.1");
	unless(p[1] == 123) puts("bad 2.2");
}
deep_4_0();
} -output {}

test deep-5.1 {check deep-dive object sharing} -body {
#lang L --line=1
typedef struct block {
	string	line;
} block;

void deep_5_1()
{
	block	b, v1, v2;
	string	h{string}, h2{string}, h3{string};
	string	a1[][], a2[][];

	/*
	 * Having the rhs be a string concat creates an object with a
	 * refCount of 1.
	 */
	b.line = "LINE1" . "1";
	v1 = b;

	/*
	 * Now change b.line.  v1's copy should not change.
	 */
	b.line = "LINE2";
	v2 = b;

	unless (v1.line eq "LINE11") puts("v1 bad: ${v1}");
	unless (v2.line eq "LINE2") puts("v2 bad: ${v2}");

	/*
	 * Do it again but with a list of a list (2d array in this case).
	 * Having the rhs be a string concat creates an object with a
	 * refCount of 1.
	 */

	a1 = { { "old" . "val" } };
	a2 = a1;
	a1[0][0] = "newval";
	unless (a1[0][0] == "newval") puts("a1[][] bad 1");
	unless (a2[0][0] == "oldval") puts("a2[][] bad 2");

	a1 = { { } };
	a2 = a1;
	a1[0][0] = "newval";
	unless (a1[0][0] == "newval") puts("a1[][] bad 3");
	if (a2[0][0]) puts("a2[][] bad 4");

	/* Try the same thing with hashes. */

	h{"idx"} = "LINE1" . "1";
	h2 = h;

	h{"idx"} = "LINE2";
	h3 = h;

	unless (h2{"idx"} eq "LINE11") puts("h2 bad: ${h2}");
	unless (h3{"idx"} eq "LINE2") puts("h3 bad: ${h3}");
}
deep_5_1();
} -output {}

test regexp-1.0 {regular expression support} -body {
#lang L --line=1
void regexp_1_0() {
        string s = "string";
        puts(s =~ /ring/);
        puts(s =~ /bob/);
        puts(s !~ /ring/);
        puts(s !~ /bob/);
}
#lang tcl
regexp_1_0
} -output "1\n0\n0\n1\n"

test regexp-1.1 {magic submatch variables ($1, $2, ...)} -body {
#lang L --line=1
void regexp_1_1() {
        string s = "Go not to the elves for counsel, for they will say both yes and no.";

        if (s =~ /((Go).*(elves)).*/) {
                puts($0);
                puts($1);
                puts($2);
                puts($3);
        }
}
#lang tcl
regexp_1_1
} -output "Go not to the elves for counsel, for they will say both yes and no.
Go not to the elves\nGo\nelves\n"


test regexp-1.2 {magic submatch variables with interpolation} -body {
#lang L --line=1
void regexp_1_2() {
        string s = "Go not to the elves for counsel, for they will say both yes and no.";
        string interp = "elves";

        if (s =~ /((Go).*(${interp})).*/) {
                puts($0);
                puts($1);
                puts($2);
                puts($3);
        }
}
#lang tcl
regexp_1_2
} -output "Go not to the elves for counsel, for they will say both yes and no.
Go not to the elves\nGo\nelves\n"

test regexp-1.3 {regexp substitution} -body {
#lang L --line=1 -poly
void regexp_1_3() {
        string s = "string";
	string s1[] = {"a", "b", "coochie"};
	hash h[2];

        puts(s =~ m/ring/);
        puts(s =~ m|bob|);
	puts("--------");
	puts(s =~ s/ring/ling/);
	puts(s);
	puts("--------");
	puts(s1[2] =~ s/c/f/);
	puts(s1);
	puts("--------");
	h[0]{"a"} = "string";
	h[1]{"m"} = "not a string";
	puts(h);
	h[1]{"m"} =~ s/not a/probably a/;
	puts(h);
}
#lang tcl
regexp_1_3
} -output "1\n0\n--------\n1\nstling\n--------\n1\na b foochie\n--------\n{a string} {m {not a string}}\n{a string} {m {probably a string}}\n"

test regexp-1.4 {regexp modifiers i and g} -body {
#lang L --line=1 -poly
void regexp_1_4() {
	string foo = "aaa";
	foo =~ s/a/b/;
	puts(foo);
	foo =~ s/a/b/g;
	puts(foo);
	foo =~ s/B/a/;
	puts(foo);
	foo =~ s/B/a/i;
	puts(foo);
	foo =~ s/B/a/ig;
	puts(foo);
	if (foo =~ /A/) {
		puts("busted");
	}
	if (foo =~ /A/i) {
		puts("works");
	}
}
#lang tcl
regexp_1_4
} -output "baa\nbbb\nbbb\nabb\naaa\nworks\n"

test regexp-1.5 {regexp quoting} -body {
#lang L --line=1
void
regexp_1_5()
{
	string	r, s;

	s = "a b c d";
	s =~ s/\s//;
	unless (s eq "ab c d") puts("bad 1");

	s = "a  b    c     d";
	s =~ s/\s+//g;
	unless (s eq "abcd") puts("bad 2");

	r = "\\s+";
	s = "a  b    c     d";
	s =~ s/${r}//g;
	unless (s eq "abcd") puts("bad 3");

	r = "\\s+";
	s = "a  b    c     d";
	s =~ s/\${r}//g;
	unless (s eq "a  b    c     d") puts("bad 4");

	s = "$a$b";
	s =~ s/\$//g;  // should match a dollar sign
	unless (s eq "ab") puts("bad 5");

	r = "\\s+";
	s = '${r} ${r}';
	s =~ s/\${r}//g;  // should match '${r}' literally
	unless (s eq " ") puts("bad 6");

	s = "(in parens)";
	s =~ s/\(//;
	unless (s eq "in parens)") puts("bad 7");
	s =~ s/(in)//;
	unless (s eq " parens)") puts("bad 8");

	/*
	 * Check escapes in the substitution part:
	 *   & \0 \1 ... \9 get substituted with the re matches
	 *   \a \e \f \n \r \t get expanded to control chars
	 *   \x for anything else gets expanded to "x"
	 *   $0-$9 are synonyms for \0-\9
	 */

	/* Check &, \0, and $0. */
	s = "abc";
	s =~ s/b/x&y/;
	unless (s eq "axbyc") puts("bad 9.1");
	s = "abc";
	s =~ s/b/x\0y/;
	unless (s eq "axbyc") puts("bad 9.2");
	s = "abc";
	s =~ s/b/x$0y/;
	unless (s eq "axbyc") puts("bad 9.2.1");

	/* Check \1 through \9. */
	s = "123456789abc";
	s =~ s/123456789a(b)c/123456789c\1a/;
	unless (s eq "123456789cba") puts("bad 9.3");
	s = "123456789abc";
	s =~ s/12345678(9)a(b)c/123456789c\2a/;
	unless (s eq "123456789cba") puts("bad 9.4");
	s = "123456789abc";
	s =~ s/1234567(8)(9)a(b)c/123456789c\3a/;
	unless (s eq "123456789cba") puts("bad 9.5");
	s = "123456789abc";
	s =~ s/123456(7)(8)(9)a(b)c/123456789c\4a/;
	unless (s eq "123456789cba") puts("bad 9.6");
	s = "123456789abc";
	s =~ s/12345(6)(7)(8)(9)a(b)c/123456789c\5a/;
	unless (s eq "123456789cba") puts("bad 9.7");
	s = "123456789abc";
	s =~ s/1234(5)(6)(7)(8)(9)a(b)c/123456789c\6a/;
	unless (s eq "123456789cba") puts("bad 9.8");
	s = "123456789abc";
	s =~ s/123(4)(5)(6)(7)(8)(9)a(b)c/123456789c\7a/;
	unless (s eq "123456789cba") puts("bad 9.9");
	s = "123456789abc";
	s =~ s/12(3)(4)(5)(6)(7)(8)(9)a(b)c/123456789c\8a/;
	unless (s eq "123456789cba") puts("bad 9.10");
	s = "123456789abc";
	s =~ s/1(2)(3)(4)(5)(6)(7)(8)(9)a(b)c/123456789c\9a/;
	unless (s eq "123456789cba") puts("bad 9.11");

	/* Check $1 through $9. */
	s = "123456789abc";
	s =~ s/123456789a(b)c/123456789c$1a/;
	unless (s eq "123456789cba") puts("bad 9.12");
	s = "123456789abc";
	s =~ s/12345678(9)a(b)c/123456789c$2a/;
	unless (s eq "123456789cba") puts("bad 9.13");
	s = "123456789abc";
	s =~ s/1234567(8)(9)a(b)c/123456789c$3a/;
	unless (s eq "123456789cba") puts("bad 9.14");
	s = "123456789abc";
	s =~ s/123456(7)(8)(9)a(b)c/123456789c$4a/;
	unless (s eq "123456789cba") puts("bad 9.15");
	s = "123456789abc";
	s =~ s/12345(6)(7)(8)(9)a(b)c/123456789c$5a/;
	unless (s eq "123456789cba") puts("bad 9.16");
	s = "123456789abc";
	s =~ s/1234(5)(6)(7)(8)(9)a(b)c/123456789c$6a/;
	unless (s eq "123456789cba") puts("bad 9.17");
	s = "123456789abc";
	s =~ s/123(4)(5)(6)(7)(8)(9)a(b)c/123456789c$7a/;
	unless (s eq "123456789cba") puts("bad 9.18");
	s = "123456789abc";
	s =~ s/12(3)(4)(5)(6)(7)(8)(9)a(b)c/123456789c$8a/;
	unless (s eq "123456789cba") puts("bad 9.19");
	s = "123456789abc";
	s =~ s/1(2)(3)(4)(5)(6)(7)(8)(9)a(b)c/123456789c$9a/;
	unless (s eq "123456789cba") puts("bad 9.19.1");

	/* Make sure $a still works, where a != [0-9]. */
	s = "123456789abc";
	s =~ s/1(2)(3)(4)(5)(6)(7)(8)(9)a(b)c/123456789c$aa/;
	unless (s eq "123456789c$aa") puts("bad 9.19.2");

	/* Check \a \e \f \n \r \t. */
	s = "a\nb\n\nc\n\nd\n";
	s =~ s/\n\n/\n/g;
	unless (s eq "a\nb\nc\nd\n") puts("bad 9.20");

	/* Check \x for x being anything else. */
	s = "abc";
	s =~ s/b/a\bc/;
	unless (s eq "aabcc") puts("bad 9.30");
	s = "abc";
	s =~ s/b/a\&c/;
	unless (s eq "aa&cc") puts("bad 9.31");

	/*
	 * Re-do the above checks but put the escapes in an
	 * interpolated part of the substituted string.  This checks
	 * that they are properly processed at run time.
	 */

	/* Check & and \0. */
	s = "abc";
	r = "x&y";
	s =~ s/b/${r}/;
	unless (s eq "axbyc") puts("bad 10.1");
	s = "abc";
	r = "x\\0y";
	s =~ s/b/${r}/;
	unless (s eq "axbyc") puts("bad 10.2");

	/* Check \1 through \9. */
	s = "123456789abc";
	r = "123456789c\\1a";
	s =~ s/123456789a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.3");
	s = "123456789abc";
	r = "123456789c\\2a";
	s =~ s/12345678(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.4");
	s = "123456789abc";
	r = "123456789c\\3a";
	s =~ s/1234567(8)(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.5");
	s = "123456789abc";
	r = "123456789c\\4a";
	s =~ s/123456(7)(8)(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.6");
	s = "123456789abc";
	r = "123456789c\\5a";
	s =~ s/12345(6)(7)(8)(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.7");
	s = "123456789abc";
	r = "123456789c\\6a";
	s =~ s/1234(5)(6)(7)(8)(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.8");
	s = "123456789abc";
	r = "123456789c\\7a";
	s =~ s/123(4)(5)(6)(7)(8)(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.9");
	s = "123456789abc";
	r = "123456789c\\8a";
	s =~ s/12(3)(4)(5)(6)(7)(8)(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.10");
	s = "123456789abc";
	r = "123456789c\\9a";
	s =~ s/1(2)(3)(4)(5)(6)(7)(8)(9)a(b)c/${r}/;
	unless (s eq "123456789cba") puts("bad 10.11");

	/* Check \a \e \f \n \r \t. */
	s = "a\nb\n\nc\n\nd\n";
	r = "\\n";
	s =~ s/\n\n/${r}/g;
	unless (s eq "a\nb\nc\nd\n") puts("bad 10.20");

	/* Check \x for x being anything else. */
	s = "abc";
	r = "a\\bc";
	s =~ s/b/${r}/;
	unless (s eq "aabcc") puts("bad 10.30");
	s = "abc";
	r = "a\\&c";
	s =~ s/b/${r}/;
	unless (s eq "aa&cc") puts("bad 10.31");
}
#lang tcl
regexp_1_5
} -output ""

test regexp-1.6 {regexp capture variables in interpolated regexp} -body {
#lang L --line=1
void regexp_1_6()
{
	string	r1 = "(1)";
	string	r2 = "(1)(2)(3)(4)(5)(6)(7)(8)(9)";

	unless ("x1y" =~ /x${r1}y/) puts("bad 1.1");
	unless ($0 eq "x1y") puts("bad 1.2");
	unless ($1 eq "1") puts("bad 1.3");

	unless ("x123456789y" =~ /x${r2}y/) puts("bad 2.1");
	unless ($0 eq "x123456789y") puts("bad 2.2");
	unless ($1 eq "1") puts("bad 2.3");
	unless ($2 eq "2") puts("bad 2.4");
	unless ($3 eq "3") puts("bad 2.5");
	unless ($4 eq "4") puts("bad 2.6");
	unless ($5 eq "5") puts("bad 2.7");
	unless ($6 eq "6") puts("bad 2.8");
	unless ($7 eq "7") puts("bad 2.9");
	unless ($8 eq "8") puts("bad 2.10");
	unless ($9 eq "9") puts("bad 2.11");
}
regexp_1_6();
} -output {}

test regexp-1.7 {check number of regexp capture variables available} -body {
#lang L --line=1
void regexp_1_7()
{
	/*
	 * This is more of a performance check.  Ensure that in a
	 * regexp with no interpolations that no unneeded capture
	 * variables are allocated.
	 */

	puts($1);  // error -- no regexp seen yet, so $1 is not yet declared

	"x" =~ /(x)/;  // declares $1
	puts($2);  // error

	"x" =~ /(x)(y)/;  // declares $1 and $2
	puts($3);  // error
}
} -returnCodes error -match regexp -result {.*9: L Error: undeclared variable: \$1
.*12: L Error: undeclared variable: \$2
.*15: L Error: undeclared variable: \$3
}

test regexp-1.8 {check matching of different regexp kinds} -body {
#lang L --line=1
/*
 * The compiler generates four different kinds of code for regexp
 * matching.  This test checks each kind:
 * re is a string constant - INST_STR_EQ
 * re is a glob (/l modifier) - INST_STR_MATCH
 * re has no captures - INST_REGEXP
 * re has captures - ::regexp cmd
 */
int regexp_1_8_streq()       { return("abc" =~ /^abc$/); }
int regexp_1_8_strmatch()    { return("abc" =~ /abc/l); }
int regexp_1_8_simple_re()   { return("abc" =~ /a*bc/); }
int regexp_1_8_complex_re()  { return("abc" =~ /a*(b)c/); }
int regexp_1_8_complex_re2() { return("abc" =~ /^${""}abc$/); }
int regexp_1_8_complex_re3() { return("abc" =~ /^abc${""}$/); }
int regexp_1_8_complex_re4() { return("abc" =~ /^ab${""}c$/); }
void regexp_1_8()
{
	string	dis;

	unless (regexp_1_8_streq())       puts("bad 1.1");
	unless (regexp_1_8_strmatch())    puts("bad 1.2");
	unless (regexp_1_8_simple_re())   puts("bad 1.3");
	unless (regexp_1_8_complex_re())  puts("bad 1.4");
	unless (regexp_1_8_complex_re2()) puts("bad 1.5");
	unless (regexp_1_8_complex_re3()) puts("bad 1.6");
	unless (regexp_1_8_complex_re4()) puts("bad 1.7");

	/*
	 * Check the disassembly of the regexp matches to verify that
	 * they are compiled as expected.
	 */
	dis = ::tcl::unsupported::disassemble("proc", "regexp_1_8_streq");
	unless (dis =~ /streq/) puts("bad 2.1");
	dis = ::tcl::unsupported::disassemble("proc", "regexp_1_8_strmatch");
	unless (dis =~ /strmatch/) puts("bad 2.2");
	dis = ::tcl::unsupported::disassemble("proc", "regexp_1_8_simple_re");
	unless (dis =~ / regexp/) puts("bad 2.3");
	dis = ::tcl::unsupported::disassemble("proc", "regexp_1_8_complex_re");
	unless (dis =~ /::regexp/) puts("bad 2.4");
	dis = ::tcl::unsupported::disassemble("proc", "regexp_1_8_complex_re2");
	unless (dis =~ /::regexp/) puts("bad 2.5");
	dis = ::tcl::unsupported::disassemble("proc", "regexp_1_8_complex_re3");
	unless (dis =~ /::regexp/) puts("bad 2.6");
	dis = ::tcl::unsupported::disassemble("proc", "regexp_1_8_complex_re4");
	unless (dis =~ /::regexp/) puts("bad 2.7");
}
regexp_1_8();
} -output {}

test regexp-1.9 {check alternate regexp syntax} -body {
#lang L
void regexp_1_9()
{
	string	s;

	unless ("Hello World" =~ m!World!) puts("bad 1.1");
	unless ("Hello World" =~ m!world!i) puts("bad 1.2");

	unless ("Hello World" =~ m,World,) puts("bad 1.3");
	unless ("Hello World" =~ m,world,i) puts("bad 1.4");

	unless ("Hello World" =~ m/World/) puts("bad 1.5");
	unless ("Hello World" =~ m/world/i) puts("bad 1.6");

	unless ("/usr/bin/perl" =~ m"/perl") puts("bad 1.7");
	unless ("/usr/bin/perl" =~ m"/Perl"i) puts("bad 1.8");

	/*
	 * The following delims are special cases and must be matched
	 * as shown.  Using the start delim as the end delim is an
	 * error here, unlike all the other allowable delims.  This is
	 * for Perl compatibility.
	 */

	unless ("Hello World" =~ m{World}) puts("bad 2.1");
	unless ("Hello World" =~ m{world}i) puts("bad 2.2");

	/* Test alternate syntax like s{regexp}{replace}. */

	s = "xyzzy";
	s =~ s{xy}{zz};
	unless (s == "zzzzy") puts("bad 3.1");

	s = "xyzzy";
	s =~ s{XY}{zz}i;
	unless (s == "zzzzy") puts("bad 3.2");

	s = "xyzzy";
	s =~ s{xy}/zz/;
	unless (s == "zzzzy") puts("bad 3.3");

	s = "xyzzy";
	s =~ s{XY}/zz/i;
	unless (s == "zzzzy") puts("bad 3.4");
}
regexp_1_9();
} -output {}

test regexp-1.10 {test alternate regexp lexical and syntax errors} -setup {
	# This is a pain to test because tcltest cannot handle
	# the unbalanced {} () that we need in the L code.
	# Make the .l file using makeFile so we can quote those
	# characters and keep tcltest happy.
	makeFile "
		void main()
		{
			string	s;

			/*
			 * This tests when the regexp start delim is different
			 * than the end delim. The following are all errors,
			 * because the start delim is not escaped inside the
			 * regexp even though it is illegal to use it as
			 * the end delim.  This rule comes from Perl.
			 */
			s =~ m\{\{\};
			s =~ s\{\{\}\{\};

			/*
			 * Put this one last since it causes a syntax error.
			 * Although s{regexp}{replace} is legal,
			 * s/regexp//replace/ is not.
			 */
			s =~ s/regexp//replace/;
		}
	" regexp-1.10.l
} -body {
#lang L
void regexp_1_10()
{
	int	ret;
	string	tclsh = interpreter();
	string	out, err[];

	ret = system({tclsh, "regexp-1.10.l"}, undef, &out, &err);
	unless (ret == 1) puts("bad 1.1");
	if (out) puts("bad 1.2: ${out}");
	unless (err[0] =~ /:13: L Error: regexp delimiter must be quoted/) {
		puts("bad 1.3: ${err[0]}");
	}
	unless (err[1] =~ /:14: L Error: regexp delimiter must be quoted/) {
		puts("bad 1.4: ${err[1]}");
	}
	unless (err[2] =~ /:21: L Error: syntax error/) {
		puts("bad 1.5: ${err[2]}");
	}
}
regexp_1_10();
} -output {}

test regexp-1.11 {test regexp submatch captures with subst operator} -body {
#lang L --line=1
void regexp_1_11()
{
	string	s;

	/*
	 * A single substitution.
	 */
	s = "abcd";
	s =~ s/a(b)(c)d/a\2\1d/;
	unless (s == "acbd") puts("bad 1.1 '${s}'");
	unless ($0 == "abcd") puts("bad 1.2");
	unless ($1 == "b") puts("bad 1.3");
	unless ($2 == "c") puts("bad 1.4");

	/*
	 * Multiple substitutions. $0-$9 should reflect the last match.
	 */
	s = "abc1abc22abc333";
	s =~ s/a(b)(c)(\d+)/\3\2\1/g;
	unless (s == "1cb22cb333cb") puts("bad 2.1 '${s}'");
	unless ($0 == "abc333") puts("bad 2.2");
	unless ($1 == "b") puts("bad 2.3");
	unless ($2 == "c") puts("bad 2.4");
	unless ($3 == "333") puts("bad 2.5");
}
regexp_1_11();
} -output {}

test regexp-1.12 {check newline matching of . in regexp} -body {
#lang L --line=1
void regexp_1_12()
{
	/*
	 * "." in a regexp should not match embedded newlines.
	 */

	string	s1 = "a\nb";
	string	s2 = "a\n\nb";

	/*
	 * These used to compile to INST_STR_MATCH bytecodes.
	 */

	// s1 & s2 are Tcl_Obj's with no type yet
	if (s1 =~ /a.b/) puts("bad 1.1");
	if (s2 =~ /a.*b/) puts("bad 1.2");

	// make them type bytearray
	s1 = Binary_format("a*", s1);
	s2 = Binary_format("a*", s2);
	if (s1 =~ /a.b/) puts("bad 1.3");
	if (s2 =~ /a.*b/) puts("bad 1.4");

	// make them type string
	s1 = sprintf("%s", s1);
	s2 = sprintf("%s", s2);
	if (s1 =~ /a.b/) puts("bad 1.5");
	if (s2 =~ /a.*b/) puts("bad 1.6");

	/*
	 * These compile to INST_REGEXP bytecodes.
	 */

	if (s1 =~ /a.bc?/) puts("bad 2.1");
	if (s2 =~ /a.*bc?/) puts("bad 2.2");

	/*
	 * These compile to calls to the ::regexp cmd.
	 */

	if (s1 =~ /a.(b)/) puts("bad 3.1");
	if (s2 =~ /a.*(b)/) puts("bad 3.2");
}
regexp_1_12();
} -output {}

test regexp-2 {test globs} -body {
#lang L --line=1
void regexp_2()
{
	unless ("x" =~ /?/l) puts("bad 1.1");
	unless ("xy" =~ /??/l) puts("bad 1.2");
	unless ("xy" =~ /*y/l) puts("bad 1.3");  /* this comment is for emacs */
	unless ("xy" =~ /[x-z]y/l) puts("bad 1.4");
}
regexp_2();
} -output {}

test reference-1.1 {L references} -body {
#lang L --line=1
private int ref_11_g_private;
int ref_11_g_public;
struct reference_1_1_point {
	int x, y;
};
private void setvar(int &var, int val)
{
	var = val;
}
class ref_11_cls {
	public	int cpub;
	instance {
		public	int cinst;
	}
	constructor ref_11_cls_new()
	{
		setvar(&cpub, 123);
		unless (cpub == 123) puts("bad c.1");
		setvar(&cinst, 456);
		unless (cinst == 456) puts("bad c.2");
	}
}
void reference_1_1()
{
	int		local;
	ref_11_cls	o;
	struct reference_1_1_point a = { 0, 0 };

	unless ((a.x == 0) && (a.y == 0)) puts("bad 1.1");
	reference_1_1_tweak(&a);
	unless ((a.x == 2) && (a.y == 0)) puts("bad 1.2");

	setvar(&local, 222);
	unless (local == 222) puts("bad 2.1");

	o = ref_11_cls_new();
	unless (ref_11_cls->cpub == 123) puts("bad 3.1");
	unless (o->cinst == 456) puts("bad 3.2");

	setvar(&ref_11_cls->cpub, 234);
	unless (ref_11_cls->cpub == 234) puts("bad 3.3");

	setvar(&o->cinst, 567);
	unless (o->cinst == 567) puts("bad 3.4");

	setvar(&ref_11_g_public, 1100);
	unless (ref_11_g_public == 1100) puts("bad 4.1");

	setvar(&ref_11_g_private, 1200);
	unless (ref_11_g_private == 1200) puts("bad 4.2");
}
void reference_1_1_tweak(struct reference_1_1_point &foo)
{
	foo->x = 2;
}
reference_1_1();
} -output {}

test reference-1.2 {test deep-dive arguments (copy in/out)} -body {
#lang L --line=1
void r12set(string &s, string v) { s = v; }
void reference_1_2()
{
	string	a[];
	string	aa[][];
	string	aaa[][][];
	string	h{string};
	string	hh{string}{string};
	string	hhh{string}{string}{string};
	struct {
		string	s;
		string	a[];
		string	h{string};
	} st;

	r12set(&a[0], "zero");
	unless (a[0] eq "zero") puts("bad 1.1");
	r12set(&a[1], "one");
	unless ((a[0] eq "zero") && (a[1] eq "one")) puts("bad 1.2");
	r12set(&a[0], "is1");
	unless ((a[0] eq "is1") && (a[1] eq "one")) puts("bad 1.3");

	r12set(&aa[1][2], "12");
	unless (aa[1][2] eq "12") puts("bad 2.1");

	r12set(&aaa[3][2][1], "321");
	unless (aaa[3][2][1] eq "321") puts("bad 3.1");

	r12set(&h{"zero"}, "is0");
	unless (h{"zero"} eq "is0") puts("bad 10.1");

	r12set(&hh{"zero1"}{"zero2"}, "is00");
	unless (hh{"zero1"}{"zero2"} eq "is00") puts("bad 11.1");

	r12set(&hhh{"zero3"}{"zero2"}{"zero1"}, "is000");
	unless (hhh{"zero3"}{"zero2"}{"zero1"} eq "is000") puts("bad 12.1");

	r12set(&st.s, "iss");
	unless (st.s eq "iss") puts("bad 20.1");

	r12set(&st.a[3], "a-3");
	unless (st.a[3] eq "a-3") puts("bad 21.1");

	r12set(&st.h{"two"}, "h-2");
	unless (st.h{"two"} eq "h-2") puts("bad 22.1");
}
reference_1_2();
} -output {}

test reference-1.2.1 {test deep-dive copy in/out with built-in compiler functions} -body {
#lang L --line=1
void reference_1_2_1()
{
	string	cmd, s[];
	STATUS	st[];
	FILE	f;
	int	pid, ret;

	/*
	 * These tests pass array or hash elements as reference
	 * parameters.  The compiler implements these as
	 * copy-in/copy-out parameters and these used to not work
	 * with compiler built-ins.
	 */

	// check system(): out/err/STATUS args
	cmd = <<'END'
	perl -e 'print "test32"; print STDERR "yes1"; exit(0);'
	END;
	ret = system(cmd, undef, &s[0], &s[1], &st[0]);
	unless (ret == 0) puts("bad 1.1");
	unless (s[0] == "test32") puts("bad 1.2");
	unless (s[1] == "yes1") puts("bad 1.3");
	unless (st[0].argv[0] == "perl") puts("bad 1.4");

	// check read(): buf arg
	unless (Fprintf("ref-1-2-1.txt", "654321") == 0) puts("bad 2.1");
	unless (f = fopen("ref-1-2-1.txt", "r")) puts("bad 2.2");
	unless (read(f, &s[0]) == 6) puts("bad 2.3");
	unless (s[0] == "654321") pust("bad 2.4");
	fclose(f);
	unlink("ref-1-2-1.txt");

	// check spawn(): when the STATUS arg gets set
	cmd = "not-perl -e 'exit(123);'";
	pid = spawn(cmd, undef, undef, undef, &st[0]);
	if (defined(pid)) puts("bad 3.1");
	unless (st[0].argv == {"not-perl","-e","exit(123);"}) puts("bad 3.3");

	// check waitpid(): STATUS arg
	cmd = "perl -e 'exit(123);'";
	pid = spawn(cmd);
	unless (defined(pid)) puts("bad 4.1");
	unless (waitpid(pid, &st[0], 0) == pid) puts("bad 4.2");
	unless (st[0].argv == {"perl","-e","exit(123);"}) puts("bad 4.3");
}
reference_1_2_1();
} -output {}

test reference-1.3 {test copy in/out semantics} -body {
#lang L --line=1
string g_ref13[];
void r13(string &s, string v)
{
	s = v;
	g_ref13 = { "ch-one", "ch-two", "ch-three" };
}
void reference_1_3()
{
	g_ref13 = { "one", "two" };
	r13(&g_ref13[0], "new-one");
	unless (join("|", g_ref13) eq "new-one|ch-two|ch-three") puts("bad 1.1");
}
reference_1_3();
} -output {}

test reference-1.4 {test multiple reference arguments} -body {
#lang L --line=1
void reference_1_4_foo1(string &s1, string &s2)
{
	s1 = s2;
}
void reference_1_4_foo2(string &s1, string s2)
{
	s1 = s2;
	s2 = "bad";
}
void reference_1_4_foo3(string &s1, string s2, string &s3)
{
	s1 = sprintf("%s%s", s2, s3);
	s2 = "bad";
}
void reference_1_4_foo4(string &s1, string s2, string &s3)
{
	s1 = sprintf("%s%s", s2, s3);
	s3 = s2;
	s2 = "bad";
}
void reference_1_4_foo5(string &s1, string &s2, string &s3)
{
	s1 = sprintf("%s%s", s2, s3);
	s2 = s3;
	s3 = "x";
}
void reference_1_4_foo6(string &s1, string s2, string &s3, string s4)
{
	s1 = sprintf("%s%s", s2, s3);
	s3 = sprintf("%s%s", s3, s4);
	s2 = s4 = "bad";
}
void reference_1_4_foo7(string s1, string &s2, string s3, string s4, string &s5)
{
	s2 = sprintf("%s%s%s", s1, s2, s3);
	s5 = sprintf("%s%s%s", s3, s4, s5);
	s1 = s3 = s4 = "bad";
}
void reference_1_4()
{
	string	s1, s2, s3;

	s1 = "";
	s2 = "foo1";
	reference_1_4_foo1(&s1, &s2);
	unless (s1 eq "foo1") puts("bad 1.1");
	unless (s2 eq "foo1") puts("bad 1.2");

	s1 = "";
	reference_1_4_foo2(&s1, "foo2");
	unless (s1 eq "foo2") puts("bad 2.1");

	s1 = "";
	s2 = "xxx";
	reference_1_4_foo3(&s1, "foo3", &s2);
	unless (s1 eq "foo3xxx") puts("bad 3.1");
	unless (s2 eq "xxx") puts("bad 3.2");

	s1 = "xx";
	s2 = "yy";
	reference_1_4_foo4(&s1, "foo4", &s2);
	unless (s1 eq "foo4yy") puts("bad 4.1");
	unless (s2 eq "foo4") puts("bad 4.2");

	s1 = "zz";
	s2 = "xx";
	s3 = "yy";
	reference_1_4_foo5(&s1, &s2, &s3);
	unless (s1 eq "xxyy") puts("bad 4.1");
	unless (s2 eq "yy") puts("bad 4.2");
	unless (s3 eq "x") puts("bad 4.3");

	s1 = "x";
	s2 = "y";
	reference_1_4_foo6(&s1, "foo61", &s2, "foo62");
	unless (s1 eq "foo61y") puts("bad 5.1");
	unless (s2 eq "yfoo62") puts("bad 5.2");

	s1 = "a";
	s2 = "b";
	reference_1_4_foo7("foo71", &s1, "foo72", "foo73", &s2);
	unless (s1 eq "foo71afoo72") puts("bad 6.1");
	unless (s2 eq "foo72foo73b") puts("bad 6.2");
}
reference_1_4();
} -output {}

test reference-1.5 {test parameter multiple declaration errs with references} -body {
#lang L --line=1 -nowarn
void reference_1_5_1(string &arg1, string arg1)  {}
void reference_1_5_2(string &arg2, string &arg2) {}
void reference_1_5_3(string arg3,  string &arg3) {}
void reference_1_5_4(string &arg4, string &arg4, string arg4)  {}
void reference_1_5_5(string &arg5, string arg5,  string &arg5) {}
} -returnCodes error -match regexp -result {.*1: L Error: multiple declaration of local arg1
.*2: L Error: multiple declaration of local &arg2
.*3: L Error: multiple declaration of local arg3
.*4: L Error: multiple declaration of local &arg4
.*4: L Error: multiple declaration of local arg4
.*5: L Error: multiple declaration of local &arg5
.*5: L Error: multiple declaration of local arg5
.*5: L Error: multiple declaration of local arg5
}

test reference-1.6 {test reference parameter passed as a reference parameter} -body {
#lang L --line=1
string reference_1_6_g;
void reference_1_6_1(string &arg)
{
	arg .= "2";
	reference_1_6_2(&arg);
}
void reference_1_6_2(string &arg)
{
	arg .= "3";
}
void reference_1_6()
{
	string	s;

	s = "1";
	reference_1_6_1(&s);
	unless (s == "123") puts("bad 1");

	reference_1_6_g = "1";
	reference_1_6_1(&reference_1_6_g);
	unless (reference_1_6_g == "123") puts("bad 2");
}
reference_1_6();
} -output {}

test pointer-1 {check L pointers} -body {
#lang L --line=1
string	pointer_1_g_public;
private	string	pointer_1_g_private;
private string chk(_argused string opt, poly var)
{
	return (var);
}
class pointer_1_cls {
	public	string s;
	instance {
		public	string si;
	}
	constructor pointer_1_cls_new()
	{
		string	nm;

		nm = chk(textvariable: &pointer_1_g_public);
		unless (nm eq "::pointer_1_g_public") {
			puts("bad c1.1");
		}
		nm = chk(textvariable: &pointer_1_g_private);
		unless (nm =~ /::_[0-9]+%l_toplevel_pointer_1_g_private/) {
			puts("bad c1.2");
			puts(nm);
		}
		nm = chk(textvariable: &s);
		unless (nm eq "::L::_class_pointer_1_cls::s") {
			puts("bad c1.3");
		}
		nm = chk(textvariable: &si);
		unless (nm eq "::L::_instance_pointer_1_cls1::si") {
			puts("bad c1.4");
		}
	}
}
void pointer_1()
{
	string  nm;
	pointer_1_cls obj = pointer_1_cls_new();

	nm = chk(textvariable: &pointer_1_g_public);
	unless (nm eq "::pointer_1_g_public") {
		puts("bad 1.1");
	}
	nm = chk(textvariable: &pointer_1_g_private);
	unless (nm =~ /::_[0-9]+%l_toplevel_pointer_1_g_private/) {
		puts("bad 1.2");
	}
	nm = chk(textvariable: &pointer_1_cls->s);
	unless (nm eq "::L::_class_pointer_1_cls::s") {
		puts("bad 1.3");
	}
	nm = chk(textvariable: &obj->si);
	unless (nm eq "::L::_instance_pointer_1_cls1::si") {
		puts("bad 1.4");
	}
}
pointer_1();
} -output {}

test pointer-2 {check L pointer identification} -body {
#lang L --line=1
string	pointer_2_g;
private void chk(_argused string opt, poly arg, string varname)
{
	unless (arg =~ /${varname}/) puts("bad chk.1");
}
private string joinargs(...args)
{
	string	ret, s;

	foreach (s in args) {
		if (defined(ret)) {
			ret .= " " . s;
		} else {
			ret = s;
		}
	}
	return (ret);
}
void pointer_2()
{
	string	s;

	/* These are L pointers. */
	s = joinargs(textvariable: &pointer_2_g);
	unless (s eq "-textvariable ::pointer_2_g") puts("bad 1.1");
	s = joinargs(tvariable: &pointer_2_g);
	unless (s eq "-tvariable ::pointer_2_g") puts("bad 1.2");
	s = joinargs(variable: &pointer_2_g);
	unless (s eq "-variable ::pointer_2_g") puts("bad 1.3");

	/* These are reference parameters, not pointers. */
	s = joinargs(ariable: &s);
	unless (s eq "-ariable s") puts("bad 2.1");
	s = joinargs(o: &s);
	unless (s eq "-o s") puts("bad 2.2");

	/* Mix of L pointers and ref parms. */
	s = joinargs(textvariable: &pointer_2_g, &s);
	unless (s eq "-textvariable ::pointer_2_g s") puts("bad 3.1");
	s = joinargs(textvariable: &pointer_2_g, &s, &s);
	unless (s eq "-textvariable ::pointer_2_g s s") puts("bad 3.2");
	s = joinargs(&s, textvariable: &pointer_2_g);
	unless (s eq "s -textvariable ::pointer_2_g") puts("bad 3.3");
	s = joinargs(&s, &s, textvariable: &pointer_2_g);
	unless (s eq "s s -textvariable ::pointer_2_g") puts("bad 3.4");
	s = joinargs(&s, textvariable: &pointer_2_g, &s);
	unless (s eq "s -textvariable ::pointer_2_g s") puts("bad 3.5");
}
pointer_2();
} -output {}

test pointer-3 {check L pointer errors} -body {
#lang L --line=1 -nowarn
class pointer_3_cls {}
private void chk(_argused string opt, _argused poly arg) {}
void pointer_3()
{
	string	s;
	string	sa[];
	string	saa[][];
	string	h{string};

	/*
	 * These should all issue errors, not crash the compiler.
	 */
	chk(textvariable: &undeclared1);
	chk(textvariable: &undeclared2[2]);
	chk(textvariable: &undeclared3.s);
	chk(textvariable: &undeclared4->s);
	chk(textvariable: &pointer_3_cls->undeclared1);
	chk(textvariable: &pointer_3_cls->undeclared2[3]);
	chk(textvariable: &s);
	chk(textvariable: &sa[1]);
	chk(textvariable: &saa[1][2]);
	chk(textvariable: &h{"bad"});
	chk(textvariable: &chk);
}
} -returnCodes error -match regexp -result {.*13: L Error: undeclared variable: undeclared1
.*14: L Error: undeclared variable: undeclared2
.*15: L Error: undeclared variable: undeclared3
.*16: L Error: undeclared variable: undeclared4
.*17: L Error: undeclared1 is not a member of class pointer_3_cls
.*18: L Error: undeclared2 is not a member of class pointer_3_cls
.*19: L Error: illegal operand to &
.*20: L Error: illegal operand to &
.*21: L Error: illegal operand to &
.*22: L Error: illegal operand to &
.*23: L Error: illegal operand to &
}

test typedef-1.0 {basic typedef support} -body {
#lang L --line=1
typedef int typedef_1_0_foot[5];
typedef string typedef_1_0_nike;
typedef struct typedef_1_0_point {
  int x;
  int y;
} typedef_1_0_point;

void typedef_1_0() {
  puts(typedef_1_0_aux());
}

typedef_1_0_nike typedef_1_0_aux() {
  typedef_1_0_foot cheese;
  typedef_1_0_nike shoe = "pegasus";
  typedef_1_0_point p;

  p.x = 1;
  p.y = 2;
  puts(p);
  cheese[2] = 1;
  cheese[3] = 2;
  cheese[4] = 3;
  puts(cheese[3]);
  puts(shoe);
  return shoe;
}
#lang tcl
typedef_1_0
} -output "1 2\n2\npegasus\npegasus\n"

test typedef-1.1 {test redefining identical typedefs} -body {
#lang L --line=1
typedef int t1;
typedef int t1;
typedef int t1;

typedef float t2;
typedef float t2;
typedef float t2;

typedef string t3;
typedef string t3;
typedef string t3;

typedef widget t4;
typedef widget t4;
typedef widget t4;

typedef poly t5;
typedef poly t5;
typedef poly t5;

typedef int a11_1[];
typedef int a11_1[];
typedef int a11_1[];

typedef int a11_2[2];
typedef int a11_2[2];
typedef int a11_2[2];

typedef int a11_3{int};
typedef int a11_3{int};
typedef int a11_3{int};

typedef int a11_4[2][3];
typedef int a11_4a[3];
typedef a11_4a a11_4[2];

typedef struct { int x,y; } s11_1;
typedef struct { int x,y; } s11_1;
typedef struct { int x,y; } s11_1;

typedef int int_typedef;

typedef int h11_1{int};
typedef int h11_1{int_typedef};
typedef int_typedef h11_1{int};
typedef int_typedef h11_1{int_typedef};

typedef int h11_2{int}{int};
typedef int h11_2a{int};
typedef h11_2a h11_2{int};
} -output ""

test typedef-1.2 {test redefining different typedefs} -body {
#lang L --line=1
typedef int t12;
typedef float t12;
typedef string t12;
typedef widget t12;
typedef poly t12;     // not an error, but perhaps should be
typedef int t12[];
typedef int t12[2];
typedef int t12{int};
typedef struct { int i; } t12;

typedef int a12_1[];  // not an error -- array size is ignored
typedef int a12_1[2];

typedef int a12_2[2]; // not an error -- array size is ignored
typedef int a12_2[];

typedef int a12_3[2];
typedef string a12_3[2];

typedef int h12_1{int};
typedef int h12_1{string};

typedef int h12_2{int};
typedef string h12_2{int};

typedef int h12_3{int};
typedef string h12_3{string};

typedef struct { int x; } s12_1;
typedef struct { string x; } s12_1;

typedef struct { int x; } s12_2;
typedef struct { int x,y; } s12_2;

typedef struct { int x,y; } s12_3;
typedef struct { int x; } s12_3;

typedef struct s1 { int x; } s12_4;
typedef struct s2 { string x; } s12_4;

typedef struct s3 { int x; } s12_5;
typedef struct s4 { int x,y; } s12_5;

typedef struct s5 { int x,y; } s12_6;
typedef struct s6 { int x; } s12_6;
} -returnCodes error -match regexp -result {.*2: L Error: Cannot redefine type t12
.*3: L Error: Cannot redefine type t12
.*4: L Error: Cannot redefine type t12
.*6: L Error: Cannot redefine type t12
.*7: L Error: Cannot redefine type t12
.*8: L Error: Cannot redefine type t12
.*9: L Error: Cannot redefine type t12
.*18: L Error: Cannot redefine type a12_3
.*21: L Error: Cannot redefine type h12_1
.*24: L Error: Cannot redefine type h12_2
.*27: L Error: Cannot redefine type h12_3
.*30: L Error: Cannot redefine type s12_1
.*33: L Error: Cannot redefine type s12_2
.*36: L Error: Cannot redefine type s12_3
.*39: L Error: Cannot redefine type s12_4
.*42: L Error: Cannot redefine type s12_5
.*45: L Error: Cannot redefine type s12_6
}

test typedef-1.3 {test some typedef cases} -body {
#lang L --line=1
/*
 * This is really a regression test.  These have caused errors in the past.
 */
typedef int	int_t;
typedef int	h1_t{int_t};
typedef int_t	h2_t{int};
typedef int_t	h3_t{int_t};
void typedef_1_3()
{
	int	k, n;
	h1_t	h1 = { 1=>2 };
	h2_t	h2 = { 3=>4, 5=>6 };
	h3_t	h3 = { 7=>8, 9=>10, 11=>12 };

	unless (h1{1} == 2) puts("bad 1");
	n = 0;
	foreach (k in h1) ++n;
	unless (n == 1) puts("bad 2");

	unless ((h2{3} == 4) && (h2{5} == 6)) puts("bad 3");
	n = 0;
	foreach (k in h2) ++n;
	unless (n == 2) puts("bad 4");

	unless ((h3{7} == 8) && (h3{9} == 10) && (h3{11} == 12)) puts("bad 4");
	n = 0;
	foreach (k in h3) ++n;
	unless (n == 3) puts("bad 5");
}
#lang tcl
typedef_1_3
} -output {}

test typedef-1.4 {test another typedef case} -body {
#lang L --line=1
/* Another regression test.  This used to fail. */
typedef struct {
	int x;
	int y;
} typedef_1_4_t;

typedef_1_4_t typedef_1_4_bars{string};

void typedef_1_4_foo(typedef_1_4_t f)
{
	typedef_1_4_bars{"FOO"} = f;
	puts("X = ${f.x}");
}

void typedef_1_4()
{
	typedef_1_4_t	f = { 1, 2 };
	typedef_1_4_foo(f);
}
#lang tcl
typedef_1_4
} -output {X = 1
}


test defined-1.0 {interesting defined form support} -body {
#lang L --line=1
void defined_1_0() {
  int arr[5][2], i, j;
  for (i = 0; defined(arr[i]); i++) {
    for (j = 0; defined(arr[i][j]); j++) {
      puts(format("%d, %d", i, j));
    }
  }
  puts("-*-");
  puts(defined(arr[3]));
  puts(defined(arr[-1]));
}
#lang tcl
defined_1_0
} -output "-*-
0
0
"

test defined-1.1 {defined works on hashes} -body {
#lang L --line=1
void defined_1_1() {
	hash foo[5];

	foo[2]{"a"} = 1;
	foo[3]{"b"} = 2;
	
	if (defined(foo[2]{"a"})) {
		puts("defined works");
	}
	if (!defined(foo[2]{"b"})) {
		puts("defined works even better");
	}
}
#lang tcl
defined_1_1
} -output "defined works\ndefined works even better\n"

test main-1.0 {test that main gets called} -setup {
	set fname [makeFile {
		void main() {
			printf("main got called\n");
		}
	} test-1.0.l]
} -constraints {
	exec
} -body {
	exec [interpreter] $fname
} -cleanup {
	removeFile test-1.0.l
} -result {main got called}

test main-2.1 {test main() with one parameter} -setup {
	set fname [makeFile {
		void main(string av[]) {
			string	s;
			undef(av[0]);  // don't print av[0]
			foreach (s in av) printf("<${s}>");
		}
	} main-2.1.l]
} -constraints {
	exec
} -body {
	exec [interpreter] $fname arg1 arg2 arg3
} -cleanup {
	removeFile main-2.1.l
} -result {<arg1><arg2><arg3>}

test main-2.2 {test main() with two parameters} -setup {
	set fname [makeFile {
		void main(int ac, string av[]) {
			string	s;
			printf("<${ac}>");
			undef(av[0]);  // don't print av[0]
			foreach (s in av) printf("<${s}>");
		}
	} main-2.2.l]
} -constraints {
	exec
} -body {
	exec [interpreter] $fname arg1 arg2 arg3
} -cleanup {
	removeFile main-2.2.l
} -result {<4><arg1><arg2><arg3>}

test main-2.3 {test main() with three parameters} -setup {
	set fname [makeFile {
		putenv("MAIN23_TEST=YES");
		void main(int ac, string av[], string env{string}) {
			string	s;
			printf("<${ac}>");
			undef(av[0]);  // don't print av[0]
			foreach (s in av) printf("<${s}>");
			printf("<${env{"MAIN23_TEST"}}>");
		}
	} main-2.3.l]
} -constraints {
	exec
} -body {
	exec [interpreter] $fname arg1 arg2 arg3
} -cleanup {
	removeFile main-2.3.l
} -result {<4><arg1><arg2><arg3><YES>}

test main-3 {check that main() return value is tclsh exit status} -setup {
	set fname1 [makeFile {
			int main(string av[])
			{
				puts("main here");
				return (int)av[1];
			}
	} main-3-int.l]
	set fname2 [makeFile {
			void main()
			{
				puts("main here");
			}
	} main-3-void.l]
} -body {
#lang L --line=1
void main3()
{
	int	ret;
	string	out;
	string	tclsh = eval("interpreter");

	ret = system({tclsh, "main-3-int.l", 0}, undef, &out, undef);
	unless (ret == 0) puts("1.1");
	unless (out == "main here\n") puts("bad 1.2");

	ret = system({tclsh, "main-3-int.l", 1}, undef, &out, undef);
	unless (ret == 1) puts("bad 2.1");
	unless (out == "main here\n") puts("bad 2.2");

	ret = system({tclsh, "main-3-int.l", 123}, undef, &out, undef);
	unless (ret == 123) puts("bad 3.1");
	unless (out == "main here\n") puts("bad 3.2");

	/* Check that a void main() gives an exit status of 0. */
	ret = system({tclsh, "main-3-void.l", 123}, undef, &out, undef);
	unless (ret == 0) puts("bad 4.1");
	unless (out == "main here\n") puts("bad 4.2");
}
main3();
} -output {}

test main-4 {check main() type checking} -body {
#lang L --line=1
float main() { return (3.14159); }
void main(float bad) {}
void main(int ac, string bad) {}
void main(int ac, string av[], string bad) {}
void main(int bad1, string bad2[], string bad3{string}, string too_many) {}
} -returnCodes error -match regexp -result {.*1: L Error: main must have int or void return type
.*2: L Error: invalid parameter types for main\(\)
.*3: L Error: invalid parameter types for main\(\)
.*4: L Error: invalid parameter types for main\(\)
.*5: L Error: too many formal parameters for main\(\)
}

test defined-1.2 {defined operator on scalars} -body {
#lang L --line=1
int d12_fint() { return 0; }
float d12_ffloat() { return 0.0; }
string d12_fstring() { return "0"; }
void
defined_1_2()
{
	int	i;
	int	ii = 0;
	string	s;
	string	ss = "";
	float	f;
	float	ff = 3.14159;

	if (defined(i))  puts("err 1");
	unless (defined(ii)) puts("err 2");
	if (defined(s))  puts("err 3");
	unless (defined(ss)) puts("err 4");
	if (defined(f))  puts("err 5");
	unless (defined(ff)) puts("err 6");
	unless (defined(0))  puts("err 7");
	unless (defined(1))  puts("err 7");
	unless (defined("")) puts("err 8");
	unless (defined("x")) puts("err 9");
	unless (defined(0.0)) puts("err 10");
	unless (defined(1.0)) puts("err 11");
	unless (defined(d12_fint()))    puts("err 12");
	unless (defined(d12_ffloat()))  puts("err 13");
	unless (defined(d12_fstring())) puts("err 14");
	unless (defined(1-0))     puts("err 16");
	unless (defined(1+2+3+4)) puts("err 17");
}
#lang tcl
defined_1_2
} -output ""

test defined-1.3 {defined operator on auto-extended arrays} -body {
#lang L --line=1
void
defined_1_3()
{
	int	i;
	int	a[];
	int	a3[3] = {0, 0, 0};
	string	s[];
	string	s3[3] = {"", "", ""};
	float	f[];
	float	f3[3] = {0.0, 0.0, 0.0};
	string	h{int}[];

	a[3] = 3;
	a[5] = 5;
	a[6] = 6;
	a[8] = 8;
	if (defined(a[0]))     puts("err 1.1");
	if (defined(a[1]))     puts("err 1.2");
	if (defined(a[2]))     puts("err 1.3");
	unless (defined(a[3])) puts("err 1.4");
	if (defined(a[4]))     puts("err 1.5");
	unless (defined(a[5])) puts("err 1.6");
	unless (defined(a[6])) puts("err 1.7");
	if (defined(a[7]))     puts("err 1.8");
	unless (defined(a[8])) puts("err 1.9");
	for (i = 9; i < 1000; ++i) {
		if (defined(a[i])) printf("err 1.10 i=%d\n", i);
	}

	unless (defined(a3[0])) puts("err 2.1");
	unless (defined(a3[1])) puts("err 2.2");
	unless (defined(a3[2])) puts("err 2.3");
	for (i = 3; i < 1000; ++i) {
		if (defined(a3[i])) printf("err 2.4 i=%d\n", i);
	}

	s[3] = "3";
	s[5] = "5";
	s[6] = "6";
	s[8] = "8";
	if (defined(s[0]))     puts("err 3.1");
	if (defined(s[1]))     puts("err 3.2");
	if (defined(s[2]))     puts("err 3.3");
	unless (defined(s[3])) puts("err 3.4");
	if (defined(s[4]))     puts("err 3.5");
	unless (defined(s[5])) puts("err 3.6");
	unless (defined(s[6])) puts("err 3.7");
	if (defined(s[7]))     puts("err 3.8");
	unless (defined(s[8])) puts("err 3.9");
	for (i = 9; i < 1000; ++i) {
		if (defined(s[i])) printf("err 3.10 i=%d\n", i);
	}

	unless (defined(s3[0])) puts("err 4.1");
	unless (defined(s3[1])) puts("err 4.2");
	unless (defined(s3[2])) puts("err 4.3");
	for (i = 3; i < 1000; ++i) {
		if (defined(s3[i])) printf("err 4.4 i=%d\n", i);
	}

	f[3] = 3.0;
	f[5] = 5.0;
	f[6] = 6.0;
	f[8] = 8.0;
	if (defined(f[0]))     puts("err 5.1");
	if (defined(f[1]))     puts("err 5.2");
	if (defined(f[2]))     puts("err 5.3");
	unless (defined(f[3])) puts("err 5.4");
	if (defined(f[4]))     puts("err 5.5");
	unless (defined(f[5])) puts("err 5.6");
	unless (defined(f[6])) puts("err 5.7");
	if (defined(f[7]))     puts("err 5.8");
	unless (defined(f[8])) puts("err 5.9");
	for (i = 9; i < 1000; ++i) {
		if (defined(f[i])) printf("err 5.10 i=%d\n", i);
	}

	unless (defined(f3[0])) puts("err 5.1");
	unless (defined(f3[1])) puts("err 5.2");
	unless (defined(f3[2])) puts("err 5.3");
	for (i = 3; i < 1000; ++i) {
		if (defined(f3[i])) printf("err 5.4 i=%d\n", i);
	}

	h{0}[2] = "2";
	if (defined(h{0}[0]))     puts("err 6.1");
	if (defined(h{0}[1]))     puts("err 6.2");
	unless (defined(h{0}[2])) puts("err 6.3");
	if (defined(h{0}[3]))     puts("err 6.4");
}
#lang tcl
defined_1_3
} -output ""

test defined-1.4 {check propagation of undefined values} -body {
#lang L --line=1
int
d14(int i)
{
	return (i);
}
void
defined_1_4()
{
	int	i, j;
	int	a[];

	a[1] = 1;  // a[0] is now undefined
	i = a[0];  // i is now undefined
	j = d14(i);  // j is now undefined

	if (defined(a[0])) puts("err 1");
	if (defined(i)) puts("err 2");
	if (defined(j)) puts("err 3");
	if (defined(d14(i))) puts("err 4");
	if (defined(d14(j))) puts("err 5");
	if (defined(d14(d14(j)))) puts("err 6");
	if (defined(d14(d14(d14(j))))) puts("err 7");
}
#lang tcl
defined_1_4
} -output ""

test defined-1.5 {check that tcl shimmering does not make undef defined} -body {
#lang L --line=1
void defined_1_5()
{
	/*
	 * This tests that the use of the undefined "s" in the printf,
	 * or the undefined ah[0] in the foreach, does not shimmer the
	 * shared undef object to something that is defined.  This was
	 * a bug in an earlier implementation of undef.
	 */

	string	a[], s;
	int	ah[]{int}, k, v;

	s = a[0];  // s is now undef

	if (defined(s)) puts("bad 1.1");
	printf("s = '%s'\n", s);
	if (defined(s)) puts("bad 1.2");
	printf("s = '%s'\n", s);

	if (defined(ah[0])) puts("bad 2.1");
	foreach (k=>v in ah[0]) {}
	if (defined(ah[0])) puts("bad 2.2");
	if (defined(s)) puts("bad 1.3");
}
defined_1_5();
} -output {s = ''
s = ''
}

test defined-1.6 {check undef constant} -body {
#lang L --line=1
string defined_1_6_foo(string arg)
{
	if (arg) {
		return (arg);
	} else {
		return (undef);
	}
}
void defined_1_6()
{
	int	i;
	string	s;

	if (defined(undef)) puts("bad 0.1");

	i = undef;
	if (defined(i)) puts("bad 1.1");
	printf("i = '%s'\n", i);
	if (defined(i)) puts("bad 1.2");

	i = 0;
	unless (defined(i)) puts("bad 2.1");
	printf("i = '%s'\n", i);
	unless (defined(i)) puts("bad 2.2");

	i = undef;
	if (defined(i)) puts("bad 3.1");
	printf("i = '%s'\n", i);
	if (defined(i)) puts("bad 3.2");

	unless (defined(defined_1_6_foo("1"))) puts("bad 4.1");
	if (defined(defined_1_6_foo(s))) puts("bad 4.2");
	if (defined(defined_1_6_foo(undef))) puts("bad 4.3");
}
defined_1_6();
} -output {i = ''
i = '0'
i = ''
}

test defined-1.7 {check attempted assignment to undef} -body {
#lang L --line=1
void defined_1_7()
{
	undef = 1;
	undef += 1;
	++undef;
	undef--;
	undef =~ s/a/b/;
}
} -returnCodes error -match regexp -result {.*3: L Error: invalid l-value in assignment
.*4: L Error: invalid l-value in assignment
.*5: L Error: invalid l-value in inc/dec
.*6: L Error: invalid l-value in inc/dec
.*7: L Error: invalid l-value in =~
}

test defined-1.8 {check attempted declaration of undef} -body {
#lang L --line=1
void undef() {}
int undef;
void defined_1_8()
{
	int	undef;
}
} -returnCodes error -match regexp -result {.*1: L Error: cannot use undef for function name
.*2: L Error: cannot use undef for variable name
.*5: L Error: cannot use undef for variable name
}

test defined-1.9 {check that undef has type poly} -body {
#lang L --line=1
class defined_1_9_cls {}
void defined_1_9()
{
	int	i;
	float	f;
	string	s;
	int	a[], aa[][];
	int	h{int}, hh{int}{int};
	struct { int i,j; } st;
	defined_1_9_cls o;

	/* None of these should be type errors. */

	i = undef;
	if (defined(i)) puts("bad 1");
	f = undef;
	if (defined(f)) puts("bad 2");
	s = undef;
	if (defined(s)) puts("bad 3");
	a = undef;
	if (defined(a)) puts("bad 4");
	aa = undef;
	if (defined(aa)) puts("bad 5");
	h = undef;
	if (defined(h)) puts("bad 6");
	hh = undef;
	if (defined(hh)) puts("bad 7");
	st = undef;
	if (defined(st)) puts("bad 8");
	o = undef;
	if (defined(o)) puts("bad 9");
}
defined_1_9();
} -output {}

test defined-1.10 {check undef as a reference parameter} -body {
#lang L --line=1
void defined_1_10_foo(int &arg) { arg = 0; }
void defined_1_10()
{
	defined_1_10_foo(&undef);  // err
}
defined_1_10();
} -returnCodes error -match regexp -result {.*4: L Error: illegal operand to &
}

test defined-1.10.2 {check undef as a reference parameter 2} -setup {
	set fname1 [makeFile {
		// The docs say this causes a run-time error in foo().
		void foo(string &p)
		{
			puts(p);
		}
		void main()
		{
			foo(undef);
		}
	} defined-1-10-2-read.l .]
	set fname2 [makeFile {
		// The docs say this causes a run-time error in foo().
		void foo(string &p)
		{
			p = "x";
		}
		void main()
		{
			foo(undef);
		}
	} defined-1-10-2-write.l .]
} -body {
#lang L
void defined_1_10_2()
{
	int	ret;
	string	err[];
	string	tclsh = interpreter();

	ret = system({tclsh, "defined-1-10-2-read.l"}, undef, undef, &err);
	unless (ret) puts("bad 1");

	ret = system({tclsh, "defined-1-10-2-write.l"}, undef, undef, &err);
	unless (ret) puts("bad 2");
}
defined_1_10_2();
} -output {}

test defined-1.11 {check that assignment to part of an obj makes it defined} -body {
#lang L --line=1
void defined_1_11()
{
	string	s;
	string	a[];
	string	aa[][];
	string	h{string};
	string	hh{string}{string};

	if (defined(s)) puts("bad 1.1");
	s[0] = "x";
	unless (defined(s)) puts("bad 1.2");

	if (defined(a)) puts("bad 2.1");
	a[0] = "x";
	unless (defined(a)) puts("bad 2.2");

	if (defined(aa)) puts("bad 3.1");
	a[0][0] = "x";
	unless (defined(a)) puts("bad 3.2");
	unless (defined(a[0])) puts("bad 3.3");

	if (defined(h)) puts("bad 4.1");
	h{"k"} = "v";
	unless (defined(h)) puts("bad 4.2");

	if (defined(hh)) puts("bad 5.1");
	hh{"k1"}{"k2"} = "v";
	unless (defined(hh)) puts("bad 5.2");
	unless (defined(hh{"k1"})) puts("bad 5.3");
}
defined_1_11();
} -output {}

test defined-1.12 {check defined(&var)} -body {
#lang L --line=1 -nowarn
string def1_12_g1 = "global1";
string def1_12_g2 = "global2";
string def1_12_g3 = "global3";

// The args are all named differently on purpose.
string def1_12_f1(string &a1)
{
	return ((string)defined(&a1));
}
string def1_12_f2(string &a2, string &b2)
{
	return ((string)defined(&a2) . (string)defined(&b2));
}
string def1_12_f3(string &a3, string &b3, string &c3)
{
	return ((string)defined(&a3) . (string)defined(&b3) .
		(string)defined(&c3));
}
string def1_12_ff(string &a4, string &b4)
{
	return (def1_12_f1(&a4) . def1_12_f1(&b4));
}
void defined_1_12()
{
	string	a, b, c;

	unless (def1_12_f1(&a) eq "1") puts("bad 1.1");
	unless (def1_12_f1(undef) eq "0") puts("bad 1.2");

	unless (def1_12_f2(&a, &b) eq "11") puts("bad 2.1");
	unless (def1_12_f2(undef, &b) eq "01") puts("bad 2.2");
	unless (def1_12_f2(&a, undef) eq "10") puts("bad 2.3");
	unless (def1_12_f2(undef, undef) eq "00") puts("bad 2.4");

	unless (def1_12_f3(&a, &b, &c) eq "111") puts("bad 3.1");
	unless (def1_12_f3(undef, &b, &c) eq "011") puts("bad 3.2");
	unless (def1_12_f3(&a, undef, &c) eq "101") puts("bad 3.3");
	unless (def1_12_f3(&a, &b, undef) eq "110") puts("bad 3.4");
	unless (def1_12_f3(undef, &b, undef) eq "010") puts("bad 3.5");
	unless (def1_12_f3(undef, undef, &a) eq "001") puts("bad 3.6");
	unless (def1_12_f3(&a, undef, undef) eq "100") puts("bad 3.7");
	unless (def1_12_f3(undef, undef, undef) eq "000") puts("bad 3.8");

	unless (def1_12_ff(&a, &b) eq "11") puts("bad 4.1");
	unless (def1_12_ff(undef, &b) eq "01") puts("bad 4.2");
	unless (def1_12_ff(&a, undef) eq "10") puts("bad 4.3");
	unless (def1_12_ff(undef, undef) eq "00") puts("bad 4.4");

	unless (def1_12_f1(&def1_12_g1) eq "1") puts("bad 5.1");
	unless (def1_12_f2(&def1_12_g1, &def1_12_g2) eq "11") puts("bad 5.2");
	unless (def1_12_f3(&def1_12_g1, &def1_12_g2, &def1_12_g3) eq "111") {
		puts("bad 5.2");
	}
}
defined_1_12();
} -output {}

test defined-1.13 {check errors with defined(&var)} -body {
#lang L --line=1 -nowarn
private string not_a_ref_parm1;
string not_a_ref_parm2;
class def_1_13_cls
{
	public string	not_a_ref_parm3;
	instance {
		public string	not_a_ref_parm4;
	}
}
void defined_1_13()
{
	string	not_a_ref_parm5;
	def_1_13_cls obj = def_1_13_cls_new();

	defined(&not_declared);
	defined(&not_a_ref_parm1);
	defined(&not_a_ref_parm2);
	defined(&def_1_13_cls->not_a_ref_parm3);
	defined(&obj->not_a_ref_parm4);
	defined(&not_a_ref_parm5);
	defined(&defined_1_13);  // fn ptr
	defined(&3);
}
defined_1_13();
} -returnCodes error -match regexp -result {.*15: L Error:.*not a call-by-reference parm
.*16: L Error:.*not a call-by-reference parm
.*17: L Error:.*not a call-by-reference parm
.*18: L Error:.*not a call-by-reference parm
.*19: L Error:.*not a call-by-reference parm
.*20: L Error:.*not a call-by-reference parm
.*21: L Error:.*not a call-by-reference parm
.*22: L Error:.*not a call-by-reference parm
}

test defined-1.14 {check that undef is false} -body {
#lang L --line=1
string defined_1_14fn(_argused string &s)
{
	if (&s) {
		return ("def");
	} else {
		return ("undef");
	}
}
void defined_1_14()
{
	int	i;
	string	s;
	string	a[];
	string	h{string};
	struct { int i; int j; } st;
	poly	p;

	if (undef) puts("bad 1");
	if (i) puts("bad 2");
	if (s) puts("bad 3");
	if (p) puts("bad 4.1");
	if (a) puts("bad 4.2");
	if (h) puts("bad 4.3");
	if (st) puts("bad 4.4");
	unless (defined_1_14fn(&s) eq "def") puts("bad 4.5");
	unless (defined_1_14fn(undef) eq "undef") puts("bad 4.6");

	/* Check that Tcl code does the same thing. */
	eval('if {$i} {puts "bad 5"}');
	eval('if {$s} {puts "bad 6"}');
	eval('if {$p} {puts "bad 7"}');
	eval('if {$a} {puts "bad 8"}');
	eval('if {$h} {puts "bad 8"}');
	eval('if {$st} {puts "bad 10"}');
}
defined_1_14();
} -output {}

test defined-1.15 {check that undef != anything defined} -body {
#lang L --line=1
void defined_1_15()
{
	int	i;
	string	s;
	poly	p;

	if (defined(i) || defined(s) || defined(p)) puts("bad");

	if (i == 0) puts("bad 1.1");
	unless (i != 0) puts("bad 1.2");

	if (s eq "") puts("bad 2.1");
	unless (s ne "") puts("bad 2.2");

	if (p eq "") puts("bad 3.1");
	unless (p ne "") puts("bad 3.2");

	/*
	 * An L regexp compiles down to different opcodes depending on the
	 * complexity of the regexp, so test each.
	 */
	if (s =~ /^$/) puts("bad 4.1");		// constant (INST_STR_EQ)
	if (s =~ /.*/) puts("bad 4.2");		// glob (INST_STR_MATCH)
	if (s =~ /x*/) puts("bad 4.2");		// non-glob re (INST_REGEXP)
	if (s =~ //g) puts("bad 4.3");		// complex (::regexp cmd)

	/* Check that Tcl code does the same thing. */
	eval('if {$i == 0}  {puts "bad 5.1"}');
	eval('if {$s == ""} {puts "bad 5.2"}');
}
defined_1_15();
} -output {}

test defined-1.16 {check calling defined proc from Tcl code} -body {
#lang L
void defined_1_16()
{
	string	d = "this is defined";
	string	u;  // this is not

	if (defined(u)) puts("bad 1.1");
	eval('if [defined $u] {puts "bad 1.2"}');

	unless (defined(d)) puts("bad 2.1");
	eval('if ![defined $d] {puts "bad 2.2"}');
}
defined_1_16();
} -output {}

test undef-1 {check undef built-in} -body {
#lang L --line=1
void undef_1()
{
	string	s;
	string	a[], a2[];
	string	h{string}, h2{string};

	h = { "k1"=>"v1", "k2"=>"v2", "k3"=>"v3" };
	h2 = h;
	undef(h{"k1"});
	unless (length(h) == 2) puts("bad 1.1");
	unless ((h{"k2"} eq "v2") && (h{"k3"} eq "v3")) puts("bad 1.2");
	undef(h{"k2"});
	unless (length(h) == 1) puts("bad 1.3");
	unless (h{"k3"} eq "v3") puts("bad 1.4");
	undef(h{"k3"});
	unless (length(h) == 0) puts("bad 1.5");
	unless (defined(h)) puts("bad 1.6");

	/* Make sure deleting from h didn't affect a copy of h. */
	unless (length(h2) == 3) puts("bad 2.1");
	unless ((h2{"k1"} eq "v1") && (h2{"k2"} eq "v2")) puts("bad 2.2");
	unless (h2{"k3"} eq "v3") puts("bad 2.3");

	/*
	 * Deleting a non-existent hash element is legal.  Deep-dive
	 * semantics says to create the element, then it gets deleted.
	 */
	h = {};
	undef(h{"not_here"});
	unless (length(h) == 0) puts("bad 3.1");
	unless (defined(h)) puts("bad 3.2");

	a = { "1", "2", "3" };
	a2 = a;
	undef(a[0]);
	unless (length(a) == 2) puts("bad 4.1");
	unless ((a[0] eq "2") && (a[1] eq "3")) puts("bad 4.2");
	undef(a[0]);
	unless (length(a) == 1) puts("bad 4.3");
	unless (a[0] eq "3") puts("bad 4.4");
	undef(a[0]);
	unless (length(a) == 0) puts("bad 4.5");
	unless (defined(a)) puts("bad 4.6");

	/* Make sure deleting from "a" didn't affect a copy of "a". */
	unless (length(a2) == 3) puts("bad 5.1");
	unless ((a2[0] eq "1") && (a2[1] eq "2")) puts("bad 5.2");
	unless (a2[2] eq "3") puts("bad 5.3");

	/*
	 * Deleting a non-existent array element is legal.  Deep-dive
	 * semantics says to create the element (AND all before it),
	 * then it gets deleted but all the elements before it remain.
	 */
	a = {};
	undef(a[3]);
	unless (length(a) == 3) puts("bad 6.1");
	unless (defined(a)) puts("bad 6.2");
	if (defined(a[0]) || defined(a[1]) || defined(a[2])) puts("bad 6.3");

	s = "0123456789";
	undef(s[0]);
	unless (s eq "123456789") puts("bad 10.1");
	undef(s[1]);
	unless (s eq "13456789") puts("bad 10.2");
	undef(s[7]);
	unless (s eq "1345678") puts("bad 10.3");

	/* undef(var) is like var=undef. */
	s = "testing";
	undef(s);
	if (defined(s)) puts("bad 20.1");
}
undef_1();
} -output {}

test undef-2 {check undef built-in on nested arrays and hashes} -body {
#lang L --line=1
void undef_2()
{
	int	a[][] = { {1,2,3}, {4,5,6}, {7,8,9} };
	int	h{int}{int} = {
		1 => { 10=>10, 20=>20, 30=>30 },
		2 => { 10=>10, 20=>20, 30=>30 },
		3 => { 10=>10, 20=>20, 30=>30 },
	};

	undef(h{2});
	unless (length(h) == 2) puts("bad 1.1");

	undef(h{1}{20});
	unless (length(h{1}) == 2) puts("bad 2.1");
	unless ((h{1}{10} == 10) && (h{1}{30} == 30)) puts("bad 2.2");
	undef(h{1}{10});
	unless (length(h{1}) == 1) puts("bad 2.3");
	unless (h{1}{30} == 30) puts("bad 2.4");
	undef(h{1}{30});
	unless (length(h{1}) == 0) puts("bad 2.5");

	unless (length(h) == 2) puts("bad 3.1");
	undef(h{1});
	unless (length(h) == 1) puts("bad 3.3");
	unless (length(h{3}) == 3) puts("bad 3.4");

	undef(a[1]);
	unless (length(a) == 2) puts("bad 4.1");
	unless (length(a[0]) == 3) puts("bad 4.2");
	unless (length(a[1]) == 3) puts("bad 4.3");
	unless ((a[0][0] == 1) && (a[0][1] == 2)) puts("bad 4.4");
	unless (a[0][2] == 3) puts("bad 4.5");

	undef(a[1][1]);
	unless (length(a[1]) == 2) puts("bad 5.1");
	unless ((a[1][0] == 7) && (a[1][1] == 9)) puts("bad 5.2");

	undef(a[0]);
	unless (length(a) == 1) puts("bad 6.1");
	unless (length(a[0]) == 2) puts("bad 6.2");
	undef(a[0]);
	unless (length(a) == 0) puts("bad 6.3");
}
undef_2();
} -output {}

test undef-3 {check undef built-in on class variables} -body {
#lang L --line=1
class undef_3_cls {
	public	string hcls{string};
	public	string acls[];
	public	string scls;
	instance {
		public	string hins{string};
		public	string ains[];
		public	string sins;
	}
}
void undef_3()
{
	undef_3_cls obj = undef_3_cls_new();

	undef_3_cls->hcls = { "k1"=>"v1", "k2"=>"v2", "k3"=>"v3" };
	undef(undef_3_cls->hcls{"k1"});
	unless (length(undef_3_cls->hcls) == 2) puts("bad 1.1");
	unless (undef_3_cls->hcls{"k2"} eq "v2") puts("bad 1.2");
	unless (undef_3_cls->hcls{"k3"} eq "v3") puts("bad 1.3");
	undef(undef_3_cls->hcls{"k2"});
	unless (length(undef_3_cls->hcls) == 1) puts("bad 1.4");
	unless (undef_3_cls->hcls{"k3"} eq "v3") puts("bad 1.5");
	undef(undef_3_cls->hcls{"k3"});
	unless (length(undef_3_cls->hcls) == 0) puts("bad 1.6");
	unless (defined(undef_3_cls->hcls)) puts("bad 1.7");

	undef_3_cls->acls = { "1", "2", "3" };
	undef(undef_3_cls->acls[0]);
	unless (length(undef_3_cls->acls) == 2) puts("bad 2.1");
	unless (undef_3_cls->acls[0] eq "2") puts("bad 2.2");
	unless (undef_3_cls->acls[1] eq "3") puts("bad 2.3");
	undef(undef_3_cls->acls[0]);
	unless (length(undef_3_cls->acls) == 1) puts("bad 2.4");
	unless (undef_3_cls->acls[0] eq "3") puts("bad 2.5");
	undef(undef_3_cls->acls[0]);
	unless (length(undef_3_cls->acls) == 0) puts("bad 2.6");
	unless (defined(undef_3_cls->acls)) puts("bad 2.7");

	obj->hins = { "k1"=>"v1", "k2"=>"v2", "k3"=>"v3" };
	undef(obj->hins{"k1"});
	unless (length(obj->hins) == 2) puts("bad 3.1");
	unless (obj->hins{"k2"} eq "v2") puts("bad 3.2");
	unless (obj->hins{"k3"} eq "v3") puts("bad 3.3");
	undef(obj->hins{"k2"});
	unless (length(obj->hins) == 1) puts("bad 3.4");
	unless (obj->hins{"k3"} eq "v3") puts("bad 3.5");
	undef(obj->hins{"k3"});
	unless (length(obj->hins) == 0) puts("bad 3.6");
	unless (defined(obj->hins)) puts("bad 3.7");

	obj->ains = { "1", "2", "3" };
	undef(obj->ains[0]);
	unless (length(obj->ains) == 2) puts("bad 4.1");
	unless (obj->ains[0] eq "2") puts("bad 4.2");
	unless (obj->ains[1] eq "3") puts("bad 4.3");
	undef(obj->ains[0]);
	unless (length(obj->ains) == 1) puts("bad 4.4");
	unless (obj->ains[0] eq "3") puts("bad 4.5");
	undef(obj->ains[0]);
	unless (length(obj->ains) == 0) puts("bad 4.6");
	unless (defined(obj->ains)) puts("bad 4.7");

	undef_3_cls->scls = "testing";
	undef(undef_3_cls->scls);
	if (defined(undef_3_cls->scls)) puts("bad 5.1");

	obj->sins = "testing";
	undef(obj->sins);
	if (defined(obj->sins)) puts("bad 6.1");
}
undef_3();
} -output {}

test undef-4 {check undef built-in errors} -body {
#lang L --line=1
private string[] foo() { return {"x"}; }
void undef_4()
{
	string	a[];
	struct { int i,j; } st;

	undef();
	undef(a[0], a[1]);
	undef(a[1..3]);
	undef(foo());
	undef(st.i);
	undef(3);
}
undef_4();
} -returnCodes error -match regexp -result {.*7: L Error: incorrect # args to undef
.*8: L Error: incorrect # args to undef
.*9: L Error: illegal l-value in undef\(\)
.*10: L Error: illegal l-value in undef\(\)
.*11: L Error: cannot undef\(\) a struct field
.*12: L Error: illegal l-value in undef\(\)
}

test undef-5 {check that undefined list goes to defined} -body {
#lang L --line=1
void undef_5()
{
	string	a[] = {"x"};

	a = undef;
	if (defined(a)) puts("bad 1.1");
	a[END+1] = "x";
	unless (defined(a)) puts("bad 1.2");

	a = undef;
	if (defined(a)) puts("bad 2.1");
	push(&a, "x");
	unless (defined(a)) puts("bad 2.2");

	a = undef;
	if (defined(a)) puts("bad 3.1");
	a[0] = "x";
	unless (defined(a)) puts("bad 3.2");

	a = undef;
	if (defined(a)) puts("bad 4.1");
	a[10] = "x";
	unless (defined(a)) puts("bad 4.2");

	a = undef;
	if (defined(a)) puts("bad 5.1");
	push(&a, {"x","y"});
	unless (defined(a)) puts("bad 5.2");
}
undef_5();
} -output {}

test undef-6 {check comparison errors against undef} -body {
#lang L --line=1
void undef_6()
{
	int	i;
	string	s;

	i == undef;  // line 6
	i != undef;
	i <= undef;
	i <  undef;
	i >= undef;
	i >  undef;
	undef == i;
	undef != i;
	undef <= i;
	undef <  i;
	undef >= i;
	undef >  i;  // line 17

	s eq undef;  // line 19
	s ne undef;
	s le undef;
	s lt undef;
	s ge undef;
	s gt undef;
	undef eq s;
	undef ne s;
	undef le s;
	undef lt s;
	undef ge s;
	undef gt s;  // line 30

	undef == undef;  // line 32
	undef != undef;
	undef <= undef;
	undef <  undef;
	undef >= undef;
	undef >  undef;
	undef eq undef;
	undef ne undef;
	undef le undef;
	undef lt undef;
	undef ge undef;
	undef gt undef;  // line 43
}
} -returnCodes error -match regexp -result {.*6: L Error: undef illegal in comparison
.*7: L Error: undef illegal in comparison
.*8: L Error: undef illegal in comparison
.*9: L Error: undef illegal in comparison
.*10: L Error: undef illegal in comparison
.*11: L Error: undef illegal in comparison
.*12: L Error: undef illegal in comparison
.*13: L Error: undef illegal in comparison
.*14: L Error: undef illegal in comparison
.*15: L Error: undef illegal in comparison
.*16: L Error: undef illegal in comparison
.*17: L Error: undef illegal in comparison
.*19: L Error: undef illegal in comparison
.*20: L Error: undef illegal in comparison
.*21: L Error: undef illegal in comparison
.*22: L Error: undef illegal in comparison
.*23: L Error: undef illegal in comparison
.*24: L Error: undef illegal in comparison
.*25: L Error: undef illegal in comparison
.*26: L Error: undef illegal in comparison
.*27: L Error: undef illegal in comparison
.*28: L Error: undef illegal in comparison
.*29: L Error: undef illegal in comparison
.*30: L Error: undef illegal in comparison
.*32: L Error: undef illegal in comparison
.*33: L Error: undef illegal in comparison
.*34: L Error: undef illegal in comparison
.*35: L Error: undef illegal in comparison
.*36: L Error: undef illegal in comparison
.*37: L Error: undef illegal in comparison
.*38: L Error: undef illegal in comparison
.*39: L Error: undef illegal in comparison
.*40: L Error: undef illegal in comparison
.*41: L Error: undef illegal in comparison
.*42: L Error: undef illegal in comparison
.*43: L Error: undef illegal in comparison
}

test undef-7 {check for bug with undef object ref count} -body {
#lang L --line=1
void undef_7()
{
	string	a[];

	/*
	 * This used to trip a bug in undef (and assert or core dump)
	 * where the undef object's ref count would be reset to 1234
	 * in Lcompile.c every time a reference to the undef object
	 * was given out.  If undef propagated more than this # of
	 * times, the wheels could fall off while freeing an object
	 * that had these undefs in it.
	 */

	// This creates 3000 Tcl_Obj's that point to undef, and when
	// they are added to the array, the undef ref count is
	// incremented as expected.
	a[3000] = "";

	// Now create one more ref to undef (when it is pushed onto
	// the Tcl run-time stack).  This used to reset the ref count
	// back to 1234, then when the locals were freed which includes
	// the 3000 undefs above, we used to assert or core dump.
	undef;
}
undef_7();
} -output {}

test undef-8 {check for another bug with undef object ref count} -body {
#lang L --line=1
#pragma nowarn
void undef_8()
{
	int	iters = 100;
	int	a[], aft, bef, h{int}, i, j, x, y;
	string	s;
	FILE	f;

	/*
	 * These check for an old bug where the undef object's ref
	 * count would continually grow until it eventually
	 * overflowed.  Here we check that various operations which
	 * should create and then drop a reference to undef don't grow
	 * the ref count.
	 */

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		{x,y} = {i};  // uses INST_L_LINDEX_STK bytecode
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 1 composite assign ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		a[0] = 0;  // grows array w/undef
		undef(a);
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 2 a[] write ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		a[0];  // read of undefined array element
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 3 a[] read ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		pop(&a);  // elt delete on empty array
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 5 pop(&a) ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		((hash){i}){0};  // hash read of non-hash
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 6 not-a-hash{idx} ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		h{0};  // hash read of undef element
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 7 h{} ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		s[0];  // string index of undef string
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 8 undef_string[] ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		"s"[2];  // string index beyond end of string
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 9 string[beyond] ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		undef;  // puts undef on run-time stack
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 10 undef ${bef} -> ${aft}");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		getopt({}, "", {});  // getopt returns undef
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 11 getopt ${bef} -> ${aft}");

	f = fopen("tst", "w");
	puts(f, "testing");
	fclose(f);
	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		f = fopen("tst", "r");
		while (<f>) ;  // returns undef on EOF
		fclose(f);
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 12 <f> ${bef} -> ${aft}");
	unlink("tst");

	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		fgetline("bad channel");  // returns undef
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 13 fgetline ${bef} -> ${aft}");

	/*
	 * This one can't be tested here unless we spawn another tclsh
	 * since it eats args from the cmd line and messes up tcltest.
	 */
	/*
	bef = Lrefcnt(undef);
	for (i = 0; i < iters; ++i) {
		<>;
	}
	aft = Lrefcnt(undef);
	if (aft > bef) puts("bad 14 <> ${bef} -> ${aft}");
	*/

}
undef_8();
} -output {}

test undef-9 {test read of an undef ref parm} -body {
#lang L
void undef_9f(string &arg)
{
	puts(arg);
}
void undef_9()
{
	undef_9f(undef);
}
undef_9();
} -returnCodes error -match regexp -result {undefined reference parameter read}

test undef-10 {test write of an undef ref parm} -body {
#lang L
void undef_10f(string &arg)
{
	arg = "bad";
}
void undef_10()
{
	undef_10f(undef);
}
undef_10();
} -returnCodes error -match regexp -result {undefined reference parameter written}

test undef-11 {test read of an _optional undef ref parm} -body {
#lang L
void undef_11f(_optional string &arg)
{
	puts(arg);
}
void undef_11()
{
	undef_11f();
}
undef_11();
} -returnCodes error -match regexp -result {undefined reference parameter read}

test undef-12 {test write of an _optional undef ref parm} -body {
#lang L
void undef_12f(_optional string &arg)
{
	arg = "bad";
}
void undef_12()
{
	undef_12f();
}
undef_12();
} -returnCodes error -match regexp -result {undefined reference parameter written}

test undef-13 {test definedness tests on ref parm} -body {
#lang L
string undef_13f(string &arg)
{
	string	ret;

	ret = (string)defined(&arg);
	if (defined(&arg)) ret .= (string)defined(arg);

	return (ret);
}
string undef_13opt(_optional string &arg)
{
	string	ret;

	ret = (string)defined(&arg);
	if (defined(&arg)) ret .= (string)defined(arg);

	return (ret);
}
void undef_13()
{
	string	p;

	unless (undef_13f(undef) == "0") puts("bad 1.1");
	unless (undef_13f(&p) == "10") puts("bad 1.2");
	p = "ok";
	unless (undef_13f(&p) == "11") puts("bad 1.3");

	p = undef;
	unless (undef_13opt() == "0") puts("bad 2.0");
	unless (undef_13opt(undef) == "0") puts("bad 2.1");
	unless (undef_13opt(&p) == "10") puts("bad 2.2");
	p = "ok";
	unless (undef_13opt(&p) == "11") puts("bad 2.3");
}
undef_13();
} -output {}

test undef-14 {test definedness tests on function-pointer parm} -body {
#lang L
/*
 * Although function-pointer args look like ref parms because they
 * have a &, they are not references and the rules for defined()
 * tests are different.  You cannot say defined(&arg).
 */
string undef_14foo() { return ("x"); }
string undef_14f(string &arg())
{
	return ((string)defined(arg));
}
string undef_14opt(_optional string &arg())
{
	return ((string)defined(arg));
}
void undef_14()
{
	unless (undef_14f(undef) == "0") puts("bad 1.1");
	unless (undef_14f(&undef_14foo) == "1") puts("bad 1.2");

	unless (undef_14opt() == "0") puts("bad 2.1");
	unless (undef_14opt(undef) == "0") puts("bad 2.2");
	unless (undef_14opt(&undef_14foo) == "1") puts("bad 2.3");
}
undef_14();
} -output {}

test toplevel-1.0 {Toplevel code in L} -body {
#lang L --line=1
int toplevel_1_0_i = 2;
printf("at the toplevel, i is: %d\n", toplevel_1_0_i);

void toplevel_1_0(void) {
  printf("in toplevel_1_0, i is: %d\n", toplevel_1_0_i);
}
#lang tcl
toplevel_1_0
} -output {at the toplevel, i is: 2
in toplevel_1_0, i is: 2
}

test toplevel-1.1 {Toplevel code via the L command, sharing variables} -body {
L { puts("Accent on helpful side of your nature.  Drain the moat."); }
proc toplevel_1_1 {} {
    set toplevel_1_1_v 2
    L {
	    string toplevel_1_1_v = "Sphenic numbers always have exactly "
		    "eight divisors.";
    }
    puts $toplevel_1_1_v
}
toplevel_1_1
} -output {Accent on helpful side of your nature.  Drain the moat.
2
}

test typecheck-1.0 {L typechecking} -body {
#lang L --line=1
string typecheck_1_0_foo() {
	return "string";
}

void typecheck_1_0() {
	puts(typecheck_1_0_foo() + 22);
}
#lang tcl
typecheck_1_0
} -returnCodes {error} -match glob \
-result "*:6: L Error: expected type int or float but got string*\n"

test typecheck-1.1 {arity check} -body {
#lang L --line=1 -nowarn
void typecheck_1_1_foo() {}
void typecheck_1_1_bar(int a, int b) {}
void typecheck_1_1() {
	typecheck_1_1_foo(1, 2, 3);
	typecheck_1_1_bar();
}
#lang tcl
} -returnCodes {error} -match glob \
-result "*:4: L Error: too many arguments for function typecheck_1_1_foo
*:5: L Error: not enough arguments for function typecheck_1_1_bar\n"

test typecheck-1.2 {check functions returning int arrays of arrays} -body {
#lang L --line=1
int[]
typecheck_1_2_int()
{
	int	i, a[3];

	for (i = 0; i < 3; ++i) {
		a[i] = i;
	}
	return a;
}
int[][]
typecheck_1_2_int_int()
{
	int	i, j, a[3][4];

	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			a[i][j] = 10*i + j;
		}
	}
	return a;
}
int[][][]
typecheck_1_2_int_int_int()
{
	int	i, j, k, a[3][4][5];

	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			for (k = 0; k < 5; ++k) {
				a[i][j][k] = 100*i + 10*j + k;
			}
		}
	}
	return a;
}
void
typecheck_1_2()
{
	int	i, j, k;
	int	one[3];
	int	two[3][4];
	int	three[3][4][5];

	one   = typecheck_1_2_int();
	two   = typecheck_1_2_int_int();
	three = typecheck_1_2_int_int_int();

	for (i = 0; i < 3; ++i) {
		unless (one[i] == i) {
			printf("one: i=%d bad\n", i);
		}
	}
	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			unless (two[i][j] == (10*i + j)) {
				printf("two: i=%d j=%d bad\n", i, j);
			}
		}
	}
	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			for (k = 0; k < 5; ++k) {
				unless (three[i][j][k] == (100*i + 10*j + k)) {
					printf("three: i=%d j=%d k=%d bad\n",
					       i, j, k);
				}
			}
		}
	}
}
typecheck_1_2();
} -output {}

test typecheck-1.3 {check functions returning float arrays of arrays} -body {
#lang L --line=1
float[]
typecheck_1_3_float()
{
	int	i;
	float	a[3];

	for (i = 0; i < 3; ++i) {
		a[i] = i;
	}
	return a;
}
float[][]
typecheck_1_3_float_float()
{
	int	i, j;
	float	a[3][4];

	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			a[i][j] = 10.0*i + j;
		}
	}
	return a;
}
float[][][]
typecheck_1_3_float_float_float()
{
	int	i, j, k;
	float	a[3][4][5];

	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			for (k = 0; k < 5; ++k) {
				a[i][j][k] = 100.0*i + 10.0*j + k;
			}
		}
	}
	return a;
}
void
typecheck_1_3()
{
	int	i, j, k;
	float	one[3];
	float	two[3][4];
	float	three[3][4][5];

	one   = typecheck_1_3_float();
	two   = typecheck_1_3_float_float();
	three = typecheck_1_3_float_float_float();

	/*
	 * Although testing equality of floats is usually unwise,
	 * there should be sufficient precision in this case to make
	 * the comparisons true when they should be.
	 */
	for (i = 0; i < 3; ++i) {
		unless (one[i] == i) {
			printf("one: i=%d bad\n", i);
		}
	}
	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			unless (two[i][j] == (10.0*i + j)) {
				printf("two: i=%d j=%d bad\n", i, j);
			}
		}
	}
	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			for (k = 0; k < 5; ++k) {
				unless (three[i][j][k] == (100.0*i+10.0*j+k)) {
					printf("three: i=%d j=%d k=%d bad\n",
					       i, j, k);
				}
			}
		}
	}
}
typecheck_1_3();
} -output {}

test typecheck-1.4 {check functions returning string arrays of arrays} -body {
#lang L --line=1
string[]
typecheck_1_4_string()
{
	int	i;
	string	a[3];

	for (i = 0; i < 3; ++i) {
		a[i] = "${i}";
	}
	return a;
}
string[][]
typecheck_1_4_string_string()
{
	int	i, j;
	string	a[3][4];

	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			a[i][j] = "${i}:${j}";
		}
	}
	return a;
}
string[][][]
typecheck_1_4_string_string_string()
{
	int	i, j, k;
	string	a[3][4][5];

	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			for (k = 0; k < 5; ++k) {
				a[i][j][k] = "${i}:${j}:${k}";
			}
		}
	}
	return a;
}
void
typecheck_1_4()
{
	int	i, j, k;
	string	one[3];
	string	two[3][4];
	string	three[3][4][5];

	one   = typecheck_1_4_string();
	two   = typecheck_1_4_string_string();
	three = typecheck_1_4_string_string_string();

	for (i = 0; i < 3; ++i) {
		unless (one[i] eq "${i}") {
			printf("one: i=%d bad\n", i);
		}
	}
	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			unless (two[i][j] eq "${i}:${j}") {
				printf("two: i=%d j=%d bad\n", i, j);
			}
		}
	}
	for (i = 0; i < 3; ++i) {
		for (j = 0; j < 4; ++j) {
			for (k = 0; k < 5; ++k) {
				unless (three[i][j][k] eq "${i}:${j}:${k}") {
					printf("three: i=%d j=%d k=%d bad\n",
					       i, j, k);
				}
			}
		}
	}
}
typecheck_1_4();
} -output {}

test typecheck-1.5 {check functions returning void arrays are illegal} -body {
#lang L --line=1
void[] typecheck_1_5() { return; }
} -returnCodes error -match regexp -result {.*1: L Error: type void illegal.*
}

test typecheck-2.1 {check int-to-float casts and coercions} -body {
#lang L --line=1
float
typecheck_2_1_return_float(float f)
{
	return f;
}

float
typecheck_2_1_sum_three_floats(float f1, float f2, float f3)
{
	return f1 + f2 + f3;
}

void
typecheck_2_1()
{
	/*
	 * Exact comparisons with floats must be done with care.  Keep
	 * the precision of the numbers low so there is sufficient
	 * precision for the variable comparisons to be true when
	 * intended.
	 */

	/* Test initializers and all comparison ops that allow floats. */

	int	i1 = 1964;
	int	i2 = 0;
	float	f1 = i1;
	float	f2 = 0.0;

	unless (f1 == 1964)        puts("BAD 1.1.1");
	unless (1964 == f1)        puts("BAD 1.1.2");
	unless (f1 == 1964.0)      puts("BAD 1.1.3");
	unless (1964.0 == f1)      puts("BAD 1.1.4");
	unless (f1 == (float)1964) puts("BAD 1.1.5");
	unless ((float)1964 == f1) puts("BAD 1.1.6");
	unless (f1 == (float)i1)   puts("BAD 1.1.7");
	unless ((float)i1 == f1)   puts("BAD 1.1.8");
	unless (f1 == i1)          puts("BAD 1.1.9");
	unless (i1 == f1)          puts("BAD 1.1.10");

	unless (f1 >= 1964)        puts("BAD 1.2.1");
	unless (1964 >= f1)        puts("BAD 1.2.2");
	unless (f1 >= 1964.0)      puts("BAD 1.2.3");
	unless (1964.0 >= f1)      puts("BAD 1.2.4");
	unless (f1 >= (float)1964) puts("BAD 1.2.5");
	unless ((float)1964 >= f1) puts("BAD 1.2.6");
	unless (f1 >= (float)i1)   puts("BAD 1.2.7");
	unless ((float)i1 >= f1)   puts("BAD 1.2.8");
	unless (f1 >= i1)          puts("BAD 1.2.9");
	unless (i1 >= f1)          puts("BAD 1.2.10");

	unless (f1 <= 1964)        puts("BAD 1.3.1");
	unless (1964 <= f1)        puts("BAD 1.3.2");
	unless (f1 <= 1964.0)      puts("BAD 1.3.3");
	unless (1964.0 <= f1)      puts("BAD 1.3.4");
	unless (f1 <= (float)1964) puts("BAD 1.3.5");
	unless ((float)1964 <= f1) puts("BAD 1.3.6");
	unless (f1 <= (float)i1)   puts("BAD 1.3.7");
	unless ((float)i1 <= f1)   puts("BAD 1.3.8");
	unless (f1 <= i1)          puts("BAD 1.3.9");
	unless (i1 <= f1)          puts("BAD 1.3.10");

	unless (f1 != 1999)        puts("BAD 1.4.1");
	unless (1999 != f1)        puts("BAD 1.4.2");
	unless (f1 != 1999.0)      puts("BAD 1.4.3");
	unless (1999.0 != f1)      puts("BAD 1.4.4");
	unless (f1 != (float)1999) puts("BAD 1.4.5");
	unless ((float)1999 != f1) puts("BAD 1.4.6");
	unless (f1 != (float)i2)   puts("BAD 1.4.7");
	unless ((float)i2 != f1)   puts("BAD 1.4.8");
	unless (f1 != i2)          puts("BAD 1.4.9");
	unless (i2 != f1)          puts("BAD 1.4.10");

	/* Test assignments and all binary ops that allow floats. */

	i2 = 1965;
	f2 = i2;
	unless (f2 == 1965.0) puts("BAD 2.1");

	f2 = f2 + 1;
	unless (f2 == 1966.0) puts("BAD 2.2");

	f2 = f2 - 2;
	unless (f2 == 1964.0) puts("BAD 2.3");

	f2 = f2 / 2;
	unless (f2 == 982.0)  puts("BAD 2.4");

	f2 = f2 * 2;
	unless (f2 == 1964.0) puts("BAD 2.5");

	f2 = i2;
	f2 = 1 + f2;
	unless (f2 == 1966.0) puts("BAD 3.1");

	f2 = -2 + f2;
	unless (f2 == 1964.0) puts("BAD 3.2");

	f2 = f2 / 2;
	unless (f2 == 982.0)  puts("BAD 3.3");

	f2 = 2;
	f2 = 2 / f2;
	unless (f2 == 1.0)    puts("BAD 3.4");

	i2 = 1965;
	f2 = i2;
	f2 += 1;
	unless (f2 == 1966.0) puts("BAD 4.1");

	f2 -= 2;
	unless (f2 == 1964.0) puts("BAD 4.2");

	f2 /= 2;
	unless (f2 == 982.0)  puts("BAD 4.3");

	f2 *= 2;
	unless (f2 == 1964.0) puts("BAD 4.4");

	/* Test that int actuals coerce to a float when the formal is a float. */

	f2 = typecheck_2_1_return_float(1);
	unless (f2 == 1.0)    puts("BAD 5.1");

	i2 = 3;
	f2 = typecheck_2_1_return_float(i2);
	unless (f2 == 3.0)    puts("BAD 5.2");

	f2 = typecheck_2_1_sum_three_floats(1, 2, 3);
	unless (f2 = 6.0)     puts("BAD 5.3");

	i1 = 1;
	i2 = 3;
	f2 = typecheck_2_1_sum_three_floats(i1, i2, 3);
	unless (f2 = 6.0)     puts("BAD 5.4");
}
typecheck_2_1();
} -output ""

test typecheck-3.1 {void illegal in if-stmt conditional} -body {
#lang L --line=1
void typecheck_3_1_v() { return; }
void
typecheck_3_1()
{
	if (typecheck_3_1_v()) return;
}
} -returnCodes error -match regexp -result {void type illegal in predicate}

test typecheck-3.2 {void illegal in unless-stmt conditional} -body {
#lang L --line=1
void typecheck_3_2_v() { return; }
void
typecheck_3_2()
{
	unless (typecheck_3_2_v()) return;
}
} -returnCodes error -match regexp -result {void type illegal in predicate}

test typecheck-3.3 {void illegal in while-loop conditional} -body {
#lang L --line=1
void typecheck_3_3_v() { return; }
void
typecheck_3_3()
{
	while (typecheck_3_3_v()) return;
}
} -returnCodes error -match regexp -result {void type illegal in predicate}

test typecheck-3.4 {void illegal in do-loop conditional} -body {
#lang L --line=1
void typecheck_3_4_v() { return; }
void
typecheck_3_4()
{
	do {
		return;
	} while(typecheck_3_4_v());
}
} -returnCodes error -match regexp -result {void type illegal in predicate}

test typecheck-3.5 {void illegal in for-loop conditional} -body {
#lang L --line=1
void typecheck_3_5_v() { return; }
void
typecheck_3_5()
{
	for (1; typecheck_3_5_v(); 1) return;
}
} -returnCodes error -match regexp -result {void type illegal in predicate}

test typecheck-3.6 {void illegal in abbreviated-for-loop conditional} -body {
#lang L --line=1
void typecheck_3_6_v() { return; }
void
typecheck_3_6()
{
	for (1; typecheck_3_6_v();) return;
}
} -returnCodes error -match regexp -result {void type illegal in predicate}

test typecheck-3.10 {void illegal in binary operators} -body {
#lang L --line=1
void t310v() { return; }
void
typecheck_3_10()
{
	int	i;

	if (t310v() && 0) return;
	if (0 && t310v()) return;
	if (t310v() || 0) return;
	if (0 || t310v()) return;
	if (t310v() =~ /bad/) return;
	if (t310v() eq "") return;
	if ("" eq t310v()) return;
	if (t310v() ne "") return;
	if ("" ne t310v()) return;
	if (t310v() gt "") return;
	if ("" gt t310v()) return;
	if (t310v() ge "") return;
	if ("" ge t310v()) return;
	if (t310v() lt "") return;
	if ("" lt t310v()) return;
	if (t310v() le "") return;
	if ("" le t310v()) return;
	if (t310v() == 0)  return;
	if (0 == t310v())  return;
	if (t310v() != 0)  return;
	if (0 != t310v())  return;
	if (t310v() > 0)   return;
	if (0 > t310v())   return;
	if (t310v() >= 0)  return;
	if (0 >= t310v())  return;
	if (t310v() < 0)   return;
	if (0 < t310v())   return;
	if (t310v() <= 0)  return;
	if (0 <= t310v())  return;
	i = t310v() + 1;
	i = 1 + t310v();
	i = t310v() - 1;
	i = 1 - t310v();
	i = t310v() * 1;
	i = 1 * t310v();
	i = t310v() / 1;
	i = 1 / t310v();
	i = t310v() % 1;
	i = 1 % t310v();
	i = t310v() & 1;
	i = 1 & t310v();
	i = t310v() | 1;
	i = 1 | t310v();
	i = t310v() ^ 1;
	i = 1 ^ t310v();
	i = t310v() << 1;
	i = 1 << t310v();
	i = t310v() >> 1;
	i = 1 >> t310v();
}
} -returnCodes error -match regexp -result {.*7: L Error: void type illegal in predicate
.*8: L Error: void type illegal in predicate
.*9: L Error: void type illegal in predicate
.*10: L Error: void type illegal in predicate
.*11: L Error: expected type.*but got void in =~
.*12: L Error: expected type.*but got void in string comparison
.*13: L Error: expected type.*but got void in string comparison
.*14: L Error: expected type.*but got void in string comparison
.*15: L Error: expected type.*but got void in string comparison
.*16: L Error: expected type.*but got void in string comparison
.*17: L Error: expected type.*but got void in string comparison
.*18: L Error: expected type.*but got void in string comparison
.*19: L Error: expected type.*but got void in string comparison
.*20: L Error: expected type.*but got void in string comparison
.*21: L Error: expected type.*but got void in string comparison
.*22: L Error: expected type.*but got void in string comparison
.*23: L Error: expected type.*but got void in string comparison
.*24: L Error: type void illegal
.*25: L Error: type void illegal
.*26: L Error: type void illegal
.*27: L Error: type void illegal
.*28: L Error: type void illegal
.*29: L Error: type void illegal
.*30: L Error: type void illegal
.*31: L Error: type void illegal
.*32: L Error: type void illegal
.*33: L Error: type void illegal
.*34: L Error: type void illegal
.*35: L Error: type void illegal
.*36: L Error: expected type.*but got void in arithmetic operator
.*37: L Error: expected type.*but got void in arithmetic operator
.*38: L Error: expected type.*but got void in arithmetic operator
.*39: L Error: expected type.*but got void in arithmetic operator
.*40: L Error: expected type.*but got void in arithmetic operator
.*41: L Error: expected type.*but got void in arithmetic operator
.*42: L Error: expected type.*but got void in arithmetic operator
.*43: L Error: expected type.*but got void in arithmetic operator
.*44: L Error: expected type.*but got void in arithmetic operator
.*45: L Error: expected type.*but got void in arithmetic operator
.*46: L Error: expected type.*but got void in arithmetic operator
.*47: L Error: expected type.*but got void in arithmetic operator
.*48: L Error: expected type.*but got void in arithmetic operator
.*49: L Error: expected type.*but got void in arithmetic operator
.*50: L Error: expected type.*but got void in arithmetic operator
.*51: L Error: expected type.*but got void in arithmetic operator
.*52: L Error: expected type.*but got void in arithmetic operator
.*53: L Error: expected type.*but got void in arithmetic operator
.*54: L Error: expected type.*but got void in arithmetic operator
.*55: L Error: expected type.*but got void in arithmetic operator
}

test typecheck-3.10.2 {void illegal in binary operators 2} -body {
#lang L --line=1
void t310_2v() { return; }
void
typecheck_3_10_2()
{
	int	i;

	/*
	 * Similar to typecheck-3.10 but testing void as both lhs and
	 * rhs.  The earlier test was getting too big which makes it
	 * hard to update for changes in error messages or error
	 * checking in the compiler.
	 */

	if (t310_2v() && t310_2v()) return;
	if (t310_2v() || t310_2v()) return;
	if (t310_2v() =~ /bad/) return;
	if (t310_2v() eq t310_2v()) return;
	if (t310_2v() ne t310_2v()) return;
	if (t310_2v() gt t310_2v()) return;
	if (t310_2v() ge t310_2v()) return;
	if (t310_2v() lt t310_2v()) return;
	if (t310_2v() le t310_2v()) return;
	if (t310_2v() == t310_2v()) return;
	if (t310_2v() != t310_2v()) return;
	if (t310_2v() > t310_2v())  return;
	if (t310_2v() >= t310_2v()) return;
	if (t310_2v() < t310_2v())  return;
	if (t310_2v() <= t310_2v()) return;
	i = t310_2v() + t310_2v();
	i = t310_2v() - t310_2v();
	i = t310_2v() * t310_2v();
	i = t310_2v() / t310_2v();
	i = t310_2v() % t310_2v();
	i = t310_2v() & t310_2v();
	i = t310_2v() | t310_2v();
	i = t310_2v() ^ t310_2v();
	i = t310_2v() << t310_2v();
	i = t310_2v() >> t310_2v();
}
} -returnCodes error -match regexp -result {.*14: L Error: void type illegal in predicate
.*15: L Error: void type illegal in predicate
.*16: L Error: expected type.*but got void in =~
.*17: L Error: expected type.*but got void in string comparison
.*18: L Error: expected type.*but got void in string comparison
.*19: L Error: expected type.*but got void in string comparison
.*20: L Error: expected type.*but got void in string comparison
.*21: L Error: expected type.*but got void in string comparison
.*22: L Error: expected type.*but got void in string comparison
.*23: L Error: type void illegal
.*24: L Error: type void illegal
.*25: L Error: type void illegal
.*26: L Error: type void illegal
.*27: L Error: type void illegal
.*28: L Error: type void illegal
.*29: L Error: expected type.*but got void in arithmetic operator
.*30: L Error: expected type.*but got void in arithmetic operator
.*31: L Error: expected type.*but got void in arithmetic operator
.*32: L Error: expected type.*but got void in arithmetic operator
.*33: L Error: expected type.*but got void in arithmetic operator
.*34: L Error: expected type.*but got void in arithmetic operator
.*35: L Error: expected type.*but got void in arithmetic operator
.*36: L Error: expected type.*but got void in arithmetic operator
.*37: L Error: expected type.*but got void in arithmetic operator
.*38: L Error: expected type.*but got void in arithmetic operator
}

test typecheck-3.11 {void illegal in casts and unary operators} -body {
#lang L --line=1
void t311v() { return; }
void
typecheck_3_11()
{
	int	i;
	float	f;
	string	s;
	hash	h;

	i = (int)t311v();
	f = (float)t311v();
	s = (string)t311v();
	h = (hash)t311v();
	i = !t311v();
	i = ~t311v();
	i = +t311v();
	i = -t311v();
}
} -returnCodes error -match regexp -result {.*10: L Error: type void illegal
.*11: L Error: type void illegal
.*12: L Error: type void illegal
.*13: L Error: type void illegal
.*14: L Error: void type illegal in predicate
.*15: L Error: expected type int.*
.*16: L Error: expected type int or float.*
.*17: L Error: expected type int or float.*
}

test typecheck-3.12 {void illegal in assignments} -body {
#lang L --line=1
void t312v() { return; }
int takes_int(int i) { return i; }
void
typecheck_3_12()
{
	int	i;

	i = t312v();
	i += t312v();
	i -= t312v();
	i /= t312v();
	i *= t312v();
	i %= t312v();
	i &= t312v();
	i |= t312v();
	i ^= t312v();
	i >>= t312v();
	i <<= t312v();
	takes_int(t312v());
}
} -returnCodes error -match regexp -result {.*8: L Error: type void illegal
.*9: L Error: type void illegal
.*10: L Error: type void illegal
.*11: L Error: type void illegal
.*12: L Error: type void illegal
.*13: L Error: type void illegal
.*14: L Error: type void illegal
.*15: L Error: type void illegal
.*16: L Error: type void illegal
.*17: L Error: type void illegal
.*18: L Error: type void illegal
.*19: L Error: parameter 1 has incompatible type
}

test typecheck-3.13 {void illegal as foreach expr} -body {
#lang L --line=1 -nowarn
void t313v() { return; }
void
typecheck_3_13()
{
	int	k;

	foreach (k in t313v()) { }
}
} -returnCodes error -match regexp -result {.*foreach expression must be array, hash, or string}

test typecheck-4.1 {type errors in foreach} -body {
#lang L --line=1
void
typecheck_4_1()
{
	int	vi;
	float	vf;
	string	vs;
	int	ai[2] = { 22, 23 };
	string	as[2] = { "b", "c" };
	float	af[2] = { 2.1, 2.2 };
	hash	h = { 1=>2, 2=>3 };

	foreach (vi in as) {}
	foreach (vi in af) {}
	foreach (vs in ai) {}
	foreach (vs in af) {}
	foreach (vf in as) {}
	foreach (vi,vi in h) {}
}
} -returnCodes error -match regexp -result {.*12: L Error: loop index type incompatible with array element type
.*13: L Error: loop index type incompatible with array element type
.*14: L Error: loop index type incompatible with array element type
.*15: L Error: loop index type incompatible with array element type
.*16: L Error: loop index type incompatible with array element type
.*17: L Error: multiple variables illegal in foreach over hash
}

test typecheck-4.2 {type errors in foreach with multiple variables} -body {
#lang L --line=1
void
typecheck_4_2()
{
	int	i1,i2,i3;
	float	f1,f2,f3;
	string	s1,s2,s3;
	int	ai[3] = { 22, 23, 24 };
	string	as[3] = { "b", "c", "d" };
	float	af[3] = { 2.1, 2.2, 2.3 };

	foreach (i1,s2,s3 in as) {}
	foreach (s1,i2,s3 in as) {}
	foreach (s1,s2,i3 in as) {}
	foreach (s1,i2,i3 in ai) {}
	foreach (i1,s2,i3 in ai) {}
	foreach (i1,i2,s3 in ai) {}
	foreach (s1,f2,f3 in af) {}
	foreach (f1,s2,f3 in af) {}
	foreach (f1,f2,s3 in af) {}

	/* Make sure that multiple type errors get caught. */
	foreach (i1,i2,s3 in as) {}
	foreach (i1,i2,i3 in as) {}
}
} -returnCodes error -match regexp -result {.*11: L Error: loop index type incompatible with array element type
.*12: L Error: loop index type incompatible with array element type
.*13: L Error: loop index type incompatible with array element type
.*14: L Error: loop index type incompatible with array element type
.*15: L Error: loop index type incompatible with array element type
.*16: L Error: loop index type incompatible with array element type
.*17: L Error: loop index type incompatible with array element type
.*18: L Error: loop index type incompatible with array element type
.*19: L Error: loop index type incompatible with array element type
.*22: L Error: loop index type incompatible with array element type
.*22: L Error: loop index type incompatible with array element type
.*23: L Error: loop index type incompatible with array element type
.*23: L Error: loop index type incompatible with array element type
.*23: L Error: loop index type incompatible with array element type
}

test typecheck-4.4 {scalars as condition expressions} -body {
#lang L --line=1
void
typecheck_4_4()
{
	/* These are all legal. */

	int	i = 0;
	float	f = 0.0;
	string	s1, s2 = "defined";
	widget	w;
	poly	p = "0";

	if (i) puts("bad 1");
	if (f) puts("bad 2");  // Exact comparisons w/floats don't always work

	/* Strings as conditionals get checked for defined. */
	if (s1) puts("bad 3");
	unless (s2) puts("bad 4");

	/* !condition should work too. */
	unless (!s1) puts("bad 4.1");
	if (!s2) puts("bad 4.2");
	if (s1 || !s2) puts("bad 4.3");

	if (w) puts("bad 5");
	if (p) puts("bad 6");
}
typecheck_4_4();
} -output {}

test typecheck-5.1 {type errors in hash elements} -body {
#lang L --line=1
struct st51 {
	int	x;
	int	y;
};
void
typecheck_5_1()
{
	int		a[3], i;
	string		s;
	float		f;
	poly		p;
	struct st51	st = {0,0};

	int		ihi{int};
	int		ihs{string};
	int		ihf{float};

	string		shi{int};
	string		shs{string};
	string		shf{float};

	float		fhi{int};
	float		fhs{string};
	float		fhf{float};

	poly		phi{int};
	poly		phs{string};
	poly		phf{float};

	ihi{1.1} = 0;	// These want an index of type int.
	ihi{"s"} = 0;
	ihi{st}  = 0;
	ihi{a}   = 0;
	ihi{shi} = 0;
	shi{1.1} = "s";
	shi{"s"} = "s";
	shi{st}  = "s";
	shi{a}   = "s";
	shi{shi} = "s";
	fhi{1.1} = 0.0;
	fhi{"s"} = 0.0;
	fhi{st}  = 0.0;
	fhi{a}   = 0.0;
	fhi{shi} = 0.0;
	phi{1.1} = 0.0;
	phi{"s"} = 0.0;
	phi{st}  = 0.0;
	phi{a}   = 0.0;
	phi{shi} = 0.0;
	i = ihi{1.1};
	i = ihi{"s"};
	i = ihi{st};
	i = ihi{a};
	i = ihi{shi};
	s = shi{1.1};
	s = shi{"s"};
	s = shi{st};
	s = shi{a};
	s = shi{shi};
	f = fhi{1.1};
	f = fhi{"s"};
	f = fhi{st};
	f = fhi{a};
	f = fhi{shi};
	p = phi{1.1};
	p = phi{"s"};
	p = phi{st};
	p = phi{a};
	p = phi{shi};
	ihs{1.1} = 0;	// These want an index of type string.
	ihs{0}   = 0;
	ihs{st}  = 0;
	ihs{a}   = 0;
	ihs{shi} = 0;
	shs{1.1} = "s";
	shs{0}   = "s";
	shs{st}  = "s";
	shs{a}   = "s";
	shs{shi} = "s";
	fhs{1.1} = 0.0;
	fhs{0}   = 0.0;
	fhs{st}  = 0.0;
	fhs{a}   = 0.0;
	fhs{shi} = 0.0;
	phs{1.1} = 0.0;
	phs{0}   = 0.0;
	phs{st}  = 0.0;
	phs{a}   = 0.0;
	phs{shi} = 0.0;
	i = ihs{1.1};
	i = ihs{0};
	i = ihs{st};
	i = ihs{a};
	i = ihs{shi};
	s = shs{1.1};
	s = shs{0};
	s = shs{st};
	s = shs{a};
	s = shs{shi};
	f = fhs{1.1};
	f = fhs{0};
	f = fhs{st};
	f = fhs{a};
	f = fhs{shi};
	p = phs{1.1};
	p = phs{0};
	p = phs{st};
	p = phs{a};
	p = phs{shi};
	ihf{"s"} = 0;	// These want an index of type float (but int is OK).
	ihf{st}  = 0;
	ihf{a}   = 0;
	ihf{shi} = 0;
	shf{"s"} = "s";
	shf{st}  = "s";
	shf{a}   = "s";
	shf{shi} = "s";
	fhf{"s"} = 0.0;
	fhf{st}  = 0.0;
	fhf{a}   = 0.0;
	fhf{shi} = 0.0;
	phf{"s"} = 0.0;
	phf{st}  = 0.0;
	phf{a}   = 0.0;
	phf{shi} = 0.0;
	i = ihf{"s"};
	i = ihf{st};
	i = ihf{a};
	i = ihf{shi};
	s = shf{"s"};
	s = shf{st};
	s = shf{a};
	s = shf{shi};
	f = fhf{"s"};
	f = fhf{st};
	f = fhf{a};
	f = fhf{shi};
	p = phf{"s"};
	p = phf{st};
	p = phf{a};
	p = phf{shi};
}
#lang tcl
typecheck_5_1
} -returnCodes error -match regexp -result {.*30: L Error: expected type int but got float in hash index
.*31: L Error: expected type int but got string in hash index
.*32: L Error: expected type int but got struct in hash index
.*33: L Error: expected type int but got array in hash index
.*34: L Error: expected type int but got hash in hash index
.*35: L Error: expected type int but got float in hash index
.*36: L Error: expected type int but got string in hash index
.*37: L Error: expected type int but got struct in hash index
.*38: L Error: expected type int but got array in hash index
.*39: L Error: expected type int but got hash in hash index
.*40: L Error: expected type int but got float in hash index
.*41: L Error: expected type int but got string in hash index
.*42: L Error: expected type int but got struct in hash index
.*43: L Error: expected type int but got array in hash index
.*44: L Error: expected type int but got hash in hash index
.*45: L Error: expected type int but got float in hash index
.*46: L Error: expected type int but got string in hash index
.*47: L Error: expected type int but got struct in hash index
.*48: L Error: expected type int but got array in hash index
.*49: L Error: expected type int but got hash in hash index
.*50: L Error: expected type int but got float in hash index
.*51: L Error: expected type int but got string in hash index
.*52: L Error: expected type int but got struct in hash index
.*53: L Error: expected type int but got array in hash index
.*54: L Error: expected type int but got hash in hash index
.*55: L Error: expected type int but got float in hash index
.*56: L Error: expected type int but got string in hash index
.*57: L Error: expected type int but got struct in hash index
.*58: L Error: expected type int but got array in hash index
.*59: L Error: expected type int but got hash in hash index
.*60: L Error: expected type int but got float in hash index
.*61: L Error: expected type int but got string in hash index
.*62: L Error: expected type int but got struct in hash index
.*63: L Error: expected type int but got array in hash index
.*64: L Error: expected type int but got hash in hash index
.*65: L Error: expected type int but got float in hash index
.*66: L Error: expected type int but got string in hash index
.*67: L Error: expected type int but got struct in hash index
.*68: L Error: expected type int but got array in hash index
.*69: L Error: expected type int but got hash in hash index
.*70: L Error: expected type string but got float in hash index
.*71: L Error: expected type string but got int in hash index
.*72: L Error: expected type string but got struct in hash index
.*73: L Error: expected type string but got array in hash index
.*74: L Error: expected type string but got hash in hash index
.*75: L Error: expected type string but got float in hash index
.*76: L Error: expected type string but got int in hash index
.*77: L Error: expected type string but got struct in hash index
.*78: L Error: expected type string but got array in hash index
.*79: L Error: expected type string but got hash in hash index
.*80: L Error: expected type string but got float in hash index
.*81: L Error: expected type string but got int in hash index
.*82: L Error: expected type string but got struct in hash index
.*83: L Error: expected type string but got array in hash index
.*84: L Error: expected type string but got hash in hash index
.*85: L Error: expected type string but got float in hash index
.*86: L Error: expected type string but got int in hash index
.*87: L Error: expected type string but got struct in hash index
.*88: L Error: expected type string but got array in hash index
.*89: L Error: expected type string but got hash in hash index
.*90: L Error: expected type string but got float in hash index
.*91: L Error: expected type string but got int in hash index
.*92: L Error: expected type string but got struct in hash index
.*93: L Error: expected type string but got array in hash index
.*94: L Error: expected type string but got hash in hash index
.*95: L Error: expected type string but got float in hash index
.*96: L Error: expected type string but got int in hash index
.*97: L Error: expected type string but got struct in hash index
.*98: L Error: expected type string but got array in hash index
.*99: L Error: expected type string but got hash in hash index
.*100: L Error: expected type string but got float in hash index
.*101: L Error: expected type string but got int in hash index
.*102: L Error: expected type string but got struct in hash index
.*103: L Error: expected type string but got array in hash index
.*104: L Error: expected type string but got hash in hash index
.*105: L Error: expected type string but got float in hash index
.*106: L Error: expected type string but got int in hash index
.*107: L Error: expected type string but got struct in hash index
.*108: L Error: expected type string but got array in hash index
.*109: L Error: expected type string but got hash in hash index
.*110: L Error: expected type float but got string in hash index
.*111: L Error: expected type float but got struct in hash index
.*112: L Error: expected type float but got array in hash index
.*113: L Error: expected type float but got hash in hash index
.*114: L Error: expected type float but got string in hash index
.*115: L Error: expected type float but got struct in hash index
.*116: L Error: expected type float but got array in hash index
.*117: L Error: expected type float but got hash in hash index
.*118: L Error: expected type float but got string in hash index
.*119: L Error: expected type float but got struct in hash index
.*120: L Error: expected type float but got array in hash index
.*121: L Error: expected type float but got hash in hash index
.*122: L Error: expected type float but got string in hash index
.*123: L Error: expected type float but got struct in hash index
.*124: L Error: expected type float but got array in hash index
.*125: L Error: expected type float but got hash in hash index
.*126: L Error: expected type float but got string in hash index
.*127: L Error: expected type float but got struct in hash index
.*128: L Error: expected type float but got array in hash index
.*129: L Error: expected type float but got hash in hash index
.*130: L Error: expected type float but got string in hash index
.*131: L Error: expected type float but got struct in hash index
.*132: L Error: expected type float but got array in hash index
.*133: L Error: expected type float but got hash in hash index
.*134: L Error: expected type float but got string in hash index
.*135: L Error: expected type float but got struct in hash index
.*136: L Error: expected type float but got array in hash index
.*137: L Error: expected type float but got hash in hash index
.*138: L Error: expected type float but got string in hash index
.*139: L Error: expected type float but got struct in hash index
.*140: L Error: expected type float but got array in hash index
.*141: L Error: expected type float but got hash in hash index
}

test typecheck-6.1 {type check errors with push built-in} -body {
#lang L --line=1 -nowarn
class typecheck_6_1_cls {}
void
typecheck_6_1()
{
	int	a[], aa[][], i, j;
	int	h{int};
	float	f;
	string	s;
	struct { int i,j; } st;
	poly	p;
	widget	w;
	typecheck_6_1_cls o;

	/* Errors -- first arg not a reference (&). */
	push(a, i);
	push(i, i);
	push(h, i);
	push(f, i);
	push(s, i);
	push(st, i);
	push(p, i);
	push(w, i);

	/* Error -- too few arguments. */
	push(&a);
	push();


	/* Error -- first arg not an array reference. */
	push(&i, i);
	push(&h, i);
	push(&f, i);
	push(&s, i);
	push(&st, i);
	push(&w, i);
	push(&1, i);
	push(&3.14159, i);
	push(&o, i);
}
#lang tcl
typecheck_6_1
} -returnCodes {error} -match regexp -result {.*:15: L Error: first arg to push not an array reference.*
.*:16: L Error: first arg to push not an array reference.*
.*:17: L Error: first arg to push not an array reference.*
.*:18: L Error: first arg to push not an array reference.*
.*:19: L Error: first arg to push not an array reference.*
.*:20: L Error: first arg to push not an array reference.*
.*:21: L Error: first arg to push not an array reference.*
.*:22: L Error: first arg to push not an array reference.*
.*:25: L Error: too few arguments to push
.*:26: L Error: too few arguments to push
.*:30: L Error: first arg to push not an array reference.*
.*:31: L Error: first arg to push not an array reference.*
.*:32: L Error: first arg to push not an array reference.*
.*:33: L Error: first arg to push not an array reference.*
.*:34: L Error: first arg to push not an array reference.*
.*:35: L Error: first arg to push not an array reference.*
.*:36: L Error: first arg to push not an array reference.*
.*:37: L Error: first arg to push not an array reference.*
.*:38: L Error: first arg to push not an array reference.*
}

test typecheck-6.2 {type check errors with push built-in 2} -body {
#lang L --line=1
void typecheck_6_2_v() { }
void
typecheck_6_2()
{
	int	ai[], i;
	string	as[], s;
	widget	aw[], w;
	float	af[], f;
	int	aa[][];			// array of array
	int	ah[]{int}, h{int};	// array of hash, and a hash
	struct { int i,j; } ast[], st;	// array of struct, and a struct

	/*
	 * Check pushing incompatible type onto the array.  Just check
	 * for an array of int, since we check the full type-checker
	 * elsewhere.
	 */

	push(&ai, typecheck_6_2_v());  // pushing a void

	push(&ai, f);
	push(&ai, s);

	push(&ai, aa);
	push(&ai, as);
	push(&ai, af);
	push(&ai, h);
	push(&ai, ah);
	push(&ai, st);
	push(&ai, ast);
	push(&ai, w);
	push(&ai, aw);

	push(&aa[0], f);
	push(&aa[0], s);


	push(&aa[0], as);
	push(&aa[0], af);
	push(&aa[0], h);
	push(&aa[0], ah);
	push(&aa[0], st);
	push(&aa[0], ast);
	push(&aa[0], w);
	push(&aa[0], aw);

	push(&ai, f, s);
	push(&ai, i, f);
	push(&ai, i, f, s);
}
typecheck_6_2();
} -returnCodes {error} -match regexp -result {.*:19: L Error: arg #2 to push has type incompatible with array
.*:21: L Error: arg #2 to push has type incompatible with array
.*:22: L Error: arg #2 to push has type incompatible with array
.*:24: L Error: arg #2 to push has type incompatible with array
.*:25: L Error: arg #2 to push has type incompatible with array
.*:26: L Error: arg #2 to push has type incompatible with array
.*:27: L Error: arg #2 to push has type incompatible with array
.*:28: L Error: arg #2 to push has type incompatible with array
.*:29: L Error: arg #2 to push has type incompatible with array
.*:30: L Error: arg #2 to push has type incompatible with array
.*:31: L Error: arg #2 to push has type incompatible with array
.*:32: L Error: arg #2 to push has type incompatible with array
.*:34: L Error: arg #2 to push has type incompatible with array
.*:35: L Error: arg #2 to push has type incompatible with array
.*:38: L Error: arg #2 to push has type incompatible with array
.*:39: L Error: arg #2 to push has type incompatible with array
.*:40: L Error: arg #2 to push has type incompatible with array
.*:41: L Error: arg #2 to push has type incompatible with array
.*:42: L Error: arg #2 to push has type incompatible with array
.*:43: L Error: arg #2 to push has type incompatible with array
.*:44: L Error: arg #2 to push has type incompatible with array
.*:45: L Error: arg #2 to push has type incompatible with array
.*:47: L Error: arg #2 to push has type incompatible with array
.*:47: L Error: arg #3 to push has type incompatible with array
.*:48: L Error: arg #3 to push has type incompatible with array
.*:49: L Error: arg #3 to push has type incompatible with array
.*:49: L Error: arg #4 to push has type incompatible with array
}

test typecheck-6.3 {type check push built-in} -body {
#lang L --line=1
void
typecheck_6_3()
{
	int	ai[], i;
	string	as[], s;
	widget	aw[], w;
	float	af[], f;
	poly	ap[], p;
	int	aa[][], a[];		// array of array, and an array
	int	ah[]{int}, h{int};	// array of hash, and a hash
	struct { int i,j; } ast[], st;	// array of struct, and a struct

	/* All legal. */

	push(&ai, 0);
	push(&ai, i);

	push(&as, "s");
	push(&as, s);

	push(&af, 3.14);
	push(&af, f);
	push(&af, 0);  // legal to push ints onto a float array
	push(&af, i);

	push(&ap, 0);
	push(&ap, 3.14);
	push(&ap, "s");
	push(&ap, i);
	push(&ap, s);
	push(&ap, w);
	push(&ap, f);
	push(&ap, p);
	push(&ap, ai);
	push(&ap, as);
	push(&ap, af);
	push(&ap, ap);
	push(&ap, aw);
	push(&ap, ast);
	push(&ap, h);
	push(&ap, st);

	push(&aw, w);
	push(&aw, (widget)"w");
	push(&aw, s);  // legal to push strings onto a widget array
	push(&aw, "w");

	push(&ah, h);

	push(&aa, a);

	push(&ast, st);
}
#lang tcl
typecheck_6_3
} -output {}

test typecheck-7.1 {test type checking of reference parameters} -body {
#lang L --line=1 -nowarn
void typecheck_7_1_foo(int &a) {}
void typecheck_7_1()
{
	int	a;

	typecheck_7_1_foo(a);  // incorrect arg type
}
typecheck_7_1();
} -returnCodes error -match regexp -result {.*6: L Error: parameter 1 has incompatible type
}

test typecheck-8.1 {widget and string type compatibility} -body {
#lang L --line=1
void typecheck_8_1()
{
	poly	p = "p";
	string	s = "s";
	widget	w = "w";

	p = s;
	unless (p eq "s") puts("bad 1");
	p = w;
	unless (p eq "w") puts("bad 2");
	p = p;
	unless (p eq "w") puts("bad 3");
	p = "p";
	s = p;
	unless (s eq "p") puts("bad 4");
	s = s;
	unless (s eq "p") puts("bad 5");
	s = w;
	unless (s eq "w") puts("bad 6");
	s = "s";
	w = p;
	unless (w eq "p") puts("bad 7");
	w = s;
	unless (w eq "s") puts("bad 8");
	w = w;
	unless (w eq "s") puts("bad 9");
	w = "w";

	unless (p ne s) puts("bad 10");
	unless (s ne p) puts("bad 11");
	unless (p ne w) puts("bad 12");
	unless (w ne p) puts("bad 13");
	unless (s ne w) puts("bad 14");
	unless (w ne s) puts("bad 15");
	unless (p eq p) puts("bad 16");
	unless (s eq s) puts("bad 17");
	unless (w eq w) puts("bad 18");
}
#lang tcl
typecheck_8_1
} -output {}

test typecheck-9.1 {illegal types in function prototype declarations} -body {
#lang L --line=1
void typecheck_9_1_1(void, void);
void typecheck_9_1_2(void, void, void);
void typecheck_9_1_3(int, void);
void typecheck_9_1_4(void, int);
void typecheck_9_1_5(void[]);
void typecheck_9_1_6(void[][]);
void typecheck_9_1_7(void{int});
void typecheck_9_1_8(void{int}[]);
void typecheck_9_1_9(void[]{int});
void typecheck_9_1_10(void &bad);
void typecheck_9_1_11(int{void});
void{int} typecheck_9_1_12();
void[] typecheck_9_1_13();
int{void} typecheck_9_1_14();
} -returnCodes error -match regexp -result {.*1: L Error: type void illegal
.*1: L Error: type void illegal
.*2: L Error: type void illegal
.*2: L Error: type void illegal
.*2: L Error: type void illegal
.*3: L Error: type void illegal
.*4: L Error: type void illegal
.*5: L Error: type void illegal
.*6: L Error: type void illegal
.*7: L Error: type void illegal
.*8: L Error: type void illegal
.*9: L Error: type void illegal
.*10: L Error: type void illegal in declaration of 'bad'
.*11: L Error: type void illegal
.*12: L Error: type void illegal in declaration of 'typecheck_9_1_12'
.*13: L Error: type void illegal in declaration of 'typecheck_9_1_13'
.*14: L Error: type void illegal in declaration of 'typecheck_9_1_14'
}

test typecheck-9.2 {illegal types in function pointer args} -body {
#lang L --line=1
void typecheck_9_2_1(void &bad(void, void));
void typecheck_9_2_2(void &bad(void, void, void));
void typecheck_9_2_3(void &bad(int, void));
void typecheck_9_2_4(void &bad(void, int));
void typecheck_9_2_5(void &bad(void[]));
void typecheck_9_2_6(void &bad(void[][]));
void typecheck_9_2_7(void &bad(void{int}));
void typecheck_9_2_8(void &bad(void{int}[]));
void typecheck_9_2_9(void &bad(void[]{int}));
void typecheck_9_2_10(void &bad(void &bad));
void typecheck_9_2_11(void &bad(int{void}));
void typecheck_9_2_12(void{int} &bad());
void typecheck_9_2_13(void[] &bad());
void typecheck_9_2_14(int{void} &bad());
} -returnCodes error -match regexp -result {.*1: L Error: type void illegal
.*1: L Error: type void illegal
.*2: L Error: type void illegal
.*2: L Error: type void illegal
.*2: L Error: type void illegal
.*3: L Error: type void illegal
.*4: L Error: type void illegal
.*5: L Error: type void illegal
.*6: L Error: type void illegal
.*7: L Error: type void illegal
.*8: L Error: type void illegal
.*9: L Error: type void illegal
.*10: L Error: type void illegal in declaration of 'bad'
.*11: L Error: type void illegal
.*12: L Error: type void illegal in declaration of 'bad'
.*13: L Error: type void illegal in declaration of 'bad'
.*14: L Error: type void illegal in declaration of 'bad'
}

test typecheck-9.3 {illegal types in variable declarations 1} -body {
#lang L --line=1
void typecheck_9_3()
{
	void	bad1;
	void	bad2[];
	void	bad3[][];
	void	bad4{int};
	void	bad5{int}{int};
	void	bad6[]{int};
	void	bad7{int}[];
	int	bad8{void};
	int	bad9[]{void}{int};
	int	&bad10;
	int	&bad11[];
	int	&bad12{int};
	int	&bad13(void);
	int	&bad14(int);
	int	&bad15(int arg);
}
} -returnCodes error -match regexp -result {.*3: L Error:.*bad1.*
.*4: L Error:.*bad2.*
.*5: L Error:.*bad3.*
.*6: L Error:.*bad4.*
.*7: L Error:.*bad5.*
.*8: L Error:.*bad6.*
.*9: L Error:.*bad7.*
.*10: L Error:.*bad8.*
.*11: L Error:.*bad9.*
.*12: L Error:.*bad10.*
.*13: L Error:.*bad11.*
.*14: L Error:.*bad12.*
.*15: L Error:.*bad13.*
.*16: L Error:.*bad14.*
.*17: L Error:.*bad15.*
}

test typecheck-9.3.1 {illegal types in variable declarations 2} -body {
#lang L --line=1
void typecheck_9_3_1()
{
	void	bad1, bad2[], bad3[][],	bad4{int}, bad5{int}{int};
	void	bad6[]{int}, bad7{int}[], bad8{void}, bad9[]{void}{int};
	int	&bad10, &bad11[], &bad12{int}, &bad13(void);
	int	&bad14(int), &bad15(int arg);
}
} -returnCodes error -match regexp -result {.*3: L Error:.*bad1.*
.*3: L Error:.*bad2.*
.*3: L Error:.*bad3.*
.*3: L Error:.*bad4.*
.*3: L Error:.*bad5.*
.*4: L Error:.*bad6.*
.*4: L Error:.*bad7.*
.*4: L Error:.*bad8.*
.*4: L Error:.*bad9.*
.*5: L Error:.*bad10.*
.*5: L Error:.*bad11.*
.*5: L Error:.*bad12.*
.*5: L Error:.*bad13.*
.*6: L Error:.*bad14.*
.*6: L Error:.*bad15.*
}

test typecheck-9.3.2 {illegal types in variable declarations 3} -body {
#lang L --line=1
typedef void &t932();
void typecheck_9_3_2()
{
	t932	bad1;
	t932	bad2[];
	t932	bad3[][];
	t932	bad4{int};
	t932	bad5{int}{int};
	t932	bad6[]{int};
	t932	bad7{int}[];
	t932	bad8{void};
	t932	bad9[]{void}{int};
	t932	&bad10;
	t932	&bad11[];
	t932	&bad12{int};
	t932	&bad13(void);
	t932	&bad14(int);
	t932	&bad15(int arg);
}
} -returnCodes error -match regexp -result {.*4: L Error:.*bad1.*
.*5: L Error:.*bad2.*
.*6: L Error:.*bad3.*
.*7: L Error:.*bad4.*
.*8: L Error:.*bad5.*
.*9: L Error:.*bad6.*
.*10: L Error:.*bad7.*
.*11: L Error:.*bad8.*
.*12: L Error:.*bad9.*
.*13: L Error:.*bad10.*
.*14: L Error:.*bad11.*
.*15: L Error:.*bad12.*
.*16: L Error:.*bad13.*
.*17: L Error:.*bad14.*
.*18: L Error:.*bad15.*
}

test typecheck-9.4 {illegal types in struct declarations 1} -body {
#lang L --line=1
struct {
	void	bad1;
	void	bad2[];
	void	bad3[][];
	void	bad4{int};
	void	bad5{int}{int};
	void	bad6[]{int};
	void	bad7{int}[];
	int	bad8{void};
	int	bad9[]{void}{int};
	int	&bad10;
	int	&bad11[];
	int	&bad12{int};
	int	&bad13(void);
	int	&bad14(int);
	int	&bad15(int arg);
};
} -returnCodes error -match regexp -result {.*2: L Error:.*bad1.*
.*3: L Error:.*bad2.*
.*4: L Error:.*bad3.*
.*5: L Error:.*bad4.*
.*6: L Error:.*bad5.*
.*7: L Error:.*bad6.*
.*8: L Error:.*bad7.*
.*9: L Error:.*bad8.*
.*10: L Error:.*bad9.*
.*11: L Error:.*bad10.*
.*12: L Error:.*bad11.*
.*13: L Error:.*bad12.*
.*14: L Error:.*bad13.*
.*15: L Error:.*bad14.*
.*16: L Error:.*bad15.*
}

test typecheck-9.4.1 {illegal types in struct declarations 2} -body {
#lang L --line=1
struct {
	void	bad1, bad2[], bad3[][], bad4{int}, bad5{int}{int};
	void	bad6[]{int}, bad7{int}[], bad8{void};
	int	bad9[]{void}{int}, &bad10, &bad11[];
	int	&bad12{int}, &bad13(void), &bad14(int), &bad15(int arg);
};
} -returnCodes error -match regexp -result {.*2: L Error:.*bad1.*
.*2: L Error:.*bad2.*
.*2: L Error:.*bad3.*
.*2: L Error:.*bad4.*
.*2: L Error:.*bad5.*
.*3: L Error:.*bad6.*
.*3: L Error:.*bad7.*
.*3: L Error:.*bad8.*
.*4: L Error:.*bad9.*
.*4: L Error:.*bad10.*
.*4: L Error:.*bad11.*
.*5: L Error:.*bad12.*
.*5: L Error:.*bad13.*
.*5: L Error:.*bad14.*
.*5: L Error:.*bad15.*
}

test typecheck-9.4.2 {illegal types in struct declarations 3} -body {
#lang L --line=1
typedef void &t942();
struct {
	t942	bad1;
	t942	bad2[];
	t942	bad3[][];
	t942	bad4{int};
	t942	bad5{int}{int};
	t942	bad6[]{int};
	t942	bad7{int}[];
	t942	bad8{void};
	t942	bad9[]{void}{int};
	t942	&bad10;
	t942	&bad11[];
	t942	&bad12{int};
	t942	&bad13(void);
	t942	&bad14(int);
	t942	&bad15(int arg);
};
} -returnCodes error -match regexp -result {.*3: L Error:.*bad1.*
.*4: L Error:.*bad2.*
.*5: L Error:.*bad3.*
.*6: L Error:.*bad4.*
.*7: L Error:.*bad5.*
.*8: L Error:.*bad6.*
.*9: L Error:.*bad7.*
.*10: L Error:.*bad8.*
.*11: L Error:.*bad9.*
.*12: L Error:.*bad10.*
.*13: L Error:.*bad11.*
.*14: L Error:.*bad12.*
.*15: L Error:.*bad13.*
.*16: L Error:.*bad14.*
.*17: L Error:.*bad15.*
}

test typecheck-9.4.3 {call-by-name type errors} -body {
#lang L --line=1 -nowarn
typedef int arr_t[];
typedef int hash_t{int};
typedef struct { int i,j; } struc_t;
void t943(int &i, string &s, float &f, arr_t &a, hash_t &h, struc_t &st) {}

void typecheck_9_4_3()
{
	int	i;
	string	s;
	float	f;
	arr_t	a;
	hash_t	h;
	struc_t	st;

	t943( i, &s, &f, &a, &h, &st);
	t943(&i,  s, &f, &a, &h, &st);
	t943(&i, &s,  f, &a, &h, &st);
	t943(&i, &s, &f,  a, &h, &st);
	t943(&i, &s, &f, &a,  h, &st);
	t943(&i, &s, &f, &a, &h,  st);
	t943( i,  s,  f,  a,  h,  st);
}
} -returnCodes error -match regexp -result {.*15: L Error: parameter 1 has incompatible type
.*16: L Error: parameter 2 has incompatible type
.*17: L Error: parameter 3 has incompatible type
.*18: L Error: parameter 4 has incompatible type
.*19: L Error: parameter 5 has incompatible type
.*20: L Error: parameter 6 has incompatible type
.*21: L Error: parameter 1 has incompatible type
.*21: L Error: parameter 2 has incompatible type
.*21: L Error: parameter 3 has incompatible type
.*21: L Error: parameter 4 has incompatible type
.*21: L Error: parameter 5 has incompatible type
.*21: L Error: parameter 6 has incompatible type
}

test typecheck-10.1 {check type errors in op=} -body {
#lang L --line=1
void typecheck_10_1()
{
	int	i1, i2;
	string	s1;


	i1 += s1;
	i1 -= s1;
	i1 *= s1;
	i1 /= s1;

	i1 %= s1;
	s1 %= i1;
	i1 &= s1;
	s1 &= i1;
	i1 |= s1;
	s1 |= i1;
	i1 ^= s1;
	s1 ^= i1;
	i1 <<= s1;
	s1 <<= i1;
	i1 >>= s1;
	s1 >>= i1;

	i1 .= i2;
	i1 .= s1;
	s1 .= i1;
}
} -returnCodes error -match regexp -result {.*7: L Error: assignment of incompatible types
.*8: L Error: assignment of incompatible types
.*9: L Error: assignment of incompatible types
.*10: L Error: assignment of incompatible types
.*12: L Error: assignment of incompatible types
.*13: L Error: assignment of incompatible types
.*14: L Error: assignment of incompatible types
.*15: L Error: assignment of incompatible types
.*16: L Error: assignment of incompatible types
.*17: L Error: assignment of incompatible types
.*18: L Error: assignment of incompatible types
.*19: L Error: assignment of incompatible types
.*20: L Error: assignment of incompatible types
.*21: L Error: assignment of incompatible types
.*22: L Error: assignment of incompatible types
.*23: L Error: assignment of incompatible types
.*25: L Error: expected type string or widget but got int in .=
.*26: L Error: assignment of incompatible types
.*27: L Error: assignment of incompatible types
}

test typecheck-10.2 {check type errors in comparison operators} -body {
#lang L --line=1
void typecheck_10_2()
{
	int	i;
	string	s;

	s == i;  // line 6
	i == s;

	s != i;
	i != s;  // line 10

	s <= i;
	i <= s;

	s >= i;  // line 15
	i >= s;

	s <  i;
	i <  s;
	// line 20
	s >  i;
	i >  s;


	i eq s;  // line 25
	s eq i;
	i eq i;
	i ne s;
	s ne i;
	i ne i;  // line 30
	i le s;
	s le i;
	i le i;
	i ge s;
	s ge i;  // line 35
	i ge i;
	i lt s;
	s lt i;
	i lt i;
	i gt s;  // line 40
	s gt i;
	i gt i;  // line 42
}
} -returnCodes error -match regexp -result {.*6: L Error: incompatible types in comparison
.*7: L Error: incompatible types in comparison
.*9: L Error: incompatible types in comparison
.*10: L Error: incompatible types in comparison
.*12: L Error: incompatible types in comparison
.*15: L Error: incompatible types in comparison
.*16: L Error: incompatible types in comparison
.*18: L Error: incompatible types in comparison
.*19: L Error: incompatible types in comparison
.*21: L Error: incompatible types in comparison
.*22: L Error: incompatible types in comparison
.*25: L Error: expected type string or widget but got int in string comparison
.*26: L Error: expected type string or widget but got int in string comparison
.*27: L Error: expected type string or widget but got int in string comparison
.*28: L Error: expected type string or widget but got int in string comparison
.*29: L Error: expected type string or widget but got int in string comparison
.*30: L Error: expected type string or widget but got int in string comparison
.*31: L Error: expected type string or widget but got int in string comparison
.*32: L Error: expected type string or widget but got int in string comparison
.*34: L Error: expected type string or widget but got int in string comparison
.*35: L Error: expected type string or widget but got int in string comparison
.*36: L Error: expected type string or widget but got int in string comparison
.*37: L Error: expected type string or widget but got int in string comparison
.*38: L Error: expected type string or widget but got int in string comparison
.*39: L Error: expected type string or widget but got int in string comparison
.*40: L Error: expected type string or widget but got int in string comparison
.*41: L Error: expected type string or widget but got int in string comparison
.*42: L Error: expected type string or widget but got int in string comparison
}

test typecheck-10.3 {check type names in type-error messages} -body {
#lang L --line=1
class typecheck_10_3_cls {}
void typecheck_10_3()
{
	int			x;
	typecheck_10_3_cls	obj;

	1 eq "string";
	1.0 eq "string";
	"string" == 1;
	(widget)"s" == 1;
	(void)"s" == 1;
	(int{int})"s" == 1;
	(struct {int i;})"s" == 1;
	(int[])"s" == 1;
	{1,2,3} == 1;
	&x == 1;
	obj == 1;
}
} -returnCodes error -match regexp -result {.*7: L Error: expected type string or widget but got int in string comparison
.*8: L Error: expected type string or widget but got float in string comparison
.*9: L Error: incompatible types in comparison
.*10: L Error: incompatible types in comparison
.*11: L Error: type void illegal
.*12: L Error: incompatible types in comparison
.*13: L Error: incompatible types in comparison
.*14: L Error: incompatible types in comparison
.*15: L Error: incompatible types in comparison
.*16: L Error: incompatible types in comparison
.*17: L Error: incompatible types in comparison
}

test typecheck-11.1 {check FMT errors} -body {
#lang L --line=1
void typeck_11_1_foo0(_argused FMT fmt, _argused ...args) {}
void typeck_11_1_foo1(_argused int a, _argused FMT fmt, _argused ...args) {}
void typecheck_11_1()
{
	typeck_11_1_foo0("%s");
	typeck_11_1_foo0("%s %s");
	typeck_11_1_foo0("%s %s", "bad");
	typeck_11_1_foo0("%%s %s");

	typeck_11_1_foo1(1, "%s");
	typeck_11_1_foo1(1, "%s %s");
	typeck_11_1_foo1(1, "%s %s", "bad");
	typeck_11_1_foo1(1, "%%s %s");

	// With some unicode.
	typeck_11_1_foo0("זו ה%sשפה שלנו");
	typeck_11_1_foo0("%s זו ה%%sשפה שלנו");

	typeck_11_1_foo0(1);  // format arg not a string
}
typecheck_11_1();
} -returnCodes error -match regexp -result {.*5: L Warning: bad format specifier
.*6: L Warning: bad format specifier
.*7: L Warning: bad format specifier
.*8: L Warning: bad format specifier
.*10: L Warning: bad format specifier
.*11: L Warning: bad format specifier
.*12: L Warning: bad format specifier
.*13: L Warning: bad format specifier
.*16: L Warning: bad format specifier
.*17: L Warning: bad format specifier
.*19: L Error: parameter 1 has incompatible type
}

test typecheck-11.2 {check FMT errors 2} -body {
#lang L --line=1
void typeck_11_2_foo0(_argused FMT fmt, _argused int bad) {}
void typeck_11_2_foo1(_argused FMT fmt) {}
} -returnCodes error -match regexp -result {.*1: L Error: rest argument must follow FMT
.*2: L Error: rest argument must follow FMT
}

test typecheck-11.3 {check FMT cases where compile-time checks cannot be done} -body {
#lang L --line=1
void typeck_11_3_foo0(_argused FMT fmt, _argused ...args) {}
void typecheck_11_3()
{
	string	fmt = "%s";

	typeck_11_3_foo0("${fmt}", "bad", "but", "no", "error");
	typeck_11_3_foo0(fmt, "bad", "but", "no", "error");
}
typecheck_11_3();
} -output {}

test typecheck-11.4 {check that unicode does not confuse FMT checking} -body {
#lang L --line=1
void typecheck_11_4()
{
	string	s;

	s = sprintf("זו ה%sשפה שלנו %s", "is", "meaningless");
	unless (s == "זו הisשפה שלנו meaningless") puts("bad 1");
}
typecheck_11_4();
} -output {}

test typecheck-11.5 {check more legal FMT cases} -body {
#lang L
void typecheck_11_5()
{
	string	a[] = { "1", "2", "3" };

	/*
	 * These are legal cases where the number of %'s in the format
	 * arg doesn't equal the number of subsequent args.
	 */

	unless (sprintf("%1$d %1$x", 16) == "16 10") puts("bad 1");
	unless (sprintf("%*s", 6, "123") == "   123") puts("bad 2");
	unless (sprintf("%.*s", 3, "1234567890") == "123") puts("bad 3");
	unless (sprintf("%*.*s", 3, 5, "1234567890") == "12345") puts("bad 4");
	unless (sprintf("%%s") == "%s") puts("bad 5");

	/*
	 * Here, the number of actuals isn't known at comile time so
	 * no check should be done and therefore no compile-time error
	 * should occur.
	 */

	unless (sprintf("%s %s %s", (expand)a) == "1 2 3") puts("bad 10");
}
typecheck_11_5();
} -output {}

test fnptr-1 {function pointers 1} -body {
#lang L --line=1
typedef string &fnptr1_t(int);

string fnptr1_doit(int x)
{
	return ("doit got ${x}");
}
string fnptr1_foo(string &f(int))
{
	return (f(33));
}
string fnptr1_foo2(fnptr1_t f)
{
	return (f(44));
}
void fnptr_1()
{
	unless (fnptr1_foo(&fnptr1_doit) eq "doit got 33") puts("bad 1");
	unless (fnptr1_foo2(&fnptr1_doit) eq "doit got 44") puts("bad 2");
}
#lang tcl
fnptr_1
} -output {}

test fnptr-2 {function pointers 2} -body {
#lang L --line=1
typedef int &fnptr2_t(poly,poly);

/* Integer comparison. */
int icmp(int a, int b)
{
	if (a < b) {
		return -1;
	} else if (a > b) {
		return 1;
	} else {
		return 0;
	}
}

/* Unary comparison. */
int ucmp(string a, string b)
{
	int	al = strlen(a);
	int	bl = strlen(b);

	if (al < bl) {
		return -1;
	} else if (al > bl) {
		return 1;
	} else {
		return 0;
	}
}

string fnptr2_sort(poly[] a, fnptr2_t compar)
{
	int	i, swapped;

	do {
		swapped = 0;
		for (i = 0; i < length(a)-1; ++i) {
			if (compar(a[i], a[i+1]) > 0) {
				poly t = a[i];
				a[i]   = a[i+1];
				a[i+1] = t;
				swapped = 1;
			}
		}
	} while (swapped);

	return ((string)a);
}

void fnptr_2()
{
	unless (fnptr2_sort((int[])"3 1 4 1 5 9", &icmp) eq "1 1 3 4 5 9") {
		puts("bad 1");
	}
	unless (fnptr2_sort((string[])"111 1 1 11 111111111 11111", &ucmp) eq
		"1 1 11 111 11111 111111111") {
		puts("bad 2");
	}
}
#lang tcl
fnptr_2
} -output {}

test fnptr-3 {function pointer type errors} -body {
#lang L --line=1 -nowarn
typedef void &fp3_v_v_t(void);
typedef void &fp3_v_i_t(int);
typedef int  &fp3_i_v_t(void);
typedef int  &fp3_i_i_t(int);
typedef void &fp3_v_is_t(int, string);

void fp3_v_v(void)  {}
void fp3_v_i(int i) {}
int  fp3_i_v(void)  { return (0); }
int  fp3_i_i(int i) { return (i); }
void fp3_v_is(int i, string s) {}

void fp3f_vv (fp3_v_v_t f)   { f();  }
void fp3f_vi (fp3_v_i_t f)   { f(1); }
void fp3f_iv (fp3_i_v_t f)   { f();  }
void fp3f_ii (fp3_i_i_t f)   { f(1); }
void fp3f_vis(fp3_v_is_t f) { f(1,"s"); }

void fnptr_3()
{
	fp3f_vv(1);
	fp3f_vv(1.1);
	fp3f_vv((int[])"1 2 3");
	fp3f_vv((hash)"1 2 3 4");
	fp3f_vv((struct { int i,j; })"1 2");

	/* Try all the various error combinations, given the above types. */

	fp3f_vv(fp3_v_v);
	fp3f_vv(&fp3_v_i);
	fp3f_vv(&fp3_i_v);
	fp3f_vv(&fp3_i_i);
	fp3f_vv(&fp3_v_is);

	fp3f_vi(fp3_v_i);
	fp3f_vi(&fp3_v_v);
	fp3f_vi(&fp3_i_v);
	fp3f_vi(&fp3_i_i);
	fp3f_vi(&fp3_v_is);

	fp3f_iv(fp3_i_v);
	fp3f_iv(&fp3_v_v);
	fp3f_iv(&fp3_v_i);
	fp3f_iv(&fp3_i_i);
	fp3f_iv(&fp3_v_is);

	fp3f_ii(fp3_i_i);
	fp3f_ii(&fp3_v_v);
	fp3f_ii(&fp3_v_i);
	fp3f_ii(&fp3_i_v);
	fp3f_ii(&fp3_v_is);

	fp3f_vis(fp3_v_is);
	fp3f_vis(&fp3_v_v);
	fp3f_vis(&fp3_v_i);
	fp3f_vis(&fp3_i_v);
	fp3f_vis(&fp3_i_i);
}
} -returnCodes error -match regexp -result {.*21: L Error: parameter 1.*
.*22: L Error: parameter 1.*
.*23: L Error: parameter 1.*
.*24: L Error: parameter 1.*
.*25: L Error: parameter 1.*
.*30: L Error: parameter 1.*
.*31: L Error: parameter 1.*
.*32: L Error: parameter 1.*
.*33: L Error: parameter 1.*
.*36: L Error: parameter 1.*
.*37: L Error: parameter 1.*
.*38: L Error: parameter 1.*
.*39: L Error: parameter 1.*
.*42: L Error: parameter 1.*
.*43: L Error: parameter 1.*
.*44: L Error: parameter 1.*
.*45: L Error: parameter 1.*
.*48: L Error: parameter 1.*
.*49: L Error: parameter 1.*
.*50: L Error: parameter 1.*
.*51: L Error: parameter 1.*
.*54: L Error: parameter 1.*
.*55: L Error: parameter 1.*
.*56: L Error: parameter 1.*
.*57: L Error: parameter 1.*
}

test assign-1 {check assignment statement value and type} -body {
#lang L --line=1
void
assign_1()
{
	/*
	 * Check type and value of "lhs = rhs".  Rhs should be
	 * evaluated before lhs.  The type of (lhs = rhs) should be
	 * the type of lhs and have the value of lhs.
	 */

	int	i, j, k;
	float	f, g;
	string	s1, s2;
	int	a1[], a2[], a3[];
	int	h1{int}, h2{int}, h3{int};

	i = (j = 13);
	unless ((i == 13) && (j == 13)) puts("bad 1");

	i = (j = (k = 14));
	unless ((i == 14) && (j == 14) && (k == 14)) puts("bad 2");

	i = j = k = 14;  // = should be right associative
	unless ((i == 14) && (j == 14) && (k == 14)) puts("bad 2.1");

	/* Note: exact comparisons against floats don't always work. */
	f = (g = (i = 1));
	unless ((f == 1.0) && (g == 1.0)) puts("bad 3");

	s1 = (s2 = "ok");
	unless ((s1 eq "ok") && (s2 eq "ok")) puts("bad 4");

	a1[0] = 3;
	a3 = (a2 = a1);
	unless ((a1[0] == 3) && !defined(a1[1])) puts("bad 5.1");
	unless ((a2[0] == 3) && !defined(a2[1])) puts("bad 5.2");
	unless ((a3[0] == 3) && !defined(a3[1])) puts("bad 5.3");

	h1{1} = 4;
	h3 = (h2 = h1);
	unless ((h1{1} == 4) && (h2{1} == 4) && (h3{1} == 4)) puts("bad 6.1");
	foreach (i in h1) unless (i == 1) puts("bad 6.2");
	foreach (i in h2) unless (i == 1) puts("bad 6.3");
	foreach (i in h3) unless (i == 1) puts("bad 6.4");

	/* Check that rhs is evaluated *before* lhs. */

	i = 0;
	a1[i] = (i = 2);
	unless (a1[2] == 2) puts("bad 7");

	i = 3;
	a1[3] = 1;
	a1[4] = 2;
	a1[i] = ++i;
	unless ((a1[3] == 1) && (a1[4] == 4)) puts("bad 8");

	i = 3;
	a1[3] = 1;
	a1[4] = 2;
	a1[i] = i++;
	unless ((a1[3] == 1) && (a1[4] == 3)) puts("bad 9");

	i = 3;
	a1[3] = 1;
	a1[4] = 2;
	a1[i] += ++i;
	unless ((a1[3] == 1) && (a1[4] == 6)) puts("bad 10");

	i = 3;
	a1[3] = 1;
	a1[4] = 2;
	a1[i] += i++;
	unless ((a1[3] == 1) && (a1[4] == 5)) puts("bad 11");
}
#lang tcl
assign_1
} -output {}

test backtrace-1.0 {backtracing in L} -setup {
	set fname [makeFile {
void foo()
{
	puts("foo", "bar");
}

void bar()
{
	foo();
}

int
main()
{
	bar();
}

	} backtrace-1.0.l]
} -constraints {
	exec
} -body {
	exec [interpreter] $fname
} -cleanup {
	removeFile backtrace-1.0.l
} -returnCodes {error} -match regexp -result {.*line 4.*line 9.*line 15}

test pattern-1.0 {L pattern functions} -body {
#lang L --line=1
string Pattern1_()
{
	// This is NOT a pattern function (because the _ is trailing).
	return("Pattern1_");
}
string Pattern1_foo(int a, int b)
{
	return("Pattern1_foo ${a} ${b}");
}
string Pattern1_*(...args)
{
	poly	p;
	string	ret = "Pattern1_* ${$1}";
	foreach (p in args) ret .= " ${p}";
	return (ret);
}
string pattern2(...args)
{
	poly	p;
	string	ret = "pattern2";
	foreach (p in args) ret .= " ${p}";
	return (ret);
}
string p1_0_widget(...args)
{
	poly	p;
	string	ret = "p1_0_widget";
	foreach (p in args) ret .= " ${p}";
	return (ret);
}
void pattern_1_0()
{
	string	s;
	widget	w = "p1_0_widget";

	s = Pattern1_foo(1, 2);	// calls Pattern1_foo(1, 2)
	unless (s eq "Pattern1_foo 1 2") puts("bad 1.1");

	s = Pattern1_bar();	// calls Pattern1_*("bar")
	unless (s eq "Pattern1_* bar") puts("bad 2.1");
	s = Pattern1_bar(3);	// calls Pattern1_*("bar", 3)
	unless (s eq "Pattern1_* bar 3") puts("bad 2.2");
	s = Pattern1_bar(3, 4);	// calls Pattern1_*("bar", 3, 4)
	unless (s eq "Pattern1_* bar 3 4") puts("bad 2.3");
	s = Pattern1_foo123(1, 2);	// calls Pattern1_*("foo123", 1, 2)
	unless (s eq "Pattern1_* foo123 1 2") puts("bad 2.4");
	s = Pattern1_foo_(1, 2);	// calls Pattern1_*("foo_", 1, 2)
	unless (s eq "Pattern1_* foo_ 1 2") puts("bad 2.5");

	s = Pattern1_Bar();	// calls Pattern1_*("bar")
	unless (s eq "Pattern1_* bar") puts("bad 3.1");
	s = Pattern1_Bar(3);	// calls Pattern1_*("bar", 3)
	unless (s eq "Pattern1_* bar 3") puts("bad 3.2");
	s = Pattern1_Bar(3, 4);	// calls Pattern1_*("bar", 3, 4)
	unless (s eq "Pattern1_* bar 3 4") puts("bad 3.3");

	s = Pattern1_barBaz();
	unless (s eq "Pattern1_* bar baz") puts("bad 4.1");
	s = Pattern1_barBaz(3);
	unless (s eq "Pattern1_* bar baz 3") puts("bad 4.2");
	s = Pattern1_barBaz(3, 4);
	unless (s eq "Pattern1_* bar baz 3 4") puts("bad 4.3");

	s = Pattern1_barBazBlech();
	unless (s eq "Pattern1_* bar baz blech") puts("bad 5.1");
	s = Pattern1_barBazBlech(3);
	unless (s eq "Pattern1_* bar baz blech 3") puts("bad 5.2");
	s = Pattern1_barBazBlech(3, 4);
	unless (s eq "Pattern1_* bar baz blech 3 4") puts("bad 5.3");

	s = Pattern2_bar();	// calls pattern2("bar")
	unless (s eq "pattern2 bar") puts("bad 6.1");
	s = Pattern2_bar(5);	// calls pattern2("bar", 5)
	unless (s eq "pattern2 bar 5") puts("bad 6.2");
	s = Pattern2_bar(5, 6);	// calls pattern2("bar", 5, 6)
	unless (s eq "pattern2 bar 5 6") puts("bad 6.3");

	s = Pattern2_Bar();
	unless (s eq "pattern2 bar") puts("bad 7.1");
	s = Pattern2_Bar(5);
	unless (s eq "pattern2 bar 5") puts("bad 7.2");
	s = Pattern2_Bar(5, 6);
	unless (s eq "pattern2 bar 5 6") puts("bad 7.3");

	s = Pattern2_barBaz();
	unless (s eq "pattern2 bar baz") puts("bad 8.1");
	s = Pattern2_barBaz(5);
	unless (s eq "pattern2 bar baz 5") puts("bad 8.2");
	s = Pattern2_barBaz(5, 6);
	unless (s eq "pattern2 bar baz 5 6") puts("bad 8.3");

	s = Pattern2_barBazBlech();
	unless (s eq "pattern2 bar baz blech") puts("bad 9.1");
	s = Pattern2_barBazBlech(5);
	unless (s eq "pattern2 bar baz blech 5") puts("bad 9.2");
	s = Pattern2_barBazBlech(5, 6);
	unless (s eq "pattern2 bar baz blech 5 6") puts("bad 9.3");

	s = Pattern1_();	// calls Pattern1_()
	unless (s eq "Pattern1_") puts("bad 10.1");

	s = Pattern2_bar(w);	// calls p1_0_widget("bar")
	unless (s eq "p1_0_widget bar") puts("bad 20.1");
	s = Pattern2_bar(w, 1);	// calls p1_0_widget("bar", 1)
	unless (s eq "p1_0_widget bar 1") puts("bad 20.2");
	s = Pattern2_bar(w, 1, 2); // calls p1_0_widget("bar", 1, 2)
	unless (s eq "p1_0_widget bar 1 2") puts("bad 20.3");

	s = Pattern2_Bar(w);
	unless (s eq "p1_0_widget bar") puts("bad 21.1");
	s = Pattern2_Bar(w, 1);
	unless (s eq "p1_0_widget bar 1") puts("bad 21.2");
	s = Pattern2_Bar(w, 1, 2);
	unless (s eq "p1_0_widget bar 1 2") puts("bad 21.3");

	s = Pattern2_barBaz(w);
	unless (s eq "p1_0_widget bar baz") puts("bad 22.1");
	s = Pattern2_barBaz(w, 1);
	unless (s eq "p1_0_widget bar baz 1") puts("bad 22.2");
	s = Pattern2_barBaz(w, 1, 2);
	unless (s eq "p1_0_widget bar baz 1 2") puts("bad 22.3");

	s = Pattern2_barBazBlech(w);
	unless (s eq "p1_0_widget bar baz blech") puts("bad 23.1");
	s = Pattern2_barBazBlech(w, 1);
	unless (s eq "p1_0_widget bar baz blech 1") puts("bad 23.2");
	s = Pattern2_barBazBlech(w, 1, 2);
	unless (s eq "p1_0_widget bar baz blech 1 2") puts("bad 23.3");
}
pattern_1_0();
} -output {}

test pattern-1.2 {check pattern function argument type checking} -body {
#lang L --line=1 -nowarn
void Pattern120_*() {}
void Pattern121_*(int a) {}
void Pattern122_*(int a, int b) {}
void pattern_1_2()
{
	Pattern120_foo(1);
	Pattern121_foo();
	Pattern121_foo(1,2);
	Pattern122_foo();
	Pattern122_foo(1);
	Pattern122_foo(1,2,3);
}
pattern_1_2();
} -returnCodes {error} -match regexp -result {.*6: L Error: too many arguments for function Pattern120_foo
.*7: L Error: not enough arguments for function Pattern121_foo
.*8: L Error: too many arguments for function Pattern121_foo
.*9: L Error: not enough arguments for function Pattern122_foo
.*10: L Error: not enough arguments for function Pattern122_foo
.*11: L Error: too many arguments for function Pattern122_foo
}

test pattern-1.3 {check pattern function call with (expand) args} -body {
#lang L --line=1
string pattern13(...args)
{
	poly	p;
	string	ret = "pattern13";
	foreach (p in args) ret .= " ${p}";
	return (ret);
}
void pattern_1_3()
{
	int	i;
	string	got, want;
	string	args[], args2[];

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo((expand)args);
		want = "pattern13 foo";
		if (length(args)) want .= " " . join(" ", args);
		unless (got eq want) {
			printf("bad 1.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo((expand)args, "a");
		want = "pattern13 foo";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a";
		unless (got eq want) {
			printf("bad 2.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo((expand)args, "a", "b");
		want = "pattern13 foo";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a b";
		unless (got eq want) {
			printf("bad 3.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo((expand)args, "a", "b", "c");
		want = "pattern13 foo";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a b c";
		unless (got eq want) {
			printf("bad 4.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBar((expand)args);
		want = "pattern13 foo bar";
		if (length(args)) want .= " " . join(" ", args);
		unless (got eq want) {
			printf("bad 5.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBar((expand)args, "a");
		want = "pattern13 foo bar";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a";
		unless (got eq want) {
			printf("bad 6.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBar((expand)args, "a", "b");
		want = "pattern13 foo bar";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a b";
		unless (got eq want) {
			printf("bad 7.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBar((expand)args, "a", "b", "c");
		want = "pattern13 foo bar";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a b c";
		unless (got eq want) {
			printf("bad 8.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBarBaz((expand)args);
		want = "pattern13 foo bar baz";
		if (length(args)) want .= " " . join(" ", args);
		unless (got eq want) {
			printf("bad 9.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBarBaz((expand)args, "a");
		want = "pattern13 foo bar baz";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a";
		unless (got eq want) {
			printf("bad 10.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBarBaz((expand)args, "a", "b");
		want = "pattern13 foo bar baz";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a b";
		unless (got eq want) {
			printf("bad 11.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBarBaz((expand)args, "a", "b", "c");
		want = "pattern13 foo bar baz";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a b c";
		unless (got eq want) {
			printf("bad 12.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	args2 = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo((expand)args, (expand)args2, "a");
		want = "pattern13 foo";
		if (length(args)) want .= " " . join(" ", args);
		want .= " a";
		unless (got eq want) {
			printf("bad 20.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1] = (string)i;
	}

	args = {};
	args2 = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo((expand)args, (expand)args2, "a");
		want = "pattern13 foo";
		if (length(args))  want .= " " . join(" ", args);
		if (length(args2)) want .= " " . join(" ", args2);
		want .= " a";
		unless (got eq want) {
			printf("bad 20.2 got '%s' want '%s'\n", got, want);
		}
		args[END+1]  = (string)i;
		args2[END+1] = (string)(i*100);
	}

	args = {};
	args2 = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo((expand)args, "a", (expand)args2);
		want = "pattern13 foo";
		if (length(args))  want .= " " . join(" ", args);
		want .= " a";
		if (length(args2)) want .= " " . join(" ", args2);
		unless (got eq want) {
			printf("bad 20.3 got '%s' want '%s'\n", got, want);
		}
		args[END+1]  = (string)i;
		args2[END+1] = (string)(i*100);
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo("a", (expand)args);
		want = "pattern13 foo a";
		if (length(args))  want .= " " . join(" ", args);
		unless (got eq want) {
			printf("bad 21.1 got '%s' want '%s'\n", got, want);
		}
		args[END+1]  = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_foo("a", "b", (expand)args);
		want = "pattern13 foo a b";
		if (length(args))  want .= " " . join(" ", args);
		unless (got eq want) {
			printf("bad 21.2 got '%s' want '%s'\n", got, want);
		}
		args[END+1]  = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBar("a", (expand)args);
		want = "pattern13 foo bar a";
		if (length(args))  want .= " " . join(" ", args);
		unless (got eq want) {
			printf("bad 21.3 got '%s' want '%s'\n", got, want);
		}
		args[END+1]  = (string)i;
	}

	args = {};
	for (i = 0; i < 10; ++i) {
		got  = Pattern13_fooBar("a", "b", (expand)args);
		want = "pattern13 foo bar a b";
		if (length(args))  want .= " " . join(" ", args);
		unless (got eq want) {
			printf("bad 21.4 got '%s' want '%s'\n", got, want);
		}
		args[END+1]  = (string)i;
	}
}
pattern_1_3();
} -output {}

test include-1.0 {include files} -setup {
	set fname [makeFile {
			++include_1_0;
			unless (basename(__FILE__) eq "foo-1.0.l") puts("bad 1");
			unless (__LINE__ == 4) puts("bad 2");
		   } foo-1.0.l [file dirname [info script]]]
} -body {
#lang L --line=1
int include_1_0 = 0;
puts(include_1_0);
#include "foo-1.0.l"
puts(include_1_0);
// Check variations in spacing and punctation.
// The compiler should include foo-1.0.l only once.
#include"foo-1.0.l"
#include "foo-1.0.l"
#include  "foo-1.0.l"
#include  "foo-1.0.l" 
#include"foo-1.0.l"
puts(include_1_0);
} -cleanup {
	removeFile $fname
} -output {0
1
1
}

test include-1.1 {nested include files} -setup {
#
# The code for these files isn't indented because L recognizes
# include() only when it starts at the beginning of the line.
#
	set fname1 [makeFile {#include "foo-1.1-2.l"
unless (basename(__FILE__) eq "foo-1.1-1.l") puts("bad 1.1");
unless (__LINE__ == 3) puts("bad 1.2 ${__LINE__}");
} foo-1.1-1.l [file dirname [info script]]]
	set fname2 [makeFile {unless (__LINE__ == 1) puts("bad 2.1");
int include_1_1a = 3;
unless (basename(__FILE__) eq "foo-1.1-2.l") puts("bad 2.2");
unless (__LINE__ == 4) puts("bad 2.3");
#include "foo-1.1-3.l"
unless (basename(__FILE__) eq "foo-1.1-2.l") puts("bad 2.4");
unless (__LINE__ == 7) puts("bad 2.5 ${__LINE__}");
} foo-1.1-2.l .]
	set fname3 [makeFile {
int include_1_1b = 4;
unless (basename(__FILE__) eq "foo-1.1-3.l") puts("bad 3.1");
unless (__LINE__ == 4) puts("bad 3.2");
} foo-1.1-3.l .]
} -body {
#lang L --line=1
#include "foo-1.1-1.l"
unless (include_1_1a == 3) puts("bad 10.1");
unless (include_1_1b == 4) puts("bad 10.2");
} -cleanup {
	removeFile $fname1
	removeFile $fname2
	removeFile $fname3
} -output {}

test include-1.2 {malformed includes} -body {
#lang L --line=1
#include "
#include <
#include ""
#include <>
} -returnCodes {error} -match regexp -result {.*1: L Error: malformed #include
.*2: L Error: malformed #include
.*3: L Error: malformed #include
.*4: L Error: malformed #include
}

test include-1.3 {test line number tracking with include files} -setup {
	set fname1 [makeFile {int include_1_3a = "bad1";
#include "foo-1.3-2.l"} foo-1.3-1.l [file dirname [info script]]]
	set fname2 [makeFile {int include_1_3b = "bad2";
#include "foo-1.3-3.l"
int include_1_3c = "bad3";} foo-1.3-2.l .]
	set fname3 [makeFile {int include_1_3d = "bad4";} foo-1.3-3.l .]
} -body {
#lang L --line=1
int include_1_3 = "bad0";
#include "foo-1.3-1.l"
int include_1_3last = "badn";
} -cleanup {
	removeFile $fname1
	removeFile $fname2
	removeFile $fname3
} -returnCodes {error} -match regexp -result {.*1: L Error: assignment of incompatible types
.*foo-1.3-1.l:1: L Error: assignment of incompatible types
.*foo-1.3-2.l:1: L Error: assignment of incompatible types
.*foo-1.3-3.l:1: L Error: assignment of incompatible types
.*foo-1.3-2.l:3: L Error: assignment of incompatible types
.*3: L Error: assignment of incompatible types
}

test include-1.4 {test missing include file} -body {
#lang L --line=1
#include "does-not-exist.l"
} -returnCodes {error} -match regexp -result {.*1: L Error: cannot find include file does-not-exist.l
}

# Create files with the same names in $BIN/mydir, $BIN/include, and in
# the cwd of the L script, and ensure that the one specified by an
# absolute path (to mydir) gets included, where $BIN is where the
# running tclsh lives.
test include-1.5 {test include "/abs/path" search path} -setup {
	set mydir  [makeDirectory mydir [file dirname [interpreter]]]
	set incdir [makeDirectory include [file dirname [interpreter]]]
	set fname1 [makeFile {puts("good");} f-1.5-1.l $mydir]
	set fname2 [makeFile {puts("bad");}  f-1.5-1.l $incdir]
	set fname3 [makeFile {puts("bad");}  f-1.5-1.l .]
	set script [makeFile "#include \"$mydir/f-1.5-1.l\"" f-1.5-scr.l .]
} -constraints {
	exec
} -body {
	exec [interpreter] $script
} -cleanup {
	removeFile $fname1
	removeFile $fname2
	removeFile $fname3
	removeFile $script
	removeDirectory $mydir
	removeDirectory $incdir
} -result {good}

# Create files with the same names in $BIN/include and in
# the cwd of the L script, and ensure that #include "file.l" includes
# the one in the cwd, where $BIN is where the running tclsh lives.
test include-1.6 {test include "file" search path} -setup {
	set incdir [makeDirectory include [file dirname [interpreter]]]
	set fname1 [makeFile {puts("bad");}  f-1.6-1.l $incdir]
	set fname2 [makeFile {puts("good");} f-1.6-1.l .]
	set script [makeFile "#include \"f-1.6-1.l\"" f-1.6-scr.l .]
} -constraints {
	exec
} -body {
	exec [interpreter] $script
} -cleanup {
	removeFile $fname1
	removeFile $fname2
	removeFile $script
	removeDirectory $incdir
} -result {good}

# Create files with the same names in $BIN/include and in
# the cwd of the L script, and ensure that #include <file.l> includes
# the one in $BIN, where $BIN is where the running tclsh lives.
test include-1.7 {test include <file> search path 1} -setup {
	set incdir [makeDirectory include [file dirname [interpreter]]]
	set fname1 [makeFile {puts("good");} f-1.7-1.l $incdir]
	set fname2 [makeFile {puts("bad");}  f-1.7-1.l .]
	set script [makeFile "#include <f-1.7-1.l>" f-1.7-scr.l .]
} -constraints {
	exec
} -body {
	exec [interpreter] $script
} -cleanup {
	removeFile $fname1
	removeFile $fname2
	removeFile $script
	removeDirectory $incdir
} -result {good}

# Ensure that #include <file.l> finds file.l in $BIN/include,
# where $BIN is where the running tclsh lives.
test include-1.8 {test include <file> search path 1} -setup {
	set incdir [makeDirectory include [file dirname [interpreter]]]
	set fname1 [makeFile {puts("good");} f-1.8-1.l $incdir]
	set script [makeFile "#include <f-1.8-1.l>" f-1.8-scr.l .]
} -constraints {
	exec
} -body {
	exec [interpreter] $script
} -cleanup {
	removeFile $fname1
	removeFile $script
	removeDirectory $incdir
} -result {good}

test include-2.1 {nested include files almost nested too deeply} -setup {
	set fname1  [makeFile {#include "f-1.2.l"}  f-1.1.l [file dirname [info script]]]
	set fname2  [makeFile {#include "f-1.3.l"}  f-1.2.l .]
	set fname3  [makeFile {#include "f-1.4.l"}  f-1.3.l .]
	set fname4  [makeFile {#include "f-1.5.l"}  f-1.4.l .]
	set fname5  [makeFile {#include "f-1.6.l"}  f-1.5.l .]
	set fname6  [makeFile {#include "f-1.7.l"}  f-1.6.l .]
	set fname7  [makeFile {#include "f-1.8.l"}  f-1.7.l .]
	set fname8  [makeFile {#include "f-1.9.l"}  f-1.8.l .]
	set fname9  [makeFile {#include "f-1.10.l"} f-1.9.l .]
	set fname10 [makeFile {#include "f-1.11.l"} f-1.10.l .]
	set fname11 [makeFile {printf("ok");}	    f-1.11.l .]
} -body {
#lang L --line=1
#include "f-1.1.l"
} -output {ok}

test include-2.2 {nested include files nested too deeply} -setup {
	set fname1  [makeFile {#include "f-2.2.l"}  f-2.1.l [file dirname [info script]]]
	set fname2  [makeFile {#include "f-2.3.l"}  f-2.2.l .]
	set fname3  [makeFile {#include "f-2.4.l"}  f-2.3.l .]
	set fname4  [makeFile {#include "f-2.5.l"}  f-2.4.l .]
	set fname5  [makeFile {#include "f-2.6.l"}  f-2.5.l .]
	set fname6  [makeFile {#include "f-2.7.l"}  f-2.6.l .]
	set fname7  [makeFile {#include "f-2.8.l"}  f-2.7.l .]
	set fname8  [makeFile {#include "f-2.9.l"}  f-2.8.l .]
	set fname9  [makeFile {#include "f-2.10.l"} f-2.9.l .]
	set fname10 [makeFile {#include "f-2.11.l"} f-2.10.l .]
	set fname11 [makeFile {#include "f-2.12.l"} f-2.11.l .]
	set fname12 [makeFile {printf("ok");}	    f-2.12.l .]
} -body {
#lang L --line=1
#include "f-2.1.l"
} -returnCodes {error} -match regexp -result {f-2.11.l:1: L Error: include file nesting too deep -- aborting
}

# This test creates two slave interps that declare global symbols
# with the same names as those declared in the master interp.
# If the L global state is properly kept per-interp, there
# should be no multiple-declaration errors.

test interp-1 {test per-interp global state} -body {
#lang L --line=1
int interp_1_g;
void interp_1_foo() {}

#lang tcl
interp create interp_1_1
interp eval interp_1_1 {
#lang L --line=1
int interp_1_g;
void interp_1_foo() {}
}
interp create interp_1_2
interp eval interp_1_2 {
#lang L --line=1
int interp_1_g;
void interp_1_foo() {}
}
interp delete interp_1_2
interp delete interp_1_1
} -output {}

test split-1.0 {test split function} -body {
#lang L --line=1
void
split_1_0()
{
	int	m;
	string	s;
	string	r[];
	widget	w;

	/* These are all white space. */
	string	allspace[] = {
		"",
		" ",
		"  ",
		"   ",
		"    ",
		"\n",
		"\t",
		"\n\n" };

	foreach (s in allspace) {
		r = split(s);
		if (defined(r[0])) printf("bad 1: '%s'\n", s);
	}

	/*
	 * A split followed by a join should give the string back.
	 */

	s = "This is not a test. This is really not a test.";
	r = split(s);
	unless (s eq join(" ", r)) puts("bad 2.1");

	s = "This:is:not:a:test.:This:is:really:not:a:test.";
	r = split(/:/, s);
	unless (s eq join(":", r)) puts("bad 2.3");

	s = ":This:is:not:a:test.:This:is:really:not:a:test.";
	r = split(/:/, s);
	unless (s eq join(":", r)) puts("bad 2.4");

	/*
	 * A split with no regexp should split on white space but
	 * return no null field for any initial white space.
	 * A split on / / can return initial null fields however.
	 */

	r = split(" has one");
	unless ((r[0] eq "has") && (r[1] eq "one")) puts("bad 3.1");
	unless (length(r) == 2) puts("bad 3.2");

	r = split(/ /, "has none");
	unless ((r[0] eq "has") && (r[1] eq "none")) puts("bad 3.3");
	unless (length(r) == 2) puts("bad 3.4");

	r = split(/ /, " has one");
	unless ((r[0] eq "") && (r[1] eq "has") &&
		(r[2] eq "one")) puts("bad 3.5");
	unless (length(r) == 3) puts("bad 3.6");

	/* Trailing white space never produces a null field. */

	r = split("trail ");
	unless (r[0] eq "trail") puts("bad 4.1");
	unless (length(r) == 1) puts("bad 4.2");

	r = split(/ /, "trail ");
	unless (r[0] eq "trail") puts("bad 4.3");
	unless (length(r) == 1) puts("bad 4.4");

	r = split(/ /, "trail ");
	unless (r[0] eq "trail") puts("bad 4.5");
	unless (length(r) == 1) puts("bad 4.6");

	/*
	 * If all result fields are null, they are considered to be
	 * trailing and should not be returned.
	 */

	r = split(/x/, "xxx");
	unless (length(r) == 0) puts("bad 4.7");

	r = split(/x/, "xxx");
	unless (length(r) == 0) puts("bad 4.8");

	r = split(/xx/, "xxxxxx");
	unless (length(r) == 0) puts("bad 4.9");

	r = split(/xx/, "xxxxxx");
	unless (length(r) == 0) puts("bad 4.10");

	r = split(/two/, "twotwotwo");
	unless (length(r) == 0) puts("bad 4.11");

	r = split(/two/, "twotwotwo");
	unless (length(r) == 0) puts("bad 4.12");

	/* Check split on a regexp. */

	r = split(/[abc]/, "XaXbXcX");
	unless ((r[0] eq "X") && (r[1] eq "X") && (r[2] eq "X") &&
		(r[3] eq "X")) {
		puts("bad 5.3");
	}
	unless (length(r) == 4) puts("bad 5.4");

	r = split(/[abc]/, "XaaXbXcX");
	unless ((r[0] eq "X") && (r[1] eq "") && (r[2] eq "X") &&
		(r[3] eq "X") && (r[4] eq "X")) {
		puts("bad 5.5");
	}
	unless (length(r) == 5) puts("bad 5.6");

	r = split(/xx/, "xxxyxx");
	unless ((r[0] eq "") && (r[1] eq "xy")) {
		puts("bad 5.11");
	}
	unless (length(r) == 2) puts("bad 5.12");

	/* A match at the end never produces a trailing null field. */

	r = split(/d/, "abcd");
	unless (r[0] eq "abc") puts("bad 5.15");
	unless (length(r) == 1) puts("bad 5.16");

	r = split(/def/, "abcdef");
	unless (r[0] eq "abc") puts("bad 5.17");
	unless (length(r) == 1) puts("bad 5.18");

	/* A match on the first char always produces a null field. */

	r = split(/a/, "abcd");
	unless ((r[0] eq "") && (r[1] eq "bcd")) puts("bad 5.19");
	unless (length(r) == 2) puts("bad 5.20");

	/* Test interpolated regexp. */

	s = "abc";
	r = split(/[${s}]/, "XaXbXcX");
	unless ((r[0] eq "X") && (r[1] eq "X") && (r[2] eq "X") &&
		(r[3] eq "X")) {
		puts("bad 6.1");
	}
	unless (length(r) == 4) puts("bad 6.2");

	/* Test limits, regexp match. */

	r = split(/ /, "1 2 3 4", 4);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3") &&
		(r[3] eq "4")) {
		puts("bad 7.17");
	}
	unless (length(r) == 4) puts("bad 7.18");

	r = split(/ /, "1 2 3 4", 3);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3 4")) {
		puts("bad 7.19");
	}
	unless (length(r) == 3) puts("bad 7.20");

	r = split(/ /, "1 2 3 4", 2);
	unless ((r[0] eq "1") && (r[1] eq "2 3 4")) puts("bad 7.21");
	unless (length(r) == 2) puts("bad 7.22");

	r = split(/ /, "1 2 3 4", 1);
	unless (r[0] eq "1 2 3 4") puts("bad 7.23");
	unless (length(r) == 1) puts("bad 7.24");

	r = split(/ /, "1 2 3 4", 0);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3") &&
		(r[3] eq "4")) {
		puts("bad 7.25");
	}
	unless (length(r) == 4) puts("bad 7.26");

	r = split(/ /, "1 2 3 4", -1);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3") &&
		(r[3] eq "4")) {
		puts("bad 7.27");
	}
	unless (length(r) == 4) puts("bad 7.28");

	/* Test limits, multi-char match. */

	r = split(/aa/, "1aa2aa3aa4", 5);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3") &&
		(r[3] eq "4")) {
		puts("bad 7.30");
	}
	unless (length(r) == 4) puts("bad 7.31");

	r = split(/aa/, "1aa2aa3aa4", 4);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3") &&
		(r[3] eq "4")) {
		puts("bad 7.32");
	}
	unless (length(r) == 4) puts("bad 7.33");

	r = split(/aa/, "1aa2aa3aa4", 3);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3aa4")) {
		puts("bad 7.34");
	}
	unless (length(r) == 3) puts("bad 7.35");

	r = split(/aa/, "1aa2aa3aa4", 2);
	unless ((r[0] eq "1") && (r[1] eq "2aa3aa4")) puts("bad 7.36");
	unless (length(r) == 2) puts("bad 7.37");

	r = split(/aa/, "1aa2aa3aa4", 1);
	unless (r[0] eq "1aa2aa3aa4") puts("bad 7.38");
	unless (length(r) == 1) puts("bad 7.39");

	r = split(/aa/, "1aa2aa3aa4", 0);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3") &&
		(r[3] eq "4")) {
		puts("bad 7.40");
	}
	unless (length(r) == 4) puts("bad 7.41");

	r = split(/aa/, "1aa2aa3aa4", -1);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3") &&
		(r[3] eq "4")) {
		puts("bad 7.42");
	}
	unless (length(r) == 4) puts("bad 7.43");

	/* Test that an escape of the regexp delimeter works. */

	r = split(/\//, "/this/is/a/pathname");
	unless ((r[0] eq "") && (r[1] eq "this") && (r[2] eq "is") &&
		(r[3] eq "a") && (r[4] eq "pathname")) {
		puts("bad 8.1");
	}
	unless (length(r) == 5) puts("bad 8.2");

	/* Ensure third arg is not parsed as a regexp. */

	m = 3;
	r = split(/ /, "1 2 3 4", m);
	unless ((r[0] eq "1") && (r[1] eq "2") && (r[2] eq "3 4")) {
		puts("bad 9.7");
	}
	unless (length(r) == 3) puts("bad 9.8");

	/* Split on a multi-character delimeter. */

	r = split(/two/, "onetwothreetwofourtwo");
	unless ((r[0] eq "one") && (r[1] eq "three") && (r[2] eq "four")) {
		puts("bad 10.7");
	}
	unless (length(r) == 3) puts("bad 10.8");

	r = split(/two/, "twoonetwo");
	unless ((r[0] eq "") && (r[1] eq "one")) {
		puts("bad 10.9");
	}
	unless (length(r) == 2) puts("bad 10.10");

	r = split(/two/, "nomatches");
	unless (r[0] eq "nomatches") {
		puts("bad 10.11");
	}
	unless (length(r) == 1) puts("bad 10.12");

	/* Split on an empty regexp. */

	r = split(//, "abc");
	unless ((r[0] eq "a") && (r[1] eq "b") && (r[2] eq "c")) {
		puts("bad 12.1");
	}
	unless (length(r) == 3) puts("bad 12.2");

	/* Split on a widget should work. */

	w = "axbxc";
	r = split(/x/, w);
	unless ((r[0] eq "a") && (r[1] eq "b") && (r[2] eq "c")) {
		puts("bad 13.1");
	}
	unless (length(r) == 3) puts("bad 13.2");

	/*
	 * Check splitting on a regexp w/trimming leading null fields
	 * from the result.
	 */

	r = split(/ /t, " A B");
	unless ((r[0] eq "A") && (r[1] eq "B")) puts("bad 14.1");
	unless (length(r) == 2) puts("bad 14.2");

	r = split(/ /t, "        A B");
	unless ((r[0] eq "A") && (r[1] eq "B")) puts("bad 14.3");
	unless (length(r) == 2) puts("bad 14.4");

	r = split(/ /t, "   A  B ");
	unless ((r[0] eq "A") && (r[1] eq "") && (r[2] eq "B")) puts("bad 14.5");
	unless (length(r) == 3) puts("bad 14.6");
}
split_1_0();
} -output {}

test split-1.1 {test split regexp alternate delim syntax} -body {
#lang L
void split_1_1()
{
	string	m, mm, mvar, r[], re;

	r = split(m|\n|, "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.1");

	r = split(m:\n:, "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.2");

	r = split(m,\n,, "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.3");

	r = split(m"\n", "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.3.1");

	r = split(m!\n!, "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.3.2");

	/* Test some interpolations inside the regexp. */

	re = '\n';
	r = split(m|${re}|, "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.4");

	re = '\n';
	r = split(m$${re}$, "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.5");

	re = '\n';
	r = split(m{${re}}, "l1\nl2\nl3\n");
	unless (eq(r, {"l1","l2","l3"})) puts("bad 1.6");

	re = "y";
	r = split(m|x${re}|, "axybxyc");
	unless (eq(r, {"a","b","c"})) puts("bad 1.8");

	re = "x";
	r = split(m|${re}y|, "axybxyc");
	unless (eq(r, {"a","b","c"})) puts("bad 1.9");

	re = "y";
	r = split(m|x${re}z|, "axyzbxyzc");
	unless (eq(r, {"a","b","c"})) puts("bad 1.10");

	/* Test regexp modifiers. */

	r = split(m|x|, "xaxbXcXdx");
	unless (eq(r, {"","a","bXcXd"})) puts("bad 2.1 ${r}");

	r = split(m|x|t, "xaxbXcXdx");
	unless (eq(r, {"a","bXcXd"})) puts("bad 2.2 ${r}");

	r = split(m|x|i, "xaxbXcXdx");
	unless (eq(r, {"","a","b","c","d"})) puts("bad 2.3 ${r}");

	r = split(m|x|it, "xaxbXcXdx");
	unless (eq(r, {"a","b","c","d"})) puts("bad 2.4 ${r}");

	r = split(m|x|ti, "xaxbXcXdx");
	unless (eq(r, {"a","b","c","d"})) puts("bad 2.5 ${r}");

	/*
	 * Test splitting on a variable named "m" or whose name begins
	 * with "m".
	 */

	m = "l1\nl2\nl3\n";
	r = split(m);
	unless (eq(r, {"l1","l2","l3"})) puts("bad 3.1");

	mm = "l1\nl2\nl3\n";
	r = split(mm);
	unless (eq(r, {"l1","l2","l3"})) puts("bad 3.2");

	mvar = "l1\nl2\nl3\n";
	r = split(mvar);
	unless (eq(r, {"l1","l2","l3"})) puts("bad 3.3");
}
split_1_1();
} -output {}

test split-2 {test split errors} -body {
#lang L --line=1
void split_2()
{
	split(/re/g, "bad");
	split(/re/ig, "bad");
}
} -returnCodes error -match regexp -result {.*3: L Error: illegal regular expression modifier
.*4: L Error: illegal regular expression modifier
}

test split-3 {test split errors 2} -body {
#lang L --line=1
void split_3()
{
	/*
	 * This is a syntax error because the grammar special-cases
	 * split() because the 1st arg can be a regexp or a string,
	 * and does not allow no args.
	 */
	split();
}
} -returnCodes error -match regexp -result {.*8: L Error: syntax error, unexpected \)
}

test split-4 {test split errors 3} -body {
#lang L --line=1
void split_4()
{
	split(/delim/, "str", 0, 0);
	split(0);
	split(/delim/, "str", "bad");
	split("bad delim", "str");
	split("bad delim", "str", 0);
}
} -returnCodes error -match regexp -result {.*3: L Error: too many args to split
.*4: L Error: expression to split must be string
.*5: L Error: third arg to split must be integer
.*6: L Error: split delimiter must be a regular expression
.*7: L Error: split delimiter must be a regular expression
}

test split-5 {test split errors 4 -- bad regexp} -body {
#lang L --line=1
void split_5()
{
	split(/+/, "str");
}
split_5();
} -returnCodes error -result {couldn't compile pcre pattern: nothing to repeat}
#'

test split-8 {test m() as arg to split} -setup {
	makeFile {
		/*
		 * Put this in its own file to avoid polluting
		 * the global name space with a function m().
		 */
		string m(...args)
		{
			string	ret = "", s;

			foreach (s in args) ret .= s;
			return (ret);
		}
		void main()
		{
			string	s[];

			s = split(m());
			if (length(s)) puts("bad 1");

			s = split(m("x"));
			unless (eq(s, {"x"})) puts("bad 2");

			s = split(m("x"," ","y"));
			unless (eq(s, {"x","y"})) puts("bad 3");
		}
	} split-8.l
} -body {
#lang L
void split_8()
{
	int	ret;
	string	tclsh = interpreter();
	string	out, err;

	ret = system({tclsh, "split-8.l"}, undef, &out, &err);
	unless (ret == 0) puts("bad 1.1");
	if (out) puts("bad 1.2: ${out}");
	if (err) puts("bad 1.3: ${err}");
}
split_8();
} -output {}

test consts-1.0 {test constants function} -body {
#lang L --line=1
void
constants_1_0()
{
	int	i;
	float	f;

	/*
	 * Adding 0 to these forces Tcl to shimmer them to a numeric type.
	 */

	i = 0 + 0;
	unless ((tcl)i eq "0") puts("bad 1.1");
	i = 00 + 0;
	unless ((tcl)i eq "0") puts("bad 1.2");
	i = 000 + 0;
	unless ((tcl)i eq "0") puts("bad 1.3");
	i = 1234 + 0;
	unless ((tcl)i eq "1234") puts("bad 1.4");
	i = 01235 + 0;
	unless ((tcl)i eq "1235") puts("bad 1.5");
	i = 001236 + 0;
	unless ((tcl)i eq "1236") puts("bad 1.6");
	i = 10000000000 + 0;  // >32 bits
	unless ((tcl)i eq "10000000000") puts("bad 1.7");
	i = 36893488147419103232 + 0;  // >64 bits
	unless ((tcl)i eq "36893488147419103232") puts("bad 1.8");
	i = 314159265358979323846264338327950288 + 1;  // even bigger
	unless ((tcl)i eq "314159265358979323846264338327950289") {
		puts("bad 1.9");
	}
	i = 111111111111111111111111111111 + 222222222222222222222222222222;
	unless ((tcl)i eq "333333333333333333333333333333") {
		puts("bad 1.10");
	}

	i = 0xdeadbeef + 0;
	unless ((tcl)i eq "3735928559") puts("bad 2.1");
	i = 0xdeadbeefbadb0bad + 0;  // 64 bits
	unless ((tcl)i eq "16045690984232324013") puts("bad 2.2");
	i = 0xdeadbeefbadb0badb0 + 0;  // >64 bits
	unless ((tcl)i eq "4107696891963474947504") puts("bad 2.3");

	i = 0o755 + 0;
	unless ((tcl)i eq "493") puts("bad 3.1");
	i = 0o0756 + 0;
	unless ((tcl)i eq "494") puts("bad 3.2");

	f = 1234.5678 + 0.0;
	unless (sprintf("%.4f", f) eq "1234.5678") puts("bad 4.1");
}
constants_1_0();
} -output {}

# These tests check the L compiler's mapping between the source-file
# offsets of each "command" and the tcl bytecodes generated for it.
# Generally speaking, a command is a statement or expression, although
# some statements don't generate a mapping per-se (like "if"
# statements).  This is tested by generating a bytecode disassembly
# and checking that the text of the commands were identified properly
# in various syntactic contexts.  This seems like the only way to get
# at the mappings easily for testing.

test src-mappings-1 {test bytecode <-> source-file-offset mappings 1} -body {
#lang L --line=1 -nowarn
struct sm1 {
	int	i;
};
void
src_mappings_1()
{
	/*
	 * This test checks the mappings for declarations.
	 * Note: avoid tabs in the source to make the test regexp clearer.
	 */

	int i1;
	int i2 = 2;
	int i3, i4;
	int i5, i6 = 6, i7;
	string s1;
	string s2 = "str2";
	string s3, s4;
	string s5, s6 = "str6", s7;
	float f1;
	float f2 = 2.0;
	float f3, f4;
	float f5, f6 = 6.0, f7;
	/* The hash ones test typedef names (hash is a typedef). */
	hash h1;
	hash h2 = {2=>2};
	hash h3, h4;
	hash h5, h6 = {6=>6}, h7;
	struct sm1 st1;
	struct sm1 st2 = {2};
	struct sm1 st3, st4;
	struct sm1 st5, st6 = {6}, st7;
	poly p1;
	poly p2 = 2;
	poly p3, p4;
	poly p5, p6 = 6, p7;
	widget w1;
	widget w2 = "w2";
	widget w3, w4;
	widget w5, w6 = "w6", w7;
	int ai1[];
	int ai2[2];
	int ai3[] = {3};
	int ai4[], ai5[5];
	int ai6[], ai7[] = {7}, ai8[];
	string as1[];
	string as2[2];
	string as3[] = {"3"};
	string as4[], as5[5];
	string as6[], as7[] = {"7"}, as8[];
	float af1[];
	float af2[2];
	float af3[] = {3.0};
	float af4[], af5[5];
	float af6[], af7[] = {7.0}, af8[];
	hash ah1[];
	hash ah2[2];
	hash ah3[], ah4[4], ah5[];
	struct s ast1[];
	struct s ast2[2];
	struct s ast3[], ast4[4], ast5[];

	puts(::tcl::unsupported::disassemble("proc", "src_mappings_1"));
	return;
}
#lang tcl
src_mappings_1
} -match regexp -output {.*Command \d+: "i1"
.*Command \d+: "i2 = 2"
.*Command \d+: "i3"
.*Command \d+: "i4"
.*Command \d+: "i5"
.*Command \d+: "i6 = 6"
.*Command \d+: "i7"
.*Command \d+: "s1"
.*Command \d+: "s2 = \\"str2\\""
.*Command \d+: "s3"
.*Command \d+: "s4"
.*Command \d+: "s5"
.*Command \d+: "s6 = \\"str6\\""
.*Command \d+: "s7"
.*Command \d+: "f1"
.*Command \d+: "f2 = 2.0"
.*Command \d+: "f3"
.*Command \d+: "f4"
.*Command \d+: "f5"
.*Command \d+: "f6 = 6.0"
.*Command \d+: "f7"
.*Command \d+: "h1"
.*Command \d+: "h2 = \{2=>2\}"
.*Command \d+: "h3"
.*Command \d+: "h4"
.*Command \d+: "h5"
.*Command \d+: "h6 = \{6=>6\}"
.*Command \d+: "h7"
.*Command \d+: "st1"
.*Command \d+: "st2 = \{2\}"
.*Command \d+: "st3"
.*Command \d+: "st4"
.*Command \d+: "st5"
.*Command \d+: "st6 = \{6\}"
.*Command \d+: "st7"
.*Command \d+: "p1"
.*Command \d+: "p2 = 2"
.*Command \d+: "p3"
.*Command \d+: "p4"
.*Command \d+: "p5"
.*Command \d+: "p6 = 6"
.*Command \d+: "p7"
.*Command \d+: "w1"
.*Command \d+: "w2 = \\"w2\\""
.*Command \d+: "w3"
.*Command \d+: "w4"
.*Command \d+: "w5"
.*Command \d+: "w6 = \\"w6\\""
.*Command \d+: "w7"
.*Command \d+: "ai1\[\]"
.*Command \d+: "ai2\[2\]"
.*Command \d+: "ai3\[\] = \{3\}"
.*Command \d+: "ai4\[\]"
.*Command \d+: "ai5\[5\]"
.*Command \d+: "ai6\[\]"
.*Command \d+: "ai7\[\] = \{7\}"
.*Command \d+: "ai8\[\]"
.*Command \d+: "as1\[\]"
.*Command \d+: "as2\[2\]"
.*Command \d+: "as3\[\] = \{\\"3\\"\}"
.*Command \d+: "as4\[\]"
.*Command \d+: "as5\[5\]"
.*Command \d+: "as6\[\]"
.*Command \d+: "as7\[\] = \{\\"7\\"\}"
.*Command \d+: "as8\[\]"
.*Command \d+: "af1\[\]"
.*Command \d+: "af2\[2\]"
.*Command \d+: "af3\[\] = \{3.0\}"
.*Command \d+: "af4\[\]"
.*Command \d+: "af5\[5\]"
.*Command \d+: "af6\[\]"
.*Command \d+: "af7\[\] = \{7.0\}"
.*Command \d+: "af8\[\]"
.*Command \d+: "ah1\[\]"
.*Command \d+: "ah2\[2\]"
.*Command \d+: "ah3\[\]"
.*Command \d+: "ah4\[4\]"
.*Command \d+: "ah5\[\]"
.*Command \d+: "ast1\[\]"
.*Command \d+: "ast2\[2\]"
.*Command \d+: "ast3\[\]"
.*Command \d+: "ast4\[4\]"
.*Command \d+: "ast5\[\]"
}

test src-mappings-2 {test bytecode <-> source-file-offset mappings 2} -body {
#lang L --line=1 -nowarn
int f0() { return (0); }
int f1(int i) { return (1); }
int f2(int i, int j) { return (2); }
int f3(string opt, int i) {}
void
src_mappings_2()
{
	/*
	 * This test checks the mappings for expressions.
	 * Note: avoid tabs in the source to make the test regexp clearer.
	 */

	int i, j;
	int i1 = 1+2;
	int i2 = i1+2*3;
	int i3, i4, i5;
	string s, t;
	float f;
	int ai[];
	int aii[][];
	int ah{int};
	int ahh{int}{int};

	puts(::tcl::unsupported::disassemble("proc", "src_mappings_2"));
	return;

	/* Check assignments. */
	i1 = 1;
	f = 3.14;
	s = "str";

	/* Check array and hash subscripts. */
	i = ai[i1 - i2 - i3];
	i = aii[i1][i2];
	i = ah{i3 - i4};
	i = ahh{i3}{i4 - i5};

	/* Check that each sub-expression has a mapping. */
	i3 = 3;
	i4 = 4 + 3;
	i5 = i3 + i4 * i5 - 5;

	/* Check parameters. */
	f0();
	f1(i1);
	f2(i1, i2);
	f2(i1, i2 + f1(2));
	f3(opt: i3);  // try this b/c at one point we were injecting an extra :

	/* Check that each binary and unary operator gets a mapping. */
	(tcl)i;
	(string)i;
	(widget)i;
	(float)i;
	!i;
	~i;
	+i;
	-i;
	&i;
	defined(i);
	i = j;
	i += j;
	i -= j;
	i *= j;
	i /= j;
	i %= j;
	i &= j;
	i |= j;
	i <<= j;
	i >>= j;
	i && j;
	i || j;
	s eq t;
	s ne t;
	s gt t;
	s ge t;
	s lt t;
	s le t;
	i == j;
	i != j;
	i > j;
	i >= j;
	i < j;
	i <= j;
	i + j;
	i - j;
	i * j;
	i / j;
	i % j;
	i & j;
	i | j;
	i ^ j;
	i << j;
	i >> j;
	s =~ /x/;
	s =~ /x/i;
	s =~ /x/g;
	s =~ /x/ig;
	s =~ m|x|;
	s =~ m|x|i;
	s =~ m|x|g;
	s =~ m|x|ig;
	s =~ s/x/y/;
	s =~ s/x/y/i;
	s =~ s/x/y/g;
	s =~ s/x/y/ig;

	/* Check ?: operator. */
	i = (i>j)?(i-1):(j-1);

	/* Check interpolated strings. */
	s = "abc${t}";
	s = "${t}xyz";
	s = "abc${t}xyz";
	s = "abc${"${t}"}xyz";
}
#lang tcl
src_mappings_2
} -match regexp -output {.*Command \d+: "1\+2"
.*Command \d+: "i1 = 1\+2"
.*Command \d+: "i1\+2\*3"
.*Command \d+: "i2 = i1\+2\*3"
.*Command \d+: "2\*3"
.*Command \d+: "i1 = 1"
.*Command \d+: "f = 3.14"
.*Command \d+: "s = \\"str\\""
.*Command \d+: "ai\[i1 - i2 - i3\]"
.*Command \d+: "i = ai\[i1 - i2 - i3\]"
.*Command \d+: "i1 - i2"
.*Command \d+: "i1 - i2 - i3"
.*Command \d+: "aii\[i1\]\[i2\]"
.*Command \d+: "i = aii\[i1\]\[i2\]"
.*Command \d+: "ah\{i3 - i4\}"
.*Command \d+: "i = ah\{i3 - i4\}"
.*Command \d+: "i3 - i4"
.*Command \d+: "ahh\{i3\}\{i4 - i5\}"
.*Command \d+: "i = ahh\{i3\}\{i4 - i5\}"
.*Command \d+: "i4 - i5"
.*Command \d+: "i3 = 3"
.*Command \d+: "4 \+ 3"
.*Command \d+: "i4 = 4 \+ 3"
.*Command \d+: "i3 \+ i4 \* i5"
.*Command \d+: "i3 \+ i4 \* i5 - 5"
.*Command \d+: "i5 = i3 \+ i4 \* i5 - 5"
.*Command \d+: "i4 \* i5"
.*Command \d+: "f0\(\)"
.*Command \d+: "f1\(i1\)"
.*Command \d+: "f2\(i1, i2\)"
.*Command \d+: "f2\(i1, i2 \+ f1\(2\)\)"
.*Command \d+: "i2 \+ f1\(2\)"
.*Command \d+: "f1\(2\)"
.*Command \d+: "f3\(opt: i3\)"
.*Command \d+: "\(tcl\)i"
.*Command \d+: "\(string\)i"
.*Command \d+: "\(widget\)i"
.*Command \d+: "\(float\)i"
.*Command \d+: "!i"
.*Command \d+: "~i"
.*Command \d+: "\+i"
.*Command \d+: "-i"
.*Command \d+: "&i"
.*Command \d+: "defined\(i\)"
.*Command \d+: "i = j"
.*Command \d+: "i \+= j"
.*Command \d+: "i -= j"
.*Command \d+: "i \*= j"
.*Command \d+: "i /= j"
.*Command \d+: "i %= j"
.*Command \d+: "i <<= j"
.*Command \d+: "i >>= j"
.*Command \d+: "i && j"
.*Command \d+: "i \|\| j"
.*Command \d+: "s eq t"
.*Command \d+: "s ne t"
.*Command \d+: "s gt t"
.*Command \d+: "s ge t"
.*Command \d+: "s lt t"
.*Command \d+: "s le t"
.*Command \d+: "i == j"
.*Command \d+: "i != j"
.*Command \d+: "i > j"
.*Command \d+: "i >= j"
.*Command \d+: "i < j"
.*Command \d+: "i <= j"
.*Command \d+: "i \+ j"
.*Command \d+: "i - j"
.*Command \d+: "i \* j"
.*Command \d+: "i / j"
.*Command \d+: "i % j"
.*Command \d+: "i & j"
.*Command \d+: "i \| j"
.*Command \d+: "i \^ j"
.*Command \d+: "i << j"
.*Command \d+: "i >> j"
.*Command \d+: "s =~ /x/"
.*Command \d+: "s =~ /x/i"
.*Command \d+: "s =~ /x/g"
.*Command \d+: "s =~ /x/ig"
.*Command \d+: "s =~ m\|x\|"
.*Command \d+: "s =~ m\|x\|i"
.*Command \d+: "s =~ m\|x\|g"
.*Command \d+: "s =~ m\|x\|ig"
.*Command \d+: "s =~ s/x/y/"
.*Command \d+: "s =~ s/x/y/i"
.*Command \d+: "s =~ s/x/y/g"
.*Command \d+: "s =~ s/x/y/ig"
.*Command \d+: "\(i>j\)\?\(i-1\):\(j-1\)"
.*Command \d+: "\(i-1\)"
.*Command \d+: "\(j-1\)"
.*Command \d+: "\\"abc\$\{t\}\\""
.*Command \d+: "s = \\"abc\$\{t\}\\""
.*Command \d+: "\\"\$\{t\}xyz\\""
.*Command \d+: "s = \\"\$\{t\}xyz\\""
.*Command \d+: "\\"abc\$\{t\}xyz\\""
.*Command \d+: "s = \\"abc\$\{t\}xyz\\""
.*Command \d+: "\\"abc\$\{\\"\$\{t\}\\"\}xyz\\""
.*Command \d+: "s = \\"abc\$\{\\"\$\{t\}\\"\}xyz\\""
.*Command \d+: "\\"\$\{t\}\\""
}

test src-mappings-3 {test bytecode <-> source-file-offset mappings 3} -body {
#lang L --line=1 -nowarn
int
f()
{
	return (0);
}
void
fv()
{
	return;
}
int{int}
fh()
{
	int h{int};
	return (h);
}
int[]
fa()
{
	int a[5];
	return (a);
}
int
src_mappings_3()
{
	/*
	 * This test checks the mappings for statements.
	 */

	int i, j, k, v;
	int a[5];
	int h{int};

	/* Disassemble fv() to get its "return" stmt w/no arg. */
	puts(::tcl::unsupported::disassemble("proc", "fv"));
	puts(::tcl::unsupported::disassemble("proc", "src_mappings_3"));
	return(0);

	while (0) f();
	do f(); while (0);
	for (i = 0; i < 10;) f();
	for (i = 0; i < 10; ++i) f();
	foreach (k => v in fh()) f();
	foreach (i,j in fa()) f();
	switch (0) {
		case i: ++i; break;
		default: break;
	}
	push (&a, f());
	/* Check break and continue. */
	do {
		break;
		continue;
	} while (0);
	goto L1;
 L1:
}
#lang tcl
src_mappings_3
} -match regexp -output {.*Command \d+: "return"
.*Command \d+: "return\(0\)"
.*Command \d+: "while \(0\) f\(\);"
.*Command \d+: "f\(\)"
.*Command \d+: "do f\(\); while \(0\);"
.*Command \d+: "i = 0"
.*Command \d+: "for \(i = 0; i < 10;\) f\(\);"
.*Command \d+: "i < 10"
.*Command \d+: "f\(\)"
.*Command \d+: "i = 0"
.*Command \d+: "for \(i = 0; i < 10; \+\+i\) f\(\);"
.*Command \d+: "i < 10"
.*Command \d+: "f\(\)"
.*Command \d+: "\+\+i"
.*Command \d+: "fh\(\)"
.*Command \d+: "foreach \(k => v in fh\(\)\) f\(\);"
.*Command \d+: "f\(\)"
.*Command \d+: "fa\(\)"
.*Command \d+: "foreach \(i,j in fa\(\)\) f\(\);"
.*Command \d+: "f\(\)"
.*Command \d+: "switch \(0\) \{\\n\\t\\tcase i: \+\+i; break;\\n\\t\\tdefault: break;\\n\\t\}"
.*Command \d+: "i"
.*Command \d+: "default:"
.*Command \d+: "push \(&a, f\(\)\)"
.*Command \d+: "break"
.*Command \d+: "continue"
.*Command \d+: "goto L1;"
}

test src-mappings-4 {test bytecode <-> source-file-offset mappings with includes} -setup {
	set fname1 [makeFile {
void src_mappings_4_foo1()
{
	int v1 = 123;
	while (0) {
		puts(v1);
	}
}
#include "foo-sm4-2.l"
} foo-sm4-1.l [file dirname [info script]]]
	set fname2 [makeFile {
void src_mappings_4_foo2()
{
	int	i, j;
	i = j+1;
}
} foo-sm4-2.l .]
} -body {
#lang L --line=1
#include "foo-sm4-1.l"
void src_mappings_4()
{
	/*
	 * We don't need much for this test.  If the source offsets are
	 * mis-aligned, it can be seen with even just one command.
	 */

	int	k, l;

	puts("--foo1--");
	puts(::tcl::unsupported::disassemble("proc", "src_mappings_4_foo1"));
	puts("--foo2--");
	puts(::tcl::unsupported::disassemble("proc", "src_mappings_4_foo2"));
	puts("--main--");
	puts(::tcl::unsupported::disassemble("proc", "src_mappings_4"));
	return;

	k = l+2;
}
src_mappings_4();
} -match regexp -output {--foo1--
.*Command \d+: "v1 = 123"
.*Command \d+: "puts\(v1\)"
.*--foo2--
.*Command \d+: "i = j\+1"
.*--main--
.*Command \d+: "return"
.*Command \d+: "k = l\+2"
}

test src-mappings-5 {test bytecode <-> source-file-offset mappings w/here docs} -body {
#lang L --line=1 -nowarn
void src_mappings_5()
{
	string s1 = <<END
str1
END
	string s2 = <<'END'
str2
END

	puts(::tcl::unsupported::disassemble("proc", "src_mappings_5"));
}
src_mappings_5();
} -match regexp -output {.*Command \d+: "s1 = <<END\\nstr1\\nEND"
.*Command \d+: "s2 = <<'END'\\nstr2\\nEND"
}

test src-mappings-6 {test bytecode <-> source-file-offset mapping for variable} -body {
#lang L --line=1
void src_mappings_6()
{
	string	s = "";

	if (s) s = "1";

	puts(::tcl::unsupported::disassemble("proc", "src_mappings_6"));
}
src_mappings_6();
} -match regexp -output {.*Command \d+: "s"
}

test function-1.0 {check function call rules} -body {
#lang L --line=1
void function_1_0_foo() { puts("foo"); }
void function_1_0_f()   { puts("f"); }
void
function_1_0()
{
	function_1_0_foo();
	function_1_0_f();

	/*
	 * Calling an undeclared function is not an error, we just get
	 * no arg type checking, so passing anything should be allowed.
	 */
	if (0) {
		string	s, p;

		not_defined1();
		not_defined1(s);
		not_defined1(s, p);
		not_defined2(1, 2, 3, 4);
	}
}
#lang tcl
function_1_0
} -output {foo
f
}

test function-1.1 {check function call rules error cases} -body {
#lang L --line=1
int function_1_1_f1;
int function_1_1_f1() { return (0); }	// err -- already declared as variable
int function_1_1_f2() { return (0); }
int function_1_1_f2;			// err -- already declared as function
int function_1_1_f3() { return (0); }
int function_1_1_f3() { return (0); }	// err -- multiply declared function
void
function_1_1()
{
	int	i;
	float	f;
	int	a[];
	int	h{int};
	struct { int i,j; } st;

	/* All illegal because the var isn't a string or poly. */
	i();
	f();
	a();
	h();
	st();
}
#lang tcl
function_1_1
} -returnCodes {error} -match regexp -result {.*1: L Error: multiple declaration of global function_1_1_f1
.*4: L Error: multiple declaration of global function_1_1_f2
.*6: L Error: function function_1_1_f3 already declared
.*:17: L Error: 'i' is declared but not as a function
.*:18: L Error: 'f' is declared but not as a function
.*:19: L Error: 'a' is declared but not as a function
.*:20: L Error: 'h' is declared but not as a function
.*:21: L Error: 'st' is declared but not as a function
}

test function-1.2 {check function prototypes} -body {
#lang L --line=1 -nowarn
int function_1_2_f1();
int function_1_2_f1() { return (1); }

int function_1_2_f2();
int function_1_2_f2();
int function_1_2_f2();
int function_1_2_f2();
int function_1_2_f2() { return (1); }

int function_1_2_f3() { return (1); }
int function_1_2_f3();

string function_1_2_f4(int a, string b, float c, int d[], hash e);
string function_1_2_f4(int a, string b, float c, int d[], hash e){ return (b); }

string function_1_2_f5(int a, string b, float c, int d[], hash e){ return (b); }
string function_1_2_f5(int a, string b, float c, int d[], hash e);

void
function_1_2()
{
	int	a;
	string	s;
	float	c;
	int	d[];
	hash	e;

	s = function_1_2_f4(a, "f4", c, d, e);
	unless (s eq "f4") puts("bad 1");

	s = function_1_2_f5(a, "f5", c, d, e);
	unless (s eq "f5") puts("bad 2");

	unless (function_1_2_f10(12) == 12) puts("bad 3");
	unless (function_1_2_f11(13) == 13) puts("bad 4");
	unless (function_1_2_f12(14) == 14) puts("bad 5");

	/*
	 * These check that the right parameter-passing mode is
	 * in the calls to the functions declared later.
	 */

	d = {1,2,3,4};
	unless (function_1_2_sum_ref(&d) == 10) puts("bad 6.1");
	unless (length(d) == 3) puts("bad 6.2");
	unless ((d[0] == 9) && (d[1] == 10) && (d[2] == 11)) puts("bad 6.3");

	d = {1,2,3,4};
	unless (function_1_2_sum_cow(d) == 10) puts("bad 7.1");
	unless (length(d) == 4) puts("bad 7.2");
	unless ((d[0] == 1) && (d[1] == 2)) puts("bad 7.3");
	unless ((d[2] == 3) && (d[3] == 4)) puts("bad 7.4");
}
function_1_2();
int function_1_2_f10(int a) { return (a); }
int function_1_2_f11(int a) { return (a); }
int function_1_2_f11(int a);
int function_1_2_f12(int a);
int function_1_2_f12(int a) { return (a); }
int function_1_2_sum_ref(int &a[])
{
	int	i, sum = 0;

	foreach (i in a) sum += i;
	a = {9,10,11};
	return (sum);
}
int function_1_2_sum_cow(int a[])
{
	int	i, sum = 0;

	foreach (i in a) sum += i;
	a = {9,10,11};
	return (sum);
}
} -output {}

test function-1.3 {check function prototypes 2} -body {
#lang L --line=1
void
function_1_3()
{
	/* Call some libl functions correctly.  There should be no type errs. */

	unless (streq("testing", "testing")) puts("bad 1");
	unless (strlen("three") == 5) puts("bad 2");
	unless (strneq("test", "testing", 4)) puts("bad 3");
}
#lang tcl
function_1_3
} -output {}

test function-1.3.2 {check function prototypes 3} -body {
#lang L --line=1
/*
 * Check that a void formal-parameter list is treated exactly like no
 * parameters.
 */
void function_1_3_2_f1();
void function_1_3_2_f2();
void function_1_3_2_f3(void);
void function_1_3_2_f4(void);
void
function_1_3_2()
{
	function_1_3_2_f1();
	function_1_3_2_f2();
	function_1_3_2_f3();
	function_1_3_2_f4();
}
function_1_3_2();
void function_1_3_2_f1()     { puts("f1"); }
void function_1_3_2_f2(void) { puts("f2"); }
void function_1_3_2_f3()     { puts("f3"); }
void function_1_3_2_f4(void) { puts("f4"); }
} -output {f1
f2
f3
f4
}

test function-1.4 {check function prototype errors} -body {
#lang L --line=1
void
function_1_4()
{
	/* Call a libl function with incorrect args. */

	streq();
	streq("a");
	streq("a", 2);
	streq("a", "b", 2);
}
} -returnCodes {error} -match regexp -result {.*6: L Error: not enough arguments for function streq
.*7: L Error: not enough arguments for function streq
.*8: L Error: parameter 2 has incompatible type
.*9: L Error: too many arguments for function streq
}

test function-1.5 {check function prototype errors 2} -body {
#lang L --line=1
void function_1_5_f1();
int function_1_5_f1() { return (0); }

int function_1_5_f2() { return (0); }
void function_1_5_f2();

void function_1_5_f3(int a);
void function_1_5_f3() { }

void function_1_5_f4() { }
void function_1_5_f4(int a);

int function_1_5_f5(int a);
void function_1_5_f5() { }

void function_1_5_f6() { }
int function_1_5_f6(int a);

string function_1_5_f7(int a, string b, float c, int d[]);
string function_1_5_f7(int a, string b, float c, int d[], hash e){ return (b); }

string function_1_5_f8(string b, float c, int d[], hash e);
string function_1_5_f8(int a, string b, float c, int d[], hash e){ return (b); }

string function_1_5_f9(string b, float c, int d[], hash e);
string function_1_5_f9(string b, ...rest){ return (b); }
} -returnCodes {error} -match regexp -result {.*2: L Error: does not match other declaration of function_1_5_f1
.*5: L Error: does not match other declaration of function_1_5_f2
.*8: L Error: does not match other declaration of function_1_5_f3
.*11: L Error: does not match other declaration of function_1_5_f4
.*14: L Error: does not match other declaration of function_1_5_f5
.*17: L Error: does not match other declaration of function_1_5_f6
.*20: L Error: does not match other declaration of function_1_5_f7
.*23: L Error: does not match other declaration of function_1_5_f8
.*26: L Error: does not match other declaration of function_1_5_f9
}

test function-1.6 {check function prototype errors 3} -body {
#lang L --line=1
void function_1_6()
{
	/*
	 * Check that type checking is done to calls of functions
	 * declared later.
	 */

	function_1_6_v(1);
	function_1_6_i();
	function_1_6_i("bad");
}
void function_1_6_v() {}
void function_1_6_i(int i) { i = 0; }
} -returnCodes {error} -match regexp -result {.*8: L Error: too many arguments for function function_1_6_v
.*9: L Error: not enough arguments for function function_1_6_i
.*10: L Error: parameter 1 has incompatible type
}

test function-2 {check call to undefined function warnings} -setup {
	set file [makeFile {
			void fn2_nobody();
			void Fn2_*();
			void main()
			{
				undeclared_call1();
				undeclared_call2();
				undeclared_call3();
				fn2_nobody();
				Undeclared1_too();
				Undeclared2_hasargs(1,2,3);
				Fn2_star();
			}
		} function2.l .]
} -constraints {
	exec
} -body {
	exec [interpreter] --warn-undefined-fns $file
} -returnCodes {error} -match regexp -result {L Warning: function undeclared_call1 not defined
L Warning: function undeclared_call2 not defined
L Warning: function undeclared_call3 not defined
L Warning: function fn2_nobody not defined
L Warning: function undeclared1 not defined
L Warning: function undeclared2 not defined
L Warning: function Fn2_\* not defined
}

test function-2.1 {check _optional formal-parameter attribute} -body {
#lang L --line=1
string fn21_foo1(_optional string arg1)
{
	if (arg1) {
		return (arg1);
	} else {
		return ("<undef>");
	}
}
string fn21_foo2(string arg1, _optional string arg2)
{
	if (arg2) {
		return (arg1 . arg2);
	} else {
		return (arg1 . "<undef>");
	}
}
string fn21_foo3(string arg1, string arg2, _optional string arg3)
{
	if (arg3) {
		return (arg1 . arg2 . arg3);
	} else {
		return (arg1 . arg2 . "<undef>");
	}
}
void function_2_1()
{
	unless (fn21_foo1() eq "<undef>") puts("bad 1.1");
	unless (fn21_foo1("one") eq "one") puts("bad 1.2");

	unless (fn21_foo2("one") eq "one<undef>") puts("bad 2.1");
	unless (fn21_foo2("one", "two") eq "onetwo") puts("bad 2.2");

	unless (fn21_foo3("1","2") eq "12<undef>") puts("bad 3.1");
	unless (fn21_foo3("1","2","3") eq "123") puts("bad 3.2");
}
function_2_1();
} -output {}

test function-2.2 {check _optional formal-parameter attribute errors} -body {
#lang L --line=1 -nowarn
void fn22_err1(_optional string arg1, _optional string arg2) {}
void fn22_err2(_optional string arg1, string arg2) {}
void fn22_err3(string arg0, _optional string arg1, string arg2) {}
void fn22_err4(...args, _optional string arg1) {}
void fn22_err5(_optional string arg1, ...args) {}
} -returnCodes {error} -match regexp -result {.*1: L Error: _optional parameter must be last
.*2: L Error: _optional parameter must be last
.*3: L Error: _optional parameter must be last
.*4: L Error: Rest parameter must be last
.*5: L Error: _optional parameter must be last
}

test function-3 {check _attribute error} -body {
#lang L --line=1
void function3() _attribute (bad) {}
} -returnCodes {error} -match regexp -result {.*1: L Error: illegal attribute 'bad'
}

test function-4 {check formal-parameter attribute inconsistency checking} -body {
#lang L --line=1
// Check with and without names for the formals in the proto.
string function4a(string s);
string function4a(_optional string s)
{
	return (s);
}
string function4b(_optional string s);
string function4b(string s)
{
	return (s);
}
string function4c(string);
string function4c(_optional string s)
{
	return (s);
}
string function4d(_optional string);
string function4d(string s)
{
	return (s);
}
string function4e(string);
string function4e(_mustbetype string s)
{
	return (s);
}
string function4f(_mustbetype string);
string function4f(string s)
{
	return (s);
}
string function4g(_mustbetype string);
string function4g(_optional string s)
{
	return (s);
}
} -returnCodes {error} -match regexp -result {.*3: L Error: does not match other declaration of function4a
.*8: L Error: does not match other declaration of function4b
.*13: L Error: does not match other declaration of function4c
.*18: L Error: does not match other declaration of function4d
.*23: L Error: does not match other declaration of function4e
.*28: L Error: does not match other declaration of function4f
.*33: L Error: does not match other declaration of function4g
}

test initializers-1 {check variable initializer error cases} -body {
#lang L --line=1
extern int g = 0;
void initializers_1() {
	/*
	 * Externs in local scopes are illegal as well as extern
	 * initializers, so this is error on two counts.
	 */
	extern int l = 0;
}
} -returnCodes {error} -match regexp -result {.*1: L Error: extern initializers illegal
.*7: L Error: extern.*
}

test initializers-2 {check variable initializers} -body {
#lang L --line=1
struct initializers_2_s1 {
	int	i;
	int	j, k;
	string	s;
	string	as[];
	string	hs{int};
};
struct initializers_2_s2 {
	int	i, j;
};
typedef struct initializers_2_s2 h_of_s2{int};

void initializers_2()
{
	/*
	 * In addition to the initializers themselves, check various
	 * number of initializers per declaration.
	 */
	int	i;
	int	i1 = 11;
	int	i2 = 0, i3 = 33;
	int	i4 = 0, i5 = 55, i6 = 0;
	int	i7 = 0, i8 = 88, i9 = 99, i10 = 111;
	string	s = "s";
	float	f = 3.1, f2 = 3;
	string	ai[] = { "a", "b", "c" };
	string	hs{int} = { 1=>"one", 2=>"two", 3=>"three" };
	struct initializers_2_s1 st = {
		1,
		2, 3,
		"s",
		{ "x", "y", "z" },
		{ 3=>"t", 6=>"s" },   // note the trailing comma (legal)
	};
	string	aempty[] = {};
	h_of_s2	h2 = { 1 => {2,3}, 2 => {4,5} };

	unless (i1 == 11) puts("bad 1");
	unless (!i2 && !i4 && !i6 && !i7) puts("bad 2");
	unless (i3 == 33) puts("bad 3");
	unless (i5 == 55) puts("bad 4");
	unless (i8 == 88) puts("bad 5");
	unless (i9 == 99) puts("bad 6");
	unless (i10 == 111) puts("bad 7");
	unless (s eq "s") puts("bad 8");
	unless (f == 3.1) puts("bad 9");
	unless (f2 == 3) puts("bad 9.1");
	unless ((ai[0] eq "a") && (ai[1] eq "b")) puts("bad 10");
	unless ((ai[2] eq "c") && !defined(ai[3])) puts("bad 11");
	i = 0;
	foreach (s in ai) ++i;
	unless (i == 3) puts("bad 12");
	unless ((hs{1} eq "one") && (hs{2} eq "two")) puts("bad 13");
	unless ((hs{3} eq "three")) puts("bad 14");
	i = 0;
	foreach (i1 in hs) ++i;
	unless (i == 3) puts("bad 15");

	unless ((st.i == 1) && (st.j == 2) && (st.k == 3)) puts("bad 16");
	unless ((st.s eq "s") && (st.as[0] eq "x")) puts("bad 17");
	unless ((st.as[1] eq "y") && (st.as[2] eq "z")) puts("bad 18");
	i = 0;
	foreach (s in st.as) ++i;
	unless (i == 3) puts("bad 19");
	unless ((st.hs{3} eq "t") && (st.hs{6} eq "s")) puts("bad 20");
	i = 0;
	foreach (i1 in st.hs) ++i;
	unless (i == 2) puts("bad 21");

	if (defined(aempty[0])) puts("bad 30");
	unless ((h2{1}.i == 2) && (h2{1}.j == 3)) puts("bad 31");
	unless ((h2{2}.i == 4) && (h2{2}.j == 5)) puts("bad 32");
}
#lang tcl
initializers_2
} -output {}

test initializers-3 {check variable initializer type errors} -body {
#lang L --line=1 -nowarn
struct initializers_3_s1 {
	int	i;
	int	j, k;
	string	s;
	string	as[];
	string	hs{int};
};

void initializers_3()
{
	int	i1 = 1.0;
	int	i2, i3 = "s";
	int	i4, i5 = {3}, i6;
	string	s = 3.1;
	float	f = "3.1";
	string	ai[] = {"a", 2, "c"};

	struct initializers_2_s1 st = {
		1,
		2,  // err -- omitted initializer for "k"
		"s",
		{ "x", "y", "z" },
		{ 3=>"t", 6=>"s" }
	};
	string	hs2{int} = { 1=>"one", 3 };
}
} -returnCodes {error} -match regexp -result {.*11: L Error: assignment of incompatible types
.*12: L Error: assignment of incompatible types
.*13: L Error: assignment of incompatible types
.*14: L Error: assignment of incompatible types
.*15: L Error: assignment of incompatible types
.*16: L Error: assignment of incompatible types
.*18: L Error: assignment of incompatible types
.*25: L Error: cannot mix hash and non-hash elements
}

test initializers-4 {check expressions in variable initializers} -body {
#lang L --line=1
int init_4_g = 33;
void initializers_4()
{
	/*
	 * Initializers are full-blown expressions, so they can contain
	 * variables etc.
	 */
	int	e1 = 11;
	int	e2 = e1*2;
	int	a[] = { init_4_g, init_4_g*2, e1, e2, 3 };

	unless ((e1 == 11) && (e2 == 22)) puts("bad 1");
	unless ((a[0] == 33) && (a[1] == 66) && (a[2] == 11) &&
		(a[3] == 22) && (a[4] == 3)) puts("bad 2");
	if (defined(a[5])) puts("bad 3");
}
#lang tcl
initializers_4
} -output {}

test initializers-5 {check order of variable initializers} -body {
#lang L --line=1
void initializers_5()
{
	/*
	 * This checks the variable initializers are compiled
	 * top-to-bottom and left-to-right.
	 */
	int	i1 = 2, i2 = i1 * 7, i3 = i1 + i2;
	int	i4 = i3 * 10;

	unless (i1 == 2) puts("bad 1");
	unless (i2 == 14) puts("bad 2");
	unless (i3 == 16) puts("bad 3");
	unless (i4 == 160) puts("bad 4");
}
initializers_5();
} -output {}

test initializers-6 {check blank initial values} -body {
#lang L --line=1
void initializers_6()
{
	int	i;
	float	f;
	string	s;
	poly	p;
	string	as[];
	string	hs{string};
	struct s1 {
		int	i;
		float	f;
		string	s;
		string	sa[];
		string	hs{string};
	} st;

	if (defined(i)) puts("bad 1");
	if (defined(f)) puts("bad 2");
	if (defined(s)) puts("bad 3");
	if (defined(p)) puts("bad 4");
	if (defined(as)) puts("bad 5");
	if (defined(hs)) puts("bad 6");
	if (defined(st)) puts("bad 7");
}
initializers_6();
} -output {}

test composite-1 {check composite values in expressions 1} -body {
#lang L --line=1
struct composite_1_s1 {
	int	i;
	int	j, k;
	string	s;
	string	as[];
	string	hs{int};
};
int composite_1_g = 33;
void composite_1()
{
	/*
	 * These are taken from the initializer-* tests above but
	 * are used in the rhs of expressions instead of in initializers.
	 */

	int	i, i1;
	int	e1 = 11;
	int	e2 = e1*2;
	string	s;
	int	a[];
	string	ai[];
	string	hs{int};
	struct composite_1_s1 st;
	string	aempty[];
	h_of_s2	h2;

	a = { composite_1_g, composite_1_g*2, e1, e2, 3 };

	unless ((e1 == 11) && (e2 == 22)) puts("bad 1");
	unless ((a[0] == 33) && (a[1] == 66) && (a[2] == 11) &&
		(a[3] == 22) && (a[4] == 3)) puts("bad 2");
	if (defined(a[5])) puts("bad 3");

	ai = { "a", "b", "c" };
	hs = { 1=>"one", 2=>"two", 3=>"three" };
	st = {
		1,
		2, 3,
		"s",
		{ "x", "y", "z" },
		{ 3=>"t", 6=>"s" },   // note the trailing comma (legal)
	};
	aempty = {};
	h2 = { 1 => {2,3}, 2 => {4,5} };

	unless ((ai[0] eq "a") && (ai[1] eq "b")) puts("bad 10");
	unless ((ai[2] eq "c") && !defined(ai[3])) puts("bad 11");
	i = 0;
	foreach (s in ai) ++i;
	unless (i == 3) puts("bad 12");
	unless ((hs{1} eq "one") && (hs{2} eq "two")) puts("bad 13");
	unless ((hs{3} eq "three")) puts("bad 14");
	i = 0;
	foreach (i1 in hs) ++i;
	unless (i == 3) puts("bad 15");

	unless ((st.i == 1) && (st.j == 2) && (st.k == 3)) puts("bad 16");
	unless ((st.s eq "s") && (st.as[0] eq "x")) puts("bad 17");
	unless ((st.as[1] eq "y") && (st.as[2] eq "z")) puts("bad 18");
	i = 0;
	foreach (s in st.as) ++i;
	unless (i == 3) puts("bad 19");
	unless ((st.hs{3} eq "t") && (st.hs{6} eq "s")) puts("bad 20");
	i = 0;
	foreach (i1 in st.hs) ++i;
	unless (i == 2) puts("bad 21");

	if (defined(aempty[0])) puts("bad 30");
	unless ((h2{1}.i == 2) && (h2{1}.j == 3)) puts("bad 31");
	unless ((h2{2}.i == 4) && (h2{2}.j == 5)) puts("bad 32");
}
#lang tcl
composite_1
} -output {}

test composite-2 {check composite values in expressions 2} -body {
#lang L --line=1
string composite_2_join(string[] a)
{
	string	s;
	string	ret = "";

	foreach (s in a) ret = sprintf("%s%s", ret, s);
	return (ret);
}
void composite_2()
{
	/*
	 * Try more operations with composite values.
	 */

	int	i;

	unless (composite_2_join({"a","b","c"}) eq "abc") puts("bad 1");

	for (i = 0; i < 5; ++i) {
		unless ({0,1,2,3,4}[i] == i) printf("bad 2 %d\n", i);
	}
	if (defined({0,1,2,3,4}[5])) puts("bad 3");

	unless ({1=>"one", 2=>"two", 3=>"three"}{1} eq "one") puts("bad 4");
	unless ({1=>"one", 2=>"two", 3=>"three"}{2} eq "two") puts("bad 5");
	unless ({1=>"one", 2=>"two", 3=>"three"}{3} eq "three") puts("bad 6");

	unless (((struct { int i,j,k; }){1,2,3}).i == 1) puts("bad 10");
	unless (((struct { int i,j,k; }){1,2,3}).j == 2) puts("bad 11");
	unless (((struct { int i,j,k; }){1,2,3}).k == 3) puts("bad 12");

	unless ({{1,2},{3,4},{4,5}}[1][0] == 3) puts("bad 20");
}
#lang tcl
composite_2
} -output {}

test composite-2.2 {check hash of array of composite constants} -body {
#lang L --line=1
void composite_2_2()
{
	/*
	 * This checks that lists used as array constants need not all
	 * have the same number of elements to satisfy the type
	 * checker.
	 */

	string	h{string}[] = {
		"k1" => { "1" },
		"k2" => { "1", "2", "3" },
		"k3" => { "1", "2" }
	};

	unless (length(h) == 3) puts("bad 1.1");
	unless (length(h{"k1"}) == 1) puts("bad 1.2");
	unless (length(h{"k2"}) == 3) puts("bad 1.3");
	unless (length(h{"k3"}) == 2) puts("bad 1.4");
	unless (join(" ", h{"k1"}) eq "1") puts("bad 1.5");
	unless (join(" ", h{"k2"}) eq "1 2 3") puts("bad 1.6");
	unless (join(" ", h{"k3"}) eq "1 2") puts("bad 1.7");
}
composite_2_2();
} -output {}

test composite-2.3 {check list type compatibility in assignment} -body {
#lang L --line=1
void composite_2_3()
{
	float	af[];

	/*
	 * This verifies that the type checker gets the compatibility
	 * test right when checking an array against a list type.  The
	 * opposite, when you try to assign a list of ints and floats
	 * to an int array, is an error and is checked in a test
	 * below.
	 */
	af = { 1.1, 2.2 };
	af = { 1, 2.2 };
	af = { 1.1, 2 };
	af = { 1, 2 };
}
composite_2_3();
} -output {}

test composite-3 {check type errors with composite values} -body {
#lang L --line=1 -nowarn
void composite_3_as(string[] a) {}
void composite_3_ai(int[] a) {}
void composite_3_his(int{string} a) {}
void composite_3_hsi(string{int} a) {}
void composite_3_hss(string{string} a) {}
void composite_3_hii(int{int} a) {}

void composite_3()
{
	int	i[];

	composite_3_as({1,2,3});
	composite_3_ai({"a","b","c"});
	composite_3_his({1,2,3});
	composite_3_his({1=>2,3=>4});
	composite_3_hsi({1=>2,3=>4});
	composite_3_hss({1=>2,3=>4});
	composite_3_hii({"1"=>2,"3"=>4});

	i = { 1.1 };
	i = { 1, 2.2 };
}
} -returnCodes {error} -match regexp -result {.*12: L Error:.*incompatible type.*
.*13: L Error:.*incompatible type.*
.*14: L Error:.*incompatible type.*
.*15: L Error:.*incompatible type.*
.*16: L Error:.*incompatible type.*
.*17: L Error:.*incompatible type.*
.*18: L Error:.*incompatible type.*
.*20: L Error:.*incompatible type.*
.*21: L Error:.*incompatible type.*
}

test composite-4 {check composite l-values} -body {
#lang L --line=1
class composite_4
{
	public	string c;
	instance {
		public	string i;
	}
}
void composite_4_main()
{
	string	a, b, c;
	string	sa[];
	composite_4 o1, o2, o3;

	a = "bad";
	{ a } = { "one" };
	unless (a eq "one") puts("bad 1.1");

	a = b = "bad";
	{ a, b } = { "one", "two" };
	unless ((a eq "one") && (b eq "two")) puts("bad 2.1");

	a = b = c = "bad";
	{ a, b, c } = { "one", "two", "three" };
	unless ((a eq "one") && (b eq "two") && (c eq "three")) puts("bad 3.1");

	a = "bad";
	{ a } = {};
	if (defined(a)) puts("bad 4.1");

	a = b = "bad";
	{ a, b } = {};
	if (defined(a) || defined(b)) puts("bad 5.1");

	a = b = c = "bad";
	{ a, b, c } = {};
	if (defined(a) || defined(b) || defined(c)) puts("bad 6.1");

	a = b = c = "bad";
	{ a, b, c } = { "one" };
	unless (a eq "one") puts("bad 7.1");
	if (defined(b) || defined(c)) puts("bad 7.2");

	a = b = c = "bad";
	{ a, b, c } = { "one", "two" };
	unless ((a eq "one") && (b eq "two")) puts("bad 8.1");
	if (defined(c)) puts("bad 8.2");

	a = "bad";
	{ a } = { "one", "two" };
	unless (a eq "one") puts("bad 9.1");

	a = "bad";
	{ a } = { "one", "two", "three" };
	unless (a eq "one") puts("bad 10.1");

	a = b = "bad";
	{ a, b } = { "one", "two", "three" };
	unless ((a eq "one") && (b eq "two")) puts("bad 11.1");

	a = "bad";
	{ a, undef } = { "one", "two" };
	unless (a eq "one") puts("bad 12.1");

	a = "bad";
	{ a, undef } = { "one" };
	unless (a eq "one") puts("bad 13.1");

	a = "bad";
	{ a, undef, undef } = { "one" };
	unless (a eq "one") puts("bad 14.1");

	a = "bad";
	{ undef, a } = { "one", "two" };
	unless (a eq "two") puts("bad 15.1");

	a = "bad";
	{ undef, a } = { "one", "two", "three" };
	unless (a eq "two") puts("bad 16.1");

	a = "bad";
	{ undef, a, undef } = { "one", "two", "three" };
	unless (a eq "two") puts("bad 17.1");

	{ undef } = {};
	{ undef, undef } = {};
	{ undef, undef, undef } = {};
	{ undef } = { undef };

	{ sa[0] } = { "one" };
	unless (sa[0] eq "one") puts("bad 18.1");

	{ sa[0], sa[1] } = { "one", "two" };
	unless ((sa[0] eq "one") && (sa[1] eq "two")) puts("bad 19.1");

	{ sa[0], sa[1], sa[3] } = { "one", "two", "four" };
	unless ((sa[0] eq "one") && (sa[1] eq "two") && (sa[3] eq "four")) {
		puts("bad 20.1");
	}
	if (defined(sa[2])) puts("bad 20.2");

	o1 = composite_4_new();
	o2 = composite_4_new();
	o3 = composite_4_new();
	{ o1->i, o2->i, o3->i } = { "one", "two", "three" };
	unless (o1->i eq "one") puts("bad 21.1");
	unless (o2->i eq "two") puts("bad 21.2");
	unless (o3->i eq "three") puts("bad 21.3");
	{ composite_4->c } = { "cvar" };
	unless (composite_4->c eq "cvar") puts("bad 21.4");
	composite_4_delete(o1);
	composite_4_delete(o2);
	composite_4_delete(o3);

	a = b = "bad";
	{ a, b } = (poly){ "one", "two" };
	unless ((a eq "one") && (b eq "two")) puts("bad 22.1");
	a = b = "bad";
	{ a, b } = (poly){ "one", "two", "three" };
	unless ((a eq "one") && (b eq "two")) puts("bad 22.2");
	a = b = "bad";
	{ a } = (poly){ "one", "two", "three" };
	unless ((a eq "one") && (b eq "bad")) puts("bad 22.3");
}
composite_4_main();
} -output {}

test composite-4.1 {check composite l-values with non-constant rhs} -body {
#lang L --line=1
void composite_4_1()
{
	int	ai[], i, j, k;
	string	as[], a, b, c;
	poly	ap[];
	struct {
		int	i;
		int	j;
		string	s;
		string	t;
	} st;

	as = { "a", "b", "c" };
	{ a, b, c } = as;
	unless ((a eq "a") && (b eq "b") && (c eq "c")) puts("bad 1.1");

	ai = { 1, 2, 3 };
	{ i, j, k } = ai;
	unless ((i == 1) && (j == 2) && (k == 3)) puts("bad 2.1");

	st = { 5, 6, "x", "y" };
	{ i, j, a, b } = st;
	unless ((i == 5) && (j == 6) && (a eq "x") && (b eq "y")) {
		puts("bad 3.1");
	}

	{ a, b } = split("one two three");
	unless ((a eq "one") && (b eq "two")) puts("bad 4.1");

	as = { "a" };
	{ a, b, c } = as;
	unless ((a eq "a") && !defined(b) && !defined(c)) puts("bad 5.1");

	ap = { 5, 6, "x", "y" };
	{ i, j, a, b } = ap;
	unless ((i == 5) && (j == 6) && (a eq "x") && (b eq "y")) {
		puts("bad 6.1");
	}
	ap = { "5", "6", 1, 2 };
	{ i, j, a, b } = ap;  // poly array, so no type checking
	unless ((i == 5) && (j == 6) && (a eq "1") && (b eq "2")) {
		puts("bad 6.2");
	}

	/* These are not type errors. */
	i = j = 0;
	{ a, i, j } = { "s" };
	if (defined(i) || defined(j)) puts("bad 10.1");
	c = ""; i = j = 0;
	{ i, j, a, b, c, i, j } = st;
	if (defined(c) || defined(i) || defined(j)) puts("bad 10.2");
}
composite_4_1();
} -output {}

test composite-5 {check composite l-value errors} -body {
#lang L --line=1 -nowarn
int composite_5_f() { return (0); }
void composite_5()
{
	int	a, b;
	string	s;

	{ a, b } += 1;
	{ a, b } -= 1;
	{ a, b } *= 1;
	{ a, b } /= 1;
	{ a, b } %= 1;
	{ a, b } &= 1;
	{ a, b } |= 1;
	{ a, b } ^= 1;
	{ a, b } >>= 1;
	{ a, b } <<= 1;
	{ a, b } =~ /bad/;
	{ s } =~ s/bad/bad/;

	{ a, b } = 0;

	{ 1 } = { 1 };
	{ composite_5_f() } = { 1 };
}
} -returnCodes {error} -match regexp -result {.*7: L Error: arithmetic assignment illegal
.*8: L Error: arithmetic assignment illegal
.*9: L Error: arithmetic assignment illegal
.*10: L Error: arithmetic assignment illegal
.*11: L Error: arithmetic assignment illegal
.*12: L Error: arithmetic assignment illegal
.*13: L Error: arithmetic assignment illegal
.*14: L Error: arithmetic assignment illegal
.*15: L Error: arithmetic assignment illegal
.*16: L Error: arithmetic assignment illegal
.*17: L Error: expected type string or widget but got list in =~
.*18: L Error: invalid l-value in =~
.*20: L Error: right-hand side incompatible with composite assign
.*22: L Error: invalid l-value in assignment
.*23: L Error: invalid l-value in assignment
}

test composite-6 {test composite l-value type errors} -body {
#lang L --line=1
void composite_6()
{
	string	as[], a, b;
	int	ai[], i, j;
	struct {
		int	i;
		string	s;
	} st;

	{ a, i } = as;
	{ i, a } = ai;
	{ i, i } = as;

	{ a, b } = { "a", 1 };
	{ a, b } = { 1, "a" };

	{ a, i } = st;
	{ i, j } = st;

	{ a, b } = { "bad" => "bad" };
}
} -returnCodes {error} -match regexp -result {.*10: L Error: assignment of incompatible types
.*11: L Error: assignment of incompatible types
.*12: L Error: assignment of incompatible types
.*14: L Error: assignment of incompatible types
.*15: L Error: assignment of incompatible types
.*17: L Error: assignment of incompatible types
.*18: L Error: assignment of incompatible types
.*20: L Error: right-hand side incompatible with composite assign
}

test lvalue-1 {check indexing hash/struct/array expressions} -body {
#lang L --line=1
void lvalue_1()
{
	/*
	 * This checks deep-dive of an expression rather than a
	 * variable.  Set up expressions that have array/struct/hash
	 * values and then index into them.
	 */
	string	a1[] = { "1", "2", "3" };
	string	a2[];

	unless (split("a x c")[0] eq "a") puts("bad 1");
	unless (split("y b c")[1] eq "b") puts("bad 2");
	unless (split("z b c")[2] eq "c") puts("bad 3");

	if (defined(a2[0])) puts("bad 4");
	unless ((a2 = a1)[0] eq "1") puts("bad 5");
	unless ((a2 = a1)[1] eq "2") puts("bad 6");
	unless ((a2 = a1)[2] eq "3") puts("bad 7");
	unless ((a2[0] eq "1") && (a2[1] eq "2") && (a2[2] eq "3")) {
		puts("bad 8");
	}
	if (defined(a2[3])) puts("bad 9");

	unless ((1 ? a1 : a2)[0] eq "1") puts("bad 10");
	unless ((1 ? a1 : a2)[1] eq "2") puts("bad 11");
	unless ((1 ? a1 : a2)[2] eq "3") puts("bad 12");
}
#lang tcl
lvalue_1
} -output {}

test lvalue-2 {illegal l-value in deep-dive assignments} -body {
#lang L --line=1
int[] lvalue_2_ints()
{
	int	a[] = { 1, 2, 3 };
	return (a);
}
void lvalue_2()
{
	int	a1[], a2[];
	string	s1[], s2[];

	lvalue_2_ints()[0] = 0;
	lvalue_2_ints()[0] += 1;
	++lvalue_2_ints()[0];
	lvalue_2_ints()[0]--;
	split("a","b","c")[0] =~ s/a/b/;

	(a2 = a1)[0] = 0;
	(a2 = a1)[0] += 1;
	++(a2 = a1)[0];
	(a2 = a1)[0]--;
	(s2 = s1)[0] =~ s/bad/yes-its-still-bad/;
}
#lang tcl
lvalue_2
} -returnCodes {error} -match regexp -result {.*11: L Error: invalid l-value in assignment
.*12: L Error: invalid l-value in assignment
.*13: L Error: invalid l-value in inc/dec
.*14: L Error: invalid l-value in inc/dec
.*15: L Error: invalid l-value in =~
.*17: L Error: invalid l-value in assignment
.*18: L Error: invalid l-value in assignment
.*19: L Error: invalid l-value in inc/dec
.*20: L Error: invalid l-value in inc/dec
.*21: L Error: invalid l-value in =~
}

test lvalue-3 {invalid l-value in inc/dec operators} -body {
#lang L --line=1
void lvalue_3()
{
	int	i = 0;

	i----;
	i++++;
	(i++)++;
	(i++)--;
	(i--)++;
	(i--)--;
	++++i;
	----i;
	++(++i);
	++(--i);
	--(++i);
	--(--i);
	--(i--);
	--(i++);
	++(i--);
	++(i++);
	(--i)--;
	(--i)++;
	(++i)--;
	(++i)++;
}
#lang tcl
lvalue_3
} -returnCodes {error} -match regexp -result {.*5: L Error: invalid l-value in inc/dec
.*6: L Error: invalid l-value in inc/dec
.*7: L Error: invalid l-value in inc/dec
.*8: L Error: invalid l-value in inc/dec
.*9: L Error: invalid l-value in inc/dec
.*10: L Error: invalid l-value in inc/dec
.*11: L Error: invalid l-value in inc/dec
.*12: L Error: invalid l-value in inc/dec
.*13: L Error: invalid l-value in inc/dec
.*14: L Error: invalid l-value in inc/dec
.*15: L Error: invalid l-value in inc/dec
.*16: L Error: invalid l-value in inc/dec
.*17: L Error: invalid l-value in inc/dec
.*18: L Error: invalid l-value in inc/dec
.*19: L Error: invalid l-value in inc/dec
.*20: L Error: invalid l-value in inc/dec
.*21: L Error: invalid l-value in inc/dec
.*22: L Error: invalid l-value in inc/dec
.*23: L Error: invalid l-value in inc/dec
.*24: L Error: invalid l-value in inc/dec
}

test lvalue-4 {invalid l-value in assignments} -body {
#lang L --line=1
int lvalue_4_foo() { return (1); }
void lvalue_4()
{
	int	i;

	lvalue_4_foo() = i;
	lvalue_4_foo() += i;
	lvalue_4_foo() -= i;
	lvalue_4_foo() *= i;
	lvalue_4_foo() /= i;
	lvalue_4_foo() %= i;
	lvalue_4_foo() &= i;
	lvalue_4_foo() |= i;
	lvalue_4_foo() ^= i;
	lvalue_4_foo() >>= i;
	lvalue_4_foo() <<= i;
	lvalue_4_foo() =~ s/bad/dab/;
}
#lang tcl
lvalue_4
} -returnCodes {error} -match regexp -result {.*6: L Error: invalid l-value in assignment
.*7: L Error: invalid l-value in assignment
.*8: L Error: invalid l-value in assignment
.*9: L Error: invalid l-value in assignment
.*10: L Error: invalid l-value in assignment
.*11: L Error: invalid l-value in assignment
.*12: L Error: invalid l-value in assignment
.*13: L Error: invalid l-value in assignment
.*14: L Error: invalid l-value in assignment
.*15: L Error: invalid l-value in assignment
.*16: L Error: invalid l-value in assignment
.*17: L Error: invalid l-value in =~
}

test lvalue-5 {invalid l-value in & operator} -body {
#lang L --line=1 -nowarn
int lvalue_5_foo() { return (1); }
void lvalue_5_bar(int &i) {}
void lvalue_5()
{
	int	a[], aa[][];

	lvalue_5_bar(&lvalue_5_foo());
	lvalue_5_bar(&1);
	&1;
	&1.1;
	&"s";
	&{1,2,3};
	&{1=>1};
	&(1+2);
}
#lang tcl
lvalue_5
} -returnCodes {error} -match regexp -result {.*7: L Error: illegal operand to &
.*8: L Error: illegal operand to &
.*9: L Error: illegal operand to &
.*10: L Error: illegal operand to &
.*11: L Error: illegal operand to &
.*12: L Error: illegal operand to &
.*13: L Error: illegal operand to &
.*14: L Error: illegal operand to &
}

test builtin-1 {check keys built-in} -body {
#lang L --line=1
int[]
builtin_1_isort(int a[])
{
	int	sorted[] = sort(a);
	return (sorted);
}
string[]
builtin_1_ssort(string a[])
{
	string	sorted[] = sort(a);
	return (sorted);
}
void builtin_1()
{
	int	hi{int};
	int	hs{string};
	int	hp{poly};
	int	ki[];
	string	ks[];
	poly	kp[];

	hi = { 3=>3, 1=>1, 4=>4, 5=>5, 9=>9 };
	ki = keys(hi);
	ki = builtin_1_isort(ki);
	unless ((ki[0] == 1) && (ki[1] == 3) && (ki[2] == 4)) puts("bad 1.1");
	unless ((ki[3] == 5) && (ki[4] == 9)) puts("bad 1.2");
	if (defined(ki[5])) puts("bad 1.3");

	hs = { "3"=>3, "1"=>1, "4"=>4, "5"=>5, "9"=>9 };
	ks = keys(hs);
	ks = builtin_1_ssort(ks);
	unless ((ks[0] eq "1") && (ks[1] eq "3")) puts("bad 2.1");
	unless ((ks[2] eq "4") && (ks[3] eq "5")) puts("bad 2.2");
	unless (ks[4] eq "9") puts("bad 2.3");
	if (defined(ks[5])) puts("bad 2.4");

	hp{"3"} = 3;
	hp{1}   = 1;
	hp{"4"} = 4;
	hp{5}   = 5;
	hp{"9"} = 9;
	kp = keys(hp);
	kp = builtin_1_ssort(kp);
	unless ((kp[0] eq "1") && (kp[1] eq "3")) puts("bad 3.1");
	unless ((kp[2] eq "4") && (kp[3] eq "5")) puts("bad 3.2");
	unless (kp[4] eq "9") puts("bad 3.3");
	if (defined(kp[5])) puts("bad 3.4");
}
builtin_1();
} -output {}

test builtin-2 {check errors with keys built-in} -body {
#lang L --line=1
void builtin_2()
{
	int	h{int};
	int	k[];

	k = keys();
	k = keys(k);
	k = keys(h, h);
	/*
	 * These test that the compiler does not assert due to keys()
	 * not getting a type even though the call has an error.
	 */
	keys() + 1;
	keys(k) + 1;
}
} -returnCodes {error} -match regexp -result {.*6: L Error: incorrect # args to keys
.*7: L Error: arg to keys is not a hash
.*8: L Error: incorrect # args to keys
}

test builtin-3 {check length built-in} -body {
#lang L --line=1
void builtin_3()
{
	int	a[] = {1,2,3,4};
	int	h{int} = {1=>1,2=>2,3=>3};
	poly	p = {1,2,3,4,5,6};
	widget	w = "12345";

	unless (length("abcde") == 5) puts("bad 1");
	unless (length(a) == 4) puts("bad 2");
	unless (length(p) == 6) puts("bad 4");
	unless (length(h) == 3) puts("bad 5");
	unless (length(w) == 5) puts("bad 6");

	/*
	 * length() of anything undef should return 0.
	 */
	unless (length((string)undef) == 0) puts("bad 10.1");
	unless (length((string[])undef) == 0) puts("bad 10.2");
	unless (length((string{string})undef) == 0) puts("bad 10.3");
	unless (length((poly)undef) == 0) puts("bad 10.4");
}
builtin_3();
} -output {}

test builtin-4 {check errors with length built-in} -body {
#lang L --line=1
void builtin_4_f() {}
void builtin_4()
{
	length();
	length(1,2);
	length(3.14159);
	length(builtin_4_f());
	/*
	 * This tests that the compiler does not assert due to length()
	 * not getting a type even though the call has an error.
	 */
	length() + 1;
}
} -returnCodes {error} -match regexp -result {.*4: L Error: incorrect # args to length
.*5: L Error: incorrect # args to length
.*6: L Error: arg to length has illegal type
.*7: L Error: arg to length has illegal type
}

test builtin-5 {check sort built-in} -body {
#lang L --line=1
int builtin_5_compar(string a, string b)
{
	int	la = length(a);
	int	lb = length(b);

	if (la < lb) {
		return (-1);
	} else if (la > lb) {
		return (1);
	} else {
		return (0);
	}
}
void builtin_5()
{
	int	ui[] = {3, 1, 4, 1, 5, 9, 2};
	int	si[];
	string	us[] = {"u","n","s","o","r","t","e","d"};
	string	ss[];
	float	uf[] = {3.1, 1.0, 9.2, -1.0, 5.5};
	float	sf[];
	string	uc[] = {"1", "22222", "333", "44", "5555"};
	string	sc[];

	ss = sort(us);
	unless ((ss[0] eq "d") && (ss[1] eq "e")) puts("bad 1.1");
	unless ((ss[2] eq "n") && (ss[3] eq "o")) puts("bad 1.2");
	unless ((ss[4] eq "r") && (ss[5] eq "s")) puts("bad 1.3");
	unless ((ss[6] eq "t") && (ss[7] eq "u")) puts("bad 1.4");

	si = sort(ui);
	unless ((si[0] == 1) && (si[1] == 1) && (si[2] == 2)) puts("bad 2.1");
	unless ((si[3] == 3) && (si[4] == 4) && (si[5] == 5)) puts("bad 2.2");
	unless (si[6] == 9) puts("bad 2.3");

	/*
	 * Exact comparisons with floats don't always work, so if this
	 * test fails, suspect that first.
	 */
	sf = sort(uf);
	unless ((sf[0] == -1.0) && (sf[1] == 1.0)) puts("bad 3.1");
	unless ((sf[2] == 3.1)  && (sf[3] == 5.5)) puts("bad 3.2");
	unless (sf[4] == 9.2) puts("bad 3.3");

	ss = sort(decreasing:, us);
	unless ((ss[7] eq "d") && (ss[6] eq "e")) puts("bad 4.1");
	unless ((ss[5] eq "n") && (ss[4] eq "o")) puts("bad 4.2");
	unless ((ss[3] eq "r") && (ss[2] eq "s")) puts("bad 4.3");
	unless ((ss[1] eq "t") && (ss[0] eq "u")) puts("bad 4.4");

	sc = sort(command: &builtin_5_compar, uc);
	unless ((sc[0] eq "1")   && (sc[1] eq "44")) puts("bad 5.1");
	unless ((sc[2] eq "333") && (sc[3] eq "5555")) puts("bad 5.2");
	unless (sc[4] eq "22222") puts("bad 5.3");
}
builtin_5();
} -output {}

test builtin-6 {check sort built-in errors} -body {
#lang L --line=1
int builtin_6_compar(string a, string b) { return (0); }
void builtin_6()
{
	string	s;

	sort();
	sort(1);
	/*
	 * These test that the compiler does not assert due to sort()
	 * not getting a type even though the call has an error.
	 */
	sort() + 1;
	sort(1) + 1;

	sort(command: builtin_6_compar, {});
	sort(command: &s, {});
	sort(command:, {});
	sort(command:);
}
} -returnCodes {error} -match regexp -result {.*6: L Error: incorrect # args to sort
.*7: L Error: last arg to sort not an array or list
.*12: L Error: incorrect # args to sort
.*13: L Error: last arg to sort not an array or list
.*15: L Error: \'command:\' arg to sort must be \&function
.*16: L Error: \'command:\' arg to sort must be \&function
.*17: L Error: \'command:\' arg to sort must be \&function
.*18: L Error: last arg to sort not an array or list
}

test builtin-7 {check join built-in} -body {
#lang L --line=1
void builtin_7()
{
	int	ai[] = {1,2,3};
	string	as[] = {"a","b","c"};
	string	s = "x";
	poly	p = "p";
	widget	w = "w";

	unless (join(" ", as) eq "a b c") puts("bad 1");
	unless (join(s, as) eq "axbxc") puts("bad 2");
	unless (join("xyz", as) eq "axyzbxyzc") puts("bad 3");
	unless (join(p, as) eq "apbpc") puts("bad 4");
	unless (join(p,p) eq "p") puts("bad 5");
	unless (join(" ", ai) eq "1 2 3") puts("bad 6");
	unless (join(w, ai) eq "1w2w3") puts("bad 7");
}
builtin_7();
} -output {}

test builtin-8 {check join built-in errors} -body {
#lang L --line=1
void builtin_8()
{
	int	ai[];

	join();
	join(ai,"s1","s2");
	join(ai, ai);
	join(1);
	join(1.1);
	join("s");
	join("s", 1);
	/*
	 * These test that the compiler does not assert due to join()
	 * not getting a type even though the call has an error.
	 */
	join() + 1;
	join(ai, ai) + 1;
	join("s", 1) + 1;
}
} -returnCodes {error} -match regexp -result {.*5: L Error: incorrect # args to join
.*6: L Error: incorrect # args to join
.*7: L Error: first arg to join not a string
.*8: L Error: incorrect # args to join
.*9: L Error: incorrect # args to join
.*10: L Error: incorrect # args to join
.*11: L Error: second arg to join not an array or list
}

test builtin-9 {check re-declaration of built-ins} -body {
#lang L --line=1
void abs() {}
void assert() {}
void die() {}
void join() {}
void keys() {}
void length() {}
void pop() {}
void push() {}
void rename() {}
void sort() {}
void undef() {}
void warn() {}
} -returnCodes {error} -match regexp -result {.*1: L Error: function 'abs' conflicts with built-in
.*2: L Error: function 'assert' conflicts with built-in
.*3: L Error: function 'die' conflicts with built-in
.*4: L Error: function 'join' conflicts with built-in
.*5: L Error: function 'keys' conflicts with built-in
.*6: L Error: function 'length' conflicts with built-in
.*7: L Error: function 'pop' conflicts with built-in
.*8: L Error: function 'push' conflicts with built-in
.*9: L Error: function 'rename' conflicts with built-in
.*10: L Error: function 'sort' conflicts with built-in
.*11: L Error: function 'undef' conflicts with built-in
.*12: L Error: function 'warn' conflicts with built-in
}

test builtin-10 {check built-ins stack integrity} -body {
#lang L --line=1
void builtin_10()
{
	/*
	 * This checks that an ignored return value doesn't leave the
	 * stack unbalanced (which would cause a crash).
	 */

	int	a[], i;
	int	n = 100;
	int	h{int} = { 1=>1, 2=>2 };

	for (i = 0; i < n; ++i) {
		push(&a, i);
		abs(1);
		assert(1);
		join(" ", {"a","b"});
		keys(h);
		length(h);
		pop(&a);
		push(&a, i);
		sort({3,2,1});
		split("x y z");
		undef(h{0});
	}
	unless (length(a) == n) puts("bad 1");
}
builtin_10();
} -output {}

test builtin-11 {check push onto class and instance variables} -body {
#lang L --line=1
class builtin_11
{
	public	int apubl[];
	instance {
		public	int ainst[];
	}
}
void builtin_11_main()
{
	builtin_11 o = builtin_11_new();

	push(&builtin_11->apubl, 1);
	push(&builtin_11->apubl, 2);
	push(&builtin_11->apubl, 3);
	unless (length(builtin_11->apubl) == 3) puts("bad 1.1");
	unless (builtin_11->apubl[0] == 1) puts("bad 1.2");
	unless (builtin_11->apubl[1] == 2) puts("bad 1.3");
	unless (builtin_11->apubl[2] == 3) puts("bad 1.4");

	push(&o->ainst, 1);
	push(&o->ainst, 2);
	push(&o->ainst, 3);
	unless (length(o->ainst) == 3) puts("bad 2.1");
	unless (o->ainst[0] == 1) puts("bad 2.2");
	unless (o->ainst[1] == 2) puts("bad 2.3");
	unless (o->ainst[2] == 3) puts("bad 2.4");

	builtin_11_delete(o);
}
builtin_11_main();
} -output {}

test builtin-11.2 {check push and pop built-in} -body {
#lang L --line=1
void builtin_11_2()
{
	string	aa[][], s;
	string	ha{string}[];
	struct {
		string	a[];
		string	aaaa[][][][];
	} st;

	aa = undef;
	push(&aa[0], "a");
	unless ((tcl)aa[0] eq "a") puts("bad 1.1");
	unless (defined(aa[0])) puts("bad 1.2");
	push(&aa[0], "b");
	unless ((tcl)aa[0] eq "a b") puts("bad 1.3");
	push(&aa[0], "c");
	unless ((tcl)aa[0] eq "a b c") puts("bad 1.4");
	s = pop(&aa[0]);
	unless (defined(s) && (s eq "c")) puts("bad 1.5");
	s = pop(&aa[0]);
	unless (s eq "b") puts("bad 1.6");
	s = pop(&aa[0]);
	unless (s eq "a") puts("bad 1.7");
	s = pop(&aa[0]);
	if (defined(s)) puts("bad 1.8");
	s = pop(&aa[0]);
	if (defined(s)) puts("bad 1.9");

	aa[0] = {"x","y"};
	push(&aa[0], "a");
	unless ((tcl)aa[0] eq "x y a") puts("bad 2.1");
	push(&aa[0], "b");
	unless ((tcl)aa[0] eq "x y a b") puts("bad 2.2");
	s = pop(&aa[0]);
	unless (defined(s) && (s eq "b")) puts("bad 2.3");
	s = pop(&aa[0]);
	unless (s eq "a") puts("bad 2.4");
	s = pop(&aa[0]);
	unless (s eq "y") puts("bad 2.5");
	s = pop(&aa[0]);
	unless (s eq "x") puts("bad 2.6");
	s = pop(&aa[0]);
	if (defined(s)) puts("bad 2.7");
	s = pop(&aa[0]);
	if (defined(s)) puts("bad 2.8");

	ha = undef;
	push(&ha{"new"}, "a");
	unless ((tcl)ha{"new"} eq "a") puts("bad 5.1");
	unless (defined(ha{"new"})) puts("bad 5.2");
	push(&ha{"new"}, "b");
	unless ((tcl)ha{"new"} eq "a b") puts("bad 5.3");
	push(&ha{"new"}, "c");
	unless ((tcl)ha{"new"} eq "a b c") puts("bad 5.4");
	s = pop(&ha{"new"});
	unless (defined(s) && (s eq "c")) puts("bad 5.5");
	s = pop(&ha{"new"});
	unless (s eq "b") puts("bad 5.6");
	s = pop(&ha{"new"});
	unless (s eq "a") puts("bad 5.7");
	s = pop(&ha{"new"});
	if (defined(s)) puts("bad 5.8");
	s = pop(&ha{"new"});
	if (defined(s)) puts("bad 5.9");

	ha{"new"} = {"p","q"};
	push(&ha{"new"}, "a");
	unless ((tcl)ha{"new"} eq "p q a") puts("bad 6.1");
	push(&ha{"new"}, "b");
	unless ((tcl)ha{"new"} eq "p q a b") puts("bad 6.2");
	s = pop(&ha{"new"});
	unless (defined(s) && (s eq "b")) puts("bad 6.3");
	s = pop(&ha{"new"});
	unless (s eq "a") puts("bad 6.4");
	s = pop(&ha{"new"});
	unless (s eq "q") puts("bad 6.5");
	s = pop(&ha{"new"});
	unless (s eq "p") puts("bad 6.6");
	s = pop(&ha{"new"});
	if (defined(s)) puts("bad 6.7");
	s = pop(&ha{"new"});
	if (defined(s)) puts("bad 6.8");

	st.a = undef;
	push(&st.a, "a");
	unless ((tcl)st.a eq "a") puts("bad 10.1");
	unless (defined(st.a)) puts("bad 10.2");
	push(&st.a, "b");
	unless ((tcl)st.a eq "a b") puts("bad 10.3");
	push(&st.a, "c");
	unless ((tcl)st.a eq "a b c") puts("bad 10.4");
	s = pop(&st.a);
	unless (defined(s) && (s eq "c")) puts("bad 10.5");
	s = pop(&st.a);
	unless (s eq "b") puts("bad 10.6");
	s = pop(&st.a);
	unless (s eq "a") puts("bad 10.7");
	s = pop(&st.a);
	if (defined(s)) puts("bad 10.8");
	s = pop(&st.a);
	if (defined(s)) puts("bad 10.9");

	st.a = {"r","s"};
	push(&st.a, "a");
	unless ((tcl)st.a eq "r s a") puts("bad 11.1");
	push(&st.a, "b");
	unless ((tcl)st.a eq "r s a b") puts("bad 11.2");
	s = pop(&st.a);
	unless (defined(s) && (s eq "b")) puts("bad 11.3");
	s = pop(&st.a);
	unless (s eq "a") puts("bad 11.4");
	s = pop(&st.a);
	unless (s eq "s") puts("bad 11.5");
	s = pop(&st.a);
	unless (s eq "r") puts("bad 11.6");
	s = pop(&st.a);
	if (defined(s)) puts("bad 11.7");
	s = pop(&st.a);
	if (defined(s)) puts("bad 11.8");

	push(&st.aaaa[0][1][2], "a");
	unless ((tcl)st.aaaa[0][1][2] eq "a") puts("bad 15.1");
	unless (defined(st.aaaa[0][1][2])) puts("bad 15.2");
	push(&st.aaaa[0][1][2], "b");
	unless ((tcl)st.aaaa[0][1][2] eq "a b") puts("bad 15.2");
	push(&st.aaaa[0][1][2], "c");
	unless ((tcl)st.aaaa[0][1][2] eq "a b c") puts("bad 15.3");
	s = pop(&st.aaaa[0][1][2]);
	unless (defined(s) && (s eq "c")) puts("bad 15.4");
	s = pop(&st.aaaa[0][1][2]);
	unless (s eq "b") puts("bad 15.5");
	s = pop(&st.aaaa[0][1][2]);
	unless (s eq "a") puts("bad 15.6");
	s = pop(&st.aaaa[0][1][2]);
	if (defined(s)) puts("bad 15.7");
	s = pop(&st.aaaa[0][1][2]);
	if (defined(s)) puts("bad 15.8");
}
builtin_11_2();
} -output {}

test builtin-11.3 {check push built-in with multiple args} -body {
#lang L --line=1
void builtin_11_3()
{
	int	i;
	string	a[], aa[][];

	push(&a, "a");
	unless (join("",a) eq "a") puts("bad 1.1");
	unless (length(a) == 1) puts("bad 1.2");

	push(&a, "b", "c");
	unless (join("",a) eq "abc") puts("bad 2.1");
	unless (length(a) == 3) puts("bad 2.2");

	push(&a, "d", "e", "f");
	unless (join("",a) eq "abcdef") puts("bad 3.1");
	unless (length(a) == 6) puts("bad 3.2");

	/* Check that the first arg is evaluated exactly once. */
	undef(a);
	i = 0;
	push(&aa[i++], "a", "b", "c");
	unless ((i == 1) && eq(aa[0],{"a","b","c"})) puts("bad 4.1");
	unless (length(aa) == 1) puts("bad 4.2");
	if (aa[1]) puts("bad 4.3");
}
builtin_11_3();
} -output {}

test builtin-11.4 {check push built-in with list args} -body {
#lang L --line=1
void builtin_11_4()
{
	int	a[], aa[][], aaa[][][];
	struct {
		int	a[];
	} st;
	string	sa[], saa[][];

	/* Check pushing to a plain variable. */

	push(&a, 1);
	unless (eq(a,{1})) puts("bad 1.1");

	push(&a, {2});
	unless (eq(a,{1,2})) puts("bad 1.2");

	push(&a, {3,4});
	unless (eq(a,{1,2,3,4})) puts("bad 1.3");

	push(&a, {5,6,7});
	unless (eq(a,{1,2,3,4,5,6,7})) puts("bad 1.4");

	push(&a, 8, {9,10});
	unless (eq(a,{1,2,3,4,5,6,7,8,9,10})) puts("bad 1.5");

	push(&a, {11,12}, 13);
	unless (eq(a,{1,2,3,4,5,6,7,8,9,10,11,12,13})) puts("bad 1.6");

	push(&a, 14, {15}, 16, {17,18});
	unless (eq(a,{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18})) {
		puts("bad 1.7");
	}

	/* Check pushing to a struct member (deep dive). */

	push(&st.a, 1);
	unless (eq(st.a,{1})) puts("bad 2.1");

	push(&st.a, {2});
	unless (eq(st.a,{1,2})) puts("bad 2.2");

	push(&st.a, {3,4});
	unless (eq(st.a,{1,2,3,4})) puts("bad 2.3");

	push(&st.a, {5,6,7});
	unless (eq(st.a,{1,2,3,4,5,6,7})) puts("bad 2.4");

	push(&st.a, 8, {9,10});
	unless (eq(st.a,{1,2,3,4,5,6,7,8,9,10})) puts("bad 2.5");

	push(&st.a, {11,12}, 13);
	unless (eq(st.a,{1,2,3,4,5,6,7,8,9,10,11,12,13})) puts("bad 2.6");

	push(&st.a, 14, {15}, 16, {17,18});
	unless (eq(st.a,{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18})) {
		puts("bad 2.7");
	}

	/*
	 * If you push to a type[], you can push a type or a type[],
	 * and you can mix and match in one push.  Check that these
	 * are done correctly.
	 */

	push(&aa, {1,1});  // should push a single element {1,1}
	unless (length(aa) == 1) puts("bad 3.0");
	unless (eq(aa, { {1,1} })) puts("bad 3.1");
	push(&aa, {2,2});
	unless (eq(aa, { {1,1}, {2,2} })) puts("bad 3.2");
	push(&aa, { {3,3} });  // should push {3,3}
	unless (eq(aa, { {1,1}, {2,2}, {3,3} })) puts("bad 3.3");
	push(&aa, { {4,4},{5,5} });  // should push {4,4} and {5,5}
	unless (eq(aa, { {1,1}, {2,2}, {3,3}, {4,4}, {5,5} })) puts("bad 3.4");
	undef(aa);
	push(&aa, {1,1}, {{2,2}}, {{3,3},{4,4}}, {5,5});
	unless (eq(aa, { {1,1}, {2,2}, {3,3}, {4,4}, {5,5} })) puts("bad 3.5");

	push(&aaa[0], {1,1});  // should push a single element {1,1}
	unless (length(aaa[0]) == 1) puts("bad 3.10");
	unless (eq(aaa[0], { {1,1} })) puts("bad 3.11");
	push(&aaa[0], {2,2});
	unless (eq(aaa[0], { {1,1}, {2,2} })) puts("bad 3.12");
	push(&aaa[0], { {3,3} });  // should push {3,3}
	unless (eq(aaa[0], { {1,1}, {2,2}, {3,3} })) puts("bad 3.13");
	push(&aaa[0], { {4,4},{5,5} });  // should push {4,4} and {5,5}
	unless (eq(aaa[0], { {1,1}, {2,2}, {3,3}, {4,4}, {5,5} })) {
		puts("bad 3.14");
	}
	undef(aaa[0]);
	push(&aaa[0], {1,1}, {{2,2}}, {{3,3},{4,4}}, {5,5});
	unless (eq(aaa[0], { {1,1}, {2,2}, {3,3}, {4,4}, {5,5} })) {
		puts("bad 3.15");
	}

	/*
	 * Check that things are appended as list elements and not via
	 * string concat.
	 */

	undef(sa);
	push(&sa, "a b");
	unless (length(sa) == 1) puts("bad 4.1");
	unless (sa[0] == "a b") puts("bad 4.2");
	undef(sa);
	push(&sa, {"a b"});
	unless (length(sa) == 1) puts("bad 4.3");
	unless (sa[0] == "a b") puts("bad 4.4");

	undef(saa[0]);
	push(&saa[0], "a b");
	unless (length(saa[0]) == 1) puts("bad 5.1");
	unless (saa[0][0] == "a b") puts("bad 5.2");
	undef(saa[0]);
	push(&saa[0], {"a b"});
	unless (length(saa[0]) == 1) puts("bad 5.3");
	unless (saa[0][0] == "a b") puts("bad 5.4");
}
builtin_11_4();
} -output {}

test builtin-11.5 {check insert built-in} -body {
#lang L --line=1
void builtin_11_5()
{
	int	a[], i;
	struct {
		int	a[];
	} st;

	/* Check inserting into a plain variable, scalar args. */

	a = {};
	insert(&a, 0, 1);
	unless (eq(a, {1})) puts("bad 1.1");
	insert(&a, 0, 2);
	unless (eq(a, {2,1})) puts("bad 1.2");
	insert(&a, 0, 3, 4);
	unless (eq(a, {3,4,2,1})) puts("bad 1.3");
	insert(&a, 0, 5, 6, 7);
	unless (eq(a, {5,6,7,3,4,2,1})) puts("bad 1.4");

	/* Check inserting into a struct member (deep dive), scalar args. */

	st.a = {};
	insert(&st.a, 0, 1);
	unless (eq(st.a, {1})) puts("bad 2.1");
	insert(&st.a, 1, 2);
	unless (eq(st.a, {1,2})) puts("bad 2.2");
	insert(&st.a, 1, 3, 4);
	unless (eq(st.a, {1,3,4,2})) puts("bad 2.3");
	insert(&st.a, 0, 5, 6, 7);
	unless (eq(st.a, {5,6,7,1,3,4,2})) puts("bad 2.4");
	insert(&st.a, 2, 8);
	unless (eq(st.a, {5,6,8,7,1,3,4,2})) puts("bad 2.5");
	insert(&st.a, 0, 9);
	unless (eq(st.a, {9,5,6,8,7,1,3,4,2})) puts("bad 2.6");

	/* Check inserting into a plain variable, scalar and list args. */

	a = {};
	insert(&a, 0, 1);
	unless (eq(a, {1})) puts("bad 3.1");
	insert(&a, 0, {2});
	unless (eq(a, {2,1})) puts("bad 3.2");
	insert(&a, 0, 3, {4,5});
	unless (eq(a, {3,4,5,2,1})) puts("bad 3.3");
	insert(&a, 0, {5,6,7}, 8, {9,10});
	unless (eq(a, {5,6,7,8,9,10,3,4,5,2,1})) puts("bad 3.4 ${a}");

	/* Check with a struct member (deep dive), scalar and list args. */

	st.a = {};
	insert(&st.a, 0, 1);
	unless (eq(st.a, {1})) puts("bad 4.1");
	insert(&st.a, 0, {2});
	unless (eq(st.a, {2,1})) puts("bad 4.2");
	insert(&st.a, 0, 3, {4,5});
	unless (eq(st.a, {3,4,5,2,1})) puts("bad 4.3");
	insert(&st.a, 0, {5,6,7}, 8, {9,10});
	unless (eq(st.a, {5,6,7,8,9,10,3,4,5,2,1})) puts("bad 4.4 ${a}");

	/* Check with an expression as the index arg. */

	a = {};
	i = 0;
	insert(&a, i, 1);
	unless (eq(a, {1})) puts("bad 5.1");
	insert(&a, i, 2);
	unless (eq(a, {2,1})) puts("bad 5.2");
	insert(&a, i+1, 3);
	unless (eq(a, {2,3,1})) puts("bad 5.3");
	insert(&a, --i, 5);  // try a side effect in the index arg
	unless (eq(a, {2,3,1,5})) puts("bad 5.4");
	insert(&a, i+1, 6);
	unless (eq(a, {6,2,3,1,5})) puts("bad 5.5");
}
builtin_11_5();
} -output {}

test builtin-11.6 {check unshift built-in} -body {
#lang L --line=1
void builtin_11_6()
{
	int	a[];
	struct {
		int	a[];
	} st;

	/* Check unshifting into a plain variable, scalar args. */

	a = {};
	unshift(&a, 0);
	unless (eq(a, {0})) puts("bad 1.1");
	unshift(&a, 1);
	unless (eq(a, {1,0})) puts("bad 1.2");
	unshift(&a, 2, 3);
	unless (eq(a, {2,3,1,0})) puts("bad 1.3");
	unshift(&a, 4, 5, 6);
	unless (eq(a, {4,5,62,3,1,0})) puts("bad 1.4");

	/* Check unshifting into a struct member (deep dive), scalar args. */

	st.a = {};
	unshift(&st.a, 1);
	unless (eq(st.a, {1})) puts("bad 2.1");
	unshift(&st.a, 2);
	unless (eq(st.a, {2,1})) puts("bad 2.2");
	unshift(&st.a, 3, 4);
	unless (eq(st.a, {3,4,2,1})) puts("bad 2.3");
	unshift(&st.a, 5, 6, 7);
	unless (eq(st.a, {5,6,7,3,4,2,1})) puts("bad 2.4");
	unshift(&st.a, 8);
	unless (eq(st.a, {8,5,6,7,3,4,2,1})) puts("bad 2.5");
	unshift(&st.a, 9);
	unless (eq(st.a, {9,8,6,7,8,3,4,2,1})) puts("bad 2.6");

	/* Check unshifting into a plain variable, scalar and list args. */

	a = {};
	unshift(&a, 1);
	unless (eq(a, {1})) puts("bad 3.1");
	unshift(&a, {2});
	unless (eq(a, {2,1})) puts("bad 3.2");
	unshift(&a, 3, {4,5});
	unless (eq(a, {3,4,5,2,1})) puts("bad 3.3");
	unshift(&a, {5,6,7}, 8, {9,10});
	unless (eq(a, {5,6,7,8,9,10,3,4,5,2,1})) puts("bad 3.4 ${a}");

	/* Check with a struct member (deep dive), scalar and list args. */

	st.a = {};
	unshift(&st.a, 1);
	unless (eq(st.a, {1})) puts("bad 4.1");
	unshift(&st.a, {2});
	unless (eq(st.a, {2,1})) puts("bad 4.2");
	unshift(&st.a, 3, {4,5});
	unless (eq(st.a, {3,4,5,2,1})) puts("bad 4.3");
	unshift(&st.a, {5,6,7}, 8, {9,10});
	unless (eq(st.a, {5,6,7,8,9,10,3,4,5,2,1})) puts("bad 4.4 ${a}");
}
} -output {}


test builtin-11.7 {check shift built-in} -body {
#lang L --line=1
void builtin_11_7()
{
	int	a[];
	struct {
		int	a[];
	} st;

	a = { 1,2,3,4,5 };
	unless (shift(&a) == 1) puts("bad 1.1");
	unless (eq(a, {2,3,4,5})) puts("bad 1.2");
	unless (shift(&a) == 2) puts("bad 1.3");
	unless (eq(a, {3,4,5})) puts("bad 1.4");
	unless (shift(&a) == 3) puts("bad 1.5");
	unless (eq(a, {4,5})) puts("bad 1.6");
	unless (shift(&a) == 4) puts("bad 1.7");
	unless (eq(a, {5})) puts("bad 1.8");
	unless (shift(&a) == 5) puts("bad 1.9");
	unless (eq(a, {})) puts("bad 1.10");
	unless (defined(a)) puts("bad 1.11");
	if (defined(shift(&a))) puts("bad 1.12");
	unless (eq(a, {})) puts("bad 1.13");
	unless (defined(a)) puts("bad 1.14");

	st.a = { 1,2,3,4,5 };
	unless (shift(&st.a) == 1) puts("bad 2.1");
	unless (eq(st.a, {2,3,4,5})) puts("bad 2.2");
	unless (shift(&st.a) == 2) puts("bad 2.3");
	unless (eq(st.a, {3,4,5})) puts("bad 2.4");
	unless (shift(&st.a) == 3) puts("bad 2.5");
	unless (eq(st.a, {4,5})) puts("bad 2.6");
	unless (shift(&st.a) == 4) puts("bad 2.7");
	unless (eq(st.a, {5})) puts("bad 2.8");
	unless (shift(&st.a) == 5) puts("bad 2.9");
	unless (eq(st.a, {})) puts("bad 2.10");
	unless (defined(st.a)) puts("bad 2.11");
	if (defined(shift(&st.a))) puts("bad 2.12");
	unless (eq(st.a, {})) puts("bad 2.13");
	unless (defined(st.a)) puts("bad 2.14");
}
builtin_11_7();
} -output {}

test builtin-14 {check errors in push and pop built-ins} -body {
#lang L --line=1
int[] builtin_14_array() { return {1,2,3}; }
void builtin_14()
{
	int	i;
	string	s;

	/* The first arg has array type, but it's not an l-value. */
	push(&(builtin_14_array()), 0);
	pop(&(builtin_14_array()));

	pop(&3) + 1;	// not an array reference
	pop(&i) + 1;	// not an array reference
	pop(&s) + 1;	// not an array reference
	pop() + 1;	// bad # args
	pop(1,2) + 1;	// bad # args
	/*
	 * We add 1 above to test that the compiler does not assert
	 * due to pop() not getting a type even though there is an
	 * error.
	 */
}
} -returnCodes {error} -match regexp -result {.*8: L Error: invalid l-value in push
.*9: L Error: invalid l-value in pop
.*11: L Error: arg to pop not an array reference.*
.*12: L Error: arg to pop not an array reference.*
.*13: L Error: arg to pop not an array reference.*
.*14: L Error: incorrect # arguments to pop
.*15: L Error: incorrect # arguments to pop
}

test builtin-14.2 {check errors in insert built-in} -body {
#lang L --line=1
int[] builtin_14_2_array() { return {1,2,3}; }
void builtin_14_2()
{
	int	i, a[];
	string	s;

	/* The first arg has array type, but it's not an l-value. */
	insert(&(builtin_14_2_array()), 0, 0);

	insert(&3, 0, 0) + 1;	// 1st arg not an array reference
	insert(&i, 0, 0) + 1;	// 1st arg not an array reference
	insert(&s, 0, 0) + 1;	// 1st arg not an array reference
	insert(&a, "s", 0) + 1;	// 2nd arg not an int
	insert(&a, 1.0, 0) + 1;	// 2nd arg not an int
	insert(&a, a, 0) + 1;	// 2nd arg not an int
	insert(&a, &i, 0) + 1;	// 2nd arg not an int
	insert() + 1;		// too few args
	insert(&a, 0) + 1;	// too few args
	/*
	 * We add 1 above to test that the compiler does not assert
	 * due to insert() not getting a type even though there is an
	 * error.
	 */
}
} -returnCodes {error} -match regexp -result {.*8: L Error: invalid l-value in insert
.*10: L Error: first arg to insert not an array reference.*
.*11: L Error: first arg to insert not an array reference.*
.*12: L Error: first arg to insert not an array reference.*
.*13: L Error: second arg to insert not an int
.*14: L Error: second arg to insert not an int
.*15: L Error: second arg to insert not an int
.*16: L Error: second arg to insert not an int
.*17: L Error: too few arguments to insert
.*18: L Error: too few arguments to insert
}

test builtin-14_3 {check errors in unshift built-in} -body {
#lang L --line=1
int[] builtin_14_3_array() { return {1,2,3}; }
void builtin_14_3()
{
	int	i, a[];
	string	s;

	/* The first arg has array type, but it's not an l-value. */
	unshift(&(builtin_14_3_array()), 0);

	unshift(&3, 0) + 1;	// 1st arg not an array reference
	unshift(&i, 0) + 1;	// 1st arg not an array reference
	unshift(&s, 0) + 1;	// 1st arg not an array reference
	unshift(&a, "s") + 1;	// 2nd arg not an int
	unshift(&a, 1.0) + 1;	// 2nd arg not an int
	unshift(&a, &i) + 1;	// 2nd arg not an int
	unshift() + 1;		// too few args
	/*
	 * We add 1 above to test that the compiler does not assert
	 * due to pop() not getting a type even though there is an
	 * error.
	 */
}
} -returnCodes {error} -match regexp -result {.*8: L Error: invalid l-value in unshift
.*10: L Error: first arg to unshift not an array reference.*
.*11: L Error: first arg to unshift not an array reference.*
.*12: L Error: first arg to unshift not an array reference.*
.*13: L Error: arg #2 to unshift has type incompatible with array
.*14: L Error: arg #2 to unshift has type incompatible with array
.*15: L Error: arg #2 to unshift has type incompatible with array
.*16: L Error: too few arguments to unshift
}

test builtin-14_4 {check errors in shift built-in} -body {
#lang L --line=1
int[] builtin_14_4_array() { return {1,2,3}; }
void builtin_14_4()
{
	int	i;
	string	s;

	/* The first arg has array type, but it's not an l-value. */
	shift(&(builtin_14_array()));

	shift(&3) + 1;	// not an array reference
	shift(&i) + 1;	// not an array reference
	shift(&s) + 1;	// not an array reference
	shift() + 1;	// bad # args
	shift(1,2) + 1;	// bad # args
	/*
	 * We add 1 above to test that the compiler does not assert
	 * due to pop() not getting a type even though there is an
	 * error.
	 */
}
} -returnCodes {error} -match regexp -result {.*8: L Error: invalid l-value in shift
.*10: L Error: arg to shift not an array reference.*
.*11: L Error: arg to shift not an array reference.*
.*12: L Error: arg to shift not an array reference.*
.*13: L Error: incorrect # arguments to shift
.*14: L Error: incorrect # arguments to shift
}

test builtin-15 {check abs built-in} -body {
#lang L --line=1
void builtin_15()
{
	poly	p;

	unless (abs(1) == 1) puts("bad 1.1");
	unless (abs(0) == 0) puts("bad 1.2");
	unless (abs(-1) == 1) puts("bad 1.3");

	unless (abs(1.1) == 1.1) puts("bad 2.1");
	unless (abs(0.0) == 0.0) puts("bad 2.2");
	unless (abs(-1.1) == 1.1) puts("bad 2.3");

	p = -1;
	unless (abs(p) == 1) puts("bad 3.1");
	p = -1.1;
	unless (abs(p) == 1.1) puts("bad 3.2");
}
builtin_15();
} -output {}

test builtin-16 {check abs built-in errors} -body {
#lang L --line=1
void builtin_16()
{
	abs();
	abs(1, 1);
	abs(1.1, 1.1);
	abs("bad");
	/*
	 * This tests that the compiler does not assert due to abs()
	 * not getting a type even though the call has an error.
	 */
	abs() + 1;
}
} -returnCodes {error} -match regexp -result {.*3: L Error: incorrect # args to abs
.*4: L Error: incorrect # args to abs
.*5: L Error: incorrect # args to abs
.*6: L Error: must pass int or float to abs
}

test builtin-17 {check typeof built-in} -body {
#lang L --line=1
class builtin_17_cls {}
typedef int builtin_17_type1;
typedef builtin_17_type1 builtin_17_type2;
void builtin_17()
{
	int		i;
	string		s;
	poly		p;
	widget		w;
	int		a[];
	string		h{string};
	struct { int i; }	str;
	builtin_17_type1	v1;
	builtin_17_type2	v2;
	builtin_17_cls		c;

	unless (typeof(i) eq "int") puts("bad 1");
	unless (typeof(s) eq "string") puts("bad 2");
	unless (typeof(p) eq "poly") puts("bad 3");
	unless (typeof(w) eq "widget") puts("bad 4");
	unless (typeof(a) eq "array") puts("bad 5");
	unless (typeof(h) eq "hash") puts("bad 6");
	unless (typeof(str) eq "struct") puts("bad 7");
	unless (typeof(c) eq "builtin_17_cls") puts("bad 8");
	unless (typeof(v1) eq "builtin_17_type1") puts("bad 9");
	unless (typeof(v2) eq "builtin_17_type2") puts("bad 10");
	unless (typeof(builtin_17) eq "function") puts("bad 11");
}
builtin_17();
} -output {}

test builtin-18 {check typeof built-in errors} -body {
#lang L --line=1 -nowarn
void builtin_18()
{
	int	i = 0;

	typeof("bad");
	typeof(i+0);
	typeof((string)i);
}
} -returnCodes {error} -match regexp -result {.*5: L Error: argument to typeof\(\) not a variable
.*6: L Error: argument to typeof\(\) not a variable
.*7: L Error: argument to typeof\(\) not a variable
}

test builtin-19.1 {check min/max built-ins} -body {
#lang L --line=1
void builtin_19_1()
{
	unless (min(-1, 1) == -1) puts("bad 1");
	unless (min(2, 1) == 1) puts("bad 2");

	unless (min(-1.0, 1.0) == -1.0) puts("bad 3");
	unless (min(2.0, 1.0) == 1.0) puts("bad 4");
}
builtin_19_1();
} -output {}

test builtin-19.2 {check min/max built-in errors} -body {
#lang L --line=1
void builtin_19_2()
{
	min();
	min(1);
	min(1,2,3);
	max();
	max(1);
	max(1,2,3);
	min("bad","bad");
	max("bad","bad");
}
} -returnCodes {error} -match regexp -result {.*3: L Error: incorrect # args to min
.*4: L Error: incorrect # args to min
.*5: L Error: incorrect # args to min
.*6: L Error: incorrect # args to max
.*7: L Error: incorrect # args to max
.*8: L Error: incorrect # args to max
.*9: L Error: expected type int or float but got string in min/max
.*10: L Error: expected type int or float but got string in min/max
}

test builtin-20 {check (expand) operator in built-ins} -body {
#lang L --line=1
void builtin_20()
{
	string	res[];
	string  sa[] = { "123", "3", "987" };
	string  opts[] = { "-decreasing", "-integer" };

	res = sort((expand)opts, sa);
	unless (eq(res, {"3","123","987"})) puts("bad 1.1");
}
builtin_20();
} -returnCodes {error} -match regexp -result {.*7: L Error: \(expand\) illegal with this function
}

test line-file-1 {test __LINE__ and __FILE__} -body {
#lang L --line=1
void line_file_1()
{
	unless(basename(__FILE__) eq "l-core.test") puts("bad 1.1");
	unless(__LINE__ == 4) puts("bad 1.2");
	unless(__LINE__ == 5) puts("bad 1.3");
	unless(__LINE__ == 6) puts("bad 1.4");
	unless(__FUNC__ eq "line_file_1") puts("bad 1.5");
}
line_file_1();
} -output {}

test line-file-2 {test __LINE__, __FILE__, and __FUNC__ errors} -body {
#lang L --line=1
void line_file_2_s(string &s) { s = "bad"; }
void line_file_2_i(int &i) { i = 1; }
void line_file_2()
{
	__FILE__ = "bad";
	__LINE__ = 1;
	__FUNC__ = "bad";
	line_file_2_s(&__FILE__);
	line_file_2_i(&__LINE__);
	line_file_2_i(&__FUNC__);
}
} -returnCodes {error} -match regexp -result {.*5: L Error: invalid l-value in assignment
.*6: L Error: invalid l-value in assignment
.*7: L Error: invalid l-value in assignment
.*8: L Error: illegal operand to &
.*9: L Error: illegal operand to &
.*10: L Error: illegal operand to &
}

test line-file-3 {test __FUNC__} -body {
#lang L --line=1
unless (__FUNC__ =~ /\d+%l_toplevel/) puts("bad 10.1");
void line_file_3b()
{
	unless (__FUNC__ eq "line_file_3b") puts("bad 1");
}
void line_file_3()
{
	unless (__FUNC__ eq "line_file_3") puts("bad 2");
	line_file_3b();
}
unless (__FUNC__ =~ /\d+%l_toplevel/) puts("bad 10.2");
line_file_3();
} -output {}

test lregex-1 {test a trivial regex} -body {
#lang L --line=1
int lregex_1(void) {
	if ("x" =~ /x+/) { return(1); } else { return(0); }
}
#lang tcl
lregex_1;
} -result {1}

test class-1.1 {test basic class functionality} -body {
#lang L --line=1
int	class_1_1_inits = 0;
int	class_1_1_frees = 0;
int	class_1_1_foos  = 0;
int	class_1_1_privs = 0;
class class_1_1
{
	public	int cvar1 = 123;
	public	int cvar2 = cvar1 * 2;
	instance {
		public	string inst = "initial";
	}
	private void priv();
	constructor class_1_1_init(string s)
	{
		unless (inst eq "initial") puts("bad c1");
		inst = s;
		++class_1_1_inits;
	}
	destructor class_1_1_free(class_1_1 self)
	{
		++class_1_1_frees;
	}
	void class_1_1_foo(class_1_1 self)
	{
		++class_1_1_foos;
		priv();
	}
	string class_1_1_inst(class_1_1 self)
	{
		return (inst);
	}
	int class_1_1_cvar1(class_1_1 self)
	{
		return (cvar1);
	}
	int class_1_1_cvar2(class_1_1 self)
	{
		return (cvar2);
	}
	private void priv()
	{
		++class_1_1_privs;
	}
}
void class_1_1_main()
{
	class_1_1 o = class_1_1_init("constructed");

	unless (class_1_1_inst(o) eq "constructed") puts("bad 1.1");
	unless (class_1_1_cvar1(o) == 123) puts("bad 1.2");
	unless (class_1_1_cvar2(o) == 246) puts("bad 1.3");
	unless (class_1_1_inits == 1) puts("bad 1.4");
	unless (class_1_1_frees == 0) puts("bad 1.5");
	unless (class_1_1_foos  == 0) puts("bad 1.6");
	unless (class_1_1_privs == 0) puts("bad 1.7");

	class_1_1_foo(o);
	unless (class_1_1_inits == 1) puts("bad 2.1");
	unless (class_1_1_frees == 0) puts("bad 2.2");
	unless (class_1_1_foos  == 1) puts("bad 2.3");
	unless (class_1_1_privs == 1) puts("bad 2.4");

	class_1_1_foo(o);
	unless (class_1_1_inits == 1) puts("bad 3.1");
	unless (class_1_1_frees == 0) puts("bad 3.2");
	unless (class_1_1_foos  == 2) puts("bad 3.3");
	unless (class_1_1_privs == 2) puts("bad 3.4");

	unless (class_1_1_inst(o) eq "constructed") puts("bad 4.1");
	unless (class_1_1_inits == 1) puts("bad 4.1");
	unless (class_1_1_frees == 0) puts("bad 4.2");
	unless (class_1_1_foos  == 2) puts("bad 4.3");
	unless (class_1_1_privs == 2) puts("bad 4.4");

	class_1_1_free(o);
	unless (class_1_1_inits == 1) puts("bad 5.1");
	unless (class_1_1_frees == 1) puts("bad 5.2");
	unless (class_1_1_foos  == 2) puts("bad 5.3");
	unless (class_1_1_privs == 2) puts("bad 5.4");
}
class_1_1_main();
} -output {}

test class-1.2 {test multiple object instances} -body {
#lang L --line=1
class class_1_2
{
	instance {
		public	int n;
	}
	constructor class_1_2_init(int i) { n = i; }
	destructor class_1_2_free(class_1_2 self) {}
	int class_1_2_inst(class_1_2 self) { return (n); }
}
void class_1_2_main()
{
	int		i, j;
	class_1_2	o[];

	for (i = 0; i < 10; ++i) {
		o[i] = class_1_2_init(i);
		unless (class_1_2_inst(o[i]) == i) printf("bad 1 i=%d\n", i);
	}
	for (i = 0; i < 10; ++i) {
		unless (class_1_2_inst(o[i]) == i) printf("bad 2 i=%d\n", i);
	}
	for (i = 0; i < 10; ++i) {
		class_1_2_free(o[i]);
		for (j = i+1; j < 10; ++j) {
			unless (class_1_2_inst(o[j]) == j) {
				printf("bad 3 j=%d\n", j);
			}
		}
	}
}
class_1_2_main();
} -output {}

test class-1.3 {test class variables} -body {
#lang L --line=1
class class_1_3
{
	public	string cls_var = "first";
	constructor class_1_3_init() {}
	destructor class_1_3_free(class_1_3 self) {}
	void class_1_3_set(class_1_3 self, string s)
	{
		cls_var = s;
	}
	string class_1_3_get(class_1_3 self)
	{
		return (cls_var);
	}
}
void class_1_3_main()
{
	int		i, j;
	class_1_3	o[];

	/* As we init objects, cls_var should not change. */
	for (i = 0; i < 10; ++i) {
		o[i] = class_1_3_init();
		for (j = 0; j <= i; ++j) {
			unless (class_1_3_get(o[j]) eq "first") {
				printf("bad 1 j=%d\n", j);
			}
		}
	}
	/* All objects should see the change to "second". */
	class_1_3_set(o[5], "second");
	for (j = 0; i < 10; ++i) {
		unless (class_1_3_get(o[i]) eq "second") {
			printf("bad 2 i=%d\n", i);
		}
	}
	/* Deleting one object shouldn't mess up cls_var. */
	class_1_3_free(o[5]);
	for (j = 0; i < 10; ++i) {
		if (i == 5) continue;
		unless (class_1_3_get(o[i]) eq "second") {
			printf("bad 2 i=%d\n", i);
		}
	}
}
class_1_3_main();
} -output {}

test class-1.4 {test no class instance variables} -body {
#lang L --line=1
class class_1_4
{
	public	int cvar = 123;
	constructor class_1_4_new()
	{
		unless (cvar == 123) puts ("bad c1");
	}
	destructor class_1_4_delete(class_1_4 self)
	{
		unless (cvar == 123) puts ("bad d1");
	}
}
void class_1_4_main()
{
	class_1_4 o = class_1_4_new();
	class_1_4_delete(o);
}
class_1_4_main();
} -output {}

test class-1.5 {test no class variables} -body {
#lang L --line=1
class class_1_5
{
	instance {
		public	int inst = 123;
	}
	constructor class_1_5_new()
	{
		unless (inst == 123) puts ("bad c1");
	}
	destructor class_1_5_delete(class_1_5 self)
	{
		unless (inst == 123) puts ("bad d1");
	}
}
void class_1_5_main()
{
	class_1_5 o = class_1_5_new();
	class_1_5_delete(o);
}
class_1_5_main();
} -output {}

test class-1.6 {test "->" as member variable selection} -body {
#lang L --line=1
class class_1_6
{
	public	string cvar = "cvar";
	instance {
		public	string ivar = "ivar";
	}
}
void class_1_6_main()
{
	/* Check that -> works ("." is not allowed). */

	class_1_6 o = class_1_6_new();

	unless (class_1_6->cvar eq "cvar") puts("bad 1.1");
	unless (o->ivar eq "ivar") puts("bad 2.1");

	class_1_6_delete(o);
}
class_1_6_main();
} -output {}

test class-1.7 {test indexing errors on class instance variables} -body {
#lang L --line=1
class class_1_7
{
	public	string cvar = "cvar";
	instance {
		public	string ivar = "ivar";
	}
}
void class_1_7_main()
{
	/* Check that any index other than -> is caught as an error. */

	class_1_7 o = class_1_7_new();

	o.ivar;
	o{"bad"};
	o[0];
}
} -returnCodes {error} -match regexp -result {.*14: L Error: must access object only with ->
.*15: L Error: must access object only with ->
.*16: L Error: must access object only with ->
}

test class-1.8 {check calling private member functions} -body {
#lang L --line=1
/*
 * Check that private member functions can be called from the
 * constructor and destructor, whether they are declared before or
 * after the call site.
 */
private int cnt1 = 0;
private int cnt2 = 0;
class class_1_8
{
	private void p1() { ++cnt1; }
	constructor class_1_8_new()
	{
		p1();
		p2();
	}
	destructor class_1_8_delete(class_1_8 self)
	{
		p1();
		p2();
	}
	public void class_1_8_foo(class_1_8 self)
	{
		p1();
		p2();
	}
	private void p2() { ++cnt2; }
}
void class_1_8_main()
{
	class_1_8 o = class_1_8_new();
	unless (cnt1 == 1) puts("bad 1.1");
	unless (cnt2 == 1) puts("bad 1.2");
	class_1_8_foo(o);
	unless (cnt1 == 2) puts("bad 2.1");
	unless (cnt2 == 2) puts("bad 2.2");
	class_1_8_delete(o);
	unless (cnt1 == 3) puts("bad 3.1");
	unless (cnt2 == 3) puts("bad 3.2");
}
class_1_8_main();
} -output {}

test class-1.9 {check calling class member fns before they are declared} -body {
#lang L --line=1
/*
 * Check the error cases to make sure that the proto is being
 * processed before the call site even though it comes after.
 */
class class_1_9
{
	void class_1_9_f1(class_1_9 self)
	{
		class_1_9 o = class_1_9_new(123);  // error -- too many args
		class_1_9_f2(o, 123);  // error
	}
	constructor class_1_9_new()
	{
		class_1_9_f2(self, 123);  // error
		class_1_9_free(self, 123);  // error
	}
	destructor class_1_9_free(class_1_9 self)
	{
		class_1_9_f2(self, 123);  // error
	}
	void class_1_9_f2(class_1_9 self)
	{
	}
}
} -returnCodes {error} -match regexp -result {.*14: L Error: too many arguments for function class_1_9_f2
.*15: L Error: too many arguments for function class_1_9_free
.*19: L Error: too many arguments for function class_1_9_f2
.*9: L Error: too many arguments for function class_1_9_new
.*10: L Error: too many arguments for function class_1_9_f2
}

test class-1.10 {check forward class declarations} -body {
#lang L --line=1
class class_1_10a
{
	constructor class_1_10a_new() {}
}
class class_1_10a;  // ok -- class_1_10a already declared
class class_1_10a;  // ok -- class_1_10a already declared
class class_1_10b;  // forward declaration
private class_1_10a obj_a;
private class_1_10b obj_b;
class class_1_10b
{
	constructor class_1_10b_new() {}
}
void class_1_10_main()
{
	obj_a = class_1_10a_new();
	obj_b = class_1_10b_new();
}
class_1_10_main();
} -output {}

test class-1.11 {check forward class declaration errors} -body {
#lang L --line=1
class class_1_11a {}
class class_1_11a {}  // error -- already declared
typedef int class_1_11_t;
class class_1_11_t;  // error -- not a class type
} -returnCodes {error} -match regexp -result {.*2: L Error: redeclaration of class_1_11a
.*4: L Error: class_1_11_t not a class type
}

test class-1.12 {check returns from class destructor} -body {
#lang L --line=1
/*
 * Check that an explicit return from with the class destructor does
 * not bypass the code to delete the namespace instance.
 */
class class_1_12 {
	destructor class_1_12_delete(class_1_12 self)
	{
		return;
	}
}
void class_1_12_main()
{
	string		parent;
	class_1_12	obj;

	/* Creating a new object creates a new namespace under ::L. */
	obj = class_1_12_new();
	if (::catch("set parent [::namespace parent $obj]")) puts("bad 1");
	unless (parent eq "::L") puts("bad 2");

	/* After this delete, the namepsace should be gone. */
	class_1_12_delete(obj);
	unless (::catch("set parent [::namespace parent $obj]")) puts("bad 3");
}
class_1_12_main();
} -output {}

test class-2.1 {check missing class constructor} -body {
#lang L --line=1
class class_2_1
{
	instance {
		public	int inst = 123;
	}
	destructor class_2_1_delete(class_2_1 self)
	{
		unless (inst == 123) puts("bad 1");
	}
}
void class_2_1_main()
{
	class_2_1 o = class_2_1_new();
	class_2_1_delete(o);
}
class_2_1_main();
} -output {}

test class-2.2 {check class missing destructor} -body {
#lang L --line=1
class class_2_2
{
	instance {
		public	int inst = 123;
	}
	constructor class_2_2_new()
	{
		unless (inst == 123) puts("bad 1");
	}
}
void class_2_2_main()
{
	class_2_2 o = class_2_2_new();
	class_2_2_delete(o);
}
class_2_2_main();
} -output {}

test class-2.2.1 {check class missing constructor and destructor} -body {
#lang L --line=1
class class_2_2_1
{
	instance {
		public	int inst = 123;
	}
	int class_2_2_1_get(class_2_2_1 self) { return inst; }
}
void class_2_2_1_main()
{
	class_2_2_1 o = class_2_2_1_new();
	unless (class_2_2_1_get(o) == 123) puts("bad 1");
	class_2_2_1_delete(o);
}
class_2_2_1_main();
} -output {}

test class-2.3 {check multiple class constructors and destructors} -body {
#lang L --line=1
class class_2_3
{
	public	int n = 0;
	instance {
		public	int inst = n + 100;
	}
	constructor class_2_3_new1()
	{
		++n;
		return (self);
	}
	constructor class_2_3_new2(int i)
	{
		n += i;
		return (self);
	}
	destructor class_2_3_delete1(class_2_3 self)
	{
		--n;
	}
	destructor class_2_3_delete2(class_2_3 self, int i)
	{
		n -= i;
	}
}
void class_2_3_main()
{
	class_2_3	o1, o2;

	o1 = class_2_3_new1();
	unless (class_2_3->n == 1) puts("bad 1.1");
	unless (o1->inst == 100) puts("bad 1.2");
	o2 = class_2_3_new2(10);
	unless (class_2_3->n == 11) puts("bad 2.1");
	unless (o2->inst == 101) puts("bad 2.2");
	class_2_3_delete1(o2);
	unless (class_2_3->n == 10) puts("bad 3.1");
	class_2_3_delete2(o1, 10);
	unless (class_2_3->n == 0) puts("bad 4.1");
}
class_2_3_main();
} -output {}

test class-2.5 {check missing self argument in class destructor 1} -body {
#lang L --line=1
class class_2_5
{
	constructor class_2_5_init() {}
	destructor class_2_5_free() {}
}
} -returnCodes {error} -match regexp -result {.*4: L Error: class public member function lacks 'self' as first arg
}

test class-2.6 {check missing self argument in class destructor 2} -body {
#lang L --line=1 -nowarn
class class_2_6
{
	constructor class_2_6_init() {}
	destructor class_2_6_free(string bad) {}
}
} -returnCodes {error} -match regexp -result {.*4: L Error: class public member function lacks 'self' as first arg
}

test class-2.7 {check missing self argument in class destructor 3} -body {
#lang L --line=1 -nowarn
class class_2_7
{
	constructor class_2_7_init() {}
	destructor class_2_7_free(string bad, class_2_7 self) {}
}
} -returnCodes {error} -match regexp -result {.*4: L Error: class public member function lacks 'self' as first arg
}

test class-2.8 {check missing self argument in public class member fn} -body {
#lang L --line=1 -nowarn
class class_2_8
{
	constructor class_2_8_init() {}
	destructor class_2_8_free(class_2_8 self) {}
	void class_2_8_foo1() {}
	void class_2_8_foo2(string bad) {}
	void class_2_8_foo3(string bad, class_2_8 self) {}
}
} -returnCodes {error} -match regexp -result {.*5: L Error: class public member function lacks 'self' as first arg
.*6: L Error: class public member function lacks 'self' as first arg
.*7: L Error: class public member function lacks 'self' as first arg
}

test class-2.9 {check use of self argument in class member fn} -body {
#lang L --line=1
class class_2_9
{
	constructor class_2_9_init() {}
	destructor class_2_9_free(class_2_9 self) {}
	void class_2_9_foo1(class_2_9 self) {}
	void class_2_9_foo2(class_2_9 self, class_2_9 self) {}
	void class_2_9_foo3(class_2_9 self, string self) {}
}
} -returnCodes {error} -match regexp -result {.*6: L Error: multiple declaration of local self
.*7: L Error: multiple declaration of local self
}

test class-2.10 {check declaration of local named self in class} -body {
#lang L --line=1
class class_2_10
{
	constructor class_2_10_init()
	{
		int	self;
	}
	destructor class_2_10_free(class_2_10 self)
	{
		class_2_10 self;
	}
	void class_2_10_foo(class_2_10 self)
	{
		int	self;
	}
	private void class_2_10_priv()
	{
		int	self;
	}
}
} -returnCodes {error} -match regexp -result {.*5: L Error: multiple declaration.*
.*9: L Error: multiple declaration.*
.*13: L Error: multiple declaration.*
.*17: L Error: multiple declaration.*
}

test class-2.11 {check return stmt in class destructor 1} -body {
#lang L --line=1
class class_2_11
{
	destructor class_2_11_delete(class_2_11 self)
	{
		return;  // legal -- return type of void
	}
}
void class_2_11_main()
{
	class_2_11 o = class_2_11_new();
	class_2_11_delete(o);
}
class_2_11_main();
} -output {}

test class-2.12 {check return stmt in class destructor 2} -body {
#lang L --line=1
class class_2_12
{
	destructor class_2_12_delete(class_2_12 self)
	{
		return ("bad");  // err -- return type is void
	}
}
} -returnCodes {error} -match regexp -result {.*5: L Error: void function cannot return value
}

test class-2.12.1 {check return stmt in class constructor 1} -body {
#lang L --line=1
class class_2_12_1
{
	instance { public int inst = 123; }
	constructor class_2_12_1_new()
	{
		return (self);
	}
	int class_2_12_1_get(class_2_12_1 self) { return (inst); }
}
void class_2_12_1_main()
{
	class_2_12_1 o = class_2_12_1_new();
	unless (class_2_12_1_get(o) == 123) puts("bad 1");
	class_2_12_1_delete(o);
}
class_2_12_1_main();
} -output {}

test class-2.12.2 {check return stmt in class constructor 2} -body {
#lang L --line=1
class class_2_12_2
{
	constructor class_2_12_2_new()
	{
		return ("bad");  // err -- bad return type
	}
}
} -returnCodes {error} -match regexp -result {.*5: L Error: incompatible return type
}

test class-2.13 {check name clash with class constructor 1} -body {
#lang L --line=1
class class_2_13
{
	constructor class_2_13_new() {}
	void class_2_13_new(class_2_13 self) {}  // err
	private void class_2_13_new(class_2_13 self) {}  // err
}
} -returnCodes {error} -match regexp -result {.*3: L Error: does not match other declaration of class_2_13_new
.*5: L Error: function class_2_13_new already declared
}

test class-2.14 {check name clash with class constructor 2} -body {
#lang L --line=1
class class_2_14
{
	void class_2_14_new(class_2_14 self) {}  // err
	private void class_2_14_new(class_2_14 self) {}  // err
}
} -returnCodes {error} -match regexp -result {.*1: L Error: does not match other declaration of class_2_14_new
.*4: L Error: function class_2_14_new already declared
}

test class-2.15 {check name clash with class destructor 1} -body {
#lang L --line=1
class class_2_15
{
	destructor class_2_15_delete(class_2_15 self) {}
	void class_2_15_delete(class_2_15 self) {}  // err
	private void class_2_15_delete(class_2_15 self) {}  // err
}
} -returnCodes {error} -match regexp -result {.*4: L Error: function class_2_15_delete already declared
.*5: L Error: function class_2_15_delete already declared
}

test class-2.16 {check name clash with class destructor 2} -body {
#lang L --line=1
class class_2_16
{
	void class_2_16_delete(class_2_16 self) {}  // err
	private void class_2_16_delete(class_2_16 self) {}  // err
}
} -returnCodes {error} -match regexp -result {.*3: L Error: function class_2_16_delete already declared
.*4: L Error: function class_2_16_delete already declared
}

test class-2.17 {check illegal self parameter in class constructor 1} -body {
#lang L --line=1
class class_2_17
{
	constructor class_2_17_new(class_2_17 self) {}
}
} -returnCodes {error} -match regexp -result {.*3: L Error: 'self' parameter illegal in class constructor
}

test class-2.18 {check illegal self parameter in class constructor 2} -body {
#lang L --line=1 -nowarn
class class_2_18
{
	constructor class_2_18_new(int a, class_2_17 self) {}
}
} -returnCodes {error} -match regexp -result {.*3: L Error: 'self' parameter illegal in class constructor
}

test class-2.20 {check class public member fn with arg without name} -body {
#lang L --line=1 -nowarn
class class_2_20
{
	/*
	 * This is syntactically legal and the compiler should check
	 * for this error.
	 */
	public void class_2_20_foo(class_2_20) {}
}
} -returnCodes {error} -match regexp -result {.*7: L Error: class public member function lacks 'self' as first arg
}

test class-2.21 {check class member function use before declare} -body {
#lang L --line=1
class class_2_21
{
	public int class_2_21_foo(class_2_21 self, int arg)
	{
		return (priv(arg) + class_2_21_pub(self, arg));
	}
	private int priv(int arg)
	{
		return (arg);
	}
	public int class_2_21_pub(class_2_21 self, int arg)
	{
		return (-arg);
	}
}
void class_2_21_main()
{
	class_2_21 o;

	o = class_2_21_new();
	unless (class_2_21_foo(o, 13) == 0) puts("bad 1");
}
class_2_21_main();
} -output {}

test class-2.22 {check self in private member function} -body {
#lang L --line=1
class class_2_22 {
	constructor class_2_22_init() {
		some_method(self);
	}
	private void some_method(class_2_22 self) {}
	private void some_method2(int ok, class_2_22 self) {}
}
} -returnCodes {error} -match regexp -result {.*5: L Error: 'self' parameter illegal in private function
.*6: L Error: 'self' parameter illegal in private function
}

test class-3.1 {check scoping of class vars and class instance vars 1} -body {
#lang L --line=1
class class_3_1
{
	/*
	 * Class variables and instance variables should both be at
	 * class scope, so a name clash should be an error.  Note that
	 * because the instance var always get compiled first, we
	 * don't check for line #'s in the error messages.
	 */
	instance {
		public	int x;
	}
	public	int x;
	private	int x;
	public	int x;
	constructor class_3_1_init() {}
	destructor class_3_1_free(class_3_1 self) {}
}
} -returnCodes {error} -match regexp -result {.*: L Error: multiple declaration of x
.*: L Error: multiple declaration of x
.*: L Error: multiple declaration of x
}

test class-3.2 {check scoping of class vars and class instance vars 2} -body {
#lang L --line=1
class class_3_2
{
	/*
	 * Like the class_3_1 test but with multiple instance declarations.
	 * Note that because the instance var always get compiled
	 * first, we don't check for line #'s in the error messages.
	 */
	instance {
		public	int x;
		private	int x;
		public	int x;
	}
	public	int x;
	constructor class_3_2_init() {}
	destructor class_3_2_free(class_3_2 self) {}
}
} -returnCodes {error} -match regexp -result {.*: L Error: multiple declaration of x
.*: L Error: multiple declaration of x
.*: L Error: multiple declaration of x
}

test class-3.3 {check empty class instance variable section} -body {
#lang L --line=1
class class_3_3
{
	instance {}
}
} -result {}

test class-3.3.1 {check completely empty class declaration} -body {
#lang L --line=1
class class_3_3_1 {}
void class_3_3_1_main()
{
	class_3_3_1 o = class_3_3_1_new();
	class_3_3_1_delete(o);
}
class_3_3_1_main();
} -output {}

test class-3.4 {check scoping of class vars and class instance vars 4} -body {
#lang L --line=1
class class_3_4
{
	/*
	 * Like the class_3_3 test but with var decls in the reverse order.
	 * Note that because the instance var always get compiled first,
	 * we don't check for line #'s in the error messages.
	 */
	public	int x;
	private	int x;
	instance {
		public	int x;
		private	int x;
	}
	constructor class_3_4_init() {}
	destructor class_3_4_free(class_3_4 self) {}
}
} -returnCodes {error} -match regexp -result {.*: L Error: multiple declaration of x
.*: L Error: multiple declaration of x
.*: L Error: multiple declaration of x
}

test class-3.5 {check scoping of class vars and class instance vars 5} -body {
#lang L --line=1
class class_3_5
{
	/*
	 * Like the class_3_2 test but with private and public function
	 * declarations of the same name as the variables.  Note that
	 * because the instance var always get compiled first, we
	 * don't check for all line #'s in the error messages.
	 */
	instance {
		public	int class_3_5_x;
		public	int class_3_5_x;  // err -- multiply declared
	}
	public	int class_3_5_x;  // err -- multiply declared
	public	int class_3_5_x;  // err -- multiply declared
	private void class_3_5_x() {}  // err -- already declared as a variable
	void class_3_5_x() {}  // err -- already declared as a variable
	public void class_3_5_x() {}  // err -- already declared as a variable
	constructor class_3_5_init() {}
	destructor class_3_5_free(class_3_5 self) {}
}
} -returnCodes {error} -match regexp -result {.*: L Error: multiple declaration of class_3_5_x
.*: L Error: multiple declaration of class_3_5_x
.*: L Error: multiple declaration of class_3_5_x
.*15: L Error: class_3_5_x already declared as a variable
.*16: L Error: class_3_5_x already declared as a variable
.*17: L Error: class_3_5_x already declared as a variable
}

test class-3.6 {check scoping of class vars and class instance vars 6} -body {
#lang L --line=1
class class_3_6
{
	/*
	 * Like the class_3_5 test but with only a public function
	 * declaration of the same name as the variables.  Note that
	 * because the instance var always get compiled first, we
	 * don't check for all line #'s in the error messages.
	 */
	instance {
		public	int class_3_6_x;
		public	int class_3_6_x;  // err -- multiply declared
	}
	public	int class_3_6_x;  // err -- multiply declared
	public	int class_3_6_x;  // err -- multiply declared
	void class_3_6_x() {}  // err -- already declared as a variable
	constructor class_3_6_init() {}
	destructor class_3_6_free(class_3_6 self) {}
}
} -returnCodes {error} -match regexp -result {.*: L Error: multiple declaration of class_3_6_x
.*: L Error: multiple declaration of class_3_6_x
.*: L Error: multiple declaration of class_3_6_x
.*15: L Error: class_3_6_x already declared as a variable
}

test class-3.7 {check variable visibility in class member functions} -body {
#lang L --line=1
/*
 * Ensure class and instance variables are visible and work
 * inside of all class member functions.
 */
class class_3_7
{
	public	string publ_cvar = "publ_cvar";
	private	string priv_cvar = "priv_cvar";
	instance {
		public	string publ_ivar = "publ_ivar";
		private	string priv_ivar = "priv_ivar";
	}
	constructor class_3_7_init()
	{
		unless (publ_cvar eq "publ_cvar") puts("bad c1");
		unless (priv_cvar eq "priv_cvar") puts("bad c2");
		unless (publ_cvar eq "publ_cvar") puts("bad c3");
		unless (priv_ivar eq "priv_ivar") puts("bad c4");
	}
	destructor class_3_7_free(class_3_7 self)
	{
		unless (publ_cvar eq "publ_cvar") puts("bad d1");
		unless (priv_cvar eq "priv_cvar") puts("bad d2");
		unless (publ_ivar eq "publ_ivar") puts("bad d3");
		unless (priv_ivar eq "priv_ivar") puts("bad d4");
	}
	private void priv()
	{
		unless (publ_cvar eq "publ_cvar") puts("bad p1");
		unless (priv_cvar eq "priv_cvar") puts("bad p2");
		unless (publ_ivar eq "publ_ivar") puts("bad p3");
		unless (priv_ivar eq "priv_ivar") puts("bad p4");
	}
	void class_3_7_foo(class_3_7 self)
	{
		unless (publ_cvar eq "publ_cvar") puts("bad f1");
		unless (priv_cvar eq "priv_cvar") puts("bad f2");
		unless (publ_ivar eq "publ_ivar") puts("bad f3");
		unless (priv_ivar eq "priv_ivar") puts("bad f4");
		priv();
	}
}
void class_3_7_main()
{
	class_3_7 o = class_3_7_init();
	class_3_7_foo(o);
	class_3_7_free(o);
}
class_3_7_main();
} -output {}

test class-3.8 {check missing public/private qualifiers on class vars} -body {
#lang L --line=1
class class_3_8
{
	int	bad1, bad2;
	int	bad3;
	instance {
		int	ibad1, ibad2;
		int	ibad3;
	}
}
} -returnCodes {error} -match regexp -result {.*3: L Error: class variable bad1 not declared public or private
.*3: L Error: class variable bad2 not declared public or private
.*4: L Error: class variable bad3 not declared public or private
.*6: L Error: class instance variable ibad1 not declared public or private
.*6: L Error: class instance variable ibad2 not declared public or private
.*7: L Error: class instance variable ibad3 not declared public or private
}

test class-3.9 {check expressions in class and instance variable intializers} -body {
#lang L --line=1
class class_3_9
{
	/*
	 * These initializers check that the declarations get compiled
	 * top-to-bottom and left-to-right.
	 */
	private	int c1 = 1;
	private	int c2 = c1 * 2, c3 = c2 + 3;
	instance {
		/* These get evaluated when the constructor runs. */
		private	int i1 = c1;
		private	int i2 = c2 * 2, i3 = i2 + 3;
	}
	constructor class_3_9_new()
	{
		unless (c1 == 1) puts("bad c1");
		unless (c2 == (c1 * 2)) puts("bad c2");
		unless (c3 == (c2 + 3)) puts("bad c3");
		unless (i1 == c1) puts("bad c4");
		unless (i2 == (c2 * 2)) puts("bad c5");
		unless (i3 == (i2 + 3)) puts("bad c6");
	}
}
void class_3_9_main()
{
	class_3_9 o = class_3_9_new();
	class_3_9_delete(o);
}
class_3_9_main();
} -output {}

test class-3.10 {check dereferncing struct type name like a class name} -body {
#lang L --line=1
/*
 * This used to assert: declare a typedef for a struct and then
 * use the struct name like a class name to dereference a class
 * variable.
 */
typedef struct {
	int	x;
} class_3_10_var;
void class_3_10_main()
{
	class_3_10_var->x;
}
class_3_10_main();
} -returnCodes {error} -match regexp -result {.*11: L Error: can dereference only class types
}

test class-4.1 {check scoping of private names in classes} -body {
#lang L --line=1
/*
 * Check that per-class variables are defined in the class scope,
 * meaning that two classes can have the same variable names and the
 * same names as global variables.
 */
int class_4_1_global_var  = 100;
int class_4_1_global_var2 = 101;
void class_4_1_global_func() {}
class class_4_1_1
{
	public	int class_4_1_global_var = 411;  // OK -- shadows the global
	instance {
		public	int class_4_1_global_var2 = 811;  // also OK
	}

	constructor class_4_1_1_init() {}
	destructor class_4_1_1_free(class_4_1_1 self) {}
	private int priv() { return (class_4_1_global_var); }
	int class_4_1_1_get(class_4_1_1 self)
	{
		unless (class_4_1_global_var2 == 811) puts("bad c1");
		return (priv());
	}
}
class class_4_1_2
{
	public	int class_4_1_global_var = 412;  // OK -- shadows the global
	instance {
		public	int class_4_1_global_var2 = 812;  // also OK
	}

	constructor class_4_1_2_init() {}
	destructor class_4_1_2_free(class_4_1_2 self) {}
	private int priv() { return (class_4_1_global_var); }
	int class_4_1_2_get(class_4_1_2 self)
	{
		unless (class_4_1_global_var2 == 812) puts("bad c2");
		return (priv());
	}
}
void class_4_1()
{
	class_4_1_1	o411 = class_4_1_1_init();
	class_4_1_2	o412 = class_4_1_2_init();

	unless (class_4_1_global_var == 100) puts("bad 1");
	unless (class_4_1_1_get(o411) == 411) puts("bad 2");
	unless (class_4_1_2_get(o412) == 412) puts("bad 3");
	unless (class_4_1_global_var == 100) puts("bad 4");
}
class_4_1();
} -output {}

test class-4.2 {check typedef and struct type scoping in classes 1} -body {
#lang L --line=1
/*
 * Check that typedef and struct names declared inside a class get
 * defined at the global scope, not at the class scope.  This test
 * checks that a re-declaration of a global type name inside class
 * scope is an error.
 */
typedef int class_4_2_type;
struct class_4_2_struct {
	int	i;
	string	s;
};
class class_4_2
{
	public	class_4_2_type 	i;
	public	struct class_4_2_struct st;

	typedef string class_4_2_type;	// err -- already defined
	struct class_4_2_struct {	// err -- already defined
		int	a[];
	};

	constructor class_4_2_init() {}
	destructor class_4_2_free(class_4_2_1 self) {}
}
} -returnCodes {error} -match regexp -result {.*17: L Error: Cannot redefine type class_4_2_type
.*19: L Error: multiple declaration of struct class_4_2_struct
}

test class-4.3 {check typedef and struct type scoping in classes 2} -body {
#lang L --line=1 -nowarn
/*
 * Check that typedef and struct names declared inside a class get
 * defined at the global scope, not at the class scope.  This test
 * checks that a declaration of a global type name inside class scope
 * is visible outside that scope.
 */
class class_4_3_1
{
	typedef string class_4_3_type;
	struct class_4_3_struct {
		string	s;
	};

	public	class_4_3_type s = "431";
	public	struct class_4_3_struct st = { "431" };

	constructor class_4_3_1_init()
	{
		unless (s eq "431") puts("bad c1.1");
		unless (st.s eq "431") puts("bad c1.2");
	}
	destructor class_4_3_1_free(class_4_3_1 self) {}
}

class_4_3_type		gs = "g43";
struct class_4_3_struct	gst = { "g43" };

class class_4_3_2
{
	public	class_4_3_type s = "432";
	public	struct class_4_3_struct st = { "432" };

	constructor class_4_3_2_init()
	{
		unless (s eq "432") puts("bad c2.1");
		unless (st.s eq "432") puts("bad c2.2");
	}
	destructor class_4_3_2_free(class_4_3_2 self) {}
}
void class_4_3_main()
{
	class_4_3_1	o431 = class_4_3_1_init();
	class_4_3_2	o432 = class_4_3_2_init();

	unless (gs eq "g43") puts("bad 1");
	unless (gst.s eq "g43") puts("bad 2");
}
class_4_3_main();
} -output {}

test class-5.1 {check class object type checking} -body {
#lang L --line=1 -nowarn
class class_5_1_1
{
	constructor class_5_1_1_init() {}
	destructor class_5_1_1_free(class_5_1_1 self) {}
	void class_5_1_1_foo(class_5_1_1 self, int a) {}
}
class class_5_1_2
{
	constructor class_5_1_2_init() {}
	destructor class_5_1_2_free(class_5_1_2 self) {}
	void class_5_1_2_foo(class_5_1_2 self, int a) {}
}
void class_5_1()
{
	class_5_1_1	o511;
	class_5_1_2	o512;

	/* These are all type errors (wrong class). */
	o511 = class_5_1_2_init();
	o512 = class_5_1_1_init();
	class_5_1_1_foo(o512, 0);
	class_5_1_2_foo(o511, 0);
	class_5_1_1_free(o512);
	class_5_1_2_free(o511);
}
} -returnCodes {error} -match regexp -result {.*19: L Error: assignment of incompatible types
.*20: L Error: assignment of incompatible types
.*21: L Error: parameter 1 has incompatible type
.*22: L Error: parameter 1 has incompatible type
.*23: L Error: parameter 1 has incompatible type
.*24: L Error: parameter 1 has incompatible type
}

test class-5.2 {check wrong object type in class member fn declarations} -body {
#lang L --line=1
class class_5_2_1
{
	constructor class_5_2_1_init() {}
	destructor class_5_2_1_free(class_5_2_1 self) {}
}
class class_5_2_2
{
	constructor class_5_2_2_init() {}
	/* These have the wrong class as the arg type. */
	destructor class_5_2_2_free(class_5_2_1 self) {}
	void class_5_2_2_foo(class_5_2_1 self) {}
}
} -returnCodes {error} -match regexp -result {.*10: L Error: 'self' parameter must be of class type
.*11: L Error: 'self' parameter must be of class type
}

test class-5.3 {check that class member fn args get type checked 1} -body {
#lang L --line=1 -nowarn
/*
 * This test checks that class member function arguments are
 * type checked.  There should be no type errors in this example.
 */
typedef string myhash{int};
class class_5_3 {
	constructor class_5_3_init(int a, string b, myhash c) {}
	destructor class_5_3_free(class_5_3 self) {}
	private void priv(myhash a, int b, int c) {}
	string class_5_3_foo(class_5_3 self, string a, int b) {
		myhash	h;
		priv(h, 3, 4);
		return(a);
	}
}
void class_5_3_main()
{
	myhash		h;
	class_5_3	o = class_5_3_init(1, "str", h);
	unless (class_5_3_foo(o, "foo", 3) eq "foo") puts("bad 1");
}
class_5_3_main();
} -output {}

test class-5.4 {check that class member fn args get type checked 2} -body {
#lang L --line=1 -nowarn
/*
 * This test checks that class member function arguments are
 * type checked.  This example has type errors.
 */
typedef string myhash{int};
class class_5_4 {
	constructor class_5_4_init(int a, string b, myhash c) {}
	destructor class_5_4_free(class_5_4 self) {}
	private void priv(myhash a, int b, int c) {}
	string class_5_4_foo(class_5_4 self, string a, int b) {
		myhash	h;
		priv(3, h, 4);  // args 1,2 backwards
		return(b);  // bad return type
	}
}
void class_5_4_main()
{
	int		i;
	myhash		h;
	class_5_4	o = class_5_4_init(1, h, "str");  // args 2,3 backwards

	i = class_5_4_foo(o, 3, "foo");  // args 2,3 backwards
}
class_5_4_main();
} -returnCodes {error} -match regexp -result {.*12: L Error: parameter 1 has incompatible type
.*12: L Error: parameter 2 has incompatible type
.*13: L Error: incompatible return type
.*20: L Error: parameter 2 has incompatible type
.*20: L Error: parameter 3 has incompatible type
.*22: L Error: parameter 2 has incompatible type
.*22: L Error: parameter 3 has incompatible type
.*22: L Error: assignment of incompatible types
}

test class-6.1 {check class variable access from outside class} -body {
#lang L --line=1
void class_6_1_str(string &s, string new)
{
	s = new;
}
void class_6_1_hash(string &h{int}, int k, string v)
{
	h{k} = v;
}
void class_6_1_arr(int &a[][], int i, int j, int v)
{
	a[i][j] = v;
}
class class_6_1
{
	public	string s = "cvar";
	public	string h{int} = { 1=>"one", 2=>"two" };
	public	string a[] = { "zero", "one", "two" };
	public	int aa[][] = { {1,2}, {3,4} };
}
void class_6_1_main()
{
	/*
	 * This test also checks the use of complex class variables
	 * as well as class variables as reference parameters.
	 */

	unless (class_6_1->s eq "cvar") puts("bad 1.1");
	unless (class_6_1->h{1} eq "one") puts("bad 1.2");
	unless (class_6_1->h{2} eq "two") puts("bad 1.3");
	unless (class_6_1->a[0] eq "zero") puts("bad 1.4");
	unless (class_6_1->a[1] eq "one") puts("bad 1.5");
	unless (class_6_1->a[2] eq "two") puts("bad 1.6");
	unless (class_6_1->aa[0][0] == 1) puts("bad 1.10");
	unless (class_6_1->aa[0][1] == 2) puts("bad 1.11");
	unless (class_6_1->aa[1][0] == 3) puts("bad 1.12");
	unless (class_6_1->aa[1][1] == 4) puts("bad 1.13");

	class_6_1->s = "new";
	unless (class_6_1->s eq "new") puts("bad 2.1");

	class_6_1->h = { 3=>"three" };
	unless (class_6_1->h{3} eq "three") puts("bad 3.1");
	unless (length(class_6_1->h) == 1) puts("bad 3.2");

	class_6_1->a = { "just-one" };
	unless (class_6_1->a[0] eq "just-one") puts("bad 4.1");
	unless (length(class_6_1->a) == 1) puts("bad 4.2");

	class_6_1->aa = { {5} };
	unless (class_6_1->aa[0][0] == 5) puts("bad 5.1");
	unless (length(class_6_1->aa) == 1) puts("bad 5.2");
	unless (length(class_6_1->aa[0]) == 1) puts("bad 5.3");

	class_6_1_str(&class_6_1->s, "new-s");
	unless (class_6_1->s eq "new-s") puts("bad 6.1");

	class_6_1->h = {};
	class_6_1_hash(&class_6_1->h, 4, "four");
	unless (class_6_1->h{4} eq "four") puts("bad 7.1");
	unless (length(class_6_1->h) == 1) puts("bad 7.2");
	if (defined(class_6_1->h{5})) puts("bad 7.3");

	class_6_1->aa = {};
	class_6_1_arr(&class_6_1->aa, 0, 0, 11);
	class_6_1_arr(&class_6_1->aa, 0, 1, 12);
	class_6_1_arr(&class_6_1->aa, 1, 0, 13);
	class_6_1_arr(&class_6_1->aa, 1, 1, 14);
	unless (class_6_1->aa[0][0] == 11) puts("bad 8.1");
	unless (class_6_1->aa[0][1] == 12) puts("bad 8.2");
	unless (class_6_1->aa[1][0] == 13) puts("bad 8.3");
	unless (class_6_1->aa[1][1] == 14) puts("bad 8.4");
	unless (length(class_6_1->aa) == 2) puts("bad 8.5");
	unless (length(class_6_1->aa[0]) == 2) puts("bad 8.6");
	unless (length(class_6_1->aa[1]) == 2) puts("bad 8.7");
	if (defined(class_6_1->aa[2])) puts("bad 8.8");
}
class_6_1_main();
} -output {}

test class-6.2 {check class variable access errors from outside class} -body {
#lang L --line=1 -nowarn
class class_6_2
{
	private	string s = "cvar";
}
void class_6_2_main()
{
	string	bad = class_6_2->s;  // error
}
} -returnCodes {error} -match regexp -result {.*7: L Error: s is not a public variable of class class_6_2
}

test class-6.3 {check class variable access from inside class} -body {
#lang L --line=1
class class_6_3
{
	public	string cpubl = "publ-cvar";
	private	string cpriv = "priv-cvar";
	constructor class_6_3_new()
	{
		unless (cpubl eq "publ-cvar") puts("bad c1");
		unless (cpriv eq "priv-cvar") puts("bad c2");
		unless (class_6_3->cpubl eq "publ-cvar") puts("bad c3");
		unless (class_6_3->cpriv eq "priv-cvar") puts("bad c4");
	}
	public void class_6_3_foo(class_6_3 self)
	{
		unless (cpubl eq "publ-cvar") puts("bad foo.1");
		unless (cpriv eq "priv-cvar") puts("bad foo.2");
		unless (class_6_3->cpubl eq "publ-cvar") puts("bad foo.3");
		unless (class_6_3->cpriv eq "priv-cvar") puts("bad foo.4");
	}
	destructor class_6_3_delete(class_6_3 self)
	{
		unless (cpubl eq "publ-cvar") puts("bad d1");
		unless (cpriv eq "priv-cvar") puts("bad d2");
		unless (class_6_3->cpubl eq "publ-cvar") puts("bad d3");
		unless (class_6_3->cpriv eq "priv-cvar") puts("bad d4");
	}
}
void class_6_3_main()
{
	class_6_3 o = class_6_3_new();
	class_6_3_foo(o);
	class_6_3_delete(o);
}
class_6_3_main();
} -output {}

test class-6.4 {check erroneous class instance var access via class name} -body {
#lang L --line=1
class class_6_4
{
	instance {
		public	string ipubl;
		private	string ipriv;
	}
	constructor class_6_4_new()
	{
		string	s;
		s = class_6_4->ipubl;  // err
		s = class_6_4->ipriv;  // err
	}
}
void class_6_4_main()
{
	string	s;
	class_6_4 o = class_6_4_new();

	s = class_6_4->ipubl;  // err
	s = class_6_4->ipriv;  // err

	class_6_4_delete(o);
}
class_6_4_main();
} -returnCodes {error} -match regexp -result {.*10: L Error: ipubl is not a class variable of class class_6_4
.*11: L Error: ipriv is not a class variable of class class_6_4
.*19: L Error: ipubl is not a class variable of class class_6_4
.*20: L Error: ipriv is not a class variable of class class_6_4
}

test class-6.5 {check class instance var access from outside class} -body {
#lang L --line=1
class class_6_5
{
	instance {
		public	string	ivar1;
		public	string	ivar2;
	}
	constructor class_6_5_new(string s1, string s2)
	{
		ivar1 = s1;
		ivar2 = s2;
	}
}
void class_6_5_main()
{
	class_6_5 o1 = class_6_5_new("a", "b");
	class_6_5 o2 = class_6_5_new("c", "d");
	class_6_5 o3 = class_6_5_new("e", "f");

	unless (o1->ivar1 eq "a") puts("bad 1");
	unless (o1->ivar2 eq "b") puts("bad 2");
	unless (o2->ivar1 eq "c") puts("bad 3");
	unless (o2->ivar2 eq "d") puts("bad 4");
	unless (o3->ivar1 eq "e") puts("bad 5");
	unless (o3->ivar2 eq "f") puts("bad 6");

	class_6_5_delete(o1);
	class_6_5_delete(o2);
	class_6_5_delete(o3);
}
class_6_5_main();
} -output {}

test class-6.6 {check class instance var access errs from outside class} -body {
#lang L --line=1
class class_6_6
{
	instance {
		private	string	ivar1;
		public	string	ivar2;
	}
}
void class_6_6_main()
{
	string	s;
	class_6_6 o = class_6_6_new();

	s = o->ivar1;  // err
}
} -returnCodes {error} -match regexp -result {.*13: L Error: ivar1 is not a public variable of class class_6_6
}

test class-6.7 {check class instance var access from inside class} -body {
#lang L --line=1
class class_6_7
{
	instance {
		public	string	ivar1;
		public	string	ivar2;
	}
	constructor class_6_7_new(string s1, string s2)
	{
		ivar1 = s1;
		ivar2 = s2;
	}
	public void class_6_7_chk(class_6_7 self, string s1, string s2)
	{
		unless (ivar1 eq s1) puts("bad chk.1");
		unless (ivar2 eq s2) puts("bad chk.2");
		unless (self->ivar1 eq s1) puts("bad chk.3");
		unless (self->ivar2 eq s2) puts("bad chk.4");
	}
	private void chkother(class_6_7 other, string s1, string s2)
	{
		unless (other->ivar1 eq s1) puts("bad priv.chkother.1");
		unless (other->ivar2 eq s2) puts("bad priv.chkother.2");
	}
	public void class_6_7_chkother(class_6_7 self, class_6_7 other,
				       string s1, string s2)
	{
		unless (other->ivar1 eq s1) puts("bad chkother.1");
		unless (other->ivar2 eq s2) puts("bad chkother.2");
		chkother(other, s1, s2);
	}
}
void class_6_7_main()
{
	class_6_7 o1 = class_6_7_new("a", "b");
	class_6_7 o2 = class_6_7_new("c", "d");
	class_6_7 o3 = class_6_7_new("e", "f");

	class_6_7_chk(o1, "a", "b");
	class_6_7_chk(o2, "c", "d");
	class_6_7_chk(o3, "e", "f");

	class_6_7_chkother(o2, o1, "a", "b");
	class_6_7_chkother(o1, o2, "c", "d");
	class_6_7_chkother(o1, o3, "e", "f");

	class_6_7_delete(o1);
	class_6_7_delete(o2);
	class_6_7_delete(o3);
}
class_6_7_main();
} -output {}

test class-6.8 {check class variable access errors} -body {
#lang L --line=1
class class_6_8
{
	public	string cpubl;
	private	string cpriv;
}
void class_6_8_main()
{
	string	s;
	class_6_8 o = class_6_8_new();

	s = o->cpubl;  // err
	s = o->cpriv;  // err
}
} -returnCodes {error} -match regexp -result {.*11: L Error: cpubl is not an instance variable of class class_6_8
.*12: L Error: cpriv is not an instance variable of class class_6_8
}

test class-7.1 {check object erroneously declared with same name as class} -body {
#lang L --line=1 -nowarn
class class_7_1 {}
void class_7_1_main()
{
	class_7_1 class_7_1;  // err
}
} -returnCodes {error} -match regexp -result {.*4: L Error: cannot declare object with same name as class
}

test class-8.1 {check class variables as l-values} -body {
#lang L --line=1
class class_8_1
{
	public	string	s;
	public	int	i;

	public void class_8_1_chk(class_8_1 self)
	{
		class_8_1->s = "abcd";
		unless (class_8_1->s eq "abcd") puts("bad c1.1");

		class_8_1->s[0] = "xyz";
		unless (class_8_1->s eq "xyzbcd") puts("bad c1.2");

		class_8_1->s[END+1] = "pdq";
		unless (class_8_1->s eq "xyzbcdpdq") puts("bad c1.3");

		unless (class_8_1->s =~ /bcd/) puts("bad c1.4");

		class_8_1->s =~ s/bcd/dcb/;
		unless (class_8_1->s eq "xyzdcbpdq") puts("bad c1.5");

		class_8_1->s[0] =~ s/x/0/;
		unless (class_8_1->s eq "0yzdcbpdq") puts("bad c1.6");

		class_8_1->i = 2;
		unless (class_8_1->i == 2) puts("bad c2.1");

		class_8_1->i += 2;
		unless (class_8_1->i == 4) puts("bad c2.2");

		class_8_1->i += class_8_1->i;
		unless (class_8_1->i == 8) puts("bad c2.3");
	}
}
void class_8_1_main()
{
	class_8_1 o = class_8_1_new();

	class_8_1_chk(o);

	class_8_1->s = "abcd";
	unless (class_8_1->s eq "abcd") puts("bad 1.1");

	class_8_1->s[0] = "xyz";
	unless (class_8_1->s eq "xyzbcd") puts("bad 1.2");

	class_8_1->s[END+1] = "pdq";
	unless (class_8_1->s eq "xyzbcdpdq") puts("bad 1.3");

	unless (class_8_1->s =~ /bcd/) puts("bad 1.4");

	class_8_1->s =~ s/bcd/dcb/;
	unless (class_8_1->s eq "xyzdcbpdq") puts("bad 1.5");

	class_8_1->s[0] =~ s/x/0/;
	unless (class_8_1->s eq "0yzdcbpdq") puts("bad 1.6");

	class_8_1->i = 2;
	unless (class_8_1->i == 2) puts("bad 2.1");

	class_8_1->i += 2;
	unless (class_8_1->i == 4) puts("bad 2.2");

	class_8_1->i += class_8_1->i;
	unless (class_8_1->i == 8) puts("bad 2.3");

	class_8_1_chk(o);
}
class_8_1_main();
} -output {}

test class-8.1.5 {check class and class instance variables used in nested scopes} -body {
#lang L --line=1
class class_8_1_5
{
	private	int n = 0;
	public	int cnum = -1;
	instance { public int num = n++; }
	constructor class_8_1_5_new() { ++cnum; }
}
void class_8_1_5_main()
{
	/*
	 * This test checks that the compiler-generated temps used for
	 * accessing class and instance variables are allocated
	 * properly in the presence of nested scopes.  There was a
	 * prior compiler bug where duplicate temps could be created.
	 */

	int	i, j;
	int	n = 10;
	class_8_1_5 o1, o2, o3, o4, o[];

	o1 = class_8_1_5_new();
	unless ((o1->num == 0) && (class_8_1_5->cnum == 0)) puts("bad 1");
	o2 = class_8_1_5_new();
	unless ((o2->num == 1) && (class_8_1_5->cnum == 1)) puts("bad 2");

	for (i = 0; i < n; ++i) {
		o[i] = class_8_1_5_new();
		unless (o[i]->num == (i+2)) puts("bad 3.1");
		unless (class_8_1_5->cnum == (i+2)) puts("bad 3.2");
		for (j = 0; j < i; ++j) {
			unless (o[j]->num == (j+2)) puts("bad 4.1");
		}
	}
	for (i = 0; i < n; ++i) {
		unless (o[i]->num == (i+2)) puts("bad 5.1");
	}
	o3 = class_8_1_5_new();
	unless (o3->num == (n+2)) puts("bad 6.1");
	unless (class_8_1_5->cnum == (n+2)) puts("bad 6.2");
	o4 = class_8_1_5_new();
	unless (o4->num == (n+3)) puts("bad 7.1");
	unless (class_8_1_5->cnum == (n+3)) puts("bad 7.2");
}
class_8_1_5_main();
} -output {}

test class-8.2 {check class instance variables as l-values} -body {
#lang L --line=1
class class_8_2
{
	instance {
		public	string	s;
		public	int	i;
	}
	constructor class_8_2_new()
	{
		self->s = "abcd";
		unless (self->s eq "abcd") puts("bad 1.1");

		self->s[0] = "xyz";
		unless (self->s eq "xyzbcd") puts("bad 1.2");

		self->s[END+1] = "pdq";
		unless (self->s eq "xyzbcdpdq") puts("bad 1.3");

		unless (self->s =~ /bcd/) puts("bad 1.4");

		self->s =~ s/bcd/dcb/;
		unless (self->s eq "xyzdcbpdq") puts("bad 1.5");

		self->s[0] =~ s/x/0/;
		unless (self->s eq "0yzdcbpdq") puts("bad 1.6");

		self->i = 2;
		unless (self->i == 2) puts("bad 2.1");

		self->i += 2;
		unless (self->i == 4) puts("bad 2.2");

		self->i += self->i;
		unless (self->i == 8) puts("bad 2.3");
	}
	public void class_8_2_chk(class_8_2 self, class_8_2 other)
	{
		other->s = "abcd";
		unless (other->s eq "abcd") puts("bad 1.1");

		other->s[0] = "xyz";
		unless (other->s eq "xyzbcd") puts("bad 1.2");

		other->s[END+1] = "pdq";
		unless (other->s eq "xyzbcdpdq") puts("bad 1.3");

		unless (other->s =~ /bcd/) puts("bad 1.4");

		other->s =~ s/bcd/dcb/;
		unless (other->s eq "xyzdcbpdq") puts("bad 1.5");

		other->s[0] =~ s/x/0/;
		unless (other->s eq "0yzdcbpdq") puts("bad 1.6");

		other->i = 2;
		unless (other->i == 2) puts("bad 2.1");

		other->i += 2;
		unless (other->i == 4) puts("bad 2.2");

		other->i += other->i;
		unless (other->i == 8) puts("bad 2.3");
	}
}
void class_8_2_main()
{
	class_8_2 o = class_8_2_new();

	class_8_2_chk(o, o);

	o->s = "abcd";
	unless (o->s eq "abcd") puts("bad 1.1");

	o->s[0] = "xyz";
	unless (o->s eq "xyzbcd") puts("bad 1.2");

	o->s[END+1] = "pdq";
	unless (o->s eq "xyzbcdpdq") puts("bad 1.3");

	unless (o->s =~ /bcd/) puts("bad 1.4");

	o->s =~ s/bcd/dcb/;
	unless (o->s eq "xyzdcbpdq") puts("bad 1.5");

	o->s[0] =~ s/x/0/;
	unless (o->s eq "0yzdcbpdq") puts("bad 1.6");

	o->i = 2;
	unless (o->i == 2) puts("bad 2.1");

	o->i += 2;
	unless (o->i == 4) puts("bad 2.2");

	o->i += o->i;
	unless (o->i == 8) puts("bad 2.3");
}
class_8_2_main();
} -output {}

test class-8.3 {check class instance variables as reference parameters} -body {
#lang L --line=1
void class_8_3_str(string &s, string new)
{
	s = new;
}
void class_8_3_hash(string &h{int}, int k, string v)
{
	h{k} = v;
}
void class_8_3_arr(int &a[][], int i, int j, int v)
{
	a[i][j] = v;
}
class class_8_3
{
	instance {
		public	string s = "cvar";
		public	string h{int} = { 1=>"one", 2=>"two" };
		public	string a[] = { "zero", "one", "two" };
		public	int aa[][] = { {1,2}, {3,4} };
	}
}
void class_8_3_main()
{
	/*
	 * Note that test class-6.1 checked class variables as
	 * reference parameters.  This test is basically that test but
	 * it checks instance variables instead.
	 */

	class_8_3 o = class_8_3_new();

	unless (o->s eq "cvar") puts("bad 1.1");
	unless (o->h{1} eq "one") puts("bad 1.2");
	unless (o->h{2} eq "two") puts("bad 1.3");
	unless (o->a[0] eq "zero") puts("bad 1.4");
	unless (o->a[1] eq "one") puts("bad 1.5");
	unless (o->a[2] eq "two") puts("bad 1.6");
	unless (o->aa[0][0] == 1) puts("bad 1.10");
	unless (o->aa[0][1] == 2) puts("bad 1.11");
	unless (o->aa[1][0] == 3) puts("bad 1.12");
	unless (o->aa[1][1] == 4) puts("bad 1.13");

	o->s = "new";
	unless (o->s eq "new") puts("bad 2.1");

	o->h = { 3=>"three" };
	unless (o->h{3} eq "three") puts("bad 3.1");
	unless (length(o->h) == 1) puts("bad 3.2");

	o->a = { "just-one" };
	unless (o->a[0] eq "just-one") puts("bad 4.1");
	unless (length(o->a) == 1) puts("bad 4.2");

	o->aa = { {5} };
	unless (o->aa[0][0] == 5) puts("bad 5.1");
	unless (length(o->aa) == 1) puts("bad 5.2");
	unless (length(o->aa[0]) == 1) puts("bad 5.3");

	class_8_3_str(&o->s, "new-s");
	unless (o->s eq "new-s") puts("bad 6.1");

	o->h = {};
	class_8_3_hash(&o->h, 4, "four");
	unless (o->h{4} eq "four") puts("bad 7.1");
	unless (length(o->h) == 1) puts("bad 7.2");
	if (defined(o->h{5})) puts("bad 7.3");

	o->aa = {};
	class_8_3_arr(&o->aa, 0, 0, 11);
	class_8_3_arr(&o->aa, 0, 1, 12);
	class_8_3_arr(&o->aa, 1, 0, 13);
	class_8_3_arr(&o->aa, 1, 1, 14);
	unless (o->aa[0][0] == 11) puts("bad 8.1");
	unless (o->aa[0][1] == 12) puts("bad 8.2");
	unless (o->aa[1][0] == 13) puts("bad 8.3");
	unless (o->aa[1][1] == 14) puts("bad 8.4");
	unless (length(o->aa) == 2) puts("bad 8.5");
	unless (length(o->aa[0]) == 2) puts("bad 8.6");
	unless (length(o->aa[1]) == 2) puts("bad 8.7");
	if (defined(o->aa[2])) puts("bad 8.8");
}
class_8_3_main();
} -output {}

test class-8.4 {check objects in complex variables} -body {
#lang L --line=1
class class_8_4_1
{
	instance {
		public	class_8_4_1 o;
		public	string s;
	}
}
class class_8_4_2
{
	instance {
		public	class_8_4_1 o;
		public	string s;
	}
}
void class_8_4_foo(class_8_4_1 &o, string s)
{
	o->s = s;
}
void class_8_4_str(string &s1, string s2)
{
	s1 = s2;
}
void class_8_4_main()
{
	class_8_4_1 a[] = { class_8_4_1_new(), class_8_4_1_new() };
	class_8_4_1 o841 = class_8_4_1_new();
	class_8_4_2 o842 = class_8_4_2_new();

	o841->s = "841";
	o842->s = "842";
	unless ((o841->s eq "841") && (o842->s eq "842")) puts("bad 1.1");

	o841->o = class_8_4_1_new();
	o841->o->s = "841 in 841";
	unless (o841->o->s eq "841 in 841") puts("bad 2.1");

	o842->o = class_8_4_1_new();
	o842->o->s = "841 in 842";
	unless (o842->o->s eq "841 in 842") puts("bad 3.1");

	o842->o->o = class_8_4_1_new();
	o842->o->o->s = "841 in 841 in 842";
	unless (o842->o->o->s eq "841 in 841 in 842") puts("bad 4.1");

	class_8_4_foo(&o842->o->o, "new");
	unless (o842->o->o->s eq "new") puts("bad 5.1");

	class_8_4_1_delete(o841->o);
	class_8_4_1_delete(o841);
	class_8_4_1_delete(o842->o->o);
	class_8_4_1_delete(o842->o);
	class_8_4_2_delete(o842);

	unless (length(a) == 2) puts("bad 10.0");
	a[0]->s = "0-841";
	a[1]->s = "1-841";
	unless (a[0]->s eq "0-841") puts("bad 10.1");
	unless (a[1]->s eq "1-841") puts("bad 10.2");
	a[0]->o = class_8_4_1_new();
	a[0]->o->s = "0-841 in 841";
	unless (a[0]->o->s eq "0-841 in 841") puts("bad 10.3");
	class_8_4_foo(&a[0]->o, "new");
	unless (a[0]->o->s eq "new") puts("bad 10.4");
	class_8_4_str(&a[0]->o->s, "new2");
	unless (a[0]->o->s eq "new2") puts("bad 10.5");
}
class_8_4_main();
} -output {}

test class-8.5 {check objects as reference parameters} -body {
#lang L --line=1
class class_8_5
{
	private int n = 0;
	instance { public int num = n++; }
}
void class_8_5_create_1(class_8_5 &o)
{
	o = class_8_5_new();
}
void class_8_5_create_n(class_8_5 &o[], int n)
{
	int	i;

	for (i = 0; i < n; ++i) o[i] = class_8_5_new();
}
void class_8_5_check_n(class_8_5 o[], class_8_5 &oref[], int n)
{
	int	i;

	for (i = 0; i < n; ++i) {
		unless (o[i]->num    == (i+2)) puts("bad chk.1");
		unless (oref[i]->num == (i+2)) puts("bad chk.2");
	}
}
void class_8_5_main()
{
	int	n = 10;
	class_8_5 o1, o2;
	class_8_5 o[];

	class_8_5_create_1(&o1);
	class_8_5_create_1(&o2);
	unless (o1->num == 0) puts("bad 1");
	unless (o2->num == 1) puts("bad 2");
	class_8_5_delete(o1);
	class_8_5_delete(o2);

	class_8_5_create_n(&o, n);
	class_8_5_check_n( o, &o, n);
}
class_8_5_main();
} -output {}

test class-9.1 {check class and instance variables in comma expression} -body {
#lang L --line=1
class class_9_1
{
	public	string cvar = "cvar";
	instance {
		public	string ivar = "ivar";
	}
}
void class_9_1_main()
{
	/*
	 * This checks an obscure case to ensure that a class or
	 * instance variable whose value is discarded -- the first
	 * expression in a comma expression -- is compiled properly.
	 * These are run in a loop as a way to check that the
	 * run-time stack remains balanced.
	 */

	int	i;
	int	n = 100;
	class_9_1 o = class_9_1_new();

	for (i = 0; i < n; ++i) {
		unless (class_9_1->cvar,"val" eq "val") puts("bad 1.1");
		unless (o->ivar,"val" eq "val") puts("bad 1.2");
	}
}
class_9_1_main();
} -output {}

test goto-1 {check goto statement} -body {
#lang L --line=1
/*
 * Test gotos at global scope.  None of these labels should clash with
 * those in goto_1a() or goto_1b() below.
 */
	goto L1;
	puts("bad");
 L1:	puts("L1");
	goto L2;

/* Now test at proc scope. */
void goto_1a()
{
	int	i;

	/* Use before define. */
	goto L1;
	puts("bad 1");
 L1:	puts("L1");

	/* Use after define. */
	i = 0;
 L2:	if (++i == 2) goto L3;
	puts("L2");
	goto L2;
 L3:	puts("L3");

	/* Multiple uses before define. */
	for (i = 0; i < 4; ++i) {
		if (i == 0) goto L4;
		if (i == 1) goto L4;
		if (i == 2) goto L4;
		if (i == 3) goto L4;
		continue;
	L4:	puts("L4");
	}

	/* Multiple uses after define. */
	for (i = 0; i < 4; ++i) {
		goto L6;
		puts("bad");
	L5:	puts("L5");
		continue;
	L6:	if (i == 0) goto L5;
		if (i == 1) goto L5;
		if (i == 2) goto L5;
		if (i == 3) goto L5;
	}

	/* Multiple labels per statement. */
	for (i = 0; i < 4; ++i) {
		if (i == 0) goto L7;
		if (i == 1) goto L8;
		if (i == 2) goto L9;
		if (i == 3) goto L10;
		continue;
	L7:
	L8:
	L9:
	L10:
		puts("L7-10");
	}

	/* Label without statement. */
	do {
		goto L11;
		puts("bad");
	L11:
	} while(0);

	/* Multiple labels without statement. */
	for (i = 0; i < 4; ++i) {
		if (i == 0) goto L12;
		if (i == 1) goto L13;
		if (i == 2) goto L14;
		puts("i == 3");
	L12:
	L13:
	L14:
	} while(0);

	/*
	 * Label on a single statement (bizarre perhaps, but allowed
	 * by the grammar).
	 */

	goto L15;
	puts("bad");
	while (0) L15: puts("L15");

	goto L16;
	puts("bad");
	do L16: puts("L16"); while(0);

	goto L17;
	puts("bad");
	for (; 0; ) L17: puts("L17");

	goto L18;
	puts("bad");
	for (; 0; 0) L18: puts("L18");

	/* Labels in nested scopes. */

	i = 0;
	goto L19;
	puts("bad");
	do {
		puts("bad");
	L19:	puts("L19");
	} while (0);
	if (i++ == 0) goto L19;

	i = 0;
	goto L20;
	puts("bad");
	do {
		puts("bad");
		do {
			puts("bad");
		L20:	puts("L20");
		}
		while (0);
	} while (0);
	if (i++ == 0) goto L20;

	do {
		goto L21;  // jump out of the scope
		puts("bad");
	} while (0);
 L21:	puts("L21");
}
void goto_1b()
{
	/*
	 * Goto labels should be per proc scope, so none of these labels
	 * should clash with those in goto_1a().
	 */

	goto L1;
	puts("bad");
 L1:	puts("L1");
}
L2:
goto_1a();
goto_1b();
} -output {L1
L1
L2
L3
L4
L4
L4
L4
L5
L5
L5
L5
L7-10
L7-10
L7-10
L7-10
i == 3
L15
L16
L17
L18
L19
L19
L20
L20
L21
L1
}

test goto-2 {check gotos with labels in enclosing scopes} -body {
#lang L --line=1
goto L1;
L2: puts("global L2");
return;
void goto_2()
{
	goto L2;  // should go to goto_2()'s L2, NOT the L2 at global scope
	puts("bad");
 L2:	puts("L2");
}
L1:
goto_2();
goto L2;  // should go to the L2 at global scope, NOT goto_2()'s L2
} -output {L2
global L2
}

test goto-3 {check goto statement errors} -body {
#lang L --line=1
void goto_3()
{
	goto L1;
 L1:
 L1:
 L2:
 L2:
 L2:

 L3:
	do {
	L3:
	} while (0);

	goto L4;
	goto L6;  // error even though an L6 is defined at global scope
}
goto L5;
L6:
} -returnCodes error -match regexp -result {.*: L Error: label L1 already defined
.*: L Error: label L2 already defined
.*: L Error: label L3 already defined
.*: L Error: label L4 referenced but not defined
.*: L Error: label L6 referenced but not defined
.*: L Error: label L5 referenced but not defined
}

test goto-4 {check goto with label on first statement in the scope} -body {
#lang L --line=1
void goto_4()
{
	int	i = 0;

	/*
	 * This is a regression test for a parser bug where a labeled
	 * stmt that was first in the stmt list wasn't being reversed,
	 * causing the label to get the wrong offset.  With that bug
	 * this test would find i == 1.
	 */
	if (1) {
		L: unless (i++) goto L;
	}
	unless (i == 2) puts("bad");
}
goto_4();
} -output {}

test fntrace-1 {check function tracing, pragma syntax} -body {
#lang L --line=1
// These are all legal syntax.
#pragma fntrace=on
unless (__LINE__ == 3) puts("bad 1");
#pragma fntrace=on, fnhook=myhook
unless (__LINE__ == 5) puts("bad 2");
#pragma fntrace=on, fnhook=def
unless (__LINE__ == 7) puts("bad 3");
#pragma fntrace=off
unless (__LINE__ == 9) puts("bad 4");
#pragma fntrace=off, fnhook=myhook
unless (__LINE__ == 11) puts("bad 5");
#pragma fntrace=off, fnhook=def
unless (__LINE__ == 13) puts("bad 6");
#pragma fntrace
} -output {}

test fntrace-2 {check function trace, default hooks} -body {
#lang L --line=1 -nowarn
#pragma fntrace=on
string fntrace_2_3(string a1, string a2)
{
	fprintf(stderr, "in fntrace_2_3\n");
	return ("this is the ret value");
}
void fntrace_2_2(string a1)
{
	fprintf(stderr, "in fntrace_2_2 before\n");
	fntrace_2_3(a1, "arg2");
	fprintf(stderr, "in fntrace_2_2 after\n");
}
void fntrace_2_1()
{
	fprintf(stderr, "in fntrace_2_1 before\n");
	fntrace_2_2("arg1");
	fprintf(stderr, "in fntrace_2_1 after\n");
}
void fntrace_2()
{
	fprintf(stderr, "in fntrace_2 before\n");
	fntrace_2_1();
	fprintf(stderr, "in fntrace_2 after\n");
}
fntrace_2();
} -match regexp -errorOutput {\d+: enter fntrace_2
in fntrace_2 before
\d+: enter fntrace_2_1
in fntrace_2_1 before
\d+: enter fntrace_2_2 'arg1'
in fntrace_2_2 before
\d+: enter fntrace_2_3 'arg1' 'arg2'
in fntrace_2_3
\d+: exit fntrace_2_3 'arg1' 'arg2' ret 'this is the ret value'
in fntrace_2_2 after
\d+: exit fntrace_2_2 'arg1' ret ''
in fntrace_2_1 after
\d+: exit fntrace_2_1 ret ''
in fntrace_2 after
\d+: exit fntrace_2 ret ''
}

test fntrace-3.1 {check function trace, private user hook fn} -body {
#lang L --line=1 -nowarn
#pragma fntrace=on, fnhook=fn31_myhook
private void fn31_myhook(int pre, string av[], string ret)
{
	int	i;
	int	ac = length(av);

	printf("myhook %s: %s %d args:", pre?"pre":"post", av[0], ac-1);
	for (i = 1; i < ac; ++i) {
		printf(" '%s'", av[i]);
	}
	unless (pre) printf(" ret: '%s'", ret);
	printf("\n");
}
string fntrace_3_1_3(string a1, string a2)
{
	printf("in fntrace_3_1_3\n");
	return ("this is the ret value");
}
void fntrace_3_1_2(string a1)
{
	printf("in fntrace_3_1_2 before\n");
	fntrace_3_1_3(a1, "arg2");
	printf("in fntrace_3_1_2 after\n");
}
void fntrace_3_1_1()
{
	printf("in fntrace_3_1_1 before\n");
	fntrace_3_1_2("arg1");
	printf("in fntrace_3_1_1 after\n");
}
void fntrace_3_1()
{
	printf("in fntrace_3_1 before\n");
	fntrace_3_1_1();
	printf("in fntrace_3_1 after\n");
}
fntrace_3_1();
#pragma fnhook=def
} -output {myhook pre: fntrace_3_1 0 args:
in fntrace_3_1 before
myhook pre: fntrace_3_1_1 0 args:
in fntrace_3_1_1 before
myhook pre: fntrace_3_1_2 1 args: 'arg1'
in fntrace_3_1_2 before
myhook pre: fntrace_3_1_3 2 args: 'arg1' 'arg2'
in fntrace_3_1_3
myhook post: fntrace_3_1_3 2 args: 'arg1' 'arg2' ret: 'this is the ret value'
in fntrace_3_1_2 after
myhook post: fntrace_3_1_2 1 args: 'arg1' ret: ''
in fntrace_3_1_1 after
myhook post: fntrace_3_1_1 0 args: ret: ''
in fntrace_3_1 after
myhook post: fntrace_3_1 0 args: ret: ''
}

test fntrace-3.2 {check function trace, public user hook fn} -body {
#lang L --line=1 -nowarn
#pragma fntrace=on, fnhook=fntr32_myhook
void fntr32_myhook(int pre, string av[], string ret)
{
	int	i;
	int	ac = length(av);

	printf("myhook %s: %s %d args:", pre?"pre":"post", av[0], ac-1);
	for (i = 1; i < ac; ++i) {
		printf(" '%s'", av[i]);
	}
	unless (pre) printf(" ret: '%s'", ret);
	printf("\n");
}
string fntrace_3_2_3(string a1, string a2)
{
	printf("in fntrace_3_2_3\n");
	return ("this is the ret value");
}
void fntrace_3_2_2(string a1)
{
	printf("in fntrace_3_2_2 before\n");
	fntrace_3_2_3(a1, "arg2");
	printf("in fntrace_3_2_2 after\n");
}
void fntrace_3_2_1()
{
	printf("in fntrace_3_2_1 before\n");
	fntrace_3_2_2("arg1");
	printf("in fntrace_3_2_1 after\n");
}
void fntrace_3_2()
{
	printf("in fntrace_3_2 before\n");
	fntrace_3_2_1();
	printf("in fntrace_3_2 after\n");
}
fntrace_3_2();
#pragma fnhook=def
} -output {myhook pre: fntrace_3_2 0 args:
in fntrace_3_2 before
myhook pre: fntrace_3_2_1 0 args:
in fntrace_3_2_1 before
myhook pre: fntrace_3_2_2 1 args: 'arg1'
in fntrace_3_2_2 before
myhook pre: fntrace_3_2_3 2 args: 'arg1' 'arg2'
in fntrace_3_2_3
myhook post: fntrace_3_2_3 2 args: 'arg1' 'arg2' ret: 'this is the ret value'
in fntrace_3_2_2 after
myhook post: fntrace_3_2_2 1 args: 'arg1' ret: ''
in fntrace_3_2_1 after
myhook post: fntrace_3_2_1 0 args: ret: ''
in fntrace_3_2 after
myhook post: fntrace_3_2 0 args: ret: ''
}

test fntrace-4 {check pragma errors} -body {
#lang L --line=1
#pragma unknown1=on
#pragma unknown2
} -returnCodes error -match regexp -result {.*1: L Error: illegal attribute 'unknown1'
.*2: L Error: illegal attribute 'unknown2'
}

test fntrace-5 {check switching hooks and enabling/disabling fntrace} -body {
#lang L --line=1
#pragma fntrace=off
void myhook5(int pre, string av[], string ret)
{
	int	i;
	int	ac = length(av);

	fprintf(stderr, "5: %s: %s %d args:", pre?"pre":"post", av[0], ac-1);
	for (i = 1; i < ac; ++i) {
		fprintf(stderr, " '%s'", av[i]);
	}
	unless (pre) fprintf(stderr, " ret: '%s'", ret);
	fprintf(stderr, "\n");
}
#pragma fntrace=on, fnhook=def
// default trace hooks in effect now
void fntrace_5_def()
{
	fprintf(stderr, "in fntrace_5_def\n");
}
#pragma fntrace=on, fnhook=myhook5
// myhook in effect now
void fntrace_5_myhook()
{
	fprintf(stderr, "in fntrace_5_myhook before\n");
	fntrace_5_def();
	fprintf(stderr, "in fntrace_5_myhook after\n");
}
#pragma fntrace=off
// function tracing disabled now
void fntrace_5_off()
{
	fprintf(stderr, "in fntrace_5_off before\n");
	fntrace_5_myhook();
	fprintf(stderr, "in fntrace_5_off after\n");
}
#pragma fntrace=on, fnhook=def
// back to default hooks
void fntrace_5()
{
	fprintf(stderr, "in fntrace_5 before\n");
	fntrace_5_off();
	fprintf(stderr, "in fntrace_5 after\n");
}
fntrace_5();
} -match regexp -errorOutput {\d+: enter fntrace_5
in fntrace_5 before
in fntrace_5_off before
5: pre: fntrace_5_myhook 0 args:
in fntrace_5_myhook before
\d+: enter fntrace_5_def
in fntrace_5_def
\d+: exit fntrace_5_def ret ''
in fntrace_5_myhook after
5: post: fntrace_5_myhook 0 args: ret: ''
in fntrace_5_off after
in fntrace_5 after
\d+: exit fntrace_5 ret ''
}

test fntrace-6 {check that tracing does not munge function return value} -body {
#lang L --line=1
#pragma fntrace=on
private int myfunc(int a)
{
	return (a + 2);
}
void fntrace_6()
{
	unless (myfunc(2) == 4) puts("bad 1");
}
fntrace_6();
} -output {}

test fntrace-7 {test function tracing in classes} -body {
#lang L --line=1
#pragma fntrace=off
class fntrace_7_cls
{
#pragma fntrace=on
	private void traced() { fprintf(stderr, "traced\n"); }
	constructor fntrace_7_cls_new()
	{
		fprintf(stderr, "constructor\n");
		traced();
		not_traced();
		return (self);
	}
#pragma fntrace=off
	private void not_traced() { fprintf(stderr, "not_traced\n"); }
	destructor fntrace_7_cls_delete(fntrace_7_cls self)
	{
		fprintf(stderr, "destructor\n");
		traced();
		not_traced();
	}
#pragma fntrace=on
}
void fntrace_7()
{
	fntrace_7_cls	o = fntrace_7_cls_new();
	fntrace_7_cls_delete(o);
}
fntrace_7();
} -match regexp -errorOutput {\d+: enter fntrace_7
\d+: enter fntrace_7_cls_new
constructor
\d+: enter traced
traced
\d+: exit traced ret ''
not_traced
\d+: exit fntrace_7_cls_new ret '::L::_instance_fntrace_7_cls1'
destructor
\d+: enter traced
traced
\d+: exit traced ret ''
not_traced
\d+: exit fntrace_7 ret ''
}

test fntrace-8 {test max depth in function tracing} -body {
#lang L --line=1
#pragma fntrace=on, trace_depth=3
int fn8_d = 0;
void fn8(int max)
{
	++fn8_d;
	if (fn8_d < max) fn8(max);
	--fn8_d;
}
void fntrace_8()
{
	fn8(2);
	fn8(3);
	fn8(4);
	fn8(100);
}
fntrace_8();
} -match regexp -errorOutput {\d+: enter fntrace_8
\d+: enter fn8 '2'
\d+: enter fn8 '2'
\d+: exit fn8 '2' ret ''
\d+: exit fn8 '2' ret ''
\d+: enter fn8 '3'
\d+: enter fn8 '3'
\d+: exit fn8 '3' ret ''
\d+: exit fn8 '3' ret ''
\d+: enter fn8 '4'
\d+: enter fn8 '4'
\d+: exit fn8 '4' ret ''
\d+: exit fn8 '4' ret ''
\d+: enter fn8 '100'
\d+: enter fn8 '100'
\d+: exit fn8 '100' ret ''
\d+: exit fn8 '100' ret ''
\d+: exit fntrace_8 ret ''
}

test fntrace-9 {test entry only or exit only function tracing hooks} -body {
#lang L --line=1
#pragma fntrace=entry
void fntrace_9_entry() {}
#pragma fntrace=exit
void fntrace_9_exit() {}
#pragma fntrace=on
void fntrace_9()
{
	fntrace_9_entry();
	fntrace_9_exit();
}
fntrace_9();
} -match regexp -errorOutput {\d+: enter fntrace_9
\d+: enter fntrace_9_entry
\d+: exit fntrace_9_exit ret ''
\d+: exit fntrace_9 ret ''
}

test fntrace-10.1 {test L_TRACE environment variable, output to file} -setup {
	set fname [makeFile {
#pragma fntrace=on
		void main() {}
	} fntrace101.l]
} -body {
#lang L --line=1
void fntrace_10_1()
{
	int	ret;
	FILE	f;
	string	tclsh = eval("interpreter");

	unlink("fntrace10_1.out");
	putenv("L_TRACE=fntrace10_1.out");
	ret = system({tclsh, "fntrace101.l"}, undef, undef, undef);
	unless (ret == 0) puts("bad ret ${ret}");

	unless (f = fopen("fntrace10_1.out", "r")) puts("bad 1");
	unless (<f> =~ /enter main/) puts("bad 2");
	unless (<f> =~ /exit main/) puts("bad 3");
	fclose(f);

	putenv("L_TRACE=");
	unset("::env(L_TRACE)");
	unlink("fntrace10_1.out");
}
fntrace_10_1();
} -cleanup {
	removeFile $fname
} -output {}

test fntrace-10.2 {test L_TRACE environment variable, output to socket} -setup {
	set fname1 [makeFile {
#pragma fntrace=on
		void main() {}
	} fntrace102.l]
	set fname2 [makeFile {
		void cb(FILE sock, _argused string host, _argused int port)
		{
			unless ((<sock> =~ /enter main/) &&
				(<sock> =~ /exit main/)) {
				FILE f = fopen("fntrace_10_bad", "w");
				fclose(f);
			}
			fclose(sock);
			exit(0);
		}
		void main()
		{
			FILE	sock = socket(server: "cb", 0);
			puts(fconfigure(sock, sockname:)[2]);
			vwait("forever");
		}
	} fntrace102_server.l]
} -body {
#lang L --line=1
void fntrace_10_2()
{
	int	port, ret;
	FILE	f;
	string	tclsh = eval("interpreter");

	f = popen("'${tclsh}' fntrace102_server.l 2>fntrace102_err", "r");
	unless (f) {
		puts("bad server ${stdio_lasterr}");
		return;
	}
	port = (int)<f>;
	putenv("L_TRACE=localhost:${port}");
	unlink("fntrace_10_bad");
	ret = system({tclsh, "fntrace102.l"}, undef, undef, undef);
	unless (ret == 0) puts("bad ret ${ret}");
	if (exists("fntrace_10_bad")) puts("bad");
	unlink("fntrace_10_bad");
	unlink("fntrace102_err");
	pclose(f);
	putenv("L_TRACE=");
	unset("::env(L_TRACE)");
}
fntrace_10_2();
} -output {}

test fntrace-10.3 {test L_TRACE_FILES and --trace-files} -setup {
	set fname1 [makeFile {
		void fntrace_10_3_a() {}
	} fntrace_10_3_a.l]
	set fname2 [makeFile {
		void fntrace_10_3_b() {}
	} fntrace_10_3_b.l]
	set fname3 [makeFile {
// #includes have to start at col 1
#include "fntrace_10_3_a.l"
#include "fntrace_10_3_b.l"
		void main()
		{
			fntrace_10_3_a();
			fntrace_10_3_b();
		}
	} fntrace_10_3_c.l]
} -body {
#lang L --line=1
void fntrace_10_3()
{
	int	ret;
	string	err[];
	string	tclsh = eval("interpreter");

	/* First trace only fntrace_10_3_c.l */

	putenv("L_TRACE_FILES=fntrace_10_3_c.l");
	ret = system({tclsh, "fntrace_10_3_c.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 1.1");
	unless (err[0] =~ /enter main/) puts("bad 1.2");
	unless (err[1] =~ /exit main/) puts("bad 1.3");
	if (err[2]) puts("bad 1.4");

	putenv("L_TRACE_FILES=");
	unset("::env(L_TRACE_FILES)");
	ret = system(
	    {tclsh, "--trace-files=fntrace_10_3_c.l", "fntrace_10_3_c.l"},
	    undef, undef, &err);
	unless (ret == 0) puts("bad 1.11");
	unless (err[0] =~ /enter main/) puts("bad 1.12");
	unless (err[1] =~ /exit main/) puts("bad 1.13");
	if (err[2]) puts("bad 1.14");

	// Env var should take precedence over cmd line.
	putenv("L_TRACE_FILES=fntrace_10_3_c.l");
	ret = system({tclsh, "--trace-files=*", "fntrace_10_3_c.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 1.21");
	unless (err[0] =~ /enter main/) puts("bad 1.22");
	unless (err[1] =~ /exit main/) puts("bad 1.23");
	if (err[2]) puts("bad 1.24");

	/* Now trace fntrace_10_3_[ab].l */

	putenv("L_TRACE_FILES=fntrace_10_3_[ab].l");
	ret = system({tclsh, "fntrace_10_3_c.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 2.1");
	unless (err[0] =~ /enter fntrace_10_3_a/) puts("bad 2.2");
	unless (err[1] =~ /exit fntrace_10_3_a/) puts("bad 2.3");
	unless (err[2] =~ /enter fntrace_10_3_b/) puts("bad 2.4");
	unless (err[3] =~ /exit fntrace_10_3_b/) puts("bad 2.5");
	if (err[4]) puts("bad 2.6");

	putenv("L_TRACE_FILES=");
	unset("::env(L_TRACE_FILES)");
	ret = system(
	    {tclsh, "--trace-files=fntrace_10_3_[ab].l","fntrace_10_3_c.l"},
	    undef, undef, &err);
	unless (ret == 0) puts("bad 2.21");
	unless (err[0] =~ /enter fntrace_10_3_a/) puts("bad 2.22");
	unless (err[1] =~ /exit fntrace_10_3_a/) puts("bad 2.23");
	unless (err[2] =~ /enter fntrace_10_3_b/) puts("bad 2.24");
	unless (err[3] =~ /exit fntrace_10_3_b/) puts("bad 2.25");
	if (err[4]) puts("bad 2.26");

	// Env var should take precedence over cmd line.
	putenv("L_TRACE_FILES=fntrace_10_3_[ab].l");
	ret = system({tclsh, "--trace-files=*","fntrace_10_3_c.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 2.31");
	unless (err[0] =~ /enter fntrace_10_3_a/) puts("bad 2.32");
	unless (err[1] =~ /exit fntrace_10_3_a/) puts("bad 2.33");
	unless (err[2] =~ /enter fntrace_10_3_b/) puts("bad 2.34");
	unless (err[3] =~ /exit fntrace_10_3_b/) puts("bad 2.35");
	if (err[4]) puts("bad 2.36");

	/* Now trace them all. */

	putenv("L_TRACE_FILES=*.l");
	ret = system({tclsh, "fntrace_10_3_c.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 3.1");
	unless (err[0] =~ /enter main/) puts("bad 3.2");
	unless (err[1] =~ /enter fntrace_10_3_a/) puts("bad 3.3");
	unless (err[2] =~ /exit fntrace_10_3_a/) puts("bad 3.4");
	unless (err[3] =~ /enter fntrace_10_3_b/) puts("bad 3.5");
	unless (err[4] =~ /exit fntrace_10_3_b/) puts("bad 3.6");
	unless (err[5] =~ /exit main/) puts("bad 3.7");
	if (err[6]) puts("bad 3.8");

	putenv("L_TRACE_FILES=");
	unset("::env(L_TRACE_FILES)");
	ret = system({tclsh, "--trace-files=*", "fntrace_10_3_c.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 3.11");
	unless (err[0] =~ /enter main/) puts("bad 3.12");
	unless (err[1] =~ /enter fntrace_10_3_a/) puts("bad 3.13");
	unless (err[2] =~ /exit fntrace_10_3_a/) puts("bad 3.14");
	unless (err[3] =~ /enter fntrace_10_3_b/) puts("bad 3.15");
	unless (err[4] =~ /exit fntrace_10_3_b/) puts("bad 3.16");
	unless (err[5] =~ /exit main/) puts("bad 3.17");
	if (err[6]) puts("bad 3.18");

	// Env var should take precedence over cmd line.
	putenv("L_TRACE_FILES=*.l");
	ret = system(
	    {tclsh, "--trace-files=fntrace_10_3_c.l", "fntrace_10_3_c.l"},
	    undef, undef, &err);
	unless (ret == 0) puts("bad 3.21");
	unless (err[0] =~ /enter main/) puts("bad 3.22");
	unless (err[1] =~ /enter fntrace_10_3_a/) puts("bad 3.23");
	unless (err[2] =~ /exit fntrace_10_3_a/) puts("bad 3.24");
	unless (err[3] =~ /enter fntrace_10_3_b/) puts("bad 3.25");
	unless (err[4] =~ /exit fntrace_10_3_b/) puts("bad 3.26");
	unless (err[5] =~ /exit main/) puts("bad 3.27");
	if (err[6]) puts("bad 3.28");

	/* Try -fntrace_10_3_b.l */

	putenv("L_TRACE_FILES=*.l:-fntrace_10_3_b.l");
	ret = system({tclsh, "fntrace_10_3_c.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 4.1");
	unless (err[0] =~ /enter main/) puts("bad 4.2");
	unless (err[1] =~ /enter fntrace_10_3_a/) puts("bad 4.3");
	unless (err[2] =~ /exit fntrace_10_3_a/) puts("bad 4.4");
	unless (err[3] =~ /exit main/) puts("bad 4.5");
	if (err[4]) puts("bad 4.6");

	putenv("L_TRACE_FILES=");
	unset("::env(L_TRACE_FILES)");
}
fntrace_10_3();
} -output {}

test fntrace-10.4 {test L_TRACE_FUNCS and --trace-funcs} -setup {
	set fname [makeFile {
			void fntrace_10_4_a() {}
			void fntrace_10_4_b() {}
			void fntrace_10_4()
			{
				fntrace_10_4_a();
				fntrace_10_4_b();
			}
			fntrace_10_4();
	} fntrace_10_4.l]
} -body {
#lang L --line=1
void fntrace_10_4()
{
	int	ret;
	string	err[];
	string	tclsh = eval("interpreter");

	putenv("L_TRACE_FUNCS=fntrace_10_4_a");
	ret = system({tclsh, "fntrace_10_4.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 1.1");
	unless (err[0] =~ /enter fntrace_10_4_a/) puts("bad 1.2");
	unless (err[1] =~ /exit fntrace_10_4_a/) puts("bad 1.3");
	if (err[2]) puts("bad 1.4");

	putenv("L_TRACE_FUNCS=");
	unset("::env(L_TRACE_FUNCS)");
	ret = system({tclsh, "--trace-funcs=fntrace_10_4_a", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 1.11");
	unless (err[0] =~ /enter fntrace_10_4_a/) puts("bad 1.12");
	unless (err[1] =~ /exit fntrace_10_4_a/) puts("bad 1.13");
	if (err[2]) puts("bad 1.14");

	// Env var should take precedence over cmd line.
	putenv("L_TRACE_FUNCS=fntrace_10_4_a");
	ret = system({tclsh, "--trace-funcs=*", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 1.21");
	unless (err[0] =~ /enter fntrace_10_4_a/) puts("bad 1.22");
	unless (err[1] =~ /exit fntrace_10_4_a/) puts("bad 1.23");
	if (err[2]) puts("bad 1.24");


	putenv("L_TRACE_FUNCS=fntrace_10_4_[ab]");
	ret = system({tclsh, "fntrace_10_4.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 2.1");
	unless (err[0] =~ /enter fntrace_10_4_a/) puts("bad 2.2");
	unless (err[1] =~ /exit fntrace_10_4_a/) puts("bad 2.3");
	unless (err[2] =~ /enter fntrace_10_4_b/) puts("bad 2.4");
	unless (err[3] =~ /exit fntrace_10_4_b/) puts("bad 2.5");
	if (err[4]) puts("bad 2.6");

	putenv("L_TRACE_FUNCS=");
	unset("::env(L_TRACE_FUNCS)");
	ret = system({tclsh, "--trace-funcs=fntrace_10_4_[ab]", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 2.11");
	unless (err[0] =~ /enter fntrace_10_4_a/) puts("bad 2.12");
	unless (err[1] =~ /exit fntrace_10_4_a/) puts("bad 2.13");
	unless (err[2] =~ /enter fntrace_10_4_b/) puts("bad 2.14");
	unless (err[3] =~ /exit fntrace_10_4_b/) puts("bad 2.15");
	if (err[4]) puts("bad 2.16");

	// Env var should take precedence over cmd line.
	putenv("L_TRACE_FUNCS=fntrace_10_4_[ab]");
	ret = system({tclsh, "--trace-funcs=*", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 2.21");
	unless (err[0] =~ /enter fntrace_10_4_a/) puts("bad 2.22");
	unless (err[1] =~ /exit fntrace_10_4_a/) puts("bad 2.23");
	unless (err[2] =~ /enter fntrace_10_4_b/) puts("bad 2.24");
	unless (err[3] =~ /exit fntrace_10_4_b/) puts("bad 2.25");
	if (err[4]) puts("bad 2.26");


	putenv("L_TRACE_FUNCS=*");
	ret = system({tclsh, "fntrace_10_4.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 3.1");
	unless (err[0] =~ /enter fntrace_10_4/) puts("bad 3.2");
	unless (err[1] =~ /enter fntrace_10_4_a/) puts("bad 3.3");
	unless (err[2] =~ /exit fntrace_10_4_a/) puts("bad 3.4");
	unless (err[3] =~ /enter fntrace_10_4_b/) puts("bad 3.5");
	unless (err[4] =~ /exit fntrace_10_4_b/) puts("bad 3.6");
	unless (err[5] =~ /exit fntrace_10_4/) puts("bad 3.7");
	if (err[6]) puts("bad 3.8");

	putenv("L_TRACE_FUNCS=");
	unset("::env(L_TRACE_FUNCS)");
	ret = system({tclsh, "--trace-funcs=*", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 3.11");
	unless (err[0] =~ /enter fntrace_10_4/) puts("bad 3.12");
	unless (err[1] =~ /enter fntrace_10_4_a/) puts("bad 3.13");
	unless (err[2] =~ /exit fntrace_10_4_a/) puts("bad 3.14");
	unless (err[3] =~ /enter fntrace_10_4_b/) puts("bad 3.15");
	unless (err[4] =~ /exit fntrace_10_4_b/) puts("bad 3.16");
	unless (err[5] =~ /exit fntrace_10_4/) puts("bad 3.17");
	if (err[6]) puts("bad 3.18");

	// Env var should take precedence over cmd line.
	putenv("L_TRACE_FUNCS=*");
	ret = system({tclsh, "--trace-funcs=fntrace_10_4_a", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 3.21");
	unless (err[0] =~ /enter fntrace_10_4/) puts("bad 3.22");
	unless (err[1] =~ /enter fntrace_10_4_a/) puts("bad 3.23");
	unless (err[2] =~ /exit fntrace_10_4_a/) puts("bad 3.24");
	unless (err[3] =~ /enter fntrace_10_4_b/) puts("bad 3.25");
	unless (err[4] =~ /exit fntrace_10_4_b/) puts("bad 3.26");
	unless (err[5] =~ /exit fntrace_10_4/) puts("bad 3.27");
	if (err[6]) puts("bad 3.28");


	putenv("L_TRACE_FUNCS=*:-fntrace_10_4b");
	ret = system({tclsh, "fntrace_10_4.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 4.1");
	unless (err[0] =~ /enter fntrace_10_4/) puts("bad 4.2");
	unless (err[1] =~ /enter fntrace_10_4_a/) puts("bad 4.3");
	unless (err[2] =~ /exit fntrace_10_4_a/) puts("bad 4.4");
	unless (err[5] =~ /exit fntrace_10_4/) puts("bad 4.5");
	if (err[6]) puts("bad 4.6");

	putenv("L_TRACE_FUNCS=");
	unset("::env(L_TRACE_FUNCS)");
	ret = system({tclsh, "--trace-funcs=*:-fntrace_10_4b", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 4.11");
	unless (err[0] =~ /enter fntrace_10_4/) puts("bad 4.12");
	unless (err[1] =~ /enter fntrace_10_4_a/) puts("bad 4.13");
	unless (err[2] =~ /exit fntrace_10_4_a/) puts("bad 4.14");
	unless (err[5] =~ /exit fntrace_10_4/) puts("bad 4.15");
	if (err[6]) puts("bad 4.16");

	// Env var should take precedence over cmd line.
	putenv("L_TRACE_FUNCS=*:-fntrace_10_4b");
	ret = system({tclsh, "--trace-funcs=*", "fntrace_10_4.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 4.21");
	unless (err[0] =~ /enter fntrace_10_4/) puts("bad 4.22");
	unless (err[1] =~ /enter fntrace_10_4_a/) puts("bad 4.23");
	unless (err[2] =~ /exit fntrace_10_4_a/) puts("bad 4.24");
	unless (err[5] =~ /exit fntrace_10_4/) puts("bad 4.25");
	if (err[6]) puts("bad 4.26");

	putenv("L_TRACE_FUNCS=");
	unset("::env(L_TRACE_FUNCS)");
}
fntrace_10_4();
} -output {}

test fntrace-10.5 {test L_TRACE_SCRIPT and --trace-script, script} -setup {
	set fname [makeFile {
		void foo(_argused int a) {}
		void main()
		{
			foo(123);
		}
	} fntrace_10_5.l]
} -body {
#lang L --line=1
void fntrace_10_5()
{
	int	ret;
	string	out[];
	string	tclsh = eval("interpreter");

	/* Test a trace-hook script in L_TRACE_SCRIPT. */
	putenv("L_TRACE_ALL=on");
	putenv("L_TRACE_SCRIPT=puts(av)");
	ret = system({tclsh, "fntrace_10_5.l"}, undef, &out, undef);
	unless (ret == 0) puts("bad 1.1");
	unless (out[0] == "main") puts("bad 1.2");
	unless (out[1] == "foo 123") puts("bad 1.3");
	unless (out[2] == "foo 123") puts("bad 1.4");
	unless (out[3] == "main") puts("bad 1.5");
	if (out[4]) puts("bad 1.6");
	putenv("L_TRACE_ALL=");
	putenv("L_TRACE_SCRIPT=");
	unset("::env(L_TRACE_ALL)");
	unset("::env(L_TRACE_SCRIPT)");

	/* Test a trace-hook script in --trace-script. */
	ret = system(
	    {tclsh, "--fntrace=on", "--trace-script=puts(av)", "fntrace_10_5.l"},
	    undef, &out, undef);
	unless (ret == 0) puts("bad 1.11");
	unless (out[0] == "main") puts("bad 1.12");
	unless (out[1] == "foo 123") puts("bad 1.13");
	unless (out[2] == "foo 123") puts("bad 1.14");
	unless (out[3] == "main") puts("bad 1.15");
	if (out[4]) puts("bad 1.16");

	/* Try both.  Env variable should take precedence. */
	putenv("L_TRACE_ALL=on");
	putenv("L_TRACE_SCRIPT=puts(av)");
	ret = system(
	    {tclsh, "--fntrace=on --trace-script=puts(33)", "fntrace_10_5.l"},
	    undef, &out, undef);
	unless (ret == 0) puts("bad 1.21");
	unless (out[0] == "main") puts("bad 1.22");
	unless (out[1] == "foo 123") puts("bad 1.23");
	unless (out[2] == "foo 123") puts("bad 1.24");
	unless (out[3] == "main") puts("bad 1.25");
	if (out[4]) puts("bad 1.26");

	putenv("L_TRACE_ALL=");
	putenv("L_TRACE_SCRIPT=");
	/* Needed since L's putenv does not really unset the env var. */
	unset("::env(L_TRACE_ALL)");
	unset("::env(L_TRACE_SCRIPT)");
}
fntrace_10_5();
} -output {}

test fntrace-10.6 {test L_TRACE_SCRIPT and --trace-script, file} -setup {
	set fname1 [makeFile {
		int foo(int a)
		{
			return (a+1);
		}
		int main()
		{
			foo(123);
			return (0);
		}
	} fntrace_10_6.l]
	set fname2 [makeFile {
#pragma fnhook=myhook
		void myhook(int pre, string av[], string ret)
		{
			fprintf(stderr, "my: %d %s %s\n", pre, av, ret);
		}
	} fntrace_10_6_hooks.l]
} -body {
#lang L --line=1
void fntrace_10_6()
{
	int	ret;
	string	err[];
	string	tclsh = eval("interpreter");

	/* Test a trace filename in L_TRACE_SCRIPT. */
	putenv("L_TRACE_ALL=on");
	putenv("L_TRACE_SCRIPT=fntrace_10_6_hooks.l");
	ret = system({tclsh, "fntrace_10_6.l"}, undef, undef, &err);
	unless (ret == 0) puts("bad 1.1");
	unless (err[0] == "my: 1 main 0") puts("bad 1.2");
	unless (err[1] == "my: 1 foo 123 0") puts("bad 1.3");
	unless (err[2] == "my: 0 foo 123 124") puts("bad 1.4");
	unless (err[3] == "my: 0 main 0") puts("bad 1.5");
	if (err[4]) puts("bad 1.6");
	putenv("L_TRACE_ALL=");
	putenv("L_TRACE_SCRIPT=");
	unset("::env(L_TRACE_ALL)");
	unset("::env(L_TRACE_SCRIPT)");

	/* Test a trace filename in --trace-script. */
	ret = system(
	    {tclsh, "--fntrace=on", "--trace-script=fntrace_10_6_hooks.l",
		"fntrace_10_6.l"},
	    undef, undef, &err);
	unless (ret == 0) puts("bad 1.11");
	unless (err[0] == "my: 1 main 0") puts("bad 1.12");
	unless (err[1] == "my: 1 foo 123 0") puts("bad 1.13");
	unless (err[2] == "my: 0 foo 123 124") puts("bad 1.14");
	unless (err[3] == "my: 0 main 0") puts("bad 1.15");
	if (err[4]) puts("bad 1.16");

	/* Try both.  Env variable should take precedence. */
	putenv("L_TRACE_ALL=on");
	putenv("L_TRACE_SCRIPT=fntrace_10_6_hooks.l");
	ret = system({tclsh, "--trace-script=puts(22)", "fntrace_10_6.l"},
		     undef, undef, &err);
	unless (ret == 0) puts("bad 1.21");
	unless (err[0] == "my: 1 main 0") puts("bad 1.22");
	unless (err[1] == "my: 1 foo 123 0") puts("bad 1.23");
	unless (err[2] == "my: 0 foo 123 124") puts("bad 1.24");
	unless (err[3] == "my: 0 main 0") puts("bad 1.25");
	if (err[4]) puts("bad 1.26");

	putenv("L_TRACE_SCRIPT=");
	/* Needed since L's putenv does not really unset the env var. */
	unset("::env(L_TRACE_ALL)");
	unset("::env(L_TRACE_SCRIPT)");
}
fntrace_10_6();
} -output {}

test fntrace-10.7 {test L_TRACE_SCRIPT and --trace-script errors} -setup {
	set fname [makeFile {
		void main() {}
	} fntrace_10_7.l]
} -body {
#lang L --line=1
void fntrace_10_7()
{
	int	ret;
	string	err[];
	string	tclsh = eval("interpreter");

	putenv("L_TRACE_SCRIPT=bad-does-not-exist.l");
	ret = system({tclsh, "fntrace_10_7.l"}, undef, undef, &err);
	unless (ret == 1) puts("bad 1.1");
	unless (err[0] =~ /couldn.t open "bad-does-not-exist.l"/) {
		puts("bad 1.2");
	}
	putenv("L_TRACE_SCRIPT=");
	unset("::env(L_TRACE_SCRIPT)");

	ret = system({tclsh, "--trace-script=bad.l", "fntrace_10_7.l"},
		     undef, undef, &err);
	unless (ret == 1) puts("bad 1.11");
	unless (err[0] =~ /couldn.t open "bad.l"/) {
		puts("bad 1.12");
	}

	putenv("L_TRACE_SCRIPT=");
	/* Needed since L's putenv does not really unset the env var. */
	unset("::env(L_TRACE_SCRIPT)");
}
fntrace_10_7();
} -output {}

test fntrace-11 {test that a hook fn does not get traced} -body {
#lang L --line=1
#pragma fntrace=on, fnhook=fntrace_11_hook
void fntrace_11_hook(int pre, _argused poly av[], _argused poly ret)
{
	printf("%s %s\n", pre ? "entry" : "exit", av[0]);
}
void fntrace_11()
{
}
fntrace_11();
} -output {entry fntrace_11
exit fntrace_11
}

test fntrace-12.1 {test fn _attributes for tracing} -body {
#lang L --line=1
void fntrace_12_1_f1() _attribute (fntrace=on) {}
void fntrace_12_1_f2() {}
void fntrace_12_1_f3() _attribute (fntrace=off) {}
void fntrace_12_1()
{
	fntrace_12_1_f1();
	fntrace_12_1_f2();
	fntrace_12_1_f3();
}
fntrace_12_1();
} -match regexp -errorOutput {\d+: enter fntrace_12_1_f1
\d+: exit fntrace_12_1_f1 ret ''
}

test fntrace-12.2 {test more fn _attributes for tracing} -body {
#lang L --line=1 --trace-out=stdout
#pragma fnhook=def
void fntrace_12_2_hook(int pre, _argused poly av[], _argused poly ret)
{
	printf("%s %s\n", pre ? "entry" : "exit", av[0]);
}
void fntrace_12_2_f1() _attribute (fntrace=on, fnhook=fntrace_12_2_hook) {}
void fntrace_12_2_f2() {}
void fntrace_12_2_f3() _attribute (fntrace=off) {}
void fntrace_12_2_f4() _attribute (fntrace=on) {}
void fntrace_12_2()
{
	fntrace_12_2_f1();
	fntrace_12_2_f2();
	fntrace_12_2_f3();
	fntrace_12_2_f4();
}
fntrace_12_2();
} -match regexp -output {entry fntrace_12_2_f1
exit fntrace_12_2_f1
\d+: enter fntrace_12_2_f4
\d+: exit fntrace_12_2_f4 ret ''
}

test fntrace-13.1 {test run-time function tracing control} -body {
#lang L --line=1
#pragma fntrace=off
int fn13_d = 0;
void fn13(int max)
{
	++fn13_d;
	if (fn13_d < max) fn13(max);
	--fn13_d;
}
void fntrace_13_1_f1() {}
void fntrace_13_1_f2() {}
void fntrace_13_1()
{
	FILE	f;

	fntrace_13_1_f1();
	Ltrace({"fntrace" => "on", "trace_depth" => 3, "trace_out" => stdout});
	fntrace_13_1_f1();
	fn13(100);
	Ltrace({"fntrace" => "entry", "trace_out" => "fn13.out"});
	fntrace_13_1_f1();
	Ltrace({"trace_out" => stdout});
	Ltrace({"fntrace" => "off"});
	fntrace_13_1_f2();
	Ltrace({"trace_funcs" => "fntrace_13_1_f2"});
	fntrace_13_1_f2();
	Ltrace({"fntrace" => "off"});

	unless (f = fopen("fn13.out", "r")) puts("bad 1");
	unless (<f> =~ /\d+: enter fntrace_13_1_f1/) puts("bad 2");
	if (<f>) puts("bad 3");
	unlink("fn13.out");
}
fntrace_13_1();
} -match regexp -output {\d+: enter fntrace_13_1_f1
\d+: exit fntrace_13_1_f1 ret ''
\d+: enter fn13 '100'
\d+: enter fn13 '100'
\d+: exit fn13 '100' ret ''
\d+: exit fn13 '100' ret ''
\d+: enter fntrace_13_1_f2
\d+: exit fntrace_13_1_f2 ret ''
}

test fntrace-13.2 {test run-time disabling of entry or exit traces} -body {
#lang L --line=1
#pragma fntrace=on
void fntrace_13_2_f(poly arg)
{
	Ltrace(arg);
}
void fntrace_13_2() _attribute(fntrace=off)
{
	fntrace_13_2_f({});
	fntrace_13_2_f({"fntrace" => "off"});
	// This next one won't get us exit traces because Tcl won't call
	// the trace of a function if you turn it on while inside that
	// function.
	fntrace_13_2_f({"fntrace" => "on"});
	fntrace_13_2_f({"fntrace" => "entry"});
	fntrace_13_2_f({"fntrace" => "exit"});
	fntrace_13_2_f({"fntrace" => "off"});
}
fntrace_13_2();
} -match regexp -output {\d+: enter fntrace_13_2_f ''
\d+: exit fntrace_13_2_f '' ret ''
\d+: enter fntrace_13_2_f 'fntrace off'
\d+: enter fntrace_13_2_f 'fntrace entry'
\d+: enter fntrace_13_2_f 'fntrace exit'
\d+: exit fntrace_13_2_f 'fntrace exit' ret ''
}

test try-1 {test try/catch} -body {
#lang L
void try_1()
{
	string	err;
	int	caught;

	caught = 0;
	try {
		puts(0/0);
		puts("bad 1.1");
	} catch(&err) {
		++caught;
		unless (err == "divide by zero") puts("bad 1.2");
	}
	unless (caught == 1) puts("bad 1.3");

	caught = 0;
	try {
		puts(0/0);
		puts("bad 2.1");
	} catch {
		++caught;
	}
	unless (caught == 1) puts("bad 2.2");

	puts("got here");  // to verify that we executed code after the catches
}
try_1();
} -output "got here\n"

test try-2 {test nested try/catch} -body {
#lang L
void try_2()
{
	string	err1, err2;
	int	caught1, caught2;

	caught1 = caught2 = 0;
	try {
		puts(0/0);
		puts("bad 1.1");
	} catch(&err1) {
		++caught1;
		unless (err1 == "divide by zero") puts("bad 1.2");
		try {
			puts(0/0);
			puts("bad 1.3");
		} catch(&err2) {
			++caught2;
			unless (err2 == "divide by zero") puts("bad 1.4");
		}
		++caught2;
	}
	unless (caught1 == 1) puts("bad 1.5");
	unless (caught2 == 2) puts("bad 1.6");
	puts("got here");  // to verify that we executed code after the catch
}
try_2();
} -output "got here\n"

test try-3 {test try/catch errors} -body {
#lang L --line=1
void try_3()
{
	string	err;

	try {
		puts(0/0);
	} catch (err) {}  // should be &err

	try {
		puts(0/0);
	} catch (&3) {}

	/*
	 * A call to Tcl's catch() isn't allowed by L (have to use ::catch()).
	 */
	catch("puts bad");
}
try_3();
} -returnCodes error -match regexp -result {.*7: L Error: expected catch\(\&variable\)
.*11: L Error: illegal operand to \&
.*16: L Error: catch\(\) is reserved for try/catch; use ::catch\(\) for Tcl\'s catch
}

::tcltest::cleanupTests
return