Revived the fox tester and patched initial bugs (recursion problem in reflection)

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6841 8c9fc860-2736-0410-a75d-ab315db34111

source/FoxIntermediateBackend.Mod

@@ -11720,6 +11720,7 @@ TYPE
 				sfTypeBYTE = 1CX; 
 				sfTypeADDRESS = 1DX; 
 				sfTypeSIZE = 1EX; 
+				sfTypeIndirect = 1FX;
 				
 				sfTypeRecord = 20X;	
 
@@ -11758,6 +11759,8 @@ TYPE
 
 			VAR
 				s: Sections.Section; sizePC, i, startPC, lastOffset: LONGINT;
+				indirectTypes: Basic.HashTable;
+
 
 				PROCEDURE CurrentIndex(): SIZE;
 				VAR i: LONGINT;
@@ -11796,9 +11799,24 @@ TYPE
 						| sfTypeWORD | sfTypeLONGWORD
 						| sfTypeREAL | sfTypeLONGREAL
 						| sfTypeCOMPLEX | sfTypeLONGCOMPLEX
-						| sfTypeSET | sfTypeANY | sfTypeOBJECT | sfTypeBYTE | sfTypeADDRESS | sfTypeSIZE.
+						| sfTypeSET | sfTypeANY | sfTypeOBJECT | sfTypeBYTE | sfTypeADDRESS | sfTypeSIZE
+						| sfTypeIndirect offset:SIZE.
 		*) 
-		
+				
+				PROCEDURE Indirect(type: SyntaxTree.Type): BOOLEAN;
+				VAR offset: SIZE; 
+				BEGIN
+					IF indirectTypes.Has(type) THEN
+						offset := indirectTypes.GetInt(type);
+						Char(section, sfTypeIndirect);
+						Size(section, offset);
+						RETURN TRUE;
+					ELSE
+						indirectTypes.PutInt(type, CurrentIndex());
+						RETURN FALSE;
+					END;
+				END Indirect;
+				
 				PROCEDURE NType(type: SyntaxTree.Type);
 				VAR size: SIZE; td: SyntaxTree.TypeDeclaration; tir: Sections.Section; 
 					segmentedName: Basic.SegmentedName; offset: SIZE; parameter: SyntaxTree.Parameter;
@@ -11813,79 +11831,88 @@ TYPE
 							IF type.pointerBase.resolved IS SyntaxTree.RecordType THEN
 								IF RefInfo THEN Info(section,"PointerToRecord") END;
 								Char(section, sfTypePointerToRecord);
+								(*! do we ever need the pointer base?  NType(type.pointerBase);*)
 							ELSE
 								IF RefInfo THEN Info(section,"PointerToArray") END;
 								Char(section, sfTypePointerToArray);
 								NType(type.pointerBase);
 							END;
 						| type: SyntaxTree.ArrayType DO
-							IF type.form = SyntaxTree.Open THEN
-								IF RefInfo THEN Info(section,"OpenArray") END;
-								Char(section, sfTypeOpenArray);
-							ELSIF type.form = SyntaxTree.SemiDynamic THEN
-								IF RefInfo THEN Info(section,"DynamicArray") END;
-								Char(section, sfTypeDynamicArray); 
-							ELSIF type.form = SyntaxTree.Static THEN
-								IF RefInfo THEN Info(section,"StaticArray") END;
-								Char(section, sfTypeStaticArray);
-								Size(section, type.staticLength);
-							ELSE 
-								HALT(100);
+							IF ~Indirect(type) THEN
+								IF type.form = SyntaxTree.Open THEN
+									IF RefInfo THEN Info(section,"OpenArray") END;
+									Char(section, sfTypeOpenArray);
+								ELSIF type.form = SyntaxTree.SemiDynamic THEN
+									IF RefInfo THEN Info(section,"DynamicArray") END;
+									Char(section, sfTypeDynamicArray); 
+								ELSIF type.form = SyntaxTree.Static THEN
+									IF RefInfo THEN Info(section,"StaticArray") END;
+									Char(section, sfTypeStaticArray);
+									Size(section, type.staticLength);
+								ELSE 
+									HALT(100);
+								END;
+								NType(type.arrayBase);
 							END;
