← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/adacontrol/jaunty

« back to all changes in this revision

Viewing changes to src/rules-real_operators.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-08-24 08:44:11 UTC
  • Revision ID: james.westby@ubuntu.com-20060824084411-1r15uio1h75lqgpx
Tags: upstream-1.4r20
Import upstream version 1.4r20

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/rules-real_operators.adb
 
1
----------------------------------------------------------------------
 
2
--  Rules.Real_Operators - Package body                             --
 
3
--                                                                  --
 
4
--  This software  is (c) The European Organisation  for the Safety --
 
5
--  of Air  Navigation (EUROCONTROL) and Adalog  2004-2005. The Ada --
 
6
--  Controller  is  free software;  you can redistribute  it and/or --
 
7
--  modify  it under  terms of  the GNU  General Public  License as --
 
8
--  published by the Free Software Foundation; either version 2, or --
 
9
--  (at your  option) any later version.  This  unit is distributed --
 
10
--  in the hope  that it will be useful,  but WITHOUT ANY WARRANTY; --
 
11
--  without even the implied warranty of MERCHANTABILITY or FITNESS --
 
12
--  FOR A  PARTICULAR PURPOSE.  See the GNU  General Public License --
 
13
--  for more details.   You should have received a  copy of the GNU --
 
14
--  General Public License distributed  with this program; see file --
 
15
--  COPYING.   If not, write  to the  Free Software  Foundation, 59 --
 
16
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.           --
 
17
--                                                                  --
 
18
--  As  a special  exception, if  other files  instantiate generics --
 
19
--  from the units  of this program, or if you  link this unit with --
 
20
--  other files  to produce  an executable, this  unit does  not by --
 
21
--  itself cause the resulting executable  to be covered by the GNU --
 
22
--  General  Public  License.   This  exception  does  not  however --
 
23
--  invalidate any  other reasons why the executable  file might be --
 
24
--  covered by the GNU Public License.                              --
 
25
--                                                                  --
 
26
--  This  software is  distributed  in  the hope  that  it will  be --
 
27
--  useful,  but WITHOUT  ANY  WARRANTY; without  even the  implied --
 
28
--  warranty  of  MERCHANTABILITY   or  FITNESS  FOR  A  PARTICULAR --
 
29
--  PURPOSE.                                                        --
 
30
----------------------------------------------------------------------
 
31
 
 
32
-- Ada
 
33
with
 
34
  Ada.Strings.Wide_Unbounded;
 
35
 
 
36
-- Asis
 
37
with
 
38
  Asis,
 
39
  Asis.Elements,
 
40
  Asis.Expressions;
 
41
 
 
42
-- Adalog
 
43
with
 
44
  Thick_Queries,
 
45
  Utilities;
 
46
 
 
47
-- Adactl
 
48
with
 
49
  Framework.Language,
 
50
  Framework.Rules_Manager,
 
51
  Framework.Reports;
 
52
 
 
53
package body Rules.Real_Operators is
 
54
   use Framework;
 
55
 
 
56
   Rule_Used  : Boolean := False;
 
57
   Save_Used  : Boolean;
 
58
   Rule_Type  : Rule_Types;
 
59
   Rule_Label : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
 
60
 
 
61
   ----------
 
62
   -- Help --
 
63
   ----------
 
64
 
 
65
   procedure Help is
 
66
      use Utilities;
 
67
   begin
 
68
      User_Message ("Rule: " & Rule_Id);
 
69
      User_Message ("Parameter(s): None");
 
70
      User_Message ("Control occurrences of = or /= operators with real types");
 
71
   end Help;
 
72
 
 
73
   -------------
 
74
   -- Add_Use --
 
75
   -------------
 
76
 
 
77
   procedure Add_Use (Label         : in Wide_String;
 
78
                      Rule_Use_Type : in Rule_Types) is
 
79
      use Ada.Strings.Wide_Unbounded;
 
80
      use Framework.Language;
 
81
 
 
82
   begin
 
83
      if Parameter_Exists then
 
84
         Parameter_Error ("No parameter for rule " & Rule_Id);
 
85
      end if;
 
86
 
 
87
      if Rule_Used then
 
88
         Parameter_Error (Rule_Id & ": this rule can be specified only once");
 
89
      else
 
90
         Rule_Type  := Rule_Use_Type;
 
91
         Rule_Label := To_Unbounded_Wide_String (Label);
 
92
         Rule_Used  := True;
 
93
      end if;
 
94
   end Add_Use;
 
95
 
 
96
   -------------
 
97
   -- Command --
 
98
   -------------
 
99
 
 
100
   procedure Command (Action : Framework.Rules_Manager.Rule_Action) is
 
101
      use Framework.Rules_Manager;
 
102
   begin
 
103
      case Action is
 
104
         when Clear =>
 
105
            Rule_Used := False;
 
