https://gcc.gnu.org/g:2000ac7817b353ea920948ae74f9308dd28c4389
commit r17-4616-g2000ac7817b353ea920948ae74f9308dd28c4389 Author: Robert Dubner <[email protected]> Date: Wed Sep 23 22:12:57 2026 -0400 cobol: Cache COBPATH directories for doing .so file searches. libgcobol/ChangeLog: * libgcobol.cc (find_in_dirs): Use the cached array. (function_handle_from_cobpath): Create the cached array. gcc/testsuite/ChangeLog: * cobol.dg/group2/Passing_ADDRESS_OF_parameter.cob: New test. * cobol.dg/group2/Passing_ADDRESS_OF_parameter.out: New test. * cobol.dg/group2/Repository_uber_alles.cob: New test. * cobol.dg/group2/Repository_uber_alles.out: New test. Diff: --- .../group2/Passing_ADDRESS_OF_parameter.cob | 42 +++++ .../group2/Passing_ADDRESS_OF_parameter.out | 3 + .../cobol.dg/group2/Repository_uber_alles.cob | 121 ++++++++++++++ .../cobol.dg/group2/Repository_uber_alles.out | 2 + libgcobol/libgcobol.cc | 184 +++++++++++---------- 5 files changed, 263 insertions(+), 89 deletions(-) diff --git a/gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.cob b/gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.cob new file mode 100644 index 000000000000..392bd67e22ba --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.cob @@ -0,0 +1,42 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-output-file "group2/Passing_ADDRESS_OF_parameter.out" } + identification division. + function-id. func. + data division. + working-storage section. + 01 foo pic 9999 based. + linkage section. + 01 pfoo pointer. + 01 zed pic 999 value zero. + procedure division using by value pfoo returning zed. + set address of foo to pfoo + display "foo in func " foo " should be ""1234""" + goback. + end function func. + + identification division. + program-id. prog. + data division. + working-storage section. + 01 foo pic 9999 value 1234. + 01 zed pic 999. + procedure division. + move function func(address of foo) to zed + call "prog2" using address of foo. + goback. + end program prog. + + identification division. + program-id. prog2. + data division. + working-storage section. + 01 foo pic 9999 based. + linkage section. + 01 pfoo pointer. + procedure division using by value pfoo. + set address of foo to pfoo + display "foo in prog2 " foo " should be ""1234""" + goback. + end program prog2. + diff --git a/gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.out b/gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.out new file mode 100644 index 000000000000..1550f3cc1f5d --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.out @@ -0,0 +1,3 @@ +foo in func 1234 should be "1234" +foo in prog2 1234 should be "1234" + diff --git a/gcc/testsuite/cobol.dg/group2/Repository_uber_alles.cob b/gcc/testsuite/cobol.dg/group2/Repository_uber_alles.cob new file mode 100644 index 000000000000..5660a462013a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Repository_uber_alles.cob @@ -0,0 +1,121 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-output-file "group2/Repository_uber_alles.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. a. + OBJECT-COMPUTER. a. + REPOSITORY. Function + ABS, + ACOS, + ANNUITY, + ASIN, + ATAN, + BASECONVERT, + BIT-OF, + BIT-TO-CHAR, + BOOLEAN-OF-INTEGER, + BYTE-LENGTH, + CHAR, + CHAR-NATIONAL, + COMBINED-DATETIME, + CONCAT, + CONVERT, + COS, + CURRENT-DATE, + DATE-OF-INTEGER, + DATE-TO-YYYYMMDD, + DAY-OF-INTEGER, + DAY-TO-YYYYDDD, + DISPLAY-OF, + E, + EXCEPTION-FILE, + EXCEPTION-FILE-N, + EXCEPTION-LOCATION, + EXCEPTION-LOCATION-N, + EXCEPTION-STATEMENT, + EXCEPTION-STATUS, + EXP, + EXP10, + FACTORIAL, + FIND-STRING, + FORMATTED-CURRENT-DATE, + FORMATTED-DATE, + FORMATTED-DATETIME, + FORMATTED-TIME, + FRACTION-PART, + HEX-OF, + HEX-TO-CHAR, + HIGHEST-ALGEBRAIC, + INTEGER, + INTEGER-OF-BOOLEAN, + INTEGER-OF-DATE, + INTEGER-OF-DAY, + INTEGER-OF-FORMATTED-DATE, + INTEGER-PART, + LENGTH, + LOCALE-COMPARE, + LOCALE-DATE, + LOCALE-TIME, + LOCALE-TIME-FROM-SECONDS, + LOG, + LOG10, + LOWER-CASE, + LOWEST-ALGEBRAIC, + MAXX, + MEAN, + MEDIAN, + MIDRANGE, + MINN, + MOD, + MODULE-NAME, + NATIONAL-OF, + NUMVAL, + NUMVAL-C, + NUMVAL-F, + ORD, + ORD-MAX, + ORD-MIN, + PI, + PRESENT-VALUE, + RANDOM, + RANGE, + REM, + REVERSE, + SECONDS-FROM-FORMATTED-TIME, + SECONDS-PAST-MIDNIGHT, + SIGN, + SIN, + SMALLEST-ALGEBRAIC, + SQRT, + STANDARD-COMPARE, + STANDARD-DEVIATION, + SUBSTITUTE, + SUM, + TAN, + TEST-DATE-YYYYMMDD, + TEST-DAY-YYYYDDD, + TEST-FORMATTED-DATETIME, + TEST-NUMVAL, + TEST-NUMVAL-C, + TEST-NUMVAL-F, + TRIM, + ULENGTH, + UPOS, + UPPER-CASE, + USUBSTR, + USUPPLEMENTARY, + UUID4, + UVALID, + UWIDTH, + VARIANCE, + WHEN-COMPILED, + YEAR-TO-YYYY, + intrinsic + . + PROCEDURE DIVISION. + DISPLAY "OK". + diff --git a/gcc/testsuite/cobol.dg/group2/Repository_uber_alles.out b/gcc/testsuite/cobol.dg/group2/Repository_uber_alles.out new file mode 100644 index 000000000000..885fd66bd887 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Repository_uber_alles.out @@ -0,0 +1,2 @@ +OK + diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index 9890c7dda88e..7e48914c8e52 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -10923,7 +10923,7 @@ do_the_dl_thing(const char *directory, static void * -find_in_dirs( const char *dirs, +find_in_dirs( const std::vector<std::string> &directories, const std::string &fileUPPER, const std::string &fileMiddle, const std::string &filelower, @@ -10936,28 +10936,32 @@ find_in_dirs( const char *dirs, assert( !unmangled_name.empty() ); void *retval = NULL; - if( dirs ) + for( auto it= directories.begin(); it!=directories.end(); it++) { - std::string directory; - const char *p = dirs; - while( !retval && *p ) + std::string directory = *it; + + retval = do_the_dl_thing(directory.c_str(), + fileUPPER, + unmangled_name); + if( retval ) { - directory.clear(); - while( *p && *p != ':' ) - { - directory += *p++; - } - if( *p == ':' ) - { - p += 1; - } - if( directory.empty() ) + goto bugout; + } + if( !mangled_name.empty() ) + { + retval = do_the_dl_thing(directory.c_str(), + fileUPPER, + mangled_name); + if( retval ) { - break; + goto bugout; } + } + if( !fileMiddle.empty() ) + { retval = do_the_dl_thing(directory.c_str(), - fileUPPER, + fileMiddle, unmangled_name); if( retval ) { @@ -10966,60 +10970,59 @@ find_in_dirs( const char *dirs, if( !mangled_name.empty() ) { retval = do_the_dl_thing(directory.c_str(), - fileUPPER, + fileMiddle, mangled_name); if( retval ) { goto bugout; } } - - if( !fileMiddle.empty() ) + } + if( !filelower.empty() ) + { + retval = do_the_dl_thing(directory.c_str(), + filelower, + unmangled_name); + if( retval ) { - retval = do_the_dl_thing(directory.c_str(), - fileMiddle, - unmangled_name); - if( retval ) - { - goto bugout; - } - if( !mangled_name.empty() ) - { - retval = do_the_dl_thing(directory.c_str(), - fileMiddle, - mangled_name); - if( retval ) - { - goto bugout; - } - } + goto bugout; } - if( !filelower.empty() ) + if( !mangled_name.empty() ) { retval = do_the_dl_thing(directory.c_str(), filelower, - unmangled_name); + mangled_name); if( retval ) { goto bugout; } - if( !mangled_name.empty() ) - { - retval = do_the_dl_thing(directory.c_str(), - filelower, - mangled_name); - if( retval ) - { - goto bugout; - } - } } } } - else + + retval = do_the_dl_thing(nullptr, + fileUPPER, + unmangled_name); + if( retval ) + { + goto bugout; + } + + if( !mangled_name.empty() ) { retval = do_the_dl_thing(nullptr, fileUPPER, + mangled_name); + if( retval ) + { + goto bugout; + } + } + + if( !fileMiddle.empty() ) + { + retval = do_the_dl_thing(nullptr, + fileMiddle, unmangled_name); if( retval ) { @@ -11028,52 +11031,32 @@ find_in_dirs( const char *dirs, if( !mangled_name.empty() ) { retval = do_the_dl_thing(nullptr, - fileUPPER, + fileMiddle, mangled_name); if( retval ) { goto bugout; } } - if( !fileMiddle.empty() ) + } + if( !filelower.empty() ) + { + retval = do_the_dl_thing(nullptr, + filelower, + unmangled_name); + if( retval ) { - retval = do_the_dl_thing(nullptr, - fileMiddle, - unmangled_name); - if( retval ) - { - goto bugout; - } - if( !mangled_name.empty() ) - { - retval = do_the_dl_thing(nullptr, - fileMiddle, - mangled_name); - if( retval ) - { - goto bugout; - } - } + goto bugout; } - if( !filelower.empty() ) + if( !mangled_name.empty() ) { retval = do_the_dl_thing(nullptr, filelower, - unmangled_name); + mangled_name); if( retval ) { goto bugout; } - if( !mangled_name.empty() ) - { - retval = do_the_dl_thing(nullptr, - filelower, - mangled_name); - if( retval ) - { - goto bugout; - } - } } } bugout: @@ -11091,7 +11074,7 @@ function_handle_from_cobpath( const char *unmangled_name_, We first look for FooBar in the function. We then look for foobar in the function. We then scan the directories in COBPATH. In each directory, we look for - the function name in + the function name in FOOBAR.so FooBar.so foobar.so @@ -11110,7 +11093,7 @@ function_handle_from_cobpath( const char *unmangled_name_, unmangled_name = mangled_name; mangled_name.clear(); } - else + else { // This is Verbatim, C-style. mangled_name.clear(); @@ -11119,7 +11102,6 @@ function_handle_from_cobpath( const char *unmangled_name_, std::string fileUPPER; std::string fileMiddle; std::string filelower; - const char *COBPATH; static std::unordered_map<std::string, void *> already_searched; std::unordered_map<std::string, void *>::const_iterator it = @@ -11192,12 +11174,36 @@ function_handle_from_cobpath( const char *unmangled_name_, } // We need to search through the COBPATH directories: - - COBPATH = getenv("COBPATH"); - if( COBPATH ) + static bool initialized = false; + static std::vector<std::string> directories; + static std::vector<std::string> dummy; + if( !initialized ) { + initialized = true; + const char *COBPATH = getenv("COBPATH"); + const char *p = COBPATH; + while( p && *p ) + { + std::string directory; + while( *p && *p != ':' ) + { + directory += *p++; + } + if( *p == ':' ) + { + p += 1; + } + if( directory.empty() ) + { + break; + } + directories.push_back(directory); + } + } - retval = find_in_dirs(COBPATH, + if( !directories.empty() ) + { + retval = find_in_dirs(directories, fileUPPER, fileMiddle, filelower, @@ -11208,7 +11214,7 @@ function_handle_from_cobpath( const char *unmangled_name_, goto bugout; } } - retval = find_in_dirs(nullptr, + retval = find_in_dirs(dummy, fileUPPER, fileMiddle, filelower,
