Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/tools/cas.ada

Text File | 1988-05-03 | 8.3 KB | 227 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    :
-- function COUNT_OF_ADA_STATEMENTS (FILE_NAME  : STRING) return INTEGER;
-- Version      : 1.0
-- Author       : W. A. Whitaker, WIS JPMO
-- DDN Address  : WWHITAKER@ECLB
-- Date created :  3 MAR 84
-- Release date : 15 JAN 85
-- Last update  :  3 MAR 84
--
---------------------------------------------------------------
--
-- Keywords     :  Source analysis, Quantity, Statements
--
----------------:
--
-- Abstract     :
--  This function calculates the "STATEMENTS" of a valid Ada fragment
--  specified by a FILE_NAME string parameter.
--  It need not be a complete compilation unit
--  but it should have closed all open parentheses and string brackets.
--  The number of STATEMENTS of code is returned as an INTEGER.

--  The Ada statement is defined by a semicolon terminator
--  outside of comments, parentheses, or string or character literals.
--  This definition is insensitive to formatting or layout of the source.

--  There are exotic cases for which this will misestimate the count
--  but we have never encountered one in real code.

--  This copy of the function is embedded in a test and driver program.
--  Running the program on its own source file should give
--  The driver has an additional feature of correcting for the common
--  error of leaving out the extension on a file name.
--  The nature of this extension is system dependent and a ".TXT" is used.

--
------------------ Revision history ---------------------------
--
-- DATE         VERSION         AUTHOR          HISTORY
-- 19850115     1.0             W Whitaker      Initial Release
--
------------------ Distribution and Copyright -----------------
--
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------

with TEXT_IO;  use TEXT_IO;
procedure CAS is
--  function COUNT_OF_ADA_STATEMENTS (FILE_NAME  : STRING) return INTEGER
--  calculates the "STATEMENTS" in an Ada fragment specified by FILE_NAME.

--  This copy of the function is embedded in a test and driver program.
--  Running the CAS program on its own source file should give
--
--COUNT_OF_ADA_STATEMENTS:
--Input file name terminated by <RETURN>  => CAS.TXT
--        59 ADA STATEMENTS IN FILE CAS.TXT
--
--  The driver has an additional feature of correcting for the common
--  error of leaving out the extension on a file name.
--  The nature of this extension is system dependent and a ".TXT" is used.

------------------ Revision history ---------------------------
--
-- DATE         VERSION         AUTHOR          HISTORY
-- 19850115     1.0             W Whitaker      Initial Release
--
  package INT_IO is new INTEGER_IO(INTEGER);
  use INT_IO;

  FILE_NAME  : STRING (1..80);
  FILE_NAME_LENGTH : NATURAL;
  FIRST_TIME : BOOLEAN := TRUE;

  function COUNT_OF_ADA_STATEMENTS (FILE_NAME  : STRING) return INTEGER is
  --  This function calculates the "STATEMENTS" of a valid Ada fragment
  --  specified by a FILE_NAME string parameter
  --  It need not be a complete compilation unit
  --  but it should have closed all open parentheses and string brackets
  --  The number of STATEMENTS of code is returned as an INTEGER

  --  The Ada statement is defined by a semicolon terminator
  --  outside of comments, parentheses, or string or character literals
  --  This definition is insensitive to formatting or layout of the source

  --  There are exotic cases for which this will misestimate the count
  --  but we have never encountered one in real code

    INPUT        : FILE_TYPE;
    C            : CHARACTER := ' ';
    STATEMENTS   : INTEGER := 0;
    LEVEL        : INTEGER := 0;

  begin

    OPEN (INPUT, IN_FILE, FILE_NAME);

    loop
      GET (INPUT, C);

      --  Check for comment on the line
      if C = '-' then
        GET (INPUT, C);
        --  Which is signaled by the '-' following a '-'
        if C = '-' then
          --  Then just skip the rest of the line and go to the next
          SKIP_LINE (INPUT);
        end if;
      end if;

      --  Check for one of the characters which introduce code constructs
      --  like string or character literal or formal parameter list
      --  within which a ';' does not terminate a "line of code"
      if C = '(' or C = '"' or C = '%' or C = ''' then

        --  Check for opening parentheses
        --  Every ';' within is in a formal parameter list
        if C = '(' then
          --  Count the number of levels of parentheses
          LEVEL := LEVEL + 1;
          --  Read ahead until the whole construct is closed, LEVEL = 0
          while LEVEL > 0 loop
            GET (INPUT, C);
            if C = '(' then
              --  Increase the level if another '(' is found
              LEVEL := LEVEL + 1;
            elsif C = ')' then
              --  Decrease the level if a ')' is found
              LEVEL := LEVEL - 1;
            end if;
          end loop;

        --  Now check for string brackets of either kind, " or %
        elsif C = '"' or C = '%' then
          --  Treat them in parallel, one must lead off
          if C = '"' then
            loop
              GET (INPUT, C);
              --  Loop until the close comes
              --  If there is a doubled character it just starts again
              exit when C = '"';
            end loop;
          --  The '%' is handled exactly the same way as '"'
          elsif C = '%' then
            loop
              GET (INPUT, C);
              exit when C = '%';
            end loop;
          end if;

        --  Character literals are just three characters long including '
        elsif C = ''' then
          GET (INPUT, C);
          GET (INPUT, C);
        end if;

      --  Any ';' that can be found at this point after all exclusions
      --  must be a valid "line of code" terminator
      elsif C = ';' then
        STATEMENTS := STATEMENTS + 1;

      end if;

    end loop;

  exception
    --  Return through exception since the end of file may be encountered
    --  at several levels in the function and in any case it stops and returns
    --  Otherwise one would use END_OF_FILE but here it would have to appear
    --  in a number of places to no advantage
    --  and would cause multiple exits or returns
    --  This is much cleaner
    when END_ERROR =>
      return STATEMENTS;
    when NAME_ERROR =>
      NEW_LINE;
      PUT("NAME_ERROR in COUNT_OF_ADA_STATEMENTS "); NEW_LINE;
      raise NAME_ERROR;
  end COUNT_OF_ADA_STATEMENTS;


begin
  NEW_LINE;
  PUT_LINE("COUNT_OF_ADA_STATEMENTS:");
  PUT("Input file name terminated by <RETURN>  => ");
  GET_LINE(FILE_NAME, FILE_NAME_LENGTH);
  PUT (COUNT_OF_ADA_STATEMENTS (FILE_NAME(1..FILE_NAME_LENGTH)));
  PUT (" ADA STATEMENTS IN FILE ");
  PUT (FILE_NAME(1..FILE_NAME_LENGTH));
  NEW_LINE;

exception
  when NAME_ERROR =>
    --  *********************************************  SYSTEM NAME DEPENDENT
    --  This handles the case when you have left off the file name extension
    --  (if that is appropriate for you file system)
    --  It is dependent on the naming convention and is set up for ".TXT"
    if FIRST_TIME
      and (FILE_NAME'LAST <= 4
           or else FILE_NAME(FILE_NAME'LAST-3..FILE_NAME'LAST) /= ".TXT")  then
      FIRST_TIME := FALSE;
      PUT("Maybe you forgot the .TXT?"); NEW_LINE;  --  System dependent
      PUT (COUNT_OF_ADA_STATEMENTS (FILE_NAME(1..FILE_NAME_LENGTH) & ".TXT"));
      PUT (" ADA STATEMENTS IN FILE ");
      PUT (FILE_NAME(1..FILE_NAME_LENGTH) & ".TXT");
      NEW_LINE;
    end if;
  --  **********************************************************************
end CAS;