File: test.syms

package info (click to toggle)
libcurses-perl 1.08b-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 624 kB
  • ctags: 754
  • sloc: ansic: 8,714; perl: 1,773; makefile: 36; sh: 9
file content (250 lines) | stat: -rwxr-xr-x 6,962 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
#!../../perl
##
##  test.syms -- test for function/variable symbols 
##
##  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>


my $verbose;
my $panels;
my $menus;
my $forms;

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: $_");
    Usage("Unknown argument: $_");
}
if (@ARGV) { Usage() }

select LOG;
$| = 1;


#  Prep compile stage
#
#  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} {NULL}";
my $makefile = ($^O =~ /VMS/) ? "Descrip.MMS" : "Makefile";

open MF, $makefile               or die "Can't open $makefile: $!\n";
while (<MF>) {
    if    (/^CC\s*=\s*(.*)/)         { my $A = $1; $compile =~ s/{CC}/$A/     }
    elsif (/^INC\s*=\s*(.*)/)        { my $A = $1; $compile =~ s/{INCS}/$A/   }
    elsif (/^CCFLAGS\s*=\s*(.*)/)    { my $A = $1; $compile =~ s/{CFLAGS}/$A/ }
    elsif (/^LDLOADLIBS\s*=\s*(.*)/) { my $A = $1; $compile =~ s/{LIBS}/$A/   }
    elsif (/^LDDLFLAGS\s*=\s*(.*)/)  {
	## Only get -L's.  Other options can cause strange link behavior.
	## (I shoulda stayed in bed.)
	#
	my $A = $1;

	my $B;
	while ($A =~ m!(-L\S+)!g) {
	    $B .= " $1";
	}
	$compile =~ s/{LFLAGS}/$B/;
    }
}
close MF;

#  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 ($^O =~ /VMS/i) {
    $compile =~ s!{DEFS}!/DEFINE=SYM="_C_SYM_"!;
    $compile =~ s!{FILE}!_C_FILE_.c!;
    # no non-verbose way
}
elsif ($^O eq 'MSWin32') {
    $compile =~ s!{DEFS}!-DSYM="_C_SYM_"!;
    $compile =~ s!{FILE}!_C_FILE_.c!;
    $compile =~ s!{NULL}!>nul 2>&1!           unless $verbose;
}
else {
    $compile =~ s!{DEFS}!-DSYM="_C_SYM_"!;
    $compile =~ s!{FILE}!-o _C_FILE_ _C_FILE_.c!;
    $compile =~ s!{NULL}!>/dev/null 2>&1!     unless $verbose;
}
$compile =~ s!{NULL}!!;

if ($compile =~ /{/) {
    die "OOPS: internal error getting compile command: $compile\n";
}

print STDOUT "Doing test compiles with the compile command '$compile'\n";


###
##  Now gererate 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 and 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};
    my $cmd   = $compile;

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

    $cmd =~ s/_C_SYM_/"$sym$args"/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__