with TEXT_IO; use TEXT_IO; with INTEGER_TEXT_IO; use INTEGER_TEXT_IO; with UATL_BUILDER_DATA; use UATL_BUILDER_DATA; with UATL_PROCEDURE_BUILDER_DATA; use UATL_PROCEDURE_BUILDER_DATA; with UATL_STIM_RESPONSE_BUILDER; use UATL_STIM_RESPONSE_BUILDER; with UATL_INTERFACE_BUILDER; use UATL_INTERFACE_BUILDER; with UATL_ADA_BUILDER; use UATL_ADA_BUILDER; with UATL_FIC_BUILDER; use UATL_FIC_BUILDER; with UATL_INTERACTIVE_IO; use UATL_INTERACTIVE_IO; with TEST_MANAGER_LOGICALS; use TEST_MANAGER_LOGICALS; with TEST_MANAGER_SCREEN_DISPLAY; use TEST_MANAGER_SCREEN_DISPLAY; package body UATL_PROCEDURE_BUILDER_CODE is MENU_PROC : LIST(1..12) := (new STRING'("Functional Instrument Control"), new STRING'("Digital Test"), new STRING'("Stimulus/Response"), new STRING'("1553B Bus Polling List"), new STRING'("IEEE488 Device Setup"), new STRING'("IEEE488 Terminal Polling Rate "), new STRING'("Internal Interface Initialization"), new STRING'("Internal Interface Receivers"), new STRING'("Recording"), new STRING'("Operator Interface"), new STRING'("Ada Language Structures"), new STRING'("Test Procedure Complete ")); procedure GET is new GET_INTEGER(POSITIVE); procedure BUILD_TEST_PROCEDURE is TEST_LINE : STRING(1..80); END_TEST_LINE : NATURAL; WITHING_LINE : STRING(1..80); END_WITHING_LINE : NATURAL; COPY_LINE : STRING(1..80); END_COPY : NATURAL; CONTINUE_LOOP : STRING(1..1); WITH_PACKS : array (UATL_PACKS) of BOOLEAN := (others => FALSE); CHOICE : POSITIVE; LOOP_END : BOOLEAN; PROC_END : BOOLEAN; begin VAR_NUMBER := 0; CNT_NUMBER := 0; -- Put up builder tool header. CLEAR_SCREEN; PUT_STRING(4,1," ******** UATL Test Procedure Builder *******"); -- Get name of test procedure NEW_LINE(2); PUT(" Enter the test name: "); GET_LINE(TEST_LINE,END_TEST_LINE); -- Get file for procedure portion CREATE ( FILE => WITH_FILE, MODE => OUT_FILE, NAME => BUILDER.LOGICAL_STRING.ALL & ":" & TEST_LINE(1..END_TEST_LINE) & ".WTH"); NEW_LINE(WITH_FILE); -- Get with statements loop NEW_LINE(4); PUT_LINE(" *** Specify packages to be with'ed ***"); PUT_LINE(WITH_FILE,WITH_U_TYPE); PUT_LINE(WITH_FILE,WITH_CON); loop NEW_LINE; PUT(" Want to 'with' a package? (Y/N): "); GET(CONTINUE_LOOP); SKIP_LINE; NEW_LINE; exit when CONTINUE_LOOP /= "y" and CONTINUE_LOOP /= "Y"; PUT(" Enter name of package to be with'ed: "); GET_LINE(WITHING_LINE,END_WITHING_LINE); PUT(WITH_FILE,WITH_CLAUSE & WITHING_LINE(1..END_WITHING_LINE) & SEMICOLON); PUT_LINE(WITH_FILE,USE_CLAUSE & WITHING_LINE(1..END_WITHING_LINE) & SEMICOLON); NEW_LINE; end loop; -- Get file for procedure declarative part CREATE ( FILE => DECL_FILE, MODE => OUT_FILE, NAME => BUILDER.LOGICAL_STRING.ALL & ":" & TEST_LINE(1..END_TEST_LINE) & ".TPD"); NEW_LINE(DECL_FILE); -- Get file for procedure portion and write header CREATE ( FILE => TEST_FILE, MODE => OUT_FILE, NAME => BUILDER.LOGICAL_STRING.ALL & ":" & TEST_LINE(1..END_TEST_LINE) & ".TPT"); PUT_LINE(TEST_FILE,TEST_BEGIN); -- Put up menu of choices for the test program loop CHOICE := DISPLAY_MENU_AND_GET_SELECTION( "UATL TEST EVENTS",MENU_PROC); -- Case on selection made case CHOICE is when 1 => CREATE_FIC_CALLS; if not(WITH_PACKS(FIC)) then PUT_LINE(WITH_FILE,WITH_DRIVE); PUT_LINE(WITH_FILE,WITH_FIC_TYPES); PUT_LINE(WITH_FILE,USE_FIC_TYPES); PUT_LINE(WITH_FILE,WITH_FIC); WITH_PACKS(FIC) := TRUE; end if; when 2 => null; when 3 => CREATE_STIMULUS_RESPONSE_TEST_EVENT; if not(WITH_PACKS(STIM_RESPONSE)) then PUT_LINE(WITH_FILE,WITH_SR_TYPE); PUT_LINE(WITH_FILE,WITH_SR_PROCS); WITH_PACKS(STIM_RESPONSE) := TRUE; end if; when 4 => CREATE_1553B_BUS_POLLING_LIST_CALL; if not(WITH_PACKS(I1553_INT)) then PUT_LINE(WITH_FILE,WITH_1553_TYPE); PUT_LINE(WITH_FILE,WITH_1553_INT); WITH_PACKS(I1553_INT) := TRUE; end if; when 5 => CREATE_IEEE488_BUS_POLLING_LIST_CALL; if not(WITH_PACKS(I488_INT)) then PUT_LINE(WITH_FILE,WITH_488_TYPE); PUT_LINE(WITH_FILE,WITH_488_INT); WITH_PACKS(I488_INT) := TRUE; end if; when 6 => CREATE_IEEE488_TERMINAL_POLLING_RATE_CALL; if not(WITH_PACKS(I488_INT)) then PUT_LINE(WITH_FILE,WITH_488_TYPE); PUT_LINE(WITH_FILE,WITH_488_INT); WITH_PACKS(I488_INT) := TRUE; end if; when 7 => CREATE_INTERNAL_INITIALIZATION_CALL; if not(WITH_PACKS(INT_INT)) then PUT_LINE(WITH_FILE,WITH_INT_INT); WITH_PACKS(INT_INT) := TRUE; end if; when 8 => CREATE_INTERNAL_INTERFACE_CALLS; if not(WITH_PACKS(SR_INTERNAL)) then PUT_LINE(WITH_FILE,WITH_SR_INTERNAL); WITH_PACKS(SR_INTERNAL) := TRUE; end if; when 9 => CREATE_RECORDING_CALLS; if not(WITH_PACKS(RECORDING)) then PUT_LINE(WITH_FILE,WITH_RECORDING); WITH_PACKS(RECORDING) := TRUE; end if; when 10 => CREATE_OPERATOR_INTERFACE_CALLS; if not(WITH_PACKS(OPINT)) then PUT_LINE(WITH_FILE,WITH_OP_INT); PUT_LINE(WITH_FILE,WITH_OP_COM); WITH_PACKS(I1553_INT) := TRUE; end if; when 11 => CREATE_ADA_STRUCTURES; when 12 => exit; when others => null; end case; end loop; -- Close body file if WITH_PACKS(STIM_RESPONSE) then PUT_LINE(TEST_FILE,END_TEST_CALL); end if; PUT_LINE(TEST_FILE,END_TEST_PROC & TEST_LINE(1..END_TEST_LINE) & SEMICOLON); NEW_LINE(WITH_FILE); PUT_LINE(WITH_FILE,TEST_PROC & TEST_LINE(1..END_TEST_LINE) & IS_WORD); RESET(WITH_FILE,IN_FILE); RESET(DECL_FILE,IN_FILE); RESET(TEST_FILE,IN_FILE); CREATE ( FILE => PROC_FILE, MODE => OUT_FILE, NAME => TEST_FILES.LOGICAL_STRING.ALL & ":" & TEST_LINE(1..END_TEST_LINE) & "." & TEST_PROC_MACRO); while not(END_OF_FILE(WITH_FILE)) loop GET_LINE(WITH_FILE,COPY_LINE,END_COPY); PUT_LINE(PROC_FILE,COPY_LINE(1..END_COPY)); end loop; DELETE(WITH_FILE); while not(END_OF_FILE(DECL_FILE)) loop GET_LINE(DECL_FILE,COPY_LINE,END_COPY); PUT_LINE(PROC_FILE,COPY_LINE(1..END_COPY)); end loop; DELETE(DECL_FILE); while not(END_OF_FILE(TEST_FILE)) loop GET_LINE(TEST_FILE,COPY_LINE,END_COPY); PUT_LINE(PROC_FILE,COPY_LINE(1..END_COPY)); end loop; DELETE(TEST_FILE); CLOSE(PROC_FILE); end BUILD_TEST_PROCEDURE; end UATL_PROCEDURE_BUILDER_CODE;