english
version "1.0"
identify "%Z%%M% %I% %E%"

#: Copyright (c) 1995, 2002 by Wayne C. Gramlich.
#, All rights reserved.
#,
#, Permission to use, copy, modify, distribute, and sell this software
#, for any purpose is hereby granted without fee provided that the above
#, copyright notice and this permission are retained.  The author makes
#, no representations about the suitability of this software for any purpose.
#, It is provided "as is" without express or implied warranty.

module differ_test

#: This module implements tests the {differ} module.

import
    address
    character
    differ
    format
    in_stream
    integer
    logical
    out_stream
    set
    string
    system
    unsigned
    vector

procedure main
    takes
	system system
    returns unsigned

    #: This procedure will check the {aligns_find}@{differ_table}
    #, procedure.

    debug_stream :@= system.standard_out_stream
    differ_table :@= create@differ_table[string]()
    differ_table.debug_stream := debug_stream

    # Equality checks:
    check(differ_table, debug_stream, 'Equal 1',
      "", "")
    check(differ_table, debug_stream, 'Equal 2',
      "1", "1")
    check(differ_table, debug_stream, 'Equal 3',
      "1 2", "1 2")
    check(differ_table, debug_stream, 'Equal 4',
      "1 2 1", "1 2 1")
    check(differ_table, debug_stream, 'Equal 5',
      "1 2 1 2", "1 2 1 2")

    # All diffs:
    check(differ_table, debug_stream, 'All Diff 1',
      "[1]", "[]")
    check(differ_table, debug_stream, 'All Diff 2',
      "[1 2]", "[]")
    check(differ_table, debug_stream, 'All Diff 3',
      "[]", "[1]")
    check(differ_table, debug_stream, 'All Diff 4',
      "[]", "[1 2]")
    check(differ_table, debug_stream, 'All Diff 5',
      "[1]", "[2]")
    check(differ_table, debug_stream, 'All Diff 6',
      "[1]", "[2 3]")
    check(differ_table, debug_stream, 'All Diff 7',
      "[1 2]", "[3]")
    check(differ_table, debug_stream, 'All Diff 8',
      "[1 2]", "[3 4]")

    # Back diffs:
    check(differ_table, debug_stream, 'Back Diff 1',
      "1 [2]", "1 []")
    check(differ_table, debug_stream, 'Back Diff 2',
      "1 [2 3]", "1 []")
    check(differ_table, debug_stream, 'Back Diff 3',
      "1 []", "1 [2]")
    check(differ_table, debug_stream, 'Back Diff 4',
      "1 []", "1 [2 3]")
    check(differ_table, debug_stream, 'Back Diff 5',
      "1 [2]", "1 [3]")
    check(differ_table, debug_stream, 'Back Diff 6',
      "1 [2]", "1 [3 4]")
    check(differ_table, debug_stream, 'Back Diff 7',
      "1 [2 3]", "1 [4]")
    check(differ_table, debug_stream, 'Back Diff 8',
      "1 [2 3]", "1 [4 5]")

    # Front diffs:
    check(differ_table, debug_stream, 'Front Diff 1',
      "[1] 2", "[] 2")
    check(differ_table, debug_stream, 'Front Diff 2',
      "[1 2] 3", "[] 3")
    check(differ_table, debug_stream, 'Front Diff 3',
      "[] 2", "[1] 2")
    check(differ_table, debug_stream, 'Front Diff 4',
      "[] 3", "[1 2] 3")
    check(differ_table, debug_stream, 'Front Diff 5',
      "[1] 3", "[2] 3")
    check(differ_table, debug_stream, 'Front Diff 6',
      "[1] 4", "[2 3] 4")
    check(differ_table, debug_stream, 'Front Diff 7',
      "[1 2] 4", "[3] 4")
    check(differ_table, debug_stream, 'Front Diff 8',
      "[1 2] 5", "[3 4] 5")

    # Middle aligns:
    check(differ_table, debug_stream, 'Middle Diff 1',
      "1 [2] 3", "1 [] 3")
    check(differ_table, debug_stream, 'Middle Diff 2',
      "1 [2 3] 4", "1 [] 4")
    check(differ_table, debug_stream, 'Middle diff 3',
      "1 [] 3", "1 [2] 3")
    check(differ_table, debug_stream, 'Middle diff 4',
      "1 [] 4", "1 [2 3] 4")
    check(differ_table, debug_stream, 'Middle Diff 5',
      "1 [2] 4", "1 [3] 4")
    check(differ_table, debug_stream, 'Middle Diff 6',
      "1 [2 3] 5", "1 [4] 5")
    check(differ_table, debug_stream, 'Middle diff 7',
      "1 [2] 5", "1 [3 4] 5")
    check(differ_table, debug_stream, 'Middle diff 8',
      "1 [2 3] 6", "1 [4 5] 6")

    # Move aligns:
    check(differ_table, debug_stream, 'Move diff 1',
      "[1] 2 3 [] 4 5", "[] 2 3 [1] 4 5")
    check(differ_table, debug_stream, 'Move diff 2',
      "[1 2] 3 4 5 [] 6 7", "[] 3 4 5 [1 2] 6 7")
    check(differ_table, debug_stream, 'Move diff 3',
      "[] 1 2 [3] 4 5", "[3] 1 2 [] 4 5")
    check(differ_table, debug_stream, 'Move diff 4',
      "[] 1 2 3 [4 5] 6 7", "[4 5] 1 2 3 [] 6 7")

    # Double middle aligns:
    check(differ_table, debug_stream, 'Double middle test 1',
      "1 [2] 3 [4] 5", "1 [] 3 [] 5")
    check(differ_table, debug_stream, 'Double middle test 2',
      "1 [] 3 [] 5", "1 [2] 3 [4] 5")
    check(differ_table, debug_stream, 'Double middle test 3',
      "1 [] 3 [4] 5", "1 [2] 3 [] 5")
    check(differ_table, debug_stream, 'Double middle test 4',
      "1 [2] 3 [] 5", "1 [] 3 [4] 5")
    check(differ_table, debug_stream, 'Double middle test 5',
      "1 [4] 3 [4] 5", "1 [2] 3 [2] 5")
    check(differ_table, debug_stream, 'Double middle test 6',
      "1 [4] 3 [] 5", "1 [2] 3 [2] 5")
    check(differ_table, debug_stream, 'Double middle test 7',
      "1 [4] 3 [4] 5", "1 [2] 3 [] 5")
    check(differ_table, debug_stream, 'Double middle test 8',
      "1 [] 3 [4] 5", "1 [2] 3 [2] 5")
    check(differ_table, debug_stream, 'Double middle test 9',
      "1 2 [3] 4 5 [6] 7 8", "1 2 [] 4 5 [3] 7 8")


    # Multiple middle aligns:
    check(differ_table, debug_stream, 'Multiple middle test 1',
      "Front [cat] middle1 [dog] middle2 [mouse] back",
      "Front [] middle1 [] middle2 [] back")
    check(differ_table, debug_stream, 'Multiple middle test 2',
      "Front [cat] middle1 [dog] middle2 [mouse] middle3 [cow] back",
      "Front [] middle1 [] middle2 [] middle3 [] back")
    check(differ_table, debug_stream, 'Multiple middle test 3',
      "Front [cat] mid1 [dog] mid2 [mouse] mid3 [cow] mid4 [horse] back",
      "Front [] mid1 [] mid2 [] mid3 [] mid4 [] back")

    return 0


