Skip to content

Commit 43fe9b2

Browse files
chrisr-diffbluechrisr-diffblue
authored
Merge pull request #260 from tjj2017/address_clause
Address clause
2 parents 57a2cd3 + afef1d5 commit 43fe9b2

File tree

12 files changed

+204
-38
lines changed

12 files changed

+204
-38
lines changed

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

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,16 +3,26 @@ Calling function: Do_Expression
33
Error message: Unknown expression kind
44
Nkind: N_Expanded_Name
55
--
6+
Occurs: 42 times
7+
Calling function: Process_Declaration
8+
Error message: Address representation clauses are not currently supported
9+
Nkind: N_Attribute_Definition_Clause
10+
--
611
Occurs: 20 times
712
Calling function: Do_Expression
813
Error message: In
914
Nkind: N_In
1015
--
11-
Occurs: 15 times
16+
Occurs: 19 times
1217
Calling function: Do_While_Statement
1318
Error message: Wrong Nkind spec
1419
Nkind: N_Loop_Statement
1520
--
21+
Occurs: 4 times
22+
Calling function: Process_Statement
23+
Error message: Unknown expression kind
24+
Nkind: N_Object_Declaration
25+
--
1626
Occurs: 3 times
1727
Calling function: Do_Base_Range_Constraint
1828
Error message: unsupported upper range kind
@@ -43,6 +53,16 @@ Calling function: Do_Expression
4353
Error message: Unknown expression kind
4454
Nkind: N_Range
4555
--
56+
Occurs: 1 times
57+
Calling function: Do_Operator_General
58+
Error message: Mod of unsupported type
59+
Nkind: N_Op_Not
60+
--
61+
Occurs: 1 times
62+
Calling function: Process_Declaration
63+
Error message: Use package clause declaration
64+
Nkind: N_Use_Package_Clause
65+
--
4666
Occurs: 5 times
4767
Redacted compiler error message:
4868
"REDACTED" not declared in "REDACTED"

‎gnat2goto/driver/tree_walk.adb‎

