compiler: implement delphi like namespaces

git-svn-id: branches/paul/namespaces@18859 -

compiler/dbgbase.pas

@@ -420,6 +420,9 @@ implementation
             appendsym_absolute(list,tabsolutevarsym(sym));
           propertysym :
             appendsym_property(list,tpropertysym(sym));
+          namespacesym :
+            { ignore namespace syms, they are only of internal use }
+            ;
           else
             internalerror(200601242);
         end;

compiler/fmodule.pas

@@ -471,7 +471,7 @@ implementation
       var
         n : string;
       begin
-        n:=ChangeFileExt(ExtractFileName(s),'');
+        n:=s;
         { Programs have the name 'Program' to don't conflict with dup id's }
         if _is_unit then
          inherited create(n)

compiler/pbase.pas

@@ -243,12 +243,13 @@ implementation
     function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean;
       var
         hmodule: tmodule;
+        ns:string;
+        nssym:tsym;
       begin
-        // TODO: dot units
         result:=false;
         tokentoconsume:=_ID;
-        if assigned(srsym) and
-           (srsym.typ=unitsym) then
+
+        if assigned(srsym) and (srsym.typ in [unitsym,namespacesym]) then
           begin
             if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
               internalerror(200501154);
@@ -264,6 +265,35 @@ implementation
                 if consume_id then
                   consume(_ID);
                 consume(_POINT);
+                if srsym.typ=namespacesym then
+                  begin
+                    ns:=srsym.name;
+                    nssym:=srsym;
+                    while assigned(srsym) and (srsym.typ=namespacesym) do
+                      begin
+                        { we have a namespace. the next identifier should be either a namespace or a unit }
+                        searchsym_in_module(hmodule,ns+'.'+pattern,srsym,srsymtable);
+                        if assigned(srsym) and (srsym.typ in [namespacesym,unitsym]) then
+                          begin
+                            ns:=ns+'.'+pattern;
+                            nssym:=srsym;
+                            consume(_ID);
+                            consume(_POINT);
+                          end;
+                      end;
+                    { check if there is a hidden unit with this pattern in the namespace }
+                    if not assigned(srsym) and
+                       assigned(nssym) and (nssym.typ=namespacesym) and assigned(tnamespacesym(nssym).unitsym) then
+                      srsym:=tnamespacesym(nssym).unitsym;
+                    if assigned(srsym) and (srsym.typ<>unitsym) then
+                      internalerror(201108260);
+                    if not assigned(srsym) then
+                      begin
+                        result:=true;
+                        srsymtable:=nil;
+                        exit;
+                      end;
+                  end;
                 case token of
                   _ID:
                      searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
@@ -279,7 +309,7 @@ implementation
                           tokentoconsume:=_STRING;
                         end;
                     end
-                  end;
+                end;
               end
             else
               begin

compiler/pmodules.pas

@@ -533,7 +533,7 @@ implementation
         { insert unitsym }
         unitsym:=tunitsym.create(s,hp);
         inc(unitsym.refs);
-        current_module.localsymtable.insert(unitsym);
+        tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym);
         { add to used units }
         current_module.addusedunit(hp,false,unitsym);
       end;
@@ -748,6 +748,13 @@ implementation
            s:=pattern;
            sorg:=orgpattern;
            consume(_ID);
+           while token=_POINT do
+             begin
+               consume(_POINT);
+               s:=s+'.'+pattern;
+               sorg:=sorg+'.'+orgpattern;
+               consume(_ID);
+             end;
            { support "<unit> in '<file>'" construct, but not for tp7 }
            fn:='';
            if not(m_tp7 in current_settings.modeswitches) and
@@ -786,7 +793,7 @@ implementation
                 can not use the modulename because that can be different
                 when -Un is used }
               unitsym:=tunitsym.create(sorg,nil);
-              current_module.localsymtable.insert(unitsym);
+              tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym);
               { the current module uses the unit hp2 }
               current_module.addusedunit(hp2,true,unitsym);
             end
@@ -1071,6 +1078,7 @@ implementation
          force_init_final : boolean;
          init_procinfo,
          finalize_procinfo : tcgprocinfo;
+         unitname : string;
          unitname8 : string[8];
          ag: boolean;
 {$ifdef debug_devirt}
@@ -1087,49 +1095,53 @@ implementation
          if compile_level=1 then
           Status.IsExe:=false;
 
