tests/testinterp.c

   1 /*
   2    Copyright (c) 2007-2008 Luca Bruno
   3
   4    This file is part of Smalltalk YX.
   5
   6    Permission is hereby granted, free of charge, to any person obtaining a copy
   7    of this software and associated documentation files (the "Software"), to deal
   8    in the Software without restriction, including without limitation the rights
   9    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  10    copies of the Software, and to permit persons to whom the Software is
  11    furnished to do so, subject to the following conditions:
  12
  13    The above copyright notice and this permission notice shall be included in
  14    all copies or substantial portions of the Software.
  15
  16    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  17    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  19    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  20    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  21    FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  22    DEALINGS IN THE SOFTWARE.
  23 */
  24
  25 #include "../syx/syx.h"
  26
  27 #include <assert.h>
  28 #include <stdio.h>
  29 #ifdef HAVE_SYS_TIME_H
  30 #include <sys/time.h>
  31 #endif
  32
  33 SyxOop
  34 _interpret (syx_symbol text)
  35 {
  36   SyxParser *parser;
  37   SyxLexer *lexer;
  38   SyxOop method, context, process;
  39   syx_uint64 start, end;
  40   syx_bool ok;
  41
  42   lexer = syx_lexer_new (text);
  43   method = syx_method_new ();
  44   parser = syx_parser_new (lexer, method, syx_undefined_object_class);
  45   ok = syx_parser_parse (parser, FALSE);
  46   assert (ok == TRUE);
  47   syx_parser_free (parser, FALSE);
  48   syx_lexer_free (lexer, FALSE);
  49   process = syx_process_new ();
  50   context = syx_method_context_new (method, syx_nil, syx_nil);
  51   syx_interp_enter_context (process, context);
  52
  53   start = syx_nanotime ();
  54   syx_process_execute_blocking (process);
  55   end = syx_nanotime ();
  56   printf ("Time elapsed: %lu nanoseconds\n\n", end - start);
  57
  58   return SYX_PROCESS_RETURNED_OBJECT(process);
  59 }
  60
  61 int SYX_CDECL
  62 main (int argc, char *argv[])
  63 {
  64   SyxOop ret_obj;
  65   SyxLexer *lexer;
  66   syx_bool ok;
  67
  68   syx_init (0, NULL, "..");
  69   syx_memory_load_image ("test.sim");
  70   syx_scheduler_init ();
  71
  72   puts ("- Test assignment");
  73   ret_obj = _interpret ("method | a | ^a := -123 + 16r2AE + -2r100");
  74   assert (SYX_SMALL_INTEGER(ret_obj) == -123 + 0x2AE + -4);
  75
  76   puts ("- Test floats");
  77   ret_obj = _interpret ("method | a | a := 123.321. ^a + 2.2");
  78   assert (SYX_OBJECT_FLOAT(ret_obj) == 125.521);
  79
  80 #ifdef HAVE_LIBGMP
  81   puts ("- Test large integers");
  82   ret_obj = _interpret ("method ^16rFFFFFFFFFFFF - 16rFFFFFFFFFFF0");
  83   assert (SYX_SMALL_INTEGER(ret_obj) == 0xF);
  84   /* 30 bits + 30 bits */
  85   ret_obj = _interpret ("method ^2r1111111111111111111111111111111 + 2r1111111111111111111111111111111 = 4294967294");
  86   assert (SYX_IS_TRUE (ret_obj));
  87 #endif
  88
  89   puts ("- Test class variables");
  90   lexer = syx_lexer_new ("Object subclass: #TestClass instanceVariableNames: '' classVariableNames: 'TestVar'!"
  91                          "!TestClass class methodsFor: 'testing'!"
  92                          "initialize TestVar := 123! testVar ^TestVar ! !"
  93                          "!TestClass methodsFor: 'testing'!"
  94                          "testVar ^TestVar ! !");
  95   ok = syx_cold_parse (lexer);
  96   assert (ok == TRUE);
  97   syx_lexer_free (lexer, FALSE);
  98
  99   ret_obj = _interpret ("method TestClass initialize. ^TestClass testVar + TestClass new testVar");
 100   assert (SYX_SMALL_INTEGER(ret_obj) == 123 + 123);
 101
 102   puts ("- Test evaluating a simple block");
 103   ret_obj = _interpret ("method ^[321] value");
 104   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 105
 106   puts ("- Test block stack return");
 107   ret_obj = _interpret ("method [^321] value");
 108   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 109
 110   puts ("- Test a block with a single argument");
 111   ret_obj = _interpret ("method [:s | ^s] value: 123");
 112   assert (SYX_SMALL_INTEGER(ret_obj) == 123);
 113
 114   puts ("- Test temporary scope in blocks");
 115   ret_obj = _interpret ("method | tmp | tmp := 123. [ | tmp | tmp := 321 ] value. ^tmp");
 116   assert (SYX_SMALL_INTEGER(ret_obj) == 123);
 117
 118   puts ("- Another test for temporary scope in blocks");
 119   ret_obj = _interpret ("method | tmp | tmp := 123. [ tmp := 321 ] value. ^tmp");
 120   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 121
 122   puts ("- Test nested blocks with arguments");
 123   ret_obj = _interpret ("method ^[ :s | [ :s | s ] value: 321] value: 123");
 124   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 125
 126   puts ("- Another test for nested blocks and arguments");
 127   ret_obj = _interpret ("method | b | b := [ :a | a ]."
 128                         "^[ :b | "
 129                         "   ([ :b | "
 130                         "      ([ :b | b value: 123 + 1 ] value: b) + 1"
 131                         "   ] value: b) + 1"
 132                         "] value: b");
 133   assert (SYX_SMALL_INTEGER(ret_obj) == 126);
 134
 135   puts ("- Recursive blocks");
 136   ret_obj = _interpret ("method | b i | i := 0. b := [ :b | (i := i + 1) = 10 ifFalse: [ b value: b ] ]."
 137                         "b value: b. ^i");
 138   assert (SYX_SMALL_INTEGER(ret_obj) == 10);
 139
 140   puts ("- Test ifTrue:");
 141   ret_obj = _interpret ("method | var | var := 123. var = 321 ifTrue: [^false]. var = 123 ifTrue: [^true]");
 142   assert (SYX_IS_TRUE (ret_obj));
 143
 144   puts ("- Test ifTrue:ifFalse:");
 145   ret_obj = _interpret ("method ^false ifTrue: [ 123 ] ifFalse: [ 321 ]");
 146   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 147
 148   puts ("- Test ifTrue:ifFalse: again");
 149   ret_obj = _interpret ("method ^true ifTrue: [ 123 ] ifFalse: [ 321 ]");
 150   assert (SYX_SMALL_INTEGER(ret_obj) == 123);
 151
 152   puts ("- Test ifFalse:ifTrue:");
 153   ret_obj = _interpret ("method ^true ifTrue: [ 123 = 321 ifFalse: [^333] ifTrue: [^222] ] ifFalse: [^false]");
 154   assert (SYX_SMALL_INTEGER(ret_obj) == 333);
 155
 156   puts ("- Test temporaries in optimized blocks");
 157   ret_obj = _interpret ("method | tmp | tmp := 123. true ifTrue: [ | tmp | tmp := 321 ]. ^tmp");
 158   assert (SYX_SMALL_INTEGER(ret_obj) == 123);
 159
 160   /* From issue #29 */
 161   puts ("- Test block recursion");
 162   _interpret ("method | b | b := [ :i | | d | Transcript nextPutAll: 'before ', i printString; cr."
 163               "d := i - 1."
 164               "(i > 0 ) ifTrue: [ b value: d]."
 165               "Transcript nextPutAll: 'after ', i printString; cr. ]."
 166               "b value: 5");
 167
 168   puts ("- Test exception handling");
 169   ret_obj = _interpret ("method ^[Signal signal] on: Signal do: [:ex | true]");
 170   assert (SYX_IS_TRUE (ret_obj));
 171
 172   puts ("- Test resuming");
 173   ret_obj = _interpret ("method ^[Signal signal. 123] on: Signal do: [ :ex | ex resume. 321]");
 174   assert (SYX_SMALL_INTEGER(ret_obj) == 123);
 175
 176   puts ("- Test pass");
 177   ret_obj = _interpret ("method ^[[Error signal. 123] on: Error do: [ :ex | ex pass. 213]] on: Exception do: [:ex | 321]");
 178   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 179
 180   puts ("- Test ensuring");
 181   ret_obj = _interpret ("method [Signal signal. 123] ensure: [^321]. 213");
 182   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 183
 184   puts ("- Test ensuring 2");
 185   ret_obj = _interpret ("method [^123] ensure: [^321]. 213");
 186   assert (SYX_SMALL_INTEGER(ret_obj) == 321);
 187
 188   puts ("- Test loops");
 189   ret_obj = _interpret ("method | var | 1 to: 1000 do: [ :i | var := i. 'test' print ]. ^var");
 190   assert (SYX_SMALL_INTEGER(ret_obj) == 1000);
 191
 192   syx_quit ();
 193
 194   return 0;
 195 }