ソースを参照

+ Check if outputdir exists, Fix exitcode when displaying help pages

michael 21 年 前
コミット
41f7fa8c37

+ 8 - 12
compiler/comphook.pas

@@ -97,8 +97,7 @@ var
   status : tcompilerstatus;
 
 { Default Functions }
-procedure def_stop;
-procedure def_halt(i : longint);
+procedure def_stop(err:longint);
 Function  def_status:boolean;
 Function  def_comment(Level:Longint;const s:string):boolean;
 function  def_internalerror(i:longint):boolean;
@@ -116,8 +115,7 @@ procedure def_gdb_stop(level : longint);
 {$endif DEBUG}
 { Function redirecting for IDE support }
 type
-  tstopprocedure         = procedure;
-  thaltprocedure         = procedure(i : longint);
+  tstopprocedure         = procedure(err:longint);
   tstatusfunction        = function:boolean;
   tcommentfunction       = function(Level:Longint;const s:string):boolean;
   tinternalerrorfunction = function(i:longint):boolean;
@@ -130,7 +128,6 @@ type
 
 const
   do_stop          : tstopprocedure   = {$ifdef FPCPROCVAR}@{$endif}def_stop;
-  do_halt          : thaltprocedure   = {$ifdef FPCPROCVAR}@{$endif}def_halt;
   do_status        : tstatusfunction  = {$ifdef FPCPROCVAR}@{$endif}def_status;
   do_comment       : tcommentfunction = {$ifdef FPCPROCVAR}@{$endif}def_comment;
   do_internalerror : tinternalerrorfunction = {$ifdef FPCPROCVAR}@{$endif}def_internalerror;
@@ -188,9 +185,9 @@ end;
 ****************************************************************************}
 
 { predefined handler when then compiler stops }
-procedure def_stop;
+procedure def_stop(err:longint);
 begin
-  Halt(1);
+  Halt(err);
 end;
 
 {$ifdef DEBUG}
@@ -204,10 +201,6 @@ begin
 end;
 {$endif DEBUG}
 
-procedure def_halt(i : longint);
-begin
-  halt(i);
-end;
 
 function def_status:boolean;
 begin
@@ -385,7 +378,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.27  2004-06-20 08:55:29  florian
+  Revision 1.28  2004-09-08 11:23:30  michael
+  + Check if outputdir exists,  Fix exitcode when displaying help pages
+
+  Revision 1.27  2004/06/20 08:55:29  florian
     * logs truncated
 
 }

+ 8 - 5
compiler/compiler.pas

@@ -244,12 +244,12 @@ var
   olddo_stop : tstopprocedure;
 
 {$ifdef USEEXCEPT}
-procedure RecoverStop;
+procedure RecoverStop(err:longint);
 begin
   if recoverpospointer<>nil then
     LongJmp(recoverpospointer^,1)
   else
-    Do_Halt(1);
+    Stop(err);
 end;
 {$endif USEEXCEPT}
 
@@ -326,10 +326,10 @@ begin
   CompilerInitedAfterArgs:=true;
 end;
 
-procedure minimal_stop;
+procedure minimal_stop(err:longint);
 begin
   DoneCompiler;
-  olddo_stop{$ifdef FPCPROCVAR}(){$endif};
+  olddo_stop{$ifdef FPCPROCVAR}(err){$endif};
 end;
 
 
@@ -429,7 +429,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.46  2004-09-04 21:18:47  armin
+  Revision 1.47  2004-09-08 11:23:31  michael
+  + Check if outputdir exists,  Fix exitcode when displaying help pages
+
+  Revision 1.46  2004/09/04 21:18:47  armin
   * target netwlibc added (libc is preferred for newer netware versions)
 
   Revision 1.45  2004/06/20 08:55:29  florian

+ 11 - 2
compiler/globals.pas

@@ -588,6 +588,11 @@ implementation
         Info : SearchRec;
         disk : byte;
       begin
