diff --git a/.gitattributes b/.gitattributes index dd0fe6c305..d7240a0ac1 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8628,6 +8628,10 @@ tests/test/tobjc8a.pp svneol=native#text/plain tests/test/tobjc9.pp svneol=native#text/plain tests/test/tobjc9a.pp svneol=native#text/plain tests/test/tobjc9b.pp svneol=native#text/plain +tests/test/tobjcl1.pp svneol=native#text/plain +tests/test/tobjcl2.pp svneol=native#text/plain +tests/test/tobjcl3.pp svneol=native#text/plain +tests/test/tobjcl4.pp svneol=native#text/plain tests/test/tobject1.pp svneol=native#text/plain tests/test/tobject2.pp svneol=native#text/plain tests/test/tobject3.pp svneol=native#text/plain @@ -8940,6 +8944,7 @@ tests/test/units/sysutils/tfloattostr.pp svneol=native#text/plain tests/test/units/sysutils/tlocale.pp svneol=native#text/plain tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain +tests/test/uobjcl1.pp svneol=native#text/plain tests/test/uprec6.pp svneol=native#text/plain tests/test/uprec7.pp svneol=native#text/plain tests/test/uprocext1.pp svneol=native#text/plain diff --git a/compiler/export.pas b/compiler/export.pas index 3df578a4f9..d363d7434a 100644 --- a/compiler/export.pas +++ b/compiler/export.pas @@ -73,6 +73,9 @@ type procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word); procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word); + { to export symbols not directly related to a tsym (e.g., the Objective-C + rtti) } + procedure exportname(const s : string; options: word); procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word); procedure exportallprocsymnames(ps: tprocsym; options: word); @@ -122,6 +125,12 @@ procedure exportvarsym(sym: tsym; const s : string; index: longint; options: wor end; +procedure exportname(const s : string; options: word); + begin + exportvarsym(nil,s,0,options); + end; + + procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word); var item: TCmdStrListItem; diff --git a/compiler/expunix.pas b/compiler/expunix.pas index 0712e36066..9561d37191 100644 --- a/compiler/expunix.pas +++ b/compiler/expunix.pas @@ -172,7 +172,8 @@ begin end else begin - if (hp2.name^<>hp2.sym.mangledname) then + if assigned(hp2.sym) and + (hp2.name^<>hp2.sym.mangledname) then Message2(parser_e_cant_export_var_different_name,hp2.sym.realname,hp2.sym.mangledname) else exportedsymnames.insert(hp2.name^); diff --git a/compiler/objcutil.pas b/compiler/objcutil.pas index e05a028b39..3d388db7b1 100644 --- a/compiler/objcutil.pas +++ b/compiler/objcutil.pas @@ -52,6 +52,9 @@ interface signature or field declaration. } function objcchecktype(def: tdef; out founderror: tdef): boolean; + { Exports all assembler symbols related to the obj-c class } + procedure exportobjcclass(def: tobjectdef); + implementation uses @@ -806,4 +809,44 @@ end; end; +{****************************************************************** + ObjC class exporting +*******************************************************************} + + procedure exportobjcclassfields(objccls: tobjectdef); + var + i: longint; + vf: tfieldvarsym; + prefix: string; + begin + prefix:=target_info.cprefix+'OBJC_IVAR_$_'+objccls.objextname^+'.'; + for i:=0 to objccls.symtable.SymList.Count-1 do + if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then + begin + vf:=tfieldvarsym(objccls.symtable.SymList[i]); + { TODO: package visibility (private_extern) -- must not be exported + either} + if (vf.visibility<>vis_private) then + exportname(prefix+vf.RealName,0); + end; + end; + + + procedure exportobjcclass(def: tobjectdef); + begin + if (target_info.system in system_objc_nfabi) then + begin + { export class and metaclass symbols } + exportname(def.rtti_mangledname(objcclassrtti),0); + exportname(def.rtti_mangledname(objcmetartti),0); + { export public/protected instance variable offset symbols } + exportobjcclassfields(def); + end + else + begin + { export the class symbol } + exportname('.objc_class_name_'+def.objextname^,0); + end; + end; + end. diff --git a/compiler/pexports.pas b/compiler/pexports.pas index 5d7911a6d6..16a15ed981 100644 --- a/compiler/pexports.pas +++ b/compiler/pexports.pas @@ -45,6 +45,8 @@ implementation { parser } scanner, pbase,pexpr, + { obj-c } + objcutil, { link } gendef,export ; @@ -107,114 +109,136 @@ implementation else InternalProcName:=pd.mangledname; end; + typesym : + begin + if not is_objcclass(ttypesym(srsym).typedef) then + Message(parser_e_illegal_symbol_exported) + end; else Message(parser_e_illegal_symbol_exported) end; - if InternalProcName<>'' then - begin - { This is wrong if the first is not - an underline } - if InternalProcName[1]='_' then - delete(InternalProcName,1,1) - else if (target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince]) and UseDeffileForExports then + if (srsym.typ<>typesym) then + begin + if InternalProcName<>'' then begin - Message(parser_e_dlltool_unit_var_problem); - Message(parser_e_dlltool_unit_var_problem2); + { This is wrong if the first is not + an underline } + if InternalProcName[1]='_' then + delete(InternalProcName,1,1) + else if (target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince]) and UseDeffileForExports then + begin + Message(parser_e_dlltool_unit_var_problem); + Message(parser_e_dlltool_unit_var_problem2); + end; + if length(InternalProcName)<2 then + Message(parser_e_procname_to_short_for_export); + DefString:=srsym.realname+'='+InternalProcName; end; - if length(InternalProcName)<2 then - Message(parser_e_procname_to_short_for_export); - DefString:=srsym.realname+'='+InternalProcName; - end; - if try_to_consume(_INDEX) then - begin - pt:=comp_expr(true); - if pt.nodetype=ordconstn then - if (Tordconstnode(pt).valueint64(high(index))) then - begin - index:=0; - message(parser_e_range_check_error) - end - else - index:=Tordconstnode(pt).value.svalue - else - begin - index:=0; - consume(_INTCONST); - end; - options:=options or eo_index; - pt.free; - if target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince] then - DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(index) - else - DefString:=srsym.realname+'='+InternalProcName; {Index ignored!} - end; - if try_to_consume(_NAME) then - begin - pt:=comp_expr(true); - if pt.nodetype=stringconstn then - hpname:=strpas(tstringconstnode(pt).value_str) - else - begin - consume(_CSTRING); - end; - options:=options or eo_name; - pt.free; - DefString:=hpname+'='+InternalProcName; - end; - if try_to_consume(_RESIDENT) then - begin - options:=options or eo_resident; - DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!} - end; - if (DefString<>'') and UseDeffileForExports then - DefFile.AddExport(DefString); - - if srsym.typ=procsym then - begin - { if no specific name or index was given, then if } - { the procedure has aliases defined export those, } - { otherwise export the name as it appears in the } - { export section (it doesn't make sense to export } - { the generic mangled name, because the name of } - { the parent unit is used in that) } - if ((options and (eo_name or eo_index))=0) and - (tprocdef(tprocsym(srsym).procdeflist[0]).aliasnames.count>1) then - exportallprocsymnames(tprocsym(srsym),options) - else - begin - { there's a name or an index -> export only one name } - { correct? Or can you export multiple names with the } - { same index? And/or should we also export the aliases } - { if a name is specified? (JM) } - - if ((options and eo_name)=0) then - { Export names are not mangled on Windows and OS/2 } - if (target_info.system in (system_all_windows+[system_i386_emx, system_i386_os2])) then - hpname:=orgs - { Use set mangled name in case of cdecl/cppdecl/mwpascal } - { and no name specified } - else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cdecl,pocall_mwpascal]) then - hpname:=target_info.cprefix+tprocsym(srsym).realname - else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cppdecl]) then - hpname:=target_info.cprefix+tprocdef(tprocsym(srsym).procdeflist[0]).cplusplusmangledname - else - hpname:=orgs; - - exportprocsym(srsym,hpname,index,options); - end - end - { can also be errorsym } - else if (srsym.typ=staticvarsym) then - begin - if ((options and eo_name)=0) then - { for "cvar" } - if (vo_has_mangledname in tstaticvarsym(srsym).varoptions) then - hpname:=srsym.mangledname - else - hpname:=orgs; - exportvarsym(srsym,hpname,index,options); + if try_to_consume(_INDEX) then + begin + pt:=comp_expr(true); + if pt.nodetype=ordconstn then + if (Tordconstnode(pt).valueint64(high(index))) then + begin + index:=0; + message(parser_e_range_check_error) + end + else + index:=Tordconstnode(pt).value.svalue + else + begin + index:=0; + consume(_INTCONST); + end; + options:=options or eo_index; + pt.free; + if target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince] then + DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(index) + else + DefString:=srsym.realname+'='+InternalProcName; {Index ignored!} + end; + if try_to_consume(_NAME) then + begin + pt:=comp_expr(true); + if pt.nodetype=stringconstn then + hpname:=strpas(tstringconstnode(pt).value_str) + else + begin + consume(_CSTRING); + end; + options:=options or eo_name; + pt.free; + DefString:=hpname+'='+InternalProcName; + end; + if try_to_consume(_RESIDENT) then + begin + options:=options or eo_resident; + DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!} + end; + if (DefString<>'') and UseDeffileForExports then + DefFile.AddExport(DefString); end; + case srsym.typ of + procsym: + begin + { if no specific name or index was given, then if } + { the procedure has aliases defined export those, } + { otherwise export the name as it appears in the } + { export section (it doesn't make sense to export } + { the generic mangled name, because the name of } + { the parent unit is used in that) } + if ((options and (eo_name or eo_index))=0) and + (tprocdef(tprocsym(srsym).procdeflist[0]).aliasnames.count>1) then + exportallprocsymnames(tprocsym(srsym),options) + else + begin + { there's a name or an index -> export only one name } + { correct? Or can you export multiple names with the } + { same index? And/or should we also export the aliases } + { if a name is specified? (JM) } + + if ((options and eo_name)=0) then + { Export names are not mangled on Windows and OS/2 } + if (target_info.system in (system_all_windows+[system_i386_emx, system_i386_os2])) then + hpname:=orgs + { Use set mangled name in case of cdecl/cppdecl/mwpascal } + { and no name specified } + else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cdecl,pocall_mwpascal]) then + hpname:=target_info.cprefix+tprocsym(srsym).realname + else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cppdecl]) then + hpname:=target_info.cprefix+tprocdef(tprocsym(srsym).procdeflist[0]).cplusplusmangledname + else + hpname:=orgs; + + exportprocsym(srsym,hpname,index,options); + end + end; + staticvarsym: + begin + if ((options and eo_name)=0) then + { for "cvar" } + if (vo_has_mangledname in tstaticvarsym(srsym).varoptions) then + hpname:=srsym.mangledname + else + hpname:=orgs; + exportvarsym(srsym,hpname,index,options); + end; + typesym: + begin + case ttypesym(srsym).typedef.typ of + objectdef: + case tobjectdef(ttypesym(srsym).typedef).objecttype of + odt_objcclass: + exportobjcclass(tobjectdef(ttypesym(srsym).typedef)); + else + internalerror(2009092601); + end; + else + internalerror(2009092602); + end; + end; + end end else consume(_ID); diff --git a/tests/test/tobjcl1.pp b/tests/test/tobjcl1.pp new file mode 100644 index 0000000000..d6087b4687 --- /dev/null +++ b/tests/test/tobjcl1.pp @@ -0,0 +1,17 @@ +{ %target=darwin } +{ %cpu=powerpc,powerpc64,i386,x86_64,arm } +{ %recompile } +{ %norun } + +{$mode objfpc} +{$modeswitch objectivec1} + +library tobjcl1; + +uses + uobjcl1; + +exports + MyLibObjCClass; + +end. diff --git a/tests/test/tobjcl2.pp b/tests/test/tobjcl2.pp new file mode 100644 index 0000000000..a045d1d60e --- /dev/null +++ b/tests/test/tobjcl2.pp @@ -0,0 +1,52 @@ +{ %target=darwin } +{ %cpu=powerpc,powerpc64,i386,x86_64,arm } +{ %NEEDLIBRARY } + +{$mode objfpc} +{$modeswitch objectivec1} + +const +{$ifdef windows} + libname='tobjcl1.dll'; +{$else} + libname='tobjcl1'; + {$linklib tobjcl1} +{$endif} + +type + MyLibObjCClass = objcclass(NSObject) + public + fa: byte; + function publicfun: byte; message 'publicfun'; + protected + fb: byte; + function protectedfun: byte; message 'protectedfun'; + private + fc: byte; + function privatefun: byte; message 'privatefun'; + end; external; + + MyDerivedClass = objcclass(MyLibObjCClass) + l: longint; + function callprotectedfun: byte; message 'callprotectedfun'; + end; + + +function MyDerivedClass.callprotectedfun: byte; + begin + result:=protectedfun; + end; + + +var + a: MyLibObjCClass; +begin + a:=NSObject(MyDerivedClass.alloc).init; + a.fa:=55; + a.fb:=66; + if a.publicfun<>55 then + halt(1); + if MyDerivedClass(a).callprotectedfun<>66 then + halt(2); + a.release; +end. diff --git a/tests/test/tobjcl3.pp b/tests/test/tobjcl3.pp new file mode 100644 index 0000000000..99b040fd13 --- /dev/null +++ b/tests/test/tobjcl3.pp @@ -0,0 +1,36 @@ +{ %target=darwin } +{ %cpu=powerpc64,x86_64,arm } +{ %NEEDLIBRARY } +{ %fail } + +{$mode objfpc} +{$modeswitch objectivec1} + +const +{$ifdef windows} + libname='tobjcl1.dll'; +{$else} + libname='tobjcl1'; + {$linklib tobjcl1} +{$endif} + +type + MyLibObjCClass = objcclass(NSObject) + public + fa: byte; + fb: byte; + { this field is declared as private in the real class, + and the non-fragile ABI should be sure that this + gives a linker error } + fc: byte; + function publicfun: byte; message 'publicfun'; + function protectedfun: byte; message 'protectedfun'; + function privatefun: byte; message 'privatefun'; + end; external; + +var + a: MyLibObjCClass; +begin + a:=NSObject(MyLibObjCClass.alloc).init; + a.fc:=55; +end. diff --git a/tests/test/tobjcl4.pp b/tests/test/tobjcl4.pp new file mode 100644 index 0000000000..927c1e17d6 --- /dev/null +++ b/tests/test/tobjcl4.pp @@ -0,0 +1,26 @@ +{ %target=darwin } +{ %cpu=i386,powerpc,powerpc64,x86_64,arm } +{ %NEEDLIBRARY } +{ %fail } + +{$mode objfpc} +{$modeswitch objectivec1} + +const +{$ifdef windows} + libname='tobjcl1.dll'; +{$else} + libname='tobjcl1'; + {$linklib tobjcl1} +{$endif} + +type + MyHiddenObjcClass=objcclass(NSObject) + end; external; + +var + a: MyHiddenObjcClass; +begin + a:=NSObject(MyHiddenObjcClass.alloc).init; + a.release; +end. diff --git a/tests/test/uobjcl1.pp b/tests/test/uobjcl1.pp new file mode 100644 index 0000000000..7c52907db2 --- /dev/null +++ b/tests/test/uobjcl1.pp @@ -0,0 +1,45 @@ +{$mode objfpc} +{$modeswitch objectivec1} + +unit uobjcl1; + +interface + +type + MyLibObjCClass = objcclass(NSObject) + public + fa: byte; + function publicfun: byte; message 'publicfun'; + protected + fb: byte; + function protectedfun: byte; message 'protectedfun'; + private + fc: byte; + function privatefun: byte; message 'privatefun'; + end; + + implementation + +function MyLibObjCClass.publicfun: byte; + begin + result:=fa; + end; + + +function MyLibObjCClass.protectedfun: byte; + begin + result:=fb; + end; + + +function MyLibObjCClass.privatefun: byte; + begin + result:=fc; + end; + +type + MyHiddenObjcClass = objcclass(NSObject) + end; + + +end.