|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 14509 (0x38ad)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with String_Utilities;
package body Unit_Test_Fragments is
procedure New_Line is
begin
Put_Line ("");
end New_Line;
procedure Test_Package (Package_Name : String; Spec : Boolean) is
begin
if Spec then
Put_Line ("package Test_" & Package_Name & " is");
else
Put_Line ("package body Test_" & Package_Name & " is");
end if;
end Test_Package;
procedure End_Token (Kind : End_Token_Kind := Plain) is
begin
case Kind is
when A_Record =>
Put_Line ("end record;");
when An_If =>
Put_Line ("end if;");
when A_Loop =>
Put_Line ("end loop;");
when Plain =>
Put_Line ("end;");
end case;
end End_Token;
procedure Open_And_Close (Spec : Boolean; Package_Name : String) is
begin
if Spec then
Put_Line ("procedure Open (Report_Name : String);");
New_Line;
Put_Line ("procedure close;");
else
Put_Line ("procedure Open (Report_Name : String) is");
Begin_Token;
Put_Line ("Report.Create (Report_Name);");
Put_Line ("Report.Comment (" & """" & "TEST REPORT FOR PACKAGE " &
Package_Name & """" & ");");
Put_Line ("Report.New_line;");
Put_Line ("Report.New_line;");
Put_Line ("Report.User_Name_And_Time;");
End_Token;
New_Line;
Put_Line ("procedure close is");
Begin_Token;
Put_Line ("Report.Close;");
End_Token;
end if;
end Open_And_Close;
procedure Test_Subprogram (Package_Name : String;
Subprogram : String;
Spec : Boolean;
Subunit : Boolean) is
begin
if Subunit then
Put_Line ("separate (Test_" & Package_Name & ")");
Put_Line ("procedure Test_" & Subprogram & " is");
elsif Spec then
Put_Line ("procedure Test_" & Subprogram & ";");
else
Put_Line ("procedure Test_" & Subprogram & " is separate;");
end if;
end Test_Subprogram;
procedure With_Clause (Unit : String) is
begin
Put_Line ("with " & Unit & ";");
end With_Clause;
procedure Unbounded_Instantiation is
begin
Put_Line ("package Strings is new Unbounded_string;");
end Unbounded_Instantiation;
procedure Images (Package_Name : String; Type_Name : String) is
begin
Put_Line ("function Image (A_" & Type_Name & " : " &
Package_Name & "." & Type_Name & ") return string is");
Begin_Token;
Put_Line ("return [expression];");
End_Token;
New_Line;
Put_Line ("procedure Report_Value is new Report.User_Defined_Type (" &
Package_Name & "." & Type_Name & ");");
end Images;
procedure Begin_Token is
begin
Put_Line ("begin");
end Begin_Token;
procedure Declare_Token is
begin
Put_Line ("declare");
end Declare_Token;
procedure Parameter_Record_Header (Subprogram_Name : String) is
begin
Put_Line ("type " & Subprogram_Name & "_Parameter_Values is");
Put_Line ("record");
end Parameter_Record_Header;
function Component_Name
(Formal_Name : String; Mode_Kind : Mode; Type_Name : String)
return String is
begin
case Mode_Kind is
when Input =>
return (Formal_Name & "_" & Type_Name & "_Input_Value");
when Output =>
return (Formal_Name & "_" & Type_Name & "_Output_Value");
when Expected =>
return (Formal_Name & "_" & Type_Name & "_Expected_Value");
end case;
end Component_Name;
procedure Component_Decl (Component_Name : String;
Type_Name : String;
Is_String : Boolean;
Init : String) is
begin
if Is_String then
Put_Line (Component_Name &
" : Strings.Variable_string := strings.value (" &
Init & ");");
else
Put_Line (Component_Name & " : " & Type_Name & " := " & Init & ";");
end if;
end Component_Decl;
procedure Yield_Procedure (Subprogram_Name : String) is
begin
Put_Line ("procedure Yield (Values : out " &
Subprogram_Name & "_Parameter_Values;");
Put_Line ("Quit : out Boolean) is");
Put_Line ("P : " & Subprogram_Name & "_Parameter_Values;");
Begin_Token;
New_Line;
Put_Line (" -- Initialization expressions go here");
New_Line;
Put_Line ("Values := P;");
New_Line;
Put_Line (" -- determination of when to quit is next:");
Put_Line ("if true then");
Put_Line ("Quit := true;");
Put_Line ("else");
Put_Line ("Quit := false;");
End_Token (An_If);
Put_Line ("end Yield;");
end Yield_Procedure;
procedure Function_Return_Value (Is_String : Boolean; Name : String) is
begin
if Is_String then
Put_Line ("Function_Return_Value : Strings.Variable_string;");
else
Put_Line ("Function_Return_Value : " & Name & ";");
end if;
end Function_Return_Value;
procedure Local_Decls (Subprogram_Name : String) is
begin
Put_Line ("Terminate_Iteration : Boolean := False;");
Put_Line ("Parameters : " & Subprogram_Name & "_Parameter_Values;");
Put_Line ("Iteration_Count : natural := 0;");
end Local_Decls;
procedure Begin_Execution (Path : String) is
begin
Put_Line ("Report.Begin_Execution");
Put_Line ("(" & """" & Path & """" & ");");
end Begin_Execution;
procedure Report_New_Line is
begin
Put_Line ("Report.New_Line;");
end Report_New_Line;
procedure While_Terminate_Loop_Header is
begin
Put_Line ("while not Terminate_Iteration loop");
end While_Terminate_Loop_Header;
procedure Report_Capture_Output is
begin
Put_Line ("Report.Capture_Output;");
end Report_Capture_Output;
procedure Yield_Call is
begin
Put_Line ("Yield (Parameters, Terminate_Iteration);");
Put_Line ("");
Put_Line ("Iteration_Count := Iteration_Count + 1;");
Put_Line ("");
Put_Line ("Report.Comment (" & """" & "ITERATION NUMBER: " &
"""" & " & Positive'Image (Iteration_Count));");
end Yield_Call;
procedure Report_Comments (Comment : String) is
begin
Put_Line ("Report.Comment (" & """" & Comment & """" & ");");
end Report_Comments;
procedure Report_Value (Value_Name : String;
Subprogram_Name : String;
Component_Name : String;
Is_String : Boolean;
Is_Predefined : Boolean := False) is
begin
if not Is_Predefined then
if Is_String then
Put_Line ("Report.value (" & """" & Value_Name & """" &
", Strings.Image (" & Component_Name & " ));");
else
Put_Line ("Report.value (" & """" & Value_Name &
"""" & ", " & Component_Name & " );");
end if;
else
if Is_String then
Put_Line ("Report_value (" & """" & Value_Name & """" &
", Strings.Image (" & Component_Name & " ));");
else
Put_Line ("Report_value (" & """" & Value_Name &
"""" & ", " & Component_Name & " );");
end if;
end if;
end Report_Value;
procedure Function_Call (Package_Name : String;
Subprogram_Name : String;
Is_String : Boolean) is
begin
Put_Line ("Function_Return_Value :=");
New_Line;
if Is_String then
Put_Line ("Strings.Value (" & Package_Name & "." & Subprogram_Name);
else
Put_Line (Package_Name & "." & Subprogram_Name);
end if;
end Function_Call;
procedure Procedure_Call (Package_Name : String;
Subprogram_Name : String) is
begin
Put_Line (Package_Name & "." & Subprogram_Name);
end Procedure_Call;
procedure Actual_Parameter (Formal_Name : String;
Subprogram_Name : String;
Component_Name : String;
Is_String : Boolean;
Last : Boolean;
Is_Return_String : Boolean) is
begin
if Is_String then
if Last then
if Is_Return_String then
Put_Line (Formal_Name & " => Strings.Image (" &
Component_Name & ")));");
else
Put_Line (Formal_Name & " => Strings.Image (" &
Component_Name & "));");
end if;
else
Put_Line (Formal_Name & " => Strings.Image (" &
Component_Name & "),");
end if;
else
if Last then
if Is_Return_String then
Put_Line (Formal_Name & " => " & Component_Name & "));");
else
Put_Line (Formal_Name & " => " & Component_Name & ");");
end if;
else
Put_Line (Formal_Name & " => " & Component_Name & ",");
end if;
end if;
end Actual_Parameter;
procedure Terminate_Execution is
begin
Put_Line ("Report.Terminate_Execution;");
end Terminate_Execution;
procedure Exception_Handler is
begin
Put_Line ("exception");
Put_Line ("when others =>");
Terminate_Execution;
New_Line;
Report_New_Line;
New_Line;
Put_Line ("Report.Exception_Raise (Debug_Tools.Get_Exception_name);");
end Exception_Handler;
procedure If_Token is
begin
Put_Line ("if");
end If_Token;
procedure Or_Token is
begin
Put_Line ("or");
end Or_Token;
procedure And_Token is
begin
Put_Line ("and");
end And_Token;
procedure Then_Token is
begin
Put_Line ("then");
end Then_Token;
procedure Else_Token is
begin
Put_Line ("else");
end Else_Token;
procedure Report_Passed is
begin
Put_Line ("Report.Passed;");
end Report_Passed;
procedure Report_Failed is
begin
Put_Line ("Report.Failed;");
end Report_Failed;
procedure Function_Return_Compare (Is_String : Boolean) is
begin
if Is_String then
Put_Line ("Strings.Image (Function_Return_value) =");
Put_Line
("Strings.Image (parameters.expected_function_return_value)");
else
Put_Line
("Function_Return_value = parameters.expected_function_return_value");
end if;
end Function_Return_Compare;
procedure Function_Expected_Value (Is_String : Boolean) is
begin
Put_Line ("Report.Value (" & """" & "EXPECTED VALUE" & """" & ",");
if Is_String then
Put_Line ("Strings.Image (Parameters.Expected_return_value),");
else
Put_Line ("Image (Parameters.Expected_return_value),");
end if;
Put_Line ("Indent => 0);");
end Function_Expected_Value;
procedure Function_Return_Value (Is_String : Boolean) is
begin
Put_Line ("Report.Value (" & """" & "RETURN VALUE" & """" & ",");
if Is_String then
Put_Line ("Strings.Image (Parameters.Expected_return_value),");
else
Put_Line ("Image (Parameters.Expected_return_value),");
end if;
Put_Line ("Indent => 0);");
end Function_Return_Value;
procedure Comparison
(Value1 : String; Value2 : String; Is_String : Boolean) is
begin
if Is_String then
Put_Line ("Strings.Image (" & Value1 & ") =");
Put_Line ("Strings.Image (" & Value2 & ")");
else
Put_Line (Value1 & " =");
Put_Line (Value2);
end if;
end Comparison;
procedure Call_Test_Subprogram (Package_Name : String; Name : String) is
begin
Put_Line ("Test_" & Package_Name & ".Test_" & Name & ";");
end Call_Test_Subprogram;
procedure Call_Test_Open (Package_Name : String) is
begin
Put_Line ("Test_" & Package_Name & ".Open (Report_name);");
end Call_Test_Open;
procedure Call_Test_Close (Package_Name : String) is
begin
Put_Line ("Test_" & Package_Name & ".Close;");
end Call_Test_Close;
procedure Main_Program (Package_Name : String) is
begin
Put_Line ("procedure Test_All_" & Package_Name &
"_Subprograms (Report_Name : String :=" &
"""" & """" & ") is");
end Main_Program;
procedure Pragma_Main is
begin
Put_Line ("pragma Main;");
end Pragma_Main;
procedure Expression_Prompt is
begin
Put_Line ("[expression]");
end Expression_Prompt;
procedure True_Token is
begin
Put_Line ("true");
end True_Token;
procedure Local_Output_Value (Component_Name : String;
Type_Name : String;
Is_String : Boolean) is
begin
if Is_String then
Put_Line (Component_Name & " : Strings.Variable_String;");
else
Put_Line (Component_Name & " : " & Type_Name & ";");
end if;
end Local_Output_Value;
procedure Equality_Renames (Package_Name : String; Type_Name : String) is
begin
Put_Line ("function " & """" & "=" & """" & "(t1,t2 : " &
Package_Name & "." & Type_Name & ")");
Put_Line ("return Boolean renames " & Package_Name &
"." & """" & "=" & """" & ";");
end Equality_Renames;
procedure Put_String (S : String) is
begin
Put (S);
end Put_String;
end Unit_Test_Fragments;