Commit 439cafcf by Arnaud Charlet

Add test cases.

From-SVN: r127533
parent 32f56aad
-- { dg-do run }
with addr2_p; use addr2_p;
procedure addr2 is
begin
Process (B1);
Process (Blk => B1);
Process (B2);
Process (Blk => B2);
end;
with System;
package body addr2_p is
procedure Process (Blk : Block) is
use type System.Address;
begin
if Blk'Address /= B1'Address and then Blk'Address /= B2'Address then
raise Program_Error;
end if;
end;
end;
package addr2_p is
type Block is array (1 .. 4) of Integer;
procedure Process (Blk : Block);
B1 : constant Block := Block'((1,2,3,4));
B2 : constant Block := (1,2,3,4);
end;
-- { dg-do compile }
-- { dg-options "-gnatws" }
procedure aliased1 is
type E is (One, Two);
type R (D : E := One) is record
case D is
when One =>
I1 : Integer;
I2 : Integer;
when Two =>
B1 : Boolean;
end case;
end record;
type Data_Type is record
Data : R;
end record;
type Array_Type is array (Natural range <>) of Data_Type;
function Get return Array_Type is
Ret : Array_Type (1 .. 2);
begin
return Ret;
end;
Object : aliased Array_Type := Get;
begin
null;
end;
-- { dg-do compile }
package body profile_warning is
end;
pragma Profile_Warnings (Ravenscar);
with profile_warning_p;
package profile_warning is
pragma Elaborate_Body;
procedure I is new profile_warning_p.Proc;
end;
package body profile_warning_p is
procedure Proc is begin null; end Proc;
task type T is
end T;
task body T is
begin
null;
end;
type A_T is access T;
procedure Do_Stuff is
P : A_T;
begin
P := new T;
end Do_Stuff;
end;
package profile_warning_p is
generic
procedure Proc;
end;
-- { dg-do run }
procedure range_check is
function ident (x : integer) return integer is
begin
return x;
end ident;
guard1 : Integer;
r : array (1 .. ident (10)) of integer;
pragma Suppress (Index_Check, r);
guard2 : Integer;
begin
guard1 := 0;
guard2 := 0;
r (11) := 3;
end;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment