t/op/negate.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 plan tests => 48;
  10
  11 # Some of these will cause warnings if left on.  Here we're checking the
  12 # functionality, not the warnings.
  13 no warnings "numeric";
  14
  15 # test cases based on [perl #36675] -'-10' eq '+10'
  16 is(- 10, -10, "Simple numeric negation to negative");
  17 is(- -10, 10, "Simple numeric negation to positive");
  18 is(-"10", -10, "Negation of a positive string to negative");
  19 is(-"10.0", -10, "Negation of a positive decimal sting to negative");
  20 is(-"10foo", -10, "Negation of a numeric-lead string returns negation of numeric");
  21 is(-"-10", 10, 'Negation of string starting with "-" returns a positive number - integer');
  22 "-10" =~ /(.*)/;
  23 is(-$1, 10, 'Negation of magical string starting with "-" - integer');
  24 is(-"-10.0", 10.0, 'Negation of string starting with "-" returns a positive number - decimal');
  25 "-10.0" =~ /(.*)/;
  26 is(-$1, 10.0, 'Negation of magical string starting with "-" - decimal');
  27 is(-"-10foo", "+10foo", 'Negation of string starting with "-" returns a string starting with "+" - non-numeric');
  28 is(-"xyz", "-xyz", 'Negation of a negative string adds "-" to the front');
  29 is(-"-xyz", "+xyz", "Negation of a negative string to positive");
  30 is(-"+xyz", "-xyz", "Negation of a positive string to negative");
  31 is(-bareword, "-bareword", "Negation of bareword treated like a string");
  32 is(- -bareword, "+bareword", "Negation of -bareword returns string +bareword");
  33 is(-" -10", 10, "Negation of a whitespace-lead numeric string");
  34 is(-" -10.0", 10, "Negation of a whitespace-lead decimal string");
  35 is(-" -10foo", 10,
  36     "Negation of a whitespace-lead sting starting with a numeric");
  37 { local $::TODO = 'broken';
  38 is(-"-e1", "+e1", "Negation of e1");
  39 }
  40
  41 $x = "dogs";
  42 ()=0+$x;
  43 is -$x, '-dogs', 'cached numeric value does not sabotage string negation';
  44
  45 is(-"97656250000000000", -97656250000000000, '-bigint vs -"bigint"');
  46 "9765625000000000" =~ /(\d+)/;
  47 is -$1, -"$1", '-$1 vs -"$1" with big int';
  48
  49 $a = "%apples";
  50 chop($au = "%apples\x{100}");
  51 is(-$au, -$a, 'utf8 flag makes no difference for string negation');
  52 is -"\x{100}", 0, '-(non-ASCII) is equivalent to -(punct)';
  53
  54 sub TIESCALAR { bless[] }
  55 sub STORE { $_[0][0] = $_[1] }
  56 sub FETCH { $_[0][0] }
  57
  58 tie $t, "";
  59 $a = "97656250000000000";
  60 () = 0+$a;
  61 $t = $a;
  62 is -$t, -97656250000000000, 'magic str+int dualvar';
  63
  64 { # Repeat most of the tests under use integer
  65     use integer;
  66     is(- 10, -10, "Simple numeric negation to negative");
  67     is(- -10, 10, "Simple numeric negation to positive");
  68     is(-"10", -10, "Negation of a positive string to negative");
  69     is(-"10.0", -10, "Negation of a positive decimal sting to negative");
  70     is(-"10foo", -10,
  71         "Negation of a numeric-lead string returns negation of numeric");
  72     is(-"-10", 10,
  73         'Negation of string starting with "-" returns a positive number -'
  74        .' integer');
  75     "-10" =~ /(.*)/;
  76     is(-$1, 10, 'Negation of magical string starting with "-" - integer');
  77     is(-"-10.0", 10,
  78         'Negation of string starting with "-" returns a positive number - '
  79        .'decimal');
  80     "-10.0" =~ /(.*)/;
  81     is(-$1, 10, 'Negation of magical string starting with "-" - decimal');
  82     is(-"-10foo", "+10foo",
  83        'Negation of string starting with "-" returns a string starting '
  84       .'with "+" - non-numeric');
  85     is(-"xyz", "-xyz",
  86        'Negation of a negative string adds "-" to the front');
  87     is(-"-xyz", "+xyz", "Negation of a negative string to positive");
  88     is(-"+xyz", "-xyz", "Negation of a positive string to negative");
  89     is(-bareword, "-bareword",
  90         "Negation of bareword treated like a string");
  91     is(- -bareword, "+bareword",
  92         "Negation of -bareword returns string +bareword");
  93     is(-" -10", 10, "Negation of a whitespace-lead numeric string");
  94     is(-" -10.0", 10, "Negation of a whitespace-lead decimal string");
  95     is(-" -10foo", 10,
  96         "Negation of a whitespace-lead sting starting with a numeric");
  97     { local $::TODO = 'broken';
  98     is(-"-e1", "+e1", "Negation of e1 (use integer)");
  99     }
 100
 101     $x = "dogs";
 102     ()=0+$x;
 103     is -$x, '-dogs',
 104         'cached numeric value does not sabotage string negation';
 105
 106     $a = "%apples";
 107     chop($au = "%apples\x{100}");
 108     is(-$au, -$a, 'utf8 flag makes no difference for string negation');
 109     is -"\x{100}", 0, '-(non-ASCII) is equivalent to -(punct)';
 110 }
 111
 112 # [perl #120288] use integer should not stop barewords from being quoted
 113 {
 114     use strict;
 115     use integer;
 116     is eval "return -a"||$@, "-a", '-bareword under strict+integer';
 117 }