OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [invalid1.adb] - Blame information for rev 700

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 696 jeremybenn
-- { dg-do run }
2
-- { dg-options "-gnatws -gnatVa" }
3
 
4
pragma Initialize_Scalars;
5
 
6
procedure 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
 
19
begin
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
 
49
end;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.