1#!/usr/bin/perl
2
3# Configure.pm. Version 1.00          Copyright (C) 1995, Kenneth Albanowski
4#
5#  You are welcome to use this code in your own perl modules, I just
6#  request that you don't distribute modified copies without making it clear
7#  that you have changed something. If you have a change you think is worth
8#  merging into the original, please contact me at kjahds@kjahds.com or
9#  CIS:70705,126
10#
11#  $Id: Configure.pm,v 2.21 2004/03/02 20:28:11 jonathan Exp $
12#
13
14# Todo: clean up redudant code in CPP, Compile, Link, and Execute
15#
16
17package Configure;
18
19use strict;
20
21use vars qw(@EXPORT @ISA);
22
23use Carp;
24require Exporter;
25@ISA = qw(Exporter);
26
27@EXPORT = qw( CPP
28              Compile
29              Link
30              Execute
31              FindHeader
32              FindLib
33              Apply
34              ApplyHeaders
35              ApplyLibs
36              ApplyHeadersAndLibs
37              ApplyHeadersAndLibsAndExecute
38              CheckHeader
39              CheckStructure
40              CheckField
41              CheckHSymbol
42              CheckSymbol
43              CheckLSymbol
44              GetSymbol
45              GetTextSymbol
46              GetNumericSymbol
47              GetConstants);
48
49use Cwd;
50use Config;
51
52my ($C_usrinc, $C_libpth, $C_cppstdin, $C_cppflags, $C_cppminus,
53$C_ccflags,$C_ldflags,$C_cc,$C_libs) =
54	 @Config{qw( usrinc libpth cppstdin cppflags cppminus
55					 ccflags ldflags cc libs)};
56
57my $Verbose = 0;
58
59=head1 NAME
60
61Configure.pm - provide auto-configuration utilities
62
63=head1 SUMMARY
64
65This perl module provides tools to figure out what is present in the C
66compilation environment. This is intended mostly for perl extensions to use
67to configure themselves. There are a number of functions, with widely varying
68levels of specificity, so here is a summary of what the functions can do:
69
70
71CheckHeader:		Look for headers.
72
73CheckStructure:	Look for a structure.
74
75CheckField:		Look for a field in a structure.
76
77CheckHSymbol:		Look for a symbol in a header.
78
79CheckLSymbol:		Look for a symbol in a library.
80
81CheckSymbol:		Look for a symbol in a header and library.
82
83GetTextSymbol:		Get the contents of a symbol as text.
84
85GetNumericSymbol:	Get the contents of a symbol as a number.
86
87Apply:		Try compiling code with a set of headers and libs.
88
89ApplyHeaders:		Try compiling code with a set of headers.
90
91ApplyLibraries:	Try linking code with a set of libraries.
92
93ApplyHeadersAndLibaries:	You get the idea.
94
95ApplyHeadersAndLibariesAnExecute:	You get the idea.
96
97CPP:		Feed some code through the C preproccessor.
98
99Compile:	Try to compile some C code.
100
101Link:	Try to compile & link some C code.
102
103Execute:	Try to compile, link, & execute some C code.
104
105=head1 FUNCTIONS
106
107=cut
108
109# Here we go into the actual functions
110
111=head2 CPP
112
113Takes one or more arguments. The first is a string containing a C program.
114Embedded newlines are legal, the text simply being stuffed into a temporary
115file. The result is then fed to the C preproccessor (that preproccessor being
116previously determined by perl's Configure script.) Any additional arguments
117provided are passed to the preprocessing command.
118
119In a scalar context, the return value is either undef, if something went wrong,
120or the text returned by the preprocessor. In an array context, two values are
121returned: the numeric exit status and the output of the preproccessor.
122
123=cut
124
125sub CPP { # Feed code to preproccessor, returning error value and output
126
127	my($code,@options) = @_;
128	my($options) = join(" ",@options);
129	my($file) = "tmp$$";
130	my($in,$out) = ($file.".c",$file.".o");
131
132	open(F,">$in");
133	print F $code;
134	close(F);
135
136	print "Preprocessing |$code|\n" if $Verbose;
137	my($result) = scalar(`$C_cppstdin $C_cppflags $C_cppminus $options < $in 2>/dev/null`);
138	print "Executing '$C_cppstdin $C_cppflags $C_cppminus $options < $in 2>/dev/null'\n"  if $Verbose;
139
140
141	my($error) = $?;
142	print "Returned |$result|\n" if $Verbose;
143	unlink($in,$out);
144	return ($error ? undef : $result) unless wantarray;
145	($error,$result);
146}
147
148=head2 Compile
149
150Takes one or more arguments. The first is a string containing a C program.
151Embedded newlines are legal, the text simply being stuffed into a temporary
152file. The result is then fed to the C compiler (that compiler being
153previously determined by perl's Configure script.) Any additional arguments
154provided are passed to the compiler command.
155
156In a scalar context, either 0 or 1 will be returned, with 1 indicating a
157successful compilation. In an array context, three values are returned: the
158numeric exit status of the compiler, a string consisting of the output
159generated by the compiler, and a numeric value that is false if a ".o" file
160wasn't produced by the compiler, error status or no.
161
162=cut
163
164sub Compile { # Feed code to compiler. On error, return status and text
165	my($code,@options) = @_;
166	my($options)=join(" ",@options);
167	my($file) = "tmp$$";
168	my($in,$out) = ($file.".c",$file.".o");
169
170	open(F,">$in");
171	print F $code;
172	close(F);
173	print "Compiling |$code|\n"  if $Verbose;
174	my($result) = scalar(`$C_cc $C_ccflags -c $in $C_ldflags $C_libs $options 2>&1`);
175	print "Executing '$C_cc $C_ccflags -c $in $C_ldflags $C_libs $options 2>&1'\n"  if $Verbose;
176	my($error) = $?;
177   my($error2) = ! -e $out;
178	unlink($in,$out);
179	return (($error || $error2) ? 0 : 1) unless wantarray;
180	($error,$result,$error2);
181}
182
183=head2 Link
184
185Takes one or more arguments. The first is a string containing a C program.
186Embedded newlines are legal, the text simply being stuffed into a temporary
187file. The result is then fed to the C compiler and linker (that compiler and
188linker being previously determined by perl's Configure script.) Any
189additional arguments provided are passed to the compilation/link command.
190
191In a scalar context, either 0 or 1 is returned, with 1 indicating a
192successful compilation. In an array context, two values are returned: the
193numeric exit status of the compiler/linker, and a string consisting of the
194output generated by the compiler/linker.
195
196Note that this command I<only> compiles and links the C code. It does not
197attempt to execute it.
198
199=cut
200
201sub Link { # Feed code to compiler and linker. On error, return status and text
202	my($code,@options) = @_;
203	my($options) = join(" ",@options);
204	my($file) = "tmp$$";
205	my($in,$out) = $file.".c",$file.".o";
206
207	open(F,">$in");
208	print F $code;
209	close(F);
210	print "Linking |$code|\n" if $Verbose;
211	my($result) = scalar(`$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1`);
212	print "Executing '$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose;
213	my($error)=$?;
214	print "Error linking: $error, |$result|\n" if $Verbose;
215	unlink($in,$out,$file);
216	return (($error || $result ne "")?0:1) unless wantarray;
217	($error,$result);
218}
219
220=head2 Execute
221
222Takes one or more arguments. The first is a string containing a C program.
223Embedded newlines are legal, the text simply being stuffed into a temporary
224file. The result is then fed to the C compiler and linker (that compiler and
225linker being previously determined by perl's metaconfig script.) and then
226executed. Any additional arguments provided are passed to the
227compilation/link command. (There is no way to feed arguments to the program
228being executed.)
229
230In a scalar context, the return value is either undef, indicating the
231compilation or link failed, or that the executed program returned a nonzero
232status. Otherwise, the return value is the text output by the program.
233
234In an array context, an array consisting of three values is returned: the
235first value is 0 or 1, 1 if the compile/link succeeded. The second value either
236the exist status of the compiler or program, and the third is the output text.
237
238=cut
239
240sub Execute { #Compile, link, and execute.
241
242	my($code,@options) = @_;
243	my($options)=join(" ",@options);
244	my($file) = "tmp$$";
245	my($in,$out) = $file.".c",$file.".o";
246
247	open(F,">$in");
248	print F $code;
249	close(F);
250	print "Executing |$code|\n" if $Verbose;
251	my($result) = scalar(`$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1`);
252	print "Executing '$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose;
253	my($error) = $?;
254	unlink($in,$out);
255	if(!$error) {
256		my($result2) = scalar(`./$file`);
257		$error = $?;
258		unlink($file);
259		return ($error?undef:$result2) unless wantarray;
260		print "Executed successfully, status $error, link $result, exec |$result2|\n" if $Verbose;
261		(1,$error,$result2);
262	} else {
263		print "Link failed, status $error, message |$result|\n" if $Verbose;
264		return undef unless wantarray;
265		(0,$error,$result);
266	}
267}
268
269=head2 FindHeader
270
271Takes an unlimited number of arguments, consisting of both header names in
272the form "header.h", or directory specifications such as "-I/usr/include/bsd".
273For each supplied header, FindHeader will attempt to find the complete path.
274The return value is an array consisting of all the headers that were located.
275
276=cut
277
278sub FindHeader { #For each supplied header name, find full path
279	my(@headers) = grep(!/^-I/,@_);
280	my(@I) = grep(/^-I/,@_);
281	my($h);
282	for $h (@headers) {
283		print "Searching for $h... " if $Verbose;
284		if($h eq "") {$h=undef; next}
285		if( -f $h) {next}
286		if( -f $Config{"usrinc"}."/".$h) {
287			$h = $Config{"usrinc"}."/".$h;
288			print "Found as $h.\n" if $Verbose;
289		} else {
290                        my $text;
291			if($text = CPP("#include <$h>",join(" ",@I))) {
292				grepcpp:
293				for (split(/\s+/,(grep(/^\s*#.*$h/,split(/\n/,$text)))[0])) {
294					if(/$h/) {
295						s/^\"(.*)\"$/$1/;
296						s/^\'(.*)\'$/$1/;
297						$h = $_;
298						print "Found as $h.\n" if $Verbose;
299						last grepcpp;
300					}
301				}
302			} else {
303				$h = undef; # remove header from resulting list
304				print "Not found.\n" if $Verbose;
305			}
306		}
307	}
308	grep($_,@headers);
309}
310
311=head2 FindLib
312
313Takes an unlimited number of arguments, consisting of both library names in
314the form "-llibname", "/usr/lib/libxyz.a" or "dld", or directory
315specifications such as "-L/usr/lib/foo". For each supplied library, FindLib
316will attempt to find the complete path. The return value is an array
317consisting of the full paths to all of the libraries that were located.
318
319=cut
320
321sub FindLib { #For each supplied library name, find full path
322	my(@libs) = grep(!/^-L/,@_);
323	my(@L) = (grep(/^-L/,@_),split(" ",$Config{"libpth"}));
324	grep(s/^-L//,@L);
325	my($l);
326	my($so) = $Config{"so"};
327	my($found);
328	#print "Libaries I am searching for: ",join(",",@libs),"\n";
329	#print "Directories: ",join(",",@L),"\n";
330        my $lib;
331	for $lib (@libs) {
332		print "Searching for $lib... " if $Verbose;
333		$found=0;
334		$lib =~ s/^-l//;
335		if($lib eq "") {$lib=undef; next}
336		next if -f $lib;
337                my $path;
338		for $path (@L) {
339                        my ( $fullname, @fullname );
340			print "Searching $path for $lib...\n" if $Verbose;
341			if (@fullname=<${path}/lib${lib}.${so}.[0-9]*>){
342				$fullname=$fullname[-1]; #ATTN: 10 looses against 9!
343			} elsif (-f ($fullname="$path/lib$lib.$so")){
344			} elsif (-f ($fullname="$path/lib${lib}_s.a")
345			&& ($lib .= "_s") ){ # we must explicitly ask for _s version
346			} elsif (-f ($fullname="$path/lib$lib.a")){
347			} elsif (-f ($fullname="$path/Slib$lib.a")){
348			} else {
349				warn "$lib not found in $path\n" if $Verbose;
350				next;
351			}
352			warn "'-l$lib' found at $fullname\n" if $Verbose;
353			$lib = $fullname;
354			$found=1;
355		}
356		if(!$found) {
357			$lib = undef; # Remove lib if not found
358			print "Not found.\n" if $Verbose;
359		}
360	}
361	grep($_,@libs);
362}
363
364
365=head2
366
367Apply takes a chunk of code, a series of libraries and headers, and attempts
368to apply them, in series, to a given perl command. In a scalar context, the
369return value of the first set of headers and libraries that produces a
370non-zero return value from the command is returned. In an array context, the
371header and library set it returned.
372
373This is best explained by some examples:
374
375	Apply(\&Compile,"main(){}","sgtty.h","");
376
377In a scalar context either C<undef> or C<1>. In an array context,
378this returns C<()> or C<("sgtty.h","")>.
379
380	Apply(\&Link,"main(){int i=COLOR_PAIRS;}","curses.h","-lcurses",
381	"ncurses.h","-lncurses","ncurses/ncurses.h","-lncurses");
382
383In a scalar context, this returns either C<undef>, C<1>. In an array context,
384this returns C<("curses.h","-lcurses")>, C<("ncurses.h","-lncurses")>,
385C<("ncurses/ncurses.h","-lncurses")>, or C<()>.
386
387If we had instead said
388C<Apply(\&Execute,'main(){printf("%d",(int)COLOR_PAIRS)',...)> then in a scalar
389context either C<undef> or the value of COLOR_PAIRS would be returned.
390
391Note that you can also supply multiple headers and/or libraries at one time,
392like this:
393
394	Apply(\&Compile,"main(){fcntl(0,F_GETFD);}","fcntl.h","",
395	"ioctl.h fcntl.h","","sys/ioctl.h fcntl.h"","");
396
397So if fcntl needs ioctl or sys/ioctl loaded first, this will catch it. In an
398array context, C<()>, C<("fcntl.h","")>, C<("ioctl.h fcntl.h","")>, or
399C<("sys/ioctl.h fcntl.h","")> could be returned.
400
401You can also use nested arrays to get exactly the same effect. The returned
402array will always consist of a string, though, with elements separated by
403spaces.
404
405	Apply(\&Compile,"main(){fcntl(0,F_GETFD);}",["fcntl.h"],"",
406	["ioctl.h","fcntl.h"],"",["sys/ioctl.h","fcntl.h"],"");
407
408Note that there are many functions that provide simpler ways of doing these
409things, from GetNumericSymbol to get the value of a symbol, to ApplyHeaders
410which doesn't ask for libraries.
411
412=cut
413
414sub Apply { #
415	my($cmd,$code,@lookup) = @_;
416	my(@l,@h,$i,$ret);
417	for ($i=0;$i<@lookup;$i+=2) {
418		if( ref($lookup[$i]) eq "ARRAY" ) {
419			@h = @{$lookup[$i]};
420		} else {
421			@h = split(/\s+/,$lookup[$i]);
422		}
423		if( ref($lookup[$i+1]) eq "ARRAY" ) {
424			@l = @{$lookup[$i+1]};
425		} else {
426			@l = split(/\s+/,$lookup[$i+1]);
427		}
428
429		if($ret=&{$cmd == \&Link && !@l?\&Compile:$cmd}(join("",map($_?"#include <$_>\n":"",grep(!/^-I/,@h))).
430				$code,grep(/^-I/,@h),@l)) {
431			print "Ret=|$ret|\n" if $Verbose;
432			return $ret unless wantarray;
433		return (join(" ",@h),join(" ",@l));
434		}
435	}
436	return 0 unless wantarray;
437	();
438}
439
440=head2 ApplyHeadersAndLibs
441
442This function takes the same sort of arguments as Apply, it just sends them
443directly to Link.
444
445=cut
446
447sub ApplyHeadersAndLibs { #
448	my($code,@lookup) = @_;
449	Apply \&Link,$code,@lookup;
450}
451
452=head2 ApplyHeadersAndLibsAndExecute
453
454This function is similar to Apply and ApplyHeadersAndLibs, but it always
455uses Execute.
456
457=cut
458
459sub ApplyHeadersAndLibsAndExecute { #
460	my($code,@lookup) = @_;
461	Apply \&Execute,$code,@lookup;
462}
463
464=head2 ApplyHeaders
465
466If you are only checking headers, and don't need to look at libs, then
467you will probably want to use ApplyHeaders. The return value is the same
468in a scalar context, but in an array context the returned array will only
469consists of the headers, spread out.
470
471=cut
472
473sub ApplyHeaders {
474	my($code,@headers) = @_;
475	return scalar(ApplyHeadersAndLibs $code, map(($_,""),@headers))
476		unless wantarray;
477	split(/\s+/,(ApplyHeadersAndLibs $code, map(($_,""),@headers))[0]);
478}
479
480=head2 ApplyLibs
481
482If you are only checking libraries, and don't need to look at headers, then
483you will probably want to use ApplyLibs. The return value is the same
484in a scalar context, but in an array context the returned array will only
485consists of the libraries, spread out.
486
487=cut
488
489sub ApplyLibs {
490	my($code,@libs) = @_;
491	return scalar(ApplyHeadersAndLibs $code, map(("",$_),@libs))
492		unless wantarray;
493	split(/\s+/,(ApplyHeadersAndLibs $code, map(("",$_),@libs))[0]);
494}
495
496=head2 CheckHeader
497
498Takes an unlimited number of arguments, consiting of headers in the
499Apply style. The first set that is fully accepted
500by the compiler is returned.
501
502=cut
503
504sub CheckHeader { #Find a header (or set of headers) that exists
505	ApplyHeaders("main(){}",@_);
506}
507
508=head2 CheckStructure
509
510Takes the name of a structure, and an unlimited number of further arguments
511consisting of header groups. The first group that defines that structure
512properly will be returned. B<undef> will be returned if nothing succeeds.
513
514=cut
515
516sub CheckStructure { # Check existance of a structure.
517	my($structname,@headers) = @_;
518	ApplyHeaders("main(){ struct $structname s;}",@headers);
519}
520
521=head2 CheckField
522
523Takes the name of a structure, the name of a field, and an unlimited number
524of further arguments consisting of header groups. The first group that
525defines a structure that contains the field will be returned. B<undef> will
526be returned if nothing succeeds.
527
528=cut
529
530sub CheckField { # Check for the existance of specified field in structure
531	my($structname,$fieldname,@headers) = @_;
532	ApplyHeaders("main(){ struct $structname s1; struct $structname s2;
533								 s1.$fieldname = s2.$fieldname; }",@headers);
534}
535
536=head2 CheckLSymbol
537
538Takes the name of a symbol, and an unlimited number of further arguments
539consisting of library groups. The first group of libraries that defines
540that symbol will be returned. B<undef> will be returned if nothing succeeds.
541
542=cut
543
544sub CheckLSymbol { # Check for linkable symbol
545	my($symbol,@libs) = @_;
546	ApplyLibs("main() { void * f = (void *)($symbol); }",@libs);
547}
548
549=head2 CheckSymbol
550
551Takes the name of a symbol, and an unlimited number of further arguments
552consisting of header and library groups, in the Apply format. The first
553group of headers and libraries that defines that symbol will be returned.
554B<undef> will be returned if nothing succeeds.
555
556=cut
557
558sub CheckSymbol { # Check for linkable/header symbol
559	my($symbol,@lookup) = @_;
560	ApplyHeadersAndLibs("main() { void * f = (void *)($symbol); }",@lookup);
561}
562
563=head2 CheckHSymbol
564
565Takes the name of a symbol, and an unlimited number of further arguments
566consisting of header groups. The first group of headers that defines
567that symbol will be returned. B<undef> will be returned if nothing succeeds.
568
569=cut
570
571sub CheckHSymbol { # Check for header symbol
572	my($symbol,@headers) = @_;
573	ApplyHeaders("main() { void * f = (void *)($symbol); }",@headers);
574}
575
576=head2 CheckHPrototype (unexported)
577
578An experimental routine that takes a name of a function, a nested array
579consisting of the prototype, and then the normal header groups. It attempts
580to deduce whether the given prototype matches what the header supplies.
581Basically, it doesn't work. Or maybe it does. I wouldn't reccomend it,
582though.
583
584=cut
585
586sub CheckHPrototype { # Check for header prototype.
587	# Note: This function is extremely picky about "const int" versus "int",
588   # and depends on having an extremely snotty compiler. Anything but GCC
589   # may fail, and even GCC may not work properly. In any case, if the
590   # names function doesn't exist, this call will _succeed_. Caveat Utilitor.
591	my($function,$proto,@headers) = @_;
592	my(@proto) = @{$proto};
593	ApplyHeaders("main() { extern ".$proto[0]." $function(".
594								 join(",",@proto[1..$#proto])."); }",@headers);
595}
596
597=head2 GetSymbol
598
599Takes the name of a symbol, a printf command, a cast, and an unlimited
600number of further arguments consisting of header and library groups, in the
601Apply. The first group of headers and libraries that defines that symbol
602will be used to get the contents of the symbol in the format, and return it.
603B<undef> will be returned if nothing defines that symbol.
604
605Example:
606
607	GetSymbol("__LINE__","ld","long","","");
608
609=cut
610
611sub GetSymbol { # Check for linkable/header symbol
612	my($symbol,$printf,$cast,@lookup) = @_,"","";
613	scalar(ApplyHeadersAndLibsAndExecute(
614		"main(){ printf(\"\%$printf\",($cast)($symbol));exit(0);}",@lookup));
615}
616
617=head2 GetTextSymbol
618
619Takes the name of a symbol, and an unlimited number of further arguments
620consisting of header and library groups, in the ApplyHeadersAndLibs format.
621The first group of headers and libraries that defines that symbol will be
622used to get the contents of the symbol in text format, and return it.
623B<undef> will be returned if nothing defines that symbol.
624
625Note that the symbol I<must> actually be text, either a char* or a constant
626string. Otherwise, the results are undefined.
627
628=cut
629
630sub GetTextSymbol { # Check for linkable/header symbol
631	my($symbol,@lookup) = @_,"","";
632	my($result) = GetSymbol($symbol,"s","char*",@lookup);
633	$result .= "" if defined($result);
634	$result;
635}
636
637=head2 GetNumericSymbol
638
639Takes the name of a symbol, and an unlimited number of further arguments
640consisting of header and library groups, in the ApplyHeadersAndLibs format.
641The first group of headers and libraries that defines that symbol will be
642used to get the contents of the symbol in numeric format, and return it.
643B<undef> will be returned if nothing defines that symbol.
644
645Note that the symbol I<must> actually be numeric, in a format compatible
646with a float. Otherwise, the results are undefined.
647
648=cut
649
650sub GetNumericSymbol { # Check for linkable/header symbol
651	my($symbol,@lookup) = @_,"","";
652	my($result) = GetSymbol($symbol,"f","float",@lookup);
653	$result += 0 if defined($result);
654	$result;
655}
656
657=head2 GetConstants
658
659Takes a list of header names (possibly including -I directives) and attempts
660to grep the specified files for constants, a constant being something #defined
661with a name that matches /[A-Z0-9_]+/. Returns the list of names.
662
663=cut
664
665sub GetConstants { # Try to grep constants out of a header
666	my(@headers) = @_;
667	@headers = FindHeader(@headers);
668	my %seen;
669	my(%results);
670	map($seen{$_}=1,@headers);
671	while(@headers) {
672		$_=shift(@headers);
673		next if !defined($_);
674		open(SEARCHHEADER,"<$_");
675		while(<SEARCHHEADER>) {
676			if(/^\s*#\s*define\s+([A-Z_][A-Za-z0-9_]+)\s+/) {
677				$results{$1} = 1;
678			} elsif(/^\s*#\s*include\s+[<"]?([^">]+)[>"]?/) {
679				my(@include) = FindHeader($1);
680				@include = grep(!$seen{$_},map(defined($_)?$_:(),@include));
681				push(@headers,@include);
682				map($seen{$_}=1,@include);
683			}
684		}
685		close(SEARCHHEADER);
686	}
687	keys %results;
688}
689
690
691=head2 DeducePrototype (unexported)
692
693This one is B<really> experimental. The idea is to figure out some basic
694characteristics of the compiler, and then attempt to "feel out" the prototype
695of a function. Eventually, it may work. It is guaranteed to be very slow,
696and it may simply not be capable of working on some systems.
697
698=cut
699
700my $firstdeduce = 1;
701sub DeducePrototype {
702
703        my (@types, $checkreturn, $checknilargs, $checkniletcargs, $checkreturnnil);
704
705	if($firstdeduce) {
706		$firstdeduce=0;
707		my $checknumber=!Compile("extern int func(int a,int b);
708									 extern int func(int a,int b,int c);
709									 main(){}");
710		$checkreturn=!Compile("extern int func(int a,int b);
711									 extern long func(int a,int b);
712									 main(){}");
713		my $checketc=   !Compile("extern int func(int a,int b);
714									 extern long func(int a,...);
715									 main(){}");
716		my $checknumberetc=!Compile("extern int func(int a,int b);
717									 extern int func(int a,int b,...);
718									 main(){}");
719		my $checketcnumber=!Compile("extern int func(int a,int b,int c,...);
720									 extern int func(int a,int b,...);
721									 main(){}");
722		my $checkargtypes=!Compile("extern int func(int a);
723									 extern int func(long a);
724									 main(){}");
725		my $checkargsnil=!Compile("extern int func();
726									 extern int func(int a,int b,int c);
727									 main(){}");
728		$checknilargs=!Compile("extern int func(int a,int b,int c);
729									 extern int func();
730									 main(){}");
731		my $checkargsniletc=!Compile("extern int func(...);
732									 extern int func(int a,int b,int c);
733									 main(){}");
734		$checkniletcargs=!Compile("extern int func(int a,int b,int c);
735									 extern int func(...);
736									 main(){}");
737
738		my $checkconst=!Compile("extern int func(const int * a);
739										extern int func(int * a);
740										main(){ }");
741
742		my $checksign=!Compile("extern int func(int a);
743										extern int func(unsigned int a);
744										main(){ }");
745
746		$checkreturnnil=!Compile("extern func(int a);
747										extern void func(int a);
748										main(){ }");
749
750		@types = sort grep(Compile("main(){$_ a;}"),
751			"void","int","long int","unsigned int","unsigned long int","long long int",
752			"long long","unsigned long long",
753			"unsigned long long int","float","long float",
754			"double","long double",
755			"char","unsigned char","short int","unsigned short int");
756
757		if(Compile("main(){flurfie a;}")) { @types = (); }
758
759		$Verbose=0;
760
761		# Attempt to remove duplicate types (if any) from type list
762                my ( $i, $j );
763		if($checkargtypes) {
764			for ($i=0;$i<=$#types;$i++) {
765				for ($j=$i+1;$j<=$#types;$j++) {
766					next if $j==$i;
767					if(Compile("extern void func($types[$i]);
768										  extern void func($types[$j]); main(){}")) {
769						print "Removing type $types[$j] because it equals $types[$i]\n";
770						splice(@types,$j,1);
771						$j--;
772					}
773				}
774			}
775		} elsif($checkreturn) {
776			for ($i=0;$i<=$#types;$i++) {
777				for ($j=$i+1;$j<=$#types;$j++) {
778					next if $j==$i;
779					if(Compile("$types[$i] func(void);
780										  extern $types[$j] func(void); main(){}")) {
781						print "Removing type $types[$j] because it equals $types[$i]\n";
782						splice(@types,$j,1);
783						$j--;
784					}
785				}
786			}
787		}
788		$Verbose=1;
789
790		print "Detect differing numbers of arguments: $checknumber\n";
791		print "Detect differing return types: $checkreturn\n";
792		print "Detect differing argument types if one is ...: $checketc\n";
793		print "Detect differing numbers of arguments if ... is involved: $checknumberetc\n";
794		print "Detect differing numbers of arguments if ... is involved #2: $checketcnumber\n";
795		print "Detect differing argument types: $checkargtypes\n";
796		print "Detect differing argument types if first has no defined args: $checkargsnil\n";
797		print "Detect differing argument types if second has no defined args: $checknilargs\n";
798		print "Detect differing argument types if first has only ...: $checkargsniletc\n";
799		print "Detect differing argument types if second has only ...: $checkniletcargs\n";
800		print "Detect differing argument types by constness: $checkconst\n";
801		print "Detect differing argument types by signedness: $checksign\n";
802		print "Detect differing return types if one is not defined: $checkreturnnil\n";
803		print "Types known: ",join(",",@types),"\n";
804
805	}
806
807	my($function,@headers) = @_;
808	@headers = CheckHSymbol($function,@headers);
809	return undef if !@headers;
810
811	my $rettype = undef;
812	my @args = ();
813	my @validcount = ();
814
815	# Can we check the return type without worry about arguements?
816	if($checkreturn and (!$checknilargs or !$checkniletcargs)) {
817		for (@types) {
818			if(ApplyHeaders("extern $_ $function(". ($checknilargs?"...":"").");main(){}",[@headers])) {
819				$rettype = $_; # Great, we found the return type.
820				last;
821			}
822		}
823	}
824
825	if(!defined($rettype) and $checkreturnnil) {
826		die "No way to deduce function prototype in a rational amount of time";
827	}
828
829	my $numargs=-1;
830	my $varargs=0;
831	for (0..32) {
832			if(ApplyHeaders("main(){ $function(".join(",",("0") x $_).");}",@headers)) {
833				$numargs=$_;
834				if(ApplyHeaders("main(){ $function(".join(",",("0") x ($_+1)).");}",@headers)) {
835					$varargs=1;
836				}
837				last
838			}
839	}
840
841	die "Unable to deduce number of arguments" if $numargs==-1;
842
843	if($varargs) { $args[$numargs]="..."; }
844
845	# OK, now we know how many arguments the thing takes.
846
847
848	if(@args>0 and !defined($rettype)) {
849		for (@types) {
850			if(defined(ApplyHeaders("extern $_ $function(".join(",",@args).");main(){}",[@headers]))) {
851				$rettype = $_; # Great, we found the return type.
852				last;
853			}
854		}
855	}
856
857	print "Return type: $rettype\nArguments: ",join(",",@args),"\n";
858	print "Valid number of arguments: $numargs\n";
859	print "Accepts variable number of args: $varargs\n";
860}
861
862
863#$Verbose=1;
864
865#print scalar(join("|",CheckHeader("sgtty.h"))),"\n";
866#print scalar(join("|",FindHeader(CheckHeader("sgtty.h")))),"\n";
867#print scalar(join("|",CheckSymbol("COLOR_PAIRS","curses.h","-lcurses","ncurses.h","-lncurses","ncurses/ncurses.h","ncurses/libncurses.a"))),"\n";
868#print scalar(join("|",GetNumericSymbol("PRIO_USER","sys/resource.h",""))),"\n";
869
870