-         if token=_ID then
-          begin
-             { create filenames and unit name }
-             main_file := current_scanner.inputfile;
-             while assigned(main_file.next) do
-               main_file := main_file.next;
-
-             new(s1);
-             s1^:=current_module.modulename^;
-             current_module.SetFileName(main_file.path^+main_file.name^,true);
-             current_module.SetModuleName(orgpattern);
-
-             { check for system unit }
-             new(s2);
-             s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),''));
-             unitname8:=copy(current_module.modulename^,1,8);
-             if (cs_check_unit_name in current_settings.globalswitches) and
-                (
-                 not(
-                     (current_module.modulename^=s2^) or
-                     (
-                      (length(current_module.modulename^)>8) and
-                      (unitname8=s2^)
-                     )
-                    )
-                 or
+         unitname:=orgpattern;
+         consume(_ID);
+         while token=_POINT do
+           begin
+             consume(_POINT);
+             unitname:=unitname+'.'+orgpattern;
+             consume(_ID);
+           end;
+
+         { create filenames and unit name }
+         main_file := current_scanner.inputfile;
+         while assigned(main_file.next) do
+           main_file := main_file.next;
+
+         new(s1);
+         s1^:=current_module.modulename^;
+         current_module.SetFileName(main_file.path^+main_file.name^,true);
+         current_module.SetModuleName(unitname);
+
+         { check for system unit }
+         new(s2);
+         s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),''));
+         unitname8:=copy(current_module.modulename^,1,8);
+         if (cs_check_unit_name in current_settings.globalswitches) and
+            (
+             not(
+                 (current_module.modulename^=s2^) or
                  (
-                  (length(s1^)>8) and
-                  (s1^<>current_module.modulename^)
+                  (length(current_module.modulename^)>8) and
+                  (unitname8=s2^)
                  )
-                ) then
-              Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
-             if (current_module.modulename^='SYSTEM') then
-              include(current_settings.moduleswitches,cs_compilesystem);
-             dispose(s2);
-             dispose(s1);
-          end;
+                )
+             or
+             (
+              (length(s1^)>8) and
+              (s1^<>current_module.modulename^)
+             )
+            ) then
+          Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
+         if (current_module.modulename^='SYSTEM') then
+          include(current_settings.moduleswitches,cs_compilesystem);
+         dispose(s2);
+         dispose(s1);
 
          if (target_info.system in systems_unit_program_exports) then
            exportlib.preparelib(current_module.realmodulename^);
 
-         consume(_ID);
-
          { parse hint directives }
          try_consume_hintdirective(current_module.moduleoptions, current_module.deprecatedmsg);
 
@@ -1162,7 +1174,7 @@ implementation
 
          { insert unitsym of this unit to prevent other units having
            the same name }
-         current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
+         tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module));
 
          { load default units, like the system unit }
          loaddefaultunits;
@@ -1857,7 +1869,7 @@ implementation
 
          {Insert the name of the main program into the symbol table.}
          if current_module.realmodulename^<>'' then
-           current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
+           tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module));
 
          Message1(parser_u_parsing_implementation,current_module.mainsource^);
 
@@ -2050,6 +2062,7 @@ implementation
          main_procinfo : tcgprocinfo;
          force_init_final : boolean;
          resources_used : boolean;
+         program_name : string;
       begin
          DLLsource:=islibrary;
          Status.IsLibrary:=IsLibrary;
@@ -2097,14 +2110,21 @@ implementation
          if islibrary then
            begin
               consume(_LIBRARY);
-              current_module.setmodulename(orgpattern);
+              program_name:=orgpattern;
+              consume(_ID);
+              while token=_POINT do
+                begin
+                  consume(_POINT);
+                  program_name:=program_name+'.'+orgpattern;
+                  consume(_ID);
+                end;
+              current_module.setmodulename(program_name);
               current_module.islibrary:=true;
-              exportlib.preparelib(orgpattern);
+              exportlib.preparelib(program_name);
 
               if tf_library_needs_pic in target_info.flags then
                 include(current_settings.moduleswitches,cs_create_pic);
 
-              consume(_ID);
               consume(_SEMICOLON);
            end
          else
@@ -2112,10 +2132,17 @@ implementation
            if token=_PROGRAM then
             begin
               consume(_PROGRAM);
-              current_module.setmodulename(orgpattern);
-              if (target_info.system in systems_unit_program_exports) then
-                exportlib.preparelib(orgpattern);
+              program_name:=orgpattern;
               consume(_ID);
+              while token=_POINT do
+                begin
+                  consume(_POINT);
+                  program_name:=program_name+'.'+orgpattern;
+                  consume(_ID);
+                end;
+              current_module.setmodulename(program_name);
+              if (target_info.system in systems_unit_program_exports) then
+                exportlib.preparelib(program_name);
               if token=_LKLAMMER then
                 begin
                    consume(_LKLAMMER);
