Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/cas3.ada

Text File | 1988-05-03 | 8.1 KB | 226 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : COUNT_OF_ADA_STATEMENTS_3
-- Version      : 1.2
-- Author       : Richard Conn
--              : TI Ada Technology Branch
--              : Box 801, MS 8007
--              : McKinney, TX  75069
-- DDN Address  : RCONN at SIMTEL20
-- Derivation   : COUNT_OF_ADA_STATEMENTS_2 by Richard Conn
-- Derivation   : COUNT_OF_ADA_STATEMENTS by Bill Whitaker
-- Date created : 4 Apr 85
-- Release date : 4 Apr 85
-- Last update  : 24 June 85
--
---------------------------------------------------------------
--
-- Keywords     :  Source analysis, Quantity, Statements
--
----------------:
--
-- Abstract     :
--  This procedure 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 parens and
--  strings.
--
--  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 procedure is derived from Bill Whitaker's original
--  COUNT_OF_ADA_STATEMENTS, and it does not change his original algorithm.
--  It adds a line count and a character-checksum hash (sum of POS values of
--  all non-space characters in the file mod 256).  It also adds a count
--  of the comment lines (over CAS2, which does not).
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION         AUTHOR          HISTORY
-- 19850215     1.0             R Conn          Initial Release
-- 19850506     1.1             R Conn          Overflow Traps Added
-- 19850624     1.2             R Conn          Bug in Single-Quote Proc Fixed
--
------------------ 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,
     CHARACTER_SET;
procedure COUNT_OF_ADA_STATEMENTS (FILE_NAME  : STRING;
                                   STATEMENTS : in out NATURAL;
                                   LINE_COUNT : in out NATURAL;
                                   COMMENTS   : in out NATURAL;
                                   HASH       : in out NATURAL) is
--
--  Returned values:
--     STATEMENTS    Number of Ada code statements
--     LINE_COUNT    Number of lines of text
--     COMMENTS      Number of comments in the file
--     HASH          Checksum (Mod 256 sum) of all non-space
--                    (a space character as defined by character_set)
--                    characters
--
    INPUT        : TEXT_IO.FILE_TYPE;
    CURRENT_LINE : STRING (1 .. 256); --  arbitrarily large
    NEXT_CHAR    : NATURAL := 1;
    LAST_CHAR    : NATURAL := 0;
    C            : CHARACTER;
    LEVEL        : INTEGER := 0;
    CH_PENDING   : BOOLEAN := FALSE;
    PENDING_CH   : CHARACTER;

    procedure UNGET (CH : CHARACTER) is
    begin
        CH_PENDING := TRUE;
        PENDING_CH := CH;
    end UNGET;

    procedure GET (CH : in out CHARACTER) is
    begin
        if CH_PENDING then
            CH_PENDING := FALSE;
            CH := PENDING_CH;
        else
            if NEXT_CHAR > LAST_CHAR then
                loop
                    TEXT_IO.GET_LINE (INPUT, CURRENT_LINE, LAST_CHAR);
                    begin
                        LINE_COUNT := LINE_COUNT + 1;
                    exception
                        when others =>  null; -- trap overflow
                    end;
                    NEXT_CHAR := 1;
                    exit when NEXT_CHAR <= LAST_CHAR;
                end loop;
            end if;
            CH := CURRENT_LINE (NEXT_CHAR);
            if not CHARACTER_SET.IS_SPACE (CH) then
                HASH := (HASH + CHARACTER'POS (CH)) mod 256;
            end if;
            NEXT_CHAR := NEXT_CHAR + 1;
        end if;
    end GET;

begin

    TEXT_IO.OPEN (INPUT, TEXT_IO.IN_FILE, FILE_NAME);
    STATEMENTS := 0;
    LINE_COUNT := 0;
    COMMENTS := 0;
    HASH := 0;

    loop
        GET (C);

        --  Check for comment on the line
        if C = '-' then
            GET (C);
            --  Which is signaled by the '-' following a '-'
            if C = '-' then
                --  Then just skip the rest of the line and go to the next
                NEXT_CHAR := LAST_CHAR + 1;
                begin
                    COMMENTS := COMMENTS + 1;
                exception
                    when others =>  null; -- trap overflow
                end;
            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 (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 (C);
                        --  Loop until the close comes
                        --  If there is a doubled character it starts again
                        exit when C = '"';
                    end loop;
                    --  The '%' is handled exactly the same way as '"'
                elsif C = '%' then
                    loop
                        GET (C);
                        exit when C = '%';
                    end loop;
                end if;

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

            --  Any ';' that can be found at this point after all
            --  exclusions must be a valid "line of code" terminator
        elsif C = ';' then
            begin
                STATEMENTS := STATEMENTS + 1;
            exception
                when others =>  null; -- trap overflow
            end;

        end if;

    end loop;

exception
    when TEXT_IO.END_ERROR =>
        TEXT_IO.CLOSE (INPUT); --  close input file
    when TEXT_IO.NAME_ERROR =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT ("Error in File Name ");
        TEXT_IO.PUT (FILE_NAME);
        TEXT_IO.NEW_LINE;
        raise TEXT_IO.NAME_ERROR;
    when others =>
        raise;
end COUNT_OF_ADA_STATEMENTS;