verbose.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Peter Vreman
  4. This unit handles the verbose management
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit verbose;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cutils,
  23. globals,finput,
  24. cmsgs;
  25. {$ifndef EXTERN_MSG}
  26. {$i msgtxt.inc}
  27. {$endif}
  28. {$i msgidx.inc}
  29. Const
  30. { Levels }
  31. V_None = $0;
  32. V_Fatal = $1;
  33. V_Error = $2;
  34. V_Normal = $4; { doesn't show a text like Error: }
  35. V_Warning = $8;
  36. V_Note = $10;
  37. V_Hint = $20;
  38. V_LineInfoMask = $fff;
  39. { From here by default no line info }
  40. V_Info = $1000;
  41. V_Status = $2000;
  42. V_Used = $4000;
  43. V_Tried = $8000;
  44. V_Conditional = $10000;
  45. V_Debug = $20000;
  46. V_Executable = $40000;
  47. V_LevelMask = $fffffff;
  48. V_All = V_LevelMask;
  49. V_Default = V_Fatal + V_Error + V_Normal;
  50. { Flags }
  51. V_LineInfo = $10000000;
  52. var
  53. msg : pmessage;
  54. const
  55. msgfilename : string = '';
  56. procedure SetRedirectFile(const fn:string);
  57. function SetVerbosity(const s:string):boolean;
  58. procedure PrepareReport;
  59. function CheckVerbosity(v:longint):boolean;
  60. procedure SetCompileModule(p:tmodulebase);
  61. procedure Stop(err:longint);
  62. procedure ShowStatus;
  63. function ErrorCount:longint;
  64. procedure SetErrorFlags(const s:string);
  65. procedure GenerateError;
  66. procedure Internalerror(i:longint);
  67. procedure Comment(l:longint;s:string);
  68. function MessagePchar(w:longint):pchar;
  69. procedure Message(w:longint);
  70. procedure Message1(w:longint;const s1:string);
  71. procedure Message2(w:longint;const s1,s2:string);
  72. procedure Message3(w:longint;const s1,s2,s3:string);
  73. procedure Message4(w:longint;const s1,s2,s3,s4:string);
  74. procedure MessagePos(const pos:tfileposinfo;w:longint);
  75. procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
  76. procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
  77. procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string);
  78. procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:string);
  79. { message calls with codegenerror support }
  80. procedure cgmessage(t : longint);
  81. procedure cgmessage1(t : longint;const s : string);
  82. procedure cgmessage2(t : longint;const s1,s2 : string);
  83. procedure cgmessage3(t : longint;const s1,s2,s3 : string);
  84. procedure CGMessagePos(const pos:tfileposinfo;t:longint);
  85. procedure CGMessagePos1(const pos:tfileposinfo;t:longint;const s1:string);
  86. procedure CGMessagePos2(const pos:tfileposinfo;t:longint;const s1,s2:string);
  87. procedure CGMessagePos3(const pos:tfileposinfo;t:longint;const s1,s2,s3:string);
  88. procedure InitVerbose;
  89. procedure DoneVerbose;
  90. implementation
  91. uses
  92. comphook;
  93. var
  94. compiling_module : tmodulebase;
  95. {****************************************************************************
  96. Extra Handlers for default compiler
  97. ****************************************************************************}
  98. procedure DoneRedirectFile;
  99. begin
  100. if status.use_redir then
  101. begin
  102. close(status.redirfile);
  103. status.use_redir:=false;
  104. end;
  105. if status.use_bugreport then
  106. begin
  107. close(status.reportbugfile);
  108. status.use_bugreport:=false;
  109. end;
  110. end;
  111. procedure SetRedirectFile(const fn:string);
  112. begin
  113. assign(status.redirfile,fn);
  114. {$I-}
  115. append(status.redirfile);
  116. if ioresult <> 0 then
  117. rewrite(status.redirfile);
  118. {$I+}
  119. status.use_redir:=(ioresult=0);
  120. end;
  121. procedure PrepareReport;
  122. var
  123. fn : string;
  124. begin
  125. if status.use_bugreport then
  126. exit;
  127. fn:='fpcdebug.txt';
  128. assign(status.reportbugfile,fn);
  129. {$I-}
  130. append(status.reportbugfile);
  131. if ioresult <> 0 then
  132. rewrite(status.reportbugfile);
  133. {$I+}
  134. status.use_bugreport:=(ioresult=0);
  135. if status.use_bugreport then
  136. writeln(status.reportbugfile,'FPC bug report file');
  137. end;
  138. function CheckVerbosity(v:longint):boolean;
  139. begin
  140. CheckVerbosity:=status.use_bugreport or
  141. ((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask));
  142. end;
  143. function SetVerbosity(const s:string):boolean;
  144. var
  145. m : Longint;
  146. i : Integer;
  147. inverse : boolean;
  148. c : char;
  149. begin
  150. Setverbosity:=false;
  151. val(s,m,i);
  152. if (i=0) and (s<>'') then
  153. status.verbosity:=m
  154. else
  155. begin
  156. i:=1;
  157. while i<=length(s) do
  158. begin
  159. c:=upcase(s[i]);
  160. inverse:=false;
  161. { on/off ? }
  162. if (i<length(s)) then
  163. case s[i+1] of
  164. '-' : begin
  165. inc(i);
  166. inverse:=true;
  167. end;
  168. '+' : inc(i);
  169. end;
  170. { handle switch }
  171. case c of
  172. { Special cases }
  173. 'A' : status.verbosity:=V_All;
  174. '0' : status.verbosity:=V_Default;
  175. 'P' : begin
  176. if inverse then
  177. paraprintnodetree:=0
  178. else
  179. paraprintnodetree:=1;
  180. end;
  181. 'R' : begin
  182. if inverse then
  183. begin
  184. status.use_gccoutput:=false;
  185. status.use_stderr:=false;
  186. end
  187. else
  188. begin
  189. status.use_gccoutput:=true;
  190. status.use_stderr:=true;
  191. end;
  192. end;
  193. 'Z' : begin
  194. if inverse then
  195. status.use_stderr:=false
  196. else
  197. status.use_stderr:=true;
  198. end;
  199. { Normal cases - do an or }
  200. 'E' : if inverse then
  201. status.verbosity:=status.verbosity and (not V_Error)
  202. else
  203. status.verbosity:=status.verbosity or V_Error;
  204. 'I' : if inverse then
  205. status.verbosity:=status.verbosity and (not V_Info)
  206. else
  207. status.verbosity:=status.verbosity or V_Info;
  208. 'W' : if inverse then
  209. status.verbosity:=status.verbosity and (not V_Warning)
  210. else
  211. status.verbosity:=status.verbosity or V_Warning;
  212. 'N' : if inverse then
  213. status.verbosity:=status.verbosity and (not V_Note)
  214. else
  215. status.verbosity:=status.verbosity or V_Note;
  216. 'H' : if inverse then
  217. status.verbosity:=status.verbosity and (not V_Hint)
  218. else
  219. status.verbosity:=status.verbosity or V_Hint;
  220. 'L' : if inverse then
  221. status.verbosity:=status.verbosity and (not V_Status)
  222. else
  223. status.verbosity:=status.verbosity or V_Status;
  224. 'U' : if inverse then
  225. status.verbosity:=status.verbosity and (not V_Used)
  226. else
  227. status.verbosity:=status.verbosity or V_Used;
  228. 'T' : if inverse then
  229. status.verbosity:=status.verbosity and (not V_Tried)
  230. else
  231. status.verbosity:=status.verbosity or V_Tried;
  232. 'C' : if inverse then
  233. status.verbosity:=status.verbosity and (not V_Conditional)
  234. else
  235. status.verbosity:=status.verbosity or V_Conditional;
  236. 'D' : if inverse then
  237. status.verbosity:=status.verbosity and (not V_Debug)
  238. else
  239. status.verbosity:=status.verbosity or V_Debug;
  240. 'X' : if inverse then
  241. status.verbosity:=status.verbosity and (not V_Executable)
  242. else
  243. status.verbosity:=status.verbosity or V_Executable;
  244. 'V' : PrepareReport;
  245. end;
  246. inc(i);
  247. end;
  248. end;
  249. if status.verbosity=0 then
  250. status.verbosity:=V_Default;
  251. setverbosity:=true;
  252. end;
  253. procedure Loadprefixes;
  254. function loadprefix(w:longint):string;
  255. var
  256. s : string;
  257. idx : longint;
  258. begin
  259. s:=msg^.get(w,[]);
  260. idx:=pos('_',s);
  261. if idx>0 then
  262. Loadprefix:=Copy(s,idx+1,255)
  263. else
  264. Loadprefix:=s;
  265. end;
  266. begin
  267. { Load the prefixes }
  268. fatalstr:=Loadprefix(general_i_fatal);
  269. errorstr:=Loadprefix(general_i_error);
  270. warningstr:=Loadprefix(general_i_warning);
  271. notestr:=Loadprefix(general_i_note);
  272. hintstr:=Loadprefix(general_i_hint);
  273. end;
  274. procedure LoadMsgFile(const fn:string);
  275. begin
  276. { reload the internal messages if not already loaded }
  277. {$ifndef EXTERN_MSG}
  278. if not msg^.msgintern then
  279. msg^.LoadIntern(@msgtxt,msgtxtsize);
  280. {$endif}
  281. if not msg^.LoadExtern(fn) then
  282. begin
  283. {$ifdef EXTERN_MSG}
  284. writeln('Fatal: Cannot find error message file.');
  285. halt(3);
  286. {$else}
  287. msg^.LoadIntern(@msgtxt,msgtxtsize);
  288. {$endif}
  289. end;
  290. { reload the prefixes using the new messages }
  291. Loadprefixes;
  292. end;
  293. procedure MaybeLoadMessageFile;
  294. begin
  295. { Load new message file }
  296. if (msgfilename<>'') then
  297. begin
  298. LoadMsgFile(msgfilename);
  299. msgfilename:='';
  300. end;
  301. end;
  302. procedure SetCompileModule(p:tmodulebase);
  303. begin
  304. compiling_module:=p;
  305. end;
  306. var
  307. lastfileidx,
  308. lastmoduleidx : longint;
  309. Procedure UpdateStatus;
  310. begin
  311. { fix status }
  312. status.currentline:=aktfilepos.line;
  313. status.currentcolumn:=aktfilepos.column;
  314. if assigned(compiling_module) and
  315. assigned(compiling_module.sourcefiles) and
  316. ((compiling_module.unit_index<>lastmoduleidx) or
  317. (aktfilepos.fileindex<>lastfileidx)) then
  318. begin
  319. { update status record }
  320. status.currentmodule:=compiling_module.modulename^;
  321. status.currentsource:=compiling_module.sourcefiles.get_file_name(aktfilepos.fileindex);
  322. status.currentsourcepath:=compiling_module.sourcefiles.get_file_path(aktfilepos.fileindex);
  323. { update lastfileidx only if name known PM }
  324. if status.currentsource<>'' then
  325. lastfileidx:=aktfilepos.fileindex
  326. else
  327. lastfileidx:=0;
  328. lastmoduleidx:=compiling_module.unit_index;
  329. end;
  330. if assigned(compiling_module) then
  331. status.compiling_current:=(compiling_module.state in [ms_compile,ms_second_compile]);
  332. end;
  333. procedure stop(err:longint);
  334. begin
  335. do_stop(err);
  336. end;
  337. procedure ShowStatus;
  338. begin
  339. UpdateStatus;
  340. if do_status() then
  341. stop(1);
  342. end;
  343. function ErrorCount:longint;
  344. begin
  345. ErrorCount:=status.errorcount;
  346. end;
  347. procedure SetErrorFlags(const s:string);
  348. var
  349. code : integer;
  350. i,j,l : longint;
  351. begin
  352. { empty string means error count = 1 for backward compatibility (PFV) }
  353. if s='' then
  354. begin
  355. status.maxerrorcount:=1;
  356. exit;
  357. end;
  358. i:=0;
  359. while (i<length(s)) do
  360. begin
  361. inc(i);
  362. case s[i] of
  363. '0'..'9' :
  364. begin
  365. j:=i;
  366. while (j<=length(s)) and (s[j] in ['0'..'9']) do
  367. inc(j);
  368. val(copy(s,i,j-i),l,code);
  369. if code<>0 then
  370. l:=1;
  371. status.maxerrorcount:=l;
  372. i:=j;
  373. end;
  374. 'w','W' :
  375. status.errorwarning:=true;
  376. 'n','N' :
  377. status.errornote:=true;
  378. 'h','H' :
  379. status.errorhint:=true;
  380. end;
  381. end;
  382. end;
  383. procedure GenerateError;
  384. begin
  385. inc(status.errorcount);
  386. end;
  387. procedure internalerror(i : longint);
  388. begin
  389. UpdateStatus;
  390. do_internalerror(i);
  391. inc(status.errorcount);
  392. stop(1);
  393. end;
  394. procedure Comment(l:longint;s:string);
  395. var
  396. dostop : boolean;
  397. begin
  398. dostop:=((l and V_Fatal)<>0);
  399. if ((l and V_Error)<>0) or
  400. (status.errorwarning and ((l and V_Warning)<>0)) or
  401. (status.errornote and ((l and V_Note)<>0)) or
  402. (status.errorhint and ((l and V_Hint)<>0)) then
  403. inc(status.errorcount);
  404. { check verbosity level }
  405. if not CheckVerbosity(l) then
  406. exit;
  407. if (l and V_LineInfoMask)<>0 then
  408. l:=l or V_LineInfo;
  409. { Create status info }
  410. UpdateStatus;
  411. { Fix replacements }
  412. DefaultReplacements(s);
  413. { show comment }
  414. if do_comment(l,s) or dostop then
  415. stop(1);
  416. if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
  417. begin
  418. Message1(unit_f_errors_in_unit,tostr(status.errorcount));
  419. status.skip_error:=true;
  420. stop(1);
  421. end;
  422. end;
  423. Procedure Msg2Comment(s:string);
  424. var
  425. idx,i,v : longint;
  426. dostop : boolean;
  427. begin
  428. {Reset}
  429. dostop:=false;
  430. v:=0;
  431. {Parse options}
  432. idx:=pos('_',s);
  433. if idx=0 then
  434. v:=V_Normal
  435. else
  436. if (idx >= 1) And (idx <= 5) then
  437. begin
  438. for i:=1 to idx do
  439. begin
  440. case upcase(s[i]) of
  441. 'F' :
  442. begin
  443. v:=v or V_Fatal;
  444. inc(status.errorcount);
  445. dostop:=true;
  446. end;
  447. 'E' :
  448. begin
  449. v:=v or V_Error;
  450. inc(status.errorcount);
  451. end;
  452. 'O' :
  453. v:=v or V_Normal;
  454. 'W':
  455. begin
  456. v:=v or V_Warning;
  457. if status.errorwarning then
  458. inc(status.errorcount);
  459. end;
  460. 'N' :
  461. begin
  462. v:=v or V_Note;
  463. if status.errornote then
  464. inc(status.errorcount);
  465. end;
  466. 'H' :
  467. begin
  468. v:=v or V_Hint;
  469. if status.errorhint then
  470. inc(status.errorcount);
  471. end;
  472. 'I' :
  473. v:=v or V_Info;
  474. 'L' :
  475. v:=v or V_LineInfo;
  476. 'U' :
  477. v:=v or V_Used;
  478. 'T' :
  479. v:=v or V_Tried;
  480. 'C' :
  481. v:=v or V_Conditional;
  482. 'D' :
  483. v:=v or V_Debug;
  484. 'X' :
  485. v:=v or V_Executable;
  486. 'S' :
  487. dostop:=true;
  488. '_' : ;
  489. end;
  490. end;
  491. end;
  492. Delete(s,1,idx);
  493. { check verbosity level }
  494. if not CheckVerbosity(v) then
  495. exit;
  496. if (v and V_LineInfoMask)<>0 then
  497. v:=v or V_LineInfo;
  498. { fix status }
  499. UpdateStatus;
  500. { Fix replacements }
  501. DefaultReplacements(s);
  502. { show comment }
  503. if do_comment(v,s) or dostop then
  504. stop(1);
  505. if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
  506. begin
  507. Message1(unit_f_errors_in_unit,tostr(status.errorcount));
  508. status.skip_error:=true;
  509. stop(1);
  510. end;
  511. end;
  512. function MessagePchar(w:longint):pchar;
  513. begin
  514. MaybeLoadMessageFile;
  515. MessagePchar:=msg^.GetPchar(w)
  516. end;
  517. procedure Message(w:longint);
  518. begin
  519. MaybeLoadMessageFile;
  520. Msg2Comment(msg^.Get(w,[]));
  521. end;
  522. procedure Message1(w:longint;const s1:string);
  523. {$ifdef ver1_0}
  524. var
  525. hs1 : string;
  526. {$endif ver1_0}
  527. begin
  528. MaybeLoadMessageFile;
  529. {$ifdef ver1_0}
  530. { 1.0.x is broken, it uses concatcopy instead of shortstring
  531. copy when passing array of shortstring. (PFV) }
  532. hs1:=s1;
  533. Msg2Comment(msg^.Get(w,[hs1]));
  534. {$else ver1_0}
  535. Msg2Comment(msg^.Get(w,[s1]));
  536. {$endif ver1_0}
  537. end;
  538. procedure Message2(w:longint;const s1,s2:string);
  539. {$ifdef ver1_0}
  540. var
  541. hs1,hs2 : string;
  542. {$endif ver1_0}
  543. begin
  544. MaybeLoadMessageFile;
  545. {$ifdef ver1_0}
  546. { 1.0.x is broken, it uses concatcopy instead of shortstring
  547. copy when passing array of shortstring. (PFV) }
  548. hs1:=s1;
  549. hs2:=s2;
  550. Msg2Comment(msg^.Get(w,[hs1,hs2]));
  551. {$else ver1_0}
  552. Msg2Comment(msg^.Get(w,[s1,s2]));
  553. {$endif ver1_0}
  554. end;
  555. procedure Message3(w:longint;const s1,s2,s3:string);
  556. {$ifdef ver1_0}
  557. var
  558. hs1,hs2,hs3 : string;
  559. {$endif ver1_0}
  560. begin
  561. MaybeLoadMessageFile;
  562. {$ifdef ver1_0}
  563. { 1.0.x is broken, it uses concatcopy instead of shortstring
  564. copy when passing array of shortstring. (PFV) }
  565. hs1:=s1;
  566. hs2:=s2;
  567. hs3:=s3;
  568. Msg2Comment(msg^.Get(w,[hs1,hs2,hs3]));
  569. {$else ver1_0}
  570. Msg2Comment(msg^.Get(w,[s1,s2,s3]));
  571. {$endif ver1_0}
  572. end;
  573. procedure Message4(w:longint;const s1,s2,s3,s4:string);
  574. {$ifdef ver1_0}
  575. var
  576. hs1,hs2,hs3,hs4 : string;
  577. {$endif ver1_0}
  578. begin
  579. MaybeLoadMessageFile;
  580. {$ifdef ver1_0}
  581. { 1.0.x is broken, it uses concatcopy instead of shortstring
  582. copy when passing array of shortstring. (PFV) }
  583. hs1:=s1;
  584. hs2:=s2;
  585. hs3:=s3;
  586. hs4:=s4;
  587. Msg2Comment(msg^.Get(w,[hs1,hs2,hs3,hs4]));
  588. {$else ver1_0}
  589. Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]));
  590. {$endif ver1_0}
  591. end;
  592. procedure MessagePos(const pos:tfileposinfo;w:longint);
  593. var
  594. oldpos : tfileposinfo;
  595. begin
  596. oldpos:=aktfilepos;
  597. aktfilepos:=pos;
  598. MaybeLoadMessageFile;
  599. Msg2Comment(msg^.Get(w,[]));
  600. aktfilepos:=oldpos;
  601. end;
  602. procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
  603. var
  604. oldpos : tfileposinfo;
  605. begin
  606. oldpos:=aktfilepos;
  607. aktfilepos:=pos;
  608. MaybeLoadMessageFile;
  609. Msg2Comment(msg^.Get(w,[s1]));
  610. aktfilepos:=oldpos;
  611. end;
  612. procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
  613. var
  614. oldpos : tfileposinfo;
  615. begin
  616. oldpos:=aktfilepos;
  617. aktfilepos:=pos;
  618. MaybeLoadMessageFile;
  619. Msg2Comment(msg^.Get(w,[s1,s2]));
  620. aktfilepos:=oldpos;
  621. end;
  622. procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string);
  623. var
  624. oldpos : tfileposinfo;
  625. begin
  626. oldpos:=aktfilepos;
  627. aktfilepos:=pos;
  628. MaybeLoadMessageFile;
  629. Msg2Comment(msg^.Get(w,[s1,s2,s3]));
  630. aktfilepos:=oldpos;
  631. end;
  632. procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:string);
  633. var
  634. oldpos : tfileposinfo;
  635. begin
  636. oldpos:=aktfilepos;
  637. aktfilepos:=pos;
  638. MaybeLoadMessageFile;
  639. Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]));
  640. aktfilepos:=oldpos;
  641. end;
  642. {*****************************************************************************
  643. override the message calls to set codegenerror
  644. *****************************************************************************}
  645. procedure cgmessage(t : longint);
  646. var
  647. olderrorcount : longint;
  648. begin
  649. if not(codegenerror) then
  650. begin
  651. olderrorcount:=Errorcount;
  652. verbose.Message(t);
  653. codegenerror:=olderrorcount<>Errorcount;
  654. end;
  655. end;
  656. procedure cgmessage1(t : longint;const s : string);
  657. var
  658. olderrorcount : longint;
  659. begin
  660. if not(codegenerror) then
  661. begin
  662. olderrorcount:=Errorcount;
  663. verbose.Message1(t,s);
  664. codegenerror:=olderrorcount<>Errorcount;
  665. end;
  666. end;
  667. procedure cgmessage2(t : longint;const s1,s2 : string);
  668. var
  669. olderrorcount : longint;
  670. begin
  671. if not(codegenerror) then
  672. begin
  673. olderrorcount:=Errorcount;
  674. verbose.Message2(t,s1,s2);
  675. codegenerror:=olderrorcount<>Errorcount;
  676. end;
  677. end;
  678. procedure cgmessage3(t : longint;const s1,s2,s3 : string);
  679. var
  680. olderrorcount : longint;
  681. begin
  682. if not(codegenerror) then
  683. begin
  684. olderrorcount:=Errorcount;
  685. verbose.Message3(t,s1,s2,s3);
  686. codegenerror:=olderrorcount<>Errorcount;
  687. end;
  688. end;
  689. procedure cgmessagepos(const pos:tfileposinfo;t : longint);
  690. var
  691. olderrorcount : longint;
  692. begin
  693. if not(codegenerror) then
  694. begin
  695. olderrorcount:=Errorcount;
  696. verbose.MessagePos(pos,t);
  697. codegenerror:=olderrorcount<>Errorcount;
  698. end;
  699. end;
  700. procedure cgmessagepos1(const pos:tfileposinfo;t : longint;const s1 : string);
  701. var
  702. olderrorcount : longint;
  703. begin
  704. if not(codegenerror) then
  705. begin
  706. olderrorcount:=Errorcount;
  707. verbose.MessagePos1(pos,t,s1);
  708. codegenerror:=olderrorcount<>Errorcount;
  709. end;
  710. end;
  711. procedure cgmessagepos2(const pos:tfileposinfo;t : longint;const s1,s2 : string);
  712. var
  713. olderrorcount : longint;
  714. begin
  715. if not(codegenerror) then
  716. begin
  717. olderrorcount:=Errorcount;
  718. verbose.MessagePos2(pos,t,s1,s2);
  719. codegenerror:=olderrorcount<>Errorcount;
  720. end;
  721. end;
  722. procedure cgmessagepos3(const pos:tfileposinfo;t : longint;const s1,s2,s3 : string);
  723. var
  724. olderrorcount : longint;
  725. begin
  726. if not(codegenerror) then
  727. begin
  728. olderrorcount:=Errorcount;
  729. verbose.MessagePos3(pos,t,s1,s2,s3);
  730. codegenerror:=olderrorcount<>Errorcount;
  731. end;
  732. end;
  733. {*****************************************************************************
  734. Initialization
  735. *****************************************************************************}
  736. procedure InitVerbose;
  737. begin
  738. { Init }
  739. msg:=new(pmessage,Init(20,msgidxmax));
  740. if msg=nil then
  741. begin
  742. writeln('Fatal: MsgIdx Wrong');
  743. halt(3);
  744. end;
  745. {$ifndef EXTERN_MSG}
  746. msg^.LoadIntern(@msgtxt,msgtxtsize);
  747. {$else EXTERN_MSG}
  748. LoadMsgFile(exepath+'errore.msg');
  749. {$endif EXTERN_MSG}
  750. FillChar(Status,sizeof(TCompilerStatus),0);
  751. status.verbosity:=V_Default;
  752. Status.MaxErrorCount:=50;
  753. Loadprefixes;
  754. lastfileidx:=-1;
  755. lastmoduleidx:=-1;
  756. status.currentmodule:='';
  757. status.currentsource:='';
  758. status.currentsourcepath:='';
  759. status.compiling_current:=false;
  760. compiling_module:=nil;
  761. { Register internalerrorproc for cutils/cclasses }
  762. internalerrorproc:=@internalerror;
  763. end;
  764. procedure DoneVerbose;
  765. begin
  766. if assigned(msg) then
  767. begin
  768. dispose(msg,Done);
  769. msg:=nil;
  770. end;
  771. DoneRedirectFile;
  772. end;
  773. initialization
  774. finalization
  775. { Be sure to close the redirect files to flush all data }
  776. DoneRedirectFile;
  777. end.
  778. {
  779. $Log$
  780. Revision 1.37 2005-02-07 17:25:28 peter
  781. -vz for output to stderr
  782. Revision 1.36 2005/01/20 17:29:07 peter
  783. * fixed -vv
  784. Revision 1.35 2004/11/15 23:35:31 peter
  785. * tparaitem removed, use tparavarsym instead
  786. * parameter order is now calculated from paranr value in tparavarsym
  787. Revision 1.34 2004/10/15 09:14:17 mazen
  788. - remove $IFDEF DELPHI and related code
  789. - remove $IFDEF FPCPROCVAR and related code
  790. Revision 1.33 2004/09/08 11:23:31 michael
  791. + Check if outputdir exists, Fix exitcode when displaying help pages
  792. Revision 1.32 2004/06/20 08:55:30 florian
  793. * logs truncated
  794. Revision 1.31 2004/02/23 15:59:46 peter
  795. * fix crashes with 1.0.x
  796. Revision 1.30 2004/02/20 19:49:21 daniel
  797. * Message system uses open arrays internally
  798. * Bugfix for string handling in array constructor node
  799. * Micro code reductions in pdecl.pas
  800. Revision 1.29 2004/02/15 12:17:59 peter
  801. * reset compiling_module, fixes crash in ide with second compile
  802. }