-							NType(type.arrayBase);
 						| type: SyntaxTree.MathArrayType DO
-							IF type.form = SyntaxTree.Open THEN
-								IF RefInfo THEN Info(section,"MathOpenArray") END;
-								Char(section, sfTypeMathOpenArray); 
-							ELSIF type.form = SyntaxTree.Static THEN
-								IF RefInfo THEN Info(section,"MathStaticArray") END;
-								Char(section, sfTypeMathStaticArray);
-								Size(section, type.staticLength);
-							ELSIF type.form = SyntaxTree.Tensor THEN
-								IF RefInfo THEN Info(section,"MathTensor") END;
-								Char(section, sfTypeMathTensor);
-							ELSE
-								HALT(100);
+							IF ~Indirect(type) THEN
+								IF type.form = SyntaxTree.Open THEN
+									IF RefInfo THEN Info(section,"MathOpenArray") END;
+									Char(section, sfTypeMathOpenArray); 
+								ELSIF type.form = SyntaxTree.Static THEN
+									IF RefInfo THEN Info(section,"MathStaticArray") END;
+									Char(section, sfTypeMathStaticArray);
+									Size(section, type.staticLength);
+								ELSIF type.form = SyntaxTree.Tensor THEN
+									IF RefInfo THEN Info(section,"MathTensor") END;
+									Char(section, sfTypeMathTensor);
+								ELSE
+									HALT(100);
+								END;
+								NType(type.arrayBase);
 							END;
-							NType(type.arrayBase);
 						| type: SyntaxTree.RecordType DO
