Preserve source identities

contest.sh

@@ -25,9 +25,6 @@ test_dir=$(dirname $file)
 build_dir="$root_dir/build"
 base=$(basename "$file" .json)
 src="$test_dir/$base.solc"
-hull="$build_dir/output1.hull"
-hexfile="$build_dir/$base.hex"
-yulfile="$build_dir/$base.yul"
 
 create=true
 # Allow overriding testrunner location (useful for Nix builds)
@@ -87,16 +84,41 @@ suite=$(echo $presuite | tr -d '"')
 echo "Compiling to Hull..."
 # Allow overriding sol-core command (useful for Nix builds)
 : ${SOLCORE_CMD:="cabal run exe:sol-core --"}
-if ! $SOLCORE_CMD -f "$src"; then
+mkdir -p "$build_dir"
+work_root="$build_dir/.contest-work"
+mkdir -p "$work_root"
+work_dir="$(mktemp -d "$work_root/run.XXXXXX")"
+work_marker="$work_dir/.owned-by-contest"
+touch "$work_marker"
+hull="$work_dir/output1.hull"
+yulfile="$work_dir/output.yul"
+hexfile="$work_dir/output.hex"
+runner_input="$work_dir/runner-input.json"
+runner_output="$work_dir/runner-output.json"
+
+cleanup_work_dir() {
+    if [[ -z "${work_dir:-}" ]]; then
+        return
+    fi
+
+    if [[ "$work_dir" != "$work_root"/run.* || ! -f "$work_marker" ]]; then
+        echo "Error: refusing to clean unverified contest work directory '$work_dir'" >&2
+        return 1
+    fi
+
+    rm -rf -- "$work_dir"
+}
+
+trap cleanup_work_dir EXIT
+trap 'exit 129' HUP
+trap 'exit 130' INT
+trap 'exit 143' TERM
+
+if ! $SOLCORE_CMD -f "$src" -o "$work_dir"; then
     echo "Error: sol-core compilation failed"
     exit 1
 fi
 
-mkdir -p "$build_dir"
-if ls ./output*.hull 1> /dev/null 2>&1; then
-    mv ./output*.hull "$build_dir"/
-fi
-
 if [[ ! -f "$hull" ]]; then
     echo "Error: sol-core did not produce output1.hull"
     exit 1
@@ -122,6 +144,6 @@ fi
 
 echo "Hex output: $hexfile"
 
-jq ".$suite.bytecode |= \"$(cat $hexfile)\" " $file > $build_dir/$suite.json
+jq ".$suite.bytecode |= \"$(cat $hexfile)\" " $file > "$runner_input"
 
-"$testrunner_exe" "$evmone" "$build_dir/$suite.json" "$build_dir/$suite-output.json"
+"$testrunner_exe" "$evmone" "$runner_input" "$runner_output"

run_contests.sh

@@ -5,6 +5,8 @@ set -euo pipefail
 root_dir="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)"
 cd "$root_dir"
 
+bash ./scripts/test_contest_concurrency.sh
+
 bash ./contest.sh test/examples/dispatch/basic.json
 bash ./contest.sh test/examples/dispatch/assembly.json
 bash ./contest.sh test/examples/dispatch/neg.json

scripts/test_contest_concurrency.sh

