# revisions: 41570,41571,41938,42457,42327,42556,42557

git-svn-id: branches/fixes_3_2@43393 -

.gitattributes

@@ -11715,6 +11715,8 @@ tests/tbs/tb0649.pp -text svneol=native#text/pascal
 tests/tbs/tb0650.pp svneol=native#text/pascal
 tests/tbs/tb0651.pp svneol=native#text/pascal
 tests/tbs/tb0654.pp svneol=native#text/plain
+tests/tbs/tb0655.pp svneol=native#text/pascal
+tests/tbs/tb0657.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -16426,6 +16428,7 @@ tests/webtbs/tw3577.pp svneol=native#text/plain
 tests/webtbs/tw3578.pp svneol=native#text/plain
 tests/webtbs/tw3579.pp svneol=native#text/plain
 tests/webtbs/tw3583.pp svneol=native#text/plain
+tests/webtbs/tw35862.pp svneol=native#text/pascal
 tests/webtbs/tw3589.pp svneol=native#text/plain
 tests/webtbs/tw3594.pp svneol=native#text/plain
 tests/webtbs/tw3595.pp svneol=native#text/plain

packages/graph/src/inc/graph.inc

@@ -265,7 +265,7 @@ var
                { thick width }
                hline(x1,x2,y2-1);
                hline(x1,x2,y2);
-               hline(x2,x2,y2+1);
+               hline(x1,x2,y2+1);
             end;
         end
     else

packages/rtl-generics/src/generics.collections.pas

@@ -679,7 +679,10 @@ type
     procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); inline;
     procedure NodeNotify(ANode: PNode; ACollectionNotification: TCollectionNotification; ADispose: boolean); inline;
     procedure SetValue(var AValue: TValue; constref ANewValue: TValue);
+    function GetItem(const AKey: TKey): TValue;
+    procedure SetItem(const AKey: TKey; const AValue: TValue);
 
+    property Items[Index: TKey]: TValue read GetItem write SetItem;
     // for reporting
     procedure WriteStr(AStream: TStream; const AText: string);
   public type
@@ -747,8 +750,8 @@ type
     function Remove(constref AKey: TKey; ADisposeNode: boolean = true): boolean;
     function ExtractPair(constref AKey: TKey; ADisposeNode: boolean = true): TTreePair; overload;
     function ExtractPair(constref ANode: PNode; ADispose: boolean = true): TTreePair; overload;
-    function ExtractNode(constref AKey: TKey; ADisposeNode: boolean): PNode; overload;
-    function ExtractNode(ANode: PNode; ADispose: boolean): PNode; overload;
+    function Extract(constref AKey: TKey; ADisposeNode: boolean): PNode;
+    function ExtractNode(ANode: PNode; ADispose: boolean): PNode;
     procedure Delete(ANode: PNode; ADispose: boolean = true); inline;
 
     function GetEnumerator: TPairEnumerator;
@@ -782,6 +785,8 @@ type
   end;
 
   TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>)
+  public
+    property Items; default;
   end;
 
   TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>)
@@ -808,6 +813,7 @@ type
   protected
     property OnKeyNotify;
     property OnValueNotify;
+    property Items;
   public type
     TItemEnumerator = TKeyEnumerator;
   public
@@ -3319,6 +3325,21 @@ begin
   Result := TValueCollection(FValues);
 end;
 
+function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetItem(const AKey: TKey): TValue;
+var
+  LNode: PNode;
+begin
+  LNode := Find(AKey);
+  if not Assigned(LNode) then
+    raise EAVLTree.CreateRes(@SDictionaryKeyDoesNotExist);
+  result := LNode.Value;
+end;
+
+procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.SetItem(const AKey: TKey; const AValue: TValue);
+begin
+  Find(AKey).Value := AValue;
+end;
+
 constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create;
 begin
   FComparer := TComparer<TKey>.Default;
