Skip to content

Commit df792b2

Browse files
committed
Report known error when tcl_ext_lib cannot be loaded
Fixes #644 Signed-off-by: Xavier Delaruelle <xavier.delaruelle@cea.fr>
1 parent 898e471 commit df792b2

8 files changed

Lines changed: 129 additions & 3 deletions

File tree

Makefile

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -79,7 +79,8 @@ TEST_PREREQ += lib/libtestutil-closedir$(SHLIB_SUFFIX) \
7979
lib/libtestutil-0getgroups$(SHLIB_SUFFIX) \
8080
lib/libtestutil-dupgetgroups$(SHLIB_SUFFIX) \
8181
lib/libtestutil-time$(SHLIB_SUFFIX) \
82-
lib/libtestutil-mktime$(SHLIB_SUFFIX)
82+
lib/libtestutil-mktime$(SHLIB_SUFFIX) \
83+
lib/libtestutil-tcl_loadfile$(SHLIB_SUFFIX)
8384
endif
8485
endif
8586

@@ -660,6 +661,9 @@ lib/libtestutil-time$(SHLIB_SUFFIX):
660661
lib/libtestutil-mktime$(SHLIB_SUFFIX):
661662
$(MAKE) --no-print-directory -C lib $(@F)
662663

664+
lib/libtestutil-tcl_loadfile$(SHLIB_SUFFIX):
665+
$(MAKE) --no-print-directory -C lib $(@F)
666+
663667
# example configs for test rules
664668
testsuite/example/.modulespath: testsuite/example/.modulespath.in
665669
$(translate-in-script)
@@ -1172,6 +1176,7 @@ $(V).SILENT: initdir pkgdoc doc version.inc share/rpm/environment-modules.spec \
11721176
lib/libtestutil-getpwuid$(SHLIB_SUFFIX) lib/libtestutil-getgroups$(SHLIB_SUFFIX) \
11731177
lib/libtestutil-0getgroups$(SHLIB_SUFFIX) lib/libtestutil-mktime$(SHLIB_SUFFIX) \
11741178
lib/libtestutil-dupgetgroups$(SHLIB_SUFFIX) lib/libtestutil-time$(SHLIB_SUFFIX) \
1179+
lib/libtestutil-tcl_loadfile$(SHLIB_SUFFIX) \
11751180
testsuite/example/.modulespath testsuite/example/modulespath-wild \
11761181
testsuite/example/modulerc testsuite/example/initrc-1 testsuite/example/initrc \
11771182
dist-tar dist-gzip dist-bzip2 dist-win $(MODULECMDTEST) $(MODULECMDTEST)_i

NEWS.rst

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,6 +130,8 @@ Modules 5.7.0 (not yet released)
130130
or :subcmd:`sh-to-mod` sub-command, does not get access to shell aliases,
131131
functions or completions settings only available in interactive sessions or
132132
defined in profile files. (fix issue #646)
133+
* Report a global known error when Modules Tcl extension library cannot be
134+
loaded. (fix issue #644)
133135

134136

135137
.. _5.6 release notes:

lib/.gitignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@
1616
/libtestutil-dupgetgroups.so
1717
/libtestutil-time.so
1818
/libtestutil-mktime.so
19+
/libtestutil-tcl_loadfile.so
1920
/envmodules.c.gcov
2021
/envmodules.gcda
2122
/envmodules.gcno

lib/Makefile.in

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,10 @@ libtestutil-mktime@SHLIB_SUFFIX@: testutil-mktime.c
6060
$(ECHO_CC)
6161
$(LDCC) $< -o $@
6262

63+
libtestutil-tcl_loadfile@SHLIB_SUFFIX@: testutil-tcl_loadfile.c
64+
$(ECHO_CC)
65+
$(LDCC) $< -o $@
66+
6367
clean:
6468
rm -f envmodules.o
6569
rm -f libtclenvmodules@TCL_SHLIB_SUFFIX@
@@ -70,6 +74,7 @@ clean:
7074
rm -f libtestutil-dupgetgroups@SHLIB_SUFFIX@
7175
rm -f libtestutil-time@SHLIB_SUFFIX@
7276
rm -f libtestutil-mktime@SHLIB_SUFFIX@
77+
rm -f libtestutil-tcl_loadfile@SHLIB_SUFFIX@
7378
rm -f envmodules.c.gcov envmodules.gcda envmodules.gcno
7479

7580
distclean: clean
@@ -95,4 +100,4 @@ $(V).SILENT: envmodules.o libtclenvmodules@TCL_SHLIB_SUFFIX@ \
95100
libtestutil-closedir@SHLIB_SUFFIX@ libtestutil-getpwuid@SHLIB_SUFFIX@ \
96101
libtestutil-getgroups@SHLIB_SUFFIX@ libtestutil-0getgroups@SHLIB_SUFFIX@ \
97102
libtestutil-dupgetgroups@SHLIB_SUFFIX@ libtestutil-time@SHLIB_SUFFIX@ \
98-
libtestutil-mktime@SHLIB_SUFFIX@
103+
libtestutil-mktime@SHLIB_SUFFIX@ libtestutil-tcl_loadfile@SHLIB_SUFFIX@

lib/testutil-tcl_loadfile.c

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
/*************************************************************************
2+
*
3+
* TESTUTIL-TCL_LOADFILE.C, Superseded Tcl_LoadFile function for test purpose
4+
* Copyright (C) 2026 Xavier Delaruelle
5+
*
6+
* This program is free software: you can redistribute it and/or modify
7+
* it under the terms of the GNU General Public License as published by
8+
* the Free Software Foundation, either version 2 of the License, or
9+
* (at your option) any later version.
10+
*
11+
* This program is distributed in the hope that it will be useful,
12+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
13+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14+
* GNU General Public License for more details.
15+
*
16+
* You should have received a copy of the GNU General Public License
17+
* along with this program. If not, see <http://www.gnu.org/licenses/>.
18+
*
19+
************************************************************************/
20+
21+
#include <tcl.h>
22+
23+
#if defined (__APPLE__)
24+
25+
int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
26+
const char *const symbols[], int flags, void *procVPtrs,
27+
Tcl_LoadHandle *handlePtr)
28+
{
29+
Tcl_SetObjResult(interp, Tcl_ObjPrintf("error message"));
30+
return TCL_ERROR;
31+
}
32+
33+
/* Code injection with DYLD interposing */
34+
__attribute__((used))
35+
static struct {
36+
const void *replacement;
37+
const void *replacee;
38+
} interposers[]
39+
__attribute__((section("__DATA,__interpose"))) = {
40+
{ (const void *)my_read, (const void *)read }
41+
};
42+
43+
#else
44+
45+
int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
46+
const char *const symbols[], int flags, void *procVPtrs,
47+
Tcl_LoadHandle *handlePtr)
48+
{
49+
Tcl_SetObjResult(interp, Tcl_ObjPrintf("error message"));
50+
return TCL_ERROR;
51+
}
52+
53+
54+
55+
56+
#endif
57+
58+
/* vim:set tabstop=3 shiftwidth=3 expandtab autoindent: */

