fbc: add syntax for PROCPTR( identifier, type )

changelog.txt

@@ -22,6 +22,7 @@ Version 1.09.0
 - darwin: Implemented objinfo for Darwin/OSX Mach-O .o files, so #inclib etc. work (TeeEmCee)
 - fbc: add '-entry name' command line option to set program entry point (TeeEmCee)
 - added objinfo support for ELF files on freebsd
+- PROCPTR( identifier, type ) syntax to allow getting procedure pointer for based on sub/function type
 
 [fixed]
 - github #315: set parameters when calling SCREENCONTROL (was broken in fbc 1.08.0 due to new LONG/LONGINT SCREENCONTROL API's)

src/compiler/parser-expr-unary.bas

@@ -429,7 +429,8 @@ end function
 private function hProcPtrBody _
 	( _
 		byval base_parent as FBSYMBOL ptr, _
-		byval proc as FBSYMBOL ptr _
+		byval proc as FBSYMBOL ptr, _
+		byval check_exact as boolean = FALSE _
 	) as ASTNODE ptr
 
 	dim as FBSYMBOL ptr sym = any
@@ -444,12 +445,15 @@ private function hProcPtrBody _
 	end if
 
 	'' resolve overloaded procs
-	if( symbIsOverloaded( proc ) ) then
+	if( symbIsOverloaded( proc ) or check_exact ) then
         if( parser.ctxsym <> NULL ) then
         	if( symbIsProc( parser.ctxsym ) ) then
         		sym = symbFindOverloadProc( proc, parser.ctxsym )
         		if( sym <> NULL ) then
         			proc = sym
+				elseif( check_exact ) then
+					errReport( FB_ERRMSG_NOMATCHINGPROC, TRUE )
+					return astNewCONSTi( 0 )
         		end if
         	end if
         end if
@@ -630,7 +634,35 @@ function cAddrOfExpression( ) as ASTNODE ptr
 			lexSkipToken( LEXCHECK_POST_LANG_SUFFIX )
 		end if
 
-		expr = hProcPtrBody( base_parent, sym )
+		'' ',' ?
+		if( hMatch( CHAR_COMMA ) ) then
+			dim dtype as integer
+			dim subtype as FBSYMBOL ptr
+			if( cSymbolType( dtype, subtype ) = FALSE ) then
+				errReport( FB_ERRMSG_SYNTAXERROR, TRUE )
+				'' error recovery: skip until ')' and fake a node
+				hSkipUntil( CHAR_RPRNT, TRUE )
+				return astNewCONSTi( 0 )
+			else
+				if( typeGetDtAndPtrOnly( dtype ) = typeAddrOf( FB_DATATYPE_FUNCTION ) ) then
+					dim oldsym as FBSYMBOL ptr = parser.ctxsym
+					dim old_dtype as integer = parser.ctx_dtype
+					parser.ctxsym = subtype
+					parser.ctx_dtype = dtype
+					expr = hProcPtrBody( base_parent, sym, TRUE )
+					parser.ctxsym = oldsym
+					parser.ctx_dtype = old_dtype
+				else
+					errReport( FB_ERRMSG_SYNTAXERROR, TRUE )
+					'' error recovery: skip until ')' and fake a node
+					hSkipUntil( CHAR_RPRNT, TRUE )
+					return astNewCONSTi( 0 )
+				end if
+			end if
+
+		else
+			expr = hProcPtrBody( base_parent, sym )
+		end if
 
 		'' ')'
 		if( hMatch( CHAR_RPRNT ) = FALSE ) then

tests/pointers/procptr-type.bas

@@ -0,0 +1,117 @@
+#include "fbcunit.bi"
+
+dim shared id as string
+
+sub s overload ()
+	id = "s()"
+end sub
+
+sub s( byval arg as byte )
+	id = "s( byval arg as byte )"
+end sub
+
+sub s( byval arg as short )
+	id = "s( byval arg as short )"
+end sub
+
+sub s( byval arg as long )
+	id = "s( byval arg as long )"
+end sub
+
+sub s( byval arg as longint )
+	id = "s( byval arg as longint )"
+end sub
+
+sub s( byval arg as single )
+	id = "s( byval arg as single )"
+end sub
+
+sub s( byval arg as double )
+	id = "s( byval arg as double )"
+end sub
+
+
+SUITE( fbc_tests.pointers.procptr_type )
+
+	TEST( subs )
+
+		scope
+			var p1 = procptr(s)
+			p1()
+			CU_ASSERT( id = "s()" )
+		end scope
+
+		scope
+			var p1 = procptr(s, sub() )
+			p1()
+			CU_ASSERT( id = "s()" )
+		end scope
+
+		scope
+			var p1 = procptr(s, sub( byval as byte ) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as byte )" )
+		end scope
+
+		scope
+			var p1 = procptr(s, sub( byval as short ) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as short )" )
+		end scope
+
+		scope
+			var p1 = procptr(s, sub( byval as long ) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as long )" )
+		end scope
+
+		scope
+			var p1 = procptr(s, sub( byval as longint ) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as longint )" )
+		end scope
+
+		scope
+			var p1 = procptr(s, sub( byval as single ) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as single )" )
+		end scope
+
+		scope
+			var p1 = procptr(s, sub( byval as double ) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as double )" )
+		end scope
+
+	END_TEST
+
+	TEST( types )
+
+		type t as sub( byval as single )
+
+		scope
+			var p1 = procptr(s, sub( byval as single ) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as single )" )
+		end scope
+
+		scope
+			var p1 = procptr(s, t )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as single )" )
+		end scope
+
+		scope
+			var p1 = procptr(s, typeof(t) )
+			p1(0)
+			CU_ASSERT( id = "s( byval arg as single )" )
+
+			var p2 = procptr(s, typeof(p1) )
+			p2(0)
+			CU_ASSERT( id = "s( byval arg as single )" )
+		end scope
+
+
+	END_TEST
+
+END_SUITE

todo.txt

@@ -269,6 +269,16 @@ o -exx should catch...
         prototypes don't require a name and because overloading
       - := must be a new token because the "foo bar : baz" ambiguity
 
+[ ] method pointers / delegates
+    - extend PROCPTR( id, type ) to allow pointers to methods
+    - fbc handles method pointers fairly well but the syntax is not symmetrical with
+      invoking a method on a TYPE (class)
+    - var x = procptr( T.method ) could return a method pointer but must currently be
+      invoked with x( instance, [params]... ).  This is a different syntax from other
+      languages that support method pointers.
+    - delegates would need to aggregate the instance and method pointer which will
+      likely requre a new built-in type to handle by the compiler
+
 *** *** *** *** ***
 [ ] All functions returning STRING should actually return the FBSTRING object
     - it must be coded in plain C to avoid C++ dependencies