From fc6b11720a8a8ddc2573e3268ea2459e030aead7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Thu, 9 Nov 2023 11:43:19 +0100
Subject: [PATCH] * Implement ListIndexError

(cherry picked from commit 8fb39925eb85545e20a2163319d0882705d10ee7)
---
 rtl/objpas/classes/classesh.inc  |  6 +-----
 rtl/objpas/rtlconst.inc          | 15 +++++++++++++++
 rtl/objpas/sysconst.pp           |  1 +
 rtl/objpas/sysutils/sysutilh.inc |  3 ++-
 rtl/objpas/sysutils/sysutils.inc | 16 ++++++++++++++++
 5 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
index 0617a6fc16..be17dbb890 100644
--- a/rtl/objpas/classes/classesh.inc
+++ b/rtl/objpas/classes/classesh.inc
@@ -133,11 +133,7 @@ type
   EMethodNotFound = class(EFilerError);
   EInvalidImage = class(EFilerError);
   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);
   EStringListError = class(Exception);
   EComponentError = class(Exception);
diff --git a/rtl/objpas/rtlconst.inc b/rtl/objpas/rtlconst.inc
index 01290c8aad..281ff8a1d1 100644
--- a/rtl/objpas/rtlconst.inc
+++ b/rtl/objpas/rtlconst.inc
@@ -563,6 +563,21 @@ ResourceString
   SMsgDlgYes = '&Yes';
   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
 
diff --git a/rtl/objpas/sysconst.pp b/rtl/objpas/sysconst.pp
index 3f71ae5232..1a75852a49 100644
--- a/rtl/objpas/sysconst.pp
+++ b/rtl/objpas/sysconst.pp
@@ -147,6 +147,7 @@ const
   SFullpattern                  = 'Couldn''t match entire pattern string. Input too short at pattern position %d.';
   SPatternCharMismatch          = 'Pattern mismatch char "%s" at position %d.';
   SAMPMError                    = 'Hour >= 13 not allowed in AM/PM mode.';
+  SErrListIndexExt              = 'List index out of bounds (%d): %s object range is 0..%d';
 
   SShortMonthNameJan = 'Jan';
   SShortMonthNameFeb = 'Feb';
diff --git a/rtl/objpas/sysutils/sysutilh.inc b/rtl/objpas/sysutils/sysutilh.inc
index 08727e5cc2..2b975207f0 100644
--- a/rtl/objpas/sysutils/sysutilh.inc
+++ b/rtl/objpas/sysutils/sysutilh.inc
@@ -247,6 +247,7 @@ type
    EInvalidOpException = class(Exception);
 
    ENoConstructException = class(Exception);
+   EListError = Class(Exception);
 
    EOperationCancelled = class(Exception);
 
@@ -260,7 +261,7 @@ type
    procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
    procedure Abort;
    procedure OutOfMemoryError;
-
+   procedure ListIndexError(aIndex,aMax: Integer; aObj: TObject);
 
 Type
    TBeepHandler = Procedure;
diff --git a/rtl/objpas/sysutils/sysutils.inc b/rtl/objpas/sysutils/sysutils.inc
index f28381a0db..ccdd6b05c0 100644
--- a/rtl/objpas/sysutils/sysutils.inc
+++ b/rtl/objpas/sysutils/sysutils.inc
@@ -644,6 +644,20 @@ begin
   Raise OutOfMemory;
 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
   ---------------------------------------------------------------------}
@@ -1211,3 +1225,5 @@ class function TOSVersion.ToString: string; static;
 begin
   Result:=FFull;
 end;
+
+