Browse Source

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

Jonas Maebe 17 years ago
parent
commit
86f90d8ac1

+ 2 - 0
.gitattributes

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

+ 4 - 0
compiler/fmodule.pas

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

+ 14 - 0
compiler/fppu.pas

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

+ 2 - 1
compiler/globals.pas

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

+ 2 - 1
compiler/msg/errore.msg

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

+ 3 - 2
compiler/msgidx.inc

@@ -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
+ 309 - 308
compiler/msgtxt.inc


+ 2 - 0
compiler/ppu.pas

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

+ 21 - 0
compiler/scandir.pas

@@ -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 - 0
tests/test/tmainnam.pp

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

+ 9 - 0
tests/test/umainnam.pp

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

Some files were not shown because too many files changed in this diff