[Git][ghc/ghc][wip/js-base_access] JS: Fix h$base_access implementation (issue 22576)

[Josh Meredith (@JoshMeredith)]

Josh Meredith pushed to branch wip/js-base_access at Glasgow Haskell Compiler / GHC


Commits:
77794fac by Josh Meredith at 2023-04-21T12:36:44+00:00
JS: Fix h$base_access implementation (issue 22576)

- - - - -


5 changed files:

- hadrian/src/Settings/Builders/RunTest.hs
- libraries/base/jsbits/base.js
- testsuite/tests/ado/all.T
- testsuite/tests/rep-poly/all.T
- testsuite/tests/typecheck/should_fail/all.T


Changes:

=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -105,7 +105,11 @@ inTreeCompilerArgs stg = do
     tables_next_to_code <- flag TablesNextToCode
     targetWithSMP       <- targetSupportsSMP
 
-    let ghcStage = succStage stg
+    cross <- flag CrossCompiling
+
+    let ghcStage
+          | cross, Stage1 <- stg = Stage1
+          | otherwise = succStage stg
     debugAssertions     <- ghcDebugAssertions <$> flavour <*> pure ghcStage
     debugged            <- ghcDebugged        <$> flavour <*> pure ghcStage
     profiled            <- ghcProfiled        <$> flavour <*> pure ghcStage


=====================================
libraries/base/jsbits/base.js
=====================================
@@ -14,11 +14,11 @@ function h$base_access(file, file_off, mode, c) {
     TRACE_IO("base_access")
 #ifndef GHCJS_BROWSER
     if(h$isNode()) {
-        h$fs.stat(fd, function(err, fs) {
-            if(err) {
+        h$fs.access(h$decodeUtf8z(file, file_off), mode, function(err) {
+            if (err) {
                 h$handleErrnoC(err, -1, 0, c);
             } else {
-                c(mode & fs.mode); // fixme is this ok?
+                c(0);
             }
         });
     } else


=====================================
testsuite/tests/ado/all.T
=====================================
@@ -20,5 +20,5 @@ test('T15344', normal, compile_and_run, [''])
 test('T16628', normal, compile_fail, [''])
 test('T17835', normal, compile, [''])
 test('T20540', normal, compile, [''])
-test('T16135', [when(compiler_debugged(),expect_broken(16135)), js_broken(22576)], compile_fail, [''])
+test('T16135', [when(compiler_debugged(),expect_broken(16135))], compile_fail, [''])
 test('T22483', normal, compile, ['-Wall'])


=====================================
testsuite/tests/rep-poly/all.T
=====================================
@@ -85,7 +85,7 @@ test('RepPolyUnliftedNewtype', normal, compile,
      ['-fno-warn-partial-type-signatures -fno-warn-deprecated-flags'])
 test('RepPolyWildcardPattern', normal, compile_fail, [''])
 test('RepPolyWrappedVar', normal, compile_fail, [''])
-test('RepPolyWrappedVar2', js_broken(22576), compile, [''])
+test('RepPolyWrappedVar2', js_broken(23280), compile, [''])
 test('UnliftedNewtypesCoerceFail', normal, compile_fail, [''])
 test('UnliftedNewtypesLevityBinder', normal, compile_fail, [''])
 


=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -328,7 +328,7 @@ test('T8262', normal, compile_fail, [''])
 
 # TcCoercibleFail times out with the compiler is compiled with -DDEBUG.
 # This is expected (see comment in source file).
-test('TcCoercibleFail', [when(compiler_debugged(), skip), js_broken(22576)], compile_fail, [''])
+test('TcCoercibleFail', [when(compiler_debugged(), skip)], compile_fail, [''])
 
 test('TcCoercibleFail2', [], compile_fail, [''])
 test('TcCoercibleFail3', [], compile_fail, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77794face29c1109a859bfadbba2e96a35320e29

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77794face29c1109a859bfadbba2e96a35320e29
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230421/9cef93c2/attachment-0001.html>