-							IF type.pointerType # NIL (* OBJECT *) THEN
-								IF RefInfo THEN Info(section,"PointerToRecord") END;
-								Char(section, sfTypePointerToRecord)
-							ELSE
-								IF RefInfo THEN Info(section,"Record") END;
-								Char(section, sfTypeRecord);
-								td := type.typeDeclaration;		
-								IF RefInfo THEN Info(section,"TD") END;
-								IF (td # NIL) THEN
-									Global.GetSymbolSegmentedName(td,segmentedName);
-									IF (td.scope = NIL) OR (td.scope.ownerModule = module.module) THEN
-										tir := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+							IF ~Indirect(type) THEN
+								IF type.pointerType # NIL (* OBJECT *) THEN
+									IF RefInfo THEN Info(section,"PointerToRecord") END;
+									Char(section, sfTypePointerToRecord)
+								ELSE
+									IF RefInfo THEN Info(section,"Record") END;
+									Char(section, sfTypeRecord);
+									td := type.typeDeclaration;		
+									IF RefInfo THEN Info(section,"TD") END;
+									IF (td # NIL) THEN
+										Global.GetSymbolSegmentedName(td,segmentedName);
+										IF (td.scope = NIL) OR (td.scope.ownerModule = module.module) THEN
+											tir := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+										ELSE
+											tir := IntermediateCode.NewSection(module.importedSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+										END;
+										offset := ToMemoryUnits(module.system,GetTypeRecordBaseOffset(type(SyntaxTree.RecordType).recordScope.numberMethods)*module.system.addressSize);
+										Symbol(section, tir,  0, offset);
 									ELSE
-										tir := IntermediateCode.NewSection(module.importedSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+										Address(section, 0);
 									END;
-									offset := ToMemoryUnits(module.system,GetTypeRecordBaseOffset(type(SyntaxTree.RecordType).recordScope.numberMethods)*module.system.addressSize);
-									Symbol(section, tir,  0, offset);
-								ELSE
-									Address(section, 0);
 								END;
 							END;
 						| type: SyntaxTree.CellType DO
-								IF RefInfo THEN Info(section,"Record") END;
-								Char(section, sfTypeRecord);
-								td := type.typeDeclaration;		
-								IF RefInfo THEN Info(section,"TD") END;
-								IF (td # NIL) THEN
-									Global.GetSymbolSegmentedName(td,segmentedName);
-									IF (td.scope = NIL) OR (td.scope.ownerModule = module.module) THEN
-										tir := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+								IF ~Indirect(type) THEN
+									IF RefInfo THEN Info(section,"Record") END;
+									Char(section, sfTypeRecord);
+									td := type.typeDeclaration;		
+									IF RefInfo THEN Info(section,"TD") END;
+									IF (td # NIL) THEN
+										Global.GetSymbolSegmentedName(td,segmentedName);
+										IF (td.scope = NIL) OR (td.scope.ownerModule = module.module) THEN
+											tir := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+										ELSE
+											tir := IntermediateCode.NewSection(module.importedSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+										END;
+										offset := ToMemoryUnits(module.system,GetTypeRecordBaseOffset(0)*module.system.addressSize);
+										Symbol(section, tir,  0, offset);
 									ELSE
-										tir := IntermediateCode.NewSection(module.importedSections, Sections.ConstSection, segmentedName,td,declarationVisitor.dump);
+										Address(section, 0);
 									END;
-									offset := ToMemoryUnits(module.system,GetTypeRecordBaseOffset(0)*module.system.addressSize);
-									Symbol(section, tir,  0, offset);
-								ELSE
-									Address(section, 0);
 								END;
 						| type: SyntaxTree.PortType DO
 							Char(section, sfTypePORT);
@@ -11895,13 +11922,15 @@ TYPE
 								Char(section, sfIN)
 							END;
 						| type: SyntaxTree.ProcedureType DO
-								Char(section, sfTypeDelegate);
-								parameter := type.firstParameter;
-								WHILE(parameter # NIL) DO
-									NParameter(parameter, -1);
-									parameter := parameter.nextParameter;
-								END;
-								NType(type.returnType);															
+								IF ~Indirect(type) THEN
+									Char(section, sfTypeDelegate);
+									parameter := type.firstParameter;
+									WHILE(parameter # NIL) DO
+										NParameter(parameter, -1);
+										parameter := parameter.nextParameter;
+									END;
+									NType(type.returnType);
+								END;															
 						| type:SyntaxTree.EnumerationType DO
 								Char(section, sfTypeENUM);
 						| type: SyntaxTree.BasicType DO
@@ -12210,6 +12239,7 @@ TYPE
 	
 				
 			BEGIN
+				NEW(indirectTypes, 32); 
 				ArrayBlock(section,sizePC,"", FALSE);
 				
 				startPC := section.pc;

source/FoxInterpreterSymbols.Mod

@@ -422,112 +422,128 @@ TYPE
 			stack.PushA(adr);
 		END PushAddress;
 		
-		PROCEDURE Push*(o: Result): BOOLEAN;
-		VAR 
+		PROCEDURE PushTyped*(o: Result; mode: CHAR; refs: Modules.Bytes; VAR offset: SIZE): BOOLEAN;
+		VAR ofs: SIZE; 
 			s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT; 
 			r: REAL; x: LONGREAL;
 			b: BOOLEAN;
 			set: SET;
 			v:Value;
 			a: ADDRESS;
-			type,mode: CHAR;
+			type: CHAR;
 		BEGIN
-			IF Reflection.GetChar(parameters.refs, parameters.offset) # Reflection.sfVariable THEN RETURN FALSE END;			
-			Reflection.SkipSize(parameters.offset);
-			Reflection.SkipString(parameters.refs, parameters.offset);
-			mode := Reflection.GetChar(parameters.refs, parameters.offset);
-			Reflection.SkipSize(parameters.offset);
-			type := Reflection.GetChar(parameters.refs, parameters.offset);
-			
-			(*type := proc.parameters[index].type;
-			var := 1 IN proc.parameters[index].flags;
-			*)
-			INC(index);
-			IF mode  = Reflection.sfIndirect THEN (* by reference *)
-				IF type = Reflection.sfTypeOpenArray THEN 
-					type := Reflection.GetChar(parameters.refs, parameters.offset);
-					CASE type OF
-					Reflection.sfTypeCHAR, Reflection.sfTypeCHAR8:
-						IF o IS StringValue THEN
-							stack.PushSz(LEN(o(StringValue).value));
-							stack.PushA(ADDRESSOF(o(StringValue).value[0])); 
-							RETURN TRUE;
+			type := Reflection.GetChar(refs, offset);
+			IF type = Reflection.sfTypeIndirect THEN
+				ofs := Reflection.GetSize(refs, offset);
+				RETURN PushTyped(o, mode, refs, ofs); 
+			ELSE
+				INC(index);
+				IF mode  = Reflection.sfIndirect THEN (* by reference *)
+					IF type = Reflection.sfTypeOpenArray THEN 
+						type := Reflection.GetChar(refs, offset);
+						CASE type OF
+						Reflection.sfTypeCHAR, Reflection.sfTypeCHAR8:
+							IF o IS StringValue THEN
+								stack.PushSz(LEN(o(StringValue).value));
+								stack.PushA(ADDRESSOF(o(StringValue).value[0])); 
+								RETURN TRUE;
+							END;
 						END;
-					END;
-				ELSE
-					CASE type OF
-						Reflection.sfTypeCHAR .. Reflection.sfTypeSIZE, Reflection.sfTypePointerToRecord, Reflection.sfTypePointerToArray:
-						(*! check type ! *)
-						 stack.PushA(o.Address());
-						 RETURN TRUE;
 					ELSE
-						RETURN FALSE
-					END;
-				END;
-			ELSE (* by value *)
-				v := o.Evaluate();
-				IF v = NIL THEN RETURN FALSE END;
-				WITH v: Value DO 
-					CASE type OF
-					Reflection.sfTypeSHORTINT,Reflection.sfTypeSIGNED8 : 
-						IF v.GetInt(h) THEN
-							s:= SHORTINT(h); stack.PushS(s);
-							RETURN TRUE;
-						END;
-					| Reflection.sfTypeINTEGER,Reflection.sfTypeSIGNED16 : 
-						IF v.GetInt(h) THEN
-							i:= INTEGER(h); stack.PushI(i);
-							RETURN TRUE;
-						END;
-					| Reflection.sfTypeLONGINT,Reflection.sfTypeSIGNED32: 
-						IF v.GetInt(h) THEN
-							l:= LONGINT(h); stack.PushL(l);
-							RETURN TRUE;
-						END;
-					| Reflection.sfTypeHUGEINT,Reflection.sfTypeSIGNED64: 
-						IF v.GetInt(h) THEN
-							stack.PushH(h);
-							RETURN TRUE;
-						END;
-					|Reflection.sfTypeREAL:
-						IF v.GetReal(x) THEN
-							r := REAL(x);stack.PushR(r);
-							RETURN TRUE;
-						END;
-					|Reflection.sfTypeLONGREAL:
-						IF v.GetReal(x) THEN
-							stack.PushX(x);
-							RETURN TRUE;
-						END;
-					|Reflection.sfTypeBOOLEAN:
-						IF v.GetBoolean(b) THEN
-							stack.PushB(b);
-						RETURN TRUE
-						END;
-					|Reflection.sfTypeSET:
-						IF v.GetSet(set) THEN
-							stack.PushSet(set);
-							RETURN TRUE
-						END;
-					|Reflection.sfTypePointerToRecord:
-						IF v.GetAddress(a) THEN
-							stack.PushA(a);
-							RETURN TRUE
+						CASE type OF
+							Reflection.sfTypeCHAR .. Reflection.sfTypeSIZE, Reflection.sfTypePointerToRecord, Reflection.sfTypePointerToArray:
+							(*! check type ! *)
+							 stack.PushA(o.Address());
+							 RETURN TRUE;
+						ELSE
+							RETURN FALSE
 						END;
-					|Reflection.sfTypeOpenArray:
-						type := Reflection.GetChar(parameters.refs, parameters.offset);
+					END;
+				ELSE (* by value *)
+					v := o.Evaluate();
+					IF v = NIL THEN RETURN FALSE END;
+					WITH v: Value DO 
 						CASE type OF
-						Reflection.sfTypeCHAR, Reflection.sfTypeCHAR8:
-							IF v IS StringValue THEN
-								stack.PushSz(LEN(v(StringValue).value));
-								stack.PushA(ADDRESSOF(v(StringValue).value[0])); 
+						Reflection.sfTypeSHORTINT,Reflection.sfTypeSIGNED8 : 
+							IF v.GetInt(h) THEN
+								s:= SHORTINT(h); stack.PushS(s);
+								RETURN TRUE;
+							END;
+						| Reflection.sfTypeINTEGER,Reflection.sfTypeSIGNED16 : 
+							IF v.GetInt(h) THEN
+								i:= INTEGER(h); stack.PushI(i);
+								RETURN TRUE;
+							END;
+						| Reflection.sfTypeLONGINT,Reflection.sfTypeSIGNED32: 
+							IF v.GetInt(h) THEN
+								l:= LONGINT(h); stack.PushL(l);
+								RETURN TRUE;
+							END;
+						| Reflection.sfTypeHUGEINT,Reflection.sfTypeSIGNED64: 
+							IF v.GetInt(h) THEN
+								stack.PushH(h);
+								RETURN TRUE;
+							END;
+						|Reflection.sfTypeREAL:
+							IF v.GetReal(x) THEN
+								r := REAL(x);stack.PushR(r);
+								RETURN TRUE;
+							END;
+						|Reflection.sfTypeLONGREAL:
+							IF v.GetReal(x) THEN
+								stack.PushX(x);
 								RETURN TRUE;
 							END;
+						|Reflection.sfTypeBOOLEAN:
+							IF v.GetBoolean(b) THEN
+								stack.PushB(b);
+							RETURN TRUE
+							END;
+						|Reflection.sfTypeSET:
+							IF v.GetSet(set) THEN
+								stack.PushSet(set);
+								RETURN TRUE
+							END;
+						|Reflection.sfTypePointerToRecord:
+							IF v.GetAddress(a) THEN
+								stack.PushA(a);
+								RETURN TRUE
+							END;
+						|Reflection.sfTypeOpenArray:
+							type := Reflection.GetChar(refs, offset);
+							CASE type OF
+							Reflection.sfTypeCHAR, Reflection.sfTypeCHAR8:
+								IF v IS StringValue THEN
+									stack.PushSz(LEN(v(StringValue).value));
+									stack.PushA(ADDRESSOF(v(StringValue).value[0])); 
+									RETURN TRUE;
+								END;
+							END;
 						END;
 					END;
 				END;
 			END;
 			RETURN FALSE;
+		END PushTyped;
+		
+		
+		PROCEDURE Push*(o: Result): BOOLEAN;
+		VAR 
+			s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT; 
+			r: REAL; x: LONGREAL;
+			b: BOOLEAN;
+			set: SET;
+			v:Value;
+			a: ADDRESS;
+			type,mode: CHAR;
+		BEGIN
+			IF Reflection.GetChar(parameters.refs, parameters.offset) # Reflection.sfVariable THEN RETURN FALSE END;			
+			Reflection.SkipSize(parameters.offset);
+			Reflection.SkipString(parameters.refs, parameters.offset);
+			mode := Reflection.GetChar(parameters.refs, parameters.offset);
+			Reflection.SkipSize(parameters.offset);
+			RETURN PushTyped(o, mode, parameters.refs, parameters.offset);
+				
 		END Push;
 		
 		PROCEDURE Check*(): BOOLEAN;

source/FoxTest.Mod

@@ -28,7 +28,7 @@ TYPE
 		VAR result: INTEGER; msg: ARRAY 128 OF CHAR; res: LONGINT; f: Files.File; w: Files.Writer; ch: CHAR;
 		BEGIN
 			result := TestSuite.Failure;
-			IF log # NIL THEN log.String ("testing: "); log.String (name); log.String("@"); log.Int(position,0); log.Ln END;
+			IF log # NIL THEN log.String ("testing: "); log.String (name); log.String("@"); log.Int(position,0); log.Ln; log.Update; END;
 
 			(* prepare tester input as a file for all test cases *)
 			f := Files.New(fileName);

source/Generic.Reflection.Mod

@@ -45,6 +45,7 @@ CONST
 	sfTypeBYTE* = 1CX; 
 	sfTypeADDRESS* = 1DX; 
 	sfTypeSIZE* = 1EX; 
+	sfTypeIndirect*= 1FX; 
 
 	sfTypeRecord* = 20X;	
 
@@ -60,6 +61,7 @@ CONST
 	sfTypeENUM* = 2AX;
 	sfTypeCELL* = 2BX;
 	sfTypePORT* = 2CX;
+
 	
 	sfIN* = 0X;
 	sfOUT* = 1X;
@@ -81,7 +83,6 @@ CONST
 
 	(*
 		References section format: 
-		
 		Scope = sfScopeBegin {variable:Variable} {procedure:Procedure} {typeDecl:TypeDeclaration} sfScopeEnd.
 		Module = sfModule prevSymbolOffset:SIZE name:String Scope.
 		Procedure = sfProcedure prevSymbolOffset:SIZE name:String start:ADR end:ADR flags:SET {parameter:Variable} returnType:Type Scope.
@@ -107,8 +108,8 @@ CONST
 			| sfTypeWORD | sfTypeLONGWORD
 			| sfTypeREAL | sfTypeLONGREAL
 			| sfTypeCOMPLEX | sfTypeLONGCOMPLEX
-			| sfTypeSET | sfTypeANY | sfTypeOBJECT | sfTypeBYTE | sfTypeADDRESS | sfTypeSIZE.
-
+			| sfTypeSET | sfTypeANY | sfTypeOBJECT | sfTypeBYTE | sfTypeADDRESS | sfTypeSIZE
+			| sfTypeIndirect offset:SIZE.
 	*)
 
 
@@ -491,7 +492,7 @@ CONST
 	END WriteValueString;
 
 	PROCEDURE WriteValue*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; adr: ADDRESS; low, high: ADDRESS);
-	VAR type: CHAR; a: ADDRESS; size: SIZE; len: SIZE;
+	VAR type: CHAR; a: ADDRESS; size, ofs: SIZE; len: SIZE;
 	BEGIN
 		IF ~OnHeapOrStack(adr, low, high) THEN
 			SkipType(refs, offset);
@@ -499,72 +500,77 @@ CONST
 			RETURN;
 		END;
 		type := GetChar(refs, offset);
-		CASE type OF
-			sfTypeNone:
-			w.String("NONE");
-		| sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
-			WriteBasicValue(w,type, adr, size);
-			SYSTEM.GET(adr, a);
-			IF a = 0 THEN
-				w.String("NIL");
-			ELSIF CheckHeapAddress(a) THEN
-				SYSTEM.GET(a + Heaps.TypeDescOffset, a);
-				w.String(" (");
+		IF type = sfTypeIndirect THEN
+			ofs := GetSize(refs, offset); 
+			WriteValue(w, refs, ofs, adr, low, high);
+		ELSE
+			CASE type OF
+				sfTypeNone:
+				w.String("NONE");
+			| sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
+				WriteBasicValue(w,type, adr, size);
+				SYSTEM.GET(adr, a);
+				IF a = 0 THEN
+					w.String("NIL");
+				ELSIF CheckHeapAddress(a) THEN
+					SYSTEM.GET(a + Heaps.TypeDescOffset, a);
+					w.String(" (");
+					WriteType(w,a);
+					w.String(")");
+				ELSE
+					w.String("(UNKNOWN)");
+				END;
+			| sfTypePointerToArray: 
+				WriteBasicValue(w, sfTypeANY, adr, size);
+				SYSTEM.GET(adr, a);
+				IF ~OnHeapOrStack(a,low,high) THEN w.String(" (INVALID)") END;
+				SkipType(refs, offset);
+			| sfTypeOpenArray: 
+				IF (refs[offset] = sfTypeCHAR) OR (refs[offset] = sfTypeCHAR8)  THEN (* ARRAY OF CHAR *)
+					SYSTEM.GET(adr, a);
+					WriteValueString(w, a, MaxString, low, high);
+				ELSE
+					w.String("... (NO STRING)")
+				END;
+				SkipType(refs, offset);
+			| sfTypeStaticArray: 
+				len := GetSize(refs, offset); 
+				IF (refs[offset] = sfTypeCHAR)  OR (refs[offset] = sfTypeCHAR8) THEN (* ARRAY x OF CHAR *)
+					WriteValueString(w, adr, len, low, high);
+				ELSE
+					w.String("... (NO STRING)");
+				END;
+				SkipType(refs, offset);
+			| sfTypeDynamicArray: 
+				w.String("... (DYNAMIC ARRAY)");
+				SkipType(refs, offset); 
+			| sfTypeMathOpenArray: 
+				w.String("... (MATH OPEN ARRAY)");
+				SkipType(refs, offset);
+			| sfTypeMathStaticArray: 
+				w.String("... (MATH STATIC ARRAY)");
+				SkipSize(offset); SkipType(refs, offset);
+			| sfTypeMathTensor: 
+				w.String("...(MATH TENSOR)");
+				SkipType(refs, offset); 
+			| sfTypeRecord: 
+				w.String("...");
+				w.String("(");
+				a := GetAddress(refs, offset); 
 				WriteType(w,a);
 				w.String(")");
+			| sfTypeDelegate: 
+				w.String("(DELEGATE)");
+				WHILE refs[offset] = sfVariable DO SkipVariable(refs, offset) END;
+				SkipType(refs, offset); 
+			| sfTypePORT:
+				WriteBasicValue(w, type, adr, size);
+				SkipChar(offset);
 			ELSE
-				w.String("(UNKNOWN)");
+				WriteBasicValue(w, type, adr, size);
 			END;
-		| sfTypePointerToArray: 
-			WriteBasicValue(w, sfTypeANY, adr, size);
-			SYSTEM.GET(adr, a);
-			IF ~OnHeapOrStack(a,low,high) THEN w.String(" (INVALID)") END;
-			SkipType(refs, offset)
-		| sfTypeOpenArray: 
-			IF (refs[offset] = sfTypeCHAR) OR (refs[offset] = sfTypeCHAR8)  THEN (* ARRAY OF CHAR *)
-				SYSTEM.GET(adr, a);
-				WriteValueString(w, a, MaxString, low, high);
-			ELSE
-				w.String("... (NO STRING)")
-			END;
-			SkipType(refs, offset);
-		| sfTypeStaticArray: 
-			len := GetSize(refs, offset); 
-			IF (refs[offset] = sfTypeCHAR)  OR (refs[offset] = sfTypeCHAR8) THEN (* ARRAY x OF CHAR *)
-				WriteValueString(w, adr, len, low, high);
-			ELSE
-				w.String("... (NO STRING)");
-			END;
-			SkipType(refs, offset);
-		| sfTypeDynamicArray: 
-			w.String("... (DYNAMIC ARRAY)");
-			SkipType(refs, offset); 
-		| sfTypeMathOpenArray: 
-			w.String("... (MATH OPEN ARRAY)");
-			SkipType(refs, offset);
-		| sfTypeMathStaticArray: 
-			w.String("... (MATH STATIC ARRAY)");
-			SkipSize(offset); SkipType(refs, offset);
-		| sfTypeMathTensor: 
-			w.String("...(MATH TENSOR)");
-			SkipType(refs, offset); 
-		| sfTypeRecord: 
-			w.String("...");
-			w.String("(");
-			a := GetAddress(refs, offset); 
-			WriteType(w,a);
-			w.String(")");
-		| sfTypeDelegate: 
-			w.String("(DELEGATE)");
-			WHILE refs[offset] = sfVariable DO SkipVariable(refs, offset) END;
-			SkipType(refs, offset); 
-		| sfTypePORT:
-			WriteBasicValue(w, type, adr, size);
-			SkipChar(offset);
-		ELSE
-			WriteBasicValue(w, type, adr, size);
+			w.Update;
 		END;
-		w.Update;
 	END WriteValue;
 		
 	PROCEDURE WriteVariable*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT;  base: ADDRESS; low, high: ADDRESS);
@@ -611,7 +617,7 @@ CONST
 		CASE c OF
 			sfTypeNone .. sfTypeSIZE: 
 		| sfTypePointerToRecord:
-		| sfTypePointerToArray: SkipType(refs, offset);
+		| sfTypePointerToArray:SkipType(refs, offset);
 		| sfTypeOpenArray: SkipType(refs, offset);
 		| sfTypeStaticArray: SkipSize(offset); SkipType(refs, offset);
 		| sfTypeDynamicArray: SkipType(refs, offset); 
@@ -624,6 +630,7 @@ CONST
 			SkipType(refs, offset);
 		| sfTypeENUM:
 		| sfTypePORT: SkipChar(offset);
+		| sfTypeIndirect: SkipSize(offset);
 		ELSE (* ?? *)
 		END;
 	END SkipType;
@@ -1022,7 +1029,7 @@ TYPE
 		CASE c OF
 			sfTypeNone: w.String("no type");
 		| sfTypePointerToRecord: w.String("POINTER TO RECORD");
-		| sfTypePointerToArray: w.String("POINTER TO "); ReportType(w, refs, offset);
+		| sfTypePointerToArray: w.String("POINTER TO"); ReportType(w, refs, offset);
 		| sfTypeOpenArray: w.String("ARRAY OF "); ReportType(w, refs, offset);
 		| sfTypeStaticArray: w.String("ARRAY "); w.Int(GetSize(refs, offset),1 ); w.String(" OF "); ReportType(w, refs, offset);
 		| sfTypeDynamicArray: w.String("DARRAY OF "); ReportType(w,refs, offset); 
@@ -1065,6 +1072,7 @@ TYPE
 		| sfTypeADDRESS: w.String("ADDRESS"); 
 		| sfTypeSIZE: w.String("SIZE"); 
 		| sfTypePORT: w.String("PORT"); IF GetChar(refs,offset) = sfIN THEN w.String("IN") ELSE w.String("OUT") END;
+		| sfTypeIndirect: w.String ("INDIRECT AT "); w.Int(GetSize(refs, offset),1);
 		ELSE w.String("????? TYPE ?????");
 		END;
 	END ReportType;

source/Oberon.Compilation.Test

@@ -1099,21 +1099,21 @@ negative: procedure section before import section
 	IMPORT Import := Dummy;
 	END Test.
 
-negative: procedure section before const section
+positive: procedure section before const section
 
 	MODULE Test;
 	PROCEDURE Procedure; END Procedure;
 	CONST Constant = 0;
 	END Test.
-
-negative: procedure section before type section
+	
+positive: procedure section before type section
 
 	MODULE Test;
 	PROCEDURE Procedure; END Procedure;
 	TYPE Type = RECORD END;
 	END Test.
 
-negative: procedure section before var section
+positive: procedure section before var section
 
 	MODULE Test;
 	PROCEDURE Procedure; END Procedure;
@@ -10153,7 +10153,7 @@ negative: procedure marked as exported within procedure in object
 	END Object;
 	END Test.
 
-negative: procedure marked as read-only
+positive: procedure marked as read-only
 
 	MODULE Test;
 	PROCEDURE Procedure-;
@@ -10180,7 +10180,7 @@ negative: procedure marked as read-only within nested procedure
 	END Procedure;
 	END Test.
 
-negative: procedure marked as read-only within object
+positive: procedure marked as read-only within object
 
 	MODULE Test;
 	TYPE Object = OBJECT
@@ -20267,7 +20267,7 @@ negative: pointer to variable integer assignment
 	BEGIN result := variable;
 	END Test.
 
-negative: variable procedure to variable integer assignment
+negative: variable eto variable integer assignment
 
 	MODULE Test;
 	VAR variable: PROCEDURE; result: INTEGER;

source/Oberon.Execution.Test

@@ -1,5 +1,5 @@
 # Oberon language test and validation suite
-# options 	--mayTrap --prolog="Compiler.Compile -p=Win23G TesterInput.txt" --command="SystemTools.Free Test Dummy B A;SystemTools.Load Test" --logFile="FoxExecutionTest.Log" --result="Oberon.Execution.Test.Diff"
+# options 	--mayTrap --prolog="Compiler.Compile -p=Win32G TesterInput.txt" --command="SystemTools.Free Test Dummy B A;SystemTools.Load Test" --logFile="FoxExecutionTest.Log" --result="Oberon.Execution.Test.Diff"
 
 # test halt and assert statements and simple procedure call (basics for the test suite)