I've started adding a bunch of regression tests to the
Ada dejagnu testsuite (see below for the current state).
I've accumulated these over several years, and almost all
of them have been reported in gcc bugzilla (not many of
these) or to ACT (the funny package names are ACT tracking
numbers).
However it's not clear to me how to add multi-package tests.
Some of my test cases consist of more than a_package.ads,
a_package.adb (think of tests involving interaction of child
packages with parent packages for example - they necessarily
involve several compilation units). Logically speaking, the
test only needs to be run on the main package, the subsidiary
packages don't need to be tested individually. However the
testsuite infrastructure tests all bodies. How to tell it
to ignore some? Likewise for tests in gnat.dg/specs.
Thanks for your help,
Duncan.
Index: testsuite/gnat.dg/f202_014.adb
===================================================================
--- testsuite/gnat.dg/f202_014.adb (revision 0)
+++ testsuite/gnat.dg/f202_014.adb (revision 0)
@@ -0,0 +1,12 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05" }
+
+package body F202_014 is
+ procedure R (X : access constant Integer) is
+ B : Boolean;
+ begin
+ B := X = I;
+ end;
+end;
Index: testsuite/gnat.dg/ec13_012.ads
===================================================================
--- testsuite/gnat.dg/ec13_012.ads (revision 0)
+++ testsuite/gnat.dg/ec13_012.ads (revision 0)
@@ -0,0 +1,2 @@
+function EC13_012 return Boolean;
+pragma Pure_Function (EC13_012);
Index: testsuite/gnat.dg/eb24_002.ads
===================================================================
--- testsuite/gnat.dg/eb24_002.ads (revision 0)
+++ testsuite/gnat.dg/eb24_002.ads (revision 0)
@@ -0,0 +1,2 @@
+procedure EB24_002;
+pragma Pure (EB24_002);
Index: testsuite/gnat.dg/e224_009.adb
===================================================================
--- testsuite/gnat.dg/e224_009.adb (revision 0)
+++ testsuite/gnat.dg/e224_009.adb (revision 0)
@@ -0,0 +1,16 @@
+-- Wrong warning.
+
+-- { dg-do compile }
+-- { dg-options "-gnatwa" }
+
+procedure E224_009 is
+ type R is record
+ I : Integer;
+ end record;
+ An_R : aliased R;
+ type R_P is access all R;
+ A : array (1 .. 1) of R_P;
+begin
+ A (1) := An_R'Access;
+ A (1).I := 2;
+end;
Index: testsuite/gnat.dg/f109_018.adb
===================================================================
--- testsuite/gnat.dg/f109_018.adb (revision 0)
+++ testsuite/gnat.dg/f109_018.adb (revision 0)
@@ -0,0 +1,13 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+
+procedure F109_018 is
+ procedure Q (I : Integer) is
+ begin null; end;
+ procedure Q2 (I : Integer) renames Q;
+begin
+ if Q2'Mechanism_Code (1) = 1 then
+ null;
+ end if;
+end;
Index: testsuite/gnat.dg/eb30_003.adb
===================================================================
--- testsuite/gnat.dg/eb30_003.adb (revision 0)
+++ testsuite/gnat.dg/eb30_003.adb (revision 0)
@@ -0,0 +1,12 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05" }
+
+package body EB30_003 is
+ procedure F (A : A_Type) is
+ An_A : access A_Type;
+ begin
+ An_A := A.An_A;
+ end;
+end;
Index: testsuite/gnat.dg/eb14_003.adb
===================================================================
--- testsuite/gnat.dg/eb14_003.adb (revision 0)
+++ testsuite/gnat.dg/eb14_003.adb (revision 0)
@@ -0,0 +1,14 @@
+-- Program_Error, due to <> not default initializing the array elements.
+
+-- { dg-do run }
+-- { dg-options "-gnat05" }
+
+with Ada.Containers.Doubly_Linked_Lists;
+procedure EB14_003 is
+ package Lists is new Ada.Containers.Doubly_Linked_Lists (Boolean);
+ type Array_Type is array (Boolean) of Lists.List;
+ type Record_Type is record An_Array : Array_Type; end record;
+ A_Record : Record_Type := (An_Array => <>);
+begin
+ Lists.Append (A_Record.An_Array (True), True);
+end;
Index: testsuite/gnat.dg/f202_014.ads
===================================================================
--- testsuite/gnat.dg/f202_014.ads (revision 0)
+++ testsuite/gnat.dg/f202_014.ads (revision 0)
@@ -0,0 +1,5 @@
+package F202_014 is
+ type IA is access all Integer;
+ I : IA;
+ procedure R (X : access constant Integer);
+end;
Index: testsuite/gnat.dg/eb30_003.ads
===================================================================
--- testsuite/gnat.dg/eb30_003.ads (revision 0)
+++ testsuite/gnat.dg/eb30_003.ads (revision 0)
@@ -0,0 +1,6 @@
+package EB30_003 is
+ type A_Type is private;
+ procedure F (A : A_Type);
+private
+ type A_Type is record An_A : access A_Type; end record;
+end;
Index: testsuite/gnat.dg/e701_012.adb
===================================================================
--- testsuite/gnat.dg/e701_012.adb (revision 0)
+++ testsuite/gnat.dg/e701_012.adb (revision 0)
@@ -0,0 +1,11 @@
+-- Wrong warning.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05 -gnatwa" }
+
+package body E701_012 is
+ function F (X : S) return M is
+ begin
+ return M'Mod (X);
+ end;
+end;
Index: testsuite/gnat.dg/f126_007.adb
===================================================================
--- testsuite/gnat.dg/f126_007.adb (revision 0)
+++ testsuite/gnat.dg/f126_007.adb (revision 0)
@@ -0,0 +1,6 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05" }
+
+package body F126_007 is end;
Index: testsuite/gnat.dg/f117_016.adb
===================================================================
--- testsuite/gnat.dg/f117_016.adb (revision 0)
+++ testsuite/gnat.dg/f117_016.adb (revision 0)
@@ -0,0 +1,13 @@
+-- Compiler hang.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05" }
+
+package body F117_016 is
+ protected body L is
+ procedure A (X : access procedure) is
+ begin
+ X.all;
+ end;
+ end;
+end;
Index: testsuite/gnat.dg/e606_017.adb
===================================================================
--- testsuite/gnat.dg/e606_017.adb (revision 0)
+++ testsuite/gnat.dg/e606_017.adb (revision 0)
@@ -0,0 +1,18 @@
+-- Raised Program_Error.
+
+-- { dg-do run }
+-- { dg-options "-gnat05" }
+
+with Ada.Containers.Ordered_Sets;
+procedure E606_017 is
+ type E is ('A', 'B');
+ package Sets is new Ada.Containers.Ordered_Sets (E); use Sets;
+ T, S : Set;
+begin
+ Insert (T, 'B');
+ Insert (S, 'A');
+ Intersection (T, S);
+ if not Is_Empty (T) then
+ raise Program_Error;
+ end if;
+end;
Index: testsuite/gnat.dg/ec13_012.adb
===================================================================
--- testsuite/gnat.dg/ec13_012.adb (revision 0)
+++ testsuite/gnat.dg/ec13_012.adb (revision 0)
@@ -0,0 +1,9 @@
+-- Legal, but did not compile (Pure_Function does not imply Pure).
+
+-- { dg-do compile }
+
+with Ada.Text_IO; -- not pure
+function EC13_012 return Boolean is
+begin
+ return True;
+end;
Index: testsuite/gnat.dg/eb24_002.adb
===================================================================
--- testsuite/gnat.dg/eb24_002.adb (revision 0)
+++ testsuite/gnat.dg/eb24_002.adb (revision 0)
@@ -0,0 +1,9 @@
+-- Illegal, but compiled.
+
+-- { dg-do compile }
+
+with Ada.Text_IO; -- { dg-error "wrong categorization|pure unit" }
+procedure EB24_002 is
+begin
+ Ada.Text_IO.Put_Line ("pure as the driven snow!");
+end;
Index: testsuite/gnat.dg/e701_012.ads
===================================================================
--- testsuite/gnat.dg/e701_012.ads (revision 0)
+++ testsuite/gnat.dg/e701_012.ads (revision 0)
@@ -0,0 +1,6 @@
+package E701_012 is
+ Modulus : constant := 4;
+ type S is range 0 .. Modulus - 1; -- S'Last < Modulus
+ type M is mod Modulus;
+ function F (X : S) return M;
+end;
Index: testsuite/gnat.dg/f126_007.ads
===================================================================
--- testsuite/gnat.dg/f126_007.ads (revision 0)
+++ testsuite/gnat.dg/f126_007.ads (revision 0)
@@ -0,0 +1,11 @@
+package F126_007 is
+ pragma Elaborate_Body;
+ type Q_T (D : Natural) is private;
+ C_Q : constant Q_T;
+private
+ type A_T is array (Boolean range <>, Natural range <>) of Natural;
+ type Q_T (D : Natural) is record
+ A : A_T (Boolean, 0 .. D) := (others => (others => 0));
+ end record;
+ C_Q : constant Q_T := (D => 0, A => <>);
+end;
Index: testsuite/gnat.dg/f117_016.ads
===================================================================
--- testsuite/gnat.dg/f117_016.ads (revision 0)
+++ testsuite/gnat.dg/f117_016.ads (revision 0)
@@ -0,0 +1,5 @@
+package F117_016 is
+ protected L is
+ procedure A (X : access procedure);
+ end;
+end;
Index: testsuite/gnat.dg/specs/ec02_024.ads
===================================================================
--- testsuite/gnat.dg/specs/ec02_024.ads (revision 0)
+++ testsuite/gnat.dg/specs/ec02_024.ads (revision 0)
@@ -0,0 +1,11 @@
+-- Legal, but did not compile.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05" }
+
+package EC02_024 is
+ type A is array (Boolean) of access procedure;
+ type B is array (Boolean) of access procedure;
+ C : A;
+ D : B := B (C);
+end;
Index: testsuite/gnat.dg/specs/e221_009.ads
===================================================================
--- testsuite/gnat.dg/specs/e221_009.ads (revision 0)
+++ testsuite/gnat.dg/specs/e221_009.ads (revision 0)
@@ -0,0 +1,11 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+
+package E221_009 is
+ type E_1 is (A_Val, B_Val);
+ type E_2 is (C_Val, D_Val);
+ type E_Array is array (E_1 range <>, E_2 range <>, Natural range <>) of
Boolean;
+ type U (X : Natural) is record A : E_Array (E_1, E_2, 0 .. X); end record;
+ type B is record The_U : U (10); end record;
+end;
Index: testsuite/gnat.dg/specs/e930_011.ads
===================================================================
--- testsuite/gnat.dg/specs/e930_011.ads (revision 0)
+++ testsuite/gnat.dg/specs/e930_011.ads (revision 0)
@@ -0,0 +1,6 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05" }
+
+generic type I is interface; package E930_011 is end;
Index: testsuite/gnat.dg/specs/pr17921.ads
===================================================================
--- testsuite/gnat.dg/specs/pr17921.ads (revision 0)
+++ testsuite/gnat.dg/specs/pr17921.ads (revision 0)
@@ -0,0 +1,10 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+
+package PR17921 is
+ An_Array : array (Boolean) of Character;
+ An_Object : Character;
+ for An_Object'Address use An_Array (True)'Address;
+ pragma Import (Ada, An_Object);
+end;
Index: testsuite/gnat.dg/specs/f110_002.ads
===================================================================
--- testsuite/gnat.dg/specs/f110_002.ads (revision 0)
+++ testsuite/gnat.dg/specs/f110_002.ads (revision 0)
@@ -0,0 +1,16 @@
+-- Compiler crash.
+
+-- { dg-do compile }
+-- { dg-options "-gnat05" }
+
+package F110_002 is
+ type I is range 1 .. 2;
+ type A is array (I range <>) of Boolean;
+ type D (N : I := 1) is record
+ B : A (1 .. N);
+ end record;
+ type W is record
+ E : D;
+ end record;
+ C : constant W := (E => <>);
+end;
