* Fixed bug #6501: multiple resource files are correctly linked to executable.

It is done in the following way:

When unit is compiled, .rc file are compiled to .res and list of unit's resource files is stored in .ppu
Before final linking all program's .res files are collected into global .res file (.res files are easily concatenated). 
Then this global .res files is compiled to single .or file, which is linked to executable. 
As a result global resource index is created and the problem is fixed.

Old resource processing behavior still supported when tresinfo.rcbin is not set for target.
New resource processing is activated for windows and linux. Cross compiled windres can be used to compile .rc files on linux.

git-svn-id: trunk@7515 -

compiler/comprsrc.pas

@@ -26,28 +26,44 @@ unit comprsrc;
 interface
 
   uses
-    Systems;
+    Systems, cstreams;
 
 type
+   tresoutput = (roRES, roOBJ);
+
    tresourcefile = class(TAbstractResourceFile)
    private
       fname : ansistring;
    public
       constructor Create(const fn : ansistring);override;
-      procedure Compile;virtual;
+      procedure Compile(output: tresoutput; const OutName: ansistring);virtual;
       procedure PostProcessResourcefile(const s : ansistring);virtual;
+      function IsCompiled(const fn : ansistring) : boolean;virtual;
+      procedure Collect(const fn : ansistring);virtual;
+   end;
+   
+   TWinLikeResourceFile = class(tresourcefile)
+   private
+      FOut: TCFileStream;
+   public
+      function IsCompiled(const fn : ansistring) : boolean;override;
+      procedure Collect(const fn : ansistring);override;
    end;
 
 procedure CompileResourceFiles;
+procedure CollectResourceFiles;
 
 
 implementation
 
 uses
   SysUtils,
-  cutils,cfileutils,
+  cutils,cfileutils,cclasses,
   Globtype,Globals,Verbose,Fmodule,
   Script;