+        if F='' then
+          begin
+            result:=true;
+            exit;
+          end;
         { these operating systems have dos type drives }
         if source_info.system in [system_m68k_atari,system_i386_go32v2,
                                   system_i386_win32,system_i386_os2,
@@ -1211,7 +1216,6 @@ implementation
 
    function FindFilePchar(const f : string;path : pchar;var foundfile:string):boolean;
       Var
-        flower,
         singlepathstring : string;
         startpc,pc : pchar;
         sepch : char;
@@ -1786,7 +1790,9 @@ implementation
      var
        hs1 : namestr;
        hs2 : extstr;
+{$ifdef need_path_search}
        p   : pchar;
+{$endif need_path_search}
      begin
 {$ifdef delphi}
        exepath:=dmisc.getenv('PPC_EXEC_PATH');
@@ -1954,7 +1960,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.137  2004-08-31 22:02:30  olle
+  Revision 1.138  2004-09-08 11:23:31  michael
+  + Check if outputdir exists,  Fix exitcode when displaying help pages
+
+  Revision 1.137  2004/08/31 22:02:30  olle
     + support for quoting of paths in TSearchPathList.AddPath so that
       compiler directives which take paths, will support quotes.
     * uppdated TranslateMacPath

+ 2 - 0
compiler/msg/errore.msg

@@ -110,6 +110,8 @@ general_i_note=01015_I_Note:
 % Prefix for Notes
 general_i_hint=01016_I_Hint:
 % Prefix for Hints
+general_e_path_does_not_exists=01017_E_Path "$1" does not exists
+% The specified path does not exists.
 % \end{description}
 #
 # Scanner

+ 25 - 14
compiler/options.pas

@@ -152,7 +152,7 @@ end;
                                  Toption
 ****************************************************************************}
 
-procedure StopOptions;
+procedure StopOptions(err:longint);
 begin
   if assigned(Option) then
    begin
@@ -160,7 +160,7 @@ begin
      Option:=nil;
    end;
   DoneVerbose;
-  Stop;
+  Stop(err);
 end;
 
 
@@ -201,7 +201,7 @@ begin
      else
       Comment(V_Normal,s);
    end;
-  StopOptions;
+  StopOptions(0);
 end;
 
 
@@ -321,7 +321,7 @@ begin
               Message(option_help_press_enter);
               readln(input);
               if upper(input)='Q' then
-               StopOptions;
+               StopOptions(0);
             end;
            lines:=0;
          end;
@@ -330,7 +330,7 @@ begin
         inc(Lines);
       end;
    end;
-  StopOptions;
+  StopOptions(0);
 end;
 
 
@@ -338,7 +338,7 @@ procedure Toption.IllegalPara(const opt:string);
 begin
   Message1(option_illegal_para,opt);
   Message(option_help_pages_para);
-  StopOptions;
+  StopOptions(1);
 end;
 
 
@@ -1198,7 +1198,7 @@ begin
     '@' :
       begin
         Message(option_no_nested_response_file);
-        StopOptions;
+        StopOptions(1);
       end;
 
     else
@@ -1293,7 +1293,7 @@ begin
                if Level>=maxlevel then
                 begin
                   Message(option_too_many_ifdef);
-                  stopOptions;
+                  stopOptions(1);
                 end;
                inc(Level);
                skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
@@ -1305,7 +1305,7 @@ begin
                if Level>=maxlevel then
                 begin
                   Message(option_too_many_ifdef);
-                  stopOptions;
+                  stopOptions(1);
                 end;
                inc(Level);
                skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
@@ -1320,7 +1320,7 @@ begin
                if Level=0 then
                 begin
                   Message(option_too_many_endif);
-                  stopOptions;
+                  stopOptions(1);
                 end;
                dec(level);
              end
@@ -1571,7 +1571,7 @@ begin
   if s<>'' then
    begin
      writeln(s);
-     stopoptions;
+     stopoptions(1);
    end;
 end;
 
@@ -1887,7 +1887,7 @@ begin
 
 { Stop if errors in options }
   if ErrorCount>0 then
-   StopOptions;
+   StopOptions(1);
 
   { Non-core target defines }
   Option.TargetDefines(true);
@@ -1927,7 +1927,7 @@ begin
   if param_file='' then
    begin
      Message(option_no_source_found);
-     StopOptions;
+     StopOptions(1);
    end;
 {$ifndef Unix}
   param_file:=FixFileName(param_file);
@@ -1943,6 +1943,14 @@ begin
        inputextension:='.p';
    end;
 
+  { Check output dir }
+  if (OutputExeDir<>'') and
+     not PathExists(OutputExeDir) then
+    begin
+      Message1(general_e_path_does_not_exists,OutputExeDir);
+      StopOptions(1);
+    end;
+
   { Add paths specified with parameters to the searchpaths }
   UnitSearchPath.AddList(option.ParaUnitPath,true);
   ObjectSearchPath.AddList(option.ParaObjectPath,true);
@@ -2079,7 +2087,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.139  2004-08-27 21:59:26  peter
+  Revision 1.140  2004-09-08 11:23:31  michael
+  + Check if outputdir exists,  Fix exitcode when displaying help pages
+
+  Revision 1.139  2004/08/27 21:59:26  peter
   browser disabled
   uf_local_symtable ppu flag when a localsymtable is stored
 

+ 8 - 5
compiler/systems/t_emx.pas

