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