WWWWWW

Current Directory: /home/.cpan/build/Curses-1.45-0
Viewing File: /home/.cpan/build/Curses-1.45-0/testsyms
#! /usr/bin/perl
##
##  testsyms -- test for function/variable symbols
##
##  The symbols for which we test are listed in the file 'list.syms'
##
##  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) = @_;
#-----------------------------------------------------------------------------
#  A template for a compile command that can test for existence of some
#  symbol in this system's Curses library.
#
#  The template is a shell command containing some variables
#  to be substituted to make a real executable command.
#
#  Those variables are:
#
#     _C_SYM   Value for -DSYM option, e.g. "addstr" to get
#              -DSYM=addstr in the command.
#
#     _C_FILE  base of name of file to compile and executable output file
#              e.g. "foo" to compile "foo.c" into "foo"
#
#  Some of the compile command is determined by environment variables:
#
#     CC, INC, CCFLAGS, LDLOADLIBS, LDDLFLAGS
#
#-----------------------------------------------------------------------------
    my $compile;

    $compile = '#CC# #DEFS# #INCS# #CFLAGS# #FILE# #LFLAGS# #LIBS#' .
        ($verbose ? '' : '#NULL#');
        # Initial value

    my $cc         = $ENV{'CC'};
    my $inc        = $ENV{'INC'};
    my $ccflags    = $ENV{'CCFLAGS'};
    my $ldloadlibs = $ENV{'LDLOADLIBS'};
    my $lddlflags  = $ENV{'LDDLFLAGS'};

    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};
    }

    #  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;
}



sub completeCompileCmd($$$$) {
    my ($template, $sym, $args, $file) = @_;
#-----------------------------------------------------------------------------
#  The complete ready-to-execute compile command.
#
#  $template is a template for the compile command, with some variables in it
#  that need to be replaced based on the values of $sym, $args, and $file.
# -----------------------------------------------------------------------------
    my $retval;

    $retval = $template;  # initial value

    my $symargs = $sym . (defined($args) ? $args : '');

    $retval =~ s{_C_SYM_}{$symargs}ge;
    $retval =~ s{_C_FILE_}{$file}g;

    return $retval;
}



