diff options
Diffstat (limited to 'test/FrontendAda')
31 files changed, 256 insertions, 0 deletions
diff --git a/test/FrontendAda/Support/element_copy.ads b/test/FrontendAda/Support/element_copy.ads new file mode 100644 index 0000000..52c6e49 --- /dev/null +++ b/test/FrontendAda/Support/element_copy.ads @@ -0,0 +1,8 @@ +package Element_Copy is + type SmallInt is range 1 .. 4; + type SmallStr is array (SmallInt range <>) of Character; + type VariableSizedField (D : SmallInt := 2) is record + S : SmallStr (1 .. D) := "Hi"; + end record; + function F return VariableSizedField; +end; diff --git a/test/FrontendAda/Support/fat_fields.ads b/test/FrontendAda/Support/fat_fields.ads new file mode 100644 index 0000000..d3eab3e --- /dev/null +++ b/test/FrontendAda/Support/fat_fields.ads @@ -0,0 +1,6 @@ +package Fat_Fields is + pragma Elaborate_Body; + type A is array (Positive range <>) of Boolean; + type A_Ptr is access A; + P : A_Ptr := null; +end; diff --git a/test/FrontendAda/Support/global_constant.ads b/test/FrontendAda/Support/global_constant.ads new file mode 100644 index 0000000..cef4b11 --- /dev/null +++ b/test/FrontendAda/Support/global_constant.ads @@ -0,0 +1,4 @@ +package Global_Constant is + pragma Elaborate_Body; + An_Error : exception; +end; diff --git a/test/FrontendAda/Support/non_lvalue.ads b/test/FrontendAda/Support/non_lvalue.ads new file mode 100644 index 0000000..7d4eeed --- /dev/null +++ b/test/FrontendAda/Support/non_lvalue.ads @@ -0,0 +1,11 @@ +package Non_LValue is + type T (Length : Natural) is record + A : String (1 .. Length); + B : String (1 .. Length); + end record; + type T_Ptr is access all T; + type U is record + X : T_Ptr; + end record; + function A (Y : U) return String; +end; diff --git a/test/FrontendAda/Support/unc_constructor.ads b/test/FrontendAda/Support/unc_constructor.ads new file mode 100644 index 0000000..d6f8db5 --- /dev/null +++ b/test/FrontendAda/Support/unc_constructor.ads @@ -0,0 +1,8 @@ +package Unc_Constructor is + type C is null record; + type A is array (Positive range <>) of C; + A0 : constant A; + procedure P (X : A); +private + A0 : aliased constant A := (1 .. 0 => (null record)); +end; diff --git a/test/FrontendAda/Support/var_offset.ads b/test/FrontendAda/Support/var_offset.ads new file mode 100644 index 0000000..55d0eb2 --- /dev/null +++ b/test/FrontendAda/Support/var_offset.ads @@ -0,0 +1,9 @@ +package Var_Offset is + pragma Elaborate_Body; + type T (L : Natural) is record + Var_Len : String (1 .. L); + Space : Integer; + Small : Character; + Bad_Field : Character; + end record; +end; diff --git a/test/FrontendAda/Support/var_size.ads b/test/FrontendAda/Support/var_size.ads new file mode 100644 index 0000000..6a570cb --- /dev/null +++ b/test/FrontendAda/Support/var_size.ads @@ -0,0 +1,7 @@ +package Var_Size is + type T (Length : Natural) is record + A : String (1 .. Length); + B : String (1 .. Length); + end record; + function A (X : T) return String; +end; diff --git a/test/FrontendAda/array_constructor.adb b/test/FrontendAda/array_constructor.adb new file mode 100644 index 0000000..de64b45 --- /dev/null +++ b/test/FrontendAda/array_constructor.adb @@ -0,0 +1,6 @@ +-- RUN: %llvmgcc -c %s +procedure Array_Constructor is + A : array (Integer range <>) of Boolean := (True, False); +begin + null; +end; diff --git a/test/FrontendAda/array_range_ref.adb b/test/FrontendAda/array_range_ref.adb new file mode 100644 index 0000000..ae9bdc6 --- /dev/null +++ b/test/FrontendAda/array_range_ref.adb @@ -0,0 +1,7 @@ +-- RUN: %llvmgcc -c %s +procedure Array_Range_Ref is + A : String (1 .. 3); + B : String := A (A'RANGE)(1 .. 3); +begin + null; +end; diff --git a/test/FrontendAda/array_ref.adb b/test/FrontendAda/array_ref.adb new file mode 100644 index 0000000..9577e21 --- /dev/null +++ b/test/FrontendAda/array_ref.adb @@ -0,0 +1,11 @@ +-- RUN: %llvmgcc -c %s +procedure Array_Ref is + type A is array (Natural range <>, Natural range <>) of Boolean; + type A_Access is access A; + function Get (X : A_Access) return Boolean is + begin + return X (0, 0); + end; +begin + null; +end; diff --git a/test/FrontendAda/array_size.adb b/test/FrontendAda/array_size.adb new file mode 100644 index 0000000..2f07d06 --- /dev/null +++ b/test/FrontendAda/array_size.adb @@ -0,0 +1,10 @@ +-- RUN: %llvmgcc -c %s +procedure Array_Size is + subtype S is String (1 .. 2); + type R is record + A : S; + end record; + X : R; +begin + null; +end; diff --git a/test/FrontendAda/asm.adb b/test/FrontendAda/asm.adb new file mode 100644 index 0000000..575617c --- /dev/null +++ b/test/FrontendAda/asm.adb @@ -0,0 +1,6 @@ +-- RUN: %llvmgcc -c %s +with System.Machine_Code; +procedure Asm is +begin + System.Machine_Code.Asm (""); +end; diff --git a/test/FrontendAda/constant_fold.ads b/test/FrontendAda/constant_fold.ads new file mode 100644 index 0000000..6223e7c --- /dev/null +++ b/test/FrontendAda/constant_fold.ads @@ -0,0 +1,4 @@ +-- RUN: %llvmgcc -S -emit-llvm %s -o - | not grep ptrtoint +package Constant_Fold is + Error : exception; +end; diff --git a/test/FrontendAda/debug_var_size.ads b/test/FrontendAda/debug_var_size.ads new file mode 100644 index 0000000..ea966fb --- /dev/null +++ b/test/FrontendAda/debug_var_size.ads @@ -0,0 +1,8 @@ +-- RUN: %llvmgcc -c -g %s +package Debug_Var_Size is + subtype Length_Type is Positive range 1 .. 64; + type T (Length : Length_Type := 1) is record + Varying_Length : String (1 .. Length); + Fixed_Length : Boolean; + end record; +end; diff --git a/test/FrontendAda/dg.exp b/test/FrontendAda/dg.exp new file mode 100644 index 0000000..2307c3f --- /dev/null +++ b/test/FrontendAda/dg.exp @@ -0,0 +1,6 @@ +load_lib llvm.exp + +if [ llvm_gcc_supports ada ] then { + RunLLVMTests [lsort [glob -nocomplain $srcdir/$subdir/*.{adb,ads}]] +} + diff --git a/test/FrontendAda/element_copy.adb b/test/FrontendAda/element_copy.adb new file mode 100644 index 0000000..bffcb97 --- /dev/null +++ b/test/FrontendAda/element_copy.adb @@ -0,0 +1,8 @@ +-- RUN: %llvmgcc -S -O2 %s -I%p/Support -o - | grep 6899714 +package body Element_Copy is + function F return VariableSizedField is + X : VariableSizedField; + begin + return X; + end; +end; diff --git a/test/FrontendAda/emit_var.ads b/test/FrontendAda/emit_var.ads new file mode 100644 index 0000000..35d4544 --- /dev/null +++ b/test/FrontendAda/emit_var.ads @@ -0,0 +1,5 @@ +-- RUN: %llvmgcc -c %s +with Ada.Finalization; +package Emit_Var is + type Search_Type is new Ada.Finalization.Controlled with null record; +end; diff --git a/test/FrontendAda/fat_fields.adb b/test/FrontendAda/fat_fields.adb new file mode 100644 index 0000000..510105f --- /dev/null +++ b/test/FrontendAda/fat_fields.adb @@ -0,0 +1,10 @@ +-- RUN: %llvmgcc -c %s -I%p/Support +-- RUN: %llvmgcc -c %s -I%p/Support -O2 +package body Fat_Fields is + procedure Proc is + begin + if P = null then + null; + end if; + end; +end; diff --git a/test/FrontendAda/field_order.ads b/test/FrontendAda/field_order.ads new file mode 100644 index 0000000..b49185d --- /dev/null +++ b/test/FrontendAda/field_order.ads @@ -0,0 +1,7 @@ +-- RUN: %llvmgcc -c %s +package Field_Order is + type Tagged_Type is abstract tagged null record; + type With_Discriminant (L : Positive) is new Tagged_Type with record + S : String (1 .. L); + end record; +end; diff --git a/test/FrontendAda/global_constant.adb b/test/FrontendAda/global_constant.adb new file mode 100644 index 0000000..ce9f406 --- /dev/null +++ b/test/FrontendAda/global_constant.adb @@ -0,0 +1,5 @@ +-- RUN: %llvmgcc -c %s -I%p/Support +package body Global_Constant is +begin + raise An_Error; +end; diff --git a/test/FrontendAda/init_size.ads b/test/FrontendAda/init_size.ads new file mode 100644 index 0000000..1d76ba2 --- /dev/null +++ b/test/FrontendAda/init_size.ads @@ -0,0 +1,12 @@ +-- RUN: %llvmgcc -c %s +package Init_Size is + type T (B : Boolean := False) is record + case B is + when False => + I : Integer; + when True => + J : Long_Long_Integer; -- Bigger than I + end case; + end record; + A_T : constant T := (False, 0); +end; diff --git a/test/FrontendAda/negative_field_offset.adb b/test/FrontendAda/negative_field_offset.adb new file mode 100644 index 0000000..f8b8510 --- /dev/null +++ b/test/FrontendAda/negative_field_offset.adb @@ -0,0 +1,16 @@ +-- RUN: %llvmgcc -c %s +with System; +procedure Negative_Field_Offset (N : Integer) is + type String_Pointer is access String; + -- Force use of a thin pointer. + for String_Pointer'Size use System.Word_Size; + P : String_Pointer; + + procedure Q (P : String_Pointer) is + begin + P (1) := 'Z'; + end; +begin + P := new String (1 .. N); + Q (P); +end; diff --git a/test/FrontendAda/non_bitfield.ads b/test/FrontendAda/non_bitfield.ads new file mode 100644 index 0000000..8f5845a --- /dev/null +++ b/test/FrontendAda/non_bitfield.ads @@ -0,0 +1,12 @@ +-- RUN: %llvmgcc -c %s +package Non_Bitfield is + type SP is access String; + type E is (A, B, C); + type T (D : E) is record + case D is + when A => X : Boolean; + when B => Y : SP; + when C => Z : String (1 .. 2); + end case; + end record; +end; diff --git a/test/FrontendAda/non_lvalue.adb b/test/FrontendAda/non_lvalue.adb new file mode 100644 index 0000000..157f3dd --- /dev/null +++ b/test/FrontendAda/non_lvalue.adb @@ -0,0 +1,7 @@ +-- RUN: %llvmgcc -c %s -I%p/Support +package body Non_LValue is + function A (Y : U) return String is + begin + return Y.X.B; + end; +end; diff --git a/test/FrontendAda/placeholder.adb b/test/FrontendAda/placeholder.adb new file mode 100644 index 0000000..f33c9a5 --- /dev/null +++ b/test/FrontendAda/placeholder.adb @@ -0,0 +1,12 @@ +-- RUN: %llvmgcc -c %s +procedure Placeholder is + subtype Bounded is Integer range 1 .. 5; + type Vector is array (Bounded range <>) of Integer; + type Interval (Length : Bounded := 1) is record + Points : Vector (1 .. Length); + end record; + An_Interval : Interval := (Length => 1, Points => (1 => 1)); + generic The_Interval : Interval; package R is end; + package body R is end; + package S is new R (An_Interval); +begin null; end; diff --git a/test/FrontendAda/switch.adb b/test/FrontendAda/switch.adb new file mode 100644 index 0000000..f214bca --- /dev/null +++ b/test/FrontendAda/switch.adb @@ -0,0 +1,12 @@ +-- RUN: %llvmgcc -c %s +function Switch (N : Integer) return Integer is +begin + case N is + when Integer'First .. -1 => + return -1; + when 0 => + return 0; + when others => + return 1; + end case; +end; diff --git a/test/FrontendAda/unc_constructor.adb b/test/FrontendAda/unc_constructor.adb new file mode 100644 index 0000000..bc3002c --- /dev/null +++ b/test/FrontendAda/unc_constructor.adb @@ -0,0 +1,9 @@ +-- RUN: %llvmgcc -c %s -I%p/Support +package body Unc_Constructor is + procedure P (X : A) is + begin + if X = A0 then + null; + end if; + end; +end; diff --git a/test/FrontendAda/var_offset.adb b/test/FrontendAda/var_offset.adb new file mode 100644 index 0000000..09f1c15 --- /dev/null +++ b/test/FrontendAda/var_offset.adb @@ -0,0 +1,7 @@ +-- RUN: %llvmgcc -c %s -I%p/Support +package body Var_Offset is + function F (X : T) return Character is + begin + return X.Bad_Field; + end; +end; diff --git a/test/FrontendAda/var_size.adb b/test/FrontendAda/var_size.adb new file mode 100644 index 0000000..b3db9a3 --- /dev/null +++ b/test/FrontendAda/var_size.adb @@ -0,0 +1,7 @@ +-- RUN: %llvmgcc -c %s -I%p/Support +package body Var_Size is + function A (X : T) return String is + begin + return X.A; + end; +end; diff --git a/test/FrontendAda/vce.adb b/test/FrontendAda/vce.adb new file mode 100644 index 0000000..f24045c --- /dev/null +++ b/test/FrontendAda/vce.adb @@ -0,0 +1,7 @@ +-- RUN: %llvmgcc -c %s +procedure VCE is + S : String (1 .. 2); + B : Character := 'B'; +begin + S := 'A' & B; +end; diff --git a/test/FrontendAda/vce_lv.adb b/test/FrontendAda/vce_lv.adb new file mode 100644 index 0000000..4ca4d5c --- /dev/null +++ b/test/FrontendAda/vce_lv.adb @@ -0,0 +1,9 @@ +-- RUN: %llvmgcc -c %s +procedure VCE_LV is + type P is access String ; + type T is new P (5 .. 7); + subtype U is String (5 .. 7); + X : T := new U'(others => 'A'); +begin + null; +end; |