From 4dd37534e5a7d2c5eec011742598e49e489d551a Mon Sep 17 00:00:00 2001 From: David Declerck Date: Wed, 12 Jun 2024 23:32:16 +0200 Subject: [PATCH] Merge SVN 4098, 4101 --- cobc/ChangeLog | 11 +- cobc/typeck.c | 4 +- cobc/warning.def | 4 +- tests/ChangeLog | 7 + tests/testsuite.src/listings.at | 14 +- tests/testsuite.src/run_extensions.at | 433 ----------------------- tests/testsuite.src/run_file.at | 453 ++++++++++++++++++++++++- tests/testsuite.src/run_fundamental.at | 7 +- tests/testsuite.src/run_misc.at | 3 +- tests/testsuite.src/syn_file.at | 83 ++++- 10 files changed, 564 insertions(+), 455 deletions(-) diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 23327166e..9d0c84231 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -938,6 +938,15 @@ one with additional possible NAME ... IS OMITTED and without GENERATE XML checks +2020-12-17 Simon Sobisch + + bug #571 revised: + * typeck.c (create_implicit_assign_dynamic_var): add ASSIGN name as + implicit VALUE clause for the implicit variable providing a + reasonable (expected) default if not manually set + * warning.def (implicit-define): changed from "always on" to "only upon + request" as the unexpected "inconsistent empty filename" was fixed + 2020-12-15 Simon Sobisch * typeck.c [!COB_ALLOW_UNALIGNED]: fixed unused variable warning @@ -1343,7 +1352,7 @@ 2020-07-26 Edward Hart * config.def: added possible values for assign-clause and - screen-section-rules. + screen-section-rules 2020-07-21 Simon Sobisch diff --git a/cobc/typeck.c b/cobc/typeck.c index 6c319d633..f78657830 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -3804,6 +3804,7 @@ create_implicit_assign_dynamic_var (struct cb_program * const prog, { cb_tree x; struct cb_field *p; + const char *assign_name = CB_NAME (assign); cb_warning (cb_warn_implicit_define, _("variable '%s' will be implicitly defined"), CB_NAME (assign)); @@ -3812,8 +3813,9 @@ create_implicit_assign_dynamic_var (struct cb_program * const prog, #if 0 p->count++; #endif + x = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, assign_name, strlen (assign_name))); + p->values = CB_LIST_INIT (x); CB_FIELD_ADD (prog->working_storage, p); - } static void diff --git a/cobc/warning.def b/cobc/warning.def index 8522678c7..c863b9837 100644 --- a/cobc/warning.def +++ b/cobc/warning.def @@ -69,8 +69,8 @@ CB_WARNDEF (cb_warn_parentheses, "parentheses", CB_WARNDEF (cb_warn_strict_typing, "strict-typing", _(" -Wstrict-typing warn strictly about type mismatch")) -CB_ONWARNDEF (cb_warn_implicit_define, "implicit-define", - _(" -Wno-implicit-define do not warn when data items are implicitly defined")) +CB_NOWARNDEF (cb_warn_implicit_define, "implicit-define", + _(" -Wimplicit-define warn about implicitly defined data items")) CB_ONWARNDEF (cb_warn_corresponding, "corresponding", _(" -Wno-corresponding do not warn about CORRESPONDING with no matching items")) diff --git a/tests/ChangeLog b/tests/ChangeLog index feb35cba8..cad5845a3 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -88,6 +88,13 @@ * testsuite.src/run_file.at: Added test cases for COMMIT/ROLLBACK +2020-12-20 Simon Sobisch + + * testsuite.src/run_extensions.at, testsuite.src/run_file.at: + moved ASSIGN related tests to run_file.at + * testsuite.src/run_misc.at: work around bug for CANCEL in test + "Recursive CALL of RECURSIVE program" by disabling that side-tests + 2020-12-04 Ron Norman * testsuite.src/run_misc.at: corrected for 32/64-bit by removing pointer diff --git a/tests/testsuite.src/listings.at b/tests/testsuite.src/listings.at index 78407c139..7d0f7fc9d 100644 --- a/tests/testsuite.src/listings.at +++ b/tests/testsuite.src/listings.at @@ -1049,7 +1049,12 @@ AT_DATA([prog.cob], [ STOP RUN. ]) -AT_CHECK([$COMPILE_ONLY -t prog.lst prog.cob], [1], [], [ignore]) +AT_CHECK([$COMPILE_ONLY -Wimplicit-define -t prog.lst prog.cob], [1], [], +[copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL +copy.inc:5: error: missing file description for FILE testfile +prog.cob:7: warning: variable 'filename' will be implicitly defined +prog.cob:8: error: 'FIRST-MATCH' is not defined +]) AT_DATA([prog12.lst], [GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 @@ -1097,7 +1102,12 @@ prog.cob:8: error: 'FIRST-MATCH' is not defined AT_CHECK([gcdiff prog12.lst prog.lst], [0], [], []) -AT_CHECK([$COMPILE_ONLY -T prog.lst prog.cob], [1], [], [ignore]) +AT_CHECK([$COMPILE_ONLY -Wimplicit-define -T prog.lst prog.cob], [1], [], +[copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL +copy.inc:5: error: missing file description for FILE testfile +prog.cob:7: warning: variable 'filename' will be implicitly defined +prog.cob:8: error: 'FIRST-MATCH' is not defined +]) AT_DATA([prog13.lst], [GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 diff --git a/tests/testsuite.src/run_extensions.at b/tests/testsuite.src/run_extensions.at index 56c4bb21b..0b6348938 100644 --- a/tests/testsuite.src/run_extensions.at +++ b/tests/testsuite.src/run_extensions.at @@ -2541,439 +2541,6 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - -## ASSIGN - -AT_SETUP([ASSIGN DYNAMIC and EXTERNAL]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - - WORKING-STORAGE SECTION. - 01 whatever PIC X(10) VALUE "out.txt". - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - . -]) - -AT_CHECK([$COMPILE -fassign-clause=external prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CAPTURE_FILE(./whatever) -AT_DATA([reference], -[hi -]) -AT_CHECK([diff reference whatever], [0], [], []) - -AT_CHECK([$COMPILE -fassign-clause=dynamic -fno-implicit-assign-dynamic-var prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CAPTURE_FILE(./whatever) -AT_CHECK([diff reference whatever], [0], [], []) - -AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CAPTURE_FILE(./out.txt) -AT_CHECK([diff reference out.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN DYNAMIC implicit variable]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - - PROCEDURE DIVISION. - MOVE "out.txt" TO whatever - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - . -]) - -AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], -[prog.cob:16: warning: variable 'whatever' will be implicitly defined -]) -AT_CLEANUP - - -AT_SETUP([ASSIGN EXTERNAL parsing]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - *> Labels should be removed from EXTERNAL name. - SELECT TEST-FILE ASSIGN DA-S-FILENAME. - *> EXTERNAL name allowed to duplicate FD name. - SELECT TESTFILE2 ASSIGN TESTFILE2. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - FD TESTFILE2. - 01 TESTREC2 PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fassign-clause=external prog.cob], [0], [], -[prog.cob:8: warning: ASSIGN DA-S-FILENAME interpreted as 'FILENAME' -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f FILENAME], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN directive]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - $SET ASSIGN "EXTERNAL" - SELECT g ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - FD g. - 01 g-rec PIC XXX. - - PROCEDURE DIVISION. - MOVE "out.txt" TO whatever - - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - - OPEN OUTPUT g - WRITE g-rec FROM "hi" - CLOSE g - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], -[prog.cob:21: warning: variable 'whatever' will be implicitly defined -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN expansion]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "$DIR/FILENAME". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -ffilename-mapping prog.cob], [0], [], []) -AT_CHECK([DIR="." $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "./FILENAME" && rm -f "./FILENAME"], [0], [], []) - -AT_CLEANUP - -AT_SETUP([ASSIGN mapping]) -AT_KEYWORDS([extensions runfile optional]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAME". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAME2". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fno-filename-mapping prog.cob], [0], [], []) -AT_CHECK([DD_FILENAME="x" $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "x"], [1]) -AT_CHECK([test -f "FILENAME"], [0], [], []) - -AT_CHECK([$COMPILE -ffilename-mapping prog2.cob], [0], [], []) -AT_CHECK([DD_FILENAME2="x" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "FILENAME2"], [1]) -AT_CHECK([test -f "x"], [0], [], []) -AT_CHECK([dd_FILENAME2="y" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "y"], [0], [], []) -AT_CHECK([FILENAME2="z" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "z"], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "FILENAME2"], [0], [], []) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL INFILE ASSIGN TO "MYFILE" - ORGANIZATION IS RELATIVE - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD INFILE. - 01 INREC PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - * open missing file - OPEN INPUT INFILE - DISPLAY "STATUS OPENI " WSFS - CLOSE INFILE - * - * create missing file - OPEN OUTPUT INFILE - DISPLAY "STATUS OPENO " WSFS - CLOSE INFILE - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog3.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "MYFILE"], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 00 -STATUS OPENO 00 -], []) - -AT_CHECK([MYFILE="TSTFILE" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "TSTFILE"], [0], [], []) - -AT_CHECK([dd_MYFILE="TSTFILE2" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "TSTFILE2"], [0], [], []) - -AT_CHECK([DD_MYFILE="TSTFILE3" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "TSTFILE3"], [0], [], []) - -AT_CHECK([DD_MYFILE="./nosubhere/TSTFILE" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 30 -], []) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FILE0 ASSIGN TO "./nosubhere/MYFILE0" - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - SELECT FILE1 ASSIGN TO "MYFILE1" - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - SELECT FILE2 ASSIGN TO FILENAME - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD FILE0. - 01 F0REC PIC X(80). - FD FILE1. - 01 F1REC PIC X(80). - FD FILE2. - 01 F2REC PIC X(80). - WORKING-STORAGE SECTION. - 77 FILENAME PIC X(80) VALUE "MYFILE2". - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - OPEN OUTPUT FILE0 - DISPLAY "STATUS OPENO 0 " WSFS - OPEN OUTPUT FILE1 - DISPLAY "STATUS OPENO 1 " WSFS - OPEN OUTPUT FILE2 - DISPLAY "STATUS OPENO 2 " WSFS - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog4.cob], [0], [], []) - -AT_CHECK([DD_MYFILE1="./nosubhere/NOFILE1" DD_MYFILE2="./nosubhere/NOFILE2" \ -$COBCRUN_DIRECT ./prog4], [0], -[STATUS OPENO 0 30 -STATUS OPENO 1 30 -STATUS OPENO 2 30 -], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN with COB_FILE_PATH]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAMEX". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "SUBDIR/FILENAMEX". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -ffilename-mapping prog.cob], [0], [], []) - -AT_CHECK([rm -rf "tstdir" && mkdir "tstdir"], [0], [], []) - -AT_CHECK([COB_FILE_PATH="tstdir" $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "tstdir/FILENAMEX" && rm -f "tstdir/FILENAMEX"], [0], [], []) - -AT_CHECK([COB_FILE_PATH="tstdir/" $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "tstdir/FILENAMEX"], [0], [], []) - -# FIXME: on OPEN we should also output the full filename (if any) leading to the error -AT_CHECK([COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog 2>prog.err], [1], [], []) -# workaround for testing windows-builds... -AT_CHECK([cat prog.err | tr '\\' '/'], [0], -[libcob: prog.cob:13: error: permanent file error (status = 30) for file TEST-FILE ('FILENAMEX' => ./nosubhere/FILENAMEX) on OPEN -], []) - - -AT_CHECK([$COMPILE -ffilename-mapping prog2.cob], [0], [], []) - -AT_CHECK([mkdir "tstdir/SUBDIR"], [0], [], []) - -AT_CHECK([COB_FILE_PATH="tstdir" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "tstdir/SUBDIR/FILENAMEX" && rm -f "tstdir/SUBDIR/FILENAMEX"], [0], [], []) - -AT_CHECK([COB_FILE_PATH="tstdir/" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "tstdir/SUBDIR/FILENAMEX"], [0], [], []) - -AT_CHECK([COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog2 2>prog.err], [1], [], []) -AT_CHECK([cat prog.err | tr '\\' '/'], [0], -[libcob: prog2.cob:13: error: permanent file error (status = 30) for file TEST-FILE ('SUBDIR/FILENAMEX' => ./nosubhere/SUBDIR/FILENAMEX) on OPEN -], []) - - AT_CLEANUP diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index 0df6a7174..cb9bc1488 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -2780,7 +2780,405 @@ Z9 AT_CLEANUP -AT_SETUP([ASSIGN with LOCAL-STORAGE item]) +## ASSIGN + + +AT_SETUP([ASSIGN DYNAMIC and EXTERNAL]) +AT_KEYWORDS([extensions runfile]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT f ASSIGN whatever + ORGANIZATION LINE SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD f. + 01 f-rec PIC XXX. + + WORKING-STORAGE SECTION. + 01 whatever PIC X(10) VALUE "out.txt". + + PROCEDURE DIVISION. + OPEN OUTPUT f + WRITE f-rec FROM "hi" + CLOSE f + . +]) + +AT_CHECK([$COMPILE -fassign-clause=external prog.cob], [0], [], []) +AT_CAPTURE_FILE(./whatever) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) +AT_DATA([reference], +[hi +]) +AT_CHECK([diff reference whatever], [0], [], []) + +AT_CHECK([$COMPILE -fassign-clause=dynamic -fno-implicit-assign-dynamic-var prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([diff reference whatever], [0], [], []) + +AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], []) +AT_CAPTURE_FILE(./out.txt) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([diff reference out.txt], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([ASSIGN EXTERNAL parsing]) +AT_KEYWORDS([extensions runfile]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + *> Labels should be removed from EXTERNAL name. + SELECT TEST-FILE ASSIGN DA-S-FILENAME. + *> EXTERNAL name allowed to duplicate FD name. + SELECT TESTFILE2 ASSIGN TESTFILE2. + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + FD TESTFILE2. + 01 TESTREC2 PIC X(4). + PROCEDURE DIVISION. + OPEN OUTPUT TEST-FILE. + CLOSE TEST-FILE. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fassign-clause=external prog.cob], [0], [], +[prog.cob:8: warning: ASSIGN DA-S-FILENAME interpreted as 'FILENAME' +]) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([test -f FILENAME], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([ASSIGN directive]) +AT_KEYWORDS([extensions runfile]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT f ASSIGN whatever + ORGANIZATION LINE SEQUENTIAL. + $SET ASSIGN "EXTERNAL" + SELECT g ASSIGN whatever + ORGANIZATION LINE SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD f. + 01 f-rec PIC XXX. + FD g. + 01 g-rec PIC XXX. + + PROCEDURE DIVISION. + MOVE "out.txt" TO whatever + + OPEN OUTPUT f + WRITE f-rec FROM "hi" + CLOSE f + + OPEN OUTPUT g + WRITE g-rec FROM "hi" + CLOSE g + . + END PROGRAM prog. +]) + +AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([ASSIGN filename expansion]) +AT_KEYWORDS([extensions runfile]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "$DIR/FILENAME". + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + PROCEDURE DIVISION. + OPEN OUTPUT TEST-FILE. + CLOSE TEST-FILE. + STOP RUN. +]) + +AT_CHECK([$COMPILE -ffilename-mapping prog.cob], [0], [], []) +AT_CHECK([DIR="." $COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([test -f "./FILENAME" && rm -f "./FILENAME"], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([ASSIGN filename mapping]) +AT_KEYWORDS([extensions runfile optional]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "FILENAME". + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + PROCEDURE DIVISION. + OPEN OUTPUT TEST-FILE. + CLOSE TEST-FILE. + STOP RUN. +]) + +AT_DATA([prog2.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "FILENAME2". + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + PROCEDURE DIVISION. + OPEN OUTPUT TEST-FILE. + CLOSE TEST-FILE. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fno-filename-mapping prog.cob], [0], [], []) +AT_CHECK([DD_FILENAME="x" $COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([test -f "x"], [1]) +AT_CHECK([test -f "FILENAME"], [0], [], []) + +AT_CHECK([$COMPILE -ffilename-mapping prog2.cob], [0], [], []) +AT_CHECK([DD_FILENAME2="x" $COBCRUN_DIRECT ./prog2], [0], [], []) +AT_CHECK([test -f "FILENAME2"], [1]) +AT_CHECK([test -f "x"], [0], [], []) +AT_CHECK([dd_FILENAME2="y" $COBCRUN_DIRECT ./prog2], [0], [], []) +AT_CHECK([test -f "y"], [0], [], []) +AT_CHECK([FILENAME2="z" $COBCRUN_DIRECT ./prog2], [0], [], []) +AT_CHECK([test -f "z"], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) +AT_CHECK([test -f "FILENAME2"], [0], [], []) + +AT_DATA([prog3.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog3. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT OPTIONAL INFILE ASSIGN TO "MYFILE" + ORGANIZATION IS RELATIVE + ACCESS IS SEQUENTIAL + FILE STATUS IS WSFS. + DATA DIVISION. + FILE SECTION. + FD INFILE. + 01 INREC PIC X(80). + WORKING-STORAGE SECTION. + 01 WSFS PIC X(2). + PROCEDURE DIVISION. + * + * open missing file + OPEN INPUT INFILE + DISPLAY "STATUS OPENI " WSFS + CLOSE INFILE + * + * create missing file + OPEN OUTPUT INFILE + DISPLAY "STATUS OPENO " WSFS + CLOSE INFILE + * + STOP RUN. +]) + +AT_CHECK([$COMPILE prog3.cob], [0], [], []) + +AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], +[STATUS OPENI 05 +STATUS OPENO 00 +], []) +AT_CHECK([test -f "MYFILE"], [0], [], []) + +AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], +[STATUS OPENI 00 +STATUS OPENO 00 +], []) + +AT_CHECK([MYFILE="TSTFILE" $COBCRUN_DIRECT ./prog3], [0], +[STATUS OPENI 05 +STATUS OPENO 00 +], []) +AT_CHECK([test -f "TSTFILE"], [0], [], []) + +AT_CHECK([dd_MYFILE="TSTFILE2" $COBCRUN_DIRECT ./prog3], [0], +[STATUS OPENI 05 +STATUS OPENO 00 +], []) +AT_CHECK([test -f "TSTFILE2"], [0], [], []) + +AT_CHECK([DD_MYFILE="TSTFILE3" $COBCRUN_DIRECT ./prog3], [0], +[STATUS OPENI 05 +STATUS OPENO 00 +], []) +AT_CHECK([test -f "TSTFILE3"], [0], [], []) + +AT_CHECK([DD_MYFILE="./nosubhere/TSTFILE" $COBCRUN_DIRECT ./prog3], [0], +[STATUS OPENI 05 +STATUS OPENO 30 +], []) + +AT_DATA([prog4.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog4. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT FILE0 ASSIGN TO "./nosubhere/MYFILE0" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WSFS. + SELECT FILE1 ASSIGN TO "MYFILE1" + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WSFS. + SELECT FILE2 ASSIGN TO FILENAME + ORGANIZATION IS LINE SEQUENTIAL + FILE STATUS IS WSFS. + DATA DIVISION. + FILE SECTION. + FD FILE0. + 01 F0REC PIC X(80). + FD FILE1. + 01 F1REC PIC X(80). + FD FILE2. + 01 F2REC PIC X(80). + WORKING-STORAGE SECTION. + 77 FILENAME PIC X(80) VALUE "MYFILE2". + 01 WSFS PIC X(2). + PROCEDURE DIVISION. + * + OPEN OUTPUT FILE0 + DISPLAY "STATUS OPENO 0 " WSFS + OPEN OUTPUT FILE1 + DISPLAY "STATUS OPENO 1 " WSFS + OPEN OUTPUT FILE2 + DISPLAY "STATUS OPENO 2 " WSFS + * + STOP RUN. +]) + +AT_CHECK([$COMPILE prog4.cob], [0], [], []) + +AT_CHECK([DD_MYFILE1="./nosubhere/NOFILE1" DD_MYFILE2="./nosubhere/NOFILE2" \ +$COBCRUN_DIRECT ./prog4], [0], +[STATUS OPENO 0 30 +STATUS OPENO 1 30 +STATUS OPENO 2 30 +], []) + +AT_CLEANUP + + +AT_SETUP([ASSIGN with COB_FILE_PATH]) +AT_KEYWORDS([extensions runfile]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "FILENAMEX". + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + PROCEDURE DIVISION. + OPEN OUTPUT TEST-FILE. + CLOSE TEST-FILE. + STOP RUN. +]) + +AT_DATA([prog2.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN "SUBDIR/FILENAMEX". + DATA DIVISION. + FILE SECTION. + FD TEST-FILE. + 01 TEST-REC PIC X(4). + PROCEDURE DIVISION. + OPEN OUTPUT TEST-FILE. + CLOSE TEST-FILE. + STOP RUN. +]) + +AT_CHECK([$COMPILE -ffilename-mapping prog.cob], [0], [], []) +AT_CHECK([rm -rf "tstdir" && mkdir "tstdir"], [0], [], []) +AT_CHECK([COB_FILE_PATH="tstdir" $COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([test -f "tstdir/FILENAMEX" && rm -f "tstdir/FILENAMEX"], [0], [], []) +AT_CHECK([COB_FILE_PATH="tstdir/" $COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([test -f "tstdir/FILENAMEX"], [0], [], []) + +# FIXME: on OPEN we should also output the full filename (if any) leading to the error +AT_CHECK([COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog 2>prog.err], [1], [], []) +# workaround for testing windows-builds... +AT_CHECK([cat prog.err | tr '\\' '/'], [0], +[libcob: prog.cob:13: error: permanent file error (status = 30) for file TEST-FILE ('FILENAMEX' => ./nosubhere/FILENAMEX) on OPEN +], []) + + +AT_CHECK([$COMPILE -ffilename-mapping prog2.cob], [0], [], []) + +AT_CHECK([mkdir "tstdir/SUBDIR"], [0], [], []) + +AT_CHECK([COB_FILE_PATH="tstdir" $COBCRUN_DIRECT ./prog2], [0], [], []) +AT_CHECK([test -f "tstdir/SUBDIR/FILENAMEX" && rm -f "tstdir/SUBDIR/FILENAMEX"], [0], [], []) + +AT_CHECK([COB_FILE_PATH="tstdir/" $COBCRUN_DIRECT ./prog2], [0], [], []) +AT_CHECK([test -f "tstdir/SUBDIR/FILENAMEX"], [0], [], []) + +AT_CHECK([COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog2 2>prog.err], [1], [], []) +AT_CHECK([cat prog.err | tr '\\' '/'], [0], +[libcob: prog2.cob:13: error: permanent file error (status = 30) for file TEST-FILE ('SUBDIR/FILENAMEX' => ./nosubhere/SUBDIR/FILENAMEX) on OPEN +], []) + + +AT_CLEANUP + + +AT_SETUP([ASSIGN DYNAMIC with LOCAL-STORAGE item]) AT_KEYWORDS([runfile]) AT_DATA([test.txt], @@ -2817,7 +3215,7 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP -AT_SETUP([ASSIGN with LOCAL-STORAGE item and INITIAL prog]) +AT_SETUP([ASSIGN DYNAMIC with LOCAL-STORAGE item and INITIAL prog]) AT_KEYWORDS([runfile]) # Files are initialised in a different location in INITIAL program, hence the @@ -2857,7 +3255,7 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP -AT_SETUP([ASSIGN with BASED data item and CHAINING]) +AT_SETUP([ASSIGN DYNAMIC with BASED data item and CHAINING]) AT_KEYWORDS([runfile status]) AT_DATA([TEST-FILE], @@ -2930,6 +3328,12 @@ AT_CHECK([$COBCRUN_DIRECT ./prog X], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], [libcob: prog.cob:23: error: inconsistent file name (status = 31) for file test-file ('field with NULL address') on OPEN ]) +# Tested again without source location and checks +AT_CHECK([$COBC -x prog.cob]) +AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], +[libcob: error: inconsistent file name (status = 31) for file test-file ('field with NULL address') +]) + AT_CHECK([$COMPILE prog2.cob]) AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) @@ -2937,7 +3341,7 @@ AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) AT_CLEANUP -AT_SETUP([ASSIGN with data item in LINKAGE]) +AT_SETUP([ASSIGN DYNAMIC with data item in LINKAGE]) AT_KEYWORDS([runfile FILE-CONTROL file status]) AT_DATA([prog.cob], [ @@ -3109,7 +3513,7 @@ AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], AT_CLEANUP -AT_SETUP([ASSIGN with empty data item]) +AT_SETUP([ASSIGN DYNAMIC with empty data item and CHAINING]) AT_KEYWORDS([runfile status]) AT_DATA([prog.cob], [ @@ -3125,7 +3529,6 @@ AT_DATA([prog.cob], [ FD test-file. 01 test-rec PIC X(5). WORKING-STORAGE SECTION. - 01 WS-SUBSCRIPT-CNT PIC 9. 01 path PIC X(10). 01 x PIC X. PROCEDURE DIVISION CHAINING x. @@ -3139,12 +3542,44 @@ AT_DATA([prog.cob], [ STOP RUN. ]) -AT_CHECK([$COBC -x prog.cob]) +AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: error: inconsistent file name (status = 31) for file test-file ('') +[libcob: prog.cob:22: error: inconsistent file name (status = 31) for file test-file ('') on OPEN ]) AT_CHECK([$COBCRUN_DIRECT ./prog X], [1], [], -[libcob: error: inconsistent file name (status = 31) for file test-file ('') +[libcob: prog.cob:22: error: inconsistent file name (status = 31) for file test-file ('') on OPEN +]) + +AT_CLEANUP + + +AT_SETUP([ASSIGN DYNAMIC with unset implicit data item]) +AT_KEYWORDS([runfile status]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT test-file ASSIGN fpath + ORGANIZATION LINE SEQUENTIAL. + DATA DIVISION. + FILE SECTION. + FD test-file. + 01 test-rec PIC X(5). + PROCEDURE DIVISION. + OPEN INPUT test-file + DISPLAY "Hello" + STOP RUN. +]) + +AT_CHECK([$COMPILE prog.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], +[libcob: prog.cob:14: error: file does not exist (status = 35) for file test-file ('fpath') on OPEN +]) +AT_CHECK([fpath="not.there" $COBCRUN_DIRECT ./prog X], [1], [], +[libcob: prog.cob:14: error: file does not exist (status = 35) for file test-file ('fpath' => not.there) on OPEN ]) AT_CLEANUP diff --git a/tests/testsuite.src/run_fundamental.at b/tests/testsuite.src/run_fundamental.at index 79e291c1e..28bd0d4fc 100644 --- a/tests/testsuite.src/run_fundamental.at +++ b/tests/testsuite.src/run_fundamental.at @@ -1173,20 +1173,19 @@ AT_DATA([prog.cob], [ DISPLAY 'in prog3' END-DISPLAY IF GLOB-PATH NOT = SPACES - DISPLAY GLOB-PATH + DISPLAY FUNCTION TRIM (GLOB-PATH TRAILING) END-DISPLAY END-IF EXIT PROGRAM. END PROGRAM prog3. ]) -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:60: warning: variable 'GLOB-PATH' will be implicitly defined -]) +AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [GLOBP1GLOBV1 GLOBP2GLOBV2 in prog3 +GLOB-PATH ]) AT_CLEANUP diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 1c1c3ac85..cc088de55 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -1249,7 +1249,8 @@ AT_DATA([caller.cob], [ MOVE 0 TO STOPPER CALL "callee" DISPLAY 'OK' NO ADVANCING END-DISPLAY - CANCEL "callee" , "callee2" + *> FIXME: CANCEL broken on special environments + *> CANCEL "callee" , "callee2" DISPLAY ' + FINE' NO ADVANCING END-DISPLAY STOP RUN. ]) diff --git a/tests/testsuite.src/syn_file.at b/tests/testsuite.src/syn_file.at index 20e1c8940..25a9b4ee7 100644 --- a/tests/testsuite.src/syn_file.at +++ b/tests/testsuite.src/syn_file.at @@ -1215,7 +1215,6 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [prog.cob:11: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL prog.cob:8: error: missing file description for FILE testfile -prog.cob:13: warning: variable 'filename' will be implicitly defined ]) AT_CLEANUP @@ -1803,6 +1802,7 @@ prog.cob:8: error: missing file description for FILE SELECT on line 8 ]) AT_CLEANUP + AT_SETUP([Undeclared FILE-ID variable]) AT_KEYWORDS([file]) @@ -1821,13 +1821,92 @@ AT_DATA([prog.cob], [ STOP RUN. ]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], +AT_CHECK([$COMPILE_ONLY -Wimplicit-define prog.cob], [0], [], [prog.cob:10: warning: VALUE OF is obsolete in GnuCOBOL prog.cob:12: warning: variable 'fid-file1' will be implicitly defined ]) AT_CLEANUP +AT_SETUP([Undeclared ASSIGN variable]) +AT_KEYWORDS([file global]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE + ASSIGN GLOB-PATH + . + DATA DIVISION. + FILE SECTION. + FD TEST-FILE GLOBAL. + 01 TEST-REC PIC X(4). + WORKING-STORAGE SECTION. + 78 GLOB-PATH GLOBAL VALUE "GLOBP1". + 01 GLOB-PATH2 CONSTANT GLOBAL "GLOBP2". + * Test global vars because of implicitly defined ASSIGN var, too. + 78 GLOB-VAR GLOBAL VALUE "GLOBV1". + 01 GLOB-VAR2 CONSTANT GLOBAL "GLOBV2". + PROCEDURE DIVISION. + DISPLAY GLOB-PATH GLOB-VAR + END-DISPLAY. + CALL "prog2" + END-CALL. + CALL "prog3" + END-CALL. + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog2. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST2-FILE + ASSIGN GLOB-PATH2 + . + DATA DIVISION. + FILE SECTION. + FD TEST2-FILE GLOBAL. + 01 TEST2-REC PIC X(4). + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY GLOB-PATH2 GLOB-VAR2 + END-DISPLAY. + EXIT PROGRAM. + END PROGRAM prog2. + END PROGRAM prog. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog3. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST3-FILE + ASSIGN GLOB-PATH + . + DATA DIVISION. + FILE SECTION. + FD TEST3-FILE GLOBAL. + 01 TEST3-REC PIC X(4). + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + DISPLAY 'in prog3' + END-DISPLAY + IF GLOB-PATH NOT = SPACES + DISPLAY GLOB-PATH + END-DISPLAY + END-IF + EXIT PROGRAM. + END PROGRAM prog3. +]) + +AT_CHECK([$COMPILE_ONLY -Wimplicit-define prog.cob], [0], [], +[[prog.cob:60: warning: variable 'GLOB-PATH' will be implicitly defined +]]) +AT_CLEANUP + + AT_SETUP([DELETE with LINE SEQUENTIAL]) AT_KEYWORDS([file])