+ parser-side of objcprotocol() expression to obtain the metaclass

    associated with an Objective-C protocol. Code generator part will
    always generate an internalerror currently, because it cannot yet
    be implemented (needs support for generating RTTI for Objective-C
    classes)

git-svn-id: branches/objc@13461 -

.gitattributes

@@ -8225,6 +8225,7 @@ tests/test/tmsg3.pp svneol=native#text/plain
 tests/test/tmsg4.pp svneol=native#text/plain
 tests/test/tmt1.pp svneol=native#text/plain
 tests/test/tobjc1.pp svneol=native#text/plain
+tests/test/tobjc10.pp svneol=native#text/plain
 tests/test/tobjc2.pp svneol=native#text/plain
 tests/test/tobjc3.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain

compiler/compinnr.inc

@@ -77,6 +77,7 @@ const
    in_rol_x             = 67;
    in_rol_x_x           = 68;
    in_objc_selector_x   = 69;
+   in_objc_protocol_x   = 70;
 
 
 { Internal constant functions }

compiler/ncgobjc.pas

@@ -34,6 +34,10 @@ type
     procedure pass_generate_code; override;
   end;
 
+  tcgobjcprotocolnode = class(tobjcprotocolnode)
+    procedure pass_generate_code; override;
+  end;
+
 implementation
 
 uses
@@ -86,6 +90,18 @@ procedure tcgobjcselectornode.pass_generate_code;
   end;
 
 
+{*****************************************************************************
+                           TCGOBJCPROTOCOLNODE
+*****************************************************************************}
+
+procedure tcgobjcprotocolnode.pass_generate_code;
+  begin
+    { first needs support for writing class definitions }
+    internalerror(2009072601);
+  end;
+
+
 begin
   cobjcselectornode:=tcgobjcselectornode;
+  cobjcprotocolnode:=tcgobjcprotocolnode;
 end.

compiler/ninl.pas

@@ -2456,6 +2456,12 @@ implementation
                   { reused }
                   left:=nil;
                 end;
+              in_objc_protocol_x:
+                begin
+                  result:=cobjcprotocolnode.create(left);
+                  { reused }
+                  left:=nil;
+                end;
               else
                 internalerror(8);
             end;

compiler/nobjc.pas

@@ -37,11 +37,19 @@ type
   tobjcselectornode = class(tunarynode)
    public
     constructor create(formethod: tnode);
-    function pass_typecheck:tnode;override;
-    function pass_1 : tnode;override;
+    function pass_typecheck: tnode;override;
+    function pass_1: tnode;override;
   end;
   tobjcselectornodeclass = class of tobjcselectornode;
 
+  tobjcprotocolnode = class(tunarynode)
+   public
+    constructor create(forprotocol: tnode);
+    function pass_typecheck: tnode;override;
+    function pass_1: tnode;override;
+  end;
+  tobjcprotocolnodeclass = class of tobjcprotocolnode;
+
   tobjcmessagesendnode = class(tunarynode)
    public
     constructor create(forcall: tnode);
@@ -53,6 +61,7 @@ type
 var
   cobjcselectornode : tobjcselectornodeclass;
   cobjcmessagesendnode : tobjcmessagesendnodeclass;
+  cobjcprotocolnode : tobjcprotocolnodeclass;
 
 implementation
 
@@ -163,6 +172,36 @@ function tobjcselectornode.pass_1: tnode;
     expectloc:=LOC_CREFERENCE;
   end;
 
+
+{*****************************************************************************
+                            TOBJPROTOCOLNODE
+*****************************************************************************}
+
+constructor tobjcprotocolnode.create(forprotocol: tnode);
+  begin
+    inherited create(objcprotocoln,forprotocol);
+  end;
+
+
+function tobjcprotocolnode.pass_typecheck: tnode;
+  begin
+    result:=nil;
+    typecheckpass(left);
+    if (left.nodetype<>typen) then
+      MessagePos(left.fileinfo,type_e_type_id_expected)
+    else if not is_objcprotocol(left.resultdef) then
+      MessagePos2(left.fileinfo,type_e_incompatible_types,left.resultdef.typename,'ObjCProtocol');
+    resultdef:=objc_protocoltype;
+  end;
+
+
+function tobjcprotocolnode.pass_1: tnode;
+  begin
+    result:=nil;
+    expectloc:=LOC_CREFERENCE;
+  end;
+
+
 {*****************************************************************************
                           TOBJCMESSAGESENDNODE
 *****************************************************************************}
@@ -326,7 +365,6 @@ function tobjcmessagesendnode.pass_1: tnode;
      end;
   end;
 
-
 begin
   cobjcmessagesendnode:=tobjcmessagesendnode;
 end.

compiler/node.pas

@@ -111,7 +111,8 @@ interface
           loadparentfpn,    { Load the framepointer of the parent for nested procedures }
           dataconstn,       { node storing some binary data }
           objcselectorn,    { node for an Objective-C message selector }
-          objcmessagesendn  { node for message sent to an Objective-C instance (similar to a method call) }
+          objcmessagesendn, { node for message sent to an Objective-C instance (similar to a method call) }
+          objcprotocoln     { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
        );
 
        tnodetypeset = set of tnodetype;
@@ -194,7 +195,8 @@ interface
           'loadparentfpn',
           'dataconstn',
           'objcselectorn',
-          'objcmessagesendn');
+          'objcmessagesendn',
+          'objcprotocoln');
 
     type
        { all boolean field of ttree are now collected in flags }

compiler/pexpr.pas

@@ -2579,6 +2579,21 @@ implementation
                   postfixoperators(p1,again);
                 end;
              end;
+           _OBJCPROTOCOL:
+             begin
+               { The @protocol keyword is used in two ways in Objective-C:
+                   1) to declare protocols (~ Object Pascal interfaces)
+                   2) to obtain the metaclass (~ Object Pascal) "class of")
+                      of a declared protocol
+                 This code is for handling the second case. Because of 1),
+                 we cannot simply use a system unit symbol.
+               }
+               consume(_OBJCPROTOCOL);
+               consume(_LKLAMMER);
+               p1:=factor(false);
+               consume(_RKLAMMER);
+               p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
+             end;
 
            else
              begin

tests/test/tobjc10.pp

@@ -0,0 +1,15 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+var
+  a: NSObject;
+begin
+  a:=NSObject(NSObject(NSObject.alloc).init);
+  if a.conformsToProtocol_(objcprotocol(NSObjectProtocol)) then
+    writeln('ok conformsToProtocol')
+  else
+    halt(1);
+end.