1 /*
2 SPDX-License-Identifier: GPL-2.0-or-later
3 SPDX-FileCopyrightText: 2006-2021 Umbrello UML Modeller Authors <umbrello-devel@kde.org>
4 */
5
6 #include "pascalwriter.h"
7
8 #include "association.h"
9 #include "attribute.h"
10 #include "classifier.h"
11 #include "classifierlistitem.h"
12 #include "debug_utils.h"
13 #include "enum.h"
14 #include "folder.h"
15 #include "operation.h"
16 #include "template.h"
17 #include "uml.h"
18 #include "umlclassifierlistitemlist.h"
19 #include "umldoc.h"
20 #include "umltemplatelist.h"
21
22 #include <KLocalizedString>
23 #include <KMessageBox>
24
25 #include <QFile>
26 #include <QRegExp>
27 #include <QTextStream>
28
29 const QString PascalWriter::defaultPackageSuffix = QLatin1String("_Holder");
30
31 /**
32 * Basic Constructor.
33 */
PascalWriter()34 PascalWriter::PascalWriter()
35 : SimpleCodeGenerator()
36 {
37 }
38
39 /**
40 * Empty Destructor.
41 */
~PascalWriter()42 PascalWriter::~PascalWriter()
43 {
44 }
45
46 /**
47 * Returns "Pascal".
48 * @return the programming language identifier
49 */
language() const50 Uml::ProgrammingLanguage::Enum PascalWriter::language() const
51 {
52 return Uml::ProgrammingLanguage::Pascal;
53 }
54
55 /**
56 *
57 */
isOOClass(UMLClassifier * c)58 bool PascalWriter::isOOClass(UMLClassifier *c)
59 {
60 UMLObject::ObjectType ot = c->baseType();
61 if (ot == UMLObject::ot_Interface)
62 return true;
63 if (ot == UMLObject::ot_Enum || ot == UMLObject::ot_Datatype)
64 return false;
65 if (ot != UMLObject::ot_Class) {
66 uDebug() << "unknown object type " << UMLObject::toString(ot);
67 return false;
68 }
69 QString stype = c->stereotype();
70 if (stype == QLatin1String("CORBAConstant") || stype == QLatin1String("CORBATypedef") ||
71 stype == QLatin1String("CORBAStruct") || stype == QLatin1String("CORBAUnion"))
72 return false;
73 // CORBAValue, CORBAInterface, and all empty/unknown stereotypes are
74 // assumed to be OO classes.
75 return true;
76 }
77
qualifiedName(UMLPackage * p,bool withType,bool byValue)78 QString PascalWriter::qualifiedName(UMLPackage *p, bool withType, bool byValue)
79 {
80 UMLPackage *umlPkg = p->umlPackage();
81 QString className = cleanName(p->name());
82 QString retval;
83
84 if (umlPkg == UMLApp::app()->document()->rootFolder(Uml::ModelType::Logical))
85 umlPkg = 0;
86
87 UMLClassifier *c = p->asUMLClassifier();
88 if (umlPkg == 0) {
89 retval = className;
90 if (c == 0 || !isOOClass(c))
91 retval.append(defaultPackageSuffix);
92 } else {
93 retval = umlPkg->fullyQualifiedName(QLatin1String("."));
94 if (c && isOOClass(c)) {
95 retval.append(QLatin1String("."));
96 retval.append(className);
97 }
98 }
99 if (! withType)
100 return retval;
101 if (c && isOOClass(c)) {
102 retval.append(QLatin1String(".Object"));
103 if (! byValue)
104 retval.append(QLatin1String("_Ptr"));
105 } else {
106 retval.append(QLatin1String("."));
107 retval.append(className);
108 }
109 return retval;
110 }
111
computeAssocTypeAndRole(UMLAssociation * a,QString & typeName,QString & roleName)112 void PascalWriter::computeAssocTypeAndRole
113 (UMLAssociation *a, QString& typeName, QString& roleName)
114 {
115 roleName = a->getRoleName(Uml::RoleType::A);
116 if (roleName.isEmpty()) {
117 if (a->getMultiplicity(Uml::RoleType::A).isEmpty()) {
118 roleName = QLatin1String("M_");
119 roleName.append(typeName);
120 } else {
121 roleName = typeName;
122 roleName.append(QLatin1String("_Vector"));
123 }
124 }
125 UMLClassifier* c = a->getObject(Uml::RoleType::A)->asUMLClassifier();
126 if (c == 0)
127 return;
128 typeName = cleanName(c->name());
129 if (! a->getMultiplicity(Uml::RoleType::A).isEmpty())
130 typeName.append(QLatin1String("_Array_Access"));
131 }
132
133 /**
134 * Call this method to generate Pascal code for a UMLClassifier.
135 * @param c the class to generate code for
136 */
writeClass(UMLClassifier * c)137 void PascalWriter::writeClass(UMLClassifier *c)
138 {
139 if (!c) {
140 uDebug() << "Cannot write class of NULL concept!";
141 return;
142 }
143
144 const bool isClass = !c->isInterface();
145 QString classname = cleanName(c->name());
146 QString fileName = qualifiedName(c).toLower();
147 fileName.replace(QLatin1Char('.'), QLatin1Char('-'));
148
149 //find an appropriate name for our file
150 fileName = overwritableName(c, fileName, QLatin1String(".pas"));
151 if (fileName.isEmpty()) {
152 emit codeGenerated(c, false);
153 return;
154 }
155
156 QFile file;
157 if (!openFile(file, fileName)) {
158 emit codeGenerated(c, false);
159 return;
160 }
161
162 // Start generating the code.
163
164 QTextStream pas(&file);
165 //try to find a heading file(license, comments, etc)
166 QString str;
167 str = getHeadingFile(QLatin1String(".pas"));
168 if (!str.isEmpty()) {
169 str.replace(QRegExp(QLatin1String("%filename%")), fileName);
170 str.replace(QRegExp(QLatin1String("%filepath%")), file.fileName());
171 pas << str << endl;
172 }
173
174 QString unit = qualifiedName(c);
175 pas << "unit " << unit << ";" << m_endl << m_endl;
176 pas << "INTERFACE" << m_endl << m_endl;
177 // Use referenced classes.
178 UMLPackageList imports;
179 findObjectsRelated(c, imports);
180 if (imports.count()) {
181 pas << "uses" << m_endl;
182 bool first = true;
183 foreach (UMLPackage* con, imports) {
184 if (!con->isUMLDatatype()) {
185 if (first)
186 first = false;
187 else
188 pas << "," << m_endl;
189 pas << " " << qualifiedName(con);
190 }
191 }
192 pas << ";" << m_endl << m_endl;
193 }
194
195 pas << "type" << m_endl;
196 m_indentLevel++;
197 if (c->baseType() == UMLObject::ot_Enum) {
198 UMLEnum *ue = c->asUMLEnum();
199 UMLClassifierListItemList litList = ue->getFilteredList(UMLObject::ot_EnumLiteral);
200 uint i = 0;
201 pas << indent() << classname << " = (" << m_endl;
202 m_indentLevel++;
203 foreach (UMLClassifierListItem *lit, litList) {
204 QString enumLiteral = cleanName(lit->name());
205 pas << indent() << enumLiteral;
206 if (++i < (uint)litList.count())
207 pas << "," << m_endl;
208 }
209 m_indentLevel--;
210 pas << ");" << m_endl << m_endl;
211 m_indentLevel--;
212 pas << "end." << m_endl << m_endl;
213 return;
214 }
215 UMLAttributeList atl = c->getAttributeList();
216 if (! isOOClass(c)) {
217 QString stype = c->stereotype();
218 if (stype == QLatin1String("CORBAConstant")) {
219 pas << indent() << "// " << stype << " is Not Yet Implemented" << m_endl << m_endl;
220 } else if(stype == QLatin1String("CORBAStruct")) {
221 if (isClass) {
222
223 pas << indent() << classname << " = record" << m_endl;
224 m_indentLevel++;
225 foreach (UMLAttribute* at, atl) {
226 QString name = cleanName(at->name());
227 QString typeName = at->getTypeName();
228 pas << indent() << name << " : " << typeName;
229 QString initialVal = at->getInitialValue();
230 if (!initialVal.isEmpty())
231 pas << " := " << initialVal;
232 pas << ";" << m_endl;
233 }
234 m_indentLevel--;
235 pas << "end;" << m_endl << m_endl;
236 }
237 } else if(stype == QLatin1String("CORBAUnion")) {
238 pas << indent() << "// " << stype << " is Not Yet Implemented" << m_endl << m_endl;
239 } else if(stype == QLatin1String("CORBATypedef")) {
240 pas << indent() << "// " << stype << " is Not Yet Implemented" << m_endl << m_endl;
241 } else {
242 pas << indent() << "// " << stype << ": Unknown stereotype" << m_endl << m_endl;
243 }
244 m_indentLevel--;
245 pas << indent() << "end." << m_endl << m_endl;
246 return;
247 }
248
249 // Write class Documentation if non-empty or if force option set.
250 if (forceDoc() || !c->doc().isEmpty()) {
251 pas << "//" << m_endl;
252 pas << "// class " << classname << endl;
253 pas << formatDoc(c->doc(), QLatin1String("// "));
254 pas << m_endl;
255 }
256
257 UMLClassifierList superclasses = c->getSuperClasses();
258
259 pas << indent() << classname << " = object";
260 if (!superclasses.isEmpty()) {
261 // FIXME: Multiple inheritance is not yet supported
262 UMLClassifier* parent = superclasses.first();
263 pas << "(" << qualifiedName(parent) << ")";
264 }
265 pas << m_endl;
266
267 UMLAttributeList atpub = c->getAttributeList(Uml::Visibility::Public);
268 if (isClass && (forceSections() || atpub.count())) {
269 pas << indent() << "// Public attributes:" << m_endl;
270
271 foreach (UMLAttribute* at, atpub) {
272 // if (at->getStatic())
273 // continue;
274 pas << indent() << cleanName(at->name()) << " : "
275 << at->getTypeName();
276 if (at && !at->getInitialValue().isEmpty())
277 pas << " := " << at->getInitialValue();
278 pas << ";" << m_endl;
279 }
280 }
281 //bool haveAttrs = (isClass && atl.count());
282
283 // Generate public operations.
284 UMLOperationList opl(c->getOpList());
285 UMLOperationList oppub;
286
287 foreach (UMLOperation* op, opl) {
288 if (op->visibility() == Uml::Visibility::Public)
289 oppub.append(op);
290 }
291 if (forceSections() || oppub.count())
292 pas << indent() << "// Public methods:" << m_endl << m_endl;
293 foreach (UMLOperation* op, oppub)
294 writeOperation(op, pas);
295
296 UMLAttributeList atprot = c->getAttributeList(Uml::Visibility::Protected);
297 if (atprot.count()) {
298 pas << "protected" << m_endl << m_endl;
299
300 foreach (UMLAttribute* at, atprot) {
301 // if (at->getStatic())
302 // continue;
303 pas << indent() << cleanName(at->name()) << " : "
304 << at->getTypeName();
305 if (!at->getInitialValue().isEmpty())
306 pas << " := " << at->getInitialValue();
307 pas << ";" << m_endl;
308 }
309 pas << m_endl;
310 }
311
312 UMLAttributeList atpriv = c->getAttributeList(Uml::Visibility::Private);
313 if (atpriv.count()) {
314 pas << "private" << m_endl << m_endl;
315
316 foreach (UMLAttribute* at, atpriv) {
317 if (at) {
318 pas << indent() << cleanName(at->name()) << " : "
319 << at->getTypeName();
320
321 // if (at->getStatic())
322 // continue;
323
324 if (!at->getInitialValue().isEmpty())
325 pas << " := " << at->getInitialValue();
326
327 pas << ";" << m_endl;
328 }
329 }
330 pas << m_endl;
331 }
332 pas << indent() << "end;" << m_endl << m_endl;
333
334 pas << indent() << "P" << classname << " = ^" << classname <<";" << m_endl << m_endl;
335
336 m_indentLevel--;
337 pas << "end;" << m_endl << m_endl;
338 file.close();
339 emit codeGenerated(c, true);
340 emit showGeneratedFile(file.fileName());
341 }
342
343 /**
344 * Write one operation.
345 * @param op the class for which we are generating code
346 * @param pas the stream associated with the output file
347 */
writeOperation(UMLOperation * op,QTextStream & pas,bool is_comment)348 void PascalWriter::writeOperation(UMLOperation *op, QTextStream &pas, bool is_comment)
349 {
350 if (op->isStatic()) {
351 pas << "// TODO: generate status method " << op->name() << m_endl;
352 return;
353 }
354 UMLAttributeList atl = op->getParmList();
355 QString rettype = op->getTypeName();
356 bool use_procedure = (rettype.isEmpty() || rettype == QLatin1String("void"));
357
358 pas << indent();
359 if (is_comment)
360 pas << "// ";
361 if (use_procedure)
362 pas << "procedure ";
363 else
364 pas << "function ";
365 pas << cleanName(op->name()) << " ";
366 if (atl.count()) {
367 pas << "(" << m_endl;
368 uint i = 0;
369 m_indentLevel++;
370 foreach (UMLAttribute *at, atl) {
371 pas << indent();
372 if (is_comment)
373 pas << "// ";
374 pas << cleanName(at->name()) << " : ";
375 Uml::ParameterDirection::Enum pk = at->getParmKind();
376 if (pk != Uml::ParameterDirection::In)
377 pas << "var ";
378 pas << at->getTypeName();
379 if (! at->getInitialValue().isEmpty())
380 pas << " := " << at->getInitialValue();
381 if (++i < (uint)atl.count())
382 pas << ";" << m_endl;
383 }
384 m_indentLevel--;
385 pas << ")";
386 }
387 if (! use_procedure)
388 pas << " : " << rettype << ";";
389
390 QString sourceCode = op->getSourceCode();
391 if (sourceCode.isEmpty()) {
392 pas << " virtual; abstract;" << m_endl << m_endl;
393 // TBH, we make the methods abstract here because we don't have the means
394 // for generating meaningful implementations.
395 }
396 else {
397 pas << m_endl;
398 pas << indent() << "begin" << m_endl;
399 m_indentLevel++;
400 pas << formatSourceCode(sourceCode, indent());
401 m_indentLevel--;
402 pas << indent() << "end;" << m_endl << m_endl;
403 }
404 }
405
406 /**
407 * Returns the default datatypes in a list.
408 * @return the list of default datatypes
409 */
defaultDatatypes() const410 QStringList PascalWriter::defaultDatatypes() const
411 {
412 QStringList l;
413 l.append(QLatin1String("AnsiString"));
414 l.append(QLatin1String("Boolean"));
415 l.append(QLatin1String("Byte"));
416 l.append(QLatin1String("ByteBool"));
417 l.append(QLatin1String("Cardinal"));
418 l.append(QLatin1String("Character"));
419 l.append(QLatin1String("Currency"));
420 l.append(QLatin1String("Double"));
421 l.append(QLatin1String("Extended"));
422 l.append(QLatin1String("Int64"));
423 l.append(QLatin1String("Integer"));
424 l.append(QLatin1String("Longint"));
425 l.append(QLatin1String("LongBool"));
426 l.append(QLatin1String("Longword"));
427 l.append(QLatin1String("QWord"));
428 l.append(QLatin1String("Real"));
429 l.append(QLatin1String("Shortint"));
430 l.append(QLatin1String("ShortString"));
431 l.append(QLatin1String("Single"));
432 l.append(QLatin1String("Smallint"));
433 l.append(QLatin1String("String"));
434 l.append(QLatin1String("WideString"));
435 l.append(QLatin1String("Word"));
436 return l;
437 }
438
439 /**
440 * Check whether the given string is a reserved word for the
441 * language of this code generator.
442 * @param rPossiblyReservedKeyword the string to check
443 */
isReservedKeyword(const QString & rPossiblyReservedKeyword)444 bool PascalWriter::isReservedKeyword(const QString & rPossiblyReservedKeyword)
445 {
446 const QStringList keywords = reservedKeywords();
447
448 QStringList::ConstIterator it;
449 for (it = keywords.begin(); it != keywords.end(); ++it)
450 if ((*it).toLower() == rPossiblyReservedKeyword.toLower())
451 return true;
452
453 return false;
454 }
455
456 /**
457 * Get list of reserved keywords.
458 * @return the list of reserved keywords
459 */
reservedKeywords() const460 QStringList PascalWriter::reservedKeywords() const
461 {
462 static QStringList keywords;
463
464 if (keywords.isEmpty()) {
465 keywords.append(QLatin1String("absolute"));
466 keywords.append(QLatin1String("abstract"));
467 keywords.append(QLatin1String("and"));
468 keywords.append(QLatin1String("array"));
469 keywords.append(QLatin1String("as"));
470 keywords.append(QLatin1String("asm"));
471 keywords.append(QLatin1String("assembler"));
472 keywords.append(QLatin1String("automated"));
473 keywords.append(QLatin1String("begin"));
474 keywords.append(QLatin1String("case"));
475 keywords.append(QLatin1String("cdecl"));
476 keywords.append(QLatin1String("class"));
477 keywords.append(QLatin1String("const"));
478 keywords.append(QLatin1String("constructor"));
479 keywords.append(QLatin1String("contains"));
480 keywords.append(QLatin1String("default"));
481 keywords.append(QLatin1String("deprecated"));
482 keywords.append(QLatin1String("destructor"));
483 keywords.append(QLatin1String("dispid"));
484 keywords.append(QLatin1String("dispinterface"));
485 keywords.append(QLatin1String("div"));
486 keywords.append(QLatin1String("do"));
487 keywords.append(QLatin1String("downto"));
488 keywords.append(QLatin1String("dynamic"));
489 keywords.append(QLatin1String("else"));
490 keywords.append(QLatin1String("end"));
491 keywords.append(QLatin1String("except"));
492 keywords.append(QLatin1String("export"));
493 keywords.append(QLatin1String("exports"));
494 keywords.append(QLatin1String("external"));
495 keywords.append(QLatin1String("far"));
496 keywords.append(QLatin1String("file"));
497 keywords.append(QLatin1String("final"));
498 keywords.append(QLatin1String("finalization"));
499 keywords.append(QLatin1String("finally"));
500 keywords.append(QLatin1String("for"));
501 keywords.append(QLatin1String("forward"));
502 keywords.append(QLatin1String("function"));
503 keywords.append(QLatin1String("goto"));
504 keywords.append(QLatin1String("if"));
505 keywords.append(QLatin1String("implementation"));
506 keywords.append(QLatin1String("implements"));
507 keywords.append(QLatin1String("in"));
508 keywords.append(QLatin1String("index"));
509 keywords.append(QLatin1String("inherited"));
510 keywords.append(QLatin1String("initialization"));
511 keywords.append(QLatin1String("inline"));
512 keywords.append(QLatin1String("inline"));
513 keywords.append(QLatin1String("interface"));
514 keywords.append(QLatin1String("is"));
515 keywords.append(QLatin1String("label"));
516 keywords.append(QLatin1String("library"));
517 keywords.append(QLatin1String("library"));
518 keywords.append(QLatin1String("local"));
519 keywords.append(QLatin1String("message"));
520 keywords.append(QLatin1String("mod"));
521 keywords.append(QLatin1String("name"));
522 keywords.append(QLatin1String("near"));
523 keywords.append(QLatin1String("nil"));
524 keywords.append(QLatin1String("nodefault"));
525 keywords.append(QLatin1String("not"));
526 keywords.append(QLatin1String("object"));
527 keywords.append(QLatin1String("of"));
528 keywords.append(QLatin1String("or"));
529 keywords.append(QLatin1String("out"));
530 keywords.append(QLatin1String("overload"));
531 keywords.append(QLatin1String("override"));
532 keywords.append(QLatin1String("package"));
533 keywords.append(QLatin1String("packed"));
534 keywords.append(QLatin1String("pascal"));
535 keywords.append(QLatin1String("platform"));
536 keywords.append(QLatin1String("private"));
537 keywords.append(QLatin1String("procedure"));
538 keywords.append(QLatin1String("program"));
539 keywords.append(QLatin1String("property"));
540 keywords.append(QLatin1String("protected"));
541 keywords.append(QLatin1String("public"));
542 keywords.append(QLatin1String("published"));
543 keywords.append(QLatin1String("raise"));
544 keywords.append(QLatin1String("read"));
545 keywords.append(QLatin1String("readonly"));
546 keywords.append(QLatin1String("record"));
547 keywords.append(QLatin1String("register"));
548 keywords.append(QLatin1String("reintroduce"));
549 keywords.append(QLatin1String("repeat"));
550 keywords.append(QLatin1String("requires"));
551 keywords.append(QLatin1String("resident"));
552 keywords.append(QLatin1String("resourcestring"));
553 keywords.append(QLatin1String("safecall"));
554 keywords.append(QLatin1String("sealed"));
555 keywords.append(QLatin1String("set"));
556 keywords.append(QLatin1String("shl"));
557 keywords.append(QLatin1String("shr"));
558 keywords.append(QLatin1String("static"));
559 keywords.append(QLatin1String("stdcall"));
560 keywords.append(QLatin1String("stored"));
561 keywords.append(QLatin1String("string"));
562 keywords.append(QLatin1String("then"));
563 keywords.append(QLatin1String("threadvar"));
564 keywords.append(QLatin1String("to"));
565 keywords.append(QLatin1String("try"));
566 keywords.append(QLatin1String("type"));
567 keywords.append(QLatin1String("unit"));
568 keywords.append(QLatin1String("unsafe"));
569 keywords.append(QLatin1String("until"));
570 keywords.append(QLatin1String("uses"));
571 keywords.append(QLatin1String("var"));
572 keywords.append(QLatin1String("varargs"));
573 keywords.append(QLatin1String("virtual"));
574 keywords.append(QLatin1String("while"));
575 keywords.append(QLatin1String("with"));
576 keywords.append(QLatin1String("write"));
577 keywords.append(QLatin1String("writeonly"));
578 keywords.append(QLatin1String("xor"));
579 }
580
581 return keywords;
582 }
583
584