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
|
