+ support for {$namespace x.y.z} directive to specify the namespace

    for the current unit and all types/routines declared in it. The
    unit itself becomes a member of this namespace as well, so in
    case it's called unit1, it will be x.y.z.unit1, and type tclass
    declared in it will be x.y.z.tclass. Only used for the JVM
    target currently

git-svn-id: branches/jvmbackend@18436 -

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

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

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;

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

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

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;

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