106
         when Suspend =>
 
107
            Save_Used := Rule_Used;
 
108
            Rule_Used := False;
 
109
         when Resume =>
 
110
            Rule_Used := Save_Used;
 
111
      end case;
 
112
   end Command;
 
113
 
 
114
   ---------------------------
 
115
   -- Process_Function_Call --
 
116
   ---------------------------
 
117
 
 
118
   procedure Process_Function_Call (Call : in Asis.Expression) is
 
119
      use Ada.Strings.Wide_Unbounded, Asis, Asis.Elements,
 
120
          Asis.Expressions, Framework.Reports, Thick_Queries;
 
121
   begin
 
122
      if not Rule_Used then
 
123
         return;
 
124
      end if;
 
125
      Rules_Manager.Enter (Rule_Id);
 
126
 
 
127
      -- Ruler calls us for all operators.  Check type of operator.
 
128
      case Operator_Kind (Prefix (Call)) is
 
129
         when An_Equal_Operator
 
130
           | A_Not_Equal_Operator
 
131
           =>
 
132
            -- Now check the context in which the operator is used and report
 
133
            -- errors according to the following rules
 
134
 
 
135
            -- 1) if    the left  parameter is not universal, print the message
 
136
            --    according to it
 
137
            --
 
138
            -- 2) elsif the right parameter is not universal, print the message
 
139
            --    according to it
 
140
            --
 
141
            -- 3) else we must be in a context like: if 0.0 = 1.0 theni ....
 
142
 
 
143
            declare
 
144
               Parsed_First_Parameter : Boolean := False;
 
145
               F : constant Asis.Association_List := Function_Call_Parameters (Call);
 
146
            begin
 
147
               Parameter_Loop: for I in F'RANGE loop
 
148
                  declare
 
149
                     P : constant Asis.Expression  := Actual_Parameter (F (I));
 
150
                     T : constant Asis.Declaration := Ultimate_Expression_Type (P);
 
151
                  begin
 
152
                     case Type_Kind (T) is
 
153
                        when A_Root_Type_Definition =>
 
154
                           case Root_Type_Kind (T) is
 
155
                              when A_Root_Real_Definition => -- 3.4.1(8)
 
156
                                 Report
 
157
                                 (Rule_Id,
 
158
                                  To_Wide_String (Rule_Label),
 
159
                                  Rule_Type,
 
160
                                  Get_Location (Call),
 
161
                                  "equality or inequality with Root Real !!!");
 
162
                              when A_Universal_Real_Definition => -- 3.4.1(6)
 
163
                                 if Parsed_First_Parameter then
 
164
                                    Report
 
165
                                    (Rule_Id,
 
166
                                     To_Wide_String (Rule_Label),
 
167
                                     Rule_Type,
 
168
                                     Get_Location (Call),
 
169
                                     "equality or inequality with two Universal Real constants !!!");
 
170
                                 else
 
171
                                    Parsed_First_Parameter := True;
 
172
                                 end if;
 
173
                              when others =>
 
174
                                 null;
 
175
                           end case;
 
176
                        when A_Floating_Point_Definition => -- 3.5.7(2)
 
177
                           Report
 
178
                           (Rule_Id,
 
179
                            To_Wide_String (Rule_Label),
 
180
                            Rule_Type,
 
181
                            Get_Location (Call),
 
182
                            "equality or inequality with Floating Point");
 
183
                            exit Parameter_Loop;
 
184
                        when An_Ordinary_Fixed_Point_Definition => -- 3.5.9(3)
 
185
                           Report
 
186
                           (Rule_Id,
 
187
                            To_Wide_String (Rule_Label),
 
188
                            Rule_Type,
 
189
                            Get_Location (Call),
 
190
                            "equality or inequality with Binary Fixed Point");
 
191
                            exit Parameter_Loop;
 
192
                         when A_Decimal_Fixed_Point_Definition => -- 3.5.9(4)
 
193
                           Report
 
194
                           (Rule_Id,
 
195
                            To_Wide_String (Rule_Label),
 
196
                            Rule_Type,
 
197
                            Get_Location (Call),
 
198
                            "equality or inequality with Decimal Fixed Point");
 
199
                            exit Parameter_Loop;
 
200
                       when others =>
 
201
                           null;
 
202
                     end case;
 
203
                  end;
 
204
               end loop Parameter_Loop;
 
205
            end;
 
206
 
 
207
         when others =>
 
208
            -- Including Not_An_Operator
 
209
            null;
 
210
      end case;
 
211
   end Process_Function_Call;
 
212
 
 
213
begin
 
214
   Framework.Rules_Manager.Register (Rule_Id,
 
215
                                     Help    => Help'Access,
 
216
                                     Add_Use => Add_Use'Access,
 
217
                                     Command => Command'Access);
 
218
end Rules.Real_Operators;