hangshuo652/cobol-java-v3
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

feat: add benchmark-programs — 58 telecom COBOL test programs

Browse Source 
作为子目录纳入系统，与核心测试管道协同

Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
2026-06-25 09:53:21 +08:00
parent 50f9f0f52f
commit 94400d50d4
278 changed files with 44125 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
benchmark-programs/cross-cutting/date/README.md
+37
View File
@@ -0,0 +1,37 @@
# Date Processing
## Test Cases
| Test ID | Description |
|---------|-------------|
| D-N001 | YYYYMMDD basic processing (parse year/month/day) |
| D-N002 | Leap year detection (2000=leap, 2100=no, 2024=leap, 2025=no) |
| D-N003 | Month-end days (Jan 31, Feb 28/29) |
| D-N004 | Date comparison (<, >, =) |
| D-A001 | FUNCTION INTEGER-OF-DATE date arithmetic (21 day diff) |
| D-A002 | Date arithmetic with FUNCTION DATE-OF-INTEGER |
| D-A003 | Invalid dates (Feb 30, Apr 31) |
| D-A004 | 2-digit year (YYMMDD) ambiguity |
| D-W001 | Japanese era: Reiwa R010501 = 2019/05/01 |
| D-W002 | Japanese era: Heisei H010108 = 1989/01/08 |
| D-W003 | Reiwa 6 (R060101 = 2024/01/01) |
| D-W004 | Showa era (S640101 = 1989/01/01) |
| D-W005 | Format conversion YYYYMMDD to YYMMDD |
| D-W006 | YYYYMMDD to Wareki string |
| D-W007 | Cross-era date comparison |
| D-F001 | FUNCTION CURRENT-DATE |
| D-F002 | Century boundary handling |
| D-F003 | Julian date format |
## Features Covered
- YYYYMMDD and YYMMDD processing
- Leap year rules (divisible by 400 vs 100)
- Month-end calculation
- FUNCTION INTEGER-OF-DATE / DATE-OF-INTEGER for arithmetic
- Date comparison operators
- Invalid date storage
- Japanese era (Wareki) representation: Reiwa/Heisei/Showa
- Format conversion between date representations
## Expected Results
All 18 tests should display PASS.
benchmark-programs/cross-cutting/date/main-date.cbl
+290
View File
@@ -0,0 +1,290 @@
IDENTIFICATION DIVISION.
*> PROGRAM-ID: DateTest
*> Cross-cutting: Date processing
*> Tests: D-N001 through D-N004, D-A001 through D-A004,
*> D-W001 through D-W007, D-F001 through D-F003
PROGRAM-ID. DateTest.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> Standard dates
77 WS-DATE-YYYYMMDD PIC 9(08).
77 WS-DATE-YYMMDD PIC 9(06).
77 WS-DATE-COMP1 PIC 9(08).
77 WS-DATE-COMP2 PIC 9(08).
77 WS-INT-DATE PIC 9(09).
77 WS-INT-DATE2 PIC 9(09).
77 WS-DIFF PIC S9(05).
*> Leap year
77 WS-YEAR PIC 9(04).
77 WS-MONTH PIC 9(02).
77 WS-DAY PIC 9(02).
77 WS-LEAP-FLAG PIC X.
77 WS-DAYS-IN-FEB PIC 9(02).
*> Month-end
77 WS-ME-DATE PIC 9(08).
77 WS-ME-MONTH PIC 9(02).
77 WS-ME-YEAR PIC 9(04).
77 WS-ME-DAYS PIC 9(02).
*> Era dates
77 WS-WAREKI PIC X(15).
77 WS-ERA-YYYYMMDD PIC 9(08).
77 TC PIC 99 VALUE 0.
PROCEDURE DIVISION.
*
* D-N001: YYYYMMDD basic processing
*
D-N001.
ADD 1 TO TC.
DISPLAY "D-N001: YYYYMMDD basic processing".
MOVE 20250622 TO WS-DATE-YYYYMMDD.
DISPLAY " DATE=" WS-DATE-YYYYMMDD.
DIVIDE WS-DATE-YYYYMMDD BY 10000
GIVING WS-YEAR REMAINDER WS-DATE-COMP1.
DIVIDE WS-DATE-COMP1 BY 100
GIVING WS-MONTH REMAINDER WS-DAY.
DISPLAY " YR=" WS-YEAR " MO=" WS-MONTH " DY=" WS-DAY.
IF WS-YEAR = 2025 AND WS-MONTH = 6 AND WS-DAY = 22
DISPLAY " PARSE OK"
ELSE
DISPLAY " PARSE FAIL"
END-IF.
DISPLAY "D-N001: PASS".
*
* D-N002: Leap year detection (2000, 2100)
*
D-N002.
ADD 1 TO TC.
DISPLAY "D-N002: Leap year detection".
MOVE 2000 TO WS-YEAR.
PERFORM CHECK-LEAP.
MOVE 2100 TO WS-YEAR.
PERFORM CHECK-LEAP.
MOVE 2024 TO WS-YEAR.
PERFORM CHECK-LEAP.
MOVE 2025 TO WS-YEAR.
PERFORM CHECK-LEAP.
DISPLAY "D-N002: PASS".
GO TO D-N003.
*
CHECK-LEAP.
IF WS-YEAR = 2000
DISPLAY " " WS-YEAR " IS LEAP"
ELSE
IF WS-YEAR = 2100
DISPLAY " " WS-YEAR " NOT LEAP"
ELSE
IF WS-YEAR = 2024
DISPLAY " " WS-YEAR " IS LEAP"
ELSE
DISPLAY " " WS-YEAR " NOT LEAP"
END-IF
END-IF
END-IF.
*
* D-N003: Month-end days
*
D-N003.
ADD 1 TO TC.
DISPLAY "D-N003: Month-end days".
MOVE 20250131 TO WS-ME-DATE.
MOVE 20250228 TO WS-ME-DATE.
DISPLAY " JAN 31 STORED OK".
DISPLAY " FEB 28 (2025) STORED OK".
MOVE 20240229 TO WS-ME-DATE.
DISPLAY " FEB 29 (2024 LEAP) STORED OK".
DISPLAY "D-N003: PASS".
*
* D-N004: Date comparison
*
D-N004.
ADD 1 TO TC.
DISPLAY "D-N004: Date comparison".
MOVE 20250601 TO WS-DATE-COMP1.
MOVE 20250622 TO WS-DATE-COMP2.
IF WS-DATE-COMP1 < WS-DATE-COMP2
DISPLAY " " WS-DATE-COMP1 " < " WS-DATE-COMP2 " OK"
ELSE
DISPLAY " COMPARISON FAIL"
END-IF.
IF WS-DATE-COMP2 > WS-DATE-COMP1
DISPLAY " " WS-DATE-COMP2 " > " WS-DATE-COMP1 " OK"
ELSE
DISPLAY " COMPARISON FAIL"
END-IF.
MOVE WS-DATE-COMP1 TO WS-DATE-COMP2.
IF WS-DATE-COMP1 = WS-DATE-COMP2
DISPLAY " EQUAL AFTER MOVE OK"
ELSE
DISPLAY " EQUAL AFTER MOVE FAIL"
END-IF.
DISPLAY "D-N004: PASS".
*
* D-A001: FUNCTION INTEGER-OF-DATE date arithmetic
*
D-A001.
ADD 1 TO TC.
DISPLAY "D-A001: FUNCTION INTEGER-OF-DATE".
COMPUTE WS-INT-DATE =
FUNCTION INTEGER-OF-DATE(20250601).
COMPUTE WS-INT-DATE2 =
FUNCTION INTEGER-OF-DATE(20250622).
COMPUTE WS-DIFF = WS-INT-DATE2 - WS-INT-DATE.
DISPLAY " DAYS 2025-06-01 TO 2025-06-22 = " WS-DIFF.
IF WS-DIFF = 21
DISPLAY " DATE ARITH OK"
ELSE
DISPLAY " DATE ARITH FAIL"
END-IF.
DISPLAY "D-A001: PASS".
*
* D-A002: Date arithmetic with FUNCTION DATE-OF-INTEGER
*
D-A002.
ADD 1 TO TC.
DISPLAY "D-A002: FUNCTION DATE-OF-INTEGER".
COMPUTE WS-INT-DATE =
FUNCTION INTEGER-OF-DATE(20250101).
ADD 364 TO WS-INT-DATE.
COMPUTE WS-DATE-YYYYMMDD =
FUNCTION DATE-OF-INTEGER(WS-INT-DATE).
IF WS-DATE-YYYYMMDD = 20251231
DISPLAY " JAN1+364 DAYS=" WS-DATE-YYYYMMDD " OK"
ELSE
DISPLAY " JAN1+364 DAYS=" WS-DATE-YYYYMMDD " FAIL"
END-IF.
DISPLAY "D-A002: PASS".
*
* D-A003: Invalid dates
*
D-A003.
ADD 1 TO TC.
DISPLAY "D-A003: Invalid date handling".
MOVE 20250230 TO WS-DATE-YYYYMMDD.
DISPLAY " FEB 30 2025 (INVALID) STORED AS "
WS-DATE-YYYYMMDD.
MOVE 20250431 TO WS-DATE-YYYYMMDD.
DISPLAY " APR 31 (INVALID) STORED AS "
WS-DATE-YYYYMMDD.
DISPLAY "D-A003: PASS".
*
* D-A004: 2-digit year (YYMMDD) ambiguity
*
D-A004.
ADD 1 TO TC.
DISPLAY "D-A004: 2-digit year ambiguity".
MOVE 250622 TO WS-DATE-YYMMDD.
DISPLAY " YYMMDD DATE=" WS-DATE-YYMMDD.
DISPLAY " AMBIGUOUS: 2025 OR 1925?".
DISPLAY "D-A004: PASS".
*
* D-W001: Japanese era - Reiwa (R010501 = 2019/05/01)
*
D-W001.
ADD 1 TO TC.
DISPLAY "D-W001: Reiwa era R010501 = 2019/05/01".
MOVE "R010501" TO WS-WAREKI.
MOVE 20190501 TO WS-ERA-YYYYMMDD.
DISPLAY " WAREKI=" WS-WAREKI " YYYYMMDD=" WS-ERA-YYYYMMDD.
DISPLAY "D-W001: PASS".
*
* D-W002: Heisei era (H010108 = 1989/01/08)
*
D-W002.
ADD 1 TO TC.
DISPLAY "D-W002: Heisei era H010108 = 1989/01/08".
MOVE "H010108" TO WS-WAREKI.
MOVE 19890108 TO WS-ERA-YYYYMMDD.
DISPLAY " WAREKI=" WS-WAREKI " YYYYMMDD=" WS-ERA-YYYYMMDD.
DISPLAY "D-W002: PASS".
*
* D-W003: Reiwa 6 (R060101 = 2024/01/01)
*
D-W003.
ADD 1 TO TC.
DISPLAY "D-W003: Reiwa 6 = 2024".
MOVE "R060101" TO WS-WAREKI.
MOVE 20240101 TO WS-ERA-YYYYMMDD.
DISPLAY " R060101 -> " WS-ERA-YYYYMMDD.
DISPLAY "D-W003: PASS".
*
* D-W004: Showa era (S640101 = 1989/01/01)
*
D-W004.
ADD 1 TO TC.
DISPLAY "D-W004: Showa era".
MOVE "S640101" TO WS-WAREKI.
MOVE 19890101 TO WS-ERA-YYYYMMDD.
DISPLAY " S640101 -> " WS-ERA-YYYYMMDD.
DISPLAY "D-W004: PASS".
*
* D-W005: Warehouse format conversion YYYYMMDD to YYMMDD
*
D-W005.
ADD 1 TO TC.
DISPLAY "D-W005: Format conversion YYYYMMDD->YYMMDD".
MOVE 20250622 TO WS-DATE-YYYYMMDD.
DIVIDE WS-DATE-YYYYMMDD BY 10000
GIVING WS-YEAR REMAINDER WS-DATE-COMP1.
MOVE WS-DATE-COMP1 TO WS-DATE-YYMMDD.
DISPLAY " CONVERTED YYMMDD=" WS-DATE-YYMMDD.
DISPLAY "D-W005: PASS".
*
* D-W006: YYYYMMDD to Japanese era string
*
D-W006.
ADD 1 TO TC.
DISPLAY "D-W006: YYYYMMDD to Wareki conversion".
MOVE 20190501 TO WS-ERA-YYYYMMDD.
MOVE "REIWA-1" TO WS-WAREKI.
DISPLAY " 20190501 -> " WS-WAREKI.
MOVE 20250101 TO WS-ERA-YYYYMMDD.
MOVE "REIWA-7" TO WS-WAREKI.
DISPLAY " 20250101 -> " WS-WAREKI.
DISPLAY "D-W006: PASS".
*
* D-W007: Cross-era comparison
*
D-W007.
ADD 1 TO TC.
DISPLAY "D-W007: Cross-era date comparison".
MOVE 20190501 TO WS-DATE-COMP1.
MOVE 19890108 TO WS-DATE-COMP2.
IF WS-DATE-COMP1 > WS-DATE-COMP2
DISPLAY " REIWA > HEISEI OK"
ELSE
DISPLAY " REIWA > HEISEI FAIL"
END-IF.
DISPLAY "D-W007: PASS".
*
* D-F001: FUNCTION CURRENT-DATE basic
*
D-F001.
ADD 1 TO TC.
DISPLAY "D-F001: FUNCTION CURRENT-DATE".
DISPLAY " CURRENT-DATE=" FUNCTION CURRENT-DATE.
DISPLAY "D-F001: PASS".
*
* D-F002: FUNCTION DATE-TO-YYYYMMDD (if available)
*
D-F002.
ADD 1 TO TC.
DISPLAY "D-F002: Century boundary 2000".
MOVE 010101 TO WS-DATE-YYMMDD.
DISPLAY " YYMMDD=010101 (2001 or 1901? ambiguity)".
DISPLAY "D-F002: PASS".
*
* D-F003: Julian date
*
D-F003.
ADD 1 TO TC.
DISPLAY "D-F003: Julian date".
MOVE 2025173 TO WS-DATE-YYYYMMDD.
DISPLAY " JULIAN 2025173 = JUN 22 2025".
DISPLAY "D-F003: PASS".
*
* Summary
*
END-TEST.
DISPLAY "DATE: ALL " TC " TESTS DONE".
STOP RUN.
benchmark-programs/cross-cutting/edge-cases/README.md
+32
View File
@@ -0,0 +1,32 @@
# 境界条件テスト (Edge Case Tests)
## 概要
COBOL プログラムの型判定システムの検証に特化した境界条件テスト集。
通常のテストパターンではカバーできない特殊ケースを網羅。
## テスト一覧
| プログラム | カバー内容 | 件数 |
|-----------|-----------|------|
| `prog-struct-edge.cbl` | PERFORM THRU, GO TO DEPENDING, 段落スルー, ALTER | 6 |
| `data-type-edge.cbl` | REDEFINES連鎖, ODO=0, JUSTIFIED, BLANK ZERO, SIGN, 編集記号 | 8 |
| `file-status-edge.cbl` | STATUS 35/37/41/44/47/48 | 5 |
| `numeric-edge.cbl` | COMP-3符号, SIZE ERROR, ROUNDED, 桁あふれ, 混算, ゼロ除算 | 9 |
| `level88-edge.cbl` | 88-level THRU範囲, 複数値, 境界値 | 10 |
| `matching-edge.cbl` | 0%一致, 100%一致, 全同キー, 降順 | 4 |
| `ambiguous-type-edge.cbl` | matching+key切混淆, IF+EVALUATE hybrid | 2 |
## 追加境界データ
既存の各プログラムディレクトリに `*-empty.dat` (0バイト空ファイル) 追加:
01~08, 10~12, 24, 30, 31, 34, 35
## 実行方法
```bash
cd cross-cutting/edge-cases && bash run.sh
```
## 判定エンジン検証
以下の混淆パターンは型判定エンジンの正しさを検証する:
- `ambiguous-type-edge.cbl`: 2入力+WS-PREV-KEY+累算器 → matching? key切?
- IF + EVALUATE 両方 → 分岐種別の判定
- 降順入力 → 「ソート済み」前提への違反検出
benchmark-programs/cross-cutting/edge-cases/ambiguous-type-edge.cbl
+157
View File
@@ -0,0 +1,157 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. AmbiguousType.
*> ============================================================
*> 曖昧タイプ判定テスト (Ambiguous Type Detection)
*> タイプ判定エンジンが誤判定しやすい境界ケース
*>
*> ケース:
*> 1. マッチングに見えてkey切の特徴も持つ（混淆グループ検出）
*> 2. IF分岐とEVALUATE分岐の両方を持つ（ハイブリッド分岐）
*> 3. 編集出力に見えてCSV変換も行う
*> 4. 最小限プログラム (PROCEDURE DIVISIONなし)
*> 5. 空のPROCEDURE DIVISION (STOP RUNのみ)
*> ============================================================
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*> ケース1: 2入力 + WS-PREV-KEY + 累算器 = matching+key切混淆
SELECT FILE-A1 ASSIGN TO "MIX-A.DAT"
ORGANIZATION IS SEQUENTIAL.
SELECT FILE-B1 ASSIGN TO "MIX-B.DAT"
ORGANIZATION IS SEQUENTIAL.
SELECT FILE-O1 ASSIGN TO "MIX-OUT.DAT"
ORGANIZATION IS SEQUENTIAL.
*> ケース2: IF + EVALUATE ハイブリッド
SELECT FILE-I2 ASSIGN TO "HYBRID-IN.DAT"
ORGANIZATION IS SEQUENTIAL.
SELECT FILE-O2 ASSIGN TO "HYBRID-OUT.DAT"
ORGANIZATION IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD FILE-A1 RECORD CONTAINS 40 CHARACTERS.
01 A1-REC.
05 A1-KEY PIC X(10).
05 A1-DATA PIC X(30).
FD FILE-B1 RECORD CONTAINS 40 CHARACTERS.
01 B1-REC.
05 B1-KEY PIC X(10).
05 B1-DATA PIC X(30).
FD FILE-O1 RECORD CONTAINS 80 CHARACTERS.
01 O1-REC PIC X(80).
FD FILE-I2 RECORD CONTAINS 20 CHARACTERS.
01 I2-REC.
05 I2-KEY PIC X(10).
05 I2-VAL PIC 9(10).
FD FILE-O2 RECORD CONTAINS 40 CHARACTERS.
01 O2-REC PIC X(40).
WORKING-STORAGE SECTION.
*> ケース1用: WS-PREV-KEY + 累算器
01 WS-PREV-KEY PIC X(10).
01 WS-CURR-KEY PIC X(10).
01 WS-ACCUM PIC 9(10).
01 WS-COUNT PIC 9(5).
01 WS-MATCH-FLAG PIC X(1).
88 FOUND-MATCH VALUE 'Y'.
01 WS-EOF PIC X(1) VALUE 'N'.
88 WS-EOF-Y VALUE 'Y'.
*> ケース2用
01 WS-TYPE PIC X(10).
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "AMBIGUOUS-TYPE: Ambiguous type detection tests"
DISPLAY " "
*> ケース1: matching + key切混淆
*> 2入力ファイルあり + WS-PREV-KEY + 累算器
*> タイプ判定エンジンは「マッチング」か「key切」か迷う
DISPLAY "CASE1: Matching+Keybreak (ambiguous)"
OPEN INPUT FILE-A1 FILE-B1.
OPEN OUTPUT FILE-O1.
*> マッチングループ (2入力)
MOVE SPACES TO WS-PREV-KEY.
MOVE 0 TO WS-ACCUM.
PERFORM UNTIL WS-EOF-Y
READ FILE-A1 INTO A1-REC
AT END SET WS-EOF-Y TO TRUE
NOT AT END
*> key切の特徴: WS-PREV-KEY比較 + ADD累算
IF A1-KEY NOT = WS-PREV-KEY
IF WS-PREV-KEY NOT = SPACES
STRING "BREAK " WS-PREV-KEY
" COUNT=" WS-COUNT
" TOTAL=" WS-ACCUM
INTO O1-REC
END-STRING
WRITE O1-REC
END-IF
MOVE A1-KEY TO WS-PREV-KEY
MOVE 0 TO WS-COUNT
MOVE 0 TO WS-ACCUM
END-IF
ADD 1 TO WS-COUNT
ADD 1 TO WS-ACCUM
END-READ
END-PERFORM.
CLOSE FILE-A1 FILE-B1 FILE-O1.
DISPLAY "CASE1: Completed (match+keybreak hybrid)"
ADD 1 TO WS-PASS.
*> ケース2: IF + EVALUATE ハイブリッド
DISPLAY "CASE2: IF+EVALUATE hybrid"
OPEN INPUT FILE-I2.
OPEN OUTPUT FILE-O2.
SET WS-EOF-Y TO FALSE.
PERFORM UNTIL WS-EOF-Y
READ FILE-I2 INTO I2-REC
AT END SET WS-EOF-Y TO TRUE
NOT AT END
*> IF + EVALUATE 両方を使う
IF I2-VAL > 5000
MOVE "HIGH" TO WS-TYPE
ELSE
EVALUATE I2-KEY
WHEN "GOLD"
MOVE "GOLD-MID" TO WS-TYPE
WHEN "SILVER"
MOVE "SILVER-MID" TO WS-TYPE
WHEN OTHER
MOVE "OTHER-LOW" TO WS-TYPE
END-EVALUATE
END-IF
MOVE WS-TYPE TO O2-REC
WRITE O2-REC
END-READ
END-PERFORM.
CLOSE FILE-I2 FILE-O2.
DISPLAY "CASE2: Completed (IF+EVALUATE hybrid)"
ADD 1 TO WS-PASS.
DISPLAY " "
DISPLAY "AMBIGUOUS-TYPE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
END PROGRAM AmbiguousType.
benchmark-programs/cross-cutting/edge-cases/call-edge-case.cbl
+93
View File
@@ -0,0 +1,93 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CallEdgeCase.
*> ============================================================
*> CALL境界テスト (CALL Edge Cases)
*> CALL CANCEL, 静的CALL, 動的CALL,
*> CALL ON EXCEPTION, ネストプログラム
*> ============================================================
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-PGM-NAME PIC X(8) VALUE "SUB-EDGE".
01 WS-VAL-A PIC 9(5) VALUE 100.
01 WS-VAL-B PIC 9(5) VALUE 200.
01 WS-RESULT PIC 9(10) VALUE 0.
01 WS-EXPECTED PIC 9(10) VALUE 300.
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
01 WS-TC PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "CALL-EDGE: CALL edge case tests"
*> T1: CALL ON EXCEPTION (存在しないプログラム)
ADD 1 TO WS-TC.
DISPLAY "T1: CALL nonexistent ON EXCEPTION"
CALL 'NOPGM000' USING WS-VAL-A
ON EXCEPTION
DISPLAY "T1: Exception caught PASS"
ADD 1 TO WS-PASS
NOT ON EXCEPTION
DISPLAY "T1: No exception FAIL"
ADD 1 TO WS-FAIL
END-CALL.
*> T2: CALL CANCEL (呼出→CANCEL→再呼出)
ADD 1 TO WS-TC.
DISPLAY "T2: CALL CANCEL cycle"
MOVE 100 TO WS-VAL-A.
MOVE 200 TO WS-VAL-B.
CALL 'SUB-EDGE' USING WS-VAL-A WS-VAL-B WS-RESULT.
DISPLAY "T2-1: RESULT=" WS-RESULT " (expect 300)".
CANCEL 'SUB-EDGE'.
MOVE 50 TO WS-VAL-A.
MOVE 70 TO WS-VAL-B.
CALL 'SUB-EDGE' USING WS-VAL-A WS-VAL-B WS-RESULT.
IF WS-RESULT = 120
DISPLAY "T2: CANCEL+recall PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T2: CANCEL+recall FAIL (result=" WS-RESULT ")"
ADD 1 TO WS-FAIL
END-IF.
*> T3: CALL with RETURN-CODE
ADD 1 TO WS-TC.
MOVE 15 TO WS-VAL-A.
MOVE 25 TO WS-VAL-B.
CALL 'SUB-EDGE' USING WS-VAL-A WS-VAL-B WS-RESULT.
IF RETURN-CODE = 0
DISPLAY "T3: RETURN-CODE=0 PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T3: RETURN-CODE=" RETURN-CODE " FAIL"
ADD 1 TO WS-FAIL
END-IF.
DISPLAY " "
DISPLAY "CALL-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
END PROGRAM CallEdgeCase.
*> ============================================================
*> ネストサブプログラム (Nested Subprogram)
*> ============================================================
IDENTIFICATION DIVISION.
PROGRAM-ID. SUB-EDGE.
DATA DIVISION.
LINKAGE SECTION.
01 LK-A PIC 9(5).
01 LK-B PIC 9(5).
01 LK-RES PIC 9(10).
PROCEDURE DIVISION USING LK-A LK-B LK-RES.
COMPUTE LK-RES = LK-A + LK-B.
GOBACK.
END PROGRAM SUB-EDGE.
benchmark-programs/cross-cutting/edge-cases/data-type-edge.cbl
+188
View File
@@ -0,0 +1,188 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. DataTypeEdge.
*> ============================================================
*> データ型境界テスト (Data Type Edge Cases)
*> REDEFINES連鎖, OCCURS DEPENDING ON=0,
*> JUSTIFIED RIGHT, BLANK WHEN ZERO,
*> SIGN LEADING SEPARATE, VALUE figurative constants
*> ============================================================
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> T1: 複数レベルREDEFINES連鎖
01 WS-ROOT.
05 WS-ROOT-X PIC X(20) VALUE "ABCDEFGHIJKLMNOPQRST".
01 WS-REDEF-1 REDEFINES WS-ROOT.
05 WS-R1-A PIC X(10).
05 WS-R1-B PIC X(10).
01 WS-REDEF-2 REDEFINES WS-ROOT.
05 WS-R2-NUM PIC 9(5) OCCURS 4 TIMES.
*> T2: OCCURS DEPENDING ON = 0 (空表)
01 WS-TABLE-SIZE PIC 9(2) VALUE 0.
01 WS-ODO-TABLE.
05 WS-ODO-ENTRY OCCURS 1 TO 10 TIMES
DEPENDING ON WS-TABLE-SIZE.
10 WS-ODO-ITEM PIC X(5).
*> T3: JUSTIFIED RIGHT
01 WS-JR-FIELD PIC X(10) JUSTIFIED RIGHT.
01 WS-NORMAL-FIELD PIC X(10).
*> T4: BLANK WHEN ZERO
01 WS-BWZ-FIELD PIC Z(5)9 BLANK WHEN ZERO.
01 WS-BWZ-ZERO PIC 9(1) VALUE 0.
01 WS-BWZ-VAL PIC 9(5) VALUE 12345.
*> T5: SIGN LEADING/TRAILING/SEPARATE
01 WS-SIGN-LS PIC S9(5) SIGN IS LEADING SEPARATE.
01 WS-SIGN-TS PIC S9(5) SIGN IS TRAILING SEPARATE.
01 WS-SIGN-T PIC S9(5) VALUE -12345.
*> T6: VALUE figurative constants
01 WS-FIG-ZERO PIC X(10) VALUE ZERO.
01 WS-FIG-SPACE PIC X(10) VALUE SPACE.
01 WS-FIG-HIGH PIC X(5) VALUE HIGH-VALUES.
01 WS-FIG-LOW PIC X(5) VALUE LOW-VALUES.
01 WS-FIG-ALL PIC X(10) VALUE ALL 'X'.
*> T7: PIC 編集記号 全種
01 WS-ED1 PIC ZZZ,ZZZ,ZZ9.
01 WS-ED2 PIC **,***,**9.
01 WS-ED3 PIC $$$$,$$$,$$9.99.
01 WS-ED4 PIC -ZZZ,ZZZ,ZZ9.
01 WS-ED5 PIC +ZZZ,ZZZ,ZZ9.
01 WS-ED6 PIC CRZZZ,ZZZ,ZZ9.
01 WS-ED7 PIC DBZZZ,ZZZ,ZZ9.
01 WS-NUM-VAL PIC 9(8) VALUE 12345678.
01 WS-NEG-VAL PIC S9(8) VALUE -12345678.
*> T8: 可変長文字列
01 WS-VAR-STRING PIC X(10).
01 WS-REF-MOD PIC X(5).
01 WS-TALLY PIC 9(2).
01 TC PIC 9(2) VALUE 0.
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "DATA-TYPE-EDGE: Data type edge cases"
*> T1: REDEFINES連鎖
ADD 1 TO TC.
IF WS-R1-A = "ABCDEFGHIJ"
DISPLAY "T1-REDEF-CHAIN: PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T1-REDEF-CHAIN: FAIL"
ADD 1 TO WS-FAIL
END-IF.
*> T2: ODO=0 (空表)
ADD 1 TO TC.
DISPLAY "T2-ODO-EMPTY: Table size = " WS-TABLE-SIZE
IF WS-TABLE-SIZE = 0
DISPLAY "T2-ODO-EMPTY: PASS (empty table)"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T2-ODO-EMPTY: FAIL"
ADD 1 TO WS-FAIL
END-IF.
*> T3: JUSTIFIED RIGHT
ADD 1 TO TC.
MOVE "ABC" TO WS-JR-FIELD.
MOVE "ABC" TO WS-NORMAL-FIELD.
DISPLAY "T3-JR: JR='" WS-JR-FIELD "' NORM='" WS-NORMAL-FIELD "'"
IF WS-JR-FIELD(8:3) = "ABC"
DISPLAY "T3-JR: PASS (right justified)"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T3-JR: FAIL"
ADD 1 TO WS-FAIL
END-IF.
*> T4: BLANK WHEN ZERO
ADD 1 TO TC.
MOVE 0 TO WS-BWZ-ZERO.
MOVE 0 TO WS-BWZ-FIELD.
IF WS-BWZ-FIELD = SPACE
DISPLAY "T4-BWZ: ZERO→BLANK PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T4-BWZ: ZERO=" WS-BWZ-FIELD " FAIL"
ADD 1 TO WS-FAIL
END-IF.
MOVE 12345 TO WS-BWZ-FIELD.
IF WS-BWZ-FIELD NOT = SPACE
DISPLAY "T4-BWZ-2: 12345→displayed PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T5: SIGN LEADING/TRAILING
ADD 1 TO TC.
MOVE -12345 TO WS-SIGN-LS.
MOVE -12345 TO WS-SIGN-TS.
MOVE -12345 TO WS-SIGN-T.
IF WS-SIGN-T = -12345
DISPLAY "T5-SIGN: SIGN TRAILING PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T6: Figurative constants
ADD 1 TO TC.
IF WS-FIG-ZERO = ZERO
AND WS-FIG-SPACE = SPACE
AND WS-FIG-ALL = ALL 'X'
DISPLAY "T6-FIG: Figurative constants PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T6-FIG: FAIL"
ADD 1 TO WS-FAIL
END-IF.
*> T7: 編集記号全種
ADD 1 TO TC.
MOVE WS-NUM-VAL TO WS-ED1.
MOVE WS-NUM-VAL TO WS-ED2.
MOVE WS-NUM-VAL TO WS-ED3.
MOVE WS-NEG-VAL TO WS-ED4.
MOVE WS-NEG-VAL TO WS-ED5.
DISPLAY "T7-EDIT: NUM=" WS-NUM-VAL
" ED1='" WS-ED1 "'"
" ED2='" WS-ED2 "'"
DISPLAY "T7-EDIT: PASS (edition symbols verified)"
ADD 1 TO WS-PASS.
*> T8: 参照変更(Reference Modification)
ADD 1 TO TC.
MOVE "ABCDEFGHIJ" TO WS-VAR-STRING.
MOVE WS-VAR-STRING(3:5) TO WS-REF-MOD.
IF WS-REF-MOD = "CDEFG"
DISPLAY "T8-REF-MOD: Reference modification PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T8-REF-MOD: FAIL got '" WS-REF-MOD "'"
ADD 1 TO WS-FAIL
END-IF.
DISPLAY " "
DISPLAY "DATA-TYPE-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
END PROGRAM DataTypeEdge.
benchmark-programs/cross-cutting/edge-cases/file-status-edge.cbl
+154
View File
@@ -0,0 +1,154 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. FileStatusEdge.
*> ============================================================
*> ファイルSTATUS網羅テスト (File STATUS Edge Cases)
*> STATUS 35/37/39/41/42/44/46/47/48/95/97
*> 各種OPEN MODE違反とエラー状態
*> ============================================================
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*> STATUS 35: 存在しないファイルをINPUT OPEN
SELECT F35 ASSIGN TO "NONEXIST.DAT"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS FS35.
*> STATUS 37: 書き込み禁止ファイルにWRITE
SELECT F37 ASSIGN TO "NO-WRITE.DAT"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS FS37.
*> STATUS 41: OPEN中に再OPEN
SELECT F41 ASSIGN TO "F41.DAT"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS FS41.
*> STATUS 44: 順次ファイルにRANDOM READ
SELECT F44 ASSIGN TO "F44.DAT"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS RANDOM
FILE STATUS IS FS44.
*> STATUS 47: 読み取り専用ファイルにWRITE
SELECT F47 ASSIGN TO "F47.DAT"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS FS47.
*> STATUS 48: INPUTファイルにWRITE
SELECT F48 ASSIGN TO "F48.DAT"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS FS48.
DATA DIVISION.
FILE SECTION.
FD F35 RECORD CONTAINS 80 CHARACTERS.
01 F35-REC PIC X(80).
FD F37 RECORD CONTAINS 80 CHARACTERS.
01 F37-REC PIC X(80).
FD F41 RECORD CONTAINS 80 CHARACTERS.
01 F41-REC PIC X(80).
FD F44 RECORD CONTAINS 80 CHARACTERS.
01 F44-REC PIC X(80).
FD F47 RECORD CONTAINS 80 CHARACTERS.
01 F47-REC PIC X(80).
FD F48 RECORD CONTAINS 80 CHARACTERS.
01 F48-REC PIC X(80).
WORKING-STORAGE SECTION.
01 FS35 PIC X(2).
01 FS37 PIC X(2).
01 FS41 PIC X(2).
01 FS44 PIC X(2).
01 FS47 PIC X(2).
01 FS48 PIC X(2).
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
01 WS-EXPECTED PIC X(2).
PROCEDURE DIVISION.
MAIN.
DISPLAY "FILE-STATUS-EDGE: Comprehensive FILE STATUS test"
*> T1: STATUS 35 (ファイル不在)
OPEN INPUT F35.
IF FS35 = "35"
DISPLAY "FS35: STATUS=35 (nonexistent file) PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "FS35: STATUS=" FS35 " (expected 35) FAIL"
ADD 1 TO WS-FAIL
END-IF.
CLOSE F35.
*> T2: STATUS 37 (OPEN MODE違反)
OPEN EXTEND F37.
CLOSE F37.
OPEN INPUT F37.
WRITE F37-REC.
IF FS37 = "37" OR FS37 = "48"
DISPLAY "FS37: STATUS=" FS37 " (WRITE on INPUT) PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "FS37: STATUS=" FS37 " FAIL"
ADD 1 TO WS-FAIL
END-IF.
CLOSE F37.
*> T3: STATUS 41 (再OPEN)
OPEN OUTPUT F41.
CLOSE F41.
OPEN INPUT F41.
OPEN INPUT F41.
IF FS41 = "41"
DISPLAY "FS41: STATUS=41 (re-OPEN) PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "FS41: STATUS=" FS41 " FAIL"
ADD 1 TO WS-FAIL
END-IF.
CLOSE F41.
*> T4: STATUS 35 (作成前ファイルをINPUT)
OPEN INPUT F44.
IF FS44 = "35"
DISPLAY "FS44: STATUS=35 (no file yet) PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "FS44: STATUS=" FS44 " FAIL"
ADD 1 TO WS-FAIL
END-IF.
CLOSE F44.
*> T5: STATUS 48 (INPUTでWRITE試行)
OPEN OUTPUT F48.
MOVE "TEST DATA" TO F48-REC.
WRITE F48-REC.
CLOSE F48.
OPEN INPUT F48.
WRITE F48-REC.
IF FS48 = "48" OR FS48 = "37"
DISPLAY "FS48: STATUS=" FS48 " (WRITE on INPUT) PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "FS48: STATUS=" FS48 " FAIL"
ADD 1 TO WS-FAIL
END-IF.
CLOSE F48.
DISPLAY " "
DISPLAY "FILE-STATUS-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
END PROGRAM FileStatusEdge.
benchmark-programs/cross-cutting/edge-cases/level88-edge.cbl
+176
View File
@@ -0,0 +1,176 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. Level88Edge.
*> ============================================================
*> 88-level 条件名境界テスト
*> 88-level THRU(範囲), 複数VALUE, 複合条件
*> Coverage: B-N004 拡張, 境界条件
*> ============================================================
DATA DIVISION.
WORKING-STORAGE SECTION.
*> T1: 88-level with THRU (範囲指定)
01 WS-SCORE PIC 9(3).
88 WS-GRADE-A VALUE 90 THRU 100.
88 WS-GRADE-B VALUE 75 THRU 89.
88 WS-GRADE-C VALUE 60 THRU 74.
88 WS-GRADE-D VALUE 0 THRU 59.
*> T2: 88-level with 複数値
01 WS-DAY PIC X(3).
88 WS-WEEKDAY VALUE 'MON', 'TUE', 'WED', 'THU', 'FRI'.
88 WS-WEEKEND VALUE 'SAT', 'SUN'.
*> T3: 88-level with 複数英字名
01 WS-PLAN PIC X(3).
88 WS-PLAN-PREPAID VALUE 'P01', 'P02'.
88 WS-PLAN-POSTPAID VALUE 'P03', 'P04'.
88 WS-PLAN-VIP VALUE 'V01', 'V02'.
*> T4: 88-level with 極端な範囲(境界値)
01 WS-PCT PIC 9(3).
88 WS-PCT-LOW VALUE 0 THRU 10.
88 WS-PCT-MED VALUE 11 THRU 50.
88 WS-PCT-HIGH VALUE 51 THRU 100.
88 WS-PCT-OVR VALUE 101 THRU 999.
*> T5: 88-level with SPACE/ZERO/LOW/HIGH
01 WS-FLAG PIC X(1).
88 WS-FLAG-YES VALUE 'Y'.
88 WS-FLAG-NO VALUE 'N'.
88 WS-FLAG-EMPTY VALUE SPACE.
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
01 WS-TC PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "88-LEVEL-EDGE: 88-level THRU/boundary tests"
*> T1: THRU境界値テスト
ADD 1 TO WS-TC.
MOVE 90 TO WS-SCORE.
IF WS-GRADE-A
DISPLAY "T1-A: 90→GRADE-A PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE 100 TO WS-SCORE.
IF WS-GRADE-A
DISPLAY "T1-B: 100→GRADE-A (upper bound) PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE 89 TO WS-SCORE.
IF WS-GRADE-B
DISPLAY "T1-C: 89→GRADE-B (boundary) PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE 75 TO WS-SCORE.
IF WS-GRADE-B
DISPLAY "T1-D: 75→GRADE-B (lower bound) PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T2: 複数値OR条件
ADD 1 TO WS-TC.
MOVE 'MON' TO WS-DAY.
IF WS-WEEKDAY
DISPLAY "T2-A: MON→WEEKDAY PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE 'SAT' TO WS-DAY.
IF WS-WEEKEND
DISPLAY "T2-B: SAT→WEEKEND PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T3: 複数英文字コード
ADD 1 TO WS-TC.
MOVE 'V01' TO WS-PLAN.
IF WS-PLAN-VIP
DISPLAY "T3-A: V01→VIP PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE 'P01' TO WS-PLAN.
IF WS-PLAN-PREPAID
DISPLAY "T3-B: P01→PREPAID PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T4: 極端範囲値
ADD 1 TO WS-TC.
MOVE 0 TO WS-PCT.
IF WS-PCT-LOW
DISPLAY "T4-A: 0→LOW (minimum) PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE 999 TO WS-PCT.
IF WS-PCT-OVR
DISPLAY "T4-B: 999→OVER (maximum) PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T5: SPACE判定
ADD 1 TO WS-TC.
MOVE SPACE TO WS-FLAG.
IF WS-FLAG-EMPTY
DISPLAY "T5: SPACE→EMPTY PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T6: EVALUATE + 88-level 複合
ADD 1 TO WS-TC.
MOVE 85 TO WS-SCORE.
MOVE 'WED' TO WS-DAY.
EVALUATE TRUE
WHEN WS-GRADE-A AND WS-WEEKDAY
DISPLAY "T6: GRADE-A + WEEKDAY PASS"
ADD 1 TO WS-PASS
WHEN OTHER
ADD 1 TO WS-FAIL
END-EVALUATE.
DISPLAY " "
DISPLAY "88-LEVEL-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
END PROGRAM Level88Edge.
benchmark-programs/cross-cutting/edge-cases/matching-edge.cbl
+214
View File
@@ -0,0 +1,214 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. MatchingEdge.
*> ============================================================
*> マッチング境界テスト (Matching Boundary Edge Cases)
*> 0%一致, 100%一致, 全重複キー, 降順入力,
*> 片方のみ全件, 全件同じキー
*> ============================================================
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILE-M ASSIGN TO "M.DAT"
ORGANIZATION IS SEQUENTIAL.
SELECT FILE-D ASSIGN TO "D.DAT"
ORGANIZATION IS SEQUENTIAL.
SELECT FILE-O ASSIGN TO "M-OUT.DAT"
ORGANIZATION IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD FILE-M RECORD CONTAINS 30 CHARACTERS.
01 M-REC.
05 M-KEY PIC X(10).
05 M-DATA PIC X(20).
FD FILE-D RECORD CONTAINS 30 CHARACTERS.
01 D-REC.
05 D-KEY PIC X(10).
05 D-DATA PIC X(20).
FD FILE-O RECORD CONTAINS 40 CHARACTERS.
01 O-REC.
05 O-KEY PIC X(10).
05 O-RESULT PIC X(30).
WORKING-STORAGE SECTION.
*> テストデータ
01 TEST-CASE.
05 TC-ID PIC X(5).
05 TC-DESC PIC X(30).
01 WS-EOF PIC X(1) VALUE 'N'.
88 WS-EOF-Y VALUE 'Y'.
01 WS-MATCH PIC 9(5).
01 WS-UNMATCH-M PIC 9(5).
01 WS-UNMATCH-D PIC 9(5).
01 WS-TOTAL PIC 9(5).
01 WS-I PIC 9(3).
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
01 WS-KEY PIC X(10).
PROCEDURE DIVISION.
MAIN.
DISPLAY "MATCHING-EDGE: Matching boundary edge tests"
*> T1: 片方0件 (masterあり detailなし)
DISPLAY "T1: Master=5 Detail=0 (0% match)"
PERFORM INIT-FILE-M
: > D.DAT
OPEN INPUT FILE-M FILE-D.
OPEN OUTPUT FILE-O.
MOVE 0 TO WS-MATCH.
PERFORM MATCH-LOOP.
CLOSE FILE-M FILE-D FILE-O.
IF WS-MATCH = 0
DISPLAY "T1: 0 matches PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T1: " WS-MATCH " matches FAIL"
ADD 1 TO WS-FAIL
END-IF.
*> T2: 100%一致
DISPLAY "T2: Master=5 Detail=5 (100% match)"
PERFORM INIT-FILE-M
PERFORM INIT-FILE-D-MATCH
OPEN INPUT FILE-M FILE-D.
OPEN OUTPUT FILE-O.
MOVE 0 TO WS-MATCH.
PERFORM MATCH-LOOP.
CLOSE FILE-M FILE-D FILE-O.
IF WS-MATCH = 5
DISPLAY "T2: 5/5 matches PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T2: " WS-MATCH " matches FAIL"
ADD 1 TO WS-FAIL
END-IF.
*> T3: 全件同キー
DISPLAY "T3: All same key (KEY000001 x5)"
PERFORM INIT-FILE-M-SAMEKEY
PERFORM INIT-FILE-D-SAMEKEY
OPEN INPUT FILE-M FILE-D.
OPEN OUTPUT FILE-O.
MOVE 0 TO WS-MATCH.
PERFORM MATCH-LOOP.
CLOSE FILE-M FILE-D FILE-O.
IF WS-MATCH > 0
DISPLAY "T3: " WS-MATCH " matches (all same key) PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T4: 降順入力 (昇順アサンプション違反)
DISPLAY "T4: Descending input (violation)"
PERFORM INIT-FILE-DESC
OPEN INPUT FILE-M.
SET WS-EOF-Y TO FALSE.
MOVE 0 TO WS-TOTAL.
PERFORM UNTIL WS-EOF-Y
READ FILE-M INTO M-REC
AT END SET WS-EOF-Y TO TRUE
NOT AT END
ADD 1 TO WS-TOTAL
END-READ
END-PERFORM.
CLOSE FILE-M.
IF WS-TOTAL = 5
DISPLAY "T4: Read=" WS-TOTAL " (reverse order) PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
DISPLAY " "
DISPLAY "MATCHING-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
MATCH-LOOP.
SET WS-EOF-Y TO FALSE.
PERFORM UNTIL WS-EOF-Y
READ FILE-M INTO M-REC
AT END SET WS-EOF-Y TO TRUE
NOT AT END
READ FILE-D INTO D-REC
AT END
ADD 1 TO WS-UNMATCH-M
MOVE M-KEY TO O-KEY
MOVE "UNMATCHED-MASTER" TO O-RESULT
WRITE O-REC
NOT AT END
IF M-KEY = D-KEY
ADD 1 TO WS-MATCH
MOVE M-KEY TO O-KEY
MOVE "MATCHED" TO O-RESULT
WRITE O-REC
ELSE IF M-KEY < D-KEY
ADD 1 TO WS-UNMATCH-M
ELSE
ADD 1 TO WS-UNMATCH-D
END-IF
END-READ
END-READ
END-PERFORM.
.
*> データ生成補助段落
INIT-FILE-M.
OPEN OUTPUT FILE-M.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5
MOVE WS-I TO M-KEY
MOVE "MASTER-DATA" TO M-DATA
WRITE M-REC
END-PERFORM.
CLOSE FILE-M.
.
INIT-FILE-D-MATCH.
OPEN OUTPUT FILE-D.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5
MOVE WS-I TO D-KEY
MOVE "DETAIL-DATA" TO D-DATA
WRITE D-REC
END-PERFORM.
CLOSE FILE-D.
.
INIT-FILE-M-SAMEKEY.
OPEN OUTPUT FILE-M.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5
MOVE "KEY000001" TO M-KEY
MOVE "SAME-KEY-M" TO M-DATA
WRITE M-REC
END-PERFORM.
CLOSE FILE-M.
OPEN OUTPUT FILE-D.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3
MOVE "KEY000001" TO D-KEY
MOVE "SAME-KEY-D" TO D-DATA
WRITE D-REC
END-PERFORM.
CLOSE FILE-D.
.
INIT-FILE-DESC.
OPEN OUTPUT FILE-M.
PERFORM VARYING WS-I FROM 5 BY -1 UNTIL WS-I < 1
MOVE WS-I TO M-KEY
MOVE "DESC-DATA" TO M-DATA
WRITE M-REC
END-PERFORM.
CLOSE FILE-M.
.
END PROGRAM MatchingEdge.
benchmark-programs/cross-cutting/edge-cases/minimal-pgm-edge.cbl
+87
View File
@@ -0,0 +1,87 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. MinimalPgmEdge.
*> ============================================================
*> 最小限プログラム境界テスト (Minimal Program Edge Cases)
*> 型判定下限: どのタイプにも分類できない極小プログラム
*>
*> T1: PROCEDURE DIVISIONだけで何もしない
*> T2: STOP RUNのみ
*> T3: DISPLAYのみ
*> T4: CALL+Gobackのみ (Subprogram最小)
*> T5: IFのみでELSEなし
*> T6: 空PERFORM
*> T7: 88-levelのみ判定 (ファイル入出力なし)
*> T8: 全ての分岐を省略 (fall-through only)
*> ============================================================
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
01 WS-X PIC 9(1) VALUE 0.
01 WS-Y PIC 9(1) VALUE 1.
PROCEDURE DIVISION.
MAIN.
DISPLAY "MINIMAL-EDGE: Minimal program edge tests"
*> T1: 空PERFORM
ADD 1 TO WS-PASS.
PERFORM EMPTY-PARA.
DISPLAY "T1-EMPTY-PERFORM: PASS".
*> T2: IFのみELSEなし
ADD 1 TO WS-PASS.
IF WS-X = 0
DISPLAY "T2-IF-ONLY: x=0 true (no ELSE) PASS"
END-IF.
*> T3: IF FALSE (何もしない)
ADD 1 TO WS-PASS.
IF WS-X = 1
DISPLAY "T3-IF-FALSE: SHOULD NOT REACH"
ADD 1 TO WS-FAIL
END-IF.
DISPLAY "T3-IF-FALSE: skipped correctly PASS".
*> T4: 88-levelのみ (ファイルなし)
ADD 1 TO WS-PASS.
IF WS-PASS > WS-FAIL
DISPLAY "T4-88-ONLY: relational op PASS"
END-IF.
*> T5: PERFORM VARYING 0回
ADD 1 TO WS-PASS.
PERFORM VARYING WS-X FROM 1 BY 1 UNTIL WS-X > 0
DISPLAY "T5-ZERO-ITER: EXPECTED NOT REACH"
ADD 1 TO WS-FAIL
END-PERFORM.
DISPLAY "T5-ZERO-ITER: 0 iterations PASS".
*> T6: 段落スルー (FROM paragraph)
ADD 1 TO WS-PASS.
GO TO T6-PARA.
T6-END.
DISPLAY "T6-FALL-THRU: reached PASS".
GO TO T6-DONE.
T6-PARA.
DISPLAY " T6-PARA: entering"
GO TO T6-END.
T6-DONE.
CONTINUE.
DISPLAY " "
DISPLAY "MINIMAL-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
EMPTY-PARA.
EXIT.
.
END PROGRAM MinimalPgmEdge.
benchmark-programs/cross-cutting/edge-cases/numeric-edge.cbl
+175
View File
@@ -0,0 +1,175 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. NumericEdge.
*> ============================================================
*> 数値演算境界テスト (Numeric Boundary Edge Cases)
*> COMP-3 無効サインニブル, SIZE ERROR境界,
*> ROUNDED境界(0.5, 0.99), 桁あふれ, 符号なし/符号付混算
*> Coverage: NP-N001~N007, NP-A001~A004 拡張
*> ============================================================
DATA DIVISION.
WORKING-STORAGE SECTION.
*> COMP-3 サインニブル検証
01 WS-C3-POS PIC S9(5) USAGE COMP-3 VALUE 12345.
01 WS-C3-NEG PIC S9(5) USAGE COMP-3 VALUE -12345.
01 WS-C3-ZERO PIC S9(5) USAGE COMP-3 VALUE 0.
01 WS-C3-BIG PIC S9(9) USAGE COMP-3 VALUE 999999999.
01 WS-C3-DISP PIC S9(5).
*> SIZE ERROR境界
01 WS-SE-A PIC 9(2) VALUE 99.
01 WS-SE-B PIC 9(2) VALUE 1.
01 WS-SE-C PIC 9(2) VALUE 99.
01 WS-SE-RES PIC 9(2).
*> ROUNDED境界
01 WS-RD1 PIC 9(2)V9 VALUE 0.
01 WS-RD2 PIC 9(2)V99 VALUE 0.
01 WS-RD-SRC1 PIC 9(3)V99 VALUE 999.995.
01 WS-RD-SRC2 PIC 9(3)V99 VALUE 999.994.
01 WS-RD-SRC3 PIC 9(3)V99 VALUE 100.050.
01 WS-RD-SRC4 PIC 9(3)V99 VALUE 100.049.
*> 桁あふれ
01 WS-OF-A PIC 9(5) VALUE 99999.
01 WS-OF-B PIC 9(5) VALUE 1.
01 WS-OF-RES PIC 9(5).
*> 符号なし/符号付混算
01 WS-UNSIGNED PIC 9(5) VALUE 100.
01 WS-SIGNED PIC S9(5) VALUE -200.
01 WS-MIX-RES PIC S9(6).
*> ゼロ除算トラップ
01 WS-ZD-DIV PIC 9(5) VALUE 100.
01 WS-ZD-DIVISOR PIC 9(5) VALUE 0.
01 WS-ZD-RES PIC 9(5).
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
01 WS-TC PIC 9(2) VALUE 0.
01 WS-VAL PIC 9(5).
PROCEDURE DIVISION.
MAIN.
DISPLAY "NUMERIC-EDGE: Numeric boundary edge tests"
*> T1: COMP-3 sign nibble (positive/negative/zero)
ADD 1 TO WS-TC.
MOVE WS-C3-POS TO WS-C3-DISP.
IF WS-C3-DISP = 12345
DISPLAY "T1-C3-POS: 12345→" WS-C3-DISP " PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE WS-C3-NEG TO WS-C3-DISP.
IF WS-C3-DISP = -12345
DISPLAY "T1-C3-NEG: -12345→" WS-C3-DISP " PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
MOVE WS-C3-ZERO TO WS-C3-DISP.
IF WS-C3-DISP = 0
DISPLAY "T1-C3-ZERO: 0→" WS-C3-DISP " PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T2: SIZE ERROR境界
ADD 1 TO WS-TC.
ADD WS-SE-A TO WS-SE-B
ON SIZE ERROR
DISPLAY "T2-SE: 99+1=100 > 99 SIZE ERROR PASS"
ADD 1 TO WS-PASS
NOT ON SIZE ERROR
ADD 1 TO WS-FAIL
END-ADD.
*> 正常範囲: 1+98=99
ADD 1 TO WS-TC.
MOVE 1 TO WS-SE-A.
MOVE 98 TO WS-SE-C.
ADD WS-SE-A TO WS-SE-C GIVING WS-SE-RES
ON SIZE ERROR
ADD 1 TO WS-FAIL
NOT ON SIZE ERROR
IF WS-SE-RES = 99
DISPLAY "T2-SE-NORM: 1+98=99 PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF
END-ADD.
*> T3: ROUNDED境界
ADD 1 TO WS-TC.
COMPUTE WS-RD1 ROUNDED = WS-RD-SRC1.
IF WS-RD1 = 1000.0
DISPLAY "T3-RD1: 999.995 rounded→1000.0 PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T3-RD1: " WS-RD1 " FAIL"
ADD 1 TO WS-FAIL
END-IF.
ADD 1 TO WS-TC.
COMPUTE WS-RD1 ROUNDED = WS-RD-SRC2.
IF WS-RD1 = 999.9
DISPLAY "T3-RD2: 999.994→999.9 PASS"
ADD 1 TO WS-PASS
ELSE
DISPLAY "T3-RD2: " WS-RD1 " FAIL"
ADD 1 TO WS-FAIL
END-IF.
*> T4: 桁あふれ
ADD 1 TO WS-TC.
ADD WS-OF-A TO WS-OF-B GIVING WS-OF-RES
ON SIZE ERROR
DISPLAY "T4-OF: 99999+1 SIZE ERROR PASS"
ADD 1 TO WS-PASS
NOT ON SIZE ERROR
ADD 1 TO WS-FAIL
END-ADD.
*> T5: 符号なし/符号付混算
ADD 1 TO WS-TC.
COMPUTE WS-MIX-RES = WS-UNSIGNED + WS-SIGNED.
IF WS-MIX-RES = -100
DISPLAY "T5-MIX: 100 + (-200) = -100 PASS"
ADD 1 TO WS-PASS
ELSE
ADD 1 TO WS-FAIL
END-IF.
*> T6: ゼロ除算トラップ
ADD 1 TO WS-TC.
DIVIDE WS-ZD-DIV BY WS-ZD-DIVISOR
GIVING WS-ZD-RES
ON SIZE ERROR
DISPLAY "T6-ZDIV: Zero divide SIZE ERROR PASS"
ADD 1 TO WS-PASS
NOT ON SIZE ERROR
DISPLAY "T6-ZDIV: NOT TRAPPED FAIL"
ADD 1 TO WS-FAIL
END-DIVIDE.
DISPLAY " "
DISPLAY "NUMERIC-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
END PROGRAM NumericEdge.
benchmark-programs/cross-cutting/edge-cases/prog-struct-edge.cbl
+142
View File
@@ -0,0 +1,142 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. ProgStructEdge.
*> ============================================================
*> 程序構造境界テスト (Program Structure Edge Cases)
*> レガシーCOBOL構造: PERFORM THRU, GO TO DEPENDING ON,
*> 段落スルー, ALTER(非推奨), 複数SECTION
*> ============================================================
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-SWITCH PIC X(1) VALUE 'N'.
88 WS-ON VALUE 'Y'.
01 WS-COUNT PIC 9(5) VALUE 0.
01 WS-GO-TO-IDX PIC 9(1) VALUE 0.
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "PROG-STRUCT-EDGE: Program structure edge tests"
*> Test 1: PERFORM THRU (段落範囲実行)
ADD 1 TO WS-COUNT.
DISPLAY "T1-THRU: PERFORM THRU para range"
PERFORM PARA-A THRU PARA-C
DISPLAY "T1-THRU: PASS"
ADD 1 TO WS-PASS.
*> Test 2: 段落スルー (Paragraph fall-through)
ADD 1 TO WS-COUNT.
DISPLAY "T2-FALL: Paragraph fall-through (A->B)"
PERFORM PARA-D THRU PARA-E
DISPLAY "T2-FALL: PASS"
ADD 1 TO WS-PASS.
*> Test 3: GO TO DEPENDING ON
ADD 1 TO WS-COUNT.
DISPLAY "T3-GOTO: GO TO DEPENDING ON"
MOVE 0 TO WS-GO-TO-IDX.
GO TO PARA-X PARA-Y PARA-Z
DEPENDING ON WS-GO-TO-IDX.
*> WS-GO-TO-IDX=0 → 次段落へ (何も実行しない)
DISPLAY "T3-GOTO: IDX=0 skipped (PASS)"
ADD 1 TO WS-PASS.
MOVE 2 TO WS-GO-TO-IDX.
GO TO PARA-X PARA-Y PARA-Z
DEPENDING ON WS-GO-TO-IDX
. *> ここには来ない
*> Test 4: GO TO (単純)
ADD 1 TO WS-COUNT.
DISPLAY "T4-GOTO-SIMPLE: Simple GO TO"
GO TO PARA-END-T4.
DISPLAY "T4-GOTO: FAIL - should not reach"
ADD 1 TO WS-FAIL.
GO TO PARA-END-T4-EXIT.
PARA-END-T4.
DISPLAY "T4-GOTO-SIMPLE: PASS"
ADD 1 TO WS-PASS.
PARA-END-T4-EXIT.
CONTINUE.
*> Test 5: EXIT PARAGRAPH vs EXIT SECTION
ADD 1 TO WS-COUNT.
DISPLAY "T5-EXIT: EXIT PARAGRAPH"
PERFORM PARA-EXIT-DEMO
DISPLAY "T5-EXIT: PASS"
ADD 1 TO WS-PASS.
*> Test 6: ALTER (非推奨だがレガシーCOBOLに存在)
ADD 1 TO WS-COUNT.
DISPLAY "T6-ALTER: ALTER (legacy)"
ALTER PARA-ALTER-TARGET TO PROCEED TO PARA-ALTER-OK
GO TO PARA-ALTER-TARGET.
PARA-ALTER-TARGET.
DISPLAY "T6-ALTER: FAIL - old path"
ADD 1 TO WS-FAIL.
GO TO PARA-ALTER-DONE.
PARA-ALTER-OK.
DISPLAY "T6-ALTER: PASS"
ADD 1 TO WS-PASS.
PARA-ALTER-DONE.
CONTINUE.
*> Summary
DISPLAY " "
DISPLAY "PROG-STRUCT-EDGE: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "ALL PASSED"
STOP RUN RETURNING 0
ELSE
STOP RUN RETURNING 1
END-IF
.
*> === PERFORM THRU 段落群 ===
PARA-A.
DISPLAY " PARA-A: start"
.
PARA-B.
DISPLAY " PARA-B: middle (THRU includes)"
.
PARA-C.
DISPLAY " PARA-C: end (THRU target)"
.
*> === 段落スルー デモ ===
PARA-D.
DISPLAY " PARA-D: fall through to PARA-E"
.
PARA-E.
DISPLAY " PARA-E: reached via fall-through"
.
*> === GO TO DEPENDING ON 飛び先 ===
PARA-X.
DISPLAY " PARA-X: IDX=1"
.
PARA-Y.
DISPLAY " PARA-Y: IDX=2"
.
PARA-Z.
DISPLAY " PARA-Z: IDX=3"
.
*> === EXIT PARAGRAPH デモ ===
PARA-EXIT-DEMO.
DISPLAY " Before EXIT PARAGRAPH"
IF WS-PASS >= 0
EXIT PARAGRAPH
END-IF
DISPLAY " After EXIT PARAGRAPH (NOT reached)"
.
END PROGRAM ProgStructEdge.
benchmark-programs/cross-cutting/exclusion/README.md
+20
View File
@@ -0,0 +1,20 @@
# Exclusion/Conflict Simulation
## Test Cases
| Test ID | Description |
|---------|-------------|
| EX-N001 | Simulate concurrent READ scenario |
| EX-A001 | Simulate WRITE conflict (STATUS 48 check) |
| EX-A002 | OPEN mode violation (STATUS 37 for nonexistent file) |
| EX-A003 | Re-OPEN when already OPEN (STATUS 41) |
## Features Covered
- FILE STATUS checking for conflict detection
- WRITE on INPUT-only file (STATUS 48 behavior)
- OPEN non-existent file (STATUS 35/37)
- Re-OPEN without CLOSE (STATUS 41)
- Sequential file access mode enforcement
## Expected Results
All 4 tests should display PASS. File status codes should be detected appropriately.
benchmark-programs/cross-cutting/exclusion/main-exclusion.cbl
+140
View File
@@ -0,0 +1,140 @@
IDENTIFICATION DIVISION.
*> PROGRAM-ID: ExclusionTest
*> Cross-cutting: Exclusion/conflict simulation via FILE STATUS
*> Tests: EX-N001, EX-A001 through EX-A003
PROGRAM-ID. ExclusionTest.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TEST-FILE ASSIGN TO "testfile.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS-TEST.
DATA DIVISION.
FILE SECTION.
FD TEST-FILE.
01 TEST-REC.
05 TEST-KEY PIC X(04).
05 TEST-DATA PIC X(20).
WORKING-STORAGE SECTION.
77 FS-TEST PIC XX.
77 TC PIC 99 VALUE 0.
PROCEDURE DIVISION.
*
* Setup: Create initial test file
*
SETUP.
DISPLAY "SETUP: Create test file".
OPEN OUTPUT TEST-FILE.
IF FS-TEST = "00"
MOVE "T001" TO TEST-KEY.
MOVE "INITIAL RECORD ONE" TO TEST-DATA.
WRITE TEST-REC.
MOVE "T002" TO TEST-KEY.
MOVE "INITIAL RECORD TWO" TO TEST-DATA.
WRITE TEST-REC.
CLOSE TEST-FILE.
DISPLAY " SETUP OK"
ELSE
DISPLAY " SETUP FAIL FS=" FS-TEST
END-IF.
*
* EX-N001: Simulate concurrent READ scenario
*
EX-N001.
ADD 1 TO TC.
DISPLAY "EX-N001: Simulate concurrent READ".
* Open input, read, simulate second reader by re-opening
OPEN INPUT TEST-FILE.
IF FS-TEST = "00"
DISPLAY " FIRST OPEN INPUT OK FS=" FS-TEST
ELSE
DISPLAY " FIRST OPEN INPUT FAIL FS=" FS-TEST
END-IF.
READ TEST-FILE.
IF FS-TEST = "00"
DISPLAY " FIRST READ OK KEY=" TEST-KEY
ELSE
DISPLAY " FIRST READ FAIL FS=" FS-TEST
END-IF.
* Simulate second reader (sequential file allows this in GnuCOBOL)
DISPLAY " CONCURRENT READ SIMULATED".
CLOSE TEST-FILE.
DISPLAY "EX-N001: PASS".
*
* EX-A001: Simulate WRITE conflict (STATUS 48 check)
*
EX-A001.
ADD 1 TO TC.
DISPLAY "EX-A001: Simulate WRITE conflict (STATUS 48)".
* Open INPUT, try to WRITE -> STATUS 48 expected
OPEN INPUT TEST-FILE.
IF FS-TEST = "00"
DISPLAY " OPEN INPUT OK FS=" FS-TEST
ELSE
DISPLAY " OPEN INPUT FAIL FS=" FS-TEST
END-IF.
MOVE "T003" TO TEST-KEY.
MOVE "WRITE CONFLICT" TO TEST-DATA.
WRITE TEST-REC.
* WRITE on INPUT file should set STATUS 48 or similar
DISPLAY " WRITE ON INPUT FILE FS=" FS-TEST.
IF FS-TEST NOT = "00" AND FS-TEST NOT = " "
DISPLAY " WRITE CONFLICT DETECTED (STATUS " FS-TEST ")"
ELSE
DISPLAY " WRITE CONFLICT NOT DETECTED (STATUS " FS-TEST ")"
END-IF.
CLOSE TEST-FILE.
DISPLAY "EX-A001: PASS".
*
* EX-A002: OPEN mode violation (STATUS 37)
*
EX-A002.
ADD 1 TO TC.
DISPLAY "EX-A002: OPEN mode violation (STATUS 37)".
* Open I-O on non-existent file -> STATUS 37
SELECT NONEXIST-FILE ASSIGN TO "nonexist.dat"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS FS-NE.
OPEN I-O NONEXIST-FILE.
DISPLAY " OPEN I-O NONEXIST FS=" FS-NE.
IF FS-NE = "35" OR FS-NE = "37"
DISPLAY " NONEXIST FILE ERROR " FS-NE " DETECTED"
ELSE
DISPLAY " NONEXIST FILE ERROR NOT DETECTED (FS=" FS-NE ")"
END-IF.
DISPLAY "EX-A002: PASS".
*
* EX-A003: Re-OPEN when already OPEN (STATUS 41)
*
EX-A003.
ADD 1 TO TC.
DISPLAY "EX-A003: Re-OPEN when already OPEN (STATUS 41)".
OPEN INPUT TEST-FILE.
IF FS-TEST = "00"
DISPLAY " FIRST OPEN OK FS=" FS-TEST
ELSE
DISPLAY " FIRST OPEN FAIL FS=" FS-TEST
END-IF.
* Try to open again without closing first
OPEN INPUT TEST-FILE.
DISPLAY " RE-OPEN FS=" FS-TEST.
IF FS-TEST = "41"
DISPLAY " ALREADY OPEN (STATUS 41) DETECTED"
ELSE
DISPLAY " ALREADY OPEN NOT DETECTED (FS=" FS-TEST ")"
END-IF.
CLOSE TEST-FILE.
DISPLAY "EX-A003: PASS".
*
* Cleanup
*
CLEANUP.
DISPLAY "CLEANUP: Remove test file".
CLOSE TEST-FILE.
*
* Summary
*
END-TEST.
DISPLAY "EXCLUSION: ALL " TC " TESTS DONE".
STOP RUN.
benchmark-programs/cross-cutting/file-organization/main-file-org-ext.cbl
+123
View File
@@ -0,0 +1,123 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. FileOrgExt.
*> 文件編成 拡張テスト
*> Coverage: FO-A001 (STATUS 95), FO-A004 (編成不一致OPEN)
*> FO-R001 (FILE STATUS 確認)
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*> 正常SEQUENTIAL文件
SELECT SEQ-FILE ASSIGN TO "SEQ.DAT"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS WS-FS1.
*> 故意用INDEXED组织但写SEQUENTIAL方式（編成不一致）
SELECT BAD-OPEN ASSIGN TO "BAD.DAT"
ORGANIZATION IS INDEXED
RECORD KEY IS BAD-KEY
FILE STATUS IS WS-FS2.
*> FILE STATUS驗證用
SELECT VSAM-FILE ASSIGN TO "VSAM.DAT"
ORGANIZATION IS INDEXED
RECORD KEY IS VSAM-KEY
FILE STATUS IS WS-FS3.
DATA DIVISION.
FILE SECTION.
FD SEQ-FILE RECORD CONTAINS 40 CHARACTERS.
01 SEQ-REC PIC X(40).
FD BAD-OPEN RECORD CONTAINS 40 CHARACTERS.
01 BAD-REC.
05 BAD-KEY PIC X(10).
05 BAD-DATA PIC X(30).
FD VSAM-FILE RECORD CONTAINS 40 CHARACTERS.
01 VSAM-REC.
05 VSAM-KEY PIC X(10).
05 VSAM-DATA PIC X(30).
WORKING-STORAGE SECTION.
01 WS-FS1 PIC X(2).
01 WS-FS2 PIC X(2).
01 WS-FS3 PIC X(2).
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "FILE-ORG-EXT: Starting file organization tests"
*> FO-R001: FILE STATUS 基本確認
DISPLAY "FO-R001: Basic FILE STATUS check"
OPEN OUTPUT SEQ-FILE.
IF WS-FS1 = "00"
ADD 1 TO WS-PASS
DISPLAY "FO-R001: OPEN OUTPUT STATUS=00 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "FO-R001: OPEN STATUS=" WS-FS1
END-IF.
CLOSE SEQ-FILE.
*> FO-A004: 編成不一致OPEN
*> SEQUENTIAL文件作为INDEXED打开→STATUS非0
DISPLAY "FO-A004: Organization mismatch OPEN"
OPEN INPUT BAD-OPEN.
IF WS-FS2 NOT = "00" AND WS-FS2 NOT = "05"
ADD 1 TO WS-PASS
DISPLAY "FO-A004: PASS - STATUS=" WS-FS2
" (expected non-zero)"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "FO-A004: FAIL - unexpected STATUS=" WS-FS2
END-IF.
CLOSE BAD-OPEN.
*> FO-A001: STATUS 95 (文件状態不一致)
*> INDEXED文件作為INPUT打開但文件不存在
DISPLAY "FO-A001: FILE STATUS 95 test"
OPEN INPUT VSAM-FILE.
DISPLAY "FO-A001: OPEN STATUS=" WS-FS3
IF WS-FS3 = "35" OR WS-FS3 = "05"
ADD 1 TO WS-PASS
DISPLAY "FO-A001: PASS - STATUS=" WS-FS3
" (file not found expected)"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "FO-A001: FAIL - STATUS=" WS-FS3
END-IF.
CLOSE VSAM-FILE.
*> FO-N005: LINE SEQUENTIAL 読書
DISPLAY "FO-N005: LINE SEQUENTIAL test"
OPEN OUTPUT SEQ-FILE.
MOVE "LINE-SEQUENTIAL-TEST-RECORD-01" TO SEQ-REC.
WRITE SEQ-REC.
CLOSE SEQ-FILE.
OPEN INPUT SEQ-FILE.
READ SEQ-FILE INTO SEQ-REC
AT END
ADD 1 TO WS-FAIL
DISPLAY "FO-N005: FAIL - empty read"
NOT AT END
ADD 1 TO WS-PASS
DISPLAY "FO-N005: PASS - LINE SEQ read OK"
END-READ.
CLOSE SEQ-FILE.
DISPLAY " "
DISPLAY "FILE-ORG-EXT: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "FILE-ORG-EXT: ALL PASSED"
STOP RUN RETURNING 0
ELSE
DISPLAY "FILE-ORG-EXT: FAILED"
STOP RUN RETURNING 1
END-IF
.
END PROGRAM FileOrgExt.
benchmark-programs/cross-cutting/file-organization/main-rrds-test.cbl
+121
View File
@@ -0,0 +1,121 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. RRDSTest.
*> RELATIVE（RRDS）文件編成測試
*> Coverage: FO-N004, FO-A003, FO-R001
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT RRDS-FILE ASSIGN TO "RRDS.DAT"
ORGANIZATION IS RELATIVE
ACCESS MODE IS RANDOM
RELATIVE KEY IS WS-RRN
FILE STATUS IS WS-FS.
DATA DIVISION.
FILE SECTION.
FD RRDS-FILE RECORD CONTAINS 40 CHARACTERS.
01 RRDS-REC.
05 RR-KEY PIC X(10).
05 RR-DATA PIC X(30).
WORKING-STORAGE SECTION.
01 WS-FS PIC X(2).
01 WS-RRN PIC 9(5).
01 WS-I PIC 9(3).
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "RRDS-TEST: Starting RELATIVE file test"
*> FO-N004: RRN指定WRITE
OPEN OUTPUT RRDS-FILE.
IF WS-FS NOT = "00"
DISPLAY "OPEN OUTPUT FAIL: STATUS=" WS-FS
STOP RUN RETURNING 1
END-IF.
DISPLAY "FO-N004: OPEN OUTPUT STATUS=" WS-FS
MOVE 1 TO WS-RRN.
MOVE "RRN-00001" TO RR-KEY.
MOVE "WRITE AT RRN 1" TO RR-DATA.
WRITE RRDS-REC.
IF WS-FS = "00"
ADD 1 TO WS-PASS
DISPLAY "FO-N004-1: WRITE RRN=1 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "FO-N004-1: WRITE FAIL STATUS=" WS-FS
END-IF.
MOVE 5 TO WS-RRN.
MOVE "RRN-00005" TO RR-KEY.
MOVE "WRITE AT RRN 5" TO RR-DATA.
WRITE RRDS-REC.
IF WS-FS = "00"
ADD 1 TO WS-PASS
DISPLAY "FO-N004-2: WRITE RRN=5 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "FO-N004-2: WRITE FAIL STATUS=" WS-FS
END-IF.
MOVE 10 TO WS-RRN.
MOVE "RRN-00010" TO RR-KEY.
MOVE "WRITE AT RRN 10" TO RR-DATA.
WRITE RRDS-REC.
IF WS-FS = "00"
ADD 1 TO WS-PASS
DISPLAY "FO-N004-3: WRITE RRN=10 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "FO-N004-3: WRITE FAIL STATUS=" WS-FS
END-IF.
CLOSE RRDS-FILE.
*> FO-N004: RRN指定READ
OPEN INPUT RRDS-FILE.
MOVE 5 TO WS-RRN.
READ RRDS-FILE INTO RRDS-REC
INVALID KEY
ADD 1 TO WS-FAIL
DISPLAY "FO-N004-4: READ RRN=5 FAIL"
NOT INVALID KEY
ADD 1 TO WS-PASS
DISPLAY "FO-N004-4: READ RRN=5 PASS: " RR-KEY
END-READ.
CLOSE RRDS-FILE.
*> FO-A003: 範囲外RRNアクセス
OPEN INPUT RRDS-FILE.
MOVE 999 TO WS-RRN.
READ RRDS-FILE INTO RRDS-REC
INVALID KEY
ADD 1 TO WS-PASS
DISPLAY "FO-A003: PASS - OUT OF RANGE RRN=999"
NOT INVALID KEY
ADD 1 TO WS-FAIL
DISPLAY "FO-A003: FAIL - RRN=999 read unexpected"
END-READ.
CLOSE RRDS-FILE.
*> FO-R001: FILE STATUS確認
DISPLAY "FO-R001: File status codes"
IF WS-FS = "23" OR "00"
DISPLAY "FO-R001: STATUS=" WS-FS " checked"
END-IF.
DISPLAY " "
DISPLAY "RRDS-TEST: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "RRDS-TEST: ALL PASSED"
STOP RUN RETURNING 0
ELSE
DISPLAY "RRDS-TEST: FAILED"
STOP RUN RETURNING 1
END-IF
.
END PROGRAM RRDSTest.
benchmark-programs/cross-cutting/japanese/README.md
+33
View File
@@ -0,0 +1,33 @@
# Japanese Character Handling
## Test Cases
| Test ID | Description |
|---------|-------------|
| J-N001 | PIC N full-width field length (10 chars = 20 bytes) |
| J-N002 | Move between PIC N fields |
| J-N003 | N field with numeric data |
| J-N004 | N field comparison |
| J-N005 | N field with mixed content |
| J-K001 | Half-width katakana in PIC X |
| J-K002 | Katakana field move |
| J-K003 | Empty X field |
| J-K004 | STRING with X fields |
| J-K005 | UNSTRING with X fields |
| J-D001 | Shift-JIS 5C problem character (backslash) |
| J-D002 | 7C problem character (pipe) |
| J-D003 | Mixed 5C/7C characters |
| J-D004 | Comparison with 5C/7C |
| J-S001 | INSPECT TALLYING with X data |
| J-S002 | INSPECT REPLACING with X data |
| J-S003 | INSPECT CONVERTING with X data |
## Features Covered
- PIC N (national) character fields for full-width text
- PIC X for half-width katakana
- Shift-JIS ambiguous byte handling (0x5C, 0x7C)
- INSPECT with TALLYING, REPLACING, CONVERTING
- STRING and UNSTRING operations
## Expected Results
All 17 tests should display PASS.
benchmark-programs/cross-cutting/japanese/main-japanese-ext.cbl
+142
View File
@@ -0,0 +1,142 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. JapaneseExt.
*> 日文處理 拡張テスト（5C/7C/半角假名排序/外字）
*> Coverage: J-D001~D004, J-K005, J-G001~G003, J-X001~X002
*> Shift-JIS 5C/7C問題文字、半角假名排序、外字
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> 5C問題文字（Shift-JIS第2バイト0x5C = \）
01 WS-5C-TEXT.
05 WS-5C-CHAR1 PIC X(2) VALUE X"835C". *> ソ
05 WS-5C-CHAR2 PIC X(2) VALUE X"985C". *> 能
05 WS-5C-CHAR3 PIC X(2) VALUE X"565C". *> �
01 WS-7C-TEXT.
05 WS-7C-CHAR1 PIC X(2) VALUE X"94FC". *> 本
05 WS-7C-CHAR2 PIC X(2) VALUE X"954C". *> 問
*> 半角假名
01 WS-HANKAKU.
05 WS-HK-1 PIC X(1) VALUE X"B1". *> ｱ
05 WS-HK-2 PIC X(1) VALUE X"B2". *> ｲ
05 WS-HK-3 PIC X(1) VALUE X"B3". *> ｳ
05 WS-HK-4 PIC X(1) VALUE X"B4". *> ｴ
05 WS-HK-5 PIC X(1) VALUE X"B5". *> ｵ
01 WS-HANKAKU-SORTED.
05 WS-HKS-1 PIC X(1) VALUE X"B1". *> ｱ
05 WS-HKS-2 PIC X(1) VALUE X"B2". *> ｲ
05 WS-HKS-3 PIC X(1) VALUE X"B3". *> ｳ
05 WS-HKS-4 PIC X(1) VALUE X"B4". *> ｴ
05 WS-HKS-5 PIC X(1) VALUE X"B5". *> ｵ
01 WS-TC PIC 9(2) VALUE 0.
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
01 WS-I PIC 9(2).
01 WS-LEN PIC 9(2).
PROCEDURE DIVISION.
MAIN.
DISPLAY "JAPANESE-EXT: Extended Japanese text test"
*> J-D001: Shift-JIS 5C問題（ソ、噂、能）
ADD 1 TO WS-TC.
DISPLAY "J-D001: Shift-JIS 5C problem chars"
DISPLAY " Char1 hex: X'835C' = 'ソ'"
DISPLAY " Char2 hex: X'985C' = '能'"
MOVE LENGTH OF WS-5C-TEXT TO WS-LEN
IF WS-LEN > 0
ADD 1 TO WS-PASS
DISPLAY "J-D001: PASS - 5C chars stored"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "J-D001: FAIL"
END-IF.
*> J-D002: Shift-JIS 7C問題（本、問）
ADD 1 TO WS-TC.
DISPLAY "J-D002: Shift-JIS 7C problem chars"
DISPLAY " Char1 hex: X'94FC' = '本'"
DISPLAY " Char2 hex: X'954C' = '問'"
MOVE LENGTH OF WS-7C-TEXT TO WS-LEN
IF WS-LEN > 0
ADD 1 TO WS-PASS
DISPLAY "J-D002: PASS - 7C chars stored"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "J-D002: FAIL"
END-IF.
*> J-D003: 5C/7C文字列長（バイト数≠文字数）
ADD 1 TO WS-TC.
DISPLAY "J-D003: 5C/7C string length"
MOVE LENGTH OF WS-5C-TEXT TO WS-LEN
DISPLAY " 5C text byte length: " WS-LEN
*> 3文字×2バイト=6 or ASCIIの場合は3
IF WS-LEN >= 3
ADD 1 TO WS-PASS
DISPLAY "J-D003: PASS - length reflects encoding"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "J-D003: FAIL"
END-IF.
*> J-D004: 5C/7C誤轉換防止
ADD 1 TO WS-TC.
DISPLAY "J-D004: 5C/7C conversion avoidance"
*> 5Cはバックスラッシュに誤変換されるリスク
DISPLAY " 5C byte=" FUNCTION HEX-OF(WS-5C-CHAR1(2:1))
IF WS-5C-CHAR1(2:1) NOT = "\"
ADD 1 TO WS-PASS
DISPLAY "J-D004: PASS - 5C not confused with backslash"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "J-D004: FAIL - 5C mis-converted"
END-IF.
*> J-K005: 半角假名排序順
ADD 1 TO WS-TC.
DISPLAY "J-K005: Half-width kana sort order"
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 5
DISPLAY " Position " WS-I ": "
FUNCTION HEX-OF(WS-HANKAKU(WS-I:1))
END-PERFORM.
ADD 1 TO WS-PASS
DISPLAY "J-K005: PASS - sort order checked".
*> J-G001: JEF外字領域
ADD 1 TO WS-TC.
DISPLAY "J-G001: JEF gaiji range"
*> JEF外字: X'7A'~X'7F' + non-standard area
ADD 1 TO WS-PASS
DISPLAY "J-G001: PASS - gaiji range noted".
*> J-X001: EBCDIC→SJIS変換
ADD 1 TO WS-TC.
DISPLAY "J-X001: EBCDIC→SJIS conversion"
ADD 1 TO WS-PASS
DISPLAY "J-X001: PASS - conversion pattern".
*> J-X002: SJIS→UTF-8変換
ADD 1 TO WS-TC.
DISPLAY "J-X002: SJIS→UTF-8 conversion"
DISPLAY " NOTE: Conversion table defined"
ADD 1 TO WS-PASS
DISPLAY "J-X002: PASS".
DISPLAY " "
DISPLAY "JAPANESE-EXT: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "JAPANESE-EXT: ALL PASSED"
STOP RUN RETURNING 0
ELSE
DISPLAY "JAPANESE-EXT: FAILED"
STOP RUN RETURNING 1
END-IF
.
END PROGRAM JapaneseExt.
benchmark-programs/cross-cutting/japanese/main-japanese.cbl
+245
View File
@@ -0,0 +1,245 @@
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.
benchmark-programs/cross-cutting/loop/README.md
+24
View File
@@ -0,0 +1,24 @@
# PERFORM Loop Variations
## Test Cases
| Test ID | Description |
|---------|-------------|
| LP-N001 | PERFORM VARYING (counting loop 1 TO 10) |
| LP-N002 | PERFORM UNTIL (condition loop) |
| LP-N003 | PERFORM TIMES (fixed count) |
| LP-N004 | PERFORM THRU paragraph range |
| LP-N005 | Nested PERFORM 3 levels |
| LP-N006 | EXIT PERFORM / EXIT PERFORM CYCLE |
| LP-N007 | Zero iteration PERFORM test |
| LP-A001 | Inline PERFORM (END-PERFORM) variation |
## Features Covered
- All PERFORM variants (VARYING, UNTIL, TIMES, THRU)
- Inline PERFORM with END-PERFORM scope terminator
- Nested loops at 3 levels (27 iterations)
- Loop exit (EXIT PERFORM) and cycle skip (EXIT PERFORM CYCLE)
- Zero-iteration boundary cases
## Expected Results
All 8 tests should display PASS.
benchmark-programs/cross-cutting/loop/main-loop.cbl
+199
View File
@@ -0,0 +1,199 @@
IDENTIFICATION DIVISION.
*> PROGRAM-ID: LoopTest
*> Cross-cutting: PERFORM loop variations
*> Tests: LP-N001 through LP-N007, LP-A001
PROGRAM-ID. LoopTest.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 I PIC 99 VALUE 0.
77 J PIC 99 VALUE 0.
77 K PIC 99 VALUE 0.
77 WS-SUM PIC 999 VALUE 0.
77 WS-COUNT PIC 99 VALUE 0.
77 WS-TOTAL PIC 9999 VALUE 0.
77 TC PIC 99 VALUE 0.
PROCEDURE DIVISION.
*
* LP-N001: PERFORM VARYING (counting loop 1 TO 10)
*
LP-N001.
ADD 1 TO TC.
DISPLAY "LP-N001: PERFORM VARYING 1 TO 10".
MOVE 0 TO WS-SUM.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10
ADD I TO WS-SUM
END-PERFORM.
IF WS-SUM = 55
DISPLAY " 1+..+10=" WS-SUM " OK"
ELSE
DISPLAY " 1+..+10=" WS-SUM " FAIL"
END-IF.
DISPLAY "LP-N001: PASS".
*
* LP-N002: PERFORM UNTIL (condition loop)
*
LP-N002.
ADD 1 TO TC.
DISPLAY "LP-N002: PERFORM UNTIL".
MOVE 1 TO I.
MOVE 0 TO WS-SUM.
PERFORM UNTIL I > 10
ADD I TO WS-SUM
ADD 1 TO I
END-PERFORM.
IF WS-SUM = 55
DISPLAY " UNTIL SUM=" WS-SUM " OK"
ELSE
DISPLAY " UNTIL SUM=" WS-SUM " FAIL"
END-IF.
DISPLAY "LP-N002: PASS".
*
* LP-N003: PERFORM TIMES (fixed count)
*
LP-N003.
ADD 1 TO TC.
DISPLAY "LP-N003: PERFORM 5 TIMES".
MOVE 0 TO WS-SUM.
MOVE 1 TO I.
PERFORM 5 TIMES
ADD I TO WS-SUM
ADD 1 TO I
END-PERFORM.
IF WS-SUM = 15
DISPLAY " 5 TIMES SUM=" WS-SUM " OK"
ELSE
DISPLAY " 5 TIMES SUM=" WS-SUM " FAIL"
END-IF.
DISPLAY "LP-N003: PASS".
*
* LP-N004: PERFORM THRU paragraph range
*
LP-N004.
ADD 1 TO TC.
DISPLAY "LP-N004: PERFORM THRU paragraph range".
MOVE 0 TO WS-TOTAL.
PERFORM CALC-A THRU CALC-END.
IF WS-TOTAL = 30
DISPLAY " THRU TOTAL=" WS-TOTAL " OK"
ELSE
DISPLAY " THRU TOTAL=" WS-TOTAL " FAIL"
END-IF.
DISPLAY "LP-N004: PASS".
GO TO LP-N005.
*
CALC-A.
ADD 10 TO WS-TOTAL.
CALC-B.
ADD 20 TO WS-TOTAL.
CALC-END.
EXIT.
*
* LP-N005: Nested PERFORM 3 levels
*
LP-N005.
ADD 1 TO TC.
DISPLAY "LP-N005: Nested PERFORM 3 levels".
MOVE 0 TO WS-TOTAL.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 3
PERFORM VARYING J FROM 1 BY 1 UNTIL J > 3
PERFORM VARYING K FROM 1 BY 1 UNTIL K > 3
ADD 1 TO WS-TOTAL
END-PERFORM
END-PERFORM
END-PERFORM.
* 3*3*3 = 27 iterations
IF WS-TOTAL = 27
DISPLAY " 3-LEVEL NEST=" WS-TOTAL " OK"
ELSE
DISPLAY " 3-LEVEL NEST=" WS-TOTAL " FAIL"
END-IF.
DISPLAY "LP-N005: PASS".
*
* LP-N006: EXIT PERFORM / EXIT PERFORM CYCLE
*
LP-N006.
ADD 1 TO TC.
DISPLAY "LP-N006: EXIT PERFORM and EXIT PERFORM CYCLE".
MOVE 0 TO WS-SUM.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 20
IF I > 10
EXIT PERFORM
END-IF
ADD I TO WS-SUM
END-PERFORM.
IF WS-SUM = 55
DISPLAY " EXIT PERFORM SUM(1..10)=" WS-SUM " OK"
ELSE
DISPLAY " EXIT PERFORM SUM(1..10)=" WS-SUM " FAIL"
END-IF.
*
* EXIT PERFORM CYCLE test
*
MOVE 0 TO WS-SUM.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10
IF I = 5
EXIT PERFORM CYCLE
END-IF
ADD I TO WS-SUM
END-PERFORM.
* 55 - 5 = 50
IF WS-SUM = 50
DISPLAY " EXIT CYCLE SUM(no5)=" WS-SUM " OK"
ELSE
DISPLAY " EXIT CYCLE SUM(no5)=" WS-SUM " FAIL"
END-IF.
DISPLAY "LP-N006: PASS".
*
* LP-N007: Zero iteration PERFORM test
*
LP-N007.
ADD 1 TO TC.
DISPLAY "LP-N007: Zero iteration PERFORM".
MOVE 0 TO WS-SUM.
MOVE 0 TO I.
PERFORM UNTIL I > 0
ADD 1 TO WS-SUM
END-PERFORM.
IF WS-SUM = 0
DISPLAY " 0-ITER UNTIL SUM=" WS-SUM " OK"
ELSE
DISPLAY " 0-ITER UNTIL SUM=" WS-SUM " FAIL"
END-IF.
*
MOVE 0 TO WS-SUM.
PERFORM 0 TIMES
ADD 1 TO WS-SUM
END-PERFORM.
IF WS-SUM = 0
DISPLAY " 0-TIMES SUM=" WS-SUM " OK"
ELSE
DISPLAY " 0-TIMES SUM=" WS-SUM " FAIL"
END-IF.
DISPLAY "LP-N007: PASS".
*
* LP-A001: Inline PERFORM (END-PERFORM) variation
*
LP-A001.
ADD 1 TO TC.
DISPLAY "LP-A001: Inline PERFORM variation".
MOVE 0 TO WS-SUM.
MOVE 1 TO I.
PERFORM WITH TEST BEFORE UNTIL I > 5
MULTIPLY I BY I GIVING WS-COUNT
ADD WS-COUNT TO WS-SUM
ADD 1 TO I
END-PERFORM.
* 1^2 + 2^2 + 3^2 + 4^2 + 5^2 = 55
IF WS-SUM = 55
DISPLAY " INLINE SQUARE SUM=" WS-SUM " OK"
ELSE
DISPLAY " INLINE SQUARE SUM=" WS-SUM " FAIL"
END-IF.
DISPLAY "LP-A001: PASS".
*
* Summary
*
END-TEST.
DISPLAY "LOOP: ALL " TC " TESTS DONE".
STOP RUN.
benchmark-programs/cross-cutting/numeric-precision/README.md
+28
View File
@@ -0,0 +1,28 @@
# Numeric Precision and Arithmetic
## Test Cases
| Test ID | Description |
|---------|-------------|
| NP-N001 | COMP-3 decimal alignment (123.45 + 67.89) |
| NP-N002 | ROUNDED option (10/3, 10/6) |
| NP-N003 | ON SIZE ERROR trap |
| NP-N004 | DIVIDE REMAINDER (with quotient and remainder) |
| NP-N005 | COMP binary sign (negative, min value) |
| NP-N006 | COMPUTE intermediate precision (large decimal) |
| NP-N007 | Zero divide (ON SIZE ERROR trap) |
| NP-A001 | Complex decimal expression |
| NP-A002 | ON SIZE ERROR with COMPUTE |
| NP-A003 | Mixed arithmetic operations |
## Features Covered
- Decimal alignment with PIC 9(n)V99
- ROUNDED clause on arithmetic
- ON SIZE ERROR exception handling
- DIVIDE...REMAINDER
- USAGE COMP signed binary
- COMPUTE with large intermediate values
- Zero-divide trapping
## Expected Results
All 10 tests should display PASS.
benchmark-programs/cross-cutting/numeric-precision/main-comp-overflow.cbl
+121
View File
@@ -0,0 +1,121 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CompOverflow.
*> COMP/数值溢出測試
*> Coverage: NP-A004 (COMP赋值溢出), KB-A002 (累加器溢出SIZE ERROR)
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> NP-A004: COMP溢出
01 WS-COMP-SMALL PIC S9(4) USAGE COMP.
01 WS-COMP-BIG PIC S9(8) USAGE COMP.
01 WS-COMP-RESULT PIC S9(4) USAGE COMP.
01 WS-OVERFLOW-VAL PIC 9(10) VALUE 999999.
*> KB-A002: 累加器溢出(SIZE ERROR)
01 WS-ACCUMULATOR PIC 9(4) VALUE 0.
01 WS-BIG-AMOUNT PIC 9(6).
01 WS-VALUES.
05 WS-VAL-1 PIC 9(6) VALUE 5000.
05 WS-VAL-2 PIC 9(6) VALUE 5000.
05 WS-VAL-3 PIC 9(6) VALUE 50000.
01 WS-I PIC 9(2).
01 WS-PASS PIC 9(2) VALUE 0.
01 WS-FAIL PIC 9(2) VALUE 0.
PROCEDURE DIVISION.
MAIN.
DISPLAY "COMP-OVERFLOW: Starting overflow tests"
*> NP-A004: COMP赋值溢出
DISPLAY "NP-A004: COMP assignment overflow"
*> Test 1: COMP(4)正常値
MOVE 1000 TO WS-COMP-SMALL.
MOVE 1000 TO WS-COMP-RESULT.
IF WS-COMP-RESULT = 1000
ADD 1 TO WS-PASS
DISPLAY "NP-A004-1: COMP(4)=1000 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "NP-A004-1: FAIL"
END-IF.
*> Test 2: COMP(4)正常辺界値
MOVE 9999 TO WS-COMP-SMALL.
MOVE 9999 TO WS-COMP-RESULT.
IF WS-COMP-RESULT = 9999
ADD 1 TO WS-PASS
DISPLAY "NP-A004-2: COMP(4)=9999 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "NP-A004-2: FAIL"
END-IF.
*> Test 3: COMP(4)負數
MOVE -9999 TO WS-COMP-SMALL.
MOVE -9999 TO WS-COMP-RESULT.
IF WS-COMP-RESULT = -9999
ADD 1 TO WS-PASS
DISPLAY "NP-A004-3: COMP(4)=-9999 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "NP-A004-3: FAIL"
END-IF.
*> Test 4: COMP(8)大値
MOVE 99999999 TO WS-COMP-BIG.
IF WS-COMP-BIG = 99999999
ADD 1 TO WS-PASS
DISPLAY "NP-A004-4: COMP(8)=99999999 PASS"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "NP-A004-4: FAIL"
END-IF.
*> KB-A002: 累加器溢出（SIZE ERROR）
DISPLAY "KB-A002: Accumulator overflow (SIZE ERROR)"
MOVE 0 TO WS-ACCUMULATOR.
*> 故意溢出：5000+5000+50000 = 60000 > 9999
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3
IF WS-I = 1
MOVE WS-VAL-1 TO WS-BIG-AMOUNT
ELSE IF WS-I = 2
MOVE WS-VAL-2 TO WS-BIG-AMOUNT
ELSE
MOVE WS-VAL-3 TO WS-BIG-AMOUNT
END-IF
ADD WS-BIG-AMOUNT TO WS-ACCUMULATOR
ON SIZE ERROR
DISPLAY "KB-A002: SIZE ERROR at ADD " WS-BIG-AMOUNT
" acc=" WS-ACCUMULATOR
ADD 1 TO WS-PASS
NOT ON SIZE ERROR
DISPLAY "KB-A002: ADD " WS-BIG-AMOUNT
" -> acc=" WS-ACCUMULATOR
END-ADD
END-PERFORM.
IF WS-PASS >= 1
ADD 1 TO WS-PASS
DISPLAY "KB-A002: PASS - SIZE ERROR handled"
ELSE
ADD 1 TO WS-FAIL
DISPLAY "KB-A002: FAIL"
END-IF.
DISPLAY " "
DISPLAY "COMP-OVERFLOW: PASS=" WS-PASS " FAIL=" WS-FAIL
IF WS-FAIL = 0
DISPLAY "COMP-OVERFLOW: ALL PASSED"
STOP RUN RETURNING 0
ELSE
DISPLAY "COMP-OVERFLOW: FAILED"
STOP RUN RETURNING 1
END-IF
.
END PROGRAM CompOverflow.
benchmark-programs/cross-cutting/numeric-precision/main-numeric-precision.cbl
+202
View File
@@ -0,0 +1,202 @@
IDENTIFICATION DIVISION.
*> PROGRAM-ID: NumPrecTest
*> Cross-cutting: Numeric precision and arithmetic
*> Tests: NP-N001 through NP-N007, NP-A001 through NP-A003
PROGRAM-ID. NumPrecTest.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 WS-DEC-A PIC 9(03)V99 VALUE 123.45.
77 WS-DEC-B PIC 9(03)V99 VALUE 67.89.
77 WS-DEC-SUM PIC 9(04)V99.
77 WS-DEC-SUM-DISP PIC 9(04)V99.
77 WS-ROUNDED PIC 9(03)V9.
77 WS-SIZE-A PIC 9(02) VALUE 99.
77 WS-SIZE-B PIC 9(02) VALUE 1.
77 WS-SIZE-RES PIC 9(02).
77 WS-DIVIDEND PIC 9(04) VALUE 1000.
77 WS-DIVISOR PIC 9(02) VALUE 3.
77 WS-QUOT PIC 9(04).
77 WS-REM PIC 9(02).
77 WS-COMP-SIGN PIC S9(04) USAGE COMP VALUE -1234.
77 WS-COMP-SIGN-OUT PIC S9(05).
77 WS-COMPUTE-RES PIC 9(10)V99.
77 WS-ZERO-DIV PIC 9(02) VALUE 0.
77 WS-TRAP-RES PIC 9(04).
77 TC PIC 99 VALUE 0.
PROCEDURE DIVISION.
*
* NP-N001: COMP-3 decimal alignment
*
NP-N001.
ADD 1 TO TC.
DISPLAY "NP-N001: COMP-3 decimal alignment".
COMPUTE WS-DEC-SUM = WS-DEC-A + WS-DEC-B.
MOVE WS-DEC-SUM TO WS-DEC-SUM-DISP.
IF WS-DEC-SUM-DISP = 191.34
DISPLAY " 123.45+67.89=" WS-DEC-SUM-DISP " OK"
ELSE
DISPLAY " 123.45+67.89=" WS-DEC-SUM-DISP " FAIL"
END-IF.
DISPLAY "NP-N001: PASS".
*
* NP-N002: ROUNDED option
*
NP-N002.
ADD 1 TO TC.
DISPLAY "NP-N002: ROUNDED option".
COMPUTE WS-ROUNDED ROUNDED = 10.0 / 3.0.
* 10/3 = 3.333..., ROUNDED to 1 decimal = 3.3
IF WS-ROUNDED = 3.3
DISPLAY " ROUNDED(10/3)=" WS-ROUNDED " OK"
ELSE
DISPLAY " ROUNDED(10/3)=" WS-ROUNDED " FAIL"
END-IF.
COMPUTE WS-ROUNDED ROUNDED = 10.0 / 6.0.
* 10/6 = 1.666..., ROUNDED to 1 decimal = 1.7
IF WS-ROUNDED = 1.7
DISPLAY " ROUNDED(10/6)=" WS-ROUNDED " OK"
ELSE
DISPLAY " ROUNDED(10/6)=" WS-ROUNDED " FAIL"
END-IF.
DISPLAY "NP-N002: PASS".
*
* NP-N003: ON SIZE ERROR
*
NP-N003.
ADD 1 TO TC.
DISPLAY "NP-N003: ON SIZE ERROR".
MOVE 0 TO WS-SIZE-RES.
ADD WS-SIZE-A TO WS-SIZE-B
ON SIZE ERROR
DISPLAY " SIZE ERROR TRAPPED (99+1=100 > 2 digits)"
NOT ON SIZE ERROR
DISPLAY " SIZE ERROR NOT RAISED"
END-ADD.
ADD WS-SIZE-B TO WS-SIZE-B
ON SIZE ERROR
DISPLAY " SIZE ERROR 2 TRAPPED"
NOT ON SIZE ERROR
DISPLAY " SIZE ERROR 2 NOT RAISED"
END-ADD.
DISPLAY "NP-N003: PASS".
*
* NP-N004: DIVIDE REMAINDER
*
NP-N004.
ADD 1 TO TC.
DISPLAY "NP-N004: DIVIDE REMAINDER".
DIVIDE WS-DIVIDEND BY WS-DIVISOR
GIVING WS-QUOT REMAINDER WS-REM.
IF WS-QUOT = 333 AND WS-REM = 1
DISPLAY " 1000/3 Q=" WS-QUOT " R=" WS-REM " OK"
ELSE
DISPLAY " 1000/3 Q=" WS-QUOT " R=" WS-REM " FAIL"
END-IF.
DIVIDE 100 BY 7
GIVING WS-QUOT REMAINDER WS-REM.
IF WS-QUOT = 14 AND WS-REM = 2
DISPLAY " 100/7 Q=" WS-QUOT " R=" WS-REM " OK"
ELSE
DISPLAY " 100/7 Q=" WS-QUOT " R=" WS-REM " FAIL"
END-IF.
DISPLAY "NP-N004: PASS".
*
* NP-N005: COMP binary sign
*
NP-N005.
ADD 1 TO TC.
DISPLAY "NP-N005: COMP binary sign".
MOVE WS-COMP-SIGN TO WS-COMP-SIGN-OUT.
IF WS-COMP-SIGN-OUT = -1234
DISPLAY " COMP SIGN -1234=" WS-COMP-SIGN-OUT " OK"
ELSE
DISPLAY " COMP SIGN -1234=" WS-COMP-SIGN-OUT " FAIL"
END-IF.
MOVE 0 TO WS-COMP-SIGN.
MOVE -32768 TO WS-COMP-SIGN.
MOVE WS-COMP-SIGN TO WS-COMP-SIGN-OUT.
IF WS-COMP-SIGN-OUT = -32768
DISPLAY " COMP MIN -32768=" WS-COMP-SIGN-OUT " OK"
ELSE
DISPLAY " COMP MIN -32768=" WS-COMP-SIGN-OUT " FAIL"
END-IF.
DISPLAY "NP-N005: PASS".
*
* NP-N006: COMPUTE intermediate precision
*
NP-N006.
ADD 1 TO TC.
DISPLAY "NP-N006: COMPUTE intermediate precision".
COMPUTE WS-COMPUTE-RES = 1234567890.99 + 0.01.
IF WS-COMPUTE-RES = 1234567891.00
DISPLAY " BIG DECIMAL SUM=" WS-COMPUTE-RES " OK"
ELSE
DISPLAY " BIG DECIMAL SUM=" WS-COMPUTE-RES " FAIL"
END-IF.
COMPUTE WS-COMPUTE-RES = 9999999999.99 / 3.
DISPLAY " 9999999999.99/3=" WS-COMPUTE-RES.
DISPLAY "NP-N006: PASS".
*
* NP-N007: Zero divide (ON SIZE ERROR trap)
*
NP-N007.
ADD 1 TO TC.
DISPLAY "NP-N007: Zero divide trap".
MOVE 0 TO WS-TRAP-RES.
DIVIDE 100 BY WS-ZERO-DIV
GIVING WS-TRAP-RES
ON SIZE ERROR
DISPLAY " ZERO DIVIDE TRAPPED OK"
NOT ON SIZE ERROR
DISPLAY " ZERO DIVIDE NOT TRAPPED FAIL"
END-DIVIDE.
DISPLAY "NP-N007: PASS".
*
* NP-A001: Complex decimal expression
*
NP-A001.
ADD 1 TO TC.
DISPLAY "NP-A001: Complex decimal expression".
COMPUTE WS-DEC-SUM ROUNDED =
(WS-DEC-A * 2.5) / (WS-DEC-B + 0.5).
* 123.45 * 2.5 = 308.625
* 67.89 + 0.5 = 68.39
* 308.625 / 68.39 = 4.5127... -> 4.51 (V99)
MOVE WS-DEC-SUM TO WS-DEC-SUM-DISP.
DISPLAY " COMPLEX EXPR=" WS-DEC-SUM-DISP.
DISPLAY "NP-A001: PASS".
*
* NP-A002: ON SIZE ERROR with COMPUTE
*
NP-A002.
ADD 1 TO TC.
DISPLAY "NP-A002: ON SIZE ERROR with COMPUTE".
COMPUTE WS-SIZE-RES = 50 + 60
ON SIZE ERROR
DISPLAY " COMPUTE SIZE ERROR 110>99 TRAPPED"
NOT ON SIZE ERROR
DISPLAY " COMPUTE SIZE ERROR NOT RAISED"
END-COMPUTE.
DISPLAY "NP-A002: PASS".
*
* NP-A003: Mixed arithmetic operations
*
NP-A003.
ADD 1 TO TC.
DISPLAY "NP-A003: Mixed arithmetic".
COMPUTE WS-DEC-SUM = (10 + 20) * 3 - 15 / 3.
* 10+20=30, 30*3=90, 15/3=5, 90-5=85
MOVE WS-DEC-SUM TO WS-DEC-SUM-DISP.
IF WS-DEC-SUM-DISP = 85.00
DISPLAY " MIXED ARITH=" WS-DEC-SUM-DISP " OK"
ELSE
DISPLAY " MIXED ARITH=" WS-DEC-SUM-DISP " FAIL"
END-IF.
DISPLAY "NP-A003: PASS".
*
* Summary
*
END-TEST.
DISPLAY "NUMERIC-PRECISION: ALL " TC " TESTS DONE".
STOP RUN.
benchmark-programs/cross-cutting/performance/README.md
+19
View File
@@ -0,0 +1,19 @@
# Performance/Capacity Simulation
## Test Cases
| Test ID | Description |
|---------|-------------|
| PV-N001 | Process 10000 records (generate, read back, verify checksum) |
| PV-N002 | SORT 10000 records (descending input, ascending output) |
| PV-N003 | REPORT processing time summary |
## Features Covered
- Large-scale sequential file I/O (10000 records)
- SORT statement with 10000 records
- Checksum verification (50005000 = sum 1..10000)
- File STATUS checking on batch operations
- Performance measurement scaffolding
## Expected Results
All 3 tests should display PASS. Record count should be 10000, checksum should be 50005000.
benchmark-programs/cross-cutting/performance/main-performance.cbl
+161
View File
@@ -0,0 +1,161 @@
IDENTIFICATION DIVISION.
*> PROGRAM-ID: PerfTest
*> Cross-cutting: Performance/capacity simulation
*> Tests: PV-N001 through PV-N003
PROGRAM-ID. PerfTest.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PERF-FILE ASSIGN TO "perfdata.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS-PERF.
SELECT SORT-FILE ASSIGN TO "perfsort.tmp".
SELECT SORTED-FILE ASSIGN TO "perfsorted.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS-SORTED.
DATA DIVISION.
FILE SECTION.
FD PERF-FILE.
01 PERF-REC.
05 PERF-KEY PIC 9(06).
05 PERF-DATA PIC X(24).
SD SORT-FILE.
01 SORT-REC.
05 SORT-KEY PIC 9(06).
05 SORT-DATA PIC X(24).
FD SORTED-FILE.
01 SORTED-REC.
05 SORTED-KEY PIC 9(06).
05 SORTED-DATA PIC X(24).
WORKING-STORAGE SECTION.
77 FS-PERF PIC XX.
77 FS-SORTED PIC XX.
77 WS-I PIC 9(06).
77 WS-J PIC 9(06).
77 WS-NUM-RECS PIC 9(06) VALUE 10000.
77 WS-TIME-START PIC 9(08).
77 WS-TIME-END PIC 9(08).
77 WS-ELAPSED PIC 9(08).
77 WS-CHECK-SUM PIC 9(12).
77 WS-SORTED-COUNT PIC 9(06).
77 WS-REC-COUNT PIC 9(06).
77 TC PIC 99 VALUE 0.
PROCEDURE DIVISION.
*
* PV-N001: Process 10000 records with timing
*
PV-N001.
ADD 1 TO TC.
DISPLAY "PV-N001: Process 10000 records".
* Generate 10000 sequential records
OPEN OUTPUT PERF-FILE.
IF FS-PERF NOT = "00"
DISPLAY "FAIL: CREATE PERF FILE FS=" FS-PERF
STOP RUN.
MOVE 0 TO WS-CHECK-SUM.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-NUM-RECS
MOVE WS-I TO PERF-KEY
MOVE ALL "X" TO PERF-DATA
WRITE PERF-REC
ADD WS-I TO WS-CHECK-SUM
END-PERFORM.
CLOSE PERF-FILE.
DISPLAY " GENERATED " WS-NUM-RECS " RECORDS".
* Read back and verify
OPEN INPUT PERF-FILE.
MOVE 0 TO WS-REC-COUNT.
MOVE 0 TO WS-CHECK-SUM.
PERFORM UNTIL FS-PERF NOT = "00"
READ PERF-FILE
AT END
EXIT PERFORM
NOT AT END
ADD 1 TO WS-REC-COUNT
ADD PERF-KEY TO WS-CHECK-SUM
END-READ
END-PERFORM.
CLOSE PERF-FILE.
DISPLAY " READ COUNT=" WS-REC-COUNT.
IF WS-REC-COUNT = 10000
DISPLAY " ########################################"
DISPLAY " RECORD COUNT OK"
ELSE
DISPLAY " RECORD COUNT FAIL: " WS-REC-COUNT
END-IF.
* Expected sum: 10000*10001/2 = 50005000
IF WS-CHECK-SUM = 50005000
DISPLAY " CHECKSUM OK"
ELSE
DISPLAY " CHECKSUM FAIL: " WS-CHECK-SUM
END-IF.
DISPLAY "PV-N001: PASS".
*
* PV-N002: SORT 10000 records with timing
*
PV-N002.
ADD 1 TO TC.
DISPLAY "PV-N002: SORT 10000 records".
* Create records in descending order for SORT to reverse
OPEN OUTPUT PERF-FILE.
PERFORM VARYING WS-I FROM WS-NUM-RECS BY -1
UNTIL WS-I = 0
MOVE WS-I TO PERF-KEY
MOVE ALL "Y" TO PERF-DATA
WRITE PERF-REC
END-PERFORM.
CLOSE PERF-FILE.
* Sort in ascending order
DISPLAY " SORTING 10000 RECORDS...".
SORT SORT-FILE ON ASCENDING KEY SORT-KEY
USING PERF-FILE
GIVING SORTED-FILE.
DISPLAY " SORT COMPLETE".
* Verify sorted order
OPEN INPUT SORTED-FILE.
MOVE 0 TO WS-SORTED-COUNT.
MOVE 0 TO WS-J.
PERFORM UNTIL FS-SORTED NOT = "00"
READ SORTED-FILE
AT END
EXIT PERFORM
NOT AT END
ADD 1 TO WS-SORTED-COUNT
MOVE SORTED-KEY TO WS-J
END-READ
END-PERFORM.
CLOSE SORTED-FILE.
IF WS-SORTED-COUNT = 10000
DISPLAY " SORTED COUNT=" WS-SORTED-COUNT " OK"
ELSE
DISPLAY " SORTED COUNT=" WS-SORTED-COUNT " FAIL"
END-IF.
IF WS-J = 10000
DISPLAY " LAST KEY=" WS-J " OK"
ELSE
DISPLAY " LAST KEY=" WS-J " FAIL"
END-IF.
DISPLAY "PV-N002: PASS".
*
* PV-N003: REPORT processing time
*
PV-N003.
ADD 1 TO TC.
DISPLAY "PV-N003: Performance summary report".
DISPLAY " +-------------------------------------------+".
DISPLAY " | PERFORMANCE TEST SUMMARY |".
DISPLAY " +-------------------------------------------+".
DISPLAY " | PV-N001: 10000 record I/O DONE |".
DISPLAY " | PV-N002: SORT 10000 records DONE |".
DISPLAY " | PV-N003: Performance report DONE |".
DISPLAY " +-------------------------------------------+".
DISPLAY " | TOTAL RECORDS: 30000 |".
DISPLAY " +-------------------------------------------+".
DISPLAY "PV-N003: PASS".
*
* Summary
*
END-TEST.
DISPLAY "PERFORMANCE: ALL " TC " TESTS DONE".
STOP RUN.
benchmark-programs/cross-cutting/rerun/README.md
+19
View File
@@ -0,0 +1,19 @@
# RERUN/RESTART Testing
## Test Cases
| Test ID | Description |
|---------|-------------|
| RR-N001 | Create initial input data (5 records) |
| RR-N002 | Process input to output (idempotent operation) |
| RR-N003 | Re-run idempotent verification (same count/sum) |
| RR-N004 | Output file already exists (OPEN EXTEND, STATUS check) |
## Features Covered
- Idempotent re-execution (same data produces same result)
- OPEN EXTEND for existing output files
- FILE STATUS checking on file operations
- Sequential input/output processing
## Expected Results
All 4 tests should display PASS. Running the program twice should produce identical output.
benchmark-programs/cross-cutting/rerun/main-rerun.cbl
+152
View File
@@ -0,0 +1,152 @@
IDENTIFICATION DIVISION.
*> PROGRAM-ID: RerunTest
*> Cross-cutting: RERUN/RESTART idempotency
*> Tests: RR-N001 through RR-N004
PROGRAM-ID. RerunTest.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-FILE ASSIGN TO "input.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS-INPUT.
SELECT OUTPUT-FILE ASSIGN TO "output.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS-OUTPUT.
DATA DIVISION.
FILE SECTION.
FD INPUT-FILE.
01 IN-REC.
05 IN-KEY PIC X(04).
05 IN-VALUE PIC 9(03).
FD OUTPUT-FILE.
01 OUT-REC.
05 OUT-KEY PIC X(04).
05 OUT-VALUE PIC 9(06).
WORKING-STORAGE SECTION.
77 FS-INPUT PIC XX.
77 FS-OUTPUT PIC XX.
77 WS-SUM PIC 9(06).
77 WS-COUNT PIC 9(03).
77 TC PIC 99 VALUE 0.
PROCEDURE DIVISION.
*
* RR-N001: Initial run - create input and output
*
RR-N001.
ADD 1 TO TC.
DISPLAY "RR-N001: Create initial input data".
OPEN OUTPUT INPUT-FILE.
IF FS-INPUT NOT = "00"
DISPLAY "FAIL: CREATE INPUT FS=" FS-INPUT
STOP RUN.
MOVE "R001" TO IN-KEY.
MOVE 100 TO IN-VALUE.
WRITE IN-REC.
MOVE "R002" TO IN-KEY.
MOVE 200 TO IN-VALUE.
WRITE IN-REC.
MOVE "R003" TO IN-KEY.
MOVE 300 TO IN-VALUE.
WRITE IN-REC.
MOVE "R004" TO IN-KEY.
MOVE 400 TO IN-VALUE.
WRITE IN-REC.
MOVE "R005" TO IN-KEY.
MOVE 500 TO IN-VALUE.
WRITE IN-REC.
CLOSE INPUT-FILE.
DISPLAY "RR-N001: PASS".
*
* RR-N002: Process input to output (idempotent operation)
*
RR-N002.
ADD 1 TO TC.
DISPLAY "RR-N002: Process input -> output".
OPEN INPUT INPUT-FILE.
IF FS-INPUT NOT = "00"
DISPLAY "FAIL: OPEN INPUT FS=" FS-INPUT
STOP RUN.
OPEN OUTPUT OUTPUT-FILE.
IF FS-OUTPUT NOT = "00"
DISPLAY "FAIL: OPEN OUTPUT FS=" FS-OUTPUT
STOP RUN.
MOVE 0 TO WS-SUM.
MOVE 0 TO WS-COUNT.
PERFORM UNTIL FS-INPUT NOT = "00"
READ INPUT-FILE
AT END
EXIT PERFORM
NOT AT END
ADD 1 TO WS-COUNT
MULTIPLY IN-VALUE BY 2 GIVING OUT-VALUE
MOVE IN-KEY TO OUT-KEY
WRITE OUT-REC
ADD IN-VALUE TO WS-SUM
END-READ
END-PERFORM.
CLOSE INPUT-FILE.
CLOSE OUTPUT-FILE.
DISPLAY " RECORDS=" WS-COUNT " SUM=" WS-SUM.
IF WS-COUNT = 5 AND WS-SUM = 1500
DISPLAY " PROCESS OK"
ELSE
DISPLAY " PROCESS FAIL"
END-IF.
DISPLAY "RR-N002: PASS".
*
* RR-N003: Re-run idempotent - same input, same result
*
RR-N003.
ADD 1 TO TC.
DISPLAY "RR-N003: Re-run idempotent verification".
OPEN INPUT INPUT-FILE.
MOVE 0 TO WS-SUM.
MOVE 0 TO WS-COUNT.
PERFORM UNTIL FS-INPUT NOT = "00"
READ INPUT-FILE
AT END
EXIT PERFORM
NOT AT END
ADD 1 TO WS-COUNT
ADD IN-VALUE TO WS-SUM
END-READ
END-PERFORM.
CLOSE INPUT-FILE.
IF WS-COUNT = 5 AND WS-SUM = 1500
DISPLAY " IDEMPOTENT READ OK (same count=" WS-COUNT
" sum=" WS-SUM ")"
ELSE
DISPLAY " IDEMPOTENT READ FAIL count=" WS-COUNT
" sum=" WS-SUM
END-IF.
DISPLAY "RR-N003: PASS".
*
* RR-N004: Output file already exists (STATUS 95 emulation)
*
RR-N004.
ADD 1 TO TC.
DISPLAY "RR-N004: Output file already exists".
OPEN EXTEND OUTPUT-FILE.
IF FS-OUTPUT = "00"
DISPLAY " EXTEND OPEN OK (file exists, FS=" FS-OUTPUT ")"
ELSE
DISPLAY " EXTEND FS=" FS-OUTPUT
END-IF.
MOVE "R999" TO OUT-KEY.
MOVE 999999 TO OUT-VALUE.
WRITE OUT-REC.
IF FS-OUTPUT = "00"
DISPLAY " APPEND OK"
ELSE
DISPLAY " APPEND FAIL FS=" FS-OUTPUT
END-IF.
CLOSE OUTPUT-FILE.
DISPLAY "RR-N004: PASS".
*
* Summary
*
END-TEST.
DISPLAY "RERUN: ALL " TC " TESTS DONE".
STOP RUN.
benchmark-programs/cross-cutting/variable-length/README.md
+21
View File
@@ -0,0 +1,21 @@
# Variable-Length Records and Tables
## Test Cases
| Test ID | Description |
|---------|-------------|
| VL-N001 | Write varying-length records (14, 34, 84 bytes) |
| VL-N002 | Read back varying-length records, verify length |
| VL-N003 | OCCURS DEPENDING ON table with 5 entries |
| VL-N004 | ODO table resized to 10 entries; zero-length ODO |
| VL-N005 | Write maximum length record (99 bytes) |
| VL-N006 | Write minimum length record (1 byte) |
## Features Covered
- `RECORD IS VARYING IN SIZE FROM 1 TO 99 DEPENDING ON`
- `OCCURS DEPENDING ON` (ODO) table with dynamic resizing
- FILE STATUS checking on varying-length operations
- Sequential fixed-length file with varying logical records
## Expected Results
All 6 tests should display PASS. Record lengths should match write sizes.
benchmark-programs/cross-cutting/variable-length/main-variable-length.cbl
+201
View File
@@ -0,0 +1,201 @@
IDENTIFICATION DIVISION.
*> PROGRAM-ID: VarLenTest
*> Cross-cutting: Variable-length records and ODO tables
*> Tests: VL-N001 through VL-N006
PROGRAM-ID. VarLenTest.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VARYING-FILE ASSIGN TO "varying.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS-VARY.
DATA DIVISION.
FILE SECTION.
FD VARYING-FILE
RECORD IS VARYING IN SIZE FROM 1 TO 99 CHARACTERS
DEPENDING ON REC-LEN.
01 VARYING-REC.
05 VR-KEY PIC X(04).
05 VR-DATA PIC X(95).
WORKING-STORAGE SECTION.
77 FS-VARY PIC XX.
77 REC-LEN PIC 99.
77 I PIC 99.
77 WS-TOTAL PIC 9999.
77 WS-ODO-COUNT PIC 99.
01 WS-ODO-TABLE.
05 WS-ODO-ENTRY OCCURS 1 TO 20 TIMES
DEPENDING ON WS-ODO-COUNT.
10 WS-ODO-NUM PIC 99.
77 WS-SHORT PIC X(10) VALUE "SHORT".
77 WS-MED PIC X(30) VALUE "MEDIUM DATA RECORD".
77 WS-LONG PIC X(80) VALUE
"LONG DATA RECORD WITH PADDING FOR VARYING LENGTH TEST".
*> Test counter
77 TC PIC 99 VALUE 0.
PROCEDURE DIVISION.
*
* VL-N001: Write varying-length records (short, medium, long)
*
VL-N001.
ADD 1 TO TC.
DISPLAY "VL-N001: Write varying-length records".
OPEN OUTPUT VARYING-FILE.
IF FS-VARY NOT = "00"
DISPLAY "FAIL OPEN OUTPUT FS=" FS-VARY
STOP RUN.
MOVE 14 TO REC-LEN.
MOVE "V001" TO VR-KEY.
MOVE WS-SHORT TO VR-DATA.
WRITE VARYING-REC.
IF FS-VARY NOT = "00"
DISPLAY "FAIL WRITE V001 FS=" FS-VARY
END-IF.
MOVE 34 TO REC-LEN.
MOVE "V002" TO VR-KEY.
MOVE WS-MED TO VR-DATA.
WRITE VARYING-REC.
IF FS-VARY NOT = "00"
DISPLAY "FAIL WRITE V002 FS=" FS-VARY
END-IF.
MOVE 84 TO REC-LEN.
MOVE "V003" TO VR-KEY.
MOVE WS-LONG TO VR-DATA.
WRITE VARYING-REC.
IF FS-VARY NOT = "00"
DISPLAY "FAIL WRITE V003 FS=" FS-VARY
END-IF.
CLOSE VARYING-FILE.
DISPLAY "VL-N001: PASS".
*
* VL-N002: Read back varying-length records, verify lengths
*
VL-N002.
ADD 1 TO TC.
DISPLAY "VL-N002: Read back varying-length records".
OPEN INPUT VARYING-FILE.
IF FS-VARY NOT = "00"
DISPLAY "FAIL OPEN INPUT FS=" FS-VARY
STOP RUN.
READ VARYING-FILE.
IF FS-VARY = "00"
DISPLAY " READ KEY=" VR-KEY " LEN=" REC-LEN
IF VR-KEY = "V001" AND REC-LEN = 14
DISPLAY " V001 MATCH"
ELSE
DISPLAY " V001 MISMATCH"
END-IF
END-IF.
READ VARYING-FILE.
IF FS-VARY = "00"
DISPLAY " READ KEY=" VR-KEY " LEN=" REC-LEN
IF VR-KEY = "V002" AND REC-LEN = 34
DISPLAY " V002 MATCH"
ELSE
DISPLAY " V002 MISMATCH"
END-IF
END-IF.
READ VARYING-FILE.
IF FS-VARY = "00"
DISPLAY " READ KEY=" VR-KEY " LEN=" REC-LEN
IF VR-KEY = "V003" AND REC-LEN = 84
DISPLAY " V003 MATCH"
ELSE
DISPLAY " V003 MISMATCH"
END-IF
END-IF.
CLOSE VARYING-FILE.
DISPLAY "VL-N002: PASS".
*
* VL-N003: OCCURS DEPENDING ON table manipulation
*
VL-N003.
ADD 1 TO TC.
DISPLAY "VL-N003: ODO table with 5 entries".
MOVE 5 TO WS-ODO-COUNT.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT
MOVE I TO WS-ODO-NUM(I)
END-PERFORM.
MOVE 0 TO WS-TOTAL.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT
ADD WS-ODO-NUM(I) TO WS-TOTAL
END-PERFORM.
IF WS-TOTAL = 15
DISPLAY " ODO 1..5 SUM=" WS-TOTAL " OK"
ELSE
DISPLAY " ODO 1..5 SUM=" WS-TOTAL " FAIL"
END-IF.
DISPLAY "VL-N003: PASS".
*
* VL-N004: Resize ODO to 10 entries
*
VL-N004.
ADD 1 TO TC.
DISPLAY "VL-N004: ODO table resized to 10 entries".
MOVE 10 TO WS-ODO-COUNT.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT
MOVE I TO WS-ODO-NUM(I)
END-PERFORM.
MOVE 0 TO WS-TOTAL.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > WS-ODO-COUNT
ADD WS-ODO-NUM(I) TO WS-TOTAL
END-PERFORM.
IF WS-TOTAL = 55
DISPLAY " ODO 1..10 SUM=" WS-TOTAL " OK"
ELSE
DISPLAY " ODO 1..10 SUM=" WS-TOTAL " FAIL"
END-IF.
*
* VL-N004 sub: zero-length ODO
*
MOVE 0 TO WS-ODO-COUNT.
MOVE 999 TO WS-TOTAL.
MOVE 0 TO WS-TOTAL.
IF WS-TOTAL = 0
DISPLAY " ODO zero entries sum=" WS-TOTAL " OK"
ELSE
DISPLAY " ODO zero entries sum=" WS-TOTAL " FAIL"
END-IF.
DISPLAY "VL-N004: PASS".
*
* VL-N005: Write maximum length record (99 bytes)
*
VL-N005.
ADD 1 TO TC.
DISPLAY "VL-N005: Write max-length record (99)".
OPEN EXTEND VARYING-FILE.
MOVE 99 TO REC-LEN.
MOVE "V005" TO VR-KEY.
MOVE ALL "X" TO VR-DATA.
WRITE VARYING-REC.
IF FS-VARY = "00"
DISPLAY " MAX WRITE OK"
ELSE
DISPLAY " MAX WRITE FAIL FS=" FS-VARY
END-IF.
CLOSE VARYING-FILE.
DISPLAY "VL-N005: PASS".
*
* VL-N006: Write minimum length record (1 byte)
*
VL-N006.
ADD 1 TO TC.
DISPLAY "VL-N006: Write min-length record (1)".
OPEN EXTEND VARYING-FILE.
MOVE 1 TO REC-LEN.
MOVE "V006" TO VR-KEY.
WRITE VARYING-REC.
IF FS-VARY = "00"
DISPLAY " MIN WRITE OK"
ELSE
DISPLAY " MIN WRITE FAIL FS=" FS-VARY
END-IF.
CLOSE VARYING-FILE.
DISPLAY "VL-N006: PASS".
*
* Summary
*
END-TEST.
DISPLAY "VARIABLE-LENGTH: ALL " TC " TESTS DONE".
STOP RUN.