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

See changelog

Browse Source
This commit is contained in:
Eddie Runia
1999-07-16 16:20:11 +00:00
parent b340a03cb5
commit cc0abe85a1
4 changed files with 78 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
harbour/ChangeLog
View File

@@ -1,3 +1,12 @@
19990716-18:10 CET Eddie Runia <eddie@runia.com>
+ tests/working/clasname.prg
Test program for clasname implemented. Warning : Just a partial
implementation
* source/vm/hvm.c
void Do() changed so all types call GetMethod
* source/rtl/classes.c
Small changes so messages to non-objects are properly handled.
19990716-16:00 CET Eddie Runia <eddie@runia.com>
* source/rtl/transfrm.c
Memory allocation error resolved

15
harbour/source/rtl/classes.c
View File

@@ -55,6 +55,8 @@
#define MET_VIRTUAL 4
#define MET_SUPER 5
HARBOUR DoBlock( void ); /* executes a codeblock */
typedef struct
{
void * pMessage; /* pointer to dynamic symbol when they get ready */
@@ -84,7 +86,10 @@ extern SYMBOL symEval;
PCLASS pClasses = 0;
WORD wClasses = 0;
PMETHOD pMethod = 0;
PDYNSYM msgClassName = 0, msgClassH = 0, msgEval = 0, msgClassSel = 0;
PDYNSYM msgClassName = 0,
msgClassH = 0,
msgEval = 0,
msgClassSel = 0;
/* All functions contained in classes.c */
@@ -726,10 +731,15 @@ static HARBOUR GetData( void )
HARBOURFUNC GetMethod( PHB_ITEM pObject, PSYMBOL pMessage )
{
WORD wAt, wLimit, wMask;
WORD wClass = pObject->item.asArray.value->wClass;
WORD wClass;
PCLASS pClass;
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
if( pObject->type == IT_OBJECT )
wClass = pObject->item.asArray.value->wClass;
else
wClass = 0;
if( ! msgClassName )
{
msgClassName = GetDynSym( "CLASSNAME" ); /* Standard messages */
@@ -759,7 +769,6 @@ HARBOURFUNC GetMethod( PHB_ITEM pObject, PSYMBOL pMessage )
wAt = 0;
}
}
if( pMsg == msgClassName )
return ClassName;

16
harbour/source/vm/hvm.c
View File

@@ -720,12 +720,12 @@ void Do( WORD wParams )
exit( 1 );
}
if( ! ( ( IS_NIL( pSelf ) ) || ( IS_BLOCK( pSelf ) ) || ( IS_ARRAY( pSelf ) ) ) )
/* if( ! IS_NIL( pSelf ) )
{
StackShow();
printf( "invalid symbol type for self from Do()\n" );
exit( 1 );
}
} */
pItem->item.asSymbol.lineno = 0;
pItem->item.asSymbol.paramcnt = wParams;
@@ -734,13 +734,17 @@ void Do( WORD wParams )
HB_DEBUG2( "Do with %i params\n", wParams );
if( IS_OBJECT( pSelf ) ) /* are we sending a message to an object ? */
if( ! IS_NIL( pSelf ) ) /* are we sending a message ? */
{
pFunc = GetMethod( pSelf, pSym );
if( pSym == &( symEval ) && IS_BLOCK( pSelf ) )
pFunc = pSym->pFunPtr; /* __EVAL method = function */
else
pFunc = GetMethod( pSelf, pSym );
if( ! pFunc )
{
printf( "error: message %s not implemented for class %s\n", pSym->szName,
hb_GetClassName( pSelf ) );
printf( "error: message %s not implemented for class %s\n",
pSym->szName, hb_GetClassName( pSelf ) );
exit( 1 );
}
pFunc();

47
harbour/tests/working/clasname.prg Normal file
View File

@@ -0,0 +1,47 @@
//
// $Id$
//
// The following code tests the application of the className message
// against the "fundemental" types of Clipper.
// These tests were written by Dave Pearson <davep@hagbard.demon.co.uk>
// and are placed into the public domain.
Function Main()
// First, try all the types. This checks that the VM can cope.
aEval( { /* NIL, */ "", 0, ctod( "" ), .F., {|| NIL }, ErrorNew() },;
{|x| qout( x:className ) } )
/* // Now try against values "in the code". This checks that the
// compiler can cope.
qout( NIL:className )
qout( "":className )
qout( 0:className )
qout( ctod( "" ):className )
qout( .f.:className )
qout( {|| nil }:className )
qout( ErrorNew():className )
// For fun, do it again while ensuring the parser doesn't care about
// whitespace.
qout( NIL : className )
qout( "" : className )
qout( 0 : className )
qout( ctod( "" ) : className )
qout( .f. : className )
qout( {|| nil } : className )
qout( ErrorNew() : className )
// Now for some sillier ones. If the above work the following should
// work too.
qout( ( NIL:className ):className )
qout( qout( ( NIL:className ):className ):className ) */
Return( NIL )