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() *