ソースを参照

Fixed cast to subclass method call.
Implemented field initialising. Allow sublasses to have fields with the same name.
Implemented type globals generation.
Added hierarchy 2 test.

woollybah 11 年 前
コミット
fbc92286a2
4 ファイル変更122 行追加24 行削除
  1. 40 12
      ctranslator.bmx
  2. 12 12
      decl.bmx
  3. 63 0
      tests/framework/types/hierarchy_02.bmx
  4. 7 0
      tests/framework/types/hierarchy_02.res

+ 40 - 12
ctranslator.bmx

@@ -275,10 +275,14 @@ Type TCTranslator Extends TTranslator
 					Local class:String = Bra("(" + obj + TransSubExpr( lhs ) + ")->clas")
 					Return class + "->md_" + decl.ident+TransArgs( args,decl, TransSubExpr( lhs ) )
 				Else If TNewObjectExpr(lhs) Then
-DebugStop
 					Local cdecl:TClassDecl = TNewObjectExpr(lhs).classDecl
 					Local class:String = cdecl.munged
 					Return class + ".md_" + decl.ident+TransArgs( args,decl, TransSubExpr( lhs ) )
+				Else If TCastExpr(lhs) Then
+					Local cdecl:TClassDecl = TObjectType(TCastExpr(lhs).ty).classDecl
+					Local obj:String = Bra("struct " + cdecl.munged + "_obj*")
+					Local class:String = Bra("(" + obj + TransSubExpr( lhs ) + ")->clas")
+					Return class + "->md_" + decl.ident+TransArgs( args,decl, TransSubExpr( lhs ) )
 				Else
 					InternalErr
 				End If
@@ -639,8 +643,8 @@ DebugStop
 '			If stmt.rhs.exprType.GetClass().IsInterface() rhs="GC_IPTR"+Bra(rhs)
 '		Endif
 		If TStringType(stmt.lhs.exprType) Then
-			s:+ "{"	
-			s:+ "BBSTRING tmp=" + lhs + ";~n"
+'			s:+ "{"	
+'			s:+ "BBSTRING tmp=" + lhs + ";~n"
 
 			
 			If stmt.op = "+=" Then
@@ -649,10 +653,10 @@ DebugStop
 				s :+ lhs+TransAssignOp( stmt.op )+rhs
 			End If
 
-			s :+ ";~nBBRETAIN(" + lhs +")~n"
-			s :+ "BBRELEASE(tmp)~n"
+'			s :+ ";~nBBRETAIN(" + lhs +")~n"
+'			s :+ "BBRELEASE(tmp)~n"
 			
-			s:+ "}"
+'			s:+ "}"
 		Else
 		
 				s :+ lhs+TransAssignOp( stmt.op )+rhs
@@ -1004,6 +1008,16 @@ If decl.ident = "Eof" DebugStop
 		Next
 		
 	End Method
+
+	Method EmitClassGlobalsProto(classDecl:TClassDecl)
+	
+		For Local decl:TGlobalDecl = EachIn classDecl.Decls()
+			decl.Semant()
+			
+			Emit "extern "+TransRefType( decl.ty, "" )+" "+ decl.munged+";"	'forward reference...
+		Next
+		
+	End Method
 	
 	Method EmitBBClassClassFuncProto( classDecl:TClassDecl )
 
@@ -1127,7 +1141,6 @@ If decl.ident = "Eof" DebugStop
 		
 		
 		
-		
 		'Emit "typedef struct " + classid + "_obj {"
 		Emit "struct " + classid + "_obj {"
 		Emit "struct BBClass_" + classid + "* clas;"
@@ -1147,6 +1160,9 @@ If decl.ident = "Eof" DebugStop
 
 
 		Emit "struct BBClass_" + classid + " " + classid + ";"
+
+		EmitClassGlobalsProto(classDecl);
+
 Rem	
 		' super class
 '		If Not classDecl.superClass Then
@@ -1341,6 +1357,14 @@ End Rem
 		Next
 		Emit "}"
 	End Rem
+
+		For Local decl:TDecl=EachIn classDecl.Semanted()
+			Local gdecl:TGlobalDecl =TGlobalDecl( decl )
+			If gdecl
+				Emit TransRefType( gdecl.ty, "" )+" "+gdecl.munged+";"
+				Continue
+			EndIf
+		Next
 	
 	
 		reserved = "New,Delete,ToString,ObjectCompare,SendMessage,_reserved1_,_reserved2_,_reserved3_".ToLower()
