mirror of
https://github.com/xcat2/xcat-dep.git
synced 2024-11-25 02:50:10 +00:00
311 lines
8.4 KiB
Perl
Executable File
311 lines
8.4 KiB
Perl
Executable File
#!../../perl
|
|
##
|
|
## test.syms -- test for function/variable symbols
|
|
##
|
|
## Set the environment variable CURSES_VERBOSE to see the details of the
|
|
## testing.
|
|
|
|
## Copyright (c) 1994-2000 William Setzer
|
|
##
|
|
## You may distribute under the terms of either the Artistic License
|
|
## or the GNU General Public License, as specified in the README file.
|
|
##
|
|
## This program is modelled after parts of the dist-3.0 distribution.
|
|
## In many cases I just hand-converted the sh script to perl, so this
|
|
## program probably falls under the Artistic license. At the very least,
|
|
## it has the "look and feel". Will I be sued? :-)
|
|
##
|
|
## Thanks to Raphael Manfredi and the other contributors of dist-3.0.
|
|
##
|
|
## VMS patches thanks to Peter Prymmer <pvhp@forte.com>
|
|
|
|
use strict;
|
|
use warnings;
|
|
use English;
|
|
|
|
my $verbose;
|
|
|
|
sub makeCompileCommand($) {
|
|
my ($compileR) = @_;
|
|
|
|
# Get a compile command so we can test for curses symbols.
|
|
# (There has got to be an easier way. Blech.)
|
|
#
|
|
|
|
my $compile = '#CC# #DEFS# #INCS# #CFLAGS# #FILE# #LFLAGS# #LIBS#' .
|
|
($verbose ? '' : '#NULL#');
|
|
my $makefile = ($OSNAME =~ /VMS/) ? "Descrip.MMS" : "Makefile";
|
|
|
|
my ($cc, $inc, $ccflags, $ldloadlibs, $lddlflags);
|
|
|
|
open MAKEFILE, "< $makefile" or
|
|
die "Can't open make file '$makefile' errno=$ERRNO";
|
|
while (<MAKEFILE>) {
|
|
|
|
if (/^CC\s*=\s*(.*)/) {
|
|
$cc = $1;
|
|
} elsif (/^INC\s*=\s*(.*)/) {
|
|
$inc = $1;
|
|
} elsif (/^CCFLAGS\s*=\s*(.*)/) {
|
|
$ccflags = $1;
|
|
} elsif (/^LDLOADLIBS\s*=\s*(.*)/) {
|
|
$ldloadlibs = $1;
|
|
} elsif (/^LDDLFLAGS\s*=\s*(.*)/) {
|
|
$lddlflags = $1;
|
|
}
|
|
}
|
|
|
|
if (defined($cc)) {
|
|
$compile =~ s{#CC#}{$cc};
|
|
}
|
|
if (defined($inc)) {
|
|
$compile =~ s{#INCS#}{$inc};
|
|
}
|
|
if (defined($ccflags)) {
|
|
$compile =~ s{#CFLAGS#}{$ccflags};
|
|
}
|
|
if (defined($ldloadlibs)) {
|
|
$compile =~ s{#LIBS#}{$ldloadlibs};
|
|
} else {
|
|
$compile =~ s{#LIBS#}{};
|
|
}
|
|
if (defined($lddlflags)) {
|
|
## Only get -L's. Other options can cause strange link behavior.
|
|
## (I shoulda stayed in bed.)
|
|
#
|
|
my $lflags;
|
|
$lflags = ''; # initial value
|
|
while ($lddlflags =~ m{(-L\S+)}g) {
|
|
$lflags .= " $1";
|
|
}
|
|
$compile =~ s{#LFLAGS#}{$lflags};
|
|
}
|
|
close MAKEFILE;
|
|
|
|
# Left to handle: DEFS/FILE/NULL
|
|
# DEFS => "cc" define of "SYM" to "_C_SYM_"
|
|
# FILE => "cc" compile of file _C_FILE_.c into executable _C_FILE_
|
|
# NULL => output of system call to dev null
|
|
#
|
|
# _C_SYM_ and _C_FILE_ will be filled in later
|
|
|
|
if ($OSNAME =~ m{VMS}i) {
|
|
$compile =~ s{#DEFS#}{DEFINE=SYM="_C_SYM_"};
|
|
$compile =~ s{#FILE#}{_C_FILE_.c};
|
|
$compile =~ s{#NULL#}{}; # no non-verbose way
|
|
}
|
|
elsif ($OSNAME eq 'MSWin32') {
|
|
$compile =~ s{#DEFS#}{-DSYM="_C_SYM_"};
|
|
$compile =~ s{#FILE#}{_C_FILE_.c};
|
|
$compile =~ s{#NULL#}{>nul 2>&1};
|
|
}
|
|
else {
|
|
$compile =~ s{#DEFS#}{-DSYM="_C_SYM_"};
|
|
$compile =~ s{#FILE#}{-o _C_FILE_ _C_FILE_.c};
|
|
$compile =~ s{#NULL#}{>/dev/null 2>&1};
|
|
}
|
|
|
|
if ($compile =~ m{#.+#}) {
|
|
die "OOPS: internal error constructing a compile command. " .
|
|
"We failed to substitute for a #xxx# substitution variable " .
|
|
"and thus ended up with this: '$compile'\n";
|
|
}
|
|
$$compileR = $compile;
|
|
}
|
|
|
|
|
|
|
|
###############################################################################
|
|
# MAINLINE #
|
|
###############################################################################
|
|
|
|
print("Checking capabilities of the Ncurses libraries.\n");
|
|
print("Set CURSES_VERBOSE environment variable to see the details of the " .
|
|
"tests.\n");
|
|
print("\n");
|
|
|
|
my $panels;
|
|
my $menus;
|
|
my $forms;
|
|
|
|
if ($ENV{CURSES_VERBOSE}) {
|
|
$verbose = 1;
|
|
} else {
|
|
$verbose = 0;
|
|
}
|
|
|
|
open IN, "list.syms" or die "Can't open list.syms: $!\n";
|
|
open(OUTH, ">CursesDef.h") or die "Can't open CursesDef.h: $!\n";
|
|
open LOG, ">&STDERR" or die "Can't redirect to STDERR: $!\n";
|
|
|
|
while (@ARGV) {
|
|
my $arg = shift;
|
|
|
|
$arg eq 'PANELS' and ++$panels and next;
|
|
$arg eq 'MENUS' and ++$menus and next;
|
|
$arg eq 'FORMS' and ++$forms and next;
|
|
$arg =~ /^-h/ and Usage();
|
|
$arg =~ /^-v/ and ++$verbose and next;
|
|
$arg =~ /^-l/ and do {
|
|
my $logfile = shift or Usage("<-l> needs a filename");
|
|
open LOG, ">$logfile" or die "Can't open file '$logfile': $!\n";
|
|
open STDERR, ">&LOG" or die "Can't redirect STDERR: $!\n";
|
|
|
|
next;
|
|
};
|
|
$arg =~ /^-/ and Usage("Unknown option: $arg");
|
|
Usage("Unknown argument: $arg");
|
|
}
|
|
if (@ARGV) { Usage() }
|
|
|
|
select LOG;
|
|
$| = 1;
|
|
|
|
# Prep compile stage
|
|
|
|
makeCompileCommand(\my $compile);
|
|
|
|
print STDOUT "Doing test compiles with the compile command '$compile'\n";
|
|
|
|
|
|
###
|
|
## Now generate the .h file
|
|
#
|
|
|
|
print OUTH <<'EOHDR';
|
|
/* This file is automatically generated; changes will be lost.
|
|
**
|
|
** If you need to edit this file because "test.syms" didn't do a good
|
|
** job, be sure to save a copy of your changes.
|
|
**
|
|
** The "define"s below are simply educated guesses. If you are
|
|
** having problems compiling, check the appropriate symbol to see if
|
|
** it was set correctly: For each line, if the answer to the question
|
|
** is "no", that line should start with "#undef"; if the answer is
|
|
** yes, it should start with "#define".
|
|
*/
|
|
|
|
EOHDR
|
|
|
|
print OUTH
|
|
$panels ? "#define " : "#undef ",
|
|
"C_PANELSUPPORT /* Add in panel library support? */",
|
|
"\n\n";
|
|
|
|
print OUTH
|
|
$menus ? "#define " : "#undef ",
|
|
"C_MENUSUPPORT /* Add in menu library support? */",
|
|
"\n\n";
|
|
|
|
print OUTH
|
|
$forms ? "#define " : "#undef ",
|
|
"C_FORMSUPPORT /* Add in form library support? */",
|
|
"\n\n";
|
|
|
|
# Some functions return either int or void, depending on what compiler
|
|
# and libcurses.a you are using. For the int/void test, if the
|
|
# compiler doesn't complain about assigning the sym to an int
|
|
# variable, we assume the function returns int. Otherwise, we assume
|
|
# it returns void.
|
|
|
|
my %tstfile = qw( E testsym
|
|
I testint
|
|
V testsym
|
|
T testtyp);
|
|
while (<IN>) {
|
|
next if /^\S*#/;
|
|
next unless /\S/;
|
|
|
|
my ($action, $sym, $args) = /^([A-Z])\s+(\w+)\s*(\(.*\))?/;
|
|
my $file = $tstfile{$action};
|
|
|
|
unless (defined $sym and defined $file) {
|
|
warn "WARNING: internal error on symbol $_\n";
|
|
}
|
|
|
|
my $cmd;
|
|
$cmd = $compile; # initial value
|
|
my $symargs = $sym . (defined($args) ? $args : '');
|
|
$cmd =~ s{_C_SYM_}{$symargs}ge;
|
|
$cmd =~ s{_C_FILE_}{$file}g;
|
|
|
|
print LOG $cmd, "\n" if $verbose;
|
|
my $ret = `$cmd`;
|
|
my $rc = $?;
|
|
print LOG $ret if $verbose;
|
|
print LOG "(rc = $rc)\n" if $verbose;
|
|
|
|
my $ssym = $sym;
|
|
$ssym =~ s/^w//;
|
|
|
|
my $c_sym;
|
|
my $comment;
|
|
|
|
if ($action eq 'E') {
|
|
print LOG "function '$sym' ", ($rc ? "NOT " : ""), "found\n";
|
|
|
|
$c_sym = uc "C_$ssym";
|
|
$comment = "Does function '$ssym' exist?";
|
|
}
|
|
elsif ($action eq 'I') {
|
|
print LOG "function '$sym' returns ", ($rc ? "void" : "int"), "\n";
|
|
|
|
$c_sym = uc "C_INT$ssym";
|
|
$comment = "Does function '$ssym' return 'int'?";
|
|
}
|
|
elsif ($action eq 'V') {
|
|
print LOG "variable '$sym' ", ($rc ? "NOT " : ""), "found\n";
|
|
|
|
$c_sym = uc "C_$ssym";
|
|
$comment = "Does variable '$ssym' exist?";
|
|
}
|
|
elsif ($action eq 'T') {
|
|
print LOG "typedef '$sym' ", ($rc ? "NOT " : ""), "found\n";
|
|
|
|
$c_sym = uc "C_TYP$ssym";
|
|
$comment = "Does typedef '$ssym' exist?";
|
|
}
|
|
else {
|
|
warn "WARNING: internal error on symbol $_\n";
|
|
}
|
|
|
|
print OUTH
|
|
$rc ? "#undef " : "#define ",
|
|
$c_sym, " " x (24 - length $c_sym),
|
|
"/* ",
|
|
$comment, " " x (42 - length $comment),
|
|
"*/\n";
|
|
}
|
|
|
|
unlink "testsym";
|
|
unlink "testint";
|
|
unlink "testtyp";
|
|
|
|
1 while unlink "testsym.obj"; # Possibly pointless VMSism
|
|
1 while unlink "testint.obj"; # Possibly pointless VMSism
|
|
1 while unlink "testtyp.obj"; # Possibly pointless VMSism
|
|
|
|
close IN;
|
|
close OUTH;
|
|
close LOG;
|
|
exit 0;
|
|
|
|
###
|
|
## Helper functions
|
|
#
|
|
|
|
sub Usage {
|
|
print LOG @_, "\n";
|
|
print LOG <<EOM;
|
|
Usage: find_syms [options]
|
|
where options include:
|
|
|
|
-h This message.
|
|
-v Verbose. Tell you more than you want to know about
|
|
how the Curses symbols are being determined.
|
|
-l <file> Create file <file> and dump output into it.
|
|
EOM
|
|
}
|
|
|
|
__END__
|