% $Id: FreeVarIdsTest.oz,v 1.18 2012/01/17 11:50:53 leavens Exp leavens $ % AUTHOR: Gary T. Leavens \insert 'MyOzParser.oz' \insert 'FreeVarIds.oz' \insert 'TestingNoStop.oz' %% from the course library \insert 'CommaSeparate.oz' %% From homework 3 declare % A helping procedure to eliminate repitition in the testing below proc {FVTest Message AST IdList} Res = {FreeVarIds AST} in {System.showInfo "FV(" # Message # ") == {" # {CommaSeparate {Map {AsList Res} AtomToString}} # "}"} {Assert {Equal Res {AsSet IdList}}} end proc {Reporter error(coord:Coord kind:_ msg:Message)} % ENSURES: Output shows the message {System.showInfo {PositionMsg Coord}#': '#Message} end proc {FVProgTest FileName Program IdList} % Test the given program AST = {ParseVS Program FileName Reporter} % {Show AST} Res = {FreeVarIdsProgram AST} in % {ReportAbout '\nRunning test '#FileName} {System.showInfo "FV(" # Program # ") == {" # {CommaSeparate {Map {AsList Res} AtomToString}} # "}"} {Assert {Equal Res {AsSet IdList}}} end {StartTesting 'FreeVarIdsTest $Revision: 1.18 $'} {FVTest "skip" skipStmt nil} {FVTest "local A in skip end" localStmt(varId('A') skipStmt) nil} {FVTest "A = B" unifyStmt(varId('A') varId('B')) ['A' 'B']} {FVTest "A = 3" unifyStmt(varId('A') intLit(3)) ['A']} {FVTest "A = 3 B = C" seqStmt([unifyStmt(varId('A') intLit(3)) unifyStmt(varId('B') varId('C'))]) ['A' 'B' 'C']} {FVTest "A = 3 B = C E = A" seqStmt([unifyStmt(varId('A') intLit(3)) unifyStmt(varId('B') varId('C')) unifyStmt(varId('E') varId('A'))]) ['A' 'B' 'C' 'E']} {FVTest "if B then skip else skip end" ifStmt(varId('B') skipStmt skipStmt) ['B']} {FVTest "if true then R = true else S = false end" ifStmt(boolExp(true) unifyStmt(varId('R') boolExp(true)) unifyStmt(varId('S') boolExp(false))) ['R' 'S'] } {FVTest "if 3 then skip else skip end" ifStmt(intLit(3) skipStmt skipStmt) nil} {FVTest "if 3 then A = B else skip end" ifStmt(intLit(3) unifyStmt(varId('A') varId('B')) skipStmt) ['A' 'B']} {FVTest "if X then A = B else skip end" ifStmt(varId('X') unifyStmt(varId('A') varId('B')) skipStmt) ['X' 'A' 'B']} {FVTest "if X then A = B else D = Z end" ifStmt(varId('X') unifyStmt(varId('A') varId('B')) unifyStmt(varId('D') varId('Z'))) ['X' 'A' 'B' 'D' 'Z']} {FVTest "local A in A = B end" localStmt(varId('A') unifyStmt(varId('A') varId('B'))) ['B']} {FVTest "local A in A = 3 end" localStmt(varId('A') unifyStmt(varId('A') intLit(3))) nil} {FVTest "local A in A = A end" localStmt(varId('A') unifyStmt(varId('A') varId('A'))) nil} {FVTest "local A in B = C end" localStmt(varId('A') unifyStmt(varId('B') varId('C'))) ['B' 'C']} {FVTest "case C of ok then skip else skip end" caseStmt(varId('C') atomPat(ok) skipStmt skipStmt) ['C']} {FVTest "case C of X then skip else skip end" caseStmt(varId('C') varIdPat('X') skipStmt skipStmt) ['C']} {FVTest "case C of X then B = X else skip end" caseStmt(varId('C') varIdPat('X') unifyStmt(varId('B') varId('X')) skipStmt) ['C' 'B']} {FVTest "case C of X then B = X else D = 7 end" caseStmt(varId('C') varIdPat('X') unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') intLit(7))) ['C' 'B' 'D']} {FVTest "case C of nowXisFree then B = X else D = 7 end" caseStmt(varId('C') atomPat(nowXisFree) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') intLit(7))) ['C' 'B' 'X' 'D']} {FVTest "case C of Q then B = X else Z = Q end" caseStmt(varId('C') varIdPat('Q') unifyStmt(varId('B') varId('X')) unifyStmt(varId('Z') varId('Q'))) ['C' 'B' 'X' 'Z' 'Q']} {FVTest "case C of foo() then B = X else D = 7 end" caseStmt(varId('C') recordPat(foo nil) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') intLit(7))) ['C' 'B' 'X' 'D']} {FVTest "case C of foo(X Y) then B = X else D = Y end" caseStmt(varId('C') recordPat(foo [posFld(varIdPat('X')) posFld(varIdPat('Y'))]) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') varId('Y'))) ['C' 'B' 'D' 'Y']} {FVTest "case C of foo(f1:X f2:Y) then B = X else D = Y end" caseStmt(varId('C') recordPat(foo [colonFld(f1 varIdPat('X')) colonFld(f2 varIdPat('Y'))]) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') varId('Y'))) ['C' 'B' 'D' 'Y']} {FVTest "case C of foo(f1:bar(f2:X f3:Y f4:Z))" # " then B = X if Z then D = Y else skip end" # " else skip end" caseStmt(varId('C') recordPat(foo [colonFld(f1 recordPat(atomExp(bar) [colonFld(f2 varIdPat('X')) colonFld(f3 varIdPat('Y')) colonFld(f4 varIdPat('Z'))]))]) seqStmt([unifyStmt(varId('B') varId('X')) ifStmt(varId('Z') unifyStmt(varId('D') varId('Y')) skipStmt)]) skipStmt) ['C' 'B' 'D']} {FVTest "case C of foo(f1:bar(f2:X f3:Y f4:Q))" # " then B = X if Z then D = Y else skip end" # " else skip end" caseStmt(varId('C') recordPat(foo [colonFld(f1 recordPat(atomExp(bar) [colonFld(f2 varIdPat('X')) colonFld(f3 varIdPat('Y')) colonFld(f4 varIdPat('Q'))]))]) seqStmt([unifyStmt(varId('B') varId('X')) ifStmt(varId('Z') unifyStmt(varId('D') varId('Y')) skipStmt)]) skipStmt) ['C' 'B' 'Z' 'D']} {FVTest "{P}" applyStmt(varId('P') nil) ['P']} {FVTest "{Browse 3}" applyStmt(varId('Browse') [intLit(3)]) ['Browse']} {FVTest "{Map Ls F}" applyStmt(varId('Map') [varId('Ls') varId('F')]) ['Map' 'Ls' 'F']} {FVTest "{Map 3|nil F}" applyStmt(varId('Map') [recordExp(atomExp('|') [posFld(intLit(3)) posFld(atomExp(nil))]) varId('F')]) ['Map' 'F']} {FVTest "{Map 3|nil proc {$ X R} {Browse X} R = X end}" applyStmt(varId('Map') [recordExp(atomExp('|') [posFld(intLit(3)) posFld(atomExp(nil))]) procExp([varIdPat('X') varIdPat('R')] seqStmt([applyStmt(varId('Browse') [varId('X')]) unifyStmt(varId('R') varId('X'))]))]) ['Map' 'Browse']} {FVTest "{Map 3|nil proc {$ X R} {Browse X} R = Y end}" applyStmt(varId('Map') [recordExp(atomExp('|') [posFld(intLit(3)) posFld(atomExp(nil))]) procExp([varIdPat('X') varIdPat('R')] seqStmt([applyStmt(varId('Browse') [varId('X')]) unifyStmt(varId('R') varId('Y'))]))]) ['Map' 'Browse' 'Y']} {FVTest "Three = proc {$ R} R = 3 end" unifyStmt(varId('Three') procExp([varIdPat('R')] unifyStmt(varId('R') intLit(3)))) ['Three']} {FVTest "fun {Three} 3 end" namedFunStmt('Three' nil intLit(3)) ['Three']} {FVTest "fun {Add X Y} {Plus X Y} end" namedFunStmt('Add' [varIdPat('X') varIdPat('Y')] applyExp(varId('Plus') [varId('X') varId('Y')])) ['Add' 'Plus']} {FVTest "fun {Add X Y} {Plus X X Z} end" namedFunStmt('Add' [varIdPat('X') varIdPat('Y')] applyExp(varId('Plus') [varId('X') varId('X') varId('Z')])) ['Add' 'Plus' 'Z']} {FVTest "fun {F X} proc {$ F R} R = {F A} end end" namedFunStmt('F' [varIdPat('X')] procExp([varIdPat('F') varIdPat('R')] unifyStmt(varId('R') applyExp(varId('F') [varId('A')])))) ['F' 'A']} {FVTest "InTest = proc {$ Tree R} node(X Y) = Tree in R = {Plus X Y} end" unifyStmt(varId('InTest') procExp([varIdPat('Tree') varIdPat('R')] inStmt(recordPat(node [posFld(varIdPat('X')) posFld(varIdPat('Y'))]) varId('Tree') unifyStmt(varId('R') applyExp(varId('Plus') [varId('X') varId('Y')]))))) ['InTest' 'Plus']} {FVTest "fun {First X#Y} X end" namedFunStmt('First' [recordPat('#' [posFld(varIdPat('X')) posFld(varIdPat('Y'))])] varId('X')) ['First']} {FVTest "fun {RevPair X#Y} Y#X end" namedFunStmt('RevPair' [recordPat('#' [posFld(varIdPat('X')) posFld(varIdPat('Y'))])] recordExp(atomExp('#') [posFld(varId('Y')) posFld(varId('X'))])) ['RevPair']} {FVTest "fun {RevPair P} case P of X#Y then Y#X else error end end" namedFunStmt('RevPair' [varIdPat('P')] caseExp(varId('P') recordPat('#' [posFld(varIdPat('X')) posFld(varIdPat('Y'))]) recordExp(atomExp('#') [posFld(varId('Y')) posFld(varId('X'))]) atomExp(error))) ['RevPair']} {FVTest "fun {T N} if {Odd N} then {Div {Plus {Mult 3 N} 1} 2}" # " else {Div N 2} end end" namedFunStmt('T' [varIdPat('N')] ifExp(applyExp(varId('Odd') [varId('N')]) applyExp(varId('Div') [applyExp(varId('Plus') [applyExp(varId('Mult') [intLit(3) varId('N')]) intLit(1)]) intLit(2)]) applyExp(varId('Div') [varId('N') intLit(2)]))) ['T' 'Odd' 'Div' 'Plus' 'Mult']} {FVTest "case nil of X#Y|T then T = X#Y else skip" caseStmt(atomExp(nil) recordPat(atomExp('|') [posFld(recordPat(atomExp('#') [posFld(varIdPat('X')) posFld(varIdPat('Y'))])) posFld(varIdPat('T'))]) unifyStmt(varId('T') recordExp(atomExp('#') [posFld(varId('X')) posFld(varId('Y'))])) skipStmt) nil} local CaseExample = % Part of (Figure 2 of 0DOCS.tex) unifyStmt( varId('Res') caseExp(varId('Ls') recordPat(atomExp('|') [posFld(recordPat(atomExp('#') [posFld(varIdPat('X')) posFld(varIdPat('Y'))])) posFld(varIdPat('T'))]) recordExp(atomExp('|') [posFld(recordExp(atomExp('#') [posFld(applyExp(varId('Plus') [varId('A') varId('X')])) posFld(applyExp(varId('Plus') [varId('B') varId('Y')]))])) posFld(applyExp(varId('AddToEach') [recordExp(atomExp('#') [posFld(varId('A')) posFld(varId('B'))]) varId('T')]))]) atomExp(nil))) in {FVTest "Res =" # " case Ls of X#Y|T then {Plus A X}#{Plus B Y}|{AddToEach A#B T}" # " else nil end" # " end" CaseExample ['Res' 'Ls' 'A' 'B' 'Plus' 'AddToEach']} end local ParsedFigExample = % (Figure 2 of 0DOCS.tex) namedFunStmt('AddToEach' [recordPat('#' [posFld(varIdPat('A')) posFld(varIdPat('B'))]) varIdPat('Ls')] caseExp(varId('Ls') recordPat(atomExp('|') [posFld(recordPat(atomExp('#') [posFld(varIdPat('X')) posFld(varIdPat('Y'))])) posFld(varIdPat('T'))]) recordExp(atomExp('|') [posFld(recordExp(atomExp('#') [posFld(applyExp(varId('Plus') [varId('A') varId('X')])) posFld(applyExp(varId('Plus') [varId('B') varId('Y')]))])) posFld(applyExp(varId('AddToEach') [recordExp(atomExp('#') [posFld(varId('A')) posFld(varId('B'))]) varId('T')]))]) atomExp(nil))) in {FVTest "fun {AddToEach A#B Ls}" # " case Ls of X#Y|T then {Plus A X}#{Plus B Y}|{AddToEach A#B T}" # " else nil end" # " end" ParsedFigExample ['AddToEach' 'Plus']} end {FVTest "thread X = Y end" threadStmt(unifyStmt(varId('X') varId('Y'))) ['X' 'Y']} {FVTest "X = thread Y end" unifyStmt(varId('X') threadExp(varId('Y'))) ['X' 'Y']} {Test {AsList {DeclarableVarIdsStmt unifyStmt(varId('X') varId('Y'))}} '==' ['X']} {FVProgTest 'declare1' "declare X=Y" ['Y']} {FVProgTest 'declare2' "declare A = nil B = Four|A" ['Four']} {FVProgTest 'declareIn1' "declare A = nil in B = Four|A" ['B' 'Four']} {FVProgTest 'declareFun1' "declare fun{Id X} X end" nil} {FVProgTest 'declareFun2' "declare fun{Add X Y} {Plus X Y} end" ['Plus']} {FVProgTest 'declareFun3' "declare local Foo in fun{Foo X Y} {Plus X Y} end fun{Bar A B} {Foo A B} end end" ['Plus']} {DoneTesting}