Browse Source

compiler: fix typed string-array constant crash

A typed constant array of STRING crashed DefConst with SIGFPE.  A
single-character literal such as 'I' is scanned as a CHAR scalar, so the
array-element writer took the integer path and shifted a 16-bit value through
divi until it wrapped to zero; string arrays with all multi-character elements
(StandardfunctionNames) had hidden it.

Consult the array element class and widen a scalar element of a STRING array
to a one-character string.  Refuse arrays of records/reals loudly instead of
letting the divider reach zero.

Add t118_strconstarray (empty/I/II).  Add CORPUS-TEST.md with the census of
4,919 external .pas files: 49 compile, 4,870 report errors, 0 crashes; the TP3
pascsrc subset is 44/84.
Eric Streit 2 days ago
parent
commit
c0696f0340

+ 63 - 0
CORPUS-TEST.md

@@ -0,0 +1,63 @@
+# Pascal corpus census
+
+`Sources/Dezip/` is an external collection, not part of the build.  It contains
+**4,919 `.pas` files** (77 MB, about 354k lines).  Most are SWAG/FreePascal or
+Delphi units, so a failure count is not a compiler score; it is a map of what
+the TP3 subset does not cover yet.
+
+## Method
+
+Every file was compiled separately with the current `shell/compiletest`, in a
+fresh process and with a 5-second timeout.  Separate processes matter: the
+first batch run aborted after a compiler bug, and one crashing source must not
+hide the rest of the corpus.
+
+## Current result
+
+| result | count |
+|---|---:|
+| compiles | **49** |
+| errors | **4,870** |
+| crashes/timeouts | **0** |
+
+By error code:
+
+| code | meaning | count |
+|---|---|---:|
+| 41 | unknown construct/identifier | 4,335 |
+| 90 | include file not found | 418 |
+| 102 | not implemented | 48 |
+| 1 | syntax / semicolon | 39 |
+| 30 | simple type expected | 20 |
+| 56 | type mismatch | 9 |
+| 99 | compiler overflow | 1 |
+
+The useful subset is `pascsrc/`, which is the classic TP3 example material:
+**44 of 84 compile**.  The SWAG tree is 4,473 files, almost all FreePascal or
+Delphi units; only 5 compile.
+
+## Bugs found by the corpus
+
+- **Typed constants containing an array of strings crashed the compiler.**
+  A one-character element such as `'I'` is scanned as a `CHAR` scalar, not a
+  string, so `DefConst` took the integer path and shifted a 16-bit value through
+  `divi` until it became zero: `SIGFPE` in `DefConst`.  The array element type
+  is now consulted; a scalar element of a `STRING` array is stored as a
+  one-character string.  `t118_strconstarray` compiles and prints `''`, `I`,
+  `II`.
+- This bug was also hit by `Roman2.pas` in the SWAG tree.  It now gets a normal
+  diagnostic (`Word` is not yet a type) instead of killing the compiler.
+
+## Main blockers visible in the census
+
+1. `uses`/`unit` imports.  Most SWAG files cannot even reach a declaration
+   after their `uses` line.
+2. The wider integer family: `Word`, `LongInt`, `ShortInt`, `Single`, `Double`.
+3. Turbo extras such as `absolute`, `Printer`, `Dos`, `Mem`/`Msdos`, and
+   `Addr` beyond the currently supported pointer paths.
+4. Includes whose names or search paths differ from the file's own directory
+   (`ERROR 90`, 418 files).
+
+The 49 clean files are useful smoke material, but the corpus is intentionally
+not wired into `run_all.sh`: it lives outside the repository and most of it is
+outside the TP3 language subset.

+ 1 - 1
README.md

@@ -18,7 +18,7 @@ second copy of a status table is a claim about the world that expires silently
 and is never noticed expiring, so there is one now, and this file says where it
 and is never noticed expiring, so there is one now, and this file says where it
 is.
 is.
 
 
-In short, current as of `v-TP3-CALC-CHARFOR`:
+In short, current as of `v-TP3-STRCONST`:
 
 
 - The shell and the WordStar-style editor are done.
 - The shell and the WordStar-style editor are done.
 - The compiler front end and 8086 code generator are done for the language
 - The compiler front end and 8086 code generator are done for the language

+ 34 - 12
shell/Compiler.mod

@@ -7502,7 +7502,7 @@ VAR nm : ARRAY [0..MaxName] OF CHAR ;
     isStr : BOOLEAN ;
     isStr : BOOLEAN ;
     tok : CARDINAL ;
     tok : CARDINAL ;
     typed, setTyped, arrTyped : BOOLEAN ;
     typed, setTyped, arrTyped : BOOLEAN ;
-    nb, k, divi, w, slen : CARDINAL ;
+    nb, k, divi, w, slen, eltCls : CARDINAL ;
 BEGIN
 BEGIN
    LOOP
    LOOP
       PeekKw (tok) ;
       PeekKw (tok) ;
