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

Add option to enable function LENGTH-AN.

Author: kztanaka

cobc/config.def

@@ -48,6 +48,7 @@ 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_BOOLEAN (cb_enable_length_an_intrinsic_function, "enable-length-an-intrinsic-function")
 CB_CONFIG_BOOLEAN (cb_enable_national_intrinsic_function, "enable-national-intrinsic-function")
 CB_CONFIG_SUPPORT (cb_author_paragraph, "author-paragraph")
 CB_CONFIG_SUPPORT (cb_memory_size_clause, "memory-size-clause")

cobc/reserved.c

@@ -733,6 +733,9 @@ static const struct cb_intrinsic_table function_list[] = {
   { "LENGTH",				1, 1, CB_INTR_LENGTH,
 					"cob_intr_length",
 					CB_CATEGORY_NUMERIC, 0 },
+  { "LENGTH-AN",			1, 1, CB_INTR_LENGTH_AN,
+					"cob_intr_length",
+					CB_CATEGORY_NUMERIC, 0 },
   { "LOCALE-COMPARE",			-1, 0, CB_INTR_LOCALE_COMPARE,
 					NULL,
 					CB_CATEGORY_ALPHANUMERIC, 0 },

cobc/tree.c

@@ -2620,13 +2620,15 @@ cb_build_intrinsic (cb_tree name, cb_tree args, cb_tree refmod)
 				}
 #endif /*I18N_UTF8*/
 			}
+
+		case CB_INTR_BYTE_LENGTH:
 		case CB_INTR_LENG:
-			if (!cb_enable_leng_intrinsic_function) {
+		case CB_INTR_LENGTH_AN:
+			if ((cbp->intr_enum == CB_INTR_LENG && !cb_enable_leng_intrinsic_function) ||
+			    (cbp->intr_enum == CB_INTR_LENGTH_AN && !cb_enable_length_an_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)) {
 				return make_intrinsic (name, cbp, args, NULL, NULL);

cobc/tree.h

@@ -873,6 +873,7 @@ enum cb_intr_enum {
 	CB_INTR_INTEGER_PART,
 	CB_INTR_LENG,
 	CB_INTR_LENGTH,
+	CB_INTR_LENGTH_AN,
 	CB_INTR_LOCALE_COMPARE,
 	CB_INTR_LOCALE_DATE,
 	CB_INTR_LOCALE_TIME,

config/default.conf

@@ -129,4 +129,5 @@ enable-sort-status-register:		no
 enable-special-names-argument-clause:	no
 enable-special-names-environment-clause:	no
 enable-leng-intrinsic-function:		no
+enable-length-an-intrinsic-function:	no
 enable-national-intrinsic-function:	no

config/jp-compat.conf

@@ -13,4 +13,5 @@ enable-sort-status-register:		yes
 enable-special-names-argument-clause:	yes
 enable-special-names-environment-clause:	yes
 enable-leng-intrinsic-function:		yes
+enable-length-an-intrinsic-function:	yes
 enable-national-intrinsic-function:	yes

tests/jp-compat.src/intr-funcs.at

@@ -41,3 +41,46 @@ AT_CHECK([./prog], [0], [04])
 
 AT_CLEANUP
 
+AT_SETUP([FUNCTION LENGTH-AN (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 LENGTH-AN (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 LENGTH-AN (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 LENGTH-AN (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
+