Ver código fonte

compiler: string-field assignment through DI; field offset in string writes

CALC.INC:162, the statement after the set, is

    Contents := '';

Contents is String[70], written inside `with Sheet[I,J] do' where the
record's address is in DI.  The counted-string copy now stores
<len><chars> at DI, truncated to the field's capacity, with the length
set to the SOURCE length (a short literal must not claim the capacity
and print the bytes that follow it in the string pool).  A string
VARIABLE source pushes DI as strstore's destination and calls it with
the field's capacity in CX.

Also fixes a latent bug in the WRITE arm: it pushed
`symtab[arg.idx].off' and ignored `arg.boff', so `writeln(g[2,3].S)'
printed the empty first element's string.  The address is the field's:
off + boff.

t79_strfield: a WITH string assignment (DI), a string variable source
(strstore), a short literal, a long literal truncated to five, a plain
record field, and N after the field to prove the copy stops at the
capacity.  Non-vacuity removes the source-length min (a short literal
prints pool garbage) and zeroes the DI length byte (every reader sees an
empty string); both redden only at execution.

The ladder moves 15201 -> 15272, now `Value := 0': a REAL field, which
needs the 6-byte representation and an integer-to-real conversion.
Eric Streit 2 dias atrás
pai
commit
a2e5e69008

+ 36 - 5
shell/Compiler.mod

@@ -3920,10 +3920,36 @@ BEGIN
       RETURN
    END ;
    IF (r.kind = 5) AND (r.cls = TString) THEN
