diff --git a/.github/workflows/.windows-msys2-visam.yml b/.github/workflows/.windows-msys2-visam.yml new file mode 100644 index 000000000..363e8719e --- /dev/null +++ b/.github/workflows/.windows-msys2-visam.yml @@ -0,0 +1,111 @@ +name: Windows Workflow + +on: + pull_request: + branches: [ gc4 ] + push: + branches: [ gc3_to_gc4 ] + # manual run in actions tab - for all branches + workflow_dispatch: + +jobs: + build: + strategy: + fail-fast: false + matrix: + os: + - windows-latest + + runs-on: ${{ matrix.os }} + + steps: + # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it + - name: Checkout code + uses: actions/checkout@v3 + + - name: Install packages + uses: msys2/setup-msys2@v2 + with: + update: true + install: autoconf automake libtool make mingw-w64-x86_64-libxml2 mingw-w64-x86_64-cjson mingw-w64-x86_64-db mingw-w64-x86_64-gmp libdb-devel mingw-w64-x86_64-gcc flex bison gmp-devel help2man texinfo gettext-devel + + - name: Set git user + run: | + git config --global user.name github-actions + git config --global user.email github-actions-bot@users.noreply.github.com + + - name: Installing VISAM prerequisite + run: | + wget http://inglenet.ca/Products/GnuCOBOL/visam-2.2.tar.Z + tar -xvzf visam-2.2.tar.Z + cd visam-2.2 + ./configure --prefix=/usr/local/visam-2.2 --enable-vbisamdefault + sed -i -e "s/\(allow_undefined=\)yes/\1no/" libtool + make + make install + echo "/usr/local/visam-2.2/bin" >> $GITHUB_PATH + echo "CPATH=/usr/local/visam-2.2/include" >> $GITHUB_ENV + echo "LIBRARY_PATH=/usr/local/visam-2.2/lib" >> $GITHUB_ENV + echo "LD_LIBRARY_PATH=/usr/local/visam-2.2/lib" >> $GITHUB_ENV + shell: msys2 {0} + + - name: bootstrap + run: | + ./autogen.sh + autoconf + autoreconf --install --force + shell: msys2 {0} + + - name: Build environment setup + run: | + mkdir _build + shell: msys2 {0} + + - name: configure + run: | + cd _build + ../configure --with-visam --with-indexed=visam --enable-cobc-internal-checks --enable-hardening --prefix /opt/cobol/gnucobol --exec-prefix /opt/cobol/gnucobol + shell: msys2 {0} + + - name: Upload config.log + uses: actions/upload-artifact@v3 + if: failure() + with: + name: config.log + path: _build/config.log + + - name: make + run: | + cd _build + make --jobs=$(($(nproc)+1)) + shell: msys2 {0} + + - name: install + run: | + cd _build + make install + find /opt/cobol > install.log + shell: msys2 {0} + + - name: Upload install.log + uses: actions/upload-artifact@v3 + with: + name: install.log + path: _build/install.log + + - name: check + run: | + export PATH=/opt/cobol/gnucobol/bin:$PATH + cd _build/tests + make check TESTSUITEFLAGS="--jobs=$(($(nproc)+1))" + shell: msys2 {0} + +# make check TESTSUITEFLAGS="--jobs=$(($(nproc)+1))" || (echo "not all tests passed") +# make test + + - name: Upload testsuite.log + uses: actions/upload-artifact@v3 + if: failure() + with: + name: testsuite.log + path: _build/tests/testsuite.log diff --git a/.github/workflows/macos-bdb.yml b/.github/workflows/macos-bdb.yml index 6ad7e64ef..9d3896529 100644 --- a/.github/workflows/macos-bdb.yml +++ b/.github/workflows/macos-bdb.yml @@ -57,6 +57,7 @@ jobs: - name: configure run: | cd _build + export CPPFLAGS="READ_WRITE_NEEDS_FLUSH $CPPFLAGS" export CFLAGS="-Wno-deprecated-non-prototype -Wno-parentheses-equality $CFLAGS" ../configure --with-db --with-indexed=db --enable-cobc-internal-checks --enable-hardening --prefix /opt/cobol/gnucobol --exec-prefix /opt/cobol/gnucobol diff --git a/.github/workflows/macos-visam.yml b/.github/workflows/macos-visam.yml index 25019314f..02cc32882 100644 --- a/.github/workflows/macos-visam.yml +++ b/.github/workflows/macos-visam.yml @@ -70,6 +70,7 @@ jobs: - name: configure run: | cd _build + export CPPFLAGS="READ_WRITE_NEEDS_FLUSH $CPPFLAGS" export CFLAGS="-Wno-deprecated-non-prototype -Wno-parentheses-equality $CFLAGS" ../configure --with-visam --with-indexed=visam --enable-cobc-internal-checks --enable-hardening --prefix /opt/cobol/gnucobol --exec-prefix /opt/cobol/gnucobol diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 3ee4512ca..7c52ac0bf 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -676,6 +676,8 @@ cb_search to at_end, storing pair of AT END (position) and statements * codegen.c (output_search_whens, output_search_all): adjust output of source references for better debugging experience and add AT END tracing + * typeck.c: Remove ERROR for REWRITE an INPUT-OUTPUT of LINE SEQUENTIAL + This has been supported for a while in rw/trunk 2021-12-30 Ron Norman diff --git a/cobc/typeck.c b/cobc/typeck.c index f443f855e..e7df9942f 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -3124,10 +3124,10 @@ cb_build_const_next (struct cb_field *f) p = p->parent; } if (!p->flag_external) { - cb_error (_("VALUE of '%s': %s target is invalid"), f->name, "NEXT"); - cb_error (_("target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause")); - return cb_build_numeric_literal (0, "1", 0); - } + cb_error (_("VALUE of '%s': %s target is invalid"), f->name, "NEXT"); + cb_error (_("target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause")); + return cb_build_numeric_literal (0, "1", 0); + } } /* @@ -8708,10 +8708,10 @@ cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, if (CB_TREE_CLASS (returning) != CB_CLASS_NUMERIC && CB_TREE_CLASS (returning) != CB_CLASS_POINTER) { cb_error_x (CB_TREE (current_statement), - _("invalid RETURNING field")); - return; + _("invalid RETURNING field")); + return; + } } - } error_ind = 0; @@ -13030,9 +13030,9 @@ cb_emit_rewrite (cb_tree record, cb_tree from, cb_tree lockopt) cb_error_x (CB_TREE (current_statement), _("%s not allowed on %s files"), "REWRITE", "REPORT"); return; - } else if (current_statement->handler_type == INVALID_KEY_HANDLER - && f->organization != COB_ORG_RELATIVE - && f->organization != COB_ORG_INDEXED) { + } else if (current_statement->handler_type == INVALID_KEY_HANDLER && + (f->organization != COB_ORG_RELATIVE && + f->organization != COB_ORG_INDEXED)) { cb_error_x (CB_TREE(current_statement), _("INVALID KEY clause invalid with this file type")); return; diff --git a/config/ChangeLog b/config/ChangeLog index 2237b8f82..a2cf8698e 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -17,6 +17,10 @@ * *.conf: changed top-level-occurs-clause "skip" to "unconformable" +2022-09-21 Simon Sobisch + + * runtime.cfg: extend docs for LINE SEQUENTIAL settings + 2022-08-17 Simon Sobisch * general: add xml-parse-xmlss, note: explicit NOT enabled @@ -141,6 +145,11 @@ default.conf, in all other cases no change to RECURSIVE attribute is happening any more, fixing bug 686 +2021-07-05 Ron Norman + + * runtime.cfg: added COB_SEQ_CONCAT_NAME and COB_SEQ_CONCAT_SEP used + for 'concatenated input files' + 2021-03-05 Ron Norman * runtime.cfg (fileio): added COB_FILE_ISNODAT to disable ISAM datafile.dat @@ -642,6 +651,10 @@ marked as not verified yet) * general: added literal-length, numeric-literal-length +2015-03-14 Ron Norman + + * runtime.cfg: add COB_LS_VALIDATE + 2015-03-14 Ron Norman * runtime.cfg: added all configuration options with documentation diff --git a/config/runtime.cfg b/config/runtime.cfg index a268a038d..26d56ce62 100644 --- a/config/runtime.cfg +++ b/config/runtime.cfg @@ -395,8 +395,19 @@ # Alias: STRIP_TRAILING_SPACES (0 = yes) # Type: boolean # Default: false +# Note: This setting is most useful if you want to REWRITE those +# files. # Example: LS_FIXED TRUE +# Environment name: COB_LS_VALIDATE +# Parameter name: ls_validate +# Purpose: Defines for LINE SEQUENTIAL files that the data should be +# validated as it is read (status 09) / written (status 71). +# Type: boolean +# Default: true (per COBOL 2022) +# Note: If active effectively disables COB_LS_NULLS. +# Example: LS_VALIDATE FALSE + # Environment name: COB_LS_NULLS # Parameter name: ls_nulls # Purpose: Defines for LINE SEQUENTIAL files what to do with data @@ -406,7 +417,11 @@ # Type: boolean # Default: true (for MF files) otherwise false # Note: The TRUE setting will insert a null character x"00" before -# those values to escape them, and redo on read-in. +# those values to escape them, and redo on read-in plus +# validating that they only occur after a null character. +# Decreases LINE SEQUENTIAL performance and prevents writing +# escape sequences or formatting within the data. +# Only checked if COB_LS_VALIDATE is disabled. # Example: LS_NULLS = TRUE # Environment name: COB_LS_SPLIT @@ -420,19 +435,6 @@ # (per COBOL 202x) # Example: LS_SPLIT = FALSE -# Environment name: COB_LS_VALIDATE -# Parameter name: ls_validate -# Purpose: Defines for LINE SEQUENTIAL files that the data should be -# validated. If any record has non-DISPLAY characters then -# an error status of 71 is returned -# This option is only for GnuCOBOL format files -# Type: boolean -# Default: true -# Note: The TRUE setting does data validation -# The FALSE setting lets non-DISPLAY characters be written -# If LS_NULLS is set, then LS_VALIDATE is not checked -# Example: LS_VALIDATE = FALSE - # Environment name: COB_LS_INSTAB # Parameter name: ls_instab # Purpose: Defines for LINE SEQUENTIAL files that multiple spaces diff --git a/libcob/ChangeLog b/libcob/ChangeLog index abb3c7357..1d7949907 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -201,6 +201,14 @@ PERFORM stack and used for restoring those on return * common.h (cob_module): fields for current frame_ptr +2022-09-21 Simon Sobisch + + * common.c, fileio.c: change COB_LS_VALIDATE to be the default and to + override COB_LS_NULLS + * fileio.c: fix bug #853 pass \r to validation / COBOL if it isn't + followed by \n + * fileio.c: minor refactor - use of separate FILE *fp + 2022-09-13 Simon Sobisch * intrinsic.c (cob_check_numval): fix missing check for @@ -441,6 +449,13 @@ * screenio.c (cob_field_display): If no field, use empty field as default This is to handle DISPLAY OMITTED +2022-02-04 Simon Sobisch + + * general: backport of REWRITE in LINE SEQUENTIAL (especially: record_off), + COB_LS_VALIDATE to check LINE SEQUENTIAL files during read/write, + COB_SEQ_CONCAT_NAME and COB_SEQ_CONCAT_SEP, and other file specific + features + 2022-01-30 Simon Sobisch * call.c (set_resolve_error): distinguish between exceptions @@ -688,7 +703,8 @@ * common.c: Runtime report show 'not set' if that was the default * fileio.c: Change default for LS_SPLIT = TRUE - Check LINE SEQUENTIAL data and if invalid return 09 status + * fileio.c (lineseq_read): Check LINE SEQUENTIAL data and if invalid + return 09 status per COBOL 2022 2021-10-01 Ron Norman @@ -872,6 +888,15 @@ * fextfh.c: Check FCD-CURRENT-REC-LEN being changed on WRITE/REWRITE +2021-07-05 Ron Norman + + * common.h (cob_file): Added flag_is_concat, org_filename and nxt_filename + * common.c: Handle runtime options COB_SEQ_CONCAT_NAME and + COB_SEQ_CONCAT_SEP used for 'concatenated input files' + * coblocal.h (cob_settings): Added fields for concatenated files + * fileio.c: Add code to handle SEQUENTIAL and LINE SEQUENTIAL + concatenated input files for OPEN INPUT and I-O + 2021-07-02 Simon Sobisch * reportio.c: move hard line/col limit to REPORT_MAX_LINES REPORT_MAX_COLS @@ -1846,6 +1871,7 @@ * fileio.c: For LINE SEQUENTIAL and OPEN I-O some platforms (SUNOS for one) require that a fflush be done between each read/write of the file + Simon 2022-02-04: for now surrounded with [READ_WRITE_NEEDS_FLUSH] * common.h,move.c,sysdefines.h: Updates for speeding up arithmetic 2020-04-17 Ron Norman @@ -1857,8 +1883,8 @@ 2020-04-14 Ron Norman * fileio.c: Fixed to NOT mix I/O to FILE * via putc and 'int fd' via write - 'FILE *' is buffered and 'int fd' is NOT so the data - can end up in a very strange sequence in the file + 'FILE *' is buffered and 'int fd' is NOT so the data + could end up in a very strange sequence in the file 2020-04-14 Ron Norman @@ -2072,7 +2098,7 @@ 2019-11-14 Ron Norman - * common.c: Fix for display of runtime options + * common.c (get_config_val): fix for display of runtime options * fileio.c: If bad data in LINE SEQUENTIAL file cause error status 71 instead of 34 @@ -3701,6 +3727,12 @@ 2016-06-20 Ron Norman + * common.h: added some COB_CHAR_xxx to define some characters + * fileio.c: for LINE SEQUENTIAL files with COB_LS_VALIDATE = true + changed bad data error from 30 to 34 + Also allow some characters thru such as BS, FF, TAB, ESC, SI + No data validation is done for LINE ADVANCING output files + * coblocal.h, common.c: FR #138 identify config variables which accept a path list and any which only accept a single directory/file are checked for the PATH_SEP character and error is given if @@ -4098,6 +4130,11 @@ New runtime option (mf_files) to set all files to default to Micro Focus format +2015-04-27 Ron Norman + + * fileio.c, common.h (cob_file): updated to support line sequential rewrite + * fileio.c, common.c, coblocal.h (cob_settings): new COB_LS_VALIDATE + 2015-04-14 Ron Norman * reportio.c common.c: diff --git a/libcob/coblocal.h b/libcob/coblocal.h index fa9e13c04..32512d772 100644 --- a/libcob/coblocal.h +++ b/libcob/coblocal.h @@ -231,9 +231,9 @@ typedef struct __cob_settings { unsigned int cob_unix_lf; /* Use POSIX LF */ unsigned int cob_do_sync; unsigned int cob_ls_fixed; /* Line Sequential is fixed length */ + unsigned int cob_ls_validate; /* Validate data in Line Sequential */ unsigned int cob_ls_nulls; /* NUL insert to Line Sequential */ unsigned int cob_ls_split; /* Split 'too long' record into parts (Default is truncate) */ - unsigned int cob_ls_validate; /* Validate data in Line Sequential */ unsigned int cob_ls_instab; /* TAB insert to Line Sequential (INSERTTAB)*/ unsigned int cob_varseq_type; /* Variable Sequential Default file format */ unsigned int cob_varrel_type; /* Variable Relative default file format */ diff --git a/libcob/common.c b/libcob/common.c index 8496ead7d..90cd87cce 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -459,7 +459,7 @@ static struct config_tbl gc_conf[] = { {"COB_LS_SPLIT","ls_split", "true",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_split)}, {"COB_LS_INSTAB","ls_instab", "false",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_instab)}, {"COB_LS_NULLS","ls_nulls", "not set",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_nulls)}, - {"COB_LS_VALIDATE","ls_validate", "not set",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_validate)}, + {"COB_LS_VALIDATE","ls_validate", "true",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_validate)}, {"COB_SHARE_MODE","share_mode", "none",shareopts,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_share_mode)}, {"COB_RETRY_MODE","retry_mode", "none",retryopts,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_retry_mode)}, {"COB_RETRY_TIMES","retry_times", "0",NULL,GRP_FILE,ENV_UINT,SETPOS(cob_retry_times)}, @@ -7898,14 +7898,14 @@ get_config_val (char *value, int pos, char *orgvalue) && !(gc_conf[pos].data_type & STS_CNFSET) && !(gc_conf[pos].data_type & ENV_BOOL) && gc_conf[pos].default_val != NULL) { - strcpy(value,gc_conf[pos].default_val); + strcpy (value, gc_conf[pos].default_val); orgvalue[0] = 0; } if (gc_conf[pos].default_val != NULL && strcmp (orgvalue, gc_conf[pos].default_val) != 0) { orgvalue[0] = 0; - } else if(strcmp(value,orgvalue) == 0) { + } else if (strcmp (value, orgvalue) == 0) { orgvalue[0] = 0; } diff --git a/libcob/fileio.c b/libcob/fileio.c index c68cac7f9..9ea09ee41 100644 --- a/libcob/fileio.c +++ b/libcob/fileio.c @@ -74,6 +74,22 @@ #define COB_CHAR_SI 0x0F #endif +/* Define some characters for checking LINE SEQUENTIAL data content */ +#define COB_CHAR_CR '\r' +#define COB_CHAR_FF '\f' +#define COB_CHAR_LF '\n' +#define COB_CHAR_SPC ' ' +#define COB_CHAR_TAB '\t' +#ifdef COB_EBCDIC_MACHINE +#define COB_CHAR_BS 0x16 +#define COB_CHAR_ESC 0x27 +#define COB_CHAR_SI 0x0F +#else +#define COB_CHAR_BS 0x08 +#define COB_CHAR_ESC 0x1B +#define COB_CHAR_SI 0x0F +#endif + struct file_list { struct file_list *next; cob_file *file; @@ -3599,20 +3615,23 @@ errno_cob_sts (const int default_status) } } -#define COB_CHECKED_WRITE(fd,string,length) do { \ - if (write (fd, string, (size_t)length) != (size_t)length) { \ +#define COB_CHECKED_FPUTC(char_to_write,fstream) do { \ + const int character = (int)char_to_write; \ + if (putc (character, fstream) != character) { \ return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); \ } \ } ONCE_COB /* LCOV_EXCL_LINE */ -#define COB_CHECKED_FPUTC(character,fstream) do { \ - if (fputc ((int)character, fstream) != (int)character) { \ +#define COB_CHECKED_WRITE(fd,string,length_to_write) do { \ + const size_t length = (size_t)length_to_write; \ + if (write (fd, string, length) != length) { \ return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); \ } \ } ONCE_COB /* LCOV_EXCL_LINE */ -#define COB_CHECKED_FWRITE(fstream,string,length) do { \ - if (fwrite (string, 1, (size_t)length, fstream) != (size_t)length) { \ +#define COB_CHECKED_FWRITE(fstream,string,length_to_write) do { \ + const size_t length = (size_t)length_to_write; \ + if (fwrite (string, 1, length, fstream) != length) { \ return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); \ } \ } ONCE_COB /* LCOV_EXCL_LINE */ @@ -3662,11 +3681,10 @@ static int cob_linage_write_opt (cob_file *f, const int opt) { cob_linage *lingptr; - FILE *fp; + FILE *fp = (FILE *)f->file; int i; int n; - fp = (FILE *)f->file; lingptr = f->linage; if (opt & COB_WRITE_PAGE) { i = cob_get_int (lingptr->linage_ctr); @@ -3739,7 +3757,7 @@ cob_seq_write_rcsz (cob_file *f, const int rcsz) unsigned int sint; } recsize; - if (f->record_min != f->record_max) { + if (f->record_min != f->record_max) { recsize.sint = 0; switch (f->file_format) { case COB_FILE_IS_GC: @@ -3785,6 +3803,7 @@ cob_seq_write_rcsz (cob_file *f, const int rcsz) static unsigned int cob_seq_write_opt (cob_file *f, const int opt) { + FILE *fp = (FILE *)f->file; int i; char *tmp; @@ -3794,7 +3813,7 @@ cob_seq_write_opt (cob_file *f, const int opt) f->flag_needs_cr = 0; f->flag_needs_nl = 0; i = opt & COB_WRITE_MASK; - if ((opt & COB_WRITE_LINES) + if ((opt & COB_WRITE_LINES) && i > 0) { cob_seq_write_rcsz (f, f->record_max); tmp = cob_malloc (f->record_max); @@ -3810,28 +3829,28 @@ cob_seq_write_opt (cob_file *f, const int opt) if (!i) { /* AFTER/BEFORE 0 */ if (f->flag_needs_cr) - COB_CHECKED_FPUTC ('\r', (FILE *)f->file); + COB_CHECKED_FPUTC ('\r', fp); f->flag_needs_cr = 0; } else { if ((f->file_features & COB_FILE_LS_CRLF) && f->file_format == COB_FILE_IS_MF) { if (f->flag_needs_cr) - COB_CHECKED_FPUTC ('\r', (FILE *)f->file); + COB_CHECKED_FPUTC ('\r', fp); f->record_off++; f->flag_needs_cr = 0; - } + } for (i = opt & COB_WRITE_MASK; i > 0; --i) { - COB_CHECKED_FPUTC ('\n', (FILE *)f->file); + COB_CHECKED_FPUTC ('\n', fp); } } cob_file_sync (f); } else if (opt & COB_WRITE_PAGE) { if ((f->file_features & COB_FILE_LS_CRLF)) { if (f->flag_needs_cr) - COB_CHECKED_FPUTC ('\r', (FILE *)f->file); + COB_CHECKED_FPUTC ('\r', fp); f->flag_needs_cr = 0; } - COB_CHECKED_FPUTC ('\f', (FILE *)f->file); + COB_CHECKED_FPUTC ('\f', fp); cob_file_sync (f); } return 0; @@ -3840,9 +3859,10 @@ cob_seq_write_opt (cob_file *f, const int opt) static int cob_file_write_opt (cob_file *f, const int opt) { + FILE *fp = (FILE *)f->file; int i; - if (f->flag_is_pipe) + if (f->flag_is_pipe) return COB_STATUS_00_SUCCESS; if (f->flag_select_features & COB_SELECT_LINAGE) { @@ -3853,25 +3873,25 @@ cob_file_write_opt (cob_file *f, const int opt) if (!i) { /* AFTER/BEFORE 0 */ if (f->flag_needs_cr) - COB_CHECKED_FPUTC ('\r', (FILE *)f->file); + COB_CHECKED_FPUTC ('\r', fp); f->flag_needs_cr = 0; } else { for (; i > 0; --i) { if (f->flag_needs_cr) { - COB_CHECKED_FPUTC ('\r', (FILE *)f->file); + COB_CHECKED_FPUTC ('\r', fp); f->flag_needs_cr = 0; } - COB_CHECKED_FPUTC ('\n', (FILE *)f->file); + COB_CHECKED_FPUTC ('\n', fp); } } } else if (opt & COB_WRITE_PAGE) { if ((f->file_features & COB_FILE_LS_CRLF)) { if (f->flag_needs_cr) { - COB_CHECKED_FPUTC ('\r', (FILE *)f->file); + COB_CHECKED_FPUTC ('\r', fp); f->flag_needs_cr = 0; } } - COB_CHECKED_FPUTC ('\f', (FILE *)f->file); + COB_CHECKED_FPUTC ('\f', fp); } return 0; } @@ -4200,6 +4220,25 @@ cob_fd_file_open (cob_file *f, char *filename, if ((ret=set_file_lock(f, filename, mode)) != 0) return ret; + f->record_off = -1; +#if 0 /* Simon: disabled, this function is expected to not use a file */ + { + const char *fmode; + if (mode == COB_OPEN_INPUT) { + fmode = "r"; + } else if (mode == COB_OPEN_I_O) { + if (nonexistent) + fmode = "w+"; + else + fmode = "r+"; + } else if (mode == COB_OPEN_EXTEND) { + fmode = ""; + } else { + fmode = "w"; + } + f->file = (void*)fdopen(f->fd, fmode); + } +#endif if (f->flag_optional && nonexistent) { return COB_STATUS_05_SUCCESS_OPTIONAL; } @@ -4456,7 +4495,15 @@ cob_file_open (cob_file_api *a, cob_file *f, char *filename, #endif break; case COB_OPEN_I_O: +#ifdef _WIN32 fmode = "rb+"; +#else + if (!cobsetptr->cob_unix_lf) { + fmode = "r+"; + } else { + fmode = "rb+"; + } +#endif break; case COB_OPEN_EXTEND: /* Problem on WIN32 (tested _MSC_VER 1500 and GCC build) if file isn't there: */ @@ -4600,9 +4647,10 @@ cob_file_close (cob_file_api *a, cob_file *f, const int opt) } } if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - if (f->flag_needs_nl + if (f->flag_needs_nl && f->file_format != COB_FILE_IS_MF && !(f->flag_select_features & COB_SELECT_LINAGE)) { + f->flag_needs_nl = 0; putc ('\n', (FILE *)f->file); } f->flag_needs_nl = 0; @@ -4640,11 +4688,15 @@ cob_file_close (cob_file_api *a, cob_file *f, const int opt) { HANDLE osHandle = (HANDLE)_get_osfhandle (f->fd); if (osHandle != INVALID_HANDLE_VALUE) { + /* CHECKME: Should this use UnlockFileEx ? */ if (!UnlockFile (osHandle, 0, 0, MAXDWORD, MAXDWORD)) { #if 0 /* CHECKME - What is the correct thing to do here? */ - /* not translated as "testing only" */ - cob_runtime_warning ("issue during UnLockFile (%s), lastError: " CB_FMT_LLU, - "cob_file_close", (cob_u64_t)GetLastError ()); + const DWORD last_error = GetLastError (); + if (last_error != 158) { /* no locked region */ + /* not translated as "testing only" */ + cob_runtime_warning ("issue during UnLockFile (%s), lastError: " CB_FMT_LLU, + "cob_file_close", (cob_u64_t)last_error); + } #endif } } @@ -4733,19 +4785,20 @@ open_next (cob_file *f) && *f->nxt_filename != 0) { char *nx = strchr(f->nxt_filename,file_setptr->cob_concat_sep[0]); close (f->fd); - if (f->file) + if (f->file) { fclose (f->file); + } f->fd = -1; f->file = NULL; if (nx) { *nx = 0; - if (f->open_mode == COB_OPEN_I_O) + if (f->open_mode == COB_OPEN_I_O) f->fd = open (f->nxt_filename, O_RDWR); else f->fd = open (f->nxt_filename, O_RDONLY); f->nxt_filename = nx + 1; } else { - if (f->open_mode == COB_OPEN_I_O) + if (f->open_mode == COB_OPEN_I_O) f->fd = open (f->nxt_filename, O_RDWR); else f->fd = open (f->nxt_filename, O_RDONLY); @@ -4757,9 +4810,9 @@ open_next (cob_file *f) } if (f->fd != -1) { if (f->open_mode == COB_OPEN_INPUT) { - f->file = (void*)fdopen(f->fd, "r"); - } else { - f->file = (void*)fdopen(f->fd, "r+"); + f->file = (void*)fdopen(f->fd, "r"); + } else { + f->file = (void*)fdopen(f->fd, "r+"); } return 1; } @@ -4786,10 +4839,10 @@ sequential_read (cob_file_api *a, cob_file *f, const int read_opts) if (f->flag_operation != 0) { f->flag_operation = 0; } - if(f->record_off == -1) { + if (f->record_off == -1) { f->record_off = set_file_pos (f, (off_t)f->file_header); /* Set current file position */ } else { - f->record_off = lseek (f->fd, 0, SEEK_CUR); /* Get current file position */ + f->record_off = lseek (f->fd, (off_t)0, SEEK_CUR); /* Get current file position */ set_file_pos (f, (off_t)f->record_off); } @@ -4797,8 +4850,9 @@ sequential_read (cob_file_api *a, cob_file *f, const int read_opts) /* Read record size */ bytesread = read (f->fd, recsize.sbuff, f->record_prefix); if (bytesread == 0 - && open_next (f)) + && open_next (f)) { goto again; + } if (bytesread != (int)f->record_prefix) { if (bytesread == 0) { return COB_STATUS_10_END_OF_FILE; @@ -4843,8 +4897,9 @@ sequential_read (cob_file_api *a, cob_file *f, const int read_opts) /* Read record */ bytesread = read (f->fd, f->record->data, f->record->size); if (bytesread == 0 - && open_next (f)) + && open_next (f)) { goto again; + } if (f->record_min != f->record_max && f->file_format == COB_FILE_IS_MF) { @@ -4903,7 +4958,7 @@ sequential_write (cob_file_api *a, cob_file *f, int opt) } else if(f->record_off == -1) { f->record_off = set_file_pos (f, (off_t)f->file_header); } else { - f->record_off = lseek (f->fd, 0, SEEK_CUR); /* Get current file position */ + f->record_off = lseek (f->fd, (off_t)0, SEEK_CUR); /* Get current file position */ set_file_pos (f, (off_t)f->record_off); } @@ -4952,11 +5007,11 @@ sequential_rewrite (cob_file_api *a, cob_file *f, const int opt) f->flag_operation = 1; if (f->record_off != -1) { - if (lseek (f->fd, f->record_off, SEEK_SET) == -1) { + if (lseek (f->fd, f->record_off, SEEK_SET) == (off_t)-1) { return COB_STATUS_30_PERMANENT_ERROR; } } else { - f->record_off = lseek (f->fd, 0, SEEK_CUR); /* Get current file position */ + f->record_off = lseek (f->fd, (off_t)0, SEEK_CUR); /* Get current file position */ if (lseek (f->fd, (off_t)(f->record_off - f->record->size), SEEK_SET) == -1) { return COB_STATUS_30_PERMANENT_ERROR; } @@ -5035,12 +5090,15 @@ sequential_rewrite (cob_file_api *a, cob_file *f, const int opt) return COB_STATUS_00_SUCCESS; } +/* LINE SEQUENTIAL */ + #define IS_BAD_CHAR(x) (x < ' ' && x != COB_CHAR_BS && x != COB_CHAR_ESC \ && x != COB_CHAR_FF && x != COB_CHAR_SI && x != COB_CHAR_TAB) -/* LINE SEQUENTIAL */ + static int lineseq_read (cob_file_api *a, cob_file *f, const int read_opts) { + FILE *fp = (FILE *)f->file; unsigned char *dataptr; size_t i = 0; int sts = COB_STATUS_00_SUCCESS; @@ -5050,34 +5108,61 @@ lineseq_read (cob_file_api *a, cob_file *f, const int read_opts) COB_UNUSED (read_opts); dataptr = f->record->data; - if (f->file == NULL) + if (f->file == NULL) { return COB_STATUS_30_PERMANENT_ERROR; + } again: - if (!f->flag_is_pipe) - f->record_off = ftell ((FILE *)f->file); /* Save position at start of line */ + if (!f->flag_is_pipe) { + f->record_off = ftell (fp); /* Save position at start of line */ + } for (; ;) { - n = getc ((FILE *)f->file); + n = getc (fp); if (n == EOF) { if (!i) { - if (open_next (f)) + if (open_next (f)) { goto again; + } return COB_STATUS_10_END_OF_FILE; } else { break; } } - if (n == 0 - && (f->file_features & COB_FILE_LS_NULLS)) { - n = getc ((FILE *)f->file); - /* LCOV_EXCL_START */ - if (n == EOF) { - return COB_STATUS_30_PERMANENT_ERROR; + if (n == '\r') { + int next = getc (fp); + if (next == '\n') { + /* next is LF -> so ignore CR */ + n = '\n'; + } else { + /* looks like \r was part of the data, + re-position and pass to COBOL data + after validation */ + fseek (fp, -1, SEEK_CUR); + } + } + if (n == '\n') { + break; + } + if ((f->file_features & COB_FILE_LS_VALIDATE)) { + if ((IS_BAD_CHAR (n) + || (n > 0x7E && !isprint(n)))) { + return COB_STATUS_09_READ_DATA_BAD; } - if ((f->file_features & COB_FILE_LS_VALIDATE) - && (unsigned char)n >= ' ') { /* Should be less than a space */ + } else if ((f->file_features & COB_FILE_LS_NULLS)) { + if (n == 0) { + n = getc (fp); + /* LCOV_EXCL_START */ + if (n == EOF) { + return COB_STATUS_30_PERMANENT_ERROR; + } + /* LCOV_EXCL_STOP */ + /* NULL-Encoded -> should be less than a space */ + if ((unsigned char)n >= ' ') { + return COB_STATUS_71_BAD_CHAR; + } + /* Not NULL-Encoded, may not be less than a space */ + } else if ((unsigned char)n < ' ') { return COB_STATUS_71_BAD_CHAR; } - /* LCOV_EXCL_STOP */ } else if (n == COB_CHAR_TAB && f->flag_ls_instab) { @@ -5090,21 +5175,14 @@ lineseq_read (cob_file_api *a, cob_file *f, const int read_opts) i++; } continue; - } else { - if (n == '\r') { - continue; /* Ignore CR on reading */ - } - if (n == '\n') { - break; - } - if (n == '\f') /* Skip NEW PAGE on reading */ - continue; - if ((f->file_features & COB_FILE_LS_VALIDATE) - && (IS_BAD_CHAR (n) - || (n > 0x7E && !isprint(n)))) { - return COB_STATUS_09_READ_DATA_BAD; - } } +#if 0 /* CHECKME: When should this be done? + Only for LS_VALIDATE / LS_NULLS? */ + /* Skip NEW PAGE on reading */ + if (n == '\f') { + continue; + } +#endif if (i < f->record_max) { *dataptr++ = (unsigned char)n; i++; @@ -5113,13 +5191,13 @@ lineseq_read (cob_file_api *a, cob_file *f, const int read_opts) /* If record is too long, then simulate end * so balance becomes the next record read */ long k = 1; - n = getc ((FILE *)f->file); + n = getc (fp); if (n == '\r') { - n = getc ((FILE *)f->file); + n = getc (fp); k++; } if (n != '\n') { - fseek((FILE*)f->file, -k, SEEK_CUR); + fseek (fp, -k, SEEK_CUR); if (!(COB_MODULE_PTR && COB_MODULE_PTR->flag_dialect == COB_DIALECT_MF)) sts = COB_STATUS_06_READ_TRUNCATE; @@ -5134,8 +5212,11 @@ lineseq_read (cob_file_api *a, cob_file *f, const int read_opts) f->record_max - i); } f->record->size = i; - if (f->open_mode == COB_OPEN_I_O) /* Required on some systems */ - fflush((FILE*)f->file); +#ifdef READ_WRITE_NEEDS_FLUSH + if (f->open_mode == COB_OPEN_I_O) { /* Required on some systems */ + fflush (fp); + } +#endif return sts; } @@ -5143,19 +5224,22 @@ lineseq_read (cob_file_api *a, cob_file *f, const int read_opts) static size_t lineseq_size (cob_file *f) { - size_t size,i; - if ((f->file_features & COB_FILE_LS_FIXED)) + size_t size, i; + if ((f->file_features & COB_FILE_LS_FIXED)) { return f->record->size; + } if (f->variable_record) { f->record->size = (size_t)cob_get_int (f->variable_record); if (f->record->size > f->record_max) { f->record->size = f->record_max; } } - if (f->record->size < f->record_min) + if (f->record->size < f->record_min) { f->record->size = f->record_min; - if (f->record->size == 0) + } + if (f->record->size == 0) { return 0; + } for (i = f->record->size - 1; ; --i) { if (f->record->data[i] != ' ') { i++; @@ -5170,20 +5254,20 @@ lineseq_size (cob_file *f) static int lineseq_write (cob_file_api *a, cob_file *f, const int opt) { + FILE *fp = (FILE *)f->file; unsigned char *p; cob_linage *lingptr; size_t size; int ret; - FILE *fo; + COB_UNUSED (a); /* Determine the size to be written */ size = lineseq_size (f); - fo = (FILE*)f->file; if (f->flag_is_pipe) { if (f->fdout >= 0) { - fo = (FILE*)f->fileout; + fp = (FILE *)f->fileout; } } else { if (f->flag_select_features & COB_SELECT_LINAGE) { @@ -5192,58 +5276,74 @@ lineseq_write (cob_file_api *a, cob_file *f, const int opt) f->flag_needs_top = 0; lingptr = f->linage; for (i = 0; i < lingptr->lin_top; ++i) { - COB_CHECKED_FPUTC ('\n', fo); + COB_CHECKED_FPUTC ('\n', fp); } } } /* WRITE AFTER */ if ((opt & COB_WRITE_AFTER) - && !f->flag_is_pipe) { + && !f->flag_is_pipe) { if (f->flag_select_features & COB_SELECT_LINAGE) { ret = cob_linage_write_opt (f, opt); - if (ret) + if (ret) { return ret; - } else - if (f->last_write_mode == COB_LAST_WRITE_BEFORE) { - COB_CHECKED_FPUTC ('\n', (FILE *)f->file); + } + } else if (f->last_write_mode == COB_LAST_WRITE_BEFORE) { + COB_CHECKED_FPUTC ('\n', fp); f->flag_needs_nl = 0; f->flag_needs_cr = 0; - } else { + } else { ret = cob_file_write_opt (f, opt); - if (ret) + if (ret) { return ret; + } f->flag_needs_nl = 1; } f->last_write_mode = COB_LAST_WRITE_AFTER; } - f->record_off = ftell ((FILE *)f->file); /* Save file position at start of line */ + f->record_off = ftell (fp); /* Save file position at start of line */ } - if ((opt & COB_WRITE_BEFORE) + if ((opt & COB_WRITE_BEFORE) && f->last_write_mode != COB_LAST_WRITE_BEFORE) { if (f->flag_needs_cr && f->last_write_mode != COB_LAST_WRITE_UNKNOWN) { - COB_CHECKED_FPUTC ('\r', (FILE *)f->file); + COB_CHECKED_FPUTC ('\r', fp); } f->flag_needs_cr = 0; f->last_write_mode = COB_LAST_WRITE_BEFORE; - } + } + + f->record_off = ftell (fp); /* Save file position at start of line */ + /* Write to the file */ - if (size) { - if ((f->file_features & COB_FILE_LS_CRLF)) + if (size > 0) { + if ((f->file_features & COB_FILE_LS_CRLF)) { f->flag_needs_cr = 1; - if (f->file_features & COB_FILE_LS_NULLS) { + } + if ((f->file_features & COB_FILE_LS_VALIDATE)) { + size_t i; + p = f->record->data; + for (i = 0; i < size; ++i, ++p) { + if (IS_BAD_CHAR (*p)) { + return COB_STATUS_71_BAD_CHAR; + } + } + COB_CHECKED_FWRITE (fp, f->record->data, size); + } else if ((f->file_features & COB_FILE_LS_NULLS) + || f->flag_ls_instab) { size_t i, j, k, t; p = f->record->data; - for (i=j=0; j < (int)size; j++) { - if (p[j] < ' ') { + for (i = j = 0; j < size; j++) { + if ((f->file_features & COB_FILE_LS_NULLS) + && p[j] < ' ') { if ((j - i) > 0) { - COB_CHECKED_FWRITE(fo, &p[i], j - i); + COB_CHECKED_FWRITE(fp, &p[i], j - i); } i = j + 1; - COB_CHECKED_FPUTC(0x00, fo); - COB_CHECKED_FPUTC(p[j], fo); + COB_CHECKED_FPUTC(0x00, fp); + COB_CHECKED_FPUTC(p[j], fp); } else if (p[j] == ' ' && p[j+1] == ' ' @@ -5251,15 +5351,15 @@ lineseq_write (cob_file_api *a, cob_file *f, const int opt) && i < j && f->flag_ls_instab) { t = ((j + 7) / 8) * 8; - for(k=j; k < size && p[k] == ' '; k++); + for (k = j; k < size && p[k] == ' '; k++); k = (k / 8) * 8; if (k >= t && t < size) { if ((j - i) > 0) { - COB_CHECKED_FWRITE(fo, &p[i], j - i); + COB_CHECKED_FWRITE(fp, &p[i], j - i); } while (t <= k) { - COB_CHECKED_FPUTC(COB_CHAR_TAB, fo); + COB_CHECKED_FPUTC(COB_CHAR_TAB, fp); t += 8; } j = k - 1; @@ -5269,64 +5369,45 @@ lineseq_write (cob_file_api *a, cob_file *f, const int opt) } } if (i < size) { - errno = 0; - ret = fwrite (&p[i],(int)size - i, 1, fo); - if (ret <= 0) { - return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); - } + COB_CHECKED_FWRITE(fp, &p[i], (int)size - i); } } else { - if (f->file_features & COB_FILE_LS_VALIDATE) { - int i; - p = f->record->data; - for (i = 0; i < (int)size; ++i, ++p) { - if (IS_BAD_CHAR (*p)) { - return COB_STATUS_71_BAD_CHAR; - } - } - } - errno = 0; - ret = fwrite (f->record->data, size, (size_t)1, fo); - /* LCOV_EXCL_START */ - if (ret != 1) { - return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); - }; - /* LCOV_EXCL_STOP */ + COB_CHECKED_FWRITE (fp, f->record->data, size); } } + if (f->flag_is_pipe) { - COB_CHECKED_FPUTC ('\n', fo); - fflush(fo); + COB_CHECKED_FPUTC ('\n', fp); + fflush (fp); f->flag_needs_nl = 0; return COB_STATUS_00_SUCCESS; } - if (f->flag_select_features & COB_SELECT_LINAGE) { - COB_CHECKED_FPUTC ('\n', fo); + if ((f->flag_select_features & COB_SELECT_LINAGE)) { + COB_CHECKED_FPUTC ('\n', fp); f->flag_needs_nl = 0; - } else - if ((f->file_features & COB_FILE_LS_CRLF)) { + } else if ((f->file_features & COB_FILE_LS_CRLF)) { if ((opt & COB_WRITE_PAGE) || ((opt & COB_WRITE_BEFORE) && f->flag_needs_nl)) { /* CHECKME - possible bug, see discussion board */ } else if (opt == 0) { if (f->flag_needs_cr) { - COB_CHECKED_FPUTC ('\r', fo); + COB_CHECKED_FPUTC ('\r', fp); f->flag_needs_cr = 0; } } } - if ((opt == 0) - && !(f->flag_select_features & COB_SELECT_LINAGE) - && ((f->file_features & COB_FILE_LS_LF) - || (f->file_features & COB_FILE_LS_CRLF))){ + if ((opt == 0) + && !(f->flag_select_features & COB_SELECT_LINAGE) + && ((f->file_features & COB_FILE_LS_LF) + || (f->file_features & COB_FILE_LS_CRLF))) { /* At least add 1 LF */ if (f->flag_needs_cr) { - COB_CHECKED_FPUTC ('\r', fo); + COB_CHECKED_FPUTC ('\r', fp); f->flag_needs_cr = 0; } - COB_CHECKED_FPUTC ('\n', fo); + COB_CHECKED_FPUTC ('\n', fp); f->flag_needs_nl = 0; } @@ -5339,15 +5420,19 @@ lineseq_write (cob_file_api *a, cob_file *f, const int opt) f->flag_needs_nl = 0; f->last_write_mode = COB_LAST_WRITE_BEFORE; } - if (f->open_mode == COB_OPEN_I_O) /* Required on some systems */ - fflush ((FILE*)f->file); +#ifdef READ_WRITE_NEEDS_FLUSH + if (f->open_mode == COB_OPEN_I_O) { /* Required on some systems */ + fflush (fp); + } +#endif return COB_STATUS_00_SUCCESS; } static int lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) { + FILE *fp = (FILE *)f->file; unsigned char *p; size_t size, psize, slotlen, rcsz; off_t curroff, savepos; @@ -5355,17 +5440,19 @@ lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) COB_UNUSED (a); COB_UNUSED (opt); - if (f->flag_is_pipe) + if (f->flag_is_pipe) { return COB_STATUS_30_PERMANENT_ERROR; + } - curroff = ftell ((FILE *)f->file); /* Current file position */ + curroff = ftell (fp); /* Current file position */ size = lineseq_size (f); p = f->record->data; psize = size; slotlen = curroff - f->record_off - 1; - if ((f->file_features & COB_FILE_LS_CRLF)) + if ((f->file_features & COB_FILE_LS_CRLF)) { slotlen--; + } if ((f->file_features & COB_FILE_LS_NULLS) || f->flag_ls_instab) { size_t j; @@ -5375,7 +5462,7 @@ lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) psize++; } else if (f->flag_ls_instab - && memcmp(&p[j]," ",8) == 0 + && memcmp(&p[j], " ", 8) == 0 && j < (size - 2)) { while (memcmp(&p[j], " ", 8) == 0 && j < size) { @@ -5390,9 +5477,10 @@ lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) return COB_STATUS_44_RECORD_OVERFLOW; } - if (fseek((FILE*)f->file, (off_t)f->record_off, SEEK_SET) != 0) { + if (fseek(fp, (off_t)f->record_off, SEEK_SET) != 0) { return COB_STATUS_30_PERMANENT_ERROR; } + if (f->flag_do_qbl && qblfd != -1) { /* Save the before image */ rcsz = f->record->size; @@ -5400,32 +5488,41 @@ lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) memcpy (qbl_tmp, f->record->data, rcsz); lineseq_read (a, f, 0); memcpy (qbl_hdr->data, f->record->data, f->record->size); - while(f->record->size < f->record_max) { + while (f->record->size < f->record_max) { qbl_hdr->data[f->record->size++] = ' '; } cob_put_qbl (f, QBL_BEFORE); memcpy (f->record->data, qbl_tmp, rcsz); f->record_off = savepos; - if (fseek((FILE*)f->file, (off_t)savepos, SEEK_SET) != 0) { + if (fseek(fp, (off_t)savepos, SEEK_SET) != 0) { return COB_STATUS_30_PERMANENT_ERROR; } } /* Write to the file */ if (size > 0) { - if ((f->file_features & COB_FILE_LS_NULLS) + if ((f->file_features & COB_FILE_LS_VALIDATE)) { + size_t i; + p = f->record->data; + for (i = 0; i < size; ++i, ++p) { + if (IS_BAD_CHAR (*p)) { + return COB_STATUS_71_BAD_CHAR; + } + } + COB_CHECKED_FWRITE (fp, f->record->data, size); + } else if ((f->file_features & COB_FILE_LS_NULLS) || f->flag_ls_instab) { size_t i, j, k, t; p = f->record->data; - for (i=j=0; j < size; j++) { + for (i = j = 0; j < size; j++) { if ((f->file_features & COB_FILE_LS_NULLS) && p[j] < ' ') { - if (j - i > 0) { - COB_CHECKED_FWRITE(f->file, &p[i], j - i); + if ((j - i) > 0) { + COB_CHECKED_FWRITE(fp, &p[i], j - i); } i = j + 1; - COB_CHECKED_FPUTC(0x00, (FILE*)f->file); - COB_CHECKED_FPUTC(p[j], (FILE*)f->file); + COB_CHECKED_FPUTC(0x00, fp); + COB_CHECKED_FPUTC(p[j], fp); } else /* FIXME: EXPANDTAB should be separate and possibly [Test needed with MF INSERTTAB yes, EXPANDTAB no] @@ -5438,15 +5535,15 @@ lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) && p[j+1] == ' ' && i < j) { t = ((j + 7) / 8) * 8; - for(k=j; k < size && p[k] == ' '; k++); + for (k = j; k < size && p[k] == ' '; k++); k = (k / 8) * 8; if (k >= t && t < size) { if ((j - i) > 0) { - COB_CHECKED_FWRITE(f->file, &p[i], j - i); + COB_CHECKED_FWRITE(fp, &p[i], j - i); } while (t <= k) { - COB_CHECKED_FPUTC(COB_CHAR_TAB, (FILE*)f->file); + COB_CHECKED_FPUTC(COB_CHAR_TAB, fp); t += 8; } j = k - 1; @@ -5456,34 +5553,29 @@ lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) } } if (i < size) { - COB_CHECKED_FWRITE(f->file, &p[i],(int)size - i); + COB_CHECKED_FWRITE(fp, &p[i], (int)size - i); } } else { - if ((f->file_features & COB_FILE_LS_VALIDATE)) { - int i; - p = f->record->data; - for (i = 0; i < (int)size; ++i, ++p) { - if (IS_BAD_CHAR(*p)) { - return COB_STATUS_71_BAD_CHAR; - } - } - } - COB_CHECKED_FWRITE(f->file, f->record->data, size); + COB_CHECKED_FWRITE(fp, f->record->data, size); } if (psize < slotlen) { /* In case new record was shorter, pad with spaces */ size_t i; for (i = psize; i < slotlen; i++) { - COB_CHECKED_FPUTC(' ', (FILE*)f->file); + COB_CHECKED_FPUTC(' ', fp); } } } - if (fseek((FILE*)f->file, (off_t)curroff, SEEK_SET) != 0) { + if (fseek (fp, (off_t)curroff, SEEK_SET) != 0) { return COB_STATUS_30_PERMANENT_ERROR; } - if (f->open_mode == COB_OPEN_I_O) /* Required on some systems */ - fflush((FILE*)f->file); + +#ifdef READ_WRITE_NEEDS_FLUSH + if (f->open_mode == COB_OPEN_I_O) { /* Required on some systems */ + fflush (fp); + } +#endif return COB_STATUS_00_SUCCESS; } @@ -5523,7 +5615,7 @@ relative_read_size (cob_file *f, off_t off, int *isdeleted) if (f->record_prefix == 2) { relsize = ((rechdr[0] & 0x0F) << 8) + rechdr[1]; } else { - relsize = ((rechdr[0] & 0x0F) << 24) + (rechdr[1] << 16) + relsize = ((rechdr[0] & 0x0F) << 24) + (rechdr[1] << 16) + (rechdr[2] << 8) + rechdr[3]; } if ((rechdr[0] & 0x20)) { @@ -5746,7 +5838,7 @@ relative_read (cob_file_api *a, cob_file *f, cob_field *k, const int read_opts) return COB_STATUS_10_END_OF_FILE; } if(off >= st.st_size) { - if (f->access_mode == COB_ACCESS_SEQUENTIAL) + if (f->access_mode == COB_ACCESS_SEQUENTIAL) return COB_STATUS_10_END_OF_FILE; return COB_STATUS_23_KEY_NOT_EXISTS; } @@ -6227,7 +6319,7 @@ cob_file_unlock (cob_file *f) return; } - if (f->open_mode != COB_OPEN_CLOSED + if (f->open_mode != COB_OPEN_CLOSED && f->open_mode != COB_OPEN_LOCKED) { if (f->organization == COB_ORG_SORT) { return; @@ -6280,7 +6372,7 @@ cob_file_unlock (cob_file *f) */ void cob_file_create ( - cob_file ** pfl, + cob_file ** pfl, const char *exname, const char *select_name, const enum cob_file_org fileorg, @@ -6338,7 +6430,7 @@ void cob_file_destroy (cob_file **pfl) { cob_file *fl; - if (pfl != NULL + if (pfl != NULL && *pfl != NULL) { fl = *pfl; if (fl->linage) { @@ -6543,7 +6635,7 @@ cob_file_set_lock ( } /* - * Setup of the file is now complete + * Setup of the file is now complete */ void cob_file_complete ( cob_file * fl) @@ -6570,7 +6662,7 @@ cob_file_external_addr (const char *exname, /* external pointer available - get the address stored and set / check keys */ cob_file *fl = *pfl = *epfl; - /* already allocated, just pass on */ + /* already allocated, just pass on */ if (pky != NULL) { *pky = fl->keys; } @@ -6606,7 +6698,7 @@ cob_file_malloc (cob_file **pfl, cob_file_key **pky, fl = cob_cache_malloc (sizeof (cob_file)); fl->file_version = COB_FILE_VERSION; fl->open_mode = COB_OPEN_CLOSED; - fl->nkeys = nkeys; + fl->nkeys = nkeys; if (nkeys > 0 && pky != NULL) { @@ -6638,6 +6730,10 @@ cob_file_free (cob_file **pfl, cob_file_key **pky) cob_cache_free (fl->linage); fl->linage = NULL; } + if (fl->org_filename) { + cob_cache_free (fl->org_filename); + fl->org_filename = NULL; + } if (*pfl != NULL) { cob_cache_free (*pfl); *pfl = NULL; @@ -6892,8 +6988,8 @@ cob_open (cob_file *f, const int mode, const int sharing, cob_field *fnstatus) f->flag_is_concat = 0; if (file_setptr->cob_concat_name && (f->organization == COB_ORG_SEQUENTIAL - || f->organization == COB_ORG_LINE_SEQUENTIAL) - && (mode == COB_OPEN_INPUT + || f->organization == COB_ORG_LINE_SEQUENTIAL) + && (mode == COB_OPEN_INPUT || mode == COB_OPEN_I_O) && (cp = strchr(file_open_name,file_setptr->cob_concat_sep[0])) != NULL && file_open_name[0] != '>' @@ -6913,8 +7009,8 @@ cob_open (cob_file *f, const int mode, const int sharing, cob_field *fnstatus) return; } if (errno == ENOENT) { - if ((mode != COB_OPEN_OUTPUT && mode != COB_OPEN_EXTEND) - || f->organization == COB_ORG_INDEXED) + if ((mode != COB_OPEN_OUTPUT && mode != COB_OPEN_EXTEND) + || f->organization == COB_ORG_INDEXED) cob_file_save_status (f, fnstatus, COB_XSTATUS_NOT_FILE); else cob_file_save_status (f, fnstatus, COB_XSTATUS_NOT_DIR); @@ -7347,8 +7443,8 @@ cob_write (cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus, } if (f->organization == COB_ORG_RELATIVE) { - if (f->access_mode == COB_ACCESS_SEQUENTIAL - && (f->open_mode == COB_OPEN_OUTPUT + if (f->access_mode == COB_ACCESS_SEQUENTIAL + && (f->open_mode == COB_OPEN_OUTPUT || f->open_mode == COB_OPEN_EXTEND)) { f->cur_rec_num = f->max_rec_num + 1; if (f->cur_rec_num < 1) @@ -7982,15 +8078,17 @@ cob_sys_close_file (unsigned char *file_handle) return close (fd); } -/* dummy entry point for library routine CBL_FLUSH_FILE - doesn't do anything yet! */ +/* entry point and processing for library routine CBL_FLUSH_FILE + (flush bytestream file handle, got from CBL_OPEN_FILE) */ int cob_sys_flush_file (unsigned char *file_handle) { - COB_UNUSED (file_handle); + int fd; COB_CHK_PARMS (CBL_FLUSH_FILE, 1); - return 0; + memcpy (&fd, file_handle, sizeof (int)); + return fdcobsync (fd); } /* entry point and processing for library routine CBL_DELETE_FILE */ diff --git a/tests/testsuite.src/run_file.at b/tests/testsuite.src/run_file.at index add3dc61a..f621de40d 100644 --- a/tests/testsuite.src/run_file.at +++ b/tests/testsuite.src/run_file.at @@ -2803,7 +2803,7 @@ AT_DATA([prog.cob], [ WORKING-STORAGE SECTION. 01 whatever PIC X(10) VALUE "out.txt". - + PROCEDURE DIVISION. OPEN OUTPUT f WRITE f-rec FROM "hi" @@ -4477,7 +4477,7 @@ AT_DATA([prog.cob], [ Display "read next". Read tbw next record - at end + at end Display "read next end" Go to tbw-exit not at end @@ -5087,7 +5087,7 @@ AT_DATA([prog.cob], [ 78 MAX-SUB VALUE 6. 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4). + 77 REC-NUM VALUE 1 BINARY-SHORT UNSIGNED. 01 TEST-DATA. @@ -5135,7 +5135,7 @@ AT_DATA([prog.cob], [ 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL PIC 9(3) COMP-3 OCCURS MAX-SUB. 01 WORK-AREA. - 05 SUB BINARY-SHORT. + 05 SUB BINARY-SHORT UNSIGNED. 88 ODD-RECORD VALUE 1 3 5. @@ -6485,11 +6485,11 @@ AT_DATA([prog.cob], [ SELECT INFILE ASSIGN TO EXTERNAL INFILE ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS INPUT-STATUS . - + SELECT OUTFILE ASSIGN TO EXTERNAL OUTFILE ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS INPUT-STATUS . - + DATA DIVISION. FILE SECTION. FD INFILE @@ -6497,43 +6497,43 @@ AT_DATA([prog.cob], [ DEPENDING ON INPUT-LEN . 01 INPUT-REC PIC X(40). - + FD OUTFILE RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS DEPENDING ON INPUT-LEN . 01 OUTPUT-REC PIC X(40). - + WORKING-STORAGE SECTION. - + 01 OUTPUT-FILE PIC X(19) VALUE 'TEST-FILE'. 01 INPUT-FILE PIC X(19) VALUE 'TEST-INP'. 01 INPUT-STATUS PIC XX. 01 INPUT-LEN PIC 999 VALUE 18 . - + PROCEDURE DIVISION. A000-BEGIN. OPEN INPUT INFILE. READ INFILE - DISPLAY " Read 1: STATUS IS " INPUT-STATUS + DISPLAY " Read 1: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" READ INFILE - DISPLAY " Read 2: STATUS IS " INPUT-STATUS + DISPLAY " Read 2: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" MOVE 0 TO INPUT-LEN READ INFILE - DISPLAY " Read 3: STATUS IS " INPUT-STATUS + DISPLAY " Read 3: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" MOVE SPACES TO INPUT-REC MOVE 0 TO INPUT-LEN READ INFILE - DISPLAY " Read 4: STATUS IS " INPUT-STATUS + DISPLAY " Read 4: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN IF INPUT-STATUS = "00" - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" END-IF CLOSE INFILE @@ -6541,14 +6541,14 @@ AT_DATA([prog.cob], [ MOVE 9 TO INPUT-LEN MOVE "Record 1............." TO OUTPUT-REC WRITE OUTPUT-REC - DISPLAY "Write 1: STATUS IS " INPUT-STATUS + DISPLAY "Write 1: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN UPON CONSOLE MOVE 64 TO INPUT-LEN MOVE ALL '.' TO OUTPUT-REC MOVE "Record 2" TO OUTPUT-REC (1:8) WRITE OUTPUT-REC - DISPLAY "Write 2: STATUS IS " INPUT-STATUS + DISPLAY "Write 2: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN UPON CONSOLE CLOSE OUTFILE @@ -6601,11 +6601,11 @@ AT_DATA([prog.cob], [ SELECT INFILE ASSIGN TO EXTERNAL INFILE ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS INPUT-STATUS . - + SELECT OUTFILE ASSIGN TO EXTERNAL OUTFILE ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS INPUT-STATUS . - + DATA DIVISION. FILE SECTION. FD INFILE @@ -6613,43 +6613,43 @@ AT_DATA([prog.cob], [ DEPENDING ON INPUT-LEN . 01 INPUT-REC PIC X(40). - + FD OUTFILE RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS DEPENDING ON INPUT-LEN . 01 OUTPUT-REC PIC X(40). - + WORKING-STORAGE SECTION. - + 01 OUTPUT-FILE PIC X(19) VALUE 'TEST-FILE'. 01 INPUT-FILE PIC X(19) VALUE 'TEST-INP'. 01 INPUT-STATUS PIC XX. 01 INPUT-LEN PIC 999 VALUE 18 . - + PROCEDURE DIVISION. A000-BEGIN. OPEN INPUT INFILE. READ INFILE - DISPLAY " Read 1: STATUS IS " INPUT-STATUS + DISPLAY " Read 1: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" READ INFILE - DISPLAY " Read 2: STATUS IS " INPUT-STATUS + DISPLAY " Read 2: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" MOVE 0 TO INPUT-LEN READ INFILE - DISPLAY " Read 3: STATUS IS " INPUT-STATUS + DISPLAY " Read 3: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" MOVE SPACES TO INPUT-REC MOVE 0 TO INPUT-LEN READ INFILE - DISPLAY " Read 4: STATUS IS " INPUT-STATUS + DISPLAY " Read 4: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN IF INPUT-STATUS = "00" - DISPLAY " :" INPUT-REC ":" + DISPLAY " :" INPUT-REC ":" END-IF CLOSE INFILE @@ -6657,14 +6657,14 @@ AT_DATA([prog.cob], [ MOVE 9 TO INPUT-LEN MOVE "Record 1............." TO OUTPUT-REC WRITE OUTPUT-REC - DISPLAY "Write 1: STATUS IS " INPUT-STATUS + DISPLAY "Write 1: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN UPON CONSOLE MOVE 64 TO INPUT-LEN MOVE ALL '.' TO OUTPUT-REC MOVE "Record 2" TO OUTPUT-REC (1:8) WRITE OUTPUT-REC - DISPLAY "Write 2: STATUS IS " INPUT-STATUS + DISPLAY "Write 2: STATUS IS " INPUT-STATUS " LENGTH IS " INPUT-LEN UPON CONSOLE CLOSE OUTFILE @@ -6700,7 +6700,7 @@ AT_CHECK([diff reference TEST-FILE], [0], [], []) # same check with dialect option (4.x feature) # AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], []) -# +# # AT_CHECK([DD_INFILE=./inp_data OUTFILE=TEST-FILE \ # $COBCRUN_DIRECT ./prog], [0], # [ Read 1: STATUS IS 00 LENGTH IS 040 @@ -6714,7 +6714,7 @@ AT_CHECK([diff reference TEST-FILE], [0], [], []) # Write 1: STATUS IS 00 LENGTH IS 009 # Write 2: STATUS IS 00 LENGTH IS 064 # ], []) -# +# # AT_CHECK([diff reference TEST-FILE], [0], [], []) AT_CLEANUP @@ -9509,7 +9509,7 @@ AT_DATA([prog.cob], [ 10 STAT-X2 PIC X COMP-X. 77 BYTE-1 PICTURE 9(3). 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(2). + 78 MAX-SUB VALUE 16. 77 IDX PICTURE 9. 77 IDX2 PICTURE 9. 77 OUT-FILE-NAME PICTURE X(9) @@ -9537,7 +9537,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC X(8) VALUE "PRE00000". 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. + PIC X(8) OCCURS MAX-SUB. 02 DATA-COMPANY-TBL. 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". @@ -9558,7 +9558,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. + PIC X(25) OCCURS MAX-SUB. 02 DATA-ADDRESS-1-TBL. 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". @@ -9579,7 +9579,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. + PIC X(25) OCCURS MAX-SUB. 02 DATA-ADDRESS-2-TBL. 05 FILLER PIC X(10) VALUE "NEW YORK ". @@ -9600,7 +9600,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC X(10) VALUE "WHITEPLAIN". 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. + PIC X(10) OCCURS MAX-SUB. 02 DATA-ADDRESS-3-TBL. 05 FILLER PIC X(10) VALUE "N.Y. ". @@ -9621,7 +9621,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC X(10) VALUE "N.Y. ". 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. + PIC X(10) OCCURS MAX-SUB. 02 DATA-TELEPHONE-TBL. 05 FILLER PIC 9(10) VALUE 3131234432. @@ -9642,7 +9642,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC 9(10) VALUE 4169898509. 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. + PIC 9(10) OCCURS MAX-SUB. 02 DATA-DP-MGR-TBL. 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". @@ -9663,7 +9663,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. + PIC X(20) OCCURS MAX-SUB. 02 DATA-MACHINE-TBL. 05 FILLER PIC X(8) VALUE "UNI-9030". @@ -9684,7 +9684,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC X(8) VALUE "UNI-9040". 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. + PIC X(8) OCCURS MAX-SUB. 02 DATA-NO-TERMINALS-TBL. 05 FILLER PIC 9(3) COMP-3 VALUE 85. @@ -9705,7 +9705,7 @@ AT_DATA([prog.cob], [ 05 FILLER PIC 9(3) COMP-3 VALUE 86. 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. + PIC 9(3) COMP-3 OCCURS MAX-SUB. 01 WORK-AREA. 05 REC-NUM PICTURE 9(2) VALUE 0. @@ -10125,7 +10125,7 @@ AT_DATA([prog.cob], [ 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL PIC 9(3) COMP-3 OCCURS MAX-SUB. 01 WORK-AREA. - 05 SUB BINARY-SHORT. + 05 SUB BINARY-SHORT UNSIGNED. 88 ODD-RECORD VALUE 1 3 5. @@ -12437,7 +12437,7 @@ AT_DATA([prog.cob], [ 78 MAX-SUB VALUE 6. 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(04). + 77 REC-NUM VALUE 1 BINARY-SHORT UNSIGNED. 01 TEST-DATA. @@ -12486,7 +12486,7 @@ AT_DATA([prog.cob], [ 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL PIC 9(3) COMP-3 OCCURS MAX-SUB. 01 WORK-AREA. - 05 SUB BINARY-SHORT. + 05 SUB BINARY-SHORT UNSIGNED. 88 ODD-RECORD VALUE 1 3 5. @@ -12606,36 +12606,36 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Loading sample program data file. Sample program data file load complete. Initial Re-Read Open Sts:00 -Read2 ALP00000 #:0001 Trms:0010 -Read BET00000 #:0002 Trms:0013 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 +Read2 ALP00000 #:00001 Trms:0010 +Read BET00000 #:00002 Trms:0013 +Read2 GAM00000 #:00003 Trms:0075 +Read DEL00000 #:00004 Trms:0010 +Read2 EPS00000 #:00005 Trms:0090 +Read FOR00000 #:00006 Trms:0254 Read Status: 10 For Rewrite Open I-O Sts:00 -Read2 ALP00000 #:0001 Trms:0010 +Read2 ALP00000 #:00001 Trms:0010 REWRITE ALP00000 Sts 00 Trms:0011 For Rewrite/Delete Open I-O Sts:00 -Read2 ALP00000 #:0001 Trms:0011 +Read2 ALP00000 #:00001 Trms:0011 REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 #:0002 Trms:0013 +Read BET00000 #:00002 Trms:0013 DELETE BET00000 Sts 00 Re-list Open Sts:00 -Read2 ALP00000 #:0001 Trms:0012 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 +Read2 ALP00000 #:00001 Trms:0012 +Read2 GAM00000 #:00003 Trms:0075 +Read DEL00000 #:00004 Trms:0010 +Read2 EPS00000 #:00005 Trms:0090 +Read FOR00000 #:00006 Trms:0254 Read Status: 10 Re-list afer Extend Open Sts:00 -Read2 ALP00000 #:0001 Trms:0012 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 -Read2 ALP00000 #:0007 Trms:0010 -Read BET00000 #:0008 Trms:0013 +Read2 ALP00000 #:00001 Trms:0012 +Read2 GAM00000 #:00003 Trms:0075 +Read DEL00000 #:00004 Trms:0010 +Read2 EPS00000 #:00005 Trms:0090 +Read FOR00000 #:00006 Trms:0254 +Read2 ALP00000 #:00007 Trms:0010 +Read BET00000 #:00008 Trms:0013 Read Status: 10 ], []) @@ -19389,7 +19389,7 @@ AT_CHECK([diff reference child.txt], [0], [], []) AT_CLEANUP -AT_SETUP([WRITE and REWRITE FILE name ]) +AT_SETUP([WRITE and REWRITE FILE name]) AT_KEYWORDS([runfile]) AT_DATA([prog.cob], [ @@ -21593,15 +21593,14 @@ AT_DATA([prog.cob], [ 10 CM-CUST-NUM PICTURE X(8). 10 CM-COMPANY PICTURE X(25). 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. + 10 CM-NO-TERMINALS PICTURE 9(5). + 10 CM-PK-DATE PICTURE S9(14). 10 CM-TRAILER PICTURE X(52). WORKING-STORAGE SECTION. 78 MAX-SUB VALUE 6. 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 BINARY-LONG. 01 TEST-DATA. @@ -21640,18 +21639,18 @@ AT_DATA([prog.cob], [ 02 DATA-NO-TERMINALS-TBL. - 05 FILLER PIC 9(5) COMP-3 VALUE 8240. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 13. - 05 FILLER PIC 9(5) COMP-3 VALUE 65535. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 254. + 05 FILLER PIC 9(5) VALUE 8240. + 05 FILLER PIC 9(5) VALUE 10. + 05 FILLER PIC 9(5) VALUE 13. + 05 FILLER PIC 9(5) VALUE 65535. + 05 FILLER PIC 9(5) VALUE 10. + 05 FILLER PIC 9(5) VALUE 254. 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(5) COMP-3 OCCURS MAX-SUB. + PIC 9(5) OCCURS MAX-SUB. 01 WORK-AREA. - 05 SUB BINARY-SHORT. - 88 ODD-RECORD VALUE 1 3 5. + 05 SUB USAGE BINARY-SHORT UNSIGNED. + 88 ODD-RECORD VALUE 1 3 5. PROCEDURE DIVISION. @@ -21668,6 +21667,7 @@ AT_DATA([prog.cob], [ OPEN I-O FLATFILE. PERFORM READ-RECORD MOVE 10 TO CM-NO-TERMINALS + MOVE "STUFF" TO CM-TRAILER REWRITE TSPFL-RECORD DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT " Trms:" CM-NO-TERMINALS. @@ -21802,6 +21802,7 @@ Read Status: 10 AT_CLEANUP + #TODO: Expandtab AT_SETUP([LINE SEQUENTIAL INSERTTAB]) @@ -22216,10 +22217,10 @@ AT_DATA([prog.cob], [ 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL PIC 9(3) COMP-3 OCCURS MAX-SUB. - 78 REC-MAX VALUE 16. + 78 REC-MAX VALUE MAX-SUB. 01 WORK-AREA. 05 REC-NUM BINARY-SHORT UNSIGNED VALUE 0. - 05 SUB BINARY-SHORT. + 05 SUB BINARY-SHORT UNSIGNED. 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. 88 NULL-KEY VALUE 4 5 8 12 14. @@ -22461,7 +22462,7 @@ AT_DATA([prog.cob], [ AND CUST-STAT NOT = "02" DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM ELSE - DISPLAY REC-NUM " Initial: " CM-CUST-NUM + DISPLAY REC-NUM " Initial: " CM-CUST-NUM " " CM-TELEPHONE IF REC-NUM = 3 MOVE CM-CUST-NUM TO SAV-KEY @@ -22723,10 +22724,10 @@ Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . Hit End of File Read Prev/Delete -00001 Initial: PRE00000 4169898509 -00002 Initial: MOR00000 4169898509 -00003 Initial: DEL00000 4169898509 -00004 Initial: BET00000 4169898509 +00001 Initial: PRE00000 4169898509 +00002 Initial: MOR00000 4169898509 +00003 Initial: DEL00000 4169898509 +00004 Initial: BET00000 4169898509 Start: PRE00000 4169898509 Prev: MOR00000 4169898509 Delete: MOR00000 sequential @@ -24026,7 +24027,7 @@ AT_DATA([prog.cob], [ 78 MAX-SUB VALUE 6. 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 BINARY-LONG. + 77 REC-NUM VALUE 1 BINARY-LONG UNSIGNED. 77 ADD-TERMS PICTURE 9(8) VALUE 0. 01 TEST-DATA. @@ -24066,18 +24067,18 @@ AT_DATA([prog.cob], [ 02 DATA-NO-TERMINALS-TBL. - 05 FILLER PIC 9(5) COMP-3 VALUE 8240. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 13. - 05 FILLER PIC 9(5) COMP-3 VALUE 65535. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 254. + 05 FILLER PIC 9(5) VALUE 8240. + 05 FILLER PIC 9(5) VALUE 10. + 05 FILLER PIC 9(5) VALUE 13. + 05 FILLER PIC 9(5) VALUE 65535. + 05 FILLER PIC 9(5) VALUE 10. + 05 FILLER PIC 9(5) VALUE 254. 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(5) COMP-3 OCCURS MAX-SUB. + PIC 9(5) OCCURS MAX-SUB. 01 WORK-AREA. - 05 SUB BINARY-SHORT. - 88 ODD-RECORD VALUE 1 3 5. + 05 SUB USAGE BINARY-SHORT UNSIGNED. + 88 ODD-RECORD VALUE 1 3 5. PROCEDURE DIVISION. @@ -24229,7 +24230,7 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE -ffile-format=mf prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +AT_CHECK([COB_LS_VALIDATE=0 $COBCRUN_DIRECT ./prog], [0], [Loading sample program data file. Sample program data file load complete. List: Open after COMMIT Sts:00 @@ -25006,49 +25007,48 @@ List tmp directory Open Sts: 9/021 AT_CLEANUP -AT_SETUP([LINE SEQUENTIAL Data]) +AT_SETUP([LINE SEQUENTIAL data]) AT_KEYWORDS([runfile]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. PROGRAM-ID. prog. - + ENVIRONMENT DIVISION. CONFIGURATION SECTION. - + INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT FLATFILE ASSIGN "LS-TEST" ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS CUST-STAT. + FILE STATUS IS CUST-STAT . DATA DIVISION. FILE SECTION. FD FLATFILE BLOCK CONTAINS 5 RECORDS. - + 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-TYPE PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. + 10 CM-CUST-NUM PICTURE X(8). + 10 CM-TYPE PICTURE X. + 10 CM-COMPANY PICTURE X(25). + 10 CM-DISK PICTURE X(8). + 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. 10 CM-PK-DATE PICTURE S9(14) COMP-3. WORKING-STORAGE SECTION. - + 78 MAX-SUB VALUE 4. 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 BINARY-LONG. - + 01 TEST-DATA. - + 02 DATA-CUST-NUM-TBL. 05 FILLER PIC X(8) VALUE "ALP00000". 05 FILLER PIC X(8) VALUE "BET00000". 05 FILLER PIC X(8) VALUE "GAM00000". 05 FILLER PIC X(8) VALUE "DEL00000". - + 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL PIC X(8) OCCURS MAX-SUB. 02 DATA-COMPANY-TBL. @@ -25067,51 +25067,49 @@ AT_DATA([prog.cob], [ PIC X(10) OCCURS MAX-SUB. 02 DATA-NO-TERMINALS-TBL. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 3. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. + 05 FILLER PIC 9(3) VALUE 10. + 05 FILLER PIC 9(3) VALUE 13. + 05 FILLER PIC 9(3) VALUE 3. + 05 FILLER PIC 9(3) VALUE 254. 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS MAX-SUB. + PIC 9(3) OCCURS MAX-SUB. 01 WORK-AREA. - 05 SUB BINARY-SHORT. + 05 SUB BINARY-SHORT UNSIGNED. 88 ODD-RECORD VALUE 1 3 5. - + PROCEDURE DIVISION. * Load file using MF rules - DISPLAY "LS_OPTIONS" UPON ENVIRONMENT-NAME - DISPLAY "format=mf" UPON ENVIRONMENT-VALUE + SET ENVIRONMENT "COB_LS_VALIDATE" TO "FALSE" + SET ENVIRONMENT "COB_LS_NULLS" TO "TRUE" DISPLAY "MF Load data" PERFORM LOADFILE. * Read file using MF rules OPEN INPUT FLATFILE. - DISPLAY "MF List Open Sts:" CUST-STAT + DISPLAY "MF Open Sts: " CUST-STAT PERFORM UNTIL CUST-STAT NOT = "00" PERFORM READ-RECORD END-PERFORM. CLOSE FLATFILE. - * Read file using GC rules - DISPLAY "LS_OPTIONS" UPON ENVIRONMENT-NAME - DISPLAY "format=gc" UPON ENVIRONMENT-VALUE + * Read file using Std rules + SET ENVIRONMENT "COB_LS_VALIDATE" TO "true" + SET ENVIRONMENT "COB_LS_NULLS" TO "false" OPEN INPUT FLATFILE. - DISPLAY "GC List Open Sts:" CUST-STAT + DISPLAY "Std Open Sts: " CUST-STAT PERFORM UNTIL CUST-STAT NOT = "00" PERFORM READ-RECORD END-PERFORM. CLOSE FLATFILE. - * Load file using GC rules - DISPLAY "GC Load data" - DISPLAY "LS_OPTIONS" UPON ENVIRONMENT-NAME - DISPLAY "format=gc" UPON ENVIRONMENT-VALUE + * Load file using Std rules + DISPLAY "Std Load data" PERFORM LOADFILE. STOP RUN RETURNING 0. - + READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. + * MOVE SPACES TO TSPFL-RECORD. READ FLATFILE IF CUST-STAT NOT = "00" DISPLAY "Read Status: " CUST-STAT @@ -25123,11 +25121,11 @@ AT_DATA([prog.cob], [ LOADFILE. OPEN OUTPUT FLATFILE. PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 + VARYING SUB FROM 1 BY 1 UNTIL SUB > MAX-SUB OR CUST-STAT NOT = "00". CLOSE FLATFILE. - + LOAD-RECORD. MOVE SPACES TO TSPFL-RECORD. MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. @@ -25136,9 +25134,9 @@ AT_DATA([prog.cob], [ MOVE 20070319 TO CM-PK-DATE. IF SUB = 1 OR 4 OR 6 MOVE -20070319 TO CM-PK-DATE. - + IF ODD-RECORD - MOVE "8417" TO CM-DISK + MOVE "8417" TO CM-DISK ELSE MOVE "8470" TO CM-DISK. WRITE TSPFL-RECORD. @@ -25151,15 +25149,15 @@ AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [MF Load data -MF List Open Sts:00 +MF Open Sts: 00 Read ALP00000 Trms:0010 Read BET00000 Trms:0013 Read GAM00000 Trms:0003 Read DEL00000 Trms:0254 Read Status: 10 -GC List Open Sts:00 +Std Open Sts: 00 Read Status: 09 -GC Load data +Std Load data Error status 71 writing record ALP00000 ], []) @@ -25167,7 +25165,7 @@ AT_CLEANUP AT_SETUP([Concatenated Files]) -AT_KEYWORDS([runfile Status]) +AT_KEYWORDS([runfile status]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -25183,9 +25181,7 @@ AT_DATA([prog.cob], [ DATA DIVISION. FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - + FD FLATFILE. 01 FLAT-RECORD. 10 FILE-NAME PICTURE X(8). 10 FLAT-MARK PICTURE X(6). @@ -25194,8 +25190,8 @@ AT_DATA([prog.cob], [ 10 FLAT-FILLER PICTURE X(2). WORKING-STORAGE SECTION. - 77 REC-NUM VALUE 0 PICTURE 9(2). - 77 MAX-REC VALUE 3 PICTURE 9(2). + 77 REC-NUM VALUE 0 BINARY-SHORT UNSIGNED. + 78 MAX-REC VALUE 3. 77 FLAT-STAT PICTURE X(2). 77 THE-FILE-NAME PICTURE X(48). @@ -25209,13 +25205,10 @@ AT_DATA([prog.cob], [ MOVE "file3" TO THE-FILE-NAME PERFORM LOADFILE. - DISPLAY "COB_SEQ_CONCAT_NAME" UPON ENVIRONMENT-NAME. - DISPLAY "TRUE" UPON ENVIRONMENT-VALUE. MOVE "file1+file2+file3" TO THE-FILE-NAME PERFORM UPDTFILE. - DISPLAY "COB_SEQ_CONCAT_SEP" UPON ENVIRONMENT-NAME. - DISPLAY "&" UPON ENVIRONMENT-VALUE. + SET ENVIRONMENT "COB_SEQ_CONCAT_SEP" TO "&" MOVE "file1&file2&file3" TO THE-FILE-NAME PERFORM LISTFILE. STOP RUN RETURNING 0. @@ -25236,7 +25229,7 @@ AT_DATA([prog.cob], [ DISPLAY "OPEN I-O: " THE-FILE-NAME " Sts:" FLAT-STAT END-IF. PERFORM VARYING REC-NUM FROM 1 BY 1 - UNTIL FLAT-STAT NOT = "00" + UNTIL FLAT-STAT NOT = "00" MOVE SPACES TO FLAT-RECORD READ FLATFILE IF REC-NUM = 5 @@ -25258,7 +25251,7 @@ AT_DATA([prog.cob], [ CLOSE FLATFILE. READ-RECORD. - MOVE SPACES TO FLAT-RECORD. + * MOVE SPACES TO FLAT-RECORD. READ FLATFILE IF FLAT-STAT NOT = "00" IF FLAT-STAT NOT = "10" @@ -25292,6 +25285,11 @@ AT_DATA([prog.cob], [ AT_CHECK([$COMPILE prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[OPEN I-O: file1+file2+file3 Sts:35 +OPEN INPUT: file1&file2&file3 Sts:35 +], []) + +AT_CHECK([COB_SEQ_CONCAT_NAME=true $COBCRUN_DIRECT ./prog], [0], [file1 Record 1 . file1 Record 2 . file1 Record 3 . @@ -26720,7 +26718,7 @@ AT_DATA([prog.cob], [ WORKING-STORAGE SECTION. 01 f-status PIC XX. - + PROCEDURE DIVISION. OPEN OUTPUT f WRITE f-rec FROM "a" diff --git a/tests/testsuite.src/syn_file.at b/tests/testsuite.src/syn_file.at index c1b24c960..625fff40d 100644 --- a/tests/testsuite.src/syn_file.at +++ b/tests/testsuite.src/syn_file.at @@ -1736,7 +1736,6 @@ prog.cob:25: warning: source is non-numeric - substituting zero AT_CLEANUP - AT_SETUP([WRITE / REWRITE on LINE SEQUENTIAL files]) AT_KEYWORDS([file]) AT_XFAIL_IF(true) @@ -1772,7 +1771,6 @@ AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], AT_CLEANUP - AT_SETUP([WRITE / REWRITE on REPORT files]) AT_KEYWORDS([file])