+ support for setting the name of "main" (-XM command line parameter) in

the code using {$pascalmainname x} + storing it in the ppu file
    (and give a warning if it's overridden multiple times + test)

git-svn-id: trunk@10406 -
This commit is contained in:
Jonas Maebe 2008-03-01 13:05:01 +00:00
parent e1ec2834df
commit 86f90d8ac1
11 changed files with 475 additions and 406 deletions

2
.gitattributes vendored
View File

@ -7307,6 +7307,7 @@ tests/test/tmacpas3.pp svneol=native#text/plain
tests/test/tmacpas4.pp svneol=native#text/plain
tests/test/tmacpas5.pp svneol=native#text/plain
tests/test/tmacprocvar.pp svneol=native#text/plain
tests/test/tmainnam.pp svneol=native#text/plain
tests/test/tmath1.pp svneol=native#text/plain
tests/test/tmcbool2.pp svneol=native#text/plain
tests/test/tmmx1.pp svneol=native#text/plain
@ -7470,6 +7471,7 @@ tests/test/uimpluni2.pp svneol=native#text/plain
tests/test/uinline4a.pp svneol=native#text/plain
tests/test/uinline4b.pp svneol=native#text/plain
tests/test/umacpas1.pp svneol=native#text/plain
tests/test/umainnam.pp svneol=native#text/plain
tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
tests/test/units/crt/tcrt.pp svneol=native#text/plain
tests/test/units/crt/tctrlc.pp svneol=native#text/plain

View File

@ -146,6 +146,7 @@ interface
linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
linkotherstaticlibs,
linkotherframeworks : tlinkcontainer;
mainname : pshortstring; { alternate name for "main" procedure }
used_units : tlinkedlist;
dependent_units : tlinkedlist;
@ -469,6 +470,7 @@ implementation
linkotherstaticlibs:=TLinkContainer.Create;
linkothersharedlibs:=TLinkContainer.Create;
linkotherframeworks:=TLinkContainer.Create;
mainname:=nil;
FImportLibraryList:=TFPHashObjectList.Create(true);
crc:=0;
interface_crc:=0;
@ -564,6 +566,7 @@ implementation
linkotherstaticlibs.Free;
linkothersharedlibs.Free;
linkotherframeworks.Free;
stringdispose(mainname);
FImportLibraryList.Free;
stringdispose(objfilename);
stringdispose(asmfilename);
@ -708,6 +711,7 @@ implementation
linkothersharedlibs:=TLinkContainer.Create;
linkotherframeworks.Free;
linkotherframeworks:=TLinkContainer.Create;
stringdispose(mainname);
FImportLibraryList.Free;
FImportLibraryList:=TFPHashObjectList.Create;
do_compile:=false;

View File

@ -944,6 +944,13 @@ uses
readlinkcontainer(LinkotherSharedLibs);
iblinkotherframeworks :
readlinkcontainer(LinkOtherFrameworks);
ibmainname:
begin
mainname:=stringdup(ppufile.getstring);
if (mainaliasname<>defaultmainaliasname) then
Message1(scan_w_multiple_main_name_overrides,mainaliasname);
mainaliasname:=mainname^;
end;
ibImportSymbols :
readImportSymbols;
ibderefmap :
@ -1013,6 +1020,13 @@ uses
ppufile.putstring(realmodulename^);
ppufile.writeentry(ibmodulename);
{ write the alternate main procedure name if any }
if assigned(mainname) then
begin
ppufile.putstring(mainname^);
ppufile.writeentry(ibmainname);
end;
writesourcefiles;
{$IFDEF MACRO_DIFF_HINT}
writeusedmacros;

View File

@ -299,7 +299,8 @@ interface
{ default name of the C-style "main" procedure of the library/program }
{ (this will be prefixed with the target_info.cprefix) }
mainaliasname : string = 'main';
defaultmainaliasname = 'main';
mainaliasname : string = defaultmainaliasname;
{ by default no local variable trashing }
localvartrashing: longint = -1;

View File

@ -124,7 +124,7 @@ general_i_number_of_notes=01023_I_$1 note(s) issued
#
# Scanner
#
# 02085 is the last used one
# 02086 is the last used one
#
% \section{Scanner messages.}
% This section lists the messages that the scanner emits. The scanner takes
@ -353,6 +353,7 @@ scan_w_frameworks_darwin_only=02084_W_Framework-related options are only support
% Frameworks are not a known concept, or at least not supported by FPC, on operating systems other than Darwin/Mac OS X.
scan_e_illegal_minfpconstprec=02085_E_Illegal minimal floating point constant precision "$1"
% Valid minimal precisions for floating point constants are default, 32 and 64, which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision.
scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure multiple times, was previously set to "$1"
% \end{description}
#
# Parser

View File

@ -105,6 +105,7 @@ const
scan_w_unsupported_switch_by_target=02082;
scan_w_frameworks_darwin_only=02084;
scan_e_illegal_minfpconstprec=02085;
scan_w_multiple_main_name_overrides=02086;
parser_e_syntax_error=03000;
parser_e_dont_nest_interrupt=03004;
parser_w_proc_directive_ignored=03005;
@ -741,9 +742,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 45996;
MsgTxtSize = 46084;
MsgIdxMax : array[1..20] of longint=(
24,86,244,84,64,50,108,22,135,60,
24,87,244,84,64,50,108,22,135,60,
42,1,1,1,1,1,1,1,1,1
);

File diff suppressed because it is too large Load Diff

View File

@ -126,6 +126,8 @@ const
ibnodetree = 80;
ibasmsymbols = 81;
ibresources = 82;
ibmainname = 90;
{ target-specific things }
iblinkotherframeworks = 100;

View File

@ -616,6 +616,26 @@ implementation
do_moduleswitch(cs_support_macro);
end;
procedure dir_pascalmainname;
var
s: string;
begin
current_scanner.skipspace;
s:=trimspace(current_scanner.readcomment);
if assigned(current_module.mainname) and
(s<>current_module.mainname^) then
begin
Message1(scan_w_multiple_main_name_overrides,current_module.mainname^);
stringdispose(current_module.mainname)
end
else if (mainaliasname<>defaultmainaliasname) and
(mainaliasname<>s) then
Message1(scan_w_multiple_main_name_overrides,mainaliasname);
mainaliasname:=s;
if (mainaliasname<>defaultmainaliasname) then
current_module.mainname:=stringdup(mainaliasname);
end;
procedure dir_maxfpuregisters;
var
l : integer;
@ -1345,6 +1365,7 @@ implementation
AddDirective('PACKENUM',directive_all, @dir_packenum);
AddDirective('PACKRECORDS',directive_all, @dir_packrecords);
AddDirective('PACKSET',directive_all, @dir_packset);
AddDirective('PASCALMAINNAME',directive_all, @dir_pascalmainname);
AddDirective('PIC',directive_all, @dir_pic);
AddDirective('POP',directive_all, @dir_pop);
AddDirective('PROFILE',directive_all, @dir_profile);

10
tests/test/tmainnam.pp Normal file
View File

@ -0,0 +1,10 @@
{ %recompile }
{ %fail }
{ %opt=-Sew -Cn }
uses umainnam;
{$pascalmainname mytest}
begin
end.

9
tests/test/umainnam.pp Normal file
View File

@ -0,0 +1,9 @@
unit umainnam;
interface
{$pascalmainname testing}
implementation
end.