@@ -0,0 +1,208 @@
+#!/usr/bin/env bash
+
+set -euo pipefail
+
+repo_root="$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd)"
+tmp_parent="${TMPDIR:-/tmp}"
+tmp_parent="${tmp_parent%/}"
+test_root="$(mktemp -d "$tmp_parent/solcore-contest-concurrency.XXXXXX")"
+test_marker="$test_root/.owned-by-contest-concurrency-test"
+touch "$test_marker"
+
+cleanup_test_root() {
+    if [[ "$test_root" != "$tmp_parent"/solcore-contest-concurrency.* || ! -f "$test_marker" ]]; then
+        echo "Error: refusing to clean unverified test directory '$test_root'" >&2
+        return 1
+    fi
+
+    rm -rf -- "$test_root"
+}
+
+trap cleanup_test_root EXIT
+trap 'exit 129' HUP
+trap 'exit 130' INT
+trap 'exit 143' TERM
+
+mkdir -p \
+    "$test_root/cases/alpha" \
+    "$test_root/cases/beta" \
+    "$test_root/fake-bin" \
+    "$test_root/state"
+cp "$repo_root/contest.sh" "$test_root/contest.sh"
+chmod +x "$test_root/contest.sh"
+
+printf '%s\n' alpha > "$test_root/cases/alpha/shared.solc"
+printf '%s\n' '{"shared": {}}' > "$test_root/cases/alpha/shared.json"
+printf '%s\n' beta > "$test_root/cases/beta/shared.solc"
+printf '%s\n' '{"shared": {}}' > "$test_root/cases/beta/shared.json"
+printf '%s\n' user-owned-sentinel > "$test_root/output1.hull"
+touch "$test_root/libevmone.so"
+
+cat > "$test_root/fake-bin/tool" <<'EOF'
+#!/usr/bin/env bash
+
+set -euo pipefail
+
+tool="$(basename "$0")"
+
+case "$tool" in
+    sol-core)
+        src=
+        output_dir=
+        while [[ $# -gt 0 ]]; do
+            case "$1" in
+                -f)
+                    src="$2"
+                    shift 2
+                    ;;
+                -o)
+                    output_dir="$2"
+                    shift 2
+                    ;;
+                *)
+                    shift
+                    ;;
+            esac
+        done
+
+        case_name="$FAKE_CASE"
+        [[ "$(<"$src")" == "$case_name" ]]
+        printf '%s\n' "$case_name" > "$output_dir/output1.hull"
+        printf '%s\n' "$output_dir" > "$FAKE_STATE/$case_name.work-dir"
+        touch "$FAKE_STATE/compiler-$case_name.ready"
+
+        deadline=$((SECONDS + 10))
+        until [[ -f "$FAKE_STATE/compiler-alpha.ready" && -f "$FAKE_STATE/compiler-beta.ready" ]]; do
+            if (( SECONDS >= deadline )); then
+                echo "Timed out waiting for both fake compilers" >&2
+                exit 1
+            fi
+            sleep 0.01
+        done
+        ;;
+    yule)
+        hull="$1"
+        shift
+        output=
+        while [[ $# -gt 0 ]]; do
+            case "$1" in
+                -o)
+                    output="$2"
+                    shift 2
+                    ;;
+                *)
+                    shift
+                    ;;
+            esac
+        done
+
+        case_name="$(<"$hull")"
+        printf '%s\n' "$output" > "$FAKE_STATE/$case_name.yul-path"
+        printf '%s\n' "$case_name" > "$output"
+        ;;
+    solc)
+        yul=
+        for arg in "$@"; do
+            yul="$arg"
+        done
+        case_name="$(<"$yul")"
+        [[ "$case_name" == "$FAKE_CASE" ]]
+        printf '%s\n' "$yul" > "$FAKE_STATE/$case_name.solc-input"
+        printf '%s\n' "Binary representation:" "hex-$case_name"
+        ;;
+    jq)
+        if [[ "$1" == "keys[0]" ]]; then
+            printf '%s\n' '"shared"'
+        else
+            [[ "$1" == *"hex-$FAKE_CASE"* ]]
+            printf '{"shared":{"bytecode":"%s","case":"%s"}}\n' \
+                "hex-$FAKE_CASE" "$FAKE_CASE"
+        fi
+        ;;
+    testrunner)
+        [[ -f "$1" ]]
+        [[ -f "$2" ]]
+        command grep -q "\"case\":\"$FAKE_CASE\"" "$2"
+        printf '%s\n' "$2" > "$FAKE_STATE/$FAKE_CASE.runner-input"
+        printf '%s\n' "$3" > "$FAKE_STATE/$FAKE_CASE.runner-output"
+        printf '{"ok":true,"case":"%s"}\n' "$FAKE_CASE" > "$3"
+        ;;
+    *)
+        echo "Unexpected fake tool name: $tool" >&2
+        exit 1
+        ;;
+esac
+EOF
+
+chmod +x "$test_root/fake-bin/tool"
+for tool in sol-core yule solc jq testrunner; do
+    ln -s tool "$test_root/fake-bin/$tool"
+done
+
+run_case() {
+    local case_name="$1"
+
+    PATH="$test_root/fake-bin:$PATH" \
+        SOLCORE_CMD="$test_root/fake-bin/sol-core" \
+        YULE_CMD="$test_root/fake-bin/yule" \
+        testrunner_exe="$test_root/fake-bin/testrunner" \
+        evmone="$test_root/libevmone.so" \
+        FAKE_STATE="$test_root/state" \
+        FAKE_CASE="$case_name" \
+        bash "$test_root/contest.sh" \
+        "$test_root/cases/$case_name/shared.json" \
+        > "$test_root/state/$case_name.log" 2>&1
+}
+
+run_case alpha &
+alpha_pid=$!
+run_case beta &
+beta_pid=$!
+
+failed=0
+if ! wait "$alpha_pid"; then
+    command cat "$test_root/state/alpha.log" >&2
+    failed=1
+fi
+if ! wait "$beta_pid"; then
+    command cat "$test_root/state/beta.log" >&2
+    failed=1
+fi
+if [[ "$failed" != "0" ]]; then
+    exit 1
+fi
+
+alpha_work_dir="$(<"$test_root/state/alpha.work-dir")"
+beta_work_dir="$(<"$test_root/state/beta.work-dir")"
+alpha_yul_path="$(<"$test_root/state/alpha.yul-path")"
+beta_yul_path="$(<"$test_root/state/beta.yul-path")"
+alpha_solc_input="$(<"$test_root/state/alpha.solc-input")"
+beta_solc_input="$(<"$test_root/state/beta.solc-input")"
+alpha_runner_input="$(<"$test_root/state/alpha.runner-input")"
+beta_runner_input="$(<"$test_root/state/beta.runner-input")"
+alpha_runner_output="$(<"$test_root/state/alpha.runner-output")"
+beta_runner_output="$(<"$test_root/state/beta.runner-output")"
+
+[[ "$alpha_work_dir" == "$test_root/build/.contest-work/run."* ]]
+[[ "$beta_work_dir" == "$test_root/build/.contest-work/run."* ]]
+[[ "$alpha_work_dir" != "$beta_work_dir" ]]
+[[ "$alpha_yul_path" == "$alpha_work_dir/output.yul" ]]
+[[ "$beta_yul_path" == "$beta_work_dir/output.yul" ]]
+[[ "$alpha_yul_path" != "$beta_yul_path" ]]
+[[ "$alpha_solc_input" == "$alpha_yul_path" ]]
+[[ "$beta_solc_input" == "$beta_yul_path" ]]
+[[ "$alpha_runner_input" == "$alpha_work_dir/runner-input.json" ]]
+[[ "$beta_runner_input" == "$beta_work_dir/runner-input.json" ]]
+[[ "$alpha_runner_input" != "$beta_runner_input" ]]
+[[ "$alpha_runner_output" == "$alpha_work_dir/runner-output.json" ]]
+[[ "$beta_runner_output" == "$beta_work_dir/runner-output.json" ]]
+[[ "$alpha_runner_output" != "$beta_runner_output" ]]
+[[ ! -e "$alpha_work_dir" ]]
+[[ ! -e "$beta_work_dir" ]]
+[[ "$(<"$test_root/output1.hull")" == "user-owned-sentinel" ]]
+[[ ! -e "$test_root/build/shared.yul" ]]
+[[ ! -e "$test_root/build/shared.hex" ]]
+[[ ! -e "$test_root/build/shared.json" ]]
+[[ ! -e "$test_root/build/shared-output.json" ]]
+
+printf '%s\n' "contest concurrency regression passed"

