paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 05:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
mantis #14680)

git-svn-id: branches/objc@13769 -
This commit is contained in:
Jonas Maebe 2009-09-28 09:43:34 +00:00
parent 3f0eee741a
commit 50f37ad445
3 changed files with 21 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compiler/pdecsub.pas
View File

@ -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;

7
tests/test/talign.pp
View File

@ -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;

4
tests/test/tobjc22.pp
View File

@ -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;