Browse Source

* Implement ListIndexError

(cherry picked from commit 8fb39925eb85545e20a2163319d0882705d10ee7)
Michaël Van Canneyt 1 year ago
parent
commit
fc6b11720a

+ 1 - 5
rtl/objpas/classes/classesh.inc

@@ -133,11 +133,7 @@ type
   EMethodNotFound = class(EFilerError);
   EMethodNotFound = class(EFilerError);
   EInvalidImage = class(EFilerError);
   EInvalidImage = class(EFilerError);
   EResNotFound = class(Exception);
   EResNotFound = class(Exception);
-{$ifdef FPC_TESTGENERICS}
-  EListError = fgl.EListError;
-{$else}
-  EListError = class(Exception);
-{$endif}
+  EListError = {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.EListError;
   EBitsError = class(Exception);
   EBitsError = class(Exception);
   EStringListError = class(Exception);
   EStringListError = class(Exception);
   EComponentError = class(Exception);
   EComponentError = class(Exception);

+ 15 - 0
rtl/objpas/rtlconst.inc

@@ -563,6 +563,21 @@ ResourceString
   SMsgDlgYes = '&Yes';
   SMsgDlgYes = '&Yes';
   SMsgDlgYesToAll = 'Yes to a&ll';
   SMsgDlgYesToAll = 'Yes to a&ll';
 
 
+  // Constants for Delphi compatibility
+  sAttributeExists = 'Attribute ''%s'' already exists';
+  sDeviceExists = 'Device ''%s'' already exists';
+  sCannotManuallyConstructDevice = 'Manual construction of TDeviceInfo is not supported'; 
+  SArgumentOutOfRange = 'Argument out of range';
+  StrNoClientClass = 'The client cannot be an instance of the class %s';  
+  SListIndexErrorExt = 'List index out of bounds (%0:d).  %2:s object range is 0..%1:d';
+  
+  { Classes observer support }
+  SErrNotIObserverInterface = 'Interface is not an IObserver interface';
+  SErrUnsupportedObserver = 'Observer type not supported';
+  SErrOnlyOneEditingObserverAllowed = 'Only one editing link observer is allowed';
+  SErrObserverNoSinglecast = 'No singlecast observer interface found';
+  SerrObserverNoMulticastFound = 'No multicast observer interface (%d) found';
+  SErrObserverNotAvailable = 'Observer type (%d) not available';
 
 
 implementation
 implementation
 
 

+ 1 - 0
rtl/objpas/sysconst.pp

@@ -147,6 +147,7 @@ const
   SFullpattern                  = 'Couldn''t match entire pattern string. Input too short at pattern position %d.';
   SFullpattern                  = 'Couldn''t match entire pattern string. Input too short at pattern position %d.';
   SPatternCharMismatch          = 'Pattern mismatch char "%s" at position %d.';
   SPatternCharMismatch          = 'Pattern mismatch char "%s" at position %d.';
   SAMPMError                    = 'Hour >= 13 not allowed in AM/PM mode.';
   SAMPMError                    = 'Hour >= 13 not allowed in AM/PM mode.';
+  SErrListIndexExt              = 'List index out of bounds (%d): %s object range is 0..%d';
 
 
   SShortMonthNameJan = 'Jan';
   SShortMonthNameJan = 'Jan';
   SShortMonthNameFeb = 'Feb';
   SShortMonthNameFeb = 'Feb';

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

@@ -247,6 +247,7 @@ type
    EInvalidOpException = class(Exception);
    EInvalidOpException = class(Exception);
 
 
    ENoConstructException = class(Exception);
    ENoConstructException = class(Exception);
+   EListError = Class(Exception);
 
 
    EOperationCancelled = class(Exception);
    EOperationCancelled = class(Exception);
 
 
@@ -260,7 +261,7 @@ type
    procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
    procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
    procedure Abort;
    procedure Abort;
    procedure OutOfMemoryError;
    procedure OutOfMemoryError;
-
+   procedure ListIndexError(aIndex,aMax: Integer; aObj: TObject);
 
 
 Type
 Type
    TBeepHandler = Procedure;
    TBeepHandler = Procedure;

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

@@ -644,6 +644,20 @@ begin
   Raise OutOfMemory;
   Raise OutOfMemory;
 end;
 end;
 
 
+procedure ListIndexError(aIndex,aMax: Integer; aObj: TObject);
+
+var
+ aClassName : string;
+
+begin
+  if Assigned(aObj) then
+    aClassName:=aObj.ClassName
+  else
+    aClassName:='<nil>';  
+  Raise EListError.CreateFmt(SErrListIndexExt,[aIndex,aClassName,aMax])
+end;
+
+
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     Initialization/Finalization/exit code
     Initialization/Finalization/exit code
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
@@ -1211,3 +1225,5 @@ class function TOSVersion.ToString: string; static;
 begin
 begin
   Result:=FFull;
   Result:=FFull;
 end;
 end;
+
+