Merged revisions 10385,10406-10407,10411 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r10385 | florian | 2008-02-24 21:00:08 +0100 (Sun, 24 Feb 2008) | 2 lines

* patch by C Western for #10883

........
r10406 | jonas | 2008-03-01 14:05:01 +0100 (Sat, 01 Mar 2008) | 4 lines

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

........
r10407 | jonas | 2008-03-01 14:07:12 +0100 (Sat, 01 Mar 2008) | 5 lines

  * rewrote the setup code using {$pascalmainname x} so you can
    use this graph unit like any other (instead of having to put all
    code in a separate function and then calling StartGraphProgram
    with the address of this function as parameter)

........
r10411 | jonas | 2008-03-01 18:22:57 +0100 (Sat, 01 Mar 2008) | 5 lines

  + added {$linkframework Carbon} to FPCMacOSAll so -k"-framework Carbon" is
    not longer needed when using that unit
  - removed the same statement from the Mac OS X graph unit (since it uses
    FPCMacOSAll)

........

git-svn-id: branches/fixes_2_2@10612 -

.gitattributes

@@ -7263,6 +7263,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
@@ -7408,6 +7409,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

compiler/fmodule.pas

@@ -145,6 +145,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;
@@ -468,6 +469,7 @@ implementation
         linkotherstaticlibs:=TLinkContainer.Create;
         linkothersharedlibs:=TLinkContainer.Create;
         linkotherframeworks:=TLinkContainer.Create;
+        mainname:=nil;
         FImportLibraryList:=TFPHashObjectList.Create(true);
         crc:=0;
         interface_crc:=0;
@@ -561,6 +563,7 @@ implementation
         linkotherstaticlibs.Free;
         linkothersharedlibs.Free;
         linkotherframeworks.Free;
+        stringdispose(mainname);
         FImportLibraryList.Free;
         stringdispose(objfilename);
         stringdispose(asmfilename);
@@ -706,6 +709,7 @@ implementation
         linkothersharedlibs:=TLinkContainer.Create;
         linkotherframeworks.Free;
         linkotherframeworks:=TLinkContainer.Create;
+        stringdispose(mainname);
         FImportLibraryList.Free;
         FImportLibraryList:=TFPHashObjectList.Create;
         do_compile:=false;

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;

compiler/globals.pas

@@ -309,7 +309,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;

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

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;
@@ -734,9 +735,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 45564;
+  MsgTxtSize = 45652;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,86,238,84,63,50,108,22,135,60,
+    24,87,238,84,63,50,108,22,135,60,
     42,1,1,1,1,1,1,1,1,1
   );

compiler/ppu.pas

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

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

packages/graph/src/macosx/graph.pp

@@ -18,21 +18,14 @@ interface
 uses
   { in the interface so the graphh definitions of moveto etc override }
   { the ones in the universal interfaces                              }
-  cthreads, FPCMacOSAll;
+  FPCMacOSAll;
 
-{$linkframework Carbon}
-
-type
-  TGraphProgram = function(p: pointer): longint;
-
-  procedure StartGraphProgram(p: TGraphProgram);
+{$pascalmainname FPCMacOSXGraphMain}
 
 {$i graphh.inc}
 
 Const
   { Supported modes }
