#!/usr/bin/perl

# Copyright 2007, 2008, 2009, 2010, 2011 Kevin Ryde

# This file is part of Devel-Mallinfo.

# Devel-Mallinfo is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.

# Devel-Mallinfo is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.

# You should have received a copy of the GNU General Public License along
# with Devel-Mallinfo.  If not, see <http://www.gnu.org/licenses/>.



# Usage: perl inc/config.pl makeprog objext exeext
#
# Generate a "config.h" file for use by Mallinfo.xs.  Normally this is run
# from Makefile.PL, with $(MAKE), $(OBJ_EXT) and $(EXE_EXT) as arguments.
# Those args are used to run "make" on feature test programs.  There's
# probably better ways to do C configury like this, but for one header, one
# struct, and the struct contents it's enough.
#
# Being separate from Makefile.PL lets this script use the $(CC) and rules
# in the Makefile.  Thus for instance
#
#     perl Makefile.PL OPTIMIZE=-g
#
# gets that OPTIMIZE setting used in the configure tests.  Overrides at the
# make stage however will depend on make having the $(MAKEFLAGS) environment
# variable mechanism like GNU make has.  For instance
#
#     perl Makefile.PL
#     make OPTIMIZE=-g    # only with MAKEFLAGS sub-make mechanism
#

use strict;
use POSIX;

# Ensure output goes immediately so messages are in the right place relative
# to external program runs.  Perl output is already supposed to be flushed
# before system() and friends in 5.6 and up, but as per the perlfunc man
# page this might not be the case on all platforms.
select(STDERR);
$| = 1;
select(STDOUT);
$| = 1;

# defaults just for running "perl inc/config.pl" to try it out
my $make      = $ARGV[0] || 'make';
my $objext    = $ARGV[1] || '.o';
my $exeext    = $ARGV[2] || '';
print "inc/config.pl: settings\n";
print "  MAKE=$make\n";
print "  OBJ_EXT=$objext\n";
print "  EXE_EXT=$exeext\n";

sub unlink_maybe {
  my ($filename) = @_;
  if (unlink ($filename) == 0) {
    if ($! != ENOENT) {
      die "Cannot delete file $filename: $!";
    }
  }
}

sub write_file {
  my ($filename, $content) = @_;
  (open (OUT, ">$filename")
   and print OUT $content
   and close OUT)
    or die "Cannot write to file $filename: $@";
}

sub read_file {
  my ($filename) = @_;
  my $content;
  (open IN, "<$filename"
   and do { local $/ = undef; $content = <IN> }
   and close IN)
    or die "Cannot read $filename: $@";
  return $content;
}

# run "make" on $target, return 1 for success, 0 for fail
sub make {
  my ($target) = @_;
  print "$make $target\n";
  # MSDOS builds of perl don't always have WIFEXITED in the POSIX module :-(,
  # so just look for 0 as the wait status for exit code 0 (success)
  return (system ("$make $target") == 0 ? 1 : 0);
}

# attempt to compile and link the program code in $code to produce an
# executable, return 1 if successful, 0 if not
sub try_compile_and_link {
  my ($code) = @_;
  unlink_maybe ("a.out");
  unlink_maybe ("conftest$exeext");
  unlink_maybe ("conftest$objext");
  unlink_maybe ("conftest.i");
  write_file ('conftest.c',
              "/* generated by inc/config.pl */\n" . $code);
  # using .c.o rule from MakeMaker, plus conftest-link rule in Makefile.PL
  return make ("conftest-link");
}

#------------------------------------------------------------------------------
# $CC availability

