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

This commit is contained in:
michael 2004-09-08 11:23:30 +00:00
parent bbe6c833f0
commit 41f7fa8c37
8 changed files with 83 additions and 53 deletions

View File

@ -97,8 +97,7 @@ var
status : tcompilerstatus; status : tcompilerstatus;
{ Default Functions } { Default Functions }
procedure def_stop; procedure def_stop(err:longint);
procedure def_halt(i : longint);
Function def_status:boolean; Function def_status:boolean;
Function def_comment(Level:Longint;const s:string):boolean; Function def_comment(Level:Longint;const s:string):boolean;
function def_internalerror(i:longint):boolean; function def_internalerror(i:longint):boolean;
@ -116,8 +115,7 @@ procedure def_gdb_stop(level : longint);
{$endif DEBUG} {$endif DEBUG}
{ Function redirecting for IDE support } { Function redirecting for IDE support }
type type
tstopprocedure = procedure; tstopprocedure = procedure(err:longint);
thaltprocedure = procedure(i : longint);
tstatusfunction = function:boolean; tstatusfunction = function:boolean;
tcommentfunction = function(Level:Longint;const s:string):boolean; tcommentfunction = function(Level:Longint;const s:string):boolean;
tinternalerrorfunction = function(i:longint):boolean; tinternalerrorfunction = function(i:longint):boolean;
@ -130,7 +128,6 @@ type
const const
do_stop : tstopprocedure = {$ifdef FPCPROCVAR}@{$endif}def_stop; 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_status : tstatusfunction = {$ifdef FPCPROCVAR}@{$endif}def_status;
do_comment : tcommentfunction = {$ifdef FPCPROCVAR}@{$endif}def_comment; do_comment : tcommentfunction = {$ifdef FPCPROCVAR}@{$endif}def_comment;
do_internalerror : tinternalerrorfunction = {$ifdef FPCPROCVAR}@{$endif}def_internalerror; do_internalerror : tinternalerrorfunction = {$ifdef FPCPROCVAR}@{$endif}def_internalerror;
@ -188,9 +185,9 @@ end;
****************************************************************************} ****************************************************************************}
{ predefined handler when then compiler stops } { predefined handler when then compiler stops }
procedure def_stop; procedure def_stop(err:longint);
begin begin
Halt(1); Halt(err);
end; end;
{$ifdef DEBUG} {$ifdef DEBUG}
@ -204,10 +201,6 @@ begin
end; end;
{$endif DEBUG} {$endif DEBUG}
procedure def_halt(i : longint);
begin
halt(i);
end;
function def_status:boolean; function def_status:boolean;
begin begin
@ -385,7 +378,10 @@ end;
end. end.
{ {
$Log$ $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 * logs truncated
} }

View File

