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

19990809-06:23 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-08-09 05:21:31 +00:00
parent e4fc927645
commit 35b7c865f0
9 changed files with 108 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
harbour/ChangeLog
View File

@@ -1,3 +1,23 @@
19990809-06:23 GMT+1 Victor Szel <info@szelvesz.hu>
* include/memvars.ch
! #ifdef _MEMVARS_CH guard added.
! Changed all comments to ANSI C style, since it's included in C code, too.
* source/rtl/errorapi.c
+ Fixed logic for _errLaunch(), it seem ready now, plus highly
Clipper compatible.
* source/Makefile
+ runner added.
* source/odbc/odbc.c
! Small typo fixed.
* source/rtl/menuto.prg
+ Handles non-declared variables correctly. Uses __MVSCOPE().
* include/hbdefs.h
* Small cleanup, typo fix.
* tests/working/copyfile.prg
tests/working/copyfile.txt (removed)
% copyfile.txt is no longer needed.
* Open error test uses a much more rare file name.
19990808-20:55 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/compiler/harbour.y

14
harbour/include/hbdefs.h
View File

@@ -32,30 +32,30 @@
#if ! defined(HB_DONT_DEFINE_BASIC_TYPES)
#undef BOOL /* boolean */
typedef int BOOL;
#undef BYTE
typedef unsigned char BYTE; /* 1 byte unsigned */
#undef WORD /* 2 bytes unsigned */
typedef unsigned short int WORD;
#undef SHORT /* 2 bytes signed */
typedef short int SHORT;
#undef WORD /* 2 bytes unsigned */
typedef unsigned short int WORD;
#undef USHORT /* 2 bytes unsigned */
typedef unsigned short int USHORT;
#undef LONG /* 4 bytes signed */
typedef long LONG;
#undef ULONG /* 4 bytes signed */
#undef ULONG /* 4 bytes unsigned */
typedef unsigned long ULONG;
#undef DWORD /* 4 bytes unsigned */
typedef unsigned long DWORD;
#undef BOOL /* boolean */
typedef int BOOL;
#undef FALSE
#undef TRUE
#define FALSE 0

20
harbour/include/memvars.ch
View File

@@ -4,11 +4,15 @@
/* NOTE: This file is also used by C code. */
// Values returned from __MVSCOPE function
//
#define MV_NOT_FOUND -2 //not found in the symbols table
#define MV_UNKNOWN -1 //not created yet
#define MV_ERROR 0 //information cannot be obtained
#define MV_PUBLIC 1 //PUBLIC variable
#define MV_PRIVATE_GLOBAL 2 //PRIVATE created outside of current function/procedure
#define MV_PRIVATE_LOCAL 3 //PRIVATE created in current function/procedure
#ifndef _MEMVARS_CH
#define _MEMVARS_CH
/* Values returned from __MVSCOPE() function */
#define MV_NOT_FOUND -2 /* not found in the symbols table */
#define MV_UNKNOWN -1 /* not created yet */
#define MV_ERROR 0 /* information cannot be obtained */
#define MV_PUBLIC 1 /* PUBLIC variable */
#define MV_PRIVATE_GLOBAL 2 /* PRIVATE created outside of current function/procedure */
#define MV_PRIVATE_LOCAL 3 /* PRIVATE created in current function/procedure */
#endif /* _MEMVARS_CH */

1
harbour/source/Makefile
View File

@@ -12,5 +12,6 @@ DIRS=\
vm \
rdd \
tools \
runner \
include $(ROOT)config/dir.cf

2
harbour/source/odbc/odbc.c
View File

