OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

Compare Revisions

  • This comparison shows the changes necessary to convert path 
    /openrisc/tags/gnu-src/gcc-4.5.1/gcc-4.5.1-or32-1.0rc1/gcc/testsuite/gnat.dg/specs
    from Rev 304 to Rev 338
    ↔ Reverse comparison
  •

Rev 304 → Rev 338

/preelab.ads
0,0 → 1,9
-- { dg-do compile }
 
with Ada.Finalization;
package preelab is
type T is limited private;
pragma Preelaborable_Initialization (T);
private
type T is new Ada.Finalization.Limited_Controlled with null record;
end preelab;
/size_attribute1_pkg1.adb
0,0 → 1,13
package body Size_Attribute1_Pkg1 is
 
type Rec is
record
F : T;
end record;
 
procedure Dummy is
begin
null;
end;
 
end Size_Attribute1_Pkg1;
/size_attribute1_pkg2.adb
0,0 → 1,9
package body Size_Attribute1_Pkg2 is
 
procedure Proc is
I : Integer := T'Size;
begin
null;
end;
 
end Size_Attribute1_Pkg2;
/root.ads
0,0 → 1,9
package Root is
 
type Buffer_Type is array (Positive range <>) of Natural;
 
type Root_Type (First : Natural) is abstract tagged record
Buffer_Root : Buffer_Type (1 .. First);
end record;
 
end Root;
/uc1.ads
0,0 → 1,22
-- { dg-do compile }
-- { dg-options "-gnatws" }
 
with System;
with System.Storage_Elements;
with Unchecked_Conversion;
 
package UC1 is
 
function Conv is
new Unchecked_Conversion (Source => System.Address, Target => Integer);
function Conv is
new Unchecked_Conversion (Source => Integer, Target => System.Address);
 
M : constant System.Address := System.Storage_Elements.To_Address(0);
N : constant System.Address := Conv (Conv (M) + 1);
A : constant System.Address := Conv (Conv (N) + 1);
 
I : Integer;
for I use at A;
 
end UC1;
/corr_discr.ads
0,0 → 1,13
package Corr_Discr is
 
type Base (T1 : Boolean := True; T2 : Boolean := False)
is null record;
for Base use record
T1 at 0 range 0 .. 0;
T2 at 0 range 1 .. 1;
end record;
 
type Deriv (D : Boolean := False) is new Base (T1 => True, T2 => D);
 
end Corr_Discr;
 
/variant_part.ads
0,0 → 1,8
-- { dg-do compile }
package Variant_Part is
type T1(b: boolean) is record
case (b) is -- { dg-error "discriminant name may not be parenthesized" }
when others => null;
end case;
end record;
end Variant_Part;
/abstract_private.ads
0,0 → 1,17
generic
package Abstract_Private is
 
type T1 is abstract tagged private;
procedure P1 (X : T1) is abstract;
 
type T2 is abstract tagged private;
 
private
 
type T1 is abstract tagged null record;
procedure P2 (X : T1) is abstract; -- { dg-error "must be visible" }
 
type T2 is abstract new T1 with null record;
procedure P1 (X : T2) is abstract;
 
end Abstract_Private;
/fe_inlining_helper.adb
0,0 → 1,4
procedure FE_Inlining_Helper is
begin
null;
end FE_Inlining_Helper;
/size_attribute1_pkg1.ads
0,0 → 1,15
-- { dg-excess-errors "no code generated" }
 
with Size_Attribute1_Pkg2;
 
generic
 
type T is private;
 
package Size_Attribute1_Pkg1 is
 
package My_R is new Size_Attribute1_Pkg2 (T);
 
procedure Dummy;
 
end Size_Attribute1_Pkg1;
/size_attribute1_pkg2.ads
0,0 → 1,11
-- { dg-excess-errors "no code generated" }
 
generic
 
type T is private;
 
package Size_Attribute1_Pkg2 is
 
procedure Proc;
 
end Size_Attribute1_Pkg2;
/limited1.ads
0,0 → 1,10
-- { dg-do compile }
 
package limited1 is
pragma Pure;
type Buffer is limited interface;
type Synchronous_Buffer_Type is synchronized interface and Buffer;
 
private
end limited1;
/root-level_1.ads
0,0 → 1,14
package Root.Level_1 is
 
type Level_1_Type (First : Natural;
Second : Natural) is new Root_Type with private;
 
private
 
type Level_1_Type (First : Natural;
Second : Natural) is new Root_Type (First => First)
with record
Buffer_1 : Buffer_Type (1 .. Second);
end record;
 
end Root.Level_1;
/restricted_pkg.ads
0,0 → 1,10
-- { dg-do compile }
-- { dg-options "-gnatc" }
 
pragma Restrictions (No_Entry_Queue);
package Restricted_Pkg is
type Iface is limited interface;
protected type PO is new Iface with
procedure Dummy;
end;
end;
/root-level_2.ads
0,0 → 1,9
with Root.Level_1;
 
package Root.Level_2 is
 
type Level_2_Type (First : Natural;
Second : Natural) is new
Level_1.Level_1_Type (First => First, Second => Second) with null record;
 
end Root.Level_2;
/cpp_assignment.ads
0,0 → 1,10
-- { dg-do compile }
 
