udt-wstring: add TYPE EXTENDS Z|WSTRING [, udt]

- type can extend Z|WSTRING and another user defined type (pseudo multiple inheritance for z|wstring only)
- extended types inherit Z|WSTRING if the base type also extended Z|WSTRING

Author: jayrm

src/compiler/parser-decl-struct.bas

@@ -627,7 +627,8 @@ private function hTypeAdd _
 		byval isunion as integer, _
 		byval align as integer, _
 		byval baseDType as integer = 0, _
-		byval baseSubtype as FBSYMBOL ptr = NULL _
+		byval baseSubtype as FBSYMBOL ptr = NULL, _
+		byval baseStringType as integer = 0 _
 	) as FBSYMBOL ptr
 
 	dim as FBSYMBOL ptr s = any
@@ -639,12 +640,10 @@ private function hTypeAdd _
 		s = symbStructBegin( NULL, NULL, parent, symbUniqueLabel( ), NULL, isunion, align, (baseSubtype <> NULL), 0, 0 )
 	end if
 
-	select case baseDType
+	select case baseStringType
 	case FB_DATATYPE_CHAR
-		assert( baseSubtype = NULL )
 		symbSetUdtIsZstring( s )
 	case FB_DATATYPE_WCHAR
-		assert( baseSubtype = NULL )
 		symbSetUdtIsWstring( s )
 	end select
 
@@ -1009,6 +1008,7 @@ sub cTypeDecl( byval attrib as integer )
 	'' (EXTENDS SymbolType)?
 	dim as FBSYMBOL ptr baseSubtype = NULL
 	dim as integer baseDType = 0
+	dim as integer stringType = 0
 
 	if( lexGetToken( ) = FB_TK_EXTENDS ) then
 		lexSkipToken( )
@@ -1022,15 +1022,61 @@ sub cTypeDecl( byval attrib as integer )
 			'' allow extending WSTRING and ZSTRING, the UDT
 			'' will use different rules for conversions,
 			if (baseDType = FB_DATATYPE_WCHAR) or (baseDType = FB_DATATYPE_CHAR) then
+				stringType = baseDType
+				baseDType = 0
 				assert( baseSubtype = NULL )
-			
+
 			'' anything else? don't allow
 			else
 				errReport( FB_ERRMSG_EXPECTEDCLASSTYPE )
 				'' error recovery: skip
 				baseSubtype = NULL
 			end if
 		end if
+
+		'' got a string type?  check for another base type
+		if( stringType <> 0 ) then
+
+			'' ','?
+			if( lexGetToken( ) = CHAR_COMMA ) then
+				lexSkipToken( )
+
+				'' SymbolType
+				hSymbolType( baseDType, baseSubtype, 0, FALSE, TRUE )
+
+				'' is the base type a struct?
+				if( baseDType <> FB_DATATYPE_STRUCT ) then
+					errReport( FB_ERRMSG_EXPECTEDCLASSTYPE )
+					'' error recovery: skip
+					baseSubtype = NULL
+				end if
+			end if
+		end if
+
+		'' base type? check if z|wstring was already extended
+		if( baseSubType ) then
+			select case stringType
+			case FB_DATATYPE_CHAR
+				'' can't extend zstring if inheriting from wstring
+				if( symbGetUdtIsWstring( baseSubtype ) ) then
+					errReport( FB_ERRMSG_INVALIDDATATYPES )
+					stringType = FB_DATATYPE_WCHAR
+				end if
+			case FB_DATATYPE_WCHAR
+				'' can't extend wstring if inheriting from zstring
+				if( symbGetUdtIsZstring( baseSubtype ) ) then
+					errReport( FB_ERRMSG_INVALIDDATATYPES )
+					stringType = FB_DATATYPE_CHAR
+				end if
+			case else
+				'' inherit from base type
+				if( symbGetUdtIsZstring( baseSubtype ) ) then
+					stringType = FB_DATATYPE_CHAR
+				elseif( symbGetUdtIsWstring( baseSubtype ) ) then
+					stringType = FB_DATATYPE_WCHAR
+				end if
+			end select
+		end if
 	end if
 
 	'' [FIELD '=' ConstExpression]