@@ -73,7 +73,7 @@ HB_INIT_SYMBOLS_BEGIN( odbc__InitSymbols )
HB_INIT_SYMBOLS_END( odbc__InitSymbols );
#pragma odbc__InitSymbols
HARBOUR HB_SQLALLOCEN( void ) /* HB_SQLALLOCENNNECT( @hEnv ) --> nRetCode */
HARBOUR HB_SQLALLOCEN( void ) /* HB_SQLALLOCENV( @hEnv ) --> nRetCode */
{
HENV hEnv;
RETCODE ret = SQLAllocEnv( &hEnv );

72
harbour/source/rtl/errorapi.c
View File

@@ -47,10 +47,10 @@ WORD hb_errLaunch( PHB_ITEM pError )
if ( pError )
{
/* TODO: Determine if there was a BREAK in error handler. */
BOOL bBreak = FALSE;
WORD nSequenceLevel = 0;
USHORT uiFlags = hb_errGetFlags( pError );
/* TODO: Determine if there was a BREAK in the error handler. */
BOOL bBreak;
WORD nSequenceLevel;
USHORT uiFlags;
if ( ! IS_BLOCK( &errorBlock ) )
{
@@ -64,34 +64,68 @@ WORD hb_errLaunch( PHB_ITEM pError )
hb_vmPush( pError );
hb_vmDo( 1 );
/* TODO: Detect these properly */
bBreak = FALSE;
nSequenceLevel = 0;
uiFlags = hb_errGetFlags( pError );
if ( bBreak )
{
wRetVal = E_BREAK;
}
else if ( IS_LOGICAL( &stack.Return ) )
{
wRetVal = stack.Return.item.asLogical.value ? E_RETRY : E_DEFAULT;
if ( nSequenceLevel )
{
wRetVal = E_BREAK;
/* TODO: Initiate a jump to the closest RECOVER statement */
}
else
{
/* TODO: QUIT correctly, without any message */
exit( 1 );
}
}
else
{
wRetVal = E_DEFAULT;
}
BOOL bFailure = FALSE;
if ( ( wRetVal == E_BREAK && nSequenceLevel == 0 ) ||
( wRetVal == E_DEFAULT && !( uiFlags & EF_CANDEFAULT ) ) ||
( wRetVal == E_RETRY && !( uiFlags & EF_CANRETRY ) ) )
{
/* TODO: Change to internal error: */
printf("Error recovery failure, ???? (0)");
exit( 1 ); /* TODO: quit correctly */
/* If the error block didn't return a logical value, */
/* or the canSubstitute flag has been set, consider it as a failure */
if ( ! IS_LOGICAL( &stack.Return ) ||
( uiFlags & EF_CANSUBSTITUTE ) )
{
bFailure = TRUE;
}
else
{
wRetVal = stack.Return.item.asLogical.value ? E_RETRY : E_DEFAULT;
if ( ( wRetVal == E_DEFAULT && !( uiFlags & EF_CANDEFAULT ) ) ||
( wRetVal == E_RETRY && !( uiFlags & EF_CANRETRY ) ) )
{
bFailure = TRUE;
}
}
if ( bFailure )
{
/* TODO: Change to internal error: */
printf("Error recovery failure, ???? (0)");
exit( 1 ); /* TODO: quit correctly */
}
}
}
else
wRetVal = E_RETRY;
{
wRetVal = E_RETRY; /* Clipper does this, undocumented */
}
return wRetVal;
}
/* NOTE: This should be called when the EF_CANSUBSTITUE flag was set */
/* Since it this case the error handler will return the value */
/* to be substituted */
/* TODO:
PHB_ITEM hb_errLaunchExt( PHB_ITEM pError )
{

31
harbour/source/rtl/menuto.prg
View File

@@ -20,7 +20,7 @@
#include "setcurs.ch"
#include "inkey.ch"
#include "color.ch"
#include "memvars.ch"
static aLevel := {}
static nPointer := 1
@@ -60,20 +60,17 @@ function __MenuTo( bBlock, cVariable )
local nSaveCursor
local cSaveReadVar
local bOldError
local lBlockError
local lDeclared
// Detect if a memvar was passed
bOldError := errorblock( {|| __Break( NIL ) } )
begin sequence
n := eval( bBlock )
lBlockError := .F.
recover
lBlockError := .T.
__mvPUBLIC( cVariable )
end sequence
errorblock( bOldError )
if __mvSCOPE( cVariable ) <= MV_ERROR
__mvPUBLIC( cVariable )
lDeclared := .T.
else
lDeclared := .F.
n := eval( bBlock )
endif
// if no prompts were defined, exit with 0
@@ -226,7 +223,7 @@ function __MenuTo( bBlock, cVariable )
eval( bBlock, n )
if lBlockError
if lDeclared
release ( cVariable )
endif
@@ -234,11 +231,3 @@ function __MenuTo( bBlock, cVariable )
return n
// Temp emulation of the BREAK() function.
// NOTE: xExpr is not handled
static function __Break( xExpr )
break
return nil

8
harbour/tests/working/copyfile.prg
View File

@@ -5,9 +5,9 @@
FUNCTION Main()
// ? "1", __copyfile("COPYFROM.TXT")
? "2", __copyfile("COPYFROM.TXT", "COPYTO.TXT")
? "3", __copyfile("C.PRG", "B.PRG")
? "4", __copyfile("COPYFROM.TXT", "..")
// ? "1", __copyfile("COPYFROM.PRG")
? "2", __copyfile("COPYFROM.PRG", "COPYTO.TMP")
? "3", __copyfile("_NOTHERE.$$$", "COPYTO.TMP")
? "4", __copyfile("COPYFROM.PRG", "..")
RETURN NIL

7
harbour/tests/working/copyfrom.txt
View File

@@ -1,7 +0,0 @@
; Test file for COPYFILE.PRG
; Don't delete
dslkfjgs;ldfg
dsfg;lkdsflgksd
gsdfl;gkjdsfg
df;lkgjsdfg