OSDN > 浏览软件 > Portable Assembler Framework > SCM > hg > Ada95FL > 提交

Portable Assembler Framework
Fork
PAF
Ada95FL

Ada95FL: 提交

Ada 95 foundation library

Commit MetaInfo

修订版	8b364150de99af6ad262f2f3469d6af7f33b59c4 (tree)
时间	2019-10-04 08:16:57
作者	Sergey Dukov <dukov54@live...>
Commiter	Sergey Dukov

Log Message

#32763 Implement "function Replace_Slice(...;By : String_32)..."

更改概述

modified: Unbounded/unbounded_array.adb (diff)
modified: Unbounded/unbounded_array.ads (diff)
modified: tester/unbounded_tester.adb (diff)
add: tester/output-01.txt (diff)

差异

diff -r 8c562e5f3973 -r 8b364150de99 Unbounded/unbounded_array.adb

--- a/Unbounded/unbounded_array.adb Thu Oct 03 15:48:38 2019 +0400

+++ b/Unbounded/unbounded_array.adb Fri Oct 04 03:16:57 2019 +0400

		@@ -994,6 +994,10 @@
994	994	Raise_Exception(Buffer_Locked'Identity,
995	995	"Buffer is locked for change");
996	996	end if;
	997	+ if SR.UTF32 then
	998	+ Raise_Exception(Illegal_Unicode'Identity,
	999	+ "Have not support operaiton for operand`s types");
	1000	+ end if;
997	1001	-- Check index first
998	1002	if Before > SR.Last + 1 then
999	1003	raise Array_Index_Error;

		@@ -1018,7 +1022,7 @@
