aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2021-04-07 07:52:07 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2021-06-29 14:23:45 +0000
commit997d3894fbd931e4dfa210a809175d7c2dc73b4b (patch)
tree0951d51e40da6fa3a8b688fa61821c4bfc31e973 /gcc
parent10215ba9d7848b858d3c2103807222675028225a (diff)
downloadgcc-997d3894fbd931e4dfa210a809175d7c2dc73b4b.zip
gcc-997d3894fbd931e4dfa210a809175d7c2dc73b4b.tar.gz
gcc-997d3894fbd931e4dfa210a809175d7c2dc73b4b.tar.bz2
[Ada] Fix bug in node/entity kind numbers in sinfo/einfo.h
gcc/ada/ * gen_il-gen.adb (Put_C_Type_And_Subtypes): Put the correct numbers. * gen_il-internals.ads, gen_il-internals.adb: (Pos): Remove this function. It was assuming that the order of the enumeration literals in Type_Enum is the same as the order of the generated types Node_Kind and Entity_Kind, which is not true.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/gen_il-gen.adb11
-rw-r--r--gcc/ada/gen_il-internals.adb12
-rw-r--r--gcc/ada/gen_il-internals.ads8
3 files changed, 13 insertions, 18 deletions
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
index 6b48e8e..6a61117 100644
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -2930,9 +2930,15 @@ package body Gen_IL.Gen is
procedure Put_C_Type_And_Subtypes
(S : in out Sink; Root : Root_Type) is
+ Cur_Pos : Root_Nat := 0;
+ -- Current Node_Kind'Pos or Entity_Kind'Pos to be printed
+
procedure Put_Enum_Lit (T : Node_Or_Entity_Type);
-- Print out the #define corresponding to the Ada enumeration literal
-- for T in Node_Kind and Entity_Kind (i.e. concrete types).
+ -- This looks like "#define Some_Kind <pos>", where Some_Kind
+ -- is the Node_Kind or Entity_Kind enumeration literal, and
+ -- <pos> is Node_Kind'Pos or Entity_Kind'Pos of that literal.
procedure Put_Kind_Subtype (T : Node_Or_Entity_Type);
-- Print out the SUBTYPE macro call corresponding to an abstract
@@ -2941,7 +2947,8 @@ package body Gen_IL.Gen is
procedure Put_Enum_Lit (T : Node_Or_Entity_Type) is
begin
if T in Concrete_Type then
- Put (S, "#define " & Image (T) & " " & Image (Pos (T)) & "" & LF);
+ Put (S, "#define " & Image (T) & " " & Image (Cur_Pos) & LF);
+ Cur_Pos := Cur_Pos + 1;
end if;
end Put_Enum_Lit;
@@ -2961,7 +2968,7 @@ package body Gen_IL.Gen is
Iterate_Types (Root, Pre => Put_Enum_Lit'Access);
Put (S, "#define Number_" & Node_Or_Entity (Root) & "_Kinds " &
- Image (Pos (Last_Concrete (Root)) + 1) & "" & LF & LF);
+ Image (Cur_Pos) & "" & LF & LF);
Iterate_Types (Root, Pre => Put_Kind_Subtype'Access);
diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb
index 59a142d..d77fe7a 100644
--- a/gcc/ada/gen_il-internals.adb
+++ b/gcc/ada/gen_il-internals.adb
@@ -477,16 +477,4 @@ package body Gen_IL.Internals is
Put (S, "-- End type hierarchy for " & N_Or_E & LF & LF);
end Put_Type_Hierarchy;
- ---------
- -- Pos --
- ---------
-
- function Pos (T : Concrete_Type) return Root_Nat is
- First : constant Concrete_Type :=
- (if T in Concrete_Node then Concrete_Node'First
- else Concrete_Entity'First);
- begin
- return Type_Enum'Pos (T) - Type_Enum'Pos (First);
- end Pos;
-
end Gen_IL.Internals;
diff --git a/gcc/ada/gen_il-internals.ads b/gcc/ada/gen_il-internals.ads
index 8d13e80..9c5779b 100644
--- a/gcc/ada/gen_il-internals.ads
+++ b/gcc/ada/gen_il-internals.ads
@@ -202,7 +202,10 @@ package Gen_IL.Internals is
Nil'Access);
-- Iterate top-down on the type hierarchy. Call Pre and Post before and
-- after walking child types. Note that this ignores union types, because
- -- they are nonhierarchical.
+ -- they are nonhierarchical. The order in which concrete types are visited
+ -- matches the order of the generated enumeration types Node_Kind and
+ -- Entity_Kind, which is not the same as the order of the Type_Enum
+ -- type in Gen_IL.Types.
function Is_Descendant (Ancestor, Descendant : Node_Or_Entity_Type)
return Boolean;
@@ -212,9 +215,6 @@ package Gen_IL.Internals is
procedure Put_Type_Hierarchy (S : in out Sink; Root : Root_Type);
- function Pos (T : Concrete_Type) return Root_Nat;
- -- Return Node_Kind'Pos (T) or Entity_Kind'Pos (T)
-
----------------
type Field_Desc is record