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