Browse Source

--- Merging r14226 into '.':
U compiler/utils/samplecfg
--- Merging r14227 into '.':
G compiler/utils/samplecfg
--- Merging r14254 into '.':
U rtl/unix/sysutils.pp
U rtl/go32v2/sysutils.pp
U rtl/win/sysutils.pp
U rtl/os2/sysutils.pp
U rtl/objpas/rtlconst.inc
U rtl/objpas/sysutils/sysutilh.inc
U rtl/objpas/sysutils/sysutils.inc
--- Merging r14258 into '.':
U packages/fcl-web/src/custweb.pp
--- Merging r14262 into '.':
U packages/pasjpeg/src/jdmarker.pas
--- Merging r14264 into '.':
U packages/mysql/src/mysql3dyn.pp
U packages/mysql/src/mysql3.pp

# revisions: 14226,14227,14254,14258,14262,14264
------------------------------------------------------------------------
r14226 | jonas | 2009-11-20 14:07:45 +0100 (Fri, 20 Nov 2009) | 3 lines
Changed paths:
M /trunk/compiler/utils/samplecfg

* set default cpu type to pentiumm for darwin/i386 (since the first Macs
with an Intel cpu had a Core Solo)

------------------------------------------------------------------------
------------------------------------------------------------------------
r14227 | jonas | 2009-11-20 14:20:01 +0100 (Fri, 20 Nov 2009) | 3 lines
Changed paths:
M /trunk/compiler/utils/samplecfg

* use pipes instead of temporary files by default for assembling under
Darwin

------------------------------------------------------------------------
------------------------------------------------------------------------
r14254 | michael | 2009-11-22 18:33:56 +0100 (Sun, 22 Nov 2009) | 1 line
Changed paths:
M /trunk/rtl/go32v2/sysutils.pp
M /trunk/rtl/objpas/rtlconst.inc
M /trunk/rtl/objpas/sysutils/sysutilh.inc
M /trunk/rtl/objpas/sysutils/sysutils.inc
M /trunk/rtl/os2/sysutils.pp
M /trunk/rtl/unix/sysutils.pp
M /trunk/rtl/win/sysutils.pp

