FUNCTION LENG関数をサポートする設定の追加です。

kztanaka · kztanaka · commit f8e0cac41b47 · 2013-10-25T14:20:39.000+09:00
Add option to enable function LENG.
diff --git a/cobc/config.def b/cobc/config.def
@@ -47,6 +47,7 @@ CB_CONFIG_BOOLEAN (cb_enable_program_status_register, "enable-program-status-reg
 CB_CONFIG_BOOLEAN (cb_enable_sort_status_register, "enable-sort-status-register")
 CB_CONFIG_BOOLEAN (cb_enable_special_names_argument_clause, "enable-special-names-argument-clause")
 CB_CONFIG_BOOLEAN (cb_enable_special_names_environment_clause, "enable-special-names-environment-clause")
+CB_CONFIG_BOOLEAN (cb_enable_leng_intrinsic_function, "enable-leng-intrinsic-function")
 CB_CONFIG_SUPPORT (cb_author_paragraph, "author-paragraph")
 CB_CONFIG_SUPPORT (cb_memory_size_clause, "memory-size-clause")
 CB_CONFIG_SUPPORT (cb_multiple_file_tape_clause, "multiple-file-tape-clause")
diff --git a/cobc/reserved.c b/cobc/reserved.c
@@ -727,6 +727,9 @@ static const struct cb_intrinsic_table function_list[] = {
   { "INTEGER-PART",			1, 1, CB_INTR_INTEGER_PART,
 					"cob_intr_integer_part",
 					CB_CATEGORY_NUMERIC, 0 },
+  { "LENG",				1, 1, CB_INTR_LENG,
+					"cob_intr_length",
+					CB_CATEGORY_NUMERIC, 0 },
   { "LENGTH",				1, 1, CB_INTR_LENGTH,
 					"cob_intr_length",
 					CB_CATEGORY_NUMERIC, 0 },
diff --git a/cobc/tree.c b/cobc/tree.c
@@ -2620,6 +2620,12 @@ cb_build_intrinsic (cb_tree name, cb_tree args, cb_tree refmod)
 				}
 #endif /*I18N_UTF8*/
 			}
