taste-semantic_check.adb 10.7 KB
Newer Older
1
with Ada.Strings.Unbounded,
2
     Ada.Characters.Handling,  --  To_Lower
3
     Ada.Containers,
4
     TASTE.Deployment_View,
Maxime Perrotin's avatar
Maxime Perrotin committed
5
     TASTE.Interface_View,
6
7
8
     TASTE.Parser_Utils;

use Ada.Strings.Unbounded,
9
    Ada.Containers,
10
    Ada.Characters.Handling,
11
    TASTE.Deployment_View,
Maxime Perrotin's avatar
Maxime Perrotin committed
12
    TASTE.Interface_View,
13
    TASTE.Interface_View.Interfaces_Maps,
14
15
16
    TASTE.Parser_Utils;

package body TASTE.Semantic_Check is
17
   --  use String_Vectors;
18
19
   procedure Check_Model (Model : TASTE_Model) is
      use Option_Partition;
20
      Opt_Part     : Option_Partition.Option;
21
      Found_Error  : Boolean := False;
22
23
24
      --  Allow case insensitive checks of unbounded strings:
      function "="(A, B : Unbounded_String) return Boolean is
          (To_Lower (To_String (A)) = (To_Lower (To_String (B))));
Maxime Perrotin's avatar
Maxime Perrotin committed
25
26

      Error_Found : Boolean := False;
27
   begin
28
29
30
31
32
      --  Checks done when generating skeletons
      for Each of Model.Interface_View.Flat_Functions loop
         --  SDL functions
         if Each.Language = "sdl" then
            for PI of Each.Provided loop
Maxime Perrotin's avatar
Maxime Perrotin committed
33
34
35
               --  Check that if a PI and a RI have the same name, they
               --  also have the same interface (since they are translated
               --  to a single "signal" in SDL)
36
37
               for RI of Each.Required loop
                  if PI.Name = RI.Name then --  Case insensitive check
Maxime Perrotin's avatar
Maxime Perrotin committed
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
                     if PI.Params.Length /= RI.Params.Length then
                        Error_Found := True;
                     else
                        for I in PI.Params.First_Index .. PI.Params.Last_Index
                        loop
                           --  Compare each param (name + type)
                           if PI.Params (I).Name /= RI.Params (I).Name
                               or PI.Params (I).Sort /= RI.Params (I).Sort
                           then
                              Error_Found := True;
                           end if;
                        end loop;
                     end if;
                     if Error_Found then
                        raise Semantic_Error with
                           "In SDL function " & To_String (Each.Name)
                           & ": PI and RI signatures shall be identical when "
                           & "interfaces have the same name - "
                           & To_String (PI.Name);
                     end if;
58
59
                  end if;
               end loop;
Maxime Perrotin's avatar
Maxime Perrotin committed
60
61
62
63
64
65
66
67
68
69
               --  Check that sporadic inputs only have one IN param at most
               if PI.RCM = Sporadic_Operation and then
                  (PI.Params.Length > 1 or (PI.Params.Length = 1 and
                  (for all Param of PI.Params => Param.Direction /= param_in)))
               then
                  raise Semantic_Error with
                   "In SDL function " & To_String (Each.Name) & ": sporadic "
                     & "interfaces shall have at most one IN parameter "
                     & "(fix " &  To_String (PI.Name) & ")";
               end if;
70
71
72
73
            end loop;
         end if;
      end loop;
      --  Checks done when generating glue
74
75
      if Model.Configuration.Glue then
         for Each of Model.Interface_View.Flat_Functions loop
76
            Opt_Part  := Model.Find_Binding (Each.Name);
77
            --  Check that each function is placed on a partition
78
            if not Each.Is_Type and then not Opt_Part.Has_Value then
79
80
81
82
               raise Semantic_Error with
                "In the deployment view, the function " & To_String (Each.Name)
                & " is not bound to any partition!";
            end if;
83
84
85

            --  Check that functions have at least one PI
            --  with the exception of GUIs and Blackbox devices
86
87
            if Each.Language /= "gui"
               and then Each.Language /= "blackbox_device"
88
89
90
91
92
93
94
               and then Each.Provided.Length = 0
            then
               raise Semantic_Error with
                  "Function " & To_String (Each.Name) & " has no provided "
                  & "interfaces, and dead code is not allowed";
            end if;

95
            --  Check that Simulink functions have exactly one PI and no RI
96
97
98
99
100
            if (Each.Language    = "simulink"
                or Each.Language = "qgenada"
                or Each.Language = "qgenc")
                and then (Each.Provided.Length /= 1
                          or Each.Required.Length /= 0)
101
102
            then
               raise Semantic_Error with
Maxime Perrotin's avatar
Maxime Perrotin committed
103
104
105
106
107
                  "Function " & To_String (Each.Name) & " must contain only "
                  & "one Provided Interface and no Required Interfaces";
            end if;

            --  Check that Simulink/QGen functions's PI is synchronous
108
109
110
            if Each.Language    = "simulink"
               or Each.Language = "qgenada"
               or Each.Language = "qgenc"
Maxime Perrotin's avatar
Maxime Perrotin committed
111
112
113
114
115
116
117
118
119
120
            then
               for PI of Each.Provided loop
                  if PI.RCM /= Unprotected_Operation
                     and PI.RCM /= Protected_Operation
                  then
                     raise Semantic_Error with "The provided interface of "
                     & "function " & To_String (Each.Name) & " must be either"
                     & " protected or unprotected, but not sporadic or cyclic";
                  end if;
               end loop;
