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