#!perl.exe

use strict;
use warnings;
use IO::Socket;

#####################################################################
# Copyright (c) 2004-2005 IBM Corporation and others.
# All rights reserved. This program and the accompanying materials 
# are made available under the terms of the Eclipse Public License v1.0
# which accompanies this distribution, and is available at
# http://www.eclipse.org/legal/epl-v10.html
# 
# Contributors:
#     Bjorn Freeman-Benson - initial API and implementation
#####################################################################
#
# This test is designed to run on Windows:
#
# cd c:\eclipse\workspace\org.eclipse.debug.examples.core
# perl pdavm\tests\vmtests.pl
#
# If the tests fail, they often indicate that by hanging in an
# infinite loop. Additionally, the vm under test often becomes
# a 100% CPU usage zombie. Use the task manager to kill them.
#
my $socket1;
my $socket2;

sub expect_output {
	my $expect = shift;
	my $line = <PROGRAM_OUTPUT>;
	chomp($line);
	return if( $line eq $expect );
	die "expected output: $expect\nSaw output: $line";
}
sub expect_output_eof {
	my $line = <PROGRAM_OUTPUT>;
	return if( !defined $line );
	die "expected: EOF on output";
}
sub send_command {
	my $string = shift;
	my $expect = shift;
	$expect = "ok" if( !defined $expect );
	#print STDERR "SEND: $string\n";
	print $socket1 "$string\n";
	my $result = <$socket1>;
	chomp($result);
	#print STDERR "RESULT: $result\n";
	die "sent: $string\nexpected: $expect\nsaw:      $result" if( !($result eq $expect) );
}
sub expect_event {
	my $string = shift;
	my $event = <$socket2>;
	chomp($event);
	#print STDERR "EVENT: $event\n";
	die "expected event: $string\nsaw event: $event" if( !($string eq $event) );
}
sub setup_sockets {
	#print STDERR "calling socket 12345\n";
	$socket1 = IO::Socket::INET->new(
			Proto    => "tcp",
			PeerAddr => "localhost",
			PeerPort => "12345",
			Timeout  => 10,
		    )
		  or die "cannot connect to debug socket 12345";
	#print STDERR "calling socket 12346\n";
	$socket2 = IO::Socket::INET->new(
			Proto    => "tcp",
			PeerAddr => "localhost",
			PeerPort => "12346",
			Timeout  => 10,
		    )
		  or die "cannot connect to debug socket 12346";
	#print STDERR "done calling sockets\n";
}

sub test2 {
	print "test2 (common debug commands)..\n";
	
	my $kidpid;
	die "can't fork: $!" unless defined($kidpid = fork());
	if( $kidpid ) {	
		#print STDERR "starting program\n";
		open PROGRAM_OUTPUT, "perl pdavm\\pda.pl pdavm\\tests\\vmtest2.pda -debug 12345 12346 |";
		#print STDERR "done starting program\n";
		expect_output("-debug 12345 12346");
		expect_output("debug connection accepted");
		expect_output("10");
		expect_output_eof();
		exit 0;
	} else {
		setup_sockets();
		expect_event("started");
		# test step
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		# test breakpoint
		send_command("set 4");
		send_command("data", "6|");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended breakpoint 4");
		# test data stack
		send_command("data", "6|7|8|9|");
		send_command("popdata");
		send_command("data", "6|7|8|");
		send_command("pushdata 11");
		send_command("data", "6|7|8|11|");
		send_command("setdata 1 2");
		send_command("data", "6|2|8|11|");
		# test call stack
		send_command("set 12");
		send_command("set 19");
		send_command("stepreturn");
		expect_event("resumed client");
		expect_event("suspended breakpoint 12");
		send_command("clear 19");
		send_command("stack", "pdavm\\tests\\vmtest2.pda|6|main#pdavm\\tests\\vmtest2.pda|18|sub1|m|n#pdavm\\tests\\vmtest2.pda|12|sub2" );
		send_command("stepreturn");
		expect_event("resumed client");
		expect_event("suspended step");
		send_command("stack", "pdavm\\tests\\vmtest2.pda|6|main#pdavm\\tests\\vmtest2.pda|18|sub1|m|n#pdavm\\tests\\vmtest2.pda|13|sub2" );
		send_command("stepreturn");
		expect_event("resumed client");
		expect_event("suspended step");
		send_command("stack", "pdavm\\tests\\vmtest2.pda|6|main#pdavm\\tests\\vmtest2.pda|22|sub1|m|n" );
		send_command("set 6");
		send_command("stepreturn");
		expect_event("resumed client");
		expect_event("suspended breakpoint 6");
		# test set and clear
		send_command("set 27");
		send_command("set 29");
		send_command("set 33");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended breakpoint 33");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended breakpoint 27");
		send_command("clear 33");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended breakpoint 29");
		# test var and setvar
		send_command("set 47");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended breakpoint 47");
		send_command("var 1 b", "4");
		send_command("var 2 b", "2");
		send_command("var 1 a", "0");
		send_command("setvar 1 a 99");
		send_command("data", "6|2|8|11|27|1|4|");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("var 1 a", "99");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("data", "6|2|8|11|27|1|4|99|");
		# test exit
		send_command("exit");
		expect_event("terminated");
	}
	#print STDERR "waiting for child\n";
	wait();
	#print STDERR "child joined\n";
	close PROGRAM_OUTPUT;
	print "test2..SUCCESS\n";
}

