Browse Source

Merged revision(s) 32450-32451, 32455, 32457-32458, 32460-32462, 32477, 32480 from branches/svenbarth/packages:
cclasses.pas, TCmdStrList:
* if doubles are not allowed then do case sensitive checks instead of insensitive ones

........
Correctly handle export/import generation depending on whether we're compiling for a system that needs indirect imports or not.

systems.pas:
* replace systems_package_need_exports with systems_indirect_var_imports
pmodules.pas, proc_package:
- remove check for systems_package_need_exports
pkgutil.pas:
* insert_export, export_unit: export the direct or the indirect variable symbol depending on systems_indirect_var_imports

........
ncgrtti.pas, TRTTIWriter.write_extra_rttisyms:
* enumdef_rtti_string2ordindex & enumdef_rtti_ord2stringindex: put the indirect suffix at the end of the symbol

........
pkgutil.pas, add_package_libs:
* check for systems_indirect_var_imports instead of systems_package_needs_exports

........
expunix.pas, texportlibunix:
* generatelib: check all procdefs whether they have the alias and not only the first one

........
pkgutil.pas:
* insert_export: directly report the symbol type instead of its ordinal to ease finding of problems

........
pkgutil.pas, export_procsym:
* restructure if for better readability
+ also check the procdef for po_has_public_name

........
Ensure that all implicitely imported units are indeed part of the package.

pmodules.pas, proc_package:
* instead of checking the units loaded by the current module we need to check *all* units that are loaded for the package

........
Fix inclusion of PPUs that don't have a corresponding object file.

pkgutil.pas, RewritePPU:
* don't abort if a unit does have the flag uf_no_link set
* only abort if both uf_static_link and uf_no_link are not set

........
Generate an error if a unit listed as in "contains" is part of a directly or indirectly required package.

pmodules.pas, proc_package:
* walk all units and check whether it had been loaded from a package, but is also part of the units of the current module; if so then generate an error

........

git-svn-id: trunk@33516 -

svenbarth 9 years ago
parent
commit
3e70ac05c2
4 changed files with 57 additions and 30 deletions
  1. 4 4
      compiler/cclasses.pas
  2. 13 2
      compiler/expunix.pas
  3. 17 15
      compiler/pkgutil.pas
  4. 23 9
      compiler/pmodules.pas

+ 4 - 4
compiler/cclasses.pas

@@ -401,7 +401,7 @@ type
        { string container }
        { string container }
        TCmdStrList = class(TLinkedList)
        TCmdStrList = class(TLinkedList)
        private
        private
-          FDoubles : boolean;  { if this is set to true, doubles are allowed }
+          FDoubles : boolean;  { if this is set to true, doubles (case insensitive!) are allowed }
        public
        public
           constructor Create;
           constructor Create;
           constructor Create_No_Double;
           constructor Create_No_Double;
@@ -2407,7 +2407,7 @@ end;
     procedure TCmdStrList.insert(const s : TCmdStr);
     procedure TCmdStrList.insert(const s : TCmdStr);
       begin
       begin
          if (s='') or
          if (s='') or
-            ((not FDoubles) and (find(s)<>nil)) then
+            ((not FDoubles) and (findcase(s)<>nil)) then
           exit;
           exit;
          inherited insert(TCmdStrListItem.create(s));
          inherited insert(TCmdStrListItem.create(s));
       end;
       end;
@@ -2416,7 +2416,7 @@ end;
     procedure TCmdStrList.concat(const s : TCmdStr);
     procedure TCmdStrList.concat(const s : TCmdStr);
       begin
       begin
          if (s='') or
          if (s='') or
-            ((not FDoubles) and (find(s)<>nil)) then
+            ((not FDoubles) and (findcase(s)<>nil)) then
           exit;
           exit;
          inherited concat(TCmdStrListItem.create(s));
          inherited concat(TCmdStrListItem.create(s));
       end;
       end;
@@ -2428,7 +2428,7 @@ end;
       begin
       begin
         if s='' then
         if s='' then
          exit;
          exit;
-        p:=find(s);
+        p:=findcase(s);
         if assigned(p) then
         if assigned(p) then
          begin
          begin
            inherited Remove(p);
            inherited Remove(p);

+ 13 - 2
compiler/expunix.pas

@@ -131,6 +131,8 @@ procedure texportlibunix.generatelib;  // straight t_linux copy for now.
 var
 var
   hp2 : texported_item;
   hp2 : texported_item;
   pd  : tprocdef;
   pd  : tprocdef;
+  anyhasalias : boolean;
+  i : longint;
 {$ifdef x86}
 {$ifdef x86}
   sym : tasmsymbol;
   sym : tasmsymbol;
   r : treference;
   r : treference;
@@ -147,8 +149,17 @@ begin
       begin
       begin
         { the manglednames can already be the same when the procedure
         { the manglednames can already be the same when the procedure
           is declared with cdecl }
           is declared with cdecl }
-        pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
-        if not has_alias_name(pd,hp2.name^) then
+        { note: for "exports" sections we only allow non overloaded procsyms,
+                so checking all symbols only matters for packages }
+        anyhasalias:=false;
+        for i:=0 to tprocsym(hp2.sym).procdeflist.count-1 do
+          begin
+            pd:=tprocdef(tprocsym(hp2.sym).procdeflist[i]);
+            anyhasalias:=has_alias_name(pd,hp2.name^);
+            if anyhasalias then
+              break;
+          end;
+        if not anyhasalias then
          begin
          begin
            { place jump in al_procedures }
            { place jump in al_procedures }
            current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
            current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));

+ 17 - 15
compiler/pkgutil.pas

