1pragma Ada_2012; 2with Ada.Numerics.Generic_Elementary_Functions; 3with Ada.Text_IO, Ada.Finalization; 4with X_Declarations.Child; 5with X_Declarations_Locations; 6procedure T_declarations is -- library procedure, no_spec_procedure 7 procedure Test_Anonymous_Subtype is separate; -- separate, no_spec_procedure 8 procedure Test_Self_SP; -- not_library_procedure, local_procedure 9 procedure Test_Self_SP is separate; -- separate 10 11 type I1 is range 1 .. 10; -- signed_type, integer_type 12 type I2 is mod 128; -- binary_modular_type, modular_type, integer_type 13 type I3 is mod 127; -- non_binary_modular_type, modular_type, integer_type 14 VI1_1 : I1; -- variable, scalar_variable, uninitialized_variable 15 VI1_2 : I1 range 1..2; -- variable, scalar_variable, uninitialized_variable, anonymous_subtype_declaration 16 17 type Fl is digits 5; -- float_type 18 type Fx1 is delta 0.1 range 0.0 .. 1.0; -- ordinary_fixed_type_no_small, ordinary_fixed_type, fixed_type 19 type Fx2 is delta 0.1 digits 5; -- decimal_fixed_type, fixed_type 20 21 type Enum is (A, B, 'c', D, 'e'); -- enumeration_type, character_literal x2 22 V_Enum : Enum := A; -- variable, scalar_variable, initialized_variable 23 24 task T1 is -- single_task, task_variable, task, non_ravenscar_task 25 entry E (I : Integer := 1); -- task_entry, defaulted_parameter 26 end T1; 27 task body T1 is 28 procedure P is -- task_body procedure, not library procedure, local procedure, no_spec_procedure 29 begin 30 null; -- null_procedure_body, null_procedure 31 end; 32 begin 33 null; 34 exception -- handlers 35 when others => 36 null; 37 end T1; 38 39 task type T2 (X : Integer) is -- task_type, task, non_ravenscar_task, task_discriminant, discriminant 40 entry E; -- task_entry 41 end T2; 42 task body T2 is 43 begin 44 null; 45 end T2; 46 47 task type T3; -- task_type, task, non_ravenscar_task 48 task body T3 is 49 begin 50 null; 51 end T3; 52 53 VT3 : T3; -- variable, task_variable, non_ravenscar_task 54 55 protected P1 is -- single_protected, protected_variable, protected 56 entry E1 (I : out Integer; J : in out Integer); -- protected_entry, out_parameter, in_out_parameter 57 entry E2; -- protected_entry, multiple_protected_entries 58 end P1; 59 protected body P1 is 60 entry E1 (I : out Integer; J : in out Integer) when True is --out_parameter, in_out_parameter 61 begin 62 null; 63 exception -- handlers 64 when others => 65 null; 66 end E1; 67 entry E2 when True is 68 begin 69 null; 70 end E2; 71 end P1; 72 73 protected type P2 (X : Integer := 0) is -- protected_type, protected, protected_discriminant, defaulted_discriminant, discriminant 74 entry E1; -- protected_entry 75 entry E2; -- protected_entry, multiple_protected_entries 76 private 77 I : Integer; -- uninitialized_protected_component 78 J : Integer := 0; -- initialized_protected_component 79 end P2; 80 protected body P2 is 81 entry E1 when True is 82 begin 83 null; 84 end E1; 85 entry E2 when True is 86 begin 87 null; 88 end E2; 89 end P2; 90 91 VP2 : P2 (0); -- variable, protected_variable, anonymous subtype_declarations 92 93 E : exception; -- exception 94 NN1 : constant := 1; -- named_number 95 NN2 : constant := 1.0; -- named_number 96 97 type Acc1; -- incomplete_type 98 type Acc1 is access Integer; -- access_type 99 type Acc2 is access procedure; -- access_subprogram_type, access_type 100 type Acc3 is access T2; -- access_nondef_discriminated_type, access_task_type, access_type 101 type Acc4 is access P2; -- access_def_discriminated_type, access_protected_type, access_type 102 103 type Der_Task is new T2; -- derived_type 104 type Acc5 is access Der_Task; -- access_nondef_discriminated_type, access_task_type, access_type 105 106 type Acc6 is access all Integer; -- access_type, access_all_type 107 type Acc7 is access constant Integer; -- access_type, access_constant_type 108 type Acc8 is access Ada.Text_IO.File_Type; -- access_language_type, access_type; 109 type Acc9 is access Ada.Finalization.Controlled; -- access_language_type, access_type; 110 111 I,J,K : aliased Integer; -- variable x3, aliased_variable x3, scalar_variable x3, uninitialized_variable x3, multiple_names 112 C : aliased constant Character := ' '; -- constant, aliased_constant 113 114 type Rec1 is tagged; -- tagged_incomplete_type 115 type Rec1 is tagged null record; -- null_tagged_type, tagged_type, record_type 116 type Rec2 (X : Integer) is tagged limited null record; -- null_tagged_type, tagged_type, record_type, discriminant 117 type Rec3 is null record; -- null_ordinary_record_type, ordinary_record_type, record_type 118 type Rec4 (X : Integer := 0) is -- ordinary_record_type, record_type, defaulted_discriminant, discriminant 119 record 120 case X is -- variant_part 121 when 0 => 122 I : Integer; -- uninitialized_record_component 123 when others => 124 J : Integer := 0; -- initialized_record_component 125 end case; 126 end record; 127 type Rec5 is null record; -- null_ordinary_record_type, ordinary_record_type, record_type 128 type Rec6 is record -- null_ordinary_record_type, ordinary_record_type, record_type 129 null; 130 end record; 131 type Rec7 is -- ordinary_record_type, record_type 132 record 133 I : Integer; -- uninitialized_record_component 134 J : Integer := 0; -- initialized_record_component 135 end record; 136 Vclass : Rec1'Class := Rec1'(null record); -- variable, tagged_variable, class_wide_variable 137 Cclass : constant Rec1'Class := Rec1'(null record); -- constant, class_wide_constant 138 VRec1 : Rec1; -- variable, tagged_variable, uninitialized_variable 139 VRec3 : Rec3; -- variable, ordinary_record_variable, uninitialized_variable 140 VRec4 : Rec4; -- variable, ordinary_record_variable, uninitialized_variable 141 type Acc_Rec2 is access Rec2; -- access_nondef_discriminated_type, access_type 142 type Acc_Rec3 is access Rec4; -- access_def_discriminated_type, access_type 143 144 type Arr1 is array (1 .. 10) of Character; -- constrained_array_type, array, anonymous_subtype_declaration 145 type Arr2 is array (Positive range <>) of Integer'Base; -- unconstrained_array_type, array 146 type Arr3 is new Arr2 (1..10); -- derived_type, anonymous_subtype_declaration x2 147 subtype Subarr21 is Arr2; -- subtype, unconstrained_subtype 148 subtype Subarr22 is Arr2 (1 .. 3); -- subtype, anonymous_subtype_declaration 149 subtype Subarr23 is Subarr22; -- subtype, unconstrained_subtype 150 type Arr4 is new Subarr22; -- derived_type 151 VArr1 : array (1 .. 10) of Character; -- anonymous_subtype_declaration, variable, single_array, constrained_array_variable, array, uninitialized_variable 152 Varr2 : Arr2 := (1, 2, 3); -- variable, unconstrained_array_variable, array, initialized_variable 153 Carr1 : constant Arr2 := Varr2; -- constant, unconstrained_array_constant, array 154 Varr3 : array (Positive range <>) of Integer := (1, 2, 3); -- variable, single_array, unconstrained_array_variable, array, initialized_variable 155 Varr4 : Subarr21 := (1,2, 3); -- variable, unconstrained_array_variable, array, initialized_variable 156 Varr5 : Subarr23; -- variable, constrained_array_variable, array, uninitialized_variable 157 Carr2 : constant Subarr23 := Varr5; -- constant, constrained_array_constant, array 158 type Acc_Arr1 is access Arr1; -- access_constrained_array_type, access_type 159 type Acc_Arr2 is access Arr2; -- access_unconstrained_array_type, access_type 160 type Acc_Arr22 is access Subarr22; -- access_constrained_array_type, access_type 161 type Acc_Arr3 is access Arr3; -- access_constrained_array_type, access_type 162 type Acc_Arr4 is access Arr4; -- access_constrained_array_type, access_type 163 164 type Der1 is new Rec1 with null record; -- null_extension, extension, tagged_type, record_type 165 type Der2 (Y : Integer) is new Rec1 with null record; -- null_extension, extension, tagged_type, record_type, discriminant 166 type Der3 (Y : Integer) is new Rec2 (Y) with null record; -- null_extension, extension, tagged_type, record_type, discriminant, anonymous_subtype_declaration 167 type Der4 is new Rec3; -- derived_type 168 VDer1 : Der1; -- variable, tagged_variable, uninitialized_variable 169 VDer4 : Der4; -- variable, ordinary_record_variable, uninitialized_variable 170 171 type T_Float is digits 5; -- float_type 172 type T_Fixed1 is delta 0.01 range 0.0 .. 1.0; -- ordinary_fixed_type_with_small, ordinary_fixed_type, fixed_type 173 for T_Fixed1'Small use 0.01; 174 type T_Fixed2 is delta 0.01 digits 7; -- decimal_fixed_type, fixed_type 175 176 generic -- Not Library Generic_Procedure, generic 177 I : Integer := 1; -- defaulted_generic_parameter 178 procedure P (J : Integer := 1; K : in out Float; L : out Float); -- Defaulted_Parameter, In_Out_Parameter, Out_Parameter 179 procedure P (J : Integer := 1; K : in out Float; L : out Float) is begin null; end; -- null_procedure_body, null_procedure 180 181 package Pack1 is private end Pack1; -- not library package, empty_visible_part, empty_private_part 182 package body Pack1 is 183 end Pack1; 184 185 package Pack2 is -- not library package 186 type Priv1 is private; -- Non_Limited_Private_Type 187 type Priv2 (<>) is limited private; -- Limited_Private_Type, Unknown_Discriminant, Discriminant 188 type Ext1 is new Rec1 with private; -- Private_Extension 189 type Abs1 is abstract tagged private; -- Tagged_Private_Type, Non_Limited_Private_Type, Abstract_Type 190 type Abs2 is abstract tagged limited private; -- Tagged_Private_Type, Limited_Private_Type, Abstract_Type 191 type Int1 is interface; 192 procedure P (X : Abs1) is abstract; -- Public Procedure, Not Library Procedure, Local Procedure, Abstract_Procedure 193 function F (Y : Abs2) return Integer is abstract; -- Abstract_Function 194 function "+" (L : Abs1) return Integer is abstract; -- Operator, Abstract_Operator, Abstract_Function 195 Deferred : constant Priv1; -- Constant, Deferred_Constant 196 procedure P_As_Body; -- Public Procedure, Not Library Procedure, Local Procedure 197 function F_As_Body return Integer; 198 function F_Expr (I : Integer) return Integer is -- Expression_Function 199 (I+1); 200 type Acc_Priv2 is access Priv2; -- access_type (not access_unknown_discriminated_type because of full type) 201 private 202 type Priv1 is new Integer; -- Derived_Type 203 type Priv2 is new Integer; -- Derived_Type 204 type Ext1 is new Rec1 with record -- Extension, Tagged_Type, Record_Type 205 I : Integer; -- Uninitialized_Record_Component 206 end record; 207 type Abs1 is abstract tagged null record; -- Null_Tagged_Type, Tagged_Type, Record_Type, Abstract_Type 208 type Abs2 is abstract tagged limited -- Tagged_Type, Record_Type, Abstract_Type 209 record 210 X : Integer; -- Uninitialized_Record_component 211 end record; 212 procedure Proc1; -- Private Procedure, Not Library Procedure, Local Procedure 213 Deferred : constant Priv1 := 0; 214 end Pack2; 215 package body Pack2 is 216 type Abs3 is abstract new Abs2 with null record; -- Null_Extension, Extension, Tagged_Type, Record_Type, Abstract_Type 217 procedure Proc1 is 218 begin 219 null; -- null_procedure_body, Null_Procedure 220 end Proc1; 221 procedure Proc2 is -- Own procedure, not library procedure, local procedure, no_spec_procedure 222 begin 223 declare 224 procedure Proc3 is -- Not Library Procedure, Local Procedure, Block Procedure, no_spec_procedure 225 begin 226 null; -- null_procedure_body, Null Procedure 227 end Proc3; 228 begin 229 null; 230 end; 231 end Proc2; 232 procedure P_As_Body renames Test_Self_SP; -- renaming_as_body, renaming, not_operator_renaming, non_identical_renaming 233 function F_Hidden return Integer is -- No_Spec_Function 234 begin 235 return 0; 236 end F_Hidden; 237 function F_As_Body return Integer renames F_Hidden; -- renaming_as_body, renaming, not_operator_renaming, non_identical_renaming 238 begin -- package_statements 239 null; 240 exception -- handlers 241 when Numeric_Error => -- non_joint_CE_NE_handler 242 null; 243 when others => 244 null; 245 end Pack2; 246 247 package Pack3 renames Pack2; -- renaming, not_operator_renaming, non_identical_renaming, synonym_renaming 248 generic package Generic_Elementary_Functions -- renaming, Not_Operator_Renaming, library_unit_renaming 249 renames Ada.Numerics.Generic_Elementary_Functions; 250 251 function "+" (L : Arr2) return Arr2 is -- operator #00046, no_spec_function 252 begin 253 return L; 254 end "+"; 255 256 function "+" (X, Y : Integer) return Integer is -- operator, predefined_operator, multiple_names, no_spec_function 257 begin 258 return I : Integer := 1 do 259 I := I + 1; 260 exception -- handlers 261 when others => 262 null; 263 end return; 264 exception -- handlers 265 when others => 266 null; 267 end "+"; 268 269 function "-" (X, Y : Integer) return Integer; -- Operator, Predefined_operator, multiple_names 270 function "-" (X, Y : Integer) return Integer is -- Multiple_names 271 begin 272 return 1; 273 end "-"; 274 275 function F1 (X, Y : Integer) return Integer renames "+"; -- renaming_as_declaration, renaming, operator_renaming, non_identical_operator_renaming, non_identical_renaming, multiple_names 276 function F2 (X, Y : Integer) return Integer renames Standard."+"; -- renaming_as_declaration, renaming, operator_renaming, non_identical_operator_renaming, non_identical_renaming, multiple_names 277 function "*" (X, Y : Integer) return Integer renames Standard."*"; -- renaming_as_declaration, renaming, operator_renaming, multiple_names 278 279 generic -- Not Library Generic_Package, generic 280 Global : in out Integer; -- in_out_generic_parameter 281 type T1 is private; -- formal type 282 type T2(<>) is private; -- formal type 283 with procedure Formal_P1; -- formal_procedure 284 with procedure Formal_P2 is <>; -- formal_procedure, box_defaulted_formal_procedure 285 with procedure Formal_P3 is Test_Self_SP; -- formal_procedure, name_defaulted_formal_procedure 286 with procedure Formal_P4 is null; -- formal_procedure, null_defaulted_formal_procedure 287 with function Formal_F1 return Integer; -- formal_function 288 with function Formal_F2 return Integer is <>; -- formal_function, box_defaulted_formal_function 289 with function Formal_F3 return Integer is Pack2.F_As_Body; -- formal_function, name_defaulted_formal_function 290 with package EF is new Ada.Numerics.Generic_Elementary_Functions (<>); -- formal_package 291 package Test_Formals is private end; -- empty_visible_part, empty_private_part 292 package body Test_Formals is 293 procedure Inner is begin null; end; -- in_generic procedure, own procedure, not library procedure, local procedure, null_procedure_body, null_procedure, no_spec_function 294 type Acc_T1 is access T1; -- access_formal_type, access_type 295 type Acc_T2 is access T2; -- access_unknown_discriminated_type, access_formal_type, access_type; 296 begin 297 null; -- package statements 298 end Test_Formals; 299 300 subtype Int1 is Integer range 1..10; -- subtype 301 subtype Int2 is Integer; -- subtype, unconstrained_subtype 302 V_Int1 : Int1; -- variable, scalar_variable, uninitialized_variable 303 V_Int2 : Int2 range 1..10; -- variable, scalar_variable, uninitialized_variable, anonymous_subtype_declaration 304 305 Arr : Integer renames X_Declarations.Arr (1); -- not_operator_renaming, non_identical_renaming, renaming 306 function Succ (X : Integer) return Integer renames Integer'Succ; -- renaming_as_declaration, renaming, not_operator_renaming, non_identical_renaming 307 function "/" (X, Y : Integer) return Integer renames Standard."+"; -- renaming_as_declaration, renaming, operator_renaming, non_identical_operator_renaming, non_identical_renaming, multiple_names 308 309 procedure Predefined_Operator is separate; -- separate, no_spec_function 310 311 Renf1 : Integer renames Succ (1); -- renaming, not_operator_renaming, non_identical_renaming, function_call_renaming 312 Renf2 : Integer renames "+"(1,2); -- renaming, not_operator_renaming, non_identical_renaming, function_call_renaming 313 314 315 type Al1 is array (Int1) of aliased Character; -- constrained_array_type, array, aliased_array_component 316 type Al2 is array (Positive range <>) of aliased Character; -- unconstrained_array_type, array, aliased_array_component 317 Al3 : array (Int1) of aliased Character := (others => ' '); -- variable, single_array, aliased_array_component, constrained_array_variable, array, initialized_variable 318 319 type Al4 is -- ordinary_record_type, record_type 320 record 321 F1 : Integer := 0; -- initialized record component 322 F2 : aliased Integer := 1; -- initialized_record_component, aliased_record_component 323 end record; 324 325 protected Al5 is -- single_protected, protected_variable, protected 326 private 327 Y : aliased Integer := 2; -- initialized_protected_component, aliased_protected_component 328 end Al5; 329 protected body Al5 is 330 end Al5; 331 332 procedure Null_2005 is null; -- null_procedure_declaration, null_procedure, not librar_procedure, local_procedure 333 function "=" (L : Rec1; R : Rec1) return Boolean is -- operator, predefined_operator, equality_operator, no_spec_function 334 begin 335 return False; 336 end "="; 337begin 338 begin 339 null; -- null_procedure_body, null_procedure 340 exception -- handlers 341 when Constraint_Error | Numeric_Error => 342 null; 343 when others => 344 null; 345 end; 346exception -- handlers 347 when Constraint_Error => -- non_joint_CE_NE_handler 348 null; 349 when others => 350 null; 351end T_declarations; 352