Преглед изворни кода

* don't open error file twice but close it first if necessary

git-svn-id: trunk@5340 -
florian пре 18 година
родитељ
комит
d80bfc692d
1 измењених фајлова са 13 додато и 6 уклоњено
  1. 13 6
      compiler/verbose.pas

+ 13 - 6
compiler/verbose.pas

@@ -145,12 +145,19 @@ var
 
 
     procedure SetRedirectFile(const fn:string);
     procedure SetRedirectFile(const fn:string);
       begin
       begin
+        { close old redirection file because FileRedirection is handled in both passes }
+        if status.use_redir then
+          close(status.redirfile);
+
         assign(status.redirfile,fn);
         assign(status.redirfile,fn);
-        {$I-}
-         append(status.redirfile);
-         if ioresult <> 0 then
-          rewrite(status.redirfile);
-        {$I+}
+      {$I-}
+        append(status.redirfile);
+        if ioresult <> 0 then
+          begin
+            assign(status.redirfile,fn);
+            rewrite(status.redirfile);
+          end;
+      {$I+}
         status.use_redir:=(ioresult=0);
         status.use_redir:=(ioresult=0);
       end;
       end;
 
 
@@ -384,7 +391,7 @@ var
            status.currentmodule:=module.modulename^;
            status.currentmodule:=module.modulename^;
            status.currentsource:=module.sourcefiles.get_file_name(current_filepos.fileindex);
            status.currentsource:=module.sourcefiles.get_file_name(current_filepos.fileindex);
            status.currentsourcepath:=module.sourcefiles.get_file_path(current_filepos.fileindex);
            status.currentsourcepath:=module.sourcefiles.get_file_path(current_filepos.fileindex);
-           
+
            { update lastfileidx only if name known PM }
            { update lastfileidx only if name known PM }
            if status.currentsource<>'' then
            if status.currentsource<>'' then
              lastfileidx:=current_filepos.fileindex
              lastfileidx:=current_filepos.fileindex