Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Psh / Strategy / Perlfunc.pm

package Psh::Strategy::Perlfunc;

=item * C<perlfunc>

Tries to detect perl builtins - this is helpful if you e.g. have
a print command on your system. This is a small, minimal version
without options which will react on your own sub's or on a limited
list of important perl builtins. Please also see the strategy
perlfunc_heavy

=cut

require Psh::Strategy;

@Psh::Strategy::Perlfunc::ISA=('Psh::Strategy');

sub new { Psh::Strategy::new(@_) }

sub consumes {
	return Psh::Strategy::CONSUME_TOKENS;
}

sub runs_before {
	return qw(perlscript auto_resume executable);
}

my %perl_builtins = qw(
 print 1 printf 1 push 1 pop 1 shift 1 unshift 1 system 1
 package 1
 chop 1 chomp 1 use 1 for 1 foreach 1 sub 1 do 1
);

sub applies {
	my @words= @{$_[2]};
	my $line= ${$_[1]};

	my $fnname = $words[0];
	my $parenthesized = 0;

	# catch "join(':',@foo)" here as well:
	if ($fnname =~ m/\(/) {
		$parenthesized = 1;
		$fnname = (split('\(', $fnname))[0];
	}

	my $qPerlFunc = 0;
	if (exists $perl_builtins{$fnname}) {
		my $needArgs = $perl_builtins{$fnname};
		if ($needArgs > 0
			and ($parenthesized
				 or scalar(@{$_[2]}) >= $needArgs)) {
			$qPerlFunc = 1;
		}
	} elsif( $fnname =~ /^([a-zA-Z0-9_]+)\:\:([a-zA-Z0-9_:]+)$/) {
		if( $1 eq 'CORE') {
			my $needArgs = $perl_builtins{$2};
			if ($needArgs > 0
				and ($parenthesized or scalar(@{$_[2]}) >= $needArgs)) {
				$qPerlFunc = 1;
			}
		} else {
			$qPerlFunc = (Psh::PerlEval::protected_eval("defined(&{'$fnname'})"))[0];
		}
	} elsif( $fnname =~ /^[a-zA-Z0-9_]+$/) {
		$qPerlFunc = (Psh::PerlEval::protected_eval("defined(&{'$fnname'})"))[0];
	}

	return $line if $qPerlFunc;
	return '';
}

sub execute {
	my @args= @_;
	$args[4]=undef;
	return Psh::Strategy::Eval::execute(@args);
}

1;