diff options
Diffstat (limited to 'gcc/ada/ceinfo.adb')
| -rw-r--r-- | gcc/ada/ceinfo.adb | 226 |
1 files changed, 0 insertions, 226 deletions
diff --git a/gcc/ada/ceinfo.adb b/gcc/ada/ceinfo.adb deleted file mode 100644 index 8ce6b69..0000000 --- a/gcc/ada/ceinfo.adb +++ /dev/null @@ -1,226 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- C E I N F O -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2020, 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 einfo.ads and einfo.adb. Checks that field name usage --- is consistent, including comments mentioning fields. - --- Note that this is used both as a standalone program, and as a procedure --- called by XEinfo. 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.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; -with GNAT.Spitbol.Table_VString; - -procedure CEinfo is - - package TV renames GNAT.Spitbol.Table_VString; - use TV; - - Infil : File_Type; - Lineno : Natural := 0; - - Err : exception; - -- Raised on error - - Fieldnm : VString; - Accessfunc : VString; - Line : VString; - - Fields : GNAT.Spitbol.Table_VString.Table (500); - -- Maps field names to underlying field access name - - UC : constant Pattern := Any ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); - - Fnam : constant Pattern := (UC & Break (' ')) * Fieldnm; - - Field_Def : constant Pattern := - "-- " & Fnam & " (" & Break (')') * Accessfunc; - - Field_Ref : constant Pattern := - " -- " & Fnam & Break ('(') & Len (1) & - Break (')') * Accessfunc; - - Field_Com : constant Pattern := " -- " & Fnam & Span (' ') & - (Break (' ') or Rest) * Accessfunc; - - Func_Hedr : constant Pattern := " function " & Fnam; - - Func_Retn : constant Pattern := " return " & Break (' ') * Accessfunc; - - Proc_Hedr : constant Pattern := " procedure " & Fnam; - - Proc_Setf : constant Pattern := " Set_" & Break (' ') * Accessfunc; - - procedure Next_Line; - -- Read next line trimmed from Infil into Line and bump Lineno - - procedure Next_Line is - begin - Line := Get_Line (Infil); - Trim (Line); - Lineno := Lineno + 1; - end Next_Line; - --- Start of processing for CEinfo - -begin - Anchored_Mode := True; - New_Line; - Open (Infil, In_File, "einfo.ads"); - - Put_Line ("Acquiring field names from spec"); - - loop - Next_Line; - - -- Old format of einfo.ads - - exit when Match (Line, " -- Access Kinds --"); - - -- New format of einfo.ads - - exit when Match (Line, "-- Access Kinds --"); - - if Match (Line, Field_Def) then - Set (Fields, Fieldnm, Accessfunc); - end if; - end loop; - - Put_Line ("Checking consistent references in spec"); - - loop - Next_Line; - exit when Match (Line, " -- Description of Defined"); - end loop; - - loop - Next_Line; - exit when Match (Line, " -- Component_Alignment Control"); - - if Match (Line, Field_Ref) then - if Accessfunc /= "synth" - and then - Accessfunc /= "special" - and then - Accessfunc /= Get (Fields, Fieldnm) - then - if Present (Fields, Fieldnm) then - Put_Line ("*** field name incorrect at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - - else - Put_Line - ("*** unknown field name " & Fieldnm & " at line " & Lineno); - end if; - - raise Err; - end if; - end if; - end loop; - - Close (Infil); - Open (Infil, In_File, "einfo.adb"); - Lineno := 0; - - Put_Line ("Check listing of fields in body"); - - loop - Next_Line; - exit when Match (Line, " -- Attribute Access Functions --"); - - if Match (Line, Field_Com) - and then Fieldnm /= "(unused)" - and then Accessfunc /= Get (Fields, Fieldnm) - then - if Present (Fields, Fieldnm) then - Put_Line ("*** field name incorrect at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - - else - Put_Line - ("*** unknown field name " & Fieldnm & " at line " & Lineno); - end if; - - raise Err; - end if; - end loop; - - Put_Line ("Check references in access routines in body"); - - loop - Next_Line; - exit when Match (Line, " -- Classification Functions --"); - - if Match (Line, Func_Hedr) then - null; - - elsif Match (Line, Func_Retn) - and then Accessfunc /= Get (Fields, Fieldnm) - and then Fieldnm /= "Mechanism" - then - Put_Line ("*** incorrect field at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - raise Err; - end if; - end loop; - - Put_Line ("Check references in set routines in body"); - - loop - Next_Line; - exit when Match (Line, " -- Attribute Set Procedures"); - end loop; - - loop - Next_Line; - exit when Match (Line, " ------------"); - - if Match (Line, Proc_Hedr) then - null; - - elsif Match (Line, Proc_Setf) - and then Accessfunc /= Get (Fields, Fieldnm) - and then Fieldnm /= "Mechanism" - then - Put_Line ("*** incorrect field at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - raise Err; - end if; - end loop; - - Close (Infil); - - Put_Line ("All tests completed successfully, no errors detected"); - -end CEinfo; |