+  
+const
+  GlobalResName = 'fpc-res';
 
 {****************************************************************************
                               TRESOURCEFILE
@@ -64,23 +80,42 @@ begin
 end;
 
 
-procedure tresourcefile.compile;
+function tresourcefile.IsCompiled(const fn: ansistring): boolean;
+begin
+  Result:=CompareText(ExtractFileExt(fn), target_info.resobjext) = 0;
+end;
+
+
+procedure tresourcefile.Collect(const fn: ansistring);
+begin
+  if fn='' then
+    exit;
+  fname:=fn;
+  Compile(roOBJ, ChangeFileExt(fn, target_info.resobjext));
+end;
+
+
+procedure tresourcefile.compile(output: tresoutput; const OutName: ansistring);
 var
   respath,
   srcfilepath,
-  n,
   s,
-  resobj,
+  bin,
   resbin   : TCmdStr;
   resfound,
   objused  : boolean;
 begin
-  resbin:='';
+  if output=roRES then
+    bin:=target_res.rcbin
+  else
+    bin:=target_res.resbin;
+  if bin='' then
+    exit;
   resfound:=false;
   if utilsdirectory<>'' then
-    resfound:=FindFile(utilsprefix+target_res.resbin+source_info.exeext,utilsdirectory,false,resbin);
+    resfound:=FindFile(utilsprefix+bin+source_info.exeext,utilsdirectory,false,resbin);
   if not resfound then
-    resfound:=FindExe(utilsprefix+target_res.resbin,false,resbin);
+    resfound:=FindExe(utilsprefix+bin,false,resbin);
   { get also the path to be searched for the windres.h }
   respath:=ExtractFilePath(resbin);
   if (not resfound) and not(cs_link_nolink in current_settings.globalswitches) then
@@ -89,18 +124,25 @@ begin
      current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
    end;
   srcfilepath:=ExtractFilePath(current_module.mainsource^);
-  resobj:=current_module.outputpath^+ChangeFileExt(ExtractFileName(fname),target_info.resobjext);
-  if not path_absolute(fname) then
-    fname:=srcfilepath+fname;
-  s:=target_res.rescmd;
-  ObjUsed:=(pos('$OBJ',s)>0);
-  Replace(s,'$OBJ',maybequoted(resobj));
-  Replace(s,'$RES',maybequoted(fname));
+  if output=roRES then
+    begin
+      s:=target_res.rccmd;
+      Replace(s,'$RES',maybequoted(OutName));
+      Replace(s,'$RC',maybequoted(fname));
+      ObjUsed:=False;
+    end
+  else
+    begin
+      s:=target_res.rescmd;
+      ObjUsed:=(pos('$OBJ',s)>0);
+      Replace(s,'$OBJ',maybequoted(OutName));
+      Replace(s,'$RES',maybequoted(fname));
+    end;
   { windres doesn't like empty include paths }
   if respath='' then
     respath:='.';
   Replace(s,'$INC',maybequoted(respath));
-  if (target_info.system = system_i386_win32) and
+  if (target_res.resbin='windres') and
      (srcfilepath<>'') then
     s:=s+' --include '+maybequoted(srcfilepath);
 { Execute the command }
@@ -123,35 +165,197 @@ begin
        end
      end;
     end;
-  PostProcessResourcefile(maybequoted(resobj));
+  if output=roOBJ then
+    PostProcessResourcefile(OutName);
   { Update asmres when externmode is set }
   if cs_link_nolink in current_settings.globalswitches then
     AsmRes.AddLinkCommand(resbin,s,'');
-  if ObjUsed then
-    current_module.linkunitofiles.add(resobj,link_always);
+  if (output=roOBJ) and ObjUsed then
+    current_module.linkunitofiles.add(OutName,link_always);
+end;
+
+
+function TWinLikeResourceFile.IsCompiled(const fn: ansistring): boolean;
+const
+  ResSignature : array [1..32] of byte =
+  ($00,$00,$00,$00,$20,$00,$00,$00,$FF,$FF,$00,$00,$FF,$FF,$00,$00,
+   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00);
+var
+  f : file;
+  oldfmode : byte;
+  buf: array[1..32] of byte;
+  i: longint;
+begin
+  Result:=CompareText(ExtractFileExt(fn), target_info.resext) = 0;
+  if Result then exit;
+  oldfmode:=Filemode;
+  Filemode:=0;
+  assign(f,fn);
+  reset(f,1);
+  BlockRead(f, buf, SizeOf(buf), i);
+  close(f);
+  Filemode:=oldfmode;
+  
+  if i<>SizeOf(buf) then
+    exit;
+
+  for i:=1 to 32 do
+    if buf[i]<>ResSignature[i] then
+      exit;
+      
+  Result:=True;
+end;
+
+
+procedure TWinLikeResourceFile.Collect(const fn: ansistring);
+const
+  zeroes: array[1..3] of byte = (0,0,0);
+var
+  fs: TCFileStream;
+  i: longint;
+begin
+  if fn='' then
+    begin
+      if FOut<>nil then
+        begin
+          FOut.Free;
+          Compile(roOBJ,ChangeFileExt(fname,target_info.resobjext));
+        end;
+    end
+  else
+    begin
+      fs:=TCFileStream.Create(fn,fmOpenRead or fmShareDenyNone);
+      if CStreamError<>0 then
+        begin
+          fs.Free;
+          Comment(V_Error,'Can''t open resource file: '+fn);
+          exit;
+        end;
+      if FOut=nil then
+        FOut:=TCFileStream.Create(fname,fmCreate)
+      else
+        fs.Seek(32, soFromBeginning);
+      FOut.CopyFrom(fs, fs.Size-fs.Position);
+      fs.Free;
+      { align resource to dword }
+      i:=4 - FOut.Position mod 4;
+      if i<4 then
+        FOut.WriteBuffer(zeroes, i);
+    end;
 end;
 
 
 procedure CompileResourceFiles;
 var
   resourcefile : tresourcefile;
+  res: TCmdStrListItem;
+  p,s : TCmdStr;
+  src,dst : TCFileStream;
+  outfmt : tresoutput;
 begin
   { OS/2 (EMX) must be processed elsewhere (in the linking/binding stage).
     same with MacOS}
-  if not (target_info.system in [system_i386_os2,
-                                 system_i386_emx,system_powerpc_macos]) then
-   While not current_module.ResourceFiles.Empty do
-     begin
-       if target_info.res<>res_none then
-         begin
-           resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(current_module.ResourceFiles.getfirst));
-           resourcefile.compile;
-           resourcefile.free;
-         end
-       else
-         Message(scan_e_resourcefiles_not_supported);
-     end;
+  if target_info.system in [system_i386_os2,system_i386_emx,system_powerpc_macos] then exit;
+
+  p:=ExtractFilePath(current_module.mainsource^);
+  res:=TCmdStrListItem(current_module.ResourceFiles.First);
+  while res<>nil do
+    begin
+      if target_info.res=res_none then
+        Message(scan_e_resourcefiles_not_supported);
+      s:=res.FPStr;
+      if not path_absolute(s) then
+        s:=p+s;
+      resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s));
+      if resourcefile.IsCompiled(s) then
+        begin
+          resourcefile.free;
+          if CompareText(current_module.outputpath^, p) <> 0 then
+            begin
+              { Copy .res file to units output dir }
+              res.FPStr:=ExtractFileName(res.FPStr);
+              src:=TCFileStream.Create(s,fmOpenRead or fmShareDenyNone);
+              if CStreamError<>0 then
+                begin
+                  Comment(V_Error,'Can''t open resource file: '+src.FileName);
+                  exit;
+                end;
+              dst:=TCFileStream.Create(current_module.outputpath^+res.FPStr,fmCreate);
+              if CStreamError<>0 then
+                begin
+                  Comment(V_Error,'Can''t create resource file: '+dst.FileName);
+                  exit;
+                end;
+              dst.CopyFrom(src,src.Size);
+              dst.Free;
+              src.Free;
+            end;
+        end
+      else
+        begin
+          res.FPStr:=ExtractFileName(res.FPStr);
+          if target_res.rcbin='' then
+            begin
+              { if target does not have .rc to .res compiler, create obj }
+              outfmt:=roOBJ;
+              res.FPStr:=ChangeFileExt(res.FPStr,target_info.resobjext);
+            end
+          else
+            begin
+              outfmt:=roRES;
+              res.FPStr:=ChangeFileExt(res.FPStr,target_info.resext);
+            end;
+          resourcefile.compile(outfmt, current_module.outputpath^+res.FPStr);
+          resourcefile.free;
+        end;
+      res:=TCmdStrListItem(res.Next);
+    end;
 end;
 
 
