Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / cais / caistst.src < prev next >

Wrap

Text File | 1988-05-03 | 376.8 KB | 12,378 lines

--:::::::::::::: --caistest.pro --:::::::::::::: -------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : CAISTEST -- Version : 860307 -- Author : Mitre Corp. -- : Rebecca Bowerman Helen Gill -- : Chuck Howell Robbie Hutchison -- : Mike McClimens -- DDN Address : cig-info at mitre -- Date created : 07 MAR 86 -- Release date : 07 MAR 86 -- Last update : 07 MAR 86 -- Machine/System Compiled/Run on : Vax 8600 -- UNIX -- Verdix Ada Development Sys -- -* --------------------------------------------------------------- -- -* -- Keywords : Tool Interfaces, Portability, Stoneman, -- Operating System Calls, Host-Dependencies, -- MIL-STD-CAIS, APSE, Programming Support Environment, -- Regression Tests ----------------: -- -- Abstract : -- This set of tests exercises a wide range of the -- implemented CAIS interfaces. In general the results of the -- tests are self-documenting. However they are programmer- -- developed tests and are not as rigorous as might be -- expected for acceptance testing. They also vary in style. -- In some instances dependencies upon the state of the node -- model remain in these tests and thus may require the -- existence (or non-existence) of nodes and/or attributes. -- -- The tests are: -- attribute_ex.a => Test Exceptions on Attribute Com -- cais_commandos.a => Set of Interactive CAIS Commands -- copytree_test.a => Tests Copy_Tree(+Node), Rename -- existree_ex.a => Same as Nodetree_ex sans Creates -- io_ex_create_test.a => Test Exceptions on Text_Io.Create -- io_ex_open_test.a => Test Exceptions on Text_Io.Open -- io_ex_delete_test.a => Test Exceptions on Text_Io.Delete -- list_test_02_12.a => Tests List_Utilities 5.4.2 - 12 -- list_test_13_ss.a => Tests List_Utilities 5.4.13 - 23 -- list_tstex.a => Tests Exceptions on List_Utilities -- listutst.a => Five Quick List_Utilities Tests -- list_utilities_tests-body.a => Part of Above -- list_utilities_tests-spec.a => Part of Above -- natt_tst_all.a => Test Node Attribute Commands -- natt_tst_it.a => Test Node Attribute Iterators -- new_user.a => Adds New_Users -- node_mgnt.a => Tests some of Node-Management -- node_management_tests-body.a => Part of Above -- node_management_tests-body.a => Part of Above -- nodetree_ex.a => Tests some Node_Management Excep. -- nodetree_cleanup.a => Deletes Nodes from Above -- patt_tst_all.a => Test Path Attribute Commands -- patt_tst_it.a => Test Path Attribute Iterators -- struct_nodes.a => Main for Structural_Nodes test -- structural_nodes_tests-body.a => Part of Above -- structural_nodes_tests-spec.a => Part of Above -- test_internals.a => Test Window into Cais Insides -- test_node_iterate.a => Tests Node Iterate -- text_test.a => Tests some of Text_Io -- text_io_tests-body.a => Part of Above -- text_io_tests-spec.a => Part of Above -- -- The tests should be run when the CAIS is installed -- and users have been added. They can also be run as -- regression tests, if the CAIS code is modified. They may -- be helpful as supplementary (though rudimentary) examples -- to MIL-STD-CAIS ----------------: -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 03/07/85 860307 Mitre Corp Initial Release -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- -- Restrictions on use or distribution: Although there are -- no current plans to provide maintenance for this set of -- CAIS tests, further modifications are planned. We would -- appreciate your reporting problems and experiences to: -- -- cig-info at mitre (net address) -- -- or call at: -- -- (703) 883-7858 -- -* ------------------ 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. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- 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-------------------------------- --:::::::::::::: --testscript.log --:::::::::::::: Script started on Fri Mar 7 16:30:02 1986 *************************************************************** * This file contains sample outputs from CAIS tests. The style * of reporting tests varies greatly among the test. It may be * advisable to read the test source. However, an attempt was * made in all tests to self-check and explicitly indicate * failures. Good Luck ************************************************************** ************************************************************* * Several tests run under this test driver. You should * determine the number of tests available (14 in this case). * The level of test output must be: status or none. * Tests may or may not issue status information. Test failures * are reported at the end. All other tests pass. ************************************************************** % text_test.out Enter the highest test number to be run: 15 PLEASE ENTER AN INTEGER 0 .. 14 Enter the highest test number to be run: 14 Abort the test upon an unexpected exception? (Yes or No): no Enter the level of test output to be printed: status Do you want output redirected to a file? (yes or no): no **** Beginning Execution of Text_Test **** TEST_OUTPUT is set to STATUS ABORT_ON_EXCEPTION is set to FALSE TEST_COUNT is set to 14 **** End of Text_Test **** NO TESTS FAILED. *********************************************************** * Cais_commandos is a set of interactive CAIS commands * which allows simple creation, deletion, and listing of * the node system. QUIT is used in some cases, in others * ! is required to quit. Don't be confused and be wary of * naming a node to be QUIT. ********************************************************** % cais_commandos.out 1. Add_Attributes 2. Change_Attributes 3. Create_File_Nodes 4. Delete_Nodes 5. Import_Export 6. Create_Struc_Nodes 7. Directory 8. Delete_Attributes 9. List_Attributes ENTER COMMAND NUMBER (0 to QUIT): 7 DIRECTORY: Give NODE (or QUIT): 'current_node Give PRIMARY or SECONDARY: primary Give FILE or STRUCTURAL: file DOT(HOWELL) DOT(MIKE) Give NODE (or QUIT): quit COMPLETED. 1. Add_Attributes 2. Change_Attributes 3. Create_File_Nodes 4. Delete_Nodes 5. Import_Export 6. Create_Struc_Nodes 7. Directory 8. Delete_Attributes 9. List_Attributes ENTER COMMAND NUMBER (0 to QUIT): 6 CREATING STRUCTURAL NODES Give PATH (or QUIT): test Give PATH (or QUIT): test1 Give PATH (or QUIT): quit COMPLETED. 1. Add_Attributes 2. Change_Attributes 3. Create_File_Nodes 4. Delete_Nodes 5. Import_Export 6. Create_Struc_Nodes 7. Directory 8. Delete_Attributes 9. List_Attributes ENTER COMMAND NUMBER (0 to QUIT): 7 DIRECTORY: Give NODE (or QUIT): 'current_node Give PRIMARY or SECONDARY: primary Give FILE or STRUCTURAL: structural DOT(TEST) DOT(TEST1) Give NODE (or QUIT): quit COMPLETED. 1. Add_Attributes 2. Change_Attributes 3. Create_File_Nodes 4. Delete_Nodes 5. Import_Export 6. Create_Struc_Nodes 7. Directory 8. Delete_Attributes 9. List_Attributes ENTER COMMAND NUMBER (0 to QUIT): 9 LISTING ATTRIBUTES NODE, PATH, or QUIT? node Give NODE (or QUIT): howell ACCESS_METHOD => (TEXT) FILE_KIND => (SECONDARY_STORAGE) NODE, PATH, or QUIT? path Give PATH (or QUIT): 'current_node.howell KIND => (("FILE")) NODE, PATH, or QUIT? quit COMPLETED. 1. Add_Attributes 2. Change_Attributes 3. Create_File_Nodes 4. Delete_Nodes 5. Import_Export 6. Create_Struc_Nodes 7. Directory 8. Delete_Attributes 9. List_Attributes ENTER COMMAND NUMBER (0 to QUIT): 0 ******************************************************************* * Several I/O and List_Utility tests are of the following form. * Pass/Fail messages are printed for each test. Diagnostic * information is interspersed with the messages and may be ignored. * This output should be able to be quickly scanned for correctness * or compared with previous runs for character_by_character * consistency. ****************************************************************** % io_ex_create_test.out 1. OK -- Create raises Io_Definitions.Name_Error when file exists 2. OK -- Create raises Io_Definitions.Name_Error when key is bad 3. OK -- Create raises Io_Definitions.Name_Error when relation is bad CAIS Use_Error: Bad attribute value in Cais.Text_Io.Create 4. OK -- Create raises Io_Definitions.Use_Error when attribute syntax illegal CAIS Use_Error: Invalid Access_Method in Cais.Text_Io.Create 5. OK -- Create raises Io_Definitions.Use_Error when attribute semantics illegal CAIS Use_Error: Invalid File_Kind in Cais.Text_Io.Create 6. OK -- Create raises Io_Definitions.Use_Error when predefined attribute 7. OK -- Create raises Io_Definitions.Use_Error when predefined relation 8. OK -- Create raises Io_Definitions.Status_Error when base not open 9. OK -- Create raises Io_Definitions.Status_Error when file handle open 10. OK -- Create raises Io_Definitions.Intent_Violation when base intent not Append_Relationships ********************************************************************* * Several Exception tests have this style, quickly listing the no. of * passing tests. Failed tests will be reported on a separate line. * For this test, inaccessibility test are skipped unless a 'Y' is * entered as a response. If they are to be run the tester must * interrupt this process and move the node's "shadow file". Don't * lose it because it is hard to clean up unless you put it back ******************************************************************** % nodetree_ex.out CREATE --TREE CREATE --Nowalk.john CREATE --Nowalk.john.johnjr CREATE --Nowalk.john.johnjr.mark CREATE --Nowalk.john.will CREATE --Nowalk.john.will.kitty NOW YOU must make the node dot(will) inaccessible It should be the 2nd from last node created. Should Inaccessibility tests be run (Y/N) n PASSES TEST: 2 3 5 6 8 9 10 12 13 14 PASSES TEST: 15 16 17 18 19 20 21 22 23 24 PASSES TEST: 25 26 27 28 29 30 31 32 33 34 PASSES TEST: 35 36 37 38 39 40 41 42 43 44 PASSES TEST: 45 48 49 50 ****************************T O T A L S*********************** Number of tests run: 50 Number of failures : 0 *** NOTE 6 TESTS ARE SKIPPED IF INACCESSIBILITY NOT CHECKED*** ************************************************************** ************************************************************* * Some attribute tests tell you what to expect and then show * you whar is there ( and maybe a little bit more). As long * as the extra attributes are system'types or can reasonably * be expected, they can be ignored. Unfortunately, this * style of test reporting really should be read to be * verified, but could be compared automatically against * previous test results. ************************************************************ % patt_tst.all.out TESTING CREATE TST_NODE1 EXPECTS: time, verified KIND => (("FILE")) TIME => (HOUR=>12,MINUTE=>30,SECONDS=>49) VERIFIED => (TRUE) TST_NODE2 EXPECTS: time KIND => (("FILE")) TIME => (HOUR=>12,MINUTE=>30,SECONDS=>49) TESTING GET TEST PASSES: FOUND (HOUR=>12,MINUTE=>30,SECONDS=>49) TEST PASSES: FOUND (TRUE) TEST PASSES: FOUND (HOUR=>12,MINUTE=>30,SECONDS=>49) TESTING SET TST_NODE1 EXPECTS: time=101517, verified=false KIND => (("FILE")) TIME => (HOUR=>10,MINUTE=>15,SECONDS=>17) VERIFIED => (FALSE) TST_NODE2 EXPECTS: time=101517 KIND => (("FILE")) TIME => (HOUR=>10,MINUTE=>15,SECONDS=>17) TESTING DELETE ONLY VERIFIED EXPECTED: KIND => (("FILE")) VERIFIED => (FALSE) NOTHING EXPECTED : KIND => (("FILE")) NOTHING EXPECTED : KIND => (("FILE")) ************************************************************* * In this test there are only 7 tests and only the 1st 5 * print out STATUS information. Unfortunately, the test * will accept up to 15 as the number of tests to be run. * Tests 6 and 7 do not report their success and any test * higher than 8 always shows as a failure. The test * results look much better when NONE is entered for level * and 7 is entered for # of tests. ************************************************************ % node_mgmt.out Enter the highest test number to be run: 10 Abort the test upon an unexpected exception? (Yes or No): no Enter the level of test output to be printed: status Do you want output redirected to a file? (yes or no): no **** Beginning Execution of Node_Management_Tests **** TEST_OUTPUT is set to STATUS ABORT_ON_EXCEPTION is set to FALSE TEST_COUNT is set to 10 Test 001: Bad Pathname raised NAME_ERROR correctly Test 002: Node_Management.Open with Open node handle raised STATUS_ERROR correctly Test 003 Is_Equal is OK Test 004: Different Node_Management.Open interfaces are equivalant. Test 005: Node_Management.Close worked as advertised. **** End of Node_Management_Tests **** A total of 3 Test(s) failed. The following test(s) failed: Test number 8 Test number 9 Test number 10 script done on Fri Mar 7 17:11:14 1986 ******************************************************************* ********E N D O F S A M P L E T E S T O U T P U T********** ******************************************************************* --:::::::::::::: --attribute_ex.a --:::::::::::::: ---------------------------------------------------------------------------- --NOTE! SETUP IS DIFFICULT. THIS TEST ASSUMES THAT THE TOP_NODE FOR THE -- -- USER HAS A PATH FOR DOT(HOWELL). ALSO MAKE SURE THAT ATTRIBUTES -- -- ADDED BY THIS TEST ARE DELETED BEFORE TRYING TO RUN THE TEST -- -- AGAIN. -- -- G O O D L U C K ! -- ---------------------------------------------------------------------------- with Cais; use Cais; with Text_Io; use Text_Io; procedure Attribute_Ex is use Attributes; use List_Utilities; use Node_Management; use Node_Definitions; Exceptions_Tested : constant := 48; Failures : integer := 0; Line_Count : integer; Expected : string(1..3); Impotent_Node : Cais.Node_Type; Closed_Node : Cais.Node_Type; Node : Cais.Node_Type; Key : Relationship_Key(1..6) := "howell"; Relation : Relation_Name(1..3) := "dot"; Null_List : List_Type; procedure Wrong_Exception(II: integer; SS: string) is begin Failures := Failures + 1; Line_Count := 10; new_line; put( integer'image(II) & ":**ERROR**" & " Received: " & SS & " Expected: " & Expected ); end Wrong_Exception; procedure No_Ex(Error: in string) is begin new_line; put(Error); Line_Count := 10; Failures := Failures + 1; end No_Ex; procedure Raise_Exception(II: integer ) is Text : Natural; String1 : string(1..3); Name1 : NameString(1..3); Iterator : Attribute_Iterator; Attribute : Attribute_Name(1..32); begin case II is --MIL STD 5.1.3.1 --not applicable --MIL STD 5.1.3.2 --no exceptions --MIL STD 5.1.3.4 --no exceptions --MIL STD 5.1.3.5 --no exceptions when 1 => --MIL STD 5.1.3.1 Expected := "Use"; --Use_Error Expected Create_Node_Attribute(Node,"aaa",Null_List); No_Ex(" 1:**ERROR**CREATE_NODE_ATT: attribute exists"); when 2 => Expected := "Use"; --Use_Error Expected Create_Node_Attribute(Node,"aa_",Null_List); No_Ex(" 2:**ERROR**CREATE_NODE_ATT: illegal attribute"); when 3 => Expected := "Use"; --Use_Error Expected Create_Node_Attribute(Node,"access_method",Null_List); No_Ex(" 3:**ERROR**CREATE_NODE_ATT: predefined attribute"); when 4 => Expected := "Sta"; --Status_Error Expected Create_Node_Attribute(Closed_Node,"aaa",Null_List); No_Ex(" 4:**ERROR**CREATE_NODE_ATT: unopened node"); when 5 => Expected := "Int"; --Intent_Error Expected Create_Node_Attribute(Impotent_Node,"aaa",Null_List); No_Ex(" 5:**ERROR**CREATE_NODE_ATT: Impotent node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 6 => --MIL STD 5.1.3.2 Expected := "Use"; --Use_Error Expected Create_Path_Attribute(Node,Key,Relation,"aaa",Null_List); No_Ex(" 6:**ERROR**CREATE_Path_ATT: attribute exists"); when 7 => Expected := "Use"; --Use_Error Expected Create_Path_Attribute(Node,Key,Relation,"aa_",Null_List); No_Ex(" 7:**ERROR**CREATE_Path_ATT: illegal attribute"); when 8 => Expected := "Use"; --Use_Error Expected Create_Path_Attribute(Node,Key,Relation,"access_method",Null_List); No_Ex(" 8:**ERROR**CREATE_Path_ATT: predefined attribute"); when 9 => Expected := "Sta"; --Status_Error Expected Create_Path_Attribute(Closed_Node,Key,Relation,"aaa",Null_List); No_Ex(" 9:**ERROR**CREATE_Path_ATT: unopened Node"); when 10 => Expected := "Int"; --Intent_Error Expected Create_Path_Attribute(Impotent_Node,Key,Relation,"aaa",Null_List); No_Ex("10:**ERROR**CREATE_Path_ATT: Impotent Node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 11 => ---MIL STD 5.1.3.4 Expected := "Use"; --Use_Error Expected Delete_Node_Attribute(Node,"xxx"); No_Ex("11:**ERROR**Delete_NODE_ATT: attribute undefined"); when 12 => Expected := "Use"; --Use_Error Expected Delete_Node_Attribute(Node,"access_method"); No_Ex("12:**ERROR**Delete_NODE_ATT: predefined attribute"); when 13 => Expected := "Sta"; --Status_Error Expected Delete_Node_Attribute(Closed_Node,"aaa"); No_Ex("13:**ERROR**Delete_NODE_ATT: unopened node"); when 14 => Expected := "Int"; --Intent_Error Expected Delete_Node_Attribute(Impotent_Node,"aaa"); No_Ex("14:**ERROR**Delete_NODE_ATT: Impotent node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 15 => --MIL STD 5.1.3.4 Expected := "Use"; --Use_Error Expected Delete_Path_Attribute(Node,Key,Relation,"xxx"); No_Ex("15:**ERROR**Delete_Path_ATT: attribute undefined"); when 16 => Expected := "Use"; --Use_Error Expected Delete_Path_Attribute(Node,Key,Relation,"access_method"); No_Ex("16:**ERROR**Delete_Path_ATT: predefined attribute"); when 17 => Expected := "Sta"; --Status_Error Expected Delete_Path_Attribute(Closed_Node,Key,Relation,"aaa"); No_Ex("17:**ERROR**Delete_Path_ATT: unopened Node"); when 18 => Expected := "Int"; --Intent_Error Expected Delete_Path_Attribute(Impotent_Node,Key,Relation,"aaa"); No_Ex("18:**ERROR**Delete_Path_ATT: Impotent Node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 19 => --MIL STD 5.1.3.5 Expected := "Use"; --Use_Error Expected Set_Node_Attribute(Node,"xxx",Null_List); No_Ex("19:**ERROR**Set_NODE_ATT: attribute undefined"); when 20 => Expected := "Use"; --Use_Error Expected Set_Node_Attribute(Node,"aa_",Null_List); No_Ex("20:**ERROR**Set_NODE_ATT: illegal attribute"); when 21 => Expected := "Use"; --Use_Error Expected Set_Node_Attribute(Node,"access_method",Null_List); No_Ex("21:**ERROR**Set_NODE_ATT: predefined attribute"); when 22 => Expected := "Sta"; --Status_Error Expected Set_Node_Attribute(Closed_Node,"aaa",Null_List); No_Ex("22:**ERROR**Set_NODE_ATT: unopened node"); when 23 => Expected := "Int"; --Intent_Error Expected Set_Node_Attribute(Impotent_Node,"aaa",Null_List); No_Ex("23:**ERROR**Set_NODE_ATT: Impotent node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 24 => --MIL STD 5.1.3.6 Expected := "Use"; --Use_Error Expected Set_Path_Attribute(Node,Key,Relation,"xxx",Null_List); No_Ex("24:**ERROR**Set_Path_ATT: attribute undefined"); when 25 => Expected := "Use"; --Use_Error Expected Set_Path_Attribute(Node,Key,Relation,"aa_",Null_List); No_Ex("25:**ERROR**Set_Path_ATT: illegal attribute"); when 26 => Expected := "Use"; --Use_Error Expected Set_Path_Attribute(Node,Key,Relation,"access_method",Null_List); No_Ex("26:**ERROR**Set_Path_ATT: predefined attribute"); when 27 => Expected := "Sta"; --Status_Error Expected Set_Path_Attribute(Closed_Node,Key,Relation,"aaa",Null_List); No_Ex("27:**ERROR**Set_Path_ATT: unopened Node"); when 28 => Expected := "Int"; --Intent_Error Expected Set_Path_Attribute(Impotent_Node,Key,Relation,"aaa",Null_List); No_Ex("28:**ERROR**Set_Path_ATT: Impotent Node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 29 => --MIL STD 5.1.3.7 Expected := "Use"; --Use_Error Expected Get_Node_Attribute(Node,"xxx",Null_List); No_Ex("29:**ERROR**Get_NODE_ATT: attribute undefined"); when 30 => Expected := "Use"; --Use_Error Expected Get_Node_Attribute(Node,"aa_",Null_List); No_Ex("30:**ERROR**Get_NODE_ATT: illegal attribute"); when 31 => Expected := "Use"; --Use_Error Expected Get_Node_Attribute("'current_node","aaaaaa",Null_List); No_Ex("31:**ERROR**Get_NODE_ATT: attribute undefined"); when 32 => Expected := "Sta"; --Status_Error Expected Get_Node_Attribute(Closed_Node,"aaa",Null_List); No_Ex("32:**ERROR**Get_NODE_ATT: unopened node"); when 33 => Expected := "Int"; --Intent_Error Expected Get_Node_Attribute(Impotent_Node,"aaa",Null_List); No_Ex("33:**ERROR**Get_NODE_ATT: Impotent node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 34 => --MIL STD 5.1.3.8 Expected := "Use"; --Use_Error Expected Get_Path_Attribute(Node,Key,Relation,"xxx",Null_List); No_Ex("34:**ERROR**Get_Path_ATT: attribute undefined"); when 35 => Expected := "Use"; --Use_Error Expected Get_Path_Attribute(Node,Key,Relation,"aa_",Null_List); No_Ex("35:**ERROR**Get_Path_ATT: illegal attribute"); when 36 => Expected := "Use"; --Use_Error Expected Get_Path_Attribute("'current_node.howell","aaaaaa",Null_List); No_Ex("36:**ERROR**Get_Path_ATT: attribute undefined"); when 37 => Expected := "Sta"; --Status_Error Expected Get_Path_Attribute(Closed_Node,Key,Relation,"aaa",Null_List); No_Ex("37:**ERROR**Get_Path_ATT: unopened Node"); when 38 => Expected := "Int"; --Intent_Error Expected Get_Path_Attribute(Impotent_Node,Key,Relation,"aaa",Null_List); No_Ex("38:**ERROR**Get_Path_ATT: Impotent Node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** --MIL STD 5.1.3.9 --only definitions when 39 => --MIL STD 5.1.3.10 Expected := "Use"; --Use_Error Expected Node_Attribute_Iterate(Iterator,Node,"aa_"); No_Ex("39:**ERROR**NODE_ATT_ITERATE: illegal attribute"); when 40 => Expected := "Use"; --Use_Error Expected Node_Attribute_Iterate(Iterator,Node,"a__a"); No_Ex("40:**ERROR**NODE_ATT_ITERATE: illegal attribute"); when 41 => Expected := "Sta"; --Status_Error Expected Node_Attribute_Iterate(Iterator,Closed_Node,"aaa"); No_Ex("41:**ERROR**NODE_ATT_ITERATE: unopened node"); when 42 => Expected := "Int"; --Intent_Error Expected Node_Attribute_Iterate(Iterator,Impotent_Node,"aaa"); No_Ex("42:**ERROR**NODE_ATT_ITERATE: Impotent node"); --*************************************************************** --*************************************************************** --********SECURITY_VIOLATIONS ARE NOT TESTED BECAUSE************* --***********ACCESS_CONTROL IS NOT IMPLEMENTED******************* --*************************************************************** --*************************************************************** when 43 => --MIL STD 5.1.3.12 Expected := "Use"; --Use_Error Expected Path_Attribute_Iterate(Iterator,Node,Key,Relation,"aa_"); No_Ex("44:**ERROR**Path_ATT_ITERATE: illegal attribute"); when 44 => Expected := "Use"; --Use_Error Expected Path_Attribute_Iterate(Iterator,Node,Key,Relation,"aa__a"); No_Ex("44:**ERROR**Path_ATT_ITERATE: illegal attribute"); when 45 => Expected := "Sta"; --Status_Error Expected Path_Attribute_Iterate(Iterator,Closed_Node,Key,Relation,"aaa"); No_Ex("45:**ERROR**Path_ATT_ITERATE: unopened Node"); when 46 => Expected := "Int"; --Intent_Error Expected Path_Attribute_Iterate(Iterator,Impotent_Node,Key,Relation,"aaa"); No_Ex("46:**ERROR**Path_ATT_ITERATE: Impotent Node"); when 47 => --MIL STD 5.1.3.12 Expected := "Use"; --Use_Error Expected if More(Iterator) then No_Ex("47:**ERROR**MORE: iterator undefined"); end if; when 48 => --MIL STD 5.1.3.13 Expected := "Use"; --Use_Error Expected Get_Next(Iterator,Attribute,Null_List); No_Ex("48:**ERROR**GET_NEXT: iterator undefined"); --******************************* --ERROR, SHOULD NEVER BE EXECUTED --******************************* when others => put_line( "******No test for: " & integer'image(II) ); end case; end Raise_Exception; begin Open(Node,"'current_node",(1=>read_relationships, 2 => read_attributes, 3=>write_relationships, 4 => write_attributes, 5=>append_relationships,6 => append_attributes)); Open(Impotent_Node,"'current_user",(1=>read_contents)); Create_Node_Attribute(Node,"aaa",Null_List); Create_Path_Attribute(Node,Key,Relation,"aaa",Null_List); Line_Count := 10; for I in 1..Exceptions_Tested loop begin if Line_Count = 10 then new_line; put("PASSES TEST: "); Line_Count := 0; end if; Raise_Exception(I); exception when Node_Definitions.Use_Error => if Expected /= "Use" then Wrong_Exception(I,"Use_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Node_Definitions.Status_Error => if Expected /= "Sta" then Wrong_Exception(I,"Status_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Intent_Violation => if Expected /= "Int" then Wrong_Exception(I,"Intent_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Security_Violation => if Expected /= "Sec" then Wrong_Exception(I,"Security_Violation"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Node_Definitions.Name_Error => if Expected /= "Nam" then Wrong_Exception(I,"Name_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; end; end loop; new_line; put_line("****************************T O T A L S***********************"); put_line("Number of tests run: " & integer'image(Exceptions_Tested)); put_line("Number of failures : " & integer'image(Failures) ); put_line("**************************************************************"); end Attribute_Ex; --:::::::::::::: --cais_commandos.a --:::::::::::::: with Cais; use Cais; with Character_Set; use Character_Set; with Text_IO; use Text_IO; procedure Cais_Commandos is Last : natural; Line : string(1..255); ---------------------------------------------------------------------- -- ADD_ATTRIBUTES -- -- -- CAIS tool to add attributes to a node or path -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Jun 19 13:57:23 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- -- This tool adds any number of user-specified attributes to given -- nodes or paths. The tool loops through nodes/paths and attributes -- until the user enters "quit." This tool does NOT change the values -- of existing attributes. procedure Add_Attributes is use Attributes; use List_Utilities; use Node_Definitions; use Node_Management; type Response is (NODE, PATH, QUIT); Node_or_Path : Response; Valid_Response : Boolean := False; Node_Handle : Node_Definitions.Node_Type; NodePath_Str : Node_Definitions.Name_String (1..80); -- Arbitrary # Attrib_Name : Attributes.Attribute_Name (1..80); -- Arbitrary # Attrib_Val_Str : String (1..80); -- Arbitrary # Last1, Last2, Last3 : Natural; Temp_Lst_Item : List_Utilities.List_Type; Attrib_Val_Lst : List_Utilities.List_Type; package Response_IO is new Enumeration_IO (Response); Use Response_IO; procedure String_To_Simple_List ( Str : String; List : in out List_Type) is Offset : Integer; Tmp_List : List_Type; begin Offset := Last_Non_Space (Str); Copy (List, EMPTY_LIST); Copy (Tmp_List, EMPTY_LIST); String_Items.Insert (List => Tmp_List, List_Item => Str (Str'first .. Offset), Position => 0); Insert (List => List, List_Item => Tmp_List, Position => 0); end String_To_Simple_List; begin New_Line; Put_Line ("ADDING ATTRIBUTES"); -- Loop for each node or path until user enters "quit." EACH_NODE_OR_PATH: loop -- Determine whether user wants to add node or path attributes. New_Line; while not Valid_Response loop Put("NODE, PATH, or QUIT? "); GET_RESPONSE: begin Get(Node_or_Path); Skip_Line (Standard_Input); exit EACH_NODE_OR_PATH when (Node_or_Path = QUIT); Valid_Response := True; exception when Data_Error => Skip_Line (Standard_Input); Put(Ascii.Bel); Put_Line("Valid responses are NODE, PATH, or QUIT."); New_Line; end GET_RESPONSE; end loop; Valid_Response := False; -- Get Node or Path string. if Node_or_Path = NODE then Put ("Give NODE (or QUIT): "); else Put("Give PATH (or QUIT): "); end if; Get_Line (NodePath_Str, Last1); exit EACH_NODE_OR_PATH when (NodePath_Str(1..4) = "quit") or (NodePath_Str(1..4) = "QUIT"); CAIS_EXCEPTIONS: begin -- Obtain an open node handle. if Node_or_Path = NODE then Node_Management.Open (Node_Handle, NodePath_Str(1..Last1), (1=> Append_Attributes)); else Node_Management.Open (Node_Handle, Node_Management.Base_Path(NodePath_Str(1..Last1)), (1=> Write_Relationships)); end if; -- Get attribute names and values repeatedly -- and create either node or path attributes. ADD_ATTRIB: loop New_Line; Put (" Give NAME (or QUIT): "); Get_Line (Attrib_Name, Last2); exit ADD_ATTRIB when (Attrib_Name(1..4) = "quit") or (Attrib_Name(1..4) = "QUIT"); Put (" Give VALUE: "); Get_Line (Attrib_Val_Str, Last3); -- Convert attribute value from string to list type. List_Utilities.Copy (Attrib_Val_Lst, List_Utilities.Empty_List); String_To_Simple_List(Attrib_Val_Str(1..Last3), Temp_Lst_Item); List_Utilities.Insert (Attrib_Val_Lst, Temp_Lst_Item, Attrib_Name(1..Last2), Position => 0); -- Now have all parameters to create an attribute. if Node_or_Path = NODE then Attributes.Create_Node_Attribute (Node_Handle, Attrib_Name(1..Last2), Attrib_Val_Lst); else Attributes.Create_Path_Attribute (Node_Handle, Node_Management.Last_Key(NodePath_Str(1..Last1)), Node_Management.Last_Relation(NodePath_Str(1..Last1)), Attrib_Name(1..Last2), Attrib_Val_Lst); end if; end loop ADD_ATTRIB; exception when Node_Definitions.Status_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Status error raised while creating ***"); Put_Line("*** attributes; node handle is not open. ***"); else Put_Line("*** Status error raised while opening ***"); Put_Line("*** a node handle; node handle is ***"); Put_Line("*** already open or base is not an ***"); Put_Line("*** open node handle. ***"); end if; when Node_Definitions.Use_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Use error raised while creating ***"); Put_Line("*** attributes; attribute is predefined, ***"); Put_Line("*** already exists, or is syntactically ***"); Put_Line("*** illegal. ***"); New_Line; Put_Line("Note: Use Change_Attributes tool if "); Put_Line(" attribute already exists."); else Put_Line("*** Use error raised while opening ***"); Put_Line("*** a node handle; specified intent ***"); Put_Line("*** is an empty array. ***"); end if; when Node_Definitions.Intent_Violation => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Intent violation raised while creating ***"); Put_Line("*** attributes; node not opened with the ***"); Put_Line("*** intent to append attributes or ***"); Put_Line("*** write relationships. ***"); else Put_Line("*** Intent violation raised while opening ***"); Put_Line("*** a node handle; base is not open with ***"); Put_Line("*** the intent to read relationships. ***"); end if; when Node_Definitions.Name_Error => New_Line; Put_Line("*** Name error raised while opening a node ***"); Put_Line("*** handle; pathname is syntactically illegal ***"); Put_Line("*** or some node in path is unobtainable, ***"); Put_Line("*** inaccessible or non-existent. ***"); New_Line; when Node_Definitions.Security_Violation => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Security violation raised while ***"); Put_Line("*** creating attributes. ***"); else Put_Line("*** Security violation raised while ***"); Put_Line("*** opening a node handle. ***"); end if; when Node_Definitions.Lock_Error | Node_Definitions.Access_Violation => New_Line; Put_Line("*** Lock error or access violation ***"); Put_Line("*** raised while opening a node handle. ***"); end CAIS_EXCEPTIONS; Node_Management.Close(Node_Handle); end loop EACH_NODE_OR_PATH; New_Line; Put_Line ("COMPLETED."); New_Line; exception when others => New_Line; Put_Line ("*** Unhandled exception ***"); New_Line; raise; end Add_Attributes; ---------------------------------------------------------------------- -- CHANGE_ATTRIBUTES -- -- -- CAIS tool to change attributes of a node or path -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Jul 10 15:20:23 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- -- This tool changes any number of user-specified attributes of given -- nodes or paths. The tool loops through nodes/paths and attributes -- until the user enters "quit." procedure Change_Attributes is use Attributes; use List_Utilities; use Node_Definitions; use Node_Management; type Response is (NODE, PATH, QUIT); Node_or_Path : Response; Valid_Response : Boolean := False; Node_Handle : Node_Definitions.Node_Type; NodePath_Str : Node_Definitions.Name_String (1..80); -- Arbitrary # Attrib_Name : Attributes.Attribute_Name (1..80); -- Arbitrary # Attrib_Val_Str : String (1..80); -- Arbitrary # Last1, Last2, Last3 : Natural; Temp_Lst_Item : List_Utilities.List_Type; Attrib_Val_Lst : List_Utilities.List_Type; package Response_IO is new Enumeration_IO (Response); Use Response_IO; procedure String_To_Simple_List ( Str : String; List : in out List_Type) is Offset : Integer; Tmp_List : List_Type; begin Offset := Last_Non_Space (Str); Copy (List, EMPTY_LIST); Copy (Tmp_List, EMPTY_LIST); String_Items.Insert (List => Tmp_List, List_Item => Str (Str'first .. Offset), Position => 0); Insert (List => List, List_Item => Tmp_List, Position => 0); end String_To_Simple_List; begin New_Line; Put_Line ("CHANGING ATTRIBUTES"); -- Loop for each node or path until user enters "quit." EACH_NODE_OR_PATH: loop -- Determine whether user wants to add node or path attributes. New_Line; while not Valid_Response loop Put("NODE, PATH, or QUIT? "); GET_RESPONSE: begin Get(Node_or_Path); Skip_Line (Standard_Input); exit EACH_NODE_OR_PATH when (Node_or_Path = QUIT); Valid_Response := True; exception when Data_Error => Skip_Line (Standard_Input); Put(Ascii.Bel); Put_Line("Valid responses are NODE, PATH, or QUIT."); New_Line; end GET_RESPONSE; end loop; Valid_Response := False; -- Get Node or Path string. if Node_or_Path = NODE then Put ("Give NODE (or QUIT): "); else Put("Give PATH (or QUIT): "); end if; Get_Line (NodePath_Str, Last1); exit EACH_NODE_OR_PATH when (NodePath_Str(1..4) = "quit") or (NodePath_Str(1..4) = "QUIT"); CAIS_EXCEPTIONS: begin -- Obtain an open node handle. if Node_or_Path = NODE then Node_Management.Open (Node_Handle, NodePath_Str(1..Last1), (1=> Write_Attributes)); else Node_Management.Open (Node_Handle, Node_Management.Base_Path(NodePath_Str(1..Last1)), (1=> Write_Relationships)); end if; -- Get attribute names and values repeatedly -- and set either node or path attributes. CHG_ATTRIB: loop New_Line; Put (" Give NAME (or QUIT): "); Get_Line (Attrib_Name, Last2); exit CHG_ATTRIB when (Attrib_Name(1..4) = "quit") or (Attrib_Name(1..4) = "QUIT"); Put (" Give VALUE: "); Get_Line (Attrib_Val_Str, Last3); -- Convert attribute value from string to list type. List_Utilities.Copy (Attrib_Val_Lst, List_Utilities.Empty_List); String_To_Simple_List(Attrib_Val_Str(1..Last3), Temp_Lst_Item); List_Utilities.Insert (Attrib_Val_Lst, Temp_Lst_Item, Attrib_Name(1..Last2), Position => 0); -- Now have all parameters to set an attribute. if Node_or_Path = NODE then Attributes.Set_Node_Attribute (Node_Handle, Attrib_Name(1..Last2), Attrib_Val_Lst); else Attributes.Set_Path_Attribute (Node_Handle, Node_Management.Last_Key(NodePath_Str(1..Last1)), Node_Management.Last_Relation(NodePath_Str(1..Last1)), Attrib_Name(1..Last2), Attrib_Val_Lst); end if; end loop CHG_ATTRIB; exception when Node_Definitions.Status_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Status error raised while setting ***"); Put_Line("*** attributes; node handle is not open. ***"); else Put_Line("*** Status error raised while opening ***"); Put_Line("*** a node handle; node handle is ***"); Put_Line("*** already open or base is not an ***"); Put_Line("*** open node handle. ***"); end if; when Node_Definitions.Use_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Use error raised while setting ***"); Put_Line("*** attributes; attribute does not exist ***"); Put_Line("*** or is predefined and cannot be modified ***"); Put_Line("*** by user. ***"); New_Line; else Put_Line("*** Use error raised while opening ***"); Put_Line("*** a node handle; specified intent ***"); Put_Line("*** is an empty array. ***"); end if; when Node_Definitions.Intent_Violation => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Intent violation raised while setting ***"); Put_Line("*** attributes; node not opened with the ***"); Put_Line("*** intent to write attributes or ***"); Put_Line("*** relationships. ***"); else Put_Line("*** Intent violation raised while opening ***"); Put_Line("*** a node handle; base is not open with ***"); Put_Line("*** the intent to read relationships. ***"); end if; when Node_Definitions.Name_Error => New_Line; Put_Line("*** Name error raised while opening a node ***"); Put_Line("*** handle; pathname is syntactically illegal ***"); Put_Line("*** or some node in path is unobtainable, ***"); Put_Line("*** inaccessible or non-existent. ***"); when Node_Definitions.Security_Violation => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Security violation raised while ***"); Put_Line("*** setting attributes. ***"); else Put_Line("*** Security violation raised while ***"); Put_Line("*** opening a node handle. ***"); end if; when Node_Definitions.Lock_Error | Node_Definitions.Access_Violation => New_Line; Put_Line("*** Lock error or access violation ***"); Put_Line("*** raised while opening a node handle. ***"); end CAIS_EXCEPTIONS; Node_Management.Close(Node_Handle); end loop EACH_NODE_OR_PATH; New_Line; Put_Line ("COMPLETED."); New_Line; exception when others => New_Line; Put_Line ("*** Unhandled exception ***"); New_Line; raise; end Change_Attributes; ----------------------------------------------------------------- -- Create_file_nodes -- -- This procedure creates the primary relationship to -- a file node identified by NODE. -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- Mon Jul 29 16:02:45 EDT 1985 -- -- (Unclassified and Uncopyrighted) -- ----------------------------------------------------------------- procedure Create_File_Nodes is use Node_Definitions; use Node_Management; use List_Utilities; Node : Node_Definitions.Node_Type; File : Io_Definitions.File_Type; Node_Str : Node_Definitions.Name_String(1..100); Intents : Node_Definitions.Intention(1..2) := (1 => Exclusive_Write, 2 => Read_Relationships); Last : Natural; Attr_String : Name_String(1..Pragmatics.Max_Name_String); Last_Attr : Natural; Attr_List : List_Type; begin New_Line; Put_Line ("CREATING FILE NODES"); GET_NODE: loop New_Line; Put ("Give NODE (or ! to quit) =>"); Get_Line (Node_Str, Last); exit GET_NODE when (Last = 1 and Node_Str(1) = '!'); Put_Line ("Enter Node Attributes (One Line, <= 256 characters);"); Put_Line (" Include File_Kind and Access_Method to change defaults."); Put ("> "); Get_Line (Attr_String, Last_Attr); To_List (Attr_String(1..Last_Attr), Attr_List); CAIS_CALLS: begin Cais.Text_Io.Create (File, Node_Str(1..Last), Attributes => Attr_List); Cais.Text_Io.Close (File); exception when Node_Definitions.Name_Error => New_Line; Put_Line("*** Node is inaccessible ***"); New_Line; when Node_Definitions.Status_Error => New_Line; Put_Line("*** Open status is incorrect ***"); New_Line; when Security_Violation => New_Line; Put_Line("*** SECURITY VIOLATION ***"); New_Line; end CAIS_CALLS; end loop GET_NODE; New_Line; Put_Line("CREATE_FILE_NODES COMPLETE"); New_Line; exception when others => New_Line; Put_Line("*** UNHANDLED EXCEPTION ***"); New_Line; raise; end Create_File_Nodes; ---------------------------------------------------------------------- -- CREATE_STRUC_NODES -- -- -- CAIS tool to create structural nodes -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Fri Jun 21 14:27:35 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- -- This tool creates structural nodes as specified -- by the user. Any number of nodes can be created until the user -- enters "quit." This tool does not set attributes, access control, -- or level. procedure Create_Struc_Nodes is use Node_Definitions; use Node_Management; use Structural_Nodes; Path_Str : Node_Definitions.Name_String (1..80); -- Arbitrary # Last : Natural; begin New_Line; Put_Line ("CREATING STRUCTURAL NODES"); -- Loop for each node until user enters "quit." EACH_NODE: loop -- Get node's pathname string. Put("Give PATH (or QUIT): "); Get_Line (Path_Str, Last); New_Line; exit EACH_NODE when (Path_Str(1..4) = "quit") or (Path_Str(1..4) = "QUIT"); CAIS_EXCEPTIONS: begin Structural_Nodes.Create_Node(Path_Str(1..Last)); exception when Node_Definitions.Status_Error => New_Line; Put_Line("*** Status error raised while creating ***"); Put_Line("*** a node; base is not open or node ***"); Put_Line("*** is already open. ***"); when Node_Definitions.Use_Error => New_Line; Put_Line("*** Use error raised while creating ***"); Put_Line("*** a node; parameters are illegal, ***"); Put_Line("*** attributes are predefined, or ***"); Put_Line("*** relation cannot be created by user.***"); when Node_Definitions.Intent_Violation => New_Line; Put_Line("*** Intent violation raised while ***"); Put_Line("*** creating a node; base not open ***"); Put_Line("*** with intent to append ***"); Put_Line("*** relationships. ***"); when Node_Definitions.Name_Error => New_Line; Put_Line("*** Name error raised while creating ***"); Put_Line("*** a node; node already exists, is ***"); Put_Line("*** syntactically illegal as specified, ***"); Put_Line("*** or is unobtainable due to access ***"); Put_Line("*** control. ***"); when Node_Definitions.Security_Violation => New_Line; Put_Line("*** Security violation raised while ***"); Put_Line("*** creating a node. ***"); end CAIS_EXCEPTIONS; end loop EACH_NODE; New_Line; Put_Line ("COMPLETED."); New_Line; exception when others => New_Line; Put_Line ("*** Unhandled exception ***"); New_Line; raise; end Create_Struc_Nodes; ----------------------------------------------------------------------------- -- DELETE_ATTRIBUTES -- -- -- CAIS tool to delete selected attributes of a node or path. -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Jun 19 15:44:40 EDT 1985 -- -- (Unclassified and Uncopyrighted) -- -- ------------------------------------------------------------------------------ procedure Delete_Attributes is use Attributes; use Node_Definitions; use Node_Management; type Response is (NODE, PATH, QUIT); Node_or_Path : Response; Valid_Response : Boolean := False; Node_Handle : Node_Definitions.Node_Type; NodePath_Str : Node_Definitions.Name_String(1..80); --Arbitrary Attrib_Name : Attributes.Attribute_Name(1..80); --Arbitrary Last1, Last2 : Natural; package Response_IO is new Enumeration_IO(Response); Use Response_IO; begin New_Line; Put_Line("DELETING ATTRIBUTES"); -- Loop for each node or path until user enters "quit." EACH_NODE_OR_PATH: loop -- Determine whether user wants to delete node or path attributes. New_Line; while not Valid_Response loop Put("NODE, PATH, or QUIT? "); GET_RESPONSE: begin Get(Node_or_Path); Skip_Line(Standard_Input); exit EACH_NODE_OR_PATH when (Node_or_Path = QUIT); Valid_Response := True; exception when Data_Error => Skip_Line(Standard_Input); Put(Ascii.Bel); Put_Line("Valid responses are NODE, PATH, or QUIT"); New_Line; end GET_RESPONSE; end loop; Valid_Response := False; -- Get node or path string. if Node_or_Path = NODE then Put("Give NODE (or QUIT): "); else Put("Give PATH (or QUIT): "); end if; Get_Line(NodePath_Str, Last1); exit EACH_NODE_OR_PATH when (NodePath_Str(1..4) = "quit") or (NodePath_Str(1..4) = "QUIT"); New_Line; CAIS_EXCEPTIONS: begin -- Obtain an open node handle. if Node_or_Path = NODE then Node_Management.Open (Node_Handle, NodePath_Str(1..Last1), (1=> Write_Attributes)); else Node_Management.Open (Node_Handle, Node_Management.Base_Path(NodePath_Str(1..Last1)), (1=> Write_Relationships)); end if; -- Loop through attributes to be deleted. DEL_ATTRIB: loop Put(" Give NAME (or QUIT): "); Get_Line(Attrib_Name, Last2); exit DEL_ATTRIB when (Attrib_Name(1..4) = "quit") or (Attrib_Name(1..4) = "QUIT"); if Node_or_Path = NODE then Attributes.Delete_Node_Attribute (Node_Handle, Attrib_Name(1..Last2)); else Attributes.Delete_Path_Attribute (Node_Handle, Last_Key(NodePath_Str(1..Last1)), Last_Relation(NodePath_Str(1..Last1)), Attrib_Name(1..Last2)); end if; end loop DEL_ATTRIB; exception when Node_Definitions.Status_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Status error raised while deleting ***"); Put_Line("*** attributes; node handle is not open. ***"); else Put_Line("*** Status error raised while opening ***"); Put_Line("*** a node handle; node handle is ***"); Put_Line("*** already open or base is not an ***"); Put_Line("*** open node handle. ***"); end if; New_Line; when Node_Definitions.Use_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Use error raised while deleting ***"); Put_Line("*** attributes; attribute does not exist ***"); Put_Line("*** or is predefined and can not be ***"); Put_Line("*** modified by user. ***"); New_Line; else Put_Line("*** Use error raised while opening ***"); Put_Line("*** a node handle; specified intent ***"); Put_Line("*** is an empty array. ***"); end if; New_Line; when Node_Definitions.Intent_Violation => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Intent violation raised while deleting ***"); Put_Line("*** attributes; node not opened with the ***"); Put_Line("*** intent to write attributes or ***"); Put_Line("*** relationships. ***"); else Put_Line("*** Intent violation raised while opening ***"); Put_Line("*** a node handle; base is not open with ***"); Put_Line("*** the intent to read relationships. ***"); end if; New_Line; when Node_Definitions.Name_Error => New_Line; Put_Line("*** Name error raised while opening a node ***"); Put_Line("*** handle; pathname is syntactically illegal ***"); Put_Line("*** or some node in path is unobtainable, ***"); Put_Line("*** inaccessible or non-existent. ***"); New_Line; when Node_Definitions.Security_Violation => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Security violation raised while ***"); Put_Line("*** deleting attributes. ***"); else Put_Line("*** Security violation raised while ***"); Put_Line("*** opening a node handle. ***"); end if; New_Line; when Node_Definitions.Lock_Error | Node_Definitions.Access_Violation => New_Line; Put_Line("*** Lock error or access violation ***"); Put_Line("*** raised while opening a node handle. ***"); New_line; end CAIS_EXCEPTIONS; Node_Management.Close(Node_Handle); end loop EACH_NODE_OR_PATH; New_Line; Put_Line("COMPLETED."); New_Line; exception when others => New_Line; Put_Line("*** Unhandled exception ***"); raise; end Delete_Attributes; ---------------------------------------------------------------------- -- DELETE_NODES -- -- -- CAIS tool to delete structural or file nodes -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Fri Jun 21 14:27:35 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- -- This tool deletes either structural or file nodes as specified -- by the user. Any number of nodes can be deleted until the user -- enters "quit." procedure Delete_Nodes is use Node_Definitions; use Node_Management; Node : Node_Definitions.Node_Type; Node_Str : Node_Definitions.Name_String (1..80); -- Arbitrary # Last : Natural; begin New_Line; Put_Line ("DELETING NODES"); New_Line; -- Loop for each node until user enters "quit." EACH_NODE: loop -- Get node string. Put("Give NODE (or QUIT): "); Get_Line (Node_Str, Last); New_Line; exit EACH_NODE when (Node_Str(1..4) = "quit") or (Node_Str(1..4) = "QUIT"); CAIS_EXCEPTIONS: begin Node_Management.Open (Node, Node_Str(1..Last), (Exclusive_Write, Read_Relationships)); Node_Management.Delete_Node(Node); -- Do not have to distinguish between a structural vs. -- file node since either can be deleted this way. Do -- not have an open file handle so do not need to use -- Cais_Text_IO.Delete. exception when Node_Definitions.Name_Error => New_Line; Put_Line("*** Name error raised while deleting ***"); Put_Line("*** a node; parent of node is ***"); Put_Line("*** inaccessible. ***"); when Node_Definitions.Status_Error => New_Line; Put_Line("*** Status error raised while deleting ***"); Put_Line("*** a node; node handle is not open. ***"); when Node_Definitions.Use_Error => New_Line; Put_Line("*** Use error raised while deleting ***"); Put_Line("*** a node; primary relationships ***"); Put_Line("*** emanate from node. ***"); when Node_Definitions.Intent_Violation => New_Line; Put_Line("*** Intent violation raised while ***"); Put_Line("*** deleting a node; node not open ***"); Put_Line("*** with intent exclusive write and ***"); Put_Line("*** read relationships. ***"); when Node_Definitions.Lock_Error => New_Line; Put_Line("*** Lock error raised while deleting ***"); Put_Line("*** a node. ***"); when Node_Definitions.Security_Violation => New_Line; Put_Line("*** Security violation raised while ***"); Put_Line("*** deleting a node. ***"); when Node_Definitions.Access_Violation => New_Line; Put_Line("*** Access violation raised while ***"); Put_Line("*** deleting a node. ***"); end CAIS_EXCEPTIONS; end loop EACH_NODE; New_Line; Put_Line ("COMPLETED."); New_Line; exception when others => New_Line; Put_Line ("*** Unhandled exception ***"); New_Line; raise; end Delete_Nodes; ---------------------------------------------------------------------- -- DIRECTORY -- -- -- CAIS tool to list all targets of relationships -- emanating from a given node. -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Tue Jun 25 11:23:07 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- procedure Directory is use Node_Definitions; use Node_Management; Node, Next_Node : Node_Definitions.Node_Type; Node_Str : Node_Definitions.Name_String(1..100); -- Arbitrary #. Relationship_Str : String(1..80); Relationship_Flag : Boolean; Kind : Node_Kind; Last1, Last2, Last3 : Natural; Iterator : Node_Management.Node_Iterator; package Enum_Io is new Enumeration_IO(Node_Kind); use Enum_Io; begin New_Line; Put_Line ("DIRECTORY:"); -- Loop for each node until user enters "quit." EACH_NODE: loop New_Line; Put ("Give NODE (or QUIT): "); Get_Line (Node_Str, Last1); exit EACH_NODE when (Node_Str(1..4) = "quit") or (Node_Str(1..4) = "QUIT"); Put("Give PRIMARY or SECONDARY: "); Get_Line(Relationship_Str, Last2); if Relationship_Str(1..Last2) = "SECONDARY" or Relationship_Str(1..Last2) = "secondary" then Relationship_Flag := False; else Relationship_Flag := True; end if; Put("Give FILE or STRUCTURAL: "); Enum_Io.Get(Kind); Skip_Line(Standard_Input); New_Line; CAIS_EXCEPTIONS: begin Node_Management.Open (Node, Node_Str(1..Last1), (1=> Read_Relationships)); Node_Management.Iterate (Iterator, Node, Kind, Primary_Only=> Relationship_Flag); while Node_Management.More (Iterator) loop Node_Management.Get_Next (Iterator, Next_Node); Put(" " & Path_Relation(Next_Node)); Put("("); Put(Path_Key(Next_Node)); Put_Line(")"); end loop; exception when Node_Definitions.Status_Error => New_Line; if Node_Management.Is_Open(Node) then Put_Line("*** Status error raised while iterating ***"); Put_Line("*** nodes or finding relations/keys; ***"); Put_Line("*** node handle is not open. ***"); else Put_Line("*** Status error raised while opening ***"); Put_Line("*** a node handle; node handle is ***"); Put_Line("*** already open or base is not an ***"); Put_Line("*** open node handle. ***"); end if; New_Line; when Node_Definitions.Use_Error => New_Line; if Node_Management.Is_Open(Node) then Put_Line("*** Use error raised while iterating nodes; ***"); Put_Line("*** relation/key are syntactically illegal. ***"); New_Line; else Put_Line("*** Use error raised while opening ***"); Put_Line("*** a node handle; specified intent ***"); Put_Line("*** is an empty array. ***"); end if; New_Line; when Node_Definitions.Intent_Violation => New_Line; if Node_Management.Is_Open(Node) then Put_Line("*** Intent violation raised while iterating ***"); Put_Line("*** nodes; node not opened with the intent ***"); Put_Line("*** to read relationships. ***"); else Put_Line("*** Intent violation raised while opening ***"); Put_Line("*** a node handle; base is not open with ***"); Put_Line("*** the intent to read relationships. ***"); end if; New_Line; when Node_Definitions.Name_Error => New_Line; if Node_Management.Is_Open(Node) then Put_Line("*** Name error raised while iterating ***"); Put_Line("*** nodes; next node is unobtainable ***"); Put_Line("*** and intent is not existence. ***"); else Put_Line("*** Name error raised while opening a ***"); Put_Line("*** node handle; pathname is syntac- ***"); Put_Line("*** tically illegal or some node in ***"); Put_Line("*** path is unobtainable, inaccessible ***"); Put_Line("*** or non-existent. ***"); end if; New_Line; when Node_Definitions.Security_Violation => New_Line; if Node_Management.Is_Open(Node) then Put_Line("*** Security violation raised while ***"); Put_Line("*** iterating nodes. ***"); else Put_Line("*** Security violation raised while ***"); Put_Line("*** opening a node handle. ***"); end if; New_Line; when Node_Definitions.Lock_Error => New_Line; if Node_Management.Is_Open(Node) then Put_Line("*** Lock error raised while iterating nodes.***"); else Put_Line("*** Lock error raised while opening a ***"); Put_Line("*** node handle. ***"); end if; New_Line; when Node_Definitions.Access_Violation => New_Line; if Node_Management.Is_Open(Node) then Put_Line("*** Access violation raised while ***"); Put_Line("*** iterating nodes. ***"); else Put_Line("*** Lock error raised while opening a ***"); Put_Line("*** node handle. ***"); end if; New_Line; end CAIS_EXCEPTIONS; Node_Management.Close (Node); end loop EACH_NODE; New_Line; Put_Line ("COMPLETED."); New_Line; exception when others => New_Line; Put_Line ("*** Unhandled exception ***"); New_Line; raise; end Directory; procedure Import_Export is use Node_Management; use Io_Definitions; use Node_Definitions; use File_Import_Export; use Pragmatics; type Response is (IMPORT, EXPORT, QUIT); Import_or_Export : Response; Valid_Response : Boolean :=False; Cais_File : Cais.Text_IO.File_Type; Node : Node_Definitions.Node_Type; Node_Name : Node_Definitions.Name_String (1..Pragmatics.Max_Name_String); Node_Last : Natural; Host_File : Cais.Text_IO.File_Type; File_Name : String(1..80); File_Last : Natural; Text_Line : String(1..256); Line_Length : Natural; package Response_IO is new Enumeration_IO(Response); use Response_IO; begin New_Line; Put_Line("TESTING FILE IMPORT AND EXPORT"); EACH_FILE_IO: loop New_Line; Valid_Response := False; while not Valid_Response loop Put("IMPORT, EXPORT, OR QUIT: "); GET_RESPONSE: begin Get(Import_or_Export); exit EACH_FILE_IO when (Import_or_Export = Quit); Valid_Response := True; exception when Text_Io.Data_Error => Put(Ascii.Bel); Put_Line("You may IMPORT, EXPORT or QUIT"); New_Line; end GET_RESPONSE; end loop; Skip_Line(Standard_Input); Put("Give NODE (or QUIT): "); Get_Line(Node_Name,Node_Last); New_Line; exit EACH_FILE_IO when (Node_Name(1..4) = "quit") or (Node_Name(1..4) = "QUIT"); Put("Give FILE (or QUIT): "); Get_Line(File_Name,File_Last); New_Line; exit EACH_FILE_IO when (File_Name(1..4) = "quit") or (File_Name(1..4) = "QUIT"); CAIS_EXCEPTIONS: begin if Import_or_Export = Import then Node_Management.Open(Node, Node_Name(1..Node_Last), (1 => Write_Contents)); Import (Node, File_Name(1..File_Last)); Node_Management.Close (Node); end if; if Import_or_Export = Export then Node_Management.Open(Node, Node_Name(1..Node_Last), (1 => Read_Contents)); Export (Node, File_Name(1..File_Last)); Node_Management.Close (Node); end if; exception when Node_Definitions.Name_Error => New_Line; if not Node_Management.Is_Obtainable(Node) then Put_Line("*** Name error raised while file import/ ***"); Put_Line("*** export; node identified by NODE is ***"); Put_Line("*** inaccessible. ***"); end if; New_Line; when Node_Definitions.Use_Error => New_Line; Put_Line("*** Use error raised while file import/export ***"); Put_Line("*** Host File Name does not adhere to the ***"); Put_Line("*** required syntax for file names in the ***"); Put_Line("*** host file system or the Host File Name ***"); Put_Line("*** does not exist in the Host File System. ***"); Put_Line("*** Also, FILE may not be the value of the ***"); Put_Line("*** attribute KIND of the node identified ***"); Put_Line("*** by NODE. ***"); New_Line; when Node_Definitions.Status_Error => New_Line; if not Node_Management.Is_Open(Node) then Put_Line("*** Status error raised while file import/ ***"); Put_Line("*** export; node handle is not open. ***"); end if; New_Line; when Node_Definitions.Intent_Violation => New_Line; Put_Line("*** Intent violation raised while file import/ ***"); Put_Line("*** export; NODE was not opened with an intent ***"); Put_Line("*** establishing the right to write contents. ***"); New_Line; when Node_Definitions.Lock_Error|Node_Definitions.Access_Violation| Node_Definitions.Security_Violation => New_Line; Put_Line("*** Lock error, access violation or security ***"); Put_Line("*** violation raised while opening a node ***"); Put_Line("*** handle. ***"); New_Line; end CAIS_EXCEPTIONS; end loop EACH_FILE_IO; Put_Line("*** File Import/Export => Complete ***"); New_Line; exception when others => New_Line; Put_Line("*** Unhandled exception ***"); New_Line; raise; end Import_Export; ---------------------------------------------------------------------- -- LIST_ATTRIBUTES -- -- -- CAIS tool to list all attributes of a node or path -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Jun 19 09:59:37 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- -- This tool lists all attribute names and values for user-specified -- nodes or paths. The tool loops through nodes/paths until the user -- enters "quit." procedure List_Attributes is use Attributes; use List_Utilities; use Node_Definitions; use Node_Management; type Response is (NODE, PATH, QUIT); Node_or_Path : Response; Valid_Response : Boolean := False; Node_Handle : Node_Definitions.Node_Type; NodePath_Str : Node_Definitions.Name_String (1..80); -- Arbitrary # Last : Natural; Attrib_Iterator : Attributes.Attribute_Iterator; Attrib_Name : Attributes.Attribute_Name(1..80); -- Arbitrary # Attrib_Val : List_Utilities.List_Type; Attrib_Val_Item : List_Utilities.List_Type; package Response_IO is new Enumeration_IO(Response); use Response_IO; begin New_Line; Put_Line ("LISTING ATTRIBUTES"); -- Loop for each node or path until user enters "quit." EACH_NODE_OR_PATH: loop -- Determine whether user wants to add node or path attributes. New_Line; while not Valid_Response loop Put("NODE, PATH, or QUIT? "); GET_RESPONSE: begin Get(Node_or_Path); Skip_Line(Standard_Input); exit EACH_NODE_OR_PATH when (Node_or_Path = QUIT); Valid_Response := True; exception when Data_Error => Skip_Line(Standard_Input); Put(Ascii.Bel); Put_Line("Valid responses are NODE, PATH, or QUIT."); New_Line; end GET_RESPONSE; end loop; Valid_Response := False; -- Get node or path string. if Node_or_Path = NODE then Put("Give NODE (or QUIT): "); else Put("Give PATH (or QUIT): "); end if; Get_Line (NodePath_Str, Last); New_Line; exit EACH_NODE_OR_PATH when (NodePath_Str(1..4) = "quit") or (NodePath_Str(1..4) = "QUIT"); CAIS_EXCEPTIONS: begin -- Obtain an open node handle and attribute iterator. if Node_or_Path = NODE then Node_Management.Open (Node_Handle, NodePath_Str(1..Last), (1=> Read_Attributes)); Attributes.Node_Attribute_Iterate (Attrib_Iterator, Node_Handle); else Node_Management.Open (Node_Handle, Base_Path(NodePath_Str(1..Last)), (1=> Read_Relationships)); Attributes.Path_Attribute_Iterate (Attrib_Iterator, Node_Handle, Last_Key(NodePath_Str(1..Last)), Last_Relation(NodePath_Str(1..Last))); end if; -- Loop through attributes printing names and values. while Attributes.More (Attrib_Iterator) loop Attributes.Get_Next (Attrib_Iterator, Attrib_Name, Attrib_Val); Last := Character_Set.Last_Non_Space(Attrib_Name); Put (" "); Put (Attrib_Name (1..Last)); Put (" => "); if List_Utilities.Get_List_Kind(Attrib_Val) = Named then -- Pull attribute value item from list. List_Utilities.Extract (Attrib_Val, Attrib_Name(1..Last), Attrib_Val_Item); Put (List_Utilities.To_Text (Attrib_Val_Item)); else Put(List_Utilities.To_Text(Attrib_Val)); end if; New_Line; end loop; exception when Node_Definitions.Status_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Status error raised while iterating ***"); Put_Line("*** attributes; node handle is not open. ***"); else Put_Line("*** Status error raised while opening ***"); Put_Line("*** a node handle; node handle is ***"); Put_Line("*** already open or base is not an ***"); Put_Line("*** open node handle. ***"); end if; when Node_Definitions.Use_Error => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Use error raised while iterating ***"); Put_Line("*** attributes; probably a syntactically ***"); Put_Line("*** illegal pattern. ***"); else Put_Line("*** Use error raised while opening ***"); Put_Line("*** a node handle; specified intent ***"); Put_Line("*** is an empty array. ***"); end if; when Node_Definitions.Intent_Violation => New_Line; if Node_Management.Is_Open(Node_Handle) then Put_Line("*** Intent violation raised while iterating ***"); Put_Line("*** attributes; node not opened with the ***"); Put_Line("*** intent to read attributes/relationships.***"); else Put_Line("*** Intent violation raised while opening ***"); Put_Line("*** a node handle; base is not open with ***"); Put_Line("*** the intent to read relationships. ***"); end if; when Node_Definitions.Name_Error => New_Line; Put_Line("*** Name error raised while opening a node ***"); Put_Line("*** handle; pathname is syntactically illegal ***"); Put_Line("*** or some node in path is unobtainable, ***"); Put_Line("*** inaccessible or non-existent. ***"); when Node_Definitions.Lock_Error|Node_Definitions.Access_Violation| Node_Definitions.Security_Violation => New_Line; Put_Line("*** Lock error, access violation, or security ***"); Put_Line("*** violation raised while opening a node ***"); Put_Line("*** handle. ***"); end CAIS_EXCEPTIONS; Node_Management.Close (Node_Handle); end loop EACH_NODE_OR_PATH; New_Line; Put_Line ("COMPLETED."); New_Line; exception when others => New_Line; Put_Line ("*** Unhandled exception ***"); New_Line; raise; end List_Attributes; begin loop New_Line; New_Line; Put_Line("1. Add_Attributes 2. Change_Attributes 3. Create_File_Nodes"); Put_Line("4. Delete_Nodes 5. Import_Export 6. Create_Struc_Nodes"); Put_Line("7. Directory 8. Delete_Attributes 9. List_Attributes"); Put("ENTER COMMAND NUMBER (0 to QUIT): "); Get_Line(Line, Last); if Last > 0 and then Line(1) in '0'..'9' then case Line(1) is when '0' => exit; when '1' => Add_Attributes; when '2' => Change_Attributes; when '3' => Create_File_Nodes; when '4' => Delete_Nodes; when '5' => Import_Export; when '6' => Create_Struc_Nodes; when '7' => Directory; when '8' => Delete_Attributes; when '9' => List_Attributes; when others => exit; end case; else exit; end if; end loop; end Cais_Commandos; --:::::::::::::: --copytree_test.a --:::::::::::::: with Cais; Use Cais; with Text_Io; use Text_Io; procedure Copytree_Test is use Node_Definitions; use Node_Management; Node : Cais.Node_Type; Node1 : Cais.Node_Type; Node2 : Cais.Node_Type; Node3 : Cais.Node_Type; procedure Myplant is use Cais.node_management; use Cais.node_definitions; Node : Cais.Node_Type; Node1 : Cais.Node_Type; Node2 : Cais.Node_Type; Node3 : Cais.Node_Type; Node4 : Cais.Node_Type; Node5 : Cais.Node_Type; Node6 : Cais.Node_Type; File : Cais.Text_Io.File_Type; begin Put_Line("CREATE --TREE"); Cais.Structural_Nodes.Create_Node(Node, Name=>"'current_user.Nowalk"); Close(Node); Open(Node, "'current_user.Nowalk", (1=>read_relationships, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john"); Cais.Structural_Nodes.Create_Node(Node1, Node, "john", "dot" ); Close(Node1); Open(Node1, Node, "john","dot", (1=>read_relationships, 2=>append_relationships)); Put_Line("huzzah"); Put_Line("CREATE --Nowalk.john.johnjr"); Cais.Text_Io.Create(File, Node1, "johnjr", "dot" ); Cais.Text_Io.Close(File); Open(Node2, Node1, "johnjr","dot", (1=>read_relationships, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john.will"); Cais.Text_Io.Create(File, Node1, "will", "dot" ); Cais.Text_Io.Close(File); Open(Node6, Node1, "will","dot", (1=>read_relationships, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john.johnjr.mike"); Cais.Text_Io.Create(File, Node2, "mike", "dot" ); Cais.Text_Io.Close(File); Open(Node5, Node2, "mike","dot", (1=>read_relationships, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john.johnjr.mark"); Cais.Text_Io.Create(File, Node2, "mark", "dot" ); Cais.Text_Io.Close(File); Open(Node3, Node2, "mark","dot", (1=>read_relationships, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john.johnjr.mark.mary"); Cais.Text_Io.Create(File, Node3, "mary", "dot" ); Cais.Text_Io.Close(File); Open(Node4, Node3, "mary","dot", (1=>read_relationships, 2=>append_relationships)); --Put in Secondary Uncle Links Link(Node5, Node4, "Mike", "uncle"); Link(Node6, Node3, "Will", "uncle"); Link(Node6, Node5, "Will", "uncle"); --Put in Secondary Sibling Links Link(Node5, Node3, "Mark", "sibling"); Link(Node3, Node5, "Mike", "sibling"); Link(Node6, Node2, "Will", "sibling"); Link(Node2, Node6, "Johnjr", "sibling"); --Put in Secondary Sibling Links Link(Node, Node1, "Nowalk", "clan"); Link(Node, Node2, "Nowalk", "clan"); Link(Node, Node3, "Nowalk", "clan"); Link(Node, Node4, "Nowalk", "clan"); Link(Node, Node5, "Nowalk", "clan"); Link(Node, Node6, "Nowalk", "clan"); --Put in Self Reference Link(Node4, Node4, "Me", "Self"); Put_Line("--TEST SETUP COMPLETED"); end Myplant; begin Myplant; Open(Node,"'current_user.Nowalk", (1=>read, 2=>append_relationships)); Put_Line("Nowalk is Open"); Open(Node1,"'current_user.Nowalk.john.johnjr.mark.mary", (1=>read, 2=>append_relationships)); Put_Line("Mary is Open"); Open(Node2,"'current_user.Nowalk.john", (1=>read, 2=>append_relationships)); Put_Line("john is Open"); Open(Node3,"'current_user.Nowalk.john.johnjr.mark", (1=>read, 2=>append_relationships, 3=>write_relationships)); Put_Line("Mark is Open"); Copy_Node(Node1, Node, "marie", "dot"); put_line("Nowalk.John.Johnjr.Mark.Mary COPIED TO Nowalk.Marie"); Copy_Tree(Node2, Node, "johann", "dot"); put_line("The TREE Nowalk.John COPIED TO Nowalk.Johann"); Rename(Node3, Node2, "mark", "dot"); put_line("The TREE Nowalk.John.Johnjr.Mark RENAMED TO Nowalk.John.Mark"); put_line("Verify by examining the resulting node files."); put_line("Then cleanup by running Nodetree_Cleanup!!! "); end Copytree_Test; --:::::::::::::: --existree_ex.a --:::::::::::::: -----------------------------N O D E T R E E _ E X--------------------------- -- Purpose: -- ------- -- This program runs exception tests for the subprogams in sections -- 7,8,9,17,18,19,20, and 22 of MIL-STD-CAIS 5.1.2. These routines -- provide information on the primary_name, provide access to the -- parent node, provide for copying and deleting trees, and provide -- for copying and renaming nodes. -- -- Tests for Lock_Error, Access_Violation, and Security_Violation -- are not included because these features are not yet implemented. -- -- In order to perform these tests, several nodes are created. Several -- nodes have strange properties, such as inaccessibility. The -- manner in which these properties have been created likely violates -- rules enforced by access_methods or locking_checks. Therefore, -- this program must be updated once these features are implemented. -- ------------------------------------------------------------------------------ with Cais; use Cais; with Text_Io; use Text_Io; procedure Existree_Ex is use Attributes; use List_Utilities; use Node_Management; use Node_Definitions; Exceptions_Tested : constant := 50; Failures : integer := 0; Line_Count : integer; Expected : string(1..3); Check_Inaccessibility : boolean; Inaccessible_Node : Cais.Node_Type; In_Traversed_Node : Cais.Node_Type; Closed_Node : Cais.Node_Type; Open_Node : Cais.Node_Type; Locked_Node : Cais.Node_Type; Impotent_Node : Cais.Node_Type; Hidden_Node : Cais.Node_Type; Process_Node : Cais.Node_Type; Top_Node : Cais.Node_Type; Living_Node : Cais.Node_Type; Offspring_Node : Cais.Node_Type; Parent : Cais.Node_Type; Temp_File : Cais.Text_Io.File_Type; Node : Cais.Node_Type; Node1 : Cais.Node_Type; Wait : string(1..100); Last : natural; No_Intent : Intention(1..2) := (Existence, read); Key : Relationship_Key(1..6) := "howell"; Relation : Relation_Name(1..4) := "user"; Null_List : List_Type; procedure Wrong_Exception(II: integer; SS: string) is begin Failures := Failures + 1; Line_Count := 10; new_line; put( integer'image(II) & ":**ERROR**" & " Received: " & SS & " Expected: " & Expected ); end Wrong_Exception; procedure No_Ex(Error: in string) is begin new_line; put(Error); Line_Count := 10; Failures := Failures + 1; end No_Ex; procedure Raise_Exception(II: integer ) is Text : Natural; String1 : string(1..3); Name1 : NameString(1..3); Iterator : Attribute_Iterator; Attribute : Attribute_Name(1..32); begin case II is --MIL STD 5.1.3.1 --not applicable --Access_Violation not checked --Lock_Error not checked when 1 => --MIL STD 5.1.2.7 if check_inaccessibility then Expected := "Nam"; Put_Line (Primary_Name(In_Traversed_Node) ); No_Ex(" 1***ERROR***Primary_Name: inaccessible"); end if; when 2 => Expected := "Sta"; Put_Line (Primary_Name(Closed_Node) ); No_Ex(" 2***ERROR***Primary_Name: not open"); when 3 => Expected := "Int"; Put_Line (Primary_Name(Impotent_Node) ); No_Ex(" 3***ERROR***Primary_Name: bad intent"); --Access_Violation not checked --Lock_Error not checked when 4 => --MIL STD 5.1.2.8 if check_inaccessibility then Expected := "Nam"; Put_Line (Primary_Key(In_Traversed_Node) ); No_Ex(" 4***ERROR***Primary_Key: inaccessible"); end if; when 5 => Expected := "Sta"; Put_Line (Primary_Key(Closed_Node) ); No_Ex(" 5***ERROR***Primary_Key: not open"); when 6 => Expected := "Int"; Put_Line (Primary_Key(Impotent_Node) ); No_Ex(" 6***ERROR***Primary_Key: bad intent"); --Access_Violation not checked --Lock_Error not checked when 7 => --MIL STD 5.1.2.9 if check_inaccessibility then Expected := "Nam"; Put_Line (Primary_Relation(In_Traversed_Node) ); No_Ex(" 7***ERROR***Primary_Relation: inaccessible"); end if; when 8 => Expected := "Sta"; Put_Line (Primary_Relation(Closed_Node) ); No_Ex(" 8***ERROR***Primary_Relation: not open"); when 9 => Expected := "Int"; Put_Line (Primary_Relation(Impotent_Node) ); No_Ex(" 9***ERROR***Primary_Relation: bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 10 => --MIL STD 5.1.2.17 Expected := "Nam"; Get_Parent(Parent, Top_Node); No_Ex(" 10***ERROR***Get_Parent: top-level"); Close(Parent); when 11 => if check_inaccessibility then Expected := "Nam"; Get_Parent(Parent, In_Traversed_Node); No_Ex(" 11***ERROR***Get_Parent: inaccessible parent"); Close(Parent); end if; when 12 => Expected := "Use"; Get_Parent(Parent, Offspring_Node, No_Intent(2..1) ); No_Ex(" 12***ERROR***Get_Parent: null intention"); Close(Parent); when 13 => Expected := "Sta"; Get_Parent(Open_Node, Offspring_Node); No_Ex(" 13***ERROR***Get_Parent: open parent"); Close(Parent); when 14 => Expected := "Sta"; Get_Parent(Parent, Closed_Node); No_Ex(" 14***ERROR***Get_Parent: closed node"); Close(Parent); when 15 => Expected := "Int"; Get_Parent(Parent, Impotent_Node); No_Ex(" 15***ERROR***Get_Parent: bad intent"); Close(Parent); --Security_Violation not checked when 16 => --MIL STD 5.1.2.18 Expected := "Nam"; Copy_Node(Impotent_Node,Living_Node, "Bad__Key"); No_Ex(" 16***ERROR***Copy_Node: illegal key"); when 17 => Expected := "Nam"; Copy_Node(Impotent_Node,Living_Node, "OK", "Bad__Rel"); No_Ex(" 17***ERROR***Copy_Node: illegal relation"); when 18 => Expected := "Nam"; Copy_Node(Impotent_Node,Living_Node, "johnjr", "dot" ); No_Ex(" 18***ERROR***Copy_Node: existing node"); when 19 => Expected := "Use"; Copy_Node(Process_Node,Living_Node, "dan", "dot" ); No_Ex(" 19***ERROR***Copy_Node: wrong node kind"); when 20 => Expected := "Use"; Copy_Node(Living_Node, Living_Node, "jim", "dot"); No_Ex(" 20***ERROR***Copy_Node: primary relationships"); when 21 => Expected := "Use"; Copy_Node(Offspring_Node,Living_Node, "dummy", "access"); No_Ex(" 21***ERROR***Copy_Node: predefined relation"); when 22 => Expected := "Sta"; Copy_Node(Closed_Node,Living_Node, "dummy", "link" ); No_Ex(" 22***ERROR***Copy_Node: from closed"); when 23 => Expected := "Sta"; Copy_Node(Living_Node,Closed_Node,"dummy", "link" ); No_Ex(" 23***ERROR***Copy_Node: to closed"); when 24 => Expected := "Int"; Copy_Node(Impotent_Node,Living_Node, "dummy", "link" ); No_Ex(" 24***ERROR***Copy_Node: from bad intent"); when 25 => Expected := "Int"; Copy_Node(Living_Node,Impotent_Node, "dummy", "link" ); No_Ex(" 25***ERROR***Copy_Node: to bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 26 => --MIL STD 5.1.2.19 Expected := "Nam"; Copy_Tree(Impotent_Node,Living_Node, "Bad__Key"); No_Ex(" 26***ERROR***Copy_Tree: illegal key"); when 27 => Expected := "Nam"; Copy_Tree(Impotent_Node,Living_Node, "OK", "Bad__Rel"); No_Ex(" 27***ERROR***Copy_Tree: illegal relation"); when 28 => Expected := "Nam"; Copy_Tree(Impotent_Node,Living_Node, "johnjr", "dot" ); No_Ex(" 28***ERROR***Copy_Tree: existing node"); when 29 => Expected := "Use"; Copy_Tree(Process_Node,Living_Node, "dan", "dot" ); No_Ex(" 29***ERROR***Copy_Tree: wrong node kind"); when 30 => Expected := "Use"; Copy_Tree(Offspring_Node,Living_Node, "dummy", "access"); No_Ex(" 30***ERROR***Copy_Tree: predefined relation"); when 31 => Expected := "Sta"; Copy_Tree(Closed_Node,Living_Node, "dummy", "link" ); No_Ex(" 31***ERROR***Copy_Tree: from closed"); when 32 => Expected := "Sta"; Copy_Tree(Living_Node,Closed_Node,"dummy", "link" ); No_Ex(" 32***ERROR***Copy_Tree: to closed"); when 33 => Expected := "Int"; Copy_Tree(Impotent_Node,Living_Node, "dummy", "link" ); No_Ex(" 33***ERROR***Copy_Tree: from bad intent"); when 34 => Expected := "Int"; Copy_Tree(Offspring_Node,Hidden_Node, "dummy", "link" ); No_Ex(" 34***ERROR***Copy_Tree: to bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 35 => --MIL STD 5.1.2.20 Expected := "Nam"; Rename(Hidden_Node,Living_Node, "Bad__Key"); No_Ex(" 35***ERROR***Rename: illegal key"); when 36 => Expected := "Nam"; Rename(Hidden_Node,Living_Node, "OK", "Bad__Rel"); No_Ex(" 36***ERROR***Rename: illegal relation"); when 37 => Expected := "Nam"; Rename(Hidden_Node,Living_Node, "johnjr", "dot" ); No_Ex(" 37***ERROR***Rename: existing node"); when 38 => Expected := "Use"; Rename(Process_Node,Living_Node, "dan", "dot" ); No_Ex(" 38***ERROR***Rename: wrong node kind"); when 39 => Expected := "Use"; Rename(Living_Node,Offspring_Node, "dummy", "dot"); No_Ex(" 39***ERROR***Rename: acircularity test"); when 40 => Expected := "Use"; Rename(Offspring_Node,Living_Node, "dummy", "access"); No_Ex(" 40***ERROR***Rename: predefined relation"); when 41 => Expected := "Use"; Rename(Top_Node,Living_Node, "dummy", "dot"); No_Ex(" 41***ERROR***Rename: parent relation is predefined"); when 42 => Expected := "Sta"; Rename(Closed_Node,Living_Node, "dummy", "link" ); No_Ex(" 42***ERROR***Rename: from closed"); when 43 => Expected := "Sta"; Rename(Living_Node,Closed_Node,"dummy", "link" ); No_Ex(" 43***ERROR***Rename: to closed"); when 44 => Expected := "Int"; Rename(Hidden_Node,Living_Node, "dummy", "link" ); No_Ex(" 44***ERROR***Rename: from bad intent"); when 45 => Expected := "Int"; Rename(Living_Node,Impotent_Node, "dummy", "link" ); No_Ex(" 45***ERROR***Rename: to bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 46 => --MIL STD 5.1.2.22 if check_inaccessibility then Expected := "Nam"; Delete_Tree(In_Traversed_Node); No_Ex(" 46***ERROR***Delete_Tree: inaccessible parent"); end if; when 47 => --MIL STD 5.1.2.22 if check_inaccessibility then Expected := "Nam"; Delete_Tree(Living_Node); No_Ex(" 47***ERROR***Delete_Tree: inaccessible subtree"); end if; when 48 => --MIL STD 5.1.2.22 Expected := "Use"; Delete_Tree(Top_Node); No_Ex(" 48***ERROR***Delete_Tree: parent relation is predefined"); when 49 => --MIL STD 5.1.2.22 Expected := "Sta"; Delete_Tree(Closed_Node); No_Ex(" 49***ERROR***Delete_Tree: unopened node"); when 50 => --MIL STD 5.1.2.22 Expected := "Int"; Delete_Tree(Hidden_Node); No_Ex(" 50***ERROR***Delete_Tree: bad intent"); when others => Put_Line("***TEST SET-UP ERROR*** " & integer'image(II) & " NOT EXPECTED!!"); end case; end Raise_Exception; begin Open(Top_Node,"'current_user",(1=>Exclusive_Write, 2=>Read)); Open(Impotent_Node,"'current_user",(1=>read_contents)); Put_Line("CREATE --TREE"); --Structural_Nodes.Create_Node(Node, Name=>"'current_user.Nowalk"); --Close(Node); Open(Node1, "'current_user.Nowalk", (1=>read, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john"); --Structural_Nodes.Create_Node(Living_Node, Node1, "john", "dot" ); --Close(Living_Node); Open(Living_Node, Node1, "john","dot", (1=>read, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john.johnjr"); --Cais.Text_Io.Create(Temp_File, Living_Node, "johnjr", "dot" ); --Cais.Text_Io.Close(Temp_File); Open(Offspring_Node,Living_Node, "johnjr","dot", (1=>read, 2=>Exclusive_Write, 3=>append_relationships)); Put_Line("CREATE --Nowalk.john.johnjr.mark"); --Cais.Text_Io.Create(Temp_File, Offspring_Node, "Mark", "dot" ); --Cais.Text_Io.Close(Temp_File); Put_Line("CREATE --Nowalk.john.will"); --Cais.Text_Io.Create(Temp_File, Living_Node, "will", "dot" ); --Cais.Text_Io.Close(Temp_File); Open(Node, Living_Node, "will","dot", (1=>Exclusive_write, 2=>append_relationships,3=>read)); Put_Line("CREATE --Nowalk.john.will.kitty"); --Cais.Text_Io.Create(Temp_File, Node, "kitty", "dot" ); --Cais.Text_Io.Close(Temp_File); Open(Inaccessible_Node, Living_Node, "will","dot", (1=>write, 2=>read)); Open(In_traversed_Node,Node,"kitty","dot",(1=>exclusive_write,2=>read)); Put_Line("NOW YOU must make the node dot(will) inaccessible"); Put_Line("It should be the 2nd from last node created."); Put_Line("Should Inaccessibility tests be run (Y/N)"); Get_Line(Wait, Last); if Last = 1 and then Wait(1) = 'Y' then Check_Inaccessibility := true; else Check_Inaccessibility := false; end if; Open(Process_Node,"'current_job",(1=>Existence)); Open(Hidden_Node, Living_Node, "johnjr","dot", (1=>existence)); Open(Open_Node, Living_Node, "johnjr","dot", (1=>write, 2=>read)); --======================================================================== --===================S E T U P C O M P L E T E D======================== --======================================================================== Line_Count := 10; for I in 1..Exceptions_Tested loop begin if Line_Count = 10 then new_line; put("PASSES TEST: "); Line_Count := 0; end if; Raise_Exception(I); exception when Node_Definitions.Use_Error => if Expected /= "Use" then Wrong_Exception(I,"Use_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Node_Definitions.Status_Error => if Expected /= "Sta" then Wrong_Exception(I,"Status_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Intent_Violation => if Expected /= "Int" then Wrong_Exception(I,"Intent_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Lock_Error => if Expected /= "Loc" then Wrong_Exception(I,"Lock_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Security_Violation => if Expected /= "Sec" then Wrong_Exception(I,"Security_Violation"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Node_Definitions.Name_Error => if Expected /= "Nam" then Wrong_Exception(I,"Name_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; end; end loop; new_line; put_line("****************************T O T A L S***********************"); put_line("Number of tests run: " & integer'image(Exceptions_Tested)); put_line("Number of failures : " & integer'image(Failures) ); put_line("*** NOTE 6 TESTS ARE SKIPPED IF INACCESSIBILITY NOT CHECKED***"); put_line("**************************************************************"); end Existree_Ex; --:::::::::::::: --io_ex_create_test.a --:::::::::::::: with Cais; use Cais; with Trace; procedure Create_Test is use Node_Definitions; use Node_Management; use Cais.Text_Io; use List_Utilities; Test_Max: constant Natural := 20; type Test_Result is (Succeed, Fail); type Test_Vec is Array (1..Test_Max) of Test_Result; Test_Outcomes : Test_Vec := (others => Succeed); Tests_Executed : Natural; File1 : File_Type; File2 : File_Type; Base : Cais.Node_Type; Unopened_File : File_Type; Unopened_Base : Cais.Node_Type; Attr_List : List_Type; procedure Name_Trap ( File :in out File_Type; Base :in out Cais.Node_Type; Key : Relationship_Key := Latest_Key; Relation : Relation_Name := Default_Relation; Mode : File_Mode := Inout_File; Form : List_Type := Empty_List; Attributes : List_Type := Empty_List; Access_Control : List_Type := Empty_List; Level : List_Type := Empty_List; -- parameters not used in Create call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Create (File, Base, Key, Relation, Mode, Form, Attributes, Access_Control, Level); Trace.Report (Natural'image(Test_Number) & ". Create fails to raise " & "Io_Definitions.Name_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Name_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Create raises " & "Io_Definitions.Name_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Create when " & Situation (Situation'range)); Results (Test_Number) := Fail; end Name_Trap; procedure Status_Trap ( File :in out File_Type; Base :in out Cais.Node_Type; Key : Relationship_Key := Latest_Key; Relation : Relation_Name := Default_Relation; Mode : File_Mode := Inout_File; Form : List_Type := Empty_List; Attributes : List_Type := Empty_List; Access_Control : List_Type := Empty_List; Level : List_Type := Empty_List; -- parameters not used in Create call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Create (File, Base, Key, Relation, Mode, Form, Attributes, Access_Control, Level); Trace.Report (Natural'image(Test_Number) & ". Create fails to raise " & "Io_Definitions.Status_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Status_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Create raises " & "Io_Definitions.Status_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Create when " & Situation (Situation'range)); Results (Test_Number) := Fail; end Status_Trap; procedure Use_Trap ( File :in out File_Type; Base :in out Cais.Node_Type; Key : Relationship_Key := Latest_Key; Relation : Relation_Name := Default_Relation; Mode : File_Mode := Inout_File; Form : List_Type := Empty_List; Attributes : List_Type := Empty_List; Access_Control : List_Type := Empty_List; Level : List_Type := Empty_List; -- parameters not used in Create call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Create (File, Base, Key, Relation, Mode, Form, Attributes, Access_Control, Level); Trace.Report (Natural'image(Test_Number) & ". Create fails to raise " & "Io_Definitions.Use_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Use_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Create raises " & "Io_Definitions.Use_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Create when " & Situation (Situation'range)); Results (Test_Number) := Fail; end Use_Trap; procedure Intent_Trap ( File :in out File_Type; Base :in out Cais.Node_Type; Key : Relationship_Key := Latest_Key; Relation : Relation_Name := Default_Relation; Mode : File_Mode := Inout_File; Form : List_Type := Empty_List; Attributes : List_Type := Empty_List; Access_Control : List_Type := Empty_List; Level : List_Type := Empty_List; -- parameters not used in Create call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Create (File, Base, Key, Relation, Mode, Form, Attributes, Access_Control, Level); Trace.Report (Natural'image(Test_Number) & ". Create fails to raise " & "Io_Definitions.Intent_Violation when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Node_Definitions.Intent_Violation => Trace.Report (Natural'image(Test_Number) & ". OK -- Create raises " & "Io_Definitions.Intent_Violation when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Create when " & Situation (Situation'range)); Results (Test_Number) := Fail; end Intent_Trap; begin Trace.Enable_All; Open (Base, "'current_node", (1 => append_relationships)); Create (File1, Base, "test1", "Exceptions", Inout_File); Name_Trap (File2, Base, "test1", "Exceptions", Inout_File, Results => Test_Outcomes, Test_Number => 1, Situation => "file exists"); Name_Trap (File2, Base, ".test2", "Exceptions", Inout_File, Results => Test_Outcomes, Test_Number => 2, Situation => "key is bad"); Name_Trap (File2, Base, "test3", "'Exceptions", Inout_File, Results => Test_Outcomes, Test_Number => 3, Situation => "relation is bad"); To_List ("(A=>Avalue)", Attr_List); Use_Trap (File2, Base, "test4", "Exceptions", Inout_File, Attributes => Attr_List, Results => Test_Outcomes, Test_Number => 4, Situation => "attribute syntax illegal"); To_List ("(Access_Method=>(Direct))", Attr_List); Use_Trap (File2, Base, "test5", "Exceptions", Inout_File, Attributes => Attr_List, Results => Test_Outcomes, Test_Number => 5, Situation => "attribute semantics illegal"); To_List ("(File_Kind=>(Avalue))", Attr_List); Use_Trap (File2, Base, "test6", "Exceptions", Inout_File, Attributes => Attr_List, Results => Test_Outcomes, Test_Number => 6, Situation => "predefined attribute"); Use_Trap (File2, Base, "test7", "Adopted_Role", Inout_File, Results => Test_Outcomes, Test_Number => 7, Situation => "predefined relation"); Status_Trap (Unopened_File, Unopened_Base, "test8", "Exceptions", Inout_File, Results => Test_Outcomes, Test_Number => 8, Situation => "base not open"); Status_Trap (File1, Base, "test9", "Exceptions", Inout_File, Results => Test_Outcomes, Test_Number => 9, Situation => "file handle open"); Close (Base); Delete (File1); Open (Base, "'current_node", (1 => existence)); Intent_Trap (File2, Base, "test10", "Exceptions", Inout_File, Results => Test_Outcomes, Test_Number => 10, Situation => "base intent not Append_Relationships"); end Create_Test; --:::::::::::::: --io_ex_delete_test.a --:::::::::::::: with Cais; use Cais; with Trace; procedure Delete_Test is use Node_Definitions; use Node_Management; use Cais.Text_Io; use List_Utilities; Test_Max: constant Natural := 20; type Test_Result is (Succeed, Fail); type Test_Vec is Array (1..Test_Max) of Test_Result; Test_Outcomes : Test_Vec := (others => Succeed); Tests_Executed : Natural; File1 : File_Type; File2 : File_Type; Unopened_File : File_Type; Unopened_Base : Cais.Node_Type; Attr_List : List_Type; procedure Name_Trap ( File :in out File_Type; -- parameters not used in Delete call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Delete (File); Trace.Report (Natural'image(Test_Number) & ". Delete fails to raise " & "Io_Definitions.Name_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Name_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Delete raises " & "Io_Definitions.Name_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Delete "); Results (Test_Number) := Fail; end Name_Trap; procedure Status_Trap ( File :in out File_Type; -- parameters not used in Delete call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Delete (File); Trace.Report (Natural'image(Test_Number) & ". Delete fails to raise " & "Io_Definitions.Status_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Status_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Delete raises " & "Io_Definitions.Status_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Delete "); Results (Test_Number) := Fail; end Status_Trap; procedure Use_Trap ( File :in out File_Type; -- parameters not used in Delete call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Delete (File); Trace.Report (Natural'image(Test_Number) & ". Delete fails to raise " & "Io_Definitions.Use_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Use_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Delete raises " & "Io_Definitions.Use_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Delete "); Results (Test_Number) := Fail; end Use_Trap; procedure Intent_Trap ( File :in out File_Type; -- parameters not used in Delete call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Delete (File); Trace.Report (Natural'image(Test_Number) & ". Delete fails to raise " & "Io_Definitions.Intent_Violation when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Node_Definitions.Intent_Violation => Trace.Report (Natural'image(Test_Number) & ". OK -- Delete raises " & "Io_Definitions.Intent_Violation when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Delete "); Results (Test_Number) := Fail; end Intent_Trap; begin Trace.Enable_All; -- Cannot test for Name_Error on inaccessible parent until -- discretionary access control is in place. Trace.Report ("1. OK -- test for Name_Error is stubbed."); Create (File1, "'current_node'del_exc(test2_parent)",Inout_File); Create (File2, "'current_node'del_exc(test2_parent).child",Inout_File); Use_Trap (File1, Results => Test_Outcomes, Test_Number => 2, Situation => "primary relationships emanate from " & "node to be deleted"); Delete (File2); Delete (File1); Status_Trap (Unopened_File, Results => Test_Outcomes, Test_Number => 3, Situation => "file handle is not open"); end Delete_Test; --:::::::::::::: --io_ex_open_test.a --:::::::::::::: with Cais; use Cais; with Trace; procedure Open_Test is use Node_Definitions; use Node_Management; use Cais.Text_Io; use List_Utilities; Test_Max: constant Natural := 20; type Test_Result is (Succeed, Fail); type Test_Vec is Array (1..Test_Max) of Test_Result; Test_Outcomes : Test_Vec := (others => Succeed); Tests_Executed : Natural; package Dir_Io is new Cais.Direct_Io (Integer); package Dir_Defs renames Dir_Io.Dir_Io_Definitions; File1 : File_Type; File2 : File_Type; FileX : Dir_Io.File_Type; Node1 : Cais.Node_Type; Node2 : Cais.Node_Type; -- Not a text file Unopened_File : File_Type; Unopened_Node : Cais.Node_Type; Attr_List : List_Type; procedure Status_Trap ( File :in out File_Type; Node : Cais.Node_Type; Mode : File_Mode := Inout_File; -- parameters not used in Open call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Open (File, Node, Mode); Trace.Report (Natural'image(Test_Number) & ". Open fails to raise " & "Io_Definitions.Status_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Status_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Open raises " & "Io_Definitions.Status_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Open "); Results (Test_Number) := Fail; end Status_Trap; procedure Use_Trap ( File :in out File_Type; Node : Cais.Node_Type; Mode : File_Mode := Inout_File; -- parameters not used in Open call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Open (File, Node, Mode); Trace.Report (Natural'image(Test_Number) & ". Open fails to raise " & "Io_Definitions.Use_Error when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Io_Definitions.Use_Error => Trace.Report (Natural'image(Test_Number) & ". OK -- Open raises " & "Io_Definitions.Use_Error when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Open "); Results (Test_Number) := Fail; end Use_Trap; procedure Intent_Trap ( File :in out File_Type; Node : Cais.Node_Type; Mode : File_Mode := Inout_File; -- parameters not used in Open call Results :in out Test_Vec; Test_Number : Natural; Situation : String) is begin Open (File, Node, Mode); Trace.Report (Natural'image(Test_Number) & ". Open fails to raise " & "Io_Definitions.Intent_Violation when " & Situation (Situation'range)); Results (Test_Number) := Fail; exception when Node_Definitions.Intent_Violation => Trace.Report (Natural'image(Test_Number) & ". OK -- Open raises " & "Io_Definitions.Intent_Violation when " & Situation (Situation'range)); when others => Trace.Report (Natural'image(Test_Number) & ". Unexpected exception in Open "); Results (Test_Number) := Fail; end Intent_Trap; begin Trace.Enable_All; Structural_Nodes.Create_Node (Node => Node1, Name => "'Current_Node'Open_Exc(test1)"); Use_Trap (File1, Node1, Out_File, Results => Test_Outcomes, Test_Number => 1, Situation => "not a file node"); Close (Node1); Open (Node => Node1, Name => "'Current_Node'Open_Exc(test1)", Intent => (1 => Exclusive_Write, 2 => Read_Relationships)); Delete_Node (Node1); Dir_Io.Create (FileX, "'Current_Node'Open_Exc(test2)", Dir_Defs.Inout_File); Dir_Io.Close (FileX); Open (Node2, "'Current_Node'Open_Exc(test2)", (1=> Read, 2 => Exclusive_Write)); Use_Trap (File2, Node2, In_File, Results => Test_Outcomes, Test_Number => 2, Situation => "not Text Access_Method"); Delete_Node (Node2); Status_Trap (Unopened_File, Unopened_Node, Inout_File, Results => Test_Outcomes, Test_Number => 3, Situation => "node handle not open"); Create (File2, "'Current_Node'Open_Exc(test4)", Inout_File); Open (Node2, "'Current_Node'Open_Exc(test4) ", (1 => Write)); Status_Trap (File2, Node2, Out_File, Results => Test_Outcomes, Test_Number => 4, Situation => "file handle open"); Close (Node2); Delete (File2); Create (File1, "'Current_Node'Open_Exc(test5)", Inout_File); Open (Node2, "'Current_Node'Open_Exc(test5)", (1 => Existence)); Intent_Trap (File2, Node2, Append_File, Results => Test_Outcomes, Test_Number => 5, Situation => " intent disallows mode"); Close (Node2); Delete (File1); end Open_Test; --:::::::::::::: --list_test_02_12.a --:::::::::::::: with Cais; use Cais; with Text_Io; use Text_Io; procedure List_Test_02_12 is procedure Test2 is use List_Utilities; use String_Items; List2 : List_Type; List1 : List_Type; String_Item : string(1..24); procedure Show(L1 : List_Type; L2 : List_Type; L3 : String; II : Positive) is XX : string(1..35) := " "; begin put_line( L3 ); if To_Text(L1) = To_Text(L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Show; begin To_List("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2);--numbers Copy (List1,List2); Show(List1, List2, "(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",1); To_List("(""1"",""embedded"""""",""in""""middle"")",List2);--strings Copy (List1,List2); Show(List1, List2, "(""1"",""embedded"""""",""in""""middle"")",2);--strings To_List("(""Name"",""ID001"",""ada_name"")",List2);--identifiers Copy (List1,List2); Show(List1, List2, "(""Name"",""ID001"",""ada_name"")",3); To_List("((list),(list,(sublist),(sublist)),((sub1list,(sub2list))))",List2); Copy (List1,List2); Show(List1,List2,"((list),(list,(sublist),(sublist)),((sub1list,(sub2list))))",4); To_List("( I=>1, you=>2, We=>3, Them_Guys=>4)", List2); Copy(List1, List2); Show(List1, List2, "( I=>1, you=>2, We=>3, Them_Guys=>4)",5); end Test2; procedure Test3 is use List_Utilities; use String_Items; List2 : List_Type; String_Item : string(1..24); procedure Test(L1 : String; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; begin put_line(L1); put_line(To_Text(L2)); if To_Text(L2) = L1 then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2);--numbers Test("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2,1);--numbers To_List("(""1"",""embedded"""""",""in""""middle"")",List2);--strings Test("(""1"",""embedded"""""",""in""""middle"")",List2,2);--strings To_List("(""Name"",""ID001"",""ada_name"")",List2);--identifiers Test("(""Name"",""ID001"",""ada_name"")",List2,3);--identifiers To_List("((list), (list,(sublist),(sublist)), ((sub1list,(sub2list))) )", List2);--lists Test("((LIST),(LIST,(SUBLIST),(SUBLIST)),((SUB1LIST,(SUB2LIST))))", List2,4);--lists end Test3; procedure Test4 is use List_Utilities; use String_Items; List2 : List_Type; String_Item : string(1..24); procedure Test(L1 : String; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; begin put_line(L1); if To_Text(L2) = L1 then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2);--numbers Test("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)", List2, 1); To_List("(""1"",""embedded"""""",""in""""middle"")",List2);--strings Test( "(""1"",""embedded"""""",""in""""middle"")", List2, 2); To_List("(""Name"",""ID001"",""ada_name"")",List2);--identifiers Test( "(""Name"",""ID001"",""ada_name"")", List2, 3); To_List("((list), (list,(sublist),(sublist)), ((sub1list,(sub2list))) )", List2);--lists Test("((LIST),(LIST,(SUBLIST),(SUBLIST)),((SUB1LIST,(SUB2LIST))))",List2,4); end Test4; procedure Test5 is use List_Utilities; use String_Items; List2 : List_Type; List1 : List_Type; String_Item : string(1..24); procedure Show(L1 : List_Type; L2 : List_Type; L3 : String; II : Positive) is XX : string(1..35) := " "; begin put_line( L3 ); if Is_Equal(L1, L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Show; begin To_List("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2);--numbers Copy (List1,List2); Show(List1, List2, "(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",1); To_List("(""1"",""embedded"""""",""in""""middle"")",List2);--strings Copy (List1,List2); Show(List1, List2, "(""1"",""embedded"""""",""in""""middle"")",2);--strings To_List("(""Name"",""ID001"",""ada_name"")",List2);--identifiers Copy (List1,List2); Show(List1, List2, "(""Name"",""ID001"",""ada_name"")",3); To_List("((list),(list,(sublist),(sublist)),((sub1list,(sub2list))))",List2); Copy (List1,List2); Show(List1,List2,"((list),(sublist)),((sublist)),((sublist,(sub2list))))",4); To_List("( I=>1, you=>2, We=>3, Them_Guys=>4)", List2); Copy(List1, List2); Show(List1, List2, "( I=>1, you=>2, We=>3, Them_Guys=>4)",5); end Test5; ------------------------------------------------------------------------ --Tests the DELETE operation on any item type within a list 5.4.1.6-- ------------------------------------------------------------------------ procedure Test6 is use List_Utilities; use String_Items; use Identifier_Items; List2 : List_Type; List1 : List_Type; Tok_You : Token_Type; Tok_I : Token_Type; Tok_We : Token_Type; Tok_Them_G : Token_Type; Tok_UPPER : Token_Type; Tok_Low : Token_Type; String_Item : string(1..24); procedure Show(L1 : List_Type; L2 : List_Type; L3 : String; II : Positive) is XX : string(1..35) := " "; begin put_line( L3 ); if Is_Equal(L1,L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Show; begin put_line("-------------------------------------------------------------"); put_line("Tests the DELETE operation 5.4.1.6"); put_line("-------------------------------------------------------------"); To_List("(1,2,3,4,5,6)",List2); To_List("(1,2,4,5)",List1); Delete(List2,3); Delete(List2,5); Show(List1, List2, "*** 3 AND 6 *** SHOULD BE DELETED",1); To_List("((list),(list,(sublist),(sublist)),((sub1list,(sub2list))))",List2); To_List("((list),((sub1list,(sub2list))))",List1); Delete (List2,2); Show(List1,List2,"MIDDLE LIST DELETED (list,(sublist),(sublist)) ****",2); To_List("( I=>1, you=>2, We=>3, Them_Guys=>4)", List2); To_List("( you=>2 )", List1); Delete (List2,"We "); Delete (List2,1); Delete (List2,2); Show(List1, List2, "ONLY ""YOU"" SHOULD REMAIN",3); To_Token("You", Tok_You); To_Token("I", Tok_I); To_Token("We", Tok_We); To_Token("Them_Guys",Tok_Them_G); To_Token("YOU", Tok_UPPER); To_Token("we", Tok_Low); To_List("( I=>1, you=>2, We=>3, Them_Guys=>4)", List2); To_List("( Them_Guys=>4)", List1); Delete(List2, Tok_You); Delete(List2, "I "); Delete(List2, Tok_We); Show(List1, List2, "ONLY ""THEM_GUYS"" SHOULD REMAIN",4); To_List("( I=>1, you=>2, We=>3, Them_Guys=>4)", List2); To_List("( I=>1 )", List1); Delete(List2, Tok_Them_G); Delete(List2, Tok_UPPER); Delete(List2, Tok_Low); Show(List1, List2, "ONLY ""I"" SHOULD REMAIN",5); end Test6; ------------------------------------------------------------------------ --Tests the GET_LIST_KIND operation on any list 5.4.1.7-- ------------------------------------------------------------------------ procedure Test7 is use List_Utilities; List2 : List_Type; begin To_List("(ONE=>1,TWO=>2)",List2); if Get_List_Kind(List2) = Named then put_line("NAMED List OK. TEST 1 PASSES"); else put_line("NAMED error*******TEST 1 FAILS*************"); end if; Delete(List2,2); Delete(List2,1); if Get_List_Kind(List2) = Empty then put_line("EMPTY List OK. TEST 2 PASSES"); else put_line("EMPTY error*******TEST 2 FAILS*************"); end if; To_List("(1,2,3)",List2); if Get_List_Kind(List2) = Unnamed then put_line("UNNAMED List OK. TEST 3 PASSES"); else put_line("UNNAMED error*******TEST 3 FAILS*************"); end if; end Test7; ------------------------------------------------------------------------ --Tests the GET_ITEM_KIND operation on any item type in a list 5.4.1.8-- ------------------------------------------------------------------------ procedure Test8 is use List_Utilities; List2 : List_Type; begin To_List("(1, 3.14, ID_NAME, ""string"", (1,2) )", List2); if Get_Item_Kind(List2,1) = Integer_Item then put_line("Integer_Item OK. TEST 1 PASSES"); else put_line("Integer_Item error*******TEST 1 FAILS*****"); end if; if Get_Item_Kind(List2,2) = Float_Item then put_line("Float_Item OK. TEST 2 PASSES"); else put_line("Float_Item error*******TEST 2 FAILS*****"); end if; if Get_Item_Kind(List2,3) = Identifier_Item then put_line("Identifier_Item OK. TEST 3 PASSES"); else put_line("Identifier_Item error*******TEST 3 FAILS*****"); end if; if Get_Item_Kind(List2,5) = List_Item then put_line("List_Item OK. TEST 4 PASSES"); else put_line("List_Item error*******TEST 4 FAILS*****"); end if; if Get_Item_Kind(List2,4) = String_Item then put_line("String_Item OK. TEST 5 PASSES"); else put_line("String_Item error*******TEST 5 FAILS*****"); end if; To_List("(aa=>1, bb=>3.14, cc=>ID_NAME, dd=>""string"", ee=>(1,2) )",List2); if Get_Item_Kind(List2,"aa") = Integer_Item then put_line("Integer_Item OK. TEST 6 PASSES"); else put_line("Integer_Item error*******TEST 6 FAILS*****"); end if; if Get_Item_Kind(List2,"bb") = Float_Item then put_line("Float_Item OK. TEST 7 PASSES"); else put_line("Float_Item error*******TEST 7 FAILS*****"); end if; if Get_Item_Kind(List2,3) = Identifier_Item then put_line("Identifier_Item OK. TEST 8 PASSES"); else put_line("Identifier_Item error*******TEST 8 FAILS*****"); end if; if Get_Item_Kind(List2,"ee") = List_Item then put_line("List_Item OK. TEST 9 PASSES"); else put_line("List_Item error*******TEST 9 FAILS*****"); end if; if Get_Item_Kind(List2,4) = String_Item then put_line("String_Item OK. TEST 10 PASSES"); else put_line("String_Item error*******TEST 10 FAILS*****"); end if; end Test8; ------------------------------------------------------------------------ --Tests the SPLICE operation on any two lists 5.4.1.9-- ------------------------------------------------------------------------ procedure Test9 is use List_Utilities; List1 : List_Type; List2 : List_Type; List3 : List_Type; List4 : List_Type; List5 : List_Type; procedure Test(L1 : List_Type; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; begin put_line(To_Text(L1)); if Is_Equal(L2,L1) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List ("( ""3"" )", List1); To_List (" (""1"", ""2"", ""4"") ", List2); To_List (" (""1"", ""2"", ""3"", ""4"") ", List5); Splice (List2,2,List1); Test(List2,List5,1); To_List ("(1,2,3,4)", List1); To_List (" (""1"", ""2"", ""3"", ""4"",1,2,3,4) ", List5); Splice (List2,4,List1); Test(List2,List5,2); To_List ("(A=>Mike, A_1=>Mary)",List3); To_List ("(B=>Mark)", List4); To_List ("(A=>Mike, B=>Mark, A_1=>Mary)",List5); Splice (List3,1,List4); Test(List3,List5,3); begin Splice (List3,0,List4); Put_line ("ZERO POSITION SPLICE IS SUPPORTED **ERR** FAILS TEST 4"); exception when others => Put_line ("ZERO POSITION SPLICE IS CORRECTLY FLAGGED PASSES TEST 4"); end; end Test9; ------------------------------------------------------------------------ --Tests the MERGE operation on any two lists 5.4.1.10-- ------------------------------------------------------------------------ procedure Test10 is use List_Utilities; List1 : List_Type; List2 : List_Type; List3 : List_Type; List4 : List_Type; List5 : List_type; List6 : List_type; List7 : List_type; procedure Test(L1 : List_Type; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; begin put_line(To_Text(L1)); if Is_Equal(L1,L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List ("( ""3"" )", List1); To_List (" (""1"", ""2"", ""4"") ", List2); Merge (List1,List2,List5); To_List (" (""3"", ""1"", ""2"", ""4"") ", List7); Test(List5,List7,1); To_List ("(1,2,3,4)", List1); Merge (List1,List2,List5); To_List (" (1,2,3,4,""1"", ""2"", ""4"") ", List7); Test(List5,List7,2); To_List ("(A=>Mike, A_1=>Mary)",List3); To_List ("(B=>Mark)", List4); Merge (List3,List4,List5); To_List ("(A=>Mike, A_1=>Mary,B=>Mark)",List7); Test(List5,List7,3); To_List ("()", List6); --test null lists Merge (List1,List6,List5); To_List ("(1,2,3,4)", List7); Test(List5,List7,4); Merge (List6,List2,List5); To_List (" (""1"", ""2"", ""4"") ", List7); Test(List5,List7,5); Merge (List3,List6,List5); To_List ("(A=>Mike, A_1=>Mary)",List7); Test(List5,List7,6); Merge (List6,List4,List5); To_List ("(B=>Mark)", List7); Test(List5,List7,7); end Test10; ------------------------------------------------------------------------ --Tests the SET_EXTRACT operation on any sublist of a list 5.4.1.11-- ------------------------------------------------------------------------ procedure Test11 is use List_Utilities; use String_Items; List2 : List_Type; String_Item : string(1..24); procedure Test(L1 : String; L2 : String; L3 : String; II : Positive) is XX : string(1..35) := " "; L4 : List_Type; L5 : List_Type; begin put_line( L3 ); To_List(L1, L4); To_List(L2, L5); if Is_Equal(L4,L5) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2);--numbers put_line("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24) --numbers"); Test( "(1234567890,1.,1_1,1_1.1_1,1.45,1E+01)", Set_Extract(List2,3,6), "TOKENS 3-6", 1); Test( "(1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)", Set_Extract(List2,3,9), "TOKENS 3-9", 2); To_List("(""1"",""embedded"""""",""in""""middle"")",List2);--strings put_line("(""1"",""embedded"""""",""in""""middle"") --strings"); Test( "(""1"",""embedded"""""")", Set_Extract(List2,1,2), "TOKENS 1-2", 3); Test( "(""1"")", Set_Extract(List2,1,1), "TOKENS 1-1", 4); To_List("(""Name"",""ID001"",""ada_name"")",List2);--identifiers put_line("(""Name"",""ID001"",""ada_name"") --identifiers"); Test( "(""ada_name"")", Set_Extract(List2,3,1), "TOKENS 3-3", 5); To_List("((list), (list,(sublist),(sublist)), ((sub1list,(sub2list))) )", List2);--lists put_line("((list), (list,(sublist),(sublist)), ((sub1list,(sub2list))) )" & "--lists"); Test("((list),(list,(sublist),(sublist)),((sub1list,(sub2list))))", Set_Extract(List2,1,3), "TOKENS 1-3", 6); Test("((list),(list,(sublist),(sublist)))", Set_Extract(List2,1,2), "TOKENS 1-2", 7); end Test11; ------------------------------------------------------------------------ --Tests the LENGTH operation on any list 5.4.1.12-- ------------------------------------------------------------------------ procedure Test12 is use List_Utilities; use String_Items; List1 : List_Type; List2 : List_Type; List3 : List_Type; List4 : List_Type; List5 : List_type; List6 : List_type; String_Item : string(1..24); procedure Test(L1 : List_Utilities.Count; L2 : List_Utilities.Count; II : Positive) is XX : String(1..35) := " "; begin put_line("EXPECT" & List_Utilities.Count'image(L1) & " => GET " & List_Utilities.Count'image(L2)); if L1 = L2 then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2);--numbers put_line( "(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)" ); Test(9, Length(List2), 1); To_List("(""1"",""embedded"""""",""in""""middle"")",List2);--strings put_line( "(""1"",""embedded"""""",""in""""middle"")" ); Test(3, Length(List2), 2); To_List("(""Name"",""ID001"",""ada_name"")",List2);--identifiers put_line( "(""Name"",""ID001"",""ada_name"")" ); Test(3, Length(List2), 3); To_List("((list), (list,(sublist),(sublist)), ((sub1list,(sub2list))) )", List2);--lists Test(3, Length(List2), 4); To_List ("( ""3"" )", List1); To_List (" (""1"", ""2"", ""4"") ", List2); Merge (List1,List2,List5); Test(4, Length(List5), 5); To_List ("(1,2,3,4)", List1); Merge (List1,List2,List5); Test(7, Length(List5), 6); To_List ("(A=>Mike, A_1=>Mary)",List3); To_List ("(B=>Mark)", List4); Merge (List3,List4,List5); Test(3, Length(List5), 7); To_List ("()", List6); --test null lists Merge (List1,List6,List5); Test(4, Length(List5), 8); Test(0, Length(List6), 9); end Test12; begin Test2; Test3; Test4; Test5; Test6; Test7; Test8; Test9; Test10; Test11; Test12; end List_Test_02_12; --:::::::::::::: --list_test_13_ss.a --:::::::::::::: with Cais; use Cais; with Text_Io; use Text_Io; procedure List_Test_13_ss is --------------------------------------------------------------------------- --Tests the LENGTH operation on strings representing a list_item 5.4.1.13-- --------------------------------------------------------------------------- procedure Test13 is use List_Utilities; use String_Items; use Identifier_Items; List1 : List_Type; List2 : List_Type; List3 : List_Type; List4 : List_Type; List5 : List_type; List6 : List_type; Token_Form : Token_Type; String_Item : string(1..24); procedure Test(L1 : Integer; L2 : Integer; II : Positive) is XX : String(1..35) := " "; begin put_line("EXPECT" & integer'image(L1) & " => GET " & integer'image(L2)); if L1 = L2 then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin new_line; put_line("123456789012345678901234567890123456789012345678901234567890"); put_line(" + + + + + +"); To_List("(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)",List2);--numbers put_line( "(1,01,1234567890,1.,1_1,1_1.1_1,1.45,1E+01,1E-24)" ); Test(49, Text_Length(List2), 1); Test(2, Text_Length(List2,2), 2); Test(7, Text_Length(List2,6), 3); To_List("(""1"",""embedded"""""",""in""""middle"")",List2);--strings put_line("(""1"",""embedded"""""",""in""""middle"")"); Test(31, Text_Length(List2), 4); Test(9, Text_Length(List2,3), 5); To_List("(""Name"",""ID001"",""ada_name"")",List2);--identifiers put_line( "(""Name"",""ID001"",""ada_name"")" ); Test(27, Text_Length(List2), 6); Test(8, Text_Length(List2,3), 7); To_List("((list), (list,(sublist),(sublist)), ((sub1list,(sub2list))) )", List2);--lists put_line("((list),(list,(sublist),(sublist)),((sub1list,(sub2list))))"); Test(59, Text_Length(List2), 8); Test(26, Text_Length(List2,2), 9); Test(23, Text_Length(List2,3), 10); To_List ("( ""3"" )", List1); To_List (" (""1"", ""2"", ""4"") ", List2); Merge (List1,List2,List5); put_line(To_Text(List5)); Test(17, Text_Length(List5), 11); Test(1, Text_Length(List5,4), 12); Test(1, Text_Length(List5,1), 13); To_List ("(1,2,3,4)", List1); Merge (List1,List2,List5); new_line; new_line; put_line("123456789012345678901234567890123456789012345678901234567890"); put_line(" + + + + + +"); put_line(To_Text(List5)); Test(21, Text_Length(List5), 14); To_List ("(A=>Mike, A_1=>Mary)",List3); To_List ("(B=>Mark)", List4); Merge (List3,List4,List5); put_line(To_Text(List5)); Test(27, Text_Length(List5), 15); Test(4, Text_Length(List5,"a"), 16); To_Token("b",Token_Form); Test(4, Text_Length(List5,Token_Form), 17); To_List ("()", List6); --test null lists Merge (List1,List6,List5); put_line(To_Text(List5)); Test(9, Text_Length(List5), 18); put_line(To_Text(List6)); Test(2, Text_Length(List6), 19); To_List ("("""")", List2); Test(0, Text_Length(List2,1), 20); end Test13; ------------------------------------------------------------------------ --Tests the ITEM_NAME operation on positions within a list 5.4.1.14-- ------------------------------------------------------------------------ procedure Test14 is use List_Utilities; use String_Items; use Identifier_Items; List3 : List_Type; List4 : List_Type; List5 : List_type; Pos1 : Token_Type; Pos2 : Token_Type; Pos3 : Token_Type; procedure Test(L1 : String; L2 : Token_Type; II : Positive) is XX : string(1..35) := " "; L3 : Token_Type; begin To_Token(L1, L3); if Is_Equal(L3,L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List ("(A=>Mike, A_1=>Mary)",List3); To_List ("(B=>Mark)", List4); Merge (List3,List4,List5); put_line(To_Text(List5)); Item_Name(List5,1,Pos1); Test("A", Pos1, 1); Item_Name(List5,2,Pos2); Test("A_1", Pos2, 2); Item_Name(List5,3,Pos3); Test("B", Pos3, 3); To_List("(Name=>1, MiXeD_Name=>ID, llllllllllooooooooooonnnnng_name=>1.)", List5); put_line(To_Text(List5)); Item_Name(List5,1,Pos1); Test("NAME", Pos1, 4); Item_Name(List5,2,Pos2); Test("MIXED_NAME", Pos2, 5); Item_Name(List5,3,Pos3); Test("llllllllllooooooooooonnnnng_name", Pos3, 6); end Test14; ------------------------------------------------------------------------ --Tests the POSITION_BY_NAME operation on named lists 5.4.1.15-- ------------------------------------------------------------------------ procedure Test15 is use List_Utilities; use String_Items; use Identifier_Items; List3 : List_Type; List4 : List_Type; List5 : List_type; Pos1 : Position_Count; Pos2 : Position_Count; Pos3 : Position_Count; Tok1 : Token_Type; procedure Test(L1 : Position_Count; L2 : Position_Count; II : Positive) is XX : string(1..35) := " "; begin put_line("EXPECT" & List_Utilities.Count'image(L1) & " => GET " & List_Utilities.Count'image(L2)); if L1 = L2 then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List ("(A=>Mike, A_1=>Mary)",List3); To_List ("(B=>Mark)", List4); Merge (List3,List4,List5); put_line(To_Text(List5)); Pos1 := Position_By_Name(List5,"a"); Test(1, Pos1, 1); Pos2 := Position_By_Name(List5,"A_1"); Test(2, Pos2, 2); Pos3 := Position_By_Name(List5,"b"); Test(3, Pos3, 3); To_List("(Name=>1, MiXeD_Name=>ID, llllllllllooooooooooonnnnng_name=>1.)", List5); put_line(To_Text(List5)); Pos1 := Position_By_Name(List5,"NAME"); Test(1, Pos1, 4); Pos2 := Position_By_Name(List5,"mixed_nAME"); Test(2, Pos2, 5); Pos3 := Position_By_Name(List5,"llllllllllooooooooooonnnnng_name"); Test(3, Pos3, 6); To_List("(Name=>1, MiXeD_Name=>ID, llllll_o_o_oooonnnnng_name=>1.)", List5); put_line(To_Text(List5)); To_Token("NAME",Tok1); Pos1 := Position_By_Name(List5,Tok1); Test(1, Pos1, 7); To_Token("mixed_nAME",Tok1); Pos2 := Position_By_Name(List5,Tok1); Test(2, Pos2, 8); To_Token("llllll_o_o_oooonnnnng_name",Tok1); Pos3 := Position_By_Name(List5,Tok1); Test(3, Pos3, 9); end Test15; ------------------------------------------------------------------------ --Tests the EXTRACT operation on any list_items in a list 5.4.1.16-- ------------------------------------------------------------------------ procedure Test16 is use List_Utilities; use Identifier_Items; List1 : List_Type; List2 : List_Type; List3 : List_Type; Toke : Token_Type; procedure Show(L1 : List_Type; L2 : String; II : Positive) is XX : string(1..35) := " "; L3 : List_Type; begin put_line(To_Text(L1)); To_List(L2,L3); if Is_Equal(L1,L3) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Show; begin To_List (" ((1), ((2)), (4,5)) ", List2); put_line(To_Text(List2)); Extract(List2,1,List3); Show(List3,"(1)",1); Extract(List2,2,List3); Show(List3,"((2))",2); Extract(List2,3,List3); Show(List3,"(4,5)",3); To_List ("( (""3"") )", List1); put_line(To_Text(List1)); Extract(List1,1,List3); Show(List3,"(""3"")",4); To_List("(SIMPLE=>(list), NESTED=>(list,(sublist),(sublist)), TWICEN=>((sub1list ,(sub2list))))",List2); put_line(To_Text(List2)); Extract(List2,"simple",List3); Show(List3,"(list)",5); Extract(List2,"nEsTed",List3); Show(List3,"(list,(sublist),(sublist))",6); Extract(List2,"TWICEN",List3); Show(List3,"((sub1list,(sub2list)))",7); To_Token("simple",Toke); Extract(List2,Toke,List3); Show(List3,"(list)",8); To_Token("NeStEd",Toke); Extract(List2,Toke,List3); Show(List3,"(list,(sublist),(sublist))",9); To_Token("twiceN",Toke); Extract(List2,Toke,List3); Show(List3,"((sub1list,(sub2list)))",10); Extract(List2,1,List3); Show(List3,"(list)",11); Extract(List2,2,List3); Show(List3,"(list,(sublist),(sublist))",12); Extract(List2,3,List3); Show(List3,"((sub1list,(sub2list)))",13); end Test16; ------------------------------------------------------------------------ --Tests the REPLACE operation on list_items within a list 5.4.1.17-- ------------------------------------------------------------------------ procedure Test17 is use List_Utilities; use Identifier_Items; List1 : List_Type; List2 : List_Type; List3 : List_Type; List4 : List_Type; Toke : Token_Type; procedure Test(L1 : List_Type; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; begin put_line(To_Text(L1)); if Is_Equal(L1,L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List (" ((1), ((2)), (4,5)) ", List2); To_List ("( ""NEW"" )", List3); put_line(To_Text(List2)); Replace(List2,List3,1); To_List("((""NEW""),((2)),(4,5))",List4); Test(List2,List4,1); Replace(List2,List3,2); To_List("((""NEW""),(""NEW""),(4,5))",List4); Test(List2,List4,2); Replace(List2,List3,3); To_List("((""NEW""),(""NEW""),(""NEW""))",List4); Test(List2,List4,3); new_line; To_List ("( (""OLD"") )", List1); put_line(To_Text(List1)); Replace(List1,List3,1); To_List("((""NEW""))",List4); Test(List1,List4,4); new_line; To_List("(SIMPLE=>(list), NESTED=>(list,(sub),(sub)), TWICEN=>((sub1,(sub2))))", List2); put_line(To_Text(List2)); Replace(List2,List3,"simple"); put_line(To_Text(List2)); To_List("(SIMPLE=>(""NEW""),NESTED=>(list,(sub),(sub))," & "TWICEN=>((sub1,(sub2))))",List4); Test(List2,List4,5); Replace(List2,List3,"nEsTed"); To_List("(SIMPLE=>(""NEW""),NESTED=>(""NEW""),TWICEN=>((sub1,(sub2))))",List4); Test(List2,List4,6); Replace(List2,List3,"TWICEN"); To_List("(SIMPLE=>(""NEW""),NESTED=>(""NEW""),TWICEN=>(""NEW""))",List4); Test(List2,List4,7); new_line; To_List ("( NEW_Token )", List3); To_Token("simple",Toke); Replace(List2,List3,Toke); To_List("(SIMPLE=>(New_Token),NESTED=>(""NEW""),TWICEN=>(""NEW""))",List4); Test(List2,List4,8); To_Token("NeStEd",Toke); Replace(List2,List3,Toke); To_List("(SIMPLE=>(New_Token),NESTED=>(New_Token),TWICEN=>(""NEW""))",List4); Test(List2,List4,9); To_Token("twiceN",Toke); Replace(List2,List3,Toke); To_List("(SIMPLE=>(New_Token),NESTED=>(New_Token),TWICEN=>(New_Token))",List4); Test(List2,List4,10); new_line; To_List ("( NEW_POSITION )", List3); Replace(List2,List3,1); To_List("(SIMPLE=>(New_Position),NESTED=>(New_Token),TWICEN=>(New_Token))", List4); Test(List2,List4,11); Replace(List2,List3,2); To_List("(SIMPLE=>(New_Position),NESTED=>(New_Position)," & "TWICEN=>(New_Token))",List4); Test(List2,List4,12); Replace(List2,List3,3); To_List("(SIMPLE=>(New_Position),NESTED=>(New_Position)," & "TWICEN=>(New_Position))",List4); Test(List2,List4,13); end Test17; ------------------------------------------------------------------------ --Tests the INSERT operation on list_items within a list 5.4.1.18-- ------------------------------------------------------------------------ procedure Test18 is use List_Utilities; use Identifier_Items; List1 : List_Type; List2 : List_Type; List3 : List_Type; Toke : Token_Type; procedure Test(L1 : String; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; L3 : List_Type; begin put_line(To_Text(L2)); To_List(L1, L3); put_line(To_Text(L3)); if Is_Equal(L3,L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List (" ((1), ((2)), (4,5)) ", List2); To_List ("( NEW )", List3); put_line(To_Text(List2)); Insert(List2,List3,3); Test( "((1), ((2)), (4,5), (NEW))", List2, 1); Insert(List2,List3,2); Test( "((1), ((2)), (NEW), (4,5), (NEW))", List2, 2); Insert(List2,List3,1); Test( "((1), (NEW), ((2)), (NEW), (4,5), (NEW))", List2, 3); Insert(List2,List3,0); new_line; To_List ("( )", List1); put_line(To_Text(List1)); Insert(List1,List3,0); put_line(To_Text(List1)); Test( "((NEW))", List1, 4); new_line; To_List("(SIMPLE=>(ll), NESTED=>(ll,(sub),(sub)), TWICEN=>((sub1,(sub2))))", List2); put_line(To_Text(List2)); Insert(List2,List3,"Isimple",0); Test("(ISIMPLE=>(NEW), SIMPLE=>(ll), NESTED=>(ll,(sub),(sub))," & "TWICEN=>((sub1,(sub2))))", List2, 5); Insert(List2,List3,"InEsTed",2); Test("(ISIMPLE=>(NEW), SIMPLE=>(ll), INESTED=>(NEW),NESTED=>(ll,(sub),(sub)),"& "TWICEN=>((sub1,(sub2))))", List2, 6); Insert(List2,List3,"ITWICEN",4); Test("(ISIMPLE=>(NEW), SIMPLE=>(ll), INESTED=>(NEW),NESTED=>(ll,(sub),(sub)),"& "ITWICEN=>(NEW), TWICEN=>((sub1,(sub2))))", List2, 7); new_line; To_List("(SIMPLE=>(ll), NESTED=>(ll,(sub),(sub)), TWICEN=>((sub1,(sub2))))",List2); To_List ("( NEW_Token )", List3); To_Token("Tsimple",Toke); Insert(List2,List3,Toke,0); put_line(To_Text(List2)); Test("(TSIMPLE=>(NEW_TOKEN), SIMPLE=>(ll), NESTED=>(ll,(sub),(sub))," & "TWICEN=>((sub1,(sub2))))", List2, 8); To_Token("TNeStEd",Toke); Insert(List2,List3,Toke,2); put_line(To_Text(List2)); Test("(TSIMPLE=>(NEW_TOKEN), SIMPLE=>(ll), TNESTED=>(NEW_TOKEN)," & "NESTED=>(ll,(sub),(sub))," & "TWICEN=>((sub1,(sub2))))", List2, 9); To_Token("TtwiceN",Toke); Insert(List2,List3,Toke,4); put_line(To_Text(List2)); Test("(TSIMPLE=>(NEW_TOKEN), SIMPLE=>(ll),TNESTED=>(NEW_TOKEN)," & "NESTED=>(ll,(sub),(sub))," & "TTWICEN=>(NEW_TOKEN), TWICEN=>((sub1,(sub2))))", List2, 10); end Test18; ------------------------------------------------------------------------ --Tests the POSITION_BY_VALUE operation on list_items in list 5.4.1.19-- ------------------------------------------------------------------------ procedure Test19 is use List_Utilities; use Identifier_Items; List1 : List_Type; List2 : List_Type; List3 : List_Type; Toke : Token_Type; XX : Position_Count; First : Position_Count; Last : Position_Count; procedure Test(L1 : Position_Count; L2 : Position_Count; II : Positive) is XX : string(1..35) := " "; begin put_line("EXPECT" & List_Utilities.Count'image(L1) & " => GET " & List_Utilities.Count'image(L2)); if L1 = L2 then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List (" ((1), ((2)), (4,5)) ", List2); put_line(To_Text(List2)); First := 1; Last := 1; To_List ("(1)", List3); Test(1, Position_By_Value(List2,List3,First,Last), 1); First := 2; Last := 3; To_List ("((2))", List3); Test(2, Position_By_Value(List2,List3,First,Last), 2); First := 2; Last := 3; To_List ("(4,5)", List3); Test(3, Position_By_Value(List2,List3,First,Last), 3); To_List ("(4,5)", List3); Test(3, Position_By_Value(List2,List3,First), 4); To_List ("(4,5)", List3); Test(3, Position_By_Value(List2,List3), 5); new_line; To_List("(SIMPLE=>(ll),NESTED=>(ll,(sub),(sub)),TWICEN=>((sub1,(sub2))))",List2); put_line(To_Text(List2)); First := 2; Last := 9; To_List (" (ll,(sub),(sub))", List3); Test(2, Position_By_Value(List2,List3,First,Last), 6); First := 3; Last := 3; To_List ("((sub1,(sub2)))", List3); Test(3, Position_By_Value(List2,List3,First,Last), 7); First := 1; Last := 9; To_List ("(ll)", List3); Test(1, Position_By_Value(List2,List3,First,Last), 8); First := 1; Last := 9; To_List ("( ll )", List3); Test(1, Position_By_Value(List2,List3,First,Last), 9); First := 3; Last := 3; To_List ("(( sub1, (sub2 )))", List3); Test(3, Position_By_Value(List2,List3,First,Last), 10); end Test19; ------------------------------------------------------------------------ --Quick test of list operations. Very quick. 5.4.1.23...-- ------------------------------------------------------------------------ procedure Testll is use List_Utilities; List1 : List_Type; List2 : List_Type; List3 : List_Type; procedure Test(L1 : List_Type; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; begin put_line(To_Text(L1)); if Is_Equal(L1,L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List (" (""1"", ""2"", ""4"") ", List2); To_List ("( ""3"" )", List1); Insert (List2, List1, 2); To_List (" (""1"", ""2"", (""3""), ""4"") ", List3); Test (List2, List3, 1); Extract (List2, 3, List3); Test (List1, List3, 2); end Testll; ------------------------------------------------------------------------ --Quick test of string operations. Very quick. 5.4.1.23...-- ------------------------------------------------------------------------ procedure Testss is use List_Utilities; use String_Items; List2 : List_Type; List3 : List_Type; List4 : List_Type; List5 : List_Type; XX : string(1..35) := " "; procedure Test(L1 : List_Type; L2 : List_Type; II : Positive) is XX : string(1..35) := " "; begin put_line(To_Text(L1)); if Is_Equal(L1,L2) then put_line(XX & "**************PASSES TEST " & Positive'Image(II) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(II) ); end Test; begin To_List (" (""1"", ""2"") ", List2); To_List (" (44, Id_44) ", List3); To_List (" (""1"", ""2"", 44, Id_44) ", List5); Merge(List2, List3, List4); Test(List4,List5,1); Insert (List4,"String Insertion Works",2); To_List (" (""1"", ""2"",""String Insertion Works"",44, Id_44) ",List5); Test(List4,List5,2); begin if "String Insertion Works" = Extract(List4,3) then put_line(XX & "**************PASSES TEST " & Positive'Image(3) ); else put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(3) ); end if; exception when others => put_line(XX & "!!!!!!!!!!!!!!!!!FAILS! TEST " & Positive'Image(3) ); end; Insert (List4,"",2); To_List("(""1"", ""2"", """", ""String Insertion Works"",44, Id_44)",List5); Test(List4,List5,4); Put_Line(Extract(List4,3) & "!!Even when null"); end Testss; begin Test13; Test14; Test15; Test16; Test17; Test18; Test19; Testll; Testss; end List_Test_13_ss; --:::::::::::::: --list_tstex.a --:::::::::::::: ------------------------------------------------------------------------ ----------------L I S T _ U T E X C E P T I O N T E S T------------- --These tests raise each of the possible exceptions specified in the -- --package of List_Utilities. -- ------------------------------------------------------------------------ ------------------------------------------------------------------------ with Cais; use Cais; with Text_Io; use Text_Io; procedure Test_Ex is use List_Utilities; use Identifier_Items; use String_Items; Package LU renames List_Utilities; Exceptions_Tested : constant := 90; Failures : integer := 0; Line_Count : integer; Expected : string(1..3); procedure Wrong_Exception(II: integer; SS: string) is begin Failures := Failures + 1; Line_Count := 10; new_line; put( integer'image(II) & ":**ERROR**" & " Received: " & SS & " Expected: " & Expected ); end Wrong_Exception; procedure No_Exception(Error: in string) is begin new_line; put(Error); Line_Count := 10; Failures := Failures + 1; end No_exception; procedure Raise_Exception(II: integer ) is Text : Natural; Token1 : Token_Type; String1 : string(1..3); Name1 : NameString(1..3); Posit1 : Position_Count; List1 : List_Type; List2 : List_Type; List3 : List_Type; Listtext: List_Text(1..10); Kind1 : Item_Kind; begin case II is --MIL STD 5.4.1.1 --not applicable --MIL STD 5.4.1.2 --no exceptions when 1 => --MIL STD 5.4.1.3 Expected := "Use"; --Use_Error Expected To_List("error", List1); No_Exception(" 1:**ERROR**TO_LIST: no ()"); when 2 => Expected := "Use"; --Use_Error Expected To_List("(error,,)", List1); No_Exception(" 2:**ERROR**TO_LIST: two ,,"); when 3 => Expected := "Use"; --Use_Error Expected To_List("(error,id_)", List1); No_Exception(" 3:**ERROR**TO_LIST: trailing _"); when 4 => Expected := "Use"; --Use_Error Expected To_List("(error,name=>""zz"")", List1); No_Exception(" 4:**ERROR**TO_LIST: mixed pos/name"); when 5 => Expected := "Use"; --Use_Error Expected To_List("(name=>1,1.1)", List1); No_Exception(" 5:**ERROR**TO_LIST: mixed name/pos"); --MIL STD 5.4.1.4 --no exceptions --MIL STD 5.4.1.5 --no exceptions when 6 => --MIL STD 5.4.1.6 Expected := "Use"; --Use_Error Expected To_List("(1,2)", List1); Delete(List1,3); No_Exception(" 6:**ERROR**DELETE: position too high"); when 7 => Expected := "Use"; --Use_Error Expected To_List("()", List1); Delete(List1,1); No_Exception(" 7:**ERROR**DELETE: null list"); when 8 => Expected := "Use"; --Use_Error Expected To_List("(1,2)", List1); Delete(List1,"No_Name"); No_Exception(" 8:**ERROR**DELETE: mixed pos/name"); when 9 => Expected := "Use"; --Use_Error Expected To_List("(1,2)", List1); To_Token("No_Name",Token1); Delete(List1,Token1); No_Exception(" 9:**ERROR**DELETE: mixed pos/token"); when 10 => Expected := "Use"; --Use_Error Expected To_List("(TWO=>2)", List1); To_Token("No_Name",Token1); new_line; put("*****AT ISSUE WITH MIL STD CAIS, FAILURE EXPECTED ON 10"); Delete(List1,Token1); No_Exception("**STD ISSUE**10:**ERROR**DELETE: bad name"); --MIL STD 5.4.1.7 --no exceptions --MIL STD 5.4.1.8 when 11 => Expected := "Sea"; --Search_Error Expected To_List("(TWO=>2)", List1); Kind1 := Get_Item_Kind(List1,"No_Name"); No_Exception("11:**ERROR**GET_ITEM_KIND: bad name"); when 12 => Expected := "Sea"; --Search_Error Expected To_List("(TWO=>2)", List1); To_Token("No_Name",Token1); Kind1 := Get_Item_Kind(List1,Token1); No_Exception("12:**ERROR**GET_ITEM_KIND: bad token"); when 13 => Expected := "Use"; --Use_Error Expected To_List("()", List1); Kind1 := Get_Item_Kind(List1,2); No_Exception("13:**ERROR**GET_ITEM_KIND: null list"); when 14 => Expected := "Use"; --Use_Error Expected To_List("(TWO=>2)", List1); Delete(List1,3); No_Exception("14:**ERROR**GET_ITEM_KIND: position high"); when 15 => --MIL STD 5.4.1.9 Expected := "Use"; --Use_Error Expected To_List("(1,3)", List1); To_List("( 2 )", List2); Splice(List1,5,List2); No_Exception("15:**ERROR**SPLICE: position high"); when 16 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List1); Splice(List1,3,"(2,,)"); No_Exception("16:**ERROR**SPLICE: bad list"); when 17 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List1); Splice(List1,3,"(I=>2)"); No_Exception("17:**ERROR**SPLICE: mixed pos/name"); when 18 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Splice(List1,3,"(I=>2)"); No_Exception("18:**ERROR**SPLICE: duplicate names"); when 19 => --MIL STD 5.4.1.10 Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); To_List("(I=>1,J=>3)", List2); Merge(List1,List2,List3); No_Exception("19:**ERROR**MERGE: duplicate names"); when 20 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); To_List("(1,3)", List2); Merge(List1,List2,List3); No_Exception("20:**ERROR**MERGE: mixed name/pos"); when 21 => --MIL STD 5.4.1.11 Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Listtext := Set_Extract(List1,4,4); No_Exception("21:**ERROR**SET_EXTRACT: position too high"); when 22 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Listtext := Set_Extract(List2,4,4); No_Exception("22:**ERROR**SET_EXTRACT: position too high"); --MIL STD 5.4.1.12 --no exceptions when 23 => --MIL STD 5.4.1.13 Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Text := Text_Length(List1,10); No_Exception("23:**ERROR**TEXT_LENGTH: position too high"); when 24 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Text := Text_Length(List2, "No_Name"); No_Exception("24:**ERROR**TEXT_LENGTH: mixed name/pos"); --*****NOTE************ --see test 90 also --for Text_Length --********************* when 25 => --MIL STD 5.4.1.14 Expected := "Use"; --Use_Error Expected To_List("(""I""=>1,""J""=>3)", List2); Item_Name(List2, 2, Token1); No_Exception("25:**ERROR**ITEM_NAME: mixed name/pos"); when 26 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Item_Name(List1, 4, Token1); No_Exception("26:**ERROR**ITEM_NAME: position too high"); when 27 => --MIL STD 5.4.1.15 Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Posit1 := Position_By_Name(List2, "No_Name"); No_Exception("27:**ERROR**POSITION_BY_NAME: mixed name/pos"); when 28 => Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>3)", List1); Posit1 := Position_By_Name(List1, "No_Name"); No_Exception("28:**ERROR**POSITION_BY_NAME: bad name"); when 29 => Expected := "Use"; --Use_Error Expected To_List("()", List1); Posit1 := Position_By_Name(List1, "No_Name"); No_Exception("29:**ERROR**POSITION_BY_NAME: empty list"); when 30 => --MIL STD 5.4.1.16 Expected := "Use"; --Use_Error Expected To_List("()", List1); Extract(List1, "No_Name", List2); No_Exception("30:**ERROR**EXTRACT: empty list"); when 31 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Extract(List1, 20, List2); No_Exception("31:**ERROR**EXTRACT: position too high"); when 32 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Extract(List1, "No_Name", List2); No_Exception("32:**ERROR**EXTRACT: mixed name/pos"); when 33 => Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>3)", List1); Extract(List1, "No_Name", List2); No_Exception("33:**ERROR**EXTRACT: bad name"); when 34 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Extract(List1, 12, List2); No_Exception("34:**ERROR**EXTRACT: bad position"); when 35 => --MIL STD 5.4.1.17 Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Replace(List2, List1, "No_Name"); No_Exception("35:**ERROR**REPLACE: mixed Name/pos"); when 36 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Replace(List1, List2, "I"); No_Exception("36:**ERROR**REPLACE: item not a list"); when 37 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Replace(List1, List2, 1); No_Exception("37:**ERROR**REPLACE: pos item not a list"); when 38 => Expected := "Use"; --Use_Error Expected To_List("()", List1); Replace(List1, List2, 2); No_Exception("38:**ERROR**REPLACE: empty list"); when 39 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Replace(List1, List2, 7); No_Exception("39:**ERROR**REPLACE: position too high"); when 40 => Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>3)", List1); Replace(List1, List2, "No_Name"); No_Exception("40:**ERROR**REPLACE: bad name"); when 41 => --MIL STD 5.4.1.18 Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Insert(List1, List2, 0); No_Exception("41:**ERROR**INSERT: mixed pos/name"); when 42 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Insert(List2, List1, "Try_Me",0); No_Exception("42:**ERROR**INSERT: mixed name/pos"); when 43 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Insert(List1, List2, "I", 0); No_Exception("43:**ERROR**INSERT: duplicate name"); when 44 => Expected := "Use"; --Use_Error Expected To_List("(1,3)", List2); Insert(List2, List1, 4); No_Exception("44:**ERROR**INSERT: bad position"); when 45 => --MIL STD 5.4.1.19 Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Posit1 := Position_By_Value(List1, List2, 4, 6); No_Exception("45:**ERROR**POSITION_BY_VALUE: high start"); when 46 => Expected := "Use"; --Use_Error Expected To_List("()", List2); Posit1 := Position_By_Value(List2, List1, 4, 6); No_Exception("46:**ERROR**POSITION_BY_VALUE: empty list"); when 47 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>3)", List1); Posit1 := Position_By_Value(List1, List2, 2, 1); No_Exception("47:**ERROR**POSITION_BY_VALUE: bad range"); when 48 => Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>3)", List1); Posit1 := Position_By_Value(List1, List2, 1, 2); No_Exception("48:**ERROR**POSITION_BY_VALUE: bad value"); when 49 => --MIL STD 5.4.1.20.1 Expected := "Use"; --Use_Error Expected To_Token("bad__format", Token1); No_Exception("49:**ERROR**TO_TOKEN: bad identifier syntax"); --MIL STD 5.4.1.20.2 --No Exceptions --MIL STD 5.4.1.20.3 --No Exceptions when 50 => --MIL STD 5.4.1.20.4 Expected := "Use"; --Use_Error Expected To_List("(ONE,TWO)", List2); Extract(List1, "No_Name", Token1); No_Exception("50:**ERROR**EXTRACT: mixed pos/name"); when 51 => Expected := "Sea"; --Search_Error Expected To_List("(I=>ONE,J=>TWO)", List1); Extract(List1, "No_Name", Token1); No_Exception("51:**ERROR**EXTRACT: bad name"); when 52 => Expected := "Use"; --Use_Error Expected To_List("(ONE,TWO)", List2); Extract(List2, 3, Token1); No_Exception("52:**ERROR**EXTRACT: bad position"); when 53 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Extract(List1, "I", Token1); No_Exception("53:**ERROR**EXTRACT: name item not a token"); when 54 => --MIL STD 5.4.1.10 Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Extract(List1, 1, Token1); No_Exception("54:**ERROR**EXTRACT: pos item not a token"); when 55 => Expected := "Use"; --Use_Error Expected To_List("()", List2); Extract(List2, 1, Token1); No_Exception("55:**ERROR**EXTRACT: empty list"); when 56 => --MIL STD 5.4.1.20.5 Expected := "Use"; --Use_Error Expected To_List("()", List2); Replace(List2, Token1, 1); No_Exception("56:**ERROR**REPLACE: empty list"); when 57 => Expected := "Use"; --Use_Error Expected To_List("(1,TWO)", List1); Replace(List1, Token1, "No_Name"); No_Exception("57:**ERROR**REPLACE: mixed name/pos"); when 58 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, Token1, 5); No_Exception("58:**ERROR**REPLACE: bad position"); when 59 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, Token1, "I"); No_Exception("59:**ERROR**REPLACE: name item not an ident"); when 60 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, Token1, 1); No_Exception("60:**ERROR**REPLACE: pos item not an ident"); when 61 => Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, Token1, "No_Name"); No_Exception("61:**ERROR**REPLACE: bad name"); when 62 => --MIL STD 5.4.1.20.6 Expected := "Use"; --Use_Error Expected To_List("(1,TWO)", List1); Insert(List1, Token1, "No_Name", 2); No_Exception("62:**ERROR**INSERT: mixed name/pos"); when 63 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Insert(List1, Token1, 1); No_Exception("63:**ERROR**INSERT: mixed pos/name"); when 64 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Insert(List1, Token1, "J", 0); No_Exception("64:**ERROR**INSERT: duplicate name"); when 65 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Insert(List1, Token1, Token1, 10); No_Exception("65:**ERROR**INSERT: bad position"); when 66 => --MIL STD 5.4.1.20.7 Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Posit1 := Position_By_Value(List1, "TWO", 7, 9); No_Exception("66:**ERROR**POSITION_BY_VALUE: high start"); when 67 => Expected := "Use"; --Use_Error Expected To_List("()", List1); Posit1 := Position_By_Value(List1, "TWO", 7, 9); No_Exception("66:**ERROR**POSITION_BY_VALUE: empty list"); when 68 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Posit1 := Position_By_Value(List1, "TWO", 2, 1); No_Exception("66:**ERROR**POSITION_BY_VALUE: bad range"); when 69 => Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>TWO)", List1); Posit1 := Position_By_Value(List1, "ONE", 1, 2); No_Exception("69:**ERROR**POSITION_BY_VALUE: bad value"); --MIL STD 5.4.1.21 --************** --NOT IMPLEMENTED --************** --MIL STD 5.4.1.22 --************** --NOT IMPLEMENTED --************** when 70 => --MIL STD 5.4.1.23.1 Expected := "Use"; --Use_Error Expected To_List("(ONE,TWO)", List2); String1 := Extract(List1, "No_Name"); No_Exception("70:**ERROR**EXTRACT: mixed pos/name"); when 71 => Expected := "Sea"; --Search_Error Expected To_List("(I=>ONE,J=>TWO)", List1); String1 := Extract(List1, "No_Name"); No_Exception("71:**ERROR**EXTRACT: bad name"); when 72 => Expected := "Use"; --Use_Error Expected To_List("(ONE,TWO)", List2); String1 := Extract(List2, 3); No_Exception("72:**ERROR**EXTRACT: position too high"); when 73 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); String1 := Extract(List1, "I"); No_Exception("73:**ERROR**EXTRACT: name item not a token"); when 74 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); String1 := Extract(List1, 1); No_Exception("74:**ERROR**EXTRACT: pos item not a token"); when 75 => Expected := "Use"; --Use_Error Expected To_List("()", List2); String1 := Extract(List2, 1); No_Exception("75:**ERROR**EXTRACT: empty list"); when 76 => --MIL STD 5.4.1.23.2 Expected := "Use"; --Use_Error Expected To_List("()", List2); Replace(List2, String1, 1); No_Exception("76:**ERROR**REPLACE: empty list"); when 77 => Expected := "Use"; --Use_Error Expected To_List("(1,TWO)", List1); Replace(List1, String1, "No_Name"); No_Exception("77:**ERROR**REPLACE: mixed name/pos"); when 78 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, String1, 5); No_Exception("78:**ERROR**REPLACE: bad position"); when 79 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, String1, "J"); No_Exception("79:**ERROR**REPLACE: name item not a string"); when 80 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, String1, 1); No_Exception("80:**ERROR**REPLACE: pos item not a string"); when 81 => Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, String1, "No_Name"); No_Exception("81:**ERROR**REPLACE: bad name"); when 82 => --MIL STD 5.4.1.23.3 Expected := "Use"; --Use_Error Expected To_List("(1,TWO)", List1); Insert(List1, String1, "No_Name", 2); No_Exception("82:**ERROR**INSERT: mixed name/pos"); when 83 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Replace(List1, String1, 1); No_Exception("83:**ERROR**INSERT: mixed pos/name"); when 84 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Insert(List1, String1, "J", 0); No_Exception("84:**ERROR**INSERT: duplicate name"); when 85 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Insert(List1, String1, 10); No_Exception("85:**ERROR**INSERT: bad position"); when 86 => --MIL STD 5.4.1.23.4 Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>TWO)", List1); Posit1 := Position_By_Value(List1, "ONE", 1, 2); No_Exception("86:**ERROR**POSITION_BY_VALUE: bad value"); when 87 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Posit1 := Position_By_Value(List1, "ONE", 8, 9); No_Exception("87:**ERROR**POSITION_BY_VALUE: high start"); when 88 => Expected := "Use"; --Use_Error Expected To_List("(I=>1,J=>TWO)", List1); Posit1 := Position_By_Value(List1, "ONE", 2, 1); No_Exception("88:**ERROR**POSITION_BY_VALUE: bad range"); when 89 => Expected := "Use"; --Use_Error Expected To_List("()", List1); Posit1 := Position_By_Value(List1, "ONE", 2, 3); No_Exception("88:**ERROR**POSITION_BY_VALUE: empty list"); when 90 => --MIL STD 5.4.1.13 Expected := "Sea"; --Search_Error Expected To_List("(I=>1,J=>3)", List2); Text := Text_Length(List2, "No_Name"); No_Exception("24:**ERROR**TEXT_LENGTH: bad name"); --******************************* --ERROR, SHOULD NEVER BE EXECUTED --******************************* when others => put_line( "******No test for: " & integer'image(II) ); end case; end Raise_Exception; begin Line_Count := 10; for I in 1..Exceptions_Tested loop begin if Line_Count = 10 then new_line; put("PASSES TEST: "); Line_Count := 0; end if; Raise_Exception(I); exception when Node_Definitions.Use_Error => if Expected /= "Use" then Wrong_Exception(I,"Use_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Search_Error => if Expected /= "Sea" then Wrong_Exception(I,"Search_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Constraint_Error => if Expected /= "Con" then Wrong_Exception(I,"Constraint_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; end; end loop; new_line; put_line("****************************T O T A L S***********************"); put_line("Number of tests run: " & integer'image(Exceptions_Tested)); put_line("Number of failures : " & integer'image(Failures) ); put_line("**************************************************************"); end Test_Ex; --:::::::::::::: --list_utilities_tests-body.a --:::::::::::::: ---------------------------------------------------------------------- -- List_Utilities_Tests -- (Package Body) -- -- -- A Set of Simple Test Subprograms To Exercise -- Portions of List_Utilities -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Mar 13 10:00:00 EST 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in package -- List_Utilities. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "main procedure" named Listutst. This procedure acts -- as a test driver, calling the different test functions in -- sequence. Output from the tests goes to Standard output -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- The test functions have two parameters: -- Verbosity - (Kinds_Of_Output) can have the following values: -- None - No messages are sent to Standard_Output -- Status - the test reports on its success or failure -- Dump - in addition to reporting on its success -- or failure, the test will print the -- string representation of the list(s) -- at the end of the test -- Die_On_Exception : Boolean - if true, an unexpected exception -- will be propogated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- Example: -- ------- -- See the procedure Listutst for all the examples you could -- ever want... -- -- Notes: -- ----- -- See the sections marked "--HACK" for temporary changes and -- "quick fixes". -- -- -- Revision History: -- ---------------- -- Mar 8 (CCH): Added the Verbosity and Die_On_Exception options. -- Mar 8 (CCH): Added the internal procedure Dump_List. -- Mar 12 (CCH): Added the internal procedure Report_Status. -- ------------------------------------------------------------------- with Cais; use Cais; with Text_IO; use Text_Io; package body List_Utilities_Tests is use List_Utilities; use String_Items; -- nested package within List_Utilities; ---------------------- D U M P _ L I S T ---------------------- -- -- Purpose: -- ------- -- To print the character string representation of a list_type -- to Std. Output. -- -- Parameters: -- ---------- -- Verbosity string will be printed only if this is set -- to DUMP. -- Item_Name A string to be printed along with the string -- representation. This allows the identification -- of which list_type is being dumped. -- List_Item the list_type item to be dumped. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- procedure Dump_List ( Verbosity : Kinds_Of_Output; Item_Name : String; List_Item : List_Type) is begin if Verbosity /= Dump then return; -- do nothing else Put (Item_Name); Put (" is stored as:"); Put_Line (To_Text (List_Item)); end if; end Dump_List; --------------------- R E P O R T _ S T A T U S -------------------- -- -- Purpose: -- ------- -- To print a descriptive test result message to Std. Output, -- governed by the level of output desired for the test. -- -- Parameters: -- ---------- -- Verbosity The message will be printed unless this is -- set to NONE. -- Msg The string representing the message to be printed. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- procedure Report_Status ( Verbosity : Kinds_Of_Output; Msg : String) is begin if Verbosity = None then return; -- do nothing else Put_Line (Msg); end if; end Report_Status; ---------------------- T E S T 0 0 1 ---------------------- -- -- Purpose: -- ------- -- Simple test of Copy with EMPTY_STRING. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- DUMP: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If true, an unhandled exception will be propogated. -- If False, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/fail of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test001 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result is Result : Test_Result := Fail; Sample_List : List_Type; begin Copy (Sample_List, EMPTY_LIST); if Get_List_Kind (Sample_List) /= Empty then Report_Status ( Verbosity, "LIST_UTILITIES TEST 001: SAMPLE_LIST /= EMPTY "); else Result := Pass; Report_Status ( Verbosity, "List_Utilities test 001: OK"); end if; -- Get_List_Kind (Sample_List) /= Empty Dump_List (Verbosity, "EMPTY_LIST", EMPTY_LIST); return Result; exception when others => Report_Status (Verbosity, "**** LIST_UTILITIES TEST 001: UNHANDLED EXCEPTION"); Dump_List (Verbosity, "EMPTY_LIST", EMPTY_LIST); if Die_On_Exception then raise; else return (Fail); end if; end Test001; ---------------------- T E S T 0 0 2 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- DUMP: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If true, an unhandled exception will be propogated. -- If False, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/fail of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test002 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result is Result : Test_Result := Pass; Sample_List : List_Type; begin Copy (Sample_List, EMPTY_LIST); if Length (Sample_List) /= 0 then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 002: EMPTY LIST LENGTH /= 0."); end if; Insert (Sample_List, List_Item => "12345", Named => "String_1", Position => 0); if Get_List_Kind (Sample_List) /= Named then Result := Fail; Report_Status ( Verbosity, "LIST_UTILITIES TEST 002: SAMPLE_LIST /= NAMED"); end if; if Result = Pass then Report_Status (Verbosity, "List_Utilities test 002: OK"); end if; Dump_List (Verbosity, "SAMPLE_LIST", Sample_List); return Result; exception when others => Report_Status (Verbosity, "**** LIST_UTILITIES TEST 002: UNHANDLED EXCEPTION"); Dump_List (Verbosity, "EMPTY_LIST", EMPTY_LIST); if Die_On_Exception then raise; else return (Fail); end if; end Test002; ---------------------- T E S T 0 0 3 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- DUMP: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If true, an unhandled exception will be propogated. -- If False, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/fail of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test003 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result is Result : Test_Result := Pass; Sample_List : List_Type; Found_First : Boolean := False; begin Copy (Sample_List, EMPTY_LIST); Insert (Sample_List, List_Item => "12345", Named => "String1", Position => 0); if Length (Sample_List) /= 1 then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 003: LENGTH /= 1"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; if Extract (Sample_List, "String1") /= "12345" then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 003: String1 /= 12345"); Dump_List (Verbosity, "Sample_List", Sample_List); else Found_First := True; end if; if Extract (Sample_List, "StRiNg1") /= "12345" then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 003: StRiNg1 /= 12345"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; if Text_Length (Sample_List, "String1") /= 5 then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 003: TEXT LENGTH /= 7"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; if Result = Pass then Report_Status (Verbosity, "List_Utilities test 003: OK"); end if; Dump_List (Verbosity, "Sample_List", Sample_List); return Result; exception when Search_Error => if Found_First then Report_Status (Verbosity, "LIST_UTILITIES TEST 003: CAN'T FIND StRiNg1"); Dump_List (Verbosity, "Sample_List", Sample_List); else Report_Status (Verbosity, "LIST_UTILITIES TEST 003: CAN'T FIND String1"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; if Die_On_Exception then raise; else return (Fail); end if; when others => Report_Status (Verbosity, "**** LIST_UTILITIES TEST 003: UNHANDLED EXCEPTION"); Dump_List (Verbosity, "Sample_List", Sample_List); if Die_On_Exception then raise; else return (Fail); end if; end Test003; ---------------------- T E S T 0 0 4 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- DUMP: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If true, an unhandled exception will be propogated. -- If False, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/fail of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test004 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result is Result : Test_Result := Pass; Sample_List : List_Type; Phyl : File_Type; Str : String (1..400) := (others => ' '); Str_Len : Natural; begin Copy (Sample_List, EMPTY_LIST); Insert (Sample_List, List_Item => "12345", Named => "String1", Position => 0); OPEN_FILE: begin -- to trap exception here Open (Phyl, Out_File, "Phyl.tmp"); exception when Name_Error => Create (Phyl, Out_File, "Phyl.tmp"); end OPEN_FILE; Put_Line (Phyl, To_Text (Sample_List)); Copy (Sample_List, EMPTY_LIST); if Length (Sample_List) /= 0 then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 004: RESET LIST LENGTH /= 0"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; Close (Phyl); Open (Phyl, In_File, "Phyl.tmp"); Get_Line (Phyl, Str, Str_Len); To_List (Str (1..Str_Len), Sample_List); if Get_List_Kind (Sample_List) /= Named then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 004: Sample_List is not Named"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; if Extract (Sample_List, "String1") /= "12345" then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 004: String1 /= 123435"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; if Result = Pass then Report_Status (Verbosity, "List_Utilities test 004: OK"); Dump_List (Verbosity, "Sample_List", Sample_List); end if; return Result; exception when Search_Error => Report_Status (Verbosity, "LIST_UTILITIES TEST 004: CAN'T FIND String1"); Dump_List (Verbosity, "Sample_List", Sample_List); if Die_On_Exception then raise; else return (Fail); end if; when others => Report_Status (Verbosity, "**** LIST_UTILITIES TEST 004: UNHANDLED EXCEPTION"); Dump_List (Verbosity, "EMPTY_LIST", EMPTY_LIST); if Die_On_Exception then raise; else return (Fail); end if; end Test004; ---------------------- T E S T 0 0 5 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- DUMP: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If true, an unhandled exception will be propogated. -- If False, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/fail of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test005 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result is Result : Test_Result := Pass; List_One : List_Type; List_Two : List_Type; Phyl : File_Type; Str : String (1..256) := (others => ' '); Str_Len : Natural; begin Copy (List_One, EMPTY_LIST); Copy (List_Two, EMPTY_LIST); Insert (List_One, List_Item => "'USER(THOMPSON).GONZO", Named => "Parent", Position => 0); Insert (List_Two, List_Item => "SECONDARY_STORAGE", Named => "File_Kind", Position => 0); Insert (List_Two, List_Item => "TEXT", Named => "Access_Method", Position => 0); if Length (List_One) /= 1 then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 005: LIST_ONE LENGTH /= 1"); Dump_List (Verbosity, "List_One", List_One); end if; if Length (List_Two) /= 2 then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 005: LIST_TWO LENGTH /= 2"); Dump_List (Verbosity, "List_Two", List_Two); end if; Insert ( List => List_One, List_Item => List_Two, Named => "Attributes", Position => 0); if Length (List_One) /= 2 then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 005: LIST_ONE LENGTH /= 2"); Dump_List (Verbosity, "List_One", List_One); end if; OPEN_FILE: begin -- to trap exception here Open (Phyl, Out_File, "Phyl2.tmp"); exception when Name_Error => Create (Phyl, Out_File, "Phyl2.tmp"); end OPEN_FILE; Put_line (Phyl, To_Text (List_One)); Close (Phyl); Copy (List_Two, EMPTY_LIST); Open (Phyl, In_File, "Phyl2.tmp"); Get_Line (Phyl, Str, Str_Len); To_List (Str (1..Str_Len), List_Two); Copy (List_One, EMPTY_LIST); Extract ( List => List_Two, Named => "Attributes", List_Item => List_One); if Extract (List_One, "File_Kind") /= "SECONDARY_STORAGE" then Result := Fail; Report_Status (Verbosity, "LIST_UTILITIES TEST 005: FILE_KIND IS WRONG"); Dump_List (Verbosity, "List_One", List_One); end if; if Result = Pass then Report_Status (Verbosity, "List_Utilities test 005: OK"); Dump_List (Verbosity, "List_One", List_One); Dump_List (Verbosity, "List_Two", List_Two); end if; return Result; exception when Search_Error => Report_Status (Verbosity, "LIST_UTILITIES TEST 005: SEARCH_ERROR"); Dump_List (Verbosity, "List_One", List_One); Dump_List (Verbosity, "List_Two", List_Two); if Die_On_Exception then raise; else return (Fail); end if; when others => Report_Status (Verbosity, "**** LIST_UTILITIES TEST 005: UNHANDLED EXCEPTION"); Dump_List (Verbosity, "EMPTY_LIST", EMPTY_LIST); if Die_On_Exception then raise; else return (Fail); end if; end Test005; ---------------------- T E S T 0 0 6 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- DUMP: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If true, an unhandled exception will be propogated. -- If False, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/fail of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- -- function Test006 ( -- Verbosity : Kinds_Of_Output := Dump; -- Die_On_Exception : Boolean := True) -- return Test_Result is -- -- Result : Test_Result := Fail; -- -- begin -- -- return Result; -- -- exception -- -- when others => -- Report_Status (Verbosity, -- "**** LIST_UTILITIES TEST 006: UNHANDLED EXCEPTION"); -- Dump_List (Verbosity, "EMPTY_LIST", EMPTY_LIST); -- -- if Die_On_Exception then -- raise; -- else -- return (Fail); -- end if; -- end Test006; end List_Utilities_Tests; --:::::::::::::: --list_utilities_tests-spec.a --:::::::::::::: ---------------------------------------------------------------------- -- List_Utilities_Tests -- (Package Specification) -- -- -- A Set of Simple Test Subprograms To Exercise -- Portions of List_Utilities -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Mar 13 10:00:00 EST 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in package -- List_Utilities. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "main procedure" named Listutst. This procedure acts -- as a test driver, calling the different test functions in -- sequence. Output from the tests goes to Standard output -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- The test functions have two parameters: -- Verbosity - (Kinds_Of_Output) can have the following values: -- None - No messages are sent to Standard_Output -- Status - the test reports on its success or failure -- Dump - in addition to reporting on its success -- or failure, the test will print the -- string representation of the list(s) -- at the end of the test -- Die_On_Exception : Boolean - if true, an unexpected exception -- will be propogated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- Example: -- ------- -- See the procedure Listutst for all the examples you could -- ever want... -- -- Notes: -- ----- -- -- Revision History: -- ---------------- -- Mar 8 (CCH): Added the Verbosity and Die_On_Exception options. -- ------------------------------------------------------------------- package List_Utilities_Tests is type Test_Result is (Pass, Fail); type Kinds_Of_Output is (None, Status, Dump); function Test001 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result; function Test002 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result; function Test003 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result; function Test004 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result; function Test005 ( Verbosity : Kinds_Of_Output := Dump; Die_On_Exception : Boolean := True) return Test_Result; end List_Utilities_Tests; --:::::::::::::: --listutst.a --:::::::::::::: ---------------------------------------------------------------------- -- Listutst -- -- -- Test Driver for Tests of Package List_Utilities -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Mon Mar 11 10:00:15 EST 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- This is the test driver for the suite of tests in the package -- List_Utilities_Tests. -- -- Usage: -- ----- -- -- Example: -- ------- -- -- Notes: -- ----- -- The use of compile-time constants to determine the test -- configuration is LAME; this should be changed to an interactive -- mode (that can be run from a command language file) soon. -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- with Text_IO, List_Utilities_Tests; use Text_IO, List_Utilities_Tests; procedure Listutst is Valid_Response : Boolean := FALSE; Phyl : File_Type; MAX_FILENAME : constant Natural := 39; Phyl_Name : String (1..30); Name_Length : Natural; type Response is (YES,NO); Redir : Response; package YesNo is new Enumeration_IO (Response); use YesNo; package Pos_IO is new Integer_IO (Positive); use Pos_IO; -- Edit these for different "test configuration" -- at least until this turkey becomes more interactive (and -- then these would be the default values...) TEST_OUTPUT : constant Kinds_Of_Output := Status; ABORT_ON_EXCEPTION : constant Boolean := TRUE; MAX_TESTS : constant Positive := 5; -- Max # of tests run subtype Test_Count is Natural range 0..MAX_TESTS; Results : array (1..MAX_TESTS) of Test_Result; Error_Count : Test_Count := 0; Current_Test : Test_Count := 0; begin while not Valid_Response loop Put ("Do you want output redirected to a file? (yes or no):"); GET_ANSWER: begin Get (Redir); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER EITHER YES OR NO ONLY."); end GET_ANSWER; end loop; Skip_Line (Standard_Input); if Redir = Yes then Put ("Please enter the filename for redirected output:"); Get_Line (Phyl_Name, Name_Length); OPEN_FILE: begin Open (Phyl, Out_File, Phyl_Name (1..Name_Length)); Delete (Phyl); Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); exception when NAME_ERROR => Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); end OPEN_FILE; Set_Output (Phyl); end if; Put_Line ("**** Beginning Execution of List_Utilities_Tests ****"); Put (" TEST_OUTPUT is set to "); Put_Line (Kinds_Of_Output'Image(TEST_OUTPUT)); Put (" ABORT_ON_EXCEPTION is set to "); Put_Line (Boolean'Image(ABORT_ON_EXCEPTION)); Put (" MAX_TESTS is set to "); Put (MAX_TESTS); New_Line(2); Current_Test := 1; Results (Current_Test) := Test001 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := 2; Results (Current_Test) := Test002 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := 3; Results (Current_Test) := Test003 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := 4; Results (Current_Test) := Test004 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := 5; Results (Current_Test) := Test005 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; -- Produce Summary New_Line; Put_Line ("**** End of List_Utilities_Tests ****"); if Error_Count = 0 then New_Line; Put_Line ("NO TESTS FAILED. HUZZAH!"); else New_Line; Put ("A total of "); Put (Error_Count); Put_Line (" Test(s) failed."); Put_Line ("The following test(s) failed:"); for I in 1..MAX_TESTS loop if Results (I) = fail then Put ("Test number "); Put (I); New_Line; end if; end loop; end if; end Listutst; --:::::::::::::: --natt_tst_all.a --:::::::::::::: with Cais; use Cais; with Text_Io; use Text_Io; Procedure Natt_Tst_All is use Node_Management; use Node_Definitions; use Attributes; use List_Utilities; Time_Value_1 : List_Type; Time_Value_2 : List_Type; Verification_1: List_Type; Verification_2: List_Type; Work_List : List_Type; Open_Node : Cais.Node_Type; Mike_Node : Cais.Node_Type; procedure Print_Attributes(Node : Cais.Node_Type; Text : string) is Name : Attribute_Name(1..20); Value : List_Type; Selected : Attribute_Iterator; begin put_line(Text); Node_Attribute_Iterate(Selected, Node); while more(Selected) loop Name := " "; Get_Next(Selected, Name, Value); Put(" "); Put(Name); Put("=> "); Put(To_Text(Value)); new_line; end loop; end Print_Attributes; procedure Print_Value(List1: List_Type; List2: List_Type) is begin if Is_Equal(List1, list2) then put_line("TEST PASSES: FOUND " & To_Text(List2)); else put_line("***ERROR***"); put_Line(" LIST1 is " & To_Text(List1) ); put_Line(" LIST2 is " & To_Text(List2) ); end if; end Print_Value; begin To_List("(Hour=>12, Minute=>30, Seconds=>49)", Time_Value_1 ); To_List("(Hour=>10, Minute=>15, Seconds=>17)", Time_Value_2 ); To_List("(true)", Verification_1 ); To_List("(false)", Verification_2 ); Open(Open_Node, "'current_node.howell", (1=>write, 2=>read)); --CREATE(5.1.3.1 AND 2) Create_Node_Attribute(Open_Node, "Time", Time_Value_1); Create_Node_Attribute(Open_Node, "Verified", Verification_1); Create_Node_Attribute("mike", "Time", Time_Value_2); Print_Attributes(Open_Node,"TST_NODE1 EXPECTS: time, verified"); Open(Mike_Node, "'current_node.mike", (1=>write, 2=>read)); Print_Attributes(Mike_Node,"TST_NODE2 EXPECTS: time"); Close(Mike_Node); --GET(5.1.3.7 AND 8) Get_Node_Attribute(Open_Node, "Time", Work_List); Print_Value(Work_List, Time_Value_1); Get_Node_Attribute(Open_Node, "Verified", Work_List); Print_Value(Work_List, Verification_1); Get_Node_Attribute("mike", "Time", Work_List); Print_Value(Work_List, Time_Value_2); --SET(5.1.3.5 AND 6) Set_Node_Attribute(Open_Node, "Time", Time_Value_2); Set_Node_Attribute(Open_Node, "Verified", Verification_2); Set_Node_Attribute("mike", "Time", Time_Value_2); Print_Attributes(Open_Node,"TST_NODE1 EXPECTS: time=101517, verified=false"); Open(Mike_Node, "'current_node.mike", (1=>write, 2=>read)); Print_Attributes(Mike_Node,"TST_NODE2 EXPECTS: time=101517"); Close(Mike_Node); --DELETE(5.1.3.3 AND 4) Delete_Node_Attribute(Open_Node, "Verified"); Print_Attributes(Open_Node,"ONLY TIME EXPECTED: "); Delete_Node_Attribute(Open_Node, "Time"); Print_Attributes(Open_Node,"NOTHING EXPECTED : "); Delete_Node_Attribute("mike", "Time"); Open(Mike_Node, "'current_node.mike", (1=>write, 2=>read)); Print_Attributes(Mike_Node,"NOTHING EXPECTED : "); Close(Mike_Node); end Natt_Tst_All; --:::::::::::::: --natt_tst_it.a --:::::::::::::: with Cais; use Cais; with Text_Io; use Text_Io; Procedure Natt_Tst_It is use Attributes; use List_Utilities; use Node_Management; use Node_Definitions; Node : Cais.Node_Type; procedure Test_Setup is NULL_LIST : LIST_TYPE; begin To_List("()", NULL_LIST); Create_Node_Attribute(Node,"ammamma",NULL_LIST); Create_Node_Attribute(Node,"axxaxxa",NULL_LIST); Create_Node_Attribute(Node,"a ",NULL_LIST); Create_Node_Attribute(Node,"m ",NULL_LIST); Create_Node_Attribute(Node,"z ",NULL_LIST); Create_Node_Attribute(Node,"aaa ",NULL_LIST); Create_Node_Attribute(Node,"xxx ",NULL_LIST); Create_Node_Attribute(Node,"ax ",NULL_LIST); Create_Node_Attribute(Node,"xx ",NULL_LIST); Create_Node_Attribute(Node,"xz ",NULL_LIST); Create_Node_Attribute(Node,"axz ",NULL_LIST); Create_Node_Attribute(Node,"amz ",NULL_LIST); Create_Node_Attribute(Node,"xmx ",NULL_LIST); Create_Node_Attribute(Node,"xmxz ",NULL_LIST); Create_Node_Attribute(Node,"xmxm ",NULL_LIST); Create_Node_Attribute(Node,"axxz ",NULL_LIST); Create_Node_Attribute(Node,"am ",NULL_LIST); Create_Node_Attribute(Node,"az ",NULL_LIST); Create_Node_Attribute(Node,"aazz ",NULL_LIST); Create_Node_Attribute(Node,"aaxx ",NULL_LIST); Create_Node_Attribute(Node,"xxzz ",NULL_LIST); Create_Node_Attribute(Node,"aa ",NULL_LIST); Create_Node_Attribute(Node,"aaaa ",NULL_LIST); Create_Node_Attribute(Node,"axa ",NULL_LIST); Create_Node_Attribute(Node,"axxa ",NULL_LIST); Create_Node_Attribute(Node,"axaxa ",NULL_LIST); end Test_Setup; procedure Print_Iterator(Selector: Attribute_Pattern; Amount : integer) is Name : Attribute_Name(1..15); Value : List_Type; II : integer range 0..400 := 0; Selected : Attribute_Iterator; begin Put(Selector & " EXPECTS: " & integer'image(Amount) ); Node_Attribute_Iterate(Selected, Node, Selector); while More(Selected) loop Name := (others => ' '); Get_Next(Selected, Name, Value); if II mod 3 = 0 then New_Line; Put(" "); end if; Put(Name); Put( "=>" & To_Text(Value)); II := II+1; end loop; New_Line; Put_Line(Selector & "***FINDS: " & integer'image(II) & "********"); end Print_Iterator; begin put_line("The total set consists of :"); put_line(" a aa aaa aaaa aaxx aazz "); put_line(" am ammamma amz ax axa axaxa "); put_line(" axz axxa axxaxxa axxz az "); put_line(" m xmx xmxm xmxz xx xxx "); put_line(" xxzz xz z "); Open(Node, "'current_node", (1=>read, 2=>write)); Test_Setup; Put_Line("**********************************************************"); Put_Line("**NOTE: expected results do not account for meaningful **"); Put_Line("** attributes already associated with the node. If**"); Put_Line("** they occur, just check that they conform to the **"); Put_Line("** pattern submitted. **"); Put_Line("**********************************************************"); Print_Iterator("????????", 0); Print_Iterator("???", 6); Print_Iterator("?", 3); Print_Iterator("?z", 2); Print_Iterator("?m?", 2); Print_Iterator("?m?z", 1); Print_Iterator("?m?j", 0); Print_Iterator("a?z", 2); Print_Iterator("a??z", 2); Print_Iterator("a?", 4); Print_Iterator("*", 26); Print_Iterator("***", 26); Print_Iterator("a*", 17); Print_Iterator("aa*", 5); Print_Iterator("a*a*a", 5); Print_Iterator("*z", 9); Print_Iterator("*zz", 2); Print_Iterator("*x*", 15); Print_Iterator("*xx*", 7); Print_Iterator("*m*", 7); Print_Iterator("a*a", 8); Print_Iterator("*m??", 3); Print_Iterator("a??*", 12); Print_Iterator("*?*?*", 23); Print_Iterator("amz", 1); Print_Iterator("a", 1); Print_Iterator("z", 1); end Natt_Tst_It; --:::::::::::::: --new_user.a --:::::::::::::: with Cais; use Cais; procedure New_User is begin Add_User; end New_User; --:::::::::::::: --node_management_tests-body.a --:::::::::::::: ---------------------------------------------------------------------- -- N O D E _ M A N A G E M E N T _ T E S T S -- (Package Body) -- -- -- A Set of Simple Test Subprograms To Exercise -- Portions of Node_Management -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Fri Feb 21 14:47:34 EST 1986 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in package -- Node_Management. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "main procedure" named Node_Mgmt. This procedure acts -- as a test driver, calling the different test functions in -- sequence. Output from the tests can be redirected to a file, -- or sent to Standard_Output. -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- The test functions have two parameters: -- Verbosity - (Kinds_Of_Output) can have the following values: -- None - No messages are sent to Standard_Output -- Status - the test reports on its success or failure -- Die_On_Exception : Boolean - if FALSE, an unexpected exception -- will be propogated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- Example: -- ------- -- See the procedure Node_Mgmt for all the examples you could -- ever want... -- -- Notes: -- ----- -- None. -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- with Text_IO; use Text_IO; with Cais; use Cais; package body Node_Management_Tests is use Node_Definitions; use Node_Management; use Structural_Nodes; --------------------- R E P O R T _ S T A T U S -------------------- -- -- Purpose: -- ------- -- To print a descriptive test result message to Std. Output, -- governed by the level of output desired for the test. -- -- Parameters: -- ---------- -- Verbosity The message will be printed unless this is -- set to NONE. -- Msg The string representing the message to be printed. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- procedure Report_Status ( Verbosity : Kinds_Of_Output; Msg : String) is begin if Verbosity = NONE then return; -- do nothing else Put_Line (Msg); end if; end Report_Status; ---------------------- T E S T 0 0 1 ---------------------- -- -- Purpose: -- ------- -- Test that NAME_ERROR is raised with a syntax error in the pathname -- for Node_Management.Open. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test001 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; Node : Node_Definitions.Node_Type; begin Node_Management.Open (Node, "wazoo??"); return Result; exception when Node_Definitions.NAME_ERROR => Report_Status (Verbosity, "Test 001: Bad Pathname raised " & " NAME_ERROR correctly"); return PASS; when OTHERS => Report_Status (Verbosity, "**** Test 001: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return FAIL; end if; end Test001; ---------------------- T E S T 0 0 2 ---------------------- -- -- Purpose: -- ------- -- Test if Open called with an Open node handle will raise STATUS_ERROR -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test002 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; Node : Node_Definitions.Node_Type; begin Node_Management.Open (Node, "'Parent"); Node_Management.Open (Node, CURRENT_NODE); exception when Node_Definitions.STATUS_ERROR => Report_Status (Verbosity, "Test 002: Node_Management.Open with Open node " & "handle raised STATUS_ERROR correctly"); return PASS; when OTHERS => Report_Status (Verbosity, "**** Test 002: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test002; ---------------------- T E S T 0 0 3 ---------------------- -- -- Purpose: -- ------- -- This is a simple test of Is_Same. Two nodes to the same pathname -- are Node_Management.Opened; they should be the same. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test003 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := PASS; Node1, Node2, Node3 : Node_Definitions.Node_Type; begin Node_Management.Open (Node1, CURRENT_NODE); Node_Management.Open (Node2, CURRENT_NODE); if not Is_Same (Node1, Node2) then Report_Status (Verbosity, "Test 003 Is_Equal is FALSE for" & " equal nodes"); Result := FAIL; end if; Node_Management.Open (Node3, "'Current_Job"); if Is_Same (Node1, Node3) then Report_Status (Verbosity, "Test 003 Is_Equal is TRUE for" & " nodes not equal"); Result := FAIL; end if; if Result = PASS then Report_Status (Verbosity, "Test 003 Is_Equal is OK"); end if; return Result; exception when OTHERS => Report_Status (Verbosity, "**** Test 003: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test003; ---------------------- T E S T 0 0 4 ---------------------- -- -- Purpose: -- ------- -- To test that Node_Management.Open with a pathname and Node_Management.Open with a base node handle -- return a node handle to the same node when the base, rel name, -- and rel key are equivalent to the pathname. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- --------------------------------------------------------------------- function Test004 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Node1, Node2, Base : Node_Definitions.Node_Type; begin Node_Management.Open (Node1, "'Current_Node"); Node_Management.Open (Base, "'Current_Node'Job"); Node_Management.Open (Node2, Base => Base, Key => "", Relation => "Parent"); if Is_Same (Node1, Node2) then Report_Status (Verbosity, "Test 004: Different Node_Management.Open" & " interfaces are equivalant."); return PASS; end if; return FAIL; exception when OTHERS => Report_Status (Verbosity, "**** Test 004: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test004; ---------------------- T E S T 0 0 5 ---------------------- -- -- Purpose: -- ------- -- To test the behavior of Node_Management.Close on a Node_Management.Closed node handle and -- a node handle that was never Node_Management.Opened. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test005 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Node1, Node2 : Node_Definitions.Node_Type; Result : Test_Result := PASS; begin Node_Management.Close (Node1); Node_Management.Open (Node1, "'parent"); Node_Management.Close (Node1); Node_Management.Close (Node1); -- if we get here, everything went as expected... Report_Status (Verbosity, "Test 005: Node_Management.Close worked as advertised."); return PASS; exception when OTHERS => Report_Status (Verbosity, "**** Test 005: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test005; ---------------------- T E S T 0 0 6 ---------------------- -- -- Purpose: -- ------- -- Exercise the Link and Unlink services. First, -- attempt an Node_Management.Open for a relationship that does not exist (after -- an Unlink to ensure that the relationship does not exist). -- Try to create a link with a predefined relation name. -- Then create a link, and try the Node_Management.Open again. Remove the link. -- Try to unlink a nonexistant relationship; try to unlink a -- primary relationship. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test006 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Base_Node, Target_Node : Node_Definitions.Node_Type; begin Block1: -- use Unlink to ensure this link doesn't exist begin Unlink ("'Current_Node'Test_Relation(Test_Key)"); exception when Node_Definitions.Name_Error => null; when others => Report_Status (Verbosity, "**** Test 006: Block1 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block1; Block2: -- try an Node_Management.Open with nonexistant link begin Node_Management.Open (Base_Node, "'Current_Node'Test_Relation(Test_Key)"); -- ?huh? We shouldn't be here! Report_Status (Verbosity, "**** Test 006: Block2 Node_Management.Open did NOT Fail"); return Fail; exception when Node_Definitions.Name_Error => null; when others => Report_Status (Verbosity, "**** Test 006: Block2 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block2; Node_Management.Close (Base_Node); Block3: -- Node_Management.Open target node, create link to it begin Node_Management.Open (Target_Node, "'Current_Node'Job"); Link (Target_Node, "'Current_Node'Test_Relation(Test_Key)"); exception when others => Report_Status (Verbosity, "**** Test 006: Block3 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block3; Block4: -- try the Node_Management.Open again begin Node_Management.Open (Base_Node, "'Current_Node'Test_Relation(Test_Key)"); exception when others => Report_Status (Verbosity, "**** Test 006: Block4 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block4; Block5: -- Try Unlink again begin Unlink ("'Current_Node'Test_Relation(Test_Key)"); exception when others => Report_Status (Verbosity, "**** Test 006: Block5 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block5; Block6: -- Try Unlink with Predefined primary relation begin Unlink ("'Current_Node'Job"); -- ?huh? We shouldn't be here! Report_Status (Verbosity, "**** Test 006: Block6 Unlink did NOT Fail"); return Fail; exception when Node_Definitions.Use_Error => null; when others => Report_Status (Verbosity, "**** Test 006: Block6 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block6; Block7: -- Try Unlink with nonexistant relation begin Node_Management.Close (Base_Node); Node_Management.Open (Base_Node, "'Current_Node", Intent => (1 => Exclusive_Write, 2=> Read_Relationships)); Unlink (Base_Node, Key => "Bogus", Relation => "swill"); -- ?huh? We shouldn't be here! Report_Status (Verbosity, "**** Test 006: Block7 Unlink did NOT Fail"); return Fail; exception when Node_Definitions.Name_Error => null; when others => Report_Status (Verbosity, "**** Test 006: Block7 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block7; -- If we finally get here, the test was passed! return Pass; exception when others => Report_Status (Verbosity, "**** Test 006: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test006; ---------------------- T E S T 0 0 7 ---------------------- -- -- Purpose: -- ------- -- This test exercises a variety of Node_Management services and -- their interactions. The node 'Current_Node'Test_Rel(Test_Key) -- is deleted (in case it existed prior to the running of this -- test), then created. Is_Obtainable should then return True for -- that node. The node handle is Closed, then Opened for existence -- intent only. Is_Obtainable should still return True. The -- node is again Closed, and Opened for Write intent. An attempt -- to delete the node should then raise an Intent_Violation. -- Finally, the node is Opened with Exclusive_Write and Read intents, -- and deleted. An Open with Existence Intent should still be ok, -- and Is_Obtainable should now return False. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- This test uses Structural_Nodes.Create. -- --------------------------------------------------------------------- function Test007 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; Node : Node_Definitions.Node_Type; begin Block1: -- delete the node (just in case it exists) begin Node_Management.Open (Node, "'Current_Node'Test_Rel(Test_Key)", Intent => (1 => Exclusive_Write, 2 => Read)); Delete_Node (Node); exception when Node_Definitions.Name_Error => null; when others => Report_Status (Verbosity, "**** Test 007: Block1 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block1; Node_Management.Close (Node); Block2: -- now create the test node begin Structural_Nodes.Create_Node ("'Current_User'Test_Rel(Test_Key)"); exception when others => Report_Status (Verbosity, "**** Test 007: Block2 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block2; Block3: -- Node_Management.Open it for Existence begin Node_Management.Open (Node, "'Current_User'Test_Rel(Test_Key)", Intent => (1 => Existence)); if not Is_Obtainable (Node) then Report_Status (Verbosity, "Test 007: Block3 Is_Obtainable failed"); return (Fail); end if; exception when others => Report_Status (Verbosity, "**** Test 007: Block3 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block3; Node_Management.Close (Node); Block4: -- Node_Management.Open without Intents required for Node_Delete begin Node_Management.Open (Node, "'Current_User'Test_Rel(Test_Key)", Intent => (1 =>Read)); Delete_Node (Node); exception when Intent_Violation => null; when others => Report_Status (Verbosity, "**** Test 007: Block4 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block4; Node_Management.Close (Node); Block5: -- Node_Management.Open with Intents required for Node_Delete begin Node_Management.Open (Node, "'Current_User'Test_Rel(Test_Key)", Intent => (1 => Exclusive_Write, 2 => Read)); Delete_Node (Node); exception when others => Report_Status (Verbosity, "**** Test 007: Block5 failed"); if Die_On_Exception then raise; else return (FAIL); end if; end Block5; Node_Management.Close (Node); -- if we get here, everything was copasetic... return Pass; exception when others => Report_Status (Verbosity, "**** Test 007: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test007; ---------------------- T E S T 0 0 8 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test008 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 008: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test008; ---------------------- T E S T 0 0 9 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test009 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 009: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test009; ---------------------- T E S T 0 1 0 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test010 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 010: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test010; ---------------------- T E S T 0 1 1 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test011 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 011: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test011; ---------------------- T E S T 0 1 2 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test012 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 012: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test012; ---------------------- T E S T 0 1 3 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test013 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 013: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test013; ---------------------- T E S T 0 1 4 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test014 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 014: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test014; ---------------------- T E S T 0 1 5 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or failure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test015 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 015: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test015; end Node_Management_Tests; --:::::::::::::: --node_management_tests-spec.a --:::::::::::::: ---------------------------------------------------------------------- -- N O D E _ M A N A G E M E N T _ T E S T S -- (Package Specification) -- -- -- A Set of Simple Test Subprograms To Exercise -- Portions of Node_Management -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Sun Aug 11 14:48:31 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in package -- Node_Management. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "main procedure" named Node_Mgmt. This procedure acts -- as a test driver, calling the different test functions in -- sequence. Output from the tests can be redirected to a file, -- or sent to Standard_Output. -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- The test functions have two parameters: -- Verbosity - (Kinds_Of_Output) can have the following values: -- None - No messages are sent to Standard_Output -- Status - the test reports on its success or failure -- Die_On_Exception : Boolean - if true, an unexpected exception -- will be propogated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- Example: -- ------- -- See the procedure Node_Mgmt for all the examples you could -- ever want... -- -- Notes: -- ----- -- None. -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- package Node_Management_Tests is type Test_Result is (Pass, Fail); type Kinds_Of_Output is (NONE, STATUS); function Test001 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test002 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test003 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test004 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test005 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test006 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test007 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test008 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test009 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test010 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test011 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test012 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test013 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test014 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test015 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; end Node_Management_Tests; --:::::::::::::: --node_mgmt.a --:::::::::::::: ---------------------------------------------------------------------- -- N O D E _ M G M T -- -- -- Test Driver for Tests of Package Node_Management -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Jun 12 14:11:46 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- This is the test driver for the suite of tests in the package -- Node_Management_Tests. -- -- Usage: -- ----- -- -- Example: -- ------- -- -- Notes: -- ----- -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- with Text_IO; use Text_IO; with Node_Management_Tests; use Node_Management_Tests; procedure Node_Mgmt is Valid_Response : Boolean := FALSE; Phyl : File_Type; MAX_FILENAME : constant Natural := 39; -- Arbitrary number Phyl_Name : String (1..MAX_FILENAME); Name_Length : Natural; Test_Output : Kinds_Of_Output; Abort_On_Exception : Boolean; MAX_TESTS : constant Positive := 15; Subtype Count is Integer range 0 .. MAX_TESTS; package Count_IO is new Integer_IO (Count); use Count_IO; type Response is (YES,NO); Yesno : Response; package YesNo_IO is new Enumeration_IO (Response); use YesNo_IO; package Verbosity_IO is new Enumeration_IO (Kinds_Of_Output); use Verbosity_IO; Results : array (1..MAX_TESTS) of Test_Result; Test_Count : Natural; Error_Count : Natural := 0; Current_Test : Natural := 0; begin Valid_Response := FALSE; while not Valid_Response loop Put ("Enter the highest test number to be run: "); GET_TEST_COUNT: begin Get (Test_Count); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER AN INTEGER 0 .. " & Integer'image(MAX_TESTS)); end GET_TEST_COUNT; end loop; Skip_Line (Standard_Input); Valid_Response := FALSE; while not Valid_Response loop Put ("Abort the test upon an unexpected exception? (Yes or No): "); GET_ABORT_STATUS: begin Get (Yesno); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER EITHER YES OR NO ONLY."); end GET_ABORT_STATUS; end loop; Skip_Line (Standard_Input); Abort_On_Exception := (Yesno = YES); Valid_Response := FALSE; while not Valid_Response loop Put ("Enter the level of test output to be printed: "); GET_VERBOSITY: begin Get (Test_Output); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER ONE OF THE FOLLOWING:"); for i in Kinds_Of_Output'pos(Kinds_Of_Output'base'first) .. Kinds_Of_Output'pos(Kinds_Of_Output'base'last) loop Put(" "); Put(Kinds_Of_Output'val(i)); New_line; end loop; end GET_VERBOSITY; end loop; Skip_Line (Standard_Input); Valid_Response := FALSE; while not Valid_Response loop Put ("Do you want output redirected to a file? (yes or no): "); GET_ANSWER: begin Get (Yesno); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER EITHER YES OR NO ONLY."); end GET_ANSWER; end loop; Skip_Line (Standard_Input); if Yesno = YES then Put ("Enter the filename for redirected output: "); Get_Line (Phyl_Name, Name_Length); OPEN_FILE: begin Open (Phyl, Out_File, Phyl_Name (1..Name_Length)); Delete (Phyl); Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); exception when NAME_ERROR => Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); end OPEN_FILE; Set_Output (Phyl); end if; New_Line; Put_Line ("**** Beginning Execution of Node_Management_Tests ****"); Put (" TEST_OUTPUT is set to "); Put_Line (Kinds_Of_Output'Image(TEST_OUTPUT)); Put (" ABORT_ON_EXCEPTION is set to "); Put_Line (Boolean'Image(ABORT_ON_EXCEPTION)); Put (" TEST_COUNT is set to "); Put (Test_Count); New_Line(2); Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test001 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test002 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test003 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test004 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test005 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test006 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test007 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test008 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test009 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test010 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test011 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test012 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test013 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test014 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test015 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; -- Produce Summary <<PRINT_RESULTS>> New_Line; Put_Line ("**** End of Node_Management_Tests ****"); if Error_Count = 0 then New_Line; Put_Line ("NO TESTS FAILED. HUZZAH!"); else New_Line; Put ("A total of "); Put (Error_Count); Put_Line (" Test(s) failed."); Put_Line ("The following test(s) failed:"); for I in 1 .. Test_Count loop if Results (I) = fail then Put ("Test number "); Put (I); New_Line; end if; end loop; end if; end Node_Mgmt; --:::::::::::::: --nodetree_cleanup.a --:::::::::::::: with Cais; use Cais; with Text_Io; use Text_Io; procedure Nodetree_Cleanup is use Node_Definitions; use Node_Management; Node : Cais.Node_Type; begin Open(Node,"'current_user.Nowalk", (1=>read_relationships, 2=>Exclusive_Write)); Put_Line("Nowalk is Open"); Delete_Tree(Node); end Nodetree_Cleanup; --:::::::::::::: --nodetree_ex.a --:::::::::::::: -----------------------------N O D E T R E E _ E X--------------------------- -- Purpose: -- ------- -- This program runs exception tests for the subprogams in sections -- 7,8,9,17,18,19,20, and 22 of MIL-STD-CAIS 5.1.2. These routines -- provide information on the primary_name, provide access to the -- parent node, provide for copying and deleting trees, and provide -- for copying and renaming nodes. -- -- Tests for Lock_Error, Access_Violation, and Security_Violation -- are not included because these features are not yet implemented. -- -- In order to perform these tests, several nodes are created. Several -- nodes have strange properties, such as inaccessibility. The -- manner in which these properties have been created likely violates -- rules enforced by access_methods or locking_checks. Therefore, -- this program must be updated once these features are implemented. -- ------------------------------------------------------------------------------ with Cais; use Cais; with Text_Io; use Text_Io; procedure Nodetree_Ex is use Attributes; use List_Utilities; use Node_Management; use Node_Definitions; Exceptions_Tested : constant := 50; Failures : integer := 0; Line_Count : integer; Expected : string(1..3); Check_Inaccessibility : boolean; Inaccessible_Node : Cais.Node_Type; In_Traversed_Node : Cais.Node_Type; Closed_Node : Cais.Node_Type; Open_Node : Cais.Node_Type; Locked_Node : Cais.Node_Type; Impotent_Node : Cais.Node_Type; Hidden_Node : Cais.Node_Type; Process_Node : Cais.Node_Type; Top_Node : Cais.Node_Type; Living_Node : Cais.Node_Type; Offspring_Node : Cais.Node_Type; Parent : Cais.Node_Type; Temp_File : Cais.Text_Io.File_Type; Node : Cais.Node_Type; Node1 : Cais.Node_Type; Wait : string(1..100); Last : natural; No_Intent : Intention(1..2) := (Existence, read); Key : Relationship_Key(1..6) := "howell"; Relation : Relation_Name(1..4) := "user"; Null_List : List_Type; procedure Wrong_Exception(II: integer; SS: string) is begin Failures := Failures + 1; Line_Count := 10; new_line; put( integer'image(II) & ":**ERROR**" & " Received: " & SS & " Expected: " & Expected ); end Wrong_Exception; procedure No_Ex(Error: in string) is begin new_line; put(Error); Line_Count := 10; Failures := Failures + 1; end No_Ex; procedure Raise_Exception(II: integer ) is Text : Natural; String1 : string(1..3); Name1 : NameString(1..3); Iterator : Attribute_Iterator; Attribute : Attribute_Name(1..32); begin case II is --MIL STD 5.1.3.1 --not applicable --Access_Violation not checked --Lock_Error not checked when 1 => --MIL STD 5.1.2.7 if check_inaccessibility then Expected := "Nam"; Put_Line (Primary_Name(In_Traversed_Node) ); No_Ex(" 1***ERROR***Primary_Name: inaccessible"); end if; when 2 => Expected := "Sta"; Put_Line (Primary_Name(Closed_Node) ); No_Ex(" 2***ERROR***Primary_Name: not open"); when 3 => Expected := "Int"; Put_Line (Primary_Name(Impotent_Node) ); No_Ex(" 3***ERROR***Primary_Name: bad intent"); --Access_Violation not checked --Lock_Error not checked when 4 => --MIL STD 5.1.2.8 if check_inaccessibility then Expected := "Nam"; Put_Line (Primary_Key(In_Traversed_Node) ); No_Ex(" 4***ERROR***Primary_Key: inaccessible"); end if; when 5 => Expected := "Sta"; Put_Line (Primary_Key(Closed_Node) ); No_Ex(" 5***ERROR***Primary_Key: not open"); when 6 => Expected := "Int"; Put_Line (Primary_Key(Impotent_Node) ); No_Ex(" 6***ERROR***Primary_Key: bad intent"); --Access_Violation not checked --Lock_Error not checked when 7 => --MIL STD 5.1.2.9 if check_inaccessibility then Expected := "Nam"; Put_Line (Primary_Relation(In_Traversed_Node) ); No_Ex(" 7***ERROR***Primary_Relation: inaccessible"); end if; when 8 => Expected := "Sta"; Put_Line (Primary_Relation(Closed_Node) ); No_Ex(" 8***ERROR***Primary_Relation: not open"); when 9 => Expected := "Int"; Put_Line (Primary_Relation(Impotent_Node) ); No_Ex(" 9***ERROR***Primary_Relation: bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 10 => --MIL STD 5.1.2.17 Expected := "Nam"; Get_Parent(Parent, Top_Node); No_Ex(" 10***ERROR***Get_Parent: top-level"); Close(Parent); when 11 => if check_inaccessibility then Expected := "Nam"; Get_Parent(Parent, In_Traversed_Node); No_Ex(" 11***ERROR***Get_Parent: inaccessible parent"); Close(Parent); end if; when 12 => Expected := "Use"; Get_Parent(Parent, Offspring_Node, No_Intent(2..1) ); No_Ex(" 12***ERROR***Get_Parent: null intention"); Close(Parent); when 13 => Expected := "Sta"; Get_Parent(Open_Node, Offspring_Node); No_Ex(" 13***ERROR***Get_Parent: open parent"); Close(Parent); when 14 => Expected := "Sta"; Get_Parent(Parent, Closed_Node); No_Ex(" 14***ERROR***Get_Parent: closed node"); Close(Parent); when 15 => Expected := "Int"; Get_Parent(Parent, Impotent_Node); No_Ex(" 15***ERROR***Get_Parent: bad intent"); Close(Parent); --Security_Violation not checked when 16 => --MIL STD 5.1.2.18 Expected := "Nam"; Copy_Node(Impotent_Node,Living_Node, "Bad__Key"); No_Ex(" 16***ERROR***Copy_Node: illegal key"); when 17 => Expected := "Nam"; Copy_Node(Impotent_Node,Living_Node, "OK", "Bad__Rel"); No_Ex(" 17***ERROR***Copy_Node: illegal relation"); when 18 => Expected := "Nam"; Copy_Node(Impotent_Node,Living_Node, "johnjr", "dot" ); No_Ex(" 18***ERROR***Copy_Node: existing node"); when 19 => Expected := "Use"; Copy_Node(Process_Node,Living_Node, "dan", "dot" ); No_Ex(" 19***ERROR***Copy_Node: wrong node kind"); when 20 => Expected := "Use"; Copy_Node(Living_Node, Living_Node, "jim", "dot"); No_Ex(" 20***ERROR***Copy_Node: primary relationships"); when 21 => Expected := "Use"; Copy_Node(Offspring_Node,Living_Node, "dummy", "access"); No_Ex(" 21***ERROR***Copy_Node: predefined relation"); when 22 => Expected := "Sta"; Copy_Node(Closed_Node,Living_Node, "dummy", "link" ); No_Ex(" 22***ERROR***Copy_Node: from closed"); when 23 => Expected := "Sta"; Copy_Node(Living_Node,Closed_Node,"dummy", "link" ); No_Ex(" 23***ERROR***Copy_Node: to closed"); when 24 => Expected := "Int"; Copy_Node(Impotent_Node,Living_Node, "dummy", "link" ); No_Ex(" 24***ERROR***Copy_Node: from bad intent"); when 25 => Expected := "Int"; Copy_Node(Living_Node,Impotent_Node, "dummy", "link" ); No_Ex(" 25***ERROR***Copy_Node: to bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 26 => --MIL STD 5.1.2.19 Expected := "Nam"; Copy_Tree(Impotent_Node,Living_Node, "Bad__Key"); No_Ex(" 26***ERROR***Copy_Tree: illegal key"); when 27 => Expected := "Nam"; Copy_Tree(Impotent_Node,Living_Node, "OK", "Bad__Rel"); No_Ex(" 27***ERROR***Copy_Tree: illegal relation"); when 28 => Expected := "Nam"; Copy_Tree(Impotent_Node,Living_Node, "johnjr", "dot" ); No_Ex(" 28***ERROR***Copy_Tree: existing node"); when 29 => Expected := "Use"; Copy_Tree(Process_Node,Living_Node, "dan", "dot" ); No_Ex(" 29***ERROR***Copy_Tree: wrong node kind"); when 30 => Expected := "Use"; Copy_Tree(Offspring_Node,Living_Node, "dummy", "access"); No_Ex(" 30***ERROR***Copy_Tree: predefined relation"); when 31 => Expected := "Sta"; Copy_Tree(Closed_Node,Living_Node, "dummy", "link" ); No_Ex(" 31***ERROR***Copy_Tree: from closed"); when 32 => Expected := "Sta"; Copy_Tree(Living_Node,Closed_Node,"dummy", "link" ); No_Ex(" 32***ERROR***Copy_Tree: to closed"); when 33 => Expected := "Int"; Copy_Tree(Impotent_Node,Living_Node, "dummy", "link" ); No_Ex(" 33***ERROR***Copy_Tree: from bad intent"); when 34 => Expected := "Int"; Copy_Tree(Offspring_Node,Hidden_Node, "dummy", "link" ); No_Ex(" 34***ERROR***Copy_Tree: to bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 35 => --MIL STD 5.1.2.20 Expected := "Nam"; Rename(Hidden_Node,Living_Node, "Bad__Key"); No_Ex(" 35***ERROR***Rename: illegal key"); when 36 => Expected := "Nam"; Rename(Hidden_Node,Living_Node, "OK", "Bad__Rel"); No_Ex(" 36***ERROR***Rename: illegal relation"); when 37 => Expected := "Nam"; Rename(Hidden_Node,Living_Node, "johnjr", "dot" ); No_Ex(" 37***ERROR***Rename: existing node"); when 38 => Expected := "Use"; Rename(Process_Node,Living_Node, "dan", "dot" ); No_Ex(" 38***ERROR***Rename: wrong node kind"); when 39 => Expected := "Use"; Rename(Living_Node,Offspring_Node, "dummy", "dot"); No_Ex(" 39***ERROR***Rename: acircularity test"); when 40 => Expected := "Use"; Rename(Offspring_Node,Living_Node, "dummy", "access"); No_Ex(" 40***ERROR***Rename: predefined relation"); when 41 => Expected := "Use"; Rename(Top_Node,Living_Node, "dummy", "dot"); No_Ex(" 41***ERROR***Rename: parent relation is predefined"); when 42 => Expected := "Sta"; Rename(Closed_Node,Living_Node, "dummy", "link" ); No_Ex(" 42***ERROR***Rename: from closed"); when 43 => Expected := "Sta"; Rename(Living_Node,Closed_Node,"dummy", "link" ); No_Ex(" 43***ERROR***Rename: to closed"); when 44 => Expected := "Int"; Rename(Hidden_Node,Living_Node, "dummy", "link" ); No_Ex(" 44***ERROR***Rename: from bad intent"); when 45 => Expected := "Int"; Rename(Living_Node,Impotent_Node, "dummy", "link" ); No_Ex(" 45***ERROR***Rename: to bad intent"); --Security_Violation not checked --Access_Violation not checked --Lock_Error not checked when 46 => --MIL STD 5.1.2.22 if check_inaccessibility then Expected := "Nam"; Delete_Tree(In_Traversed_Node); No_Ex(" 46***ERROR***Delete_Tree: inaccessible parent"); end if; when 47 => --MIL STD 5.1.2.22 if check_inaccessibility then Expected := "Nam"; Delete_Tree(Living_Node); No_Ex(" 47***ERROR***Delete_Tree: inaccessible subtree"); end if; when 48 => --MIL STD 5.1.2.22 Expected := "Use"; Delete_Tree(Top_Node); No_Ex(" 48***ERROR***Delete_Tree: parent relation is predefined"); when 49 => --MIL STD 5.1.2.22 Expected := "Sta"; Delete_Tree(Closed_Node); No_Ex(" 49***ERROR***Delete_Tree: unopened node"); when 50 => --MIL STD 5.1.2.22 Expected := "Int"; Delete_Tree(Hidden_Node); No_Ex(" 50***ERROR***Delete_Tree: bad intent"); when others => Put_Line("***TEST SET-UP ERROR*** " & integer'image(II) & " NOT EXPECTED!!"); end case; end Raise_Exception; begin Open(Top_Node,"'current_user",(1=>Exclusive_Write, 2=>Read)); Open(Impotent_Node,"'current_user",(1=>read_contents)); Put_Line("CREATE --TREE"); Structural_Nodes.Create_Node(Node, Name=>"'current_user.Nowalk"); Close(Node); Open(Node1, "'current_user.Nowalk", (1=>read, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john"); Structural_Nodes.Create_Node(Living_Node, Node1, "john", "dot" ); Close(Living_Node); Open(Living_Node, Node1, "john","dot", (1=>read, 2=>append_relationships)); Put_Line("CREATE --Nowalk.john.johnjr"); Cais.Text_Io.Create(Temp_File, Living_Node, "johnjr", "dot" ); Cais.Text_Io.Close(Temp_File); Open(Offspring_Node,Living_Node, "johnjr","dot", (1=>read, 2=>Exclusive_Write, 3=>append_relationships)); Put_Line("CREATE --Nowalk.john.johnjr.mark"); Cais.Text_Io.Create(Temp_File, Offspring_Node, "mark", "dot" ); Cais.Text_Io.Close(Temp_File); Put_Line("CREATE --Nowalk.john.will"); Cais.Text_Io.Create(Temp_File, Living_Node, "will", "dot" ); Cais.Text_Io.Close(Temp_File); Open(Node, Living_Node, "will","dot", (1=>Exclusive_write, 2=>append_relationships,3=>read)); Put_Line("CREATE --Nowalk.john.will.kitty"); Cais.Text_Io.Create(Temp_File, Node, "kitty", "dot" ); Cais.Text_Io.Close(Temp_File); Open(Inaccessible_Node, Living_Node, "will","dot", (1=>write, 2=>read)); Open(In_traversed_Node,Node,"kitty","dot",(1=>exclusive_write,2=>read)); Put_Line("NOW YOU must make the node dot(will) inaccessible"); Put_Line("It should be the 2nd from last node created."); Put_Line("Should Inaccessibility tests be run (Y/N)"); Get_Line(Wait, Last); if Last = 1 and then Wait(1) = 'Y' then Check_Inaccessibility := true; else Check_Inaccessibility := false; end if; Open(Process_Node,"'current_job",(1=>Existence)); Open(Hidden_Node,Living_Node, "johnjr","dot", (1=>existence)); Open(Open_Node, Living_Node, "johnjr","dot", (1=>write, 2=>read)); --======================================================================== --===================S E T U P C O M P L E T E D======================== --======================================================================== Line_Count := 10; for I in 1..Exceptions_Tested loop begin if Line_Count = 10 then new_line; put("PASSES TEST: "); Line_Count := 0; end if; Raise_Exception(I); exception when Node_Definitions.Use_Error => if Expected /= "Use" then Wrong_Exception(I,"Use_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Node_Definitions.Status_Error => if Expected /= "Sta" then Wrong_Exception(I,"Status_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Intent_Violation => if Expected /= "Int" then Wrong_Exception(I,"Intent_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Lock_Error => if Expected /= "Loc" then Wrong_Exception(I,"Lock_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Security_Violation => if Expected /= "Sec" then Wrong_Exception(I,"Security_Violation"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; when Node_Definitions.Name_Error => if Expected /= "Nam" then Wrong_Exception(I,"Name_Error"); else Line_Count := Line_Count+1; put( integer'image(I)); put(" "); end if; end; end loop; new_line; put_line("****************************T O T A L S***********************"); put_line("Number of tests run: " & integer'image(Exceptions_Tested)); put_line("Number of failures : " & integer'image(Failures) ); put_line("*** NOTE 6 TESTS ARE SKIPPED IF INACCESSIBILITY NOT CHECKED***"); put_line("**************************************************************"); end Nodetree_Ex; --:::::::::::::: --patt_tst_all.a --:::::::::::::: with Cais; use Cais; with Text_Io; use Text_Io; Procedure Patt_Tst_All is use Node_Management; use Node_Definitions; use Attributes; use List_Utilities; package LU renames List_Utilities; Time_Value_1 : List_Type; Time_Value_2 : List_Type; Verification_1: List_Type; Verification_2: List_Type; Work_List : List_Type; Base : Cais.Node_Type; Key : Relationship_Key(1..6) := "howell"; Key1 : Relationship_Key(1..4) := "mike"; Relation : Relation_Name(1..3) := "dot"; procedure Print_Attributes(Node : Cais.Node_Type; Text : string; Key : Relationship_Key) is Name : Attribute_Name(1..32); Value : List_Type; Selected : Attribute_Iterator; begin put_line(Text); Path_Attribute_Iterate(Selected, Node, Key, Relation); while more(Selected) loop Name := (others => ' '); Get_Next(Selected, Name, Value); Put(" "); Put(Name); Put("=> "); Put(To_Text(Value)); new_line; end loop; end Print_Attributes; procedure Print_Attributes(Name: Name_String; Text: string)is Node : Cais.Node_Type; begin Open(Node, Name, (1=>write_relationships, 2=>read_relationships, 3=>append_relationships, 4=>write_attributes)); Print_Attributes(Node, Text, Key1); Close(Node); end Print_Attributes; procedure Print_Value(List1: List_Type; List2: List_Type) is begin if Is_Equal(List1, list2) then put_line("TEST PASSES: FOUND " & To_Text(List2)); else put_line("***ERROR***"); put_Line(" LIST1 is " & To_Text(List1) ); put_Line(" LIST2 is " & To_Text(List2) ); end if; end Print_Value; begin To_List("(Hour=>12, Minute=>30, Seconds=>49)", Time_Value_1 ); To_List("(Hour=>10, Minute=>15, Seconds=>17)", Time_Value_2 ); To_List("(true)", Verification_1 ); To_List("(false)", Verification_2 ); Open(Base,"'current_node",(1=>write_relationships, 2=>read_relationships, 3=>append_relationships, 4=>write_attributes)); --CREATE(5.1.3.1 AND 2) New_Line; Put_Line("TESTING CREATE"); Create_Path_Attribute(Base, Key, Relation, "Time", Time_Value_1); Create_Path_Attribute(Base, Key, Relation, "Verified", Verification_1); Create_Path_Attribute("'current_node.mike", "Time", Time_Value_1); Print_Attributes(Base,"TST_NODE1 EXPECTS: time, verified",Key); Print_Attributes("'current_node","TST_NODE2 EXPECTS: time"); --GET(5.1.3.7 AND 8) New_Line; Put_Line("TESTING GET"); Get_Path_Attribute(Base, Key, Relation, "Time", Work_List); Print_Value(Work_List, Time_Value_1); Get_Path_Attribute(Base, Key, Relation, "Verified", Work_List); Print_Value(Work_List, Verification_1); Get_Path_Attribute("'current_node.mike", "Time", Work_List); Print_Value(Work_List, Time_Value_1); --SET(5.1.3.5 AND 6) New_Line; Put_Line("TESTING SET"); Set_Path_Attribute(Base, Key, Relation, "Time", Time_Value_2); Set_Path_Attribute(Base, Key, Relation, "Verified", Verification_2); Set_Path_Attribute("'current_node.mike", "Time", Time_Value_2); Print_Attributes(Base,"TST_NODE1 EXPECTS: time=101517, verified=false",Key); Print_Attributes("'current_node","TST_NODE2 EXPECTS: time=101517"); --DELETE(5.1.3.3 AND 4) New_Line; Put_Line("TESTING DELETE"); Delete_Path_Attribute(Base, Key, Relation, "Time"); Print_Attributes(Base,"ONLY VERIFIED EXPECTED: ",Key); Delete_Path_Attribute(Base, Key, Relation, "Verified"); Print_Attributes(Base,"NOTHING EXPECTED : ",Key); Delete_Path_Attribute("'current_node.mike", "Time"); Print_Attributes("'current_node","NOTHING EXPECTED : "); end Patt_Tst_All; --:::::::::::::: --patt_tst_it.a --:::::::::::::: with Cais; use Cais; with Text_Io; use Text_Io; Procedure Patt_Tst_It is use Attributes; use List_Utilities; use Node_Definitions; use Node_Management; Base : Cais.Node_Type; Key : Relationship_Key(1..6) := "howell"; Relation : Relation_Name(1..3) := "dot"; procedure Test_Setup is NULL_LIST : LIST_TYPE; begin To_List("()", NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"ammamma",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"axxaxxa",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"a ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"m ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"z ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"aaa ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"xxx ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"ax ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"xx ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"xz ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"axz ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"amz ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"xmx ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"xmxz ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"xmxm ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"axxz ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"am ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"az ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"aazz ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"aaxx ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"xxzz ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"aa ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"aaaa ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"axa ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"axxa ",NULL_LIST); Create_Path_Attribute(Base,Key,Relation,"axaxa ",NULL_LIST); end Test_Setup; procedure Print_Iterator(Selector: Attribute_Pattern; Amount : integer) is Name : Attribute_Name(1..15); Value : List_Type; II : integer range 0..400 := 0; Selected : Attribute_Iterator; begin Put(Selector & " EXPECTS: " & integer'image(Amount) ); Path_Attribute_Iterate(Selected, Base, Key, Relation, Selector); while more(Selected) loop Name := (others => ' '); Get_Next(Selected, Name, Value); if II mod 3 = 0 then New_Line; Put(" "); end if; Put(Name); Put( "=>" & To_Text(Value)); II := II+1; end loop; New_Line; Put_Line(Selector & "***FINDS: " & integer'image(II) & "********"); end Print_Iterator; begin put_line("The total set consists of :"); put_line(" a aa aaa aaaa aaxx aazz "); put_line(" am ammamma amz ax axa axaxa "); put_line(" axz axxa axxaxxa axxz az "); put_line(" m xmx xmxm xmxz xx xxx "); put_line(" xxzz xz z "); Open(Base, "'current_node", (1=>read_relationships, 2=>write_relationships, 3=>append_relationships)); Test_Setup; Put_Line("**********************************************************"); Put_Line("**NOTE: expected results do not account for meaningful **"); Put_Line("** attributes already associated with the path. If**"); Put_Line("** they occur, just check that they conform to the **"); Put_Line("** pattern submitted. **"); Put_Line("**********************************************************"); Print_Iterator("????????", 0); Print_Iterator("???", 6); Print_Iterator("?", 3); Print_Iterator("?z", 2); Print_Iterator("?m?", 2); Print_Iterator("?m?z", 1); Print_Iterator("?m?j", 0); Print_Iterator("a?z", 2); Print_Iterator("a??z", 2); Print_Iterator("a?", 4); Print_Iterator("*", 26); Print_Iterator("***", 26); Print_Iterator("a*", 17); Print_Iterator("aa*", 5); Print_Iterator("a*a*a", 5); Print_Iterator("*z", 9); Print_Iterator("*zz", 2); Print_Iterator("*x*", 15); Print_Iterator("*xx*", 7); Print_Iterator("*m*", 7); Print_Iterator("a*a", 8); Print_Iterator("*m??", 3); Print_Iterator("a??*", 12); Print_Iterator("*?*?*", 23); Print_Iterator("amz", 1); Print_Iterator("a", 1); Print_Iterator("z", 1); end Patt_Tst_It; --:::::::::::::: --struct_nodes.a --:::::::::::::: ---------------------------------------------------------------------- -- S T R U C T _ N O D E S -- -- -- Test Driver for Tests of Structural_Nodes -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Mon Jun 24 22:17:26 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- This is the test driver for the suite of tests in the package -- Structural_Nodes. -- -- Usage: -- ----- -- TBS -- -- Example: -- ------- -- See Node_mgmt for an early example of this sort of program. -- -- Notes: -- ----- -- TBS -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- with Text_IO; use Text_IO; with Trace; use Trace; with Structural_Nodes_Tests; use Structural_Nodes_Tests; procedure Struct_Nodes is Valid_Response : Boolean := FALSE; Phyl : File_Type; MAX_FILENAME : constant Natural := 40; -- Arbitrary number Phyl_Name : String (1..MAX_FILENAME); Name_Length : Natural; Test_Output : Structural_Nodes_Tests.Kinds_Of_Output; Abort_On_Exception : Boolean; MAX_TESTS : constant Positive := 15; -- any number you like Subtype Count is Integer range 0 .. MAX_TESTS; -- This is the only instantiation that would not be replaced in -- the "first cut" of the generic procedure Interactive_Get... package Count_IO is new Integer_IO (Count); use Count_IO; type Response is (YES,NO); Yesno : Response; -- presumably we would replace this with something like -- procedure Get_YesNO is new Interactive_Get (Response); etc. package YesNo_IO is new Enumeration_IO (Response); use YesNo_IO; -- presumably we would replace this with something like -- procedure Get_Verbosity is new Interactive_Get (Kinds_Of_Output); etc. package Verbosity_IO is new Enumeration_IO (Kinds_Of_Output); use Verbosity_IO; Results : array (1..MAX_TESTS) of Test_Result; Test_Count : Natural; Error_Count : Natural := 0; Current_Test : Natural := 0; begin Enable_All; --!Debug Valid_Response := FALSE; while not Valid_Response loop Put ("Enter the highest test number to be run: "); GET_TEST_COUNT: begin Get (Test_Count); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER AN INTEGER 0 .. " & Integer'image(MAX_TESTS)); end GET_TEST_COUNT; end loop; Skip_Line (Standard_Input); Valid_Response := FALSE; while not Valid_Response loop Put ("Abort the test upon an unexpected exception? (Yes or No): "); GET_ABORT_STATUS: begin Get (Yesno); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER EITHER YES OR NO ONLY."); end GET_ABORT_STATUS; end loop; Skip_Line (Standard_Input); Abort_On_Exception := (Yesno = YES); -- basic general_case algorithm is in this section of code.. -- missing the concept of max number of tries, of course... Valid_Response := FALSE; while not Valid_Response loop Put ("Enter the level of test output to be printed: "); GET_VERBOSITY: begin Get (Test_Output); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER ONE OF THE FOLLOWING:"); for i in Kinds_Of_Output'pos(Kinds_Of_Output'base'first) .. Kinds_Of_Output'pos(Kinds_Of_Output'base'last) loop Put(" "); Put(Kinds_Of_Output'val(i)); New_line; end loop; end GET_VERBOSITY; end loop; Skip_Line (Standard_Input); -- the skip_line is in effect a "flush" -- of the input buffer... Valid_Response := FALSE; while not Valid_Response loop Put ("Do you want output redirected to a file? (yes or no): "); GET_ANSWER: begin Get (Yesno); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER EITHER YES OR NO ONLY."); end GET_ANSWER; end loop; Skip_Line (Standard_Input); if Yesno = YES then Put ("Enter the filename for redirected output: "); Get_Line (Phyl_Name, Name_Length); OPEN_FILE: begin Open (Phyl, Out_File, Phyl_Name (1..Name_Length)); Delete (Phyl); Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); exception when NAME_ERROR => Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); end OPEN_FILE; Set_Output (Phyl); end if; New_Line; Put_Line ("**** Beginning Execution of Structural_Nodes_Tests ****"); Put (" TEST_OUTPUT is set to "); Put_Line (Kinds_Of_Output'Image(TEST_OUTPUT)); Put (" ABORT_ON_EXCEPTION is set to "); Put_Line (Boolean'Image(ABORT_ON_EXCEPTION)); Put (" TEST_COUNT is set to "); Put (Test_Count); New_Line(2); Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test001 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test002 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test003 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test004 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test005 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test006 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test007 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test008 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test009 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test010 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test011 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test012 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test013 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test014 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; Current_Test := Current_Test + 1; if Current_Test > Test_Count then goto PRINT_RESULTS; -- the ultimate taboo!! end if; Results (Current_Test) := Test015 ( Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; -- Produce Summary <<PRINT_RESULTS>> New_Line; Put_Line ("**** End of Structural Nodes Tests ****"); New_Line; New_Line; if Error_Count = 0 then New_Line; Put_Line ("NO TESTS FAILED. HUZZAH!"); else New_Line; Put ("A total of "); Put (Error_Count); Put_Line (" Test(s) failed."); Put_Line ("The following test(s) failed:"); for I in 1 .. Test_Count loop if Results (I) = fail then Put ("Test number "); Put (I); New_Line; end if; end loop; end if; end Struct_Nodes; --:::::::::::::: --structural_nodes_tests-body.a --:::::::::::::: ---------------------------------------------------------------------- -- S T R U C T U R A L _ N O D E S -- (Package Body) -- -- -- A Set of Simple Test Subprograms To Exercise -- Structural_Nodes -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Fri Feb 21 15:05:21 EST 1986 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in -- Structural_Nodes. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "test driver" named Struct_Nodes. This test driver calls the -- different test functions in sequence. Output from the tests can -- be redirected to a file. -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- *** The verbosity may be changed (e.g. if you want to add a -- *** DUMP option). -- The test functions have two parameters: -- -- Verbosity - (Kinds_Of_Output) can have the following values: -- NONE - No messages are sent to Standard_Output -- STATUS - the test reports on its success or failure -- -- Die_On_Exception - (Boolean) if true, an unexpected exception -- will be propogated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- Example: -- ------- -- See the package Node_Management_Tests for some examples. -- -- Notes: -- ----- -- None. -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- with Text_IO; use Text_IO; with Cais; use Cais; package body structural_nodes_tests is use Node_Management; use Node_Definitions; use List_Utilities; use Structural_Nodes; --------------------- R E P O R T _ S T A T U S -------------------- -- -- Purpose: -- ------- -- To print a descriptive test result message to Std. Output, -- governed by the level of output desired for the test. -- -- Parameters: -- ---------- -- Verbosity The message will be printed unless this is -- set to NONE. -- Msg The string representing the message to be printed. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- procedure Report_Status ( Verbosity : Kinds_Of_Output; Msg : String) is begin if Verbosity = NONE then return; -- do nothing else Put_Line (Msg); end if; end Report_Status; ---------------------- T E S T 0 0 1 ---------------------- -- -- Purpose: -- ------- -- This test verifies that Structural_Nodes.Create correctly handles -- the following erroneous situations: -- using an unopened node handle for a base -- using an opened node handle as the node -- using a predefined relation name -- using a syntactically invalid relation name -- using a syntactically invalid relation key -- including a predefined attribute as a node attribute -- attempting to create an existing node -- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test001 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Node : Node_Definitions.Node_Type; Base : Node_Definitions.Node_Type; Simple_List : List_Type; Result : Test_Result := PASS; begin -- attempting to use a predefined relation begin Create_Node (Node => Node, Name => "'Parent'Job'Parent"); exception when Node_Definitions.USE_ERROR => Node_Management.Close (Node); -- as expected when others => Report_Status (Verbosity, "Test 001: Creating w/ predefined relation had problems"); raise; end; -- using an unopened node handle for a base begin Create_Node ( Node => Node, Base => Base); exception when Node_Definitions.STATUS_ERROR => Node_Management.Close (Node); -- as expected when others => Report_Status (Verbosity, "Test 001: Open w/ closed Base had problems"); raise; end; -- using an opened node handle as the node begin Open (Node, "'parent'Job"); Create_Node ( Node => Node, Base => Base); exception when Node_Definitions.STATUS_ERROR => Node_Management.Close (Node); -- as expected when others => Report_Status (Verbosity, "Test 001: Open w/ open Node had problems"); raise; end; -- using a syntactically invalid relation name -- this runs into problem in list_utilities.find'2 (a loop) begin Open (Base, "'current_node'job", (1 => APPEND_RELATIONSHIPS)); Create_Node ( Node => Node, Base => Base, Relation => "xyz+123"); exception when Node_Definitions.NAME_ERROR => Node_Management.Close (Node); -- as expected Node_Management.Close (Base); -- as expected when others => Report_Status (Verbosity, "Test 001: Open w/ invalid relation name had problems"); raise; end; -- using a syntactically invalid relation key begin Open (Base, "'current_node'job", (1 => APPEND_RELATIONSHIPS)); Create_Node ( Node => Node, Base => Base, Key => "xyz+123"); exception when Node_Definitions.NAME_ERROR => Node_Management.Close (Node); -- as expected Node_Management.Close (Base); -- as expected when others => Report_Status (Verbosity, "Test 001: Open w/ invalid relation key had problems"); raise; end; -- using a predefined relation name -- creating an existing node -- including a predefined attribute as a node attribute return Result; exception when OTHERS => Report_Status (Verbosity, "**** Test 001: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return FAIL; end if; end Test001; ---------------------- T E S T 0 0 2 ---------------------- -- -- Purpose: -- ------- -- Simple test of creating and deleting a node. -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test002 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Node : Node_Definitions.Node_Type; Result : Test_Result := PASS; begin -- make certain we are starting from scratch... DELETE1: begin Open (Node, "'current_Node'new_rel(New_Key)", (1 => EXCLUSIVE_WRITE, 2=> READ_RELATIONSHIPS)); Delete_Node (Node); exception when Node_Definitions.NAME_ERROR => Close (Node); -- Open croaked trying to get to it... end DELETE1; Create_Node (Node, Name => "'current_Node'new_rel(New_Key)"); Close (Node); Open (Node, "'current_Node'new_rel(New_Key)", (1 => EXCLUSIVE_WRITE, 2=> READ_RELATIONSHIPS)); Delete_Node (Node); return Result; exception when OTHERS => Report_Status (Verbosity, "**** Test 002: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test002; ---------------------- T E S T 0 0 3 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test003 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when OTHERS => Report_Status (Verbosity, "**** Test 003: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test003; ---------------------- T E S T 0 0 4 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- --------------------------------------------------------------------- function Test004 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when OTHERS => Report_Status (Verbosity, "**** Test 004: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test004; ---------------------- T E S T 0 0 5 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test005 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when OTHERS => Report_Status (Verbosity, "**** Test 005: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test005; ---------------------- T E S T 0 0 6 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test006 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 006: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test006; ---------------------- T E S T 0 0 7 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test007 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 007: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test007; ---------------------- T E S T 0 0 8 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test008 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 008: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test008; ---------------------- T E S T 0 0 9 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test009 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 009: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test009; ---------------------- T E S T 0 1 0 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test010 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 010: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test010; ---------------------- T E S T 0 1 1 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test011 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 011: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test011; ---------------------- T E S T 0 1 2 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test012 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 012: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test012; ---------------------- T E S T 0 1 3 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test013 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 013: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test013; ---------------------- T E S T 0 1 4 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test014 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 014: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test014; ---------------------- T E S T 0 1 5 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propogated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test015 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Result : Test_Result := FAIL; begin return Result; exception when others => Report_Status (Verbosity, "**** Test 015: UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Test015; end structural_nodes_tests; --:::::::::::::: --structural_nodes_tests-spec.a --:::::::::::::: ---------------------------------------------------------------------- -- S T R U C T U R A L _ N O D E S -- (Package Specification) -- -- -- A Set of Simple Test Subprograms To Exercise -- Structural_Nodes -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Mon Jun 24 22:26:04 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in -- Structural_Nodes. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "test driver" named Struct_Nodes. This test driver calls the -- different test functions in sequence. Output from the tests can -- be redirected to a file. -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- *** The verbosity may be changed (e.g. if you want to add a -- *** DUMP option). -- The test functions have two parameters: -- -- Verbosity - (Kinds_Of_Output) can have the following values: -- NONE - No messages are sent to Standard_Output -- STATUS - the test reports on its success or failure -- -- Die_On_Exception - (Boolean) if true, an unexpected exception -- will be propogated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- Example: -- ------- -- See the package Node_Management_Tests for some examples. -- -- Notes: -- ----- -- None. -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- package Structural_Nodes_Tests is type Test_Result is (PASS, FAIL); --*** See note above re possible additional values. type Kinds_Of_Output is (NONE, STATUS); function Test001 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test002 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test003 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test004 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test005 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test006 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test007 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test008 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test009 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test010 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test011 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test012 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test013 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test014 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test015 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; end Structural_Nodes_Tests; --:::::::::::::: --test_internals.a --:::::::::::::: with Cais; use Cais; procedure Test_Internals is begin Delete_User; end Test_Internals; --:::::::::::::: --test_node_iterate.a --:::::::::::::: with Cais; use Cais; with Trace; with text_io; use text_io; procedure test_node_iterate is use node_management; use node_definitions; Node : Cais.Node_Type; Node1 : Cais.Node_Type; Next_Node : Cais.Node_Type; Io_File : Cais.Text_Io.File_Type; Iter : Node_Iterator; procedure Test_Setup is begin Put_Line("CREATE --TEST"); Structural_Nodes.Create_Node(Node, Name=>"'current_user.test_att"); Close(Node); Open(Node, "'current_user.test_att", (1=>read_relationships, 2=>append_relationships)); Put_Line("CREATE --a(b)"); Structural_Nodes.Create_Node(Node1, Node, "a" , "b" ); Put_Line("huzzah"); Close(Node1); Put_Line("CREATE --a(ab)"); Cais.Text_Io.Create(Io_File, Node, "a" , "ab"); Cais.Text_Io.Close(Io_File); Put_Line("CREATE --b(a)"); Cais.Text_Io.Create(Io_File, Node, "b" , "a" ); Cais.Text_Io.Close(Io_File); Put_Line("CREATE --ab(a)"); Cais.Text_Io.Create(Io_File, Node, "ab", "a" ); Cais.Text_Io.Close(Io_File); Put_Line("CREATE --ab(ab)"); Cais.Text_Io.Create(Io_File, Node, "ab", "ab"); Cais.Text_Io.Close(Io_File); Put_Line("Nodes created are: test'a(b) test'a(ab) test'b(a)"); Put_Line(" test'ab(a) test'ab(ab) "); Put_Line("--TEST SETUP COMPLETED"); end Test_Setup; procedure Test_Cleanup is begin Put_Line("--BEGIN TEST CLEANUP"); Open(Node1, "'current_user.test_att'a(b)", (exclusive_write, read_relationships) ); Delete_Node(Node1); Open(Node1, "'current_user.test_att'a(ab)", (exclusive_write, read_relationships) ); Delete_Node(Node1); Open(Node1, "'current_user.test_att'b(a)", (exclusive_write, read_relationships) ); Delete_Node(Node1); Open(Node1, "'current_user.test_att'ab(a)", (exclusive_write, read_relationships) ); Delete_Node(Node1); Open(Node1, "'current_user.test_att'ab(ab)", (exclusive_write, read_relationships) ); Delete_Node(Node1); Open(Node1, "'current_user.test_att", (exclusive_write, read_relationships) ); Delete_Node(Node1); end Test_Cleanup; begin Trace.Enable_All; Test_Setup; New_Line; New_Line; Put_Line("2 EXPECTED, Iterator over ( *, a ) (File, Primary) yeilds :"); Iterate(Iter, Node, File, "*", "a", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("0 EXPECTED, Iterator over ( *, a ) (Structural, Primary) yeilds :"); Iterate(Iter, Node, Structural, "*", "a", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("1 EXPECTED, Iterator over ( b, * ) (File, Primary) yeilds :"); Iterate(Iter, Node, File, "b", "*", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("2 EXPECTED, Iterator over ( *, ?b ) (File, Primary) yeilds :"); Iterate(Iter, Node, File, "*", "?b", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("1 EXPECTED, Iterator over ( *a*, * ) (Structural, Primary) yeilds :"); Iterate(Iter, Node, Structural, "*a*", "*", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("3 EXPECTED, Iterator over ( *a*, * ) (File, Primary) yeilds :"); Iterate(Iter, Node, File, "*a*", "*", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("2 EXPECTED, Iterator over ( *b*, a ) (File, Primary) yeilds :"); Iterate(Iter, Node, File, "*b*", "a", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("4 EXPECTED, Iterator over ( *, * ) (File, Non-Primary) yeilds :"); Iterate(Iter, Node, File, "*", "*", false); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("4 EXPECTED, Iterator over ( *, * ) (File, Primary) yeilds :"); Iterate(Iter, Node, File, "*", "*", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; New_Line; New_Line; Put_Line("0 EXPECTED, Iterator over ( *x, * ) (File, Primary) yeilds :"); Iterate(Iter, Node, File, "*x", "*", true); while More(Iter) loop Get_Next(Iter, Next_Node); Put(" "); Put(Path_Relation(Next_Node)); Put("( "); Put(Path_Key (Next_Node)); Put(" )"); New_Line; end loop; Test_Cleanup; end Test_Node_Iterate; --:::::::::::::: --text_io_tests-body.a --:::::::::::::: ---------------------------------------------------------------------- -- TEXT_IO_TESTS -- (Package Body) -- -- -- A Set of Simple Test Subprograms To Exercise -- Package Cais.Text_Io -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Jun 19 16:54:58 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in -- Cais.Text_Io. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "test driver" named Text_Test. This test driver calls the -- different test functions in sequence. Output from the tests can -- be redirected to a file. -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- *** The verbosity may be changed (e.g. if you want to add a -- *** DUMP option). -- The test functions have two parameters: -- -- Verbosity - (Kinds_Of_Output) can have the following values: -- NONE - No messages are sent to Standard_Output -- STATUS - the test reports on its success or failure -- -- Die_On_Exception - (Boolean) if true, an unexpected exception -- will be propagated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- -- Notes: -- ----- -- None. -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- with Text_IO; with Cais; use Cais; package body Text_Io_Tests is use Cais.Text_Io; use List_Utilities; ---------------------- T E S T 0 0 1 ---------------------- -- -- Purpose: -- ------- -- Tests primary interface Create -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test001 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is File : File_Type; Base : Node_Definitions.Node_Type; Attributes : List_Type; begin Node_Management.Open (Base, "'Current_Node", (1=>Node_Definitions.Append_Relationships)); To_List ("(File_Kind=>(Queue), Access_Method=>(Text), " & "User_Attr=>(Test))", Attributes); Create (File => File, Base => Base, Key => "Test001", Relation => "Testdriver", Mode => Inout_File, Form => Empty_List, Attributes => Attributes, Access_Control => Empty_List, Level => Empty_List); Close (File); return PASS; end Test001; ---------------------- T E S T 0 0 2 ---------------------- -- -- Purpose: -- ------- -- Test Create secondary interface -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test002 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is File : File_Type; Attributes : List_Type; begin To_List ("(File_Kind=>(Secondary_Storage), Access_Method=>(Text))", Attributes); Create (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Inout_File, Form => Empty_List, Attributes => Attributes, Access_Control => Empty_List, Level => Empty_List); Close (File); return PASS; end Test002; ---------------------- T E S T 0 0 3 ---------------------- -- -- Purpose: -- ------- -- Test primary interface for Open -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test003 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is File : File_Type; Node : Node_Definitions.Node_Type; begin Node_Management.Open (Node => Node, Name => "'Current_Node'Testdriver(Test002)", Intent => (1=>Node_Definitions.Write_Contents)); Open (File => File, Node => Node, Mode => Out_File); Close (File); return PASS; end Test003; ---------------------- T E S T 0 0 4 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- --------------------------------------------------------------------- function Test004 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is File : File_Type; begin Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Out_File); Close (File); return PASS; end Test004; ---------------------- T E S T 0 0 5 ---------------------- -- -- Purpose: -- ------- -- Test Put string to Out_File -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- NONE: Same as STATUS, with the additional -- output of the string representation of -- the list_type(s) used. -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates pass/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test005 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is File : File_Type; begin Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Out_File); Put (File, "ABCEDFGHIJ"); Put (File, "KLMNOPQRST"); Close (File); return PASS; end Test005; ---------------------- T E S T 0 0 6 ---------------------- -- -- Purpose: -- ------- -- Test Get string from In_File -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test006 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is File : File_Type; String1, String2 : String(1..10); begin Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => In_File); Get (File, String1); Get (File, String2); Close (File); if String1 /= "ABCEDFGHIJ" then return FAIL; end if; if String2 /= "KLMNOPQRST" then return FAIL; end if; return PASS; end Test006; ---------------------- T E S T 0 0 7 ---------------------- -- -- Purpose: -- ------- -- Test file Reset, both interfaces -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test007 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is String1, String2 : String(1..5); File : File_Type; begin Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Inout_File); Put (File, "XXXXX"); Reset (File, In_File); Get (File, String1); Reset (File); Get (File, String2); Close (File); if String1 /= String2 then return FAIL; end if; return PASS; end Test007; ---------------------- T E S T 0 0 8 ---------------------- -- -- Purpose: -- ------- -- Test function End_Of_File -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test008 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is String1 : String(1..5); File : File_Type; Char : Character; Number : Natural := 0; begin Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Out_File); Put_Line (File, "XXXXX"); Close (File); Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => In_File); while not End_Of_File (File) loop Number := Number + 1; Get (File, Char); end loop; Close (File); return PASS; end Test008; ---------------------- T E S T 0 0 9 ---------------------- -- -- Purpose: -- ------- -- Test character I/O -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test009 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is Value1, Value2 : character; File : File_Type; begin Value1 := '&'; Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Inout_File); Put (File, Value1); Reset (File, In_File); Get (File, Value2); Close (File); if Value1 /= Value2 then return FAIL; end if; return PASS; end Test009; ---------------------- T E S T 0 1 0 ---------------------- -- -- Purpose: -- ------- -- Tests CAIS generic Integer I/O package -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test010 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is type Small_Integer is range 1..20; Value1, Value2 : Small_Integer; File : File_Type; package Small_Io is new Integer_Io (Small_Integer); begin Value1 := 12; Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Inout_File); Small_Io.Put (File, Value1); Reset (File, In_File); Small_Io.Get (File, Value2); Close (File); if Value1 /= Value2 then return FAIL; end if; return PASS; end Test010; ---------------------- T E S T 0 1 1 ---------------------- -- -- Purpose: -- ------- -- Tests CAIS generic package for Fixed I/O -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test011 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is type Real_Fixed is delta 0.001 range 0.000 .. 9.999; Value1, Value2 : Real_Fixed; File : File_Type; package Real_Io is new Fixed_Io (Real_Fixed); begin Value1 := 5.432; Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Inout_File); Real_Io.Put (File, Value1); Reset (File, In_File); Real_Io.Get (File, Value2); Close (File); if Abs (Value1 - Value2) > Real_Fixed'delta then return FAIL; end if; return PASS; end Test011; ---------------------- T E S T 0 1 2 ---------------------- -- -- Purpose: -- ------- -- Tests CAIS generic package for Float I/O -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test012 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is type Real_Float is digits 5 range 0.0000 .. 9.9999; Value1, Value2 : Real_Float; File : File_Type; package Real_Io is new Float_Io (Real_Float); begin Value1 := 1.2345; Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Inout_File); Real_Io.Put (File, Value1); Reset (File, In_File); Real_Io.Get (File, Value2); Close (File); if abs (Value1 - Value2) > Real_Float'epsilon then return FAIL; end if; return PASS; end Test012; ---------------------- T E S T 0 1 3 ---------------------- -- -- Purpose: -- ------- -- Tests CAIS generic package for Enumeration I/O -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- --------------------------------------------------------------------- function Test013 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is type Fish is (Big, Whopper, Whale); Value1, Value2 : Fish; File : File_Type; package Scalar_Io is new Enumeration_Io (Fish); begin Value1 := Whopper; Open (File => File, Name => "'Current_Node'Testdriver(Test002)", Mode => Inout_File); Scalar_Io.Put (File, Value1); Reset (File, In_File); Scalar_Io.Get (File, Value2); Close (File); if Value1 /= Value2 then return FAIL; end if; return PASS; end Test013; ---------------------- T E S T 0 1 4 ---------------------- -- -- Purpose: -- ------- -- -- Parameters: -- ---------- -- Verbosity Specifies the level of output desired. Options: -- NONE: No output from this test -- STATUS: Report on success or FAILure of specific -- tests -- Die_On_Exception If TRUE, an unhandled exception will be propagated. -- If FALSE, the exception will be handled and the -- test will return a value of FAIL. -- return Test_Result Simply indicates PASS/FAIL of the test. -- -- Exceptions: -- ---------- -- None. -- -- Notes: -- ----- -- None. -- --------------------------------------------------------------------- function Test014 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result is use Node_Management; use Node_Definitions; File : File_Type; Node : Cais.Node_Type; begin Open (File, "'Current_Node'Testdriver(Test001)", Out_File); Delete (File); Open (File, "'Current_Node'Testdriver(Test002)", Out_File); Delete (File); begin Open (Node, "'Current_Node'Testdriver(Test001)", (1 => Existence)); Close (Node); return FAIL; exception when Node_Definitions.Name_Error => return PASS; when others => raise; end; begin Open (Node, "'Current_Node'Testdriver(Test002)", (1 => Existence)); Close (Node); return FAIL; exception when Node_Definitions.Name_Error => return PASS; when others => raise; end; end Test014; end Text_Io_Tests; --:::::::::::::: --text_io_tests-spec.a --:::::::::::::: ---------------------------------------------------------------------- -- TEXT_IO_TESTS -- (Package Spec) -- -- -- A Set of Simple Test Subprograms To Exercise -- Package Cais.Text_Io -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Jun 19 16:54:58 EDT 1985 %%% -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- To provide a set of functions that exercise and test the -- behavior of some of the services available in -- Cais.Text_Io. -- -- Usage: -- ----- -- The functions made available in this package will be used -- by a "test driver" named Text_Test. This test driver calls the -- different test functions in sequence. Output from the tests can -- be redirected to a file. -- Each function returns a value indicated success/failure of -- test (i.e. expected results were/were not equal to actual -- results). The driver procedure keeps track of the overall -- success/failure count and prints a test summary at the end. -- -- *** The verbosity may be changed (e.g. if you want to add a -- *** DUMP option). -- The test functions have two parameters: -- -- Verbosity - (Kinds_Of_Output) can have the following values: -- NONE - No messages are sent to Standard_Output -- STATUS - the test reports on its success or failure -- -- Die_On_Exception - (Boolean) if true, an unexpected exception -- will be propagated to the calling procedure, -- otherwise it will be caught (it is still -- treated as a failure, though). -- -- Example: -- ------- -- See the package Node_Management_Tests for some examples. -- -- Notes: -- ----- -- None. -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- package Text_Io_Tests is type Test_Result is (PASS, FAIL); --*** See note above re possible additional values. type Kinds_Of_Output is (NONE, STATUS); function Test001 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test002 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test003 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test004 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test005 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test006 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test007 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test008 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test009 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test010 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test011 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test012 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test013 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; function Test014 ( Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean := FALSE) return Test_Result; end Text_Io_Tests; --:::::::::::::: --text_test.a --:::::::::::::: ---------------------------------------------------------------------- -- TEXT_TEST -- -- -- Test Driver for Tests of Cais_Text_Io -- -- -- -- -- Ada Software Engineering Group -- The MITRE Corporation -- McLean, VA 22102 -- -- -- Wed Aug 7 13:26:38 EDT 1985 -- -- (Unclassified and uncopyrighted) -- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- Purpose: -- ------- -- This is the test driver for the suite of tests in the package -- Text_Io_Tests. -- -- Usage: -- ----- -- Run the executable, responding "14" to the number of tests. -- The message level requested should be "none" or "status". -- -- Notes: -- ----- -- -- Revision History: -- ---------------- -- ------------------------------------------------------------------- with Text_IO; use Text_IO; with Cais; use Cais; with Text_Io_Tests; use Text_Io_Tests; procedure Text_Test is Valid_Response : Boolean := FALSE; Phyl : File_Type; MAX_FILENAME : constant Natural := 40; -- Arbitrary number Phyl_Name : String (1..MAX_FILENAME); Name_Length : Natural; Test_Output : Text_Io_Tests.Kinds_Of_Output; Abort_On_Exception : Boolean; MAX_TESTS : constant Positive := 14; Subtype Count is Integer range 0 .. MAX_TESTS; package Count_IO is new Integer_IO (Count); use Count_IO; type Response is (YES,NO); Yesno : Response; MaxTries : constant Natural := 5; package Interact is generic type Enum_type is (<>); procedure Interactive_Get ( Prompt : in String; -- Prompt string Tries : Natural; -- Number of invalid responses accepted Response : in out Enum_type); -- Returns user response -- before DATA-ERROR is raised end Interact; use Interact; procedure Get_YesNO is new Interactive_Get (Response); procedure Get_Verbosity is new Interactive_Get (Kinds_Of_Output); Results : array (1..MAX_TESTS) of Test_Result; Test_Count : Natural; Error_Count : Natural := 0; ----------------------------------------------------------------------- -- Local exception handling function ----------------------------------------------------------------------- function Diagnose (Test : Positive; Verbosity : Kinds_Of_Output := STATUS; Die_On_Exception : Boolean) return Test_Result is use Cais.Io_Definitions; Test_String : String(1..3); procedure Report_Status ( Verbosity : Kinds_Of_Output; Test : Positive; Msg : String) is begin if Verbosity = NONE then return; -- do nothing else Standard.Text_Io.Put_Line ("**Error in Test " & Positive'Image(Test)); Standard.Text_Io.Put_Line (Msg); end if; end Report_Status; begin case Test is when 1 => return Test001 (Verbosity, Die_On_Exception); when 2 => return Test002 (Verbosity, Die_On_Exception); when 3 => return Test003 (Verbosity, Die_On_Exception); when 4 => return Test004 (Verbosity, Die_On_Exception); when 5 => return Test005 (Verbosity, Die_On_Exception); when 6 => return Test006 (Verbosity, Die_On_Exception); when 7 => return Test007 (Verbosity, Die_On_Exception); when 8 => return Test008 (Verbosity, Die_On_Exception); when 9 => return Test009 (Verbosity, Die_On_Exception); when 10 => return Test010 (Verbosity, Die_On_Exception); when 11 => return Test011 (Verbosity, Die_On_Exception); when 12 => return Test012 (Verbosity, Die_On_Exception); when 13 => return Test013 (Verbosity, Die_On_Exception); when 14 => return Test014 (Verbosity, Die_On_Exception); when others => null; end case; exception when Cais.Io_Definitions.Name_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.Name_Error EXCEPTION "); return FAIL; when Cais.Io_Definitions.Use_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.Use_Error EXCEPTION "); return FAIL; when Cais.Io_Definitions.Status_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.Status_Error EXCEPTION "); return FAIL; when Cais.Io_Definitions.Mode_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.Mode_Error EXCEPTION "); return FAIL; when Cais.Io_Definitions.Device_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.Device_Error EXCEPTION "); return FAIL; when Cais.Io_Definitions.End_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.End_Error EXCEPTION "); return FAIL; when Cais.Io_Definitions.Data_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.Data_Error EXCEPTION "); return FAIL; when Cais.Io_Definitions.Layout_Error => Report_Status (Verbosity, Test, "Cais.Io_Definitions.Layout_Error EXCEPTION "); return FAIL; when Node_Definitions.Lock_Error => Report_Status (Verbosity, Test, "Node_Definitions.Lock_Error EXCEPTION "); return FAIL; when Node_Definitions.Intent_Violation => Report_Status (Verbosity, Test, "Node_Definitions.Intent_Violation EXCEPTION "); return FAIL; when Node_Definitions.Access_Violation => Report_Status (Verbosity, Test, "Node_Definitions.Access_Violation EXCEPTION "); return FAIL; when Node_Definitions.Security_Violation => Report_Status (Verbosity, Test, "Node_Definitions.Security_Violation EXCEPTION "); return FAIL; when others => Report_Status (Verbosity, Test, "UNHANDLED EXCEPTION"); if Die_On_Exception then raise; else return (FAIL); end if; end Diagnose; package body Interact is procedure Interactive_Get ( Prompt : in String; Tries : Natural; Response : in out Enum_type) is Response_Value : Enum_type; Valid_Response : Boolean := FALSE; Attempt : Natural := 0; package Type_IO is new Enumeration_IO (Enum_type); use Type_IO; begin while (not Valid_Response) loop Put (Prompt); GET_VERBOSITY: begin Get (Response_Value); Valid_Response := TRUE; exception when DATA_ERROR => Skip_Line; Put_Line (ASCII.BEL & "PLEASE ENTER ONE OF THE FOLLOWING:"); for i in Enum_Type'first .. Enum_Type'last loop Put(" "); Put(i); New_line; end loop; end GET_VERBOSITY; Attempt := Attempt + 1; if Attempt >= Tries then raise DATA_ERROR; end if; end loop; Skip_Line (Standard_Input); -- the skip_line is in effect a "flush" -- of the input buffer... Response := Response_Value; end Interactive_Get; end Interact; begin Valid_Response := FALSE; while not Valid_Response loop Put ("Enter the highest test number to be run: "); GET_TEST_COUNT: begin Get (Test_Count); Valid_Response := TRUE; exception when DATA_ERROR => Put_Line (ASCII.BEL & "PLEASE ENTER AN INTEGER 0 .. " & Integer'image(MAX_TESTS)); end GET_TEST_COUNT; end loop; Skip_Line (Standard_Input); Get_YesNo ( "Abort the test upon an unexpected exception? (Yes or No): ", MaxTries, YesNo); ------------------^A ### --### A:warning: RM 3.2.1(18): variable may not yet have a value Abort_On_Exception := (Yesno = YES); Get_Verbosity ( "Enter the level of test output to be printed: ", MaxTries, Test_Output); Get_YesNo ( "Do you want output redirected to a file? (yes or no): ", MaxTries, Yesno); if Yesno = YES then Put ("Enter the filename for redirected output: "); Get_Line (Phyl_Name, Name_Length); OPEN_FILE: begin Open (Phyl, Out_File, Phyl_Name (1..Name_Length)); Delete (Phyl); Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); exception when NAME_ERROR => Create (Phyl, Out_File, Phyl_Name (1..Name_Length)); end OPEN_FILE; Set_Output (Phyl); end if; New_Line; Put_Line ("**** Beginning Execution of Text_Test ****"); Put (" TEST_OUTPUT is set to "); Put_Line (Kinds_Of_Output'Image(TEST_OUTPUT)); Put (" ABORT_ON_EXCEPTION is set to "); Put_Line (Boolean'Image(ABORT_ON_EXCEPTION)); Put (" TEST_COUNT is set to "); Put (Test_Count); New_Line(2); for Current_Test in 1..Test_Count loop Results (Current_Test) := Diagnose (Current_Test, Verbosity => TEST_OUTPUT, Die_On_Exception => ABORT_ON_EXCEPTION); if Results (Current_Test) = Fail then Error_Count := Error_Count +1; end if; end loop; -- Produce Summary <<PRINT_RESULTS>> New_Line; Put_Line ("**** End of Text_Test ****"); New_Line; New_Line; if Error_Count = 0 then New_Line; Put_Line ("NO TESTS FAILED. "); else New_Line; Put ("A total of "); Put (Error_Count); Put_Line (" Test(s) failed."); Put_Line ("The following test(s) failed:"); for I in 1 .. Test_Count loop if Results (I) = fail then Put ("Test number "); Put (I); New_Line; end if; end loop; end if; end Text_Test;