diff --git a/compiler/agjasmin.pas b/compiler/agjasmin.pas index c85c741b3f..20e4a932a2 100644 --- a/compiler/agjasmin.pas +++ b/compiler/agjasmin.pas @@ -540,6 +540,8 @@ implementation { fake class type for unit -> name=unitname and superclass=java.lang.object } AsmWrite('.class public '); + if assigned(current_module.namespace) then + AsmWrite(current_module.namespace^+'.'); AsmWriteln(current_module.realmodulename^); AsmWriteLn('.super java/lang/Object'); end diff --git a/compiler/cutils.pas b/compiler/cutils.pas index cfdbd7716e..10d2d37254 100644 --- a/compiler/cutils.pas +++ b/compiler/cutils.pas @@ -67,6 +67,8 @@ interface function lower(const c : char) : char; function lower(const s : string) : string; function lower(const s : ansistring) : ansistring; + function rpos(const needle: char; const haystack: shortstring): longint; overload; + function rpos(const needle: shortstring; const haystack: shortstring): longint; overload; function trimbspace(const s:string):string; function trimspace(const s:string):string; function space (b : longint): string; @@ -588,6 +590,34 @@ implementation end; + function rpos(const needle: char; const haystack: shortstring): longint; + begin + result:=length(haystack); + while (result>0) do + begin + if haystack[result]=needle then + exit; + dec(result); + end; + end; + + + function rpos(const needle: shortstring; const haystack: shortstring): longint; + begin + result:=0; + if (length(needle)=0) or + (length(needle)>length(haystack)) then + exit; + result:=length(haystack)-length(needle); + repeat + if (haystack[result]=needle[1]) and + (copy(haystack,result,length(needle))=needle) then + exit; + dec(result); + until result=0; + end; + + function trimbspace(const s:string):string; { return s with all leading spaces and tabs removed diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index 1892ea42e6..c04eeb1719 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -183,6 +183,8 @@ interface tobjectdef instances (the helper defs) } extendeddefs: TFPHashObjectList; + namespace: pshortstring; { for JVM target: corresponds to Java package name } + {create creates a new module which name is stored in 's'. LoadedFrom points to the module calling it. It is nil for the first compiled module. This allow inheritence of all path lists. MUST pay attention @@ -540,6 +542,7 @@ implementation mode_switch_allowed:= true; moduleoptions:=[]; deprecatedmsg:=nil; + namespace:=nil; _exports:=TLinkedList.Create; dllscannerinputlist:=TFPHashList.Create; asmdata:=TAsmData.create(realmodulename^); @@ -616,6 +619,7 @@ implementation stringdispose(mainsource); stringdispose(asmprefix); stringdispose(deprecatedmsg); + stringdispose(namespace); localunitsearchpath.Free; localobjectsearchpath.free; localincludesearchpath.free; @@ -746,6 +750,7 @@ implementation in_global:=true; mode_switch_allowed:=true; stringdispose(deprecatedmsg); + stringdispose(namespace); moduleoptions:=[]; is_dbginfo_written:=false; crc:=0; diff --git a/compiler/fppu.pas b/compiler/fppu.pas index 3c951bba34..14914f0ff8 100644 --- a/compiler/fppu.pas +++ b/compiler/fppu.pas @@ -107,7 +107,7 @@ interface implementation uses - SysUtils, + SysUtils,strutils, cfileutl, systems,version, symtable, symsym, @@ -946,6 +946,7 @@ var var b : byte; newmodulename : string; + ns: string; begin { read interface part } repeat @@ -954,6 +955,14 @@ var ibmodulename : begin newmodulename:=ppufile.getstring; + { namespace? } + b:=rpos('.',newmodulename); + if b<>0 then + begin + stringdispose(namespace); + namespace:=stringdup(copy(newmodulename,1,b-1)); + delete(newmodulename,1,b); + end; if (cs_check_unit_name in current_settings.globalswitches) and (upper(newmodulename)<>modulename^) then Message2(unit_f_unit_name_error,realmodulename^,newmodulename); @@ -1045,6 +1054,8 @@ var procedure tppumodule.writeppu; + var + ns: string; begin Message1(unit_u_ppu_write,realmodulename^); @@ -1068,7 +1079,10 @@ var Message(unit_f_ppu_cannot_write); { first the unitname } - ppufile.putstring(realmodulename^); + ns:=''; + if assigned(namespace) then + ns:=namespace^+'.'; + ppufile.putstring(ns+realmodulename^); ppufile.writeentry(ibmodulename); ppufile.putsmallset(moduleoptions); @@ -1207,6 +1221,8 @@ var procedure tppumodule.getppucrc; + var + ns: string; begin {$ifdef Test_Double_checksum_write} Assign(CRCFile,s+'.INT') @@ -1220,7 +1236,10 @@ var Message(unit_f_ppu_cannot_write); { first the unitname } - ppufile.putstring(realmodulename^); + ns:=''; + if assigned(namespace) then + ns:=namespace^+'.'; + ppufile.putstring(ns+realmodulename^); ppufile.writeentry(ibmodulename); ppufile.putsmallset(moduleoptions); diff --git a/compiler/jvmdef.pas b/compiler/jvmdef.pas index 3fb1828fb9..23a1244825 100644 --- a/compiler/jvmdef.pas +++ b/compiler/jvmdef.pas @@ -229,6 +229,7 @@ implementation var owningunit: tsymtable; tmpresult: string; + module: tmodule; begin { see tprocdef.jvmmangledbasename for description of the format } case owner.symtabletype of @@ -239,7 +240,11 @@ implementation owningunit:=owner; while (owningunit.symtabletype in [localsymtable,objectsymtable,recordsymtable]) do owningunit:=owningunit.defowner.owner; - tmpresult:=find_module_from_symtable(owningunit).realmodulename^+'/'; + module:=find_module_from_symtable(owningunit); + tmpresult:=''; + if assigned(module.namespace) then + tmpresult:=module.namespace^+'.'; + tmpresult:=tmpresult+module.realmodulename^+'/'; end; objectsymtable: case tobjectdef(owner.defowner).objecttype of diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 4da697c2ea..5894a275ea 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -375,6 +375,7 @@ implementation } if try_to_consume(_EXTERNAL) then begin + hs:=''; if token in [_CSTRING,_CWSTRING,_CCHAR,_CWCHAR] then begin { Always add library prefix and suffix to create an uniform name } @@ -383,6 +384,19 @@ implementation hs:=ChangeFileExt(hs,target_info.sharedlibext); if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then hs:=target_info.sharedlibprefix+hs; + end + else if assigned(current_module.namespace) then + begin + { import_lib is used to specify the package name for the JVM + target (= namespace) } + if (target_info.system=system_jvm_java32) and + assigned(current_module.namespace) then + hs:=current_module.namespace^; + { not sure how to deal with cppclass here, since namespaces + mean something different there } + end; + if hs<>'' then + begin { the JVM expects java/lang/Object rather than java.lang.Object } if target_info.system=system_jvm_java32 then Replace(hs,'.','/'); @@ -397,10 +411,21 @@ implementation include(od.objectoptions,oo_is_external); end else - od.objextname:=stringdup(od.objrealname^); - { ToDo: read the namespace of the class (influences the mangled name)} + begin + od.objextname:=stringdup(od.objrealname^); + { ToDo for cpp: read/set the namespace of the class (influences the mangled name) + (notice that for the JVM target, there is no difference between + the namespace and import_lib) } + if (target_info.system=system_jvm_java32) and + assigned(current_module.namespace) then + begin + od.import_lib:=stringdup(current_module.namespace^); + Replace(od.import_lib^,'.','/'); + end; + end; end; + procedure get_objc_class_or_protocol_external_status(od: tobjectdef); begin { Objective-C classes can be external -> all messages inside are @@ -1366,6 +1391,8 @@ implementation java_jlobject:=current_objectdef; if (current_objectdef.objname^='JLTHROWABLE') then java_jlthrowable:=current_objectdef; + if (current_objectdef.objname^='FPCBASERECORDTYPE') then + java_fpcbaserecordtype:=current_objectdef; end; end; end; diff --git a/compiler/scandir.pas b/compiler/scandir.pas index 824468f3ee..d247c0d4e5 100644 --- a/compiler/scandir.pas +++ b/compiler/scandir.pas @@ -780,6 +780,31 @@ unit scandir; end; + procedure dir_namespace; + var + s : string; + begin + { used to define Java package names for all types declared in the + current unit } + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + current_scanner.readstring; + s:=orgpattern; + while c='.' do + begin + current_scanner.readchar; + current_scanner.readstring; + s:=s+'.'+orgpattern; + end; + disposestr(current_module.namespace); + current_module.namespace:=stringdup(s); + end; + end; + + procedure dir_mmx; begin do_localswitch(cs_mmx); @@ -1458,6 +1483,7 @@ unit scandir; AddDirective('MMX',directive_all, @dir_mmx); AddDirective('MODE',directive_all, @dir_mode); AddDirective('MODESWITCH',directive_all, @dir_modeswitch); + AddDirective('NAMESPACE',directive_all, @dir_namespace); AddDirective('NODEFINE',directive_all, @dir_nodefine); AddDirective('NOTE',directive_all, @dir_note); AddDirective('NOTES',directive_all, @dir_notes);