+procedure CollectResourceFiles;
+var
+  resourcefile : tresourcefile;
+  
+  procedure ProcessModule(u : tmodule);
+  var
+    res : TCmdStrListItem;
+    s   : TCmdStr;
+  begin
+    res:=TCmdStrListItem(u.ResourceFiles.First);
+    while assigned(res) do
+      begin
+        if path_absolute(res.FPStr) then
+          s:=res.FPStr
+        else
+          begin
+            s:=u.path^+res.FPStr;
+            if not FileExists(s,True) then
+              s:=u.outputpath^+res.FPStr;
+          end;
+        resourcefile.Collect(s);
+        res:=TCmdStrListItem(res.Next);
+      end;
+  end;
+  
+var
+  hp : tused_unit;
+  s : TCmdStr;
+begin
+  if (target_info.res=res_none) or (target_res.rcbin='') then
+    exit;
+  s:=main_module.outputpath^+GlobalResName+target_info.resext;
+  resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s));
+  hp:=tused_unit(usedunits.first);
+  while assigned(hp) do
+    begin
+      ProcessModule(hp.u);
+      hp:=tused_unit(hp.next);
+    end;
+  ProcessModule(current_module);
+  { Finish collection }
+  resourcefile.Collect('');
+  resourcefile.free;
+end;
+
 end.

compiler/fppu.pas

@@ -71,12 +71,14 @@ interface
           procedure writederefmap;
           procedure writederefdata;
           procedure writeImportSymbols;
+          procedure writeResources;
           procedure readsourcefiles;
           procedure readloadunit;
           procedure readlinkcontainer(var p:tlinkcontainer);
           procedure readderefmap;
           procedure readderefdata;
           procedure readImportSymbols;
+          procedure readResources;
 {$IFDEF MACRO_DIFF_HINT}
           procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
           procedure writeusedmacros;
@@ -623,6 +625,20 @@ uses
       end;
 
 
