#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
}

$| = 1;
umask 0;
$xref = \ "";
$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
@a = (1..5);
%h = (1..6);
$aref = \@a;
$href = \%h;
open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
$chopit = 'aaaaaa';
@chopar = (113 .. 119);
$posstr = '123456';
$cstr = 'aBcD.eF';
pos $posstr = 3;
$nn = $n = 2;
sub subb {"in s"}

@INPUT = ;
@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
print "1..", (10 + @INPUT + @simple_input), "\n";
$ord = 0;

sub wrn {"@_"}

# Check correct optimization of ucfirst etc
$ord++;
my $a = "AB";
my $b = "\u\L$a";
print "not " unless $b eq 'Ab';
print "ok $ord\n";

# Check correct destruction of objects:
my $dc = 0;
sub A::DESTROY {$dc += 1}
$a=8;
my $b;
{ my $c = 6; $b = bless \$c, "A"}

$ord++;
print "not " unless $dc == 0;
print "ok $ord\n";

$b = $a+5;

$ord++;
print "not " unless $dc == 1;
print "ok $ord\n";

$ord++;
my $xxx = 'b';
$xxx = 'c' . ($xxx || 'e');
print "not " unless $xxx eq 'cb';
print "ok $ord\n";

{				# Check calling STORE
  my $sc = 0;
  sub B::TIESCALAR {bless [11], 'B'}
  sub B::FETCH { -(shift->[0]) }
  sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }

  my $m;
  tie $m, 'B';
  $m = 100;

  $ord++;
  print "not " unless $sc == 1;
  print "ok $ord\n";

  my $t = 11;
  $m = $t + 89;
  
  $ord++;
  print "not " unless $sc == 2;
  print "ok $ord\n";

  $ord++;
  print "# $m\nnot " unless $m == -117;
  print "ok $ord\n";

  $m += $t;

  $ord++;
  print "not " unless $sc == 3;
  print "ok $ord\n";

  $ord++;
  print "# $m\nnot " unless $m == 89;
  print "ok $ord\n";

}

# Chains of assignments

my ($l1, $l2, $l3, $l4);
my $zzzz = 12;
$zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz;

$ord++;
print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot "
  unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13
  and $l2 == 13 and $l3 == 13 and $l4 == 13;
print "ok $ord\n";

for (@INPUT) {
  $ord++;
  ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
  $comment = $op unless defined $comment;
  chomp;
  $op = "$op==$op" unless $op =~ /==/;
  ($op, $expectop) = $op =~ /(.*)==(.*)/;
  
  $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
	  ? "skip" : "# '$_'\nnot";
  $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
  (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
  
  eval <				# glob
				# readline
'faked'				# rcatline
(@z = (1 .. 3))			# aassign
chop $chopit			# chop
(chop (@x=@chopar))		# schop
chomp $chopit			# chomp
(chop (@x=@chopar))		# schomp
pos $posstr			# pos
pos $chopit			# pos returns undef
$nn++==2			# postinc
$nn++==3			# i_postinc
$nn--==4			# postdec
$nn--==3			# i_postdec
$n ** $n			# pow
$n * $n				# multiply
$n * $n				# i_multiply
$n / $n				# divide
$n / $n				# i_divide
$n % $n				# modulo
$n % $n				# i_modulo
$n x $n				# repeat
$n + $n				# add
$n + $n				# i_add
$n - $n				# subtract
$n - $n				# i_subtract
$n . $n				# concat
$n . $a=='2fake'		# concat with self
"3$a"=='3fake'			# concat with self in stringify
"$n"				# stringify
$n << $n			# left_shift
$n >> $n			# right_shift
$n <=> $n			# ncmp
$n <=> $n			# i_ncmp
$n cmp $n			# scmp
$n & $n				# bit_and
$n ^ $n				# bit_xor
$n | $n				# bit_or
-$n				# negate
-$n				# i_negate
~$n				# complement
atan2 $n,$n			# atan2
sin $n				# sin
cos $n				# cos
'???'				# rand
exp $n				# exp
log $n				# log
sqrt $n				# sqrt
int $n				# int
hex $n				# hex
oct $n				# oct
abs $n				# abs
length $posstr			# length
substr $posstr, 2, 2		# substr
vec("abc",2,8)			# vec
index $posstr, 2		# index
rindex $posstr, 2		# rindex
sprintf "%i%i", $n, $n		# sprintf
ord $n				# ord
chr $n				# chr
crypt $n, $n			# crypt
ucfirst ($cstr . "a")		# ucfirst padtmp
ucfirst $cstr			# ucfirst
lcfirst $cstr			# lcfirst
uc $cstr			# uc
lc $cstr			# lc
quotemeta $cstr			# quotemeta
@$aref				# rv2av
@$undefed			# rv2av undef
(each %h) % 2 == 1		# each
values %h			# values
keys %h				# keys
%$href				# rv2hv
pack "C2", $n,$n		# pack
split /a/, "abad"		# split
join "a"; @a			# join
push @a,3==6			# push
unshift @aaa			# unshift
reverse	@a			# reverse
reverse	$cstr			# reverse - scal
grep $_, 1,0,2,0,3		# grepwhile
map "x$_", 1,0,2,0,3		# mapwhile
subb()				# entersub
caller				# caller
warn "ignore this\n"		# warn
'faked'				# die
open BLAH, "