diff --git a/cobj/codegen.c b/cobj/codegen.c
index a4272140..8241bd70 100644
--- a/cobj/codegen.c
+++ b/cobj/codegen.c
@@ -4622,6 +4622,7 @@ static void joutput_internal_function(struct cb_program *prog,
joutput_line("/* Push module stack */");
joutput_line("CobolModule.push (module);");
+ joutput_line("CobolResolve.pushCallStackList (\"%s\");", prog->program_id);
joutput_newline();
/* Initialization */
@@ -4891,6 +4892,7 @@ static void joutput_internal_function(struct cb_program *prog,
// output_newline ();
// }
joutput_line("/* Pop module stack */");
+ joutput_line("CobolResolve.popCallStackList();");
joutput_line("CobolModule.pop();");
joutput_newline();
if (cb_flag_traceall) {
diff --git a/cobj/typeck.c b/cobj/typeck.c
index bcc17371..2bd1300a 100644
--- a/cobj/typeck.c
+++ b/cobj/typeck.c
@@ -3161,7 +3161,9 @@ void cb_emit_cancel(cb_tree prog) {
cb_emit(cb_build_funcall_1("CobolResolve.fieldCancel", prog));
}
-void cb_emit_cancel_all() { cb_emit(cb_build_funcall_0("cob_cancel_all")); }
+void cb_emit_cancel_all() {
+ cb_emit(cb_build_funcall_0("CobolResolve.cancelAll"));
+}
/*
* CLOSE statement
diff --git a/libcobj/app/src/main/java/jp/osscons/opensourcecobol/libcobj/call/CobolCallStackList.java b/libcobj/app/src/main/java/jp/osscons/opensourcecobol/libcobj/call/CobolCallStackList.java
new file mode 100644
index 00000000..712fa6c1
--- /dev/null
+++ b/libcobj/app/src/main/java/jp/osscons/opensourcecobol/libcobj/call/CobolCallStackList.java
@@ -0,0 +1,92 @@
+package jp.osscons.opensourcecobol.libcobj.call;
+
+/** CALLしたプログラムを階層構造で管理するためのクラス */
+public class CobolCallStackList {
+ private CobolCallStackList parent;
+ private CobolCallStackList children;
+ private CobolCallStackList sister;
+ private String name;
+
+ /** コンストラクタ */
+ protected CobolCallStackList() {
+ this.parent = null;
+ this.children = null;
+ this.sister = null;
+ this.name = null;
+ }
+
+ /**
+ * コンストラクタ
+ *
+ * @param name プログラム名
+ */
+ protected CobolCallStackList(String name) {
+ this.parent = null;
+ this.children = null;
+ this.sister = null;
+ this.name = name;
+ }
+
+ /**
+ * 親ノードを取得する
+ *
+ * @return parent 親ノード
+ */
+ protected CobolCallStackList getParent() {
+ return parent;
+ }
+
+ /**
+ * 親ノードを設定する
+ *
+ * @param parent 親ノード
+ */
+ protected void setParent(CobolCallStackList parent) {
+ this.parent = parent;
+ }
+
+ /**
+ * 子ノードを取得する
+ *
+ * @return children 子ノード
+ */
+ protected CobolCallStackList getChildren() {
+ return children;
+ }
+
+ /**
+ * 子ノードを設定する
+ *
+ * @param children 子ノード
+ */
+ protected void setChildren(CobolCallStackList children) {
+ this.children = children;
+ }
+
+ /**
+ * 兄弟ノードを取得する
+ *
+ * @return sister 兄弟ノード
+ */
+ protected CobolCallStackList getSister() {
+ return sister;
+ }
+
+ /**
+ * 兄弟ノードを設定する
+ *
+ * @param sister 兄弟ノード
+ */
+ protected void setSister(CobolCallStackList sister) {
+ this.sister = sister;
+ }
+
+ /**
+ * プログラム名を取得する
+ *
+ * @return name プログラム名
+ */
+ protected String getName() {
+ return name;
+ }
+}
diff --git a/libcobj/app/src/main/java/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java b/libcobj/app/src/main/java/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java
index e0930bf0..c21e6a6d 100644
--- a/libcobj/app/src/main/java/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java
+++ b/libcobj/app/src/main/java/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java
@@ -205,6 +205,12 @@ public class CobolResolve {
cobException.put(0x1609, "EC-XML-RANGE");
}
+ /** コールスタックリストのヘッド */
+ private static CobolCallStackList callStackListHead = null;
+
+ /** 現在のコールスタックリスト */
+ private static CobolCallStackList currentCallStackList = null;
+
/**
* 下記の環境変数を読み込み、CobolResolve内で定義されたメソッドの動作が変わる。
* 環境変数COB_LOAD_CASEにLOWERが指定されているときは、resolveメソッドに渡された引数を小文字に変換してから処理を開始する。
@@ -509,4 +515,125 @@ public static void cobCancel(String name) throws CobolStopRunException {
runner.cancel();
}
}
+
+ /**
+ * コールスタックリストを初期化する
+ */
+ private static void initCallStackList() {
+ if (callStackListHead == null) {
+ callStackListHead = new CobolCallStackList();
+ }
+ currentCallStackList = callStackListHead;
+ }
+
+ /**
+ * 新しいコールスタックリストを作成する
+ *
+ * @param name プログラム名
+ * @return 作成したコールスタックリスト
+ */
+ private static CobolCallStackList createCallStackList(String name) {
+ CobolCallStackList newList = new CobolCallStackList(name);
+ newList.setParent(currentCallStackList);
+ currentCallStackList = newList;
+ return newList;
+ }
+
+ /**
+ * 指定されたコールスタックリストとその子プログラムをすべてキャンセルする
+ *
+ * @param p キャンセル対象のコールスタックリスト
+ */
+ private static void cancelCallStackList(CobolCallStackList p) {
+ if (p == null) {
+ return;
+ }
+
+ // プログラムをキャンセル
+ String programName = p.getName();
+ if (programName != null) {
+ try {
+ CobolResolve.cobCancel(programName);
+ } catch (CobolStopRunException e) {
+ return;
+ }
+ }
+
+ // 子プログラムを再帰的にキャンセル
+ if (p.getChildren() != null) {
+ cancelCallStackList(p.getChildren());
+ p.setChildren(null);
+ }
+
+ // 兄弟要素を再帰的にキャンセル
+ if (p.getSister() != null) {
+ cancelCallStackList(p.getSister());
+ p.setSister(null);
+ }
+ }
+
+ /**
+ * コールスタックにプログラムをプッシュする
+ *
+ * @param name プログラム名
+ */
+ public static void pushCallStackList(String name) {
+ if (currentCallStackList == null) {
+ initCallStackList();
+ }
+
+ CobolCallStackList p = currentCallStackList.getChildren();
+ if (p == null) {
+ currentCallStackList.setChildren(createCallStackList(name));
+ return;
+ }
+
+ if (p.getName().equals(name)) {
+ currentCallStackList = p;
+ return;
+ }
+
+ if (p.getSister() == null) {
+ p.setSister(createCallStackList(name));
+ return;
+ }
+
+ p = p.getSister();
+ while (true) {
+ if (p.getName().equals(name)) {
+ currentCallStackList = p;
+ return;
+ }
+ if (p.getSister() == null) {
+ break;
+ }
+ p = p.getSister();
+ }
+
+ p.setSister(createCallStackList(name));
+ }
+
+ /**
+ * コールスタックから一つ取り出す
+ */
+ public static void popCallStackList() {
+ if (currentCallStackList != null) {
+ currentCallStackList = currentCallStackList.getParent();
+ }
+ }
+
+ /**
+ * 現在のコールスタックの子プログラムをすべてキャンセルする
+ *
+ * @throws CobolRuntimeException 現在のスタックがnullの場合
+ */
+ public static void cancelAll() throws CobolRuntimeException {
+ if (currentCallStackList == null) {
+ throw new CobolRuntimeException(
+ CobolRuntimeException.COBOL_FATAL_ERROR,
+ "Call to 'cancelAll' current stack is NULL");
+ }
+ cancelCallStackList(currentCallStackList.getChildren());
+ currentCallStackList.setChildren(null);
+ }
}
diff --git a/tests/run.src/miscellaneous.at b/tests/run.src/miscellaneous.at
index 4e2eee58..5b46a95f 100644
--- a/tests/run.src/miscellaneous.at
+++ b/tests/run.src/miscellaneous.at
@@ -610,8 +610,7 @@ AT_CHECK([java caller], [0],
AT_CLEANUP
-AT_SETUP([CANCEL ALL])
-AT_CHECK([${SKIP_TEST}])
+AT_SETUP([CANCEL ALL (1)])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
@@ -650,9 +649,9 @@ AT_DATA([call02.cob], [
GOBACK.
])
-AT_CHECK([${COMPILE} prog.cob])
-AT_CHECK([${COMPILE_MODULE} call01.cob])
-AT_CHECK([${COMPILE_MODULE} call02.cob])
+AT_CHECK([${COBJ} prog.cob])
+AT_CHECK([${COBJ} call01.cob])
+AT_CHECK([${COBJ} call02.cob])
AT_CHECK([java prog], [0],
[1
1
@@ -660,6 +659,269 @@ AT_CHECK([java prog], [0],
AT_CLEANUP
+AT_SETUP([CANCEL ALL (2)])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ CALL "child".
+ CALL "sister".
+ DISPLAY "CALL1END".
+ CALL "child".
+ CALL "sister".
+ DISPLAY "CALL2END".
+ CANCEL ALL.
+ CALL "child".
+ CALL "sister".
+ DISPLAY "CALL3END".
+ STOP RUN.
+])
+
+AT_DATA([child.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. child.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 VAR PIC 9(01) value 1.
+ PROCEDURE DIVISION.
+ DISPLAY VAR NO ADVANCING.
+ ADD 1 TO VAR.
+ CALL "grandchild1".
+ GOBACK.
+])
+
+AT_DATA([sister.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. sister.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 VAR PIC 9(01) value 2.
+ PROCEDURE DIVISION.
+ DISPLAY VAR NO ADVANCING.
+ ADD 1 TO VAR.
+ CALL "grandchild2".
+ CALL "grandchild3".
+ GOBACK.
+])
+
+AT_DATA([grandchild1.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. grandchild1.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 VAR PIC 9(01) value 3.
+ PROCEDURE DIVISION.
+ DISPLAY VAR NO ADVANCING.
+ ADD 1 TO VAR.
+ GOBACK.
+])
+
+AT_DATA([grandchild2.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. grandchild2.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 VAR PIC 9(01) value 4.
+ PROCEDURE DIVISION.
+ DISPLAY VAR NO ADVANCING.
+ ADD 1 TO VAR.
+ GOBACK.
+])
+
+AT_DATA([grandchild3.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. grandchild3.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 VAR PIC 9(01) value 5.
+ PROCEDURE DIVISION.
+ DISPLAY VAR NO ADVANCING.
+ ADD 1 TO VAR.
+ GOBACK.
+])
+
+AT_CHECK([${COBJ} prog.cob], [0])
+AT_CHECK([${COBJ} child.cob], [0])
+AT_CHECK([${COBJ} sister.cob], [0])
+AT_CHECK([${COBJ} grandchild1.cob], [0])
+AT_CHECK([${COBJ} grandchild2.cob], [0])
+AT_CHECK([${COBJ} grandchild3.cob], [0])
+AT_CHECK([java prog], [0],
+[13245CALL1END
+24356CALL2END
+13245CALL3END
+])
+
+AT_CLEANUP
+
+AT_SETUP([CANCEL ALL (3)])
+
+AT_DATA([prog.cbl], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 WS-COUNTER PIC 9(3) VALUE 0.
+ 01 WS-MESSAGE PIC X(50).
+ 01 P-NAME PIC X(17) VALUE "prog".
+ PROCEDURE DIVISION.
+ ADD 1 TO WS-COUNTER.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+
+ CALL "child".
+
+ ADD 1 TO WS-COUNTER.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+
+ CALL "child".
+
+ ADD 1 TO WS-COUNTER.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+
+ STOP RUN.
+])
+
+AT_DATA([child.cbl], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. child.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 WS-CALL-COUNT PIC 9(3) VALUE 0.
+ 01 P-NAME PIC X(17) VALUE "child".
+ PROCEDURE DIVISION.
+ ADD 1 TO WS-CALL-COUNT.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-CALL-COUNT = " WS-CALL-COUNT.
+
+ CALL "grandchild01".
+
+ DISPLAY "@<:@" P-NAME "@:>@ WS-CALL-COUNT = " WS-CALL-COUNT.
+
+ CALL "grandchild02".
+
+ GOBACK.
+])
+
+AT_DATA([grandchild01.cbl], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. grandchild01.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 WS-COUNTER PIC 9(3) VALUE 0.
+ 01 P-NAME PIC X(17) VALUE "grandchild01".
+ PROCEDURE DIVISION.
+ ADD 1 TO WS-COUNTER.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+
+ CALL "greatgrandchild01".
+ CALL "greatgrandchild02".
+
+ DISPLAY "@<:@" P-NAME "@:>@ *** CANCEL ALL ***".
+ CANCEL ALL.
+
+ CALL "greatgrandchild01".
+ CALL "greatgrandchild02".
+
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+ GOBACK.
+])
+
+AT_DATA([grandchild02.cbl], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. grandchild02.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 WS-COUNTER PIC 9(3) VALUE 0.
+ 01 P-NAME PIC X(17) VALUE "grandchild02".
+ PROCEDURE DIVISION.
+ ADD 1 TO WS-COUNTER.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+
+ IF WS-COUNTER = 1 THEN
+ DISPLAY "@<:@" P-NAME "@:>@ FIRST CALL"
+ END-IF.
+
+ GOBACK.
+])
+
+AT_DATA([greatgrandchild01.cbl], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. greatgrandchild01.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 WS-COUNTER PIC 9(3) VALUE 0.
+ 01 P-NAME PIC X(17) VALUE "greatgrandchild01".
+ PROCEDURE DIVISION.
+ ADD 1 TO WS-COUNTER.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+
+ IF WS-COUNTER = 1 THEN
+ DISPLAY "@<:@" P-NAME "@:>@ FIRST CALL"
+ END-IF.
+ GOBACK.
+])
+
+AT_DATA([greatgrandchild02.cbl], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. greatgrandchild02.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 WS-COUNTER PIC 9(3) VALUE 0.
+ 01 P-NAME PIC X(17) VALUE "greatgrandchild02".
+ PROCEDURE DIVISION.
+ ADD 1 TO WS-COUNTER.
+ DISPLAY "@<:@" P-NAME "@:>@ WS-COUNTER = " WS-COUNTER.
+
+ IF WS-COUNTER = 1 THEN
+ DISPLAY "@<:@" P-NAME "@:>@ FIRST CALL"
+ END-IF.
+ GOBACK.
+])
+
+AT_CHECK([${COBJ} prog.cbl], [0])
+AT_CHECK([${COBJ} child.cbl], [0])
+AT_CHECK([${COBJ} grandchild01.cbl], [0])
+AT_CHECK([${COBJ} grandchild02.cbl], [0])
+AT_CHECK([${COBJ} greatgrandchild01.cbl], [0])
+AT_CHECK([${COBJ} greatgrandchild02.cbl], [0])
+
+AT_CHECK([java prog], [0],
+[@<:@prog @:>@ WS-COUNTER = 001
+@<:@child @:>@ WS-CALL-COUNT = 001
+@<:@grandchild01 @:>@ WS-COUNTER = 001
+@<:@greatgrandchild01@:>@ WS-COUNTER = 001
+@<:@greatgrandchild01@:>@ FIRST CALL
+@<:@greatgrandchild02@:>@ WS-COUNTER = 001
+@<:@greatgrandchild02@:>@ FIRST CALL
+@<:@grandchild01 @:>@ *** CANCEL ALL ***
+@<:@greatgrandchild01@:>@ WS-COUNTER = 001
+@<:@greatgrandchild01@:>@ FIRST CALL
+@<:@greatgrandchild02@:>@ WS-COUNTER = 001
+@<:@greatgrandchild02@:>@ FIRST CALL
+@<:@grandchild01 @:>@ WS-COUNTER = 001
+@<:@child @:>@ WS-CALL-COUNT = 001
+@<:@grandchild02 @:>@ WS-COUNTER = 001
+@<:@grandchild02 @:>@ FIRST CALL
+@<:@prog @:>@ WS-COUNTER = 002
+@<:@child @:>@ WS-CALL-COUNT = 002
+@<:@grandchild01 @:>@ WS-COUNTER = 002
+@<:@greatgrandchild01@:>@ WS-COUNTER = 002
+@<:@greatgrandchild02@:>@ WS-COUNTER = 002
+@<:@grandchild01 @:>@ *** CANCEL ALL ***
+@<:@greatgrandchild01@:>@ WS-COUNTER = 001
+@<:@greatgrandchild01@:>@ FIRST CALL
+@<:@greatgrandchild02@:>@ WS-COUNTER = 001
+@<:@greatgrandchild02@:>@ FIRST CALL
+@<:@grandchild01 @:>@ WS-COUNTER = 002
+@<:@child @:>@ WS-CALL-COUNT = 002
+@<:@grandchild02 @:>@ WS-COUNTER = 002
+@<:@prog @:>@ WS-COUNTER = 003
+])
+
+AT_CLEANUP
+
AT_SETUP([CALL binary literal parameter/LENGTH OF - so])
AT_CHECK([${SKIP_TEST}])