From f2b0c25e87685bd11c874b1aa15e434bbc0818fa Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Tue, 18 Sep 2007 12:40:49 +0000 Subject: [PATCH] 2007-09-18 14:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbclass.ch + added new commands for scalar classes: ASSOCIATE CLASS WITH TYPE ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL| NUMERIC|POINTER|SYMBOL ENABLE CLASS TYPE ALL ENABLE TYPE CLASS ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL| NUMERIC|POINTER|SYMBOL Please remeber that: ENABLE CLASS TYPE ALL and: ENABLE TYPE CLASS ... can be used in any place of code - this commands are translated to REQUEST HB so are not executed * harbour/source/vm/classes.c + added __clsAssocType( , ) => * harbour/common.mak * harbour/source/rtl/tscalar.prg * harbour/source/rtl/Makefile + harbour/source/rtl/tscalars.c + harbour/source/rtl/tscalard.c + harbour/source/rtl/tscalarh.c + harbour/source/rtl/tscalarl.c + harbour/source/rtl/tscalarp.c + harbour/source/rtl/tscalara.c + harbour/source/rtl/tscalaru.c + harbour/source/rtl/tscalarb.c + harbour/source/rtl/tscalarn.c + harbour/source/rtl/tscalarc.c + added scalar classes for basic types, Now it's possible to define messages also for basic item types. It's even possible to overload some not defined in HVM operators, f.e. in this example we overload operator "+" so it makes AADD( , ) for code like + : #include "hbclass.ch" PROC MAIN() LOCAL a:={} ASSOCIATE CLASS MyArray WITH TYPE ARRAY a := a + "elem1" a += "elem2" a := a + "elem3" a += "elem4" ? a:asString, a:isScalar AEVAL(a,{|x,i|QOUT(i,x)}) RETURN CREATE CLASS MyArray INHERIT __HBArray OPERATOR "+" ARG xValue INLINE AADD( Self, xValue ), Self ENDCLASS Operators which have default actions for given types defined in HVM cannot be overloaded. --- harbour/ChangeLog | 56 ++++++++++++++++ harbour/common.mak | 10 +++ harbour/include/hbclass.ch | 16 +++++ harbour/source/rtl/Makefile | 10 +++ harbour/source/rtl/tscalar.prg | 20 +++--- harbour/source/rtl/tscalara.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalarb.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalarc.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalard.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalarh.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalarl.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalarn.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalarp.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalars.c | 73 +++++++++++++++++++++ harbour/source/rtl/tscalaru.c | 73 +++++++++++++++++++++ harbour/source/vm/classes.c | 116 +++++++++++++++++++++++++-------- 16 files changed, 922 insertions(+), 36 deletions(-) create mode 100644 harbour/source/rtl/tscalara.c create mode 100644 harbour/source/rtl/tscalarb.c create mode 100644 harbour/source/rtl/tscalarc.c create mode 100644 harbour/source/rtl/tscalard.c create mode 100644 harbour/source/rtl/tscalarh.c create mode 100644 harbour/source/rtl/tscalarl.c create mode 100644 harbour/source/rtl/tscalarn.c create mode 100644 harbour/source/rtl/tscalarp.c create mode 100644 harbour/source/rtl/tscalars.c create mode 100644 harbour/source/rtl/tscalaru.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 73d2cfc672..62afe4012e 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,62 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-09-18 14:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbclass.ch + + added new commands for scalar classes: + ASSOCIATE CLASS WITH TYPE + ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL| + NUMERIC|POINTER|SYMBOL + ENABLE CLASS TYPE ALL + ENABLE TYPE CLASS ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL| + NUMERIC|POINTER|SYMBOL + Please remeber that: + ENABLE CLASS TYPE ALL + and: + ENABLE TYPE CLASS ... + can be used in any place of code - this commands are translated to + REQUEST HB + so are not executed + + * harbour/source/vm/classes.c + + added __clsAssocType( , ) => + + * harbour/common.mak + * harbour/source/rtl/tscalar.prg + * harbour/source/rtl/Makefile + + harbour/source/rtl/tscalars.c + + harbour/source/rtl/tscalard.c + + harbour/source/rtl/tscalarh.c + + harbour/source/rtl/tscalarl.c + + harbour/source/rtl/tscalarp.c + + harbour/source/rtl/tscalara.c + + harbour/source/rtl/tscalaru.c + + harbour/source/rtl/tscalarb.c + + harbour/source/rtl/tscalarn.c + + harbour/source/rtl/tscalarc.c + + added scalar classes for basic types, + Now it's possible to define messages also for basic item types. + It's even possible to overload some not defined in HVM operators, + f.e. in this example we overload operator "+" so it makes + AADD( , ) + for code like + : + #include "hbclass.ch" + PROC MAIN() + LOCAL a:={} + ASSOCIATE CLASS MyArray WITH TYPE ARRAY + a := a + "elem1" + a += "elem2" + a := a + "elem3" + a += "elem4" + ? a:asString, a:isScalar + AEVAL(a,{|x,i|QOUT(i,x)}) + RETURN + CREATE CLASS MyArray INHERIT __HBArray + OPERATOR "+" ARG xValue INLINE AADD( Self, xValue ), Self + ENDCLASS + Operators which have default actions for given types defined in HVM + cannot be overloaded. + 2007-09-18 00:45 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbapicls.h * harbour/source/vm/hvm.c diff --git a/harbour/common.mak b/harbour/common.mak index ee7e17756b..ef43997f62 100644 --- a/harbour/common.mak +++ b/harbour/common.mak @@ -514,6 +514,16 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\trace$(OBJEXT) \ $(OBJ_DIR)\transfrm$(OBJEXT) \ $(OBJ_DIR)\trim$(OBJEXT) \ + $(OBJ_DIR)\tscalara$(OBJEXT) \ + $(OBJ_DIR)\tscalarb$(OBJEXT) \ + $(OBJ_DIR)\tscalarc$(OBJEXT) \ + $(OBJ_DIR)\tscalard$(OBJEXT) \ + $(OBJ_DIR)\tscalarh$(OBJEXT) \ + $(OBJ_DIR)\tscalarl$(OBJEXT) \ + $(OBJ_DIR)\tscalarn$(OBJEXT) \ + $(OBJ_DIR)\tscalarp$(OBJEXT) \ + $(OBJ_DIR)\tscalars$(OBJEXT) \ + $(OBJ_DIR)\tscalaru$(OBJEXT) \ $(OBJ_DIR)\type$(OBJEXT) \ $(OBJ_DIR)\val$(OBJEXT) \ $(OBJ_DIR)\valtostr$(OBJEXT) \ diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index 4b97ed15d2..3c348c769a 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -535,4 +535,20 @@ DECLARE HBClass ; _HB_MEMBER {[ AS ] [, ] } ;; s_oClass:AddMultiClsData( <(type)>, , __HB_CLS_SCOPE( <.export.>, <.protect.>, <.hidde.> ) + iif( <.ro.>, HB_OO_CLSTP_READONLY, 0 ) + iif( <.share.>, HB_OO_CLSTP_SHARED, 0 ) + iif( <.persistent.>, HB_OO_CLSTP_PERSIST, 0 ), {<(DataName1)> [, <(DataNameN)>]}, __HB_CLS_NOINI ) + +/* Scalar classes support */ +#command ASSOCIATE CLASS WITH TYPE => ; + __clsAssocType( __clsInstSuper( @() ), # ) + +#command ENABLE TYPE CLASS ; + [, ] => ; + REQUEST HB [, HB] + +#command ENABLE TYPE CLASS ALL => ; + REQUEST HBArray, HBBlock, HBCharacter, HBDate, HBHash, ; + HBLogical, HBNil, HBNumeric, HBSymbol, HBPointer + #endif /* HB_CLASS_CH_ */ diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 5fa69cb9e3..2e8ec10664 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -124,6 +124,16 @@ C_SOURCES=\ trace.c \ transfrm.c \ trim.c \ + tscalara.c \ + tscalarb.c \ + tscalarc.c \ + tscalard.c \ + tscalarh.c \ + tscalarl.c \ + tscalarn.c \ + tscalarp.c \ + tscalars.c \ + tscalaru.c \ type.c \ val.c \ valtostr.c \ diff --git a/harbour/source/rtl/tscalar.prg b/harbour/source/rtl/tscalar.prg index 5aa772f11f..81f50b6acc 100644 --- a/harbour/source/rtl/tscalar.prg +++ b/harbour/source/rtl/tscalar.prg @@ -109,7 +109,7 @@ METHOD BecomeErr() CLASS ScalarObject /* -------------------------------------------- */ -CREATE CLASS Array INHERIT HBScalar FUNCTION HBArray +CREATE CLASS Array INHERIT HBScalar FUNCTION __HBArray METHOD Init() @@ -241,7 +241,7 @@ METHOD _Size( newSize ) CLASS Array /* -------------------------------------------- */ -CREATE CLASS Block INHERIT HBScalar FUNCTION HBBlock +CREATE CLASS Block INHERIT HBScalar FUNCTION __HBBlock METHOD AsString() @@ -252,7 +252,7 @@ METHOD AsString() CLASS Block /* -------------------------------------------- */ -CREATE CLASS Character INHERIT HBScalar FUNCTION HBCharacter +CREATE CLASS Character INHERIT HBScalar FUNCTION __HBCharacter METHOD AsString() METHOD AsExpStr() @@ -267,7 +267,7 @@ METHOD AsExpStr() CLASS Character /* -------------------------------------------- */ -CREATE CLASS Date INHERIT HBScalar FUNCTION HBDate +CREATE CLASS Date INHERIT HBScalar FUNCTION __HBDate METHOD AsString() METHOD AsExpStr() @@ -282,7 +282,7 @@ METHOD AsExpStr() CLASS Date /* -------------------------------------------- */ -CREATE CLASS Hash INHERIT HBScalar FUNCTION HBHash +CREATE CLASS Hash INHERIT HBScalar FUNCTION __HBHash METHOD AsString() @@ -293,7 +293,7 @@ METHOD AsString() CLASS Hash /* -------------------------------------------- */ -CREATE CLASS Logical INHERIT HBScalar FUNCTION HBLogical +CREATE CLASS Logical INHERIT HBScalar FUNCTION __HBLogical METHOD AsString() @@ -304,7 +304,7 @@ METHOD AsString() CLASS Logical /* -------------------------------------------- */ -CREATE CLASS Nil INHERIT HBScalar FUNCTION HBNil +CREATE CLASS Nil INHERIT HBScalar FUNCTION __HBNil METHOD AsString() @@ -315,7 +315,7 @@ METHOD AsString() CLASS Nil /* -------------------------------------------- */ -CREATE CLASS Numeric INHERIT HBScalar FUNCTION HBNumeric +CREATE CLASS Numeric INHERIT HBScalar FUNCTION __HBNumeric METHOD AsString() @@ -326,7 +326,7 @@ METHOD AsString() CLASS Numeric /* -------------------------------------------- */ -CREATE CLASS Symbol INHERIT HBScalar FUNCTION HBSymbol +CREATE CLASS Symbol INHERIT HBScalar FUNCTION __HBSymbol METHOD AsString() @@ -337,7 +337,7 @@ METHOD AsString() CLASS Symbol /* -------------------------------------------- */ -CREATE CLASS Pointer INHERIT HBScalar FUNCTION HBPointer +CREATE CLASS Pointer INHERIT HBScalar FUNCTION __HBPointer METHOD AsString() diff --git a/harbour/source/rtl/tscalara.c b/harbour/source/rtl/tscalara.c new file mode 100644 index 0000000000..5939e5a2d3 --- /dev/null +++ b/harbour/source/rtl/tscalara.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Array scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBARRAY ); + +HB_FUNC( HBARRAY ) +{ + HB_FUNC_EXEC( __HBARRAY ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalarb.c b/harbour/source/rtl/tscalarb.c new file mode 100644 index 0000000000..3c390aa67f --- /dev/null +++ b/harbour/source/rtl/tscalarb.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Block scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBBLOCK ); + +HB_FUNC( HBBLOCK ) +{ + HB_FUNC_EXEC( __HBBLOCK ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalarc.c b/harbour/source/rtl/tscalarc.c new file mode 100644 index 0000000000..16c7486f5d --- /dev/null +++ b/harbour/source/rtl/tscalarc.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Character scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBCHARACTER ); + +HB_FUNC( HBCHARACTER ) +{ + HB_FUNC_EXEC( __HBCHARACTER ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalard.c b/harbour/source/rtl/tscalard.c new file mode 100644 index 0000000000..d814bf9048 --- /dev/null +++ b/harbour/source/rtl/tscalard.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Date scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBDATE ); + +HB_FUNC( HBDATE ) +{ + HB_FUNC_EXEC( __HBDATE ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalarh.c b/harbour/source/rtl/tscalarh.c new file mode 100644 index 0000000000..52764da7da --- /dev/null +++ b/harbour/source/rtl/tscalarh.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Hash scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBHASH ); + +HB_FUNC( HBHASH ) +{ + HB_FUNC_EXEC( __HBHASH ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalarl.c b/harbour/source/rtl/tscalarl.c new file mode 100644 index 0000000000..e4a05aca0a --- /dev/null +++ b/harbour/source/rtl/tscalarl.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Logical scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBLOGICAL ); + +HB_FUNC( HBLOGICAL ) +{ + HB_FUNC_EXEC( __HBLOGICAL ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalarn.c b/harbour/source/rtl/tscalarn.c new file mode 100644 index 0000000000..7f5925f5d9 --- /dev/null +++ b/harbour/source/rtl/tscalarn.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Numeric scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBNUMERIC ); + +HB_FUNC( HBNUMERIC ) +{ + HB_FUNC_EXEC( __HBNUMERIC ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalarp.c b/harbour/source/rtl/tscalarp.c new file mode 100644 index 0000000000..7e68a4f67b --- /dev/null +++ b/harbour/source/rtl/tscalarp.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Pointer scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBPOINTER ); + +HB_FUNC( HBPOINTER ) +{ + HB_FUNC_EXEC( __HBPOINTER ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalars.c b/harbour/source/rtl/tscalars.c new file mode 100644 index 0000000000..12cb1779f8 --- /dev/null +++ b/harbour/source/rtl/tscalars.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Symbol scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBSYMBOL ); + +HB_FUNC( HBSYMBOL ) +{ + HB_FUNC_EXEC( __HBSYMBOL ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/rtl/tscalaru.c b/harbour/source/rtl/tscalaru.c new file mode 100644 index 0000000000..bc7b60ec9f --- /dev/null +++ b/harbour/source/rtl/tscalaru.c @@ -0,0 +1,73 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * NIL scalar class function + * + * 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 "hbapi.h" +#include "hbvm.h" + +HB_FUNC_EXTERN( __HBNIL ); + +HB_FUNC( HBNIL ) +{ + HB_FUNC_EXEC( __HBNIL ); + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pItem = hb_param( -1, HB_IT_ANY ); + + if( HB_IS_OBJECT( pItem ) ) + { + hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) ); + hb_vmPush( pItem ); + hb_vmSend( 0 ); + } + } +} diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index 2e00c7364d..23ad934f53 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -1315,6 +1315,20 @@ HB_EXPORT USHORT hb_clsFindClass( const char * szClass, const char * szFunc ) return 0; } +static USHORT hb_clsFindClassByFunc( PHB_SYMB pClassFuncSym ) +{ + USHORT uiClass; + + for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ ) + { + if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym ) + { + return uiClass; + } + } + return 0; +} + /* * Get the real class name of an object message * Will return the class name from wich the message is inherited in case @@ -1557,7 +1571,7 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, pStack->uiClass = pObject->item.asArray.value->uiClass; if( pObject->item.asArray.value->uiPrevCls ) { - if( pObject->item.asArray.value->ulLen ) + if( pObject->item.asArray.value->ulLen ) { /* * Copy real object - do not move! the same super casted @@ -2228,7 +2242,7 @@ static USHORT hb_clsUpdateScope( USHORT uiScope, BOOL fAssign ) return uiScope; } -static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem ) +static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem, HB_TYPE nDefault ) { if( pItem ) { @@ -2269,7 +2283,10 @@ static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem ) case 'N': case 'n': - return HB_IT_NUMERIC; + if( hb_stricmp( hb_itemGetCPtr( pItem ), "nil" ) == 0 ) + return HB_IT_NIL; + else + return HB_IT_NUMERIC; case 'A': case 'a': @@ -2285,8 +2302,10 @@ static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem ) } } else if( HB_IS_ARRAY( pItem ) ) - return HB_IT_ARRAY; - + { + if( pItem->item.asArray.value->uiClass == 0 ) + return HB_IT_ARRAY; + } else if( HB_IS_NUMINT( pItem ) ) return HB_IT_NUMINT; @@ -2307,9 +2326,12 @@ static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem ) else if( HB_IS_SYMBOL( pItem ) ) return HB_IT_SYMBOL; + + else if( HB_IS_NIL( pItem ) ) + return HB_IT_NIL; } - return 0; + return nDefault; } /* ================================================ */ @@ -2570,7 +2592,7 @@ static BOOL hb_clsAddMsg( USHORT uiClass, const char * szMessage, pNewMeth->pFuncSym = &s___msgSetData; pNewMeth->uiData = uiIndex; pNewMeth->uiOffset = pClass->uiDataFirst; - pNewMeth->itemType = hb_clsGetItemType( pInit ); + pNewMeth->itemType = hb_clsGetItemType( pInit, 0 ); } break; @@ -2587,7 +2609,7 @@ static BOOL hb_clsAddMsg( USHORT uiClass, const char * szMessage, case HB_OO_MSG_CLSASSIGN: pNewMeth->uiData = uiIndex; - pNewMeth->itemType = hb_clsGetItemType( pInit ); + pNewMeth->itemType = hb_clsGetItemType( pInit, 0 ); pNewMeth->uiScope = hb_clsUpdateScope( uiScope, TRUE ); /* Class(y) does not allow to write to HIDDEN+READONLY instance variables, [druzus] */ @@ -3379,14 +3401,7 @@ HB_FUNC( __CLSINSTSUPER ) if( pClassFuncSym ) { - for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ ) - { - if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym ) - { - uiClassH = uiClass; - break; - } - } + uiClassH = hb_clsFindClassByFunc( pClassFuncSym ); if( uiClassH == 0 ) { hb_vmPushSymbol( pClassFuncSym ); @@ -3405,14 +3420,7 @@ HB_FUNC( __CLSINSTSUPER ) uiClassH = uiClass; else { - for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ ) - { - if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym ) - { - uiClassH = uiClass; - break; - } - } + uiClassH = hb_clsFindClassByFunc( pClassFuncSym ); /* still not found, try to send NEW() message */ if( uiClassH == 0 ) { @@ -3435,9 +3443,7 @@ HB_FUNC( __CLSINSTSUPER ) if( uiClassH && HB_IS_OBJECT( pObject ) ) pObject->item.asArray.value->uiClass = 0; else if( hb_vmRequestQuery() == 0 ) - { hb_errRT_BASE( EG_ARG, 3002, "Super class does not return an object", "__CLSINSTSUPER", 0 ); - } } } } @@ -3449,6 +3455,64 @@ HB_FUNC( __CLSINSTSUPER ) hb_retni( uiClassH ); } +/* + * = __clsAssocType( , ) + * + * Associate class with given basic type + */ +HB_FUNC( __CLSASSOCTYPE ) +{ + USHORT uiClass = ( USHORT ) hb_parni( 1 ); + PHB_ITEM pType = hb_param( 2, HB_IT_ANY ); + BOOL fResult = FALSE; + + if( uiClass && uiClass <= s_uiClasses && pType ) + { + HB_TYPE nType = hb_clsGetItemType( pType, HB_IT_ANY ); + if( nType != HB_IT_ANY ) + { + switch( nType ) + { + case HB_IT_ARRAY: + s_uiArrayClass = uiClass; + break; + case HB_IT_BLOCK: + s_uiBlockClass = uiClass; + break; + case HB_IT_STRING: + s_uiCharacterClass = uiClass; + break; + case HB_IT_DATE: + s_uiDateClass = uiClass; + break; + case HB_IT_HASH: + s_uiHashClass = uiClass; + break; + case HB_IT_LOGICAL: + s_uiLogicalClass = uiClass; + break; + case HB_IT_NIL: + s_uiNilClass = uiClass; + break; + case HB_IT_NUMERIC: + s_uiNumericClass = uiClass; + break; + case HB_IT_SYMBOL: + s_uiSymbolClass = uiClass; + break; + case HB_IT_POINTER: + s_uiPointerClass = uiClass; + break; + default: + uiClass = 0; + } + fResult = uiClass != 0; + } + } + + hb_retl( fResult ); +} + /* * = __ClsCntClasses() *