1. Vincenzo Ampolo
  2. gdc

Source

gdc / gdc.test / d_do_test.exp

#   Copyright (C) 2000, 2007, 2009, 2010 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/>.

# Test using the DMD testsuite.
# Load support procs.
load_lib gdc-dg.exp

# Translate DMD test directives to dejagnu equivalent.
proc dmd2dg { type test } {
    global DEFAULT_DFLAGS

    set filename [file tail $test]
    if { "$filename" == "$test" } {
        set filename "dg-$filename"
    }

    set fdin [open $test r]
    fconfigure $fdin -encoding binary
    set fdout [ open $filename w]
    fconfigure $fdout -encoding binary

    switch $type {
        compilable {
#            puts $fdout {// { dg-final { output-exists } } }
        }
    }

    while { [gets $fdin copy_line] >= 0 } {
        if [string match "*//*" $copy_line] {
            puts $fdout $copy_line
            continue
        }
        set out_line $copy_line

        # PERMUTE_ARGS.  Must be handled separately
        if [string match "PERMUTE_ARGS" $copy_line] {
            #set DEFAULT_DFLAGS [regexp]
            continue 
        }

        # COMPILE_SEPARATELY. Not handled.
        if [string match "COMPILE_SEPARATELY" $copy_line] {
            set out_line $copy_line
        }
        # POST_SCRIPT. not handled
        if [string match "POST_SCRIPT" $copy_line] {
            set out_line $copy_line
        }

        # Can be handled with dg directives.

        # EXECUTE_ARGS.  ???
        if [string match "EXECUTE_ARGS" $copy_line] {
            set out_line $copy_line
        }

        # EXTRA_SOURCES ???
        if [string match "EXTRA_SOURCES" $copy_line] {
            regsub "// *EXTRA_SOURCES:(.*)" "// dg-extra
            set out_line $copy_line
        }


        # REQUIRED_ARGS.
        if [string match "REQUIRED_ARGS" $copy_line] {
            # Also need to convert DMD arguments to GDC.
            # regsub {"// *REQUIRED_ARGS"} $copy_line {""} out_line
            set out_line $copy_line
        }
        puts $fdout $out_line
    }
    close $fdin
    close $fdout

    return $filename 
}

proc gdc-permute-options { options } {
    set result { }
    set n [expr 1<<[llength $options]]
    for { set i 0 } { $i<$n } { incr i } {
        set option ""
        for { set j 0 } { $j<[llength $options] } { incr j } {
            if [expr $i & 1 << $j] {
                append option [lindex $options $j]
                append option " "
            }
        }
        lappend result $option
        
    }
    return $result
}


proc gdc-do-test { } {
    global srcdir subdir
    global verbose
    global dg-final-code


    # If a testcase doesn't have special options, use these.
    global DEFAULT_DFLAGS
    if ![info exists DEFAULT_DFLAGS] then {
        set DEFAULT_DFLAGS "-g -O2 -funittest -frelease"
    }

    # Initialize `dg'.
    dg-init

    # Main loop.

    set verbose 1
    # Find all tests and pass to routine.
    foreach test [lsort [find $srcdir/$subdir *]] {
        regexp ".*/(.+)/(.+)\.(.+)$" $test match dir name ext

        # Skip invalid test directory
        if {[lsearch "runnable compilable fail_compilation" $dir] == -1} {
            continue
        }

        # Skip invalid test extensions
        if {[lsearch "d" $ext] == -1} {
            continue
        }

        # Convert to DG test.
        set import_dir "[file dirname $test]/import"
        set filename [dmd2dg $dir $test]

        #set options [gdc-permute-options $DEFAULT_DFLAGS]
        set options {""}

        switch $dir {
            runnable {
                # gdc-runtest  $filename
            }
            
            compilable {
                for { set i 0 } { $i<[llength $options] } { incr i } {
                    set flags [format "%s -I%s" [lindex $options $i] $import_dir]
                    puts "$filename - $flags"
                    gdc-dg-test $filename  assemble "$flags"
                }
            }
    
            fail_compilation {
                # gdc-xfail-compile $filename
            }
        }

        # Cleanup
#        file delete $filename
    }

    # All done.
    dg-finish
}

gdc-do-test