Lines changed: 57 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
with Namet; use Namet;
22
with Nlists; use Nlists;
33
with Sem;
4+
with Sem_Eval; use Sem_Eval;
45
with Sem_Util; use Sem_Util;
56
with Sem_Aux; use Sem_Aux;
67
with Snames; use Snames;
@@ -4644,51 +4645,70 @@ package body Tree_Walk is
46444645
procedure Handle_Representation_Clause (N : Node_Id);
46454646
procedure Handle_Representation_Clause (N : Node_Id) is
46464647
Attr_Id : constant String := Get_Name_String (Chars (N));
4647-
Target_Name : constant Irep := Do_Identifier (Name (N));
4648-
Entity_Esize : constant Uint := Esize (Entity (N));
4649-
Target_Type_Irep : constant Irep :=
4650-
Follow_Symbol_Type (Get_Type (Target_Name), Global_Symbol_Table);
4651-
Expression_Value : constant Uint := Intval (Expression (N));
46524648
begin
4653-
pragma Assert (Kind (Target_Type_Irep) in Class_Type);
4654-
if Attr_Id = "size" then
4655-
4656-
-- Just check that the front-end already applied this size
4657-
-- clause, i .e. that the size of type-irep we already had
4658-
-- equals the entity type this clause is applied to (and the
4659-
-- size specified in this clause).
4660-
pragma Assert (Entity_Esize =
4661-
UI_From_Int (Int (Get_Width (Target_Type_Irep)))
4662-
and Entity_Esize = Expression_Value);
4649+
-- First check if it is an address clause which gnat2goto does not
4650+
-- currently handle
4651+
if Attr_Id = "address" then
4652+
Report_Unhandled_Node_Empty
4653+
(N, "Process_Declaration",
4654+
"Address representation clauses are not currently supported");
46634655
return;
4664-
elsif Attr_Id = "component_size" then
4665-
if not Is_Array_Type (Entity (N)) then
4666-
Report_Unhandled_Node_Empty (N, "Process_Declaration",
4667-
"Component size only supported for array types");
4668-
return;
4669-
end if;
4656+
elsif Attr_Id = "size" or else Attr_Id = "component_size" then
46704657
declare
4671-
Array_Data : constant Irep :=
4672-
Get_Data_Component_From_Type (Target_Type_Irep);
4673-
Target_Subtype : constant Irep :=
4674-
Follow_Symbol_Type (Get_Subtype (Get_Type (Array_Data)),
4675-
Global_Symbol_Table);
4676-
Target_Subtype_Width : constant Uint :=
4677-
UI_From_Int (Int (Get_Width (Target_Subtype)));
4658+
Target_Name : constant Irep := Do_Identifier (Name (N));
4659+
Entity_Esize : constant Uint := Esize (Entity (N));
4660+
Target_Type_Irep : constant Irep :=
4661+
Follow_Symbol_Type
4662+
(Get_Type (Target_Name), Global_Symbol_Table);
4663+
Expression_Value : constant Uint := Expr_Value (Expression (N));
46784664
begin
4679-
if Component_Size (Entity (N)) /= Expression_Value or
4680-
Target_Subtype_Width /= Expression_Value
4681-
then
4682-
Report_Unhandled_Node_Empty (N, "Process_Declaration",
4683-
"Having component sizes be different from the size of " &
4684-
"their underlying type is currently not supported");
4665+
pragma Assert (Kind (Target_Type_Irep) in Class_Type);
4666+
if Attr_Id = "size" then
4667+
4668+
-- Just check that the front-end already applied this size
4669+
-- clause, i .e. that the size of type-irep we already had
4670+
-- equals the entity type this clause is applied to (and the
4671+
-- size specified in this clause).
4672+
pragma Assert
4673+
(Entity_Esize =
4674+
UI_From_Int (Int (Get_Width (Target_Type_Irep)))
4675+
and Entity_Esize = Expression_Value);
4676+
return;
4677+
elsif Attr_Id = "component_size" then
4678+
if not Is_Array_Type (Entity (N)) then
4679+
Report_Unhandled_Node_Empty
4680+
(N, "Process_Declaration",
4681+
"Component size only supported for array types");
4682+
return;
4683+
end if;
4684+
declare
4685+
Array_Data : constant Irep :=
4686+
Get_Data_Component_From_Type (Target_Type_Irep);
4687+
Target_Subtype : constant Irep :=
4688+
Follow_Symbol_Type (Get_Subtype (Get_Type (Array_Data)),
4689+
Global_Symbol_Table);
4690+
Target_Subtype_Width : constant Uint :=
4691+
UI_From_Int (Int (Get_Width (Target_Subtype)));
4692+
begin
4693+
if Component_Size (Entity (N)) /= Expression_Value or
4694+
Target_Subtype_Width /= Expression_Value
4695+
then
4696+
Report_Unhandled_Node_Empty
4697+
(N, "Process_Declaration",
4698+
"Having component sizes be different from the "
4699+
& "size of their underlying type "
4700+
& "is currently not supported");
4701+
end if;
4702+
end;
4703+
return;
46854704
end if;
46864705
end;
4687-
return;
46884706
end if;
46894707

4690-
Report_Unhandled_Node_Empty (N, "Process_Declaration",
4691-
"Representation clause unsupported: " & Attr_Id);
4708+
Report_Unhandled_Node_Empty
4709+
(N, "Process_Declaration",
4710+
"Representation clause unsupported: " & Attr_Id);
4711+
46924712
end Handle_Representation_Clause;
46934713

46944714
begin

