1-- { dg-do run } 2-- { dg-options "-gnatws -gnatVa" } 3 4pragma Initialize_Scalars; 5 6procedure Invalid1 is 7 8 X : Boolean; 9 A : Boolean := False; 10 11 procedure Uninit (B : out Boolean) is 12 begin 13 if A then 14 B := True; 15 raise Program_Error; 16 end if; 17 end; 18 19begin 20 21 -- first, check that initialize_scalars is enabled 22 begin 23 if X then 24 A := False; 25 end if; 26 raise Program_Error; 27 exception 28 when Constraint_Error => null; 29 end; 30 31 -- second, check if copyback of an invalid value raises constraint error 32 begin 33 Uninit (A); 34 if A then 35 -- we expect constraint error in the 'if' above according to gnat ug: 36 -- .... 37 -- call. Note that there is no specific option to test `out' 38 -- parameters, but any reference within the subprogram will be tested 39 -- in the usual manner, and if an invalid value is copied back, any 40 -- reference to it will be subject to validity checking. 41 -- ... 42 raise Program_Error; 43 end if; 44 raise Program_Error; 45 exception 46 when Constraint_Error => null; 47 end; 48 49end; 50