sub writeHeader($) {
    my ($cursesDefFh) = @_;

    print $cursesDefFh <<'EOHDR';
/*============================================================================
                                CursesDef.h
==============================================================================

  This file defines C macros that tell which Curses functions are available
  (in the C Curses library) on the target platform and some information about
  what variant is implemented.

  ==> This file was automatically generated by the program 'testsyms'; changes
  ==> will be lost the next time 'testsyms' runs.

  If you need to edit this file because 'testsyms' didn't do a good job, be
  sure to save a copy of your changes.

  This method of determining what is implemented on this system (trying to
  compile something and noting whether the compile succeeds or fails) is quite
  sloppy and prone to error.  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
}


my %tstfile = qw( E  testsym
                  I  testint
                  V  testsym
                  T  testtyp);



sub testCompile($$$$$$) {
    my ($action, $sym, $args, $compileCmdTemplate, $logFh, $compFailedR) = @_;
#-----------------------------------------------------------------------------
#  Do a test compile to determine if symbol $sym exists in this system's
#  Curses library.
#
#  Use the compile command template $compileCmdTemplate to do this,
#  filling in variables _C_SYM and _C_FILE in this template appropriately.
#
#  The source file we compile is that given my %tstfile for the action
#  $action.
#
#  The symbol for which we test is $sym, with $args appended if $args
#  is defined.
#
#  Return $$compFailedR true iff the compile failed.  Note that we don't
#  supply any information as to how it failed; caller must simply assume
#  that it failed because the symbol is not defined in this system's
#  Curses library.
#-----------------------------------------------------------------------------
    my $file  = $tstfile{$action};

    unless (defined $sym and defined $file) {
        warn "WARNING: internal error on symbol $_\n";
    }

    my $cmd = completeCompileCmd($compileCmdTemplate, $sym, $args, $file);

    print $logFh $cmd, "\n"      if $verbose;

    my $cmdStdout = qx{$cmd};  my $termStat = $?;

    if ($verbose) {
        print $logFh ("Stdout: '$cmdStdout' ");
        print $logFh ("(term status = $termStat)");
        print $logFh ("\n");
    }

    $$compFailedR = ($termStat != 0);
}



###############################################################################
#                                 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");

if ($ENV{CURSES_VERBOSE}) {
    $verbose = 1;
} else {
    $verbose = 0;
}

open(my $listSymsFh,  '<', 'list.syms')
    or die "Can't open list.syms: $!";
open(my $cursesDefFh, '>', 'CursesDef.h')
    or die "Can't open CursesDef.h for output: $!";
open(my $logFh, ">&STDERR")
    or die "Can't redirect to STDERR: $!\n";

my $logFileNm;

while (@ARGV) {
    my $arg = shift;

    $arg =~ /^-h/    and Usage();
    $arg =~ /^-v/    and ++$verbose and next;
    $arg =~ /^-l/    and do {
        $logFileNm = shift      or Usage("<-l> needs a filename");
        next;
    };
    $arg =~ /^-/ and Usage("Unknown option: $arg");
    Usage("Unknown argument: $arg");
}
if (@ARGV) { Usage() }

if (defined($logFileNm)) {
    open($logFh, '>', $logFileNm)
        or die "Can't open file '$logFileNm': $!";
    open STDERR, ">&$logFh"
        or die "Can't redirect STDERR: $!";
} else {
    open($logFh, ">&STDERR");
}


select $logFh;
$| = 1;


makeCompileCommand(\my $compile);

print $logFh ("Doing test compiles with the compile command '$compile'\n");

writeHeader($cursesDefFh);

while (<$listSymsFh>) {
    next if /^\S*#/;
    next unless /\S/;

    my ($action, $sym, $args) = /^([A-Z])\s+(\w+)\s*(\(.*\))?/;

    testCompile($action, $sym, $args, $compile, $logFh, \my $compFailed);

    my $ssym  = $sym;
    $ssym =~ s/^w//;

    my $c_sym;
    my $comment;

    if ($action eq 'E') {
        print $logFh ("function '$sym' ",
                      ($compFailed ? "NOT " : ""), "found\n");

        $c_sym   = uc "C_$ssym";
        $comment = "Does function '$ssym' exist?";
    } elsif ($action eq 'I') {
        # 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.

        print $logFh ("function '$sym' returns ",
                      ($compFailed ? "void" : "int"), "\n");

        $c_sym   = uc "C_INT$ssym";
        $comment = "Does function '$ssym' return 'int'?";
    } elsif ($action eq 'V') {
        print $logFh ("variable '$sym' ",
                      ($compFailed ? "NOT " : ""), "found\n");

        $c_sym   = uc "C_$ssym";
        $comment = "Does variable '$ssym' exist?";
    } elsif ($action eq 'T') {
        print $logFh ("typedef '$sym' ",
                      ($compFailed ? "NOT " : ""), "found\n");

        $c_sym   = uc "C_TYP$ssym";
        $comment = "Does typedef '$ssym' exist?";
    } else {
        warn "WARNING: internal error on symbol $_\n";
    }

    my $pad1 = length($c_sym)   < 24 ? " " x (24 - length($c_sym))   : "";
    my $pad2 = length($comment) < 42 ? " " x (42 - length($comment)) : "";

    print $cursesDefFh
        $compFailed ? "#undef  " : "#define ",
        $c_sym, $pad1, "/* ", $comment, $pad2, "*/",
        "\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($listSymsFh);
close($cursesDefFh);
close($logFh);
exit 0;

###
##  Helper functions
#

sub Usage {
    print LOG @_, "\n";
    print LOG <<EOM;
Usage: testsyms [options]
where options are

   -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__
F1l3 Manager
