diff options
Diffstat (limited to 'gcc/ada/gen_il-gen.adb')
| -rw-r--r-- | gcc/ada/gen_il-gen.adb | 47 |
1 files changed, 15 insertions, 32 deletions
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb index 5eb1a58..873c3cd 100644 --- a/gcc/ada/gen_il-gen.adb +++ b/gcc/ada/gen_il-gen.adb @@ -167,7 +167,6 @@ package body Gen_IL.Gen is -- Check that syntactic fields precede semantic fields. Note that this -- check is happening before we compute inherited fields. - -- Exempt Chars and Actions from this rule, for now. declare Semantic_Seen : Boolean := False; @@ -178,11 +177,8 @@ package body Gen_IL.Gen is raise Illegal with "syntactic fields must precede semantic ones " & Image (T); end if; - else - if Fields (J).F not in Chars | Actions then - Semantic_Seen := True; - end if; + Semantic_Seen := True; end if; end loop; end; @@ -509,14 +505,11 @@ package body Gen_IL.Gen is Node_Field_Types_Used, Entity_Field_Types_Used : Type_Set; Setter_Needs_Parent : Field_Set := - (Actions | Expression | Then_Actions | Else_Actions => True, + (Then_Actions | Else_Actions => True, others => False); -- Set of fields where the setter should set the Parent. True for - -- syntactic fields of type Node_Id and List_Id, but with some - -- exceptions. Expression is syntactic AND semantic, and the Parent - -- is needed. Default_Expression is also both, but the Parent is not - -- needed. Then_Actions and Else_Actions are not syntactic, but the - -- Parent is needed. + -- syntactic fields of type Node_Id and List_Id. Then_Actions and + -- Else_Actions are not syntactic, but the Parent is needed. -- -- Computed in Check_For_Syntactic_Field_Mismatch. @@ -896,7 +889,7 @@ package body Gen_IL.Gen is -- For example, Left_Opnd comes before Right_Opnd, -- which wouldn't be the case if Right_Opnd were -- inherited from N_Op. - ((T = N_Op and then F = Right_Opnd) + ((T = N_Op and then F in Right_Opnd | Chars) or else (T = N_Renaming_Declaration and then F = Name) or else (T = N_Generic_Renaming_Declaration and then F = Name) or else F in Defining_Unit_Name @@ -1301,26 +1294,15 @@ package body Gen_IL.Gen is end if; end loop; - -- The following fields violate this rule. We might want to - -- simplify by getting rid of these cases, but we allow them - -- for now. At least, we don't want to add any new cases of - -- syntactic/semantic mismatch. + if Syntactic_Seen and Semantic_Seen then + raise Illegal with + "syntactic/semantic mismatch for " & Image (F); + end if; - if F in Chars | Actions | Expression | Default_Expression + if Field_Table (F).Field_Type in Traversed_Field_Type + and then Syntactic_Seen then - pragma Assert (Syntactic_Seen and Semantic_Seen); - - else - if Syntactic_Seen and Semantic_Seen then - raise Illegal with - "syntactic/semantic mismatch for " & Image (F); - end if; - - if Field_Table (F).Field_Type in Traversed_Field_Type - and then Syntactic_Seen - then - Setter_Needs_Parent (F) := True; - end if; + Setter_Needs_Parent (F) := True; end if; end; end if; @@ -2675,7 +2657,7 @@ package body Gen_IL.Gen is if Is_Descendant (N_Op, T) then -- Special cases for N_Op nodes: fill in the Chars and Entity - -- fields even though they were not passed in. + -- fields. Assert that the Chars passed in is defaulted. declare Op : constant String := Image_Sans_N (T); @@ -2705,6 +2687,7 @@ package body Gen_IL.Gen is -- "Op_", but the Name_Id constant does not. begin + Put (S, "pragma Assert (Chars = No_Name);" & LF); Put (S, "Set_Chars (N, Name_" & Op_Name & ");" & LF); Put (S, "Set_Entity (N, Standard_" & Op & ");" & LF); end; @@ -2990,7 +2973,7 @@ package body Gen_IL.Gen is (if T in Entity_Type and then F in Node_Field then " -- N" else ""); -- A comment to put out for fields of entities that are - -- shared with nodes, such as Chars. + -- shared with nodes. begin while First_Bit < Type_Bit_Size_Aligned (T) loop |