cobol-java-v3/benchmark-programs/cross-cutting/japanese/main-japanese.cbl

       IDENTIFICATION DIVISION.
      *> PROGRAM-ID: JapaneseTest
      *> Cross-cutting: Japanese character handling
      *> Tests: J-N001 through J-N005, J-K001 through J-K005,
      *>        J-D001 through J-D004, J-S001 through J-S003
       PROGRAM-ID. JapaneseTest.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
      *> J-N series: PIC N full-width fields
       77 JN-FIELD1           PIC N(10).
       77 JN-FIELD2           PIC N(20).
       77 JN-RESULT           PIC N(30).
      *> J-K series: Half-width katakana PIC X fields
       77 JK-FIELD1           PIC X(20).
       77 JK-FIELD2           PIC X(20).
       77 JK-RESULT           PIC X(40).
      *> J-D series: Shift-JIS 5C/7C problem characters
       77 JD-5C               PIC X(10).
       77 JD-7C               PIC X(10).
       77 JD-MIXED            PIC X(20).
      *> J-S series: INSPECT with Japanese
       77 JS-SRC              PIC X(30).
       77 JS-TALLY            PIC 99.
       77 TC                  PIC 99 VALUE 0.
       PROCEDURE DIVISION.
      *
      * J-N001: PIC N full-width field assignment
      *
       J-N001.
           ADD 1 TO TC.
           DISPLAY "J-N001: PIC N full-width field assignment".
           MOVE ALL "A" TO JN-FIELD1.
           DISPLAY "  N-FIELD LEN=" LENGTH OF JN-FIELD1.
      *   PIC N(10) = 20 bytes in GnuCOBOL (2 bytes per N char)
           IF LENGTH OF JN-FIELD1 = 20
               DISPLAY "  N(10) LENGTH=20 OK"
           ELSE
               DISPLAY "  N(10) LENGTH=" LENGTH OF JN-FIELD1 " FAIL"
           END-IF.
           DISPLAY "J-N001: PASS".
      *
      * J-N002: Move between N fields
      *
       J-N002.
           ADD 1 TO TC.
           DISPLAY "J-N002: Move between PIC N fields".
           MOVE "ABCDEFGHIJ" TO JN-FIELD1.
           MOVE JN-FIELD1 TO JN-FIELD2.
           IF JN-FIELD2(1:10) = JN-FIELD1(1:10)
               DISPLAY "  N-FIELD MOVE OK"
           ELSE
               DISPLAY "  N-FIELD MOVE FAIL"
           END-IF.
           DISPLAY "J-N002: PASS".
      *
      * J-N003: N field numeric fill
      *
       J-N003.
           ADD 1 TO TC.
           DISPLAY "J-N003: N field with numeric data".
           MOVE "12345" TO JN-FIELD1.
           DISPLAY "  N-FIELD WITH DIGITS OK".
           DISPLAY "J-N003: PASS".
      *
      * J-N004: N field comparison
      *
       J-N004.
           ADD 1 TO TC.
           DISPLAY "J-N004: N field comparison".
           MOVE "TEST-DATA" TO JN-FIELD1.
           MOVE "TEST-DATA" TO JN-FIELD2.
           IF JN-FIELD1 = JN-FIELD2
               DISPLAY "  N-FIELD EQUAL OK"
           ELSE
               DISPLAY "  N-FIELD EQUAL FAIL"
           END-IF.
           DISPLAY "J-N004: PASS".
      *
      * J-N005: N field with mixed content
      *
       J-N005.
           ADD 1 TO TC.
           DISPLAY "J-N005: N field mixed content".
           MOVE "ABC123XYZ" TO JN-FIELD1.
           MOVE JN-FIELD1 TO JN-RESULT.
           DISPLAY "  N MIXED CONTENT OK".
           DISPLAY "J-N005: PASS".
      *
      * J-K001: Half-width katakana in PIC X
      *
       J-K001.
           ADD 1 TO TC.
           DISPLAY "J-K001: Half-width katakana in PIC X".
           MOVE "ABCDEFGHIJ" TO JK-FIELD1.
           DISPLAY "  X-FIELD=" JK-FIELD1.
           DISPLAY "J-K001: PASS".
      *
      * J-K002: Katakana field move
      *
       J-K002.
           ADD 1 TO TC.
           DISPLAY "J-K002: Move between X fields".
           MOVE "KATAKANA-TEST " TO JK-FIELD1.
           MOVE JK-FIELD1 TO JK-FIELD2.
           IF JK-FIELD2 = JK-FIELD1
               DISPLAY "  X-FIELD MOVE OK"
           ELSE
               DISPLAY "  X-FIELD MOVE FAIL"
           END-IF.
           DISPLAY "J-K002: PASS".
      *
      * J-K003: Empty katakana field
      *
       J-K003.
           ADD 1 TO TC.
           DISPLAY "J-K003: Empty X field".
           MOVE SPACES TO JK-FIELD1.
           IF JK-FIELD1 = SPACES
               DISPLAY "  EMPTY X-FIELD OK"
           ELSE
               DISPLAY "  EMPTY X-FIELD FAIL"
           END-IF.
           DISPLAY "J-K003: PASS".
      *
      * J-K004: Katakana string concatenation via STRING
      *
       J-K004.
           ADD 1 TO TC.
           DISPLAY "J-K004: STRING with X fields".
           MOVE SPACES TO JK-RESULT.
           STRING "ABC-" DELIMITED BY SIZE
                  "XYZ" DELIMITED BY SIZE
             INTO JK-RESULT.
           IF JK-RESULT(1:7) = "ABC-XYZ"
               DISPLAY "  STRING CONCAT OK"
           ELSE
               DISPLAY "  STRING CONCAT FAIL: " JK-RESULT
           END-IF.
           DISPLAY "J-K004: PASS".
      *
      * J-K005: Katakana field with UNSTRING
      *
       J-K005.
           ADD 1 TO TC.
           DISPLAY "J-K005: UNSTRING with X fields".
           MOVE "ABC/DEF/GHI" TO JK-FIELD1.
           MOVE SPACES TO JK-RESULT.
           UNSTRING JK-FIELD1 DELIMITED BY "/"
               INTO JK-FIELD2
           END-UNSTRING.
           IF JK-FIELD2(1:3) = "ABC"
               DISPLAY "  UNSTRING OK"
           ELSE
               DISPLAY "  UNSTRING FAIL: " JK-FIELD2
           END-IF.
           DISPLAY "J-K005: PASS".
      *
      * J-D001: Shift-JIS 5C problem character
      *
       J-D001.
           ADD 1 TO TC.
           DISPLAY "J-D001: 5C problem character handling".
      *   0x5C is backslash in ASCII, yen sign in Shift-JIS
           MOVE "TEST\DATA" TO JD-5C.
           DISPLAY "  5C FIELD=" JD-5C.
           DISPLAY "J-D001: PASS".
      *
      * J-D002: 7C problem character
      *
       J-D002.
           ADD 1 TO TC.
           DISPLAY "J-D002: 7C problem character handling".
      *   0x7C is pipe in ASCII
           MOVE "PIPE|TEST" TO JD-7C.
           DISPLAY "  7C FIELD=" JD-7C.
           DISPLAY "J-D002: PASS".
      *
      * J-D003: Mixed 5C/7C characters
      *
       J-D003.
           ADD 1 TO TC.
           DISPLAY "J-D003: Mixed 5C/7C characters".
           MOVE "A\B|C\D|E" TO JD-MIXED.
           DISPLAY "  MIXED 5C7C=" JD-MIXED.
           DISPLAY "J-D003: PASS".
      *
      * J-D004: Comparison with 5C/7C
      *
       J-D004.
           ADD 1 TO TC.
           DISPLAY "J-D004: Comparison with 5C/7C".
           MOVE "ABC\DEF" TO JD-5C.
           MOVE "ABC\DEF" TO JD-7C.
           IF JD-5C = JD-7C
               DISPLAY "  5C/7C EQUAL OK"
           ELSE
               DISPLAY "  5C/7C NOT EQUAL"
           END-IF.
           DISPLAY "J-D004: PASS".
      *
      * J-S001: INSPECT TALLY with X data
      *
       J-S001.
           ADD 1 TO TC.
           DISPLAY "J-S001: INSPECT TALLYING".
           MOVE "AABBCCDDEE" TO JS-SRC.
           MOVE 0 TO JS-TALLY.
           INSPECT JS-SRC TALLYING JS-TALLY FOR ALL "A".
           IF JS-TALLY = 2
               DISPLAY "  TALLY A COUNT=" JS-TALLY " OK"
           ELSE
               DISPLAY "  TALLY A COUNT=" JS-TALLY " FAIL"
           END-IF.
           DISPLAY "J-S001: PASS".
      *
      * J-S002: INSPECT REPLACING with X data
      *
       J-S002.
           ADD 1 TO TC.
           DISPLAY "J-S002: INSPECT REPLACING".
           MOVE "ABCDEFGHIJ" TO JS-SRC.
           INSPECT JS-SRC REPLACING ALL "A" BY "X".
           IF JS-SRC(1:1) = "X"
               DISPLAY "  REPLACE A->X OK: " JS-SRC
           ELSE
               DISPLAY "  REPLACE A->X FAIL: " JS-SRC
           END-IF.
           DISPLAY "J-S002: PASS".
      *
      * J-S003: INSPECT CONVERTING with X data
      *
       J-S003.
           ADD 1 TO TC.
           DISPLAY "J-S003: INSPECT CONVERTING".
           MOVE "ABCDEFGHIJ" TO JS-SRC.
           INSPECT JS-SRC CONVERTING "ABC" TO "XYZ".
           DISPLAY "  CONVERT ABC->XYZ: " JS-SRC.
           DISPLAY "J-S003: PASS".
      *
      * Summary
      *
       END-TEST.
           DISPLAY "JAPANESE: ALL " TC " TESTS DONE".
           STOP RUN.