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
136
137
138
139
140
141
142
143
144
145 | ------------------------------------------------------------------------------
-- --
-- TGen --
-- --
-- Copyright (C) 2022, AdaCore --
-- --
-- TGen is free software; you can redistribute it and/or modify it under --
-- under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This software is distributed in the hope that it will be --
-- useful but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and a --
-- copy of the GCC Runtime Library Exception along with this program; see --
-- the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
------------------------------------------------------------------------------
--
-- Random value generation strategies. For the moment this concerns only
-- static generation strategies, but will also be applicable to dynamic
-- generation later on.
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with TGen.JSON; use TGen.JSON;
with TGen.Strings; use TGen.Strings;
with TGen.Types; use TGen.Types;
package TGen.Strategies is
type Generation_Context is tagged null record;
-- Context for the generation of parameter values. For now, no information
-- is needed as generation is not contextual.
type Strategy_Kind is
(Random_Kind, State_Kind, Dispatching_Kind, Wrapping_Kind);
package Disc_Value_Maps is new Ada.Containers.Indefinite_Hashed_Maps
(Key_Type => Unbounded_String,
Element_Type => JSON_Value,
Hash => Ada.Strings.Unbounded.Hash,
Equivalent_Keys => "=",
"=" => TGen.JSON."=");
subtype Disc_Value_Map is Disc_Value_Maps.Map;
type Strategy_Type is abstract tagged null record;
function Generate
(S : in out Strategy_Type;
Disc_Context : Disc_Value_Map) return JSON_Value
is abstract;
-- Create a un-encoded value according to S. This means, for discrete type
-- values, that the generated JSON value should be of kind Integer, instead
-- of their stringified version, so it can be re-used more efficiently in
-- other contexts (e.g. as index constraints or as discriminant
-- constraints). The values generated by this will be converted to
-- something parsable by the marshallers through the Encode primitive of
-- the corresponding type representation.
type Strategy_Acc is access all Strategy_Type'Class;
type Unimplemented_Strategy_Type is new Strategy_Type with
null record;
overriding function Generate
(S : in out Unimplemented_Strategy_Type;
Disc_Context : Disc_Value_Map) return JSON_Value
is
(raise Program_Error with "Unimplemented static strategy");
type Commented_Out_Strategy_Type is new Strategy_Type with
null record;
-- Strategy that generates comments stating that the user should fill in
-- a valid value.
overriding function Generate
(S : in out Commented_Out_Strategy_Type;
Disc_Context : Disc_Value_Map) return JSON_Value;
type Basic_Strategy_Type is new Strategy_Type with record
T : SP.Ref;
-- A generic strategy will always need to store the type it references,
-- to do introspection and know, e.g. the bounds of the type if it is a
-- scalar type.
F : access function (T : Typ'Class) return JSON_Value;
-- The actual generation function. See below the instantiation of the
-- Generate function.
end record;
overriding function Generate
(S : in out Basic_Strategy_Type;
Disc_Context : Disc_Value_Map) return JSON_Value
is
(S.F (S.T.Get));
type Dispatching_Strategy_Type is new Strategy_Type with
record
Bias : Float;
S1, S2 : Strategy_Acc;
end record;
-- This strategy dispatches the generation to two strategies, according
-- to a certain bias. This is useful when mixing two strategies, e.g.
-- a random one and an enumerative one.
overriding function Generate
(S : in out Dispatching_Strategy_Type;
Disc_Context : Disc_Value_Map) return JSON_Value;
function Make_Dispatching_Strat
(S1, S2 : Strategy_Type'Class;
Bias : Float := 0.5) return Dispatching_Strategy_Type;
generic
type Equivalence_Class_Type is private;
with package Equivalence_Classes_Vectors is
new Ada.Containers.Vectors
(Index_Type => Positive, Element_Type => Equivalence_Class_Type);
package Equivalence_Classes_Strategy_Package is
type Equivalence_Class_Strategy_Type is new Strategy_Type with
record
T : SP.Ref;
Classes : Equivalence_Classes_Vectors.Vector;
Draw : access function
(T : SP.Ref;
Class : Equivalence_Class_Type) return JSON_Value;
end record;
-- This strategy implements equivalence classes strategy, i.e.
-- strategies where we will pick in an equivalence class each time
-- we are generating a value. Note that we can pick several time a value
-- from the same equivalence class. TODO: fix this?
overriding function Generate
(S : in out Equivalence_Class_Strategy_Type;
Disc_Context : Disc_Value_Map) return JSON_Value;
end Equivalence_Classes_Strategy_Package;
end TGen.Strategies;
|