sol-core.cabal

@@ -64,6 +64,7 @@ library
       Solcore.Backend.EmitHull
       Solcore.Backend.Mast
       Solcore.Backend.MastEval
+      Solcore.Backend.NameEncoding
       Solcore.Backend.Specialise
       Solcore.Desugarer.DecisionTreeCompiler
       Solcore.Desugarer.DeriveClasses
@@ -188,6 +189,7 @@ test-suite sol-core-tests
 
   -- cabal-fmt: expand test -Main
   other-modules:
+    BackendNameEncodingTests
     Cases
     ContractAbiTests
     DiagnosticCliTests

src/Solcore/Backend/EmitHull.hs

@@ -15,6 +15,7 @@ import GHC.Stack (HasCallStack)
 import Language.Hull qualified as Hull
 import Language.Yul
 import Solcore.Backend.Mast
+import Solcore.Backend.NameEncoding (encodeBackendName)
 import Solcore.Frontend.Pretty.SolcorePretty
 import Solcore.Frontend.Syntax.Contract (Constr (..), DataTy (..))
 import Solcore.Frontend.Syntax.Name
@@ -271,7 +272,7 @@ translateTCon tycon tas = do
     Just (DataTy _n tvs cs _) -> do
       let subst = zip tvs (map mastToTy tas)
       tys <- mapM (translateDCon subst) cs
