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