xref: /onnv-gate/usr/src/cmd/perl/contrib/Sun/Solaris/Exacct/t/RandTest (revision 12388:1bc8d55b0dfd)

#!/usr/perl5/bin/perl
#
# Copyright (c) 2003, Oracle and/or its affiliates. All rights reserved.
#

#
# This script is a stress test for ::Exacct and libexacct.
# See README for details.
#

use strict;
use warnings;
use blib;
use POSIX qw(:sys_wait_h);

use Sun::Solaris::Exacct qw(:ALL);
use Sun::Solaris::Exacct::Catalog qw(:ALL);
use Sun::Solaris::Exacct::Object qw(:ALL);
use Sun::Solaris::Exacct::File qw(:ALL);
use Fcntl;

our $exit = 0;
our $ono  = 1;
our $maxono = 1000;	# max = 16777216 (2^24)

#
# Dump an object.
#
sub dump_object
{
	my ($obj, $fh, $indent) = @_;
	$fh ||= \*STDOUT;
	$indent ||= 0;
	my @cat = $obj->catalog()->value();
	my $istr = '  ' x $indent;

	if ($obj->type() == &EO_ITEM) {
		printf $fh ("%sITEM\n%s  Catalog = %s|%s|%d\n",
		   $istr, $istr, @cat);
		$indent++;
		my $val = $obj->value();
		if (ref($val)) {
			dump_object($val, $fh, $indent);
		} else {
			printf $fh ("%s  Value = %s\n", $istr, $val);
		}
	} else {
		printf $fh ("%sGROUP\n%s  Catalog = %s|%s|%d\n",
		    $istr, $istr, @cat);
		$indent++;
		foreach my $val ($obj->value()) {
			dump_object($val, $fh, $indent);
		}
		printf $fh ("%sENDGROUP\n", $istr);
	}
}

#
# Dump a list of objects.
#
sub dump_objects
{
	my ($fh, $objs) = @_;
	foreach my $o (@$objs) {
		dump_object($o, $fh);
	}
}

#
# Build up a set of random objects.
#
sub gen_objs
{
	my ($nobjs, $embed) = @_;
	$nobjs += $ono;
	$embed ||= 0;
	my @objs;
	while ($ono < $nobjs) {
		my $rt = int(rand(9)) + 1;
		$rt = 15 if ($rt >= 9);	# Group.
		$rt <<= 28;
		if ($rt == &EXT_UINT8) {
			push(@objs, ea_new_item($rt | $ono++, 8));
		} elsif ($rt == &EXT_UINT16) {
			push(@objs, ea_new_item($rt | $ono++, 16));
		} elsif ($rt == &EXT_UINT32) {
			push(@objs, ea_new_item($rt | $ono++, 32));
		} elsif ($rt == &EXT_UINT64) {
			push(@objs, ea_new_item($rt | $ono++, 64));
		} elsif ($rt == &EXT_DOUBLE) {
			push(@objs, ea_new_item($rt | $ono++,
			    123456789.123456789));
		} elsif ($rt == &EXT_STRING) {
			push(@objs, ea_new_item($rt | $ono++, "string"));
		} elsif ($rt == &EXT_EXACCT_OBJECT) {
			my $o = $ono++;
			my $i = int(rand($nobjs - $ono)) + 1;
			push(@objs, ea_new_item($rt | $o, gen_objs($i, 1)));
		} elsif ($rt == &EXT_RAW) {
			push(@objs, ea_new_item($rt | $ono++, "RAWrawRAW"));
		} elsif ($rt == &EXT_GROUP) {
			my $o = $ono++;
			my $i = int(rand($nobjs - $ono + 1));
			push(@objs, ea_new_group($rt | $o, gen_objs($i)));
		}

		# If for an embedded object, just return 1 object.
		last if ($embed);
	}
	return(@objs);
}

#
# Main routine.
#
$| = 1;
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $exit = 1; };
my $iters = 0;
while (! $exit) {
	print(".");

	# Generate and output some random records.
	my $f = ea_new_file("/tmp/wr.$$", &O_RDWR | &O_CREAT | &O_TRUNC)
	    || die("\ncreate /tmp/wr.$$ failed: ", ea_error_str(), "\n");
	my @outobjs = gen_objs($maxono);
	$f->write(@outobjs);
	$f = undef;
	open($f, ">/tmp/wr1.$$") || die("\nopen /tmp/wr1.$$ failed: $!\n");
	dump_objects($f, \@outobjs);
	close($f);
	@outobjs = ();

	# Scan the file forwards with next.
	$f = ea_new_file("/tmp/wr.$$", &O_RDONLY)
	    || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
	while ($f->next()) {
		;
	}
	die("\nnext /tmp/wr.$$ failed: ", ea_error_str(), "\n")
	    unless (ea_error() == EXR_EOF);
	$f = undef;

	# Scan the file backwards with previous.
	$f = ea_new_file("/tmp/wr.$$", &O_RDONLY, aflags => &EO_TAIL)
	    || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
	while ($f->previous()) {
		;
	}
	die("\nprevious /tmp/wr.$$ failed: ", ea_error_str(), "\n")
	    unless (ea_error() == EXR_EOF);
	$f = undef;

	# Read the file forwards with get.
	my @inobjs = ();
	$f = ea_new_file("/tmp/wr.$$", &O_RDONLY)
	    || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
	while (my $obj = $f->get()) {
		push(@inobjs, $obj);
	}
	die("\nget /tmp/wr.$$ failed: ", ea_error_str(), "\n")
	    unless (ea_error() == EXR_EOF);
	$f = undef;

	# Dump the objects and compare with original.
	open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n");
	dump_objects($f, \@inobjs);
	close($f);
	if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) {
		die("\nget cmp failed /tmp/wr2.$$\n");
	}

	# Read the file forwards with next and get.
	@inobjs = ();
	$f = ea_new_file("/tmp/wr.$$", &O_RDONLY)
	    || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
	while ($f->next()) {
		my $obj = $f->get();
		push(@inobjs, $obj);
	}
	die("\nnext/get /tmp/wr.$$ failed: ", ea_error_str(), "\n")
	    unless (ea_error() == EXR_EOF);
	$f = undef;

	# Dump the objects and compare with original.
	open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n");
	dump_objects($f, \@inobjs);
	close($f);
	if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) {
		die("\nnext/get cmp failed /tmp/wr2.$$\n");
	}

	# Read the file backwards with previous and get.
	@inobjs = ();
	$f = ea_new_file("/tmp/wr.$$", &O_RDONLY, aflags => &EO_TAIL)
	    || die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
	while ($f->previous()) {
		my $obj = $f->get();
		$f->previous();
		unshift(@inobjs, $obj);
	}
	die("\nprevious/get /tmp/wr.$$ failed: ", ea_error_str(), "\n")
	    unless (ea_error() == EXR_EOF);
	$f = undef;

	# Dump the objects and compare with original.
	open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n");
	dump_objects($f, \@inobjs);
	close($f);
	if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) {
		die("\nprevious/get cmp failed /tmp/wr2.$$\n");
	}

	# Run randtest on the file.
	foreach my $sz (qw(5 10 50 100)) {
		my $s = system ("./randtest 1000 $sz /tmp/wr.$$") >> 8;
		if ($s == 2) {
			$exit = 1;
		} elsif ($s != 0) {
			die("randtest 1000 $sz /tmp/wr.$$ failed $s\n");
		}
	}

	$iters++;
}
unlink("/tmp/wr.$$", "/tmp/wr1.$$", "/tmp/wr2.$$") ||
    die("\nCan't cleanup: $!\n");
print("\n$iters iterations completed\n");