From: Robert Dubner <[email protected]>
Date: Fri, 18 Sep 2026 16:36:02 -0400
Subject: [PATCH] cobol: Change policy for finding .so files. [PR127412]
This patch partially addresses PR127412 by changing "cp1140" to
"ibm1140" in the DejaGNU tests. "ibm1140", unlike "cp1140", is
recognized not just on glibc systems, but FreeBSD and NetBSD systems as
well. Some necessary changes to charmaps.cc have not yet been made.
The main purpose of this patch is to modify the policy used to search
for shared-object .so files that contain a desired symbol.
gcc/cobol/ChangeLog:
* gcobol.1: Documentation for the .so search.
* move.cc: Fix typo.
* parse.y: Data capacity test.
* symbols.cc (expand_picture): Fix off-by-one error; handle corner
case where 'B' is the final character of a numeric-edited PICTURE
string.
* symbols.h: Remove unnecessary test.
libgcobol/ChangeLog:
* libgcobol.cc (do_the_dl_thing): New .so policy.
(find_in_dirs): Likewise.
(__gg__function_handle_from_cobpath): Likewise.
gcc/testsuite/ChangeLog:
PR cobol/127412
* cobol.dg/group2/CBL_DELETE_FILE.cob: Minor logic change.
* cobol.dg/group2/CBL_DELETE_FILE.out: Likewise.
* cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob: Likewise.
* cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.out: Likewise.
*
cobol.dg/group2/CBL_READ_FILE__check_file_size_with_flags___128.cob:
Likewise.
* cobol.dg/group2/CDF_Feature_.cob: Switch to "ibm1140".
*
cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob:
Likewise.
* cobol.dg/group2/FIND-STRING__forward_.cob: Likewise.
* cobol.dg/group2/FIND-STRING__reverse_.cob: Likewise.
* cobol.dg/group2/FUNCTION_CONVERT.cob: Likewise.
* cobol.dg/group2/CBL_CHECK_FILE_EXIST__known_timestamp_.cob: New
test.
* cobol.dg/group2/MF__identifier_as_PIC_X_ANY_LENGTH.cob: New
test.
---
gcc/cobol/gcobol.1 | 31 ++---
gcc/cobol/move.cc | 2 +-
gcc/cobol/parse.y | 29 +++--
gcc/cobol/symbols.cc | 25 ++--
gcc/cobol/symbols.h | 6 -
...CBL_CHECK_FILE_EXIST__known_timestamp_.cob | 45 +++++++
.../cobol.dg/group2/CBL_DELETE_FILE.cob | 8 +-
.../cobol.dg/group2/CBL_DELETE_FILE.out | 2 +-
.../group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.cob | 8 +-
.../group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.out | 4 +-
...FILE__check_file_size_with_flags___128.cob | 2 +-
.../cobol.dg/group2/CDF_Feature_.cob | 2 +-
...d_ORD_with_COLLATING_sequence_-_EBCDIC.cob | 2 +-
.../cobol.dg/group2/FIND-STRING__forward_.cob | 2 +-
.../cobol.dg/group2/FIND-STRING__reverse_.cob | 2 +-
.../cobol.dg/group2/FUNCTION_CONVERT.cob | 2 +-
.../MF__identifier_as_PIC_X_ANY_LENGTH.cob | 30 +++++
libgcobol/libgcobol.cc | 118 +++++++++++-------
18 files changed, 216 insertions(+), 104 deletions(-)
create mode 100644
gcc/testsuite/cobol.dg/group2/CBL_CHECK_FILE_EXIST__known_timestamp_.cob
create mode 100644
gcc/testsuite/cobol.dg/group2/MF__identifier_as_PIC_X_ANY_LENGTH.cob
diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1
index 21438c0568b..cdcb7146810 100644
--- a/gcc/cobol/gcobol.1
+++ b/gcc/cobol/gcobol.1
@@ -1954,22 +1954,22 @@ precisely match the behavior of other \*[lang]
compilers.
You have been warned.
.
.Sh ENVIRONMENT
-.Bl -tag -width COBPATH
-.It Ev COBPATH
+.Bl -tag -width GCOBOL_LIBRARY_PATH
+.It Ev GCOBOL_LIBRARY_PATH
If defined, specifies the directory paths to be used by the
.Nm
runtime library,
.Pa libgcobol.so ,
-to locate shared objects.
+to locate entry points in shared objects.
Like
.Ev LD_LIBRARY_PATH ,
it may contain several directory names separated by a colon
.Pq Ql \&: .
-.Ev COBPATH
+.Ev GCOBOL_LIBRARY_PATH
is searched first, followed by
.Ev LD_LIBRARY_PATH .
Note that
-.Ev COBPATH does not change where the runtime linker looks for
+.Ev GCOBOL_LIBRARY_PATH does not change where the runtime linker looks
for
.Pa libgcobol.so
itself.
How the runtime linker searches for
@@ -1978,16 +1978,19 @@ when the executable loads is controlled by
.Xr ld.so 8 ,
not libgcobol.
.Pp
-Each directory is searched for files whose name ends in
-.Ql ".so" .
-For each such file,
+Each directory is searched for a file whose name is based on the desired
+symbol. The literal name, with
+.Ql ".so"
+appended, is tried first. For each such file,
.Xr dlopen 3
-is attempted, and, if successful
-.Xr dlsym 3 .
-No relationship is defined between the symbol's name and the filename.
-.Pp
-Without
-.Ev COBPATH ,
+is attempted, and if successful,
+.Xr dlsym 3 is used to search for the
+symbol. If either fails, a second attempt is made after converting
+the desired symbol to lowercase.
+.Pp
+When
+.Ev GCOBOL_LIBRARY_PATH and
+.Ev LD_LIBRARY_PATH are not explicitly used,
binaries produced by
.Nm
behave as one might expect of any program compiled with gcc. Any
diff --git a/gcc/cobol/move.cc b/gcc/cobol/move.cc
index 44df3e4f240..685fee28705 100644
--- a/gcc/cobol/move.cc
+++ b/gcc/cobol/move.cc
@@ -15,7 +15,7 @@
* contributors may be used to endorse or promote products derived from
* this software without specific prior written permission.
*
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORSdf
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 9b07e9c46c8..3bbf60e17e7 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -12986,7 +12986,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( capacity_ok(formal, actual) ) {
+ if( formal->data.capacity() == actual->data.capacity() ) {
if( formal->type == actual->type ) { // captures USAGE except
COMP-X
return true;
}
@@ -12995,17 +12995,13 @@ cbl_ffi_arg_t::matches( const cbl_ffi_arg_t&
that ) const {
return true;
}
}
- // If actual is by reference, so must the formal be.
- dbgmsg("%s:%d: failed, reference feature mismatch", __func__,
__LINE__);
+ // If actual is by reference, so must the formal be.
return false;
break;
case by_content_e:
break;
case by_value_e:
- if( crv != by_value_e ) {
- dbgmsg("%s:%d: failed, actual %s not by value", __func__, __LINE__,
actual->name);
- return false;
- }
+ if( crv != by_value_e ) return false;
if( formal->type == FldPointer && that.refer.is_pointer() ) return
true;
break;
}
@@ -13022,7 +13018,6 @@ 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;
}
@@ -13071,6 +13066,24 @@ bad_arg( const char name[],
return ok;
}
+static const char *
+passby_str(int mask)
+{
+ switch( mask ) {
+ case by_default_e:
+ case by_reference_e:
+ return "BY REFERENCE";
+ case by_content_e:
+ return "BY CONTENT";
+ case by_value_e:
+ return "BY VALUE";
+ default:
+ break;
+ }
+
+ return "UNKNOWN PASSING METHOD";
+}
+
// Verify provided actual parameters against formals.
static void
verify_args( const YYLTYPE& loc,
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 5f6752ef746..6d96ba311b6 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -4807,7 +4807,7 @@ expand_picture(const char *picture)
long repeat;
int currency_symbol = NULLCH;
- while( (ch = (*p++ & 0xFF) ) )
+ while( (ch = ((*p++) & 0xFF) ) )
{
if( ch == ascii_oparen )
{
@@ -4863,7 +4863,7 @@ expand_picture(const char *picture)
dest_length += sign_length;
}
}
- retval[dest_length++] = NULLCH;
+ retval[dest_length] = NULLCH;
// To ease the workload on interpreting the PICTURE string at run time,
we
// are going to convert everything we can to upper case. We also
convert
@@ -4875,11 +4875,9 @@ expand_picture(const char *picture)
switch(retval[i])
{
case ascii_a:
- case ascii_c:
case ascii_e:
case ascii_n:
case ascii_p:
- case ascii_r:
case ascii_s:
case ascii_x:
case ascii_z:
@@ -4897,13 +4895,18 @@ expand_picture(const char *picture)
case ascii_B:
case ascii_b:
- if( i < dest_length-1 )
- {
- retval[i] = TOUPPER(retval[i]);
- }
-
-
-
+ if( i < dest_length-1 )
+ {
+ retval[i] = ascii_B;
+ }
+ else
+ {
+ if( i>=1 && retval[i-1] != ascii_D && retval[i-1] != ascii_d )
+ {
+ retval[i] = ascii_B;
+ }
+ }
+ break;
}
}
return retval;
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 6c6142ed1a9..3887b275b7b 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -1444,12 +1444,6 @@ 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/group2/CBL_CHECK_FILE_EXIST__known_timestamp_.cob
b/gcc/testsuite/cobol.dg/group2/CBL_CHECK_FILE_EXIST__known_timestamp_.cob
new file mode 100644
index 00000000000..849c3e4f7d2
--- /dev/null
+++
b/gcc/testsuite/cobol.dg/group2/CBL_CHECK_FILE_EXIST__known_timestamp_.cob
@@ -0,0 +1,45 @@
+ *> Do not edit this generated file. See README.txt
+ *> { dg-do run }
+ *> { dg-options "-dialect mf" }
+
+ copy "cblproto.cpy".
+ identification division.
+ program-id. prog.
+ data division.
+ working-storage section.
+ copy "cbltypes.cpy".
+ 77 filename pic x(5) value "file".
+ 01 buf type cblt-fileexist-buf.
+ 01 year constant 2026.
+ 01 month constant 9.
+ 01 cday constant 16.
+ 01 hours constant 15.
+ 01 minutes constant 18.
+ 01 seconds constant 0.
+ 01 status-code pic x(2) comp-5.
+ 01 status-bits redefines status-code.
+ 03 msb pic x.
+ 03 lsb pic x comp-x.
+ procedure division.
+ call "CBL_CHECK_FILE_EXIST" using filename buf
+ returning status-code.
+ if status-code <> 0
+ display "CBL_CHECK_FILE_EXIST failed with "
+ "[" msb ", " lsb "]"
+ else if cblte-fe-year <> year
+ display "expected year " year ", got " cblte-fe-year
+ else if cblte-fe-month <> month
+ display "expected month " month ", got " cblte-fe-month
+ else if cblte-fe-day <> cday
+ display "expected day " cday ", got " cblte-fe-day
+ else if cblte-fe-hours <> hours
+ display "expected hours " hours ", got " cblte-fe-hours
+ else if cblte-fe-minutes <> minutes
+ display "expected minutes " minutes
+ ", got " cblte-fe-minutes
+ else if cblte-fe-seconds <> seconds
+ display "expected seconds " seconds
+ ", got " cblte-fe-seconds
+ end-if.
+ end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob
b/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob
index d924a4c9030..499d9d836fa 100644
--- a/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob
+++ b/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob
@@ -6,8 +6,8 @@
identification division.
program-id. test_delete_file.
data division.
- >>define filename as "/tmp/test_delete_file.cbl.txt"
- >>define invalid-path as "/tmp/thisfileshouldnotexist.txt"
+ >>define filename as "test_delete_file.cbl.txt"
+ >>define invalid-path as "thisfileshouldnotexist.txt"
working-storage section.
01 file-status pic x(2) comp-5.
01 fs redefines file-status.
@@ -47,10 +47,10 @@
exit paragraph.
delete-file section.
- call "CBL_DELETE_FILE" using filename.
+ call "CBL_DELETE_FILE" using filename returning file-status.
if file-status <> 0
- display "CBL_DELETE_FILE failed with " return-code
+ display "CBL_DELETE_FILE failed with " file-status
end-if.
exit paragraph.
diff --git a/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.out
b/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.out
index 55a5fe10c98..314d1d184ea 100644
--- a/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.out
+++ b/gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.out
@@ -1,4 +1,4 @@
-Expected failure when deleting /tmp/thisfileshouldnotexist.txt
+Expected failure when deleting thisfileshouldnotexist.txt
File status MSB: 9
File status LSB: 013
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 0c0a43cb051..0f7ec298389 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
@@ -15,7 +15,7 @@
.
object-computer. Posix.
- >>define FILE_NAME as "/tmp/thisfileshouldneverexist.txt"
+ >>define FILE_NAME as "thisfileshouldneverexist.txt"
data division.
working-storage section.
@@ -65,9 +65,9 @@
access-mode
deny-mode
device
- file-handle
- returning file-status.
- if file-status <> 0
+ file-handle.
+ if return-code <> 0
+ move return-code to file-status
display "Expected failure when opening " FILE_NAME
display "File status MSB: " msb
display "File status LSB: " lsb
diff --git
a/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.out
b/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.out
index 67a56adcfa5..bec7477035e 100644
--- a/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.out
+++ b/gcc/testsuite/cobol.dg/group2/CBL_OPEN_FILE___CBL_CLOSE_FILE.out
@@ -1,6 +1,6 @@
Opening /dev/null as read-only
-Opening /tmp/thisfileshouldneverexist.txt as read-only
-Expected failure when opening /tmp/thisfileshouldneverexist.txt
+Opening thisfileshouldneverexist.txt as read-only
+Expected failure when opening thisfileshouldneverexist.txt
File status MSB: 9
File status LSB: 013
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 68e863f65cb..aac046ccde1 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
@@ -15,7 +15,7 @@
object-computer. Posix.
data division.
- >>define filename as "/tmp/test_file_size.cbl.txt"
+ >>define filename as "test_file_size.cbl.txt"
>>define buffer as "hi, this text is exactly 38 bytes long"
working-storage section.
01 file-handle pic x(4) comp-5.
diff --git a/gcc/testsuite/cobol.dg/group2/CDF_Feature_.cob
b/gcc/testsuite/cobol.dg/group2/CDF_Feature_.cob
index 9150dd5d721..fa701da6c52 100644
--- a/gcc/testsuite/cobol.dg/group2/CDF_Feature_.cob
+++ b/gcc/testsuite/cobol.dg/group2/CDF_Feature_.cob
@@ -1,6 +1,6 @@
*> Do not edit this generated file. See README.txt
*> { dg-do run }
- *> { dg-options "-fexec-charset=cp1140 -dialect ibm" }
+ *> { dg-options "-fexec-charset=ibm1140 -dialect ibm" }
*> { dg-output-file "group2/CDF_Feature_.out" }
id division.
diff --git
a/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBC
DIC.cob
b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBC
DIC.cob
index 346f393777c..0cde1ff859a 100644
---
a/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBC
DIC.cob
+++
b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBC
DIC.cob
@@ -1,6 +1,6 @@
*> Do not edit this generated file. See README.txt
*> { dg-do run }
- *> { dg-options "-fexec-charset=cp1140" }
+ *> { dg-options "-fexec-charset=ibm1140" }
*> { dg-output-file
"group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.out" }
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
diff --git a/gcc/testsuite/cobol.dg/group2/FIND-STRING__forward_.cob
b/gcc/testsuite/cobol.dg/group2/FIND-STRING__forward_.cob
index 1cc5ae59942..f007d709344 100644
--- a/gcc/testsuite/cobol.dg/group2/FIND-STRING__forward_.cob
+++ b/gcc/testsuite/cobol.dg/group2/FIND-STRING__forward_.cob
@@ -1,6 +1,6 @@
*> Do not edit this generated file. See README.txt
*> { dg-do run }
- *> { dg-options "-fexec-charset=cp1140" }
+ *> { dg-options "-fexec-charset=ibm1140" }
*> { dg-output-file "group2/FIND-STRING__forward_.out" }
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
diff --git a/gcc/testsuite/cobol.dg/group2/FIND-STRING__reverse_.cob
b/gcc/testsuite/cobol.dg/group2/FIND-STRING__reverse_.cob
index 831822cd1d2..e30011e2800 100644
--- a/gcc/testsuite/cobol.dg/group2/FIND-STRING__reverse_.cob
+++ b/gcc/testsuite/cobol.dg/group2/FIND-STRING__reverse_.cob
@@ -1,6 +1,6 @@
*> Do not edit this generated file. See README.txt
*> { dg-do run }
- *> { dg-options "-fexec-charset=cp1140" }
+ *> { dg-options "-fexec-charset=ibm1140" }
*> { dg-output-file "group2/FIND-STRING__reverse_.out" }
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CONVERT.cob
b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONVERT.cob
index 48c4c0bfd9b..7bad2fdaed5 100644
--- a/gcc/testsuite/cobol.dg/group2/FUNCTION_CONVERT.cob
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONVERT.cob
@@ -7,7 +7,7 @@
configuration section.
special-names.
locale sbc is "cp1252"
- locale ebcd is "cp1140".
+ locale ebcd is "ibm1140".
object-computer.
gnu-linux
classification
diff --git
a/gcc/testsuite/cobol.dg/group2/MF__identifier_as_PIC_X_ANY_LENGTH.cob
b/gcc/testsuite/cobol.dg/group2/MF__identifier_as_PIC_X_ANY_LENGTH.cob
new file mode 100644
index 00000000000..e5ca6e66c55
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MF__identifier_as_PIC_X_ANY_LENGTH.cob
@@ -0,0 +1,30 @@
+ *> Do not edit this generated file. See README.txt
+ *> { dg-do run }
+ *> { dg-options "-dialect mf" }
+[
+ identification division.
+ program-id. foo prototype.
+ data division.
+ linkage section.
+ 01 buf pic x any length.
+ procedure division using buf.
+ end program foo.
+
+ identification division.
+ program-id. prog.
+ data division.
+ working-storage section.
+ 77 buf pic x(64) value "hello".
+ procedure division.
+ call "foo" using buf.
+ end program prog.
+
+ identification division.
+ program-id. foo.
+ data division.
+ linkage section.
+ 01 buf pic x any length.
+ procedure division using buf.
+ display "buf is " buf.
+ end program foo.
+]
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index fdc80fd95be..f436e822889 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -10901,12 +10901,60 @@ __gg__set_program_list( int program_id,
}
static std::unordered_map<std::string, void *> already_found;
+static void *
+do_the_dl_thing(const char *directory,
+ const char *unmangled_name,
+ const char *mangled_name)
+ {
+ // Using the GnuCOBOL convention, this code looks first for a file
+ // named unmangled_name.so. It checks for a function unmangled_name
+ // in that file. When not found, it checks for mangled_name.
+ void *retval = NULL;
+ void *handle;
+ std::string file;
+ if( directory )
+ {
+ file = directory;
+ file += '/';
+ }
+ file += unmangled_name;
+ file += ".so";
+ handle = dlopen(file.c_str(), RTLD_LAZY|RTLD_NODELETE );
+ if( handle )
+ {
+ retval = dlsym(handle, unmangled_name);
+ if( retval )
+ {
+ already_found[unmangled_name] = retval;
+ }
+ }
+ if( !retval )
+ {
+ file.clear();
+ if( directory )
+ {
+ file = directory;
+ file += '/';
+ }
+ file += mangled_name;
+ file += ".so";
+ handle = dlopen(file.c_str(), RTLD_LAZY|RTLD_NODELETE );
+ if( handle )
+ {
+ retval = dlsym(handle, mangled_name);
+ if( retval )
+ {
+ already_found[mangled_name] = retval;
+ }
+ }
+ }
+ return retval;
+ }
static
void *
find_in_dirs(const char *dirs, char *unmangled_name, char *mangled_name)
{
-
std::unordered_map<std::string, void *>::const_iterator it =
already_found.find(unmangled_name);
@@ -10923,65 +10971,36 @@ find_in_dirs(const char *dirs, char
*unmangled_name, char *mangled_name)
void *retval = NULL;
if( dirs )
{
- char directory[1024];
- char file[1024];
+ std::string directory;
const char *p = dirs;
while( !retval && *p )
{
- size_t index = 0;
- while( index < sizeof(directory)-1 && *p && *p != ':' )
+ directory.clear();
+ while( *p && *p != ':' )
{
- directory[index++] = *p++;
+ directory += *p++;
}
- directory[index++] = '\0';
if( *p == ':' )
{
p += 1;
}
// directory is the next one for us to check:
- DIR *dir = opendir(directory);
+ DIR *dir = opendir(directory.c_str());
if( dir )
{
- while( !retval )
- {
- const dirent *entry = readdir(dir);
- if( !entry )
- {
- break;
- }
- size_t len = strlen(entry->d_name);
- if( len > 3
- && entry->d_name[len-3] == '.'
- && entry->d_name[len-2] == 's'
- && entry->d_name[len-1] == 'o'
- )
- {
- strcpy(file, directory);
- strcat(file, "/");
- strcat(file, entry->d_name);
- void *handle = dlopen(file, RTLD_LAZY|RTLD_NODELETE );
- if( handle )
- {
- retval = dlsym(handle, unmangled_name);
- if( retval )
- {
- already_found[unmangled_name] = retval;
- break;
- }
- retval = dlsym(handle, mangled_name);
- if( retval )
- {
- already_found[mangled_name] = retval;
- break;
- }
- dlclose(handle);
- }
- }
- }
+ retval = do_the_dl_thing(directory.c_str(),
+ unmangled_name,
+ mangled_name);
closedir(dir);
}
}
}
+ else
+ {
+ retval = do_the_dl_thing(nullptr,
+ unmangled_name,
+ mangled_name);
+ }
return retval;
}
@@ -10993,7 +11012,8 @@ __gg__function_handle_from_cobpath( char
*unmangled_name, char *mangled_name)
// We search for a function. We check first for the unmangled name,
and then
// the mangled name. We do this first for the executable, then for .so
- // files in COBPATH, and then for files in LD_LIBRARY_PATH
+ // files in GCOBOL_LIBRARY_PATH, and then we allow dlopen to use its
default
+ // behavior.
static void *handle_executable = NULL;
if( !handle_executable )
@@ -11012,8 +11032,12 @@ __gg__function_handle_from_cobpath( char
*unmangled_name, char *mangled_name)
}
if( !retval )
{
- const char *LD_LIBRARY_PATH = getenv("LD_LIBRARY_PATH");
- retval = find_in_dirs(LD_LIBRARY_PATH, unmangled_name, mangled_name);
+ const char *COBPATH = getenv("LD_LIBRARY_PATH");
+ retval = find_in_dirs(COBPATH, unmangled_name, mangled_name);
+ }
+ if( !retval )
+ {
+ retval = find_in_dirs(nullptr, unmangled_name, mangled_name);
}
return retval;
--
2.34.1