package CPP_Assignment is
type T is tagged record
Data : Integer := 0;
end record;
pragma Convention (CPP, T);
 
Obj1 : T := (Data => 1); Obj2 : T'Class := Obj1;
end;
/discr_record_constant.ads
0,0 → 1,22
-- { dg-do compile }
 
pragma Restrictions (No_Implicit_Heap_Allocations);
 
package Discr_Record_Constant is
 
type T (Big : Boolean := False) is record
case Big is
when True =>
Content : Integer;
when False =>
null;
end case;
end record;
 
D : constant T := (True, 0);
 
Var : T := D; -- OK, maximum size
Con : constant T := D; -- Violation of restriction
Ter : constant T := Con; -- Violation of restriction
 
end Discr_Record_Constant;
/fe_inlining_helper.ads
0,0 → 1,3
-- { dg-excess-errors "no code generated" }
generic
procedure FE_Inlining_Helper;
/fe_inlining.ads
0,0 → 1,4
-- { dg-do compile }
-- { dg-options "-O -gnatN" }
with FE_Inlining_Helper;
procedure FE_Inlining is new FE_Inlining_Helper;
/varsize_return.ads
0,0 → 1,10
-- { dg-do compile }
-- { dg-options "-gnatws" }
 
with Varsize_Return_Pkg1;
 
package Varsize_Return is
 
package P is new Varsize_Return_Pkg1 (Id_T => Natural);
 
end Varsize_Return;
/controller.ads
0,0 → 1,15
-- { dg-do compile }
 
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package Controller is
type Iface is interface;
type Thing is tagged record
Name : Unbounded_String;
end record;
type Object is abstract new Thing and Iface with private;
private
type Object is abstract new Thing and Iface
with record
Surname : Unbounded_String;
end record;
end Controller;
/pack33.ads
0,0 → 1,27
-- { dg-do compile }
 
package Pack33 is
 
Bits : constant := 33;
 
type Bits_33 is mod 2 ** Bits;
for Bits_33'Size use Bits;
 
type Cluster is record
E0, E1, E2, E3, E4, E5, E6, E7 : Bits_33;
end record;
 
for Cluster use record
E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
end record;
 
for Cluster'Size use Bits * 8;
 
end Pack33;
/access3.ads
0,0 → 1,25
-- { dg-do compile }
 
package access3 is
type TF is access function return access procedure (P1 : Integer);
type TAF is access protected function return access procedure (P1 : Integer);
type TAF2 is access
function return access protected procedure (P1 : Integer);
type TAF3 is access
protected function return access protected procedure (P1 : Integer);
type TAF_Inf is
access protected function return
access function return
access function return
access function return
access function return
access function return
access function return
access function return
access function return
Integer;
end access3;
/elab1.ads
0,0 → 1,21
-- { dg-do compile }
 
pragma Restrictions(No_Elaboration_Code);
 
with System;
 
package Elab1 is
 
type Ptrs_Type is array (Integer range 1 .. 2) of System.Address;
type Vars_Array is array (Integer range 1 .. 2) of Integer;
 
Vars : Vars_Array;
 
Val1 : constant Integer := 1;
Val2 : constant Integer := 2;
 
