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

2007-12-19 18:48 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/xhb/Makefile
  * harbour/contrib/xhb/common.mak
  + harbour/contrib/xhb/xhbqself.c
    + added xHarbour compatible HB_QSELF() function

  * harbour/contrib/xhb/xhbfunc.c
    * removed HB_QSELF() redirecting to Class(y) compatible __SENDER()
      function

  * harbour/contrib/xhb/xhbcomp.prg
    ! fixed scalar classes overloading, do not enable extended messages
      for basic types if user haven't requested it (ENABLE TYPE CLASS ...),
      use scalar classes defined in RTL
This commit is contained in:
Przemyslaw Czerpak
2007-12-19 17:48:57 +00:00
parent ed89a813a2
commit 2be165e461
6 changed files with 155 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
harbour/ChangeLog
View File

@@ -8,6 +8,21 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-12-19 18:48 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/xhb/Makefile
* harbour/contrib/xhb/common.mak
+ harbour/contrib/xhb/xhbqself.c
+ added xHarbour compatible HB_QSELF() function
* harbour/contrib/xhb/xhbfunc.c
* removed HB_QSELF() redirecting to Class(y) compatible __SENDER()
function
* harbour/contrib/xhb/xhbcomp.prg
! fixed scalar classes overloading, do not enable extended messages
for basic types if user haven't requested it (ENABLE TYPE CLASS ...),
use scalar classes defined in RTL
2007-12-19 13:05 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbmath.h
* harbour/source/rtl/math.c

1
harbour/contrib/xhb/Makefile
View File

@@ -12,6 +12,7 @@ C_SOURCES=\
xhbenum.c \
xhbfunc.c \
xhbmsgs.c \
xhbqself.c \
xhbwith.c \
hbcomprs.c \
hbchksum.c \

1
harbour/contrib/xhb/common.mak
View File

@@ -28,6 +28,7 @@ LIB_OBJS = \
$(OBJ_DIR)\xhbenum$(OBJEXT) \
$(OBJ_DIR)\xhbfunc$(OBJEXT) \
$(OBJ_DIR)\xhbmsgs$(OBJEXT) \
$(OBJ_DIR)\xhbqself$(OBJEXT) \
$(OBJ_DIR)\xhbwith$(OBJEXT) \
$(OBJ_DIR)\hbcomprs$(OBJEXT) \
$(OBJ_DIR)\hbchksum$(OBJEXT) \

255
harbour/contrib/xhb/xhbcomp.prg
View File

