Add deleting destructor for c++ ABI

changelog.txt

@@ -46,6 +46,7 @@ Version 1.08.0
 - only write debug line information for statements and don't write comments / empty lines / directives for top level source code in assembly debug ouput
 - optimize byref 'm += s' string concatenations to fb_StrConcatByref() which will check for same string descriptor at run-time which can't be determined at compile time for byref parameters.
 - github #298: allow command line options passed to as, gcc, ld  to be longer than 128 characters by using string types internally
+- sf.net #923: implicitly emit the deleting destrutor for extern "c++" mangling for better g++ ABI compatibility
 
 [added]
 - extern "rtlib": respects the parent namespace, uses default fb calling convention and C style name mangling

src/compiler/ast-helper.bas

@@ -153,7 +153,7 @@ function astBuildVarDtorCall overload _
 			'' UDT var with dtor?
 			if( symbHasDtor( s ) ) then
 				if( check_access ) then
-					if( symbCheckAccess( symbGetCompDtor( symbGetSubtype( s ) ) ) = FALSE ) then
+					if( symbCheckAccess( symbGetCompDtor1( symbGetSubtype( s ) ) ) = FALSE ) then
 						errReport( FB_ERRMSG_NOACCESSTODTOR )
 					end if
 				end if
@@ -543,7 +543,7 @@ function astBuildDtorCall _
 	dim as ASTNODE ptr callexpr = any
 
 	'' Can be virtual
-	dtor = symbGetCompDtor( sym )
+	dtor = symbGetCompDtor1( sym )
 	if( ignore_virtual ) then
 		callexpr = astNewCALL( dtor )
 	else

src/compiler/ast-node-proc.bas

@@ -33,6 +33,7 @@ declare function hInitVptr _
 	) as ASTNODE ptr
 declare sub hCallCtors( byval n as ASTNODE ptr, byval sym as FBSYMBOL ptr )
 declare sub hCallDtors( byval proc as FBSYMBOL ptr )
+declare sub hCallDeleteDtor( byval proc as FBSYMBOL ptr )
 declare sub hGenStaticInstancesDtors( byval proc as FBSYMBOL ptr )
 declare sub hGenGlobalInstancesCtor( )
 
@@ -500,7 +501,7 @@ sub astProcBegin( byval sym as FBSYMBOL ptr, byval ismain as integer )
 			astNewVAR( symbGetParamVar( argv ) ) )
 
 	'' Destructor?
-	elseif( symbIsDestructor( sym ) and enable_implicit_code ) then
+	elseif( (symbIsDestructor0( sym ) or symbIsDestructor1( sym )) and enable_implicit_code ) then
 		''
 		'' If the UDT has a vptr, reset it at the top of destructors,
 		'' such that the vptr always matches the type of object that
@@ -672,13 +673,18 @@ function astProcEnd( byval callrtexit as integer ) as integer
 	res = (symbCheckLabels(symbGetProcSymbTbHead(parser.currproc)) = 0)
 
 	if( res ) then
-		'' Destructor?
-		if( symbIsDestructor( sym ) and enable_implicit_code ) then
+		'' Complete Destructor?
+		if( symbIsDestructor1( sym ) and enable_implicit_code ) then
 			'' Call destructors, behind the exit label, so they'll
 			'' always be called, even with early returns.
 			hCallDtors( sym )
 		end if
 
+		'' Deleting Destructor?
+		if( symbIsDestructor0( sym ) and enable_implicit_code ) then
+			hCallDeleteDtor( sym )
+		end if
+
 		'' update proc's breaks list, adding calls to destructors when needed
 		if( n->block.breaklist.head <> NULL ) then
 			res = astScopeUpdBreakList( n )
@@ -1272,6 +1278,26 @@ private sub hCallFieldDtors _
 
 end sub
 