Ptrs : constant Ptrs_Type :=
(1 => Vars (Val1)'Address,
2 => Vars (Val2)'Address);
 
end Elab1;
/interface5.ads
0,0 → 1,9
-- { dg-do compile }
-- { dg-options "-gnatc" }
 
package interface5 is
type Lim_Iface is limited interface;
protected type Prot_Typ is new Lim_Iface with
private
end Prot_Typ;
end interface5;
/constructor.ads
0,0 → 1,13
-- { dg-do compile }
 
package constructor is
type R (Name_Length : Natural) is record
Name : Wide_String (1..Name_Length);
Multiple : Boolean;
end record;
Null_Params : constant R :=
(Name_Length => 0,
Name => "",
Multiple => False);
end;
/attribute_parsing.ads
0,0 → 1,5
-- { dg-do compile }
package Attribute_Parsing is
I : constant Integer := 12345;
S : constant String := I'Img (1 .. 2);
end Attribute_Parsing;
/universal_fixed.ads
0,0 → 1,8
-- { dg-do compile }
 
package Universal_Fixed is
Nm2Metres : constant := 1852.0;
type Metres is delta 1.0 range 0.0 .. 1_000_000.0;
type Nautical_Miles is
delta 0.001 range 0.0 .. (Metres'Last + (Nm2Metres / 2)) / Nm2Metres;
end Universal_Fixed;
/gen_interface.ads
0,0 → 1,8
-- { dg-do compile }
 
with gen_interface_p;
package gen_interface is
type T is interface;
procedure P (Thing: T) is abstract;
package NG is new gen_interface_p (T, P);
end;
/iface_eq_test.ads
0,0 → 1,6
-- { dg-do compile }
generic
package Iface_Eq_Test is
type Iface is limited interface;
function "=" (L, R : access Iface) return Boolean is abstract;
end;
/root-level_1-level_2.ads
0,0 → 1,7
package Root.Level_1.Level_2 is
 
type Level_2_Type (First : Natural;
Second : Natural) is new
Level_1.Level_1_Type (First => First, Second => Second) with null record;
 
end Root.Level_1.Level_2;
/alignment1.ads
0,0 → 1,11
-- { dg-do compile }
 
package Alignment1 is
S : Natural := 20;
pragma Volatile (S);
 
type Block is array (1 .. S) of Integer;
for Block'Alignment use 128;
 
B : Block;
end;
/alignment2.ads
0,0 → 1,47
-- { dg-do compile }
 
with Interfaces; use Interfaces;
 
package Alignment2 is
 
-- warning
type R1 is record
A, B, C, D : Integer_8;
end record;
for R1'Size use 32;
for R1'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
 
-- warning
type R2 is record
A, B, C, D : Integer_8;
end record;
for R2'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
 
-- OK, big size
type R3 is record
A, B, C, D : Integer_8;
end record;
for R3'Size use 32 * 8;
for R3'Alignment use 32;
 
-- OK, big size
type R4 is record
A, B, C, D, E, F, G, H : Integer_32;
end record;
for R4'Alignment use 32;
 
-- warning
type I1 is new Integer_32;
for I1'Size use 32;
for I1'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
 
-- warning
type I2 is new Integer_32;
for I2'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
 
-- OK, big size
type I3 is new Integer_32;
for I3'Size use 32 * 8;
for I3'Alignment use 32;
 
end Alignment2;
/pack2.ads
0,0 → 1,10
-- { dg-do compile }
 
package Pack2 is
type Rec is record
Ptr: access Character;
Int :Integer;
end record;
type Table is array (1..2) of rec;
pragma Pack (Table);
end Pack2;
/warnstar.ads
0,0 → 1,12
-- { dg-do compile }
 
pragma Warnings (Off, "*bits of*unused");
package warnstar is
type r is record
a : integer;
end record;
for r use record
a at 0 range 0 .. 1023;
end record;
end warnstar;
/pack3.ads
0,0 → 1,45
-- { dg-do compile }
 
with Pack3_Pkg;
 
package Pack3 is
 
subtype N_TYPE is INTEGER range 0..5;
 
type LIST_ARRAY is array (N_TYPE range <>) of INTEGER;
 
type LIST (N : N_TYPE := 0) is record
LIST : LIST_ARRAY(1..N);
end record;
pragma PACK(LIST);
 
subtype CS is STRING(1..Pack3_Pkg.F);
 
type CSA is array (NATURAL range <>) of CS;
 
type REC is record
I1, I2 : INTEGER;
end record ;
 
type CMD is (CO, AS);
 
type CMD_BLOCK_TYPE (D : CMD := CO) is record
N : CSA (1..4);
case D is
when CO => L : LIST;
when AS => R : REC;
end case ;
end record;
pragma PACK(CMD_BLOCK_TYPE);
 
type CMD_TYPE is (RIGHT, WRONG);
 
type CMD_RESULT (D : CMD_TYPE) is record
case D is
when RIGHT => C : CMD_BLOCK_TYPE;
when WRONG => null;
end case;
end record ;
pragma PACK(CMD_RESULT);
 
end Pack3;
/specs.exp
0,0 → 1,36
# Copyright (C) 2006, 2007 Free Software Foundation, Inc.
 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
 
# GCC testsuite that uses the `dg.exp' driver.
 
# Load support procs.
load_lib gnat-dg.exp
 
# If a testcase doesn't have special options, use these.
global DEFAULT_CFLAGS
if ![info exists DEFAULT_CFLAGS] then {
set DEFAULT_CFLAGS ""
}
 
# Initialize `dg'.
dg-init
 
# Main loop.
dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.ads]] \
"" $DEFAULT_CFLAGS
 
# All done.
dg-finish
/pack4.ads
0,0 → 1,12
package Pack4 is
 
type Buffer is array (Natural range <>) of Boolean;
 
type Root (Size : Natural) is tagged record
Data : Buffer (1..Size);
end record;
pragma Pack (Root);
 
type Derived is new Root with null record;
 
end Pack4;
/pack5.ads
0,0 → 1,13
package Pack5 is
 
type Small is range -32 .. 31;
 
type Arr is array (Integer range <>) of Small;
pragma Pack (Arr);
 
type Rec is record
Y: Arr (1 .. 10);
end record;
pragma Pack (Rec);
 
end Pack5;
/pack6.ads
0,0 → 1,24
-- { dg-do compile }
 
with Ada.Finalization;
with Pack6_Pkg;
 
package Pack6 is
 
package Eight_Bits is new Pack6_Pkg (8);
 
type Some_Data is record
Byte_1 : Eight_Bits.Object;
Byte_2 : Eight_Bits.Object;
end record;
 
for Some_Data use record
Byte_1 at 0 range 0 .. 7;
Byte_2 at 1 range 0 .. 7;
end record;
 
type Top_Object is new Ada.Finalization.Controlled with record
Data : Some_Data;
end record;
 
end Pack6;
/empty_variants.ads
0,0 → 1,32
-- { dg-do compile }
-- { dg-options "-gnatdF" }
 
package Empty_Variants is
type Rec (D : Integer := 1) is record
case D is
when 1 =>
I : Integer;
when 2 .. 5 =>
J : Integer;
K : Integer;
when 6 =>
null;
when 7 .. 8 =>
null;
when others =>
L : Integer;
M : Integer;
N : Integer;
end case;
end record;
R : Rec;
I : Integer := R.I;
J : Integer := R.J;
K : Integer := R.K;
L : Integer := R.L;
M : Integer := R.L;
 