* Implemented OnBeep to install custom beep handler
------------------------------------------------------------------------
------------------------------------------------------------------------
r14258 | joost | 2009-11-23 14:57:29 +0100 (Mon, 23 Nov 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/custweb.pp

* Extracted ExceptionToHtml to procedure so it can be used elsewhere
------------------------------------------------------------------------
------------------------------------------------------------------------
r14262 | jonas | 2009-11-23 22:20:53 +0100 (Mon, 23 Nov 2009) | 3 lines
Changed paths:
M /trunk/packages/pasjpeg/src/jdmarker.pas

* fixed underflow error in get_interesting_appn() (patch by Marek Mauder
(Galfar), mantis #15150)

------------------------------------------------------------------------
------------------------------------------------------------------------
r14264 | marco | 2009-11-24 12:14:12 +0100 (Tue, 24 Nov 2009) | 2 lines
Changed paths:
M /trunk/packages/mysql/src/mysql3.pp
M /trunk/packages/mysql/src/mysql3dyn.pp

* real_connect "db" parameter added which was added in 3.22. Mants 15041, but dled mysql 3.23 to verify.

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14699 -

marco 15 years ago
parent
commit
84b805fa74

+ 13 - 0
compiler/utils/samplecfg

@@ -273,6 +273,12 @@ $CPUCROSSIFDEF2
 #ENDIF NEEDCROSSBINUTILS
 #ENDIF
 
+# assembling
+#ifdef darwin
+# use pipes instead of temporary files for assembling
+-ap
+#endif
+
 # ----------------
 # Parsing switches
 # ----------------
@@ -351,6 +357,13 @@ $CPUCROSSIFDEF2
 # See "fpc -i" also for more fine-grained control over which optimizations
 # to perform
 
+#ifdef darwin
+#ifdef cpui386
+-Cppentiumm
+-Oppentiumm
+#endif
+#endif
+
 # -----------------------
 # Set Filenames and Paths
 # -----------------------

+ 32 - 24
packages/fcl-web/src/custweb.pp

@@ -113,6 +113,8 @@ Type
 
   EFPWebError = Class(Exception);
 
+procedure ExceptionToHTML(S: TStrings; const E: Exception; const Title, Email, Administrator: string);
+
 Implementation
 
 {$ifdef CGIDEBUG}
@@ -128,6 +130,35 @@ resourcestring
   SError = 'Error: ';
   SNotify = 'Notify: ';
 
+procedure ExceptionToHTML(S: TStrings; const E: Exception; const Title, Email, Administrator: string);
+var
+  FrameNumber: Integer;
+  Frames: PPointer;
+  FrameCount: integer;
+  TheEmail: String;
+begin
+  With S do
+    begin
+    Add('<html><head><title>'+Title+': '+SModuleError+'</title></head>'+LineEnding);
+    Add('<body>');
+    Add('<center><hr><h1>'+Title+': ERROR</h1><hr></center><br><br>');
+    Add(SAppEncounteredError+'<br>');
+    Add('<ul>');
+    Add('<li>'+SError+' <b>'+E.Message+'</b>');
+    Add('<li> Stack trace:<br>');
+    Add(BackTraceStrFunc(ExceptAddr)+'<br>');
+    FrameCount:=ExceptFrameCount;
+    Frames:=ExceptFrames;
+    for FrameNumber := 0 to FrameCount-1 do
+      Add(BackTraceStrFunc(Frames[FrameNumber])+'<br>');
+    Add('</ul><hr>');
+    TheEmail:=Email;
+    If (TheEmail<>'') then
+      Add('<h5><p><i>'+SNotify+Administrator+': <a href="mailto:'+TheEmail+'">'+TheEmail+'</a></i></p></h5>');
+    Add('</body></html>');
+    end;
+end;
+
 procedure TCustomWebApplication.DoRun;
 var ARequest : TRequest;
     AResponse : TResponse;
@@ -141,10 +172,6 @@ end;
 
 procedure TCustomWebApplication.ShowRequestException(R: TResponse; E: Exception);
 Var
- TheEmail : String;
- FrameCount: integer;
- Frames: PPointer;
- FrameNumber:Integer;
  S : TStrings;
 
 begin
@@ -164,26 +191,7 @@ begin
     begin
     S:=TStringList.Create;
     Try
-      With S do
-        begin
-        Add('<html><head><title>'+Title+': '+SModuleError+'</title></head>'+LineEnding);
-        Add('<body>');
-        Add('<center><hr><h1>'+Title+': ERROR</h1><hr></center><br><br>');
-        Add(SAppEncounteredError+'<br>');
-        Add('<ul>');
-        Add('<li>'+SError+' <b>'+E.Message+'</b>');
-        Add('<li> Stack trace:<br>');
-        Add(BackTraceStrFunc(ExceptAddr)+'<br>');
-        FrameCount:=ExceptFrameCount;
-        Frames:=ExceptFrames;
-        for FrameNumber := 0 to FrameCount-1 do
-          Add(BackTraceStrFunc(Frames[FrameNumber])+'<br>');
-        Add('</ul><hr>');
-        TheEmail:=Email;
-        If (TheEmail<>'') then
-          Add('<h5><p><i>'+SNotify+Administrator+': <a href="mailto:'+TheEmail+'">'+TheEmail+'</a></i></p></h5>');
-        Add('</body></html>');
-        end;
+      ExceptionToHTML(S, E, Title, Email, Administrator);
       R.Content:=S.Text;
       R.SendContent;
     Finally

+ 1 - 1
packages/mysql/src/mysql3.pp

@@ -2,7 +2,6 @@
 unit mysql3;
 
 {$undef use_mysql_321} { if undefined, use mysql 3.23 interface }
-
 {
   Import unit for the mysql header files.
 
@@ -60,6 +59,7 @@ Function mysql_error(mysql : PMYSQL) : pchar; extdecl; external mysqllib;
 function mysql_init(mysql: PMYSQL) : PMYSQL;extdecl; external mysqllib name 'mysql_init';
 function mysql_connect (mysql : PMYSQL; host,user,passwd: pchar) : PMYSQL;extdecl; external mysqllib name 'mysql_connect';
 function mysql_real_connect (mysql : PMYSQL; const host,user,passwd : pchar;
+		                   {$ifndef use_mysql_321} const db : Pchar; {$endif}  // strictly speaking 3.22+ not 3.21+	      		
                                    port : cardinal;
                                    unix_socket : pchar;
                                    clientflag : cardinal) : PMYSQL;extdecl; external mysqllib;

+ 1 - 0
packages/mysql/src/mysql3dyn.pp

@@ -52,6 +52,7 @@ var
   mysql_init : function(mysql: PMYSQL) : PMYSQL;extdecl;
   mysql_connect : function(mysql : PMYSQL; host,user,passwd: pchar) : PMYSQL;extdecl;
   mysql_real_connect : function(mysql : PMYSQL; const host,user,passwd : pchar;
+		                   {$ifndef use_mysql_321} const db : Pchar; {$endif}  // strictly speaking 3.22+ not 3.21+	      		
                                    port : cardinal;
                                    unix_socket : pchar;
                                    clientflag : cardinal) : PMYSQL;extdecl;

+ 20 - 16
packages/pasjpeg/src/jdmarker.pas

@@ -1692,27 +1692,31 @@ begin
       numtoread := uint(length)
     else
       numtoread := 0;
-  for i := 0 to numtoread-1 do
+      
+  if numtoread > 0 then
   begin
-  { Read a byte into b[i]. If must suspend, return FALSE. }
-    { make a byte available.
-      Note we do *not* do INPUT_SYNC before calling fill_input_buffer,
-      but we must reload the local copies after a successful fill. }
-    if (bytes_in_buffer = 0) then
+    for i := 0 to numtoread-1 do
     begin
-      if (not datasrc^.fill_input_buffer(cinfo)) then
+      { Read a byte into b[i]. If must suspend, return FALSE. }
+      { make a byte available.
+        Note we do *not* do INPUT_SYNC before calling fill_input_buffer,
+        but we must reload the local copies after a successful fill. }
+      if (bytes_in_buffer = 0) then
       begin
-        get_interesting_appn := FALSE;
-        exit;
+        if (not datasrc^.fill_input_buffer(cinfo)) then
+        begin
+          get_interesting_appn := FALSE;
+          exit;
+        end;
+        { Reload the local copies }
+        next_input_byte := datasrc^.next_input_byte;
+        bytes_in_buffer := datasrc^.bytes_in_buffer;
       end;
-      { Reload the local copies }
-      next_input_byte := datasrc^.next_input_byte;
-      bytes_in_buffer := datasrc^.bytes_in_buffer;
-    end;
-    Dec( bytes_in_buffer );
+      Dec( bytes_in_buffer );
 
-    b[i] := GETJOCTET(next_input_byte^);
-    Inc(next_input_byte);
+      b[i] := GETJOCTET(next_input_byte^);
+      Inc(next_input_byte);
+    end;
   end;
 
   Dec(length, numtoread);

+ 2 - 1
rtl/go32v2/sysutils.pp

@@ -635,7 +635,7 @@ end ;
                               Misc Functions
 ****************************************************************************}
 
-procedure Beep;
+procedure sysBeep;
 begin
 end;
 
@@ -844,6 +844,7 @@ end;
 Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
+  OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
 end.

+ 1 - 0
rtl/objpas/rtlconst.inc

@@ -152,6 +152,7 @@ ResourceString
   SInvalidDateMonthWeek         = '(%d, %d, %d, %d) is not a valid DateMonthWeek quad';
   SInvalidDateWeek              = '(%d, %d, %d) is not a valid DateWeek triplet';
   SInvalidDayOfWeekInMonth      = '(%d, %d, %d, %d) is not a valid DayOfWeekInMonth quad';
+  SErrIllegalDateFormatString   = '"%s" is not a valid date format string';
   SInvalidFileName              = '"%s" is not a valid file name.';
   SInvalidIcon                  = 'Invalid Icon';
   SInvalidImage                 = 'Invalid stream format';

+ 11 - 2
rtl/objpas/sysutils/sysutilh.inc

@@ -173,15 +173,24 @@ type
    procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
    procedure Abort;
    procedure OutOfMemoryError;
+
+
+Type
+   TBeepHandler = Procedure;
+
+Var
+   OnBeep : TBeephandler = Nil;
+
    procedure Beep;
    function SysErrorMessage(ErrorCode: Integer): String;
 
+
+
 Type
    TCreateGUIDFunc = Function(Out GUID : TGUID) : Integer;
-
+   
 Var
    OnCreateGUID : TCreateGUIDFunc = Nil;
-
    Function CreateGUID(out GUID : TGUID) : Integer;
 
 type

+ 8 - 0
rtl/objpas/sysutils/sysutils.inc

@@ -683,3 +683,11 @@ begin
   Result:='';
 {$ENDIF}
 end;
+
+{ Beep support }
+
+procedure Beep;
+begin
+  If Assigned(OnBeep) then
+    OnBeep;
+end;

+ 4 - 2
rtl/os2/sysutils.pp

@@ -836,11 +836,12 @@ end;
 {****************************************************************************
                               Misc Functions
 ****************************************************************************}
+procedure sysbeep;
 
-procedure Beep;
 begin
-end;
+  // Maybe implement later on ?
 
+end;
 
 {****************************************************************************
                               Locale Functions
@@ -1075,6 +1076,7 @@ end;
 Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
+  OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
 end.

+ 8 - 3
rtl/unix/sysutils.pp

@@ -998,9 +998,6 @@ end;
                               Misc Functions
 ****************************************************************************}
 
-procedure Beep;
-begin
-end;
 
 
 {****************************************************************************
@@ -1363,6 +1360,12 @@ begin
   Result:=TheUserDir;    
 end;
 
+Procedure SysBeep;
+
+begin
+  Write(#7);
+  Flush(Output);
+end;
 
 {****************************************************************************
                               Initialization code
@@ -1372,6 +1375,8 @@ Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
   SysConfigDir:='/etc'; { Initialize system config dir }
+  OnBeep:=@SysBeep;
+  
 Finalization
   FreeDriveStr;
   DoneExceptions;

+ 2 - 1
rtl/win/sysutils.pp

@@ -604,7 +604,7 @@ end;
                               Misc Functions
 ****************************************************************************}
 
-procedure Beep;
+procedure sysbeep;
 begin
   MessageBeep(0);
 end;
@@ -1221,6 +1221,7 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
   LoadVersionInfo;
   InitSysConfigDir;
+  OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
   if kernel32dll<>0 then