https://gcc.gnu.org/g:db54bfba3a0afb93257b9e30ff7fa70207367045

commit r17-4450-gdb54bfba3a0afb93257b9e30ff7fa70207367045
Author: Robert Dubner <[email protected]>
Date:   Fri Sep 18 16:36:02 2026 -0400

    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.

Diff:
---
 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 ++++++++
 gcc/testsuite/cobol.dg/group2/CBL_DELETE_FILE.cob  |   8 +-
 gcc/testsuite/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 +-
 ...READ_FILE__check_file_size_with_flags___128.cob |   2 +-
 gcc/testsuite/cobol.dg/group2/CDF_Feature_.cob     |   2 +-
 ...AR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob |   2 +-
 .../cobol.dg/group2/FIND-STRING__forward_.cob      |   2 +-
 .../cobol.dg/group2/FIND-STRING__reverse_.cob      |   2 +-
 gcc/testsuite/cobol.dg/group2/FUNCTION_CONVERT.cob |   2 +-
 .../group2/MF__identifier_as_PIC_X_ANY_LENGTH.cob  |  30 ++++++
 libgcobol/libgcobol.cc                             | 118 +++++++++++++--------
 18 files changed, 216 insertions(+), 104 deletions(-)

diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1
index 21438c0568b0..cdcb71468109 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 44df3e4f2405..685fee287056 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 9b07e9c46c8e..3bbf60e17e75 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 5f6752ef7461..6d96ba311b6a 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 6c6142ed1a93..3887b275b7b0 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 000000000000..849c3e4f7d23
--- /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 d924a4c90303..499d9d836faa 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 55a5fe10c98a..314d1d184eaf 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 0c0a43cb0510..0f7ec298389a 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 67a56adcfa57..bec7477035e4 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 68e863f65cbc..aac046ccde13 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 9150dd5d7210..fa701da6c522 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_-_EBCDIC.cob
 
b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob
index 346f393777c2..0cde1ff859ac 100644
--- 
a/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.cob
+++ 
b/gcc/testsuite/cobol.dg/group2/CHAR_and_ORD_with_COLLATING_sequence_-_EBCDIC.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 1cc5ae599420..f007d7093443 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 831822cd1d2f..e30011e2800a 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 48c4c0bfd9b1..7bad2fdaed56 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 000000000000..e5ca6e66c55a
--- /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 fdc80fd95beb..f436e822889d 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;

Reply via email to