‎testsuite/gnat2goto/tests/address_clause/address_clause.adb‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
with System; use System;
2+
with System.Storage_Elements;
3+
procedure Address_Clause is
4+
Var_Addr_1 : Integer;
5+
for Var_Addr_1'Address use System'To_Address (16#6F#);
6+
7+
Var_Addr_2 : Integer;
8+
for Var_Addr_2'Address use System.Storage_Elements.To_Address (16#80#);
9+
begin
10+
Var_Addr_1 := 1;
11+
Var_Addr_2 := 2;
12+
pragma Assert (Var_Addr_1 + Var_Addr_2 = 3);
13+
end Address_Clause;

‎testsuite/gnat2goto/tests/address_clause/test.out‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
Standard_Output from gnat2goto address_clause:
2+
N_Attribute_Definition_Clause "address" (Node_Id=2277) (source,analyzed)
3+
Sloc = 8303 address_clause.adb:5:4
4+
Chars = "address" (Name_Id=300000791)
5+
Name = N_Identifier "var_addr_1" (Node_Id=2274)
6+
Expression = N_Function_Call (Node_Id=2280)
7+
Entity = N_Defining_Identifier "var_addr_1" (Entity_Id=2264)
8+
Check_Address_Alignment = True
9+
N_Attribute_Definition_Clause "address" (Node_Id=2295) (source,analyzed)
10+
Sloc = 8387 address_clause.adb:8:4
11+
Chars = "address" (Name_Id=300000791)
12+
Name = N_Identifier "var_addr_2" (Node_Id=2292)
13+
Expression = N_Function_Call (Node_Id=2302)
14+
Entity = N_Defining_Identifier "var_addr_2" (Entity_Id=2282)
15+
Check_Address_Alignment = True
16+
17+
Standard_Error from gnat2goto address_clause:
18+
----------At: Process_Declaration----------
19+
----------Address representation clauses are not currently supported----------
20+
----------At: Process_Declaration----------
21+
----------Address representation clauses are not currently supported----------
22+
23+
[1] file address_clause.adb line 12 assertion: SUCCESS
24+
VERIFICATION SUCCESSFUL

‎testsuite/gnat2goto/tests/address_clause/test.py‎

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()

‎testsuite/gnat2goto/tests/size_integer_and_objects/check_size.adb‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
procedure Check_Size is
2+
Size_1 : constant := -23 + 31;
3+
Size_2 : constant Integer := 35 - 3;
4+
Size_3 : constant := 2 * Size_1;
5+
6+
type T_1 is new Integer range 0 .. 47;
7+
for T_1'Size use Size_1;
8+
9+
type T_2 is range 0 .. 2**16 + 1;
10+
for T_2'Size use Size_2;
11+
12+
type Unsigned_8 is mod 2**8;
13+
for Unsigned_8'Size use Size_3;
14+
15+
Var_T_1 : T_1;
16+
Var_T_2 : T_2;
17+
18+
Var_Size_1 : Integer range 0 .. 47;
19+
for Var_Size_1'Size use Size_1;
20+
21+
Var_Size_2 : Integer range 0 .. 2**16 + 1;
22+
for Var_Size_2'Size use Size_2;
23+
24+
Var_U8 : Unsigned_8;
25+
for Var_U8'Size use Size_1;
26+
27+
begin
28+
Var_T_1 := 30;
29+
Var_T_2 := 40;
30+
pragma Assert (Integer (Var_T_1) + Integer (Var_T_2) = 70);
31+
32+
Var_Size_1 := 10;
33+
Var_Size_2 := 20;
34+
pragma Assert (Var_Size_1 + Var_Size_2 = 30);
35+
36+
Var_U8 := 255;
37+
pragma Assert (Var_U8 + 1 = 0);
38+
end Check_Size;

‎testsuite/gnat2goto/tests/size_integer_and_objects/test.opt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
ALL XFAIL gnat2goto fails when Size representation clause applied to standard types and their derivations or to objects.

‎testsuite/gnat2goto/tests/size_integer_and_objects/test.out‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
+===========================GNAT BUG DETECTED==============================+
2+
| GNU Ada (ada2goto) Assert_Failure tree_walk.adb:4673 |
3+
| Error detected at check_size.adb:1:11 |
4+
| Please submit a bug report; see https://gcc.gnu.org/bugs/ . |
5+
| Use a subject line meaningful to you and us to track the bug. |
6+
| Include the entire contents of this bug box in the report. |
7+
| Include the exact command that you entered. |
8+
| Also include sources listed below. |
9+
+==========================================================================+
10+
11+
Please include these source files with error report
12+
Note that list may not be accurate in some cases,
13+
so please double check that the problem can still
14+
be reproduced with the set of files listed.
15+
Consider also -gnatd.n switch (see debug.adb).
16+
17+
check_size.adb
18+
19+
compilation abandoned

‎testsuite/gnat2goto/tests/size_integer_and_objects/test.py‎

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()

‎testsuite/gnat2goto/tests/size_mod_type/check_size_mod.adb‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
procedure Check_Size_Mod is
2+
S1 : constant := 39 - 7;
3+
S2 : constant Integer := -100 + 164;
4+
5+
type Unsigned_8 is mod 2 ** 8;
6+
for Unsigned_8'Size use S1;
7+
8+
type Unsigned_4 is mod 2 ** 4;
9+
for Unsigned_4'Size use S2;
10+
11+
V1 : Unsigned_8;
12+
V2 : Unsigned_4;
13+
begin
14+
V1 := 255;
15+
V2 := 15;
16+
17+
pragma Assert (V1 + 1 = 0);
18+
pragma Assert (V2 + 2 = 1);
19+
end Check_Size_Mod;

0 commit comments

Comments
 (0)