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