+private sub hCallDeleteDtor _
+	( _
+		byval proc as FBSYMBOL ptr _
+	)
+
+	dim as FBSYMBOL ptr parent = any, dtor1 = any, this_ = any
+	dim as ASTNODE ptr thisptr = any, tree = any
+
+	parent = symbGetNamespace( proc )
+	dtor1 = symbGetCompDtor1( parent )
+	if( dtor1 = NULL ) then
+		exit sub
+	end if
+	this_ = symbGetParamVar( symbGetProcHeadParam( proc ) )
+	thisptr = astNewADDROF( astBuildVarField( this_ ) )
+	tree = astBuildDeleteOp( AST_OP_DEL, thisptr )
+	astAdd( tree )
+
+end sub
+
 private sub hCallBaseDtor _
 	( _
 		byval parent as FBSYMBOL ptr, _
@@ -1296,7 +1322,7 @@ private sub hCallBaseDtor _
 	'' Just like derived classes are not responsible for initializing their
 	'' base class, they shouldn't be made responsible for cleaning it up.
 
-	dtor = symbGetCompDtor( symbGetSubtype( base_ ) )
+	dtor = symbGetCompDtor1( symbGetSubtype( base_ ) )
 	if( dtor = NULL ) then
 		exit sub
 	end if

src/compiler/error.bas

@@ -878,7 +878,7 @@ private function hMakeParamDesc _
 				pname = strptr( s )
 			'' method?
 			elseif( (proc->pattrib and (FB_PROCATTRIB_CONSTRUCTOR or _
-							FB_PROCATTRIB_DESTRUCTOR or _
+							FB_PROCATTRIB_DESTRUCTOR1 or FB_PROCATTRIB_DESTRUCTOR0 or _
 							FB_PROCATTRIB_OPERATOR)) <> 0 ) then
 				s = symbMethodToStr( proc )
 				pname = strptr( s )

src/compiler/parser-compound.bas

@@ -317,7 +317,7 @@ sub cExitStatement( )
 			if( symbGetType( parser.currproc ) = FB_DATATYPE_VOID ) then
 				if( (parser.currproc->pattrib and _
 					 (FB_PROCATTRIB_PROPERTY or FB_PROCATTRIB_OPERATOR or _
-					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR)) <> 0 ) then
+					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR1 or FB_PROCATTRIB_DESTRUCTOR0)) <> 0 ) then
 					errnum = FB_ERRMSG_ILLEGALOUTSIDEASUB
 				end if
 			else
@@ -328,7 +328,7 @@ sub cExitStatement( )
 			if( symbGetType( parser.currproc ) <> FB_DATATYPE_VOID ) then
 				if( (parser.currproc->pattrib and _
 					 (FB_PROCATTRIB_PROPERTY or FB_PROCATTRIB_OPERATOR or _
-					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR)) <> 0 ) then
+					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR1 or FB_PROCATTRIB_DESTRUCTOR0)) <> 0 ) then
 					errnum = FB_ERRMSG_ILLEGALOUTSIDEAFUNCTION
 				else
 					errnum = hCheckForCtorResult( )
@@ -357,7 +357,7 @@ sub cExitStatement( )
 			end if
 
 		case FB_TK_DESTRUCTOR
-			if( symbIsDestructor( parser.currproc ) = FALSE ) then
+			if( symbIsDestructor1( parser.currproc ) = FALSE ) then
 				errnum = FB_ERRMSG_ILLEGALOUTSIDEADTOR
 			end if
 

src/compiler/parser-decl-struct.bas

@@ -183,7 +183,7 @@ private sub hFieldInit _
 				end if
 
 				'' Does it have a destructor?
-				defctor = symbGetCompDtor( subtype )
+				defctor = symbGetCompDtor1( subtype )
 				if( defctor ) then
 					'' Check whether we have access
 					if( symbCheckAccess( defctor ) = FALSE ) then

src/compiler/parser-decl-var.bas

@@ -1189,7 +1189,7 @@ private function hFlushInitializer _
 	'' object?
 	if( has_dtor and (not symbIsRef( sym )) ) then
 		'' check visibility