@@ -7555,12 +7555,16 @@ BEGIN
             DropC (NewSym (nm, KVar, TSet, typSize, typElem, soff, 0, FALSE))
             DropC (NewSym (nm, KVar, TSet, typSize, typElem, soff, 0, FALSE))
          END
          END
       ELSIF OK () AND arrTyped THEN
       ELSIF OK () AND arrTyped THEN
-         (* array typed constant: `(v1, v2, ...)' in element order, each value
-            written little-endian in typElem bytes.  CALC's is XPOS (seven
-            Integers, 14 bytes).  An element that is a STRING (CALC.INC's
-            StandardfunctionNames) is a later increment, and is refused here. *)
+         (* array typed constant: `(v1, v2, ...)' in element order.  Integers
+            are written little-endian in typElem bytes; a STRING element is
+            <length><chars>.  CALC uses both XPOS (Integers) and
+            StandardfunctionNames (string[6]). *)
          ExpectDelim ('=', ENoSemi) ;
          ExpectDelim ('=', ENoSemi) ;
          ExpectDelim ('(', ENoSemi) ;
          ExpectDelim ('(', ENoSemi) ;
+         eltCls := 0 ;
+         IF newArrIdx > 0 THEN
+            eltCls := arrs [newArrIdx - 1].ecls
+         END ;
          nb := 0 ;
          nb := 0 ;
          LOOP
          LOOP
             RdConst (v, cls, isStr) ;
             RdConst (v, cls, isStr) ;
@@ -7568,25 +7572,43 @@ BEGIN
                Err (ECompOvf) ;
                Err (ECompOvf) ;
                EXIT
                EXIT
             END ;
             END ;
-            IF isStr THEN
+            IF isStr OR ((eltCls = TString) AND (v >= 0) AND (v <= 255)) THEN
                (* A string element is <length><chars>, padded with NULs to
                (* A string element is <length><chars>, padded with NULs to
-                  typElem bytes.  StandardfunctionNames is array of string[6]. *)
-               slen := strLen [rdStrX] ;
-               IF slen > typElem - 1 THEN
-                  slen := typElem - 1
+                  typElem bytes.  StandardfunctionNames is array of string[6].
+                  A single-character literal ('I') is a TScalar, not a
+                  string, so an array of STRING must still store it as a
+                  one-character element.  Treating it as an integer divided
+                  by 256 once per byte and hit DIV by zero at the fourth. *)
+               IF isStr THEN
+                  slen := strLen [rdStrX] ;
+                  IF slen > typElem - 1 THEN
+                     slen := typElem - 1
+                  END
+               ELSE
+                  slen := 1
                END ;
                END ;
                constBlob [nb] := CHR (slen) ;
                constBlob [nb] := CHR (slen) ;
                k := 0 ;
                k := 0 ;
                WHILE k < typElem - 1 DO
                WHILE k < typElem - 1 DO
                   IF k < slen THEN
                   IF k < slen THEN
-                     constBlob [nb + 1 + k] :=
-                        strPool [strOff [rdStrX] + k]
+                     IF isStr THEN
+                        constBlob [nb + 1 + k] :=
+                           strPool [strOff [rdStrX] + k]
+                     ELSE
+                        constBlob [nb + 1 + k] := CHR (v)
+                     END
                   ELSE
                   ELSE
                      constBlob [nb + 1 + k] := CHR (0)
                      constBlob [nb + 1 + k] := CHR (0)
                   END ;
                   END ;
                   INC (k)
                   INC (k)
                END ;
                END ;
                nb := nb + typElem
                nb := nb + typElem
+            ELSIF typElem > 2 THEN
+               (* An array of records/reals has no scalar encoding here.
+                  Refuse loudly instead of shifting a 16-bit value through
+                  divi until it wraps to zero and aborts the compiler. *)
+               Err (ENoLib) ;
+               EXIT
             ELSE
             ELSE
                w := VAL (CARDINAL, W16 (v)) ;
                w := VAL (CARDINAL, W16 (v)) ;
                divi := 1 ;
                divi := 1 ;

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

@@ -742,3 +742,5 @@ t115_nestedlocal	OK	104	5
 t116_nestedstr	OK	301	263
 t116_nestedstr	OK	301	263
 
 
 t117_charfor	OK	88	6
 t117_charfor	OK	88	6
+
+t118_strconstarray	OK	93	5

+ 3 - 0
shell/tests/fixtures/t118_strconstarray.out

@@ -0,0 +1,3 @@
+
+I
+II

+ 9 - 0
shell/tests/fixtures/t118_strconstarray.pas

@@ -0,0 +1,9 @@
+program strconst2;
+type st = string[4];
+     star = array[0..2] of st;
+const W : star = ('', 'I', 'II');
+begin
+  writeln(W[0]);
+  writeln(W[1]);
+  writeln(W[2])
+end.