simpletest.sh: Use $PERL environment variable. git-svn-id: https://svn.code.sf.net/p/jode/code/trunk@1248 379699f6-c40d-0410-875b-85095c16579emaster
parent
3378492cd3
commit
39d1fbb31b
@ -0,0 +1,184 @@ |
|||||||
|
#!/usr/bin/perl -s -w |
||||||
|
# |
||||||
|
# javaDependencies Copyright (C) 1999 Jochen Hoenicke. |
||||||
|
# |
||||||
|
# This program is free software; you can redistribute it and/or modify |
||||||
|
# it under the terms of the GNU General Public License as published by |
||||||
|
# the Free Software Foundation; either version 2, or (at your option) |
||||||
|
# any later version. |
||||||
|
# |
||||||
|
# This program is distributed in the hope that it will be useful, |
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||||
|
# GNU General Public License for more details. |
||||||
|
# |
||||||
|
# You should have received a copy of the GNU General Public License |
||||||
|
# along with this program; see the file COPYING. If not, write to |
||||||
|
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
||||||
|
# |
||||||
|
# $Id$ |
||||||
|
|
||||||
|
# This scripts create Makefile dependencies out of class files. It |
||||||
|
# simply scans the constant pool of the class files, finding all |
||||||
|
# references to other classes and adding a dependency to that class. |
||||||
|
# |
||||||
|
# It doesn't do a perfect job, since it can't handle dependencies to |
||||||
|
# constant values in different classes: The compiler inlines the |
||||||
|
# constant and thus doesn't include a reference to the class. |
||||||
|
# |
||||||
|
# Usage: |
||||||
|
# javaDependencies.pl -classpath <cp> [-dependdir <depdir> [-subdir <subdir>]] |
||||||
|
# [-depfile <depfile>] |
||||||
|
# <classfiles> |
||||||
|
# |
||||||
|
# cp: colon separated paths to the java files we should depend on. |
||||||
|
# depdir: if set, use this path as path to the java files when printing |
||||||
|
# dependencies, not the path where the java files were found. |
||||||
|
# useful, if you want to make use of VPATH settings in Makefile. |
||||||
|
# subdir: if set, this is the path from depdir to the current directory. |
||||||
|
# Use it to remove unneccessary ../../$subdir/ |
||||||
|
# depfile: the name of the dependency file, default is "Makefile.dep". |
||||||
|
# class: The class files (not inner classes) for which the dependencies |
||||||
|
# should be generated. We will also look for inner and anon |
||||||
|
# classes. |
||||||
|
|
||||||
|
my $buff; |
||||||
|
|
||||||
|
sub readInBuff ($) { |
||||||
|
my $count = $_[0]; |
||||||
|
my $offset = 0; |
||||||
|
while ($count > 0) { |
||||||
|
my $result; |
||||||
|
$result = read FILE, $buff, $count, $offset or return 0; |
||||||
|
$offset += $result; |
||||||
|
$count -= $result; |
||||||
|
} |
||||||
|
$offset; |
||||||
|
} |
||||||
|
|
||||||
|
sub readUTF () { |
||||||
|
readInBuff 2 or die "Can't read UTF8 length"; |
||||||
|
my $ulength = unpack("n", $buff) & 0xffff; |
||||||
|
return "" if $ulength == 0; |
||||||
|
readInBuff $ulength or die "Can't read UTF8 string $ulength"; |
||||||
|
unpack("a$ulength", $buff); |
||||||
|
} |
||||||
|
|
||||||
|
$depfile = "Makefile.dep" if (!defined($depfile)); |
||||||
|
open DEPFILE, ">$depfile"; |
||||||
|
print DEPFILE <<EOF; |
||||||
|
# This dependency file is automatically created by $0 from class files. |
||||||
|
# Do not edit. |
||||||
|
|
||||||
|
EOF |
||||||
|
foreach $clazz (@ARGV) { |
||||||
|
next if $clazz =~ (/^.*\$.*\.class/); |
||||||
|
$clazz =~ /([^\$]*)(\$.*)?\.class/ or die "not a class file"; |
||||||
|
$base = $1; |
||||||
|
my ($filename, %done); |
||||||
|
%done=(); |
||||||
|
for $filename ($clazz, glob("$base\\\$*.class")) { |
||||||
|
open FILE, $filename; |
||||||
|
binmode FILE; |
||||||
|
|
||||||
|
readInBuff 8 or die "Can't read header"; |
||||||
|
my ($magic, $minor, $major) = unpack("Nnn", $buff); |
||||||
|
|
||||||
|
die "Wrong magic $magic" if $magic != 0xcafebabe; |
||||||
|
die "Wrong minor $minor" if $minor > 3; |
||||||
|
die "Wrong minor $major" if $major != 45; |
||||||
|
|
||||||
|
readInBuff 2 or die "Can't read cpool length"; |
||||||
|
|
||||||
|
|
||||||
|
my ($length) = unpack("n", $buff) & 0xffff; |
||||||
|
|
||||||
|
my $number; |
||||||
|
my @strings = (); |
||||||
|
my @clazzes; |
||||||
|
for ($number = 1; $number < $length; $number++) { |
||||||
|
|
||||||
|
readInBuff 1 or die "Can't read constant tag"; |
||||||
|
my ($tag) = unpack("C", $buff); |
||||||
|
|
||||||
|
#print STDERR "$number/$length: $tag"; |
||||||
|
tags: |
||||||
|
for ($tag) { |
||||||
|
/^1$/ && do { |
||||||
|
# UTF 8 |
||||||
|
$strings[$number] = &readUTF(); |
||||||
|
#print STDERR ": $strings[$number]"; |
||||||
|
last tags; |
||||||
|
}; |
||||||
|
|
||||||
|
/^(3|4|9|10|11|12)$/ && do { |
||||||
|
# INTEGER, FLOAT, FIELDREF, METHODREF, IFACEREF, NAMEANDTYPE |
||||||
|
readInBuff 4; |
||||||
|
last tags; |
||||||
|
}; |
||||||
|
|
||||||
|
/^(5|6)$/ && do { |
||||||
|
# LONG, DOUBLE |
||||||
|
readInBuff 8; |
||||||
|
$number++; |
||||||
|
last tags; |
||||||
|
}; |
||||||
|
|
||||||
|
/^7$/ && do { |
||||||
|
# CLASS |
||||||
|
readInBuff 2; |
||||||
|
push @clazzes, (unpack("n", $buff) & 0xffff); |
||||||
|
last tags; |
||||||
|
}; |
||||||
|
|
||||||
|
/^8$/ && do { |
||||||
|
# STRING |
||||||
|
readInBuff 2; |
||||||
|
last tags; |
||||||
|
}; |
||||||
|
die "Unknown tag: $tag, $number/$length, $filename"; |
||||||
|
} |
||||||
|
#print STDERR "\n"; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
my @deplist = (); |
||||||
|
clazz: |
||||||
|
for $c (@clazzes) { |
||||||
|
$clzz = $strings[$c]; |
||||||
|
next if $clzz =~ /^\[/; |
||||||
|
next if defined $done{"$clzz"}; |
||||||
|
$done{$clzz} = 1; |
||||||
|
|
||||||
|
my $p; |
||||||
|
for $p (split ':', $classpath) { |
||||||
|
if (-e "$p/$clzz.java") { |
||||||
|
my $path="$p/"; |
||||||
|
if (defined $dependdir) { |
||||||
|
$path = "$dependdir/"; |
||||||
|
if (defined $subdir) { |
||||||
|
my $currsubdir = "$subdir/"; |
||||||
|
while ($currsubdir =~ m<^([A-Za-z0-9]+)/+(.*)>) { |
||||||
|
$currsubdir = $2; |
||||||
|
my $firstcomp = $1; |
||||||
|
if ($clzz =~ m<$firstcomp/(.*)>) { |
||||||
|
my $remain = $1; |
||||||
|
if ($path =~ m<^(|.*/)\.\./+$>) { |
||||||
|
$path = $1; |
||||||
|
$clzz = $remain; |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
push @deplist, "$path$clzz.java"; |
||||||
|
next clazz; |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
if (@deplist) { |
||||||
|
print DEPFILE "$clazz: " . join (" ", @deplist) . "\n"; |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
close DEPFILE; |
@ -0,0 +1,235 @@ |
|||||||
|
#!/usr/bin/perl -w |
||||||
|
# |
||||||
|
# jcpp Copyright (C) 1999 Jochen Hoenicke. |
||||||
|
# |
||||||
|
# This program is free software; you can redistribute it and/or modify |
||||||
|
# it under the terms of the GNU General Public License as published by |
||||||
|
# the Free Software Foundation; either version 2, or (at your option) |
||||||
|
# any later version. |
||||||
|
# |
||||||
|
# This program is distributed in the hope that it will be useful, |
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||||
|
# GNU General Public License for more details. |
||||||
|
# |
||||||
|
# You should have received a copy of the GNU General Public License |
||||||
|
# along with this program; see the file COPYING. If not, write to |
||||||
|
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
||||||
|
# |
||||||
|
# $Id$ |
||||||
|
|
||||||
|
# This is a program to allow conditional compiled code in java files. |
||||||
|
# The key idea is, not to run the file always through the |
||||||
|
# preprocessor, but to modify the java files directly and make use of |
||||||
|
# comments. |
||||||
|
# |
||||||
|
# The comments all have the form /// and start at the beginning of the |
||||||
|
# line to distinguish them from normal comments. You must not use |
||||||
|
# such comments for other purposes. |
||||||
|
# |
||||||
|
# Usage is simple: jcpp -Ddefine1 -Ddefine2 first.java second.java |
||||||
|
# The files should contain comments of the form |
||||||
|
# |
||||||
|
# ///#ifdef JDK12 |
||||||
|
# jdk1.2 code |
||||||
|
# ///#else |
||||||
|
# jdk1.1 code |
||||||
|
# ///#endif |
||||||
|
# |
||||||
|
# After running jcpp the false branch is commented out. If the true |
||||||
|
# branch was commented out it will get commented in. |
||||||
|
# |
||||||
|
# jcpp also definitions, useful for package renaming. The java file |
||||||
|
# must look like this: |
||||||
|
# |
||||||
|
# ///#def COLLECTIONS java.util |
||||||
|
# import java.util.Vector |
||||||
|
# import java.util.ArrayList |
||||||
|
# ///#enddef |
||||||
|
# |
||||||
|
# If jcpp is then called with -DCOLLECTIONS=gnu.java.util.collections |
||||||
|
# it will replace every occurence of java.util (the string in the #def |
||||||
|
# line) with the new value: |
||||||
|
# |
||||||
|
# ///#def COLLECTIONS gnu.java.util.collections |
||||||
|
# import gnu.java.util.collections.Vector |
||||||
|
# import gnu.java.util.collections.ArrayList |
||||||
|
# ///#enddef |
||||||
|
|
||||||
|
my @files; |
||||||
|
my %defs; |
||||||
|
|
||||||
|
for (@ARGV) { |
||||||
|
if ($_ =~ /^-D([^=]*)$/) { |
||||||
|
$defs{$1} = 1; |
||||||
|
} elsif ($_ =~ /^-D([^=]*)=([^=]*)$/) { |
||||||
|
$defs{$1} = $2; |
||||||
|
} else { |
||||||
|
push @files, $_; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
for (@files) { |
||||||
|
# Number of nested #if directives. Initially 0, will be increased |
||||||
|
# on every #if directive and decreased on every #endif directive. |
||||||
|
my $level = 0; |
||||||
|
|
||||||
|
# The number of the outermost level, whose #if directive was |
||||||
|
# false. This is 0, if there wasn't an false #if directive, yet. |
||||||
|
# As long as it is != 0, we comment every line, and ignore |
||||||
|
# directives except for increasing/decreasing $level. |
||||||
|
my $falselevel = 0; |
||||||
|
|
||||||
|
# Tells if an error occured and the transformation shouldn't |
||||||
|
# be done. |
||||||
|
my $error = 0; |
||||||
|
my $changes = 0; |
||||||
|
|
||||||
|
# The list of #def replacements, @replold is the previous value, |
||||||
|
# @replnew the new one. |
||||||
|
my @replold = (); |
||||||
|
my @replnew = (); |
||||||
|
|
||||||
|
my $file = $_; |
||||||
|
open OLD, "<$file" or do { |
||||||
|
print STDERR "Can't open file $file\n"; |
||||||
|
next; |
||||||
|
}; |
||||||
|
open NEW, ">$file.tmp" or do { |
||||||
|
print STDERR "Can't open tmp file $file.tmp\n"; |
||||||
|
next; |
||||||
|
}; |
||||||
|
my $linenr = 0; |
||||||
|
LINE: |
||||||
|
while (<OLD>) { |
||||||
|
$linenr++; |
||||||
|
if (m'^///#') { |
||||||
|
# This is a directive. First we print it out. |
||||||
|
if (m'^///#\s*if') { |
||||||
|
$level++; |
||||||
|
if (m'^///#\s*ifdef\s+(\w+)\s*$') { |
||||||
|
# If there was an outer false #if directive, we ignore the |
||||||
|
# condition. |
||||||
|
next LINE if ($falselevel); |
||||||
|
|
||||||
|
my $label=$1; |
||||||
|
|
||||||
|
# An ifdef directive, look if -D is defined. |
||||||
|
$falselevel = $level |
||||||
|
unless (defined $defs{$label}); |
||||||
|
} elsif (m'^///#\s*ifndef\s+(\w+)\s*$') { |
||||||
|
# If there was an outer false #if directive, we ignore the |
||||||
|
# condition. |
||||||
|
next LINE if ($falselevel); |
||||||
|
|
||||||
|
my $label=$1; |
||||||
|
# An ifndef directive, look if -D is defined |
||||||
|
$falselevel = $level |
||||||
|
if (defined $defs{$label}); |
||||||
|
} elsif (m'^///#\s*if\s+(\w+)\s*(==|!=)\s*(\S+)\s*$') { |
||||||
|
# If there was an outer false #if directive, we ignore the |
||||||
|
# condition. |
||||||
|
next LINE if ($falselevel); |
||||||
|
|
||||||
|
my $label=$1; |
||||||
|
my $value=$3; |
||||||
|
|
||||||
|
# An ifdef directive, look if -D is defined. |
||||||
|
$falselevel = $level |
||||||
|
unless ($2 eq "==" ? $defs{$label} eq $value |
||||||
|
: $defs{$label} ne $value); |
||||||
|
} elsif (m'^///#\s*if\s+(\w+)\s*(>=|<=|>|<)\s*(\S+)\s*$') { |
||||||
|
# If there was an outer false #if directive, we ignore the |
||||||
|
# condition. |
||||||
|
next LINE if ($falselevel); |
||||||
|
|
||||||
|
my $label=$1; |
||||||
|
my $value=$3; |
||||||
|
|
||||||
|
# An ifdef directive, look if -D is defined. |
||||||
|
$falselevel = $level |
||||||
|
unless ($2 eq ">=" ? $defs{$label} >= $value |
||||||
|
: $2 eq "<=" ? $defs{$label} <= $value |
||||||
|
: $2 eq ">" ? $defs{$label} > $value |
||||||
|
: $defs{$label} < $value); |
||||||
|
} |
||||||
|
} elsif (m'^///#\s*else\s*$') { |
||||||
|
# An else directive. We switch from true to false and |
||||||
|
# if level is falselevel we switch from false to true |
||||||
|
if ($level == 0) { |
||||||
|
# An else outside of any directives; warn. |
||||||
|
print STDERR "$file: $linenr: unmatched $_"; |
||||||
|
$error = 1; |
||||||
|
} elsif ($falselevel == $level) { |
||||||
|
$falselevel = 0; |
||||||
|
} elsif ($falselevel == 0) { |
||||||
|
$falselevel = $level; |
||||||
|
} |
||||||
|
} elsif (m'^///#\s*endif\s*$') { |
||||||
|
# set $falselevel to 0, if the false branch is over now. |
||||||
|
$falselevel = 0 if ($falselevel == $level); |
||||||
|
# decrease level. |
||||||
|
if ($level == 0) { |
||||||
|
print STDERR "$file: $linenr: unmatched $_"; |
||||||
|
$error = 1; |
||||||
|
} else { |
||||||
|
$level--; |
||||||
|
} |
||||||
|
} elsif (m'^///#\s*def\s+(\w+)\s+(\S*)$') { |
||||||
|
my $label = $1; |
||||||
|
my $old = $2; |
||||||
|
my $new = $defs{$label}; |
||||||
|
if (defined $new && $new ne $old) { |
||||||
|
push @replold, "$old"; |
||||||
|
push @replnew, "$new"; |
||||||
|
$changes = 1; |
||||||
|
} else { |
||||||
|
push @replnew, ""; |
||||||
|
push @replold, ""; |
||||||
|
} |
||||||
|
} elsif (m'^///#\s*enddef\s*$') { |
||||||
|
pop @replold; |
||||||
|
pop @replnew; |
||||||
|
} else { |
||||||
|
print STDERR "$file: $linenr: ignoring unknown directive $_"; |
||||||
|
$error = 1; |
||||||
|
} |
||||||
|
} elsif (m'^///(.*)') { |
||||||
|
$line = $1; |
||||||
|
if ($falselevel == 0 && $level > 0) { |
||||||
|
# remove comments in true branch, but not in outermost level. |
||||||
|
$_ = "$line\n"; |
||||||
|
$changes = 1; |
||||||
|
} |
||||||
|
} else { |
||||||
|
if ($falselevel != 0) { |
||||||
|
# add comments in false branch |
||||||
|
$_ = "///$_"; |
||||||
|
$changes = 1; |
||||||
|
} |
||||||
|
} |
||||||
|
for ($i = 0; $i < @replold; $i++) { |
||||||
|
$_ =~ s/\Q$replold[$i]\E/$replnew[$i]/ if ($replold[$i] ne ""); |
||||||
|
} |
||||||
|
print NEW $_; |
||||||
|
} |
||||||
|
|
||||||
|
if ($level != 0 || $falselevel != 0) { |
||||||
|
# something got wrong |
||||||
|
print STDERR "$file: unmatched directives: level $level, ". |
||||||
|
"falselevel $falselevel\n"; |
||||||
|
$error = 1; |
||||||
|
} |
||||||
|
|
||||||
|
if ($error == 0) { |
||||||
|
if ($changes == 0) { |
||||||
|
unlink "$file.tmp"; |
||||||
|
} else { |
||||||
|
(rename "$file", "$file.orig" |
||||||
|
and rename "$file.tmp", "$file") |
||||||
|
or print STDERR "$file: Couldn't rename files.\n"; |
||||||
|
} |
||||||
|
} else { |
||||||
|
print STDERR "$file: errors occured, file not transformed.\n"; |
||||||
|
} |
||||||
|
} |
Loading…
Reference in new issue