print "inc/config.pl: testing whether compiler works\n";
my $compiler_works = try_compile_and_link ('
int main (void) { return 0; }
');
if (! $compiler_works) {
  die "Oops, our compile+link rule in the Makefile doesn't work";
}

#------------------------------------------------------------------------------
# malloc.h availability/usability:
#   - freebsd has deliberate #error in malloc.h, which is very stupid
#   - darwin doesn't have malloc.h at all
#
print "inc/config.pl: testing whether <malloc.h> is available\n";
my $have_malloc_h = try_compile_and_link ('
#include <malloc.h>
int main (void) { return 0; }
');
print "inc/config.pl: <malloc.h> ", ($have_malloc_h?"is":"is not"), " available\n";

my $hash_include_malloc_h = ($have_malloc_h ? "#include <malloc.h>\n" : "");


#------------------------------------------------------------------------------
# mallinfo() availability

print "inc/config.pl: testing whether mallinfo() function is available\n";
my $have_mallinfo = try_compile_and_link ("
#include <stdlib.h>
$hash_include_malloc_h
int main (void) {
  struct mallinfo m;
  m = mallinfo ();
  return (m.arena != 0);
}
");
if ($have_mallinfo) {
  print "inc/config.pl: mallinfo() is available\n";
} else {
  print <<EOF;
+------------------------------------------+
+ WARNING:                                 |
+ WARNING: mallinfo() not available        |
+ WARNING: Devel::Mallinfo will do nothing |
+ WARNING:                                 |
+------------------------------------------+
EOF
}

#------------------------------------------------------------------------------
# struct mallinfo fields

my @mallinfo_fields;
if ($have_mallinfo) {
  print "inc/config.pl: extracting fields from struct mallinfo\n";
  # using conftest.c program above and the .c.i rule from MakeMaker
  if (! make ('conftest.i')) {
    if (! make ('conftest-fallback-i')) {
      die "Oops, can't make conftest.i";
    }
  }
  my $preproc = read_file ('conftest.i');

  if (! ($preproc =~ /struct\s+mallinfo\s*\{(.*?)}/s)) {
    print "\"struct mallinfo\" not found in conftest.i preprocessed output\n";

  } else {
    my $body = $1;  # the insides of the struct
    while ($body =~ /([A-Za-z0-9_]+)\s*;/g) {  # field name before each ";"
      push @mallinfo_fields, $1;
    }
    if (@mallinfo_fields) {
      print "struct mallinfo fields found:\n  ",join(' ',@mallinfo_fields),"\n";
    } else {
      print "no fields matched in \"struct mallinfo\" body\n";
    }
  }

  if (! @mallinfo_fields) {
    print <<EOF;
+----------------------------------------------+
+ WARNING:                                     |
+ WARNING: cannot grep struct mallinfo fields, |
+ WARNING: using default fallbacks             |
+ WARNING:                                     |
+----------------------------------------------+
EOF
    @mallinfo_fields = qw(arena ordblks smblks hblks hblkhd
                          usmblks fsmblks uordblks fordblks keepcost);
  }
}


#------------------------------------------------------------------------------
# malloc_info() availability

print "inc/config.pl: testing whether malloc_info() function is available\n";
my $have_malloc_info = try_compile_and_link ("
#include <stdio.h>
#include <stdlib.h>
$hash_include_malloc_h
int main (void) {
  malloc_info(0,stdout);
  return 0;
}
");
if ($have_malloc_info) {
  print "inc/config.pl: malloc_info() is available\n";
} else {
  print "inc/config.pl: malloc_info() not available\n";
}


#------------------------------------------------------------------------------
# malloc_stats() availability

print "inc/config.pl: testing whether malloc_stats() function is available\n";
my $have_malloc_stats = try_compile_and_link ("
#include <stdlib.h>
$hash_include_malloc_h
int main (void) {
  malloc_stats();
  return 0;
}
");
if ($have_malloc_stats) {
  print "inc/config.pl: malloc_stats() is available\n";
} else {
  print "inc/config.pl: malloc_stats() not available\n";
}


#------------------------------------------------------------------------------
# malloc_trim() availability

print "inc/config.pl: testing whether malloc_trim() function is available\n";
my $have_malloc_trim = try_compile_and_link ("
#include <stdlib.h>
$hash_include_malloc_h
int main (void) {
  malloc_trim(1);
  return 0;
}
");
if ($have_malloc_trim) {
  print "inc/config.pl: malloc_trim() is available\n";
} else {
  print "inc/config.pl: malloc_trim() not available\n";
}


#------------------------------------------------------------------------------

open OUT, '>config.h' or die;
print OUT "/* generated by inc/config.pl */

#define HAVE_MALLOC_H     $have_malloc_h
#define HAVE_MALLINFO     $have_mallinfo
#define HAVE_MALLOC_INFO  $have_malloc_info
#define HAVE_MALLOC_STATS $have_malloc_stats
#define HAVE_MALLOC_TRIM  $have_malloc_trim

#define STRUCT_MALLINFO_FIELDS \\
";
my $field;
foreach $field (@mallinfo_fields) {
  print OUT "  FIELD ($field);  \\\n";
}
print OUT "  /*end*/\n";
close OUT or die;

exit 0;