From: Robert Dubner <[email protected]>
Date: Wed, 23 Sep 2026 22:12:57 -0400
Subject: [PATCH] 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.
---
.../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(-)
create mode 100644
gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.cob
create mode 100644
gcc/testsuite/cobol.dg/group2/Passing_ADDRESS_OF_parameter.out
create mode 100644
gcc/testsuite/cobol.dg/group2/Repository_uber_alles.cob
create mode 100644
gcc/testsuite/cobol.dg/group2/Repository_uber_alles.out
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 00000000000..392bd67e22b
--- /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 00000000000..1550f3cc1f5
--- /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 00000000000..5660a462013
--- /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 00000000000..885fd66bd88
--- /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 9890c7dda88..7e48914c8e5 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,
--
2.34.1
