//_Header
//*******************************************************************
//    NOVA CONTROL SYSTEM  ---  Lawrence Livermore Laboratory
//
//    Copyright 1985 by The Regents of the University of California
//*******************************************************************
//
//_Module_Name:  TESTSUITE
//
//_Description:
//	Controls the Praxis Language Test Suite
//*******************************************************************
//_Author:  F. Holloway		_Creation_Date:  04-MAY-1985
//_Revisions:
//  1.000  04-MAY-1985  FWH	Initial Key-in.
//*******************************************************************
//_End

main module TESTSUITE
    use	TEXTIO
    use	TOPTEXTIO
    use	FINDSTRING





    out_line	(TTY, 	"	Welcome to the Praxis Test Suite")
    out_line	(TTY,	"--------------------------------------------")
    out_line	(TTY,	"The Test Suite consists of hundreds of small")
    out_line	(TTY,	"programs with a multilevel index.  Users may") 
    out_line	(TTY,	"migrate down to any level and the programs ")
    out_line	(TTY,	"within that level and all lower levels")
    out_line	(TTY,	"--------------------------------------------")

    declare
	Index_File_Name		= "XAM:INDEXSUI.COM"

	Max_Level		= 9
	Begin_Category		: static array [0..Max_Level] of Integer
	End_Category		: static array [0..Max_Level] of Integer
	Present_Level		: static Integer

	Index_file		: static file
	blankchar		is char initially $<SP>
	Index_Line_Type		is packed array [1..80] of blankchar
	Max_Line		= 300
	Index_File_Buffer	: static array [1..Max_Line] of Index_Line_Type
	Highest_Buffer_Index	: static integer
    enddeclare


    procedure	SHOW_INDEX_LINE 
	param	
	    Tab_Level	: integer
	    Index 	: integer
	endparam

	declare (Tab_count : integer initially 0)

	while tab_count < Tab_level do
	    out_string	(TTY, "    ")
	    tab_count *= +1
	endwhile

	declare
	    Local_Line 		: Index_Line_type
	    Local_line_length	: integer 
	    copy_flag		: boolean initially false
	enddeclare

	// cut off .hlx, leading spaces and tabs

	declare 
	    Local_I : integer initially 1
	    Passed_I: integer initially 5	    
	enddeclare

	while Passed_I < high (Index_line_type) do
	    Local_line [Local_I] := Index_file_buffer [Index] [Passed_I]  
	    if Local_line [Local_I] = $<HT> do
		Local_line [Local_I] := $<SP>
	    orif Local_line [Local_I] = $<SP> do
	    otherwise
		copy_flag := true
	    endif
	    if copy_flag do
		Local_I *= +1
	    endif
	    Passed_I *= +1
	endwhile

	// cut of trailing blanks

	CUT_Loop: block
	  for I := high(index_line_type)-4 downto 1 do
	    Local_line_length := I
	    if Local_line [I] <> $<SP> do
		break CUT_LOOP
	    endif
	  endfor
	endblock {CUT_Loop}

	out_string	(TTY, Local_line, Local_line_length)
	out_record	(TTY)
    endprocedure

    procedure	SHOW_MODULE_LINE 
	param	
	    Tab_Level	: integer
	    Index 	: integer
	endparam

	declare (Tab_count : integer initially 0)

	while tab_count < Tab_level do
	    out_string	(TTY, "    ")
	    tab_count *= +1
	endwhile

	declare
	    Local_Line 		: Index_Line_type
	    Local_line_length	: integer 
	    copy_flag		: boolean initially false
	enddeclare

	// cut off *, leading spaces and tabs

	declare 
	    Local_I : integer initially 1
	    Passed_I: integer initially 2	    
	enddeclare

	while Passed_I < high (Index_line_type) do
	    Local_line [Local_I] := Index_file_buffer [Index] [Passed_I]  
	    if Local_line [Local_I] = $<HT> do
		Local_line [Local_I] := $<SP>
	    orif Local_line [Local_I] = $<SP> do
	    otherwise
		copy_flag := true
	    endif
	    if copy_flag do
		Local_I *= +1
	    endif
	    Passed_I *= +1
	endwhile

	// cut of trailing blanks

	CUT_Loop: block
	  for I := high(index_line_type)-4 downto 1 do
	    Local_line_length := I
	    if Local_line [I] <> $<SP> do
		break CUT_LOOP
	    endif
	  endfor
	endblock {CUT_Loop}

	out_string	(TTY, Local_line, Local_line_length)
	out_record	(TTY)
    endprocedure


    procedure	SHOW_PRESENT_SELECTION ()

%if false
    		out_string (TTY, "So, you want ")
    		out_string (TTY, Index_file_Buffer [Begin_Category[Present_Level]])
    		out_record (TTY)
	
	    	out_string (TTY, "down to ")
	    	out_record	(TTY)
	    	out_string (TTY, Index_file_Buffer [End_Category[Present_level]])
	    	out_record (TTY)