1018	1022	end Insert;
1019	1023
1020	1024	procedure Unbounded_Slice
1021		- (Source : in out Unbounded_Array_Type;
	1025	+ (Source : Unbounded_Array_Type;
1022	1026	Target : out Unbounded_Array_Type;
1023	1027	Low : Positive;
1024	1028	High : Natural)

		@@ -1052,9 +1056,6 @@
1052	1056	end if;
1053	1057	if Low > High then
1054	1058	Target.Reference := Empty_Referenced_Buffer'Access;
1055		- if SR = TR and then Is_One(SR.Counter) then
1056		- Source.Reference := Empty_Referenced_Buffer'Access;
1057		- end if;
1058	1059	Unreference (TR);
1059	1060	return;
1060	1061	end if;

		@@ -1063,9 +1064,6 @@
1063	1064	DR.Data (1 .. DL) := SR.Data (Low .. High);
1064	1065	DR.Last := DL;
1065	1066	Target.Reference := DR;
1066		- if SR = TR and then Is_One(SR.Counter) then
1067		- Source.Reference := DR;
1068		- end if;
1069	1067	Unreference (TR);
1070	1068	end Unbounded_Slice;
1071	1069

		@@ -2365,7 +2363,7 @@
2365	2363	end Length32;
2366	2364
2367	2365	procedure Unbounded_Slice_32
2368		- (Source : in out Unbounded_Array_Type;
	2366	+ (Source : in Unbounded_Array_Type;
2369	2367	Target : out Unbounded_Array_Type;
2370	2368	Low : Positive;
2371	2369	High : Natural)

		@@ -2423,9 +2421,6 @@
2423	2421	end if;
2424	2422	if Low > High then
2425	2423	Target.Reference := Empty_Referenced_Buffer'Access;
2426		- if SR = TR and then Is_One(SR.Counter) then
2427		- Source.Reference := Empty_Referenced_Buffer'Access;
2428		- end if;
2429	2424	Unreference (TR);
2430	2425	return;
2431	2426	end if;

		@@ -2443,11 +2438,172 @@
2443	2438	DR.UTF32 := True;
2444	2439	end;
2445	2440	end;
2446		- if SR = TR and then Is_One(SR.Counter) then
2447		- Source.Reference := DR;
2448		- end if;
2449	2441	Unreference (TR);
2450	2442	end Unbounded_Slice_32;
2451	2443
	2444	+ function Replace_Slice
	2445	+ (Source : Unbounded_Array_Type;
	2446	+ Low : Positive;
	2447	+ High : Natural;
	2448	+ By : String_32) return Unbounded_Array_Type
	2449	+ is
	2450	+ SR : constant Referenced_Buffer_Access := Source.Reference;
	2451	+ SL : Natural;
	2452	+ DL : Natural;
	2453	+ DR : Referenced_Buffer_Access;
	2454	+ SB : Positive := By'First;
	2455	+ BL : Natural := By'Length;
	2456	+ EB : Positive := By'Last;
	2457	+ begin
	2458	+ if not Is_One(SR.Lock_Counter) then
	2459	+ Raise_Exception(Buffer_Locked'Identity,
	2460	+ "Buffer is locked for change");
	2461	+ end if;
	2462	+ if not SR.UTF32 then
	2463	+ Raise_Exception(Illegal_Unicode'Identity,
	2464	+ "Have not support operaiton for operand`s types");
	2465	+ end if;
	2466	+ if SR.Last rem 4 /= 0 then
	2467	+ Raise_Exception(Illegal_Unicode'Identity,
	2468	+ "Illegal buffer length");
	2469	+ end if;
	2470	+ if BL = 0 then
	2471	+ DR := SR;
	2472	+ Reference(SR);
	2473	+ return (AF.Controlled with Reference => DR);
	2474	+ end if;
	2475	+ SL := SR.Last/4;
	2476	+ declare
	2477	+ subtype SM is String_32(1 .. SL);
	2478	+ package TP is new ATOAC(SM);
	2479	+ Source_Ptr : TP.Object_Pointer :=
	2480	+ TP.To_Pointer(SR.Data(1)'Address);
	2481	+ SA : SM renames Source_Ptr.all;
	2482	+ begin
	2483	+ if Low > SL + 1 then
	2484	+ Raise_Exception(Array_Index_Error'Identity,
	2485	+ "Illegal position values");
	2486	+ end if;
	2487	+ if High >= Low then
	2488	+ DL := BL + SL + Low - Integer'Min (High, SL) - 1;
	2489	+ -- This is the number of characters remaining in the string after
	2490	+ -- replacing the slice.
	2491	+ -- Result is empty string, reuse empty shared string
	2492	+ if DL = 0 then
	2493	+ DR := Empty_Referenced_Buffer'Access;
	2494	+ -- Otherwise allocate new shared string and fill it
	2495	+ else
	2496	+ if By(SB) = BOM32 then
	2497	+ SB := SB + 1;
	2498	+ DL := DL - 1;
	2499	+ BL := BL - 1;
	2500	+ end if;
	2501	+ if SB > EB then
	2502	+ DR := SR;
	2503	+ Reference(SR);
	2504	+ return (AF.Controlled with Reference => DR);
	2505	+ end if;
	2506	+ DR := Allocate (4*DL);
	2507	+ declare
	2508	+ subtype DSM is String_32(1 .. DL);
	2509	+ package DTP is new ATOAC(DSM);
	2510	+ Result_Ptr : DTP.Object_Pointer :=
	2511	+ DTP.To_Pointer(DR.Data(1)'Address);
	2512	+ DA : DSM renames Result_Ptr.all;
	2513	+ begin
	2514	+ DA(1 .. Low - 1) := SA(1 .. Low - 1);
	2515	+ DA(Low .. Low + BL - 1) := By(SB .. EB);
	2516	+ DA(Low + BL .. DL) := SA(High + 1 .. SL);
	2517	+ DR.Last := 4*DL;
	2518	+ DR.UTF32 := True;
	2519	+ end;
	2520	+ end if;
	2521	+ return (AF.Controlled with Reference => DR);
	2522	+ -- Otherwise just insert string
	2523	+ else
	2524	+ return Insert (Source, Low, By);
	2525	+ end if;
	2526	+ end;
	2527	+ end Replace_Slice;
	2528	+
	2529	+ function Insert
	2530	+ (Source : Unbounded_Array_Type;
	2531	+ Before : Positive;
	2532	+ New_Item : String_32) return Unbounded_Array_Type
	2533	+ is
	2534	+ SR : constant Referenced_Buffer_Access := Source.Reference;
	2535	+ DL : Natural;
	2536	+ SL : Natural;
	2537	+ NL : Natural := New_Item'Length;
	2538	+ SN : Positive := New_Item'First;
	2539	+ EN : Positive := New_Item'Last;
	2540	+ DR : Referenced_Buffer_Access;
	2541	+ begin
	2542	+ if not Is_One(SR.Lock_Counter) then
	2543	+ Raise_Exception(Buffer_Locked'Identity,
	2544	+ "Buffer is locked for change");
	2545	+ end if;
	2546	+ if not SR.UTF32 then
	2547	+ Raise_Exception(Illegal_Unicode'Identity,
	2548	+ "Have not support operaiton for operand`s types");
	2549	+ end if;
	2550	+ if SR.Last rem 4 /= 0 then
	2551	+ Raise_Exception(Illegal_Unicode'Identity,
	2552	+ "Illegal buffer length");
	2553	+ end if;
	2554	+ if NL = 0 then
	2555	+ DR := SR;
	2556	+ Reference(SR);
	2557	+ return (AF.Controlled with Reference => DR);
	2558	+ end if;
	2559	+ SL := SR.Last/4;
	2560	+ declare
	2561	+ subtype SM is String_32(1 .. SL);
	2562	+ package TP is new ATOAC(SM);
	2563	+ Source_Ptr : TP.Object_Pointer :=
	2564	+ TP.To_Pointer(SR.Data(1)'Address);
	2565	+ SA : SM renames Source_Ptr.all;
	2566	+ begin
	2567	+ -- Check index first
	2568	+ if Before > SL + 1 then
	2569	+ Raise_Exception(Array_Index_Error'Identity,
	2570	+ "Illegal position values");
	2571	+ end if;
	2572	+ DL := SL + NL;
	2573	+ -- Inserted string is empty, reuse source shared string
	2574	+ if NL = 0 then
	2575	+ Reference (SR);
	2576	+ DR := SR;
	2577	+ -- Otherwise, allocate new shared string and fill it
	2578	+ else
	2579	+ if New_Item(SN) = BOM32 then
	2580	+ SN := SN + 1;
	2581	+ NL := NL - 1;
	2582	+ DL := DL - 1;
	2583	+ end if;
	2584	+ if SN > EN then
	2585	+ DR := SR;
	2586	+ Reference(SR);
	2587	+ return (AF.Controlled with Reference => DR);
	2588	+ end if;
	2589	+ DR := Allocate (4DL + 4DL / Growth_Factor);
	2590	+ declare
	2591	+ subtype DSM is String_32(1 .. DL);
	2592	+ package DTP is new ATOAC(DSM);
	2593	+ Result_Ptr : DTP.Object_Pointer :=
	2594	+ DTP.To_Pointer(DR.Data(1)'Address);
	2595	+ DA : DSM renames Result_Ptr.all;
	2596	+ begin
	2597	+ DA(1 .. Before - 1) := SA(1 .. Before - 1);
	2598	+ DA(Before .. Before + NL - 1) := New_Item(SN .. EN);
	2599	+ DA(Before + NL .. DL) := SA(Before .. SL);
	2600	+ end;
	2601	+ DR.Last := 4*DL;
	2602	+ DR.UTF32 := True;
	2603	+ end if;
	2604	+ end;
	2605	+ return (AF.Controlled with Reference => DR);
	2606	+ end Insert;
	2607	+
2452	2608
2453	2609	end Unbounded_Array;

diff -r 8c562e5f3973 -r 8b364150de99 Unbounded/unbounded_array.ads

--- a/Unbounded/unbounded_array.ads Thu Oct 03 15:48:38 2019 +0400

+++ b/Unbounded/unbounded_array.ads Fri Oct 04 03:16:57 2019 +0400

		@@ -214,13 +214,13 @@
214	214	High : Natural) return Unbounded_Array_Type;
215	215
216	216	procedure Unbounded_Slice
217		- (Source : in out Unbounded_Array_Type;
	217	+ (Source : Unbounded_Array_Type;
218	218	Target : out Unbounded_Array_Type;
219	219	Low : Positive;
220	220	High : Natural);
221	221
222	222	procedure Unbounded_Slice_32
223		- (Source : in out Unbounded_Array_Type;
	223	+ (Source : Unbounded_Array_Type;
224	224	Target : out Unbounded_Array_Type;
225	225	Low : Positive;
226	226	High : Natural);

		@@ -243,6 +243,12 @@
243	243	High : Natural;
244	244	By : String) return Unbounded_Array_Type;
245	245
	246	+ function Replace_Slice
	247	+ (Source : Unbounded_Array_Type;
	248	+ Low : Positive;
	249	+ High : Natural;
	250	+ By : String_32) return Unbounded_Array_Type;
	251	+
246	252	procedure Replace_Slice
247	253	(Source : in out Unbounded_Array_Type;
248	254	Low : Positive;

		@@ -265,6 +271,11 @@
265	271	Before : Positive;
266	272	New_Item : String) return Unbounded_Array_Type;
267	273
	274	+ function Insert
	275	+ (Source : Unbounded_Array_Type;
	276	+ Before : Positive;
	277	+ New_Item : String_32) return Unbounded_Array_Type;
	278	+
268	279	procedure Insert
269	280	(Source : in out Unbounded_Array_Type;
270	281	Before : Positive;

diff -r 8c562e5f3973 -r 8b364150de99 tester/output-01.txt

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/tester/output-01.txt Fri Oct 04 03:16:57 2019 +0400

		@@ -0,0 +1,12 @@
	1	+UTF-8 - входной файл без BOM.
	2	+Конец файла.
	3	+UTF-8 - входной файл без BOM.
	4	+Конец файла.
	5	+UTF-8 - входной файл без BOM.
	6	+Конец файла.
	7	+UTF-8 - входной файл без BOM.
	8	+Конец файла.
	9	+UTF-8 - входной файл без BOM.
	10	+Конец файла.
	11	+UTF-8 - входной файл без BOM.
	12	+Конец файла.

diff -r 8c562e5f3973 -r 8b364150de99 tester/unbounded_tester.adb

--- a/tester/unbounded_tester.adb Thu Oct 03 15:48:38 2019 +0400

+++ b/tester/unbounded_tester.adb Fri Oct 04 03:16:57 2019 +0400

		@@ -48,11 +48,28 @@
48	48	-- 3,
49	49	-- Length32(Unicode_Array) - 1
50	50	-- );
51		- Unbounded_Slice_32(Unicode_Array,
52		- Unicode_Array,
53		- 3,
54		- Length32(Unicode_Array) - 1
55		- );
	51	+-- Unbounded_Slice_32(Unicode_Array,
	52	+-- Unicode_Array,
	53	+-- 3,
	54	+-- Length32(Unicode_Array) - 1
	55	+-- );
	56	+ declare
	57	+ Slice_Str : String_32 := Slice(Unicode_Array,
	58	+ 3,
	59	+ Length32(Unicode_Array) - 1);
	60	+ String_01 : String_32 := Slice(Unicode_Array,
	61	+ 1,
	62	+ 10);
	63	+ begin
	64	+ Unicode_Array := Replace_Slice(Unicode_Array,
	65	+ 3,
	66	+ 0,
	67	+ String_01);
	68	+ Unicode_Array := Replace_Slice(Unicode_Array,
	69	+ 1,
	70	+ Length32(Unicode_Array),
	71	+ Slice_Str);
	72	+ end;
56	73	Unicode_Array := To_Ut8(Unicode_Array, True);
57	74	Create(Output_File,
58	75	Out_File,

Show on old repository browser

Portable Assembler Framework ForkPAFAda95FL

Ada95FL: 提交

Commit MetaInfo

Log Message

更改概述

差异

Portable Assembler Framework
Fork
PAF
Ada95FL