fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
Viktor Szakats
1999-06-27 15:48:47 +00:00
parent 64af2ef5a6
commit 46eca01f3e
6 changed files with 164 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
harbour/ChangeLog
View File

@@ -1,3 +1,21 @@
19990627-16:30 CET Victor Szel <info@szelvesz.hu>
* source/rtl/errorsys.prg
+ Builds error message text like Clipper.
* source/rtl/copyfile.c
% Optimized var scoping, var naming
+ Error handling enhanced, using error launcher wrapper.
+ HB_STRICT_CLIPPER_COMPATIBILITY mode added.
! BYTEP -> char* for strings
! char* -> PBYTE for buffer
% Copy loop optimized
+ Error handling added to copy loop
+ Notes added about Clipper compatibility, todos, questions.
* source/vm/hvm.c
* "DUNNO" -> "UNKNOWN" 8)
* makedos.env
+ HARBOUR.EXE called with -i parameter, to be able to include .CH files
(probably should be added to other make environments, too.)
19990627-09:00 "Paul Tucker" <ptucker@sympatico.ca>
* source/hbpp/hbpp.c
- change lines from 1246 to 1257

2
harbour/include/dates.h
View File

@@ -9,4 +9,4 @@ char * hb_dtoc (char * szDate, char * szDateFormat);
long hb_dateEncode( long lDay, long lMonth, long lYear );
void hb_dateDecode( long julian, long * plDay, long * plMonth, long * plYear );
#endif /* HB_DATES_H_ */
#endif /* HB_DATES_H_ */

2
harbour/makedos.env
View File

@@ -19,4 +19,4 @@ CC=gcc
CFLAGS=-Wall -g -DDEBUG -I$(HARBOURDIR)/include -x c
%.c : %.prg
../../bin/harbour -n $<
../../bin/harbour -n -i$(HARBOURDIR)/include $<

145
harbour/source/rtl/copyfile.c
View File

@@ -15,78 +15,105 @@
#define BUFFER_SIZE 8192
static long hb_fsCopy(BYTEP ,BYTEP ) ;
static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal);
/* INCOMPATIBILITY: Clipper returns .F. on failure and NIL on success */
/* TODO: hb_errorRT_BASE() or a replacement should also handle DOS error */
/* and canRetry/canDefault flags */
HARBOUR HB___COPYFILE( void )
{
PHB_ITEM pError;
if ( ISCHAR(1) && ISCHAR(2) )
hb_retnl(hb_fsCopy((BYTEP)hb_parc(1),(BYTEP)hb_parc(2)));
{
#ifdef HB_STRICT_CLIPPER_COMPATIBILITY
if (!hb_fsCopy(hb_parc(1), hb_parc(2)))
{
hb_retl(FALSE);
}
#else
ULONG ulWrittenTotal;
hb_fsCopy(hb_parc(1), hb_parc(2), &ulWrittenTotal);
hb_retnl(ulWrittenTotal);
#endif
}
else
{
pError = hb_errNew();
hb_errPutDescription(pError, "Error BASE/2010 Argument error: __COPYFILE" );
hb_errLaunch(pError);
hb_errRelease(pError);
hb_errorRT_BASE(EG_ARG, 2010, "Argument error", "__COPYFILE");
}
return;
}
static long hb_fsCopy(BYTEP source,BYTEP dest)
}
static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal)
{
FHANDLE dHANDLE,sHANDLE;
char *buffer;
USHORT usCount;
ULONG ulCount = 0L;
PHB_ITEM pError;
#ifdef OS_UNIX_COMPATIBLE
struct stat struFileInfo;
int iSuccess;
#endif
sHANDLE = hb_fsOpen(source, FO_READ);
if ( hb_fsError() )
BOOL bRetVal = FALSE;
FHANDLE fhndSource;
FHANDLE fhndDest;
*ulWrittenTotal = 0L;
while ((fhndSource = hb_fsOpen(szSource, FO_READ)) == FS_ERROR)
{
pError = hb_errNew();
hb_errPutDescription(pError, "Error BASE/2012 Open error: __COPYFILE" );
hb_errLaunch(pError);
hb_errRelease(pError);
return( -1L) ;
}
#ifdef OS_UNIX_COMPATIBLE
iSuccess =fstat( sHANDLE, &struFileInfo );
#endif
dHANDLE = hb_fsCreate(dest,FC_NORMAL);
if ( hb_fsError() )
{
hb_fsClose(sHANDLE);
pError = hb_errNew();
hb_errPutDescription(pError, "Error BASE/2012 Create error: __COPYFILE" );
hb_errLaunch(pError);
hb_errRelease(pError);
return( -2L) ;
}
buffer = (char *)hb_xgrab( BUFFER_SIZE );
usCount = hb_fsRead(sHANDLE,buffer,BUFFER_SIZE);
while( TRUE )
{
ulCount += (ULONG)usCount;
hb_fsWrite(dHANDLE,buffer, usCount);
usCount = hb_fsRead(sHANDLE,buffer,BUFFER_SIZE);
if (usCount != BUFFER_SIZE )
if (hb_errorRT_BASE(EG_ARG, 2012, "Open error", szSource) == E_DEFAULT)
{
*ulWrittenTotal = (ULONG)-1L;
break;
}
}
ulCount += (ULONG)usCount;
hb_fsWrite(dHANDLE,buffer,usCount);
hb_xfree(buffer);
hb_fsClose(sHANDLE);
if (fhndSource != FS_ERROR)
{
while ((fhndDest = hb_fsCreate(szDest, FC_NORMAL)) == FS_ERROR)
{
if (hb_errorRT_BASE(EG_ARG, 2012, "Create error", szDest) == E_DEFAULT)
{
*ulWrittenTotal = (ULONG)-2L;
break;
}
}
if (fhndDest != FS_ERROR)
{
#ifdef OS_UNIX_COMPATIBLE
if( iSuccess == 0 )
fchmod( dHANDLE, struFileInfo.st_mode );
#endif
hb_fsClose(dHANDLE);
return( ulCount );
struct stat struFileInfo;
int iSuccess = fstat( fhndSource, &struFileInfo );
#endif
PBYTE buffer;
USHORT usRead;
USHORT usWritten;
buffer = (PBYTE)hb_xgrab( BUFFER_SIZE );
/* QUESTION: Does Clipper throw an error on read or write operation ? */
/* QUESTION: What is the E_DEFAULT behaviour on that error ? */
bRetVal = TRUE;
while ((usRead = hb_fsRead(fhndSource, buffer, BUFFER_SIZE)) != 0)
{
while ((usWritten = hb_fsWrite(fhndDest, buffer, usRead)) != usRead)
{
if (hb_errorRT_BASE(EG_ARG, 2012, "Write error", szDest) == E_DEFAULT)
{
bRetVal = FALSE;
break;
}
}
*ulWrittenTotal += (ULONG)usWritten;
}
hb_xfree(buffer);
#ifdef OS_UNIX_COMPATIBLE
if( iSuccess == 0 )
fchmod( fhndDest, struFileInfo.st_mode );
#endif
hb_fsClose(fhndDest);
}
hb_fsClose(fhndSource);
}
return bRetVal;
}