@@ -1049,7 +1095,7 @@ sub cTypeDecl( byval attrib as integer )
 	dim as FBSYMBOL ptr currprocsym = parser.currproc, currblocksym = parser.currblock
 	dim as integer scope_depth = parser.scope
 
-	sym = hTypeAdd( NULL, id, palias, isunion, align, baseDType, baseSubtype )
+	sym = hTypeAdd( NULL, id, palias, isunion, align, baseDType, baseSubtype, stringType )
 
 	'' restore the context
 	ast.proc.curr = currproc

tests/udt-wstring/uwstring-fixed.bas

@@ -3,31 +3,78 @@
 
 '' reference implementation of fixed length UDT wstring
 
+'' -------------------
+'' UWSTRING_FIXED_BASE
+'' -------------------
+
 ''
-constructor UWSTRING_FIXED()
+constructor UWSTRING_FIXED_BASE()
 	_data = ""
 end constructor
 
 ''
-constructor UWSTRING_FIXED( byval s as const wstring const ptr )
+constructor UWSTRING_FIXED_BASE( byval s as const wstring const ptr )
 	_data = *s
 end constructor
 
 ''
-constructor UWSTRING_FIXED( byval s as const zstring const ptr )
+constructor UWSTRING_FIXED_BASE( byval s as const zstring const ptr )
 	_data = wstr( *s )
 end constructor
 
+const function UWSTRING_FIXED_BASE.length() as integer
+	function = len( _data )
+end function
+
+''
+operator Len( byref s as const UWSTRING_FIXED_BASE ) as integer
+	return s.Length()
+end operator
+
+
+'' --------------
+'' UWSTRING_FIXED
+'' --------------
+
+''
+constructor UWSTRING_FIXED()
+end constructor
+
+''
+constructor UWSTRING_FIXED( byval s as const wstring const ptr )
+	base( s )
+end constructor
+
+''
+constructor UWSTRING_FIXED( byval s as const zstring const ptr )
+	base( s )
+end constructor
+
 ''
 operator UWSTRING_FIXED.Cast() byref as const wstring
 	operator = *cast(wstring ptr, @_data)	
 end operator
 
-const function UWSTRING_FIXED.length() as integer
-	function = len( _data )
-end function
+
+'' ----------------------
+'' UWSTRING_FIXED_MUTABLE
+'' ----------------------
 
 ''
-operator Len( byref s as const UWSTRING_FIXED ) as integer
-	return s.Length()
+constructor UWSTRING_FIXED_MUTABLE()
+end constructor
+
+''
+constructor UWSTRING_FIXED_MUTABLE( byval s as const wstring const ptr )
+	base( s )
+end constructor
+
+''
+constructor UWSTRING_FIXED_MUTABLE( byval s as const zstring const ptr )
+	base( s )
+end constructor
+
+''
+operator UWSTRING_FIXED_MUTABLE.Cast() byref as wstring
+	operator = *cast(wstring ptr, @_data)	
 end operator

tests/udt-wstring/uwstring-fixed.bi

@@ -2,18 +2,37 @@
 
 '' reference implementation of fixed length UDT wstring
 
-type UWSTRING_FIXED extends wstring
+type UWSTRING_FIXED_BASE extends wstring
 
-	private:
+	protected:
 		_data as wstring * 256
 
 	public:
 		declare constructor()
 		declare constructor( byval rhs as const wstring const ptr )
 		declare constructor( byval rhs as const zstring const ptr )
-		declare operator cast() byref as const wstring
 		declare const function length() as integer
 
 end type
 
-declare operator Len( byref s as const UWSTRING_FIXED ) as integer
+declare operator Len( byref s as const UWSTRING_FIXED_BASE ) as integer
+
+type UWSTRING_FIXED extends UWSTRING_FIXED_BASE
+
+	public:
+		declare constructor()
+		declare constructor( byval rhs as const wstring const ptr )
+		declare constructor( byval rhs as const zstring const ptr )
+
+		declare operator cast() byref as const wstring
+end type
+
+type UWSTRING_FIXED_MUTABLE extends UWSTRING_FIXED_BASE
+
+	public:
+		declare constructor()
+		declare constructor( byval rhs as const wstring const ptr )
+		declare constructor( byval rhs as const zstring const ptr )
+
+		declare operator cast() byref as wstring
+end type