@@ -3430,7 +3451,7 @@ begin
   Result.Value := DoRemove(ANode, cnExtracted, ADispose);
 end;
 
-function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ExtractNode(constref AKey: TKey; ADisposeNode: boolean): PNode;
+function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Extract(constref AKey: TKey; ADisposeNode: boolean): PNode;
 begin
   Result:=Find(AKey);
   if Result<>nil then

packages/rtl-generics/tests/tests.generics.trees.pas

@@ -42,6 +42,7 @@ type
     procedure Test_IndexedAVLTree_Add_General;
     procedure Test_IndexedAVLTree_Add;
     procedure Test_IndexedAVLTree_Delete;
+    procedure Test_IndexedAVLTree_Items;
 
     procedure Test_TAVLTreeMap_Notification;
   end;
@@ -50,6 +51,7 @@ implementation
 
 type
   TStringsTree = TIndexedAVLTree<string>;
+  TMapTree = TAVLTreeMap<string, Integer>;
 
 { TTestTrees }
 
@@ -138,6 +140,29 @@ begin
   end;
 end;
 
+procedure TTestTrees.Test_IndexedAVLTree_Items;
+var
+  LTree: TMapTree;
+begin
+  LTree := TMapTree.Create;
+  try
+    Check(LTree.Add('A', 1)<>nil);
+    Check(LTree.Add('B', 2)<>nil);
+    Check(LTree.Add('C', 3)<>nil);
+    CheckEquals(LTree.Items['A'], 1);
+    CheckEquals(LTree.Items['B'], 2);
+    CheckEquals(LTree.Items['C'], 3);
+    LTree.Items['A'] := 4;
+    LTree.Items['B'] := 5;
+    LTree.Items['C'] := 6;
+    CheckEquals(LTree.Items['A'], 4);
+    CheckEquals(LTree.Items['B'], 5);
+    CheckEquals(LTree.Items['C'], 6);
+  finally
+    LTree.Free;
+  end;
+end;
+
 procedure TTestTrees.Test_TAVLTreeMap_Notification;
 var
   LTree: TAVLTreeMap<string, string>;

packages/rtl-objpas/src/inc/variants.pp

@@ -2488,12 +2488,25 @@ begin
   DoOleVarFromVar(TVarData(aDest), TVarData(aSource));
 end;
 
-procedure sysolevarfromint(var Dest : olevariant; const Source : LongInt; const range : ShortInt);
+procedure sysolevarfromint(var Dest : olevariant; const Source : Int64; const range : ShortInt);
 begin
   DoVarClearIfComplex(TVarData(Dest));
+  { 64-bit values have their own types, all smaller ones are stored as signed 32-bit value }
   with TVarData(Dest) do begin
-    vInteger := Source;
-    vType := varInteger;
+    case range of
+      -8: begin
+        vInt64 := Int64(Source);
+        vType := varInt64;
+      end;
+      8: begin
+        vQWord := QWord(Source);
+        vType := varQWord;
+      end;
+      else begin
+        vInteger := LongInt(Source);
+        vType := varInteger;
+      end;
+    end;
   end;
 end;
 

rtl/amicommon/sysutils.pp

@@ -949,4 +949,5 @@ Initialization
   RefreshDeviceList;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/atari/sysutils.pp

@@ -527,4 +527,5 @@ Initialization
 
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/embedded/sysutils.pp

@@ -286,4 +286,5 @@ Initialization
   InitExceptions;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/emx/sysutils.pp

@@ -1335,4 +1335,5 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/gba/sysutils.pp

@@ -320,4 +320,5 @@ Initialization
   InitExceptions;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/go32v2/sysutils.pp

@@ -915,4 +915,5 @@ Initialization
   OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/inc/varianth.inc

@@ -186,7 +186,7 @@ type
       olevarfrompstr: procedure(var dest : olevariant; const source : shortstring);
       olevarfromlstr: procedure(var dest : olevariant; const source : ansistring);
       olevarfromvar: procedure(var dest : olevariant; const source : variant);