-		if( symbCheckAccess( symbGetCompDtor( symbGetSubtype( sym ) ) ) = FALSE ) then
+		if( symbCheckAccess( symbGetCompDtor1( symbGetSubtype( sym ) ) ) = FALSE ) then
 			errReport( FB_ERRMSG_NOACCESSTODTOR )
 		end if
 	end if

src/compiler/parser-expr-variable.bas

@@ -246,7 +246,7 @@ private function hMemberId( byval parent as FBSYMBOL ptr ) as FBSYMBOL ptr
 	case FB_TK_CONSTRUCTOR
 		res = symbGetCompCtorHead( parent )
 	case FB_TK_DESTRUCTOR
-		res = symbGetCompDtor( parent )
+		res = symbGetCompDtor1( parent )
 	end select
 
 	if( res ) then

src/compiler/parser-proc.bas

@@ -1056,7 +1056,9 @@ function cProcHeader _
 		if( tk = FB_TK_CONSTRUCTOR ) then
 			pattrib or= FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_OVERLOADED
 		else
-			pattrib or= FB_PROCATTRIB_DESTRUCTOR
+			'' destructor defined by user source is always the complete dtor
+			'' the deleting dtor is implicitly defined later
+			pattrib or= FB_PROCATTRIB_DESTRUCTOR1
 		end if
 
 	case FB_TK_OPERATOR
@@ -1464,6 +1466,21 @@ function cProcHeader _
 			cOverrideAttribute( proc )
 		end if
 
+		'' destructor? maybe implicitly declare the deleting destructor too
+		if( tk = FB_TK_DESTRUCTOR ) then
+			'' fbc won't generate any code that calls the deleting destructor
+			'' so don't create the deleting destructor unless we're binding to c++
+			if( symbGetMangling( parent ) = FB_MANGLING_CPP ) then
+				'' - inherit all the attribs from the declared destructor
+				''   except for the destructor type
+				dim dtor0 as FBSYMBOL ptr = symbPreAddProc( NULL )
+				symbAddProcInstanceParam( parent, dtor0 )
+				pattrib and= not FB_PROCATTRIB_DESTRUCTOR1
+				pattrib or= FB_PROCATTRIB_DESTRUCTOR0
+				dtor0 = symbAddCtor( dtor0, NULL, attrib, pattrib, mode )
+			end if
+		end if
+
 		if( tk = FB_TK_PROPERTY ) then
 			hSetUdtPropertyFlags( parent, is_indexed, is_get )
 		end if
@@ -1554,7 +1571,7 @@ function cProcHeader _
 	case FB_TK_CONSTRUCTOR
 		head_proc = symbGetCompCtorHead( parent )
 	case FB_TK_DESTRUCTOR
-		head_proc = symbGetCompDtor( parent )
+		head_proc = symbGetCompDtor1( parent )
 	case FB_TK_OPERATOR
 		head_proc = symbGetCompOpOvlHead( parent, op )
 	end select
