From cc0abe85a124880beac8a3df1748799c9ec7f362 Mon Sep 17 00:00:00 2001
From: Eddie Runia <eddie@runia.com>
Date: Fri, 16 Jul 1999 16:20:11 +0000
Subject: [PATCH] See changelog

---
 harbour/ChangeLog                  |  9 ++++++
 harbour/source/rtl/classes.c       | 15 ++++++++--
 harbour/source/vm/hvm.c            | 16 ++++++----
 harbour/tests/working/clasname.prg | 47 ++++++++++++++++++++++++++++++
 4 files changed, 78 insertions(+), 9 deletions(-)
 create mode 100644 harbour/tests/working/clasname.prg

diff --git a/harbour/ChangeLog b/harbour/ChangeLog
index 712bc12cc7..dfcf56dd25 100644
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -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
diff --git a/harbour/source/rtl/classes.c b/harbour/source/rtl/classes.c
index 423e437c07..baaba50d40 100644
--- a/harbour/source/rtl/classes.c
+++ b/harbour/source/rtl/classes.c
@@ -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;
 
diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c
index b17fa47a50..b611e98807 100644
--- a/harbour/source/vm/hvm.c
+++ b/harbour/source/vm/hvm.c
@@ -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();
diff --git a/harbour/tests/working/clasname.prg b/harbour/tests/working/clasname.prg
new file mode 100644
index 0000000000..79753321c4
--- /dev/null
+++ b/harbour/tests/working/clasname.prg
@@ -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 )
+