Matthew Pickering pushed to branch wip/gdc-files at Glasgow Haskell Compiler / GHC

Commits:

17 changed files:

Changes:

  • testsuite/tests/driver/bytecode-object/A.hs
    1
    +module BytecodeTest where
    
    2
    +
    
    3
    +binding = 1 + 1

  • testsuite/tests/driver/bytecode-object/BytecodeMain.hs
    1
    +module Main where
    
    2
    +
    
    3
    +main :: IO ()
    
    4
    +main = putStrLn "Hello from BytecodeMain!"
    \ No newline at end of file

  • testsuite/tests/driver/bytecode-object/BytecodeTest.hs
    1
    +module BytecodeTest where
    
    2
    +
    
    3
    +binding = 1 + 1

  • testsuite/tests/driver/bytecode-object/Makefile
    1
    +TOP=../../..
    
    2
    +include $(TOP)/mk/boilerplate.mk
    
    3
    +include $(TOP)/mk/test.mk
    
    4
    +
    
    5
    +# Test that a .gbc file is emitted.
    
    6
    +bytecode_object1:
    
    7
    +	"$(TEST_HC)" $(TEST_HC_OPTS) BytecodeTest.hs -c -fbyte-code -fwrite-byte-code
    
    8
    +	@[ -f BytecodeTest.gbc ] || (echo "ERROR: Expected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    9
    +
    
    10
    +# Test that a -gbcdir works
    
    11
    +bytecode_object2:
    
    12
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -gbcdir=bytecode -fbyte-code -fwrite-byte-code
    
    13
    +	@[ -d bytecode ] || (echo "ERROR: Expected bytecode directory not found"; echo "Directories in current directory:"; ls -la | grep "^d"; exit 1)
    
    14
    +	@[ -f bytecode/BytecodeTest.gbc ] || (echo "ERROR: Expected bytecode/BytecodeTest.gbc file not found"; echo "Files in bytecode directory:"; ls -la bytecode/; exit 1)
    
    15
    +
    
    16
    +# Test that a -gbcsuf works
    
    17
    +bytecode_object3:
    
    18
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -gbcsuf=bc -fbyte-code -fwrite-byte-code
    
    19
    +	@[ -f BytecodeTest.bc ] || (echo "ERROR: Expected BytecodeTest.bc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    20
    +
    
    21
    +# Test that a .gbc file is emitted in --make mode.
    
    22
    +bytecode_object4:
    
    23
    +	"$(TEST_HC)" $(TEST_HC_OPTS) --make -no-link BytecodeTest.hs -fbyte-code -fwrite-byte-code
    
    24
    +	@[ -f BytecodeTest.gbc ] || (echo "ERROR: Expected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    25
    +
    
    26
    +# Test that a -gbcdir works in --make mode
    
    27
    +bytecode_object5:
    
    28
    +	"$(TEST_HC)" $(TEST_HC_OPTS) --make -no-link BytecodeTest.hs -gbcdir=bytecode -fbyte-code -fwrite-byte-code
    
    29
    +	@[ -d bytecode ] || (echo "ERROR: Expected bytecode directory not found"; echo "Directories in current directory:"; ls -la | grep "^d"; exit 1)
    
    30
    +	@[ -f bytecode/BytecodeTest.gbc ] || (echo "ERROR: Expected bytecode/BytecodeTest.gbc file not found"; echo "Files in bytecode directory:"; ls -la bytecode/; exit 1)
    
    31
    +
    
    32
    +# Test that a -gbcsuf works in --make mode
    
    33
    +bytecode_object6:
    
    34
    +	"$(TEST_HC)" $(TEST_HC_OPTS) --make -no-link BytecodeTest.hs -gbcsuf=bc -fbyte-code -fwrite-byte-code
    
    35
    +	@[ -f BytecodeTest.bc ] || (echo "ERROR: Expected BytecodeTest.bc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    36
    +
    
    37
    +# Test that both .o and .gbc files are emitted with -fbyte-code-and-object-code
    
    38
    +bytecode_object7:
    
    39
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code-and-object-code -fwrite-byte-code
    
    40
    +	@[ -f BytecodeTest.o ] || (echo "ERROR: Expected BytecodeTest.o file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    41
    +	@[ -f BytecodeTest.gbc ] || (echo "ERROR: Expected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    42
    +
    
    43
    +# Test that -gbcdir works with -fbyte-code-and-object-code
    
    44
    +bytecode_object8:
    
    45
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -gbcdir=bytecode -fbyte-code-and-object-code -fwrite-byte-code
    
    46
    +	@[ -f BytecodeTest.o ] || (echo "ERROR: Expected BytecodeTest.o file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    47
    +	@[ -d bytecode ] || (echo "ERROR: Expected bytecode directory not found"; echo "Directories in current directory:"; ls -la | grep "^d"; exit 1)
    
    48
    +	@[ -f bytecode/BytecodeTest.gbc ] || (echo "ERROR: Expected bytecode/BytecodeTest.gbc file not found"; echo "Files in bytecode directory:"; ls -la bytecode/; exit 1)
    
    49
    +
    
    50
    +# Test that -gbcsuf works with -fbyte-code-and-object-code
    
    51
    +bytecode_object9:
    
    52
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -gbcsuf=bc -fbyte-code-and-object-code -fwrite-byte-code
    
    53
    +	@[ -f BytecodeTest.o ] || (echo "ERROR: Expected BytecodeTest.o file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    54
    +	@[ -f BytecodeTest.bc ] || (echo "ERROR: Expected BytecodeTest.bc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    55
    +
    
    56
    +# Test that -fbyte-code alone doesn't produce .hi or .o files
    
    57
    +bytecode_object10:
    
    58
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code
    
    59
    +	@[ ! -f BytecodeTest.hi ] || (echo "ERROR: Unexpected BytecodeTest.hi file found"; echo "Files in current directory:"; ls -la; exit 1)
    
    60
    +	@[ ! -f BytecodeTest.o ] || (echo "ERROR: Unexpected BytecodeTest.o file found"; echo "Files in current directory:"; ls -la; exit 1)
    
    61
    +
    
    62
    +# Test that -fbyte-code alone in --make mode doesn't produce .hi or .o files
    
    63
    +bytecode_object11:
    
    64
    +	"$(TEST_HC)" $(TEST_HC_OPTS) --make -no-link -v0 BytecodeTest.hs -fbyte-code
    
    65
    +	@[ ! -f BytecodeTest.hi ] || (echo "ERROR: Unexpected BytecodeTest.hi file found"; echo "Files in current directory:"; ls -la; exit 1)
    
    66
    +	@[ ! -f BytecodeTest.o ] || (echo "ERROR: Unexpected BytecodeTest.o file found"; echo "Files in current directory:"; ls -la; exit 1)
    
    67
    +
    
    68
    +# Test what happens with -fbyte-code and a Main module in --make mode
    
    69
    +bytecode_object12:
    
    70
    +	"$(TEST_HC)" $(TEST_HC_OPTS) --make -v0 BytecodeMain.hs -fbyte-code
    
    71
    +	@[ ! -f BytecodeMain.hi ] || (echo "ERROR: Unexpected BytecodeMain.hi file found"; echo "Files in current directory:"; ls -la; exit 1)
    
    72
    +	@[ ! -f BytecodeMain.o ] || (echo "ERROR: Unexpected BytecodeMain.o file found"; echo "Files in current directory:"; ls -la; exit 1)
    
    73
    +	@[ ! -f BytecodeMain ] || (echo "ERROR: Unexpected BytecodeMain executable found"; echo "Files in current directory:"; ls -la; exit 1)
    
    74
    +
    
    75
    +# Test recompilation by generating .gdc first, then starting GHCi
    
    76
    +bytecode_object13:
    
    77
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -dynamic -c BytecodeTest.hs -fbyte-code -fwrite-byte-code -fwrite-interface
    
    78
    +	@[ -f BytecodeTest.gbc ] || (echo "ERROR: Expected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    79
    +	@echo "Testing recompilation in GHCi..."
    
    80
    +	@echo ":quit" | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeTest.hs
    
    81
    +
    
    82
    +# Test recompilation after touching .hi file to make it newer than .gbc file
    
    83
    +bytecode_object14:
    
    84
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -dynamic -c BytecodeTest.hs -fbyte-code -fwrite-byte-code -fwrite-interface
    
    85
    +	@[ -f BytecodeTest.gbc ] || (echo "ERROR: Expected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    86
    +	@[ -f BytecodeTest.hi ] || (echo "ERROR: Expected BytecodeTest.hi file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    87
    +	@touch BytecodeTest.hi
    
    88
    +	@echo "Testing recompilation in GHCi after touching .hi file..."
    
    89
    +	@echo ":quit" | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeTest.hs
    
    90
    +
    
    91
    +# Test recompilation by generating .gbc via --interactive, then starting GHCi again
    
    92
    +bytecode_object15:
    
    93
    +	@echo ":quit" | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeTest.hs
    
    94
    +	@[ -f BytecodeTest.gbc ] || (echo "ERROR: Expected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    95
    +	@echo "Testing recompilation in GHCi..."
    
    96
    +	@echo ":quit" | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeTest.hs
    
    97
    +
    
    98
    +# Test what happens when .gbc file is deleted before starting GHCi
    
    99
    +bytecode_object16:
    
    100
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -dynamic -c BytecodeTest.hs -fbyte-code -fwrite-byte-code -fwrite-interface
    
    101
    +	@[ -f BytecodeTest.gbc ] || (echo "ERROR: Expected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    102
    +	@rm BytecodeTest.gbc
    
    103
    +	@echo "Testing GHCi startup without .gbc file..."
    
    104
    +	@echo ":quit" | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeTest.hs
    
    105
    +
    
    106
    +# Test what happens with interface file but no bytecode file
    
    107
    +# This should recompute from scratch since we are missing the .gbc file
    
    108
    +bytecode_object17:
    
    109
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -dynamic -c BytecodeTest.hs -fwrite-if-simplified-core
    
    110
    +	@[ -f BytecodeTest.hi ] || (echo "ERROR: Expected BytecodeTest.hi file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    111
    +	@[ ! -f BytecodeTest.gbc ] || (echo "ERROR: Unexpected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    112
    +	@echo "Testing GHCi startup with interface file but no bytecode file..."
    
    113
    +	@echo ":quit" | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-byte-code -fwrite-interface -fwrite-if-simplified-core BytecodeTest.hs
    
    114
    +
    
    115
    +# Test what happens with interface file but no bytecode file (without -fwrite-byte-code)
    
    116
    +# This should use the bindings in the .hi file to avoid recomputing from scratch.
    
    117
    +bytecode_object18:
    
    118
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -dynamic -c BytecodeTest.hs -fwrite-if-simplified-core
    
    119
    +	@[ -f BytecodeTest.hi ] || (echo "ERROR: Expected BytecodeTest.hi file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    120
    +	@[ ! -f BytecodeTest.gbc ] || (echo "ERROR: Unexpected BytecodeTest.gbc file not found"; echo "Files in current directory:"; ls -la; exit 1)
    
    121
    +	@echo "Testing GHCi startup with interface file but no bytecode file (without -fwrite-byte-code)..."
    
    122
    +	@echo ":quit" | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-if-simplified-core -fwrite-interface BytecodeTest.hs
    
    123
    +
    
    124
    +# Test removing .gbc file and reloading in GHCi
    
    125
    +# The module should be recompiled.
    
    126
    +bytecode_object19:
    
    127
    +	@echo "Testing GHCi with .gbc file removal and reload..."
    
    128
    +	@cat bytecode_object19.script | "$(TEST_HC)" $(TEST_HC_OPTS) --interactive -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeTest.hs

  • testsuite/tests/driver/bytecode-object/all.T
    1
    +test('bytecode_object1', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object1'])
    
    2
    +test('bytecode_object2', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object2'])
    
    3
    +test('bytecode_object3', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object3'])
    
    4
    +test('bytecode_object4', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object4'])
    
    5
    +test('bytecode_object5', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object5'])
    
    6
    +test('bytecode_object6', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object6'])
    
    7
    +test('bytecode_object7', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object7'])
    
    8
    +test('bytecode_object8', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object8'])
    
    9
    +test('bytecode_object9', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object9'])
    
    10
    +test('bytecode_object10', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object10'])
    
    11
    +test('bytecode_object11', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object11'])
    
    12
    +test('bytecode_object12', [extra_files(['BytecodeTest.hs', 'BytecodeMain.hs'])], makefile_test, ['bytecode_object12'])
    
    13
    +test('bytecode_object13', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object13'])
    
    14
    +test('bytecode_object14', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object14'])
    
    15
    +test('bytecode_object15', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object15'])
    
    16
    +test('bytecode_object16', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object16'])
    
    17
    +test('bytecode_object17', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object17'])
    
    18
    +test('bytecode_object18', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object18'])
    
    19
    +test('bytecode_object19', [extra_files(['BytecodeTest.hs'])], makefile_test, ['bytecode_object19'])

  • testsuite/tests/driver/bytecode-object/bytecode_object12.stderr
    1
    +when making flags consistent: warning: [GHC-74335] [-Winconsistent-flags (in -Wdefault)]
    
    2
    +    Byte-code linking does not currently support linking an executable, enabling -no-link
    
    3
    +

  • testsuite/tests/driver/bytecode-object/bytecode_object13.stdout
    1
    +Testing recompilation in GHCi...
    
    2
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    3
    +Ok, one module loaded.
    
    4
    +ghci> Leaving GHCi.

  • testsuite/tests/driver/bytecode-object/bytecode_object14.stdout
    1
    +Testing recompilation in GHCi after touching .hi file...
    
    2
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    3
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )[main] [Missing bytecode]
    
    4
    +Ok, one module loaded.
    
    5
    +ghci> Leaving GHCi.

  • testsuite/tests/driver/bytecode-object/bytecode_object15.stdout
    1
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    2
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )[main]
    
    3
    +Ok, one module loaded.
    
    4
    +ghci> Leaving GHCi.
    
    5
    +Testing recompilation in GHCi...
    
    6
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    7
    +Ok, one module loaded.
    
    8
    +ghci> Leaving GHCi.

  • testsuite/tests/driver/bytecode-object/bytecode_object16.stdout
    1
    +Testing GHCi startup without .gbc file...
    
    2
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    3
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )[main] [Missing bytecode]
    
    4
    +Ok, one module loaded.
    
    5
    +ghci> Leaving GHCi.

  • testsuite/tests/driver/bytecode-object/bytecode_object17.stdout
    1
    +Testing GHCi startup with interface file but no bytecode file...
    
    2
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    3
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )[main] [Missing bytecode]
    
    4
    +Ok, one module loaded.
    
    5
    +ghci> Leaving GHCi.

  • testsuite/tests/driver/bytecode-object/bytecode_object18.stdout
    1
    +Testing GHCi startup with interface file but no bytecode file (without -fwrite-byte-code)...
    
    2
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    3
    +Ok, one module loaded.
    
    4
    +ghci> Leaving GHCi.

  • testsuite/tests/driver/bytecode-object/bytecode_object19.script
    1
    +:!rm BytecodeTest.gbc
    
    2
    +:reload
    
    3
    +:quit
    \ No newline at end of file

  • testsuite/tests/driver/bytecode-object/bytecode_object19.stdout
    1
    +Testing GHCi with .gbc file removal and reload...
    
    2
    +GHCi, version 9.15.20250811: https://www.haskell.org/ghc/  :? for help
    
    3
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )[main]
    
    4
    +Ok, one module loaded.
    
    5
    +ghci> ghci> [1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )[main] [Missing bytecode]
    
    6
    +Ok, one module reloaded.
    
    7
    +ghci> Leaving GHCi.

  • testsuite/tests/driver/bytecode-object/bytecode_object4.stdout
    1
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )

  • testsuite/tests/driver/bytecode-object/bytecode_object5.stdout
    1
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )

  • testsuite/tests/driver/bytecode-object/bytecode_object6.stdout
    1
    +[1 of 1] Compiling BytecodeTest     ( BytecodeTest.hs, interpreted )