separate (Find_Unit.Build_Ada_Compilation_Unit)
procedure Named_Block (Current_Unit : in out
                          Compilation_Unit.Ada_Compilation_Unit) is
    --==============================================================
    -- This procedure builds the next part of the grammar for an   =
    -- Ada compilation unit. Based on the next token, we will      =
    -- complete different productions. At present, we are          =
    -- parsing a named block statement. We must find an identifer  =
    -- followed by a colon or there is an error. We will then      =
    -- invoke another subprogram "Unnamed_Block" to finnish parsing=
    -- the rest of the named block.                                =
    -- Grammar :                                                   =
    --           <Named_Block> =                                   =
    --                <id> ':' <Unnamed_Block>                     =
    --                                                             =
    -- written  by  GER  with  help  from  b2  and  JM             =
    -- May 1985  EVB Software Engineering Inc.                     =
    --==============================================================

    Current_Token : Token_Package.Token;
    -- Holds the current token

begin
    -- Named_Block

    -- Parse an identifer

    Get_Next_Significant_Token (Significant_Token => Current_Token,
                                Current_Unit => Current_Unit);

    if Token_Package.Class_Of (Current_Token) = Token_Package.Identifier then
        Compilation_Unit.Add_Token_To_Compilation_Unit
           (Token_To_Add => Current_Token, Unit_To_Add_To => Current_Unit);
    else
        -- Not a named block raise error
        raise Build_Syntax_Error;
    end if;

    -- parse a colon

    Get_Next_Significant_Token (Significant_Token => Current_Token,
                                Current_Unit => Current_Unit);

    if Token_Package.Value_Of (Current_Token) = Token_Package.Colon_Token then
        Compilation_Unit.Add_Token_To_Compilation_Unit
           (Token_To_Add => Current_Token, Unit_To_Add_To => Current_Unit);
    else
        -- Not a named block raise error
        raise Build_Syntax_Error;
    end if;

    -- Invoke a subprogram to parse the rest of the named block

    Unnamed_Block (Current_Unit => Current_Unit);

end Named_Block;