121
122
            end if;

123
124
125
            --  GUI check:
            --  interfaces must all be sporadic
            if Each.Language = "gui"
126
            then
127
128
129
130
131
132
               for PI of Each.Provided loop
                  if PI.RCM /= Sporadic_Operation then
                     Put_Error ("PI " & To_String (PI.Name) & " shall be "
                        & " sporadic in GUI " & To_String (Each.Name));
                     Found_Error := True;
                  end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
133
               end loop;
134
135
136
137
138
139
               for RI of Each.Required loop
                  if RI.RCM /= Sporadic_Operation then
                     Put_Error ("RI " & To_String (RI.Name) & " shall be "
                        & " sporadic in GUI " & To_String (Each.Name));
                     Found_Error := True;
                  end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
140
               end loop;
141
142
143
144
               if Found_Error then
                  raise Semantic_Error with
                     "GUI interfaces must all be sporadic";
               end if;
145
            end if;
146
147

            for PI of Each.Provided loop
148
149
               --  Check that functions including at least one (un)protected
               --  interface are located on the same partition as their callers
150
151
152
153
               if not Each.Is_Type and then (PI.RCM = Protected_Operation
                                          or PI.RCM = Unprotected_Operation)
               then
                  for Remote of PI.Remote_Interfaces loop
154
155
                     if not Opt_Part.Unsafe_Just.Bound_Functions.Contains
                       (To_String (Remote.Function_Name))
156
157
158
159
160
161
162
163
164
                     then
                        raise Semantic_Error with "Function "
                        & To_String (Each.Name) & " and function "
                        & To_String (Remote.Function_Name) & " must be located"
                        & " on the same partition in the deployment view, "
                        & "because they share a synchronous interface";
                     end if;
                  end loop;
               end if;
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

               --  Check that Cyclic PIs are not connected and that they have
               --  no parameters.
               if PI.RCM = Cyclic_Operation and then
                  (PI.Remote_Interfaces.Length > 0 or PI.Params.Length > 0)
               then
                  raise Semantic_Error with "Interface " & To_String (PI.Name)
                  & " in function " & To_String (Each.Name) & " is incorrect: "
                  & "it shall have no parameters and shall not be connected";

                  --  Check that sporadic PIs have at most one IN pararmeter
               elsif PI.RCM = Sporadic_Operation and then
                  (PI.Params.Length > 1 or (PI.Params.Length = 1 and
                  (for all Param of PI.Params => Param.Direction /= param_in)))
               then
                  raise Semantic_Error with "Interface " & To_String (PI.Name)
                  & " in function " & To_String (Each.Name) & " is incorrect: "
                  & "it shall have at most one IN parameter (no OUT param)";
               end if;
184
185
            end loop;

Maxime Perrotin's avatar
Maxime Perrotin committed
186
            --  Component type/instance checks
187
188
189
190
            if Each.Is_Type
               and Each.Language /= "ada"
               and Each.Language /= "sdl"
               and Each.Language /= "cpp"
Maxime Perrotin's avatar
Maxime Perrotin committed
191
192
            then
               raise Semantic_Error with "Function " & To_String (Each.Name)
193
194
               & " can be a type only if it is implemented in Ada, C++ or SDL"
               & " (not " & To_String (Each.Language) & ")";
Maxime Perrotin's avatar
Maxime Perrotin committed
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
            end if;

            if Each.Instance_Of.Has_Value then
               begin
                  declare
                     Corresponding_Type : constant Taste_Terminal_Function :=
                        Model.Interface_View.Flat_Functions.Element
                           (To_String (Each.Instance_Of.Unsafe_Just));
                  begin
                     if not Corresponding_Type.Is_Type then
                        raise Semantic_Error with "Function "
                        & To_String (Each.Name) & " is an instance of "
                        & To_String (Corresponding_Type.Name) & " which is NOT"
                        & " a type";
                     end if;
210
211
212
213
214
215
216
217
218
219
220
221
222

                     --  Much check that PIs and RIs of type and instance match
                     for PI of Each.Provided loop
                        null;
                     end loop;

                     for RI of Each.Required loop
                        null;
                     end loop;

--                      raise Semantic_Error with "Interface mismatch between "
--                      & "functions " & To_String (Corresponding_Type.Name) &
--                      " (type) and " & To_String (Each.Name) & " (instance)";
Maxime Perrotin's avatar
Maxime Perrotin committed
223
224
225
                  end;
               exception
                  when Constraint_Error =>
226
227
228
229
230
231
232
233
234
235
                     --  if the component type is not in the model,
                     --  it may not be an error: it could be a shared type
                     if not Model.Configuration.Shared_Types.Contains
                       (To_String (Each.Instance_Of.Unsafe_Just))
                     then
                        raise Semantic_Error with "Function not found : "
                          & To_String (Each.Instance_Of.Unsafe_Just)
                          & " (specified as type of function "
                          & To_String (Each.Name) & ")";
                     end if;
Maxime Perrotin's avatar
Maxime Perrotin committed
236
237
               end;
            end if;
238
239
240
241
242
         end loop;
      end if;
   end Check_Model;

end TASTE.Semantic_Check;