summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gnat.dg/missing_acc_check.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/gnat.dg/missing_acc_check.adb')
-rw-r--r--gcc/testsuite/gnat.dg/missing_acc_check.adb39
1 files changed, 39 insertions, 0 deletions
diff --git a/gcc/testsuite/gnat.dg/missing_acc_check.adb b/gcc/testsuite/gnat.dg/missing_acc_check.adb
new file mode 100644
index 000000000..1c2d9cf50
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/missing_acc_check.adb
@@ -0,0 +1,39 @@
+-- { dg-do run }
+
+procedure Missing_Acc_Check is
+
+ Test_Failed : Exception;
+
+ type Int_Access is access all Integer;
+
+ Save : Int_Access := null;
+
+ type Int_Rec is record
+ Int : aliased Integer;
+ end record;
+
+ type Ltd_Rec (IR_Acc : access Int_Rec) is limited null record;
+
+ function Pass_Rec (IR_Acc : access Int_Rec) return Int_Access is
+ begin
+ return IR_Acc.Int'Access; -- Accessibility check here
+ end Pass_Rec;
+
+ procedure Proc is
+ IR : aliased Int_Rec;
+ LR : Ltd_Rec (IR'Access);
+ begin
+ Save := Pass_Rec (LR.IR_Acc); -- Must raise Program_Error;
+
+ if Save /= null then
+ raise Test_Failed;
+ end if;
+
+ exception
+ when Program_Error =>
+ null;
+ end Proc;
+
+begin
+ Proc;
+end Missing_Acc_Check;