tcl-extensions

Check-in [feb760fc97]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fix silly errors: now compiles
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | winlock
Files: files | file ages | folders
SHA1:feb760fc97dd11f5d699d10bbc5a2079b6b5ac81
User & Date: aspect 2015-12-15 01:53:06
Context
2015-12-15
02:34
fix name of init function Leaf check-in: 419ca30322 user: aspect tags: winlock
01:53
fix silly errors: now compiles check-in: feb760fc97 user: aspect tags: winlock
01:03
move windows source to windows platform .. what if there is nothing to build on unix? check-in: 983cf52a87 user: aspect tags: winlock
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to win/tclwinlock.c.

     4      4   int Tcl_WinLockObjCmd(
     5      5           ClientData cdata,
     6      6           Tcl_Interp *interp,
     7      7           int objc,
     8      8           Tcl_Obj *const objv[])
     9      9   {
    10     10       Tcl_Channel channel;
    11         -    ClientData  *hread, *hwrite;
           11  +    ClientData  hread, hwrite;
    12     12   
    13     13       DWORD                       flags;
    14     14       DWORD                       nb_low, nb_high;
    15         -    LPOVERLAPPED                ovl;
           15  +    OVERLAPPED                  ovl;
    16     16       BY_HANDLE_FILE_INFORMATION  fileinfo;
    17     17   
    18     18       int f_exclusive = 0;
    19     19   
    20     20       /*  ?-exclusive? */
    21     21       if(objc < 2) {
    22         -        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments!  Expected \"%s ?-exclusive? chan\"", objv[0]));
           22  +        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments!  Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
    23     23           Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
    24     24           return TCL_ERROR;
    25     25       }
    26     26       if(objc > 3) {
    27         -        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments!  Expected \"%s ?-exclusive? chan\"", objv[0]));
           27  +        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments!  Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
    28     28           Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
    29     29           return TCL_ERROR;
    30     30       }
    31     31       if(objc == 3) {
    32     32           const char* name = Tcl_GetString(objv[1]);
    33         -        if(strcmp(name, "-exclusive", strlen(name)) == 0) {
           33  +        if(strncmp(name, "-exclusive", strlen(name)) == 0) {
    34     34               f_exclusive = 1;
    35     35           } else {
    36     36               Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid option \"%s\"! Expected ?-exclusive?", name));
    37     37               Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
    38     38               return TCL_ERROR;
    39     39           }
    40     40       }
    41     41   
    42     42       /* obtain channel from last argument */
    43         -    channel = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[objc-1], NULL), NULL);
           43  +    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[objc-1]), NULL);
    44     44       if(channel == (Tcl_Channel) NULL) {
    45         -        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetStringFromObj(objv[objc-1])));
           45  +        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetString(objv[objc-1])));
    46     46           return TCL_ERROR;
    47     47       }
    48     48   
    49     49       /* get the underlying file handles */
    50         -    if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
           50  +    if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
    51     51           hread = NULL;
    52     52       }
    53         -    if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
           53  +    if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
    54     54           hwrite = NULL;
    55     55       }
    56     56       if(hread == NULL) { hread = hwrite; }
    57     57       if(hwrite == hread) { hwrite = NULL; }
    58     58       if(hwrite != NULL) {
    59     59           Tcl_SetObjResult(interp, Tcl_ObjPrintf("Two handles!  Unable to lock (%p, %p)", hread, hwrite));
    60     60           return TCL_ERROR;
................................................................................
    66     66           goto getLastError;
    67     67       } else {
    68     68           nb_high = fileinfo.nFileSizeHigh;
    69     69           nb_low  = fileinfo.nFileSizeLow;
    70     70       }
    71     71   
    72     72       /* prepare for LockFileEx() */
    73         -    memset(ovl, 0, sizeof(ovl));
    74         -    ovl->hEvent = 0;
           73  +    memset(&ovl, 0, sizeof(ovl));
           74  +    ovl.hEvent = 0;
    75     75   
    76     76       flags = LOCKFILE_FAIL_IMMEDIATELY;
    77     77       if(f_exclusive) {
    78     78           flags |= LOCKFILE_EXCLUSIVE_LOCK;
    79     79       }
    80     80   
    81     81       /* call LockFileEx */
    82         -    if(LockFileEx(hread, flags, 0, nb_low, nb_high, ovl)) {
           82  +    if(LockFileEx(hread, flags, 0, nb_low, nb_high, &ovl)) {
    83     83   
    84     84           Tcl_SetObjResult(interp, Tcl_ObjPrintf("Locked %p", hread));
    85     85           /* we don't care about the overlay structure; it would be needed for unlocking if we did */
    86     86           return TCL_OK;
    87     87       }
    88     88   
    89     89   getLastError:
    90     90       {
    91     91           /* handle Windows error - cribbed from AppendSystemError in tclWinReg.c */
    92     92           DWORD error;
    93     93           TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
    94         -	char *msgPtr;
           94  +        char *msgPtr;
           95  +        char id[16];
           96  +        char msgBuf[1024];
           97  +        char *msg;
    95     98           Tcl_DString ds;
    96     99           DWORD length;
    97    100   
    98    101           error = GetLastError();
    99    102           length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
   100    103                                NULL, error,
   101    104                                MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,