-      olevarfromint: procedure(var dest : olevariant; const source : longint;const range : shortint);
+      olevarfromint: procedure(var dest : olevariant; const source : int64;const range : shortint);
 
       { operators }
       varop : procedure(var left : variant;const right : variant;opcode : tvarop);

rtl/macos/sysutils.pp

@@ -844,4 +844,5 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/msdos/sysutils.pp

@@ -924,4 +924,5 @@ Initialization
   OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/nativent/sysutils.pp

@@ -1258,4 +1258,5 @@ initialization
   OnBeep := @SysBeep;
 finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/nds/sysutils.pp

@@ -359,4 +359,5 @@ Initialization
   InitExceptions;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/netware/sysutils.pp

@@ -656,4 +656,5 @@ Initialization
   OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/netwlibc/sysutils.pp

@@ -723,4 +723,5 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/objpas/fgl.pp

@@ -900,7 +900,7 @@ end;
 
 function TFPGList.GetList: PTypeList;
 begin
-  Result := PTypeList(FList);
+  Result := PTypeList(@FList);
 end;
 
 function TFPGList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
@@ -1029,7 +1029,7 @@ end;
 
 function TFPGObjectList.GetList: PTypeList;
 begin
-  Result := PTypeList(FList);
+  Result := PTypeList(@FList);
 end;
 
 function TFPGObjectList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
@@ -1153,7 +1153,7 @@ end;
 
 function TFPGInterfacedObjectList.GetList: PTypeList;
 begin
-  Result := PTypeList(FList);
+  Result := PTypeList(@FList);
 end;
 
 function TFPGInterfacedObjectList.ItemPtrCompare(Item1, Item2: Pointer): Integer;

rtl/objpas/sysutils/sysutils.inc

@@ -653,6 +653,19 @@ begin
     end;
 end;
 
+procedure FreeTerminateProcs;
+var
+  TPR1, TPR2: PPRecord;
+begin
+  TPR1 := TPList;
+  TPList := Nil;
+  while Assigned(TPR1) do begin
+    TPR2 := TPR1^.NextFunc;
+    Dispose(TPR1);
+    TPR1 := TPR2;
+  end;
+end;
+
 { ---------------------------------------------------------------------
     Diskh functions, OS independent.
   ---------------------------------------------------------------------}

rtl/os2/sysutils.pp

@@ -997,4 +997,5 @@ Initialization
   OrigOSErrorWatch := TOSErrorWatch (SetOSErrorTracking (@TrackLastOSError));
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/symbian/sysutils.pp

@@ -286,4 +286,5 @@ Initialization
   InitExceptions;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/unix/sysutils.pp

@@ -1658,4 +1658,5 @@ Initialization
 Finalization
   FreeDriveStr;
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/watcom/sysutils.pp

@@ -893,4 +893,5 @@ Initialization
   InitDelay;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/wii/sysutils.pp

@@ -289,4 +289,5 @@ Initialization
   InitExceptions;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/win/sysutils.pp

@@ -1528,4 +1528,5 @@ Initialization
   OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/win16/sysutils.pp

@@ -946,4 +946,5 @@ Initialization
   OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 end.

rtl/wince/sysutils.pp

@@ -977,5 +977,6 @@ Initialization
 
 Finalization
   DoneExceptions;
+  FreeTerminateProcs;
 
 end.

tests/tbs/tb0655.pp