@ -244,12 +244,12 @@ var
olddo_stop : tstopprocedure; olddo_stop : tstopprocedure;
{$ifdef USEEXCEPT} {$ifdef USEEXCEPT}
procedure RecoverStop; procedure RecoverStop(err:longint);
begin begin
if recoverpospointer<>nil then if recoverpospointer<>nil then
LongJmp(recoverpospointer^,1) LongJmp(recoverpospointer^,1)
else else
Do_Halt(1); Stop(err);
end; end;
{$endif USEEXCEPT} {$endif USEEXCEPT}
@ -326,10 +326,10 @@ begin
CompilerInitedAfterArgs:=true; CompilerInitedAfterArgs:=true;
end; end;
procedure minimal_stop; procedure minimal_stop(err:longint);
begin begin
DoneCompiler; DoneCompiler;
olddo_stop{$ifdef FPCPROCVAR}(){$endif}; olddo_stop{$ifdef FPCPROCVAR}(err){$endif};
end; end;
@ -429,7 +429,10 @@ end;
end. end.
{ {
$Log$ $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) * target netwlibc added (libc is preferred for newer netware versions)
Revision 1.45 2004/06/20 08:55:29 florian Revision 1.45 2004/06/20 08:55:29 florian

View File

@ -588,6 +588,11 @@ implementation
Info : SearchRec; Info : SearchRec;
disk : byte; disk : byte;
begin begin
if F='' then
begin
result:=true;
exit;
end;
{ these operating systems have dos type drives } { these operating systems have dos type drives }
if source_info.system in [system_m68k_atari,system_i386_go32v2, if source_info.system in [system_m68k_atari,system_i386_go32v2,
system_i386_win32,system_i386_os2, system_i386_win32,system_i386_os2,
@ -1211,7 +1216,6 @@ implementation
function FindFilePchar(const f : string;path : pchar;var foundfile:string):boolean; function FindFilePchar(const f : string;path : pchar;var foundfile:string):boolean;
Var Var
flower,
singlepathstring : string; singlepathstring : string;
startpc,pc : pchar; startpc,pc : pchar;
sepch : char; sepch : char;
@ -1786,7 +1790,9 @@ implementation
var var
hs1 : namestr; hs1 : namestr;
hs2 : extstr; hs2 : extstr;
{$ifdef need_path_search}
p : pchar; p : pchar;
{$endif need_path_search}
begin begin
{$ifdef delphi} {$ifdef delphi}
exepath:=dmisc.getenv('PPC_EXEC_PATH'); exepath:=dmisc.getenv('PPC_EXEC_PATH');
@ -1954,7 +1960,10 @@ implementation
end. end.
{ {
$Log$ $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 + support for quoting of paths in TSearchPathList.AddPath so that
compiler directives which take paths, will support quotes. compiler directives which take paths, will support quotes.
* uppdated TranslateMacPath * uppdated TranslateMacPath

View File

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

View File

@ -152,7 +152,7 @@ end;
Toption Toption
****************************************************************************} ****************************************************************************}
procedure StopOptions; procedure StopOptions(err:longint);
begin begin
if assigned(Option) then if assigned(Option) then
begin begin
@ -160,7 +160,7 @@ begin
Option:=nil; Option:=nil;
end; end;
DoneVerbose; DoneVerbose;
Stop; Stop(err);
end; end;
@ -201,7 +201,7 @@ begin
else else
Comment(V_Normal,s); Comment(V_Normal,s);
end; end;
StopOptions; StopOptions(0);
end; end;
@ -321,7 +321,7 @@ begin
Message(option_help_press_enter); Message(option_help_press_enter);
readln(input); readln(input);
if upper(input)='Q' then if upper(input)='Q' then
StopOptions; StopOptions(0);
end; end;
lines:=0; lines:=0;
end; end;
@ -330,7 +330,7 @@ begin
inc(Lines); inc(Lines);
end; end;
end; end;
StopOptions; StopOptions(0);
end; end;
@ -338,7 +338,7 @@ procedure Toption.IllegalPara(const opt:string);
begin begin
Message1(option_illegal_para,opt); Message1(option_illegal_para,opt);
Message(option_help_pages_para); Message(option_help_pages_para);
StopOptions; StopOptions(1);
end; end;
@ -1198,7 +1198,7 @@ begin
'@' : '@' :
begin begin
Message(option_no_nested_response_file); Message(option_no_nested_response_file);
StopOptions; StopOptions(1);
end; end;
else else
@ -1293,7 +1293,7 @@ begin
if Level>=maxlevel then if Level>=maxlevel then
begin begin
Message(option_too_many_ifdef); Message(option_too_many_ifdef);
stopOptions; stopOptions(1);
end; end;
inc(Level); inc(Level);
skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts))))); skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
@ -1305,7 +1305,7 @@ begin
if Level>=maxlevel then if Level>=maxlevel then
begin begin
Message(option_too_many_ifdef); Message(option_too_many_ifdef);
stopOptions; stopOptions(1);
end; end;
inc(Level); inc(Level);
skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts))))); skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
@ -1320,7 +1320,7 @@ begin
if Level=0 then if Level=0 then
begin begin
Message(option_too_many_endif); Message(option_too_many_endif);
stopOptions; stopOptions(1);
end; end;
dec(level); dec(level);
end end
@ -1571,7 +1571,7 @@ begin
if s<>'' then if s<>'' then
begin begin
writeln(s); writeln(s);
stopoptions; stopoptions(1);
end; end;
end; end;
@ -1887,7 +1887,7 @@ begin
{ Stop if errors in options } { Stop if errors in options }
if ErrorCount>0 then if ErrorCount>0 then
StopOptions; StopOptions(1);
{ Non-core target defines } { Non-core target defines }
Option.TargetDefines(true); Option.TargetDefines(true);
@ -1927,7 +1927,7 @@ begin
if param_file='' then if param_file='' then
begin begin
Message(option_no_source_found); Message(option_no_source_found);
StopOptions; StopOptions(1);
end; end;
{$ifndef Unix} {$ifndef Unix}
param_file:=FixFileName(param_file); param_file:=FixFileName(param_file);
@ -1943,6 +1943,14 @@ begin
inputextension:='.p'; inputextension:='.p';
end; 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 } { Add paths specified with parameters to the searchpaths }
UnitSearchPath.AddList(option.ParaUnitPath,true); UnitSearchPath.AddList(option.ParaUnitPath,true);
ObjectSearchPath.AddList(option.ParaObjectPath,true); ObjectSearchPath.AddList(option.ParaObjectPath,true);
@ -2079,7 +2087,10 @@ finalization
end. end.
{ {
$Log$ $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 browser disabled
uf_local_symtable ppu flag when a localsymtable is stored uf_local_symtable ppu flag when a localsymtable is stored

View File

@ -191,9 +191,9 @@ function aout_sym(const name:string;typ,other:byte;desc:word;
begin begin
if aout_str_size+length(name)+1>sizeof(aout_str_tab) then 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 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].strofs:=aout_str_size;
aout_sym_tab[aout_sym_count].typ:=typ; aout_sym_tab[aout_sym_count].typ:=typ;
aout_sym_tab[aout_sym_count].other:=other; aout_sym_tab[aout_sym_count].other:=other;
@ -209,7 +209,7 @@ procedure aout_text_byte(b:byte);
begin begin
if aout_text_size>=sizeof(aout_text) then if aout_text_size>=sizeof(aout_text) then
Do_halt($da); Do_Stop($da);
aout_text[aout_text_size]:=b; aout_text[aout_text_size]:=b;
inc(aout_text_size); inc(aout_text_size);
end; end;
@ -229,7 +229,7 @@ procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
begin begin
if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then 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].address:=address;
aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+ aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
len shl 25+ext shl 27; len shl 25+ext shl 27;
@ -518,7 +518,10 @@ initialization
end. end.
{ {
$Log$ $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 * logs truncated
} }

View File

@ -191,9 +191,9 @@ function aout_sym(const name:string;typ,other:byte;desc:word;
begin begin
if aout_str_size+length(name)+1>sizeof(aout_str_tab) then 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 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].strofs:=aout_str_size;
aout_sym_tab[aout_sym_count].typ:=typ; aout_sym_tab[aout_sym_count].typ:=typ;
aout_sym_tab[aout_sym_count].other:=other; aout_sym_tab[aout_sym_count].other:=other;
@ -209,7 +209,7 @@ procedure aout_text_byte(b:byte);
begin begin
if aout_text_size>=sizeof(aout_text) then if aout_text_size>=sizeof(aout_text) then
Do_halt($da); Stop($da);
aout_text[aout_text_size]:=b; aout_text[aout_text_size]:=b;
inc(aout_text_size); inc(aout_text_size);
end; end;
@ -229,7 +229,7 @@ procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
begin begin
if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then 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].address:=address;
aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+ aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
len shl 25+ext shl 27; len shl 25+ext shl 27;
@ -518,7 +518,10 @@ initialization
end. end.
{ {
$Log$ $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 * logs truncated
} }

