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