sub test3 {
	print "test3 (uncaught events)..\n";
	
	my $kidpid;
	die "can't fork: $!" unless defined($kidpid = fork());
	if( $kidpid ) {	
		#print STDERR "starting program\n";
		open PROGRAM_OUTPUT, "perl pdavm\\pda.pl pdavm\\tests\\vmtest3.pda -debug 12345 12346 |";
		#print STDERR "done starting program\n";
		expect_output("-debug 12345 12346");
		expect_output("debug connection accepted");
		expect_output("10");
		expect_output_eof();
		exit 0;
	} else {
		setup_sockets();
		expect_event("started");
		send_command("resume");
		expect_event("resumed client");
		expect_event("unimplemented instruction foobar");
		expect_event("no such label zippy");
		expect_event("terminated");
	}
	#print STDERR "waiting for child\n";
	wait();
	#print STDERR "child joined\n";
	close PROGRAM_OUTPUT;
	print "test3..SUCCESS\n";
}
sub test4 {
	print "test4 (caught events)..\n";
	
	my $kidpid;
	die "can't fork: $!" unless defined($kidpid = fork());
	if( $kidpid ) {	
		#print STDERR "starting program\n";
		open PROGRAM_OUTPUT, "perl pdavm\\pda.pl pdavm\\tests\\vmtest3.pda -debug 12345 12346 |";
		#print STDERR "done starting program\n";
		expect_output("-debug 12345 12346");
		expect_output("debug connection accepted");
		expect_output("10");
		expect_output_eof();
		exit 0;
	} else {
		setup_sockets();
		expect_event("started");
		send_command("eventstop unimpinstr 1");
		send_command("resume");
		expect_event("resumed client");
		expect_event("unimplemented instruction foobar");
		expect_event("suspended event unimpinstr");
		send_command("eventstop unimpinstr 0");
		send_command("resume");
		expect_event("resumed client");
		expect_event("unimplemented instruction foobar");
		expect_event("no such label zippy");
		expect_event("terminated");
	}
	#print STDERR "waiting for child\n";
	wait();
	#print STDERR "child joined\n";
	close PROGRAM_OUTPUT;
	print "test4..SUCCESS\n";
}
sub test5 {
	print "test5 (caught events)..\n";
	
	my $kidpid;
	die "can't fork: $!" unless defined($kidpid = fork());
	if( $kidpid ) {	
		#print STDERR "starting program\n";
		open PROGRAM_OUTPUT, "perl pdavm\\pda.pl pdavm\\tests\\vmtest3.pda -debug 12345 12346 |";
		#print STDERR "done starting program\n";
		expect_output("-debug 12345 12346");
		expect_output("debug connection accepted");
		expect_output("10");
		expect_output_eof();
		exit 0;
	} else {
		setup_sockets();
		expect_event("started");
		send_command("eventstop nosuchlabel 1");
		send_command("resume");
		expect_event("resumed client");
		expect_event("unimplemented instruction foobar");
		expect_event("no such label zippy");
		expect_event("suspended event nosuchlabel");
		send_command("eventstop nosuchlabel 0");
		send_command("resume");
		expect_event("resumed client");
		expect_event("no such label zippy");
		expect_event("terminated");
	}
	#print STDERR "waiting for child\n";
	wait();
	#print STDERR "child joined\n";
	close PROGRAM_OUTPUT;
	print "test5..SUCCESS\n";
}
sub test6 {
	print "test6 (watch points)..\n";
	
	my $kidpid;
	die "can't fork: $!" unless defined($kidpid = fork());
	if( $kidpid ) {	
		#print STDERR "starting program\n";
		open PROGRAM_OUTPUT, "perl pdavm\\pda.pl pdavm\\tests\\vmtest6.pda -debug 12345 12346 |";
		#print STDERR "done starting program\n";
		expect_output("-debug 12345 12346");
		expect_output("debug connection accepted");
		expect_output("8");
		expect_output_eof();
		exit 0;
	} else {
		setup_sockets();
		expect_event("started");
		send_command("watch inner::a 1");
		send_command("watch main::a 2");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended watch write main::a");
		send_command("stack", "pdavm\\tests\\vmtest6.pda|4|main|a|b");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended watch read inner::a");
		send_command("stack", "pdavm\\tests\\vmtest6.pda|10|main|a|b#pdavm\\tests\\vmtest6.pda|25|inner|a|c");
		send_command("watch inner::a 0");
		send_command("resume");
		expect_event("resumed client");
		expect_event("terminated");
	}
	#print STDERR "waiting for child\n";
	wait();
	#print STDERR "child joined\n";
	close PROGRAM_OUTPUT;
	print "test6..SUCCESS\n";
}
sub test7 {
	print "test7 (eval)..\n";
	
	my $kidpid;
	die "can't fork: $!" unless defined($kidpid = fork());
	if( $kidpid ) {	
		#print STDERR "starting program\n";
		open PROGRAM_OUTPUT, "perl pdavm\\pda.pl pdavm\\tests\\vmtest6.pda -debug 12345 12346 |";
		#print STDERR "done starting program\n";
		expect_output("-debug 12345 12346");
		expect_output("debug connection accepted");
		expect_output("8");
		expect_output_eof();
		exit 0;
	} else {
		setup_sockets();
		expect_event("started");
		send_command("set 25");
		send_command("resume");
		expect_event("resumed client");
		expect_event("suspended breakpoint 25");
		#
		send_command("eval push%204|push%205|add");
		expect_event("resumed client");
		expect_event("evalresult 9");
		expect_event("suspended eval");
		#
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("stack", "pdavm\\tests\\vmtest6.pda|10|main|a|b#pdavm\\tests\\vmtest6.pda|26|inner|a|c");
 		send_command("data", "4|4|");
 		send_command("eval call%20other");
		expect_event("resumed client");
		expect_event("evalresult 15");
		expect_event("suspended eval");
		send_command("stack", "pdavm\\tests\\vmtest6.pda|10|main|a|b#pdavm\\tests\\vmtest6.pda|26|inner|a|c");
 		send_command("data", "4|4|");
		send_command("resume");
		expect_event("resumed client");
		expect_event("terminated");
	}
	#print STDERR "waiting for child\n";
	wait();
	#print STDERR "child joined\n";
	close PROGRAM_OUTPUT;
	print "test7..SUCCESS\n";
}
sub test1 {
	print "test1 (normal run mode)..\n";
	open PROGRAM_OUTPUT, "perl pdavm\\pda.pl examples\\example.pda |" or die $!;
	expect_output("\"hello\"");
	expect_output("\"barfoo\"");
	expect_output("\"first\"");
	expect_output("\"second\"");
	expect_output("12");
	expect_output("11");
	expect_output("10");
	expect_output("\"barfoo\"");
	expect_output("\"first\"");
	expect_output("\"second\"");
	expect_output("\"end\"");
	expect_output_eof();
	print "test1..SUCCESS\n";
}
sub test8 {
	print "test8 (drop to frame)..\n";
	
	my $kidpid;
	die "can't fork: $!" unless defined($kidpid = fork());
	if( $kidpid ) {	
		#print STDERR "starting program\n";
		open PROGRAM_OUTPUT, "perl pdavm\\pda.pl pdavm\\tests\\vmtest8.pda -debug 12345 12346 |";
		#print STDERR "done starting program\n";
		expect_output("-debug 12345 12346");
		expect_output("debug connection accepted");
		expect_output("1");
		expect_output_eof();
		exit 0;
	} else {
		setup_sockets();
		expect_event("started");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("stack", "pdavm\\tests\\vmtest8.pda|2|main|a#pdavm\\tests\\vmtest8.pda|8|inner|b#pdavm\\tests\\vmtest8.pda|12|inner2|c");
		send_command("drop");
		expect_event("suspended drop");
		send_command("stack", "pdavm\\tests\\vmtest8.pda|2|main|a#pdavm\\tests\\vmtest8.pda|7|inner|b");
		send_command("step");
		expect_event("resumed step");
		expect_event("suspended step");
		send_command("stack", "pdavm\\tests\\vmtest8.pda|2|main|a#pdavm\\tests\\vmtest8.pda|8|inner|b#pdavm\\tests\\vmtest8.pda|10|inner2");
		send_command("resume");
		expect_event("resumed client");
		expect_event("terminated");
	}
	#print STDERR "waiting for child\n";
	wait();
	#print STDERR "child joined\n";
	close PROGRAM_OUTPUT;
	print "test8..SUCCESS\n";
}

#
# Run the tests
#
test1();
test2();
test3();
test4();
test5();
test6();
test7();
test8();
print "All tests complete\n";