From 13878d759d7f57a914381e527f69a2386c824c28 Mon Sep 17 00:00:00 2001
From: Bob Dubner <rdubner@symas.com>
Date: Fri, 29 Dec 2023 10:44:44 -0500
Subject: [PATCH] Refine failsuite/run_function tests
---
gcc/cobol/UAT/failsuite.src/run_functions.at | 39 ++++++--------------
gcc/cobol/genapi.cc | 6 ++-
libgcobol/libgcobol.cc | 5 +++
3 files changed, 20 insertions(+), 30 deletions(-)
diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at
index 60f90e2c1a4b..68fc377f768b 100644
--- a/gcc/cobol/UAT/failsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/failsuite.src/run_functions.at
@@ -578,10 +578,6 @@ AT_CLEANUP
AT_SETUP([Intrinsics without FUNCTION keyword (1)])
AT_KEYWORDS([functions])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# GNU -f
-
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
@@ -593,22 +589,24 @@ AT_DATA([prog.cob], [
MOVE E TO Z.
STOP RUN.
])
-
-AT_CHECK([$COMPILE -fintrinsics=all prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
+AT_CHECK([$COMPILE prog.cob], [1], [], [prog.cob:8: syntax error: symbol 'PI' not found at 'TO'
+prog.cob:9: syntax error: symbol 'E' not found at 'TO'
+prog.cob:10: syntax error: symbol 'E' not found at 'TO'
+cobol1: error: failed compiling prog.cob
+])
AT_CLEANUP
AT_SETUP([Intrinsics without FUNCTION keyword (2)])
AT_KEYWORDS([functions])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# GNU -f
-
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ REPOSITORY.
+ FUNCTION PI
+ FUNCTION E.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Z PIC 99V99.
@@ -617,10 +615,8 @@ AT_DATA([prog.cob], [
MOVE E TO Z.
STOP RUN.
])
-
-AT_CHECK([$COMPILE -fintrinsics=pi,e prog.cob], [0], [], [])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
AT_CLEANUP
@@ -722,10 +718,6 @@ AT_CLEANUP
AT_SETUP([UDF replacing intrinsic function])
AT_KEYWORDS([functions SUBSTITUTE])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# GNU -f
-
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. SUBSTITUTE.
@@ -756,21 +748,16 @@ AT_DATA([prog.cob], [
.
END PROGRAM prog.
])
-
AT_CHECK([$COMPILE -fnot-intrinsic=substitute prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
[" _ C_O_B_O_L _ "
" - C-O-B-O-L - "
])
-
AT_CLEANUP
AT_SETUP([UDF with recursion])
AT_KEYWORDS([functions LOCAL-STORAGE])
-
-AT_SKIP_IF(true) # see bug #222 and r2291 - postponed
-
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. foo.
@@ -817,11 +804,8 @@ AT_DATA([prog.cob], [
END-DISPLAY
GOBACK.
END PROGRAM prog.
-
])
-
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-
AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
[Step: 1, Arg: 5, Return: 5
Step: 2, Arg: 4, Return: 5
@@ -829,7 +813,6 @@ Step: 3, Arg: 3, Return: 5
Step: 4, Arg: 2, Return: 5
Step: 5, Arg: 1, Return: 5
Return value '5'], [])
-
AT_CLEANUP
AT_SETUP([v2-bugs functions repository])
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 842f5596927c..3fda2f820f97 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -14308,7 +14308,7 @@ psa_new_var_decl(cbl_field_t *new_var, const char *external_record_base)
{
new_var_decl = gg_define_variable( cblc_field_type_node,
base_name,
- vs_static); // was vs_stack
+ vs_static);
}
else
{
@@ -14340,13 +14340,15 @@ parser_local_add(struct cbl_field_t *new_var )
// We need to allocate memory on the stack for this variable
char achDataName[256];
sprintf(achDataName, "..vardata_%lu", sv_data_name_counter++);
+ fprintf(stderr, "compile-time local name is %s\n", achDataName);
tree array_type = build_array_type_nelts(UCHAR, new_var->data.capacity);
tree data_decl_node = gg_define_variable( array_type,
- achDataName,
+ NULL,
vs_stack);
gg_assign( member(new_var->var_decl_node, "data"),
gg_get_address_of(data_decl_node) );
+ gg_printf("run-time local name is %s %p\n", gg_string_literal(achDataName), gg_get_address_of(data_decl_node), NULL_TREE);
}
cbl_refer_t wrapper;
wrapper.field = new_var;
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 476e82597055..61840d99cf68 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -6602,6 +6602,11 @@ __gg__display( cblc_refer_t *var,
static size_t display_string_size = MINIMUM_ALLOCATION_SIZE;
static char *display_string = (char *)MALLOC(display_string_size);
+ if(strcmp(var->field->name, "arg") == 0 )
+ {
+ fprintf(stderr, "__gg__display of arg %p\n", var->qual_data);
+ }
+
format_for_display_internal(&display_string,
&display_string_size,
var->field,
--
GitLab