extra/gml/test-core.gml

   1 % Missing core words:
   2 % bind
   3 % break
   4 % catch
   5 % catch-error
   6 % echo
   7 % eput
   8 % resetinterpreter
   9 % throw
  10 % tokenformat
  11 % tokensize
  12 % type
  13
  14 "Literals" print
  15
  16 [] [] test
  17 [-10] [-10] test
  18 [10] [+10] test
  19 [10.5] [10.5] test
  20 [10.5] [+10.5] test
  21 [-10.5] [-10.5] test
  22 [1000000.0] [10e5] test
  23 [1000000.0] [+10e5] test
  24 [-1000000.0] [-10e5] test
  25 [1050000.0] [10.5e5] test
  26 [1050000.0] [+10.5e5] test
  27 [-1050000.0] [-10.5e5] test
  28 [(1,2)][(1,2)] test
  29 [(1,2,3)][(1,2,3)] test
  30 ["Hello"] ["Hello"] test
  31
  32 [1] [{useregs} length] test
  33
  34 "Stack shuffling" print
  35
  36 [1] [1 2 pop] test
  37 [1 2 ] [1 2 3 8 2 pops] test
  38 [2 1] [1 2 exch] test
  39 ["a""b""c""d""d"] ["a""b""c""d" 0 index] test
  40 ["a""b""c""d""a"] ["a""b""c""d" 3 index] test
  41 [0 2 3 1][0 1 2 3 3 -1 roll] test
  42 [0 3 1 2][0 1 2 3 3 1 roll] test
  43 [0 1 2 3][0 1 2 3 3 0 roll] test
  44 [3 0 1 2][0 1 2 3 4 1 roll] test
  45 [1 2 3 0][0 1 2 3 4 -1 roll] test
  46 ["a" "b" "c" ["g"]] ["a" "b" "c" ["d" "e" "f" cleartomark "g"]] test
  47 ["d" "e" "f" "g" 4] ["d" "e" "f" "g" counttomark] test
  48
  49 "Arrays" print
  50
  51 [[1 2 "X"]] [1 2 "X" 3 array] test
  52 [-10] [[1 2 -10] 2 get] test
  53 [-10] [[1 2 -10] -1 get] test
  54 [[1 2 4]] [[1 2 -10] dup 2 4 put] test
  55 [[1 "X" -10]] [[1 2 -10] dup -2 "X" put] test
  56 [["a" "b" "c" "d"]] [["a" "b"] ["c" "d"] arrayappend] test
  57 [["a" "b" 100]] [["a" "b"] 100 append] test
  58 [{"a" "b" 100}] [{"a" "b"} 100 append] test
  59 [["a" "b" "c"]] [["a" "b" "c" "d" "e"] 2 pop-back] test
  60 [{"a" "b" "c"}] [{"a" "b" "c" "d" "e"} 2 pop-back] test
  61 [["a" "b" "c" "d" "e"]] [["a" "b" "c" "d" "e"] 0 pop-back] test
  62 [{"a" "b" "c" "d" "e"}] [{"a" "b" "c" "d" "e"} 0 pop-back] test
  63 [["a" "b" "c" "d"]] [["a" "b" "c" "d" "e"] pop-back] test
  64 [{"a" "b" "c" "d"}] [{"a" "b" "c" "d" "e"} pop-back] test
  65 [["c" "d" "e"]] [["a" "b" "c" "d" "e"] 2 pop-front] test
  66 [{"c" "d" "e"}] [{"a" "b" "c" "d" "e"} 2 pop-front] test
  67 [["a" "b" "c" "d" "e"]] [["a" "b" "c" "d" "e"] 0 pop-front] test
  68 [{"a" "b" "c" "d" "e"}] [{"a" "b" "c" "d" "e"} 0 pop-front] test
  69 [["b" "c" "d" "e"]] [["a" "b" "c" "d" "e"] pop-front] test
  70 [{"b" "c" "d" "e"}] [{"a" "b" "c" "d" "e"} pop-front] test
  71 ["Boo" 1 2 3] ["Boo" [1 2 3] aload] test
  72 [4] [["a" "b" "c" "d"] length] test
  73 [[3 2 1 2 2]] [[1 2 3] [5 1 0 1 1] array-get] test
  74 [[1 2 4 5 6]] [[1 2 3 4 5 6] 2 arrayremove] test
  75 [[1 2 3 4 6]] [[1 2 3 4 5 6] -2 arrayremove] test
  76 [[1 "hallo" 2 3 4]] [[1 ["hallo" 2] 3 [4] []] flatten] test
  77 [[1 2 [3]]] [[1 [2 [3]]] flatten] test
  78 [[16.2 33.5 49.0 64.3 80.5]] [[80.5 64.3 49.0 33.5 16.2] reverse] test
  79 [[ 3 4 5 1 2 3 4 5 1 2 ]] [[ 1 2 3 4 5 ] -3 7 slice] test
  80 [[ "c" "d" "e" ]] [[ "a" "b" "c" "d" "e" "f" "g" ] 3 2 subarray] test
  81
  82 [
  83  [2 1 6] %A(rray)
  84  [2 0 1] %P(ermutation)
  85  1
  86 ]
  87 [
  88  [ 2 1 6 ]
  89  dup
  90  sort-number-permutation
  91  dup
  92  2 %index of the first element in p
  93  get %get the first element of P
  94 ] test
  95
  96 "Dictionaries" print
  97
  98 [3 4] [
  99  /x 4 def
 100  dict begin
 101  /x 3 def
 102  x
 103  end
 104  x
 105 ] test
 106
 107 [3 4] [
 108  /x 4 def
 109  dict begin
 110  /x 3 def
 111  currentdict /x get
 112  end
 113  currentdict /x get
 114 ] test
 115
 116 dict begin
 117 /squared {dup mul} def
 118 [25] [5 squared] test
 119 [{dup mul}] [/squared load] test
 120 end
 121
 122 [3 4] [
 123  /x 4 def
 124  dict begin
 125  /x 3 def
 126  x
 127  /x undef
 128  x
 129  end
 130 ] test
 131
 132 dict begin
 133
 134 /mydict dict def
 135 mydict /total 0 put
 136 [1] [mydict /total known] test
 137 [0] [mydict /badname known] test
 138
 139 end
 140
 141 dict begin
 142  /myBlack (0.0,0.0,0.0) def
 143
 144  [1] [currentdict /myBlack known] test
 145  [0] [currentdict /myWhite known] test
 146 end
 147
 148 dict begin
 149  /bing 5 def
 150  /bong "OH HAI" def
 151
 152  dict begin
 153  /bong 10 def
 154
 155  [1 "OH HAI"] [/bing where exch /bong get] test
 156
 157  end
 158 end
 159
 160 [3 3] [
 161  /d dict def
 162  d /x 3 put
 163  d /x get
 164  d copy /x 100 put
 165  d /x get
 166 ] test
 167
 168 [5] [
 169  dict begin
 170  /a 1 def
 171  /b 2 def
 172  /c 3 def
 173  /d 4 def
 174  /e 5 def
 175  currentdict keys length
 176  end
 177 ] test
 178
 179 [/a 10 /b 20 /c 30] dictfromarray begin
 180  [10] [a] test
 181  [20] [b] test
 182  [30] [c] test
 183 end
 184
 185 dict dup
 186 [/a 10 /b 20 /c 30] exch dictfromarray begin
 187  [10] [a] test
 188  [20] [b] test
 189  [30] [c] test
 190 end
 191
 192 % Ensure original was mutated too!
 193 begin
 194  [10] [a] test
 195  [20] [b] test
 196  [30] [c] test
 197 end
 198
 199 "Pathnames" print
 200 ["Barak"] [
 201  dict dup begin
 202  dict dup /name exch def
 203  begin
 204  /first "Barak" def
 205  /last "Obama" def
 206  end
 207  end
 208  .name.first
 209 ] test
 210
 211 "Control flow" print
 212
 213 ["Yes"] [1 {"Yes"} if] test
 214 [] [0 {"Yes"} if] test
 215
 216 ["Yes"] [1 {"Yes"} {"No"} ifelse] test
 217 ["No"] [0 {"Yes"} {"No"} ifelse] test
 218
 219 [1 2 4 8 16] [1 {dup 2 mul dup 16 ge {exit} if} loop] test
 220
 221 [["A" "A" "A" "A" "A" "A" "A" "A"]] [["A"] 3 {dup arrayappend} repeat] test
 222
 223 [2 6 10 14 18 22 26 30 34 38] [1 2 19 {2 mul} for] test
 224 [2 6 10 14 18 22 26 30 34] [1 2 19 {2 mul} forx] test
 225
 226 [2 6 10 14] [1 2 7 {2 mul} for] test
 227 [3 7 11 15] [[1 2 7 {2 mul} for] {1 add} forall] test
 228 [[3 7 11 15]] [[1 2 7 {2 mul} for] {1 add} map] test
 229
 230 [ 10.1 9 8 7 6 5 4 3 2 ]
 231 [
 232  [ 1.1 2 3 4 5 6 7 8 9 ]
 233  [ 9 7 5 3 1 -1 -3 -5 -7 ]
 234  { add } twoforall
 235 ] test
 236
 237 [ -7.9 -5 -2 1 4 7 10 13 16 ]
 238 [
 239  [ 1.1 2 3 4 5 6 7 8 9 ]
 240  [ 9 7 5 3 1 -1 -3 -5 -7 ]
 241  { sub } twoforall
 242 ] test
 243
 244 [[10.1 9 8 7 6 5 4 3 2]]
 245 [
 246  [ 1.1 2 3 4 5 6 7 8 9 ]
 247  [ 9 7 5 3 1 -1 -3 -5 -7 ]
 248  { add } twomap
 249 ] test
 250
 251 [/x] [/x /y 0 ifpop] test
 252 [/y] [/x /y 1 ifpop] test
 253
 254 "Registers" print
 255 [2 1] [1 2 {usereg !b !a ;b ;a} exec] test
 256
 257 [100] [
 258  {
 259  usereg
 260  {dup mul} !squared
 261  10 !x
 262
 263  :x :squared
 264  } exec
 265 ] test
 266
 267 % Ghetto closures
 268 [6] [
 269     /closure-test {
 270         usereg
 271
 272         5 !x
 273
 274         {:x 1 add !x} exec
 275
 276         :x
 277     } def
 278     closure-test
 279 ] test
 280
 281 [8] [
 282     /closure-test {
 283         usereg
 284
 285         5 !x
 286
 287         {:x 1 add !x}
 288
 289         7 !x
 290
 291         exec
 292
 293         :x
 294     } def
 295     closure-test
 296 ] test
 297
 298 "Make sure nothing is left on the stack after the test" print
 299 count [exch] [0] test