languages/tcl/t/cmd_exprOld.t

   1 #!perl
   2
   3 # Copyright (C) 2004-2006, The Perl Foundation.
   4 # $Id$
   5
   6 use strict;
   7 use warnings;
   8 use lib qw(tcl/lib ./lib ../lib ../../lib ../../../lib);
   9
  10 use Parrot::Test tests => 80;
  11 use Test::More;
  12
  13 language_output_is( "tcl", <<'TCL', <<OUT, "lt, numeric, not alpha, with vars" );
  14  set a 10
  15  puts [expr $a < 9]
  16 TCL
  17 0
  18 OUT
  19
  20 language_output_is( "tcl", <<'TCL', <<OUT, "lt, numeric, not alpha, with vars and braces" );
  21  set a 10
  22  puts [expr {$a < 9}]
  23 TCL
  24 0
  25 OUT
  26
  27 language_output_is( "tcl", <<TCL, <<OUT, "&&, both sides" );
  28  proc true {} {puts T; return 1}
  29  proc false {} {puts F; return 0}
  30  puts [expr {[true] && [false]}]
  31 TCL
  32 T
  33 F
  34 0
  35 OUT
  36
  37 language_output_is( "tcl", <<TCL, <<OUT, "||, both sides" );
  38  proc true {} {puts T; return 1}
  39  proc false {} {puts F; return 0}
  40  puts [expr {[false] || [true]}]
  41 TCL
  42 F
  43 T
  44 1
  45 OUT
  46
  47 language_output_is( "tcl", <<TCL, <<OUT, "&&, short circuited" );
  48  proc true {} {puts T; return 1}
  49  proc false {} {puts F; return 0}
  50  puts [expr {[false] && [true]}]
  51 TCL
  52 F
  53 0
  54 OUT
  55
  56 language_output_is( "tcl", <<TCL, <<OUT, "||, short circuited" );
  57  proc true {} {puts T; return 1}
  58  proc false {} {puts F; return 0}
  59  puts [expr {[true] || [false]}]
  60 TCL
  61 T
  62 1
  63 OUT
  64
  65 language_output_is( "tcl", <<'TCL', <<'OUT', 'atan2(3, "a")' );
  66   expr atan2(3,"a")
  67 TCL
  68 argument to math function didn't have numeric value
  69 OUT
  70
  71 language_output_is( "tcl", <<'TCL', <<'OUT', 'atan2("a", 3)' );
  72   expr atan2("a",3)
  73 TCL
  74 argument to math function didn't have numeric value
  75 OUT
  76
  77 language_output_is( "tcl", <<'TCL', <<'OUT', 'atan2("a")' );
  78   expr atan2("a")
  79 TCL
  80 too few arguments for math function
  81 OUT
  82
  83 language_output_is( "tcl", <<'TCL', <<'OUT', "ceil(a)" );
  84   expr ceil(a)
  85 TCL
  86 syntax error in expression "ceil(a)": the word "ceil(a)" requires a preceding $ if it's a variable or function arguments if it's a function
  87 OUT
  88
  89 language_output_is( 'tcl', <<'TCL', <<'OUT', 'ceil("a")' );
  90   expr ceil("a")
  91 TCL
  92 argument to math function didn't have numeric value
  93 OUT
  94
  95 language_output_is( 'tcl', <<'TCL', <<'OUT', 'double("a")' );
  96   expr double("a")
  97 TCL
  98 argument to math function didn't have numeric value
  99 OUT
 100
 101 language_output_is( "tcl", <<'TCL', <<'OUT', "fmod(3,0) - domain error" );
 102   expr fmod(3,0)
 103 TCL
 104 domain error: argument not in valid range
 105 OUT
 106
 107 language_output_is( 'tcl', <<'TCL', <<'OUT', 'fmod(-4,"a")' );
 108   expr fmod(-4,"a")
 109 TCL
 110 argument to math function didn't have numeric value
 111 OUT
 112
 113 language_output_is( 'tcl', <<'TCL', <<'OUT', 'fmod("a",-4)' );
 114   expr fmod("a",-4)
 115 TCL
 116 argument to math function didn't have numeric value
 117 OUT
 118
 119 language_output_is( "tcl", <<'TCL', <<'OUT', 'hypot(-3,"a")' );
 120   expr hypot(-3,"a")
 121 TCL
 122 argument to math function didn't have numeric value
 123 OUT
 124
 125 language_output_is( "tcl", <<'TCL', <<'OUT', 'hypot("a",-3)' );
 126   expr hypot("a",-3)
 127 TCL
 128 argument to math function didn't have numeric value
 129 OUT
 130
 131 language_output_is( "tcl", <<'TCL', <<'OUT', 'int("a")' );
 132   expr int("a")
 133 TCL
 134 argument to math function didn't have numeric value
 135 OUT
 136
 137 language_output_is( "tcl", <<'TCL', <<'OUT', "log(-4) - domain error" );
 138   expr log(-4)
 139 TCL
 140 domain error: argument not in valid range
 141 OUT
 142
 143 language_output_is( 'tcl', <<'TCL', <<'OUT', 'pow(2,"a")' );
 144   expr pow(2,"a")
 145 TCL
 146 argument to math function didn't have numeric value
 147 OUT
 148
 149 language_output_is( 'tcl', <<'TCL', <<'OUT', 'pow("a",2)' );
 150   expr pow("a",2)
 151 TCL
 152 argument to math function didn't have numeric value
 153 OUT
 154
 155 language_output_is( 'tcl', <<'TCL', <<'OUT', 'round("a")' );
 156   expr round("a")
 157 TCL
 158 argument to math function didn't have numeric value
 159 OUT
 160
 161 language_output_is( "tcl", <<'TCL', <<'OUT', "sqrt(-49) - domain error" );
 162   expr sqrt(-49)
 163 TCL
 164 domain error: argument not in valid range
 165 OUT
 166
 167 language_output_is( 'tcl', <<'TCL', <<'OUT', 'abs(1,2) - too many args' );
 168   expr abs(1,2)
 169 TCL
 170 too many arguments for math function
 171 OUT
 172
 173 language_output_is( 'tcl', <<'TCL', <<'OUT', 'hypot(1) - too few args' );
 174   expr hypot(1)
 175 TCL
 176 too few arguments for math function
 177 OUT
 178
 179 # misc.
 180
 181 language_output_is( "tcl", <<TCL, <<OUT, "simple precedence" );
 182  puts [expr 2*3+4*2]
 183 TCL
 184 14
 185 OUT
 186
 187 language_output_is( "tcl", <<TCL, <<OUT, "parens" );
 188  puts [expr 2*(3+4)*2]
 189 TCL
 190 28
 191 OUT
 192
 193 language_output_is( "tcl", <<'TCL', <<'OUT', "premature end of expr '('" );
 194   puts [expr "("]
 195 TCL
 196 syntax error in expression "(": premature end of expression
 197 OUT
 198
 199 language_output_is( "tcl", <<'TCL', <<'OUT', "float division" );
 200 puts [expr 1 / 3.0]
 201 TCL
 202 0.3333333333333333
 203 OUT
 204
 205 language_output_is( "tcl", <<'TCL', <<'OUT', "nested expr (braces)" );
 206  puts [expr {2 * [expr {2 - 1}]}];
 207 TCL
 208 2
 209 OUT
 210
 211 language_output_is( "tcl", <<'TCL', <<'OUT', "braced operands." );
 212  set n 1
 213  puts [expr {$n * 1}]
 214 TCL
 215 1
 216 OUT
 217
 218 language_output_is( "tcl", <<'TCL', <<'OUT', "puts inside an expr" );
 219   puts [expr {[puts 2]}]
 220 TCL
 221 2
 222
 223 OUT
 224
 225 language_output_is( "tcl", <<'TCL', <<'OUT', "eq, extra characters after quotes" );
 226   puts [expr {"foo"eq{foo}}]
 227 TCL
 228 1
 229 OUT
 230
 231 language_output_is( "tcl", <<'TCL', <<'OUT', "eq, extra characters after brace" );
 232   puts [expr {{foo}eq"foo"}]
 233 TCL
 234 1
 235 OUT
 236
 237 language_output_is( "tcl", <<'TCL', <<'OUT', "eq (false)" );
 238   puts [expr {"foo"eq{baz}}]
 239 TCL
 240 0
 241 OUT
 242
 243 language_output_is( "tcl", <<'TCL', <<'OUT', "ne (true)" );
 244   puts [expr {{foo}ne{baz}}]
 245 TCL
 246 1
 247 OUT
 248
 249 language_output_is( "tcl", <<'TCL', <<'OUT', "ne (false)" );
 250   puts [expr {{foo}ne{foo}}]
 251 TCL
 252 0
 253 OUT
 254
 255 language_output_is( "tcl", <<'TCL', <<'OUT', "string == (true)" );
 256   puts [expr {"foo"=="foo"}]
 257 TCL
 258 1
 259 OUT
 260
 261 language_output_is( "tcl", <<'TCL', <<'OUT', "string == (false)" );
 262   puts [expr {"foo"=="baz"}]
 263 TCL
 264 0
 265 OUT
 266
 267 language_output_is( "tcl", <<'TCL', <<'OUT', "string != (true)" );
 268   puts [expr {"foo" != "baz"}]
 269 TCL
 270 1
 271 OUT
 272
 273 language_output_is( "tcl", <<'TCL', <<'OUT', "string != (false)" );
 274   puts [expr {"foo"!="foo"}]
 275 TCL
 276 0
 277 OUT
 278
 279 language_output_is( "tcl", <<'TCL', <<'OUT', "string <= (less)" );
 280   puts [expr {"abb"<="abc"}]
 281 TCL
 282 1
 283 OUT
 284
 285 language_output_is( "tcl", <<'TCL', <<'OUT', "string <= (greater)" );
 286   puts [expr {"abc"<="abb"}]
 287 TCL
 288 0
 289 OUT
 290
 291 language_output_is( "tcl", <<'TCL', <<'OUT', "string <= (equal)" );
 292   puts [expr {"abc"<="abc"}]
 293 TCL
 294 1
 295 OUT
 296
 297 language_output_is( "tcl", <<'TCL', <<'OUT', "string >= (less)" );
 298   puts [expr {"abb" >= "abc"}]
 299 TCL
 300 0
 301 OUT
 302
 303 language_output_is( "tcl", <<'TCL', <<'OUT', "string >= (greater)" );
 304   puts [expr {"abc" >= "abb"}]
 305 TCL
 306 1
 307 OUT
 308
 309 language_output_is( "tcl", <<'TCL', <<'OUT', "string >= (equal)" );
 310   puts [expr {"abc" >= "abc"}]
 311 TCL
 312 1
 313 OUT
 314
 315 language_output_is( "tcl", <<'TCL', <<'OUT', "string < (less)" );
 316   puts [expr {"abb" < "abc"}]
 317 TCL
 318 1
 319 OUT
 320
 321 language_output_is( "tcl", <<'TCL', <<'OUT', "string < (greater)" );
 322   puts [expr {"abc" < "abb"}]
 323 TCL
 324 0
 325 OUT
 326
 327 language_output_is( "tcl", <<'TCL', <<'OUT', "string < (equal)" );
 328   puts [expr {"abc" < "abc"}]
 329 TCL
 330 0
 331 OUT
 332
 333 language_output_is( "tcl", <<'TCL', <<'OUT', "string > (less)" );
 334   puts [expr {"abb" > "abc"}]
 335 TCL
 336 0
 337 OUT
 338
 339 language_output_is( "tcl", <<'TCL', <<'OUT', "string > (greater)" );
 340   puts [expr {"abc" > "abb"}]
 341 TCL
 342 1
 343 OUT
 344
 345 language_output_is( "tcl", <<'TCL', <<'OUT', "string > (equal)" );
 346   puts [expr {"abc" > "abc"}]
 347 TCL
 348 0
 349 OUT
 350
 351 language_output_is( "tcl", <<'TCL', <<'OUT', "unknown math function" );
 352   puts [expr fink()]
 353 TCL
 354 unknown math function "fink"
 355 OUT
 356
 357 language_output_is( "tcl", <<TCL, <<OUT, "float remainder" );
 358  puts [expr 3.2 % 2]
 359 TCL
 360 can't use floating-point value as operand of "%"
 361 OUT
 362
 363 language_output_is( "tcl", <<TCL, <<OUT, "float left shift" );
 364  puts [expr 3.2 << 2]
 365 TCL
 366 can't use floating-point value as operand of "<<"
 367 OUT
 368
 369 language_output_is( "tcl", <<TCL, <<OUT, "float right shift" );
 370  puts [expr 3.2 >> 2]
 371 TCL
 372 can't use floating-point value as operand of ">>"
 373 OUT
 374
 375 language_output_is( "tcl", <<TCL, <<OUT, "float &" );
 376  puts [expr 3.2 & 2]
 377 TCL
 378 can't use floating-point value as operand of "&"
 379 OUT
 380
 381 language_output_is( "tcl", <<TCL, <<OUT, "float |" );
 382  puts [expr 3.2 | 2]
 383 TCL
 384 can't use floating-point value as operand of "|"
 385 OUT
 386
 387 language_output_is( "tcl", <<TCL, <<OUT, "float ^" );
 388  puts [expr 3.2 ^ 2]
 389 TCL
 390 can't use floating-point value as operand of "^"
 391 OUT
 392
 393 language_output_is( "tcl", <<TCL, <<OUT, "octal" );
 394  puts [expr 000012345]
 395 TCL
 396 5349
 397 OUT
 398
 399 language_output_is( "tcl", <<TCL, <<OUT, "neg octal" );
 400  puts [expr -000012345]
 401 TCL
 402 -5349
 403 OUT
 404
 405 language_output_is( "tcl", <<TCL, <<OUT, "pos octal" );
 406  puts [expr +000012345]
 407 TCL
 408 5349
 409 OUT
 410
 411 language_output_is( "tcl", <<TCL, <<OUT, "bad octal" );
 412  puts [expr 0000912345]
 413 TCL
 414 expected integer but got "0000912345" (looks like invalid octal number)
 415 OUT
 416
 417 language_output_is( "tcl", <<TCL, <<OUT, "floats aren't octal" );
 418  puts [expr 000012345.0]
 419 TCL
 420 12345.0
 421 OUT
 422
 423 language_output_is( "tcl", <<'TCL', <<'OUT', "string > int" );
 424  puts [expr {"a" > 10}]
 425 TCL
 426 1
 427 OUT
 428
 429 language_output_is( "tcl", <<'TCL', <<'OUT', "string int < int" );
 430  puts [expr {"2" < 10}]
 431 TCL
 432 1
 433 OUT
 434
 435 language_output_is( "tcl", <<'TCL', <<'OUT', "string int < string int" );
 436  puts [expr {"2" < "10"}]
 437 TCL
 438 1
 439 OUT
 440
 441 language_output_is( "tcl", <<'TCL', <<'OUT', "in - true" );
 442   set list {b c d f}
 443   puts [expr {"b" in $list}]
 444 TCL
 445 1
 446 OUT
 447
 448 language_output_is( "tcl", <<'TCL', <<'OUT', "in - false" );
 449   set list {b c d f}
 450   puts [expr {"e" in $list}]
 451 TCL
 452 0
 453 OUT
 454
 455 language_output_is( "tcl", <<'TCL', <<'OUT', "ni - true" );
 456   set list {b c d f}
 457   puts [expr {"e" ni $list}]
 458 TCL
 459 1
 460 OUT
 461
 462 language_output_is( "tcl", <<'TCL', <<'OUT', "ni - false" );
 463   set list {b c d f}
 464   puts [expr {"b" ni $list}]
 465 TCL
 466 0
 467 OUT
 468
 469 language_output_is( "tcl", <<'TCL', <<'OUT', "hex number" );
 470   puts [expr {0xf}]
 471 TCL
 472 15
 473 OUT
 474
 475 language_output_is( "tcl", <<'TCL', <<'OUT', "hex multiplication" );
 476   puts [expr {0xf*0xa}]
 477 TCL
 478 150
 479 OUT
 480
 481 language_output_is( "tcl", <<'TCL', <<'OUT', 'bad hex' );
 482   expr 0xg
 483 TCL
 484 syntax error in expression "0xg": extra tokens at end of expression
 485 OUT
 486
 487 language_output_is( "tcl", <<'TCL', <<'OUT', 'simple ternary' );
 488   puts [ expr 1?"whee":"cry"]
 489 TCL
 490 whee
 491 OUT
 492
 493 language_output_is( "tcl", <<'TCL', <<'OUT', 'ternary, true, short circuit' );
 494   expr {1?[puts ok]:[puts nok]}
 495 TCL
 496 ok
 497 OUT
 498
 499 language_output_is( "tcl", <<'TCL', <<'OUT', 'ternary, false, short circuit' );
 500   expr {0?[puts true]:[puts false]}
 501 TCL
 502 false
 503 OUT
 504
 505 language_output_is( "tcl", <<'TCL', <<'OUT', "string mul - don't confuse variables for strings." );
 506   set a 1; puts [expr {$a * 10}]
 507 TCL
 508 10
 509 OUT
 510
 511 language_output_is( "tcl", <<'TCL', <<'OUT', 'complicated expression required for test_more.tcl' );
 512   puts [expr {"[eval {set a "aok"}]" ne "bork"}]
 513 TCL
 514 1
 515 OUT
 516
 517 # Local Variables:
 518 #   mode: cperl
 519 #   cperl-indent-level: 4
 520 #   fill-column: 100
 521 # End:
 522 # vim: expandtab shiftwidth=4: