Forráskód Böngészése

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 1 napja
szülő
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
 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 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 ;
     tok : CARDINAL ;
     typed, setTyped, arrTyped : BOOLEAN ;
-    nb, k, divi, w, slen : CARDINAL ;
+    nb, k, divi, w, slen, eltCls : CARDINAL ;
 BEGIN
    LOOP
       PeekKw (tok) ;
@@ -7555,12 +7555,16 @@ BEGIN
             DropC (NewSym (nm, KVar, TSet, typSize, typElem, soff, 0, FALSE))
          END
       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) ;
+         eltCls := 0 ;
+         IF newArrIdx > 0 THEN
+            eltCls := arrs [newArrIdx - 1].ecls
+         END ;
          nb := 0 ;
          LOOP
             RdConst (v, cls, isStr) ;
@@ -7568,25 +7572,43 @@ BEGIN
                Err (ECompOvf) ;
                EXIT
             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
-                  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 ;
                constBlob [nb] := CHR (slen) ;
                k := 0 ;
                WHILE k < typElem - 1 DO
                   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
                      constBlob [nb + 1 + k] := CHR (0)
                   END ;
                   INC (k)
                END ;
                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
                w := VAL (CARDINAL, W16 (v)) ;
                divi := 1 ;

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

@@ -742,3 +742,5 @@ t115_nestedlocal	OK	104	5
 t116_nestedstr	OK	301	263
 
 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.