1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
with String_Utils; use String_Utils;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.IO; use GNAT.IO;
with GNATCOLL.Templates; use GNATCOLL.Templates;
with Ada.Strings.Unbounded;
procedure Test_Strings is
procedure Output (Data, Result : Argument_List);
procedure Subst (Str, Result : String; Recurse : Boolean := False);
function Subst_Callback (Param : String; Quoted : Boolean) return String;
--------------------
-- Subst_Callback --
--------------------
function Subst_Callback (Param : String; Quoted : Boolean) return String is
pragma Unreferenced (Quoted);
begin
if Param = "1" then
return "foo";
elsif Param = "2" then
return "(%1)";
elsif Param = "1-" then
return "minus";
else
return "ERROR, Param was (" & Param & ")";
end if;
end Subst_Callback;
-----------
-- Subst --
-----------
procedure Subst (Str, Result : String; Recurse : Boolean := False) is
Output : constant String := Substitute
(Str,
Delimiter => '%',
Callback => Subst_Callback'Unrestricted_Access,
Recursive => Recurse);
begin
if Output /= Result then
Put_Line ("Error when substituting " & Str);
Put_Line (" Got " & Output & "--");
Put_Line (" Expecting " & Result & "--");
end if;
end Subst;
------------
-- Output --
------------
procedure Output (Data, Result : Argument_List) is
use Ada.Strings.Unbounded;
Args : Argument_List_Access;
Str : Unbounded_String;
Valid : Boolean;
begin
for R in Data'Range loop
Str := Str & Data (R).all;
if R /= Data'Last then
Str := Str & ' ';
end if;
end loop;
Args :=
Argument_String_To_List_With_Triple_Quotes (To_String (Str));
Valid := Args'Length = Result'Length;
if Valid then
for A in Args'Range loop
if Args (A).all /= Result (A - Args'First + Result'First).all then
Valid := False;
Put_Line ("Error while splitting --" & To_String (Str) & "--");
Put_Line (" Arg (" & A'Img & ")=" & Args (A).all);
Put_Line
(" Expecting " & Result (A - Args'First + Result'First).all);
exit;
end if;
end loop;
end if;
end Output;
Quote : constant Character := '"';
Triple : constant String := """""""";
Foo : constant String_Access := new String'("foo");
Foofoo : constant String_Access := new String'("foo foo");
Qfoo : constant String_Access := new String'(Quote & "foo" & Quote);
Qqqfoo : constant String_Access := new String'(Triple & "foo" & Triple);
Bar : constant String_Access := new String'("bar");
Qbar : constant String_Access := new String'(Quote & "bar" & Quote);
Qfoofoo : constant String_Access := new String'(Quote & Foofoo.all & Quote);
Qqqfoofoo : constant String_Access := new String'
(Triple & "foo foo" & Triple);
Bfoo : constant String_Access := new String'("\""Foo");
Qbfoo : constant String_Access := new String'(Quote & "\""Foo" & Quote);
Qbfoofoo : constant String_Access :=
new String'(Quote & "Foo\""Foo" & Quote);
Fooqqq : constant String_Access :=
new String'("(" & Triple & "foo" & Triple & ")");
begin
---------------------------------------
-- Tests for Argument_String_To_List --
---------------------------------------
-- Not quote => take backslash into account
Output ((Foo, Bar), (Foo, Bar));
Output ((Bfoo, Foo, Bar), (Bfoo, Foo, Bar));
-- Simple quotes always preserved: "foo" -> "foo"
Output ((Qfoo, Bar), (Qfoo, Bar));
Output ((Qfoo, Qbar), (Qfoo, Qbar));
Output ((Qfoofoo, Qbar), (Qfoofoo, Qbar));
Output ((Qbfoo, Foo, Bar), (Qbfoo, Foo, Bar));
Output ((Qbfoofoo, Qbfoofoo, Bar), (Qbfoofoo, Qbfoofoo, Bar));
-- Triple quotes remove when at start: """foo""" -> foo
Output ((Qqqfoo, Qbar), (Foo, Qbar));
Output ((Qqqfoofoo, Qbar), (Foofoo, Qbar)); -- Triple removed at start
-- Triple quotes not removed when in middle: ("""foo""") -> ("""foo""")
Output ((Fooqqq, Bar), (Fooqqq, Bar));
--------------------------
-- Tests for Substitute --
--------------------------
Subst ("%1", "foo");
Subst ("--%1--", "--minus-");
Subst ("(%1)", "(foo)"); -- DA17-001
Subst ("%1.prefix", "foo.prefix"); -- D713-012
Subst ("%2", "(foo)", True);
end Test_Strings;
|