tests/udt-zstring/uzstring-fixed.bas

@@ -1,33 +1,80 @@
 #include "fbcunit.bi"
 #include once "uzstring-fixed.bi"
 
-'' reference implementation of fixed length UDT wstring
+'' reference implementation of fixed length UDT zstring
+
+'' -------------------
+'' UZSTRING_FIXED_BASE
+'' -------------------
 
 ''
-constructor UZSTRING_FIXED()
+constructor UZSTRING_FIXED_BASE()
 	_data = ""
 end constructor
 
 ''
-constructor UZSTRING_FIXED( byval s as const zstring const ptr )
+constructor UZSTRING_FIXED_BASE( byval s as const zstring const ptr )
 	_data = *s
 end constructor
 
 ''
-constructor UZSTRING_FIXED( byval s as const wstring const ptr )
+constructor UZSTRING_FIXED_BASE( byval s as const wstring const ptr )
 	_data = str( *s )
 end constructor
 
 ''
-operator UZSTRING_FIXED.Cast() byref as const zstring
-	operator = *cast(zstring ptr, @_data)
-end operator
-
-const function UZSTRING_FIXED.length() as integer
+const function UZSTRING_FIXED_BASE.length() as integer
 	function = len( _data )
 end function
 
 ''
-operator Len( byref s as const UZSTRING_FIXED ) as integer
+operator Len( byref s as const UZSTRING_FIXED_BASE ) as integer
 	return s.Length()
 end operator
+
+'' --------------
+'' UZSTRING_FIXED
+'' --------------
+
+''
+constructor UZSTRING_FIXED()
+end constructor
+
+''
+constructor UZSTRING_FIXED( byval s as const wstring const ptr )
+	base( s )
+end constructor
+
+''
+constructor UZSTRING_FIXED( byval s as const zstring const ptr )
+	base( s )
+end constructor
+
+''
+operator UZSTRING_FIXED.Cast() byref as const zstring
+	operator = *cast(zstring ptr, @_data)
+end operator
+
+
+'' ----------------------
+'' UZSTRING_FIXED_MUTABLE
+'' ----------------------
+
+''
+constructor UZSTRING_FIXED_MUTABLE()
+end constructor
+
+''
+constructor UZSTRING_FIXED_MUTABLE( byval s as const wstring const ptr )
+	base( s )
+end constructor
+
+''
+constructor UZSTRING_FIXED_MUTABLE( byval s as const zstring const ptr )
+	base( s )
+end constructor
+
+''
+operator UZSTRING_FIXED_MUTABLE.Cast() byref as zstring
+	operator = *cast(zstring ptr, @_data)
+end operator

tests/udt-zstring/uzstring-fixed.bi

@@ -1,19 +1,38 @@
 #pragma once
 
-'' reference implementation of fixed length UDT wstring
+'' reference implementation of fixed length UDT zstring
 
-type UZSTRING_FIXED extends zstring
+type UZSTRING_FIXED_BASE extends zstring
 
-	private:
+	protected:
 		_data as zstring * 256
 
 	public:
 		declare constructor()
 		declare constructor( byval rhs as const zstring const ptr )
 		declare constructor( byval rhs as const wstring const ptr )
-		declare operator cast() byref as const zstring
 		declare const function length() as integer
 
 end type
 
-declare operator Len( byref s as const UZSTRING_FIXED ) as integer
+declare operator Len( byref s as const UZSTRING_FIXED_BASE ) as integer
+
+type UZSTRING_FIXED extends UZSTRING_FIXED_BASE
+
+	public:
+		declare constructor()
+		declare constructor( byval rhs as const wstring const ptr )
+		declare constructor( byval rhs as const zstring const ptr )
+
+		declare operator cast() byref as const zstring
+end type
+
+type UZSTRING_FIXED_MUTABLE extends UZSTRING_FIXED_BASE
+
+	public:
+		declare constructor()
+		declare constructor( byval rhs as const wstring const ptr )
+		declare constructor( byval rhs as const zstring const ptr )
+
+		declare operator cast() byref as zstring
+end type