+		case CB_INTR_LENG:
+			if (!cb_enable_leng_intrinsic_function) {
+				cb_error_x (name, _("FUNCTION %s not implemented"), CB_NAME (name));
+				return cb_error_node;
+			}
+			/* do same as CB_INTR_BYTE_LENGTH continue. */
 		case CB_INTR_BYTE_LENGTH:
 			x = CB_VALUE (args);
 			if (CB_INTRINSIC_P (x)) {
diff --git a/cobc/tree.h b/cobc/tree.h
@@ -871,6 +871,7 @@ enum cb_intr_enum {
 	CB_INTR_INTEGER_OF_DATE,
 	CB_INTR_INTEGER_OF_DAY,
 	CB_INTR_INTEGER_PART,
+	CB_INTR_LENG,
 	CB_INTR_LENGTH,
 	CB_INTR_LOCALE_COMPARE,
 	CB_INTR_LOCALE_DATE,
diff --git a/config/default.conf b/config/default.conf
@@ -128,3 +128,4 @@ enable-program-status-register:		no
 enable-sort-status-register:		no
 enable-special-names-argument-clause:	no
 enable-special-names-environment-clause:	no
+enable-leng-intrinsic-function:		no
diff --git a/config/jp-compat.conf b/config/jp-compat.conf
@@ -12,3 +12,4 @@ enable-program-status-register:		yes
 enable-sort-status-register:		yes
 enable-special-names-argument-clause:	yes
 enable-special-names-environment-clause:	yes
+enable-leng-intrinsic-function:		yes
diff --git a/tests/Makefile.am b/tests/Makefile.am
@@ -87,7 +87,8 @@ jp_compat_DEPENDENCIES = \
 	jp-compat.src/evaluate-also-missing.at \
 	jp-compat.src/empty-imperative.at \
 	jp-compat.src/spl-registers.at \
-	jp-compat.src/special-names.at
+	jp-compat.src/special-names.at \
+	jp-compat.src/intr-funcs.at
 
 EXTRA_DIST = $(srcdir)/package.m4 $(TESTS) \
 	$(syntax_DEPENDENCIES) \
diff --git a/tests/Makefile.in b/tests/Makefile.in
@@ -272,7 +272,8 @@ jp_compat_DEPENDENCIES = \
 	jp-compat.src/evaluate-also-missing.at \
 	jp-compat.src/empty-imperative.at \
 	jp-compat.src/spl-registers.at \
-	jp-compat.src/special-names.at
+	jp-compat.src/special-names.at \
+	jp-compat.src/intr-funcs.at
 
 EXTRA_DIST = $(srcdir)/package.m4 $(TESTS) \
 	$(syntax_DEPENDENCIES) \
diff --git a/tests/jp-compat.at b/tests/jp-compat.at
@@ -28,3 +28,4 @@ m4_include([evaluate-also-missing.at])
 m4_include([empty-imperative.at])
 m4_include([spl-registers.at])
 m4_include([special-names.at])
+m4_include([intr-funcs.at])
diff --git a/tests/jp-compat.src/intr-funcs.at b/tests/jp-compat.src/intr-funcs.at
@@ -0,0 +1,43 @@
+AT_SETUP([FUNCTION LENG (fixed)])
+
+AT_DATA([prog.cob], [
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       77 FIXED_FLD PIC X(8) USAGE DISPLAY.
+       77 NLEN      PIC 9(2) USAGE DISPLAY.
+       PROCEDURE        DIVISION.
+           MOVE FUNCTION LENG (FIXED_FLD) TO NLEN.
+           DISPLAY NLEN WITH NO ADVANCING.
+           STOP RUN.
+])
+
+AT_CHECK([${COMPILE_JP_COMPAT} -x prog.cob])
+AT_CHECK([./prog], [0], [08])
+
+AT_CLEANUP
+
+AT_SETUP([FUNCTION LENG (occur. depending)])
+
+AT_DATA([prog.cob], [
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 DEP_FLD.
+          03 DEP_ITEM  PIC X(2) OCCURS 1 TO 10 DEPENDING ON NDEP.
+       77 NDEP         PIC 9(2) USAGE DISPLAY.
+       77 NLEN         PIC 9(2) USAGE DISPLAY.
+       PROCEDURE        DIVISION.
+           MOVE 2 TO NDEP.
+           MOVE FUNCTION LENG (DEP_FLD) TO NLEN.
+           DISPLAY NLEN WITH NO ADVANCING.
+           STOP RUN.
+])
+
+AT_CHECK([${COMPILE_JP_COMPAT} -x prog.cob])
+AT_CHECK([./prog], [0], [04])
+
+AT_CLEANUP
+

Original file line number	Diff line number	Diff line change
`@@ -2620,6 +2620,12 @@ cb_build_intrinsic (cb_tree name, cb_tree args, cb_tree refmod)`
`2620`	`2620`	`}`
`2621`	`2621`	`#endif /I18N_UTF8/`
`2622`	`2622`	`}`
	`2623`	`+ case CB_INTR_LENG:`
	`2624`	`+ if (!cb_enable_leng_intrinsic_function) {`
	`2625`	`+ cb_error_x (name, _("FUNCTION %s not implemented"), CB_NAME (name));`
	`2626`	`+ return cb_error_node;`
	`2627`	`+ }`
	`2628`	`+ /* do same as CB_INTR_BYTE_LENGTH continue. */`
`2623`	`2629`	`case CB_INTR_BYTE_LENGTH:`
`2624`	`2630`	`x = CB_VALUE (args);`
`2625`	`2631`	`if (CB_INTRINSIC_P (x)) {`