diff --git a/src/comp/bluetcl.hs b/src/comp/bluetcl.hs index 4a729593e..08dd18155 100644 --- a/src/comp/bluetcl.hs +++ b/src/comp/bluetcl.hs @@ -349,6 +349,8 @@ helpCmd interp [_,cmd] = do isArg _ = False isKW (Just (Keyword _ _ _)) = True isKW _ = False + isKWorNone Nothing = True + isKWorNone e = isKW e matched' = dropWhile isArg matched cmd_words = map fst (reverse matched') let cmd_objs = take (length cmd_words) os @@ -373,7 +375,7 @@ helpCmd interp [_,cmd] = do else [ "", ld ] subtopics = case g' of (ChooseFrom gs) -> - if (all isKW (map htclFirstCmdElem gs)) + if (all isKWorNone (map htclFirstCmdElem gs)) then [ "", "Subcommands: " ] ++ [ " " ++ name ++ descr | gr <- gs @@ -400,11 +402,20 @@ helpCmd interp objs = htclCheckCmd helpGrammar fn interp objs -------------------------------------------------------------------------------- versionGrammar :: HTclCmdGrammar -versionGrammar = tclcmd "version" namespace helpStr "" +versionGrammar = (tclcmd "version" namespace helpStr longHelpStr) .+. + (optional $ oneOf [ kw "bsc" bscHelpStr "" + , kw "ghc" ghcHelpStr "" + ]) where helpStr = "Returns version information for Bluespec software" - -versionNum :: [String] -> IO [String] -versionNum [] = return $ [versionname, buildVersion] + longHelpStr = init $ unlines + [ "If no argument is provided, the subcommand 'bsc' is assumed." ] + bscHelpStr = "Show BSC version information" + ghcHelpStr = "Show the GHC version used to compile BSC" + +versionNum :: [String] -> IO HTclObj +versionNum [] = versionNum ["bsc"] +versionNum ["bsc"] = return $ TLst [TStr versionname, TStr buildVersion] +versionNum ["ghc"] = return $ TStr __GLASGOW_HASKELL_FULL_VERSION__ versionNum xs = internalError $ "versionNum: grammar mismatch: " ++ (show xs) -------------------------------------------------------------------------------- diff --git a/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp b/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp index f1be61708..3e0bb1f19 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp +++ b/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp @@ -1,17 +1,36 @@ + +set rtsflags {+RTS -M256M -Sstderr -RTS} + +# GHC 9.8.1 has regressions +set is_ghc_9_8 [ expr [regexp {^\d+\.\d+} $ghc_version majmin] && \ + $majmin == "9.8" ] +set rtsflags_9_8 {+RTS -M265M -Sstderr -RTS} + +proc compile_verilog_pass_except { filename except rtsflags rtsflags_except} { + if { $except } { + compile_verilog_fail $filename {} $rtsflags + copy [make_bsc_vcomp_output_name $filename] \ + [make_bsc_vcomp_output_name $filename.try1] + compile_verilog_pass $filename {} $rtsflags_except + } else { + compile_verilog_pass $filename {} $rtsflags + } +} + # ----- -compile_verilog_pass Bug1490Bool.bsv "" "+RTS -M256M -Sstderr -RTS" -compile_verilog_pass Bug1490MyBool.bsv "" "+RTS -M256M -Sstderr -RTS" -compile_verilog_pass Bug1490MyUnion.bsv "" "+RTS -M256M -Sstderr -RTS" -compile_verilog_pass Bug1490MyEnum.bsv "" "+RTS -M256M -Sstderr -RTS" +compile_verilog_pass Bug1490Bool.bsv {} $rtsflags +compile_verilog_pass Bug1490MyBool.bsv {} $rtsflags +compile_verilog_pass_except Bug1490MyUnion.bsv $is_ghc_9_8 $rtsflags $rtsflags_9_8 +compile_verilog_pass Bug1490MyEnum.bsv {} $rtsflags # ----- # There has been a regression and this example now exhausts the heap -compile_verilog_fail VsortOriginal.bsv "" "+RTS -M256M -Sstderr -RTS" +compile_verilog_fail VsortOriginal.bsv {} $rtsflags # Confirm that the test failed in the way we expect find_n_strings [make_bsc_vcomp_output_name VsortOriginal.bsv] "Heap exhausted" 1 -compile_verilog_pass VsortWorkaround.bsv "" "+RTS -M256M -Sstderr -RTS" +compile_verilog_pass_except VsortWorkaround.bsv $is_ghc_9_8 $rtsflags $rtsflags_9_8 # ----- diff --git a/testsuite/config/unix.exp b/testsuite/config/unix.exp index 5c93b94b7..6a456ab71 100644 --- a/testsuite/config/unix.exp +++ b/testsuite/config/unix.exp @@ -446,18 +446,33 @@ proc get_default_bsdir {} { } proc get_bsc_version {} { - global bsc + global bluetcl - if {$bsc != 0} then { - set helloworld [exec $bsc -v] - regexp "version .*" $helloworld version - if {![info exists version]} then { - #warning "Couldn't determine version of $bsc from `$helloworld'" - set version "unknown version" - } - } else { # this should have been detected - warning "Can't find bsc to determine version" - set version "unknown version" + bluetcl_initialize + + if { [catch "exec echo \"puts \\\[::Bluetcl::version bsc\\\]\" | $bluetcl" version] } { + perror "failed to execute bluetcl to get BSC version: $version" + exit 1 + } + if { $version == "" } { + perror "BSC version is empty" + exit 1 + } + return $version +} + +proc get_ghc_version {} { + global bluetcl + + bluetcl_initialize + + if { [catch "exec echo \"puts \\\[::Bluetcl::version ghc\\\]\" | $bluetcl" version] } { + perror "failed to execute bluetcl to get GHC version: $version" + exit 1 + } + if { $version == "" } { + perror "GHC version is empty" + exit 1 } return $version } @@ -3177,6 +3192,12 @@ set_warning_threshold 0 set bsdir [get_bsdir] verbose -log "Bluespec dir: $bsdir" 1 +set bsc_version [get_bsc_version] +verbose -log "Bluespec version: $bsc_version" 1 + +set ghc_version [get_ghc_version] +verbose -log "Bluespec tools compiled with GHC version: $ghc_version" 1 + get_test_options verbose -log "Do verilog backend tests is $vtest" 1 verbose -log "Do c backend tests is $ctest" 1 @@ -3235,6 +3256,8 @@ proc bsc_initialize {} { global bsc_initialized global env global bsc + global bsc_version + global ghc_version global bsdir global showrules @@ -3251,7 +3274,6 @@ proc bsc_initialize {} { # find bsc and version and bs prelude set bsc [which_bsc] - set bsc_version [get_bsc_version] # These functions insist that the binaries be available. # Since they are only used for internal tests, we should only insist on @@ -3275,6 +3297,7 @@ proc bsc_initialize {} { } verbose -log "Using $bsc ($bsc_version) for tests." 1 + verbose -log "BSC was compiled with GHC version $ghc_version." 1 verbose -log "Compiler options: $::env(BSC_OPTIONS)" 1 if [do_internal_checks] { verbose -log "Path to dumpbo: $dumpbo" 1