From 50f37ad445f9db0804abd81e4b2bb011b70a6a10 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Mon, 28 Sep 2009 09:43:34 +0000
Subject: [PATCH]   + support for single character message names (patch by
 Dmitry Boyarintsev,     mantis #14680)

git-svn-id: branches/objc@13769 -
---
 compiler/pdecsub.pas  | 17 ++++++++++++-----
 tests/test/talign.pp  |  7 +++++++
 tests/test/tobjc22.pp |  4 ++--
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index ca93283674..59f9f25e73 100644
--- a/compiler/pdecsub.pas
+++ b/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;
 
diff --git a/tests/test/talign.pp b/tests/test/talign.pp
index 5bd697cdc6..fddd1825d6 100644
--- a/tests/test/talign.pp
+++ b/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;
diff --git a/tests/test/tobjc22.pp b/tests/test/tobjc22.pp
index 823a6ad5c5..d11e5750b8 100644
--- a/tests/test/tobjc22.pp
+++ b/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;