• R/O
  • SSH

Ada95FL: 提交

Ada 95 foundation library


Commit MetaInfo

修订版deb49a72582b10f74b1197aa56c727e8a918f29a (tree)
时间2019-10-05 02:33:34
作者Sergey Dukov <dukov54@live...>
CommiterSergey Dukov

Log Message

#32763 Полная реализация "Replace_Element"

更改概述

差异

diff -r 43175b358cb6 -r deb49a72582b Unbounded/unbounded_array.adb
--- a/Unbounded/unbounded_array.adb Fri Oct 04 19:01:53 2019 +0400
+++ b/Unbounded/unbounded_array.adb Fri Oct 04 21:33:34 2019 +0400
@@ -821,37 +821,6 @@
821821 procedure Replace_Element
822822 (Source : in out Unbounded_Array_Type;
823823 Index : Positive;
824- By : Byte_Type)
825- is
826- SR : constant Referenced_Buffer_Access := Source.Reference;
827- DR : Referenced_Buffer_Access;
828- begin
829- if not Is_One(SR.Lock_Counter) then
830- Raise_Exception(Buffer_Locked'Identity,
831- "Buffer is locked for change");
832- end if;
833- -- Bounds check
834- if Index <= SR.Last then
835- -- Try to reuse existing shared string
836- if Can_Be_Reused (SR, SR.Last) then
837- SR.Data (Index) := By;
838- -- Otherwise allocate new shared string and fill it
839- else
840- DR := Allocate (SR.Last);
841- DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
842- DR.Data (Index) := By;
843- DR.Last := SR.Last;
844- Source.Reference := DR;
845- Unreference (SR);
846- end if;
847- else
848- raise Array_Index_Error;
849- end if;
850- end Replace_Element;
851-
852- procedure Replace_Element
853- (Source : in out Unbounded_Array_Type;
854- Index : Positive;
855824 By : Character)
856825 is
857826 begin
@@ -2203,41 +2172,6 @@
22032172 end;
22042173 end Element;
22052174
2206- procedure Replace_Element
2207- (Source : in out Unbounded_Array_Type;
2208- Index : Positive;
2209- By : Character_32)
2210- is
2211- SR : Referenced_Buffer_Access := Source.Reference;
2212- begin
2213- if not SR.UTF32 then
2214- Raise_Exception(Illegal_Unicode'Identity,
2215- "Have not support operation for operand`s types");
2216- end if;
2217- if SR.Last rem 4 /= 0 then
2218- Raise_Exception(Illegal_Unicode'Identity,
2219- "Illegal buffer length");
2220- end if;
2221- if By > Character_32'Last then
2222- Raise_Exception(Illegal_Unicode'Identity,
2223- "Illegal Character value");
2224- end if;
2225- declare
2226- SL : Natural := SR.Last / 4;
2227- subtype SM is String_32(1 .. SL);
2228- package TP is new ATOAC(SM);
2229- Source_Ptr : TP.Object_Pointer :=
2230- TP.To_Pointer(SR.Data(1)'Address);
2231- SA : SM renames Source_Ptr.all;
2232- begin
2233- if Index > SL then
2234- Raise_Exception(Array_Index_Error'Identity,
2235- "Illegal index value");
2236- end if;
2237- SA(Index) := By;
2238- end;
2239- end Replace_Element;
2240-
22412175 function Slice
22422176 (Source : Unbounded_Array_Type;
22432177 Low : Positive;
@@ -2856,5 +2790,94 @@
28562790 end;
28572791 end Append;
28582792
2793+ procedure Replace_Element
2794+ (Source : in out Unbounded_Array_Type;
2795+ Index : Positive;
2796+ By : Byte_Type)
2797+ is
2798+ SR : constant Referenced_Buffer_Access := Source.Reference;
2799+ DR : Referenced_Buffer_Access;
2800+ begin
2801+ if not Is_One(SR.Lock_Counter) then
2802+ Raise_Exception(Buffer_Locked'Identity,
2803+ "Buffer is locked for change");
2804+ end if;
2805+ -- Bounds check
2806+ if Index <= SR.Last then
2807+ -- Try to reuse existing shared string
2808+ if Can_Be_Reused (SR, SR.Last) then
2809+ SR.Data (Index) := By;
2810+ -- Otherwise allocate new shared string and fill it
2811+ else
2812+ DR := Allocate (SR.Last);
2813+ DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
2814+ DR.Data (Index) := By;
2815+ DR.Last := SR.Last;
2816+ DR.UTF32 := SR.UTF32;
2817+ Source.Reference := DR;
2818+ Unreference (SR);
2819+ end if;
2820+ else
2821+ Raise_Exception(Array_Index_Error'Identity,
2822+ "Illegal position values");
2823+ end if;
2824+ end Replace_Element;
2825+
2826+ procedure Replace_Element
2827+ (Source : in out Unbounded_Array_Type;
2828+ Index : Positive;
2829+ By : Character_32)
2830+ is
2831+ SR : Referenced_Buffer_Access := Source.Reference;
2832+ DR : Referenced_Buffer_Access;
2833+ begin
2834+ if not Is_One(SR.Lock_Counter) then
2835+ Raise_Exception(Buffer_Locked'Identity,
2836+ "Buffer is locked for change");
2837+ end if;
2838+ if not SR.UTF32 then
2839+ Raise_Exception(Illegal_Unicode'Identity,
2840+ "Have not support operation for operand`s types");
2841+ end if;
2842+ if SR.Last rem 4 /= 0 then
2843+ Raise_Exception(Illegal_Unicode'Identity,
2844+ "Illegal buffer length");
2845+ end if;
2846+ if By > Character_32'Last then
2847+ Raise_Exception(Illegal_Unicode'Identity,
2848+ "Illegal Character value");
2849+ end if;
2850+ declare
2851+ SL : Natural := SR.Last / 4;
2852+ subtype SM is String_32(1 .. SL);
2853+ package TP is new ATOAC(SM);
2854+ Source_Ptr : TP.Object_Pointer :=
2855+ TP.To_Pointer(SR.Data(1)'Address);
2856+ SA : SM renames Source_Ptr.all;
2857+ begin
2858+ if Index > SL then
2859+ Raise_Exception(Array_Index_Error'Identity,
2860+ "Illegal index value");
2861+ end if;
2862+ if Can_Be_Reused(SR, 4*SL) then
2863+ SA(Index) := By;
2864+ else
2865+ DR := Allocate(4*SL);
2866+ declare
2867+ Result_Ptr : TP.Object_Pointer :=
2868+ TP.To_Pointer(DR.Data(1)'Address);
2869+ DA : SM renames Result_Ptr.all;
2870+ begin
2871+ DA := SA;
2872+ DA(Index) := By;
2873+ DR.Last := 4*SL;
2874+ DR.UTF32 := True;
2875+ Source.Reference := DR;
2876+ Unreference(SR);
2877+ end;
2878+ end if;
2879+ end;
2880+ end Replace_Element;
2881+
28592882
28602883 end Unbounded_Array;
diff -r 43175b358cb6 -r deb49a72582b Unbounded/unbounded_array.ads
--- a/Unbounded/unbounded_array.ads Fri Oct 04 19:01:53 2019 +0400
+++ b/Unbounded/unbounded_array.ads Fri Oct 04 21:33:34 2019 +0400
@@ -189,6 +189,11 @@
189189 procedure Replace_Element
190190 (Source : in out Unbounded_Array_Type;
191191 Index : Positive;
192+ By : Byte_Type);
193+
194+ procedure Replace_Element
195+ (Source : in out Unbounded_Array_Type;
196+ Index : Positive;
192197 By : Character);
193198
194199 procedure Replace_Element
diff -r 43175b358cb6 -r deb49a72582b tester/unbounded_tester.adb
--- a/tester/unbounded_tester.adb Fri Oct 04 19:01:53 2019 +0400
+++ b/tester/unbounded_tester.adb Fri Oct 04 21:33:34 2019 +0400
@@ -51,6 +51,9 @@
5151 Append(Unicode_Array, Character_32(16#2126#)); -- omega
5252 Unicode_Array := Character_32(BOM32) & Unicode_Array;
5353 Unicode_Array := Character_32(16#2126#) & Unicode_Array;
54+ Replace_Element(Unicode_Array,
55+ Length32(Unicode_Array),
56+ Character_32(16#03A3#));
5457 -- Unicode_Array := Unbounded_Slice_32(Unicode_Array,
5558 -- 3,
5659 -- Length32(Unicode_Array) - 1
Show on old repository browser