View File

@ -78,7 +78,7 @@ interface
function CheckVerbosity(v:longint):boolean; function CheckVerbosity(v:longint):boolean;
procedure SetCompileModule(p:tmodulebase); procedure SetCompileModule(p:tmodulebase);
procedure Stop; procedure Stop(err:longint);
procedure ShowStatus; procedure ShowStatus;
function ErrorCount:longint; function ErrorCount:longint;
procedure SetErrorFlags(const s:string); procedure SetErrorFlags(const s:string);
@ -374,9 +374,9 @@ var
end; end;
procedure stop; procedure stop(err:longint);
begin begin
do_stop{$ifdef FPCPROCVAR}(){$endif}; do_stop(err);
end; end;
@ -384,7 +384,7 @@ var
begin begin
UpdateStatus; UpdateStatus;
if do_status{$ifdef FPCPROCVAR}(){$endif} then if do_status{$ifdef FPCPROCVAR}(){$endif} then
stop; stop(1);
end; end;
@ -443,7 +443,7 @@ var
UpdateStatus; UpdateStatus;
do_internalerror(i); do_internalerror(i);
inc(status.errorcount); inc(status.errorcount);
stop; stop(1);
end; end;
@ -468,12 +468,12 @@ var
DefaultReplacements(s); DefaultReplacements(s);
{ show comment } { show comment }
if do_comment(l,s) or dostop then if do_comment(l,s) or dostop then
stop; stop(1);
if (status.errorcount>=status.maxerrorcount) and not status.skip_error then if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
begin begin
Message1(unit_f_errors_in_unit,tostr(status.errorcount)); Message1(unit_f_errors_in_unit,tostr(status.errorcount));
status.skip_error:=true; status.skip_error:=true;
stop; stop(1);
end; end;
end; end;
@ -559,12 +559,12 @@ var
DefaultReplacements(s); DefaultReplacements(s);
{ show comment } { show comment }
if do_comment(v,s) or dostop then if do_comment(v,s) or dostop then
stop; stop(1);
if (status.errorcount>=status.maxerrorcount) and not status.skip_error then if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
begin begin
Message1(unit_f_errors_in_unit,tostr(status.errorcount)); Message1(unit_f_errors_in_unit,tostr(status.errorcount));
status.skip_error:=true; status.skip_error:=true;
stop; stop(1);
end; end;
end; end;
@ -873,7 +873,10 @@ finalization
end. end.
{ {
$Log$ $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 * logs truncated
Revision 1.31 2004/02/23 15:59:46 peter Revision 1.31 2004/02/23 15:59:46 peter