#!/usr/bin/perl -w

# Copyright 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/>.

use strict;
use Test;
BEGIN {
  plan tests => 4;
}

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }

require Devel::Mallinfo;

my $have_malloc_info_string = Devel::Mallinfo->can('malloc_info_string');
if (! $have_malloc_info_string) {
  MyTestHelpers::diag ('malloc_info_string() not available');
}
my $skip_malloc_info_string = ($have_malloc_info_string
                               ? undef
                               : 'due to malloc_info_string() not available');


#-----------------------------------------------------------------------------
# malloc_info_string() basic run

{
  # successful return depends on disk space available on /tmp, but think
  # it's ok to expect that when testing
  #
  my $str = $have_malloc_info_string && Devel::Mallinfo::malloc_info_string(0);
  skip ($skip_malloc_info_string,
        defined $str,
        1,
        'malloc_info_string() ran');
}

#-----------------------------------------------------------------------------
# weaken of return value

{
  my $have_scalar_util = eval { require Scalar::Util; 1 };
  if (! $have_scalar_util) {
    MyTestHelpers::diag ("Scalar::Util not available: ", $@);
  }

  my $have_weaken;
  if ($have_scalar_util) {
    $have_weaken = do {
      my $ref = [];
      eval { Scalar::Util::weaken ($ref); 1 }
    };
    if (! $have_weaken) {
      MyTestHelpers::diag ("weaken() not available: ", $@);
    }
  }

  my $ref;
  if ($have_malloc_info_string && $have_weaken) {
    $ref = \(Devel::Mallinfo::malloc_info_string(0));
    Scalar::Util::weaken ($ref);
  }
  ok (! defined $ref,
      1,
      'malloc_info_string() destroyed by weaken');
}

#-----------------------------------------------------------------------------
# malloc_info_string() induced failure from tmpfile()

my $have_bsd_resource = eval { require BSD::Resource; 1 };
if (! $have_bsd_resource) {
  MyTestHelpers::diag ("BSD::Resource not available -- ", $@);
}

my $have_rlimit_nofile;
if ($have_bsd_resource) {
  my $limits = BSD::Resource::get_rlimits();
  $have_rlimit_nofile = defined $limits->{'RLIMIT_NOFILE'};
  if (! $have_rlimit_nofile) {
    MyTestHelpers::diag ("RLIMIT_NOFILE not available");
  }
}

# don't think would have RLIMIT_NOFILE but then getrlimit() throwing "not
# implemented on this architecture", but check just in case
my $have_getrlimit;
if ($have_rlimit_nofile) {
  $have_getrlimit = eval {
    BSD::Resource::getrlimit (BSD::Resource::RLIMIT_NOFILE());
    1;
  };
  if (! $have_getrlimit) {
    MyTestHelpers::diag ("getrlimit() not available -- ", $@);
  }
}

# even less likely to have getrlimit() but not then setrlimit(), but check
# just in case
my $have_setrlimit;
if ($have_getrlimit) {
  my ($soft, $hard) = BSD::Resource::getrlimit(BSD::Resource::RLIMIT_NOFILE());
  $have_setrlimit = eval {
    BSD::Resource::setrlimit (BSD::Resource::RLIMIT_NOFILE(), $soft, $hard);
    1;
  };
  if (! $have_setrlimit) {
    MyTestHelpers::diag ("setrlimit() not available -- ",$@);
  }
}

# with RLIMIT_NOFILE making tempfile() fail
{
  my $str;
  my $err = 0;
  my $skip = (! $have_setrlimit
              ? 'due to setrlimit() not available'
              : ! $have_malloc_info_string
              ? 'due to malloc_info_string() not available'
              : undef);

  if ($have_malloc_info_string && $have_setrlimit) {
    my ($soft, $hard) = BSD::Resource::getrlimit(BSD::Resource::RLIMIT_NOFILE());
    MyTestHelpers::diag ("RLIMIT_NOFILE soft $soft hard $hard");

    BSD::Resource::setrlimit (BSD::Resource::RLIMIT_NOFILE(), 0, $hard);
    $str = Devel::Mallinfo::malloc_info_string(0);
    $err = $!;
    BSD::Resource::setrlimit (BSD::Resource::RLIMIT_NOFILE(), $soft, $hard);
  }

  require POSIX;
  my $emfile = eval { POSIX::EMFILE() } || 0; # in case no such errno

  skip ($skip,
        ! defined $str,
        1,
        'malloc_info_string() undef under NOFILE');
  skip ($skip,
        $err+0,
        $emfile,
        'malloc_info_string() errno EMFILE under NOFILE');
}

exit 0;