tcl/main.tcl.in

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -625,7 +625,11 @@ if {[catch {
625625
##nagelfar ignore +2 Too long line
626626
@libtclenvmodules@if {[file readable [getConf tcl_ext_lib]]} {
627627
@libtclenvmodules@ reportDebug "Load Tcl extension library ([getConf tcl_ext_lib])"
628-
@libtclenvmodules@ load [file normalize [getConf tcl_ext_lib]] Envmodules
628+
@libtclenvmodules@ if {[catch {
629+
@libtclenvmodules@ load [file normalize [getConf tcl_ext_lib]] Envmodules
630+
@libtclenvmodules@ } errMsg]} {
631+
@libtclenvmodules@ reportErrorAndExit $errMsg
632+
@libtclenvmodules@ }
629633
@libtclenvmodules@ setState tcl_ext_lib_loaded 1
630634
@libtclenvmodules@}
631635
# use fallback procs if extension library is not loaded

testsuite/modules.00-init/005-init_ts.exp

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -168,6 +168,7 @@ if {$install_libtclenvmodules eq {y}} {
168168
set dupgetgroupslib_file lib/libtestutil-dupgetgroups$install_shlib_suffix
169169
set timelib_file lib/libtestutil-time$install_shlib_suffix
170170
set mktimelib_file lib/libtestutil-mktime$install_shlib_suffix
171+
set tcl_loadfilelib_file lib/libtestutil-tcl_loadfile$install_shlib_suffix
171172
}
172173

173174
# check file permission capabilities
Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
##############################################################################
2+
# Modules Revision 3.0
3+
# Providing a flexible user environment
4+
#
5+
# File: modules.00-init/%M%
6+
# Revision: %I%
7+
# First Edition: 2026/07/17
8+
# Last Mod.: %U%, %G%
9+
#
10+
# Authors: Xavier Delaruelle, xavier.delaruelle@cea.fr
11+
#
12+
# Description: Testuite testsequence
13+
# Command: load
14+
# Modulefiles: bar, foo
15+
# Sub-Command:
16+
#
17+
# Comment: %C{
18+
# Test Modules Tcl extended library
19+
# }C%
20+
#
21+
##############################################################################
22+
23+
skip_if_quick_mode
24+
25+
# test issue when loading library
26+
# ensure we are in a specific test mode so we can play with installed files
27+
if {[siteconfig_isStderrTty] && [info exists tclextlib_file] &&\
28+
[info exists tcl_loadfilelib_file] && [file exists $tcl_loadfilelib_file]} {
29+
if {$tcl_platform(os) ne "Darwin"} {
30+
setenv_var LD_PRELOAD $tcl_loadfilelib_file
31+
} else {
32+
setenv_var DYLD_INSERT_LIBRARIES $tcl_loadfilelib_file
33+
}
34+
35+
set tserr "$error_msgs: error message"
36+
testouterr_cmd sh {-V} ERR $tserr
37+
38+
if {$tcl_platform(os) ne "Darwin"} {
39+
unsetenv_var LD_PRELOAD
40+
} else {
41+
unsetenv_var DYLD_INSERT_LIBRARIES
42+
}
43+
}
44+
45+
46+
#
47+
# Cleanup
48+
#
49+
50+
reset_test_env

0 commit comments

Comments
 (0)