@@ -1467,16 +1491,20 @@ End Rem
 		
 		' field initialisation
 		For Local decl:TFieldDecl=EachIn classDecl.Decls()
-			' TODO : assume zero/null defaults for now
 			Local fld:String
 
 			' ((int*)((char*)o + 5))[0] = 
 			fld :+ TransFieldRef(decl, "o")
 
-			If TNumericType(decl.ty) Or TObjectType(decl.ty) Or TPointerType(decl.ty) Then
-				fld :+ "= 0;"
-			Else If TStringType(decl.ty) Then
-				fld :+ "= &bbEmptyString;"
+			If decl.init Then
+				' initial value
+				fld :+ "= " + decl.init.Trans() + ";";
+			Else
+				If TNumericType(decl.ty) Or TObjectType(decl.ty) Or TPointerType(decl.ty) Then
+					fld :+ "= 0;"
+				Else If TStringType(decl.ty) Then
+					fld :+ "= &bbEmptyString;"
+				End If
 			End If
 			
 			Emit fld

+ 12 - 12
decl.bmx

@@ -1440,19 +1440,19 @@ End Rem
 		
 		If Not IsInterface()
 			'
-			'check for duplicate fields!
+			'check for duplicate fields! - BlitzMax supports fields with the same name in subclasses..
 			'
-			For Local decl:TDecl=EachIn Semanted()
-				Local fdecl:TFieldDecl=TFieldDecl( decl )
-				If Not fdecl Continue
-				Local cdecl:TClassDecl=superClass
-				While cdecl
-					For Local decl:TDecl=EachIn cdecl.Semanted()
-						If decl.ident=fdecl.ident Err "Field '"+fdecl.ident+"' in class "+ToString()+" overrides existing declaration in class "+cdecl.ToString()
-					Next
-					cdecl=cdecl.superClass
-				Wend
-			Next
+			'For Local decl:TDecl=EachIn Semanted()
+			'	Local fdecl:TFieldDecl=TFieldDecl( decl )
+			'	If Not fdecl Continue
+			'	Local cdecl:TClassDecl=superClass
+			'	While cdecl
+			'		For Local decl:TDecl=EachIn cdecl.Semanted()
+			'			If decl.ident=fdecl.ident Err "Field '"+fdecl.ident+"' in class "+ToString()+" overrides existing declaration in class "+cdecl.ToString()
+			'		Next
+			'		cdecl=cdecl.superClass
+			'	Wend
+			'Next
 			'
 			'Check we implement all abstract methods!
 			'

+ 63 - 0
tests/framework/types/hierarchy_02.bmx

@@ -0,0 +1,63 @@
+SuperStrict
+
+'needed to get it compile
+Framework BRL.StandardIO
+
+Type TypeA
+	Field property:String = "propA"
+	Field prop:String = "A"
+	Field prop2:String = "A"
+	Global glob:String = "A"
+
+
+	Method GetProp:String()
+		Return prop
+	End Method
+
+	Method GetGlob:String()
+		Return glob
+	End Method
+End Type
+
+
+Type TypeB Extends TypeA
+	'not overwriting, but replacing the whole property
+	Field prop:String = "B"
+	Global glob:String = "B"
+
+
+	'overwrite getter
+	Method GetProp:String()
+		Return prop
+	End Method
+
+
+	Method PrintProperty()
+		'this wont work with original BlitzMax
+		'  Print "super: " + Super.prop
+		'so we use getters to access Super.PropertyX
+		Print "Super.GetProp: " + Super.GetProp() + "  =  A"
+		Print "Self.GetProp : " + GetProp() + " =/= A"
+		Print "Self.prop    : " + Self.prop + " =/= A"
+		Print "Self.prop2   : " + Self.prop2 + "  =  A"
+
+		Print "Self.GetGlob : " + GetGlob() + "  =  A"
+		Print "Self.glob    : " + glob + " =/= A"
+	End Method
+End Type
+
+
+Local B:TypeB = New TypeB
+Rem
+should print
+
+Super.GetProp: A  =  A
+Self.GetProp : B  =  B
+Self.prop    : B  =  B
+Self.prop2   : A =/= A
+Self.GetGlob : A  =  A
+self.glob    : B =/= A
+
+End Rem
+
+B.PrintProperty()

+ 7 - 0
tests/framework/types/hierarchy_02.res

@@ -0,0 +1,7 @@
+Super.GetProp: A  =  A
+Super.GetProp: A  =  A
+Self.GetProp : B =/= A
+Self.prop    : B =/= A
+Self.prop2   : A  =  A
+Self.GetGlob : A  =  A
+Self.glob    : B =/= A