end Empty_Variants;
/oversize.ads
0,0 → 1,56
with Ada.Numerics.Discrete_Random;
 
package Oversize is
 
subtype M1 is Integer range 1 .. 200; -- Won't trigger
type R1 (D : M1 := 100) is record
Name : String (1 .. D);
end record;
 
type M2 is new Integer range 1 .. 200; -- Won't trigger
for M2'Size use 64;
type M2S is array (M2 range <>) of Character;
type R2 (D : M2 := 100) is record
Name : M2S (1 .. D);
end record;
 
subtype M3 is Integer; -- Will trigger
type R3 (D : M3 := 100) -- { dg-error "may raise Storage_Error" }
is record
Name : String (1 .. D);
end record;
 
type M4 is new Positive; -- Will trigger
type M4S is array (M4 range <>) of Character;
type R4 (D : M4 := 100) -- { dg-error "may raise Storage_Error" }
is record
Name : M4S (1 .. D);
end record;
 
type M5 is new Positive; -- Will trigger
for M5'Size use Integer'Size - 1;
type M5S is array (M5 range <>) of Character;
type R5 (D : M5 := 100) -- { dg-error "may raise Storage_Error" }
is record
Name : M5S (1 .. D);
end record;
 
subtype M6 is Integer range 1 .. (Integer'Last + 1)/2; -- Won't trigger
type R6 (D : M6 := 100) is record
Name : String (1 .. D);
end record;
 
subtype M7 is Integer range 1 .. (Integer'Last + 1)/2+1; -- Will trigger
type R7 (D : M7 := 100) -- { dg-error "may raise Storage_Error" }
is record
Name : String (1 .. D);
end record;
 
package P8 is new Ada.Numerics.Discrete_Random (Natural);
G8 : P8.Generator;
subtype M8 is Integer range 1 .. P8.Random (G8); -- Won't trigger
type R8 (D : M8 := 100) is record
Name : String (1 .. D);
end record;
 
end Oversize;
/weak1.ads
0,0 → 1,7
package Weak1 is
 
Myconst : constant Integer := 1234;
pragma Export (C, Myconst, "myconst");
pragma Weak_External (Myconst);
 
end Weak1;
/array_no_def_init.ads
0,0 → 1,9
-- { dg-do compile }
 
pragma Restrictions (No_Default_Initialization);
package Array_No_Def_Init is
type Int_Array is array (Natural range <>) of Integer;
IA : Int_Array (1 .. 10);
end Array_No_Def_Init;
/iface_eq_test-child.ads
0,0 → 1,9
-- { dg-do compile }
-- { dg-options "-gnatc" }
generic
package Iface_Eq_Test.Child is
protected type PO is new Iface with
procedure Dummy;
end;
overriding function "=" (L, R : access PO) return Boolean;
end;
/size_attribute1.ads
0,0 → 1,20
-- { dg-do compile }
 
with Size_Attribute1_Pkg1;
 
package Size_Attribute1 is
 
function Num return Natural;
pragma Import (Ada, Num);
 
type A is array (Natural range <>) of Integer;
 
type T is
record
F1 : Long_Float;
F2 : A (1 .. Num);
end record;
 
package My_Q is new Size_Attribute1_Pkg1 (T);
 
end Size_Attribute1;
/genericppc.ads
0,0 → 1,7
-- { dg-do compile }
-- { dg-options "-gnatc" }
 
generic
type T_Item is private;
function genericppc (T : in t_Item; I : integer) return integer;
pragma Precondition (I > 0);
/ai_116.ads
0,0 → 1,23
-- { dg-do compile }
 
with Ada.Finalization; use Ada;
package ai_116 is
pragma Preelaborate;
type Buffer_Type is limited interface;
 
type Handle is new Finalization.Limited_Controlled and Buffer_Type with
private;
pragma Preelaborable_Initialization(Handle);
 
type Ptr is access all String;
Null_Handle : constant Handle;
 
private
type Handle is new Finalization.Limited_Controlled and Buffer_Type with
record
Data : Ptr := null;
end record;
 
Null_Handle : constant Handle :=
(Finalization.Limited_Controlled with Data => null);
end ai_116;
/formal_type.ads
0,0 → 1,15
-- { dg-do compile }
 
with Ada.Strings.Bounded;
package formal_type is
generic
with package BI is
new Ada.Strings.Bounded.Generic_Bounded_Length (<>);
type NB is new BI.Bounded_String;
package G is end;
package BI is new Ada.Strings.Bounded.Generic_Bounded_Length (30);
type NB is new BI.Bounded_String;
Thing : NB;
Size : Integer := THing.Max_Length;
package GI is new G (BI, NB);
end;
/delta_small.ads
0,0 → 1,9
-- { dg-do compile }
 
package Delta_Small is
type T is delta 0.1 range -0.8 .. 0.8;
for T'Small use 0.1;
for T'Size use 4;
type T2 is new T range -0.4 .. 0.4;
for T2'Small use 0.0625;
end Delta_Small;
/static_initializer.ads
0,0 → 1,14
-- { dg-do compile }
 
package static_initializer is
 
type Vector is array (1 .. 3) of Float;
type Arr is array (Integer range 1 .. 3) of Vector;
 
Pos : constant Arr := ((0.0, 1.0, 2.0),
(0.5, 1.5, 2.5),
(1.0, 2.0, 4.0));
 
end;
 
-- { dg-final { scan-assembler-not "elabs" } }
/import_abstract.ads
0,0 → 1,6
-- { dg-do compile }
package Import_Abstract is
type T1 is abstract tagged null record;
procedure p1(X : T1) is abstract;
pragma Import (Ada, p1); -- { dg-error "cannot import abstract subprogram" }
end Import_Abstract;
/with_containers.ads
0,0 → 1,27
-- { dg-do compile }
 
pragma Warnings (Off);
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Hashed_Sets;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Indefinite_Hashed_Sets;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Multisets;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Ordered_Maps;
with Ada.Containers.Ordered_Multisets;
with Ada.Containers.Ordered_Sets;
with Ada.Containers.Prime_Numbers;
with Ada.Containers.Red_Black_Trees.Generic_Keys;
with Ada.Containers.Red_Black_Trees.Generic_Operations;
with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
with Ada.Containers.Red_Black_Trees;
with Ada.Containers.Restricted_Doubly_Linked_Lists;
with Ada.Containers.Vectors;
package With_Containers is
pragma Remote_Types;
end With_Containers;
/unchecked_union.ads
0,0 → 1,20
-- PR ada/28591
-- Reported by Martin Michlmayr <tbm@cyrius.com>
 
-- { dg-do compile }
-- { dg-options "-g" }
 
with Interfaces; use Interfaces;
 
package Unchecked_Union is
type Mode_Type is (Mode_B2);
 
type Value_Union (Mode : Mode_Type := Mode_B2) is record
case Mode is
when Mode_B2 =>
B2 : Integer_32;
end case;
end record;
pragma Unchecked_Union (Value_Union);
 
end Unchecked_Union;
/access_constant_decl.ads
0,0 → 1,11
-- { dg-do compile }
package Access_Constant_Decl is
 
c: aliased constant integer := 3;
 
type const_ptr is access constant integer;
cp : const_ptr := c'access;
 
x : access integer := cp; -- { dg-error "access-to-constant" }
 
end Access_Constant_Decl;
/aggr1.ads
0,0 → 1,8
-- { dg-do compile }
 
package aggr1 is
type Buffer_Array is array (1 .. 2 ** 23) of Integer;
type Message is record
Data : Buffer_Array := (others => 0);
end record;
end;
/sync_iface_test.ads
0,0 → 1,14
-- { dg-do compile }
-- { dg-options "-gnatc" }
 
package Sync_Iface_Test is
type Iface is limited interface;
procedure Do_Test
(Container : in out Iface;
Process : access procedure (E : Natural)) is abstract;
protected type Buffer is new Iface with
overriding procedure Do_Test
(Process : access procedure (E : Natural));
end;
end;
/pack3_pkg.ads
0,0 → 1,7
-- { dg-excess-errors "no code generated" }
 
package Pack3_Pkg is
 
function F return Integer;
 
end Pack3_Pkg;
/pack6_pkg.ads
0,0 → 1,17
generic
 
Size : Positive;
 
package Pack6_Pkg is
 
type Object is private;
 
private
 
type Bit is range 0 .. 1;
for Bit'Size use 1;
 
type Object is array (1 .. Size) of Bit;
pragma Pack (Object);
 
end Pack6_Pkg;
/small_alignment.ads
0,0 → 1,13
-- { dg-compile }
 
package Small_Alignment is
 
type Int is range -512 .. 511;
for Int'Alignment use 1;
 
type R is record
I: Int;
end record;
Pragma Pack (R);
 
end Small_Alignment;
/null_aggr_bug.ads
0,0 → 1,20
-- { dg-do compile }
package Null_Aggr_Bug is
type Rec1 is null record;
type Rec2 is tagged null record;
type Rec3 is new Rec2 with null record;
X1 : Rec1 := (null record);
Y1 : Rec1 := (others => <>);
X2 : Rec2 := (null record);
Y2 : Rec2 := (others => <>);
X3 : Rec3 := (null record);
Y3 : Rec3 := (others => <>);
Z3 : Rec3 := (Rec2 with others => <>);
 
end Null_Aggr_Bug;
/gen_interface_p.ads
0,0 → 1,5
generic
type I is interface;
with procedure P (X : I) is abstract;
package gen_interface_p is
end;
/box1.ads
0,0 → 1,13
-- { dg-do compile }
 
package box1 is
type Root is tagged null record;
type Der1 is new Root with record
B : Boolean;
end record;
type Der2 is new Der1 with null record;
type Der3 is new Der2 with null record;
Obj : Der3 := (Der2 with others => <>);
end;
/access_constant.ads
0,0 → 1,13
-- { dg-do compile }
package Access_Constant is
 
c: aliased constant integer := 3;
 
type const_ptr is access constant integer;
cp : const_ptr := c'access;
 
procedure inc (var_ptr: access integer :=
cp) -- { dg-error "access-to-constant" }
is abstract;
 
end Access_Constant;
/abstract_limited.ads
0,0 → 1,6
-- { dg-do compile }
 
package abstract_limited is
type I is limited interface;
type T is abstract limited new I with null record;
end;
/static_initializer2.ads
0,0 → 1,22
-- { dg-do compile }
 
package Static_Initializer2 is
 
type A is array (1..5) of Integer;
f : constant A := (1, 2, 3, 4, 5);
 
i1 : integer renames f(1);
i2 : integer renames f(2);
i3 : integer renames f(3);
i4 : integer renames f(4);
i5 : integer renames f(5);
 
b1 : boolean := i1 = 1;
b2 : boolean := i2 = 2;
b3 : boolean := i3 = 3;
b4 : boolean := i4 = 4;
b5 : boolean := i5 = 5;
 
end Static_Initializer2;
 
-- { dg-final { scan-assembler-not "elabs" } }
/static_initializer3.ads
0,0 → 1,29
-- { dg-do compile }
 
with Unchecked_Conversion;
 
package Static_Initializer3 is
 
type Byte is range 0 .. 16#FF#;
for Byte'Size use 8;
 
type Word is range 0 .. 16#FFFF# ;
for Word'Size use 16;
 
type R is record
b1 : Boolean;
b2 : Boolean;
end record;
for R use record
b1 at 0 range 0..3;
b2 at 0 range 4..7;
end record;
for R'Size use 8;
 
function Conv is new Unchecked_Conversion (R, Byte);
 
C1 : constant Byte := Conv ((true, false));
 
C2 : constant Word := Word(C1);
 
end Static_Initializer3;
/self_class.ads
0,0 → 1,9
-- { dg-do compile }
 
package Self_Class is
type P6 is private;
private
type P6 is tagged record
Self : access P6'Class;
end record;
end Self_Class;
/static_initializer4.ads
0,0 → 1,13
-- { dg-do compile }
 
package Static_Initializer4 is
 
type R is tagged record
b : Boolean;
end record;
 
type NR is new R with null record;
 
C : NR := (b => True);
 
end Static_Initializer4;
/renamings.ads
0,0 → 1,14
package Renamings is
 
package Inner is
procedure PI (X : Integer);
end Inner;
 
procedure P (X : Integer) renames Inner.PI;
procedure P (X : Float);
pragma Convention (C, P); -- { dg-error "non-local entity" }
 
procedure Q (X : Float);
procedure Q (X : Integer) renames Inner.PI;
pragma Convention (C, Q); -- { dg-error "non-local entity" }
end Renamings;
/varsize_return_pkg1.adb
0,0 → 1,24
package body Varsize_Return_Pkg1 is
function Is_Fixed return Boolean is
begin
return True;
end Is_Fixed;
 
function Do_Item (I : Natural) return Variable_Data_Fixed_T is
It : Variable_Data_Fixed_T;
begin
return It;
end Do_Item;
 
My_Db : Db.T;
 
procedure Run is
Kitem : Variable_Data_Fixed_T;
I : Natural;
begin
Kitem := Db.Get (My_Db);
Kitem := Do_Item (I);
end Run;
 
end Varsize_Return_Pkg1;
/varsize_return_pkg2.adb
0,0 → 1,7
package body Varsize_Return_Pkg2 is
function Get (X : T) return Data_T is
Result : Data_T;
begin
return Result;
end;
end Varsize_Return_Pkg2;
/double_record_extension1.ads
0,0 → 1,13
-- { dg-do compile }
 
package double_record_extension1 is
 
type T1(n: natural) is tagged record
s1: string (1..n);
end record;
type T2(j,k: natural) is new T1(j) with record
s2: string (1..k);
end record;
type T3 is new T2 (10, 10) with null record;
 
end double_record_extension1;
/double_record_extension2.ads
0,0 → 1,17
-- { dg-do compile }
 
package double_record_extension2 is
 
type Base_Message_Type (Num_Bytes : Positive) is tagged record
Data_Block : String (1..Num_Bytes);
end record;
 
type Extended_Message_Type (Num_Bytes1 : Positive; Num_Bytes2 : Positive) is new Base_Message_Type (Num_Bytes1) with record
A: String (1..Num_Bytes2);
end record;
 
type Final_Message_Type is new Extended_Message_Type with record
B : Integer;
end record;
 
end double_record_extension2;
/size_clause1.ads
0,0 → 1,48
-- { dg-do compile }
 
package Size_Clause1 is
 
-- The record inherits the alignment of Integer, which is 4, so
-- the real size is 64 instead of 40. That's OK, as long as the
-- size of a component of type R1 in a packed record is 40.
type R1 is record
I : Integer;
B : Boolean;
end record;
for R1'Size use 40;
 
type S1 is record
rr : R1; -- size must be 40
end record;
pragma Pack(S1);
 
-- The record is explicitly given alignment 1 so its real type is 40 too.
-- The size of a component of type R2 in a packed record is naturally 40.
type R2 is record
I : Integer;
B : Boolean;
end record;
for R2'Size use 40;
for R2'Alignment use 1;
 
type S2 is record
rr : R2; -- size must be 40
end record;
pragma Pack(S2);
 
-- The record is explicitly given alignment 4 so its real type is 64.
-- That's OK, as long as the size of a component of type R3 in a packed
-- record is 40.
type R3 is record
I : Integer;
B : Boolean;
end record;
for R3'Size use 40;
for R3'Alignment use 4;
 
type S3 is record
rr : R3; -- size must be 40
end record;
pragma Pack(S3);
 
end Size_Clause1;
/size_clause2.ads
0,0 → 1,48
-- { dg-do compile }
 
package Size_Clause2 is
 
-- The alignment of the record is capped to the greatest power of 2
-- factor of the size, so that the real size is 40 too and the size
-- of a component of type R1 in a packed record can be 40.
type R1 is record
I : Integer;
B : aliased Boolean;
end record;
for R1'Size use 40;
 
type S1 is record
rr : R1; -- size must be 40
end record;
pragma Pack(S1);
 
-- The record is explicitly given alignment 1 so its real type is 40 too.
-- The size of a component of type R2 in a packed record is naturally 40.
type R2 is record
I : Integer;
B : aliased Boolean;
end record;
for R2'Size use 40;
for R2'Alignment use 1;
 
type S2 is record
rr : R2; -- size must be 40
end record;
pragma Pack(S2);
 
-- The record is explicitly given alignment 4 so its real type is 64.
-- That's not OK, because the size of a component of type R3 in a packed
-- record cannot be 40 so the size clause is violated.
type R3 is record
I : Integer;
B : aliased Boolean;
end record;
for R3'Size use 40; -- { dg-error "size for .R3. too small" }
for R3'Alignment use 4;
 
type S3 is record
rr : R3; -- size must be 40
end record;
pragma Pack(S3);
 
end Size_Clause2;
/integer_value.ads
0,0 → 1,5
-- { dg-do compile }
package Integer_Value is
X : constant Integer :=
Integer'Integer_Value (12.8); -- { dg-error "fixed-point type" "" }
end Integer_Value;
/size_clause3.ads
0,0 → 1,50
-- { dg-do compile }
 
package Size_Clause3 is
 
-- The record inherits the alignment of Integer, which is 4, so
-- the real size is 64 instead of 40.
type R1 is record
I : Integer;
B : aliased Boolean;
end record;
 
-- That's not OK, the size of a component of type R1 cannot be 40.
type S1 is record
rr : R1; -- size must be 40
end record;
for S1 use record
rr at 0 range 0 .. 39; -- { dg-error "size of .rr. with aliased or tagged component" }
end record;
 
-- The record is explicitly given alignment 1 so its real type is 40.
type R2 is record
I : Integer;
B : aliased Boolean;
end record;
for R2'Alignment use 1;
 
-- That's OK, the size of a component of type R2 can be 40.
type S2 is record
rr : R2; -- size must be 40
end record;
for S2 use record
rr at 0 range 0 .. 39;
end record;
 
-- The record is explicitly given alignment 4 so its real type is 64.
type R3 is record
I : Integer;
B : aliased Boolean;
end record;
for R3'Alignment use 4;
 
-- That's not OK, the size of a component of type R3 cannot be 40.
type S3 is record
rr : R3; -- size must be 40
end record;
for S3 use record
rr at 0 range 0 .. 39; -- { dg-error "size of .rr. with aliased or tagged component" }
end record;
 
end Size_Clause3;
/addr1.ads
0,0 → 1,35
-- { dg-do compile }
 
with Interfaces; use Interfaces;
 
package Addr1 is
 
type Arr is array (Integer range <>) of Unsigned_16;
 
type Rec1 is record
I1, I2: Integer;
end record;
 
type Rec2 is record
I1, I2: Integer;
end record;
for Rec2'Size use 64;
 
A: Arr (1 .. 12);
 
Obj1: Rec1;
for Obj1'Address use A'Address; -- { dg-bogus "alignment" }
 
Obj2: Rec2;
for Obj2'Address use A'Address; -- { dg-bogus "alignment" }
 
Obj3: Rec1;
for Obj3'Address use A(1)'Address; -- { dg-bogus "alignment" }
 
Obj4: Rec1;
for Obj4'Address use A(2)'Address; -- { dg-warning "(alignment|erroneous)" }
 
Obj5: Rec1;
for Obj5'Address use A(3)'Address; -- { dg-bogus "alignment" }
 
end Addr1;
/tag1.ads
0,0 → 1,8
-- { dg-do compile }
 
package tag1 is
type T is tagged limited record
Y : access T'Class; -- OK
X : access Tag1.T'Class; -- Problem
end record;
end tag1;
/tag2.ads
0,0 → 1,17
-- { dg-do compile }
 
package tag2 is
type I is synchronized interface;
type T1 is tagged;
type T2 is tagged;
type T3 is tagged;
type T4 is tagged;
type T5 is tagged;
type T6 is tagged;
protected type T1 is end T1; -- { dg-error "must be a tagged type" }
task type T2; -- { dg-error "must be a tagged type" }
type T3 is null record; -- { dg-error "must be a tagged type" }
task type T4 is new I with end;
protected type T5 is new I with end;
type T6 is tagged null record;
end tag2;
/gnati.ads
0,0 → 1,13
-- { dg-do compile }
-- { dg-options "-gnatI" }
 
package gnati is
type j is range 1 .. 50;
for j'size use 1;
type n is new integer;
for n'alignment use -99;
type e is (a, b);
for e use (1, 1);
type r is record x : integer; end record;
for r use record x at 0 range 0 .. 0; end record;
end gnati;
/rep_clause1.ads
0,0 → 1,19
-- { dg-do compile }
-- { dg-options "-gnatwa" }
 
package Rep_Clause1 is
generic
type Custom_T is private;
package Handler is
type Storage_T is record
A : Boolean;
B : Boolean;
C : Custom_T;
end record;
 
for Storage_T use record
A at 0 range 0..0;
B at 1 range 0..0;
end record;
end Handler;
end Rep_Clause1;
/cpp1.ads
0,0 → 1,10
-- { dg-do compile }
 
package cpp1 is
type Root_Interface is interface;
 
type Typ is new Root_Interface with record
TOTO : Integer;
pragma CPP_Vtable (TOTO);
end record;
end cpp1;
/rep_clause2.ads
0,0 → 1,11
-- { dg-do compile }
-- { dg-options "-gnatws" }
 
package Rep_Clause2 is
 
type S is new String;
for S'Component_Size use 256;
 
type T is new S(1..8);
 
end Rep_Clause2;
/storage.ads
0,0 → 1,10
-- { dg-do compile }
with System.Pool_Global;
package Storage is
x1: System.Pool_Global.Unbounded_No_Reclaim_Pool;
type T1 is access integer;
for T1'Storage_Pool use (x1); -- { dg-error "must be a variable" }
type T2 is access Integer;
for T2'Storage_Pool use x1;
end Storage;
 
/varsize_return_pkg1.ads
0,0 → 1,26
-- { dg-excess-errors "no code generated" }
 
with Varsize_Return_Pkg2;
 
generic
type Id_T is range <>;
package Varsize_Return_Pkg1 is
type Variable_Data_T (Fixed : Boolean := False) is
record
case Fixed is
when True =>
Length : Natural;
when False =>
null;
end case;
end record;
function Is_Fixed return Boolean;
 
type Variable_Data_Fixed_T is new Variable_Data_T (Is_Fixed);
package Db is new Varsize_Return_Pkg2 (Id_T => Id_T,
Data_T => Variable_Data_Fixed_T);
 
end Varsize_Return_Pkg1;
/rep_clause3.ads
0,0 → 1,36
package Rep_Clause3 is
 
type Record1 is
record
Page_Handle : Integer range 0 .. 255;
Page_Owner : Integer range 0 .. 15;
end record;
for Record1 use
record
Page_Handle at 0 range 0 .. 15;
Page_Owner at 0 range 16 .. 19;
end record;
for Record1'Size use 20;
 
type Range_A is range 1 .. 7;
for Range_A'Size use 16;
 
type Array_Type is array (Range_A) of Record1;
pragma Pack (Array_Type);
for Array_Type'Size use 7 * 20;
-- for array_Type'alignment use 1;
 
type Record2 is
record
Page_Tree_Index : Range_A;
Page_Tree : Array_Type;
end record;
 
for Record2 use
record
Page_Tree_Index at 0 range 0 .. 15;
Page_Tree at 0 range 16 .. 15 + (7 * 20);
end record;
for Record2'Size use 16 + (7 * 20);
 
end Rep_Clause3;
/private_with.ads
0,0 → 1,16
-- { dg-do compile }
 
private with Ada.Containers.Ordered_Maps;
with Ada.Containers.Ordered_Sets;
with Ada.Unchecked_Deallocation;
package private_with is
 
type String_Access is access String;
 
package Index_Sets is new Ada.Containers.Ordered_Sets
(Element_Type => Positive);
 
procedure Free is new Ada.Unchecked_Deallocation
(Object => String,
Name => String_Access);
end;
/varsize_return_pkg2.ads
0,0 → 1,11
-- { dg-excess-errors "no code generated" }
 
generic
type Id_T is private;
type Data_T is private;
package Varsize_Return_Pkg2 is
type T is private;
function Get (X : T) return Data_T;
private
type T is null record;
end Varsize_Return_Pkg2;
/rep_clause4.ads
0,0 → 1,42
-- { dg-do compile }
-- { dg-options "-O" }
 
package Rep_Clause4 is
 
type Uns16 is mod 2**16;
 
type Rec32 is
record
W1 : Uns16 := 1;
W2 : Uns16 := 2;
end record;
for Rec32 use
record
W1 at 0 range 0..15;
W2 at 2 range 0..15;
end record;
for Rec32'size use 32;
 
type Rec48 is
record
W1andW2 : Rec32;
W3 : Uns16;
end record;
for Rec48 use
record
W1andW2 at 0 range 0..31;
W3 at 4 range 0..15;
end record;
for Rec48'size use 48;
 
type Rec_Type is
record
Field1 : Rec48;
end record;
for Rec_Type use
record
Field1 at 0 range 0 .. 47;
end record;
for Rec_Type'size use 48;
 
end Rep_Clause4;
/linker_section.ads
0,0 → 1,13
package Linker_Section is
Data1 : constant String := "12345678901234567";
pragma Linker_Section (Entity => Data1,
Section => ".eeprom");
type EEPROM_String is new String;
pragma Linker_Section (Entity => EEPROM_String, -- { dg-error "objects" }
Section => ".eeprom");
Data2 : constant EEPROM_String := "12345678901234567";
package Inner is end;
pragma Linker_Section (Entity => Inner, -- { dg-error "objects" }
Section => ".eeprom");
end Linker_Section;
 

powered by: WebSVN 2.1.0

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