@@ -191,9 +191,9 @@ function aout_sym(const name:string;typ,other:byte;desc:word;
 
 begin
     if aout_str_size+length(name)+1>sizeof(aout_str_tab) then
-        Do_halt($da);
+        Do_Stop($da);
     if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
-        Do_halt($da);
+        Do_Stop($da);
     aout_sym_tab[aout_sym_count].strofs:=aout_str_size;
     aout_sym_tab[aout_sym_count].typ:=typ;
     aout_sym_tab[aout_sym_count].other:=other;
@@ -209,7 +209,7 @@ procedure aout_text_byte(b:byte);
 
 begin
     if aout_text_size>=sizeof(aout_text) then
-        Do_halt($da);
+        Do_Stop($da);
     aout_text[aout_text_size]:=b;
     inc(aout_text_size);
 end;
@@ -229,7 +229,7 @@ procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
 
 begin
     if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then
-        Do_halt($da);
+        Do_Stop($da);
     aout_treloc_tab[aout_treloc_count].address:=address;
     aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
      len shl 25+ext shl 27;
@@ -518,7 +518,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.4  2004-06-20 08:55:32  florian
+  Revision 1.5  2004-09-08 11:23:31  michael
+  + Check if outputdir exists,  Fix exitcode when displaying help pages
+
+  Revision 1.4  2004/06/20 08:55:32  florian
     * logs truncated
 
 }

+ 8 - 5
compiler/systems/t_os2.pas

@@ -191,9 +191,9 @@ function aout_sym(const name:string;typ,other:byte;desc:word;
 
 begin
     if aout_str_size+length(name)+1>sizeof(aout_str_tab) then
-        Do_halt($da);
+        Stop($da);
     if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
-        Do_halt($da);
+        Stop($da);
     aout_sym_tab[aout_sym_count].strofs:=aout_str_size;
     aout_sym_tab[aout_sym_count].typ:=typ;
     aout_sym_tab[aout_sym_count].other:=other;
@@ -209,7 +209,7 @@ procedure aout_text_byte(b:byte);
 
 begin
     if aout_text_size>=sizeof(aout_text) then
-        Do_halt($da);
+        Stop($da);
     aout_text[aout_text_size]:=b;
     inc(aout_text_size);
 end;
@@ -229,7 +229,7 @@ procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
 
 begin
     if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then
-        Do_halt($da);
+        Stop($da);
     aout_treloc_tab[aout_treloc_count].address:=address;
     aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
      len shl 25+ext shl 27;
@@ -518,7 +518,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.8  2004-06-20 08:55:32  florian
+  Revision 1.9  2004-09-08 11:23:31  michael
+  + Check if outputdir exists,  Fix exitcode when displaying help pages
+
+  Revision 1.8  2004/06/20 08:55:32  florian
     * logs truncated
 
 }

+ 13 - 10
compiler/verbose.pas

@@ -78,7 +78,7 @@ interface
 
     function  CheckVerbosity(v:longint):boolean;
     procedure SetCompileModule(p:tmodulebase);
-    procedure Stop;
+    procedure Stop(err:longint);
     procedure ShowStatus;
     function  ErrorCount:longint;
     procedure SetErrorFlags(const s:string);
@@ -374,9 +374,9 @@ var
       end;
 
 
-    procedure stop;
+    procedure stop(err:longint);
       begin
-        do_stop{$ifdef FPCPROCVAR}(){$endif};
+        do_stop(err);
       end;
 
 
@@ -384,7 +384,7 @@ var
       begin
         UpdateStatus;
         if do_status{$ifdef FPCPROCVAR}(){$endif} then
-         stop;
+         stop(1);
       end;
 
 
@@ -443,7 +443,7 @@ var
         UpdateStatus;
         do_internalerror(i);
         inc(status.errorcount);
-        stop;
+        stop(1);
       end;
 
 
@@ -468,12 +468,12 @@ var
         DefaultReplacements(s);
       { show comment }
         if do_comment(l,s) or dostop then
-         stop;
+         stop(1);
         if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(status.errorcount));
            status.skip_error:=true;
-           stop;
+           stop(1);
          end;
       end;
 
@@ -559,12 +559,12 @@ var
         DefaultReplacements(s);
       { show comment }
         if do_comment(v,s) or dostop then
-         stop;
+         stop(1);
         if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
          begin
            Message1(unit_f_errors_in_unit,tostr(status.errorcount));
            status.skip_error:=true;
-           stop;
+           stop(1);
          end;
       end;
 
@@ -873,7 +873,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.32  2004-06-20 08:55:30  florian
+  Revision 1.33  2004-09-08 11:23:31  michael
+  + Check if outputdir exists,  Fix exitcode when displaying help pages
+
+  Revision 1.32  2004/06/20 08:55:30  florian
     * logs truncated
 
   Revision 1.31  2004/02/23 15:59:46  peter