@@ -52,19 +52,39 @@
#include "common.ch"
#include "hbclass.ch"
#include "xhb.ch"
ANNOUNCE XHB_LIB
INIT PROCEDURE xhb_Init()
/* Add calls to do initial settings to Harbour to be more compatible with xhb. */
ASSOCIATE CLASS xhb_Character WITH TYPE Character
ASSOCIATE CLASS xhb_Numeric WITH TYPE Numeric
ASSOCIATE CLASS xhb_Array WITH TYPE Array
ASSOCIATE CLASS xhb_Hash WITH TYPE Hash
if type("HBCHARACTER()")=="UI"
ASSOCIATE CLASS _Character WITH TYPE Character
else
ASSOCIATE CLASS xhb_Character WITH TYPE Character
endif
if type("HBNUMERIC()")=="UI"
ASSOCIATE CLASS _Numeric WITH TYPE Numeric
else
ASSOCIATE CLASS xhb_Numeric WITH TYPE Numeric
endif
if type("HBARRAY()")=="UI"
ASSOCIATE CLASS _Array WITH TYPE Array
else
ASSOCIATE CLASS xhb_Array WITH TYPE Array
endif
if type("HBHASH()")=="UI"
ASSOCIATE CLASS _Hash WITH TYPE Hash
else
ASSOCIATE CLASS xhb_Hash WITH TYPE Hash
endif
RETURN
CREATE CLASS Character INHERIT HBScalar FUNCTION xhb_Character
CREATE CLASS Character FUNCTION xhb_Character
OPERATOR "[]" FUNCTION XHB_INDEX()
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
@@ -74,11 +94,10 @@ CREATE CLASS Character INHERIT HBScalar FUNCTION xhb_Character
OPERATOR "^" FUNCTION XHB_POW()
OPERATOR "++" FUNCTION XHB_INC()
OPERATOR "--" FUNCTION XHB_DEC()
METHOD AsString INLINE HB_QSelf()
ENDCLASS
CREATE CLASS Numeric INHERIT HBScalar FUNCTION xhb_Numeric
CREATE CLASS Character INHERIT __HBCharacter FUNCTION _Character
OPERATOR "[]" FUNCTION XHB_INDEX()
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "*" FUNCTION XHB_MULT()
@@ -87,198 +106,50 @@ CREATE CLASS Numeric INHERIT HBScalar FUNCTION xhb_Numeric
OPERATOR "^" FUNCTION XHB_POW()
OPERATOR "++" FUNCTION XHB_INC()
OPERATOR "--" FUNCTION XHB_DEC()
METHOD AsString INLINE LTrim( Str( ( HB_QSelf() ) ) )
ENDCLASS
CREATE CLASS Array INHERIT HBScalar FUNCTION xhb_Array
CREATE CLASS Numeric FUNCTION xhb_Numeric
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "*" FUNCTION XHB_MULT()
OPERATOR "/" FUNCTION XHB_DIV()
OPERATOR "%" FUNCTION XHB_MOD()
OPERATOR "^" FUNCTION XHB_POW()
OPERATOR "++" FUNCTION XHB_INC()
OPERATOR "--" FUNCTION XHB_DEC()
ENDCLASS
CREATE CLASS Numeric INHERIT __HBNumeric FUNCTION _Numeric
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "*" FUNCTION XHB_MULT()
OPERATOR "/" FUNCTION XHB_DIV()
OPERATOR "%" FUNCTION XHB_MOD()
OPERATOR "^" FUNCTION XHB_POW()
OPERATOR "++" FUNCTION XHB_INC()
OPERATOR "--" FUNCTION XHB_DEC()
ENDCLASS
CREATE CLASS Array FUNCTION xhb_Array
OPERATOR "[]" FUNCTION XHB_INDEX()
OPERATOR "$$" FUNCTION XHB_INCLUDE()
MESSAGE Add METHOD Append
METHOD AddAll
METHOD Append
METHOD asString INLINE '{...}' //ValtoPrg( HB_QSelf() )
METHOD At( n ) INLINE Self[ n ]
METHOD AtIndex( n ) INLINE Self[ n ]
METHOD AtPut( n, x ) INLINE Self[ n ] := x
METHOD Collect
METHOD Copy INLINE aCopy( Self, Array( Len( Self ) ) )
METHOD DeleteAt
METHOD Do
METHOD IndexOf
METHOD Init( nLen ) INLINE ::Size := IIF( nLen == NIL, 0, nLen ), Self
METHOD InsertAt
METHOD Remove
METHOD Scan( bScan ) INLINE aScan( Self, bScan )
METHOD _Size( nLen ) INLINE aSize( Self, nLen ), nLen
ENDCLASS
CREATE CLASS Hash INHERIT HBScalar FUNCTION xhb_Hash
CREATE CLASS Array INHERIT __HBArray FUNCTION _Array
OPERATOR "[]" FUNCTION XHB_INDEX()
OPERATOR "$$" FUNCTION XHB_INCLUDE()
ENDCLASS
CREATE CLASS Hash FUNCTION xhb_Hash
ON ERROR FUNCTION XHB_HASHERROR()
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "$$" FUNCTION XHB_INCLUDE()
METHOD Add( xKey, xValue ) INLINE Self[ xKey ] := xValue, Self
METHOD AddAll( oCollection )
METHOD AtIndex( nPos ) INLINE HGetValueAt( Self, nPos )
METHOD AtPut( nPos, xValue ) INLINE HSetValueAt( Self, nPos, xValue )
METHOD Append( xKey, xValue ) INLINE Self[ xKey ] := xValue, Self
METHOD AsString() INLINE '...HASH...' // ValToPrg( HB_QSelf() )
METHOD Collect( bCollect )
METHOD Copy() INLINE hCopy( Self, Hash() )
METHOD DeleteAt( nPos ) INLINE hDelat( Self, nPos )
METHOD Do( bBlock )
METHOD IndexOf( xValue ) INLINE hScan( Self, xValue )
METHOD Init( nLen ) INLINE ::Size := IIF( nLen == NIL, 0, nLen ), Self
METHOD Remove( xValue ) INLINE hDel( Self, xValue )
METHOD Scan( bScan ) INLINE hScan( Self, bScan )
METHOD _Size( nLen )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD AddAll( otherCollection ) CLASS Array
otherCollection:Do( {|x| ::Add(x) } )
RETURN Self
//----------------------------------------------------------------------------//
METHOD Append( x ) CLASS Array
aAdd( Self, x )
RETURN Self
//----------------------------------------------------------------------------//
METHOD Collect( bCollect ) CLASS Array
LOCAL xElement, aResult[0]
FOR EACH xElement IN Self
IF Eval( bCollect, UnRef( xElement ) )
aAdd( aResult, UnRef( xElement ) )
END
NEXT
RETURN aResult
//----------------------------------------------------------------------------//
METHOD deleteAt( nPos ) CLASS Array
IF nPos > 0 .AND. nPos <= Len( Self )
aDel( Self, nPos, .T. )
ENDIF
RETURN Self
//----------------------------------------------------------------------------//
METHOD Do( bEval ) CLASS Array
LOCAL xElement
FOR EACH xElement IN Self
bEval:Eval( UnRef( xElement ), HB_EnumIndex() )
NEXT
RETURN Self
//----------------------------------------------------------------------------//
METHOD IndexOf( xValue ) CLASS Array
LOCAL xElement, cType := ValType( xValue )
FOR EACH xElement IN Self
IF ValType( xElement ) == cType .AND. xElement == xValue
RETURN HB_EnumIndex()
END
NEXT
RETURN 0
//----------------------------------------------------------------------------//
METHOD InsertAt( nPos, xValue ) CLASS Array
IF nPos > Len( self )
aSize( Self, nPos )
Self[ nPos ] := xValue
ELSEIF nPos > 0
aIns( Self, nPos, xValue, .T. )
ENDIF
RETURN Self
//----------------------------------------------------------------------------//
METHOD Remove( xValue ) CLASS Array
::DeleteAt( ::IndexOf( xValue ) )
RETURN Self
//----------------------------------------------------------------------------//
METHOD AddAll( oCollection ) CLASS HASH
oCollection:Do( { |xKey, xValue| Self[ xKey ] := xValue } )
RETURN Self
//----------------------------------------------------------------------------//
METHOD Collect( bCollect ) CLASS HASH
LOCAL xElement, aResult[0]
FOR EACH xElement IN Self:Values
IF Eval( bCollect, UnRef( xElement ) )
aAdd( aResult, UnRef( xElement ) )
END
NEXT
RETURN aResult
//----------------------------------------------------------------------------//
METHOD Do( bDo ) CLASS HASH
LOCAL xKey
FOR EACH xKey IN Self:Keys
Eval( bDo, xKey, Self[ xKey ] )
NEXT
RETURN Self
//----------------------------------------------------------------------------//
METHOD _Size( nLen ) CLASS HASH
LOCAL nOldLen := Len( Self ), Counter
IF nLen == nOldLen
RETURN nLen
ELSEIF nLen > nOldLen
hAllocate( Self, nLen )
FOR Counter := nOldLen + 1 TO nLen
Self[ "_SIZED_" + LTrim( Str( Counter ) ) ] := NIL
NEXT
ELSE
FOR Counter := nOldLen TO nLen + 1
hDelAt( Self, nLen + 1 )
NEXT
ENDIF
RETURN nLen
//----------------------------------------------------------------------------//
FUNCTION UnRef( xValue )
RETURN xValue
//----------------------------------------------------------------------------//
CREATE CLASS Hash INHERIT __HBHash FUNCTION _Hash
ON ERROR FUNCTION XHB_HASHERROR()
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "$$" FUNCTION XHB_INCLUDE()
ENDCLASS

8
harbour/contrib/xhb/xhbfunc.c
View File

@@ -251,11 +251,3 @@ HB_FUNC( ISINETSOCKET ) { HB_FUNC_EXEC( HB_INETISSOCKET ); }
HB_FUNC( INETDESTROY ) { }
#endif /* !HB_NO_DEFAULT_INET */
HB_FUNC_EXTERN( __SENDER );
HB_FUNC( HB_QSELF )
{
HB_FUNC_EXEC( __SENDER )
}

75
harbour/contrib/xhb/xhbqself.c Normal file
View File

@@ -0,0 +1,75 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* xHarbour compatible HB_QSELF() function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbvmopt.h"
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbstack.h"
HB_FUNC( HB_QSELF )
{
LONG lOffset = hb_stackBaseProcOffset( 1 );
if( lOffset > 0 )
{
PHB_ITEM pSelf = hb_stackItem( lOffset + 1 );
if( lOffset > 0 && HB_IS_BLOCK( pSelf ) &&
hb_itemGetSymbol( hb_stackItem( lOffset ) ) == &hb_symEval )
{
pSelf = hb_stackItem( hb_stackItem( lOffset )->
item.asSymbol.stackstate->lBaseItem + 1 );
}
hb_itemReturn( pSelf );
}
}