1## Copyright (C) 2003-2012, 2014-2015, 2017-2020 Free Software Foundation, Inc. 2## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, 3## Ron Norman 4## 5## This file is part of GnuCOBOL. 6## 7## The GnuCOBOL compiler is free software: you can redistribute it 8## and/or modify it under the terms of the GNU General Public License 9## as published by the Free Software Foundation, either version 3 of the 10## License, or (at your option) any later version. 11## 12## GnuCOBOL is distributed in the hope that it will be useful, 13## but WITHOUT ANY WARRANTY; without even the implied warranty of 14## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15## GNU General Public License for more details. 16## 17## You should have received a copy of the GNU General Public License 18## along with GnuCOBOL. If not, see <https://www.gnu.org/licenses/>. 19 20### GnuCOBOL Test Suite 21 22### Fundamental Tests 23 24AT_SETUP([DISPLAY literals]) 25AT_KEYWORDS([fundamental]) 26 27AT_DATA([prog.cob], [ 28 IDENTIFICATION DIVISION. 29 PROGRAM-ID. prog. 30 PROCEDURE DIVISION. 31 DISPLAY "abc" 32 END-DISPLAY. 33 DISPLAY 123 34 END-DISPLAY. 35 DISPLAY +123 36 END-DISPLAY. 37 DISPLAY -123 38 END-DISPLAY. 39 DISPLAY 12.3 40 END-DISPLAY. 41 DISPLAY +12.3 42 END-DISPLAY. 43 DISPLAY -12.3 44 END-DISPLAY. 45 DISPLAY 1.23E0 46 END-DISPLAY. 47 DISPLAY +1.23E0 48 END-DISPLAY. 49 DISPLAY -1.23E0 50 END-DISPLAY. 51 DISPLAY 12.3E-2 52 END-DISPLAY. 53 DISPLAY +12.3E-2 54 END-DISPLAY. 55 DISPLAY -12.3E-2 56 END-DISPLAY. 57 DISPLAY B'0101' 58 END-DISPLAY. 59 DISPLAY BX'EC' 60 END-DISPLAY. 61 STOP RUN. 62]) 63 64AT_CHECK([$COMPILE prog.cob], [0], [], []) 65AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 66[abc 67123 68+123 69-123 7012.3 71+12.3 72-12.3 731.23 74+1.23 75-1.23 76.123 77+.123 78-.123 795 80236 81]) 82 83AT_CLEANUP 84 85 86AT_SETUP([DISPLAY literals, DECIMAL-POINT is COMMA]) 87AT_KEYWORDS([fundamental]) 88 89AT_DATA([prog.cob], [ 90 IDENTIFICATION DIVISION. 91 PROGRAM-ID. prog. 92 ENVIRONMENT DIVISION. 93 CONFIGURATION SECTION. 94 SPECIAL-NAMES. 95 DECIMAL-POINT IS COMMA. 96 PROCEDURE DIVISION. 97 DISPLAY 12,3 98 END-DISPLAY. 99 DISPLAY +12,3 100 END-DISPLAY. 101 DISPLAY -12,3 102 END-DISPLAY. 103 DISPLAY 1,23E0 104 END-DISPLAY. 105 DISPLAY +1,23E0 106 END-DISPLAY. 107 DISPLAY -1,23E0 108 END-DISPLAY. 109 STOP RUN. 110]) 111 112AT_CHECK([$COMPILE prog.cob], [0], [], []) 113AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 114[12,3 115+12,3 116-12,3 1171,23 118+1,23 119-1,23 120]) 121 122AT_CLEANUP 123 124 125AT_SETUP([Hexadecimal literal]) 126AT_KEYWORDS([fundamental]) 127 128AT_DATA([dump.c], [ 129#include <stdio.h> 130#include <libcob.h> 131 132COB_EXT_EXPORT int 133dump (unsigned char *data) 134{ 135 int i; 136 for (i = 0; i < 4; i++) 137 printf ("%02x", data[[i]]); 138 return 0; 139} 140]) 141 142AT_DATA([prog.cob], [ 143 IDENTIFICATION DIVISION. 144 PROGRAM-ID. prog. 145 PROCEDURE DIVISION. 146 >>IF CHARSET = 'EBCDIC' 147 DISPLAY X"F1F2F3" 148 >>ELSE 149 DISPLAY X"313233" 150 >>END-IF 151 END-DISPLAY. 152 CALL "dump" USING X"000102" 153 END-CALL. 154 STOP RUN. 155]) 156 157AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) 158AT_CHECK([$COMPILE prog.cob], [0], [], []) 159AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 160[123 16100010200]) 162 163AT_CLEANUP 164 165 166AT_SETUP([DISPLAY data items with VALUE clause]) 167AT_KEYWORDS([fundamental]) 168 169AT_DATA([prog.cob], [ 170 IDENTIFICATION DIVISION. 171 PROGRAM-ID. prog. 172 DATA DIVISION. 173 WORKING-STORAGE SECTION. 174 01 X-ABC PIC XXX VALUE "abc". 175 01 X-123 PIC 999 VALUE 123. 176 01 X-P123 PIC S999 VALUE +123. 177 01 X-N123 PIC S999 VALUE -123. 178 01 X-12-3 PIC 99V9 VALUE 12.3. 179 01 X-P12-3 PIC S99V9 VALUE +12.3. 180 01 X-N12-3 PIC S99V9 VALUE -12.3. 181 PROCEDURE DIVISION. 182 DISPLAY X-ABC 183 END-DISPLAY. 184 DISPLAY X-123 185 END-DISPLAY. 186 DISPLAY X-P123 187 END-DISPLAY. 188 DISPLAY X-N123 189 END-DISPLAY. 190 DISPLAY X-12-3 191 END-DISPLAY. 192 DISPLAY X-P12-3 193 END-DISPLAY. 194 DISPLAY X-N12-3 195 END-DISPLAY. 196 STOP RUN. 197]) 198 199AT_CHECK([$COMPILE prog.cob], [0], [], []) 200AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 201[abc 202123 203+123 204-123 20512.3 206+12.3 207-12.3 208]) 209 210AT_CLEANUP 211 212 213AT_SETUP([DISPLAY data items with MOVE statement]) 214AT_KEYWORDS([fundamental]) 215 216AT_DATA([prog.cob], [ 217 IDENTIFICATION DIVISION. 218 PROGRAM-ID. prog. 219 DATA DIVISION. 220 WORKING-STORAGE SECTION. 221 01 X-ABC PIC XXX VALUE "abc". 222 01 X-123 PIC 999 VALUE 123. 223 01 X-P123 PIC S999 VALUE +123. 224 01 X-N123 PIC S999 VALUE -123. 225 01 X-12-3 PIC 99V9 VALUE 12.3. 226 01 X-P12-3 PIC S99V9 VALUE +12.3. 227 01 X-N12-3 PIC S99V9 VALUE -12.3. 228 PROCEDURE DIVISION. 229 MOVE "abc" TO X-ABC. 230 DISPLAY X-ABC 231 END-DISPLAY. 232 MOVE 123 TO X-123. 233 DISPLAY X-123 234 END-DISPLAY. 235 MOVE +123 TO X-P123. 236 DISPLAY X-P123 237 END-DISPLAY. 238 MOVE -123 TO X-N123. 239 DISPLAY X-N123 240 END-DISPLAY. 241 MOVE 12.3 TO X-12-3. 242 DISPLAY X-12-3 243 END-DISPLAY. 244 MOVE +12.3 TO X-P12-3. 245 DISPLAY X-P12-3 246 END-DISPLAY. 247 MOVE -12.3 TO X-N12-3. 248 DISPLAY X-N12-3 249 END-DISPLAY. 250 STOP RUN. 251]) 252 253AT_CHECK([$COMPILE prog.cob], [0], [], []) 254AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 255[abc 256123 257+123 258-123 25912.3 260+12.3 261-12.3 262]) 263 264AT_CLEANUP 265 266 267AT_SETUP([MOVE to edited item (1)]) 268AT_KEYWORDS([fundamental editing]) 269 270AT_DATA([prog.cob], [ 271 IDENTIFICATION DIVISION. 272 PROGRAM-ID. prog. 273 DATA DIVISION. 274 WORKING-STORAGE SECTION. 275 01 SRC-1 PIC S99V99 VALUE 1.10. 276 01 SRC-2 PIC S99V99 VALUE 0.02. 277 01 SRC-3 PIC S99V99 VALUE -0.03. 278 01 SRC-4 PIC S99V99 VALUE -0.04. 279 01 SRC-5 PIC S99V99 VALUE -0.05. 280 01 EDT-1 PIC -(04)9. 281 01 EDT-2 PIC -(04)9. 282 01 EDT-3 PIC -(04)9. 283 01 EDT-4 PIC +(04)9. 284 01 EDT-5 PIC -(05). 285 PROCEDURE DIVISION. 286 MOVE SRC-1 TO EDT-1. 287 MOVE SRC-2 TO EDT-2. 288 MOVE SRC-3 TO EDT-3. 289 MOVE SRC-4 TO EDT-4. 290 MOVE SRC-5 TO EDT-5. 291 DISPLAY '>' EDT-1 '<' 292 END-DISPLAY. 293 DISPLAY '>' EDT-2 '<' 294 END-DISPLAY. 295 DISPLAY '>' EDT-3 '<' 296 END-DISPLAY. 297 DISPLAY '>' EDT-4 '<' 298 END-DISPLAY. 299 DISPLAY '>' EDT-5 '<' 300 END-DISPLAY. 301 STOP RUN. 302]) 303 304AT_CHECK([$COMPILE prog.cob], [0], [], []) 305AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 306[> 1< 307> 0< 308> 0< 309> +0< 310> < 311]) 312 313AT_CLEANUP 314 315 316AT_SETUP([MOVE to edited item (2)]) 317AT_KEYWORDS([fundamental editing]) 318 319AT_DATA([prog.cob], [ 320 IDENTIFICATION DIVISION. 321 PROGRAM-ID. prog. 322 DATA DIVISION. 323 WORKING-STORAGE SECTION. 324 01 SRC-1 PIC S99V99 VALUE -0.06. 325 01 SRC-2 PIC S99V99 VALUE -0.07. 326 01 SRC-3 PIC S99V99 VALUE -0.08. 327 01 SRC-4 PIC S99V99 VALUE -0.09. 328 01 SRC-5 PIC S99V99 VALUE -1.10. 329 01 EDT-1 PIC 9(04)-. 330 01 EDT-2 PIC 9(04)+. 331 01 EDT-3 PIC Z(04)+. 332 01 EDT-4 PIC 9(04)DB. 333 01 EDT-5 PIC 9(04)DB. 334 PROCEDURE DIVISION. 335 MOVE SRC-1 TO EDT-1. 336 MOVE SRC-2 TO EDT-2. 337 MOVE SRC-3 TO EDT-3. 338 MOVE SRC-4 TO EDT-4. 339 MOVE SRC-5 TO EDT-5. 340 DISPLAY '>' EDT-1 '<' 341 END-DISPLAY. 342 DISPLAY '>' EDT-2 '<' 343 END-DISPLAY. 344 DISPLAY '>' EDT-3 '<' 345 END-DISPLAY. 346 DISPLAY '>' EDT-4 '<' 347 END-DISPLAY. 348 DISPLAY '>' EDT-5 '<' 349 END-DISPLAY. 350 STOP RUN. 351]) 352 353AT_CHECK([$COMPILE prog.cob], [0], [], []) 354AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 355[>0000 < 356>0000+< 357> < 358>0000 < 359>0001DB< 360]) 361 362AT_CLEANUP 363 364 365AT_SETUP([MOVE to item with simple and floating insertion]) 366AT_KEYWORDS([fundamental edited editing]) 367 368AT_DATA([prog.cob], [ 369 IDENTIFICATION DIVISION. 370 PROGRAM-ID. prog. 371 372 DATA DIVISION. 373 WORKING-STORAGE SECTION. 374 01 num-1 PIC -*B*99. 375 01 num-2 PIC $BB**,***.**. 376 01 num-3 PIC $BB--,---.--. 377 378 PROCEDURE DIVISION. 379 MOVE -123 TO num-1 380 DISPLAY ">" num-1 "<" 381 382 MOVE 1234.56 TO num-2 383 DISPLAY ">" num-2 "<" 384 385 MOVE 1234.56 TO num-3 386 DISPLAY ">" num-3 "<" 387 . 388]) 389 390AT_CHECK([$COMPILE prog.cob], [0], [], []) 391AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 392[>-**123< 393>$ *1,234.56< 394>$ 1,234.56< 395]) 396 397AT_CLEANUP 398 399 400AT_SETUP([MOVE to JUSTIFIED item]) 401AT_KEYWORDS([fundamental]) 402 403AT_DATA([prog.cob], [ 404 IDENTIFICATION DIVISION. 405 PROGRAM-ID. prog. 406 DATA DIVISION. 407 WORKING-STORAGE SECTION. 408 01 SRC-1 PIC S9(04) VALUE 11. 409 01 SRC-2 PIC S9(04) COMP VALUE 22. 410 01 SRC-3 PIC S9(04) COMP-5 VALUE 33. 411 01 SRC-4 PIC S9(04)PP VALUE 4400. 412 01 SRC-5 PIC S9(04)PPPPP VALUE 55500000. 413 01 EDT-FLD PIC X(07) JUSTIFIED RIGHT. 414 PROCEDURE DIVISION. 415 MOVE SRC-1 TO EDT-FLD. 416 DISPLAY '>' EDT-FLD '<' 417 END-DISPLAY. 418 MOVE SRC-2 TO EDT-FLD. 419 DISPLAY '>' EDT-FLD '<' 420 END-DISPLAY. 421 MOVE SRC-3 TO EDT-FLD. 422 DISPLAY '>' EDT-FLD '<' 423 END-DISPLAY. 424 MOVE SRC-4 TO EDT-FLD. 425 DISPLAY '>' EDT-FLD '<' 426 END-DISPLAY. 427 MOVE SRC-5 TO EDT-FLD. 428 DISPLAY '>' EDT-FLD '<' 429 END-DISPLAY. 430 STOP RUN. 431]) 432 433AT_CHECK([$COMPILE prog.cob], [0], [], []) 434AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 435[> 0011< 436> 0022< 437> 0033< 438> 004400< 439>5500000< 440]) 441 442AT_CLEANUP 443 444 445AT_SETUP([MOVE integer literal to alphanumeric]) 446AT_KEYWORDS([fundamental]) 447 448AT_DATA([prog.cob], [ 449 IDENTIFICATION DIVISION. 450 PROGRAM-ID. prog. 451 DATA DIVISION. 452 WORKING-STORAGE SECTION. 453 01 X PIC X(04) VALUE SPACES. 454 PROCEDURE DIVISION. 455 MOVE 0 TO X. 456 DISPLAY X NO ADVANCING 457 END-DISPLAY. 458 STOP RUN. 459]) 460 461AT_CHECK([$COMPILE prog.cob], [0], [], 462[prog.cob:8: warning: alphanumeric value is expected 463prog.cob:6: note: 'X' defined here as PIC X(04) 464]) 465AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0 ]) 466 467AT_CLEANUP 468 469 470AT_SETUP([Compare FLOAT-LONG with floating-point literal]) 471AT_KEYWORDS([fundamental literal exponent]) 472 473AT_DATA([prog.cob], [ 474 IDENTIFICATION DIVISION. 475 PROGRAM-ID. prog. 476 DATA DIVISION. 477 WORKING-STORAGE SECTION. 478 01 VAR FLOAT-LONG VALUE 0.0. 479 480 PROCEDURE DIVISION. 481 MOVE 9.899999999999E+304 TO VAR 482 IF VAR < 0 483 DISPLAY 'error: compare ' VAR ' < ' 0 484 ' failed!' 485 END-DISPLAY 486 END-IF. 487 IF VAR < 9.799999999999E+304 488 DISPLAY 'error: compare ' VAR ' < ' 9.799999999999E+304 489 ' failed!' 490 END-DISPLAY 491 END-IF. 492 IF VAR > 9.999999999999E+304 493 DISPLAY 'error: compare ' VAR ' > ' 9.999999999999E+304 494 ' failed!' 495 END-DISPLAY 496 END-IF. 497 MOVE -9.899999999999E+304 TO VAR 498 IF VAR > 0 499 DISPLAY 'error: compare ' VAR ' > ' 0 500 ' failed!' 501 END-DISPLAY 502 END-IF. 503 IF VAR < -9.999999999999E+304 504 DISPLAY 'error: compare ' VAR ' < ' -9.999999999999E+304 505 ' failed!' 506 END-DISPLAY 507 END-IF. 508 IF VAR > -9.799999999999E+304 509 DISPLAY 'error: compare ' VAR ' > ' -9.799999999999E+304 510 ' failed!' 511 END-DISPLAY 512 END-IF. 513 514 STOP RUN. 515]) 516 517AT_CHECK([$COMPILE prog.cob], [0], [], []) 518AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 519 520AT_CLEANUP 521 522 523AT_SETUP([Check for equality of FLOAT-SHORT / FLOAT-LONG]) 524AT_KEYWORDS([fundamental]) 525 526AT_DATA([prog.cob], [ 527 IDENTIFICATION DIVISION. 528 PROGRAM-ID. prog. 529 DATA DIVISION. 530 WORKING-STORAGE SECTION. 531 01 SRC1 FLOAT-LONG VALUE 11.55. 532 01 DST1 FLOAT-SHORT. 533 01 SRC2 FLOAT-SHORT VALUE 11.55. 534 01 DST2 FLOAT-LONG. 535 536 PROCEDURE DIVISION. 537 MOVE SRC1 TO DST1. 538 IF DST1 not = 11.55 539 DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-SHORT fa 540 - 'iled ' DST1 541 END-DISPLAY 542 END-IF. 543 544 MOVE SRC1 TO DST2. 545 IF DST1 not = 11.55 546 DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-LONG fai 547 - 'led ' DST2 548 END-DISPLAY 549 END-IF. 550 551 MOVE ZERO TO DST1. 552 MOVE ZERO TO DST2. 553 554 MOVE SRC2 TO DST1. 555 IF DST1 not = 11.55 556 DISPLAY 'error: move/compare FLOAT-SHORT to FLOAT-SHORT f 557 - 'ailed: ' DST1 558 END-DISPLAY 559 END-IF. 560 561 MOVE SRC2 TO DST2. 562 IF DST2 not = 11.55 563 DISPLAY 'error: move/compare FLOAT-SHORT to FLOAT-LONG fa 564 - 'iled: ' DST2 565 END-DISPLAY 566 END-IF. 567 568 MOVE ZERO TO DST1. 569 IF not (DST1 = 0 AND 0.0) 570 DISPLAY "Zero compare failed: " DST1 END-DISPLAY 571 END-IF. 572 573 MOVE -0.0 TO DST1. 574 IF not (DST1 = 0 AND 0.0) 575 DISPLAY "Negative Zero compare failed: " DST1 576 END-DISPLAY 577 END-IF. 578 579 MOVE 1.1234567 TO DST1. 580 MOVE DST1 TO DST2. 581 IF DST2 not = 1.1234567 582 DISPLAY "move/compare number to FLOAT to DOUBLE failed: " 583 DST1 " - " DST2 584 END-DISPLAY 585 END-IF. 586 587 * Check for Tolerance 588 MOVE 1.1234567 TO DST1. 589 MOVE 1.1234568 TO DST2. 590 IF DST1 not = DST2 THEN 591 DISPLAY 'move/compare of very near numbers failed (not id 592 - 'entical): ' DST1 " - " DST2 593 END-DISPLAY 594 END-IF. 595 596 * Within tolerance by definition, therefore not checked 597 * MULTIPLY 10000000000 BY DST1 DST2 END-MULTIPLY. 598 * IF DST1 = DST2 THEN 599 * DISPLAY "compare of very near numbers computed failed (id 600 *- "entical): " DST1 " - " DST2 601 * END-DISPLAY 602 * END-IF. 603 604 MOVE 1.1234567 TO DST1. 605 MOVE 1.1234569 TO DST2. 606 IF DST1 = DST2 THEN 607 DISPLAY 'move/compare of near equal numbers failed (ident 608 - 'ical): ' DST1 " - " DST2 609 END-DISPLAY 610 END-IF. 611 612 MOVE 0.0001 TO DST1. 613 MOVE 0.0000 TO DST2. 614 IF DST1 = DST2 THEN 615 DISPLAY 'move/compare of nearly equal very small numbers 616 - 'failed (identical): ' DST1 " - " DST2 617 END-DISPLAY 618 END-IF. 619 620 MOVE 1000001.0 TO DST1. 621 MOVE 1000000.0 TO DST2. 622 IF DST1 = DST2 THEN 623 DISPLAY 'move/compare of nearly equal big numbers failed 624 - '(identical): ' DST1 " - " DST2 625 END-DISPLAY 626 END-IF. 627 628 * Within tolerance by definition, therefore not checked 629 * MOVE 1000000000.0 TO DST1. 630 * MOVE 1000000001.0 TO DST2. 631 * IF DST1 = DST2 THEN 632 * DISPLAY 'move/compare of nearly equal very big numbers fa 633 *- 'iled (identical): ' DST1 " - " DST2 634 * END-DISPLAY 635 * END-IF. 636 637 STOP RUN. 638]) 639 640AT_CHECK([$COMPILE prog.cob], [0], [], []) 641AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 642 643AT_CLEANUP 644 645 646AT_SETUP([Overlapping MOVE]) 647AT_KEYWORDS([fundamental]) 648 649AT_DATA([subprog.cob], [ 650 IDENTIFICATION DIVISION. 651 PROGRAM-ID. subprog. 652 DATA DIVISION. 653 WORKING-STORAGE SECTION. 654 LINKAGE SECTION. 655 01 F1 PIC X(10). 656 01 F2 PIC X(15). 657 658 PROCEDURE DIVISION USING F1 F2. 659 MOVE F2(1:6) TO F1 (1:8). 660 IF F1 not = "Hallo1 90" 661 DISPLAY "error:3: " F1 662 END-DISPLAY 663 END-IF 664 665 GOBACK. 666]) 667 668AT_DATA([prog.cob], [ 669 IDENTIFICATION DIVISION. 670 PROGRAM-ID. prog. 671 672 DATA DIVISION. 673 WORKING-STORAGE SECTION. 674 01 STRUCTURE. 675 05 FIELD1 PIC X(5). 676 05 FIELD2 PIC X(10). 677 678 PROCEDURE DIVISION. 679 MOVE "Hallo" TO FIELD1. 680 MOVE "1234567890" TO FIELD2. 681 682 MOVE FIELD2 TO STRUCTURE. 683 IF FIELD1 not = "12345" 684 DISPLAY "error:1: " FIELD1 685 END-DISPLAY 686 END-IF 687 IF FIELD2 not = "67890 " 688 DISPLAY "error:2: " FIELD2 689 END-DISPLAY 690 END-IF 691 692 693 MOVE "Hallo" TO FIELD1. 694 MOVE "1234567890" TO FIELD2. 695 696 CALL "subprog" USING BY REFERENCE FIELD2 STRUCTURE 697 END-CALL 698 699 STOP RUN. 700]) 701 702AT_CHECK([$COMPILE_MODULE subprog.cob], [0], [], []) 703AT_CHECK([$COMPILE prog.cob], [0], [], 704[prog.cob:15: warning: overlapping MOVE may produce unpredictable results 705]) 706AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 707 708AT_DATA([prog2.cob], [ 709 IDENTIFICATION DIVISION. 710 PROGRAM-ID. prog2. 711 DATA DIVISION. 712 WORKING-STORAGE SECTION. 713 01 FILLER. 714 05 TSTMOV1 PIC X(479). 715 05 TSTMOV2 PIC X(10). 716 PROCEDURE DIVISION. 717 MOVE "0123456789" TO TSTMOV2. 718 MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) 719 IF TSTMOV2 NOT = "1234567899" 720 DISPLAY " PROBLEM MOVE: " TSTMOV2 721 ELSE 722 DISPLAY " OK with MOVE: " TSTMOV2. 723 MOVE "0123456789" TO TSTMOV2. 724 MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) 725 IF TSTMOV2 = "0000000009" 726 DISPLAY "IBM style MOVE: " TSTMOV2 727 ELSE IF TSTMOV2 NOT = "0012345679" 728 DISPLAY " PROBLEM MOVE: " TSTMOV2 729 ELSE 730 DISPLAY " OK with MOVE: " TSTMOV2. 731 STOP RUN. 732]) 733 734AT_CHECK([$COMPILE prog2.cob], [0], [], 735[prog2.cob:11: warning: overlapping MOVE may produce unpredictable results 736prog2.cob:17: warning: overlapping MOVE may produce unpredictable results 737]) 738 739AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], 740[ OK with MOVE: 1234567899 741 OK with MOVE: 0012345679 742], []) 743 744AT_CLEANUP 745 746 747AT_SETUP([Overlapping MOVE]) 748AT_KEYWORDS([fundamental]) 749 750AT_DATA([prog.cob], [ 751 IDENTIFICATION DIVISION. 752 PROGRAM-ID. prog. 753 DATA DIVISION. 754 WORKING-STORAGE SECTION. 755 01 FILLER. 756 05 TSTMOV1 PIC X(479). 757 05 TSTMOV2 PIC X(10). 758 PROCEDURE DIVISION. 759 MOVE "0123456789" TO TSTMOV2. 760 MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) 761 IF TSTMOV2 NOT = "1234567899" 762 DISPLAY " PROBLEM MOVE: " TSTMOV2 763 ELSE 764 DISPLAY " OK with MOVE: " TSTMOV2. 765 MOVE "0123456789" TO TSTMOV2. 766 MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) 767 IF TSTMOV2 = "0000000009" 768 DISPLAY "IBM style MOVE: " TSTMOV2 769 ELSE IF TSTMOV2 NOT = "0012345679" 770 DISPLAY " PROBLEM MOVE: " TSTMOV2 771 ELSE 772 DISPLAY " OK with MOVE: " TSTMOV2. 773 STOP RUN. 774]) 775 776AT_CHECK([$COMPILE prog.cob], [0], [], 777[prog.cob:11: warning: overlapping MOVE may produce unpredictable results 778prog.cob:17: warning: overlapping MOVE may produce unpredictable results 779]) 780 781AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 782[ OK with MOVE: 1234567899 783 OK with MOVE: 0012345679 784], []) 785 786AT_CLEANUP 787 788 789AT_SETUP([IBM MOVE]) 790AT_KEYWORDS([fundamental]) 791 792AT_DATA([prog.cob], [ 793 IDENTIFICATION DIVISION. 794 PROGRAM-ID. prog. 795 DATA DIVISION. 796 WORKING-STORAGE SECTION. 797 01 FILLER. 798 05 TSTMOV1 PIC X(479). 799 05 TSTMOV2 PIC X(10). 800 PROCEDURE DIVISION. 801 MOVE "0123456789" TO TSTMOV2. 802 MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) 803 IF TSTMOV2 NOT = "1234567899" 804 DISPLAY " PROBLEM MOVE: " TSTMOV2 805 ELSE 806 DISPLAY " OK with MOVE: " TSTMOV2. 807 MOVE "0123456789" TO TSTMOV2. 808 MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) 809 IF TSTMOV2 = "0000000009" 810 DISPLAY "IBM style MOVE: " TSTMOV2 811 ELSE IF TSTMOV2 NOT = "0012345679" 812 DISPLAY " PROBLEM MOVE: " TSTMOV2 813 ELSE 814 DISPLAY " OK with MOVE: " TSTMOV2. 815 STOP RUN. 816]) 817 818AT_CHECK([$COMPILE -fmove-ibm prog.cob], [0], [], []) 819 820AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 821[ OK with MOVE: 1234567899 822IBM style MOVE: 0000000009 823], []) 824 825AT_CLEANUP 826 827 828AT_SETUP([ALPHABETIC test]) 829AT_KEYWORDS([fundamental]) 830 831AT_DATA([prog.cob], [ 832 IDENTIFICATION DIVISION. 833 PROGRAM-ID. prog. 834 DATA DIVISION. 835 WORKING-STORAGE SECTION. 836 01 X PIC X(04) VALUE "AAAA". 837 01 FILLER REDEFINES X. 838 03 XBYTE PIC X. 839 03 FILLER PIC XXX. 840 PROCEDURE DIVISION. 841 MOVE X"0D" TO XBYTE. 842 IF X ALPHABETIC 843 DISPLAY "Fail - Alphabetic" 844 END-DISPLAY 845 END-IF. 846 MOVE "A" TO XBYTE. 847 IF X NOT ALPHABETIC 848 DISPLAY "Fail - Not Alphabetic" 849 END-DISPLAY 850 END-IF. 851 STOP RUN. 852]) 853 854AT_CHECK([$COMPILE prog.cob], [0], [], []) 855AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 856 857AT_CLEANUP 858 859 860AT_SETUP([ALPHABETIC-UPPER test]) 861AT_KEYWORDS([fundamental]) 862 863AT_DATA([prog.cob], [ 864 IDENTIFICATION DIVISION. 865 PROGRAM-ID. prog. 866 DATA DIVISION. 867 WORKING-STORAGE SECTION. 868 01 X PIC X(04) VALUE "AAAA". 869 01 FILLER REDEFINES X. 870 03 XBYTE PIC X. 871 03 FILLER PIC XXX. 872 PROCEDURE DIVISION. 873 MOVE X"0D" TO XBYTE. 874 IF X ALPHABETIC-UPPER 875 DISPLAY "Fail - Not alphabetic upper" 876 END-DISPLAY 877 END-IF. 878 MOVE "A" TO XBYTE. 879 IF X NOT ALPHABETIC-UPPER 880 DISPLAY "Fail - Alphabetic upper" 881 END-DISPLAY 882 END-IF. 883 STOP RUN. 884]) 885 886AT_CHECK([$COMPILE prog.cob], [0], [], []) 887AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 888 889AT_CLEANUP 890 891 892AT_SETUP([ALPHABETIC-LOWER test]) 893AT_KEYWORDS([fundamental]) 894 895AT_DATA([prog.cob], [ 896 IDENTIFICATION DIVISION. 897 PROGRAM-ID. prog. 898 DATA DIVISION. 899 WORKING-STORAGE SECTION. 900 01 X PIC X(04) VALUE "aaaa". 901 01 FILLER REDEFINES X. 902 03 XBYTE PIC X. 903 03 FILLER PIC XXX. 904 PROCEDURE DIVISION. 905 MOVE X"0D" TO XBYTE. 906 IF X ALPHABETIC-LOWER 907 DISPLAY "Fail - Not alphabetic lower" 908 END-DISPLAY 909 END-IF. 910 MOVE "a" TO XBYTE. 911 IF X NOT ALPHABETIC-LOWER 912 DISPLAY "Fail - Alphabetic lower" 913 END-DISPLAY 914 END-IF. 915 STOP RUN. 916]) 917 918AT_CHECK([$COMPILE prog.cob], [0], [], []) 919AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 920 921AT_CLEANUP 922 923 924AT_SETUP([GLOBAL at same level]) 925AT_KEYWORDS([fundamental]) 926 927AT_DATA([prog.cob], [ 928 IDENTIFICATION DIVISION. 929 PROGRAM-ID. prog. 930 DATA DIVISION. 931 WORKING-STORAGE SECTION. 932 01 X PIC X(5) GLOBAL VALUE "prog1". 933 PROCEDURE DIVISION. 934 DISPLAY X 935 END-DISPLAY. 936 CALL "prog2" 937 END-CALL 938 CALL "prog3" 939 END-CALL 940 STOP RUN. 941 IDENTIFICATION DIVISION. 942 PROGRAM-ID. prog2. 943 DATA DIVISION. 944 WORKING-STORAGE SECTION. 945 01 X PIC X(5) GLOBAL VALUE "prog2". 946 PROCEDURE DIVISION. 947 DISPLAY X 948 END-DISPLAY. 949 EXIT PROGRAM. 950 END PROGRAM prog2. 951 IDENTIFICATION DIVISION. 952 PROGRAM-ID. prog3. 953 DATA DIVISION. 954 WORKING-STORAGE SECTION. 955 PROCEDURE DIVISION. 956 DISPLAY X 957 END-DISPLAY. 958 EXIT PROGRAM. 959 END PROGRAM prog3. 960 END PROGRAM prog. 961]) 962 963AT_CHECK([$COMPILE prog.cob], [0], [], []) 964AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 965[prog1 966prog2 967prog1 968]) 969 970AT_CLEANUP 971 972 973AT_SETUP([GLOBAL at lower level]) 974AT_KEYWORDS([fundamental]) 975 976AT_DATA([prog.cob], [ 977 IDENTIFICATION DIVISION. 978 PROGRAM-ID. prog. 979 DATA DIVISION. 980 WORKING-STORAGE SECTION. 981 01 X PIC X(5) GLOBAL VALUE "prog1". 982 PROCEDURE DIVISION. 983 DISPLAY X 984 END-DISPLAY. 985 CALL "prog2" 986 END-CALL 987 STOP RUN. 988 IDENTIFICATION DIVISION. 989 PROGRAM-ID. prog2. 990 DATA DIVISION. 991 WORKING-STORAGE SECTION. 992 01 X PIC X(5) GLOBAL VALUE "prog2". 993 PROCEDURE DIVISION. 994 DISPLAY X 995 END-DISPLAY. 996 CALL "prog3" 997 END-CALL 998 EXIT PROGRAM. 999 IDENTIFICATION DIVISION. 1000 PROGRAM-ID. prog3. 1001 DATA DIVISION. 1002 WORKING-STORAGE SECTION. 1003 PROCEDURE DIVISION. 1004 DISPLAY X 1005 END-DISPLAY. 1006 EXIT PROGRAM. 1007 END PROGRAM prog3. 1008 END PROGRAM prog2. 1009 END PROGRAM prog. 1010]) 1011 1012AT_CHECK([$COMPILE prog.cob], [0], [], []) 1013AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 1014[prog1 1015prog2 1016prog2 1017]) 1018 1019AT_CLEANUP 1020 1021 1022AT_SETUP([GLOBAL CONSTANT]) 1023AT_KEYWORDS([fundamental]) 1024 1025AT_DATA([prog.cob], [ 1026 IDENTIFICATION DIVISION. 1027 PROGRAM-ID. prog. 1028 ENVIRONMENT DIVISION. 1029 INPUT-OUTPUT SECTION. 1030 FILE-CONTROL. 1031 SELECT TEST-FILE 1032 ASSIGN GLOB-PATH 1033 . 1034 DATA DIVISION. 1035 FILE SECTION. 1036 FD TEST-FILE GLOBAL. 1037 01 TEST-REC PIC X(4). 1038 WORKING-STORAGE SECTION. 1039 78 GLOB-PATH GLOBAL VALUE "GLOBP1". 1040 01 GLOB-PATH2 CONSTANT GLOBAL "GLOBP2". 1041 * Test global vars because of implicitly defined ASSIGN var, too. 1042 78 GLOB-VAR GLOBAL VALUE "GLOBV1". 1043 01 GLOB-VAR2 CONSTANT GLOBAL "GLOBV2". 1044 PROCEDURE DIVISION. 1045 DISPLAY GLOB-PATH GLOB-VAR 1046 END-DISPLAY. 1047 CALL "prog2" 1048 END-CALL. 1049 CALL "prog3" 1050 END-CALL. 1051 STOP RUN. 1052 IDENTIFICATION DIVISION. 1053 PROGRAM-ID. prog2. 1054 ENVIRONMENT DIVISION. 1055 INPUT-OUTPUT SECTION. 1056 FILE-CONTROL. 1057 SELECT TEST2-FILE 1058 ASSIGN GLOB-PATH2 1059 . 1060 DATA DIVISION. 1061 FILE SECTION. 1062 FD TEST2-FILE GLOBAL. 1063 01 TEST2-REC PIC X(4). 1064 WORKING-STORAGE SECTION. 1065 PROCEDURE DIVISION. 1066 DISPLAY GLOB-PATH2 GLOB-VAR2 1067 END-DISPLAY. 1068 EXIT PROGRAM. 1069 END PROGRAM prog2. 1070 END PROGRAM prog. 1071 IDENTIFICATION DIVISION. 1072 PROGRAM-ID. prog3. 1073 ENVIRONMENT DIVISION. 1074 INPUT-OUTPUT SECTION. 1075 FILE-CONTROL. 1076 SELECT TEST3-FILE 1077 ASSIGN GLOB-PATH 1078 . 1079 DATA DIVISION. 1080 FILE SECTION. 1081 FD TEST3-FILE GLOBAL. 1082 01 TEST3-REC PIC X(4). 1083 WORKING-STORAGE SECTION. 1084 PROCEDURE DIVISION. 1085 DISPLAY 'in prog3' 1086 END-DISPLAY 1087 IF GLOB-PATH NOT = SPACES 1088 DISPLAY FUNCTION TRIM (GLOB-PATH TRAILING) 1089 END-DISPLAY 1090 END-IF 1091 EXIT PROGRAM. 1092 END PROGRAM prog3. 1093]) 1094 1095AT_CHECK([$COMPILE prog.cob], [0], [], []) 1096AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 1097[GLOBP1GLOBV1 1098GLOBP2GLOBV2 1099in prog3 1100GLOB-PATH 1101]) 1102 1103AT_CLEANUP 1104 1105 1106AT_SETUP([GLOBAL identifiers from ENVIRONMENT DIVISION]) 1107AT_KEYWORDS([fundamental function CURRENCY SIGN RETURNING]) 1108 1109AT_DATA([prog.cob], [ 1110 FUNCTION-ID. f1. 1111 DATA DIVISION. 1112 LINKAGE SECTION. 1113 01 r BINARY-LONG. 1114 PROCEDURE DIVISION RETURNING r. 1115 move 1 to r 1116 GOBACK 1117 . 1118 END FUNCTION f1. 1119 FUNCTION-ID. f2. 1120 DATA DIVISION. 1121 LINKAGE SECTION. 1122 01 i BINARY-LONG. 1123 01 r BINARY-LONG. 1124 PROCEDURE DIVISION USING i RETURNING r. 1125 add i to i giving r 1126 GOBACK 1127 . 1128 END FUNCTION f2. 1129 1130 PROGRAM-ID. prog. 1131 1132 ENVIRONMENT DIVISION. 1133 CONFIGURATION SECTION. 1134 REPOSITORY. 1135 FUNCTION f1 1136 FUNCTION f2. 1137 SPECIAL-NAMES. 1138 CURRENCY SIGN IS "Y" 1139 DECIMAL-POINT IS COMMA. 1140 1141 PROCEDURE DIVISION. 1142 CALL "prog-nested" 1143 . 1144 1145 PROGRAM-ID. prog-nested. 1146 1147 DATA DIVISION. 1148 WORKING-STORAGE SECTION. 1149 77 n1 BINARY-LONG VALUE 0. 1150 77 curr PIC 9.9999,99Y. 1151 1152 PROCEDURE DIVISION. 1153 MOVE f1() TO n1 1154 IF n1 NOT = 1 1155 DISPLAY "ERROR 1" GOBACK 1156 END-IF 1157 MOVE f2(n1) TO n1 1158 IF n1 NOT = 2 1159 DISPLAY "ERROR 2" GOBACK 1160 END-IF 1161 MOVE f1() TO n1 1162 IF n1 NOT = 1 1163 DISPLAY "ERROR 1 2nd" GOBACK 1164 END-IF 1165 MOVE f2(f2(n1)) TO n1 1166 IF n1 NOT = 4 1167 DISPLAY "ERROR 4" GOBACK 1168 END-IF 1169 MOVE n1 TO curr 1170 DISPLAY curr 1171 1172 GOBACK 1173 . 1174 END PROGRAM prog-nested. 1175 END PROGRAM prog. 1176 1177]) 1178 1179AT_CHECK([$COMPILE prog.cob], [0], [], []) 1180AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 1181[0.0004,00Y 1182]) 1183 1184AT_CLEANUP 1185 1186 1187AT_SETUP([function with variable-length RETURNING item]) 1188AT_KEYWORDS([fundamental udf]) 1189 1190# see Bug #641 1191 1192 1193# Skipped in 3.1.1 as the codegen is not safe (returning local variable address) 1194# codegen adjusted in 4.x 1195 1196AT_SKIP_IF([true]) 1197 1198AT_DATA([prog.cob], [ 1199 IDENTIFICATION DIVISION. 1200 FUNCTION-ID. reply. 1201 DATA DIVISION. 1202 WORKING-STORAGE SECTION. 1203 77 arg-len USAGE BINARY-LONG. 1204 LINKAGE SECTION. 1205 01 argument PIC X ANY LENGTH. 1206 01 result. 1207 05 filler PIC X OCCURS 0 to 999 DEPENDING ON arg-len. 1208 PROCEDURE DIVISION USING BY REFERENCE argument RETURNING result. 1209 MOVE FUNCTION LENGTH (argument) TO arg-len 1210 MOVE argument TO result. 1211 END FUNCTION reply. 1212 1213 IDENTIFICATION DIVISION. 1214 PROGRAM-ID. prog. 1215 1216 ENVIRONMENT DIVISION. 1217 CONFIGURATION SECTION. 1218 REPOSITORY. 1219 FUNCTION reply. 1220 1221 DATA DIVISION. 1222 WORKING-STORAGE SECTION. 1223 77 arg pic x(100). 1224 1225 PROCEDURE DIVISION. 1226 *> 1227 IF not (FUNCTION REPLY ("test") = "test" 1228 and FUNCTION LENGTH (REPLY ("test")) = 4 ) 1229 DISPLAY "'test' failed: " 1230 FUNCTION LENGTH (REPLY ("test")) " #" 1231 FUNCTION REPLY ("test") "#". 1232 *> 1233 IF not (FUNCTION REPLY ("test ") = "test" 1234 and FUNCTION LENGTH (REPLY ("test ")) = 7 ) 1235 DISPLAY "'test ' failed: " 1236 FUNCTION LENGTH (REPLY ("test ")) " #" 1237 FUNCTION REPLY ("test ") "#". 1238 *> 1239 IF not (FUNCTION REPLY (arg) = spaces 1240 and FUNCTION LENGTH (REPLY (arg)) = 100 ) 1241 DISPLAY "empty arg failed: " 1242 FUNCTION LENGTH (REPLY (arg)) " #" 1243 FUNCTION REPLY (arg) "#". 1244 *> 1245 MOVE "echo this" to arg 1246 IF not (FUNCTION REPLY (arg) = arg 1247 and FUNCTION LENGTH (REPLY (arg)) = 100 ) 1248 DISPLAY "echo arg failed: " 1249 FUNCTION LENGTH (REPLY (arg)) " #" 1250 FUNCTION REPLY (arg) "#". 1251 *> 1252 MOVE z"echo this" to arg 1253 IF not (FUNCTION REPLY (arg) = arg 1254 and FUNCTION LENGTH (REPLY (arg)) = 100 ) 1255 DISPLAY "z'echo arg failed: " 1256 FUNCTION LENGTH (REPLY (arg)) " #" 1257 FUNCTION REPLY (arg) "#". 1258 *> 1259 GOBACK 1260 . 1261 END PROGRAM prog. 1262]) 1263 1264AT_CHECK([$COMPILE prog.cob], [0], [], []) 1265AT_CHECK([$COBCRUN_DIRECT ./prog], [0], []) 1266 1267AT_CLEANUP 1268 1269 1270AT_SETUP([Entry point visibility (1)]) 1271AT_KEYWORDS([fundamental CALL]) 1272 1273AT_DATA([prog.cob], [ 1274 IDENTIFICATION DIVISION. 1275 PROGRAM-ID. prog. 1276 DATA DIVISION. 1277 PROCEDURE DIVISION. 1278 CALL 'module' 1279 CALL 'modulepart' 1280 STOP RUN. 1281]) 1282 1283AT_DATA([module.cob], [ 1284 IDENTIFICATION DIVISION. 1285 PROGRAM-ID. module. 1286 DATA DIVISION. 1287 PROCEDURE DIVISION. 1288 DISPLAY 'A' WITH NO ADVANCING 1289 GOBACK. 1290 ENTRY 'modulepart'. 1291 DISPLAY 'B' WITH NO ADVANCING 1292 GOBACK. 1293]) 1294 1295AT_CHECK([$COMPILE prog.cob], [0], [], []) 1296AT_CHECK([$COMPILE_MODULE module.cob], [0], [], []) 1297AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [AB], []) 1298 1299AT_CLEANUP 1300 1301 1302AT_SETUP([Entry point visibility (2)]) 1303AT_KEYWORDS([fundamental CALL]) 1304 1305# TODO: skip on __OS400__ 1306 1307AT_DATA([prog.cob], [ 1308 IDENTIFICATION DIVISION. 1309 PROGRAM-ID. prog. 1310 DATA DIVISION. 1311 PROCEDURE DIVISION. 1312 CALL 'module' 1313 STOP RUN. 1314]) 1315 1316AT_DATA([module.c], [ 1317#include <stdio.h> 1318#include <libcob.h> 1319 1320COB_EXT_EXPORT int 1321some (void) 1322{ 1323 return 0; 1324} 1325]) 1326 1327AT_CHECK([$COMPILE prog.cob], [0], [], []) 1328AT_CHECK([$COMPILE_MODULE module.c], [0], [], []) 1329AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], 1330[libcob: prog.cob:6: error: entry point 'module' not found 1331]) 1332 1333AT_CLEANUP 1334 1335 1336AT_SETUP([Contained program visibility (1)]) 1337AT_KEYWORDS([fundamental CALL]) 1338 1339AT_DATA([prog.cob], [ 1340 IDENTIFICATION DIVISION. 1341 PROGRAM-ID. prog. 1342 DATA DIVISION. 1343 WORKING-STORAGE SECTION. 1344 01 X PIC X(5) GLOBAL VALUE "prog1". 1345 PROCEDURE DIVISION. 1346 IF X NOT = "prog1" 1347 DISPLAY X 1348 END-DISPLAY 1349 END-IF. 1350 CALL "prog2" 1351 END-CALL. 1352 CALL "prog3" 1353 END-CALL. 1354 STOP RUN. 1355 IDENTIFICATION DIVISION. 1356 PROGRAM-ID. prog2. 1357 DATA DIVISION. 1358 WORKING-STORAGE SECTION. 1359 01 X PIC X(5) GLOBAL VALUE "prog2". 1360 PROCEDURE DIVISION. 1361 IF X NOT = "prog2" 1362 DISPLAY X 1363 END-DISPLAY 1364 END-IF. 1365 CALL "prog3" 1366 END-CALL. 1367 EXIT PROGRAM. 1368 IDENTIFICATION DIVISION. 1369 PROGRAM-ID. prog3. 1370 DATA DIVISION. 1371 WORKING-STORAGE SECTION. 1372 PROCEDURE DIVISION. 1373 IF X NOT = "prog2" 1374 DISPLAY X 1375 END-DISPLAY 1376 END-IF 1377 EXIT PROGRAM. 1378 END PROGRAM prog3. 1379 END PROGRAM prog2. 1380 END PROGRAM prog. 1381]) 1382 1383AT_CHECK([$COMPILE prog.cob], [0], [], []) 1384AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], 1385[libcob: prog.cob:14: error: module 'prog3' not found 1386]) 1387 1388AT_CLEANUP 1389 1390 1391AT_SETUP([Contained program visibility (2)]) 1392AT_KEYWORDS([fundamental CALL]) 1393 1394AT_DATA([prog.cob], [ 1395 IDENTIFICATION DIVISION. 1396 PROGRAM-ID. prog. 1397 DATA DIVISION. 1398 WORKING-STORAGE SECTION. 1399 01 X PIC X(5) GLOBAL VALUE "prog1". 1400 PROCEDURE DIVISION. 1401 IF X NOT = "prog1" 1402 DISPLAY X 1403 END-DISPLAY 1404 END-IF. 1405 CALL "prog2" 1406 END-CALL. 1407 STOP RUN. 1408 IDENTIFICATION DIVISION. 1409 PROGRAM-ID. prog2. 1410 DATA DIVISION. 1411 WORKING-STORAGE SECTION. 1412 01 X PIC X(5) GLOBAL VALUE "prog2". 1413 PROCEDURE DIVISION. 1414 IF X NOT = "prog2" 1415 DISPLAY X 1416 END-DISPLAY 1417 END-IF. 1418 CALL "prog3" 1419 END-CALL. 1420 EXIT PROGRAM. 1421 END PROGRAM prog2. 1422 IDENTIFICATION DIVISION. 1423 PROGRAM-ID. prog3. 1424 DATA DIVISION. 1425 WORKING-STORAGE SECTION. 1426 PROCEDURE DIVISION. 1427 IF X NOT = "prog2" 1428 DISPLAY X 1429 END-DISPLAY 1430 END-IF. 1431 EXIT PROGRAM. 1432 END PROGRAM prog3. 1433 END PROGRAM prog. 1434]) 1435 1436AT_CHECK([$COMPILE prog.cob], [0], [], []) 1437AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], 1438[libcob: prog.cob:25: error: module 'prog3' not found 1439]) 1440 1441AT_CLEANUP 1442 1443 1444AT_SETUP([Contained program visibility (3)]) 1445AT_KEYWORDS([fundamental CALL]) 1446 1447AT_DATA([prog.cob], [ 1448 IDENTIFICATION DIVISION. 1449 PROGRAM-ID. prog. 1450 DATA DIVISION. 1451 WORKING-STORAGE SECTION. 1452 01 X PIC X(5) GLOBAL VALUE "prog1". 1453 PROCEDURE DIVISION. 1454 IF X NOT = "prog1" 1455 DISPLAY X 1456 END-DISPLAY 1457 END-IF. 1458 CALL "prog2" 1459 END-CALL. 1460 STOP RUN. 1461 IDENTIFICATION DIVISION. 1462 PROGRAM-ID. prog2. 1463 DATA DIVISION. 1464 WORKING-STORAGE SECTION. 1465 01 X PIC X(5) GLOBAL VALUE "prog2". 1466 PROCEDURE DIVISION. 1467 IF X NOT = "prog2" 1468 DISPLAY X 1469 END-DISPLAY 1470 END-IF. 1471 CALL "prog3" 1472 END-CALL. 1473 EXIT PROGRAM. 1474 END PROGRAM prog2. 1475 IDENTIFICATION DIVISION. 1476 PROGRAM-ID. prog3 COMMON. 1477 DATA DIVISION. 1478 WORKING-STORAGE SECTION. 1479 PROCEDURE DIVISION. 1480 IF X NOT = "prog1" 1481 DISPLAY X 1482 END-DISPLAY 1483 END-IF. 1484 EXIT PROGRAM. 1485 END PROGRAM prog3. 1486 END PROGRAM prog. 1487]) 1488 1489AT_CHECK([$COMPILE prog.cob], [0], [], []) 1490AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 1491 1492AT_CLEANUP 1493 1494 1495AT_SETUP([Contained program visibility (4)]) 1496AT_KEYWORDS([fundamental CALL]) 1497 1498AT_DATA([prog.cob], [ 1499 IDENTIFICATION DIVISION. 1500 PROGRAM-ID. prog. 1501 DATA DIVISION. 1502 WORKING-STORAGE SECTION. 1503 PROCEDURE DIVISION. 1504 DISPLAY "P1" NO ADVANCING 1505 END-DISPLAY. 1506 CALL "prog2" 1507 END-CALL 1508 CALL "prog3" 1509 END-CALL 1510 STOP RUN. 1511 IDENTIFICATION DIVISION. 1512 PROGRAM-ID. prog2. 1513 DATA DIVISION. 1514 WORKING-STORAGE SECTION. 1515 PROCEDURE DIVISION. 1516 DISPLAY "P2" NO ADVANCING 1517 END-DISPLAY. 1518 EXIT PROGRAM. 1519 END PROGRAM prog2. 1520 END PROGRAM prog. 1521 IDENTIFICATION DIVISION. 1522 PROGRAM-ID. prog3. 1523 DATA DIVISION. 1524 WORKING-STORAGE SECTION. 1525 PROCEDURE DIVISION. 1526 DISPLAY "P3" NO ADVANCING 1527 END-DISPLAY. 1528 CALL "prog2" 1529 END-CALL. 1530 EXIT PROGRAM. 1531 IDENTIFICATION DIVISION. 1532 PROGRAM-ID. prog2. 1533 DATA DIVISION. 1534 WORKING-STORAGE SECTION. 1535 PROCEDURE DIVISION. 1536 DISPLAY "P4" NO ADVANCING 1537 END-DISPLAY. 1538 EXIT PROGRAM. 1539 END PROGRAM prog2. 1540 END PROGRAM prog3. 1541]) 1542 1543AT_CHECK([$COMPILE prog.cob], [0], [], []) 1544AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 1545[P1P2P3P4]) 1546 1547AT_CLEANUP 1548 1549 1550AT_SETUP([CALL/CANCEL with program-prototype-name]) 1551AT_KEYWORDS([fundamental]) 1552 1553AT_DATA([prog.cob], [ 1554 IDENTIFICATION DIVISION. 1555 PROGRAM-ID. prog. 1556 1557 ENVIRONMENT DIVISION. 1558 CONFIGURATION SECTION. 1559 REPOSITORY. 1560 PROGRAM recursion-test 1561 PROGRAM cancel-test 1562 . 1563 DATA DIVISION. 1564 WORKING-STORAGE SECTION. 1565 01 num PIC 9 VALUE 0. 1566 1567 PROCEDURE DIVISION. 1568 CALL recursion-test USING num 1569 DISPLAY "<" 1570 1571 CALL cancel-test 1572 CALL cancel-test 1573 CANCEL cancel-test 1574 CALL cancel-test 1575 DISPLAY "<" 1576 . 1577 END PROGRAM prog. 1578 1579 1580 IDENTIFICATION DIVISION. 1581 PROGRAM-ID. recursion-test RECURSIVE. 1582 1583 DATA DIVISION. 1584 LINKAGE SECTION. 1585 01 x PIC 9. 1586 1587 PROCEDURE DIVISION USING x. 1588 ADD 1 TO x 1589 DISPLAY x NO ADVANCING 1590 IF x = 1 1591 CALL recursion-test USING x 1592 END-IF 1593 . 1594 END PROGRAM recursion-test. 1595 1596 1597 IDENTIFICATION DIVISION. 1598 PROGRAM-ID. cancel-test. 1599 1600 DATA DIVISION. 1601 WORKING-STORAGE SECTION. 1602 01 x PIC 9 VALUE 1. 1603 1604 PROCEDURE DIVISION. 1605 DISPLAY x NO ADVANCING 1606 ADD 1 TO x 1607 . 1608 END PROGRAM cancel-test. 1609]) 1610 1611# TO-DO: Fix these warnings when program prototypes are added. 1612AT_CHECK([$COMPILE -fno-program-name-redefinition prog.cob], [0], [], 1613[prog.cob:8: warning: no definition/prototype seen for PROGRAM 'recursion-test' 1614prog.cob:9: warning: no definition/prototype seen for PROGRAM 'cancel-test' 1615]) 1616AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 1617[12< 1618121< 1619]) 1620AT_CLEANUP 1621 1622 1623AT_SETUP([GLOBAL FD (1)]) 1624AT_KEYWORDS([fundamental]) 1625 1626AT_DATA([prog.cob], [ 1627 IDENTIFICATION DIVISION. 1628 PROGRAM-ID. prog. 1629 ENVIRONMENT DIVISION. 1630 INPUT-OUTPUT SECTION. 1631 FILE-CONTROL. 1632 SELECT TEST-FILE 1633 ASSIGN "TESTFILE" 1634 ACCESS DYNAMIC 1635 ORGANIZATION RELATIVE 1636 STATUS TESTSTAT 1637 RELATIVE KEY TESTKEY 1638 . 1639 DATA DIVISION. 1640 FILE SECTION. 1641 FD TEST-FILE GLOBAL. 1642 01 TEST-REC PIC X(4). 1643 WORKING-STORAGE SECTION. 1644 01 GLOBVALS. 1645 03 TESTKEY PIC 9(4). 1646 03 TESTSTAT PIC XX. 1647 PROCEDURE DIVISION. 1648 OPEN INPUT TEST-FILE. 1649 CALL "prog2" 1650 END-CALL. 1651 CLOSE TEST-FILE. 1652 STOP RUN. 1653 IDENTIFICATION DIVISION. 1654 PROGRAM-ID. prog2. 1655 DATA DIVISION. 1656 WORKING-STORAGE SECTION. 1657 PROCEDURE DIVISION. 1658 READ TEST-FILE 1659 INVALID KEY 1660 DISPLAY "NOK" 1661 END-DISPLAY 1662 END-READ. 1663 EXIT PROGRAM. 1664 END PROGRAM prog2. 1665 END PROGRAM prog. 1666]) 1667 1668AT_CHECK([$COMPILE prog.cob], [0], [], []) 1669 1670AT_CLEANUP 1671 1672 1673AT_SETUP([GLOBAL FD (2)]) 1674AT_KEYWORDS([fundamental]) 1675 1676AT_DATA([prog.cob], [ 1677 IDENTIFICATION DIVISION. 1678 PROGRAM-ID. prog. 1679 ENVIRONMENT DIVISION. 1680 INPUT-OUTPUT SECTION. 1681 FILE-CONTROL. 1682 SELECT TEST-FILE 1683 ASSIGN "TESTFILE" 1684 ACCESS DYNAMIC 1685 ORGANIZATION INDEXED 1686 STATUS TESTSTAT 1687 RECORD KEY TESTKEY 1688 . 1689 DATA DIVISION. 1690 FILE SECTION. 1691 FD TEST-FILE GLOBAL. 1692 01 TEST-REC. 1693 03 TESTKEY PIC X(4). 1694 WORKING-STORAGE SECTION. 1695 01 GLOBVALS. 1696 03 TESTSTAT PIC XX. 1697 PROCEDURE DIVISION. 1698 OPEN INPUT TEST-FILE. 1699 CALL "prog2" 1700 END-CALL. 1701 CLOSE TEST-FILE. 1702 STOP RUN. 1703 IDENTIFICATION DIVISION. 1704 PROGRAM-ID. prog2. 1705 DATA DIVISION. 1706 WORKING-STORAGE SECTION. 1707 PROCEDURE DIVISION. 1708 READ TEST-FILE 1709 INVALID KEY 1710 DISPLAY "NOK" 1711 END-DISPLAY 1712 END-READ. 1713 EXIT PROGRAM. 1714 END PROGRAM prog2. 1715 END PROGRAM prog. 1716]) 1717 1718AT_CHECK([$COMPILE prog.cob], [0], [], []) 1719 1720AT_CLEANUP 1721 1722 1723AT_SETUP([GLOBAL FD (3)]) 1724AT_KEYWORDS([fundamental]) 1725 1726AT_DATA([prog.cob], [ 1727 IDENTIFICATION DIVISION. 1728 PROGRAM-ID. prog. 1729 ENVIRONMENT DIVISION. 1730 INPUT-OUTPUT SECTION. 1731 FILE-CONTROL. 1732 SELECT TEST-FILE 1733 ASSIGN "TESTFILE" 1734 ACCESS DYNAMIC 1735 ORGANIZATION RELATIVE 1736 STATUS TESTSTAT 1737 RELATIVE KEY TESTKEY 1738 . 1739 DATA DIVISION. 1740 FILE SECTION. 1741 FD TEST-FILE GLOBAL. 1742 01 TEST-REC PIC X(4). 1743 WORKING-STORAGE SECTION. 1744 01 GLOBVALS. 1745 03 TESTKEY PIC 9(4). 1746 03 TESTSTAT PIC XX. 1747 PROCEDURE DIVISION. 1748 MOVE "00" TO TESTSTAT. 1749 CALL "prog2" 1750 END-CALL. 1751 IF TESTSTAT = "00" 1752 DISPLAY "Not OK" 1753 END-DISPLAY 1754 END-IF. 1755 STOP RUN. 1756 IDENTIFICATION DIVISION. 1757 PROGRAM-ID. prog2. 1758 DATA DIVISION. 1759 WORKING-STORAGE SECTION. 1760 PROCEDURE DIVISION. 1761 OPEN INPUT TEST-FILE. 1762 EXIT PROGRAM. 1763 END PROGRAM prog2. 1764 END PROGRAM prog. 1765]) 1766 1767AT_CHECK([$COMPILE prog.cob], [0], [], []) 1768AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 1769 1770AT_CLEANUP 1771 1772 1773AT_SETUP([GLOBAL FD (4)]) 1774AT_KEYWORDS([fundamental]) 1775 1776AT_DATA([prog.cob], [ 1777 IDENTIFICATION DIVISION. 1778 PROGRAM-ID. prog. 1779 ENVIRONMENT DIVISION. 1780 INPUT-OUTPUT SECTION. 1781 FILE-CONTROL. 1782 SELECT TEST-FILE 1783 ASSIGN "TESTFILE" 1784 ACCESS DYNAMIC 1785 ORGANIZATION INDEXED 1786 STATUS TESTSTAT 1787 RECORD KEY TESTKEY 1788 . 1789 DATA DIVISION. 1790 FILE SECTION. 1791 FD TEST-FILE GLOBAL. 1792 01 TEST-REC. 1793 03 TESTKEY PIC X(4). 1794 WORKING-STORAGE SECTION. 1795 01 GLOBVALS. 1796 03 TESTSTAT PIC XX. 1797 PROCEDURE DIVISION. 1798 MOVE "00" TO TESTSTAT. 1799 CALL "prog2" 1800 END-CALL. 1801 IF TESTSTAT = "00" 1802 DISPLAY "Not OK" 1803 END-DISPLAY 1804 END-IF. 1805 STOP RUN. 1806 IDENTIFICATION DIVISION. 1807 PROGRAM-ID. prog2. 1808 DATA DIVISION. 1809 WORKING-STORAGE SECTION. 1810 PROCEDURE DIVISION. 1811 OPEN INPUT TEST-FILE. 1812 EXIT PROGRAM. 1813 END PROGRAM prog2. 1814 END PROGRAM prog. 1815]) 1816 1817AT_CHECK([$COMPILE prog.cob], [0], [], []) 1818AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 1819 1820AT_CLEANUP 1821 1822 1823AT_SETUP([CANCEL test (1)]) 1824AT_KEYWORDS([fundamental]) 1825 1826AT_DATA([prog.cob], [ 1827 IDENTIFICATION DIVISION. 1828 PROGRAM-ID. prog. 1829 DATA DIVISION. 1830 WORKING-STORAGE SECTION. 1831 PROCEDURE DIVISION. 1832 CANCEL "notthere". 1833 CANCEL "prog". 1834 DISPLAY "NG" NO ADVANCING 1835 END-DISPLAY. 1836 STOP RUN. 1837]) 1838 1839AT_CHECK([$COMPILE prog.cob], [0], [], []) 1840AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], 1841[libcob: prog.cob:8: error: attempt to CANCEL active program 1842]) 1843AT_CHECK([COB_PHYSICAL_CANCEL=1 ./prog], [1], [], 1844[libcob: prog.cob:8: error: attempt to CANCEL active program 1845]) 1846 1847AT_CLEANUP 1848 1849 1850AT_SETUP([CANCEL test (2)]) 1851AT_KEYWORDS([fundamental]) 1852 1853AT_DATA([prog.cob], [ 1854 IDENTIFICATION DIVISION. 1855 PROGRAM-ID. prog. 1856 DATA DIVISION. 1857 WORKING-STORAGE SECTION. 1858 PROCEDURE DIVISION. 1859 CALL "prog2" 1860 END-CALL. 1861 DISPLAY "NG" NO ADVANCING 1862 END-DISPLAY. 1863 STOP RUN. 1864]) 1865 1866AT_DATA([prog2.cob], [ 1867 IDENTIFICATION DIVISION. 1868 PROGRAM-ID. prog2. 1869 DATA DIVISION. 1870 WORKING-STORAGE SECTION. 1871 PROCEDURE DIVISION. 1872 CANCEL "prog". 1873 DISPLAY "NG" NO ADVANCING 1874 END-DISPLAY. 1875 STOP RUN. 1876]) 1877 1878AT_CHECK([$COMPILE prog.cob], [0], [], []) 1879AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], []) 1880AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], 1881[libcob: prog2.cob:7: error: attempt to CANCEL active program 1882]) 1883AT_CHECK([COB_PHYSICAL_CANCEL=1 ./prog], [1], [], 1884[libcob: prog2.cob:7: error: attempt to CANCEL active program 1885]) 1886 1887AT_CLEANUP 1888 1889 1890AT_SETUP([CANCEL test (3)]) 1891AT_KEYWORDS([fundamental]) 1892 1893AT_DATA([prog.cob], [ 1894 IDENTIFICATION DIVISION. 1895 PROGRAM-ID. prog. 1896 DATA DIVISION. 1897 WORKING-STORAGE SECTION. 1898 PROCEDURE DIVISION. 1899 CALL "prog2" 1900 END-CALL. 1901 CALL "prog2" 1902 END-CALL. 1903 CANCEL "prog2". 1904 CALL "prog2" 1905 END-CALL. 1906 CANCEL "prog2". 1907 DISPLAY "NG" NO ADVANCING 1908 END-DISPLAY. 1909 STOP RUN. 1910]) 1911 1912AT_DATA([prog2.cob], [ 1913 IDENTIFICATION DIVISION. 1914 PROGRAM-ID. prog2. 1915 DATA DIVISION. 1916 WORKING-STORAGE SECTION. 1917 77 VAR PIC 9(01) value 1. 1918 PROCEDURE DIVISION. 1919 DISPLAY VAR NO ADVANCING 1920 END-DISPLAY. 1921 ADD 1 TO VAR END-ADD. 1922 GOBACK. 1923]) 1924 1925AT_CHECK([$COMPILE prog.cob], [0], [], []) 1926AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], []) 1927AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [121NG], []) 1928AT_CHECK([COB_PHYSICAL_CANCEL=1 ./prog], [0], [121NG], []) 1929 1930AT_CLEANUP 1931 1932 1933AT_SETUP([Separate sign positions (1)]) 1934AT_KEYWORDS([fundamental]) 1935 1936AT_DATA([prog.cob], [ 1937 IDENTIFICATION DIVISION. 1938 PROGRAM-ID. prog. 1939 DATA DIVISION. 1940 WORKING-STORAGE SECTION. 1941 01 X PIC S9 VALUE -1 SIGN LEADING SEPARATE. 1942 01 Y PIC S9 VALUE -1 SIGN TRAILING SEPARATE. 1943 PROCEDURE DIVISION. 1944 DISPLAY X(1:1) X(2:1) NO ADVANCING 1945 END-DISPLAY. 1946 DISPLAY Y(1:1) Y(2:1) NO ADVANCING 1947 END-DISPLAY. 1948 STOP RUN. 1949]) 1950 1951AT_CHECK([$COMPILE prog.cob], [0], [], []) 1952AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [-11-]) 1953 1954AT_CLEANUP 1955 1956 1957AT_SETUP([Separate sign positions (2)]) 1958AT_KEYWORDS([fundamental]) 1959 1960AT_DATA([prog.cob], [ 1961 IDENTIFICATION DIVISION. 1962 PROGRAM-ID. prog. 1963 DATA DIVISION. 1964 WORKING-STORAGE SECTION. 1965 01 X PIC S9 SIGN LEADING SEPARATE. 1966 01 Y PIC S9 SIGN TRAILING SEPARATE. 1967 PROCEDURE DIVISION. 1968 MOVE 0 TO X. 1969 DISPLAY X NO ADVANCING 1970 END-DISPLAY. 1971 MOVE ZERO TO X. 1972 DISPLAY X NO ADVANCING 1973 END-DISPLAY. 1974 MOVE 0 TO Y. 1975 DISPLAY Y NO ADVANCING 1976 END-DISPLAY. 1977 MOVE ZERO TO Y. 1978 DISPLAY Y NO ADVANCING 1979 END-DISPLAY. 1980 STOP RUN. 1981]) 1982AT_CHECK([$COMPILE prog.cob], [0], [], []) 1983AT_CHECK([$COMPILE_MODULE -fpretty-display prog.cob], [0], [], []) 1984AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+0+00+0+]) 1985AT_CHECK([$COBCRUN prog], [0], [+0+00+0+]) 1986 1987AT_CLEANUP 1988 1989 1990AT_SETUP([Context sensitive words (1)]) 1991AT_KEYWORDS([fundamental byte-length]) 1992 1993AT_DATA([prog.cob], [ 1994 IDENTIFICATION DIVISION. 1995 PROGRAM-ID. prog. 1996 DATA DIVISION. 1997 WORKING-STORAGE SECTION. 1998 01 BYTE-LENGTH PIC 9. 1999 01 X CONSTANT AS BYTE-LENGTH OF BYTE-LENGTH. 2000 PROCEDURE DIVISION. 2001 MOVE X TO BYTE-LENGTH. 2002 DISPLAY BYTE-LENGTH NO ADVANCING 2003 END-DISPLAY. 2004 STOP RUN. 2005]) 2006 2007AT_CHECK([$COMPILE prog.cob], [0], [], []) 2008AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [1]) 2009 2010AT_CLEANUP 2011 2012 2013AT_SETUP([Context sensitive words (2)]) 2014AT_KEYWORDS([fundamental yyyymmdd]) 2015 2016AT_DATA([prog.cob], [ 2017 IDENTIFICATION DIVISION. 2018 PROGRAM-ID. prog. 2019 DATA DIVISION. 2020 WORKING-STORAGE SECTION. 2021 01 YYYYMMDD PIC 9 VALUE 0. 2022 01 X PIC X(16). 2023 PROCEDURE DIVISION. 2024 ACCEPT X FROM DATE YYYYMMDD 2025 END-ACCEPT. 2026 DISPLAY YYYYMMDD NO ADVANCING 2027 END-DISPLAY. 2028 STOP RUN. 2029]) 2030 2031AT_CHECK([$COMPILE prog.cob], [0], [], []) 2032AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) 2033 2034AT_CLEANUP 2035 2036 2037AT_SETUP([Context sensitive words (3)]) 2038AT_KEYWORDS([fundamental yyyyddd]) 2039 2040AT_DATA([prog.cob], [ 2041 IDENTIFICATION DIVISION. 2042 PROGRAM-ID. prog. 2043 DATA DIVISION. 2044 WORKING-STORAGE SECTION. 2045 01 YYYYDDD PIC 9 VALUE 0. 2046 01 X PIC X(16). 2047 PROCEDURE DIVISION. 2048 ACCEPT X FROM DAY YYYYDDD 2049 END-ACCEPT. 2050 DISPLAY YYYYDDD NO ADVANCING 2051 END-DISPLAY. 2052 STOP RUN. 2053]) 2054 2055AT_CHECK([$COMPILE prog.cob], [0], [], []) 2056AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) 2057 2058AT_CLEANUP 2059 2060 2061AT_SETUP([Context sensitive words (4)]) 2062AT_KEYWORDS([fundamental intrinsic]) 2063 2064AT_DATA([prog.cob], [ 2065 IDENTIFICATION DIVISION. 2066 PROGRAM-ID. prog. 2067 ENVIRONMENT DIVISION. 2068 CONFIGURATION SECTION. 2069 REPOSITORY. 2070 FUNCTION ALL INTRINSIC. 2071 DATA DIVISION. 2072 WORKING-STORAGE SECTION. 2073 01 INTRINSIC PIC 9 VALUE 0. 2074 PROCEDURE DIVISION. 2075 DISPLAY INTRINSIC NO ADVANCING 2076 END-DISPLAY. 2077 STOP RUN. 2078]) 2079 2080AT_CHECK([$COMPILE prog.cob], [0], [], []) 2081AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) 2082 2083AT_CLEANUP 2084 2085 2086AT_SETUP([Context sensitive words (5)]) 2087AT_KEYWORDS([fundamental recursive]) 2088 2089AT_DATA([prog.cob], [ 2090 IDENTIFICATION DIVISION. 2091 PROGRAM-ID. prog RECURSIVE. 2092 ENVIRONMENT DIVISION. 2093 CONFIGURATION SECTION. 2094 DATA DIVISION. 2095 WORKING-STORAGE SECTION. 2096 01 RECURSIVE PIC 9 VALUE 0. 2097 PROCEDURE DIVISION. 2098 DISPLAY RECURSIVE NO ADVANCING 2099 END-DISPLAY. 2100 STOP RUN. 2101]) 2102 2103AT_CHECK([$COMPILE prog.cob], [0], [], []) 2104AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) 2105 2106AT_CLEANUP 2107 2108 2109AT_SETUP([Context sensitive words (6)]) 2110AT_KEYWORDS([fundamental normal]) 2111 2112AT_DATA([prog.cob], [ 2113 IDENTIFICATION DIVISION. 2114 PROGRAM-ID. prog. 2115 ENVIRONMENT DIVISION. 2116 CONFIGURATION SECTION. 2117 DATA DIVISION. 2118 WORKING-STORAGE SECTION. 2119 01 NORMAL PIC 9 VALUE 0. 2120 PROCEDURE DIVISION. 2121 DISPLAY NORMAL NO ADVANCING *> Intentionally no period or END-DISPLAY 2122 STOP RUN NORMAL. 2123]) 2124 2125AT_CHECK([$COMPILE prog.cob], [0], [], []) 2126AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) 2127 2128AT_CLEANUP 2129 2130 2131AT_SETUP([Context sensitive words (7)]) 2132AT_KEYWORDS([fundamental compute away-from-zero]) 2133 2134AT_DATA([prog.cob], [ 2135 IDENTIFICATION DIVISION. 2136 PROGRAM-ID. prog. 2137 ENVIRONMENT DIVISION. 2138 CONFIGURATION SECTION. 2139 DATA DIVISION. 2140 WORKING-STORAGE SECTION. 2141 01 X PIC 9 VALUE 0. 2142 01 AWAY-FROM-ZERO PIC 9 VALUE 0. 2143 PROCEDURE DIVISION. 2144 COMPUTE X ROUNDED MODE AWAY-FROM-ZERO 2145 AWAY-FROM-ZERO = 1.1 2146 END-COMPUTE 2147 DISPLAY X AWAY-FROM-ZERO NO ADVANCING 2148 END-DISPLAY. 2149 STOP RUN. 2150]) 2151 2152AT_CHECK([$COMPILE prog.cob], [0], [], []) 2153AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [21]) 2154 2155AT_CLEANUP 2156 2157 2158AT_SETUP([Context sensitive words (8)]) 2159AT_KEYWORDS([fundamental ibm unbounded attributes]) 2160 2161AT_DATA([prog.cob], [ 2162 IDENTIFICATION DIVISION. 2163 PROGRAM-ID. prog. 2164 ENVIRONMENT DIVISION. 2165 CONFIGURATION SECTION. 2166 DATA DIVISION. 2167 WORKING-STORAGE SECTION. 2168 01 UNBOUNDED. 2169 03 ATTRIBUTES PIC 9 VALUE 0. 2170 01 LOC. 2171 03 NAMESPACE PIC 9 VALUE 1. 2172 PROCEDURE DIVISION. 2173 DISPLAY UNBOUNDED ATTRIBUTES 2174 NAMESPACE IN LOC 2175 NO ADVANCING. 2176 STOP RUN. 2177]) 2178 2179AT_CHECK([$COMPILE -std=ibm-strict prog.cob], [0], [], []) 2180AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [001], []) 2181 2182AT_CLEANUP 2183 2184 2185AT_SETUP([ROUNDED AWAY-FROM-ZERO]) 2186AT_KEYWORDS([fundamental compute]) 2187 2188AT_DATA([prog.cob], [ 2189 IDENTIFICATION DIVISION. 2190 PROGRAM-ID. prog. 2191 ENVIRONMENT DIVISION. 2192 DATA DIVISION. 2193 WORKING-STORAGE SECTION. 2194 01 M PIC S9. 2195 01 N PIC S9. 2196 01 O PIC S9. 2197 01 P PIC S9. 2198 01 Q PIC S9. 2199 01 R PIC S9. 2200 01 S PIC S9. 2201 01 T PIC S9. 2202 01 U PIC S9. 2203 01 V PIC S9. 2204 PROCEDURE DIVISION. 2205 COMPUTE M ROUNDED MODE AWAY-FROM-ZERO 2206 = 2.49 2207 END-COMPUTE 2208 COMPUTE N ROUNDED MODE AWAY-FROM-ZERO 2209 = -2.49 2210 END-COMPUTE 2211 COMPUTE O ROUNDED MODE AWAY-FROM-ZERO 2212 = 2.50 2213 END-COMPUTE 2214 COMPUTE P ROUNDED MODE AWAY-FROM-ZERO 2215 = -2.50 2216 END-COMPUTE 2217 COMPUTE Q ROUNDED MODE AWAY-FROM-ZERO 2218 = 3.49 2219 END-COMPUTE 2220 COMPUTE R ROUNDED MODE AWAY-FROM-ZERO 2221 = -3.49 2222 END-COMPUTE 2223 COMPUTE S ROUNDED MODE AWAY-FROM-ZERO 2224 = 3.50 2225 END-COMPUTE 2226 COMPUTE T ROUNDED MODE AWAY-FROM-ZERO 2227 = -3.50 2228 END-COMPUTE 2229 COMPUTE U ROUNDED MODE AWAY-FROM-ZERO 2230 = 3.510 2231 END-COMPUTE 2232 COMPUTE V ROUNDED MODE AWAY-FROM-ZERO 2233 = -3.510 2234 END-COMPUTE 2235 DISPLAY M " " N " " O " " P " " Q " " R " " S " " T 2236 " " U " " V 2237 NO ADVANCING 2238 END-DISPLAY 2239 STOP RUN. 2240]) 2241 2242AT_CHECK([$COMPILE prog.cob], [0], [], []) 2243AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+3 -3 +3 -3 +4 -4 +4 -4 +4 -4]) 2244 2245AT_CLEANUP 2246 2247 2248AT_SETUP([ROUNDED NEAREST-AWAY-FROM-ZERO]) 2249AT_KEYWORDS([fundamental compute]) 2250 2251AT_DATA([prog.cob], [ 2252 IDENTIFICATION DIVISION. 2253 PROGRAM-ID. prog. 2254 ENVIRONMENT DIVISION. 2255 DATA DIVISION. 2256 WORKING-STORAGE SECTION. 2257 01 M PIC S9. 2258 01 N PIC S9. 2259 01 O PIC S9. 2260 01 P PIC S9. 2261 01 Q PIC S9. 2262 01 R PIC S9. 2263 01 S PIC S9. 2264 01 T PIC S9. 2265 01 U PIC S9. 2266 01 V PIC S9. 2267 PROCEDURE DIVISION. 2268 COMPUTE M ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2269 = 2.49 2270 END-COMPUTE 2271 COMPUTE N ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2272 = -2.49 2273 END-COMPUTE 2274 COMPUTE O ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2275 = 2.50 2276 END-COMPUTE 2277 COMPUTE P ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2278 = -2.50 2279 END-COMPUTE 2280 COMPUTE Q ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2281 = 3.49 2282 END-COMPUTE 2283 COMPUTE R ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2284 = -3.49 2285 END-COMPUTE 2286 COMPUTE S ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2287 = 3.50 2288 END-COMPUTE 2289 COMPUTE T ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2290 = -3.50 2291 END-COMPUTE 2292 COMPUTE U ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2293 = 3.510 2294 END-COMPUTE 2295 COMPUTE V ROUNDED MODE NEAREST-AWAY-FROM-ZERO 2296 = -3.510 2297 END-COMPUTE 2298 DISPLAY M " " N " " O " " P " " Q " " R " " S " " T 2299 " " U " " V 2300 NO ADVANCING 2301 END-DISPLAY 2302 STOP RUN. 2303]) 2304 2305AT_CHECK([$COMPILE prog.cob], [0], [], []) 2306AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +3 -3 +3 -3 +4 -4 +4 -4]) 2307 2308AT_CLEANUP 2309 2310 2311AT_SETUP([ROUNDED NEAREST-EVEN]) 2312AT_KEYWORDS([fundamental compute]) 2313 2314AT_DATA([prog.cob], [ 2315 IDENTIFICATION DIVISION. 2316 PROGRAM-ID. prog. 2317 ENVIRONMENT DIVISION. 2318 DATA DIVISION. 2319 WORKING-STORAGE SECTION. 2320 01 M PIC S9. 2321 01 N PIC S9. 2322 01 O PIC S9. 2323 01 P PIC S9. 2324 01 Q PIC S9. 2325 01 R PIC S9. 2326 01 S PIC S9. 2327 01 T PIC S9. 2328 01 U PIC S9. 2329 01 V PIC S9. 2330 PROCEDURE DIVISION. 2331 COMPUTE M ROUNDED MODE NEAREST-EVEN 2332 = 2.49 2333 END-COMPUTE 2334 COMPUTE N ROUNDED MODE NEAREST-EVEN 2335 = -2.49 2336 END-COMPUTE 2337 COMPUTE O ROUNDED MODE NEAREST-EVEN 2338 = 2.50 2339 END-COMPUTE 2340 COMPUTE P ROUNDED MODE NEAREST-EVEN 2341 = -2.50 2342 END-COMPUTE 2343 COMPUTE Q ROUNDED MODE NEAREST-EVEN 2344 = 3.49 2345 END-COMPUTE 2346 COMPUTE R ROUNDED MODE NEAREST-EVEN 2347 = -3.49 2348 END-COMPUTE 2349 COMPUTE S ROUNDED MODE NEAREST-EVEN 2350 = 3.50 2351 END-COMPUTE 2352 COMPUTE T ROUNDED MODE NEAREST-EVEN 2353 = -3.50 2354 END-COMPUTE 2355 COMPUTE U ROUNDED MODE NEAREST-EVEN 2356 = 3.510 2357 END-COMPUTE 2358 COMPUTE V ROUNDED MODE NEAREST-EVEN 2359 = -3.510 2360 END-COMPUTE 2361 DISPLAY M " " N " " O " " P " " Q " " R " " S " " T 2362 " " U " " V 2363 NO ADVANCING 2364 END-DISPLAY 2365 STOP RUN. 2366]) 2367 2368AT_CHECK([$COMPILE prog.cob], [0], [], []) 2369AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +2 -2 +3 -3 +4 -4 +4 -4]) 2370 2371AT_CLEANUP 2372 2373 2374AT_SETUP([ROUNDED NEAREST-TOWARD-ZERO]) 2375AT_KEYWORDS([fundamental compute]) 2376 2377AT_DATA([prog.cob], [ 2378 IDENTIFICATION DIVISION. 2379 PROGRAM-ID. prog. 2380 ENVIRONMENT DIVISION. 2381 DATA DIVISION. 2382 WORKING-STORAGE SECTION. 2383 01 M PIC S9. 2384 01 N PIC S9. 2385 01 O PIC S9. 2386 01 P PIC S9. 2387 01 Q PIC S9. 2388 01 R PIC S9. 2389 01 S PIC S9. 2390 01 T PIC S9. 2391 01 U PIC S9. 2392 01 V PIC S9. 2393 PROCEDURE DIVISION. 2394 COMPUTE M ROUNDED MODE NEAREST-TOWARD-ZERO 2395 = 2.49 2396 END-COMPUTE 2397 COMPUTE N ROUNDED MODE NEAREST-TOWARD-ZERO 2398 = -2.49 2399 END-COMPUTE 2400 COMPUTE O ROUNDED MODE NEAREST-TOWARD-ZERO 2401 = 2.50 2402 END-COMPUTE 2403 COMPUTE P ROUNDED MODE NEAREST-TOWARD-ZERO 2404 = -2.50 2405 END-COMPUTE 2406 COMPUTE Q ROUNDED MODE NEAREST-TOWARD-ZERO 2407 = 3.49 2408 END-COMPUTE 2409 COMPUTE R ROUNDED MODE NEAREST-TOWARD-ZERO 2410 = -3.49 2411 END-COMPUTE 2412 COMPUTE S ROUNDED MODE NEAREST-TOWARD-ZERO 2413 = 3.50 2414 END-COMPUTE 2415 COMPUTE T ROUNDED MODE NEAREST-TOWARD-ZERO 2416 = -3.50 2417 END-COMPUTE 2418 COMPUTE U ROUNDED MODE NEAREST-TOWARD-ZERO 2419 = 3.510 2420 END-COMPUTE 2421 COMPUTE V ROUNDED MODE NEAREST-TOWARD-ZERO 2422 = -3.510 2423 END-COMPUTE 2424 DISPLAY M " " N " " O " " P " " Q " " R " " S " " T 2425 " " U " " V 2426 NO ADVANCING 2427 END-DISPLAY 2428 STOP RUN. 2429]) 2430 2431AT_CHECK([$COMPILE prog.cob], [0], [], []) 2432AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +2 -2 +3 -3 +3 -3 +4 -4]) 2433 2434AT_CLEANUP 2435 2436 2437AT_SETUP([ROUNDED TOWARD-GREATER]) 2438AT_KEYWORDS([fundamental compute]) 2439 2440AT_DATA([prog.cob], [ 2441 IDENTIFICATION DIVISION. 2442 PROGRAM-ID. prog. 2443 ENVIRONMENT DIVISION. 2444 DATA DIVISION. 2445 WORKING-STORAGE SECTION. 2446 01 M PIC S9. 2447 01 N PIC S9. 2448 01 O PIC S9. 2449 01 P PIC S9. 2450 01 Q PIC S9. 2451 01 R PIC S9. 2452 01 S PIC S9. 2453 01 T PIC S9. 2454 01 U PIC S9. 2455 01 V PIC S9. 2456 PROCEDURE DIVISION. 2457 COMPUTE M ROUNDED MODE TOWARD-GREATER 2458 = 2.49 2459 END-COMPUTE 2460 COMPUTE N ROUNDED MODE TOWARD-GREATER 2461 = -2.49 2462 END-COMPUTE 2463 COMPUTE O ROUNDED MODE TOWARD-GREATER 2464 = 2.50 2465 END-COMPUTE 2466 COMPUTE P ROUNDED MODE TOWARD-GREATER 2467 = -2.50 2468 END-COMPUTE 2469 COMPUTE Q ROUNDED MODE TOWARD-GREATER 2470 = 3.49 2471 END-COMPUTE 2472 COMPUTE R ROUNDED MODE TOWARD-GREATER 2473 = -3.49 2474 END-COMPUTE 2475 COMPUTE S ROUNDED MODE TOWARD-GREATER 2476 = 3.50 2477 END-COMPUTE 2478 COMPUTE T ROUNDED MODE TOWARD-GREATER 2479 = -3.50 2480 END-COMPUTE 2481 COMPUTE U ROUNDED MODE TOWARD-GREATER 2482 = 3.510 2483 END-COMPUTE 2484 COMPUTE V ROUNDED MODE TOWARD-GREATER 2485 = -3.510 2486 END-COMPUTE 2487 DISPLAY M " " N " " O " " P " " Q " " R " " S " " T 2488 " " U " " V 2489 NO ADVANCING 2490 END-DISPLAY 2491 STOP RUN. 2492]) 2493 2494AT_CHECK([$COMPILE prog.cob], [0], [], []) 2495AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+3 -2 +3 -2 +4 -3 +4 -3 +4 -3]) 2496 2497AT_CLEANUP 2498 2499 2500AT_SETUP([ROUNDED TOWARD-LESSER]) 2501AT_KEYWORDS([fundamental compute]) 2502 2503AT_DATA([prog.cob], [ 2504 IDENTIFICATION DIVISION. 2505 PROGRAM-ID. prog. 2506 ENVIRONMENT DIVISION. 2507 DATA DIVISION. 2508 WORKING-STORAGE SECTION. 2509 01 M PIC S9. 2510 01 N PIC S9. 2511 01 O PIC S9. 2512 01 P PIC S9. 2513 01 Q PIC S9. 2514 01 R PIC S9. 2515 01 S PIC S9. 2516 01 T PIC S9. 2517 01 U PIC S9. 2518 01 V PIC S9. 2519 PROCEDURE DIVISION. 2520 COMPUTE M ROUNDED MODE TOWARD-LESSER 2521 = 2.49 2522 END-COMPUTE 2523 COMPUTE N ROUNDED MODE TOWARD-LESSER 2524 = -2.49 2525 END-COMPUTE 2526 COMPUTE O ROUNDED MODE TOWARD-LESSER 2527 = 2.50 2528 END-COMPUTE 2529 COMPUTE P ROUNDED MODE TOWARD-LESSER 2530 = -2.50 2531 END-COMPUTE 2532 COMPUTE Q ROUNDED MODE TOWARD-LESSER 2533 = 3.49 2534 END-COMPUTE 2535 COMPUTE R ROUNDED MODE TOWARD-LESSER 2536 = -3.49 2537 END-COMPUTE 2538 COMPUTE S ROUNDED MODE TOWARD-LESSER 2539 = 3.50 2540 END-COMPUTE 2541 COMPUTE T ROUNDED MODE TOWARD-LESSER 2542 = -3.50 2543 END-COMPUTE 2544 COMPUTE U ROUNDED MODE TOWARD-LESSER 2545 = 3.510 2546 END-COMPUTE 2547 COMPUTE V ROUNDED MODE TOWARD-LESSER 2548 = -3.510 2549 END-COMPUTE 2550 DISPLAY M " " N " " O " " P " " Q " " R " " S " " T 2551 " " U " " V 2552 NO ADVANCING 2553 END-DISPLAY 2554 STOP RUN. 2555]) 2556 2557AT_CHECK([$COMPILE prog.cob], [0], [], []) 2558AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -3 +2 -3 +3 -4 +3 -4 +3 -4]) 2559 2560AT_CLEANUP 2561 2562 2563AT_SETUP([ROUNDED TRUNCATION]) 2564AT_KEYWORDS([fundamental compute]) 2565 2566AT_DATA([prog.cob], [ 2567 IDENTIFICATION DIVISION. 2568 PROGRAM-ID. prog. 2569 ENVIRONMENT DIVISION. 2570 DATA DIVISION. 2571 WORKING-STORAGE SECTION. 2572 01 M PIC S9. 2573 01 N PIC S9. 2574 01 O PIC S9. 2575 01 P PIC S9. 2576 01 Q PIC S9. 2577 01 R PIC S9. 2578 01 S PIC S9. 2579 01 T PIC S9. 2580 01 U PIC S9. 2581 01 V PIC S9. 2582 PROCEDURE DIVISION. 2583 COMPUTE M ROUNDED MODE TRUNCATION 2584 = 2.49 2585 END-COMPUTE 2586 COMPUTE N ROUNDED MODE TRUNCATION 2587 = -2.49 2588 END-COMPUTE 2589 COMPUTE O ROUNDED MODE TRUNCATION 2590 = 2.50 2591 END-COMPUTE 2592 COMPUTE P ROUNDED MODE TRUNCATION 2593 = -2.50 2594 END-COMPUTE 2595 COMPUTE Q ROUNDED MODE TRUNCATION 2596 = 3.49 2597 END-COMPUTE 2598 COMPUTE R ROUNDED MODE TRUNCATION 2599 = -3.49 2600 END-COMPUTE 2601 COMPUTE S ROUNDED MODE TRUNCATION 2602 = 3.50 2603 END-COMPUTE 2604 COMPUTE T ROUNDED MODE TRUNCATION 2605 = -3.50 2606 END-COMPUTE 2607 COMPUTE U ROUNDED MODE TRUNCATION 2608 = 3.510 2609 END-COMPUTE 2610 COMPUTE V ROUNDED MODE TRUNCATION 2611 = -3.510 2612 END-COMPUTE 2613 DISPLAY M " " N " " O " " P " " Q " " R " " S " " T 2614 " " U " " V 2615 NO ADVANCING 2616 END-DISPLAY 2617 STOP RUN. 2618]) 2619 2620AT_CHECK([$COMPILE prog.cob], [0], [], []) 2621AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +2 -2 +3 -3 +3 -3 +3 -3]) 2622 2623AT_CLEANUP 2624 2625 2626AT_SETUP([Numeric operations (1)]) 2627AT_KEYWORDS([fundamental add subtract]) 2628 2629AT_DATA([prog.cob], [ 2630 IDENTIFICATION DIVISION. 2631 PROGRAM-ID. prog. 2632 DATA DIVISION. 2633 WORKING-STORAGE SECTION. 2634 01 X PIC S9V9. 2635 01 Y PIC S9V9 COMP-3. 2636 PROCEDURE DIVISION. 2637 MOVE -0.1 TO X. 2638 ADD 1 TO X. 2639 IF X NOT = 0.9 2640 DISPLAY X 2641 END-DISPLAY 2642 END-IF. 2643 MOVE 0.1 TO X. 2644 SUBTRACT 1 FROM X. 2645 IF X NOT = -0.9 2646 DISPLAY X 2647 END-DISPLAY 2648 END-IF. 2649 MOVE -0.1 TO Y. 2650 ADD 1 TO Y. 2651 IF Y NOT = 0.9 2652 DISPLAY Y 2653 END-DISPLAY 2654 END-IF. 2655 MOVE 0.1 TO Y. 2656 SUBTRACT 1 FROM Y. 2657 IF Y NOT = -0.9 2658 DISPLAY Y 2659 END-DISPLAY 2660 END-IF. 2661 STOP RUN. 2662]) 2663 2664AT_CHECK([$COMPILE prog.cob], [0], [], []) 2665AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 2666 2667AT_CLEANUP 2668 2669 2670AT_SETUP([Numeric operations (2)]) 2671AT_KEYWORDS([fundamental add subtract]) 2672 2673AT_DATA([prog.cob], [ 2674 IDENTIFICATION DIVISION. 2675 PROGRAM-ID. prog. 2676 DATA DIVISION. 2677 WORKING-STORAGE SECTION. 2678 01 FIELD PIC S9(1)V9(1). 2679 01 FELD2 PIC S9(5)V9(5). 2680 01 FELD3 PIC 9(1)V9(1). 2681 01 FELD4 PIC S9(1). 2682 PROCEDURE DIVISION. 2683 MOVE 0.2 TO FIELD 2684 ADD 1 TO FIELD 2685 IF FIELD NOT = 1.2 2686 DISPLAY "Test 1 " FIELD 2687 END-DISPLAY 2688 END-IF. 2689 2690 MOVE 0.2 TO FIELD 2691 ADD -1 TO FIELD 2692 IF FIELD NOT = -0.8 2693 DISPLAY "Test 2 " FIELD 2694 END-DISPLAY 2695 END-IF. 2696 2697 MOVE -0.2 TO FIELD 2698 ADD 1 TO FIELD 2699 IF FIELD NOT = 0.8 2700 DISPLAY "Test 3 " FIELD 2701 END-DISPLAY 2702 END-IF. 2703 2704 MOVE -0.2 TO FIELD 2705 ADD -1 TO FIELD 2706 IF FIELD NOT = -1.2 2707 DISPLAY "Test 4 " FIELD 2708 END-DISPLAY 2709 END-IF. 2710 2711 MOVE 0.2 TO FIELD 2712 SUBTRACT 1 FROM FIELD 2713 IF FIELD NOT = -0.8 2714 DISPLAY "Test 5 " FIELD 2715 END-DISPLAY 2716 END-IF. 2717 2718 MOVE 0.2 TO FIELD 2719 SUBTRACT -1 FROM FIELD 2720 IF FIELD NOT = 1.2 2721 DISPLAY "Test 6 " FIELD 2722 END-DISPLAY 2723 END-IF. 2724 2725 MOVE -0.2 TO FIELD 2726 SUBTRACT 1 FROM FIELD 2727 IF FIELD NOT = -1.2 2728 DISPLAY "Test 7 " FIELD 2729 END-DISPLAY 2730 END-IF. 2731 2732 MOVE -0.2 TO FIELD 2733 SUBTRACT -1 FROM FIELD 2734 IF FIELD NOT = 0.8 2735 DISPLAY "Test 8 " FIELD 2736 END-DISPLAY 2737 END-IF. 2738 2739 MOVE 0.2 TO FELD2 2740 ADD 1 TO FELD2 2741 IF FELD2 NOT = 1.2 2742 DISPLAY "Test 9 " FELD2 2743 END-DISPLAY 2744 END-IF. 2745 2746 MOVE 0.2 TO FELD2 2747 ADD -1 TO FELD2 2748 IF FELD2 NOT = -0.8 2749 DISPLAY "Test 10 " FELD2 2750 END-DISPLAY 2751 END-IF. 2752 2753 MOVE -0.2 TO FELD2 2754 ADD 1 TO FELD2 2755 IF FELD2 NOT = 0.8 2756 DISPLAY "Test 11 " FELD2 2757 END-DISPLAY 2758 END-IF. 2759 2760 MOVE -0.2 TO FELD2 2761 ADD -1 TO FELD2 2762 IF FELD2 NOT = -1.2 2763 DISPLAY "Test 12 " FELD2 2764 END-DISPLAY 2765 END-IF. 2766 2767 MOVE 0.2 TO FELD2 2768 SUBTRACT 1 FROM FELD2 2769 IF FELD2 NOT = -0.8 2770 DISPLAY "Test 13 " FELD2 2771 END-DISPLAY 2772 END-IF. 2773 2774 MOVE 0.2 TO FELD2 2775 SUBTRACT -1 FROM FELD2 2776 IF FELD2 NOT = 1.2 2777 DISPLAY "Test 14 " FELD2 2778 END-DISPLAY 2779 END-IF. 2780 2781 MOVE -0.2 TO FELD2 2782 SUBTRACT 1 FROM FELD2 2783 IF FELD2 NOT = -1.2 2784 DISPLAY "Test 15 " FELD2 2785 END-DISPLAY 2786 END-IF. 2787 2788 MOVE -0.2 TO FELD2 2789 SUBTRACT -1 FROM FELD2 2790 IF FELD2 NOT = 0.8 2791 DISPLAY "Test 16 " FELD2 2792 END-DISPLAY 2793 END-IF. 2794 2795 MOVE 0.2 TO FELD3 2796 ADD 1 TO FELD3 2797 IF FELD3 NOT = 1.2 2798 DISPLAY "Test 17 " FELD3 2799 END-DISPLAY 2800 END-IF. 2801 2802 MOVE 0.2 TO FELD3 2803 ADD -1 TO FELD3 2804 IF FELD3 NOT = 0.8 2805 DISPLAY "Test 18 " FELD3 2806 END-DISPLAY 2807 END-IF. 2808 2809 MOVE -0.2 TO FELD3 2810 ADD 1 TO FELD3 2811 IF FELD3 NOT = 1.2 2812 DISPLAY "Test 19 " FELD3 2813 END-DISPLAY 2814 END-IF. 2815 2816 MOVE -0.2 TO FELD3 2817 ADD -1 TO FELD3 2818 IF FELD3 NOT = 0.8 2819 DISPLAY "Test 20 " FELD3 2820 END-DISPLAY 2821 END-IF. 2822 2823 MOVE 0.2 TO FELD3 2824 SUBTRACT 1 FROM FELD3 2825 IF FELD3 NOT = 0.8 2826 DISPLAY "Test 21 " FELD3 2827 END-DISPLAY 2828 END-IF. 2829 2830 MOVE 0.2 TO FELD3 2831 SUBTRACT -1 FROM FELD3 2832 IF FELD3 NOT = 1.2 2833 DISPLAY "Test 22 " FELD3 2834 END-DISPLAY 2835 END-IF. 2836 2837 MOVE -0.2 TO FELD3 2838 SUBTRACT 1 FROM FELD3 2839 IF FELD3 NOT = 0.8 2840 DISPLAY "Test 23 " FELD3 2841 END-DISPLAY 2842 END-IF. 2843 2844 MOVE -0.2 TO FELD3 2845 SUBTRACT -1 FROM FELD3 2846 IF FELD3 NOT = 1.2 2847 DISPLAY "Test 24 " FELD3 2848 END-DISPLAY 2849 END-IF. 2850 2851 MOVE 2 TO FELD4 2852 ADD 1 TO FELD4 2853 IF FELD4 NOT = 3 2854 DISPLAY "Test 25 " FELD4 2855 END-DISPLAY 2856 END-IF. 2857 2858 MOVE 2 TO FELD4 2859 ADD -1 TO FELD4 2860 IF FELD4 NOT = 1 2861 DISPLAY "Test 26 " FELD4 2862 END-DISPLAY 2863 END-IF. 2864 2865 MOVE -2 TO FELD4 2866 ADD 1 TO FELD4 2867 IF FELD4 NOT = -1 2868 DISPLAY "Test 27 " FELD4 2869 END-DISPLAY 2870 END-IF. 2871 2872 MOVE -2 TO FELD4 2873 ADD -1 TO FELD4 2874 IF FELD4 NOT = -3 2875 DISPLAY "Test 28 " FELD4 2876 END-DISPLAY 2877 END-IF. 2878 2879 MOVE 2 TO FELD4 2880 SUBTRACT 1 FROM FELD4 2881 IF FELD4 NOT = 1 2882 DISPLAY "Test 29 " FELD4 2883 END-DISPLAY 2884 END-IF. 2885 2886 MOVE 2 TO FELD4 2887 SUBTRACT -1 FROM FELD4 2888 IF FELD4 NOT = 3 2889 DISPLAY "Test 30 " FELD4 2890 END-DISPLAY 2891 END-IF. 2892 2893 MOVE -2 TO FELD4 2894 SUBTRACT 1 FROM FELD4 2895 IF FELD4 NOT = -3 2896 DISPLAY "Test 31 " FELD4 2897 END-DISPLAY 2898 END-IF. 2899 2900 MOVE -2 TO FELD4 2901 SUBTRACT -1 FROM FELD4 2902 IF FELD4 NOT = -1 2903 DISPLAY "Test 32 " FELD4 2904 END-DISPLAY 2905 END-IF. 2906 2907 MOVE 1 TO FELD4 2908 ADD 2 TO FELD4 2909 IF FELD4 NOT = 3 2910 DISPLAY "Test 33 " FELD4 2911 END-DISPLAY 2912 END-IF. 2913 2914 MOVE 1 TO FELD4 2915 ADD -2 TO FELD4 2916 IF FELD4 NOT = -1 2917 DISPLAY "Test 34 " FELD4 2918 END-DISPLAY 2919 END-IF. 2920 2921 MOVE -1 TO FELD4 2922 ADD 2 TO FELD4 2923 IF FELD4 NOT = 1 2924 DISPLAY "Test 35 " FELD4 2925 END-DISPLAY 2926 END-IF. 2927 2928 MOVE -1 TO FELD4 2929 ADD -2 TO FELD4 2930 IF FELD4 NOT = -3 2931 DISPLAY "Test 36 " FELD4 2932 END-DISPLAY 2933 END-IF. 2934 2935 MOVE 1 TO FELD4 2936 SUBTRACT 2 FROM FELD4 2937 IF FELD4 NOT = -1 2938 DISPLAY "Test 37 " FELD4 2939 END-DISPLAY 2940 END-IF. 2941 2942 MOVE 1 TO FELD4 2943 SUBTRACT -2 FROM FELD4 2944 IF FELD4 NOT = 3 2945 DISPLAY "Test 38 " FELD4 2946 END-DISPLAY 2947 END-IF. 2948 2949 MOVE -1 TO FELD4 2950 SUBTRACT 2 FROM FELD4 2951 IF FELD4 NOT = -3 2952 DISPLAY "Test 39 " FELD4 2953 END-DISPLAY 2954 END-IF. 2955 2956 MOVE -1 TO FELD4 2957 SUBTRACT -2 FROM FELD4 2958 IF FELD4 NOT = 1 2959 DISPLAY "Test 40 " FELD4 2960 END-DISPLAY 2961 END-IF. 2962 GOBACK. 2963]) 2964 2965AT_CHECK([$COMPILE prog.cob], [0], [], 2966[prog.cob:137: warning: ignoring sign 2967prog.cob:144: warning: ignoring sign 2968prog.cob:165: warning: ignoring sign 2969prog.cob:172: warning: ignoring sign 2970]) 2971AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 2972 2973AT_CLEANUP 2974 2975 2976AT_SETUP([Numeric operations (3)]) 2977AT_KEYWORDS([fundamental add subtract]) 2978 2979AT_DATA([prog.cob], [ 2980 IDENTIFICATION DIVISION. 2981 PROGRAM-ID. prog. 2982 DATA DIVISION. 2983 WORKING-STORAGE SECTION. 2984 01 FIELD PIC S9(1)V9(1) COMP-3. 2985 01 FELD2 PIC S9(5)V9(5) COMP-3. 2986 01 FELD3 PIC 9(1)V9(1) COMP-3. 2987 01 FELD4 PIC S9(1) COMP-3. 2988 PROCEDURE DIVISION. 2989 MOVE 0.2 TO FIELD 2990 ADD 1 TO FIELD 2991 IF FIELD NOT = 1.2 2992 DISPLAY "Test 1 " FIELD 2993 END-DISPLAY 2994 END-IF. 2995 2996 MOVE 0.2 TO FIELD 2997 ADD -1 TO FIELD 2998 IF FIELD NOT = -0.8 2999 DISPLAY "Test 2 " FIELD 3000 END-DISPLAY 3001 END-IF. 3002 3003 MOVE -0.2 TO FIELD 3004 ADD 1 TO FIELD 3005 IF FIELD NOT = 0.8 3006 DISPLAY "Test 3 " FIELD 3007 END-DISPLAY 3008 END-IF. 3009 3010 MOVE -0.2 TO FIELD 3011 ADD -1 TO FIELD 3012 IF FIELD NOT = -1.2 3013 DISPLAY "Test 4 " FIELD 3014 END-DISPLAY 3015 END-IF. 3016 3017 MOVE 0.2 TO FIELD 3018 SUBTRACT 1 FROM FIELD 3019 IF FIELD NOT = -0.8 3020 DISPLAY "Test 5 " FIELD 3021 END-DISPLAY 3022 END-IF. 3023 3024 MOVE 0.2 TO FIELD 3025 SUBTRACT -1 FROM FIELD 3026 IF FIELD NOT = 1.2 3027 DISPLAY "Test 6 " FIELD 3028 END-DISPLAY 3029 END-IF. 3030 3031 MOVE -0.2 TO FIELD 3032 SUBTRACT 1 FROM FIELD 3033 IF FIELD NOT = -1.2 3034 DISPLAY "Test 7 " FIELD 3035 END-DISPLAY 3036 END-IF. 3037 3038 MOVE -0.2 TO FIELD 3039 SUBTRACT -1 FROM FIELD 3040 IF FIELD NOT = 0.8 3041 DISPLAY "Test 8 " FIELD 3042 END-DISPLAY 3043 END-IF. 3044 3045 MOVE 0.2 TO FELD2 3046 ADD 1 TO FELD2 3047 IF FELD2 NOT = 1.2 3048 DISPLAY "Test 9 " FELD2 3049 END-DISPLAY 3050 END-IF. 3051 3052 MOVE 0.2 TO FELD2 3053 ADD -1 TO FELD2 3054 IF FELD2 NOT = -0.8 3055 DISPLAY "Test 10 " FELD2 3056 END-DISPLAY 3057 END-IF. 3058 3059 MOVE -0.2 TO FELD2 3060 ADD 1 TO FELD2 3061 IF FELD2 NOT = 0.8 3062 DISPLAY "Test 11 " FELD2 3063 END-DISPLAY 3064 END-IF. 3065 3066 MOVE -0.2 TO FELD2 3067 ADD -1 TO FELD2 3068 IF FELD2 NOT = -1.2 3069 DISPLAY "Test 12 " FELD2 3070 END-DISPLAY 3071 END-IF. 3072 3073 MOVE 0.2 TO FELD2 3074 SUBTRACT 1 FROM FELD2 3075 IF FELD2 NOT = -0.8 3076 DISPLAY "Test 13 " FELD2 3077 END-DISPLAY 3078 END-IF. 3079 3080 MOVE 0.2 TO FELD2 3081 SUBTRACT -1 FROM FELD2 3082 IF FELD2 NOT = 1.2 3083 DISPLAY "Test 14 " FELD2 3084 END-DISPLAY 3085 END-IF. 3086 3087 MOVE -0.2 TO FELD2 3088 SUBTRACT 1 FROM FELD2 3089 IF FELD2 NOT = -1.2 3090 DISPLAY "Test 15 " FELD2 3091 END-DISPLAY 3092 END-IF. 3093 3094 MOVE -0.2 TO FELD2 3095 SUBTRACT -1 FROM FELD2 3096 IF FELD2 NOT = 0.8 3097 DISPLAY "Test 16 " FELD2 3098 END-DISPLAY 3099 END-IF. 3100 3101 MOVE 0.2 TO FELD3 3102 ADD 1 TO FELD3 3103 IF FELD3 NOT = 1.2 3104 DISPLAY "Test 17 " FELD3 3105 END-DISPLAY 3106 END-IF. 3107 3108 MOVE 0.2 TO FELD3 3109 ADD -1 TO FELD3 3110 IF FELD3 NOT = 0.8 3111 DISPLAY "Test 18 " FELD3 3112 END-DISPLAY 3113 END-IF. 3114 3115 MOVE -0.2 TO FELD3 3116 ADD 1 TO FELD3 3117 IF FELD3 NOT = 1.2 3118 DISPLAY "Test 19 " FELD3 3119 END-DISPLAY 3120 END-IF. 3121 3122 MOVE -0.2 TO FELD3 3123 ADD -1 TO FELD3 3124 IF FELD3 NOT = 0.8 3125 DISPLAY "Test 20 " FELD3 3126 END-DISPLAY 3127 END-IF. 3128 3129 MOVE 0.2 TO FELD3 3130 SUBTRACT 1 FROM FELD3 3131 IF FELD3 NOT = 0.8 3132 DISPLAY "Test 21 " FELD3 3133 END-DISPLAY 3134 END-IF. 3135 3136 MOVE 0.2 TO FELD3 3137 SUBTRACT -1 FROM FELD3 3138 IF FELD3 NOT = 1.2 3139 DISPLAY "Test 22 " FELD3 3140 END-DISPLAY 3141 END-IF. 3142 3143 MOVE -0.2 TO FELD3 3144 SUBTRACT 1 FROM FELD3 3145 IF FELD3 NOT = 0.8 3146 DISPLAY "Test 23 " FELD3 3147 END-DISPLAY 3148 END-IF. 3149 3150 MOVE -0.2 TO FELD3 3151 SUBTRACT -1 FROM FELD3 3152 IF FELD3 NOT = 1.2 3153 DISPLAY "Test 24 " FELD3 3154 END-DISPLAY 3155 END-IF. 3156 3157 MOVE 2 TO FELD4 3158 ADD 1 TO FELD4 3159 IF FELD4 NOT = 3 3160 DISPLAY "Test 25 " FELD4 3161 END-DISPLAY 3162 END-IF. 3163 3164 MOVE 2 TO FELD4 3165 ADD -1 TO FELD4 3166 IF FELD4 NOT = 1 3167 DISPLAY "Test 26 " FELD4 3168 END-DISPLAY 3169 END-IF. 3170 3171 MOVE -2 TO FELD4 3172 ADD 1 TO FELD4 3173 IF FELD4 NOT = -1 3174 DISPLAY "Test 27 " FELD4 3175 END-DISPLAY 3176 END-IF. 3177 3178 MOVE -2 TO FELD4 3179 ADD -1 TO FELD4 3180 IF FELD4 NOT = -3 3181 DISPLAY "Test 28 " FELD4 3182 END-DISPLAY 3183 END-IF. 3184 3185 MOVE 2 TO FELD4 3186 SUBTRACT 1 FROM FELD4 3187 IF FELD4 NOT = 1 3188 DISPLAY "Test 29 " FELD4 3189 END-DISPLAY 3190 END-IF. 3191 3192 MOVE 2 TO FELD4 3193 SUBTRACT -1 FROM FELD4 3194 IF FELD4 NOT = 3 3195 DISPLAY "Test 30 " FELD4 3196 END-DISPLAY 3197 END-IF. 3198 3199 MOVE -2 TO FELD4 3200 SUBTRACT 1 FROM FELD4 3201 IF FELD4 NOT = -3 3202 DISPLAY "Test 31 " FELD4 3203 END-DISPLAY 3204 END-IF. 3205 3206 MOVE -2 TO FELD4 3207 SUBTRACT -1 FROM FELD4 3208 IF FELD4 NOT = -1 3209 DISPLAY "Test 32 " FELD4 3210 END-DISPLAY 3211 END-IF. 3212 3213 MOVE 1 TO FELD4 3214 ADD 2 TO FELD4 3215 IF FELD4 NOT = 3 3216 DISPLAY "Test 33 " FELD4 3217 END-DISPLAY 3218 END-IF. 3219 3220 MOVE 1 TO FELD4 3221 ADD -2 TO FELD4 3222 IF FELD4 NOT = -1 3223 DISPLAY "Test 34 " FELD4 3224 END-DISPLAY 3225 END-IF. 3226 3227 MOVE -1 TO FELD4 3228 ADD 2 TO FELD4 3229 IF FELD4 NOT = 1 3230 DISPLAY "Test 35 " FELD4 3231 END-DISPLAY 3232 END-IF. 3233 3234 MOVE -1 TO FELD4 3235 ADD -2 TO FELD4 3236 IF FELD4 NOT = -3 3237 DISPLAY "Test 36 " FELD4 3238 END-DISPLAY 3239 END-IF. 3240 3241 MOVE 1 TO FELD4 3242 SUBTRACT 2 FROM FELD4 3243 IF FELD4 NOT = -1 3244 DISPLAY "Test 37 " FELD4 3245 END-DISPLAY 3246 END-IF. 3247 3248 MOVE 1 TO FELD4 3249 SUBTRACT -2 FROM FELD4 3250 IF FELD4 NOT = 3 3251 DISPLAY "Test 38 " FELD4 3252 END-DISPLAY 3253 END-IF. 3254 3255 MOVE -1 TO FELD4 3256 SUBTRACT 2 FROM FELD4 3257 IF FELD4 NOT = -3 3258 DISPLAY "Test 39 " FELD4 3259 END-DISPLAY 3260 END-IF. 3261 3262 MOVE -1 TO FELD4 3263 SUBTRACT -2 FROM FELD4 3264 IF FELD4 NOT = 1 3265 DISPLAY "Test 40 " FELD4 3266 END-DISPLAY 3267 END-IF. 3268 GOBACK. 3269]) 3270 3271AT_CHECK([$COMPILE prog.cob], [0], [], 3272[prog.cob:137: warning: ignoring sign 3273prog.cob:144: warning: ignoring sign 3274prog.cob:165: warning: ignoring sign 3275prog.cob:172: warning: ignoring sign 3276]) 3277AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 3278 3279AT_CLEANUP 3280 3281 3282AT_SETUP([Numeric operations (4)]) 3283AT_KEYWORDS([fundamental add subtract]) 3284 3285AT_DATA([prog.cob], [ 3286 IDENTIFICATION DIVISION. 3287 PROGRAM-ID. prog. 3288 DATA DIVISION. 3289 WORKING-STORAGE SECTION. 3290 01 FIELD PIC S9(1)V9(1) COMP. 3291 01 FELD2 PIC S9(5)V9(5) COMP. 3292 01 FELD3 PIC 9(1)V9(1) COMP. 3293 01 FELD4 PIC S9(1) COMP. 3294 PROCEDURE DIVISION. 3295 MOVE 0.2 TO FIELD 3296 ADD 1 TO FIELD 3297 IF FIELD NOT = 1.2 3298 DISPLAY "Test 1 " FIELD 3299 END-DISPLAY 3300 END-IF. 3301 3302 MOVE 0.2 TO FIELD 3303 ADD -1 TO FIELD 3304 IF FIELD NOT = -0.8 3305 DISPLAY "Test 2 " FIELD 3306 END-DISPLAY 3307 END-IF. 3308 3309 MOVE -0.2 TO FIELD 3310 ADD 1 TO FIELD 3311 IF FIELD NOT = 0.8 3312 DISPLAY "Test 3 " FIELD 3313 END-DISPLAY 3314 END-IF. 3315 3316 MOVE -0.2 TO FIELD 3317 ADD -1 TO FIELD 3318 IF FIELD NOT = -1.2 3319 DISPLAY "Test 4 " FIELD 3320 END-DISPLAY 3321 END-IF. 3322 3323 MOVE 0.2 TO FIELD 3324 SUBTRACT 1 FROM FIELD 3325 IF FIELD NOT = -0.8 3326 DISPLAY "Test 5 " FIELD 3327 END-DISPLAY 3328 END-IF. 3329 3330 MOVE 0.2 TO FIELD 3331 SUBTRACT -1 FROM FIELD 3332 IF FIELD NOT = 1.2 3333 DISPLAY "Test 6 " FIELD 3334 END-DISPLAY 3335 END-IF. 3336 3337 MOVE -0.2 TO FIELD 3338 SUBTRACT 1 FROM FIELD 3339 IF FIELD NOT = -1.2 3340 DISPLAY "Test 7 " FIELD 3341 END-DISPLAY 3342 END-IF. 3343 3344 MOVE -0.2 TO FIELD 3345 SUBTRACT -1 FROM FIELD 3346 IF FIELD NOT = 0.8 3347 DISPLAY "Test 8 " FIELD 3348 END-DISPLAY 3349 END-IF. 3350 3351 MOVE 0.2 TO FELD2 3352 ADD 1 TO FELD2 3353 IF FELD2 NOT = 1.2 3354 DISPLAY "Test 9 " FELD2 3355 END-DISPLAY 3356 END-IF. 3357 3358 MOVE 0.2 TO FELD2 3359 ADD -1 TO FELD2 3360 IF FELD2 NOT = -0.8 3361 DISPLAY "Test 10 " FELD2 3362 END-DISPLAY 3363 END-IF. 3364 3365 MOVE -0.2 TO FELD2 3366 ADD 1 TO FELD2 3367 IF FELD2 NOT = 0.8 3368 DISPLAY "Test 11 " FELD2 3369 END-DISPLAY 3370 END-IF. 3371 3372 MOVE -0.2 TO FELD2 3373 ADD -1 TO FELD2 3374 IF FELD2 NOT = -1.2 3375 DISPLAY "Test 12 " FELD2 3376 END-DISPLAY 3377 END-IF. 3378 3379 MOVE 0.2 TO FELD2 3380 SUBTRACT 1 FROM FELD2 3381 IF FELD2 NOT = -0.8 3382 DISPLAY "Test 13 " FELD2 3383 END-DISPLAY 3384 END-IF. 3385 3386 MOVE 0.2 TO FELD2 3387 SUBTRACT -1 FROM FELD2 3388 IF FELD2 NOT = 1.2 3389 DISPLAY "Test 14 " FELD2 3390 END-DISPLAY 3391 END-IF. 3392 3393 MOVE -0.2 TO FELD2 3394 SUBTRACT 1 FROM FELD2 3395 IF FELD2 NOT = -1.2 3396 DISPLAY "Test 15 " FELD2 3397 END-DISPLAY 3398 END-IF. 3399 3400 MOVE -0.2 TO FELD2 3401 SUBTRACT -1 FROM FELD2 3402 IF FELD2 NOT = 0.8 3403 DISPLAY "Test 16 " FELD2 3404 END-DISPLAY 3405 END-IF. 3406 3407 MOVE 0.2 TO FELD3 3408 ADD 1 TO FELD3 3409 IF FELD3 NOT = 1.2 3410 DISPLAY "Test 17 " FELD3 3411 END-DISPLAY 3412 END-IF. 3413 3414 MOVE 0.2 TO FELD3 3415 ADD -1 TO FELD3 3416 IF FELD3 NOT = 0.8 3417 DISPLAY "Test 18 " FELD3 3418 END-DISPLAY 3419 END-IF. 3420 3421 MOVE -0.2 TO FELD3 3422 ADD 1 TO FELD3 3423 IF FELD3 NOT = 1.2 3424 DISPLAY "Test 19 " FELD3 3425 END-DISPLAY 3426 END-IF. 3427 3428 MOVE -0.2 TO FELD3 3429 ADD -1 TO FELD3 3430 IF FELD3 NOT = 0.8 3431 DISPLAY "Test 20 " FELD3 3432 END-DISPLAY 3433 END-IF. 3434 3435 MOVE 0.2 TO FELD3 3436 SUBTRACT 1 FROM FELD3 3437 IF FELD3 NOT = 0.8 3438 DISPLAY "Test 21 " FELD3 3439 END-DISPLAY 3440 END-IF. 3441 3442 MOVE 0.2 TO FELD3 3443 SUBTRACT -1 FROM FELD3 3444 IF FELD3 NOT = 1.2 3445 DISPLAY "Test 22 " FELD3 3446 END-DISPLAY 3447 END-IF. 3448 3449 MOVE -0.2 TO FELD3 3450 SUBTRACT 1 FROM FELD3 3451 IF FELD3 NOT = 0.8 3452 DISPLAY "Test 23 " FELD3 3453 END-DISPLAY 3454 END-IF. 3455 3456 MOVE -0.2 TO FELD3 3457 SUBTRACT -1 FROM FELD3 3458 IF FELD3 NOT = 1.2 3459 DISPLAY "Test 24 " FELD3 3460 END-DISPLAY 3461 END-IF. 3462 3463 MOVE 2 TO FELD4 3464 ADD 1 TO FELD4 3465 IF FELD4 NOT = 3 3466 DISPLAY "Test 25 " FELD4 3467 END-DISPLAY 3468 END-IF. 3469 3470 MOVE 2 TO FELD4 3471 ADD -1 TO FELD4 3472 IF FELD4 NOT = 1 3473 DISPLAY "Test 26 " FELD4 3474 END-DISPLAY 3475 END-IF. 3476 3477 MOVE -2 TO FELD4 3478 ADD 1 TO FELD4 3479 IF FELD4 NOT = -1 3480 DISPLAY "Test 27 " FELD4 3481 END-DISPLAY 3482 END-IF. 3483 3484 MOVE -2 TO FELD4 3485 ADD -1 TO FELD4 3486 IF FELD4 NOT = -3 3487 DISPLAY "Test 28 " FELD4 3488 END-DISPLAY 3489 END-IF. 3490 3491 MOVE 2 TO FELD4 3492 SUBTRACT 1 FROM FELD4 3493 IF FELD4 NOT = 1 3494 DISPLAY "Test 29 " FELD4 3495 END-DISPLAY 3496 END-IF. 3497 3498 MOVE 2 TO FELD4 3499 SUBTRACT -1 FROM FELD4 3500 IF FELD4 NOT = 3 3501 DISPLAY "Test 30 " FELD4 3502 END-DISPLAY 3503 END-IF. 3504 3505 MOVE -2 TO FELD4 3506 SUBTRACT 1 FROM FELD4 3507 IF FELD4 NOT = -3 3508 DISPLAY "Test 31 " FELD4 3509 END-DISPLAY 3510 END-IF. 3511 3512 MOVE -2 TO FELD4 3513 SUBTRACT -1 FROM FELD4 3514 IF FELD4 NOT = -1 3515 DISPLAY "Test 32 " FELD4 3516 END-DISPLAY 3517 END-IF. 3518 3519 MOVE 1 TO FELD4 3520 ADD 2 TO FELD4 3521 IF FELD4 NOT = 3 3522 DISPLAY "Test 33 " FELD4 3523 END-DISPLAY 3524 END-IF. 3525 3526 MOVE 1 TO FELD4 3527 ADD -2 TO FELD4 3528 IF FELD4 NOT = -1 3529 DISPLAY "Test 34 " FELD4 3530 END-DISPLAY 3531 END-IF. 3532 3533 MOVE -1 TO FELD4 3534 ADD 2 TO FELD4 3535 IF FELD4 NOT = 1 3536 DISPLAY "Test 35 " FELD4 3537 END-DISPLAY 3538 END-IF. 3539 3540 MOVE -1 TO FELD4 3541 ADD -2 TO FELD4 3542 IF FELD4 NOT = -3 3543 DISPLAY "Test 36 " FELD4 3544 END-DISPLAY 3545 END-IF. 3546 3547 MOVE 1 TO FELD4 3548 SUBTRACT 2 FROM FELD4 3549 IF FELD4 NOT = -1 3550 DISPLAY "Test 37 " FELD4 3551 END-DISPLAY 3552 END-IF. 3553 3554 MOVE 1 TO FELD4 3555 SUBTRACT -2 FROM FELD4 3556 IF FELD4 NOT = 3 3557 DISPLAY "Test 38 " FELD4 3558 END-DISPLAY 3559 END-IF. 3560 3561 MOVE -1 TO FELD4 3562 SUBTRACT 2 FROM FELD4 3563 IF FELD4 NOT = -3 3564 DISPLAY "Test 39 " FELD4 3565 END-DISPLAY 3566 END-IF. 3567 3568 MOVE -1 TO FELD4 3569 SUBTRACT -2 FROM FELD4 3570 IF FELD4 NOT = 1 3571 DISPLAY "Test 40 " FELD4 3572 END-DISPLAY 3573 END-IF. 3574 GOBACK. 3575]) 3576 3577AT_CHECK([$COMPILE prog.cob], [0], [], 3578[prog.cob:137: warning: ignoring sign 3579prog.cob:144: warning: ignoring sign 3580prog.cob:165: warning: ignoring sign 3581prog.cob:172: warning: ignoring sign 3582]) 3583AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 3584 3585AT_CLEANUP 3586 3587 3588AT_SETUP([Numeric operations (5)]) 3589AT_KEYWORDS([fundamental add subtract]) 3590 3591AT_DATA([prog.cob], [ 3592 IDENTIFICATION DIVISION. 3593 PROGRAM-ID. prog. 3594 DATA DIVISION. 3595 WORKING-STORAGE SECTION. 3596 01 FIELD PIC S9(1)V9(1) COMP-5. 3597 01 FELD2 PIC S9(5)V9(5) COMP-5. 3598 01 FELD3 PIC 9(1)V9(1) COMP-5. 3599 01 FELD4 PIC S9(1) COMP-5. 3600 PROCEDURE DIVISION. 3601 MOVE 0.2 TO FIELD 3602 ADD 1 TO FIELD 3603 IF FIELD NOT = 1.2 3604 DISPLAY "Test 1 " FIELD 3605 END-DISPLAY 3606 END-IF. 3607 3608 MOVE 0.2 TO FIELD 3609 ADD -1 TO FIELD 3610 IF FIELD NOT = -0.8 3611 DISPLAY "Test 2 " FIELD 3612 END-DISPLAY 3613 END-IF. 3614 3615 MOVE -0.2 TO FIELD 3616 ADD 1 TO FIELD 3617 IF FIELD NOT = 0.8 3618 DISPLAY "Test 3 " FIELD 3619 END-DISPLAY 3620 END-IF. 3621 3622 MOVE -0.2 TO FIELD 3623 ADD -1 TO FIELD 3624 IF FIELD NOT = -1.2 3625 DISPLAY "Test 4 " FIELD 3626 END-DISPLAY 3627 END-IF. 3628 3629 MOVE 0.2 TO FIELD 3630 SUBTRACT 1 FROM FIELD 3631 IF FIELD NOT = -0.8 3632 DISPLAY "Test 5 " FIELD 3633 END-DISPLAY 3634 END-IF. 3635 3636 MOVE 0.2 TO FIELD 3637 SUBTRACT -1 FROM FIELD 3638 IF FIELD NOT = 1.2 3639 DISPLAY "Test 6 " FIELD 3640 END-DISPLAY 3641 END-IF. 3642 3643 MOVE -0.2 TO FIELD 3644 SUBTRACT 1 FROM FIELD 3645 IF FIELD NOT = -1.2 3646 DISPLAY "Test 7 " FIELD 3647 END-DISPLAY 3648 END-IF. 3649 3650 MOVE -0.2 TO FIELD 3651 SUBTRACT -1 FROM FIELD 3652 IF FIELD NOT = 0.8 3653 DISPLAY "Test 8 " FIELD 3654 END-DISPLAY 3655 END-IF. 3656 3657 MOVE 0.2 TO FELD2 3658 ADD 1 TO FELD2 3659 IF FELD2 NOT = 1.2 3660 DISPLAY "Test 9 " FELD2 3661 END-DISPLAY 3662 END-IF. 3663 3664 MOVE 0.2 TO FELD2 3665 ADD -1 TO FELD2 3666 IF FELD2 NOT = -0.8 3667 DISPLAY "Test 10 " FELD2 3668 END-DISPLAY 3669 END-IF. 3670 3671 MOVE -0.2 TO FELD2 3672 ADD 1 TO FELD2 3673 IF FELD2 NOT = 0.8 3674 DISPLAY "Test 11 " FELD2 3675 END-DISPLAY 3676 END-IF. 3677 3678 MOVE -0.2 TO FELD2 3679 ADD -1 TO FELD2 3680 IF FELD2 NOT = -1.2 3681 DISPLAY "Test 12 " FELD2 3682 END-DISPLAY 3683 END-IF. 3684 3685 MOVE 0.2 TO FELD2 3686 SUBTRACT 1 FROM FELD2 3687 IF FELD2 NOT = -0.8 3688 DISPLAY "Test 13 " FELD2 3689 END-DISPLAY 3690 END-IF. 3691 3692 MOVE 0.2 TO FELD2 3693 SUBTRACT -1 FROM FELD2 3694 IF FELD2 NOT = 1.2 3695 DISPLAY "Test 14 " FELD2 3696 END-DISPLAY 3697 END-IF. 3698 3699 MOVE -0.2 TO FELD2 3700 SUBTRACT 1 FROM FELD2 3701 IF FELD2 NOT = -1.2 3702 DISPLAY "Test 15 " FELD2 3703 END-DISPLAY 3704 END-IF. 3705 3706 MOVE -0.2 TO FELD2 3707 SUBTRACT -1 FROM FELD2 3708 IF FELD2 NOT = 0.8 3709 DISPLAY "Test 16 " FELD2 3710 END-DISPLAY 3711 END-IF. 3712 3713 MOVE 0.2 TO FELD3 3714 ADD 1 TO FELD3 3715 IF FELD3 NOT = 1.2 3716 DISPLAY "Test 17 " FELD3 3717 END-DISPLAY 3718 END-IF. 3719 3720 MOVE 0.2 TO FELD3 3721 ADD -1 TO FELD3 3722 IF FELD3 NOT = 0.8 3723 DISPLAY "Test 18 " FELD3 3724 END-DISPLAY 3725 END-IF. 3726 3727 MOVE -0.2 TO FELD3 3728 ADD 1 TO FELD3 3729 IF FELD3 NOT = 1.2 3730 DISPLAY "Test 19 " FELD3 3731 END-DISPLAY 3732 END-IF. 3733 3734 MOVE -0.2 TO FELD3 3735 ADD -1 TO FELD3 3736 IF FELD3 NOT = 0.8 3737 DISPLAY "Test 20 " FELD3 3738 END-DISPLAY 3739 END-IF. 3740 3741 MOVE 0.2 TO FELD3 3742 SUBTRACT 1 FROM FELD3 3743 IF FELD3 NOT = 0.8 3744 DISPLAY "Test 21 " FELD3 3745 END-DISPLAY 3746 END-IF. 3747 3748 MOVE 0.2 TO FELD3 3749 SUBTRACT -1 FROM FELD3 3750 IF FELD3 NOT = 1.2 3751 DISPLAY "Test 22 " FELD3 3752 END-DISPLAY 3753 END-IF. 3754 3755 MOVE -0.2 TO FELD3 3756 SUBTRACT 1 FROM FELD3 3757 IF FELD3 NOT = 0.8 3758 DISPLAY "Test 23 " FELD3 3759 END-DISPLAY 3760 END-IF. 3761 3762 MOVE -0.2 TO FELD3 3763 SUBTRACT -1 FROM FELD3 3764 IF FELD3 NOT = 1.2 3765 DISPLAY "Test 24 " FELD3 3766 END-DISPLAY 3767 END-IF. 3768 3769 MOVE 2 TO FELD4 3770 ADD 1 TO FELD4 3771 IF FELD4 NOT = 3 3772 DISPLAY "Test 25 " FELD4 3773 END-DISPLAY 3774 END-IF. 3775 3776 MOVE 2 TO FELD4 3777 ADD -1 TO FELD4 3778 IF FELD4 NOT = 1 3779 DISPLAY "Test 26 " FELD4 3780 END-DISPLAY 3781 END-IF. 3782 3783 MOVE -2 TO FELD4 3784 ADD 1 TO FELD4 3785 IF FELD4 NOT = -1 3786 DISPLAY "Test 27 " FELD4 3787 END-DISPLAY 3788 END-IF. 3789 3790 MOVE -2 TO FELD4 3791 ADD -1 TO FELD4 3792 IF FELD4 NOT = -3 3793 DISPLAY "Test 28 " FELD4 3794 END-DISPLAY 3795 END-IF. 3796 3797 MOVE 2 TO FELD4 3798 SUBTRACT 1 FROM FELD4 3799 IF FELD4 NOT = 1 3800 DISPLAY "Test 29 " FELD4 3801 END-DISPLAY 3802 END-IF. 3803 3804 MOVE 2 TO FELD4 3805 SUBTRACT -1 FROM FELD4 3806 IF FELD4 NOT = 3 3807 DISPLAY "Test 30 " FELD4 3808 END-DISPLAY 3809 END-IF. 3810 3811 MOVE -2 TO FELD4 3812 SUBTRACT 1 FROM FELD4 3813 IF FELD4 NOT = -3 3814 DISPLAY "Test 31 " FELD4 3815 END-DISPLAY 3816 END-IF. 3817 3818 MOVE -2 TO FELD4 3819 SUBTRACT -1 FROM FELD4 3820 IF FELD4 NOT = -1 3821 DISPLAY "Test 32 " FELD4 3822 END-DISPLAY 3823 END-IF. 3824 3825 MOVE 1 TO FELD4 3826 ADD 2 TO FELD4 3827 IF FELD4 NOT = 3 3828 DISPLAY "Test 33 " FELD4 3829 END-DISPLAY 3830 END-IF. 3831 3832 MOVE 1 TO FELD4 3833 ADD -2 TO FELD4 3834 IF FELD4 NOT = -1 3835 DISPLAY "Test 34 " FELD4 3836 END-DISPLAY 3837 END-IF. 3838 3839 MOVE -1 TO FELD4 3840 ADD 2 TO FELD4 3841 IF FELD4 NOT = 1 3842 DISPLAY "Test 35 " FELD4 3843 END-DISPLAY 3844 END-IF. 3845 3846 MOVE -1 TO FELD4 3847 ADD -2 TO FELD4 3848 IF FELD4 NOT = -3 3849 DISPLAY "Test 36 " FELD4 3850 END-DISPLAY 3851 END-IF. 3852 3853 MOVE 1 TO FELD4 3854 SUBTRACT 2 FROM FELD4 3855 IF FELD4 NOT = -1 3856 DISPLAY "Test 37 " FELD4 3857 END-DISPLAY 3858 END-IF. 3859 3860 MOVE 1 TO FELD4 3861 SUBTRACT -2 FROM FELD4 3862 IF FELD4 NOT = 3 3863 DISPLAY "Test 38 " FELD4 3864 END-DISPLAY 3865 END-IF. 3866 3867 MOVE -1 TO FELD4 3868 SUBTRACT 2 FROM FELD4 3869 IF FELD4 NOT = -3 3870 DISPLAY "Test 39 " FELD4 3871 END-DISPLAY 3872 END-IF. 3873 3874 MOVE -1 TO FELD4 3875 SUBTRACT -2 FROM FELD4 3876 IF FELD4 NOT = 1 3877 DISPLAY "Test 40 " FELD4 3878 END-DISPLAY 3879 END-IF. 3880 GOBACK. 3881]) 3882 3883AT_CHECK([$COMPILE prog.cob], [0], [], 3884[prog.cob:137: warning: ignoring sign 3885prog.cob:144: warning: ignoring sign 3886prog.cob:165: warning: ignoring sign 3887prog.cob:172: warning: ignoring sign 3888]) 3889AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 3890 3891AT_CLEANUP 3892 3893 3894AT_SETUP([Numeric operations (6)]) 3895AT_KEYWORDS([fundamental add]) 3896 3897AT_DATA([dump.c], [ 3898#include <stdio.h> 3899#include <libcob.h> 3900 3901COB_EXT_EXPORT int 3902dump (char *p) 3903{ 3904 printf ("%c%c", p[[0]], p[[1]]); 3905 return 0; 3906} 3907]) 3908 3909AT_DATA([prog.cob], [ 3910 IDENTIFICATION DIVISION. 3911 PROGRAM-ID. prog. 3912 3913 DATA DIVISION. 3914 WORKING-STORAGE SECTION. 3915 3916 01 P-FIELD1 PIC 99PPP. 3917 01 P-FIELD2 PIC PPP99. 3918 3919 PROCEDURE DIVISION. 3920 3921 MOVE 5000 TO P-FIELD1. 3922 ADD 5 TO P-FIELD1 END-ADD 3923 IF P-FIELD1 NOT = 5000 3924 DISPLAY "Error: Add 5 to PIC 99PPP." 3925 END-DISPLAY 3926 END-IF 3927 CALL "dump" USING P-FIELD1 END-CALL 3928 3929 ADD 5000 TO P-FIELD1 END-ADD 3930 IF P-FIELD1 NOT = 10000 3931 DISPLAY "Error: Add 5000 to PIC 99PPP." 3932 END-DISPLAY 3933 END-IF 3934 CALL "dump" USING P-FIELD1 END-CALL 3935 3936 MOVE 0.00055 TO P-FIELD2. 3937 ADD 0.00033 TO P-FIELD2 END-ADD 3938 IF P-FIELD2 NOT = 0.00088 3939 DISPLAY "Error: Add 0.00033 to PIC PPP99." 3940 END-DISPLAY 3941 END-IF 3942 CALL "dump" USING P-FIELD2 END-CALL 3943 3944 MOVE 0.00055 TO P-FIELD2. 3945 ADD 0.00300 TO P-FIELD2 END-ADD 3946 IF P-FIELD2 NOT = 0.00055 3947 DISPLAY "Error: Add 0.00300 to PIC PPP99." 3948 END-DISPLAY 3949 END-IF 3950 CALL "dump" USING P-FIELD2 END-CALL 3951 3952 STOP RUN. 3953 3954]) 3955 3956AT_CHECK([$COMPILE_MODULE dump.c]) 3957AT_CHECK([$COMPILE prog.cob], [0], []) 3958AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [05108855], []) 3959 3960AT_CLEANUP 3961 3962 3963AT_SETUP([Numeric operations (7)]) 3964AT_KEYWORDS([fundamental add compute literal]) 3965 3966AT_DATA([prog.cob], [ 3967 IDENTIFICATION DIVISION. 3968 PROGRAM-ID. prog. 3969 DATA DIVISION. 3970 WORKING-STORAGE SECTION. 3971 01 FIELD PIC S9(4)V9(2) COMP-5. 3972 01 FIELD-DISP PIC S9(4)V9(2) DISPLAY. 3973 PROCEDURE DIVISION. 3974 MOVE 0.2 TO FIELD. 3975 ADD 1 3976 2 3977 3 3978 4 3979 5 3980 6 3981 7 3982 8 3983 9 3984 10 3985 11 3986 12 3987 13 3988 14 3989 15 3990 16 3991 17 3992 18 3993 19 3994 20 3995 21 3996 22 3997 23 3998 24 3999 25 4000 26 4001 27 4002 28 4003 29 4004 30 4005 31 4006 32 4007 33 4008 34 4009 35 4010 36 4011 37 4012 38 4013 39 4014 40 4015 41 4016 42 4017 43 4018 44 4019 45 4020 46 4021 47 4022 48 4023 49 4024 50 4025 51 4026 52 4027 53 4028 54 4029 55 4030 56 4031 57 4032 58 4033 59 4034 60 4035 61 4036 62 4037 63 4038 64 4039 65 4040 66 4041 67 4042 68 4043 69 4044 70 4045 71 4046 72 4047 73 4048 74 4049 75 4050 76 4051 77 4052 78 4053 79 4054 80 4055 81 4056 82 4057 83 4058 84 4059 85 4060 86 4061 87 4062 88 4063 89 4064 90 4065 91 4066 92 4067 93 4068 94 4069 95 4070 96 4071 97 4072 98 4073 99 4074 100 4075 101 4076 102 4077 103 4078 104 4079 105 4080 106 4081 107 4082 108 4083 109 4084 110 4085 111 4086 112 4087 113 4088 114 4089 115 4090 116 4091 117 4092 118 4093 119 4094 120 4095 121 4096 122 4097 123 4098 124 4099 125 4100 126 4101 127 4102 128 4103 129 4104 TO FIELD 4105 END-ADD. 4106 IF FIELD NOT = 8385.2 4107 MOVE FIELD TO FIELD-DISP 4108 DISPLAY 'ADD with wrong result: ' FIELD-DISP 4109 END-DISPLAY 4110 END-IF. 4111 COMPUTE FIELD = (0.2 4112 + 2 4113 + 3 4114 + 4 4115 + 5 4116 + 6 4117 + 7 4118 + 8 4119 + 9 4120 + 10 4121 + 11 4122 + 12 4123 + 13 4124 + 14 4125 + 15 4126 + 16 4127 + 17 4128 + 18 4129 + 19 4130 + 20 4131 + 21 4132 + 22 4133 + 23 4134 + 24 4135 + 25 4136 + 26 4137 + 27 4138 + 28 4139 + 29 4140 + 30 4141 + 31 4142 + 32 4143 + 33 4144 + 34 4145 + 35 4146 + 36 4147 + 37 4148 + 38 4149 + 39 4150 + 40 4151 + 41 4152 + 42 4153 + 43 4154 + 44 4155 + 45 4156 + 46 4157 + 47 4158 + 48 4159 + 49 4160 + 50 4161 + 51 4162 + 52 4163 + 53 4164 + 54 4165 + 55 4166 + 56 4167 + 57 4168 + 58 4169 - 59 4170 - 60 4171 - 61 4172 - 62 4173 - 63 4174 - 64 4175 - 65 4176 - 66 4177 - 67 4178 - 68 4179 - 69 4180 - 70 4181 - 71 4182 - 72 4183 - 73 4184 - 74 4185 - 75 4186 - 76 4187 - 77 4188 - 78 4189 - 79 4190 - 80 4191 - 81 4192 - 82 4193 - 83 4194 - 84 4195 - 85 4196 - 86 4197 - 87 4198 - 88 4199 - 89 4200 - 90 4201 - 91 4202 - 92 4203 - 93 4204 - 94 4205 - 95 4206 - 96 4207 - 97 4208 - 98 4209 - 99 4210 - 100 4211 - 101 4212 - 102 4213 - 103 4214 - 104 4215 - 105 4216 - 106 4217 - 107 4218 - 108 4219 - 109 4220 - 110 4221 - 111 4222 - 112 4223 - 113 4224 - 114 4225 - 115 4226 - 116 4227 - 117 4228 - 118 4229 - 119 4230 - 120 4231 - 121 4232 - 122 4233 - 123 4234 - 124 4235 - 125 4236 - 126 4237 - 127) 4238 * 12800000000 4239 / 12900000000 4240 END-COMPUTE. 4241 IF FIELD NOT = -4670.31 4242 MOVE FIELD TO FIELD-DISP 4243 DISPLAY 'COMPUTE with wrong result: ' FIELD-DISP 4244 END-DISPLAY 4245 END-IF. 4246 GOBACK. 4247]) 4248 4249AT_CHECK([$COMPILE prog.cob], [0], [], []) 4250AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4251 4252AT_CLEANUP 4253 4254 4255AT_SETUP([Numeric operations (8)]) 4256AT_KEYWORDS([fundamental compute literal]) 4257 4258AT_DATA([prog.cob], [ 4259 IDENTIFICATION DIVISION. 4260 PROGRAM-ID. prog. 4261 DATA DIVISION. 4262 WORKING-STORAGE SECTION. 4263 1 COMPUTE-DATA. 4264 2 COMPUTE-8 PICTURE 999 VALUE ZERO. 4265 PROCEDURE DIVISION. 4266 COMPUTE COMPUTE-8 = (((24.0 + 1) * (60 - 10)) / 125) ** 2 4267 IF COMPUTE-8 NOT = 100 4268 DISPLAY 'COMPUTE with wrong result: ' COMPUTE-8 4269 END-DISPLAY 4270 END-IF 4271 COMPUTE COMPUTE-8 = 55 / (1 - 2 + 1) 4272 NOT ON SIZE ERROR 4273 DISPLAY 'SIZE ERROR not set from divide by zero!' 4274 END-DISPLAY 4275 END-COMPUTE 4276 COMPUTE COMPUTE-8 = 0 ** 1 4277 IF COMPUTE-8 NOT = 0 4278 DISPLAY '0 ** 1 <> 0: ' COMPUTE-8 4279 END-DISPLAY 4280 END-IF 4281 COMPUTE COMPUTE-8 = 55 ** 0 4282 IF COMPUTE-8 NOT = 1 4283 DISPLAY '55 ** 0 <> 1: ' COMPUTE-8 4284 END-DISPLAY 4285 END-IF 4286 COMPUTE COMPUTE-8 = 1 ** 55 4287 IF COMPUTE-8 NOT = 1 4288 DISPLAY '11 ** 55 <> 1: ' COMPUTE-8 4289 END-DISPLAY 4290 END-IF 4291 4292 GOBACK. 4293]) 4294 4295AT_CHECK([$COMPILE prog.cob], [0], [], 4296[prog.cob:14: warning: divide by constant ZERO 4297]) 4298AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4299 4300AT_CLEANUP 4301 4302 4303# CORRESPONDING 4304 4305AT_SETUP([ADD CORRESPONDING]) 4306AT_KEYWORDS([fundamental corresponding]) 4307 4308AT_DATA([prog.cob], [ 4309 IDENTIFICATION DIVISION. 4310 PROGRAM-ID. prog. 4311 DATA DIVISION. 4312 WORKING-STORAGE SECTION. 4313 01 GROUP-1. 4314 05 FIELD-A PIC 9 VALUE 1. 4315 05 FIELD-B USAGE BINARY-CHAR VALUE 2. 4316 05 INNER-GROUP. 4317 10 FIELD-C USAGE FLOAT-SHORT VALUE 3. 4318 05 FIELD-D PIC X VALUE "A". 4319 01 GROUP-2. 4320 05 FIELD-A PIC 9. 4321 05 FIELD-B USAGE BINARY-LONG. 4322 05 INNER-GROUP. 4323 10 FIELD-C PIC 9. 4324 05 FIELD-D PIC 9. 4325 4326 PROCEDURE DIVISION. 4327 ADD CORRESPONDING GROUP-1 TO GROUP-2. 4328 IF FIELD-A IN GROUP-2 NOT EQUAL 1 THEN 4329 DISPLAY "BAD FIELD-A " FIELD-A IN GROUP-2 4330 END-DISPLAY 4331 END-IF. 4332 IF FIELD-B IN GROUP-2 NOT EQUAL 2 THEN 4333 DISPLAY "BAD FIELD-B " FIELD-B IN GROUP-2 4334 END-DISPLAY 4335 END-IF. 4336 IF FIELD-C IN GROUP-2 NOT EQUAL 3 THEN 4337 DISPLAY "BAD FIELD-C " FIELD-C IN GROUP-2 4338 END-DISPLAY 4339 END-IF. 4340 IF FIELD-D IN GROUP-2 NOT EQUAL 0 THEN 4341 DISPLAY "BAD FIELD-D " FIELD-D IN GROUP-2 4342 END-DISPLAY 4343 END-IF. 4344 STOP RUN. 4345]) 4346 4347AT_CHECK([$COMPILE prog.cob], [0], [], []) 4348AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4349 4350AT_CLEANUP 4351 4352 4353AT_SETUP([ADD CORRESPONDING no match]) 4354AT_KEYWORDS([fundamental corresponding]) 4355 4356AT_DATA([prog.cob], [ 4357 IDENTIFICATION DIVISION. 4358 PROGRAM-ID. prog. 4359 DATA DIVISION. 4360 WORKING-STORAGE SECTION. 4361 01 GROUP-1. 4362 05 FIELD-A PIC X. 4363 05 FIELD-B PIC Z9. 4364 05 INNER-GROUP. 4365 10 FIELD-C PIC X. 4366 05 FIELD-D PIC 9. 4367 01 GROUP-2. 4368 05 FIELD-A PIC 9 VALUE 1. 4369 05 FIELD-B USAGE BINARY-CHAR VALUE 2. 4370 05 INNER-GROUP. 4371 10 FIELD-C USAGE FLOAT-SHORT VALUE 3. 4372 05 FIELD-D PIC X VALUE "A". 4373 4374 PROCEDURE DIVISION. 4375 SUBTRACT CORRESPONDING GROUP-2 FROM GROUP-1. 4376 IF FIELD-A IN GROUP-2 NOT EQUAL 1 THEN 4377 DISPLAY "BAD FIELD-A " FIELD-A IN GROUP-2 4378 END-DISPLAY 4379 END-IF. 4380 IF FIELD-B IN GROUP-2 NOT EQUAL 2 THEN 4381 DISPLAY "BAD FIELD-B " FIELD-B IN GROUP-2 4382 END-DISPLAY 4383 END-IF. 4384 IF FIELD-C IN GROUP-2 NOT EQUAL 3 THEN 4385 DISPLAY "BAD FIELD-C " FIELD-C IN GROUP-2 4386 END-DISPLAY 4387 END-IF. 4388 IF FIELD-D IN GROUP-2 NOT EQUAL "A" THEN 4389 DISPLAY "BAD FIELD-D " FIELD-D IN GROUP-2 4390 END-DISPLAY 4391 END-IF. 4392 STOP RUN. 4393]) 4394 4395AT_CHECK([$COMPILE prog.cob], [0], [], 4396[prog.cob:20: warning: no CORRESPONDING items found 4397]) 4398AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4399 4400AT_CLEANUP 4401 4402 4403AT_SETUP([SYNC in OCCURS]) 4404AT_KEYWORDS([fundamental SYNCHRONIZE]) 4405 4406AT_DATA([prog.cob], [ 4407 IDENTIFICATION DIVISION. 4408 PROGRAM-ID. prog. 4409 4410 DATA DIVISION. 4411 WORKING-STORAGE SECTION. 4412 01 x. 4413 03 ptrs OCCURS 5 TIMES. 4414 05 misalign-1 PIC X. 4415 05 ptr POINTER, SYNC. 4416 05 ptr-num REDEFINES ptr, 4417 >>IF P64 SET 4418 USAGE BINARY-DOUBLE UNSIGNED. 4419 >>ELSE 4420 USAGE BINARY-LONG UNSIGNED. 4421 >>END-IF 4422 05 misalign-2 PIC X. 4423 4424 01 num BINARY-LONG. 4425 4426 PROCEDURE DIVISION. 4427 SET ptr (2) TO ADDRESS OF ptr (2) 4428 SET ptr (3) TO ADDRESS OF ptr (3) 4429 4430 SUBTRACT ptr-num (2) FROM ptr-num (3) GIVING num 4431 DISPLAY FUNCTION MOD (num, FUNCTION LENGTH (ptr (1))) 4432 . 4433]) 4434 4435AT_CHECK([$COMPILE prog.cob], [0], [], []) 4436AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 4437[000000000 4438]) 4439 4440AT_CLEANUP 4441 4442 4443AT_SETUP([88 level with THRU]) 4444AT_KEYWORDS([runmisc]) 4445 4446AT_DATA([prog.cob], [ 4447 IDENTIFICATION DIVISION. 4448 PROGRAM-ID. prog. 4449 DATA DIVISION. 4450 WORKING-STORAGE SECTION. 4451 01 VAR-X PIC X VALUE SPACE. 4452 88 X VALUE "X". 4453 88 T-Y VALUE "T" THRU "Y". 4454 01 VAR-9 PIC 9 VALUE ZERO. 4455 88 V9 VALUE 9. 4456 88 V2-4 VALUE 2 THRU 4. 4457 PROCEDURE DIVISION. 4458 IF X 4459 DISPLAY "NOT OK '" VAR-X "' IS X" 4460 END-DISPLAY 4461 END-IF 4462 SET X TO TRUE 4463 IF NOT X 4464 DISPLAY "NOT OK '" VAR-X "' IS NOT X" 4465 END-DISPLAY 4466 END-IF 4467 IF NOT T-Y 4468 DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" 4469 END-DISPLAY 4470 END-IF 4471 SET T-Y TO TRUE 4472 IF NOT T-Y 4473 DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" 4474 END-DISPLAY 4475 END-IF 4476 MOVE 'Y' TO VAR-X 4477 IF NOT T-Y 4478 DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" 4479 END-DISPLAY 4480 END-IF 4481 MOVE 'Z' TO VAR-X 4482 IF T-Y 4483 DISPLAY "NOT OK '" VAR-X "' IS T-Y" 4484 END-DISPLAY 4485 END-IF 4486 MOVE 'A' TO VAR-X 4487 IF T-Y 4488 DISPLAY "NOT OK '" VAR-X "' IS T-Y" 4489 END-DISPLAY 4490 END-IF 4491 IF V9 4492 DISPLAY "NOT OK '" VAR-9 "' IS V9" 4493 END-DISPLAY 4494 END-IF 4495 SET V9 TO TRUE 4496 IF NOT V9 4497 DISPLAY "NOT OK '" VAR-9 "' IS NOT V9" 4498 END-DISPLAY 4499 END-IF 4500 SET V2-4 TO TRUE 4501 IF V9 4502 DISPLAY "NOT OK '" VAR-9 "' IS V9" 4503 END-DISPLAY 4504 END-IF 4505 IF NOT V2-4 4506 DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" 4507 END-DISPLAY 4508 END-IF 4509 MOVE 3 TO VAR-9 4510 IF NOT V2-4 4511 DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" 4512 END-DISPLAY 4513 END-IF 4514 MOVE 4 TO VAR-9 4515 IF NOT V2-4 4516 DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" 4517 END-DISPLAY 4518 END-IF 4519 MOVE 5 TO VAR-9 4520 IF V2-4 4521 DISPLAY "NOT OK '" VAR-9 "' IS V2-4" 4522 END-DISPLAY 4523 END-IF 4524 MOVE 1 TO VAR-9 4525 IF V2-4 4526 DISPLAY "NOT OK '" VAR-9 "' IS V2-4" 4527 END-DISPLAY 4528 END-IF 4529 STOP RUN. 4530]) 4531 4532AT_CHECK([$COMPILE prog.cob], [0], [], []) 4533AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4534 4535AT_CLEANUP 4536 4537 4538AT_SETUP([88 level with FILLER]) 4539AT_KEYWORDS([runmisc]) 4540 4541AT_DATA([prog.cob], [ 4542 IDENTIFICATION DIVISION. 4543 PROGRAM-ID. prog. 4544 DATA DIVISION. 4545 WORKING-STORAGE SECTION. 4546 01 FILLER PIC X VALUE SPACE. 4547 88 X VALUE "X". 4548 PROCEDURE DIVISION. 4549 IF X 4550 DISPLAY "NOT OK" 4551 END-DISPLAY 4552 END-IF 4553 SET X TO TRUE. 4554 IF NOT X 4555 DISPLAY "NOT OK" 4556 END-DISPLAY 4557 END-IF 4558 STOP RUN. 4559]) 4560 4561AT_CHECK([$COMPILE prog.cob], [0], [], []) 4562AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4563 4564AT_CLEANUP 4565 4566 4567AT_SETUP([88 level with FALSE IS clause]) 4568AT_KEYWORDS([runmisc]) 4569 4570AT_DATA([prog.cob], [ 4571 IDENTIFICATION DIVISION. 4572 PROGRAM-ID. prog. 4573 DATA DIVISION. 4574 WORKING-STORAGE SECTION. 4575 01 MYFLD PIC X(6) VALUE "ABCDEF". 4576 88 MYFLD88 VALUE "ABCDEF" 4577 FALSE IS "OKOKOK". 4578 PROCEDURE DIVISION. 4579 ASTART SECTION. 4580 A01. 4581 SET MYFLD88 TO FALSE 4582 IF MYFLD NOT = "OKOKOK" 4583 DISPLAY MYFLD 4584 END-DISPLAY 4585 END-IF 4586 STOP RUN. 4587]) 4588 4589AT_CHECK([$COMPILE prog.cob], [0], [], []) 4590AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4591 4592AT_CLEANUP 4593 4594 4595AT_SETUP([BLANK WHEN ZERO]) 4596AT_KEYWORDS([fundamental]) 4597 4598AT_DATA([prog.cob], [ 4599 IDENTIFICATION DIVISION. 4600 PROGRAM-ID. prog. 4601 4602 DATA DIVISION. 4603 WORKING-STORAGE SECTION. 4604 01 x PIC 9, BLANK WHEN ZERO, VALUE 1. 4605 4606 PROCEDURE DIVISION. 4607 DISPLAY x 4608 MOVE 0 TO x 4609 DISPLAY FUNCTION TRIM(x) 4610 MOVE ZERO TO x 4611 DISPLAY FUNCTION TRIM(x) 4612 . 4613]) 4614 4615AT_CHECK([$COMPILE prog.cob], [0], [], []) 4616AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 4617[1 4618 4619 4620]) 4621 4622AT_CLEANUP 4623 4624 4625AT_SETUP([MULTIPLY BY literal in INITIAL program]) 4626AT_KEYWORDS([decimal constants fundamental]) 4627 4628AT_DATA([prog.cob], [ 4629 IDENTIFICATION DIVISION. 4630 PROGRAM-ID. prog INITIAL. 4631 DATA DIVISION. 4632 WORKING-STORAGE SECTION. 4633 01 num PIC 9(4) VALUE 5. 4634 01 result PIC 9(4). 4635 01 ws-temp PIC 9(8)V99. 4636 01 ws-temp2 PIC 9(3)V99 VALUE 10.50. 4637 PROCEDURE DIVISION. 4638 MULTIPLY num BY 4 GIVING result 4639 MOVE 1.10 TO WS-TEMP. 4640 MULTIPLY WS-TEMP2 BY WS-TEMP GIVING WS-TEMP. 4641]) 4642 4643AT_CHECK([$COMPILE prog.cob]) 4644AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 4645 4646AT_CLEANUP 4647 4648 4649AT_SETUP([debugging lines (not active)]) 4650AT_KEYWORDS([fundamental]) 4651 4652AT_DATA([prog.cob], [ 4653 IDENTIFICATION DIVISION. 4654 PROGRAM-ID. prog. 4655 DATA DIVISION. 4656 WORKING-STORAGE SECTION. 4657 PROCEDURE DIVISION. 4658 DISPLAY "OK" NO ADVANCING 4659 END-DISPLAY. 4660 D DISPLAY "KO" NO ADVANCING 4661 D END-DISPLAY. 4662 STOP RUN. 4663]) 4664 4665AT_CHECK([$COMPILE prog.cob], [0], [], []) 4666AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 4667[OK], []) 4668 4669AT_CLEANUP 4670 4671 4672AT_SETUP([debugging lines (-fdebugging-line)]) 4673AT_KEYWORDS([fundamental]) 4674 4675AT_DATA([prog.cob], [ 4676 IDENTIFICATION DIVISION. 4677 PROGRAM-ID. prog. 4678 DATA DIVISION. 4679 WORKING-STORAGE SECTION. 4680 PROCEDURE DIVISION. 4681 DISPLAY "OK" NO ADVANCING 4682 END-DISPLAY. 4683 D DISPLAY "KO" NO ADVANCING 4684 D END-DISPLAY. 4685 STOP RUN. 4686]) 4687 4688AT_CHECK([$COMPILE -fdebugging-line prog.cob], [0], [], []) 4689AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 4690[OKKO], []) 4691 4692AT_CLEANUP 4693 4694 4695AT_SETUP([debugging lines (WITH DEBUGGING MODE)]) 4696AT_KEYWORDS([fundamental extensions]) 4697 4698AT_DATA([prog.cob], [ 4699 IDENTIFICATION DIVISION. 4700 PROGRAM-ID. prog. 4701 ENVIRONMENT DIVISION. 4702 CONFIGURATION SECTION. 4703 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 4704 DATA DIVISION. 4705 WORKING-STORAGE SECTION. 4706 PROCEDURE DIVISION. 4707 D DISPLAY "KO" NO ADVANCING UPON STDOUT 4708 D END-DISPLAY. 4709 DISPLAY "OK" NO ADVANCING UPON STDOUT 4710 END-DISPLAY. 4711 STOP RUN. 4712]) 4713 4714AT_CHECK([$COMPILE prog.cob], [0], [], []) 4715AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 4716[KOOK], []) 4717 4718AT_CLEANUP 4719 4720 4721AT_SETUP([debugging lines, free format (not active)]) 4722AT_KEYWORDS([fundamental extensions]) 4723 4724AT_DATA([prog.cob], [ 4725 IDENTIFICATION DIVISION. 4726 PROGRAM-ID. prog. 4727 DATA DIVISION. 4728 WORKING-STORAGE SECTION. 4729 PROCEDURE DIVISION. 4730 DISPLAY "OK" NO ADVANCING 4731 END-DISPLAY. 4732 >>D DISPLAY "KO" NO ADVANCING 4733 >>D END-DISPLAY. 4734 STOP RUN. 4735]) 4736 4737AT_CHECK([$COMPILE -free prog.cob], [0], [], []) 4738AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 4739[OK], []) 4740 4741AT_CLEANUP 4742 4743 4744AT_SETUP([debugging lines, free format (-fdebugging-line)]) 4745AT_KEYWORDS([fundamental extensions]) 4746 4747AT_DATA([prog.cob], [ 4748 IDENTIFICATION DIVISION. 4749 PROGRAM-ID. prog. 4750 DATA DIVISION. 4751 WORKING-STORAGE SECTION. 4752 PROCEDURE DIVISION. 4753 DISPLAY "OK" NO ADVANCING 4754 END-DISPLAY. 4755 >>D DISPLAY "KO" NO ADVANCING 4756 >>D END-DISPLAY. 4757 STOP RUN. 4758]) 4759 4760AT_CHECK([$COMPILE -free -fdebugging-line prog.cob], [0], [], []) 4761AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 4762[OKKO], []) 4763 4764AT_CLEANUP 4765 4766 4767AT_SETUP([USE FOR DEBUGGING (no DEBUGGING MODE)]) 4768AT_KEYWORDS([fundamental]) 4769 4770AT_DATA([prog.cob], [ 4771 IDENTIFICATION DIVISION. 4772 PROGRAM-ID. prog. 4773 ENVIRONMENT DIVISION. 4774 CONFIGURATION SECTION. 4775 SOURCE-COMPUTER. 4776 DATA DIVISION. 4777 WORKING-STORAGE SECTION. 4778 PROCEDURE DIVISION. 4779 DECLARATIVES. 4780 TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. 4781 DISPLAY DEBUG-ITEM END-DISPLAY. 4782 END DECLARATIVES. 4783 FIRST-PAR. 4784 DISPLAY "OK1" END-DISPLAY. 4785 GO TO SECOND-PAR. 4786 SECOND-PAR. 4787 DISPLAY "OK2" END-DISPLAY. 4788 THIRD-PAR. 4789 DISPLAY "OK3" END-DISPLAY. 4790 PERFORM FIRST-PAR THRU SECOND-PAR. 4791 DISPLAY "OK4" END-DISPLAY. 4792 PERFORM SECOND-PAR. 4793 DISPLAY "OK5" END-DISPLAY. 4794 STOP RUN. 4795]) 4796 4797AT_CHECK([$COMPILE prog.cob], [0], [], []) 4798AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 4799[OK1 4800OK2 4801OK3 4802OK1 4803OK2 4804OK4 4805OK2 4806OK5 4807], []) 4808 4809AT_CLEANUP 4810 4811 4812AT_SETUP([USE FOR DEBUGGING (COB_SET_DEBUG deactivated)]) 4813AT_KEYWORDS([fundamental]) 4814 4815AT_DATA([prog.cob], [ 4816 IDENTIFICATION DIVISION. 4817 PROGRAM-ID. prog. 4818 ENVIRONMENT DIVISION. 4819 CONFIGURATION SECTION. 4820 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 4821 DATA DIVISION. 4822 WORKING-STORAGE SECTION. 4823 PROCEDURE DIVISION. 4824 DECLARATIVES. 4825 TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. 4826 DISPLAY DEBUG-ITEM END-DISPLAY. 4827 END DECLARATIVES. 4828 FIRST-PAR. 4829 DISPLAY "OK1" END-DISPLAY. 4830 GO TO SECOND-PAR. 4831 SECOND-PAR. 4832 DISPLAY "OK2" END-DISPLAY. 4833 THIRD-PAR. 4834 DISPLAY "OK3" END-DISPLAY. 4835 PERFORM FIRST-PAR THRU SECOND-PAR. 4836 DISPLAY "OK4" END-DISPLAY. 4837 PERFORM SECOND-PAR. 4838 DISPLAY "OK5" END-DISPLAY. 4839 STOP RUN. 4840]) 4841 4842AT_CHECK([$COMPILE prog.cob], [0], [], []) 4843AT_CHECK([COB_SET_DEBUG=0 $COBCRUN_DIRECT ./prog], [0], 4844[OK1 4845OK2 4846OK3 4847OK1 4848OK2 4849OK4 4850OK2 4851OK5 4852], []) 4853 4854AT_CLEANUP 4855 4856 4857AT_SETUP([USE FOR DEBUGGING ON ALL PROCEDURES]) 4858AT_KEYWORDS([fundamental]) 4859 4860AT_DATA([prog.cob], [ 4861 IDENTIFICATION DIVISION. 4862 PROGRAM-ID. prog. 4863 ENVIRONMENT DIVISION. 4864 CONFIGURATION SECTION. 4865 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 4866 DATA DIVISION. 4867 WORKING-STORAGE SECTION. 4868 PROCEDURE DIVISION. 4869 DECLARATIVES. 4870 TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. 4871 DISPLAY DEBUG-ITEM "|" END-DISPLAY. 4872 END DECLARATIVES. 4873 FIRST-PAR. 4874 DISPLAY "OK1" END-DISPLAY. 4875 GO TO SECOND-PAR. 4876 SECOND-PAR. 4877 DISPLAY "OK2" END-DISPLAY. 4878 THIRD-PAR. 4879 DISPLAY "OK3" END-DISPLAY. 4880 PERFORM FIRST-PAR THRU SECOND-PAR. 4881 DISPLAY "OK4" END-DISPLAY. 4882 PERFORM SECOND-PAR. 4883 DISPLAY "OK5" END-DISPLAY. 4884 STOP RUN. 4885]) 4886 4887AT_CHECK([$COMPILE prog.cob], [0], [], []) 4888AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 4889[ FIRST-PAR START PROGRAM | 4890OK1 4891 16 SECOND-PAR | 4892OK2 4893 18 THIRD-PAR FALL THROUGH | 4894OK3 4895 21 FIRST-PAR PERFORM LOOP | 4896OK1 4897 16 SECOND-PAR | 4898OK2 4899OK4 4900 23 SECOND-PAR PERFORM LOOP | 4901OK2 4902OK5 4903], []) 4904 4905AT_CLEANUP 4906 4907 4908AT_SETUP([USE FOR DEBUGGING ON procedure]) 4909AT_KEYWORDS([fundamental]) 4910 4911AT_DATA([prog.cob], [ 4912 IDENTIFICATION DIVISION. 4913 PROGRAM-ID. prog. 4914 ENVIRONMENT DIVISION. 4915 CONFIGURATION SECTION. 4916 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 4917 DATA DIVISION. 4918 WORKING-STORAGE SECTION. 4919 PROCEDURE DIVISION. 4920 DECLARATIVES. 4921 TEST-DEBUG SECTION. USE FOR DEBUGGING ON SECOND-PAR. 4922 DISPLAY DEBUG-ITEM "|" END-DISPLAY. 4923 END DECLARATIVES. 4924 FIRST-PAR. 4925 DISPLAY "OK1" END-DISPLAY. 4926 GO TO SECOND-PAR. 4927 SECOND-PAR. 4928 DISPLAY "OK2" END-DISPLAY. 4929 THIRD-PAR. 4930 DISPLAY "OK3" END-DISPLAY. 4931 PERFORM FIRST-PAR THRU SECOND-PAR. 4932 DISPLAY "OK4" END-DISPLAY. 4933 PERFORM SECOND-PAR. 4934 DISPLAY "OK5" END-DISPLAY. 4935 STOP RUN. 4936]) 4937 4938AT_CHECK([$COMPILE prog.cob], [0], [], []) 4939AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 4940[OK1 4941 16 SECOND-PAR | 4942OK2 4943OK3 4944OK1 4945 16 SECOND-PAR | 4946OK2 4947OK4 4948 23 SECOND-PAR PERFORM LOOP | 4949OK2 4950OK5 4951], []) 4952 4953AT_CLEANUP 4954 4955 4956AT_SETUP([USE FOR DEBUGGING (COB_SET_DEBUG switched)]) 4957AT_KEYWORDS([fundamental]) 4958 4959AT_DATA([prog.cob], [ 4960 IDENTIFICATION DIVISION. 4961 PROGRAM-ID. prog. 4962 ENVIRONMENT DIVISION. 4963 CONFIGURATION SECTION. 4964 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 4965 DATA DIVISION. 4966 WORKING-STORAGE SECTION. 4967 PROCEDURE DIVISION. 4968 DECLARATIVES. 4969 TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. 4970 DISPLAY DEBUG-ITEM "|" END-DISPLAY. 4971 END DECLARATIVES. 4972 FIRST-PAR. 4973 SET ENVIRONMENT "COB_SET_DEBUG" TO "false" 4974 DISPLAY "OK1" END-DISPLAY. 4975 GO TO SECOND-PAR. 4976 SECOND-PAR. 4977 DISPLAY "OK2" END-DISPLAY. 4978 THIRD-PAR. 4979 DISPLAY "OK3" END-DISPLAY. 4980 PERFORM FIRST-PAR THRU SECOND-PAR. 4981 DISPLAY "OK4" END-DISPLAY. 4982 SET ENVIRONMENT "COB_SET_DEBUG" TO "Y" 4983 PERFORM SECOND-PAR. 4984 DISPLAY "OK5" END-DISPLAY. 4985 STOP RUN. 4986]) 4987 4988AT_CHECK([$COMPILE prog.cob], [0], [], []) 4989AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 4990[ FIRST-PAR START PROGRAM | 4991OK1 4992OK2 4993OK3 4994OK1 4995OK2 4996OK4 4997 25 SECOND-PAR PERFORM LOOP | 4998OK2 4999OK5 5000], []) 5001 5002AT_CLEANUP 5003 5004 5005AT_SETUP([USE FOR DEBUGGING ON [[ALL]] REFERENCES OF field]) 5006AT_KEYWORDS([fundamental]) 5007 5008AT_DATA([prog.cob], [ 5009 IDENTIFICATION DIVISION. 5010 PROGRAM-ID. prog. 5011 ENVIRONMENT DIVISION. 5012 CONFIGURATION SECTION. 5013 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 5014 DATA DIVISION. 5015 WORKING-STORAGE SECTION. 5016 01 MY-DATA-FIELDS. 5017 02 MY-DATA-FIELD-1 PIC 9 VALUE 1. 5018 02 MY-DATA-FIELD-2 PIC 9 VALUE 4. 5019 01 MY-DATA-FIELD-B PIC X(40) VALUE "ABCD". 5020 PROCEDURE DIVISION. 5021 DECLARATIVES. 5022 TEST-DEBUG SECTION. 5023 USE FOR DEBUGGING ON ALL REFERENCES OF MY-DATA-FIELD-1 5024 ALL MY-DATA-FIELD-2 5025 MY-DATA-FIELD-B. 5026 DISPLAY DEBUG-ITEM "|" END-DISPLAY. 5027 END DECLARATIVES. 5028 INIT-PAR. 5029 MOVE 6 TO MY-DATA-FIELD-2. 5030 FIRST-PAR. 5031 PERFORM VARYING MY-DATA-FIELD-1 FROM 1 BY 1 5032 UNTIL MY-DATA-FIELD-1 > MY-DATA-FIELD-2 5033 *> empty by design 5034 END-PERFORM. 5035 END-PAR. 5036 MOVE "99" TO MY-DATA-FIELD-B. 5037 MOVE MY-DATA-FIELD-B TO MY-DATA-FIELDS. 5038 STOP RUN. 5039]) 5040 5041AT_CHECK([$COMPILE -fmissing-statement=ok prog.cob], [0], [], []) 5042# TODO: validate against other compilers, especially the line 30; 5043# likely the second line should be 25 instead of 24: 5044AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 5045[ 22 MY-DATA-FIELD-2 6 | 5046 24 MY-DATA-FIELD-1 1 | 5047 24 MY-DATA-FIELD-1 1 | 5048 24 MY-DATA-FIELD-2 6 | 5049 24 MY-DATA-FIELD-1 2 | 5050 24 MY-DATA-FIELD-1 2 | 5051 24 MY-DATA-FIELD-2 6 | 5052 24 MY-DATA-FIELD-1 3 | 5053 24 MY-DATA-FIELD-1 3 | 5054 24 MY-DATA-FIELD-2 6 | 5055 24 MY-DATA-FIELD-1 4 | 5056 24 MY-DATA-FIELD-1 4 | 5057 24 MY-DATA-FIELD-2 6 | 5058 24 MY-DATA-FIELD-1 5 | 5059 24 MY-DATA-FIELD-1 5 | 5060 24 MY-DATA-FIELD-2 6 | 5061 24 MY-DATA-FIELD-1 6 | 5062 24 MY-DATA-FIELD-1 6 | 5063 24 MY-DATA-FIELD-2 6 | 5064 24 MY-DATA-FIELD-1 7 | 5065 24 MY-DATA-FIELD-1 7 | 5066 24 MY-DATA-FIELD-2 6 | 5067 29 MY-DATA-FIELD-B 99 | 5068], []) 5069 5070AT_CLEANUP 5071 5072 5073AT_SETUP([USE FOR DEBUGGING, reference within DEBUGGING]) 5074AT_KEYWORDS([fundamental]) 5075 5076AT_DATA([prog.cob], [ 5077 IDENTIFICATION DIVISION. 5078 PROGRAM-ID. prog. 5079 ENVIRONMENT DIVISION. 5080 CONFIGURATION SECTION. 5081 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 5082 DATA DIVISION. 5083 WORKING-STORAGE SECTION. 5084 01 DATA-FIELD PIC X(40) VALUE "ABCD". 5085 PROCEDURE DIVISION. 5086 DECLARATIVES. 5087 TEST-DEBUG SECTION. 5088 USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. 5089 DISPLAY DEBUG-ITEM "|". 5090 MOVE "ABCD" TO DATA-FIELD. 5091 DISPLAY DEBUG-ITEM "|". 5092 END DECLARATIVES. 5093 SOME-PAR. 5094 MOVE QUOTE TO DATA-FIELD. 5095 IF DATA-FIELD = QUOTE DISPLAY "NO DEBUG" STOP RUN. 5096 DISPLAY "DEBUG". 5097 STOP RUN. 5098]) 5099AT_CHECK([$COMPILE -Wno-terminator prog.cob], [0], [], []) 5100AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 5101[ 19 DATA-FIELD """"""""""""""""""""""""""""""""""""""""| 5102 19 DATA-FIELD """"""""""""""""""""""""""""""""""""""""| 5103 20 DATA-FIELD ABCD | 5104 20 DATA-FIELD ABCD | 5105DEBUG 5106], []) 5107AT_CHECK([$COBCRUN_DIRECT ./prog], [0], 5108[NO DEBUG 5109], []) 5110 5111AT_CLEANUP 5112 5113 5114AT_SETUP([USE FOR DEBUGGING, time of execution]) 5115AT_KEYWORDS([fundamental DEBUGGING]) 5116 5117# FIXME: the debugging procedure is executed after the statement, 5118# which is generally fine, but not for "nested" statements 5119# where DEBUG-ITEM contains wrong data and the 5120# debugging procedure is called too late 5121AT_XFAIL_IF(true) 5122 5123AT_DATA([prog.cob], [ 5124 IDENTIFICATION DIVISION. 5125 PROGRAM-ID. prog. 5126 ENVIRONMENT DIVISION. 5127 CONFIGURATION SECTION. 5128 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 5129 DATA DIVISION. 5130 WORKING-STORAGE SECTION. 5131 01 DATA-FIELD PIC X(40) VALUE "ABCD". 5132 PROCEDURE DIVISION. 5133 DECLARATIVES. 5134 TEST-DEBUG SECTION. 5135 USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. 5136 DISPLAY DEBUG-ITEM "|". 5137 MOVE "ABCD" TO DATA-FIELD. 5138 END DECLARATIVES. 5139 SOME-PAR. 5140 MOVE QUOTE TO DATA-FIELD. 5141 IF DATA-FIELD = QUOTE 5142 DISPLAY "NO DEBUG" 5143 ELSE 5144 DISPLAY "DEBUG" 5145 MOVE SPACES TO DATA-FIELD 5146 CALL "NOTHERE" USING DATA-FIELD 5147 ON OVERFLOW 5148 DISPLAY "THIS IS FINE". 5149 STOP RUN. 5150]) 5151AT_CHECK([$COMPILE -w prog.cob], [0], [], []) 5152AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 5153[ 18 DATA-FIELD """"""""""""""""""""""""""""""""""""""""| 5154 19 DATA-FIELD ABCD | 5155DEBUG 5156 23 DATA-FIELD | 5157 24 DATA-FIELD ABCD | 5158THIS IS FINE 5159], []) 5160 5161AT_CLEANUP 5162 5163 5164AT_SETUP([USE FOR DEBUGGING, reference with OCCURS]) 5165AT_KEYWORDS([fundamental DEBUGGING]) 5166 5167AT_DATA([prog.cob], [ 5168 IDENTIFICATION DIVISION. 5169 PROGRAM-ID. prog. 5170 ENVIRONMENT DIVISION. 5171 CONFIGURATION SECTION. 5172 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 5173 DATA DIVISION. 5174 WORKING-STORAGE SECTION. 5175 01 FILLER. 5176 02 FILLER OCCURS 10. 5177 03 FILLER OCCURS 5. 5178 04 DATA-FIELD PIC X(40) VALUE "ABCD" OCCURS 2. 5179 PROCEDURE DIVISION. 5180 DECLARATIVES. 5181 TEST-DEBUG SECTION. 5182 USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. 5183 DISPLAY DEBUG-ITEM "|" END-DISPLAY. 5184 END DECLARATIVES. 5185 SOME-PAR. 5186 MOVE QUOTE TO DATA-FIELD (4, 2, 1). 5187 STOP RUN. 5188]) 5189AT_CHECK([$COMPILE prog.cob], [0], [], []) 5190AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 5191[ 20 DATA-FIELD +0004 +0002 +0001 """"""""""""""""""""""""""""""""""""""""| 5192], []) 5193 5194AT_CLEANUP 5195 5196 5197AT_SETUP([USE FOR DEBUGGING, referencing BASED item]) 5198AT_KEYWORDS([fundamental DEBUGGING FREE ALLOCATE]) 5199 5200# uncommon issue but shouldn't SIGSEGV --> TODO: fix later 5201# TODO: also check "ADDRESS OF" (non)-ALLOCATED field 5202AT_XFAIL_IF(true) 5203 5204AT_DATA([prog.cob], [ 5205 IDENTIFICATION DIVISION. 5206 PROGRAM-ID. prog. 5207 ENVIRONMENT DIVISION. 5208 CONFIGURATION SECTION. 5209 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 5210 DATA DIVISION. 5211 WORKING-STORAGE SECTION. 5212 01 DATA-FIELD PIC X(40) VALUE "ABCD" BASED. 5213 PROCEDURE DIVISION. 5214 DECLARATIVES. 5215 TEST-DEBUG SECTION. 5216 USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. 5217 DISPLAY DEBUG-ITEM "|" END-DISPLAY. 5218 END DECLARATIVES. 5219 SOME-PAR. 5220 ALLOCATE DATA-FIELD INITIALIZED. 5221 FREE DATA-FIELD. 5222 STOP RUN. 5223]) 5224AT_CHECK([$COMPILE prog.cob], [0], [], []) 5225# not sure about the output, check MF, claiming to support BASED + DEBUGGING 5226AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 5227[ 17 DATA-FIELD ABCD | 5228 18 DATA-FIELD ABCD | 5229], []) 5230 5231AT_CLEANUP 5232 5233 5234AT_SETUP([USE FOR DEBUGGING file]) 5235AT_KEYWORDS([fundamental OPEN WRITE READ CLOSE]) 5236 5237AT_DATA([prog.cob], [ 5238 IDENTIFICATION DIVISION. 5239 PROGRAM-ID. prog. 5240 ENVIRONMENT DIVISION. 5241 CONFIGURATION SECTION. 5242 SOURCE-COMPUTER. mine WITH DEBUGGING MODE. 5243 INPUT-OUTPUT SECTION. 5244 FILE-CONTROL. 5245 SELECT TEST-FILE ASSIGN "./TEST-FILE". 5246 DATA DIVISION. 5247 FILE SECTION. 5248 FD TEST-FILE. 5249 01 TEST-REC PIC X(40). 5250 PROCEDURE DIVISION. 5251 DECLARATIVES. 5252 TEST-DEBUG SECTION. 5253 USE FOR DEBUGGING ON TEST-FILE. 5254 DISPLAY DEBUG-ITEM "|" END-DISPLAY. 5255 END DECLARATIVES. 5256 SOME-PAR. 5257 OPEN OUTPUT TEST-FILE. 5258 WRITE TEST-REC FROM "DEF". 5259 CLOSE TEST-FILE. 5260 OPEN INPUT TEST-FILE. 5261 READ TEST-FILE. 5262 CLOSE TEST-FILE. 5263 STOP RUN. 5264]) 5265AT_CHECK([$COMPILE prog.cob], [0], [], []) 5266AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], 5267[ 21 TEST-FILE | 5268 23 TEST-FILE | 5269 24 TEST-FILE | 5270 25 TEST-FILE DEF | 5271 26 TEST-FILE | 5272], []) 5273 5274AT_CLEANUP 5275 5276 5277AT_SETUP([Abbreviated Expressions]) 5278AT_KEYWORDS([expression conditional]) 5279 5280AT_DATA([prog.cob], [ 5281 IDENTIFICATION DIVISION. 5282 PROGRAM-ID. prog. 5283 ENVIRONMENT DIVISION. 5284 CONFIGURATION SECTION. 5285 SPECIAL-NAMES. 5286 SWITCH-1 5287 IS WRK-SWITCH-1 5288 ON STATUS IS ON-WRK-SWITCH-1 5289 OFF STATUS IS OFF-WRK-SWITCH-1 5290 SWITCH-2 5291 IS WRK-SWITCH-2 5292 OFF STATUS IS OFF-WRK-SWITCH-2. 5293 DATA DIVISION. 5294 ****************************************************************** 5295 WORKING-STORAGE SECTION. 5296 * 5297 01 FLD9-0 PIC 9 VALUE 0. 5298 01 FLD9-1 PIC 9 VALUE 1. 5299 01 FLD9-2 PIC 9 VALUE 2. 5300 01 FLD9-5 PIC 9 VALUE 5. 5301 01 FLD9-7 PIC 9 VALUE 7. 5302 01 FLD9-9 PIC 9 VALUE 9. 5303 01 FLDX PIC X VALUE 'X'. 5304 01 FLDY PIC X VALUE 'Y'. 5305 01 FLDYY PIC X VALUE 'Y'. 5306 01 FLDZ PIC X VALUE 'Z'. 5307 01 TESTNUM PIC 99 VALUE 1. 5308 5309 PROCEDURE DIVISION. 5310 MAIN-LINE. 5311 5312 IF FLD9-7 > FLD9-5 AND NOT < FLD9-0 OR FLD9-1 5313 PERFORM PASS ELSE PERFORM FAIL. 5314 IF FLD9-7 NOT = FLD9-5 OR FLD9-1 5315 PERFORM PASS ELSE PERFORM FAIL. 5316 IF FLD9-7 NOT = FLD9-5 AND FLD9-1 5317 PERFORM PASS ELSE PERFORM FAIL. 5318 IF NOT FLD9-7 = FLD9-5 OR FLD9-1 5319 PERFORM PASS ELSE PERFORM FAIL. 5320 IF NOT (FLD9-5 > FLD9-7 OR < FLD9-1) 5321 PERFORM PASS ELSE PERFORM FAIL. 5322 IF NOT (FLD9-7 NOT > FLD9-5 AND FLD9-2 AND NOT FLD9-1) 5323 PERFORM PASS ELSE PERFORM FAIL. 5324 IF FLD9-9 > FLD9-2 AND FLD9-7 AND FLD9-5 5325 PERFORM PASS ELSE PERFORM FAIL. 5326 IF FLD9-9 > FLD9-2 AND FLD9-7 OR FLD9-5 5327 PERFORM PASS ELSE PERFORM FAIL. 5328 IF FLD9-1 < FLD9-2 AND FLD9-5 AND FLD9-7 5329 PERFORM PASS ELSE PERFORM FAIL. 5330 5331 * // DISPLAY "***Constant expressions***". 5332 IF 9 > 2 AND 7 AND 5 AND 1 5333 PERFORM PASS ELSE PERFORM FAIL. 5334 IF 1 < 2 AND 5 AND 7 AND 9 5335 PERFORM PASS ELSE PERFORM FAIL. 5336 IF 5 < 2 OR 1 OR 9 OR 7 5337 PERFORM PASS ELSE PERFORM FAIL. 5338 IF 5 > 1 AND < 3 OR 6 5339 PERFORM PASS ELSE PERFORM FAIL. 5340 5341 * // DISPLAY "***Switch expressions***". 5342 IF ON-WRK-SWITCH-1 5343 OR NOT OFF-WRK-SWITCH-2 5344 AND OFF-WRK-SWITCH-1 5345 PERFORM FAIL ELSE PERFORM PASS. 5346 DISPLAY "***FINE***" WITH NO ADVANCING. 5347 STOP RUN. 5348 5349 PASS. 5350 * // DISPLAY 'Test ' TESTNUM ' passed' 5351 ADD 1 TO TESTNUM. 5352 5353 FAIL. 5354 DISPLAY 'Test ' TESTNUM ' failed!' 5355 ADD 1 TO TESTNUM. 5356]) 5357 5358AT_CHECK([$COMPILE prog.cob], [0], [], 5359[prog.cob: in paragraph 'MAIN-LINE': 5360prog.cob:47: warning: suggest parentheses around AND within OR 5361prog.cob:53: warning: expression '9' GREATER THAN '2' is always TRUE 5362prog.cob:53: warning: expression '9' GREATER THAN '7' is always TRUE 5363prog.cob:53: warning: expression '9' GREATER THAN '5' is always TRUE 5364prog.cob:53: warning: expression '9' GREATER THAN '1' is always TRUE 5365prog.cob:55: warning: expression '1' LESS THAN '2' is always TRUE 5366prog.cob:55: warning: expression '1' LESS THAN '5' is always TRUE 5367prog.cob:55: warning: expression '1' LESS THAN '7' is always TRUE 5368prog.cob:55: warning: expression '1' LESS THAN '9' is always TRUE 5369prog.cob:57: warning: expression '5' LESS THAN '2' is always FALSE 5370prog.cob:57: warning: expression '5' LESS THAN '1' is always FALSE 5371prog.cob:57: warning: expression '5' LESS THAN '9' is always TRUE 5372prog.cob:57: warning: expression '5' LESS THAN '7' is always TRUE 5373prog.cob:59: warning: expression '5' GREATER THAN '1' is always TRUE 5374prog.cob:59: warning: expression '5' LESS THAN '3' is always FALSE 5375prog.cob:59: warning: expression '5' LESS THAN '6' is always TRUE 5376]) 5377 5378AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [***FINE***], []) 5379 5380AT_CLEANUP 5381 5382 5383AT_SETUP([integer arithmetic on floating-point var]) 5384AT_KEYWORDS([fundamental literal]) 5385 5386AT_DATA([prog.cob], [ 5387 IDENTIFICATION DIVISION. 5388 PROGRAM-ID. prog. 5389 5390 DATA DIVISION. 5391 WORKING-STORAGE SECTION. 5392 01 x USAGE FLOAT-SHORT VALUE 123.456. 5393 5394 PROCEDURE DIVISION. 5395 ADD 360 TO x 5396 IF x <> 483.456 5397 DISPLAY "ADD wrong: " x 5398 MOVE 483.456 TO x 5399 END-IF 5400 5401 SUBTRACT 360 FROM x 5402 IF x <> 123.456 5403 DISPLAY "SUBTRACT wrong: " x 5404 MOVE 123.456 TO x 5405 END-IF 5406 5407 DIVIDE 2 INTO x 5408 IF x <> 61.728 5409 DISPLAY "DIVIDE wrong: " x 5410 MOVE 61.728 TO x 5411 END-IF 5412 5413 MULTIPLY 2 BY x 5414 IF x <> 123.456 5415 DISPLAY "MULTIPLY wrong: " x 5416 END-IF 5417 . 5418]) 5419 5420AT_CHECK([$COMPILE prog.cob], [0], [], []) 5421AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) 5422AT_CLEANUP 5423 5424 5425AT_SETUP([TYPEDEF application]) 5426AT_KEYWORDS([fundamental EXTERNAL]) 5427 5428AT_DATA([caller.cob], [ 5429 IDENTIFICATION DIVISION. 5430 PROGRAM-ID. caller. 5431 5432 DATA DIVISION. 5433 WORKING-STORAGE SECTION. 5434 77 INT IS TYPEDEF BINARY-LONG. 5435 77 EXT-INT IS TYPEDEF BINARY-LONG EXTERNAL. 5436 *> should this be possible? 5437 *>77 INT-VAL IS TYPEDEF USAGE INT VALUE 12. 5438 77 INT-VAL IS TYPEDEF BINARY-LONG VALUE 12. 5439 77 SOMEVAR USAGE INT VALUE 10. 5440 77 SOMEVAL USAGE INT-VAL. 5441 77 SOMEEXT USAGE EXT-INT. 5442 5443 PROCEDURE DIVISION. 5444 IF SOMEVAR <> 10 5445 DISPLAY "SOMEVAR (INT) wrong: " SOMEVAR 5446 END-IF 5447 IF SOMEVAL <> 12 5448 DISPLAY "SOMEVAR (INT-VAL) wrong: " SOMEVAL 5449 END-IF 5450 MOVE 42 TO SOMEEXT 5451 CALL "callee" 5452 . 5453]) 5454 5455AT_DATA([callee.cob], [ 5456 IDENTIFICATION DIVISION. 5457 PROGRAM-ID. callee. 5458 5459 DATA DIVISION. 5460 WORKING-STORAGE SECTION. 5461 77 EXT-INT IS TYPEDEF BINARY-LONG EXTERNAL. 5462 77 SOMEEXT USAGE EXT-INT. 5463 5464 PROCEDURE DIVISION. 5465 IF SOMEEXT <> 42 5466 DISPLAY "SOMEEXT (EXT-INT) wrong: " SOMEEXT 5467 END-IF 5468 . 5469]) 5470 5471AT_CHECK([$COMPILE caller.cob], [0], [], []) 5472AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) 5473AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) 5474AT_CLEANUP 5475