1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- V A L I D S W -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2019, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Opt; use Opt; 27with Output; use Output; 28 29package body Validsw is 30 31 ---------------------------------- 32 -- Reset_Validity_Check_Options -- 33 ---------------------------------- 34 35 procedure Reset_Validity_Check_Options is 36 begin 37 Validity_Check_Components := False; 38 Validity_Check_Copies := False; 39 Validity_Check_Default := False; 40 Validity_Check_Floating_Point := False; 41 Validity_Check_In_Out_Params := False; 42 Validity_Check_In_Params := False; 43 Validity_Check_Operands := False; 44 Validity_Check_Parameters := False; 45 Validity_Check_Returns := False; 46 Validity_Check_Subscripts := False; 47 Validity_Check_Tests := False; 48 end Reset_Validity_Check_Options; 49 50 --------------------------------- 51 -- Save_Validity_Check_Options -- 52 --------------------------------- 53 54 procedure Save_Validity_Check_Options 55 (Options : out Validity_Check_Options) 56 is 57 P : Natural := 0; 58 59 procedure Add (C : Character; S : Boolean); 60 -- Add given character C to string if switch S is true 61 62 procedure Add (C : Character; S : Boolean) is 63 begin 64 if S then 65 P := P + 1; 66 Options (P) := C; 67 end if; 68 end Add; 69 70 -- Start of processing for Save_Validity_Check_Options 71 72 begin 73 for K in Options'Range loop 74 Options (K) := ' '; 75 end loop; 76 77 Add ('e', Validity_Check_Components); 78 Add ('c', Validity_Check_Copies); 79 Add ('d', Validity_Check_Default); 80 Add ('f', Validity_Check_Floating_Point); 81 Add ('i', Validity_Check_In_Params); 82 Add ('m', Validity_Check_In_Out_Params); 83 Add ('o', Validity_Check_Operands); 84 Add ('p', Validity_Check_Parameters); 85 Add ('r', Validity_Check_Returns); 86 Add ('s', Validity_Check_Subscripts); 87 Add ('t', Validity_Check_Tests); 88 end Save_Validity_Check_Options; 89 90 ---------------------------------------- 91 -- Set_Default_Validity_Check_Options -- 92 ---------------------------------------- 93 94 procedure Set_Default_Validity_Check_Options is 95 begin 96 Reset_Validity_Check_Options; 97 Set_Validity_Check_Options ("d"); 98 end Set_Default_Validity_Check_Options; 99 100 -------------------------------- 101 -- Set_Validity_Check_Options -- 102 -------------------------------- 103 104 -- Version used when no error checking is required 105 106 procedure Set_Validity_Check_Options (Options : String) is 107 OK : Boolean; 108 EC : Natural; 109 pragma Warnings (Off, OK); 110 pragma Warnings (Off, EC); 111 begin 112 Set_Validity_Check_Options (Options, OK, EC); 113 end Set_Validity_Check_Options; 114 115 -- Normal version with error checking 116 117 procedure Set_Validity_Check_Options 118 (Options : String; 119 OK : out Boolean; 120 Err_Col : out Natural) 121 is 122 J : Natural; 123 C : Character; 124 125 begin 126 J := Options'First; 127 while J <= Options'Last loop 128 C := Options (J); 129 J := J + 1; 130 131 -- Turn on validity checking (gets turned off by Vn) 132 133 Validity_Checks_On := True; 134 135 case C is 136 when 'c' => 137 Validity_Check_Copies := True; 138 139 when 'd' => 140 Validity_Check_Default := True; 141 142 when 'e' => 143 Validity_Check_Components := True; 144 145 when 'f' => 146 Validity_Check_Floating_Point := True; 147 148 when 'i' => 149 Validity_Check_In_Params := True; 150 151 when 'm' => 152 Validity_Check_In_Out_Params := True; 153 154 when 'o' => 155 Validity_Check_Operands := True; 156 157 when 'p' => 158 Validity_Check_Parameters := True; 159 160 when 'r' => 161 Validity_Check_Returns := True; 162 163 when 's' => 164 Validity_Check_Subscripts := True; 165 166 when 't' => 167 Validity_Check_Tests := True; 168 169 when 'C' => 170 Validity_Check_Copies := False; 171 172 when 'D' => 173 Validity_Check_Default := False; 174 175 when 'E' => 176 Validity_Check_Components := False; 177 178 when 'F' => 179 Validity_Check_Floating_Point := False; 180 181 when 'I' => 182 Validity_Check_In_Params := False; 183 184 when 'M' => 185 Validity_Check_In_Out_Params := False; 186 187 when 'O' => 188 Validity_Check_Operands := False; 189 190 when 'P' => 191 Validity_Check_Parameters := False; 192 193 when 'R' => 194 Validity_Check_Returns := False; 195 196 when 'S' => 197 Validity_Check_Subscripts := False; 198 199 when 'T' => 200 Validity_Check_Tests := False; 201 202 when 'a' => 203 Validity_Check_Components := True; 204 Validity_Check_Copies := True; 205 Validity_Check_Default := True; 206 Validity_Check_Floating_Point := True; 207 Validity_Check_In_Out_Params := True; 208 Validity_Check_In_Params := True; 209 Validity_Check_Operands := True; 210 Validity_Check_Parameters := True; 211 Validity_Check_Returns := True; 212 Validity_Check_Subscripts := True; 213 Validity_Check_Tests := True; 214 215 when 'n' => 216 Validity_Check_Components := False; 217 Validity_Check_Copies := False; 218 Validity_Check_Default := False; 219 Validity_Check_Floating_Point := False; 220 Validity_Check_In_Out_Params := False; 221 Validity_Check_In_Params := False; 222 Validity_Check_Operands := False; 223 Validity_Check_Parameters := False; 224 Validity_Check_Returns := False; 225 Validity_Check_Subscripts := False; 226 Validity_Check_Tests := False; 227 Validity_Checks_On := False; 228 229 when ' ' => 230 null; 231 232 when others => 233 if Ignore_Unrecognized_VWY_Switches then 234 Write_Line ("unrecognized switch -gnatV" & C & " ignored"); 235 else 236 OK := False; 237 Err_Col := J - 1; 238 return; 239 end if; 240 end case; 241 end loop; 242 243 OK := True; 244 Err_Col := Options'Last + 1; 245 end Set_Validity_Check_Options; 246 247end Validsw; 248