| ︙ | | | ︙ | |
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
Tcl_FSLstatProc TclpObjLstat;
Tcl_FSCopyFileProc TclpObjCopyFile;
Tcl_FSDeleteFileProc TclpObjDeleteFile;
Tcl_FSRenameFileProc TclpObjRenameFile;
Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
Tcl_FSUnloadFileProc TclpUnloadFile;
Tcl_FSLinkProc TclpObjLink;
Tcl_FSListVolumesProc TclpObjListVolumes;
/*
* Define the native filesystem dispatch table. If necessary, it is ok to make
* this non-static, but it should only be accessed by the functions actually
* listed within it (or perhaps other helper functions of them). Anything
|
<
|
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
Tcl_FSLstatProc TclpObjLstat;
Tcl_FSCopyFileProc TclpObjCopyFile;
Tcl_FSDeleteFileProc TclpObjDeleteFile;
Tcl_FSRenameFileProc TclpObjRenameFile;
Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
Tcl_FSLinkProc TclpObjLink;
Tcl_FSListVolumesProc TclpObjListVolumes;
/*
* Define the native filesystem dispatch table. If necessary, it is ok to make
* this non-static, but it should only be accessed by the functions actually
* listed within it (or perhaps other helper functions of them). Anything
|
| ︙ | | | ︙ | |
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
|
* unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
* users general request (unlink and not.
*
* By default the unlink is done (if not in AUFS). However if the variable is
* present and set to true (any integer > 0) then the unlink is skipped.
*/
int
TclSkipUnlink(
Tcl_Obj *shlibFile)
{
/*
* Order of testing:
* 1. On hpux we generally want to skip unlink in general
*
* Outside of hpux then:
|
|
|
|
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
|
* unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
* users general request (unlink and not.
*
* By default the unlink is done (if not in AUFS). However if the variable is
* present and set to true (any integer > 0) then the unlink is skipped.
*/
static int
skipUnlink(
Tcl_Obj *shlibFile)
{
/*
* Order of testing:
* 1. On hpux we generally want to skip unlink in general
*
* Outside of hpux then:
|
| ︙ | | | ︙ | |
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
|
}
/*
* Try to delete the file immediately - this is possible in some OSes, and
* avoids any worries about leaving the copy laying around on exit.
*/
if (!TclSkipUnlink(copyToPtr) &&
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
/*
* We tell our caller about the real shared library which was loaded.
* Note that this does mean that the package list maintained by 'load'
* will store the original (vfs) path alongside the temporary load
|
|
|
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
|
}
/*
* Try to delete the file immediately - this is possible in some OSes, and
* avoids any worries about leaving the copy laying around on exit.
*/
if (!skipUnlink(copyToPtr) &&
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
/*
* We tell our caller about the real shared library which was loaded.
* Note that this does mean that the package list maintained by 'load'
* will store the original (vfs) path alongside the temporary load
|
| ︙ | | | ︙ | |
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
|
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot unload: filesystem does not support unloading",
-1));
}
return TCL_ERROR;
}
TclpUnloadFile(handle);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclpUnloadFile --
*
* Unloads a library given its handle
*
* This function was once filesystem-specific, but has been made portable by
* having TclpDlopen return a structure that includes procedure pointers.
*
*----------------------------------------------------------------------
*/
void
TclpUnloadFile(
Tcl_LoadHandle handle)
{
if (handle->unloadFileProcPtr != NULL) {
handle->unloadFileProcPtr(handle);
}
}
/*
*----------------------------------------------------------------------
*
* TclFSUnloadTempFile --
*
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
|
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
|
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot unload: filesystem does not support unloading",
-1));
}
return TCL_ERROR;
}
if (handle->unloadFileProcPtr != NULL) {
handle->unloadFileProcPtr(handle);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclFSUnloadTempFile --
*
|
| ︙ | | | ︙ | |