From eb11e4fe0d318925a212631706e8b9325d7b8ce7 Mon Sep 17 00:00:00 2001
From: "James K. Lowden" <jklowden@symas.com>
Date: Wed, 3 Jan 2024 17:51:18 -0500
Subject: [PATCH] introduce expanding pointer test
---
gcc/cobol/UAT/failsuite.src/run_functions.at | 50 +++++++++++++++++---
gcc/cobol/parse.y | 2 +-
gcc/cobol/parse_ante.h | 1 +
3 files changed, 46 insertions(+), 7 deletions(-)
diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at
index 68fc377f768b..c2b15c579cc4 100644
--- a/gcc/cobol/UAT/failsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/failsuite.src/run_functions.at
@@ -817,17 +817,13 @@ AT_CLEANUP
AT_SETUP([v2-bugs functions repository])
AT_KEYWORDS([v1-bugs functions repository])
-# REPOSITORY FUNCTION clause
-AT_XFAIL_IF(true)
-# FUNCTIONS NOT IMPLEMENTED TODO
-# NOT V1 ISSUE!!
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
- SOURCE-COMPUTER a.
- OBJECT-COMPUTER a.
+ SOURCE-COMPUTER. a.
+ OBJECT-COMPUTER. a.
REPOSITORY.
FUNCTION ALL INTRINSIC.
PROCEDURE DIVISION.
@@ -836,3 +832,45 @@ AT_DATA([prog.cob], [
AT_CHECK([$COMPILE prog.cob], [0], [], [])
AT_CLEANUP
+#####
+
+AT_SETUP([FUNCTION BIGGER-POINTER])
+AT_KEYWORDS([functions POINTER ])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 N PICTURE S9(8) COMP.
+ 77 P REDEFINES N USAGE POINTER.
+ 01 X PIC A(4) VALUE Z"ABC".
+ 05 E PIC A OCCURS 4.
+ 77 B PICTURE A BASED.
+
+ PROCEDURE DIVISION.
+ set P to address of E(1).
+
+ display FUNCTION trim(x) '.'
+
+ perform until B = SPACES
+ set address of B to p.
+ display B no advancing
+ set p up by 1.
+ end-perform.
+ display '.'.
+
+
+ perform until B = SPACES
+ set address of B to p.
+ display B no advancing
+ add 8 to N.
+ end-perform.
+ display '.'.
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE -dialect ibm prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 67cbd6fea55f..abfb555ba65c 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -6797,7 +6797,7 @@ set_operand: set_tgt
| signed_literal { $$ = new_reference($1); }
;
set_tgt: scalar
- | ADDRESS OF scalar { $$ = $scalar; $$->addr_of = true; }
+ | ADDRESS of scalar { $$ = $scalar; $$->addr_of = true; }
;
set: SET set_tgts[tgts] TO set_operand[src]
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index b04c1cbe08e7..fe83e582df5f 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -2539,6 +2539,7 @@ parser_move_carefully( const char */*F*/, int /*L*/,
static void
ast_set_pointers( const list<cbl_num_result_t>& tgts, cbl_refer_t src ) {
assert(!tgts.empty());
+ assert(src.field);
size_t nptr = tgts.size();
cbl_refer_t ptrs[nptr];
--
GitLab