mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 08:59:27 +02:00
+ 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:
parent
e1ec2834df
commit
86f90d8ac1
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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
@ -126,6 +126,8 @@ const
|
||||
ibnodetree = 80;
|
||||
ibasmsymbols = 81;
|
||||
ibresources = 82;
|
||||
|
||||
ibmainname = 90;
|
||||
{ target-specific things }
|
||||
iblinkotherframeworks = 100;
|
||||
|
||||
|
@ -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
10
tests/test/tmainnam.pp
Normal file
@ -0,0 +1,10 @@
|
||||
{ %recompile }
|
||||
{ %fail }
|
||||
{ %opt=-Sew -Cn }
|
||||
|
||||
uses umainnam;
|
||||
|
||||
{$pascalmainname mytest}
|
||||
|
||||
begin
|
||||
end.
|
9
tests/test/umainnam.pp
Normal file
9
tests/test/umainnam.pp
Normal file
@ -0,0 +1,9 @@
|
||||
unit umainnam;
|
||||
|
||||
interface
|
||||
|
||||
{$pascalmainname testing}
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
Loading…
Reference in New Issue
Block a user