Skip to content

Commit 9f260a1

Browse files
Merge pull request #245 from tjj2017/subprogram_body_stub
Subprogram body stub
2 parents a1cbc0f + 68873e6 commit 9f260a1

File tree

11 files changed

+85
-25
lines changed

11 files changed

+85
-25
lines changed

experiments/golden-results/StratoX-summary.txt

Lines changed: 5 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -154,6 +154,11 @@ Error message: Unsupported pragma: No return
154154
Nkind: N_Pragma
155155
--
156156
Occurs: 5 times
157+
Calling function: Do_Expression
158+
Error message: Unknown expression kind
159+
Nkind: N_Expanded_Name
160+
--
161+
Occurs: 5 times
157162
Calling function: Do_Operator_General
158163
Error message: Concat unsupported
159164
Nkind: N_Op_Concat
@@ -184,11 +189,6 @@ Error message: Generic declaration
184189
Nkind: N_Generic_Package_Declaration
185190
--
186191
Occurs: 3 times
187-
Calling function: Do_Expression
188-
Error message: Unknown expression kind
189-
Nkind: N_Expanded_Name
190-
--
191-
Occurs: 3 times
192192
Calling function: Do_Procedure_Call_Statement
193193
Error message: sym id not in symbol table
194194
Nkind: N_Procedure_Call_Statement
@@ -219,11 +219,6 @@ Error message: Unsupported pragma: Unreferenced
219219
Nkind: N_Pragma
220220
--
221221
Occurs: 1 times
222-
Calling function: Process_Declaration
223-
Error message: Subprogram body stub declaration
224-
Nkind: N_Subprogram_Body_Stub
225-
--
226-
Occurs: 1 times
227222
Calling function: Process_Statement
228223
Error message: Extended return statement
229224
Nkind: N_Extended_Return_Statement

experiments/golden-results/UKNI-Information-Barrier-summary.txt

Lines changed: 7 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,9 @@
1-
Occurs: 7 times
2-
Calling function: Process_Declaration
3-
Error message: Subprogram body stub declaration
4-
Nkind: N_Subprogram_Body_Stub
5-
--
6-
Occurs: 6 times
1+
Occurs: 27 times
72
Calling function: Do_Expression
83
Error message: Unknown expression kind
94
Nkind: N_Expanded_Name
105
--
11-
Occurs: 5 times
12-
Calling function: Do_Procedure_Call_Statement
13-
Error message: sym id not in symbol table
14-
Nkind: N_Procedure_Call_Statement
15-
--
16-
Occurs: 2 times
6+
Occurs: 3 times
177
Calling function: Do_While_Statement
188
Error message: Wrong Nkind spec
199
Nkind: N_Loop_Statement
@@ -28,6 +18,11 @@ Calling function: Do_Base_Range_Constraint
2818
Error message: unsupported upper range kind
2919
Nkind: N_Attribute_Reference
3020
--
21+
Occurs: 1 times
22+
Calling function: Do_Expression
23+
Error message: Unknown expression kind
24+
Nkind: N_Range
25+
--
3126
Occurs: 5 times
3227
Redacted compiler error message:
3328
"REDACTED" not declared in "REDACTED"

gnat2goto/driver/tree_walk.adb

Lines changed: 19 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -252,6 +252,9 @@ package body Tree_Walk is
252252
procedure Do_Subprogram_Body (N : Node_Id)
253253
with Pre => Nkind (N) = N_Subprogram_Body;
254254

255+
procedure Do_Subprogram_Body_Stub (N : Node_Id)
256+
with Pre => Nkind (N) in N_Subprogram_Body_Stub;
257+
255258
function Do_Subprogram_Or_Block (N : Node_Id) return Irep
256259
with Pre => Nkind (N) in N_Subprogram_Body |
257260
N_Task_Body |
@@ -4134,7 +4137,21 @@ package body Tree_Walk is
41344137
Global_Symbol_Table.Replace (Proc_Name, Proc_Symbol);
41354138
end Do_Subprogram_Body;
41364139

4137-
-------------------------------
4140+
-----------------------------
4141+
-- Do_Subprogram_Body_Stub --
4142+
-----------------------------
4143+
4144+
procedure Do_Subprogram_Body_Stub (N : Node_Id) is
4145+
begin
4146+
-- The Gnat compilation model requires that a file
4147+
-- containing the separate subprogram body is present
4148+
-- otherwise a compilation error is generated.
4149+
-- Therefore, the subunit will always be present when gnat2goto
4150+
-- encounters a Subprogram_Body_Stub.
4151+
Do_Subprogram_Body (Proper_Body (Unit ((Library_Unit (N)))));
4152+
end Do_Subprogram_Body_Stub;
4153+
4154+
-------------------------------
41384155
-- Do_Subprogram_Declaration --
41394156
-------------------------------
41404157

@@ -4762,8 +4779,7 @@ package body Tree_Walk is
47624779
-- body_stub --
47634780

47644781
when N_Subprogram_Body_Stub =>
4765-
Report_Unhandled_Node_Empty (N, "Process_Declaration",
4766-
"Subprogram body stub declaration");
4782+
Do_Subprogram_Body_Stub (N);
47674783

47684784
when N_Package_Body_Stub =>
47694785
Report_Unhandled_Node_Empty (N, "Process_Declaration",
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
separate (P)
2+
procedure Inc (N : in out Integer) is
3+
Old_N : constant Integer := N;
4+
begin
5+
N := N + 1;
6+
pragma Assert (N = Old_N + 1);
7+
end Inc;
Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
-- Use *.asu file extension for a subunit so that it is not included as a
2+
-- a top level unit to be analysed using by the regression test system.
3+
-- The gnat front-end will automatically analyse the subunit when it
4+
-- encounters the sybprogram_body_stub.
5+
pragma Source_File_Name (
6+
Subunit_File_Name => "*.asu",
7+
Dot_Replacement => "-");
8+
9+
procedure P (X : in out integer) is
10+
procedure Inc (N : in out Integer) is separate;
11+
Old_X : constant Integer := X;
12+
begin
13+
Inc (X);
14+
-- The following assert should succeed if the possibility
15+
-- overflow is ignored.
16+
pragma Assert (X = Old_X + 1);
17+
end P;
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
[2] file p-inc.asu line 6 assertion: SUCCESS
2+
[1] file p.adb line 16 assertion: FAILURE
3+
VERIFICATION FAILED
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
from test_support import *
2+
3+
prove()
Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
-- Use *.asu file extension for a subunit so that it is not included as a
2+
-- a top level unit to be analysed using by the regression test system.
3+
-- The gnat front-end will automatically analyse the subunit when it
4+
-- encounters the sybprogram_body_stub.
5+
pragma Source_File_Name (
6+
Subunit_File_Name => "*.asu",
7+
Dot_Replacement => "-");
8+
9+
procedure P (X : in out integer) is
10+
procedure Inc (N : in out Integer) is separate;
11+
Old_X : constant Integer := X;
12+
begin
13+
Inc (X);
14+
-- The following assert should succeed if the possibility
15+
-- overflow is ignored.
16+
pragma Assert (X = Old_X + 1);
17+
end P;
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
ALL XFAIL Assert statement in p.adb should succeed.
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
[2] file p-inc.asu line 6 assertion: SUCCESS
2+
[1] file p.adb line 16 assertion: SUCCESS
3+
VERIFICATION SUCCEEDED

0 commit comments

Comments
 (0)