-      (* A whole string field of a run-time-indexed record element: the
-         string paths address by symbol+boff, which is not this element.
-         Loud until a counted-string copy through DI exists. *)
-      Err (ENoLib) ;
+      (* A string field of a DI-addressed record element (CALC's
+         `with Sheet[I,J] do Contents := ''').  DI is the field's address.
+         A literal's bytes are known: store <len><chars>, truncated to the
+         field's capacity (size-1).  A string VARIABLE source uses strstore,
+         with DI pushed as the destination. *)
+      ParseExpr (src) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      n := VarSize (r) - 1 ;              (* usable characters *)
+      IF src.kind = 3 THEN
+         IF strLen [src.strx] < n THEN
+            n := strLen [src.strx]
+         END ;
+         EmStDiImm (0, n) ;               (* the length byte *)
+         k := 1 ;
+         WHILE k <= n DO
+            EmStDiImm (k, ORD (strPool [strOff [src.strx] + k - 1])) ;
+            INC (k)
+         END
+      ELSIF src.kind = 1 THEN
+         EmPushVarAddr (symtab [src.idx].local,
+                        (symtab [src.idx].off + src.boff) MOD 10000H) ;
+         EmPushDi () ;                    (* destination = the field *)
+         EmMovCxi (n) ;                   (* strstore's limit *)
+         DropC (EmCall (TU_StrStore)) ;
+         EmAddSp (4)
+      ELSE
+         Err (ENoLib)
+      END ;
       RETURN
    END ;
    IF (r.kind = 1) AND symtab [r.idx].isVar THEN
@@ -4399,7 +4425,12 @@ BEGIN
                         above is where the bytes live: a literal's are in the
                         code stream (wrtinl) and a variable's are in the data
                         segment or the frame (wrstr). *)
-                     EmPushVarAddr (symtab [arg.idx].local, symtab [arg.idx].off) ;
+                     (* off + boff: a string FIELD of a record/array has a
+                        non-zero boff, and the address is the field's, not the
+                        containing variable's.  `writeln (g[2,3].S)' printed
+                        the empty first element before this. *)
+                     EmPushVarAddr (symtab [arg.idx].local,
+                                    (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                      ent := TU_WrStr
                   ELSE
                      LoadAtom (arg) ;

+ 6 - 7
shell/tests/fixtures/calc_ladder.tsv

@@ -25,10 +25,9 @@
 # positions shift — which is exactly why this must be a measured number, not a
 # remembered one.
 #
-# Current rung (2026-10-21): `Contents := ''` in CALC.INC's Init - the second
-# statement inside `with Sheet[I,J] do'.  Set-field assignment and run-time
-# membership landed (t78_setfield), moving 15131 -> 15201.  The blocker is now
-# a STRING assignment to a record field addressed through DI: the counted
-# string copy must write <len><chars> to the DI address (truncated to the
-# field's capacity).
-CALC.PAS	ERR	102	15201
+# Current rung (2026-10-21): `Value := 0' in CALC.INC's Init - a REAL field
+# assignment.  String-field assignment through DI landed (t79_strfield),
+# moving 15201 -> 15272.  Value is a 6-byte Real; the RHS is the integer 0, so
+# this needs the real representation and an integer-to-real conversion before
+# any real arithmetic can follow.
+CALC.PAS	ERR	102	15272

+ 5 - 0
shell/tests/fixtures/expected.tsv

@@ -594,3 +594,8 @@ t77_with	OK	390	34
 #                   (DI) and a constant-index element; `in' on a variable
 #                   set loads the byte and masks the bit at run time.
 t78_setfield	OK	279	23
+#   t79_strfield           a STRING field through a DI-addressed element:
+#                   <len><chars> truncated to the field, a string-variable
+#                   source via strstore, and a short literal length (not the
+#                   capacity).  Also pins the field offset in writeln.
+t79_strfield	OK	307	78

+ 5 - 0
shell/tests/fixtures/t79_strfield.out

@@ -0,0 +1,5 @@
+abc
+xy
+hello
+abcde
+4

+ 57 - 0
shell/tests/fixtures/t79_strfield.pas

@@ -0,0 +1,57 @@
+program t79_strfield;
+
+{ t79 -- a STRING field written through a DI-addressed record element.
+
+  CALC.INC:162, immediately after the set:
+
+      Contents := '';
+
+  Contents is String[70].  Within `with Sheet[I,J] do' the record's address
+  is in DI, so the counted-string copy has to store <len><chars> through it,
+  truncated to the field's capacity.  Also covers a string VARIABLE source
+  (strstore with DI as the destination), a plain record field (symbol+off),
+  and the neighbour N to prove the copy stops at the field.
+
+  A short literal must set the length to the SOURCE length, not the capacity:
+  storing the capacity would print the bytes that happen to follow the
+  literal. }
+
+type
+   Cell = record
+      S : string[5];
+      N : integer;
+   end;
+
+var
+   r : Cell;
+   g : array [1..2, 1..3] of Cell;
+   i, j : integer;
+   t : string[10];
+
+begin
+   with r do
+   begin
+      S := 'abc';
+      N := 4
+   end;
+   writeln (r.S);
+
+   i := 2;
+   j := 3;
+   with g[i,j] do
+   begin
+      S := 'xy';
+      N := 9
+   end;
+   writeln (g[2,3].S);
+
+   t := 'hello';
+   with r do
+      S := t;
+   writeln (r.S);
+
+   with r do
+      S := 'abcdefgh';
+   writeln (r.S);
+   writeln (r.N)
+end.

+ 37 - 1
shell/tests/nonvacuity.sh

@@ -1128,7 +1128,8 @@ cp "$SAVED_C" Compiler.mod
 if python3 - <<'PYX'
 p = 'Compiler.mod'
 s = open(p).read()
-old = """                     EmPushVarAddr (symtab [arg.idx].local, symtab [arg.idx].off) ;
+old = """                     EmPushVarAddr (symtab [arg.idx].local,
+                                    (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                      ent := TU_WrStr"""
 assert s.count(old) == 1, 'the string-write arm found %d times -- update this mutation' % s.count(old)
 rep = """                     Err (ENoLib) ;
@@ -1959,6 +1960,41 @@ else
 fi
 cp "$SAVED_C" Compiler.mod
 
+# --- a short literal sets the SOURCE length ---------------------------------
+# Skip the min(source length, capacity): n stays at the field's capacity and
+# the copy reads past the literal into the string pool, so 'abc' prints five
+# characters.  t79's first line is 'abc'.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|         IF strLen \[src.strx\] < n THEN|         IF FALSE THEN|'; then
+    if rebuild_compiler; then
+        expect_red "t79 red when a short string literal keeps the capacity"             "FAIL" python3 tests/run_com_exec.py t79_strfield
+    else
+        echo "  FAIL: the compiler would not rebuild without the length min"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the literal-length mutation did not apply"
+    fail=$((fail + 1))
+fi
+cp "$SAVED_C" Compiler.mod
+
+# --- a DI-addressed string field stores its length --------------------------
+# Store a zero length byte: the characters go to the field but every reader
+# sees an empty string.  t79 writes 'xy' through WITH and prints it back.
+cp "$SAVED_C" Compiler.mod
+if mutate_compiler 's|         EmStDiImm (0, n) ;|         EmStDiImm (0, 0) ;|'; then
+    if rebuild_compiler; then
+        expect_red "t79 red when a string field's length byte is zero"             "FAIL" python3 tests/run_com_exec.py t79_strfield
+    else
+        echo "  FAIL: the compiler would not rebuild with a zero length"
+        fail=$((fail + 1))
+    fi
+else
+    echo "  BROKEN CASE: the string length-byte mutation did not apply"
+    fail=$((fail + 1))
+fi
+cp "$SAVED_C" Compiler.mod
+
 if rebuild_compiler; then
     if python3 tests/run_com_exec.py >/dev/null 2>&1; then
         echo "  ok: every executed fixture passes on the restored sources"