summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm342
1 files changed, 0 insertions, 342 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm b/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm
deleted file mode 100644
index b15b996995c..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/MakeDepend.pm
+++ /dev/null
@@ -1,342 +0,0 @@
-package Tk::MakeDepend;
-use strict;
-use vars qw(%define);
-use Config;
-
-my @include;
-
-use Carp;
-
-$SIG{__DIE__} = \&Carp::confess;
-
-
-use vars qw($VERSION);
-$VERSION = '4.015';
-
-sub scan_file;
-
-sub do_include
-{
- my ($inc,$dep,@include) = @_;
- foreach my $dir (@include)
- {
- my $path = "$dir/$inc";
- if (-f $path)
- {
- scan_file($path,$dep) unless exists $dep->{$path};
- return;
- }
- }
- warn "Cannot find '$inc' assume made\n";
- $dep->{$inc} = 1;
-}
-
-sub remove_comment
-{
- s#^\s*/\*.*?\*/\s*##g;
-}
-
-
-sub term
-{
- remove_comment();
- return !term() if s/^\s*!//;
- return exists($define{$1}) if s/^\s*defined\s*\(([_A-Za-z][_\w]*)\s*\)//;
- return exists($define{$1}) if s/^\s*defined\s*([_A-Za-z][_\w]*)//;
- return eval "$1" if s/^\s*(0x[0-9a-f]+)L?//i;
- return $1 if s/^\s*(\d+)L?//;
- return $define{$1} || 0 if s/^\s*([_A-Za-z][_\w]*)//;
- if (s/^\s*\(//)
- {
- my $val = expression(0);
- warn "Missing ')'\n" unless s/^\s*\)//;
- return $val;
- }
- warn "Invalid term:$_";
- return undef;
-}
-
-my %pri = ( '&&' => 4,
- '||' => 3,
- '>=' => 2, '<=' => 2, '<' => 2, '>' => 2,
- '==' => 1, '!=' => 1 );
-
-sub expression
-{
- my $pri = shift;
- # printf STDERR "%d# expr . $_\n";
- my $invert = 0;
- my $lhs = term() || 0;
- remove_comment();
- while (/^\s*(&&|\|\||>=?|<=?|==|!=)/)
- {
- my $op = $1;
- last unless ($pri{$op} >= $pri);
- s/^\s*\Q$op\E//;
- # printf STDERR "%d# $lhs $op . $_\n";
- my $rhs = expression($pri{$op}) || 0;
- my $e = "$lhs $op $rhs";
- $lhs = eval "$e" || 0;
- die "'$e' $@" if $@;
- remove_comment();
- }
- return $lhs;
-}
-
-sub do_if
-{
- my ($key,$expr) = @_;
- chomp($expr);
- if ($key eq 'ifdef' || $key eq 'ifndef')
- {
- if ($expr =~ /^\s*(\w+)/)
- {
- my $val = exists $define{$1};
- $val = !$val if ($key eq 'ifndef');
-# printf STDERR "%d from $key $expr\n",$val;
- return $val;
- }
- }
- else
- {
- local $_ = $expr;
- my $val = expression(0) != 0;
- warn "trailing: $_" if /\S/;
- #printf STDERR "%d from $key $expr\n",$val;
- return $val;
- }
-}
-
-sub scan_file
-{
- no strict 'refs';
- my ($file,$dep) = @_;
- open($file,"<$file") || die "Cannot open $file:$!";
- local $_;
- my ($srcdir) = $file =~ m#^(.*)[\\/][^\\/]*$#;
- $srcdir = '.' unless defined $srcdir;
- my $live = 1;
- $dep->{$file} = 1;
- my @stack;
- while (<$file>)
- {
- $_ .= <$file> while (s/\\\n/ /);
- if (/^\s*#\s*(\w+)\s*(.*?)\s*$/)
- {
- my $ol = $live;
- my $key = $1;
- my $rest = $2;
- if ($key =~ /^if(.*)$/)
- {
- push(@stack,$live);
- $live &&= do_if($key,$rest);
- }
- elsif ($key eq 'elif')
- {
- $live = ($live) ? 0 : $stack[-1];
- $live &&= do_if('if',$rest);
- }
- elsif ($key eq 'else')
- {
- $live = ($live) ? 0 : $stack[-1];
- }
- elsif ($key eq 'endif')
- {
- if (@stack)
- {
- $live = pop(@stack);
- }
- else
- {
- die "$file:$.: Mismatched #endif\n";
- }
- }
- elsif ($live)
- {
- if ($key eq 'include')
- {
- do_include($1,$dep,$srcdir,@include) if $rest =~ /^"(.*)"/;
- }
- elsif ($key eq 'define')
- {
- if ($rest =~ /^\s*([_A-Za-z][\w_]*)\s*(.*)$/)
- {
- my $sym = $1;
- my $val = $2 || 1;
- $val =~ s#\s*/\*.*?\*/\s*# #g;
- $define{$sym} = $val;
- }
- else
- {
- warn "ignore '$key $rest'\n";
- }
- }
- elsif ($key eq 'undef')
- {
- if ($rest =~ /^\s*([_A-Za-z][\w_]*)/)
- {
- delete $define{$1};
- }
- }
- elsif ($key =~ /^(line|pragma)$/)
- {
-
- }
- else
- {
- warn "ignore '$key $rest'\n";
- }
- }
- # printf STDERR "$file:$.: %d $key $rest\n",$live if ($ol != $live);
- }
- else
- {
- # print if $live;
- }
- }
- close($file);
- if (@stack)
- {
- warn "$file:$.: unclosed #if\n";
- }
-}
-
-sub command_line
-{
- @include = ();
- local %define = ('__STDC__' => 1 );
- my $data = '';
- my @files;
- while (@_ && $_[-1] !~ /^-/)
- {
- unshift(@files,pop(@_));
- }
- my $flags = $Config{ccflags};
- $flags =~ s/^\s+|\s+$//g;
- my @opt = (@_, split(/\s+/,$flags));
- while (@opt)
- {
- local $_ = shift(@opt);
- if (/^-I(.*)$/)
- {
- push @include,$1;
- }
- elsif (/^-D([^=]+)(?:=(.*))?$/)
- {
- $define{$1} = $2 || 1;
- }
- elsif (/^-U(.*)$/)
- {
- delete $define{$1};
- }
- elsif (/^(-.*)$/)
- {
- # Some option
- if ($opt[0] !~ /^-/)
- {
- # next arg does not start with '-' assume it
- # belongs to this option and discard it silently
- shift(@opt);
- }
- }
- else
- {
- # We got confused
- warn "Ignoring $1\n";
- }
- }
- # force /usr/include (and other system directories) to be last element of @include
- if ($Config{ccname} eq 'gcc')
- {
- push @include, parse_gcc_inc_search_list();
- }
- else
- {
- push @include, $Config{'usrinc'}
- if (defined $Config{'usrinc'} and $Config{'usrinc'} ne '');
- }
- # warn "Include:@include\n";
- while (@files)
- {
- local $_ = shift(@files);
- unless (/^(.*)\.[^\.]+$/)
- {
- warn "Skip $_";
- next;
- }
- local %define = %define;
- my $base = $1;
- my $file = $_;
- my %dep;
- warn "Finding dependencies for $file\n";
- scan_file($_,\%dep);
- my $str = "\n$base\$(OBJ_EXT) : $base.c";
- delete $dep{$file};
- my @dep = (sort(keys %dep));
- while (@dep)
- {
- my $dep = shift(@dep);
- $dep =~ s#^\./##;
- if (length($str)+length($dep) > 70)
- {
- $data .= "$str \\\n";
- $str = ' ';
- }
- else
- {
- $str .= ' ';
- }
- $str .= $dep;
- }
- $data .= "$str\n";
- }
- return $data;
-}
-
-sub parse_gcc_inc_search_list
-{
- our @GCC_INC_SEARCH_LIST;
- return @GCC_INC_SEARCH_LIST if @GCC_INC_SEARCH_LIST;
-
- require File::Spec;
- my $cmd = "$Config{cc} -xc -E -v -";
- my @inc;
- eval
- {
- open my $fh, "-|", "$cmd 2>&1 <".File::Spec->devnull
- or die "Error while running $cmd: $!";
-
- my $in_search_list;
- while(<$fh>)
- {
- if (/^#include <\.\.\.> search starts here:/)
- {
- $in_search_list = 1;
- }
- elsif ($in_search_list)
- {
- last if /^End of search list/;
- chomp;
- s/^\s+//;
- push @inc, $_;
- }
- }
- };
- if ($@)
- {
- warn $@;
- }
- if (!@inc)
- {
- # Fallback: add /usr/include
- @inc = $Config{'usrinc'}
- if (defined $Config{'usrinc'} and $Config{'usrinc'} ne '');
- }
- @GCC_INC_SEARCH_LIST = @inc;
- @inc;
-}
-
-1;
-__END__
-
-