1 (* ==================================================================== *)
3 (* Error Module for the Gardens Point Component Pascal Compiler. *)
4 (* Copyright (c) John Gough 1999, 2000. *)
6 (* ==================================================================== *)
19 (* ============================================================ *)
24 listingMax
= listingWidth
-1;
27 ParseHandler
* = POINTER TO RECORD (Scnr
.ErrorHandler
)
29 SemanticHdlr
* = POINTER TO RECORD (Scnr
.ErrorHandler
)
33 Message
= LitValue
.CharOpen
;
35 Err
= POINTER TO ErrDesc
;
37 num
, lin
, col
: INTEGER;
40 ErrBuff
= POINTER TO ARRAY OF Err
;
43 parsHdlr
: ParseHandler
;
44 semaHdlr
: SemanticHdlr
;
45 eBuffer
: ErrBuff
; (* Invariant: eBuffer[eTide] = NIL *)
46 eLimit
: INTEGER; (* High index of dynamic array. *)
47 eTide
: INTEGER; (* Next index for insertion in buf *)
48 prompt
* : BOOLEAN; (* Emit error message immediately *)
49 nowarn
* : BOOLEAN; (* Don't store warning messages *)
50 srcNam
: FileNames
.NameString
;
51 forVisualStudio
* : BOOLEAN;
54 (* ============================================================ *)
56 PROCEDURE StoreError (eNum
, linN
, colN
: INTEGER; mesg
: Message
);
57 (* Store an error message for later printing *)
61 (* -------------------------------------- *)
63 PROCEDURE append(b
: ErrBuff
; n
: Err
) : ErrBuff
;
67 IF eTide
= eLimit
THEN (* must expand *)
69 eLimit
:= eLimit
* 2 + 1;
71 FOR i
:= 0 TO eTide
DO b
[i
] := s
[i
] END;
73 b
[eTide
] := n
; INC(eTide
); b
[eTide
] := NIL;
77 (* -------------------------------------- *)
85 eBuffer
:= append(eBuffer
, nextErr
);
88 (* ============================================================ *)
90 PROCEDURE QuickSort(min
, max
: INTEGER);
94 (* ------------------------------------------------- *)
95 PROCEDURE keyVal(i
: INTEGER) : INTEGER;
97 IF (eBuffer
[i
].col
<= 0) OR (eBuffer
[i
].col
>= listingWidth
) THEN
98 eBuffer
[i
].col
:= listingMax
;
100 RETURN eBuffer
[i
].lin
* 256 + eBuffer
[i
].col
;
102 (* ------------------------------------------------- *)
105 key
:= keyVal((min
+max
) DIV 2);
107 WHILE keyVal(i
) < key
DO INC(i
) END;
108 WHILE keyVal(j
) > key
DO DEC(j
) END;
110 tmp
:= eBuffer
[i
]; eBuffer
[i
] := eBuffer
[j
]; eBuffer
[j
] := tmp
;
114 IF min
< j
THEN QuickSort(min
,j
) END;
115 IF i
< max
THEN QuickSort(i
,max
) END;
118 (* ============================================================ *)
120 PROCEDURE (h
: ParseHandler
)Report
*(num
,lin
,col
: INTEGER);
121 VAR str
: ARRAY 128 OF CHAR;
127 |
0: str
:= "EOF expected";
128 |
1: str
:= "ident expected";
129 |
2: str
:= "integer expected";
130 |
3: str
:= "real expected";
131 |
4: str
:= "CharConstant expected";
132 |
5: str
:= "string expected";
133 |
6: str
:= "'*' expected";
134 |
7: str
:= "'-' expected";
135 |
8: str
:= "'!' expected";
136 |
9: str
:= "'.' expected";
137 |
10: str
:= "'=' expected";
138 |
11: str
:= "'ARRAY' expected";
139 |
12: str
:= "',' expected";
140 |
13: str
:= "'OF' expected";
141 |
14: str
:= "'ABSTRACT' expected";
142 |
15: str
:= "'EXTENSIBLE' expected";
143 |
16: str
:= "'LIMITED' expected";
144 |
17: str
:= "'RECORD' expected";
145 |
18: str
:= "'(' expected";
146 |
19: str
:= "'+' expected";
147 |
20: str
:= "')' expected";
148 |
21: str
:= "'END' expected";
149 |
22: str
:= "';' expected";
150 |
23: str
:= "':' expected";
151 |
24: str
:= "'POINTER' expected";
152 |
25: str
:= "'TO' expected";
153 |
26: str
:= "'PROCEDURE' expected";
154 |
27: str
:= "'[' expected";
155 |
28: str
:= "']' expected";
156 |
29: str
:= "'^' expected";
157 |
30: str
:= "'$' expected";
158 |
31: str
:= "'#' expected";
159 |
32: str
:= "'<' expected";
160 |
33: str
:= "'<=' expected";
161 |
34: str
:= "'>' expected";
162 |
35: str
:= "'>=' expected";
163 |
36: str
:= "'IN' expected";
164 |
37: str
:= "'IS' expected";
165 |
38: str
:= "'OR' expected";
166 |
39: str
:= "'/' expected";
167 |
40: str
:= "'DIV' expected";
168 |
41: str
:= "'MOD' expected";
169 |
42: str
:= "'&' expected";
170 |
43: str
:= "'NIL' expected";
171 |
44: str
:= "'~' expected";
172 |
45: str
:= "'{' expected";
173 |
46: str
:= "'}' expected";
174 |
47: str
:= "'..' expected";
175 |
48: str
:= "'EXIT' expected";
176 |
49: str
:= "'RETURN' expected";
177 |
50: str
:= "'NEW' expected";
178 |
51: str
:= "':=' expected";
179 |
52: str
:= "'IF' expected";
180 |
53: str
:= "'THEN' expected";
181 |
54: str
:= "'ELSIF' expected";
182 |
55: str
:= "'ELSE' expected";
183 |
56: str
:= "'CASE' expected";
184 |
57: str
:= "'|' expected";
185 |
58: str
:= "'WHILE' expected";
186 |
59: str
:= "'DO' expected";
187 |
60: str
:= "'REPEAT' expected";
188 |
61: str
:= "'UNTIL' expected";
189 |
62: str
:= "'FOR' expected";
190 |
63: str
:= "'BY' expected";
191 |
64: str
:= "'LOOP' expected";
192 |
65: str
:= "'WITH' expected";
193 |
66: str
:= "'EMPTY' expected";
194 |
67: str
:= "'BEGIN' expected";
195 |
68: str
:= "'CONST' expected";
196 |
69: str
:= "'TYPE' expected";
197 |
70: str
:= "'VAR' expected";
198 |
71: str
:= "'OUT' expected";
199 |
72: str
:= "'IMPORT' expected";
200 |
73: str
:= "'MODULE' expected";
201 |
74: str
:= "'CLOSE' expected";
202 |
75: str
:= "'JAVACLASS' expected";
203 |
76: str
:= "not expected";
204 |
77: str
:= "error in OtherAtts";
205 |
78: str
:= "error in MethAttributes";
206 |
79: str
:= "error in ProcedureStuff";
207 |
80: str
:= "this symbol not expected in StatementSequence";
208 |
81: str
:= "this symbol not expected in StatementSequence";
209 |
82: str
:= "error in IdentStatement";
210 |
83: str
:= "error in MulOperator";
211 |
84: str
:= "error in Factor";
212 |
85: str
:= "error in AddOperator";
213 |
86: str
:= "error in Relation";
214 |
87: str
:= "error in OptAttr";
215 |
88: str
:= "error in ProcedureType";
216 |
89: str
:= "error in Type";
217 |
90: str
:= "error in Module";
218 |
91: str
:= "invalid lexical token";
222 FOR idx
:= 0 TO len
-1 DO
223 msg
[idx
] := str
[idx
];
226 StoreError(num
,lin
,col
,msg
);
230 (* ============================================================ *)
232 PROCEDURE (h
: ParseHandler
)RepSt1
*(num
: INTEGER;
233 IN s1
: ARRAY OF CHAR;
234 lin
,col
: INTEGER),EMPTY
;
235 PROCEDURE (h
: ParseHandler
)RepSt2
*(num
: INTEGER;
236 IN s1
,s2
: ARRAY OF CHAR;
237 lin
,col
: INTEGER),EMPTY
;
239 (* ============================================================ *)
241 PROCEDURE (h
: SemanticHdlr
)Report
*(num
,lin
,col
: INTEGER);
242 VAR str
: ARRAY 128 OF CHAR;
248 (* ======================= ERRORS ========================= *)
249 |
-1: str
:= "invalid character";
250 |
0: RETURN; (* just a placeholder *)
251 |
1: str
:= "Name after 'END' does not match";
252 |
2: str
:= "Identifier not known in this scope";
253 |
3: str
:= "Identifier not known in qualified scope";
254 |
4: str
:= "This name already known in this scope";
255 |
5: str
:= "This identifier is not a type name";
256 |
6: str
:= "This fieldname clashes with previous fieldname";
257 |
7: str
:= "Qualified identifier is not a type name";
258 |
8: str
:= "Not a record type, so you cannot select a field";
259 |
9: str
:= "Identifier is not a fieldname of the current type";
261 |
10: str
:= "Not an array type, so you cannot index into it";
262 |
11: str
:= "Too many indices for the dimension of the array";
263 |
12: str
:= "Not a pointer type, so you cannot dereference it";
264 |
13: str
:= "Not a procedure call or type guard";
265 |
14: str
:= "Basetype is not record or pointer type";
266 |
15: str
:= "Typename not a subtype of the current type";
267 |
16: str
:= "Basetype was not declared ABSTRACT or EXTENSIBLE";
268 |
17: str
:= "Not dynamically typed, so you cannot have type-guard";
269 |
18: str
:= "The type-guard must be a record type here";
270 |
19: str
:= "This constant token not known";
272 |
20: str
:= "Name of formal is not unique";
273 |
21: str
:= "Actual parameter is not compatible with formal type";
274 |
22: str
:= "Too few actual parameters";
275 |
23: str
:= "Too many actual parameters";
276 |
24: str
:= "Attempt to use a proper procedure when function needed";
277 |
25: str
:= "Expression is not constant";
278 |
26: str
:= "Range of the numerical type exceeded";
279 |
27: str
:= "String literal too long for destination type";
280 |
28: str
:= "Low value of range not in SET base-type range";
281 |
29: str
:= "High value of range not in SET base-type range";
283 |
30: str
:= "Low value of range cannot be greater than high value";
284 |
31: str
:= "Array index not of an integer type";
285 |
32: str
:= "Literal array index is outside array bounds";
286 |
33: str
:= "Literal value is not in SET base-type range";
287 |
34: str
:= "Typename is not a subtype of the type of destination";
288 |
35: str
:= "Expression is not of SET type";
289 |
36: str
:= "Expression is not of BOOLEAN type";
290 |
37: str
:= "Expression is not of an integer type";
291 |
38: str
:= "Expression is not of a numeric type";
292 |
39: str
:= "Overflow of negation of literal value";
294 |
40: str
:= "Expression is not of ARRAY type";
295 |
41: str
:= "Expression is not of character array type";
296 |
42: str
:= "Expression is not a standard function";
297 |
43: str
:= "Expression is not of character type";
298 |
44: str
:= "Literal expression is not in CHAR range";
299 |
45: str
:= "Expression is not of REAL type";
300 |
46: str
:= "Optional param of LEN must be a positive integer constant";
301 |
47: str
:= "LONG cannot be applied to this type";
302 |
48: str
:= "Name is not the name of a basic type";
303 |
49: str
:= "MAX and MIN not applicable to this type";
305 |
50: str
:= "ORD only applies to SET and CHAR types";
306 |
51: str
:= "SHORT cannot be applied to this type";
307 |
52: str
:= "Both operands must be numeric, SET or CHAR types";
308 |
53: str
:= "Character constant outside CHAR range";
309 |
54: str
:= "Bad conversion type";
310 |
55: str
:= "Numeric overflow in constant evaluation";
311 |
56: str
:= "BITS only applies to expressions of type INTEGER";
312 |
57: str
:= "Operands in '=' or '#' test are not type compatible";
313 |
58: str
:= "EXIT is only permitted inside a LOOP";
314 |
59: str
:= "BY expression must be a constant expression";
316 |
60: str
:= "Case label is not an integer or character constant";
317 |
61: str
:= "Method attributes don't apply to ordinary procedure";
318 |
62: str
:= "Forward type-bound method elaborated as static procedure";
319 |
63: str
:= "Forward static procedure elaborated as type-bound method";
320 |
64: str
:= "Forward method had different receiver mode";
321 |
65: str
:= "Forward procedure had non-matching formal types";
322 |
66: str
:= "Forward method had different attributes";
323 |
67: str
:= "Variable cannot have open array type";
324 |
68: str
:= "Arrays must have at least one element";
325 |
69: str
:= "Fixed array cannot have open array element type";
327 |
70: str
:= "Forward procedure had different names for formals";
328 |
71: str
:= "This imported type is LIMITED, and cannot be instantiated";
329 |
72: str
:= "Forward procedure was not elaborated by end of block";
330 |
73: str
:= "RETURN is not legal in a module body";
331 |
74: str
:= "This is a proper procedure, it cannot return a value";
332 |
75: str
:= "This is a function, it must return a value";
333 |
76: str
:= "RETURN value not assign-compatible with function type";
334 |
77: str
:= "Actual for VAR formal must be a writeable variable";
335 |
78: str
:= "Functions cannot return record types";
336 |
79: str
:= "Functions cannot return array types";
338 |
80: str
:= "This designator is not the name of a proper procedure";
339 |
81: str
:= "FOR loops cannot have zero step size";
340 |
82: str
:= "This fieldname clashes with an inherited fieldname";
341 |
83: str
:= "Expression not assign-compatible with destination";
342 |
84: str
:= "FOR loop control variable must be of integer type";
343 |
85: str
:= "Identifier is not the name of a variable";
344 |
86: str
:= "Typename is not an extension of the variable type";
345 |
87: str
:= "The selected identifier is not of dynamic type";
346 |
88: str
:= "Case select expression is not of integer or CHAR type";
347 |
89: str
:= "Case select value is duplicated for this statement";
349 |
90: str
:= "Variables of ABSTRACT type cannot be instantiated";
350 |
91: str
:= "Optional param of ASSERT must be an integer constant";
351 |
92: str
:= "This is not a standard procedure";
352 |
93: str
:= "The param of HALT must be a constant integer";
353 |
94: str
:= "This variable is not of pointer or vector type";
354 |
95: str
:= "NEW requires a length param for open arrays and vectors";
355 |
96: str
:= "NEW only applies to pointers to records and arrays";
356 |
97: str
:= "This call of NEW has too many lengths specified";
357 |
98: str
:= "Length for an open array NEW must be an integer type";
358 |
99: str
:= "Length only applies to open arrays and vectors";
360 |
100: str
:= "This call of NEW needs more length params";
361 |
101: str
:= "Numeric literal is too large, even for long type";
362 |
102: str
:= "Only ABSTRACT basetypes can have abstract extensions";
363 |
103: str
:= "This expression is read-only";
364 |
104: str
:= "Receiver type must be a record, or pointer to record";
365 |
105: str
:= "This method is not a redefinition, you must use NEW";
366 |
106: str
:= "This method is a redefinition, you must not use NEW";
367 |
107: str
:= "Receivers of record type must be VAR or IN mode";
368 |
108: str
:= "Final method cannot be redefined";
369 |
109: str
:= "Only ABSTRACT method can have ABSTRACT redefinition";
371 |
110: str
:= "This type has ABSTRACT method, must be ABSTRACT";
372 |
111: str
:= "Type has NEW,EMPTY method, must be ABSTRACT or EXTENSIBLE";
373 |
112: str
:= "Only EMPTY or ABSTRACT method can be redefined EMPTY";
374 |
113: str
:= "This redefinition of exported method must be exported";
375 |
114: str
:= "This is an EMPTY method, and cannot have OUT parameters";
376 |
115: str
:= "This is an EMPTY method, and cannot return a value";
377 |
116: str
:= "Redefined method must have consistent return type";
378 |
117: str
:= "Type has EXTENSIBLE method, must be ABSTRACT or EXTENSIBLE";
379 |
118: str
:= "Empty or abstract methods cannot be called by super-call";
380 |
119: str
:= "Super-call is invalid here";
382 |
120: str
:= "There is no overridden method with this name";
383 |
121: str
:= "Not all abstract methods were implemented";
384 |
122: str
:= "This procedure is not at module scope, cannot be a method";
385 |
123: str
:= "There is a cycle in the base-type declarations";
386 |
124: str
:= "There is a cycle in the field-type declarations";
387 |
125: str
:= "Cycle in typename equivalence declarations";
388 |
126: str
:= "There is a cycle in the array element type declarations";
389 |
127: str
:= "This is an implement-only method, and cannot be called";
390 |
128: str
:= "Only declarations at module level can be exported";
391 |
129: str
:= "Cannot open symbol file";
393 |
130: str
:= "Bad magic number in symbol file";
394 |
131: str
:= "This type is an INTERFACE, and cannot be instantiated";
395 |
132: str
:= "Corrupted symbol file";
396 |
133: str
:= "Inconsistent module keys";
397 |
134: str
:= "Types can only be public or fully private";
398 |
135: str
:= "This variable may be uninitialized";
399 |
136: str
:= "Not all paths to END contain a RETURN statement";
400 |
137: str
:= "This type tries to directly include itself";
401 |
138: str
:= "Not all paths to END in RESCUE contain a RETURN statement";
402 |
139: str
:= "Not all OUT parameters have been assigned to";
404 |
140: str
:= "Pointer bound type can only be RECORD or ARRAY";
405 |
141: str
:= "GPCP restriction: select expression cannot be LONGINT";
406 |
142: str
:= "Cannot assign entire open array";
407 |
143: str
:= "Cannot assign entire extensible or abstract record";
408 |
144: str
:= "Foreign modules must be compiled with '-special'";
409 |
145: str
:= "This type tries to indirectly include itself";
410 |
146: str
:= "Constructors are declared without receiver";
411 |
147: str
:= "Multiple supertype constructors match these parameters";
412 |
148: str
:= "This type has another constructor with equal signature";
413 |
149: str
:= "This procedure needs parameters";
415 |
150: str
:= "Parameter types of exported procedures must be exported";
416 |
151: str
:= "Return types of exported procedures must be exported";
417 |
152: str
:= "Bound type of foreign reference type cannot be assigned";
418 |
153: str
:= "Bound type of foreign reference type cannot be value param";
419 |
154: str
:= "It is not possible to extend an interface type";
420 |
155: str
:= "NEW illegal unless foreign supertype has no-arg constructor";
421 |
156: str
:= "Interfaces can't extend anything. Leave blank or use ANYREC";
422 |
157: str
:= "Only extensions of Foreign classes can implement interfaces";
423 |
158: str
:= "Additional base types must be interface types";
424 |
159: str
:= "Not all interface methods were implemented";
426 |
160: str
:= "Inherited procedure had non-matching formal types";
427 |
161: str
:= "Only foreign procs and fields can have protected mode";
428 |
162: str
:= "This name only accessible in extensions of defining type";
429 |
163: str
:= "Interface implementation has wrong export mode";
430 (**)|
164: str
:= "Non-locally accessed variable may be uninitialized";
431 |
165: str
:= "This procedure cannot be used as a procedure value";
432 |
166: str
:= "Super calls are only valid on the current receiver";
433 |
167: str
:= "SIZE is not meaningful in this implementation";
434 |
168: str
:= "Character literal outside SHORTCHAR range";
435 |
169: str
:= "Module exporting this type is not imported";
437 |
170: str
:= "This module has already been directly imported";
438 |
171: str
:= "Invalid binary operation on these types";
439 |
172: str
:= "Name clash in imported scope";
440 |
173: str
:= "This module indirectly imported with different key";
441 |
174: str
:= "Actual for IN formal must be record, array or string";
442 |
175: str
:= "The module exporting this name has not been imported";
443 |
176: str
:= "The current type is opaque and cannot be selected further";
444 |
177: str
:= "File creation error";
445 |
178: str
:= "This record field is read-only";
446 |
179: str
:= "This IN parameter is read-only";
448 |
180: str
:= "This variable is read-only";
449 |
181: str
:= "This identifier is read-only";
450 |
182: str
:= "Attempt to use a function when a proper procedure needed";
451 |
183: str
:= "This record is private, you cannot export this field";
452 |
184: str
:= "This record is readonly, this field cannot be public";
453 |
185: str
:= "Static members can only be defined with -special";
454 |
186: str
:= 'Ids with
"$", "@" or
"`" can only be defined with
-special'
;
455 |
187: str
:= "Idents escaped with ` must have length >= 2";
456 |
188: str
:= "Methods of INTERFACE types must be ABSTRACT";
457 |
189: str
:= "Non-local access to byref param of value type";
459 |
190: str
:= "Temporary restriction: non-locals not allowed";
460 |
191: str
:= "Temporary restriction: only name equivalence here";
461 |
192: str
:= "Only '=' or ':' can go here";
462 |
193: str
:= "THROW needs a string or native exception object";
463 |
194: str
:= 'Only
"UNCHECKED_ARITHMETIC" can go here'
;
464 |
195: str
:= "NEW method cannot be exported if receiver type is private";
465 |
196: str
:= "Only static fields can select on a type-name";
466 |
197: str
:= "Only static methods can select on a type-name";
467 |
198: str
:= "Static fields can only select on a type-name";
468 |
199: str
:= "Static methods can only select on a type-name";
470 |
200: str
:= "Constructors cannot be declared for imported types";
471 |
201: str
:= "Constructors must return POINTER TO RECORD type";
472 |
202: str
:= "Base type does not have a matching constructor";
473 |
203: str
:= "Base type does not allow a no-arg constructor";
474 |
204: str
:= "Constructors only allowed for extensions of foreign types";
475 |
205: str
:= "Methods can only be declared for local record types";
476 |
206: str
:= "Receivers of pointer type must have value mode";
477 |
207: str
:= "Feature with this name already known in binding scope";
478 |
208: str
:= "EVENT types only valid for .NET target";
479 |
209: str
:= "Events must have a valid formal parameter list";
481 |
210: str
:= "REGISTER expects an EVENT type here";
482 |
211: str
:= "Only procedure literals allowed here";
483 |
212: str
:= "Event types cannot be local to procedures";
484 |
213: str
:= "Temporary restriction: no proc. variables with JVM";
485 |
214: str
:= "Interface types cannot be anonymous";
486 |
215: str
:= "Interface types must be exported";
487 |
216: str
:= "Interface methods must be exported";
488 |
217: str
:= "Covariant OUT parameters unsafe removed from language";
489 |
218: str
:= "No procedure of this name with matching parameters";
490 |
219: str
:= "Multiple overloaded procedure signatures match this call";
492 |
220: RETURN; (* BEWARE PREMATURE EXIT *)
493 |
221: str
:= "Non-standard construct, not allowed with /strict";
494 |
222: str
:= "This is not a value: thus cannot end with a type guard";
495 |
223: str
:= "Override of imp-only in exported type must be imp-only";
496 |
224: str
:= "This designator is not a procedure or a function call";
497 |
225: str
:= "Non-empty constructors can only return SELF";
498 |
226: str
:= "USHORT cannot be applied to this type";
499 |
227: str
:= "Cannot import SYSTEM without /unsafe option";
500 |
228: str
:= "Cannot import SYSTEM unless target=net";
501 |
229: str
:= "Designator is not of VECTOR type";
503 |
230: str
:= "Type is incompatible with element type";
504 |
231: str
:= "Vectors are always one-dimensional only";
505 |
232: str
:= 'Hex constant too big
, use suffix
"L" instead'
;
506 |
233: str
:= "Literal constant too big, even for LONGINT";
507 |
234: str
:= "Extension of LIMITED type must be limited";
508 |
235: str
:= "LIMITED types can only be extended in the same module";
509 |
236: str
:= "Cannot resolve CLR name of this type";
510 |
237: str
:= "Invalid hex escape sequence in this string";
511 |
238: str
:= "STA is illegal unless target is NET";
512 |
239: str
:= "This module can only be accessed via an alias";
513 |
240: str
:= "This module already has an alias";
515 |
298: str
:= "ILASM failed to assemble IL file";
516 |
299: str
:= "Compiler raised an internal exception";
517 (* ===================== END ERRORS ======================= *)
518 (* ====================== WARNINGS ======================== *)
519 |
300: str
:= "Warning: Super calls are deprecated";
520 |
301: str
:= "Warning: Procedure variables are deprecated";
521 |
302: str
:= "Warning: Non-local variable access here";
522 |
303: str
:= "Warning: Numeric literal is not in the SET range [0 .. 31]";
523 |
304: str
:= "Warning: This procedure is not exported, called or assigned";
524 |
305: str
:= "Warning: Another constructor has an equal signature";
525 |
306: str
:= "Warning: Covariant OUT parameters unsafe when aliassed";
526 |
307: str
:= "Warning: Multiple overloaded procedure signatures match this call";
527 |
308: str
:= "Warning: Default static class has name clash";
528 |
309: str
:= "Warning: Looking for an automatically renamed module";
531 311: str
:= "Warning: This variable is accessed from nested procedure";
533 313: RETURN; (* BEWARE PREMATURE EXIT *)
534 |
314: str
:= "The anonymous record type is incomptible with all values";
535 |
315: str
:= "The anonymous array type is incomptible with all values";
536 |
316: str
:= "This pointer type may still have its default NIL value";
537 |
317: str
:= "Empty CASE statement will trap if control reaches here";
538 |
318: str
:= "Empty WITH statement will trap if control reaches here";
539 |
319: str
:= "STA has no effect without CPmain or WinMain";
540 |
320: str
:= "Procedure variables with JVM target are experimental";
541 (* ==================== END WARNINGS ====================== *)
543 str
:= "Semantic error: " + LitValue
.intToCharOpen(num
)^
;
547 FOR idx
:= 0 TO len
-1 DO
548 msg
[idx
] := str
[idx
];
553 StoreError(num
,lin
,col
,msg
);
556 StoreError(num
,lin
,col
,msg
);
561 Console
.WriteString("Error");
563 Console
.WriteString("Warning");
565 Console
.WriteInt(num
,0);
566 Console
.WriteString("@ line:");
567 Console
.WriteInt(lin
,0);
568 Console
.WriteString(", col:");
569 Console
.WriteInt(col
,0);
571 Console
.WriteString(str
);
577 (* ============================================================ *)
579 PROCEDURE (h
: SemanticHdlr
)RepSt1
*(num
: INTEGER;
580 IN s1
: ARRAY OF CHAR;
585 |
0: msg
:= LitValue
.strToCharOpen("Expected: END " + s1
);
586 |
1: msg
:= LitValue
.strToCharOpen("Expected: " + s1
);
587 |
89: msg
:= LitValue
.strToCharOpen("Duplicated selector values <"
590 169: msg
:= LitValue
.strToCharOpen("Current type was <"
592 |
117: msg
:= LitValue
.strToCharOpen("Type <"
593 + s1
+ "> must be extensible");
594 |
121: msg
:= LitValue
.strToCharOpen("Missing methods <" + s1
+ '
>'
);
595 |
145: msg
:= LitValue
.strToCharOpen("Types on cycle <" + s1
+ '
>'
);
598 132: msg
:= LitValue
.strToCharOpen("Filename <" + s1
+ '
>'
);
599 |
133: msg
:= LitValue
.strToCharOpen("Module <"
600 + s1
+ "> already imported with different key");
601 |
138: msg
:= LitValue
.strToCharOpen('
<'
602 + s1
+ '
> not assigned before
"RETURN"'
);
603 |
139: msg
:= LitValue
.strToCharOpen('
<'
604 + s1
+ '
> not assigned before end of procedure'
);
605 |
154: msg
:= LitValue
.strToCharOpen('
<'
606 + s1
+ "> is a Foreign interface type");
607 |
157: msg
:= LitValue
.strToCharOpen('
<'
608 + s1
+ "> is not a Foreign type");
609 |
158: msg
:= LitValue
.strToCharOpen('
<'
610 + s1
+ "> is not a foreign language interface type");
611 |
159: msg
:= LitValue
.strToCharOpen("Missing interface methods <"
613 |
162: msg
:= LitValue
.strToCharOpen('
<'
614 + s1
+ "> is a protected, foreign-language feature");
615 |
164: msg
:= LitValue
.strToCharOpen('
<'
616 + s1
+ "> not assigned before this call");
617 |
172: msg
:= LitValue
.strToCharOpen('Name
<'
618 + s1
+ '
> clashes in imported scope'
);
620 176: msg
:= LitValue
.strToCharOpen("Module "
621 + '
<'
+ s1
+ "> is not imported");
622 |
189: msg
:= LitValue
.strToCharOpen('Non
-local access to
<'
623 + s1
+ '
> cannot be verified on
.NET'
);
625 207: msg
:= LitValue
.strToCharOpen(
626 "Binding scope of feature is record type <" + s1
+ ">");
627 |
236: msg
:= LitValue
.strToCharOpen(
628 "Cannot resolve CLR name of type : " + s1
);
630 240: msg
:= LitValue
.strToCharOpen(
631 'This module has alias name
"' + s1 + '"'
);
632 |
299: msg
:= LitValue
.strToCharOpen("Exception: " + s1
);
633 |
308: msg
:= LitValue
.strToCharOpen(
634 "Renaming static class to <" + s1
+ ">");
635 |
310: msg
:= LitValue
.strToCharOpen('Access to
<'
636 + s1
+ '
> has copying not reference semantics'
);
637 |
311: msg
:= LitValue
.strToCharOpen('Access to variable
<'
638 + s1
+ '
> will be inefficient'
);
640 312: msg
:= LitValue
.strToCharOpen("Matches with - " + s1
);
641 |
313: msg
:= LitValue
.strToCharOpen("Bound to - " + s1
);
643 IF ~nowarn
OR (* If warnings are on OR *)
644 (num
< 300) THEN (* this is an error then *)
645 StoreError(num
,lin
,0,msg
); (* (1) Store THIS message *)
646 h
.Report(num
,lin
,col
); (* (2) Generate other msg *)
649 * IF (num # 251) & (num # 252) THEN
650 * StoreError(num,lin,col,msg);
651 * h.Report(num,lin,col);
653 * StoreError(num,lin,col,msg);
658 (* ============================================================ *)
660 PROCEDURE (h
: SemanticHdlr
)RepSt2
*(num
: INTEGER;
661 IN s1
,s2
: ARRAY OF CHAR;
664 * VAR str : ARRAY 128 OF CHAR;
674 306: msg
:= LitValue
.strToCharOpen(
675 "Actual par-type was " + s1
+ ", Formal type was " + s2
);
676 |
76: msg
:= LitValue
.strToCharOpen(
677 "Expr-type was " + s2
+ ", should be " + s1
);
679 83: msg
:= LitValue
.strToCharOpen(
680 "LHS type was " + s1
+ ", RHS type was " + s2
);
681 |
116: msg
:= LitValue
.strToCharOpen(
682 "Inherited retType is " + s1
+ ", this retType " + s2
);
683 |
131: msg
:= LitValue
.strToCharOpen(
684 "Module name in file <" + s1
+ ".cps> was <" + s2
+ '
>'
);
685 |
172: msg
:= LitValue
.strToCharOpen(
686 'Name
<'
+ s1
+ '
> clashes in scope
<'
+ s2
+ '
>'
);
687 |
230: msg
:= LitValue
.strToCharOpen(
688 "Expression type is " + s2
+ ", element type is " + s1
);
689 |
309: msg
:= LitValue
.strToCharOpen(
690 'Looking for module
"' + s1 + '" in file
<'
+ s2
+ '
>'
);
695 * FOR idx := 0 TO len-1 DO
696 * msg[idx] := str[idx];
700 StoreError(num
,lin
,col
,msg
);
701 h
.Report(num
,lin
,col
);
704 (* ============================================================ *)
706 PROCEDURE GetLine (VAR pos
: INTEGER;
707 OUT line
: ARRAY OF CHAR;
709 (** Read a source line. Return empty line if eof *)
718 ch
:= Scnr
.charAt(pos
); INC(pos
);
721 WHILE (ch
# lf
) & (ch
# 0X
) DO
722 IF ch
= cr
THEN (* skip *)
724 REPEAT line
[MIN(i
,listingMax
)] := ' '
; INC(i
) UNTIL i
MOD 8 = 0;
726 line
[MIN(i
,listingMax
)] := ch
; INC(i
);
728 ch
:= Scnr
.charAt(pos
); INC(pos
);
730 eof
:= (i
= 0) & (ch
= 0X
); line
[MIN(i
,listingMax
)] := 0X
;
733 (* ============================================================ *)
735 PROCEDURE PrintErr(IN desc
: ErrDesc
);
736 (** Print an error message *)
740 GPText
.WriteString(Scnr
.lst
, "**** ");
741 mLen
:= LEN(desc
.msg$
);
742 IF desc
.col
= listingMax
THEN (* write field of width (col-2) *)
743 GPText
.WriteString(Scnr
.lst
, desc
.msg
);
744 ELSIF mLen
< desc
.col
-1 THEN (* write field of width (col-2) *)
745 GPText
.WriteFiller(Scnr
.lst
, desc
.msg
, "-", desc
.col
-1);
746 GPText
.Write(Scnr
.lst
, "^");
747 ELSIF mLen
+ desc
.col
+ 5 < consoleWidth
THEN
748 GPText
.WriteFiller(Scnr
.lst
, "", "-", desc
.col
-1);
749 GPText
.WriteString(Scnr
.lst
, "^ ");
750 GPText
.WriteString(Scnr
.lst
, desc
.msg
);
752 GPText
.WriteFiller(Scnr
.lst
, "", "-", desc
.col
-1);
753 GPText
.Write(Scnr
.lst
, "^");
754 GPText
.WriteLn(Scnr
.lst
);
755 GPText
.WriteString(Scnr
.lst
, "**** ");
756 GPText
.WriteString(Scnr
.lst
, desc
.msg
);
758 GPText
.WriteLn(Scnr
.lst
);
761 (* ============================================================ *)
763 PROCEDURE Display (IN desc
: ErrDesc
);
764 (** Display an error message *)
768 Console
.WriteString("**** ");
769 mLen
:= LEN(desc
.msg$
);
770 IF desc
.col
= listingMax
THEN
771 Console
.WriteString(desc
.msg
);
772 ELSIF mLen
< desc
.col
-1 THEN
773 Console
.WriteString(desc
.msg
);
774 FOR indx
:= mLen
TO desc
.col
-2 DO Console
.Write("-") END;
776 ELSIF mLen
+ desc
.col
+ 5 < consoleWidth
THEN
777 FOR indx
:= 2 TO desc
.col
DO Console
.Write("-") END;
778 Console
.WriteString("^ ");
779 Console
.WriteString(desc
.msg
);
781 FOR indx
:= 2 TO desc
.col
DO Console
.Write("-") END;
784 Console
.WriteString("**** ");
785 Console
.WriteString(desc
.msg
);
790 (* ============================================================ *)
792 PROCEDURE DisplayVS (IN desc
: ErrDesc
);
793 (** Display an error message for Visual Studio *)
797 Console
.WriteString(srcNam
);
799 Console
.WriteInt(desc
.lin
,1);
801 Console
.WriteInt(desc
.col
,1);
802 Console
.WriteString(") : ");
803 IF desc
.num
< 300 THEN
804 Console
.WriteString("error : ");
806 Console
.WriteString("warning : ");
808 Console
.WriteString(desc
.msg
);
812 (* ============================================================ *)
814 PROCEDURE DisplayXMLHeader ();
816 Console
.WriteString('
<?xml version
="1.0"?
>'
);
818 Console
.WriteString('
<compilererrors errorsContained
="yes">'
);
820 END DisplayXMLHeader
;
822 PROCEDURE DisplayXMLEnd ();
824 Console
.WriteString('
</compilererrors
>'
);
828 PROCEDURE DisplayXML (IN desc
: ErrDesc
);
829 (** Display an error message in xml format (for eclipse) *)
830 (* <?xml version="1.0"?>
831 * <compilererrors errorsContained="yes">
834 * <position> 34 </position>
835 * <description> ; expected </description>
845 isWarn
:= desc
.num
>= 300;
847 Console
.WriteString(" <warning> ");
849 Console
.WriteString(" <error> ");
852 Console
.WriteString(" <line> ");
853 Console
.WriteInt(desc
.lin
,1);
854 Console
.WriteString(" </line>"); Console
.WriteLn
;
855 Console
.WriteString(" <position> ");
856 Console
.WriteInt(desc
.col
,1);
857 Console
.WriteString(" </position>"); Console
.WriteLn
;
858 Console
.WriteString(" <description> ");
860 Console
.WriteString("warning : ");
862 Console
.WriteString("error : ");
864 Console
.WriteString(desc
.msg
);
865 Console
.WriteString(" </description> "); Console
.WriteLn
;
867 Console
.WriteString(" </warning> ");
869 Console
.WriteString(" </error> ");
874 (* ============================================================ *)
876 PROCEDURE PrintLine(n
: INTEGER; IN l
: ARRAY OF CHAR);
878 GPText
.WriteInt(Scnr
.lst
, n
, 4); GPText
.Write(Scnr
.lst
, " ");
879 GPText
.WriteString(Scnr
.lst
, l
); GPText
.WriteLn(Scnr
.lst
);
882 (* ============================================================ *)
884 PROCEDURE DisplayLn(n
: INTEGER; IN l
: ARRAY OF CHAR);
886 Console
.WriteInt(n
, 4); Console
.Write(" ");
887 Console
.WriteString(l
); Console
.WriteLn
;
890 (* ============================================================ *)
892 PROCEDURE PrintListing
*(list
: BOOLEAN);
893 (** Print a source listing with error messages *)
895 nextErr
: Err
; (* next error descriptor *)
896 nextLin
: INTEGER; (* line num of nextErr *)
897 eof
: BOOLEAN; (* end of file found *)
898 lnr
: INTEGER; (* current line number *)
899 errC
: INTEGER; (* current error index *)
900 srcPos
: INTEGER; (* postion in sourceFile *)
901 line
: ARRAY listingWidth
OF CHAR;
903 IF xmlErrors
THEN DisplayXMLHeader(); END;
905 IF eTide
> 0 THEN QuickSort(0, eTide
-1) END;
907 GPText
.WriteString(Scnr
.lst
, "Listing:");
908 GPText
.WriteLn(Scnr
.lst
); GPText
.WriteLn(Scnr
.lst
);
910 srcPos
:= 0; nextErr
:= eBuffer
[0];
911 GetLine(srcPos
, line
, eof
); lnr
:= 1; errC
:= 0;
913 IF nextErr
# NIL THEN nextLin
:= nextErr
.lin
END;
914 IF list
THEN PrintLine(lnr
, line
) END;
915 IF ~forVisualStudio
& ~xmlErrors
& (~list
OR (lnr
= nextLin
)) THEN
918 WHILE (nextErr
# NIL) & (nextErr
.lin
= lnr
) DO
919 IF list
THEN PrintErr(nextErr
) END;
920 IF forVisualStudio
THEN
928 nextErr
:= eBuffer
[errC
];
930 GetLine(srcPos
, line
, eof
); INC(lnr
);
932 WHILE nextErr
# NIL DO
933 IF list
THEN PrintErr(nextErr
) END;
934 IF forVisualStudio
THEN
940 nextErr
:= eBuffer
[errC
];
944 * GPText.WriteLn(Scnr.lst);
945 * GPText.WriteInt(Scnr.lst, errC, 5);
946 * GPText.WriteString(Scnr.lst, " error");
947 * IF errC # 1 THEN GPText.Write(Scnr.lst, "s") END;
948 * GPText.WriteLn(Scnr.lst);
949 * GPText.WriteLn(Scnr.lst);
950 * GPText.WriteLn(Scnr.lst);
954 GPText
.WriteLn(Scnr
.lst
);
955 GPText
.WriteString(Scnr
.lst
, "There were: ");
956 IF Scnr
.errors
= 0 THEN
957 GPText
.WriteString(Scnr
.lst
, "No errors");
959 GPText
.WriteInt(Scnr
.lst
, Scnr
.errors
, 0);
960 GPText
.WriteString(Scnr
.lst
, " error");
961 IF Scnr
.errors
# 1 THEN GPText
.Write(Scnr
.lst
, "s") END;
963 GPText
.WriteString(Scnr
.lst
, ", and ");
964 IF Scnr
.warnings
= 0 THEN
965 GPText
.WriteString(Scnr
.lst
, "No warnings");
967 GPText
.WriteInt(Scnr
.lst
, Scnr
.warnings
, 0);
968 GPText
.WriteString(Scnr
.lst
, " warning");
969 IF Scnr
.warnings
# 1 THEN GPText
.Write(Scnr
.lst
, "s") END;
971 GPText
.WriteLn(Scnr
.lst
);
972 GPText
.WriteLn(Scnr
.lst
);
973 GPText
.WriteLn(Scnr
.lst
);
975 IF xmlErrors
THEN DisplayXMLEnd(); END;
978 PROCEDURE ResetErrorList
*();
984 (* ============================================================ *)
988 NEW(parsHdlr
); Scnr
.ParseErr
:= parsHdlr
;
989 NEW(semaHdlr
); Scnr
.SemError
:= semaHdlr
;
992 (* ============================================================ *)
994 PROCEDURE SetSrcNam
* (IN nam
: ARRAY OF CHAR);
996 GPText
.Assign(nam
,srcNam
);
999 (* ============================================================ *)
1001 NEW(eBuffer
, 8); eBuffer
[0] := NIL; eLimit
:= 7; eTide
:= 0;
1004 forVisualStudio
:= FALSE
;
1006 (* ============================================================ *)