@@ -1762,7 +1779,9 @@ sub cProcStmtBegin( byval attrib as FB_SYMBATTRIB, byval pattrib as FB_PROCATTRI
 		if( fbLangOptIsSet( FB_LANG_OPT_CLASS ) = FALSE ) then
 			errReportNotAllowed( FB_LANG_OPT_CLASS )
 		else
-			pattrib or= FB_PROCATTRIB_DESTRUCTOR
+			'' destructor defined by user source is always the complete dtor
+			'' the deleting dtor is implicitly defined later
+			pattrib or= FB_PROCATTRIB_DESTRUCTOR1
 		end if
 
 		hDisallowStaticAttrib( attrib, pattrib )

src/compiler/parser-quirk-mem.bas

@@ -260,7 +260,7 @@ sub cOperatorDelete( )
 
 	'' check visibility
 	if( typeHasDtor( typeDeref( dtype ), subtype ) ) then
-		if( symbCheckAccess( symbGetCompDtor( subtype ) ) = FALSE ) then
+		if( symbCheckAccess( symbGetCompDtor1( subtype ) ) = FALSE ) then
 			errReport( FB_ERRMSG_NOACCESSTODTOR )
 		end if
 	end if

src/compiler/rtl-array.bas

@@ -331,7 +331,7 @@ private sub hCheckDtor _
 
 	if( dtor = NULL ) then exit sub
 
-	assert( symbIsDestructor( dtor ) )
+	assert( symbIsDestructor1( dtor ) )
 
 	if( check_access ) then
 		if( symbCheckAccess( dtor ) = FALSE ) then
@@ -370,7 +370,7 @@ function rtlArrayClear( byval arrayexpr as ASTNODE ptr ) as ASTNODE ptr
 	if( dtype = FB_DATATYPE_STRUCT ) then
 		subtype = astGetSubtype( arrayexpr )
 		ctor = symbGetCompDefCtor( subtype )
-		dtor = symbGetCompDtor( subtype )
+		dtor = symbGetCompDtor1( subtype )
 
 		'' No default ctor, but others? Then the rtlib cannot just clear
 		'' that array of objects.
@@ -453,7 +453,7 @@ function rtlArrayErase _
 	if( dtype = FB_DATATYPE_STRUCT ) then
 		subtype = astGetSubtype( arrayexpr )
 		ctor = symbGetCompDefCtor( subtype )
-		dtor = symbGetCompDtor( subtype )
+		dtor = symbGetCompDtor1( subtype )
 
 		'' No default ctor, but others? Then the rtlib cannot just clear
 		'' that array of objects.
@@ -534,7 +534,7 @@ private sub hGetCtorDtorForRedim _
 
 	if( typeGetDtAndPtrOnly( dtype ) = FB_DATATYPE_STRUCT ) then
 		ctor = symbGetCompDefCtor( subtype )
-		dtor = symbGetCompDtor( subtype )
+		dtor = symbGetCompDtor1( subtype )
 
 		'' Assuming there aren't any other ctors if there is no default one,
 		'' because if it were possible to declare such a dynamic array,

src/compiler/symb-comp.bas

@@ -559,7 +559,8 @@ sub symbUdtDeclareDefaultMembers _
 	default.copyctor = NULL
 	default.copyctorconst = NULL
 	default.copyletopconst = NULL
-	default.dtor = NULL
+	default.dtor1 = NULL
+	default.dtor0 = NULL
 
 	'' Ctor/inited fields and no ctor yet?
 	if( (symbGetUDTHasCtorField( udt ) or symbGetUDTHasInitedField( udt )) and _
@@ -618,12 +619,29 @@ sub symbUdtDeclareDefaultMembers _
 		symbUdtAllocExt( udt )
 
 		'' no default dtor explicitly defined?
-		if( udt->udt.ext->dtor = NULL ) then
-			'' Dtor
-			default.dtor = hDeclareProc( udt, INVALID, FB_DATATYPE_INVALID, FB_SYMBATTRIB_NONE, FB_PROCATTRIB_DESTRUCTOR )
+		if( udt->udt.ext->dtor1 = NULL ) then
+
+			'' if we didn't have the complete dtor then we shouln't have the deleting dtor either
+			'' because there is no way to explicitly define the deleting dtor
+			assert( udt->udt.ext->dtor0 = NULL )
+
+			'' Complete dtor
+			default.dtor1 = hDeclareProc( udt, INVALID, FB_DATATYPE_INVALID, FB_SYMBATTRIB_NONE, FB_PROCATTRIB_DESTRUCTOR1 )
+
+			if( symbGetMangling( udt ) = FB_MANGLING_CPP ) then
+				'' Deleting dtor
+				default.dtor0 = hDeclareProc( udt, INVALID, FB_DATATYPE_INVALID, FB_SYMBATTRIB_NONE, FB_PROCATTRIB_DESTRUCTOR0 )
+			end if
 
 			'' Don't allow the implicit dtor to override a FINAL dtor from the base
-			symbProcCheckOverridden( default.dtor, TRUE )
+			symbProcCheckOverridden( default.dtor1, TRUE )
+		end if
+	end if
+
+	if( symbGetMangling( udt ) = FB_MANGLING_CPP ) then
+		if( default.dtor0 = NULL ) then
+			'' deleting dtor will be implicitly declared if the complete dtor was explicitly declared
+			default.dtor0 = symbGetCompDtor0( udt )
 		end if
 	end if
 
@@ -685,8 +703,12 @@ sub symbUdtImplementDefaultMembers _
 		hAddCtorBody( udt, default.copyctor, TRUE )
 	end if
 
-	if( default.dtor ) then
-		hAddCtorBody( udt, default.dtor, FALSE )
+	if( default.dtor1 ) then
+		hAddCtorBody( udt, default.dtor1, FALSE )
+	end if
+
+	if( default.dtor0 ) then
+		hAddCtorBody( udt, default.dtor0, FALSE )
 	end if
 
 end sub
@@ -733,7 +755,7 @@ end function
 function symbCompIsTrivial( byval sym as FBSYMBOL ptr ) as integer
 	assert( symbIsStruct( sym ) )
 	function = ((symbGetCompCopyCtor( sym ) = NULL) and _
-	            (symbGetCompDtor( sym ) = NULL) and _
+	            (symbGetCompDtor1( sym ) = NULL) and _
 	            (not symbGetHasRTTI( sym )))
 end function
 
@@ -783,13 +805,24 @@ sub symbCheckCompCtor( byval sym as FBSYMBOL ptr, byval proc as FBSYMBOL ptr )
 	end if
 end sub
 
-sub symbSetCompDtor( byval sym as FBSYMBOL ptr, byval proc as FBSYMBOL ptr )
+sub symbSetCompDtor1( byval sym as FBSYMBOL ptr, byval proc as FBSYMBOL ptr )
+	if( symbIsStruct( sym ) ) then
+		assert( symbIsDestructor1( proc ) )
+		symbUdtAllocExt( sym )
+		if( sym->udt.ext->dtor1 = NULL ) then
+			'' Add dtor
+			sym->udt.ext->dtor1 = proc
+		end if
+	end if
+end sub
+
+sub symbSetCompDtor0( byval sym as FBSYMBOL ptr, byval proc as FBSYMBOL ptr )
 	if( symbIsStruct( sym ) ) then
-		assert( symbIsDestructor( proc ) )
+		assert( symbIsDestructor0( proc ) )
 		symbUdtAllocExt( sym )
-		if( sym->udt.ext->dtor = NULL ) then
+		if( sym->udt.ext->dtor0 = NULL ) then
 			'' Add dtor
-			sym->udt.ext->dtor = proc
+			sym->udt.ext->dtor0 = proc
 		end if
 	end if
 end sub
@@ -821,11 +854,21 @@ private function symbGetCompCopyCtor( byval sym as FBSYMBOL ptr ) as FBSYMBOL pt
 	end if
 end function
 
-function symbGetCompDtor( byval sym as FBSYMBOL ptr ) as FBSYMBOL ptr
+function symbGetCompDtor1( byval sym as FBSYMBOL ptr ) as FBSYMBOL ptr
+	if( sym ) then
+		if( symbIsStruct( sym ) ) then
+			if( sym->udt.ext ) then
+				function = sym->udt.ext->dtor1
+			end if
+		end if
+	end if
+end function
+
+function symbGetCompDtor0( byval sym as FBSYMBOL ptr ) as FBSYMBOL ptr
 	if( sym ) then
 		if( symbIsStruct( sym ) ) then
 			if( sym->udt.ext ) then
-				function = sym->udt.ext->dtor
+				function = sym->udt.ext->dtor0
 			end if
 		end if
 	end if

src/compiler/symb-data.bas

@@ -322,7 +322,7 @@ function typeHasDtor _
 
 	select case( typeGet( dtype ) )
 	case FB_DATATYPE_STRUCT '', FB_DATATYPE_CLASS
-		function = (symbGetCompDtor( subtype ) <> NULL)
+		function = (symbGetCompDtor1( subtype ) <> NULL)
 	end select
 
 end function