home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / vrac / adaada.zip / ADAADA.ZIP / SRC / ADA_ERR / ADA_ERR_.ADA < prev    next >
Text File  |  1994-10-12  |  13KB  |  399 lines
  1. -- Copyright (c) 1994 ARINC Research Corporation
  2. -- From material copyright (c) 1991, 1992 Premia Corporation
  3. --
  4. -- This material may be reproduced by or for the US Government pursuant 
  5. -- to the copyright license under DFAR Clause 252.227-7013 (1988)
  6. --
  7. -- Developed for US Air Force under contract no. F41608-90-D-0544-0005
  8. --
  9. -- MODIFICATIONS
  10. --   94/06 - J. Neuse, SD/OSE/EA  - Initial code
  11. --   94/10 - O. Sluder, SD/OSE/EA - Cleanup
  12.  
  13. with CW_BFEX;
  14. with CW_CURS;
  15. with CW_EDSY;
  16. with CW_PARS;
  17. with CW_SRCH;
  18. with CW_TYPES;
  19. with SYSTEM;
  20.  
  21. -- *******************
  22. -- *                 *
  23. -- *  Error_Parsers  *  BODY
  24. -- *                 *
  25. -- *******************
  26.  
  27. package body Error_Parsers is
  28.  
  29.   -- The following pragmas are required by the Meridian OpenAda for
  30.   -- Windows 2.0 compiler in the package spec and body of code to be
  31.   -- included in a DLL, or an application calling the DLL will 
  32.   -- general protection fault
  33.   pragma SUPPRESS (elaboration_check);
  34.   pragma SUPPRESS (storage_check);
  35.  
  36.   PARSER_COUNT   : constant := 2;
  37.     
  38.   Parser_Names   : array (1 .. Parser_Count) of CW_TYPES.LPSTR;
  39.   Janus_Filename : STRING (1 .. 40);
  40.  
  41.   -- ..........
  42.   -- .        .
  43.   -- .  Init  .  BODY
  44.   -- .        .
  45.   -- ..........
  46.  
  47.   procedure Init is
  48.  
  49.   begin
  50.  
  51.     for i in Janus_Filename'FIRST .. Janus_Filename'LAST loop
  52.       Janus_Filename (i) := ' ';
  53.     end loop;
  54.  
  55.     Parser_Names := ((new STRING'("Meridian")), (new STRING'("Janus")));
  56.  
  57.     for i in 1 .. PARSER_COUNT loop
  58.       CW_EDSY.LibExport ("int _" & Parser_Names (i).all & "ErrorInfo");
  59.       CW_PARS.AddErrorInfoName ("_" & Parser_Names (i).all & "ErrorInfo");
  60.     end loop;
  61.  
  62.   end Init;
  63.  
  64.   -- .............
  65.   -- .           .
  66.   -- .  LibMain  .  BODY
  67.   -- .           .
  68.   -- .............
  69.  
  70.   function LibMain (hModule     : in WINTYPES.HANDLE;
  71.                     wDataSeg    : in WINTYPES.WORD;
  72.                     cbHeapSize  : in WINTYPES.WORD;
  73.                     lpszCmdLine : in WINTYPES.LPSTR) return INTEGER is
  74.  
  75.     -- .........................
  76.     -- .                       .
  77.     -- .  Setup_Init_Callback  .  SPEC
  78.     -- .                       .
  79.     -- .........................
  80.  
  81.     procedure Setup_Init_Callback (pfnInit_Callback : in SYSTEM.ADDRESS);
  82.  
  83.     pragma INTERFACE (microsoft_c, Setup_Init_Callback);
  84.  
  85.     -- ......................................
  86.     -- .                                         .
  87.     -- .  Setup_MeridianErrorInfo_Callback  .  SPEC
  88.     -- .                                    .
  89.     -- ......................................
  90.  
  91.     procedure Setup_MeridianErrorInfo_Callback
  92.        (pfnMeridianErrorInfo_Callback : in SYSTEM.ADDRESS);
  93.  
  94.     pragma INTERFACE (microsoft_c, Setup_MeridianErrorInfo_Callback);
  95.  
  96.     -- ...................................
  97.     -- .                                      .
  98.     -- .  Setup_JanusErrorInfo_Callback  .  SPEC
  99.     -- .                                 .
  100.     -- ...................................
  101.  
  102.     procedure Setup_JanusErrorInfo_Callback
  103.        (pfnJanusErrorInfo_Callback : in SYSTEM.ADDRESS);
  104.  
  105.     pragma INTERFACE (microsoft_c, Setup_JanusErrorInfo_Callback);
  106.  
  107.   begin
  108.     Setup_Init_Callback (Init'ADDRESS);
  109.     Setup_MeridianErrorInfo_Callback (Error_Parsers.MeridianErrorInfo'ADDRESS);
  110.     Setup_JanusErrorInfo_Callback (Error_Parsers.JanusErrorInfo'ADDRESS);
  111.     return 1;
  112.   end LibMain;
  113.  
  114.   -- .........
  115.   -- .       .
  116.   -- .  WEP  .  BODY
  117.   -- .       .
  118.   -- .........
  119.  
  120.   function WEP (bSystemExit : in INTEGER) return INTEGER is
  121.  
  122.   begin
  123.     return 1;
  124.   end WEP;
  125.  
  126.   -- ..............
  127.   -- .                    .
  128.   -- .  FindChar  .  BODY
  129.   -- .                 .
  130.   -- ..............
  131.  
  132.   function FindChar (Start : in INTEGER;
  133.                      Char  : in CHARACTER;
  134.                      Str   : in STRING) return INTEGER is
  135.  
  136.     i : integer := Start;
  137.  
  138.   begin --  function FindChar
  139.  
  140.     while Str (i) /= Char loop
  141.       i := i + 1;
  142.     end loop;
  143.  
  144.     return i;
  145.  
  146.   end FindChar;
  147.  
  148.   -- .......................
  149.   -- .                                .
  150.   -- .  MeridianErrorInfo  .  BODY
  151.   -- .                             .
  152.   -- .......................
  153.   --
  154.   -- NOTES:
  155.   -- 1.    Meridian error lines take the following format:
  156.   --       filename(nn)error message
  157.   -- 2. Meridian warning lines take the following format:
  158.   --       filename(nn)warning warning message
  159.   -- 3. Meridian compiler errors take the following format:
  160.   --       *** Compiler Error
  161.  
  162.   function MeridianErrorInfo return INTEGER is
  163.  
  164.     Error_Str   : CW_TYPES.LPSTR;
  165.     Str_Found   : BOOLEAN;
  166.     MatchLength : LONG_INTEGER   := 0;
  167.     Flags       : CW_TYPES.DWORD := 0;
  168.     MsgStr      : STRING (1 .. 256);
  169.     j           : INTEGER := 0;
  170.     i           : INTEGER := 0;
  171.     Err_File    : SYSTEM.ADDRESS;
  172.     Err_Line    : LONG_INTEGER;
  173.     Err_Col     : LONG_INTEGER;
  174.     Err_Msg     : SYSTEM.ADDRESS;
  175.     Mov_Bool    : BOOLEAN;
  176.  
  177.   begin --  function MeridianErrorInfo
  178.  
  179.     --  Set up the search control flags.
  180.     Flags := CW_TYPES."+" (CW_TYPES.SEARCH_FORWARD, CW_TYPES.SEARCH_IGCASE);
  181.  
  182.     Str_Found := CW_SRCH.SrchFind ("No errors detected.", Flags,
  183.                                    MatchLength'ADDRESS);
  184.  
  185.     if Str_Found then
  186.       return INTEGER (0);
  187.     end if;
  188.  
  189.     Str_Found := CW_SRCH.SrchFind ("*** Compiler Error", Flags,
  190.                                    MatchLength'ADDRESS);
  191.     if Str_Found then
  192.       Mov_Bool := CW_CURS.MovHome;
  193.       CW_BFEX.BufReadStr (MsgStr);
  194.       Mov_Bool := CW_CURS.MovEOL;
  195.       j        := FindChar (1, ASCII.CR, MsgStr) - 1;
  196.       Err_File := CW_PARS.ErrorSrcFile ("");
  197.       Err_Line := CW_PARS.ErrorLine (LONG_INTEGER (0));
  198.       Err_Col  := CW_PARS.ErrorColumn (LONG_INTEGER (0));
  199.       Err_Msg  := CW_PARS.ErrorMsgLine (MsgStr (1 .. j));
  200.       return INTEGER (2);
  201.     end if;
  202.  
  203.     Flags := CW_TYPES."+" (CW_TYPES.SEARCH_FORWARD, CW_TYPES.SEARCH_REGEX);
  204.     Flags := CW_TYPES."+" (Flags, CW_TYPES.SEARCH_IGCASE);
  205.  
  206.     Error_Str := new STRING'("\([0-9]+\)");
  207.  
  208.     Str_Found := CW_SRCH.SrchFind (error_str.all, Flags, MatchLength'ADDRESS);
  209.  
  210.     if Str_Found then
  211.       Mov_Bool := CW_CURS.MovHome;
  212.       CW_BFEX.BufReadStr (MsgStr);
  213.       Mov_Bool := CW_CURS.MovEOL;
  214.       --  Locate the slice containing the filename.
  215.       j := 1;
  216.       j := FindChar (j, '(', MsgStr) - 1;
  217.       --  Pass the name of the file containing the error back to CW.
  218.       Err_File := CW_PARS.ErrorSrcFile (MsgStr (1 .. j));
  219.       --  Locate the slice containing the error line number.
  220.       i := j + 2;
  221.       j := FindChar (i, ')', MsgStr) - 1;
  222.       --  Pass the line containing the error back to CW.
  223.       Err_Line := CW_PARS.ErrorLine (LONG_INTEGER'VALUE (MsgStr (i .. j)));
  224.       --  Pass the column of the error back to CW.
  225.       Err_Col := CW_PARS.ErrorColumn (LONG_INTEGER (0));
  226.       --  Locate the slice containing the error message.
  227.       i       := j + 2;
  228.       j       := FindChar (i, ASCII.CR, MsgStr) - 1;
  229.       Err_Msg := CW_PARS.ErrorMsgLine (MsgStr (i .. j));
  230.  
  231.       if MsgStr (i .. (i + 6)) = "warning" then
  232.         return INTEGER (1);
  233.       else
  234.         return INTEGER (2);
  235.       end if;
  236.  
  237.     end if;
  238.  
  239.     return INTEGER (0);
  240.  
  241.   end MeridianErrorInfo;
  242.  
  243.   -- ....................
  244.   -- .                          .
  245.   -- .  JanusErrorInfo  .  BODY
  246.   -- .                       .
  247.   -- ....................
  248.   --
  249.   -- NOTES:
  250.   -- This parser parses the BRIEF and VERBOSE output of the Janus compiler.
  251.  
  252.   function JanusErrorInfo return INTEGER is
  253.  
  254.     Error_Str   : CW_TYPES.LPSTR;
  255.     Str_Found   : BOOLEAN;
  256.     MatchLength : LONG_INTEGER   := 0;
  257.     Flags       : CW_TYPES.DWORD := 0;
  258.     MsgStr      : STRING (1 .. 256);
  259.     j           : INTEGER := 0;
  260.     i           : INTEGER := 0;
  261.     Err_File    : SYSTEM.ADDRESS;
  262.     Err_Line    : LONG_INTEGER;
  263.     Err_Col     : LONG_INTEGER;
  264.     Err_Msg     : SYSTEM.ADDRESS;
  265.     Mov_Bool    : BOOLEAN;
  266.     Fatal_Error : BOOLEAN := FALSE;
  267.  
  268.   begin --  function JanusErrorInfo
  269.  
  270.     --  Set up the search control flags.
  271.     Flags := CW_TYPES."+" (CW_TYPES.SEARCH_FORWARD, CW_TYPES.SEARCH_IGCASE);
  272.  
  273.     Str_Found := CW_SRCH.SrchFind ("Input File Is", Flags, MatchLength'ADDRESS);
  274.  
  275.     if Str_Found then
  276.  
  277.       Mov_Bool := CW_CURS.MovHome;
  278.       CW_BFEX.BufReadStr (MsgStr);
  279.       Mov_Bool := CW_CURS.MovEOL;
  280.       --  Locate the slice containing the filename.
  281.       i := 1;
  282.       i := FindChar (i, 's', MsgStr) + 2;
  283.       j := FindChar (i, ASCII.CR, MsgStr) - 1;
  284.       Janus_Filename (1 .. (j - i + 1)) := MsgStr (i .. j);
  285.       Janus_Filename (j - 1 + 2)        := ASCII.CR;
  286.     end if;
  287.  
  288.     Flags := CW_TYPES."+" (CW_TYPES.SEARCH_FORWARD, CW_TYPES.SEARCH_REGEX);
  289.     Flags := CW_TYPES."+" (Flags, CW_TYPES.SEARCH_IGCASE);
  290.  
  291.     Error_Str := new STRING'("((\*WARNING\*|\*SYNTAX ERROR\*)|" &
  292.                        "(\*ERROR\*|\*FATAL ERROR\*))");
  293.  
  294.     Str_Found := CW_SRCH.SrchFind (error_str.all, Flags, MatchLength'ADDRESS);
  295.  
  296.     if Str_Found then
  297.  
  298.       --  Locate the filename in Janus_Filename.
  299.       j := FindChar (1, ASCII.CR, Janus_Filename) - 1;
  300.       --  Pass the name of the file containing the error back to CW.
  301.       Err_File := CW_PARS.ErrorSrcFile (Janus_Filename (1 .. j));
  302.  
  303.       Mov_Bool := CW_CURS.MovUp (LONG_INTEGER (1));
  304.       Mov_Bool := CW_CURS.MovHome;
  305.       CW_BFEX.BufReadStr (MsgStr);
  306.  
  307.  
  308.       if (MsgStr (1) /= '-') then
  309.  
  310.         --  Process *FATAL ERROR* message.
  311.         --  Set Error Column
  312.         Err_Col := CW_PARS.ErrorColumn (LONG_INTEGER (1));
  313.         --  Position cursor to retrieve line number.
  314.         Mov_Bool := CW_CURS.MovDown (LONG_INTEGER (1));
  315.         Mov_Bool := CW_CURS.MovHome;
  316.         CW_BFEX.BufReadStr (MsgStr);
  317.         --  Extract line number from error.
  318.         i := 1;
  319.         while MsgStr (i) not in '0' .. '9' loop
  320.           i := i + 1;
  321.         end loop;
  322.         j := FindChar (i, ASCII.CR, MsgStr) - 1;
  323.         --  Pass the line containing the error back to CW.
  324.         Err_Line    := CW_PARS.ErrorLine (LONG_INTEGER'VALUE (MsgStr (i .. j)));
  325.         Mov_Bool    := CW_CURS.MovDown (LONG_INTEGER (1));
  326.         Fatal_Error := TRUE;
  327.  
  328.       elsif MsgStr (7 .. 10) = "Line" then
  329.  
  330.         --  Process Brief output.
  331.         --  Locate the slice containing the error line number.
  332.         i := 14; --  The Line Number starts here for the Brief output,
  333.         --  Pass I.
  334.         --  Locate line number for other passes.
  335.         while MsgStr (i) not in '0' .. '9' loop
  336.           i := i + 1;
  337.         end loop;
  338.         j := FindChar (i, ' ', MsgStr) - 1;
  339.         --  Pass the line containing the error back to CW.
  340.         Err_Line := CW_PARS.ErrorLine (LONG_INTEGER'VALUE (MsgStr (i .. j)));
  341.  
  342.         --  Locate the slice containing the error column.
  343.         i := FindChar (j, '-', MsgStr) + 2;
  344.         j := FindChar (i, ASCII.CR, MsgStr) - 1;
  345.         --  Pass the column of the error back to CW.
  346.         Err_Col := CW_PARS.ErrorColumn (LONG_INTEGER'VALUE (MsgStr (i .. j)));
  347.  
  348.         Mov_Bool := CW_CURS.MovDown (LONG_INTEGER (1));
  349.  
  350.       else
  351.  
  352.         --  Process Verbose compiler output.
  353.         --  Find the caret indicating the position.
  354.         j := FindChar (1, '^', MsgStr) - 8;
  355.         --  Pass the column of the error back to CW.
  356.         Err_Col := CW_PARS.ErrorColumn (LONG_INTEGER (j));
  357.  
  358.         Mov_Bool := CW_CURS.MovUp (LONG_INTEGER (4));
  359.         Mov_Bool := CW_CURS.MovHome;
  360.         CW_BFEX.BufReadStr (MsgStr);
  361.  
  362.         --  Find the line number.
  363.         i := FindChar (1, '.', MsgStr);
  364.         i := FindChar (i, 'e', MsgStr) + 2;
  365.         j := FindChar (i, ASCII.CR, MsgStr) - 1;
  366.         --  Pass the line containing the error back to CW.
  367.         Err_Line := CW_PARS.ErrorLine (LONG_INTEGER'VALUE (MsgStr (i .. j)));
  368.  
  369.         Mov_Bool := CW_CURS.MovDown (LONG_INTEGER (5));
  370.  
  371.       end if;
  372.  
  373.       Mov_Bool := CW_CURS.MovHome;
  374.       CW_BFEX.BufReadStr (MsgStr);
  375.  
  376.       --  Locate the slice containing the error message.
  377.       j := FindChar (1, ASCII.CR, MsgStr) - 1;
  378.       if Fatal_Error then
  379.         Err_Msg := CW_PARS.ErrorMsgLine ("*FATAL ERROR* " & MsgStr (1 .. j));
  380.       else
  381.         Err_Msg := CW_PARS.ErrorMsgLine (MsgStr (1 .. j));
  382.       end if;
  383.  
  384.       Mov_Bool := CW_CURS.MovEOL;
  385.  
  386.       if MsgStr (2 .. 8) = "WARNING" then
  387.         return INTEGER (1);
  388.       else
  389.         return INTEGER (2);
  390.       end if;
  391.  
  392.     end if;
  393.  
  394.     return INTEGER (0);
  395.  
  396.   end JanusErrorInfo;
  397.  
  398. end Error_Parsers;
  399.