Skip to content

Commit d9166e6

Browse files
tjj2017Petr Bauch
authored andcommitted
Added Process_Declaration and Extend Process_Statement
Process_Declaration(s) mirror the behaviour of Process_Statement(s), i.e. a case analysis on the kind of declaration stored in the node being processed. This commit also extends the cases in Process_Statement.
1 parent 2c591d4 commit d9166e6

File tree

1 file changed

+229
-39
lines changed

1 file changed

+229
-39
lines changed

gnat2goto/driver/tree_walk.adb

Lines changed: 229 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -355,13 +355,37 @@ package body Tree_Walk is
355355
Old_Type : Entity_Id;
356356
New_Type : Entity_Id) return Irep;
357357

358+
type Construct is (Declaration, Statement);
359+
360+
procedure Warn_Unhandled_Construct (C : Construct; Mess : String);
361+
362+
procedure Process_Declaration (N : Node_Id; Block : Irep);
363+
-- with Pre => Nkind (N) in N_Declaration or else
364+
-- Nkind (N) in N_Number_Declaration or else
365+
-- Nkind (N) in N_Later_Decl_Item or else
366+
-- Nkind (N) in N_Pragma or else
367+
-- Nkind (N) in N_Exception_Declaration or else
368+
-- Nkind (N) in N_Freeze_Entity;
369+
-- Precondition commented out because full extend of declrations not yet known
370+
-- Handles both a basic declaration and a declarative item.
371+
372+
procedure Process_Declarations (L : List_Id; Block : Irep);
373+
-- Processes the declarations and is used for both a package specification
374+
-- where only basic declarations are allowed (no subprogram bodies etc.)
375+
-- and declarative parts where such declaratios are allowed.
376+
-- The Gnat front end will check that only allowed declarations are used
377+
-- where only basic declarations permitted.
378+
-- Process_Declarations is a procedure rather than a function like its
379+
-- sister Process_Statements because the Irep (an I_Code_Block) has to be
380+
-- extended in package_specifications when it has private declarations.
381+
358382
procedure Process_Statement (N : Node_Id; Block : Irep)
359383
with Pre => Kind (Block) = I_Code_Block;
360-
-- Process statement or declaration
384+
-- Process statement
361385