@@ -2158,7 +2185,7 @@ implementation
 
          {Insert the name of the main program into the symbol table.}
          if current_module.realmodulename^<>'' then
-           current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
+           tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module));
 
          Message1(parser_u_parsing_implementation,current_module.mainsource^);
 

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 135;
+  CurrentPPUVersion = 136;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -97,7 +97,7 @@ const
   ibunitsym        = 29;
   iblabelsym       = 30;
   ibsyssym         = 31;
-//  ibrttisym        = 32;
+  ibnamespacesym   = 32;
   iblocalvarsym    = 33;
   ibparavarsym     = 34;
   ibmacrosym       = 35;

compiler/symconst.pas

@@ -487,7 +487,7 @@ type
     staticvarsym,localvarsym,paravarsym,fieldvarsym,
     typesym,procsym,unitsym,constsym,enumsym,
     errorsym,syssym,labelsym,absolutevarsym,propertysym,
-    macrosym
+    macrosym,namespacesym
   );
 
   { State of the variable:
@@ -593,7 +593,7 @@ const
        'abstractsym','globalvar','localvar','paravar','fieldvar',
        'type','proc','unit','const','enum',
        'errorsym','system sym','label','absolutevar','property',
-       'macrosym'
+       'macrosym','namespace'
      );
 
      typName : array[tdeftyp] of string[12] = (

compiler/symsym.pas

@@ -78,6 +78,16 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
 
+       tnamespacesym = class(Tstoredsym)
+          unitsym:tsym;
+          unitsymderef:tderef;
+          constructor create(const n : string);
+          constructor ppuload(ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderef;override;
+          procedure deref;override;
+       end;
+
        terrorsym = class(Tsym)
           constructor create;
        end;
@@ -477,6 +487,42 @@ implementation
          ppufile.writeentry(ibunitsym);
       end;
 
+{****************************************************************************
+                                TNAMESPACESYM
+****************************************************************************}
+
+    constructor tnamespacesym.create(const n : string);
+      begin
+         inherited create(namespacesym,n);
+         unitsym:=nil;
+      end;
+
+    constructor tnamespacesym.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuload(namespacesym,ppufile);
+         ppufile.getderef(unitsymderef);
+      end;
+
+    procedure tnamespacesym.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwrite(ppufile);
+         ppufile.putderef(unitsymderef);
+         ppufile.writeentry(ibnamespacesym);
+      end;
+
+    procedure tnamespacesym.buildderef;
+      begin
+        inherited buildderef;
+        unitsymderef.build(unitsym);
+      end;
+
+    procedure tnamespacesym.deref;
+      begin
+        inherited deref;
+        unitsym:=tsym(unitsymderef.resolve);
+      end;
+
+
 {****************************************************************************
                                   TPROCSYM
 ****************************************************************************}

compiler/symtable.pas

@@ -145,7 +145,9 @@ interface
        tabstractuniTSymtable = class(tstoredsymtable)
        public
           constructor create(const n : string;id:word);
+          function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
           function iscurrentunit:boolean;override;
+          procedure insertunit(sym:TSymEntry);
        end;
 
        tglobalsymtable = class(tabstractuniTSymtable)
@@ -154,7 +156,6 @@ interface
           constructor create(const n : string;id:word);
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function  checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
        end;
 
        tstaticsymtable = class(tabstractuniTSymtable)
@@ -455,6 +456,7 @@ implementation
                iblabelsym : sym:=tlabelsym.ppuload(ppufile);
                  ibsyssym : sym:=tsyssym.ppuload(ppufile);
                ibmacrosym : sym:=tmacro.ppuload(ppufile);
+           ibnamespacesym : sym:=tnamespacesym.ppuload(ppufile);
                 ibendsyms : break;
                     ibend : Message(unit_f_ppu_read_error);
            else
@@ -707,7 +709,7 @@ implementation
            else
             begin
               if (tsym(sym).refs=0) and
-                 not(tsym(sym).typ in [enumsym,unitsym]) and
+                 not(tsym(sym).typ in [enumsym,unitsym,namespacesym]) and
                  not(is_funcret_sym(tsym(sym))) and
                  { don't complain about compiler generated syms for specializations, see also #13405 }
                  not((tsym(sym).typ=typesym) and (df_specialization in ttypesym(sym).typedef.defoptions) and
@@ -1460,6 +1462,46 @@ implementation
       end;
 
 
+    function tabstractuniTSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
+      var
+        hsym : tsym;
+      begin
+        result:=false;
+        hsym:=tsym(FindWithHash(hashedid));
+        if assigned(hsym) then
+          begin
+            if hsym.typ=symconst.namespacesym then
+              begin                
+                case sym.typ of
+                  symconst.namespacesym:;
+                  symconst.unitsym:
+                    begin
+                      HideSym(sym); { if we add a unit and there is a namespace with the same name then hide the unit name and not the namespace }
+                      tnamespacesym(hsym).unitsym:=tsym(sym);
+                    end
+                else
+                  HideSym(hsym);
+                end;
+              end
+            else
+            { In delphi (contrary to TP) you can have a symbol with the same name as the
+              unit, the unit can then not be accessed anymore using
+              <unit>.<id>, so we can hide the symbol. 
+              Do the same if we add a namespace and there is a unit with the same name }
+            if (hsym.typ=symconst.unitsym) and
+               ((m_delphi in current_settings.modeswitches) or (sym.typ=symconst.namespacesym)) then
+              begin
+                HideSym(hsym);
+                if sym.typ=symconst.namespacesym then
+                  tnamespacesym(sym).unitsym:=tsym(hsym);
+              end
+            else
+              DuplicateSym(hashedid,sym,hsym);
+            result:=true;
+            exit;
+          end;
+      end;
+
     function tabstractuniTSymtable.iscurrentunit:boolean;
       begin
         result:=assigned(current_module) and
@@ -1469,6 +1511,29 @@ implementation
                 );
       end;
 
+    procedure tabstractuniTSymtable.insertunit(sym:TSymEntry);
+      var
+        p:integer;
+        n,ns:string;
+        oldsym:TSymEntry;
+      begin
+        insert(sym);
+        n:=sym.realname;
+        p:=pos('.',n);
+        ns:='';
+        while p>0 do
+          begin
+            if ns='' then
+              ns:=copy(n,1,p-1)
+            else
+              ns:=ns+'.'+copy(n,1,p-1);
+            system.delete(n,1,p);
+            oldsym:=Find(upper(ns));
+            if not Assigned(oldsym) or (oldsym.typ<>namespacesym) then
+              insert(tnamespacesym.create(ns));
+            p:=pos('.',n);
+          end;
+      end;
 
 {****************************************************************************
                               TStaticSymtable
@@ -1501,23 +1566,10 @@ implementation
       var
         hsym : tsym;
       begin
-        result:=false;
-        hsym:=tsym(FindWithHash(hashedid));
-        if assigned(hsym) then
-          begin
-            { Delphi (contrary to TP) you can have a symbol with the same name as the
-              unit, the unit can then not be accessed anymore using
-              <unit>.<id>, so we can hide the symbol }
-            if (m_delphi in current_settings.modeswitches) and
-               (hsym.typ=symconst.unitsym) then
-              HideSym(hsym)
-            else
-              DuplicateSym(hashedid,sym,hsym);
-            result:=true;
-            exit;
-          end;
+        result:=inherited checkduplicate(hashedid,sym);
 
-        if (current_module.localsymtable=self) and
+        if not result and
+           (current_module.localsymtable=self) and
            assigned(current_module.globalsymtable) then
           result:=tglobalsymtable(current_module.globalsymtable).checkduplicate(hashedid,sym);
       end;
@@ -1551,28 +1603,6 @@ implementation
       end;
 
 
-    function tglobalsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
-      var
-        hsym : tsym;
-      begin
-        result:=false;
-        hsym:=tsym(FindWithHash(hashedid));
-        if assigned(hsym) then
-          begin
-            { Delphi (contrary to TP) you can have a symbol with the same name as the
-              unit, the unit can then not be accessed anymore using
-              <unit>.<id>, so we can hide the symbol }
-            if (m_delphi in current_settings.modeswitches) and
-               (hsym.typ=symconst.unitsym) then
-              HideSym(hsym)
-            else
-              DuplicateSym(hashedid,sym,hsym);
-            result:=true;
-            exit;
-          end;
-      end;
-
-
 {****************************************************************************
                               TWITHSYMTABLE
 ****************************************************************************}

compiler/utils/ppudump.pp

@@ -1489,6 +1489,13 @@ begin
          ibunitsym :
            readcommonsym('Unit symbol ');
 
+         ibnamespacesym :
+           begin
+             readcommonsym('NameSpace symbol ');
+             write(space,'  Hidden Unit : ');
+             readderef('');
+           end;
+
          iblabelsym :
            readcommonsym('Label symbol ');