#   Copyright (C) 2004-2025 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3.  If not see
# <http://www.gnu.org/licenses/>.

load_lib gcc-dg.exp

# Define elna callbacks for dg.exp.

proc elna-dg-test { prog do_what extra_tool_flags } {
    set result \
    [gcc-dg-test-1 elna_target_compile $prog $do_what $extra_tool_flags]

    set comp_output [lindex $result 0]
    set output_file [lindex $result 1]

    return [list $comp_output $output_file]
}

proc elna-dg-prune { system text } {
    return [gcc-dg-prune $system $text]
}

# Utility routines.

#
# Escapes a directive argument so that it reaches dejagnu intact.
#
# dg.exp evaluates each extracted directive as a Tcl script
# ("catch $op"), which performs one round of backslash, command and
# variable substitution inside the double-quoted argument. Quoting the
# affected characters here means the argument dejagnu receives is
# exactly what the test author wrote, so @Error messages keep their
# regular expression semantics: "\[2\]" matches literal brackets and
# "[2]" stays a character class.
#
proc elna-escape-directive { text } {
    return [string map [list \
        "\\" "\\\\" \
        "\[" "\\\[" \
        "\]" "\\\]" \
        "\$" "\\\$" \
        "\"" "\\\""] $text]
}

#
# Replaces an elna-native directive in the line with its dg-* equivalent,
# escaping the directive argument for dejagnu's Tcl evaluation.
#
# line_var  - name of the variable holding the line in the caller.
# directive - elna directive name, e.g. @Error.
# dg_name   - dejagnu directive name, e.g. dg-error.
#
proc elna-convert-directive { line_var directive dg_name } {
    upvar 1 $line_var line

    if { [regexp -indices "\\(\\*\\s*$directive\\s+(.*?)\\s*\\*\\)" $line whole argument] } {
        set escaped [elna-escape-directive \
            [string range $line [lindex $argument 0] [lindex $argument 1]]]
        set prefix [string range $line 0 [expr {[lindex $whole 0] - 1}]]
        set suffix [string range $line [expr {[lindex $whole 1] + 1}] end]

        set line "${prefix}(* { $dg_name \"$escaped\" } *)$suffix"
    }
}

#
# This procedure copies a test file from the source tree to the
# build directory while rewriting elna-native directives to dejagnu
# dg-* equivalents.
#
# Directives (inside (* ... *) comments):
#
#   (* @Error message *)      Expected compiler error on this line.
#   (* @Flags args *)         Extra compiler flags.
#
# base - absolute path to the source directory, e.g. .../testsuite/elna.dg
# test - relative path from testsuite, e.g. fail_compilation/file_name.elna
#
proc elna-convert-test { base test } {
    set type [file dirname $test]
    set target $test

    # Opens a file in the build directory for writing and the source
    # file for reading.
    file mkdir $type
    set fin [open $base/$target r]
    set fout [open $target w]

    # Reads the source test file line by line and replace directives with
    # Elna equivalents using a regular expression.
    while { [gets $fin line] >= 0 } {
        elna-convert-directive line @Error dg-error
        elna-convert-directive line @Flags dg-additional-options
        puts $fout $line
    }

    close $fin

    # Suppress excess output so stray diagnostics do not fail the test.
    puts $fout "(* { dg-prune-output .* } *)"

    # Emit category-specific expectation.
    switch $type {
        compilable {
            # Assert that an output file was produced.
            puts $fout "(* { dg-final { output-exists } } *)"
        }
        fail_compilation {
            # Assert that no output file was produced.
            puts $fout "(* { dg-final { output-exists-not } } *)"
        }
        # Other cases are handled automatically.
    }

    close $fout

    # Reaches up one stack frame (into elna-dg-runtest) and links the
    # caller's cleanup_extra_files variable to the local name cleanups.
    upvar 1 cleanup_extra_files cleanups
    # This ensures the converted file gets deleted after the test runs.
    lappend cleanups $target

    return $target
}

#
# Main loop for convert each test to dejagnu.
#
proc elna-dg-runtest { testcases } {
    global dg-do-what-default
    # Saves dejagnu's current "what to do" setting so different test
    # types don't leak settings between tests. 
    set saved-dg-do-what-default ${dg-do-what-default}

    foreach test $testcases {
        set type [file tail [file dirname $test]]
        set name [file tail $test]
        set base [file dirname [file dirname $test]]

        set cleanup_extra_files ""
        # Calls the converter, $target receives the relative path of
        # the converted file.
        set target "[elna-convert-test $base $type/$name]"

        switch $type {
            runnable {
                set dg-do-what-default "run"
            }
            compilable -
            fail_compilation {
                set dg-do-what-default "compile"
            }
        }

        dg-test $target "" ""

        foreach srcfile $cleanup_extra_files {
            file delete $srcfile
        }
        file delete $target
    }

    set dg-do-what-default ${saved-dg-do-what-default}
}