63
harbour/source/rtl/errorsys.prg
View File

@@ -4,6 +4,11 @@
// Standard Harbour ErrorSys system
#include "error.ch"
#define ISCHAR(var) (ValType(var) == "C")
#define ISNUM(var) (ValType(var) == "N")
//----------------------------------------------------------------------------//
init procedure ClipInit
@@ -17,20 +22,29 @@ return
//----------------------------------------------------------------------------//
static function DefError( oError )
LOCAL cMessage
local cInfo := ""
local n := 2
cMessage := ErrorMessage(oError)
IF !Empty(oError:osCode)
cMessage += " (DOS Error " + LTrim(Str(oError:osCode)) + ")"
ENDIF
QOut( cMessage + Chr( 13 ) + Chr( 10 ))
do while ! Empty( ProcName( n ) )
cInfo += Chr( 13 ) + Chr( 10 ) + "Called from " + ProcName( n ) + ;
"(" + AllTrim( Str( ProcLine( n++ ) ) ) + ")"
QOut("Called from " + ProcName( n ) + ;
"(" + AllTrim( Str( ProcLine( n++ ) ) ) + ")")
enddo
QOut( oError:Description + Chr( 13 ) + Chr( 10 ) + cInfo )
// TOFIX: Removing ErrorLevel() call will cause a VM error
// don't know why [vszel]
ErrorLevel(1)
QUIT
__Quit()
return .t.
return .F.
//----------------------------------------------------------------------------//
@@ -40,4 +54,41 @@ procedure ErrorSys
return
// [vszel]
STATIC FUNCTION ErrorMessage(oError)
LOCAL cMessage
// start error message
cMessage := iif( oError:severity > ES_WARNING, "Error", "Warning" ) + " "
// add subsystem name if available
IF ISCHAR(oError:subsystem)
cMessage += oError:subsystem()
ELSE
cMessage += "???"
ENDIF
// add subsystem's error code if available
IF ISNUM(oError:subCode)
cMessage += "/" + LTrim(Str(oError:subCode))
ELSE
cMessage += "/???"
ENDIF
// add error description if available
IF ISCHAR(oError:description)
cMessage += " " + oError:description
ENDIF
// add either filename or operation
DO CASE
CASE !Empty(oError:filename)
cMessage += ": " + oError:filename
CASE !Empty(oError:operation)
cMessage += ": " + oError:operation
ENDCASE
RETURN cMessage
//----------------------------------------------------------------------------//

2
harbour/source/vm/hvm.c
View File

@@ -1914,7 +1914,7 @@ void StackInit( void )
break;
default:
printf( "DUNNO[%i] ", p->wType );
printf( "UNKNOWN[%i] ", p->wType );
break;
}
}