Merged revisions 7515,7624,7825,7827,7841 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r7515 | yury | 2007-05-29 18:51:02 +0300 (Вт, 29 май 2007) | 11 lines
  
  * 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.
........
  r7624 | yury | 2007-06-10 16:04:56 +0300 (Вс, 10 июн 2007) | 1 line
  
  * fixed "EInOutError : File not found" exception if .rc file not found.
........
  r7825 | yury | 2007-06-26 20:41:24 +0300 (Вт, 26 июн 2007) | 3 lines
  
  * Properly handle .res files, which are not fully correct.
  * Better error handling while working with resource files.
  * Compile .rc files included in the main module before collecting all resources.
........
  r7827 | yury | 2007-06-26 21:08:06 +0300 (Вт, 26 июн 2007) | 1 line
  
  * Fixed previous commit: loop through all resources in .res file.
........
  r7841 | yury | 2007-06-28 14:16:51 +0300 (Чт, 28 июн 2007) | 1 line
  
  * Collect resource files only when program or library is compiled.
........

git-svn-id: branches/fixes_2_2@7882 -

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,236 @@ 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 or not FileExists(fn, False) 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);
+
+type
+  TResHeader = packed record
+    DataSize: dword;
+    HeaderSize: dword;
+  end;
+
+var
+  fs: TCFileStream;
+  i, sz: longint;
+  hdr: TResHeader;
+begin
+  if fn='' then
+    begin
+      if FOut<>nil then
+        begin
+          FOut.Free;
+          Compile(roOBJ,ChangeFileExt(fname,target_info.resobjext));
+        end;
+    end
+  else
+    try
+      fs:=TCFileStream.Create(fn,fmOpenRead or fmShareDenyNone);
+      if CStreamError<>0 then
+        begin
+          fs.Free;
+          Comment(V_Error,'Can''t open resource file: '+fn);
+          Include(current_settings.globalswitches, cs_link_nolink);
+          exit;
+        end;
+      if FOut=nil then
+        begin
+          FOut:=TCFileStream.Create(fname,fmCreate);
+          { writing res signature }
+          FOut.CopyFrom(fs, 32);
+        end
+      else
+        fs.Seek(32, soFromBeginning);
+      sz:=fs.Size;
+      repeat
+        fs.ReadBuffer(hdr, SizeOf(hdr));
+        FOut.WriteBuffer(hdr, SizeOf(hdr));
+        i:=hdr.HeaderSize + hdr.DataSize - SizeOf(hdr);
+        if fs.Position + i > sz then
+          begin
+            Comment(V_Error,'Invalid resource file: '+fn);
+            Include(current_settings.globalswitches, cs_link_nolink);
+            fs.Free;
+            exit;
+          end;
+        FOut.CopyFrom(fs, i);
+        { align resource to dword }
+        i:=4 - FOut.Position mod 4;
+        if i<4 then
+          FOut.WriteBuffer(zeroes, i);
+        { position to the next resource }
+        i:=4 - fs.Position mod 4;
+        if i<4 then
+          fs.Seek(i, soFromCurrent);
+      until fs.Position + SizeOf(hdr) >= sz;
+      fs.Free;
+    except
+      on E:EOSError do begin
+        Comment(V_Error,'Error processing resource file: '+fn+': '+E.Message);
+        Include(current_settings.globalswitches, cs_link_nolink);
+      end;
+    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);
+                  Include(current_settings.globalswitches, cs_link_nolink);
+                  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);
+                  Include(current_settings.globalswitches, cs_link_nolink);
+                  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;
+  if cs_link_nolink in current_settings.globalswitches 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;
@@ -624,6 +626,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}
 
 {
@@ -877,6 +893,13 @@ uses
       end;
 
 
+    procedure tppumodule.readResources;
+      begin
+        while not ppufile.endofentry do
+          resourcefiles.Insert(ppufile.getstring);
+      end;
+
+
     procedure tppumodule.load_interface;
       var
         b : byte;
@@ -923,6 +946,8 @@ uses
                readderefmap;
              ibderefdata :
                readderefdata;
+             ibresources:
+               readResources;
              ibendinterface :
                break;
            else
@@ -1006,6 +1031,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

@@ -1502,6 +1502,8 @@ implementation
              { create the executable when we are at level 1 }
              if (compile_level=1) then
                begin
+                 { create global resource file by collecting all resource files }
+                 CollectResourceFiles;
                  { write .def file }
                  if (cs_link_deffile in current_settings.globalswitches) then
                   deffile.writefile;

compiler/ppu.pas

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

compiler/systems.pas

@@ -268,8 +268,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';
         );