%endif
    endprocedure

    function Get_Level
 	param	
	    Index_string : in ref index_line_type
	endparam
	returns Get_Level : integer
	Get_Level := integer(Index_string [4]) - integer($0)
    endfunction 


    function Is_Index
 	param	
	    Index_string : in ref index_line_type
	endparam
	returns Is_Index : boolean initially Index_String [1] = $.
    endfunction


    function Is_Module
 	param	
	    Index_string : in ref index_line_type
	endparam
	returns Is_Index : boolean initially Index_String [1] = $*
    endfunction


    //-------------------------------------------------------------------
    // 		Read the Index file entirely into memory
    //-------------------------------------------------------------------

    out_string 	(TTY, "Reading the Index File (")
    out_string	(TTY,	Index_File_Name)
    out_string	(TTY,	") into memory")
    out_record	(TTY)

    guard
	open_file	(Index_File, Read, Index_file_Name)
    	Highest_Buffer_Index		:= 1
    	repeat
	    GET_PADDED_STRING_UPPER (Index_File, 
			Index_File_Buffer [Highest_Buffer_Index])

	    // ignore comment lines

	    if Index_File_Buffer [Highest_Buffer_Index] [1] <> $! do
	    	Highest_Buffer_Index *= +1
	    endif
	    if Highest_Buffer_Index > Max_Line do
		out_line (TTY, "******** ERROR ***** OVERFLOWED INDEX_FILE_BUFFER")
	        Highest_Buffer_Index := Max_Line
	    endif
        until Index_file.EOF
        close_file	(Index_File)

    catch
	case	IO_Open_Failure:
	    out_line (TTY, "******* UNABLE TO OPEN TEST SUITE INDEX FILE")
    endguard



    // set up initial conditions

    Present_Level 			:= 0
    Begin_Category [Present_Level] 	:= 1
    End_Category [Present_Level]	:= Highest_Buffer_Index



 

    //-------------------------------------------------------------
    //	ALLOW OPERATOR TO SELECT THE LEVEL AND SUBJECT TO BE TESTED
    //-------------------------------------------------------------

    declare
	Operator_Satisfied	: boolean initially false
    enddeclare


    while not Operator_Satisfied do

    	out_line	(TTY,	"Categories available under ")
	SHOW_INDEX_LINE	(0, Begin_Category [Present_Level])   
    	out_line	(TTY,	" are:")
   

    	declare 
	    Found_Answer 	: boolean initially false
	    Answer_Index	: integer 
	    Kind_of_Answer_enum	is [index,all,back]
	    Kind_of_Answer	: Kind_of_Answer_enum initially index	
   	enddeclare


    	repeat    

	    //   Give choices of header lines at next level

	    declare
		Any_indexes : boolean initially false
	    enddeclare

	    for Index := Begin_Category [Present_Level] to End_Category [Present_Level] do
	    	if Is_Index (Index_file_Buffer [Index]) do
		    if Get_Level (Index_File_Buffer [Index]) = Present_Level+1 do
			Any_indexes := true
	            	SHOW_INDEX_LINE (1, Index)
	    	    endif
	    	endif 
	    endfor

	    if not Any_indexes do
		out_line (TTY, " - none -")
	    	out_line	(TTY,	"Modules available under ")
		SHOW_INDEX_LINE	(0, Begin_Category [Present_Level])   
	    	out_line	(TTY,	" are:")
		for Index := Begin_Category [Present_Level] to End_Category [Present_Level] do
	    	    if Is_Module (Index_file_Buffer [Index]) do
	            	SHOW_MODULE_LINE (1, Index)
	    	    endif 
	    	endfor
	    endif

 	    // get desired next level from operator

	    declare
	    	Answer			: static Index_Line_type
	    	Answer_Length		: static integer
		All_Answer		: Index_line_type initially ("ALL")
		BACK_Answer		: Index_line_type initially ("BACK")
 	    enddeclare


   	    out_Line	(TTY,	"Which subject are you interested in? (or ALL)")
    	    GET_PADDED_STRING_UPPER (TTY_In, Answer, Answer_Length)

	    // Check for special Answers

	    if Answer = ALL_answer do
		Kind_of_Answer	:= all
		Found_Answer	:= true
	    orif Answer = Back_Answer do
		Kind_of_Answer 	:= back
		Found_Answer	:= true
	    otherwise
		Kind_of_Answer 	:= index
		Found_Answer	:= false
	    endif

   	    //   Scan for header lines at next level which match the answer
     

	    if Kind_of_Answer = index do	    	
	      for Index := Begin_Category [Present_Level] to End_Category [Present_Level] do
	    	if Is_Index (Index_file_Buffer [Index]) do
	            if Get_Level (Index_File_Buffer [Index]) = Present_Level+1 do

		    	declare
		    	    Found_It	: boolean
		            Position	: integer initially 1
		        enddeclare

			FIND_STRING	(Index_file_Buffer [Index],
				Answer, Found_it, Position)

		    	if Found_it do
		    	    Found_Answer := true
			    Answer_Index := Index
		        endif
	            endif
	    	endif 
	      endfor
	    endif
            if not Found_Answer do
	    	out_line (TTY, "Did not find that answer")
    	    endif
        until Found_Answer


	//-----------------------------------------------------------
	// 	Advance to level indicated by answer
	//-----------------------------------------------------------

	select kind_of_Answer from
	    case index:

		Present_Level *= +1
		Begin_Category [Present_Level] := Answer_Index
	
	   	//  The end of this category occurs upon the next category at 
		//  this level or the end of file 
	     
		declare
		    Found_End_of_Category : boolean initially false
		enddeclare
	
		End_Category [Present_Level] := Begin_Category [Present_Level]
	
		repeat
		    End_Category [Present_Level] *= +1
		    if Is_Index (Index_file_Buffer [End_Category [Present_level]]) do
		        if Get_Level (Index_File_Buffer [End_Category[Present_Level]]) = Present_Level do
			    Found_End_of_Category := true
			    End_Category [Present_Level] *= -1
			endif
		    endif
		until Found_End_of_Category 
		or End_Category [Present_Level] = End_Category [Present_level - 1]

		SHOW_PRESENT_SELECTION ()

	    case ALL:
		Operator_Satisfied := true
		SHOW_PRESENT_SELECTION ()

	    case BACK:
		Present_Level *= -1
		if Present_level <0 do
		    Present_Level := 0
		endif
		SHOW_PRESENT_SELECTION ()
	endselect
    endwhile
endmodule