procedure check
    takes
	differ_table differ_table[string]
	debug_stream out_stream
	test_name string
	string1 string
	string2 string
    returns_nothing

    #: This procedure will verify that the appropriate differences
    #, between {string1} and {string2} are determined by
    #, {aligns_find}@{differ_table}().  The format of {string1} and
    #, {string2} is a list of space separated words.  Differences
    #, between the two strings are indicated by enclosing the
    #, differences in square brackets ('[...]').  The test results
    #, labeled by {test_name} are output to {debug_stream}.

    errors:: logical := false
    space :@= " "[0]

    words1 :@= split@(string1, space)
    words2 :@= split@(string2, space)
    aligns :@= aligns_find@(differ_table, words1, words2)


    # First make sure that the span sets cover everything:
    size :@= aligns.size
    text1 :@= allocate@string()
    text2 :@= allocate@string()
    index :@= 0
    loop
	while index < size
	align :@= aligns[index]
	type :@= align.type
	sequence1 :@= align.sequence1
	sequence2 :@= align.sequence2
	if sequence1.length = 0 && sequence2.length = 0
	    put@("Zero length align!\n\", debug_stream)
	    errors := true
	text_append@(sequence1, text1, type, "sequence1")
	text_append@(sequence2, text2, type, "sequence2")
	index :+= 1
    if text1 != string1
	errors := true
    if text2 != string2
	errors := true

    # Print out the test result:
    # aligns_deallocate@(differ_table, aligns)
    if errors
	format@format1[string](debug_stream, '%ds% failed:\n\', test_name)
	format@format2[string, string](debug_stream,
	  "\t\input1:%ds% != output1:%ds%\n\", string1, text1)
	format@format2[string, string](debug_stream,
	  "\t\input2:%ds% != output2:%ds%\n\", string2, text2)
    else
	format@format1[string](debug_stream, '%ds% succeeded!\n\', test_name)


procedure text_append@string
    takes
	append_string string
	text string
    returns_nothing

    #: This procedure will append {append_string} to the end of {text}.

    string_append@(text, append_string)


procedure text_append@sequence[item]
    takes
	sequence sequence[item]
	text string
	type align_type
	label string
    returns_nothing
    needs
	procedure text_append@item
	    takes item, string
	    returns_nothing
	procedure print@item
	    takes item, out_stream
	    returns_nothing

    #: This procedure will append {sequence} to {text}.

    debug_stream :@= sequence.differ_table.debug_stream

    items :@= sequence.items
    length :@= sequence.length
    start :@= sequence.start
    #format@format1[string](debug_stream, "label:%ds% type:", label)
    #print@(type, debug_stream)
    #format@format2[unsigned, unsigned](debug_stream,
    #  " start:%d% length:%d%\n\", start, length)
    if length = 0
	if type = differ
	    if text.size != 0
		string_append@(text, " ")
	    string_append@(text, "[]")
    else
	index :@= 0
	loop
	    while index < length
	    item :@= items[start + index]
	    if index = 0
		if text.size != 0
		    string_append@(text, " ")
		if type = differ
		    string_append@(text, "[")
		    text_append@(item, text)
		    if length = 1
			string_append@(text, "]")
		else
		    text_append@(item, text)
	    else_if index + 1 = length
		string_append@(text, " ")
		text_append@(item, text)
		if type = differ
		    string_append@(text, "]")
	    else
		string_append@(text, " ")
		text_append@(item, text)
	    index :+= 1


procedure split@string
    takes
	text string
	separator character
    returns vector[string]

    #: This procedure will break {text} into a sequence of words
    #, separated by {separator} and return the sequence.  Multiple
    #, occurrances of {separator} in a row are treated as a single
    #, occurance of {separator}.  The `[' and `]' characters are
    #, ignored.

    left_bracket :@= "["[0]
    right_bracket :@= "]"[0]
    words :@= allocate@vector[string]()
    word :@= allocate@string()
    size :@= text.size
    index :@= 0
    loop
	while index < size
	character :@= text[index]
	if character = separator
	    if word.size != 0
		append@(words, word)
		word :@= allocate@string()
	else_if character != left_bracket && character != right_bracket
	    character_append@(word, character)
	index :+= 1
    if word.size != 0
	append@(words, word)
    return words