git.gag.com Git - debian/amanda/blob - installcheck/bigint.pl

   1 # Copyright (c) 2008-2012 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or
   4 # modify it under the terms of the GNU General Public License
   5 # as published by the Free Software Foundation; either version 2
   6 # of the License, or (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful, but
   9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11 # for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 #
  17 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 use Test::More tests => 74;
  21 use strict;
  22 use warnings;
  23
  24 use lib "@amperldir@";
  25 use Amanda::Tests;
  26 use Math::BigInt;
  27 use Amanda::BigIntCompat;
  28
  29 # define some constants; Perl doesn't have native 64-bit numbers, so
  30 # none are tested
  31 my $G_MAXUINT64_bigint = Math::BigInt->new('18446744073709551615');
  32 my $G_MAXINT64_bigint = Math::BigInt->new('9223372036854775807');
  33 my $G_MININT64_bigint = Math::BigInt->new('-9223372036854775808');
  34
  35 my $G_MAXUINT32_native = 2 ** 32 - 1;
  36 my $G_MAXUINT32_double = 2.0 ** 32 - 1;
  37 my $G_MAXUINT32_bigint = Math::BigInt->new('4294967295');
  38 my $G_MAXINT32_native = 2 ** 31 - 1;
  39 my $G_MAXINT32_double = 2.0 ** 31 - 1;
  40 my $G_MAXINT32_bigint = Math::BigInt->new('2147483647');
  41 my $G_MININT32_native = - 2 ** 31;
  42 my $G_MININT32_double = - 2.0 ** 31;
  43 my $G_MININT32_bigint = Math::BigInt->new('-2147483648');
  44
  45 my $G_MAXUINT16_native = 2 ** 16 - 1;
  46 my $G_MAXUINT16_double = 2.0 ** 16 - 1;
  47 my $G_MAXUINT16_bigint = Math::BigInt->new('65535');
  48 my $G_MAXINT16_native = 2 ** 15 - 1;
  49 my $G_MAXINT16_double = 2.0 ** 15 - 1;
  50 my $G_MAXINT16_bigint = Math::BigInt->new('32767');
  51 my $G_MININT16_native = - 2 ** 15;
  52 my $G_MININT16_double = - 2.0 ** 15;
  53 my $G_MININT16_bigint = Math::BigInt->new('-32768');
  54
  55 my $G_MAXUINT8_native = 2 ** 8 - 1;
  56 my $G_MAXUINT8_double = 2.0 ** 8 - 1;
  57 my $G_MAXUINT8_bigint = Math::BigInt->new('255');
  58 my $G_MAXINT8_native = 2 ** 7 - 1;
  59 my $G_MAXINT8_double = 2.0 ** 7 - 1;
  60 my $G_MAXINT8_bigint = Math::BigInt->new('127');
  61 my $G_MININT8_native = - 2 ** 7;
  62 my $G_MININT8_double = - 2.0 ** 7;
  63 my $G_MININT8_bigint = Math::BigInt->new('-128');
  64
  65 # first test "taking" integers -- Perl -> C
  66
  67 is(Amanda::Tests::take_guint64(0), "ZERO",
  68     "Perl->C guint64 0");
  69 is(Amanda::Tests::take_guint64($G_MAXUINT64_bigint), "MAX",
  70     "Perl->C guint64 bigint MAX ($G_MAXUINT64_bigint)");
  71 is(Amanda::Tests::take_gint64(0), "ZERO",
  72     "Perl->C gint64 0");
  73 is(Amanda::Tests::take_gint64($G_MAXINT64_bigint), "MAX",
  74     "Perl->C gint64 bigint MAX ($G_MAXINT64_bigint)");
  75 is(Amanda::Tests::take_gint64($G_MININT64_bigint), "MIN",
  76     "Perl->C gint64 bigint MIN ($G_MININT64_bigint)");
  77
  78 is(Amanda::Tests::take_guint32(0), "ZERO",
  79     "Perl->C guint32 0");
  80 is(Amanda::Tests::take_guint32($G_MAXUINT32_bigint), "MAX",
  81     "Perl->C guint32 bigint MAX ($G_MAXUINT32_bigint)");
  82 is(Amanda::Tests::take_guint32($G_MAXUINT32_native), "MAX",
  83     "Perl->C guint32 native MAX ($G_MAXUINT32_native)");
  84 is(Amanda::Tests::take_guint32($G_MAXUINT32_double), "MAX",
  85     "Perl->C guint32 double MAX ($G_MAXUINT32_double)");
  86 is(Amanda::Tests::take_gint32(0), "ZERO",
  87     "Perl->C gint32 0");
  88 is(Amanda::Tests::take_gint32($G_MAXINT32_bigint), "MAX",
  89     "Perl->C gint32 bigint MAX ($G_MAXINT32_bigint)");
  90 is(Amanda::Tests::take_gint32($G_MAXINT32_native), "MAX",
  91     "Perl->C gint32 native MAX ($G_MAXINT32_native)");
  92 is(Amanda::Tests::take_gint32($G_MAXINT32_double), "MAX",
  93     "Perl->C gint32 double MAX ($G_MAXINT32_double)");
  94 is(Amanda::Tests::take_gint32($G_MININT32_bigint), "MIN",
  95     "Perl->C gint32 bigint MIN ($G_MININT32_bigint)");
  96 is(Amanda::Tests::take_gint32($G_MININT32_native), "MIN",
  97     "Perl->C gint32 native MIN ($G_MININT32_native)");
  98 is(Amanda::Tests::take_gint32($G_MININT32_double), "MIN",
  99     "Perl->C gint32 double MIN ($G_MININT32_double)");
 100
 101 is(Amanda::Tests::take_guint16(0), "ZERO",
 102     "Perl->C guint16 0");
 103 is(Amanda::Tests::take_guint16($G_MAXUINT16_bigint), "MAX",
 104     "Perl->C guint16 bigint MAX ($G_MAXUINT16_bigint)");
 105 is(Amanda::Tests::take_guint16($G_MAXUINT16_native), "MAX",
 106     "Perl->C guint16 native MAX ($G_MAXUINT16_native)");
 107 is(Amanda::Tests::take_guint16($G_MAXUINT16_double), "MAX",
 108     "Perl->C guint16 double MAX ($G_MAXUINT16_double)");
 109 is(Amanda::Tests::take_gint16(0), "ZERO",
 110     "Perl->C gint16 0");
 111 is(Amanda::Tests::take_gint16($G_MAXINT16_bigint), "MAX",
 112     "Perl->C gint16 bigint MAX ($G_MAXINT16_bigint)");
 113 is(Amanda::Tests::take_gint16($G_MAXINT16_native), "MAX",
 114     "Perl->C gint16 native MAX ($G_MAXINT16_native)");
 115 is(Amanda::Tests::take_gint16($G_MAXINT16_double), "MAX",
 116     "Perl->C gint16 double MAX ($G_MAXINT16_double)");
 117 is(Amanda::Tests::take_gint16($G_MININT16_bigint), "MIN",
 118     "Perl->C gint16 bigint MIN ($G_MININT16_bigint)");
 119 is(Amanda::Tests::take_gint16($G_MININT16_native), "MIN",
 120     "Perl->C gint16 native MIN ($G_MININT16_native)");
 121 is(Amanda::Tests::take_gint16($G_MININT16_double), "MIN",
 122     "Perl->C gint16 double MIN ($G_MININT16_double)");
 123
 124 is(Amanda::Tests::take_guint8(0), "ZERO",
 125     "Perl->C guint8 0");
 126 is(Amanda::Tests::take_guint8($G_MAXUINT8_bigint), "MAX",
 127     "Perl->C guint8 bigint MAX ($G_MAXUINT8_bigint)");
 128 is(Amanda::Tests::take_guint8($G_MAXUINT8_native), "MAX",
 129     "Perl->C guint8 native MAX ($G_MAXUINT8_native)");
 130 is(Amanda::Tests::take_guint8($G_MAXUINT8_double), "MAX",
 131     "Perl->C guint8 double MAX ($G_MAXUINT8_double)");
 132 is(Amanda::Tests::take_gint8(0), "ZERO",
 133     "Perl->C gint8 0");
 134 is(Amanda::Tests::take_gint8($G_MAXINT8_bigint), "MAX",
 135     "Perl->C gint8 bigint MAX ($G_MAXINT8_bigint)");
 136 is(Amanda::Tests::take_gint8($G_MAXINT8_native), "MAX",
 137     "Perl->C gint8 native MAX ($G_MAXINT8_native)");
 138 is(Amanda::Tests::take_gint8($G_MAXINT8_double), "MAX",
 139     "Perl->C gint8 double MAX ($G_MAXINT8_double)");
 140 is(Amanda::Tests::take_gint8($G_MININT8_bigint), "MIN",
 141     "Perl->C gint8 bigint MIN ($G_MININT8_bigint)");
 142 is(Amanda::Tests::take_gint8($G_MININT8_native), "MIN",
 143     "Perl->C gint8 native MIN ($G_MININT8_native)");
 144 is(Amanda::Tests::take_gint8($G_MININT8_double), "MIN",
 145     "Perl->C gint8 double MIN ($G_MININT8_double)");
 146
 147 # now test giving integers -- C -> Perl
 148
 149 is(Amanda::Tests::give_guint64("0"), 0, "C -> Perl guint64 0");
 150 is(Amanda::Tests::give_guint64("+"), $G_MAXUINT64_bigint, "C -> Perl guint64 MAX (always bigint)");
 151 is(Amanda::Tests::give_gint64("0"), 0, "C -> Perl gint64 0");
 152 is(Amanda::Tests::give_gint64("+"), $G_MAXINT64_bigint, "C -> Perl gint64 MAX (always bigint)");
 153 is(Amanda::Tests::give_gint64("-"), $G_MININT64_bigint, "C -> Perl gint64 MIN (always bigint)");
 154
 155 is(Amanda::Tests::give_guint32("0"), 0, "C -> Perl guint32 0");
 156 is(Amanda::Tests::give_guint32("+"), $G_MAXUINT32_bigint, "C -> Perl guint32 MAX (always bigint)");
 157 is(Amanda::Tests::give_gint32("0"), 0, "C -> Perl gint32 0");
 158 is(Amanda::Tests::give_gint32("+"), $G_MAXINT32_bigint, "C -> Perl gint32 MAX (always bigint)");
 159 is(Amanda::Tests::give_gint32("-"), $G_MININT32_bigint, "C -> Perl gint32 MIN (always bigint)");
 160
 161 is(Amanda::Tests::give_guint16("0"), 0, "C -> Perl guint16 0");
 162 is(Amanda::Tests::give_guint16("+"), $G_MAXUINT16_bigint, "C -> Perl guint16 MAX (always bigint)");
 163 is(Amanda::Tests::give_gint16("0"), 0, "C -> Perl gint16 0");
 164 is(Amanda::Tests::give_gint16("+"), $G_MAXINT16_bigint, "C -> Perl gint16 MAX (always bigint)");
 165 is(Amanda::Tests::give_gint16("-"), $G_MININT16_bigint, "C -> Perl gint16 MIN (always bigint)");
 166
 167 is(Amanda::Tests::give_guint8("0"), 0, "C -> Perl guint8 0");
 168 is(Amanda::Tests::give_guint8("+"), $G_MAXUINT8_bigint, "C -> Perl guint8 MAX (always bigint)");
 169 is(Amanda::Tests::give_gint8("0"), 0, "C -> Perl gint8 0");
 170 is(Amanda::Tests::give_gint8("+"), $G_MAXINT8_bigint, "C -> Perl gint8 MAX (always bigint)");
 171 is(Amanda::Tests::give_gint8("-"), $G_MININT8_bigint, "C -> Perl gint8 MIN (always bigint)");
 172
 173 # finally, test overflows in Perl -> C conversions; these all croak(), so we capture the errors
 174 # with an eval {}
 175
 176 eval { Amanda::Tests::take_gint64($G_MAXINT64_bigint+1); };
 177 like($@, qr/Expected a signed 64-bit value or smaller/,
 178     "gint64 rejects numbers greater than max");
 179 eval { Amanda::Tests::take_gint64($G_MININT64_bigint-1); };
 180 like($@, qr/Expected a signed 64-bit value or smaller/,
 181     "gint64 rejects numbers less than min");
 182 eval { Amanda::Tests::take_guint64($G_MAXUINT64_bigint+1); };
 183 like($@, qr/Expected an unsigned 64-bit value or smaller/,
 184     "guint64 rejects numbers greater than max");
 185 eval { Amanda::Tests::take_guint64(-1); };
 186 like($@, qr/Expected an unsigned value, got a negative integer/,
 187     "guint64 rejects numbers less than zero");
 188
 189 eval { Amanda::Tests::take_gint32($G_MAXINT32_native+1); };
 190 like($@, qr/Expected a 32-bit integer; value out of range/,
 191     "gint32 rejects numbers greater than max");
 192 eval { Amanda::Tests::take_gint32($G_MININT32_native-1); };
 193 like($@, qr/Expected a 32-bit integer; value out of range/,
 194     "gint32 rejects numbers less than min");
 195 eval { Amanda::Tests::take_guint32($G_MAXUINT32_native+1); };
 196 like($@, qr/Expected a 32-bit unsigned integer/,
 197     "guint32 rejects numbers greater than max");
 198 eval { Amanda::Tests::take_guint32(-1); };
 199 like($@, qr/Expected an unsigned value, got a negative integer/,
 200     "guint32 rejects numbers less than zero");
 201
 202 eval { Amanda::Tests::take_gint16($G_MAXINT16_native+1); };
 203 like($@, qr/Expected a 16-bit integer; value out of range/,
 204     "gint16 rejects numbers greater than max");
 205 eval { Amanda::Tests::take_gint16($G_MININT16_native-1); };
 206 like($@, qr/Expected a 16-bit integer; value out of range/,
 207     "gint16 rejects numbers less than min");
 208 eval { Amanda::Tests::take_guint16($G_MAXUINT16_native+1); };
 209 like($@, qr/Expected a 16-bit unsigned integer/,
 210     "guint16 rejects numbers greater than max");
 211 eval { Amanda::Tests::take_guint16(-1); };
 212 like($@, qr/Expected an unsigned value, got a negative integer/,
 213     "guint16 rejects numbers less than zero");
 214
 215 eval { Amanda::Tests::take_gint8($G_MAXINT8_native+1); };
 216 like($@, qr/Expected a 8-bit integer; value out of range/,
 217     "gint8 rejects numbers greater than max");
 218 eval { Amanda::Tests::take_gint8($G_MININT8_native-1); };
 219 like($@, qr/Expected a 8-bit integer; value out of range/,
 220     "gint8 rejects numbers less than min");
 221 eval { Amanda::Tests::take_guint8($G_MAXUINT8_native+1); };
 222 like($@, qr/Expected a 8-bit unsigned integer/,
 223     "guint8 rejects numbers greater than max");
 224 eval { Amanda::Tests::take_guint8(-1); };
 225 like($@, qr/Expected an unsigned value, got a negative integer/,
 226     "guint8 rejects numbers less than zero");