rev 469 - in trunk: pr src

SVN User <[email protected]> Wed, 12 May 2004 15:54:08 -0400
Newsgroups gmane.comp.lang.prothon.cvs
Message-ID <[email protected]>
Author: mark
Date: 2004-05-12 15:54:05 -0400 (Wed, 12 May 2004)
New Revision: 469

Modified:
   trunk/pr/test.pr
   trunk/src/interp.c
Log:
fixed scope chain to go through main module (globals)

Modified: trunk/pr/test.pr
===================================================================
--- trunk/pr/test.pr	2004-05-12 19:42:34 UTC (rev 468)
+++ trunk/pr/test.pr	2004-05-12 19:54:05 UTC (rev 469)
@@ -1,31 +1,46 @@
 #!/usr/bin/env prothon
 
-# bin.pr
+# dbm.pr
 
-x = Exception
+from DBM import DB
 
-object obj(String, Int):
-        Int.init_{obj}(99)      # inits using second proto
-        print Int.str_{obj}()   # prints 99
-        
-try:
-    with obj: Int.init_{obj}(99)   # init Int a second time
-except x,e: print e    # throws "object has binary data, expected none"
+db = DB("test.dbm", mode=DBM.RWTRUNCATE)
 
-try:
-    obj.init_('abc') # init as String
-except x,e: print e     # throws "object has binary data, expected none"
+if db.exists?('a'):
+	print 'err1'
+	Sys.exit(1)
+	
+db.store('a', 'abc' + 0.chr() + 'def')
+db.store('c', 'xyz')
+db.store('b', '')
 
-L = Proto(List) # L is uninitialized list
+if not db.exists?('a'):
+	print 'err2'
+	Sys.exit(1)
+	
+if db.fetch('a') != 'abc' + 0.chr() + 'def':
+	print 'err3'
+	Sys.exit(1)
+	
+if db.fetch('b') != '':
+	print 'err4'
+	Sys.exit(1)
+	
+if db.fetch('c') != 'xyz':
+	print 'err5'
+	Sys.exit(1)
+	
+list = []
+k = db.firstKey()
+while k:
+	list.append!(k)
+	k = db.nextKey(k)
 
-L.init_(1,2,3)
-print L             # prints [1, 2, 3] 
+list.sort!()
 
-L.init_(4,5,6)
-print L             # prints [4, 5, 6] 
+if list != ['a','b','c']:
+	print 'err6'
+	Sys.exit(1)
+	
+print '\nall tests passed\n'
 
-d = {1:2, 'a':'b'}
-print d             # prints {1:2, 'a':'b'}
-
-d.init_(c = 'd', f = 'g')
-print d             # prints {f:'g', c:'d'} 
\ No newline at end of file

Modified: trunk/src/interp.c
===================================================================
--- trunk/src/interp.c	2004-05-12 19:42:34 UTC (rev 468)
+++ trunk/src/interp.c	2004-05-12 19:54:05 UTC (rev 469)
@@ -1275,6 +1275,17 @@
 				IF_EXC_BREAK;
 				return_flag = fr_ccall;
 				break;
+			case OP_PRINT: {
+				int i;
+				fr_sp -= param;
+				for (i=0; i < param; i++) 
+					if (fr_stack[fr_sp+i]) {  // NOT STACKLESS XXX
+						obj_p str_obj = call_func0(ist, fr_stack[fr_sp+i], SYM(STR_));
+						IF_EXC_BREAK;
+						printf("%s ", pr_strptr(str_obj));
+					} else if (i == param-1) goto endcase;
+				printf("\n");
+			}   break;
 			case OP_IMPORT:    
 				import_module(ist, frame, param, TRUE, NULL, FALSE);
 				break;
@@ -1327,17 +1338,6 @@
 				set_attr(ist, ist->module, fr_data(param-1), obj);
 				un_su(i);
 			}	break;
-			case OP_PRINT: {
-				int i;
-				fr_sp -= param;
-				for (i=0; i < param; i++) 
-					if (fr_stack[fr_sp+i]) {  // NOT STACKLESS XXX
-						obj_p str_obj = call_func0(ist, fr_stack[fr_sp+i], SYM(STR_));
-						IF_EXC_BREAK;
-						printf("%s ", pr_strptr(str_obj));
-					} else if (i == param-1) goto endcase;
-				printf("\n");
-			}   break;
 			default: {
 				raise_exception(ist, OBJ(INTERNAL_EXC), "Bad opcode: %d", op);
 			}
@@ -1645,7 +1645,7 @@
 	set_obj_doc(module, full_doc);
 	frame = ist->frame;
 	new_locals = NEW_OBJ(NULL);
-	new_frame = create_frame( ist, module, dest_module, dyn_locals, new_locals, NULL, code );
+	new_frame = create_frame( ist, NULL, module, NULL, new_locals, NULL, code );
 	new_frame->called_from_c = TRUE;
 	if (frame) ist->frame->next_frame = new_frame;
 	new_frame->prev_frame = ist->frame;