[Win32forth-cvs] win32forth/src Class.f,1.17,1.18

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv24740/src

Modified Files:
	Class.f 
Log Message:
Jos: Jacques Bertrand fixed a bug in (FINDM) As far I could test it is OK. His test code:


:Class Display <super object
    :M Line: ( x1 y1 x2 y2 -- )
       Cr ." display draws line from: " 2swap swap . . ."  to: " swap . .
    ;M
;Class

Display TheDirectDisplay

:Class Classx <super Object
   int val

   :M Show1:  ( -- )
      10 20 30 40  Line: TheDirectDisplay
   ;M
   :M Show2:  { aDisplay -- }
      10 20 30 40  Lone: aDisplay
   ;M
   :M Show3:  ( aDisplay -- )
      >r 10 20 30 40 r> Lone: [ ]
   ;M
;Class


Display TheIndirectDisplay
Classx  TheObj1


: xx1  show1: TheObj1 ;
: xx2  TheIndirectDisplay show2: TheObj1 ;
: xx3  TheIndirectDisplay show3: TheObj1 ;

\s His explanation:

I found a little bug in Win32Forth late bound method error messages.
It annoyed me for a long time until i find the courage to try to solve it !
It's very annoying since you cannot know which method is faulty when reading
the error message
see a code example below

there is a typing error : Lone: instead of Line: in the method
when I run xx2 or xx3, the error code should be :
    Lone: is not understood by class Display

  I get instead : Show3: is not understood by class Display

  I have made a patch to correct it, but not yet thoroughfully tested.
  yes I know that the trick used to patch (FINDM) is horrible and not ANS
  compliant but it works fine.

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** Class.f	1 Jun 2006 08:08:18 -0000	1.17
--- Class.f	11 Jun 2006 20:11:38 -0000	1.18
***************
*** 111,121 ****
          2dup
          MFA ((findm)) if nip nip EXIT then
!         nip
! 
          S"  not understood by class " tempmsg$ +place
! 	turnkeyed? \ Sonntag, März 13 2005 dbu
! 	if   drop s" [UNKNOWN]" tempmsg$ +place
! 	else body> >name nfa-count tempmsg$ +place
! 	then tempmsg$ msg !  -2 throw ;
  
  : FIND-METHOD   ( SelID ^obj -- ^obj m0cfa )   \ find method in object
--- 111,120 ----
          2dup
          MFA ((findm)) if nip nip EXIT then
!         s"  --> " tempmsg$ +place swap unhash tempmsg$ +place  \ replaces nip
          S"  not understood by class " tempmsg$ +place
!         turnkeyed? \ Sonntag, März 13 2005 dbu
!         if   drop s" [UNKNOWN]" tempmsg$ +place
!         else body> >name nfa-count tempmsg$ +place
!         then tempmsg$ msg !  -2 throw ;
  
  : FIND-METHOD   ( SelID ^obj -- ^obj m0cfa )   \ find method in object
***************
*** 929,935 ****
  : msgFind       ( addr -- addr false | cfa true )
                  PARMFIND ?DUP 0=
! 		IF   _MSGFIND
!   		     (dprwarn) \ warn if deprecated selector is found (Sonntag, März 13 2005 dbu)
! 		THEN ;
  
  \ If FIND is used in a TURNKEYed application it must be reset to PARMFIND
--- 928,934 ----
  : msgFind       ( addr -- addr false | cfa true )
                  PARMFIND ?DUP 0=
!                 IF   _MSGFIND
!                      (dprwarn) \ warn if deprecated selector is found (Sonntag, März 13 2005 dbu)
!                 THEN ;
  
  \ If FIND is used in a TURNKEYed application it must be reset to PARMFIND