[gcc r17-2419] cobol: Correct tests against uninitialized access and other incorrect behavior.
"James K. Lowden via Gcc-cvs" <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:1be9a0f45e0ba43c44d80a60ea770e4eb330917f commit r17-2419-g1be9a0f45e0ba43c44d80a60ea770e4eb330917f Author: James K. Lowden <[email protected]> Date: Wed Jul 15 11:11:55 2026 -0400 cobol: Correct tests against uninitialized access and other incorrect behavior. Some tests wrote to an input parameter to NUL-terminate a filename. Some did not set RETURN-CODE to zero before returning. MF-specific tests are now also tested with the gcobc script to ensure compatibility. gcc/cobol/ChangeLog: * parse.y: Add debug messages during parameter validation. * symbols.h: (cbl_ffi_arg_t::capacity_ok): New function. libgcobol/ChangeLog: * compat/gnu/lib/CBL_CREATE_FILE.cbl: Do not write to input parameter. * compat/gnu/lib/CBL_OPEN_FILE.cbl: Same. gcc/testsuite/ChangeLog: * cobol.dg/group2/CBL_CREATE_FILE___CBL_WRITE_FILE___CBL_CLOSE_FILE.cob: Add gcobc. * cobol.dg/group2/CBL_DELETE_FILE.cob: Same. * cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob: Same. * cobol.dg/group2/CBL_OPEN_FILE___CBL_READ_FILE___CBL_CLOSE_FILE.cob: Same. * cobol.dg/group2/CBL_READ_FILE__check_file_size_with_flags___128.cob: Same. * cobol.dg/.gitignore: New test. Diff: --- gcc/cobol/parse.y | 11 +++++--- gcc/cobol/symbols.h | 6 +++++ gcc/testsuite/cobol.dg/.gitignore | 1 + ...EATE_FILE___CBL_WRITE_FILE___CBL_CLOSE_FILE.cob | 2 +- gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob | 1 + .../group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob | 4 +-- ..._OPEN_FILE___CBL_READ_FILE___CBL_CLOSE_FILE.cob | 2 +- ...READ_FILE__check_file_size_with_flags___128.cob | 2 ++ libgcobol/compat/gnu/lib/CBL_CREATE_FILE.cbl | 28 +++++++++++++++------ libgcobol/compat/gnu/lib/CBL_OPEN_FILE.cbl | 29 +++++++++++++++++++--- 10 files changed, 68 insertions(+), 18 deletions(-) diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 8213520980a0..60fa04603731 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -12745,7 +12745,7 @@ cbl_ffi_arg_t::matches( const cbl_ffi_arg_t& that ) const { case by_reference_e: if( crv == by_reference_e ) { if( (formal->attr & mask) == (actual->attr & mask) ) { - if( formal->data.capacity() == actual->data.capacity() ) { + if( capacity_ok(formal, actual) ) { if( formal->type == actual->type ) { // captures USAGE except COMP-X return true; } @@ -12754,13 +12754,17 @@ cbl_ffi_arg_t::matches( const cbl_ffi_arg_t& that ) const { return true; } } - // If actual is by reference, so must the formal be. + // If actual is by reference, so must the formal be. + dbgmsg("%s:%d: failed, reference feature mismatch", __func__, __LINE__); return false; break; case by_content_e: break; case by_value_e: - if( crv != by_value_e ) return false; + if( crv != by_value_e ) { + dbgmsg("%s:%d: failed, actual %s not by value", __func__, __LINE__, actual->name); + return false; + } if( formal->type == FldPointer && that.refer.is_pointer() ) return true; break; } @@ -12777,6 +12781,7 @@ cbl_ffi_arg_t::matches( const cbl_ffi_arg_t& that ) const { return actual->data.capacity() == formal->data.capacity() && actual->codeset.encoding == formal->codeset.encoding; } + dbgmsg("%s:%d: failed, for some reason", __func__, __LINE__); return false; } diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 408a8a5f1043..3bb84a11d354 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -1411,6 +1411,12 @@ protected: if( crv == by_reference_e ) return false; return refer.field != NULL; } + static bool capacity_ok( const cbl_field_t *formal, const cbl_field_t *actual ) { + if( formal->data.capacity() == actual->data.capacity() ) return true; + if( formal->data.capacity() == 1 && formal->has_attr(any_length_e) ) return true; + if( actual->data.capacity() == 1 && actual->has_attr(any_length_e) ) return true; + return false; + } }; // In support of serial/linear search: diff --git a/gcc/testsuite/cobol.dg/.gitignore b/gcc/testsuite/cobol.dg/.gitignore new file mode 100644 index 000000000000..93e59d108ce4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/.gitignore @@ -0,0 +1 @@ +*.txt0 diff --git a/gcc/testsuite/cobol.dg/group2/CBL_CREATE_FILE___CBL_WRITE_FILE___CBL_CLOSE_FILE.cob b/gcc/testsuite/cobol.dg/group2/CBL_CREATE_FILE___CBL_WRITE_FILE___CBL_CLOSE_FILE.cob index 0154889ebd03..55d6582f75ce 100644 --- a/gcc/testsuite/cobol.dg/group2/CBL_CREATE_FILE___CBL_WRITE_FILE___CBL_CLOSE_FILE.cob +++ b/gcc/testsuite/cobol.dg/group2/CBL_CREATE_FILE___CBL_WRITE_FILE___CBL_CLOSE_FILE.cob @@ -1,5 +1,5 @@ *> { dg-do run } - *> { dg-options "-dialect mf" } + *> { dg-options "-dialect mf -fcobol-exceptions EC-ALL" } identification division. program-id. test_cbl_write_file. diff --git a/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob b/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob index 66febc97d6a5..a9096a06177f 100644 --- a/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob +++ b/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob @@ -21,6 +21,7 @@ perform create-file. perform delete-file. perform delete-invalid-file. + move zero to return-code. goback. create-file section. diff --git a/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob b/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob index dbf8b650dd40..68cb44e55146 100644 --- a/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob +++ b/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob @@ -41,13 +41,13 @@ open-ro. move 1 to access-mode. display "Opening /dev/null as read-only" - call "CBL_OPEN_FILE" using "/dev/null" + call "CBL_OPEN_FILE" using Z"/dev/null" access-mode deny-mode device file-handle if return-code <> 0 - display "Failed to open " FILE_NAME " with " return-code + display "Failed to open " Z"/dev/null" " with " return-code else call "CBL_CLOSE_FILE" using file-handle end-if. diff --git a/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_READ_FILE___CBL_CLOSE_FILE.cob b/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_READ_FILE___CBL_CLOSE_FILE.cob index 75b53a188608..e1b5cf6bf758 100644 --- a/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_READ_FILE___CBL_CLOSE_FILE.cob +++ b/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_READ_FILE___CBL_CLOSE_FILE.cob @@ -35,7 +35,7 @@ *> Deny both read and write. move 0 to deny-mode. display "Opening /dev/zero as read-only". - call "CBL_OPEN_FILE" using "/dev/zero" + call "CBL_OPEN_FILE" using Z"/dev/zero" access-mode deny-mode device diff --git a/gcc/testsuite/cobol.dg/group2/CBL_READ_FILE__check_file_size_with_flags___128.cob b/gcc/testsuite/cobol.dg/group2/CBL_READ_FILE__check_file_size_with_flags___128.cob index 7772897ab40b..53763c624adf 100644 --- a/gcc/testsuite/cobol.dg/group2/CBL_READ_FILE__check_file_size_with_flags___128.cob +++ b/gcc/testsuite/cobol.dg/group2/CBL_READ_FILE__check_file_size_with_flags___128.cob @@ -29,6 +29,7 @@ procedure division. perform write-file. perform check-file-size. + move zero to return-code. goback. write-file section. @@ -77,6 +78,7 @@ file-handle. if return-code <> 0 + display "Failed to open file " filename display "CBL_OPEN_FILE failed with " return-code goback end-if. diff --git a/libgcobol/compat/gnu/lib/CBL_CREATE_FILE.cbl b/libgcobol/compat/gnu/lib/CBL_CREATE_FILE.cbl index 911bde060fa4..c1d6c5ebb378 100644 --- a/libgcobol/compat/gnu/lib/CBL_CREATE_FILE.cbl +++ b/libgcobol/compat/gnu/lib/CBL_CREATE_FILE.cbl @@ -47,18 +47,20 @@ 77 func-ret Binary-Long. 77 errno-val Binary-Long. 77 lk-mode PIC 9(8) COMP-5. + 01 filename-max CONSTANT AS 8 * 1024. + 01 filename PIC X(filename-max). 77 filename-len PIC 9(4) BINARY VALUE ZERO. 01 ws-access-mode PIC 9(8) COMP-5. LINKAGE SECTION. 77 RETCODE PIC X(2) COMP-5. - 01 filename PIC X ANY LENGTH. + 01 Lk-filename PIC X ANY LENGTH. 01 access-mode PIC x COMP-x. 01 deny-mode PIC x comp-x. *> Not supported (must be 0). 01 device PIC x comp-x. *> Not supported (must be 0). 01 file-handle PIC X(4) COMP-5. - PROCEDURE DIVISION USING filename, + PROCEDURE DIVISION USING Lk-filename, By Reference access-mode, By Reference deny-mode, By Reference device, @@ -72,8 +74,7 @@ END-IF. COMPUTE filename-len = - FUNCTION LENGTH(FUNCTION TRIM(filename)). - MOVE X"00" TO filename(filename-len + 1:1). + FUNCTION LENGTH(FUNCTION TRIM(Lk-filename)). D Display 'CBL_CREATE_FILE: filename: [' filename ']' D Display 'ws-access-mode: ' ws-access-mode ', ' D Display 'deny-mode: ' deny-mode. @@ -94,18 +95,31 @@ Compute ws-access-mode = ws-access-mode + O_CREAT + O_TRUNC. Compute Lk-mode = S_IRUSR + S_IWUSR + S_IRGRP + S_IWGRP. - MOVE FUNCTION posix-open(filename, ws-access-mode, lk-mode) - TO func-ret. + IF Lk-filename(filename-len:1) = ZERO + MOVE FUNCTION posix-open(Lk-filename, + ws-access-mode, lk-mode) + TO func-ret + ELSE + IF filename-max < filename-len + 1 + MOVE 30 to RETCODE + GOBACK + END-IF + MOVE Lk-filename to filename + MOVE ZERO TO filename(filename-len + 1:1) + MOVE FUNCTION posix-open(filename, ws-access-mode, lk-mode) + TO func-ret + END-IF If func-ret is < 0 Then Move Function COBRT-FILE-STATUS() to RETCODE D Display 'COBRT-FILE-STATUS returned: ' RETCODE + D ' for errno ' func-ret else Move func-ret to file-handle Move 0 to RETCODE end-if. - + END PROGRAM CBL_CREATE_FILE. >> POP SOURCE FORMAT diff --git a/libgcobol/compat/gnu/lib/CBL_OPEN_FILE.cbl b/libgcobol/compat/gnu/lib/CBL_OPEN_FILE.cbl index 0cc616453ae1..2c9a83085075 100644 --- a/libgcobol/compat/gnu/lib/CBL_OPEN_FILE.cbl +++ b/libgcobol/compat/gnu/lib/CBL_OPEN_FILE.cbl @@ -48,18 +48,21 @@ WORKING-STORAGE SECTION. 77 errno-val Binary-Long. 01 ws-access-mode PIC 9(8) comp-5. + 01 filename-max CONSTANT AS 8 * 1024. + 01 filename PIC X(filename-max). + 77 filename-len PIC 9(4) BINARY VALUE ZERO. LINKAGE SECTION. 01 RETCODE PIC X(2) COMP-5 VALUE 0. 01 REDEFINES RETCODE. 03 MSB PIC X. 03 LSB BINARY-CHAR. - 01 filename PIC X ANY LENGTH. + 01 Lk-filename PIC X ANY LENGTH. 01 access-mode PIC X COMP-X. 01 deny-mode PIC X COMP-X. *> Not supported (must be 0). 01 device PIC X COMP-X. *> Not supported (must be 0). 01 file-handle PIC X(4) COMP-5. - PROCEDURE DIVISION USING filename, + PROCEDURE DIVISION USING Lk-filename, By Reference access-mode, By Reference deny-mode, By Reference device, @@ -88,8 +91,26 @@ GOBACK END-EVALUATE. - MOVE FUNCTION posix-open(filename, ws-access-mode, deny-mode) - TO errno-val. + COMPUTE filename-len = + FUNCTION LENGTH(FUNCTION TRIM(Lk-filename)). + + * If Lk-filename ends in NUL, use it ... + IF Lk-filename(filename-len:1) = ZERO + MOVE FUNCTION posix-open(Lk-filename, + ws-access-mode, deny-mode) + TO errno-val + * ... else make a copy and terminate it with a NUL, unless it's too long. + ELSE + IF filename-max < filename-len + 1 + MOVE 30 to RETCODE + GOBACK + END-IF + MOVE Lk-filename to filename + MOVE ZERO TO filename(filename-len + 1:1) + MOVE FUNCTION posix-open(filename, + ws-access-mode, deny-mode) + TO errno-val + END-IF. D Display 'CBL_OPEN_FILE: RETCODE: ' RETCODE. If errno-val is < 0 then