362386
function Process_Statements (L : List_Id) return Irep
363387
with Post => Kind (Process_Statements'Result) = I_Code_Block;
364-
-- Process list of statements or declarations
388+
-- Process list of statements
365389

366390
procedure Register_Subprogram_Specification (N : Node_Id)
367391
with Pre => Nkind (N) in N_Subprogram_Specification;
@@ -4911,81 +4935,247 @@ package body Tree_Walk is
49114935
end;
49124936
end Maybe_Make_Typecast;
49134937

4938+
--------------------------------
4939+
-- Warn_Unhandled_Construct --
4940+
--------------------------------
4941+
4942+
procedure Warn_Unhandled_Construct (C : Construct; Mess : String) is
4943+
S : constant String :=
4944+
(case C is
4945+
when Declaration => " declarations ",
4946+
when Statement => " statements ") & "unhandled";
4947+
begin
4948+
Put_Line (Standard_Error, "Warning: " & Mess & S);
4949+
end Warn_Unhandled_Construct;
4950+
4951+
--------------------------
4952+
-- Process_Declaration --
4953+
--------------------------
4954+
4955+
procedure Process_Declaration (N : Node_Id; Block : Irep) is
4956+
begin
4957+
-- Deal with the declaration
4958+
4959+
case Nkind (N) is
4960+
4961+
-- basic_declarations --
4962+
4963+
when N_Full_Type_Declaration =>
4964+
Do_Full_Type_Declaration (N);
4965+
4966+
when N_Subtype_Declaration =>
4967+
Do_Subtype_Declaration (N);
4968+
4969+
when N_Object_Declaration =>
4970+
Do_Object_Declaration (N, Block);
4971+
4972+
when N_Number_Declaration =>
4973+
Warn_Unhandled_Construct (Declaration, "Number");
4974+
4975+
when N_Subprogram_Declaration =>
4976+
Do_Subprogram_Declaration (N);
4977+
4978+
when N_Abstract_Subprogram_Declaration =>
4979+
Warn_Unhandled_Construct
4980+
(Declaration, "Abstract subprogram");
4981+
4982+
when N_Package_Declaration =>
4983+
Warn_Unhandled_Construct (Declaration, "Package");
4984+
4985+
when N_Renaming_Declaration =>
4986+
Warn_Unhandled_Construct (Declaration, "Renaming");
4987+
4988+
when N_Exception_Declaration =>
4989+
Warn_Unhandled_Construct (Declaration, "Exception");
4990+
4991+
when N_Generic_Declaration =>
4992+
Warn_Unhandled_Construct (Declaration, "Generic");
4993+
4994+
when N_Generic_Instantiation =>
4995+
Warn_Unhandled_Construct (Declaration, "Generic instantiation");
4996+
4997+
-- basic_declarative_items --
4998+
4999+
when N_Representation_Clause =>
5000+
Warn_Unhandled_Construct (Declaration, "Representation clause");
5001+
5002+
when N_Use_Package_Clause =>
5003+
Warn_Unhandled_Construct (Declaration, "Use package clause");
5004+
5005+
when N_Use_Type_Clause =>
5006+
Warn_Unhandled_Construct (Declaration, "Use type clause");
5007+
5008+
-- remaining declarative items --
5009+
5010+
-- proper_body --
5011+
5012+
when N_Subprogram_Body =>
5013+
Do_Subprogram_Body (N);
5014+
5015+
when N_Package_Body =>
5016+
Warn_Unhandled_Construct (Declaration, "Package body");
5017+
5018+
when N_Task_Body =>
5019+
Warn_Unhandled_Construct (Declaration, "Task body");
5020+
5021+
when N_Protected_Body =>
5022+
Warn_Unhandled_Construct (Declaration, "Protected body");
5023+
5024+
-- body_stub --
5025+
5026+
when N_Subprogram_Body_Stub =>
5027+
Warn_Unhandled_Construct (Declaration, "Subprogram body stub");
5028+
5029+
when N_Package_Body_Stub =>
5030+
Warn_Unhandled_Construct (Declaration, "Package body stub");
5031+
5032+
when N_Task_Body_Stub =>
5033+
Warn_Unhandled_Construct (Declaration, "Task body stub");
5034+
5035+
when N_Protected_Body_Stub =>
5036+
Warn_Unhandled_Construct (Declaration, "Protected body stub");
5037+
5038+
-- Pragmas may appear in declarations --
5039+
5040+
when N_Pragma =>
5041+
Warn_Unhandled_Construct (Declaration, "Pragmas in");
5042+
5043+
-- Every code lable is implicitly declared in --
5044+
-- the closest surrounding block --
5045+
5046+
when N_Implicit_Label_Declaration =>
5047+
-- Ignore for now, as I guess an implicit label can't be
5048+
-- referenced.
5049+
-- Yes it can: this is the declaration of the name it appears
5050+
-- the declaritve section but is used on a statement.
5051+
null;
5052+
5053+
-- Not sure the nex two should be here --
5054+
when N_Itype_Reference =>
5055+
Do_Itype_Reference (N);
5056+
5057+
when N_Freeze_Entity =>
5058+
-- Ignore, nothing to generate
5059+
null;
5060+
5061+
when others =>
5062+
Report_Unhandled_Node_Empty (N, "Process_Declaration",
5063+
"Unknown declaration kind");
5064+
5065+
end case;
5066+
5067+
end Process_Declaration;
5068+
5069+
--------------------------
5070+
-- Process_Declarations --
5071+
--------------------------
5072+
5073+
procedure Process_Declarations (L : List_Id; Block : Irep) is
5074+
Decl : Node_Id := First (L);
5075+
begin
5076+
while Present (Decl) loop
5077+
Process_Declaration (Decl, Block);
5078+
Next (Decl);
5079+
end loop;
5080+
5081+
end Process_Declarations;
5082+
49145083
-------------------------
49155084
-- Process_Statement --
49165085
-------------------------
49175086

49185087
procedure Process_Statement (N : Node_Id; Block : Irep) is
4919-
procedure Warn_Unhandled_Statement (M : String);
4920-
procedure Warn_Unhandled_Statement (M : String) is
4921-
begin
4922-
Put_Line (Standard_Error, "Warning: " & M & "statements unhandled");
4923-
end Warn_Unhandled_Statement;
49245088
begin
49255089
-- Deal with the statement
49265090
case Nkind (N) is
5091+
-- Simple statements --
5092+
when N_Null_Statement =>
5093+
null;
5094+
49275095
when N_Assignment_Statement =>
49285096
Append_Op (Block, Do_Assignment_Statement (N));
49295097

5098+
when N_Exit_Statement =>
5099+
Append_Op (Block, Do_Exit_Statement (N));
5100+
5101+
when N_Goto_Statement =>
5102+
Warn_Unhandled_Construct (Statement, "goto");
5103+
49305104
when N_Procedure_Call_Statement =>
49315105
Append_Op (Block, Do_Procedure_Call_Statement (N));
49325106

49335107
when N_Simple_Return_Statement =>
49345108
Append_Op (Block, Do_Simple_Return_Statement (N));
49355109

4936-
when N_Object_Declaration =>
4937-
Do_Object_Declaration (N, Block);
5110+
when N_Entry_Call_Statement =>
5111+
Warn_Unhandled_Construct (Statement, "entry_call");
49385112

4939-
when N_Handled_Sequence_Of_Statements =>
4940-
Append_Op (Block, Do_Handled_Sequence_Of_Statements (N));
5113+
when N_Requeue_Statement =>
5114+
Warn_Unhandled_Construct (Statement, "requeue");
5115+
5116+
when N_Delay_Statement =>
5117+
Warn_Unhandled_Construct (Statement, "delay");
5118+
5119+
when N_Abort_Statement =>
5120+
Warn_Unhandled_Construct (Statement, "abort");
5121+
5122+
when N_Raise_Statement =>
5123+
Warn_Unhandled_Construct (Statement, "raise");
5124+
5125+
when N_Code_Statement =>
5126+
Warn_Unhandled_Construct (Statement, "code");
5127+
5128+
-- Compound statements
49415129

49425130
when N_If_Statement =>
49435131
Append_Op (Block, Do_If_Statement (N));
49445132

4945-
when N_Implicit_Label_Declaration =>
4946-
-- Ignore for now, as I guess an implicit label can't be
4947-
-- referenced.
4948-
null;
5133+
when N_Case_Statement =>
5134+
Warn_Unhandled_Construct (Statement, "case");
49495135

49505136
when N_Loop_Statement =>
49515137
Append_Op (Block, Do_Loop_Statement (N));
49525138

4953-
when N_Full_Type_Declaration =>
4954-
Do_Full_Type_Declaration (N);
5139+
when N_Block_Statement =>
5140+
Warn_Unhandled_Construct (Statement, "block");
49555141

4956-
when N_Subtype_Declaration =>
4957-
Do_Subtype_Declaration (N);
5142+
when N_Handled_Sequence_Of_Statements => -- this seems incorrct
5143+
-- It should be block_statement
5144+
Append_Op (Block, Do_Handled_Sequence_Of_Statements (N));
49585145

4959-
when N_Freeze_Entity =>
4960-
-- Ignore, nothing to generate
4961-
null;
5146+
when N_Extended_Return_Statement =>
5147+
Warn_Unhandled_Construct (Statement, "extended_return");
49625148

4963-
when N_Itype_Reference =>
4964-
Do_Itype_Reference (N);
5149+
when N_Accept_Statement =>
5150+
Warn_Unhandled_Construct (Statement, "accept");
49655151

4966-
when N_Subprogram_Declaration =>
4967-
Do_Subprogram_Declaration (N);
5152+
-- Select statements --
49685153

4969-
when N_Subprogram_Body =>
4970-
Do_Subprogram_Body (N);
5154+
when N_Selective_Accept =>
5155+
Warn_Unhandled_Construct (Statement, "selective_accept");
49715156

4972-
when N_Null_Statement =>
4973-
null;
5157+
when N_Timed_Entry_Call =>
5158+
Warn_Unhandled_Construct (Statement, "timed_entry_call");
49745159

4975-
when N_Exit_Statement =>
4976-
Append_Op (Block, Do_Exit_Statement (N));
5160+
when N_Conditional_Entry_Call =>
5161+
Warn_Unhandled_Construct (Statement, "conditional_entry_call");
5162+
5163+
when N_Asynchronous_Select =>
5164+
Warn_Unhandled_Construct (Statement, "asychronous select");
5165+
5166+
-- Pragmas may placed in sequences of statements --
49775167

49785168
when N_Pragma =>
49795169
Do_Pragma (N, Block);
49805170

4981-
when N_Raise_Statement =>
4982-
Warn_Unhandled_Statement ("Raise");
5171+
-- Not sure the nex two should be here -
5172+
-- should they be in declarations? --
5173+
-- when N_Itype_Reference =>
5174+
-- Do_Itype_Reference (N);
49835175

4984-
when N_Number_Declaration =>
4985-
Warn_Unhandled_Statement ("Number declaration");
4986-
4987-
when N_Case_Statement =>
4988-
Warn_Unhandled_Statement ("Case");
5176+
-- when N_Freeze_Entity =>
5177+
-- -- Ignore, nothing to generate
5178+
-- null;
49895179

49905180
when others =>
49915181
Report_Unhandled_Node_Empty (N, "Process_Statement",

0 commit comments

Comments
 (0)