+ support for single character message names (patch by Dmitry Boyarintsev,

    mantis #14680)

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

compiler/pdecsub.pas

@@ -1385,16 +1385,18 @@ begin
         Message(parser_e_ill_msg_param);
     end;
   pt:=comp_expr(true);
-  if pt.nodetype=stringconstn then
+  { message is 1-character long }
+  if is_constcharnode(pt) then 
+    begin
+      include(pd.procoptions,po_msgstr);
+      tprocdef(pd).messageinf.str:=stringdup(chr(byte(tordconstnode(pt).value.uvalue and $FF)));
+    end
+  else if pt.nodetype=stringconstn then
     begin
       include(pd.procoptions,po_msgstr);
       if (tstringconstnode(pt).len>255) then
         Message(parser_e_message_string_too_long);
       tprocdef(pd).messageinf.str:=stringdup(tstringconstnode(pt).value_str);
-      { check whether the selector name is valid in case of Objective-C }
-      if is_objc_class_or_protocol(tprocdef(pd)._class) and
-         not objcvalidselectorname(@tprocdef(pd).messageinf.str^[1],length(tprocdef(pd).messageinf.str^)) then
-        Message1(type_e_invalid_objc_selector_name,tprocdef(pd).messageinf.str^);
     end
   else
    if is_constintnode(pt) and
@@ -1409,6 +1411,11 @@ begin
     end
   else
     Message(parser_e_ill_msg_expr);
+  { check whether the selector name is valid in case of Objective-C }
+  if (po_msgstr in pd.procoptions) and
+     is_objc_class_or_protocol(tprocdef(pd)._class) and
+     not objcvalidselectorname(@tprocdef(pd).messageinf.str^[1],length(tprocdef(pd).messageinf.str^)) then
+    Message1(type_e_invalid_objc_selector_name,tprocdef(pd).messageinf.str^);
   pt.free;
 end;
 

tests/test/talign.pp

@@ -1,3 +1,5 @@
+{ %norun }
+
 { This is just a small file used to verify the alignment of different
   structures. Only the assembler output should be checked.
 }
@@ -13,6 +15,7 @@ type
   tmyotherclass = class(tmyclass)
   public
     procedure tito(var Msg); message 'hello';
+    procedure tita(var Msg); message 'h';
     procedure titi(var Msg); message 12;
   published
     procedure published_method;
@@ -22,6 +25,10 @@ type
    begin
    end;
 
+  procedure tmyotherclass.tita(var Msg);
+   begin
+   end;
+
   procedure tmyotherclass.titi(var Msg);
    begin
    end;

tests/test/tobjc22.pp

@@ -8,7 +8,7 @@ program protocoltest;
 
 type
   MyProtocolA = objcprotocol
-    function newMethod: longint; message 'newMethod';
+    function newMethod: longint; message 'n';
   end;
 
   MyProtocolB = objcprotocol(MyProtocolA)
@@ -24,7 +24,7 @@ type
   end;
 
   TMyObjectB = objcclass(NSObject,MyProtocolA)
-    function newMethod: longint; message 'newMethod';
+    function newMethod: longint; message 'n';
     class function newClassMethod: longint; message 'newClassMethod';
   end;