Merge pull request #611 from Dyalog/fix-603

Fix #603
Dyalog · Dec 4, 2023 · 12038be · 12038be
2 parents 7760908 + f33c69c
commit 12038be
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 8 deletions.
diff --git a/StartupSession/Link/Utils.apln b/StartupSession/Link/Utils.apln
@@ -1129,7 +1129,7 @@
       :If ts ⋄ ts←list[4;] ⋄ :Else ⋄ ts←⊂⍬ ⋄ :EndIf
     ∇
 
-    ∇ (fixed failed)←opts FixFiles(target source overwrite);⎕AVU;FixFile;_;actname;actnames;actnc;actncs;alldirs;allexts;allfiles;allnames;dir;expfiles;expname;expnames;ext;extorder;exts;file;fixedfiles;flatten;fullname;hasnc;hidden;i;inx;lasttodo;list;mask;ncorder;ns;order;parent;parents;quadfile;source;todo
+    ∇ (fixed failed)←opts FixFiles(target source overwrite);⎕AVU;FixFile;_;actname;actnames;actnc;actncs;alldirs;allexts;allfiles;allnames;dir;expfiles;expname;expnames;ext;extorder;exts;file;fixedfiles;flatten;fullname;hasnc;hidden;i;inx;lasttodo;list;mask;ncorder;ns;order;parent;parents;quadfile;source;todo;classic;z
     ⍝ Load items from files in folders
     ⍝ overwrite=¯1 : empty target - no overwrite
     ⍝ overwrite=0 : non-empty target - no overwrite
@@ -1139,7 +1139,7 @@
       :Else ⋄ allfiles←⊃opts(1 ListFiles 0)source  ⍝ whole directory including root
       :EndIf
 
-      :If 82=⎕DR'' ⍝ Classic
+      :If classic←82=⎕DR'' ⍝ Classic
       :AndIf (≢allfiles)≥i←(¯10↑¨allfiles)⍳⍥⎕C⊂'/⎕AVU.apla' ⍝ Source contains ⎕AVU
           :Trap 0 ⍝ Try to set ⎕AVU so that all ⎕NGET/⎕FIX operations will use saved ⎕AVU
               ⎕AVU←(⍎opts.ns).⎕AVU←⎕SE.Dyalog.Array.Deserialise⊃⎕NGET i⊃allfiles
@@ -1151,7 +1151,15 @@
       (parents expnames actnames actncs)←opts DetermineAplName allfiles  ⍝ expected names (one per file), actual names (one list per file), actual name classes (one list per file)
       :If opts.singlefile
       :AndIf actnames≢expnames
-          Error 'Source file defines "',actnames,'", rather than "',expnames,'"'
+          :If classic∧0=≢⊃actnames ⍝ Empty name in Classic?
+              :Trap 92 ⍝ TRANSLATION ERROR
+                 z←GetFile ⊃allfiles
+              :Else
+                 Error ⎕DMX.(EM,' ',Message)
+              :EndTrap
+          :Else
+              Error 'Source file defines "',actnames,'", rather than "',expnames,'"'
+          :EndIf
       :EndIf
       :If opts.fastLoad  ⍝ do not spend time avoiding name clashes - actnc will be all 0's anyway
           mask←actncs∊¯1   ⍝ invalid names

diff --git a/Test/test_classic.aplf b/Test/test_classic.aplf
@@ -1,27 +1,27 @@
- ok←test_classic(folder name);foosrc;foobytes;read;goosrc;goobytes;nsref
+ ok←test_classic(folder name);foosrc;foobytes;read;goosrc;goobytes;nsref;z;nsbytes
  :If 82≠⎕DR''  ⍝ Classic interpreter required for classic QA !
      Log'Not a classic interpreter - not running ',⊃⎕SI
      ok←1 ⋄ :Return
  :EndIf
  3 QMKDIR folder
 
-      ⍝ check that key and friends are correctly translated in classic edition
+ ⍝ --- check that key and friends are correctly translated in classic edition
  {}⎕SE.Link.Create name folder
  name'foo'⎕SE.Link.Fix foosrc←' res←foo arg' ' res←{⍺ ⍵}⎕U2338 arg'
  read←NREADALL folder,'/foo.aplf'
  foobytes←32 114 101 115 ¯30 ¯122 ¯112 102 111 111 32 97 114 103 13 10 32 114 101 115 ¯30 ¯122 ¯112 123 ¯30 ¯115 ¯70 32 ¯30 ¯115 ¯75 125 ¯30 ¯116 ¯72 32 97 114 103 13 10
- assert'(read~13)≡(foobytes~13)'
+ assert'(read~13 32)≡(foobytes~13 32)' ⍝ Also exclude spaces since source may or may not be preserved "as typed"
 
  goobytes←1+@8⊢foobytes  ⍝ turn foo into goo
  goosrc←{'g'@6⊢⍵}¨@1⊢foosrc
  goobytes{tie←⍵ ⎕NCREATE 0 ⋄ _←⍺ ⎕NAPPEND tie 83 ⋄ 1:_←⎕NUNTIE tie}folder,'/goo.aplf'
  Notify 'changed' (folder,'/goo.aplf')
- assert'goosrc≡⎕NR ''',name,'.goo'''
+ assert'goosrc≡⍥{⍵~¨'' ''}⎕NR ''',name,'.goo'''
 
  {}⎕SE.Link.Break name
  CleanUp folder name
 
-          ⍝ test handling of non-default ⎕AVU
+ ⍝ --- test handling of non-default ⎕AVU
  nsref←⍎name ⎕NS''⊣⎕EX name
  assert'nsref.⎕AVU[60]=8866'       ⍝ Default: right tack
  nsref.⎕FX foosrc←' foo' '⍝⊢'
@@ -38,6 +38,15 @@
  {}⎕SE.Link.Break name
  ⎕EX name
 
+ ⍝ Check error messages when TRANSLATION ERROR occurs in Classic (issue #603)
+ ⍝ Define :Namespace with comment containing copyright symbol
+
+ nsbytes←¯17 ¯69 ¯65 58 78 97 109 101 83 112 97 99 101 32 105 54 48 51 13 10
+ nsbytes,←¯30 ¯115 ¯99 32 ¯62 ¯87 13 10, 58 69 110 100 78 97 109 101 115 112 97 99 101 13 10
+ nsbytes {tie←⍵ ⎕NCREATE 0 ⋄ _←⍺ ⎕NAPPEND tie 83 ⋄ 1:_←⎕NUNTIE tie}folder,'/i603.apln'
+
+ assertError 'z←⎕SE.Link.Import name (folder,''/i603.apln'')' '(U+00A9) not in ⎕AVU'
+
  {}LinkCreate name folder
  assert'foosrc≡⎕NR ''',name,'.foo'''
  assert'nsref.⎕AVU[60]=164'        ⍝ Check ⎕AVU has been set to non-default