paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 04:06:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/comphook.pas
View File

@ -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
}

13
compiler/compiler.pas
View File

@ -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

13
compiler/globals.pas
View File

@ -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
compiler/msg/errore.msg
View File

@ -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

39
compiler/options.pas
View File

@ -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

13
compiler/systems/t_emx.pas
View File

@ -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
}

13
compiler/systems/t_os2.pas
View File

@ -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
}

23
compiler/verbose.pas
View File

@ -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