-      Hull.TNamed (show tycon) <$> buildSumType tys
+      Hull.TNamed (encodeBackendName tycon) <$> buildSumType tys
     Nothing -> errorsEM ["translateTCon: unknown type ", pretty tycon, "\n", show tycon]
   where
     buildSumType :: [Hull.Type] -> EM Hull.Type

src/Solcore/Backend/NameEncoding.hs

@@ -0,0 +1,76 @@
+module Solcore.Backend.NameEncoding
+  ( encodeBackendName,
+    encodeSpecialisedName,
+    encodeTypeIdentity,
+  )
+where
+
+import Data.Char (isAlpha, isAlphaNum, ord)
+import Data.List (isInfixOf)
+import Solcore.Frontend.Syntax.Name
+import Solcore.Frontend.Syntax.Ty
+
+-- | Encode a source-level name as a Hull/Yul identifier.
+--
+-- Plain backend-safe names are preserved because entry points and inline
+-- assembly refer to names such as @main@ by their source spelling. Encoded
+-- names use the reserved "$$" namespace; a plain name containing that marker
+-- is escaped, so source and compiler-generated names cannot forge each other.
+encodeBackendName :: Name -> String
+encodeBackendName (Name name)
+  | isBackendIdentifier name && not ("$$" `isInfixOf` name) = name
+  | otherwise = "$$N" ++ encodeSegment name
+encodeBackendName qualified@QualName {} =
+  "$$Q" ++ encodeNamePayload qualified
+
+-- | Form the backend name of a specialised declaration. Source identity and
+-- type-argument boundaries are both retained in the encoding.
+encodeSpecialisedName :: Name -> [Ty] -> Name
+encodeSpecialisedName name [] = Name (encodeBackendName name)
+encodeSpecialisedName name types =
+  Name
+    ( "$$S"
+        ++ encodeField (encodeBackendName name)
+        ++ encodeList (map encodeTypeIdentity types)
+    )
+
+-- | Encode the complete structural identity of a type.
+encodeTypeIdentity :: Ty -> String
+encodeTypeIdentity (TyVar (TVar name)) =
+  "V" ++ encodeField (encodeNamePayload name)
+encodeTypeIdentity (TyVar (Skolem name)) =
+  "K" ++ encodeField (encodeNamePayload name)
+encodeTypeIdentity (Meta (MetaTv name)) =
+  "M" ++ encodeField (encodeNamePayload name)
+encodeTypeIdentity (TyCon name types) =
+  "T"
+    ++ encodeField (encodeNamePayload name)
+    ++ encodeList (map encodeTypeIdentity types)
+
+isBackendIdentifier :: String -> Bool
+isBackendIdentifier [] = False
+isBackendIdentifier (first : rest) =
+  (isAlpha first || first == '_' || first == '$')
+    && all
+      (\char -> isAlphaNum char || char == '_' || char == '$')
+      rest
+
+-- Name constructors and qualification boundaries are retained explicitly.
+-- Code points prevent source spelling from imitating structural delimiters.
+encodeNamePayload :: Name -> String
+encodeNamePayload (Name name) = "N" ++ encodeSegment name
+encodeNamePayload (QualName qualifier leaf) =
+  "Q" ++ encodeField (encodeNamePayload qualifier) ++ encodeSegment leaf
+
+encodeSegment :: String -> String
+encodeSegment value =
+  show (length value)
+    ++ "$"
+    ++ concatMap (\char -> show (ord char) ++ "_") value
+
+encodeField :: String -> String
+encodeField value = show (length value) ++ "$" ++ value
+
+encodeList :: [String] -> String
+encodeList values =
+  show (length values) ++ "$" ++ concatMap encodeField values