@@ -0,0 +1,115 @@
+program tb0655;
+
+uses
+  Variants;
+
+var
+  s8: Int8 = $12;
+  u8: UInt8 = $98;
+  s16: Int16 = $1234;
+  u16: UInt16 = $9876;
+  s32: Int32 = $12345768;
+  u32: UInt32 = $98765432;
+  s64: Int64 = $1234567812345678;
+  u64: UInt64 = UInt64($9876543298765432);
+  v: Variant;
+  ov: OleVariant;
+begin
+  v := s8;
+  if VarType(v) <> varShortInt then
+    Halt(1);
+  if Int8(v) <> s8 then
+    Halt(2);
+
+  v := u8;
+  if VarType(v) <> varByte then
+    Halt(3);
+  if UInt8(v) <> u8 then
+    Halt(4);
+
+  v := s16;
+  if VarType(v) <> varSmallInt then
+    Halt(5);
+  if Int16(v) <> s16 then
+    Halt(6);
+
+  v := u16;
+  if VarType(v) <> varWord then
+    Halt(7);
+  if UInt16(v) <> u16 then
+    Halt(8);
+
+  v := s32;
+  if VarType(v) <> varInteger then
+    Halt(9);
+  if Int32(v) <> s32 then
+    Halt(10);
+
+  v := u32;
+  if VarType(v) <> varLongWord then
+    Halt(11);
+  if UInt32(v) <> u32 then
+    Halt(12);
+
+  v := s64;
+  if VarType(v) <> varInt64 then
+    Halt(13);
+  if Int64(v) <> s64 then
+    Halt(14);
+
+  v := u64;
+  if VarType(v) <> varUInt64 then
+    Halt(15);
+  if UInt64(v) <> u64 then
+    Halt(16);
+
+  { OleVariant has slightly different behaviour to Variant }
+  ov := s8;
+  if VarType(ov) <> varInteger then
+    Halt(17);
+  if Int8(ov) <> s8 then
+    Halt(18);
+
+  ov := u8;
+  if VarType(ov) <> varInteger then
+    Halt(19);
+  if UInt8(ov) <> u8 then
+    Halt(20);
+
+  ov := s16;
+  if VarType(ov) <> varInteger then
+    Halt(21);
+  if Int16(ov) <> s16 then
+    Halt(22);
+
+  ov := u16;
+  if VarType(ov) <> varInteger then
+    Halt(23);
+  if UInt16(ov) <> u16 then
+    Halt(24);
+
+  ov := s32;
+  if VarType(ov) <> varInteger then
+    Halt(25);
+  if Int32(ov) <> s32 then
+    Halt(26);
+
+  ov := u32;
+  if VarType(ov) <> varInteger then
+    Halt(27);
+  { ! }
+  if UInt32(Int32(ov)) <> u32 then
+    Halt(28);
+
+  ov := s64;
+  if VarType(ov) <> varInt64 then
+    Halt(29);
+  if Int64(ov) <> s64 then
+    Halt(30);
+
+  ov := u64;
+  if VarType(ov) <> varUInt64 then
+    Halt(31);
+  if UInt64(ov) <> u64 then
+    Halt(32);
+end.

tests/tbs/tb0657.pp

@@ -0,0 +1,29 @@
+program tb0657;
+
+{$mode objfpc}
+
+uses
+  fgl;
+
+type
+  TIntList = specialize TFPGList<LongInt>;
+
+const
+  c = 3;
+
+var
+  l: TIntList;
+  i: LongInt;
+begin
+  l := TIntList.Create;
+  try
+    for i := 0 to c do
+      l.Add(i);
+
+    for i := 0 to l.Count - 1 do
+      if l.List^[i] <> i then
+        Halt(i + 1);
+  finally
+    l.Free;
+  end;
+end.

tests/webtbs/tw35862.pp

@@ -0,0 +1,22 @@
+{ %OPT=-gh }
+
+program tw35862;
+
+{$modeswitch result}
+
+uses sysutils;
+
+function do_term:boolean;
+begin
+  writeln('In terminate proc');
+  Result:=true;
+end;
+
+begin
+  HaltOnNotReleased:=True;
+
+  writeln('Adding terminate proc');
+  AddTerminateproc(@do_term);
+  writeln('terminating');
+  CallterminateProcs;
+end.