-  {(sg) GTEXT deactivated because we need mode #0 as default mode}
-  {GTEXT             = 0;                 Compatible with VGAlib v1.2 }
   G320x200x16       = 1;
   G640x200x16       = 2;
   G640x350x16       = 3;
@@ -97,7 +90,11 @@ implementation
 
 uses
   { for FOUR_CHAR_CODE }
-  macpas;
+  macpas,
+  baseunix,
+  unix,
+  ctypes,
+  pthreads;
 
 const
   InternalDriverName = 'Quartz';
@@ -769,7 +766,6 @@ begin
                         or kWindowInWindowMenuAttribute
                         or kWindowCompositingAttribute
                         or kWindowLiveResizeAttribute
-                        or kWindowInWindowMenuAttribute
                         or kWindowNoUpdatesAttribute; 
 
   SetRect (contentRect, 0,  0,
@@ -964,7 +960,7 @@ end;
            begin
            ModeNumber:=I;
            ModeName:=ModeNames[i];
-           // Pretend we are VGA always.
+           // Always pretend we are VGA.
            DriverNumber := VGA;
            // MaxX is number of pixels in X direction - 1
            MaxX:=640-1;
@@ -1059,34 +1055,36 @@ begin
 end;
 
 
-var
-  proctorun: TGraphProgram;
-   
-function wrapper(p: pointer): longint;
-(*
+type
+  pmainparas = ^tmainparas;
+  tmainparas = record
+    argc: cint;
+    argv: ppchar;
+    envp: ppchar;
+  end;
+
+procedure FPCMacOSXGraphMain(argcpara: cint; argvpara, envppara: ppchar); external name '_FPCMacOSXGraphMain';
+
+function wrapper(p: pointer): pointer; cdecl;
   var
-    event : EventRef;
-*)
+    mainparas: pmainparas absolute p;
   begin 
-    wrapper:=proctorun(nil);
-    halt(wrapper);
-(*
-    if (CreateEvent(nil, kEventClassFPCGraph, kEventQuit, GetCurrentEventTime(), 0, event) <> noErr) then
-      exit;
-
-    if (PostEventToQueue(MainEventQueue,event,kEventPriorityLow) <> noErr) then
-      begin
-        ReleaseEvent(event);
-        halt(wrapper);
-      end;
-*)
+    FPCMacOSXGraphMain(mainparas^.argc, mainparas^.argv, mainparas^.envp);
+    wrapper:=nil;
+    { the main program should exit }
+    fpexit(1);
   end;
 
 
-procedure StartGraphProgram(p: TGraphProgram);
+{ this routine runs before the rtl is initialised, so don't call any }
+{ rtl routines in it                                                 }
+procedure main(argcpara: cint; argvpara, envppara: ppchar); cdecl; [public];
   var
-    taskid: mptaskid;
     eventRec: eventrecord;
+    graphmainthread: TThreadID;
+    attr: TThreadAttr;
+    ret: cint;
+    mainparas: tmainparas;
   begin
     if InstallEventHandler (GetApplicationEventTarget,
                             NewEventHandlerUPP (@GraphEventHandler), 
@@ -1094,18 +1092,24 @@ procedure StartGraphProgram(p: TGraphProgram);
                             @allGraphSpec, 
                             nil,
                             nil) <> noErr then
-      begin
-        _GraphResult:=grError;
-        exit;
-      end;
+      fpexit(1);
   
-    proctorun:=p;
-     
     { main program has to be the first one to access the event queue, see }
     { http://lists.apple.com/archives/carbon-dev/2007/Jun/msg00612.html   }
     eventavail(0,eventRec);
     maineventqueue:=GetMainEventQueue;
-    BeginThread(@wrapper);
+    ret:=pthread_attr_init(@attr);
+    if (ret<>0) then
+      fpexit(1);
+    ret:=pthread_attr_setdetachstate(@attr,1);
+    if (ret<>0) then
+      fpexit(1);
+    mainparas.argc:=argcpara;
+    mainparas.argv:=argvpara;
+    mainparas.envp:=envppara;
+    ret:=pthread_create(@graphmainthread,@attr,@wrapper,@mainparas);
+    if (ret<>0) then
+      fpexit(1);
     RunApplicationEventLoop;
   end;
 

packages/univint/src/FPCMacOSAll.pas

@@ -9,6 +9,9 @@
 
 unit FPCMacOSAll;
 interface
+
+{$linkframework Carbon}
+
 {$setc UNIVERSAL_INTERFACES_VERSION := $0342}
 {$setc GAP_INTERFACES_VERSION := $0200}
 

rtl/objpas/sysutils/sysutils.inc

@@ -27,9 +27,11 @@
       // Start with checking the file in the current directory
       Result:=Name;
       temp:=SetDirSeparators(DirList);
-      repeat
-        If (Result<>'') and FileExists(Result) Then
+      while True do begin
+        If (Result <> '') and FileExists(Result) Then
           exit;
+        If Temp = '' then
+          Break; // No more directories to search - fail
         I:=pos(PathSeparator,Temp);
         If I<>0 then
           begin
@@ -41,9 +43,9 @@
             Result:=Temp;
             Temp:='';
           end;
-        if Result<>'' then
+        If Result<>'' then
           Result:=IncludeTrailingPathDelimiter(Result)+name;
-      until temp='';
+      end;
       result:='';
     end;
 

tests/test/tmainnam.pp

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

tests/test/umainnam.pp

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