- removed 1.x specific FindGlobalComponent

- added writing stack trace of exception in Application.HandleException

git-svn-id: trunk@7260 -

components/fpcunit/fpcunittestrunner.pas

@@ -1,14 +1,13 @@
-{  This file was automatically created by Lazarus. Do not edit!
+{ This file was automatically created by Lazarus. Do not edit!
-  This source is only used to compile and install
+This source is only used to compile and install the package.
-  the package FPCUnitTestRunner 0.1.
  }
 
-unit FPCUnitTestRunner; 
+unit FPCUnitTestRunner;
 
 interface
 
 uses
-  GuiTestRunner; 
+  GuiTestRunner;
 
 implementation
 

components/fpcunit/ide/fpcunitide.pas

@@ -1,22 +1,21 @@
-{  This file was automatically created by Lazarus. Do not edit!
+{ This file was automatically created by Lazarus. Do not edit!
-  This source is only used to compile and install
+This source is only used to compile and install the package.
-  the package fpcunitide 0.1.
  }
 
-unit fpcunitide; 
+unit fpcunitide;
 
 interface
 
 uses
-  FPCUnitLazIDEIntf, LazarusPackageIntf; 
+  FPCUnitLazIDEIntf, LazarusPackageIntf;
 
 implementation
 
-procedure Register; 
+procedure Register;
 begin
-  RegisterUnit('FPCUnitLazIDEIntf', @FPCUnitLazIDEIntf.Register); 
+  RegisterUnit('FPCUnitLazIDEIntf',@FPCUnitLazIDEIntf.Register);
-end; 
+end;
 
 initialization
-  RegisterPackage('fpcunitide', @Register); 
+  RegisterPackage('fpcunitide',@Register);
 end.

designer/jitforms.pp

@@ -53,12 +53,6 @@ uses
   Classes, SysUtils, TypInfo, LCLProc, LResources, Forms, Controls, LCLIntf,
   Dialogs, JITForm, ComponentReg, IDEProcs;
 
-{$IFNDEF VER1_0}
-  {$IFNDEF VER1_9_8}
-    {$DEFINE RegisterFindGlobalComponent}
-  {$ENDIF}
-{$ENDIF}
-
 type
   //----------------------------------------------------------------------------
   TJITFormError = (
@@ -694,11 +688,7 @@ begin
       {$ENDIF}
       DoFinishReading;
     finally
-      {$IFDEF RegisterFindGlobalComponent}
       UnregisterFindGlobalComponentProc(@MyFindGlobalComponent);
-      {$ELSE}
-      FindGlobalComponent:=nil;
-      {$ENDIF}
       if DestroyDriver then Reader.Driver.Free;
       Reader.Free;
     end;
@@ -725,11 +715,7 @@ begin
   DestroyDriver:=false;
   Reader:=CreateLRSReader(BinStream,DestroyDriver);
   MyFindGlobalComponentProc:=@OnFindGlobalComponent;
-  {$IFDEF RegisterFindGlobalComponent}
   RegisterFindGlobalComponentProc(@MyFindGlobalComponent);
-  {$ELSE}
-  FindGlobalComponent:=@MyFindGlobalComponent;
-  {$ENDIF}
 
   {$IFDEF VerboseJITForms}
   writeln('[TJITComponentList.InitReading] A');
@@ -901,11 +887,7 @@ begin
       {$ENDIF}
       DoFinishReading;
     finally
-      {$IFDEF RegisterFindGlobalComponent}
       UnregisterFindGlobalComponentProc(@MyFindGlobalComponent);
-      {$ELSE}
-      FindGlobalComponent:=nil;
-      {$ENDIF}
       if DestroyDriver then Reader.Driver.Free;
       Reader.Free;
     end;

lcl/forms.pp

@@ -34,28 +34,7 @@ interface
   {$ASSERTIONS ON}
 {$endif}
 
-{$IF VER1_0_8 or VER1_0_10}
+{$DEFINE HasDefaultValues}
-// There is a problem with try..except and calling JIT procedures, so we can't
-// use the FCL TDataModule at the moment
-{ $DEFINE UseFCLDataModule}
-{$ENDIF}
-
-{$IFNDEF VER1_0}
-  {$DEFINE HasDefaultValues}
-  {$IFNDEF VER1_9_8}
-    {$DEFINE RegisterFindGlobalComponent}
-  {$ENDIF}
-{$ENDIF}
-
-// FPC 1.9.7 and later have exceptions which contain stack frames
-// If you are using an early version of fpc 1.9.7 you can define
-// ExceptionHasNoFrames to disable using stackframes.
-{$IFDEF VER1_0}
-  {$DEFINE ExceptionHasNoFrames}
-{$ENDIF}
-{$IFDEF VER1_9_6}
-  {$DEFINE ExceptionHasNoFrames}
-{$ENDIF}
 
 uses
   Classes, SysUtils, Math, FPCAdds, LCLStrConsts, LCLType, LCLProc, LCLIntf,
@@ -1264,14 +1243,10 @@ end;
 
 
 //------------------------------------------------------------------------------
-{$IFDEF ExceptionHasNoFrames}
-procedure ExceptionOccurred(Sender: TObject; Addr,Frame: Pointer);
-{$ELSE}
 procedure ExceptionOccurred(Sender: TObject; Addr:Pointer; FrameCount: Longint;
   Frames: PPointer);
 var
   FrameNumber: integer;
-{$ENDIF}
 Begin
   DebugLn('[FORMS.PP] ExceptionOccurred ');
   if HaltingProgram or HandlingException then Halt;
@@ -1280,11 +1255,10 @@ Begin
     DebugLn('  Sender=',Sender.ClassName);
     if Sender is Exception then begin
       DebugLn('  Exception=',Exception(Sender).Message);
-      {$IFNDEF ExceptionHasNoFrames}
       DebugLn('  Stack trace:');
+      DebugLn(BackTraceStrFunc(ExceptAddr));
       for FrameNumber := 0 to FrameCount-1 do
         DebugLn(BackTraceStrFunc(Frames[FrameNumber]));
-      {$ENDIF}
     end;
   end else
     DebugLn('  Sender=nil');

lcl/fpcadds.pas

@@ -33,17 +33,17 @@ type
   TStreamSeekType = int64;
   TMemStreamSeekType = integer;
   TCompareMemSize = integer;
-  
-  {$IFDEF VER1_0}
-  PCardinal = ^Cardinal;
-  PtrInt = Longint;
-  PtrUInt = Cardinal;
-  {$ENDIF}
-  
   PHandle = ^THandle;
   
 function StrToWord(const s: string): word;
 
+{$IFDEF VER2_0_0}
+// These functions were introduced after fpc 2.0.0
+function ExceptFrameCount: Longint;
+function ExceptFrames: PPointer;
+{$ENDIF}
+
+
 implementation
 
 function StrToWord(const s: string): word;
@@ -58,6 +58,23 @@ begin
   end;
 end;
 
+{$IFDEF VER2_0_0}
+function ExceptFrameCount: Longint;
+begin
+  If RaiseList=Nil then
+    Result:=0
+  else
+    Result:=RaiseList^.Framecount;
+end;
+
+function ExceptFrames: PPointer;
+begin
+  If RaiseList=Nil then
+    Result:=Nil
+  else
+    Result:=RaiseList^.Frames;
+end;
+{$ENDIF}
 
 end.
 

lcl/include/application.inc

@@ -816,6 +816,20 @@ end;
   Handles all messages first then the Idle
  ------------------------------------------------------------------------------}
 procedure TApplication.HandleException(Sender: TObject);
+
+  procedure DumpStack;
+  var
+    FrameCount: integer;
+    Frames: PPointer;
+    FrameNumber:Integer;
+  begin
+    DebugLn('  Stack trace:');
+    DebugLn(BackTraceStrFunc(ExceptAddr));
+    FrameCount:=ExceptFrameCount;
+    Frames:=ExceptFrames;
+    for FrameNumber := 0 to FrameCount-1 do
+      DebugLn(BackTraceStrFunc(Frames[FrameNumber]));
+  end;
 begin
   if Self=nil then exit;
   if AppHandlingException in FFlags then begin
@@ -831,6 +845,7 @@ begin
   // before we do anything, write it down
   if ExceptObject is Exception then begin
     DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
+    DumpStack;
   end else begin
     DebugLn('TApplication.HandleException Strange Exception ');
   end;
@@ -1404,9 +1419,6 @@ var
   Instance: TComponent;
   ok: boolean;
   AForm: TForm;
-  {$IFNDEF RegisterFindGlobalComponent}
-  OldFindGlobalComponent: TFindGlobalComponent;
-  {$ENDIF}
 begin
   // Allocate the instance, without calling the constructor
   Instance := TComponent(InstanceClass.NewInstance);
@@ -1414,12 +1426,7 @@ begin
   // events and constructors can refer to it
   TComponent(Reference) := Instance;
 
-  {$IFDEF RegisterFindGlobalComponent}
   RegisterFindGlobalComponentProc(@FindApplicationComponent);
-  {$ELSE}
-  OldFindGlobalComponent:=FindGlobalComponent;
-  FindGlobalComponent:=@FindApplicationComponent;
-  {$ENDIF}
   ok:=false;
   try
     Instance.Create(Self);
@@ -1427,11 +1434,7 @@ begin
   finally
     if not ok then
       TComponent(Reference) := nil;
-    {$IFDEF RegisterFindGlobalComponent}
     UnregisterFindGlobalComponentProc(@FindApplicationComponent);
-    {$ELSE}
-    FindGlobalComponent:=OldFindGlobalComponent;
-    {$ENDIF}
   end;
 
   if (Instance is TForm) then begin
@@ -1485,6 +1488,10 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.123  2005/06/21 14:41:16  vincents
+  - removed 1.x specific FindGlobalComponent
+  - added writing stack trace of exception in Application.HandleException
+
   Revision 1.122  2005/06/17 15:49:55  mattias
   added TApplication.ShowMainForm  from George Lober