@@ -78,10 +78,14 @@ implementation
       for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
       for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
         begin
         begin
           if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) and
           if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) and
-            ((tprocdef(tprocsym(sym).ProcdefList[i]).procoptions*[po_external])=[]) and
-            ((symtable.symtabletype in [globalsymtable,recordsymtable,objectsymtable]) or
-             ((symtable.symtabletype=staticsymtable) and (po_public in tprocdef(tprocsym(sym).ProcdefList[i]).procoptions))
-            ) then
+              ((tprocdef(tprocsym(sym).ProcdefList[i]).procoptions*[po_external])=[]) and
+              (
+                (symtable.symtabletype in [globalsymtable,recordsymtable,objectsymtable]) or
+                (
+                  (symtable.symtabletype=staticsymtable) and
+                  ([po_public,po_has_public_name]*tprocdef(tprocsym(sym).ProcdefList[i]).procoptions<>[])
+                )
+              ) then
             begin
             begin
               exportallprocdefnames(tprocsym(sym),tprocdef(tprocsym(sym).ProcdefList[i]),[]);
               exportallprocdefnames(tprocsym(sym),tprocdef(tprocsym(sym).ProcdefList[i]),[]);
             end;
             end;
@@ -170,11 +174,14 @@ implementation
           begin
           begin
             if publiconly and not (vo_is_public in tstaticvarsym(sym).varoptions) then
             if publiconly and not (vo_is_public in tstaticvarsym(sym).varoptions) then
               exit;
               exit;
-            varexport(tsym(sym).mangledname);
+            if target_info.system in systems_indirect_var_imports then
+              varexport(tsym(sym).mangledname)
+            else
+              varexport(tsym(sym).mangledname+suffix_indirect);
           end;
           end;
         else
         else
           begin
           begin
-            writeln('unknown: ',ord(TSym(sym).typ));
+            writeln('unknown: ',TSym(sym).typ);
           end;
           end;
       end;
       end;
     end;
     end;
@@ -233,13 +240,6 @@ implementation
          Comment(V_Error,'Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn);
          Comment(V_Error,'Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn);
          Exit;
          Exit;
        end;
        end;
-    { No .o file generated for this ppu, just skip }
-      if (inppu.header.common.flags and uf_no_link)<>0 then
-       begin
-         inppu.free;
-         Result:=true;
-         Exit;
-       end;
     { Already a lib? }
     { Already a lib? }
       if (inppu.header.common.flags and uf_in_library)<>0 then
       if (inppu.header.common.flags and uf_in_library)<>0 then
        begin
        begin
@@ -247,8 +247,8 @@ implementation
          Comment(V_Error,'PPU is already in a library : '+PPUFn);
          Comment(V_Error,'PPU is already in a library : '+PPUFn);
          Exit;
          Exit;
        end;
        end;
-    { We need a static linked unit }
-      if (inppu.header.common.flags and uf_static_linked)=0 then
+    { We need a static linked unit, but we also accept those without .o file }
+      if (inppu.header.common.flags and (uf_static_linked or uf_no_link))=0 then
        begin
        begin
          inppu.free;
          inppu.free;
          Comment(V_Error,'PPU is not static linked : '+PPUFn);
          Comment(V_Error,'PPU is not static linked : '+PPUFn);
@@ -440,6 +440,8 @@ implementation
       i : longint;
       i : longint;
       pkgname : tpathstr;
       pkgname : tpathstr;
     begin
     begin
+      if not (target_info.system in systems_indirect_var_imports) then
+        exit;
       for i:=0 to packagelist.count-1 do
       for i:=0 to packagelist.count-1 do
         begin
         begin
           pkgentry:=ppackageentry(packagelist[i]);
           pkgentry:=ppackageentry(packagelist[i]);

+ 23 - 9
compiler/pmodules.pas

@@ -1552,6 +1552,19 @@ type
                  if not assigned(uu) then
                  if not assigned(uu) then
                    message2(package_n_implicit_unit_import,hp.realmodulename^,current_module.realmodulename^);
                    message2(package_n_implicit_unit_import,hp.realmodulename^,current_module.realmodulename^);
                end;
                end;
+             { was this unit listed as a contained unit? If so => error }
+             if (hp<>current_module) and assigned(hp.package) then
+               begin
+                 uu:=tused_unit(current_module.used_units.first);
+                 while assigned(uu) do
+                   begin
+                     if uu.u=hp then
+                       break;
+                     uu:=tused_unit(uu.next);
+                   end;
+                 if assigned(uu) then
+                   message2(package_e_unit_already_contained_in_package,hp.realmodulename^,hp.package.realpackagename^);
+               end;
              hp:=tmodule(hp.next);
              hp:=tmodule(hp.next);
            end;
            end;
 
 
@@ -1702,15 +1715,16 @@ type
 
 
          if (not current_module.is_unit) then
          if (not current_module.is_unit) then
            begin
            begin
-             { add all contained units to the package }
-             { TODO : handle implicitly imported units }
-             uu:=tused_unit(current_module.used_units.first);
-             while assigned(uu) do
-               begin
-                 if not assigned(uu.u.package) then
-                   pkg.addunit(uu.u);
-                 uu:=tused_unit(uu.next);
-               end;
+             { we add all loaded units that are not part of a package to the
+               package; this includes units in the "contains" section as well
+               as implicitely imported ones }
+             hp:=tmodule(loaded_units.first);
+             while assigned(hp) do
+              begin
+                if (hp<>current_module) and not assigned(hp.package) then
+                  pkg.addunit(hp);
+                hp:=tmodule(hp.next);
+              end;
 
 
              pkg.initmoduleinfo(current_module);
              pkg.initmoduleinfo(current_module);