+    procedure tppumodule.writeResources;
+      var
+        res : TCmdStrListItem;
+      begin
+        res:=TCmdStrListItem(ResourceFiles.First);
+        while res<>nil do
+          begin
+            ppufile.putstring(res.FPStr);
+            res:=TCmdStrListItem(res.Next);
+          end;
+        ppufile.writeentry(ibresources);
+      end;
+
+
 {$IFDEF MACRO_DIFF_HINT}
 
 {
@@ -876,6 +892,13 @@ uses
       end;
 
 
+    procedure tppumodule.readResources;
+      begin
+        while not ppufile.endofentry do
+          resourcefiles.Insert(ppufile.getstring);
+      end;
+
+
     procedure tppumodule.load_interface;
       var
         b : byte;
@@ -922,6 +945,8 @@ uses
                readderefmap;
              ibderefdata :
                readderefdata;
+             ibresources:
+               readResources;
              ibendinterface :
                break;
            else
@@ -1005,6 +1030,7 @@ uses
          writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
          writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
          writeImportSymbols;
+         writeResources;
          ppufile.do_crc:=true;
 
          { generate implementation deref data, the interface deref data is

compiler/pmodules.pas

@@ -1474,6 +1474,9 @@ implementation
          { create dwarf debuginfo }
          create_dwarf;
 
+         { create global resource file by collecting all resource files }
+         CollectResourceFiles;
+         
          { insert own objectfile }
          insertobjectfile;
 

compiler/ppu.pas

@@ -124,6 +124,7 @@ const
   {implementation/ObjData}
   ibnodetree       = 80;
   ibasmsymbols     = 81;
+  ibresources      = 82;
 
 { unit flags }
   uf_init          = $1;

compiler/systems.pas

@@ -274,8 +274,13 @@ interface
        presinfo = ^tresinfo;
        tresinfo = record
           id      : tres;
+          { Compiler for resource (.rc or .res) to obj }
           resbin  : string[8];
           rescmd  : string[50];
+          { Optional compiler for resource script (.rc) to binary resource (.res). }
+          { If it is not provided resbin and rescmd will be used.                 }
+          rcbin   : string[8];
+          rccmd   : string[50];
           resourcefileclass : TAbstractResourceFileClass;
        end;
 

compiler/systems/i_linux.pas

@@ -31,14 +31,20 @@ unit i_linux;
           (
              id     : res_elf;
              resbin : 'fpcres';
-             rescmd : '-o $OBJ -i $RES'
+             rescmd : '-o $OBJ -i $RES';
+             { cross compiled windres can be used to compile .rc files on linux }
+             rcbin  : 'windres';
+             rccmd  : '--include $INC -O res -o $RES $RC';
           );
 
        res_elf64_info : tresinfo =
           (
              id     : res_elf;
              resbin : 'fpcres';
-             rescmd : '-o $OBJ -i $RES'
+             rescmd : '-o $OBJ -i $RES';
+             { cross compiled windres can be used to compile .rc files on linux }
+             rcbin  : 'windres';
+             rccmd  : '--include $INC -O res -o $RES $RC';
           );
 
        system_i386_linux_info : tsysteminfo =

compiler/systems/t_win.pas

@@ -91,7 +91,7 @@ interface
       end;
 
 
-      TWinResourceFile = class(TResourceFile)
+      TWinResourceFile = class(TWinLikeResourceFile)
         procedure PostProcessResourcefile(const s : ansistring);override;
       end;
 
@@ -110,14 +110,18 @@ implementation
         (
           id     : res_gnu_windres;
           resbin : 'windres';
-          rescmd : '--include $INC -O coff -o $OBJ $RES'
+          rescmd : '--include $INC -O coff -o $OBJ $RES';
+          rcbin  : 'windres';
+          rccmd  : '--include $INC -O res -o $RES $RC';
         );
 
     res_gnu_wince_windres_info : tresinfo =
         (
           id     : res_gnu_wince_windres;
           resbin : 'windres';
-          rescmd : '--include $INC -O coff -o $OBJ $RES'
+          rescmd : '--include $INC -O coff -o $OBJ $RES';
+          rcbin  : 'windres';
+          rccmd  : '--include $INC -O res -o $RES $RC';
         );