1----------------------------------------------------------------------
2--  Rules.Unsafe_Unchecked_Conversion - Package body                --
3--                                                                  --
4--  This software  is (c) SAGEM DS and  Adalog  2004-2006.  The Ada --
5--  Controller  is  free software;  you can redistribute  it and/or --
6--  modify  it under  terms of  the GNU  General Public  License as --
7--  published by the Free Software Foundation; either version 2, or --
8--  (at your  option) any later version.  This  unit is distributed --
9--  in the hope  that it will be useful,  but WITHOUT ANY WARRANTY; --
10--  without even the implied warranty of MERCHANTABILITY or FITNESS --
11--  FOR A  PARTICULAR PURPOSE.  See the GNU  General Public License --
12--  for more details.   You should have received a  copy of the GNU --
13--  General Public License distributed  with this program; see file --
14--  COPYING.   If not, write  to the  Free Software  Foundation, 59 --
15--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.           --
16--                                                                  --
17--  As  a special  exception, if  other files  instantiate generics --
18--  from the units  of this program, or if you  link this unit with --
19--  other files  to produce  an executable, this  unit does  not by --
20--  itself cause the resulting executable  to be covered by the GNU --
21--  General  Public  License.   This  exception  does  not  however --
22--  invalidate any  other reasons why the executable  file might be --
23--  covered by the GNU Public License.                              --
24--                                                                  --
25--  This  software is  distributed  in  the hope  that  it will  be --
26--  useful,  but WITHOUT  ANY  WARRANTY; without  even the  implied --
27--  warranty  of  MERCHANTABILITY   or  FITNESS  FOR  A  PARTICULAR --
28--  PURPOSE.                                                        --
29----------------------------------------------------------------------
30
31-- ASIS
32with
33  Asis.Declarations,
34  Asis.Elements,
35  Asis.Expressions;
36
37-- Adalog
38with
39  Thick_Queries,
40  Utilities;
41
42package body Rules.Unsafe_Unchecked_Conversion is
43   use Framework, Framework.Control_Manager;
44
45   Rule_Used : Boolean := False;
46   Save_Used : Boolean;
47   Context   : Basic_Rule_Context;
48
49   ----------
50   -- Help --
51   ----------
52
53   procedure Help is
54      use Utilities;
55   begin
56      User_Message ("Rule: " & Rule_Id);
57      User_Message ("Control unsafe usage of Unchecked_Conversion");
58      User_Message;
59      User_Message ("Parameter(s): none");
60   end Help;
61
62   -----------------
63   -- Add_Control --
64   -----------------
65
66   procedure Add_Control (Ctl_Label : in Wide_String; Ctl_Kind : in Control_Kinds) is
67      use Framework.Language;
68
69   begin
70      if Rule_Used then
71         Parameter_Error (Rule_Id, "rule already specified");
72      end if;
73
74      if Parameter_Exists then
75         Parameter_Error (Rule_Id, "no parameter for rule");
76      end if;
77
78      Context   := Basic.New_Context (Ctl_Kind, Ctl_Label);
79      Rule_Used := True;
80   end Add_Control;
81
82   -------------
83   -- Command --
84   -------------
85
86   procedure Command (Action : Framework.Rules_Manager.Rule_Action) is
87      use Framework.Rules_Manager;
88   begin
89      case Action is
90         when Clear =>
91            Rule_Used := False;
92         when Suspend =>
93            Save_Used := Rule_Used;
94            Rule_Used := False;
95         when Resume =>
96            Rule_Used := Save_Used;
97      end case;
98   end Command;
99
100
101   --------------------------
102   -- Process_Instantation --
103   --------------------------
104
105   procedure Process_Instantiation (Instantiation : in Asis.Declaration) is
106      use Asis, Asis.Declarations, Asis.Expressions;
107      use Framework.Reports, Thick_Queries, Utilities;
108
109      Source, Target : Asis.Expression;
110      S_Size, T_Size : Biggest_Int;
111      Assocs : Asis.Association_List (1..2);
112
113      Not_Specified : constant Biggest_Int := -1;
114
115      function Size_Value (Type_Name : Asis.Expression) return Biggest_Int is
116         use Asis.Elements;
117         Expr : Asis.Expression;
118      begin
119         Expr := Attribute_Clause_Expression (A_Size_Attribute, Type_Name);
120         if Is_Nil (Expr) then
121            return Not_Specified;
122         end if;
123
124         declare
125            Val : constant Extended_Biggest_Natural := Discrete_Static_Expression_Value (Expr);
126         begin
127            if Val = Not_Static then
128               Uncheckable (Rule_Id,
129                            False_Positive,
130                            Get_Location (Type_Name),
131                            "unable to evaluate size clause value for " & Name_Image (Type_Name));
132               return Not_Specified;
133            else
134               return Val;
135            end if;
136         end;
137      end Size_Value;
138
139      Reported : Boolean := False;
140   begin  -- Process_Instantiation
141      if not Rule_Used then
142         return;
143      end if;
144      Rules_Manager.Enter (Rule_Id);
145
146      declare
147         Name_Image : constant Wide_String := To_Upper (Full_Name_Image
148                                                        (Ultimate_Name
149                                                         (Generic_Unit_Name (Instantiation))));
150      begin
151         if Name_Image /= "ADA.UNCHECKED_CONVERSION" and Name_Image /= "UNCHECKED_CONVERSION" then
152            -- In Gnat, Unchecked_Conversion is not a renaming of Ada.Unchecked_Conversion
153            return;
154         end if;
155      end;
156
157      Assocs := Generic_Actual_Part (Instantiation);
158      Source := Simple_Name (Actual_Parameter (Assocs (1)));
159      Target := Simple_Name (Actual_Parameter (Assocs (2)));
160
161      if Is_Class_Wide_Subtype (Source) then
162         Report (Rule_Id,
163                 Context,
164                 Get_Location (Source),
165                 "class-wide type given for Source");
166         Reported := True;
167      end if;
168      if Is_Class_Wide_Subtype (Target) then
169         Report (Rule_Id,
170                 Context,
171                 Get_Location (Target),
172                 "class-wide type given for Target");
173         Reported := True;
174      end if;
175
176      S_Size := Size_Value (Source);
177      T_Size := Size_Value (Target);
178
179      if S_Size = Not_Specified then
180         Report (Rule_Id,
181                 Context,
182                 Get_Location (Source),
183                 "no size clause given for Source");
184         Reported := True;
185      end if;
186      if T_Size = Not_Specified then
187         Report (Rule_Id,
188                 Context,
189                 Get_Location (Target),
190                 "no size clause given for Target");
191         Reported := True;
192      end if;
193
194      if Reported then
195         return;
196      end if;
197
198      -- Here, S_Size and T_Size are known
199      if S_Size /= T_Size then
200         Report (Rule_Id,
201                 Context,
202                 Get_Location (Source),
203                 "Source size (" & Biggest_Int_Img (S_Size) & ") /= Target size (" & Biggest_Int_Img (T_Size) & ')');
204      end if;
205
206   end Process_Instantiation;
207
208begin  -- Rules.Unsafe_Unchecked_Conversion
209   Framework.Rules_Manager.Register (Rule_Id,
210                                     Rules_Manager.Semantic,
211                                     Help_CB        => Help'Access,
212                                     Add_Control_CB => Add_Control'Access,
213                                     Command_CB     => Command'Access);
214end Rules.Unsafe_Unchecked_Conversion;
215