diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 7b101b2a80..822a243b1b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,38 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-08-20 15:50 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbexprb.c + * do not generate error for QSELF()[...] - Clipper allows such + operation and because some valid Clipper code needs it then + I disabled error message. + + * harbour/common.mak + * harbour/source/rtl/Makefile + + harbour/source/rtl/einstvar.prg + + added undocumented CA-Cl*pper function _eInstVar() used to validate + variable type in assign messages. + + * harbour/include/hbapi.h + * harbour/source/vm/arrays.c + * changed 'char *' to 'const char *' in hb_arraySetC() and hb_arraySetCL() + + * harbour/source/rdd/dbcmd.c + * cleaned DBSKIPPER() code + + * harbour/source/rtl/browdb.prg + * use written in C DBSKIPPER() function instead of static .prg Skipped() + when HB_COMPAT_XPP macro is enabled + + * harbour/source/rtl/browse.prg + ! fixes in BROWSE() function: + ! displaying box characters + + added CL53 compatible mouse actions + + added mouse wheel actions + + added support for deleting records (K_DEL) + + added support for edit mode + + added support for append mode + 2007-08-20 15:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rtl/fserror.c + added translation (errno=>dosError) for ENOSPC diff --git a/harbour/common.mak b/harbour/common.mak index b8c544d97d..08e0abadf5 100644 --- a/harbour/common.mak +++ b/harbour/common.mak @@ -544,6 +544,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\dbedit$(OBJEXT) \ $(OBJ_DIR)\devoutp$(OBJEXT) \ $(OBJ_DIR)\dircmd$(OBJEXT) \ + $(OBJ_DIR)\einstvar$(OBJEXT) \ $(OBJ_DIR)\errorsys$(OBJEXT) \ $(OBJ_DIR)\fieldbl$(OBJEXT) \ $(OBJ_DIR)\getlist$(OBJEXT) \ diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index a154f13f0a..7463bc9086 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -683,8 +683,8 @@ extern HB_EXPORT BOOL hb_arraySetNL( PHB_ITEM pArray, ULONG ulIndex, LONG l extern HB_EXPORT BOOL hb_arraySetNLL( PHB_ITEM pArray, ULONG ulIndex, LONGLONG llNumber ); extern HB_EXPORT BOOL hb_arraySetNInt( PHB_ITEM pArray, ULONG ulIndex, HB_LONG lNumber ); extern HB_EXPORT BOOL hb_arraySetND( PHB_ITEM pArray, ULONG ulIndex, double dNumber ); -extern HB_EXPORT BOOL hb_arraySetC( PHB_ITEM pArray, ULONG ulIndex, char * szText ); -extern HB_EXPORT BOOL hb_arraySetCL( PHB_ITEM pArray, ULONG ulIndex, char * szText, ULONG ulLen ); +extern HB_EXPORT BOOL hb_arraySetC( PHB_ITEM pArray, ULONG ulIndex, const char * szText ); +extern HB_EXPORT BOOL hb_arraySetCL( PHB_ITEM pArray, ULONG ulIndex, const char * szText, ULONG ulLen ); extern HB_EXPORT BOOL hb_arraySetCPtr( PHB_ITEM pArray, ULONG ulIndex, char * szText, ULONG ulLen ); extern HB_EXPORT BOOL hb_arraySetPtr( PHB_ITEM pArray, ULONG ulIndex, void * pValue ); extern HB_EXPORT BOOL hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount ); /* fill an array with a given item */ diff --git a/harbour/include/hbexprb.c b/harbour/include/hbexprb.c index 2bdda2bb03..6df6654420 100644 --- a/harbour/include/hbexprb.c +++ b/harbour/include/hbexprb.c @@ -492,7 +492,10 @@ static HB_EXPR_FUNC( hb_compExprUseSelf ) case HB_EA_REDUCE: break; case HB_EA_ARRAY_AT: - HB_COMP_ERROR_TYPE( pSelf ); /* QUESTION: Is this OK ? */ + /* Clipper allows such operation and because some valid Clipper + * code needs it then I disabled error message, [druzus] + */ + /* HB_COMP_ERROR_TYPE( pSelf ); */ break; case HB_EA_ARRAY_INDEX: hb_compErrorIndex( HB_COMP_PARAM, pSelf ); /* SELF cannot be used as array index element */ diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index bd7766ab94..e9ee1f675a 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -2668,61 +2668,52 @@ HB_FUNC( DBSKIPPER ) if( pArea ) { - LONG nSkipped = 0; - LONG nRecs = 1; - BOOL bBEof = TRUE; - if( hb_pcount() > 0 ) - { - nRecs = hb_parnl( 1 ) ; - } + LONG lSkipped = 0; + LONG lRecs = 1; + BOOL fBEof; + ULONG ulRecords = 0; - if( SELF_EOF( pArea, &bBEof ) != SUCCESS ) - return; + if( SELF_RECCOUNT( pArea, &ulRecords ) == SUCCESS && ulRecords > 0 ) + { + if( ISNUM( 1 ) ) + lRecs = hb_parnl( 1 ) ; - if( nRecs == 0 ) - { - if( SELF_SKIP( pArea, 0 ) != SUCCESS ) - return; - } - else if( nRecs > 0 && !bBEof ) - { - while( nSkipped < nRecs ) + if( lRecs == 0 ) + SELF_SKIP( pArea, 0 ); + else if( lRecs > 0 ) { - if( SELF_SKIP( pArea, 1 ) != SUCCESS ) - return; - if( SELF_EOF( pArea, &bBEof ) != SUCCESS ) - return; - if( bBEof ) + if( SELF_EOF( pArea, &fBEof ) == SUCCESS ) + { + while( lSkipped < lRecs ) + { + if( SELF_SKIP( pArea, 1 ) != SUCCESS ) + break; + if( SELF_EOF( pArea, &fBEof ) != SUCCESS ) + break; + if( fBEof ) + { + SELF_SKIP( pArea, -1 ); + break; + } + lSkipped++; + } + } + } + else /* if( lRecs < 0 ) */ + { + while( lSkipped > lRecs ) { if( SELF_SKIP( pArea, -1 ) != SUCCESS ) - return; - nRecs = nSkipped ; - } - else - { - nSkipped++ ; + break; + if( SELF_BOF( pArea, &fBEof ) != SUCCESS ) + break; + if( fBEof ) + break; + lSkipped--; } } + hb_retnl( lSkipped ); } - else if( nRecs < 0 ) - { - while( nSkipped > nRecs ) - { - if( SELF_SKIP( pArea, -1 ) != SUCCESS ) - return; - if( SELF_BOF( pArea, &bBEof ) != SUCCESS ) - return; - if( bBEof ) - { - nRecs = nSkipped ; - } - else - { - nSkipped-- ; - } - } - } - hb_retnl( nSkipped ); } else hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "DBSKIPPER" ); diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 04f606e1af..e776bd6e1f 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -151,6 +151,7 @@ PRG_SOURCES=\ dbedit.prg \ devoutp.prg \ dircmd.prg \ + einstvar.prg \ errorsys.prg \ fieldbl.prg \ getlist.prg \ diff --git a/harbour/source/rtl/browdb.prg b/harbour/source/rtl/browdb.prg index 70ac5c794a..990d5ec14b 100644 --- a/harbour/source/rtl/browdb.prg +++ b/harbour/source/rtl/browdb.prg @@ -54,12 +54,17 @@ FUNCTION TBrowseDB( nTop, nLeft, nBottom, nRight ) LOCAL oBrowse := TBrowseNew( nTop, nLeft, nBottom, nRight ) +#ifdef HB_COMPAT_XPP + oBrowse:SkipBlock := { | nRecs | DbSkipper( nRecs ) } +#else oBrowse:SkipBlock := { | nRecs | Skipped( nRecs ) } +#endif oBrowse:GoTopBlock := { || dbGoTop() } oBrowse:GoBottomBlock := { || dbGoBottom() } RETURN oBrowse +#ifndef HB_COMPAT_XPP STATIC FUNCTION Skipped( nRecs ) LOCAL nSkipped := 0 @@ -88,4 +93,4 @@ STATIC FUNCTION Skipped( nRecs ) ENDIF RETURN nSkipped - +#endif diff --git a/harbour/source/rtl/browse.prg b/harbour/source/rtl/browse.prg index ea80232077..58d000501d 100644 --- a/harbour/source/rtl/browse.prg +++ b/harbour/source/rtl/browse.prg @@ -51,139 +51,394 @@ */ #include "inkey.ch" +#include "setcurs.ch" +#include "box.ch" -function Browse( nTop, nLeft, nBottom, nRight ) +FUNCTION Browse( nTop, nLeft, nBottom, nRight ) - local oBrw - local cOldScreen - local n, nOldCursor - local nKey := 0 - local lExit := .f. - local lGotKey := .f. - local bAction + LOCAL oBrw + LOCAL lExit, lGotKey, lAppend, lKeyPressed, lRefresh + LOCAL n, nOldCursor, nKey + LOCAL cOldScreen + LOCAL bAction - if ! Used() - return .f. - end + IF ! Used() + RETURN .F. + ENDIF - if PCount() < 4 + lExit := lGotKey := lAppend := lKeyPressed := lRefresh := .F. + + IF PCount() < 4 nTop := 1 nLeft := 0 nBottom := MaxRow() nRight := MaxCol() - endif + ENDIF - nOldCursor := SetCursor( 0 ) + DispBegin() + + nOldCursor := SetCursor( SC_NONE ) cOldScreen := SaveScreen( nTop, nLeft, nBottom, nRight ) - @ nTop, nLeft TO nBottom, nRight - @ nTop + 3, nLeft SAY Chr( 198 ) - @ nTop + 3, nRight SAY Chr( 181 ) - @ nTop + 1, nLeft + 1 SAY Space( nRight - nLeft - 1 ) + DispBox( nTop, nLeft, nBottom, nRight, B_DOUBLE_SINGLE ) + DispBox( nTop + 3, nLeft, nTop + 3, nLeft, chr( 198 ) ) + DispBox( nTop + 3, nRight, nTop + 3, nRight, chr( 181 ) ) + DispOutAt( nTop + 1, nLeft + 1, Space( nRight - nLeft - 1 ) ) oBrw := TBrowseDB( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 ) - oBrw:HeadSep := " " + Chr( 205 ) + oBrw:HeadSep := " " + Chr( 205 ) + oBrw:SkipBlock := { | nRecs | Skipped( nRecs, lAppend ) } - for n := 1 to FCount() + FOR n := 1 to FCount() oBrw:AddColumn( TBColumnNew( FieldName( n ), FieldBlock( FieldName( n ) ) ) ) - next + NEXT + + IF Eof() + DbGoTop() + ENDIF oBrw:ForceStable() - while ! lExit + DispEnd() - if nKey == 0 - while !oBrw:stabilize() .and. NextKey() == 0 - enddo - endif + IF LastRec() == 0 + nKey := K_DOWN + lKeyPressed := .T. + ENDIF - if NextKey() == 0 + WHILE ! lExit - oBrw:forceStable() - Statline( oBrw ) + WHILE ! lKeyPressed .AND. ! oBrw:Stabilize() + lKeyPressed := ( nKey := Inkey() ) != 0 + ENDDO - nKey := Inkey( 0 ) + IF ! lKeyPressed - if ( bAction := SetKey( nKey ) ) != nil - Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" ) - loop - endif - else - nKey := Inkey() - endif - - do case - case nKey == K_ESC - lExit := .t. - - case nKey == K_UP - oBrw:Up() - - case nKey == K_DOWN + IF oBrw:HitBottom() .AND. ( ! lAppend .OR. RecNo() != LastRec() + 1 ) + IF lAppend + oBrw:RefreshCurrent() + oBrw:ForceStable() + dbGoBottom() + ELSE + lAppend := .T. + SetCursor( IIF( ReadInsert(), SC_INSERT, SC_NORMAL ) ) + ENDIF oBrw:Down() + oBrw:ForceStable() + oBrw:ColorRect( { oBrw:RowPos, 1, oBrw:RowPos, oBrw:ColCount() }, ; + { 2, 2 } ) + ENDIF - case nKey == K_END - oBrw:End() + StatLine( oBrw, lAppend ) - case nKey == K_HOME - oBrw:Home() + oBrw:ForceStable() - case nKey == K_LEFT + nKey := InKey( 0 ) + IF ( bAction := SetKey( nKey ) ) != NIL + Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "") + LOOP + ENDIF + ELSE + lKeyPressed := .F. + ENDIF + + SWITCH nKey + +#ifdef HB_COMPAT_C53 + CASE K_LBUTTONDOWN + CASE K_LDBLCLK + TBMOUSE( oBrw, MRow(), MCol() ) + EXIT +#endif +#ifdef HB_EXTENSION + CASE K_MWFORWARD +#endif + CASE K_UP + IF lAppend + lRefresh := .T. + ELSE + oBrw:Up() + ENDIF + EXIT + +#ifdef HB_EXTENSION + CASE K_MWBACKWARD +#endif + CASE K_DOWN + IF lAppend + oBrw:HitBottom( .T. ) + ELSE + oBrw:Down() + ENDIF + EXIT + + CASE K_PGUP + IF lAppend + lRefresh := .T. + ELSE + oBrw:PageUp() + ENDIF + EXIT + + CASE K_PGDN + IF lAppend + oBrw:HitBottom( .T. ) + ELSE + oBrw:PageDown() + ENDIF + EXIT + + CASE K_CTRL_PGUP + IF lAppend + lRefresh := .T. + ELSE + oBrw:GoTop() + ENDIF + EXIT + + CASE K_CTRL_PGDN + IF lAppend + lRefresh := .T. + ELSE + oBrw:GoBottom() + ENDIF + EXIT + + CASE K_LEFT oBrw:Left() + EXIT - case nKey == K_RIGHT + CASE K_RIGHT oBrw:Right() + EXIT - case nKey == K_PGUP - oBrw:PageUp() + CASE K_HOME + oBrw:Home() + EXIT - case nKey == K_PGDN - oBrw:PageDown() + CASE K_END + oBrw:End() + EXIT - case nKey == K_CTRL_PGUP - oBrw:GoTop() - - case nKey == K_CTRL_PGDN - oBrw:GoBottom() - - case nKey == K_CTRL_LEFT + CASE K_CTRL_LEFT oBrw:panLeft() + EXIT - case nKey == K_CTRL_RIGHT + CASE K_CTRL_RIGHT oBrw:panRight() + EXIT - case nKey == K_CTRL_HOME + CASE K_CTRL_HOME oBrw:panHome() + EXIT - case nKey == K_CTRL_END + CASE K_CTRL_END oBrw:panEnd() + EXIT - endcase - end + CASE K_INS + IF lAppend + SetCursor( IIF( ReadInsert( ! ReadInsert() ), ; + SC_NORMAL, SC_INSERT ) ) + ENDIF + EXIT + + CASE K_DEL + IF RecNo() != LastRec() + 1 + IF Deleted() + DbRecall() + ELSE + DbDelete() + ENDIF + ENDIF + EXIT + + CASE K_ENTER + IF lAppend .OR. RecNo() != LastRec() + 1 + lKeyPressed := ( nKey := DoGet( oBrw, lAppend ) ) != 0 + ELSE + nKey := K_DOWN + lKeyPressed := .T. + ENDIF + EXIT + + CASE K_ESC + lExit := .t. + EXIT + + OTHERWISE + IF nKey >= 32 .AND. nKey <= 255 + KEYBOARD Chr( nKey ) + nKey := K_ENTER + lKeyPressed := .T. + ENDIF + EXIT + END + + IF lRefresh + lRefresh := lAppend := .F. + FreshOrder( oBrw ) + SetCursor( SC_NONE ) + ENDIF + + ENDDO RestScreen( nTop, nLeft, nBottom, nRight, cOldScreen ) SetCursor( nOldCursor ) -return .t. + RETURN .T. -static procedure Statline( oBrw ) +STATIC FUNCTION StatLine( oBrw, lAppend ) - local nTop := oBrw:nTop - 1 - local nRight := oBrw:nRight + LOCAL nTop := oBrw:nTop - 1 + LOCAL nRight := oBrw:nRight - @ nTop, nRight - 27 SAY "Record " + DispOutAt( nTop, nRight - 27, "Record " ) - if LastRec() == 0 - @ nTop, nRight - 20 SAY " " - elseif RecNo() == LastRec() + 1 - @ nTop, nRight - 40 SAY " " - @ nTop, nRight - 20 SAY " " - else - @ nTop, nRight - 40 SAY iif( Deleted(), "", " " ) - @ nTop, nRight - 20 SAY PadR( LTrim( Str( RecNo() ) ) + "/" +; - Ltrim( Str( LastRec() ) ), 16 ) +; - iif( oBrw:hitTop, "", " " ) - endif + IF LastRec() == 0 .and. ! lAppend + DispOutAt( nTop, nRight - 20, " " ) + ELSEIF RecNo() == LastRec() + 1 + DispOutAt( nTop, nRight - 40, " " ) + DispOutAt( nTop, nRight - 20, " " ) + ELSE + DispOutAt( nTop, nRight - 40, IIF( Deleted(), "", " " ) ) + DispOutAt( nTop, nRight - 20, PadR( LTrim( Str( RecNo() ) ) + "/" + ; + LTrim( Str( LastRec() ) ), 16 ) + ; + IIF( oBrw:HitTop(), "", " " ) ) + ENDIF -return + RETURN NIL +STATIC FUNCTION DoGet( oBrw, lAppend ) + + LOCAL lScore, lExit, bIns, nCursor + LOCAL oCol, oGet + LOCAL cIndexKey, cForExp, xKeyValue + LOCAL lSuccess, nKey, xValue + + oBrw:HitTop( .F. ) + StatLine( oBrw, lAppend ) + oBrw:ForceStable() + + lScore := Set( _SET_SCOREBOARD, .F. ) + lExit := Set( _SET_EXIT, .T. ) + bIns := SetKey( K_INS, {|| SetCursor( IIF( ReadInsert( ! ReadInsert() ), ; + SC_NORMAL, SC_INSERT ) ) } ) + nCursor := SetCursor( IIF( ReadInsert(), SC_INSERT, SC_NORMAL ) ) + IF !Empty( cIndexKey := IndexKey( 0 ) ) + xKeyValue := &cIndexKey + ENDIF + + oCol := oBrw:GetColumn( oBrw:ColPos ) + xValue := Eval( oCol:Block ) + oGet := GetNew( Row(), Col(), ; + { |xNewVal| IIF( PCount() == 0, xValue, xValue := xNewVal ) }, ; + "mGetVar", NIL, oBrw:ColorSpec ) + lSuccess := .F. + IF ReadModal( { oGet } ) + IF lAppend .AND. RecNo() == LastRec() + 1 + dbAppend() + ENDIF + Eval( oCol:Block, xValue ) + + IF !lAppend .AND. !Empty( cForExp := OrdFor( IndexOrd() ) ) .AND. ; + ! &cForExp + dbGoTop() + ENDIF + IF !lAppend .AND. !Empty( cIndexKey ) .AND. ! xKeyValue == &cIndexKey + lSuccess := .T. + ENDIF + ENDIF + + IF lSuccess + FreshOrder( oBrw ) + nKey := 0 + ELSE + oBrw:RefreshCurrent() + nKey := ExitKey( lAppend ) + ENDIF + + IF lAppend + oBrw:ColorRect( { oBrw:rowpos, 1, oBrw:rowpos, oBrw:colcount }, ; + { 2, 2 } ) + ENDIF + + SetCursor( nCursor ) + SetKey( K_INS, bIns ) + Set( _SET_EXIT, lExit ) + Set( _SET_SCOREBOARD, lScore ) + + RETURN nKey + +STATIC FUNCTION ExitKey( lAppend ) + + LOCAL nKey := LastKey() + + SWITCH nKey + CASE K_PGDN + nKey := IIF( lAppend, 0, K_DOWN ) + EXIT + + CASE K_PGUP + nKey := IIF( lAppend, 0, K_UP ) + + CASE K_DOWN + CASE K_UP + EXIT + + OTHERWISE + nKey := IIF( nKey == 13 .OR. ; + ( nKey >= 32 .AND. nKey <= 255 ), K_RIGHT, 0 ) + EXIT + END + + RETURN nKey + +STATIC FUNCTION FreshOrder( oBrw ) + + LOCAL nRec := RecNo() + + oBrw:RefreshAll() + oBrw:ForceStable() + + IF nRec != LastRec() + 1 + WHILE RecNo() != nRec .AND. !BOF() + oBrw:Up() + oBrw:ForceStable() + ENDDO + ENDIF + + RETURN NIL + +STATIC FUNCTION Skipped( nRecs, lAppend ) + + LOCAL nSkipped := 0 + + IF LastRec() != 0 + IF nRecs == 0 + dbSkip( 0 ) + ELSEIF nRecs > 0 .AND. RecNo() != LastRec() + 1 + DO WHILE nSkipped < nRecs + dbSkip() + IF Eof() + IF lAppend + nSkipped++ + ELSE + dbSkip( -1 ) + ENDIF + EXIT + ENDIF + nSkipped++ + ENDDO + ELSEIF nRecs < 0 + DO WHILE nSkipped > nRecs + dbSkip( -1 ) + IF Bof() + EXIT + ENDIF + nSkipped-- + ENDDO + ENDIF + ENDIF + + RETURN nSkipped diff --git a/harbour/source/rtl/einstvar.prg b/harbour/source/rtl/einstvar.prg new file mode 100644 index 0000000000..6ae6521915 --- /dev/null +++ b/harbour/source/rtl/einstvar.prg @@ -0,0 +1,77 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Undocumented CA-Cl*pper function used to validate + * instance variable type in assign messages. + * + * Copyright 2007 Przemyslaw Czerpak + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "common.ch" + +FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid ) + + LOCAL oError + + IF VALTYPE( xValue ) != cType .OR. ; + ( bValid != NIL .AND. !EVAL( bValid, oVar, xValue ) ) + oError := errornew() + oError:description := HB_LANGERRMSG( 1 ) + oError:gencode := 1 + oError:severity := 2 + oError:cansubstitute := .T. + oError:subsystem := oVar:classname + oError:operation := cMethod + oError:subcode := nSubCode + oError:args := { xValue } + xValue := EVAL( ERRORBLOCK(), oError ) + IF VALTYPE( xValue ) != cType + __errInHandler() + ENDIF + ENDIF + + RETURN xValue diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index a21e235714..ec3770f244 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -715,7 +715,7 @@ HB_EXPORT BOOL hb_arraySetND( PHB_ITEM pArray, ULONG ulIndex, double dNumber ) return FALSE; } -HB_EXPORT BOOL hb_arraySetC( PHB_ITEM pArray, ULONG ulIndex, char * szText ) +HB_EXPORT BOOL hb_arraySetC( PHB_ITEM pArray, ULONG ulIndex, const char * szText ) { HB_TRACE(HB_TR_DEBUG, ("hb_arraySetC(%p, %lu, %p)", pArray, ulIndex, szText)); @@ -728,7 +728,7 @@ HB_EXPORT BOOL hb_arraySetC( PHB_ITEM pArray, ULONG ulIndex, char * szText ) return FALSE; } -HB_EXPORT BOOL hb_arraySetCL( PHB_ITEM pArray, ULONG ulIndex, char * szText, ULONG ulLen ) +HB_EXPORT BOOL hb_arraySetCL( PHB_ITEM pArray, ULONG ulIndex, const char * szText, ULONG ulLen ) { HB_TRACE(HB_TR_DEBUG, ("hb_arraySetC(%p, %lu, %p, %lu)", pArray, ulIndex, szText, ulLen));