Skip to content

Instantly share code, notes, and snippets.

@MarkGoldberg
Created February 7, 2014 11:10
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save MarkGoldberg/8860855 to your computer and use it in GitHub Desktop.
Save MarkGoldberg/8860855 to your computer and use it in GitHub Desktop.
Clarion Get(Q, CompareFunction)
PROGRAM
MAP
END
INCLUDE('ctGenericQ.inc'),ONCE
gtStrRef GROUP,TYPE
Str &STRING
END
gtStrVal GROUP(gtStrRef),TYPE
_Value LONG
END
qtStrVal QUEUE(gtStrVal),TYPE
END
ctStrVal CLASS(ctGenericQ),TYPE
Q &qtStrVal
CONSTRUCT PROCEDURE
Find PROCEDURE(STRING xStr),LONG,PROC
Add PROCEDURE(String xStr, LONG xValue)
Del PROCEDURE(),DERIVED
_Dispose PROCEDURE(),DERIVED
END
MAP
CompareStrRef PROCEDURE(*gtStrRef xA, *gtStrRef xB),SIGNED
END
INCLUDE('debuger.inc'),ONCE
DBG Debuger
oStr ctStrVal
MAP
LookFor PROCEDURE(STRING xLookFor)
END
CODE
DBG.mg_init('StringQueue')
DO Fill
oStr.Add('Hello',47)
oStr.Add('There',42)
oStr.Add('MarkGoldberg',1965)
LookFor('There')
LookFor('WTF')
LookFor('Hello')
LookFor('There ') !<-- notice the trailing space
LookFor(' There') !<-- notice the trailing space
assert(0,eqDBG&'={47} Done')
Fill ROUTINE
DATA
QREC LONG,AUTO
CODE
LOOP QREC = 65 TO 91
oStr.Add( ALL(CHR(QRec),10),QREC)
END
LookFor PROCEDURE(STRING xLookFor)
Err LONG,AUTO
CODE
assert(0,eqDBG&'v----- LookFor['& xLookFor &']')
Err = oStr.Find(xLookFor) ; ASSERT(0,eqDBG&' Err['& Err &'] oStr.Str['& oStr.Q.Str &'] .Value['& oStr.Q._Value &']')
assert(0,eqDBG&'^----- LookFor['& xLookFor &']')
ctStrVal.CONSTRUCT PROCEDURE
CODE
SELF.Q &= NEW qtStrVal
SELF.GenericQ &= SELF.Q
ctStrVal.Del PROCEDURE
CODE
assert(0,eqDBG&'v ctStrVal.Del Str['& SELF.Q.Str &'] Value['& SELF.Q._Value &'] Records['& SELF.Records() &']')
DISPOSE(SELF.Q.Str) ;ASSERT(0,eqDBG&' ctStrVal.Del after dispose')
PUT(SELF.Q)
PARENT.Del()
;ASSERT(0,eqDBG&'^ ctStrVal.Del')
OMIT('**** WORKAROUND DEL ****')
ctStrVal.Del PROCEDURE
HoldStr &STRING
CODE
HoldStr &= SELF.Q.Str
assert(0,eqDBG&'v ctStrVal.Del Str['& SELF.Q.Str &'] Value['& SELF.Q._Value &'] Records['& SELF.Records() &']')
!DISPOSE(SELF.Q.Str) ;ASSERT(0,eqDBG&' ctStrVal.Del after dispose')
PARENT.Del()
DISPOSE(HoldStr)
;ASSERT(0,eqDBG&'^ ctStrVal.Del')
!END-OMIT('**** WORKAROUND DEL ****')
ctStrVal._Dispose PROCEDURE()!,DERIVED
CODE
ASSERT(0,eqDBG&'v ctStrVal._Dispose')
DISPOSE(SELF.Q) ; ASSERT(0,eqDBG&' ctStrVal._Dispose')
SELF.GenericQ &= NULL
ASSERT(0,eqDBG&'^ ctStrVal._Dispose')
ctStrVal.Add PROCEDURE(String xStr, LONG xValue)
CODE
SELF.Q.Str &= NEW STRING(SIZE(xStr))
SELF.Q.Str = xStr
SELF.Q._Value = xValue
ADD(SELF.Q, SELF.Q.Str)
ctStrVal.Find PROCEDURE(STRING xStr)
HoldRef &STRING
HoldPtr LONG
FoundPtr LONG
RetErr LONG,AUTO
CODE
HoldRef &= NEW STRING(SIZE(xStr)) !<--- could make this conditional when: SIZE(xStr) > SIZE(SELF.Q.Str)
HoldRef = xStr
SELF.Q.Str &= HoldRef
SELF.Q.Str = xStr !<--- problem as current row might have a short &STRING
GET(SELF.Q, CompareStrRef )
RetErr = ErrorCode()
DISPOSE(HoldRef)
RETURN RetErr
CompareStrRef PROCEDURE(*gtStrRef xA, *gtStrRef xB)!,SIGNED
RetAvsB SIGNED,AUTO
Compare:ALess EQUATE(-1)
Compare:Same EQUATE(0)
Compare:AGreater EQUATE(1)
CODE
assert(0,eqDBG&'v CompareStrRef xA['& CHOOSE( xA.Str &=NULL,'Null',xA.Str) &']')
assert(0,eqDBG&' CompareStrRef xB['& CHOOSE( xB.Str &=NULL,'Null',xB.Str) &']')
IF xA.Str &= NULL
RetAvsB = CHOOSE( xB.Str &= NULL , Compare:Same , |
Compare:ALess )
ELSE
RetAvsB = CHOOSE( xB.Str &= NULL , Compare:AGreater, |
CHOOSE( xA.Str = xB.Str , Compare:Same , |
CHOOSE( xA.Str > xB.Str , Compare:AGreater, |
Compare:ALess )))
END
assert(0,eqDBG&'^ CompareStrRef Returns['& RetAvsB &']')
RETURN RetAvsB
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment