[Ada] Variable-sized node types

gcc/ada/

	* atree.ads, atree.adb: Major rewrite to support variable-sized
	node types. Add pragmas Suppress and Assertion_Policy.  We now
	have an extra level of indirection: Node_Offsets is a table
	mapping Node_Ids to the offset of the start of each node in
	Slots. Slots is a table containing one or more contiguous slots
	for each node. Each slot is a 32-bit unchecked union that can
	contain any mixture of 1, 2, 4, 8, and 32-bit fields that fits.
	The old low-level getters and setters (e.g.  Flag123) are
	removed.
	* gen_il-fields.ads, gen_il-gen-gen_entities.adb,
	gen_il-gen-gen_nodes.adb, gen_il-gen.adb, gen_il-gen.ads,
	gen_il-main.adb, gen_il-types.ads, gen_il-utils.adb,
	gen_il-utils.ads, gen_il.adb, gen_il.ads: New gen_il program
	that generates various Ada and C++ files. In particular, the
	following files are generated by gen_il: einfo-entities.adb
	einfo-entities.ads, gnatvsn.ads, nmake.adb, nmake.ads,
	seinfo.ads, seinfo_tables.adb, seinfo_tables.ads,
	sinfo-nodes.adb, sinfo-nodes.ads, einfo.h, and sinfo.h.
	* sinfo-utils.adb, sinfo-utils.ads, einfo-utils.adb,
	einfo-utils.ads: New files containing code that needs to refer
	to Sinfo.Nodes and Einfo.Entities. This code is mostly moved
	here from Sinfo and Einfo to break cycles.
	* back_end.adb: Pass node_offsets_ptr and slots_ptr to gigi,
	instead of nodes_ptr and flags_ptr. The Nodes and Flags tables
	no longer exist. (Note that gigi never used the Flags table.)
	* sinfo-cn.ads (Change_Identifier_To_Defining_Identifier,
	Change_Character_Literal_To_Defining_Character_Literal,
	Change_Operator_Symbol_To_Defining_Operator_Symbol): Turn N into
	an IN formal.
	* sinfo-cn.adb: Update.  Add assertions, which can be removed at
	some point.  Rewrite to use higher-level facilities.  Make sure
	vanishing fields are zeroed out.  Add with/use for new packages.
	* sem_util.adb: Remove "Assert(False)" immediately followed by
	"raise Program_Error".  Use higher-level facilities such as
	Walk_Sinfo_Fields instead of depending on low-level Set_FieldN
	routines that no longer exist. Use Get_Comes_From_Source_Default
	instead of Default_Node.Comes_From_Source (Default_Node no
	longer exists).  Use Set_Basic_Convention instead of
	Basic_Set_Convention.  Add with/use for new packages.
	* sem_util.ads: The Convention field had getter Convention and
	setter Basic_Set_Convention. Make that more uniform: there is
	now a field called Basic_Convention, with Basic_Convention and
	Set_Basic_Convention as getter/setter, and write Convention and
	Set_Convention here.
	* nlists.adb: Rewrite to use abstractions, rather then depending
	on low-level implementation details of Atree. Necessary because
	those details have changed. Add with/use for new packages.
	* sem_ch12.adb: Use higher-level facilities such as
	Walk_Sinfo_Fields instead of depending on low-level Set_FieldN
	routines that no longer exist. Add with/use for new packages.
	* exp_cg.adb, sem_ch10.adb, sem_ch4.adb, sem_eval.adb,
	sem_prag.adb, sem_warn.adb: Change expanded names to refer to
	the new packages for things that moved. Add with/use for new
	packages.
	* sem_ch3.adb: Likewise. Reinitialize vanishing fields.
	* exp_disp.adb: Likewise. Remove failing assertion.
	* sinfo.ads, einfo.ads: Remove code that is now generated into
	Sinfo.Nodes and Einfo.Entities.
	* sinfo.adb, einfo.adb: Replace bodies with "pragma No_Body;".
	We should delete these at some point, but No_Body makes make
	files easier. Some code is moved to Sinfo.Nodes, Einfo.Entities,
	Sinfo.Utils, and Einfo.Utils. Some is no longer necessary.
	* treepr.adb: Rewrite to use new tables. We no longer need
	treeprs.ads.
	* treepr.ads: Add comment.
	* types.ads: Move types Component_Alignment_Kind and
	Float_Rep_Kind here.
	* atree.h: Major update to match atree.ads changes.  Add slot
	types, for use by getters/setters.
	* types.h: Move types Component_Alignment_Kind and
	Float_Rep_Kind here.
	* fe.h: Rewrite to deal with code that has changed or moved from
	Atree, Sinfo, Einfo.
	* nlists.h: Move some code to fe.h.
	* alloc.ads: Split Nodes_* constants into Node_Offsets and
	Slots, because Atree has two separate tables.  Increase values.
	Remove Nodes_Release_Threshold. Improve comment.
	* debug.adb, gnat1drv.adb: Remove obsolete gnatd.A and gnatd.N
	switches.  Add with/use for new packages.
	* opt.ads: Minor comment fix.
	* aspects.adb, checks.adb, comperr.adb, contracts.adb,
	cstand.adb, debug_a.adb, errout.adb, eval_fat.adb, exp_aggr.adb,
	exp_atag.adb, exp_attr.adb, exp_ch11.adb, exp_ch12.adb,
	exp_ch13.adb, exp_ch2.adb, exp_ch3.adb, exp_ch4.adb,
	exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch8.adb, exp_ch9.adb,
	exp_code.adb, exp_dbug.adb, exp_dist.adb, exp_fixd.adb,
	exp_imgv.adb, exp_intr.adb, exp_pakd.adb, exp_prag.adb,
	exp_put_image.adb, exp_sel.adb, exp_smem.adb, exp_spark.adb,
	exp_strm.adb, exp_tss.adb, exp_unst.adb, exp_util.adb,
	exp_util.ads, expander.adb, freeze.adb, frontend.adb,
	get_targ.ads, ghost.adb, gnat_cuda.adb, impunit.adb, inline.adb,
	itypes.adb, itypes.ads, layout.adb, lib.adb, lib-load.adb,
	lib-writ.adb, lib-xref.adb, lib-xref.ads,
	lib-xref-spark_specific.adb, live.adb, par.adb, par_sco.adb,
	pprint.adb, repinfo.adb, restrict.adb, rtsfind.adb, scil_ll.adb,
	scn.adb, sem.adb, sem.ads, sem_aggr.adb, sem_attr.adb,
	sem_aux.adb, sem_case.adb, sem_cat.adb, sem_ch11.adb,
	sem_ch13.adb, sem_ch2.adb, sem_ch5.adb, sem_ch6.adb,
	sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_dim.adb,
	sem_disp.adb, sem_dist.adb, sem_elab.adb, sem_elim.adb,
	sem_intr.adb, sem_mech.adb, sem_res.adb, sem_scil.adb,
	sem_smem.adb, sem_type.adb, set_targ.ads, sinput.adb,
	sinput-l.adb, sprint.adb, style.adb, styleg.adb, tbuild.adb,
	tbuild.ads, uname.adb: Add with/use for new packages.
	* libgnat/a-stoubu.adb, libgnat/a-stouut.adb: Simplify to ease
	bootstrap.
	* libgnat/a-stobfi.adb, libgnat/a-stoufi.adb (Create_File,
	Create_New_File): Create file in binary format, to avoid
	introducing unwanted text conversions on Windows. Simplify to
	ease bootstrap.
	* libgnat/a-stteou__bootstrap.ads: New.
	* ceinfo.adb, csinfo.adb, nmake.adt, treeprs.adt, xeinfo.adb,
	xnmake.adb, xsinfo.adb, xtreeprs.adb: Delete.
	* Make-generated.in: Build and run the gen_il program to
	generate files. The files are generated in the ada/gen_il
	subdirectory, and then moved up to ada.  We rely on gnatmake (as
	opposed to make) to build the gen_il program efficiently (i.e.
	don't do anything if the sources didn't change).
	* gcc-interface/Makefile.in (ADAFLAGS): Add -gnatU.
	(GNATMAKE_OBJS): Add new object files.
	(GENERATED_FILES_FOR_TOOLS): New variable.
	(../stamp-tools): Create a link for all
	GENERATED_FILES_FOR_TOOLS.
	* gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Add new object
	files.  Remove ada/treeprs.o.
	(GNATBIND_OBJS): Add new object files.
	(ada.mostlyclean): Remove ada/sdefault.adb and add
	ada/stamp-gen_il.
	(ada.maintainer-clean): Remove ada/treeprs.ads.
	(update-sources): Remove obsolete target.
	(ada_generated_files): Rename to...
	(ADA_GENERATED_FILES): ... this.  Add new source files.  Add
	comment.

	* gcc-interface/trans.c: Remove obsolete Nodes_Ptr and
	Flags_ptr.  Add Node_Offsets_Ptr and Slots_Ptr, which point to
	the corresponding tables in Atree.
	* gcc-interface/gigi.h (gigi): New parameters for initializing
	Node_Offsets_Ptr and Slots_Ptr.
	* gcc-interface/decl.c: Numeric_Kind,
	Discrete_Or_Fixed_Point_Kind, and Record_Kind were
	nonhierarchical, and were therefore removed for simplicity.
	Replace uses with calls to Is_In_... functions.

gnattools/

	* Makefile.in (GENERATED_FILES_FOR_TOOLS): New variable.
	($(GCC_DIR)/stamp-tools): Walk it for the first copy operation.

1 files changed, 0 insertions, 639 deletions

diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb
deleted file mode 100644
index a8084ca..0000000
--- a/gcc/ada/csinfo.adb
+++ /dev/null
@@ -1,639 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                          GNAT SYSTEM UTILITIES                           --
---                                                                          --
---                               C S I N F O                                --
---                                                                          --
---                                 B o d y                                  --
---                                                                          --
---          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
---                                                                          --
--- GNAT is free software;  you can  redistribute it  and/or modify it under --
--- terms of the  GNU General Public License as published  by the Free Soft- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
--- http://www.gnu.org/licenses for a complete copy of the license.          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  Check consistency of sinfo.ads and sinfo.adb. Checks that field name usage
---  is consistent and that assertion cross-reference lists are correct, as well
---  as making sure that all the comments on field name usage are consistent.
-
---  Note that this is used both as a standalone program, and as a procedure
---  called by XSinfo. This raises an unhandled exception if it finds any
---  errors; we don't attempt any sophisticated error recovery.
-
-with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
-with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
-with Ada.Strings.Maps;              use Ada.Strings.Maps;
-with Ada.Strings.Maps.Constants;    use Ada.Strings.Maps.Constants;
-with Ada.Text_IO;                   use Ada.Text_IO;
-
-with GNAT.Spitbol;                  use GNAT.Spitbol;
-with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
-with GNAT.Spitbol.Table_Boolean;
-with GNAT.Spitbol.Table_VString;
-
-procedure CSinfo is
-
-   package TB renames GNAT.Spitbol.Table_Boolean;
-   package TV renames GNAT.Spitbol.Table_VString;
-   use TB, TV;
-
-   Infil  : File_Type;
-   Lineno : Natural := 0;
-
-   Err : exception;
-   --  Raised on fatal error
-
-   Done : exception;
-   --  Raised after error is found to terminate run
-
-   WSP : constant Pattern := Span (' ' & ASCII.HT);
-
-   Fields   : TV.Table (300);
-   Fields1  : TV.Table (300);
-   Refs     : TV.Table (300);
-   Refscopy : TV.Table (300);
-   Special  : TB.Table (50);
-   Inlines  : TV.Table (100);
-
-   --  The following define the standard fields used for binary operator,
-   --  unary operator, and other expression nodes. Numbers in the range 1-5
-   --  refer to the Fieldn fields. Letters D-R refer to flags:
-
-   --      D = Flag4
-   --      E = Flag5
-   --      F = Flag6
-   --      G = Flag7
-   --      H = Flag8
-   --      I = Flag9
-   --      J = Flag10
-   --      K = Flag11
-   --      L = Flag12
-   --      M = Flag13
-   --      N = Flag14
-   --      O = Flag15
-   --      P = Flag16
-   --      Q = Flag17
-   --      R = Flag18
-
-   Flags : TV.Table (20);
-   --  Maps flag numbers to letters
-
-   N_Fields : constant Pattern := BreakX ("J");
-   E_Fields : constant Pattern := BreakX ("5EFGHIJOP");
-   U_Fields : constant Pattern := BreakX ("1345EFGHIJKOPQ");
-   B_Fields : constant Pattern := BreakX ("12345EFGHIJKOPQ");
-
-   Line : VString;
-   Bad  : Boolean;
-
-   Field       : constant VString := Nul;
-   Fields_Used : VString := Nul;
-   Name        : constant VString := Nul;
-   Next        : constant VString := Nul;
-   Node        : VString := Nul;
-   Ref         : VString := Nul;
-   Synonym     : constant VString := Nul;
-   Nxtref      : constant VString := Nul;
-
-   Which_Field : aliased VString := Nul;
-
-   Node_Search : constant Pattern := WSP & "--  N_" & Rest * Node;
-   Break_Punc  : constant Pattern := Break (" .,");
-   Plus_Binary : constant Pattern := WSP
-                                     & "--  plus fields for binary operator";
-   Plus_Unary  : constant Pattern := WSP
-                                     & "--  plus fields for unary operator";
-   Plus_Expr   : constant Pattern := WSP
-                                     & "--  plus fields for expression";
-   Break_Syn   : constant Pattern := WSP &  "--  "
-                                     & Break (' ') * Synonym
-                                     & " (" & Break (')') * Field;
-   Break_Field : constant Pattern := BreakX ('-') * Field;
-   Get_Field   : constant Pattern := BreakX (Decimal_Digit_Set)
-                                     & Span (Decimal_Digit_Set) * Which_Field;
-   Break_WFld  : constant Pattern := Break (Which_Field'Access);
-   Get_Funcsyn : constant Pattern := WSP & "function " & Rest * Synonym;
-   Extr_Field  : constant Pattern := BreakX ('-') & "-- " & Rest * Field;
-   Get_Procsyn : constant Pattern := WSP & "procedure Set_" & Rest * Synonym;
-   Get_Inline  : constant Pattern := WSP & "pragma Inline ("
-                                     & Break (')') * Name;
-   Set_Name    : constant Pattern := "Set_" & Rest * Name;
-   Func_Rest   : constant Pattern := "   function " & Rest * Synonym;
-   Get_Nxtref  : constant Pattern := Break (',') * Nxtref & ',';
-   Test_Syn    : constant Pattern := Break ('=') & "= N_"
-                                     & (Break (" ,)") or Rest) * Next;
-   Chop_Comma  : constant Pattern := BreakX (',') * Next;
-   Return_Fld  : constant Pattern := WSP & "return " & Break (' ') * Field;
-   Set_Syn     : constant Pattern := "   procedure Set_" & Rest * Synonym;
-   Set_Fld     : constant Pattern := WSP & "Set_" & Break (' ') * Field
-                                     & " (N, Val)";
-   Break_With  : constant Pattern := Break ('_') ** Field & "_With_Parent";
-
-   type VStringA is array (Natural range <>) of VString;
-
-   procedure Next_Line;
-   --  Read next line trimmed from Infil into Line and bump Lineno
-
-   procedure Sort (A : in out VStringA);
-   --  Sort a (small) array of VString's
-
-   procedure Next_Line is
-   begin
-      Line := Get_Line (Infil);
-      Trim (Line);
-      Lineno := Lineno + 1;
-   end Next_Line;
-
-   procedure Sort (A : in out VStringA) is
-      Temp : VString;
-   begin
-      <<Sort>>
-         for J in 1 .. A'Length - 1 loop
-            if A (J) > A (J + 1) then
-               Temp := A (J);
-               A (J) := A (J + 1);
-               A (J + 1) := Temp;
-               goto Sort;
-            end if;
-         end loop;
-   end Sort;
-
---  Start of processing for CSinfo
-
-begin
-   Anchored_Mode := True;
-   New_Line;
-   Open (Infil, In_File, "sinfo.ads");
-   Put_Line ("Check for field name consistency");
-
-   --  Setup table for mapping flag numbers to letters
-
-   Set (Flags, "4",  V ("D"));
-   Set (Flags, "5",  V ("E"));
-   Set (Flags, "6",  V ("F"));
-   Set (Flags, "7",  V ("G"));
-   Set (Flags, "8",  V ("H"));
-   Set (Flags, "9",  V ("I"));
-   Set (Flags, "10", V ("J"));
-   Set (Flags, "11", V ("K"));
-   Set (Flags, "12", V ("L"));
-   Set (Flags, "13", V ("M"));
-   Set (Flags, "14", V ("N"));
-   Set (Flags, "15", V ("O"));
-   Set (Flags, "16", V ("P"));
-   Set (Flags, "17", V ("Q"));
-   Set (Flags, "18", V ("R"));
-
-   --  Special fields table. The following names are not recorded or checked
-   --  by Csinfo, since they are specially handled. This means that any field
-   --  definition or subprogram with a matching name is ignored.
-
-   Set (Special, "Analyzed",                         True);
-   Set (Special, "Assignment_OK",                    True);
-   Set (Special, "Associated_Node",                  True);
-   Set (Special, "Cannot_Be_Constant",               True);
-   Set (Special, "Chars",                            True);
-   Set (Special, "Comes_From_Source",                True);
-   Set (Special, "Do_Overflow_Check",                True);
-   Set (Special, "Do_Range_Check",                   True);
-   Set (Special, "Entity",                           True);
-   Set (Special, "Entity_Or_Associated_Node",        True);
-   Set (Special, "Error_Posted",                     True);
-   Set (Special, "Etype",                            True);
-   Set (Special, "Evaluate_Once",                    True);
-   Set (Special, "First_Itype",                      True);
-   Set (Special, "Has_Aspect_Specifications",        True);
-   Set (Special, "Has_Dynamic_Itype",                True);
-   Set (Special, "Has_Dynamic_Length_Check",         True);
-   Set (Special, "Has_Private_View",                 True);
-   Set (Special, "Is_Controlling_Actual",            True);
-   Set (Special, "Is_Overloaded",                    True);
-   Set (Special, "Is_Static_Expression",             True);
-   Set (Special, "Left_Opnd",                        True);
-   Set (Special, "Must_Not_Freeze",                  True);
-   Set (Special, "Nkind_In",                         True);
-   Set (Special, "Parens",                           True);
-   Set (Special, "Pragma_Name",                      True);
-   Set (Special, "Raises_Constraint_Error",          True);
-   Set (Special, "Right_Opnd",                       True);
-
-   --  Loop to acquire information from node definitions in sinfo.ads,
-   --  checking for consistency in Op/Flag assignments to each synonym
-
-   loop
-      Bad := False;
-      Next_Line;
-      exit when Match (Line, "   -- Node Access Functions");
-
-      if Match (Line, Node_Search)
-        and then not Match (Node, Break_Punc)
-      then
-         Fields_Used := Nul;
-
-      elsif Node = "" then
-         null;
-
-      elsif Line = "" then
-         Node := Nul;
-
-      elsif Match (Line, Plus_Binary) then
-         Bad := Match (Fields_Used, B_Fields);
-
-      elsif Match (Line, Plus_Unary) then
-         Bad := Match (Fields_Used, U_Fields);
-
-      elsif Match (Line, Plus_Expr) then
-         Bad := Match (Fields_Used, E_Fields);
-
-      elsif not Match (Line, Break_Syn) then
-         null;
-
-      elsif Match (Synonym, "plus") then
-         null;
-
-      else
-         Match (Field, Break_Field);
-
-         if not Present (Special, Synonym) then
-            if Present (Fields, Synonym) then
-               if Field /= Get (Fields, Synonym) then
-                  Put_Line
-                    ("Inconsistent field reference at line" &
-                     Lineno'Img & " for " & Synonym);
-                  raise Done;
-               end if;
-
-            else
-               Set (Fields, Synonym, Field);
-            end if;
-
-            Set (Refs, Synonym, Node & ',' & Get (Refs, Synonym));
-            Match (Field, Get_Field);
-
-            if Match (Field, "Flag") then
-               Which_Field := Get (Flags, Which_Field);
-            end if;
-
-            if Match (Fields_Used, Break_WFld) then
-               Put_Line
-                 ("Overlapping field at line " & Lineno'Img &
-                  " for " & Synonym);
-               raise Done;
-            end if;
-
-            Append (Fields_Used, Which_Field);
-            Bad := Bad or Match (Fields_Used, N_Fields);
-         end if;
-      end if;
-
-      if Bad then
-         Put_Line ("fields conflict with standard fields for node " & Node);
-         raise Done;
-      end if;
-   end loop;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check for function consistency");
-
-   --  Loop through field function definitions to make sure they are OK
-
-   Fields1 := Fields;
-   loop
-      Next_Line;
-      exit when Match (Line, "   -- Node Update");
-
-      if Match (Line, Get_Funcsyn)
-        and then not Present (Special, Synonym)
-      then
-         if not Present (Fields1, Synonym) then
-            Put_Line
-              ("function on line " &  Lineno &
-               " is for unused synonym");
-            raise Done;
-         end if;
-
-         Next_Line;
-
-         if not Match (Line, Extr_Field) then
-            raise Err;
-         end if;
-
-         if Field /= Get (Fields1, Synonym) then
-            Put_Line ("Wrong field in function " & Synonym);
-            raise Done;
-
-         else
-            Delete (Fields1, Synonym);
-         end if;
-      end if;
-   end loop;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check for missing functions");
-
-   declare
-      List : constant TV.Table_Array := Convert_To_Array (Fields1);
-
-   begin
-      if List'Length > 0 then
-         Put_Line ("No function for field synonym " & List (1).Name);
-         raise Done;
-      end if;
-   end;
-
-   --  Check field set procedures
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check for set procedure consistency");
-
-   Fields1 := Fields;
-   loop
-      Next_Line;
-      exit when Match (Line, "   -- Inline Pragmas");
-      exit when Match (Line, "   -- Iterator Procedures");
-
-      if Match (Line, Get_Procsyn)
-        and then not Present (Special, Synonym)
-      then
-         if not Present (Fields1, Synonym) then
-            Put_Line
-              ("procedure on line " & Lineno & " is for unused synonym");
-            raise Done;
-         end if;
-
-         Next_Line;
-
-         if not Match (Line, Extr_Field) then
-            raise Err;
-         end if;
-
-         if Field /= Get (Fields1, Synonym) then
-            Put_Line ("Wrong field in procedure Set_" & Synonym);
-            raise Done;
-
-         else
-            Delete (Fields1, Synonym);
-         end if;
-      end if;
-   end loop;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check for missing set procedures");
-
-   declare
-      List : constant TV.Table_Array := Convert_To_Array (Fields1);
-
-   begin
-      if List'Length > 0 then
-         Put_Line ("No procedure for field synonym Set_" & List (1).Name);
-         raise Done;
-      end if;
-   end;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check pragma Inlines are all for existing subprograms");
-
-   Clear (Fields1);
-   while not End_Of_File (Infil) loop
-      Next_Line;
-
-      if Match (Line, Get_Inline)
-        and then not Present (Special, Name)
-      then
-         exit when Match (Name, Set_Name);
-
-         if not Present (Fields, Name) then
-            Put_Line
-              ("Pragma Inline on line " & Lineno &
-               " does not correspond to synonym");
-            raise Done;
-
-         else
-            Set (Inlines, Name, Get (Inlines, Name) & 'r');
-         end if;
-      end if;
-   end loop;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check no pragma Inlines were omitted");
-
-   declare
-      List : constant TV.Table_Array := Convert_To_Array (Fields);
-      Nxt  : VString := Nul;
-
-   begin
-      for M in List'Range loop
-         Nxt := List (M).Name;
-
-         if Get (Inlines, Nxt) /= "r" then
-            Put_Line ("Incorrect pragma Inlines for " & Nxt);
-            raise Done;
-         end if;
-      end loop;
-   end;
-
-   Put_Line ("     OK");
-   New_Line;
-   Clear (Inlines);
-
-   Close (Infil);
-   Open (Infil, In_File, "sinfo.adb");
-   Lineno := 0;
-   Put_Line ("Check references in functions in body");
-
-   Refscopy := Refs;
-   loop
-      Next_Line;
-      exit when Match (Line, "   -- Field Access Functions --");
-   end loop;
-
-   loop
-      Next_Line;
-      exit when Match (Line, "   -- Field Set Procedures --");
-
-      if Match (Line, Func_Rest)
-        and then not Present (Special, Synonym)
-      then
-         Ref := Get (Refs, Synonym);
-         Delete (Refs, Synonym);
-
-         if Ref = "" then
-            Put_Line
-              ("Function on line " & Lineno & " is for unknown synonym");
-            raise Err;
-         end if;
-
-         --  Alpha sort of references for this entry
-
-         declare
-            Refa   : VStringA (1 .. 100);
-            N      : Natural := 0;
-
-         begin
-            loop
-               exit when not Match (Ref, Get_Nxtref, Nul);
-               N := N + 1;
-               Refa (N) := Nxtref;
-            end loop;
-
-            Sort (Refa (1 .. N));
-            Next_Line;
-            Next_Line;
-            Next_Line;
-
-            --  Checking references for one entry
-
-            for M in 1 .. N loop
-               Next_Line;
-
-               if not Match (Line, Test_Syn) then
-                  Put_Line ("Expecting N_" & Refa (M) & " at line " & Lineno);
-                  raise Done;
-               end if;
-
-               Match (Next, Chop_Comma);
-
-               if Next /= Refa (M) then
-                  Put_Line ("Expecting N_" & Refa (M) & " at line " & Lineno);
-                  raise Done;
-               end if;
-            end loop;
-
-            Next_Line;
-            Match (Line, Return_Fld);
-
-            if Field /= Get (Fields, Synonym) then
-               Put_Line
-                ("Wrong field for function " & Synonym & " at line " &
-                 Lineno & " should be " & Get (Fields, Synonym));
-               raise Done;
-            end if;
-         end;
-      end if;
-   end loop;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check for missing functions in body");
-
-   declare
-      List : constant TV.Table_Array := Convert_To_Array (Refs);
-
-   begin
-      if List'Length /= 0 then
-         Put_Line ("Missing function " & List (1).Name & " in body");
-         raise Done;
-      end if;
-   end;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check Set procedures in body");
-   Refs := Refscopy;
-
-   loop
-      Next_Line;
-      exit when Match (Line, "end");
-      exit when Match (Line, "   -- Iterator Procedures");
-
-      if Match (Line, Set_Syn)
-        and then not Present (Special, Synonym)
-      then
-         Ref := Get (Refs, Synonym);
-         Delete (Refs, Synonym);
-
-         if Ref = "" then
-            Put_Line
-              ("Function on line " & Lineno & " is for unknown synonym");
-            raise Err;
-         end if;
-
-         --  Alpha sort of references for this entry
-
-         declare
-            Refa   : VStringA (1 .. 100);
-            N      : Natural;
-
-         begin
-            N := 0;
-
-            loop
-               exit when not Match (Ref, Get_Nxtref, Nul);
-               N := N + 1;
-               Refa (N) := Nxtref;
-            end loop;
-
-            Sort (Refa (1 .. N));
-
-            Next_Line;
-            Next_Line;
-            Next_Line;
-
-            --  Checking references for one entry
-
-            for M in 1 .. N loop
-               Next_Line;
-
-               if not Match (Line, Test_Syn)
-                 or else Next /= Refa (M)
-               then
-                  Put_Line ("Expecting N_" & Refa (M) & " at line " & Lineno);
-                  raise Err;
-               end if;
-            end loop;
-
-            loop
-               Next_Line;
-               exit when Match (Line, Set_Fld);
-            end loop;
-
-            Match (Field, Break_With);
-
-            if Field /= Get (Fields, Synonym) then
-               Put_Line
-                 ("Wrong field for procedure Set_" & Synonym &
-                  " at line " & Lineno & " should be " &
-                  Get (Fields, Synonym));
-               raise Done;
-            end if;
-
-            Delete (Fields1, Synonym);
-         end;
-      end if;
-   end loop;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("Check for missing set procedures in body");
-
-   declare
-      List : constant TV.Table_Array := Convert_To_Array (Fields1);
-   begin
-      if List'Length /= 0 then
-         Put_Line ("Missing procedure Set_" & List (1).Name & " in body");
-         raise Done;
-      end if;
-   end;
-
-   Put_Line ("     OK");
-   New_Line;
-   Put_Line ("All tests completed successfully, no errors detected");
-
-end CSinfo;