From 9193db5089443a16e6bb506b5dd02188f0233411 Mon Sep 17 00:00:00 2001
From: AdolfoSBH
Date: Wed, 28 Dec 2016 20:02:11 +0000
Subject: [509750] - Adding delphi examples to the test cases
---
.../cs2as/compiler/tests/OCL2QVTiTestCases.java | 34 +-
.../cs2as/compiler/tests/models/delphi/.gitignore | 3 +
.../tests/models/delphi/samples/.gitignore | 1 +
.../models/delphi/samples/untClArchivo.delphi | 263 +++++
.../delphi/samples/untClArchivo.output_ref.xmi | 1242 ++++++++++++++++++++
.../tests/models/delphi/samples/untClAux.delphi | 81 ++
.../models/delphi/samples/untClAux.output_ref.xmi | 272 +++++
.../models/delphi/samples/untClFormatos.delphi | 59 +
.../delphi/samples/untClFormatos.output_ref.xmi | 275 +++++
.../tests-gen/cg/.gitignore | 1 +
10 files changed, 2228 insertions(+), 3 deletions(-)
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/.gitignore
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/.gitignore
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.delphi
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.output_ref.xmi
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.delphi
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.output_ref.xmi
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.delphi
create mode 100644 tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.output_ref.xmi
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/OCL2QVTiTestCases.java b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/OCL2QVTiTestCases.java
index b8cf9e15d..40efe16e6 100644
--- a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/OCL2QVTiTestCases.java
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/OCL2QVTiTestCases.java
@@ -46,6 +46,7 @@ import org.eclipse.qvtd.cs2as.compiler.internal.CS2ASJavaCompilerParametersImpl;
import org.eclipse.qvtd.cs2as.compiler.internal.OCL2QVTiCompilerChain;
import org.eclipse.qvtd.cs2as.compiler.internal.OCL2QVTp;
import org.eclipse.qvtd.cs2as.compiler.tests.models.companies.CompaniesStandaloneSetup;
+import org.eclipse.qvtd.cs2as.compiler.tests.models.delphi.DelphiStandaloneSetup;
import org.eclipse.qvtd.pivot.qvtbase.Transformation;
import org.eclipse.qvtd.pivot.qvtbase.utilities.QVTbase;
import org.eclipse.qvtd.pivot.qvtcore.QVTcorePivotStandaloneSetup;
@@ -69,7 +70,9 @@ import org.junit.FixMethodOrder;
import org.junit.Test;
import org.junit.runners.MethodSorters;
+import astm.AstmPackage;
import cs2as.company.lookup.LookupPackage;
+import delphi.DelphiPackage;
import example1.source.SourcePackage;
import example1.target.TargetPackage;
import example2.classes.ClassesPackage;
@@ -734,8 +737,6 @@ public class OCL2QVTiTestCases extends LoadTestCase {
TESTS_GEN_PATH, TESTS_PACKAGE_NAME);
@NonNull Class extends Transformer> txClass = new CS2ASJavaCompilerImpl()
.compileTransformation(myQVT, qvtiTransf, cgParams);
-
-
// Execute CGed transformation
myQVT.executeModelsTX_CG(txClass, createCompaniesModelNames_CG("model1"));
myQVT.executeModelsTX_CG(txClass, createCompaniesModelNames_CG("model2"));
@@ -749,6 +750,31 @@ public class OCL2QVTiTestCases extends LoadTestCase {
myQVT.dispose();
}
+ @Test
+ public void testDelphi_CG() throws Exception {
+ DelphiStandaloneSetup.doSetup();
+ MyQVT myQVT = new MyQVT("delphi");
+ //myQVT.loadEcoreFile("Lookup.ecore", astm.lookup.LookupPackage.eINSTANCE);
+ myQVT.loadGenModels("Delphi.genmodel", "astm.genmodel", "Lookup.genmodel");
+ Transformation qvtiTransf = myQVT.executeNewOCL2QVTi_CompilerChain("Delphi.ocl");
+ CS2ASJavaCompilerParameters cgParams = new CS2ASJavaCompilerParametersImpl(
+ "",
+ "",
+ TESTS_GEN_PATH, TESTS_PACKAGE_NAME);
+ @NonNull Class extends Transformer> txClass = new CS2ASJavaCompilerImpl()
+ .compileTransformation(myQVT, qvtiTransf, cgParams);
+
+ myQVT.dispose();
+ myQVT = new MyQVT("delphi");
+ myQVT.loadEcoreFile("Delphi.ecore", DelphiPackage.eINSTANCE);
+ myQVT.loadEcoreFile("astm.ecore", AstmPackage.eINSTANCE);
+ // Execute CGed transformation
+ myQVT.executeModelsTX_CG(txClass, createDelphiModelNames_CG("untClAux"));
+ myQVT.executeModelsTX_CG(txClass, createDelphiModelNames_CG("untClFormatos"));
+ myQVT.executeModelsTX_CG(txClass, createDelphiModelNames_CG("untClArchivo"));
+ myQVT.dispose();
+ }
+
/*
protected static void assertValidModel(@NonNull URI asURI) {
EnvironmentFactory factory = OCL.createEnvironmentFactory(new StandaloneProjectMap());
@@ -859,5 +885,7 @@ public class OCL2QVTiTestCases extends LoadTestCase {
protected static @NonNull TestModels createCompaniesModelNames_CG(String modelName) {
return new TestModels(modelName, ".101", ".output_CG.xmi", ".output_ref.xmi");
}
-
+ protected static @NonNull TestModels createDelphiModelNames_CG(String modelName) {
+ return new TestModels(modelName, ".delphi", ".output_CG.xmi", ".output_ref.xmi");
+ }
}
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/.gitignore b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/.gitignore
new file mode 100644
index 000000000..119f2cfea
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/.gitignore
@@ -0,0 +1,3 @@
+/graphs/
+/temp/
+/Delphi.qvtp.qvtcas
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/.gitignore b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/.gitignore
new file mode 100644
index 000000000..e782bc693
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/.gitignore
@@ -0,0 +1 @@
+/*.output_CG.xmi
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.delphi b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.delphi
new file mode 100644
index 000000000..feed44965
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.delphi
@@ -0,0 +1,263 @@
+unit untClArchivo;
+
+interface
+
+uses
+ shellapi, windows, forms, controls, dbclient;
+const
+ FILWORD = 1;
+ FILEXCEL = 2;
+
+type
+ TArchivo = class
+ ruta : string;
+ nombre : string;
+ Descri : string;
+ Proyecto : string;
+ modulo : string;
+ tarea : string;
+ usuario : string;
+ f_creacion : string;
+ class procedure nuevoWord;
+ class procedure EjercutarProg(Ejecutable, Argumentos:string; Visibilidad:integer);
+ class function RutaReal(const idruta:integer):string;
+ class procedure SelecFicheroRutaRelativa (var idruta,nombre:string);
+ class function PathRutaRelativa (const idruta:string):string;
+ class function RutaProyecto (const proyecto: string):string;
+ class function RutaModulo (const Proyecto,Modulo : string) : string;
+ class function RutaSubMod (const Proyecto,Modulo,Submod:string):string;
+ class function BorraArchivo (const Ruta:string):integer;overload;
+ class function BorraArchivo (const Ruta:string; Cds:TclientDataset):integer;overload;
+ class function BorraArchivoDefecto(const ruta: string; Cds: TClientDataset): integer;
+// class function RutaPorDefectoTarea(const Proyecto,Modulo,Submod:string):string;
+
+ private
+ end;
+
+implementation
+
+{ TArchivo }
+uses
+ untDmDatos, untDmCds, untFrmSelFil, SysUtils, DB, untConst,untClMensa;
+
+class procedure TArchivo.nuevoWord;
+begin
+
+end;
+
+
+//EjecutarProg('c:\kk\registro.html','',Sw_ShowNormal);
+
+class procedure TArchivo.EjercutarProg(Ejecutable, Argumentos: string;
+ Visibilidad: integer);
+ var
+ Info:TShellExecuteInfo;
+ pInfo:PShellExecuteInfo;
+//// exitCode:DWord;
+ begin
+ {Puntero a Info}
+ {Pointer to Info}
+ pInfo:=@Info;
+ {Rellenamos Info}
+ {Fill info}
+ with Info do
+ begin
+ cbSize:=SizeOf(Info);
+ fMask:=SEE_MASK_NOCLOSEPROCESS;
+ wnd := Application.Handle;//a�adido application.
+ lpVerb:=nil;
+ lpFile:=PChar(Ejecutable);
+ {Parametros al ejecutable}
+ {Executable parameters}
+ lpParameters:=Pchar(Argumentos+#0);
+ lpDirectory:=nil;
+ nShow:=Visibilidad;
+ hInstApp:=0;
+ end;
+ {Ejecutamos}
+ {Execute}
+ ShellExecuteEx(pInfo);
+
+ {Esperamos que termine}
+ {Wait to finish}
+{ repeat
+ exitCode := WaitForSingleObject(Info.hProcess,500);
+ Application.ProcessMessages;
+ until (exitCode <> WAIT_TIMEOUT);
+}
+ end;
+class function TArchivo.RutaReal(const idruta: integer): string;
+begin
+ result := dmDatos.RutaDoc(idruta);
+end;
+
+class procedure TArchivo.SelecFicheroRutaRelativa(var idruta,
+ nombre: string);
+var
+ f : TFrmSelFil;
+begin
+ f := TFrmSelFil.Create(nil);
+ try
+ if f.ShowModal = mrOk then
+ begin
+ idruta := f.ruta;
+ nombre := f.fichero;
+ end;
+ finally
+ f.Free;
+ end;
+end;
+
+class function TArchivo.PathRutaRelativa(const idruta: string): string;
+begin
+ with dmcds.cdstarea do
+ begin
+ close;
+ commandtext := 'SELECT SRUTA FROM FSRUTAS ' +
+ ' WHERE IDRUTA = ' + idruta;
+ open;
+ if not IsEmpty then
+ result := Fields[0].AsString;
+// else
+// result := PathDefectoProyecto(proyecto);
+ close;
+ end;
+end;
+
+class function TArchivo.RutaModulo(const Proyecto, Modulo: string): string;
+begin
+ with dmcds.cdsRuta do
+ begin
+ close;
+ CommandText := 'SELECT IDRUTA FROM FSMODULO ' +
+ ' WHERE IDPROJEC = ' + QuotedStr(proyecto) +
+ ' AND IDMODULO = ' + QuotedStr(modulo);
+ open;
+ if not IsEmpty then
+ result := Fields[0].AsString;
+ close;
+ end;
+end;
+
+class function TArchivo.RutaProyecto(const proyecto: string): string;
+begin
+ with dmcds.cdsRuta do
+ begin
+ close;
+ CommandText := 'SELECT IDRUTA FROM FSPROJEC ' +
+ ' WHERE IDPROJEC = ' + QuotedStr(proyecto);
+ open;
+ if not IsEmpty then
+ result := Fields[0].AsString;
+ close;
+ end;
+end;
+
+class function TArchivo.RutaSubMod(const Proyecto, Modulo,
+ Submod: string): string;
+begin
+ with dmcds.cdsRuta do
+ begin
+ close;
+ CommandText := 'SELECT IDRUTA FROM FSSUBMOD ' +
+ ' WHERE IDPROJEC = ' + QuotedStr(proyecto) +
+ ' AND IDMODULO = ' + QuotedStr(modulo) +
+ ' AND IDSUBMOD = ' + QuotedStr(Submod);
+ open;
+ if not IsEmpty then
+ result := Fields[0].AsString;
+ close;
+ end;
+end;
+
+
+
+class function TArchivo.BorraArchivo(const Ruta: string): integer;
+begin
+ if not FileExists(Ruta) then
+ result := 1
+ else if RenameFile(ruta,ruta + 'borrado') then
+ begin
+ if deleteFile(ruta + 'borrado') then
+ result := 0
+ else
+ result := 3 // error al borrar;
+ end
+ else
+ result := 2; //bloqueado
+ if result = 3 then
+ if not RenameFile(ruta + 'borrado',ruta) then
+ result := 4; // se ha cambiado el nombre;
+end;
+
+class function TArchivo.BorraArchivo(const Ruta: string;
+ Cds: TclientDataset): integer;
+var
+ res : integer;
+begin
+ if cds <> nil then
+ begin
+ if not cds.IsEmpty then
+ begin
+ if cds.State = dsBrowse then
+ begin
+ try
+ cds.Delete;
+ res := BorraArchivo(ruta);
+ if ( res = 0 ) or ( res = 1 ) then
+ begin
+ if cds.ApplyUpdates(0) = 0 then
+ result := 0
+ else
+ result := 5; //cuidado, se ha borrado el fichero y no el registro;
+ end
+ else
+ result := res;
+
+ except
+ result := 6; // error controlado
+ end;
+ end
+ else
+ result := 9
+ end
+ else
+ result := 8
+
+ end
+ else
+ result := 7;
+end;
+
+class function TArchivo.BorraArchivoDefecto(const ruta: string;
+ Cds: TClientDataset): integer;
+begin
+
+ result := BorraArchivo(ruta,cds);
+ if result = 0 then
+ exit
+ else
+ begin
+ if result = 5 then
+ TMensa.Info ('Se ha borrado el archivo en disco duro pero no el registro en base de datos')
+ else if result = 6 then
+ TMensa.Info('Ha ocurrido un error inesperado')
+ else if result = 2 then
+ TMensa.Info('El archivo est� bloqueado, no puede borrarse')
+ else if result = 3 then
+ TMensa.Info('Ha ocurrido un error inesperado borrando el archivo del disco duro')
+ else if result = 4 then
+ TMensa.Info('Ha ocurrido un error borrando el archivo este ha sido renombrado con sufijo "borrado"')
+ else if result = 7 then
+ TMensa.Info('Recibido Dataset nulo')
+ else if result = 8 then
+ TMensa.Info('Dataset Vacio')
+ else if result = 9 then
+ TMensa.Info('Dataset en estado no valido')
+ else
+ TMensa.Info('Error no controlado');
+ end;
+
+end;
+
+end.
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.output_ref.xmi b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.output_ref.xmi
new file mode 100644
index 000000000..80b0d03c9
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClArchivo.output_ref.xmi
@@ -0,0 +1,1242 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.delphi b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.delphi
new file mode 100644
index 000000000..4587584ed
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.delphi
@@ -0,0 +1,81 @@
+unit untClAux;
+
+interface
+
+uses
+ Menus, Windows, SysUtils, Variants, Graphics, Forms, StdCtrls, ExtCtrls, Controls,
+ StrUtils, ShlObj, UpdaterClass, untClMensa;
+
+type
+ TEstado = class
+ codigo,
+ descripcion,
+ tipoestado : string;
+ item : TMenuItem;
+ end;
+
+ versTipo = array [0..3] of Integer;
+
+ function ObtenerAppVersion(Rut: String): versTipo;
+ procedure ActualizaApli(Formu: TForm; Modo,Escenario: Integer);
+var
+ frmPost:array of TForm;
+ ActualizacionesPendientes: Boolean;
+
+implementation
+
+function ObtenerAppVersion(Rut: String): versTipo;
+var
+ Size, Size2: DWord;
+ Pt, Pt2: Pointer;
+ vers: versTipo;
+
+begin
+ Size := GetFileVersionInfoSize(PChar(Rut), Size2);
+ if Size > 0 then
+ begin
+ GetMem (Pt, Size);
+ try
+ GetFileVersionInfo (PChar (Rut), 0, Size, Pt);
+ VerQueryValue (Pt, '\', Pt2, Size2);
+ with TVSFixedFileInfo (Pt2^) do
+ begin
+ vers[0] := HiWord (dwFileVersionMS);
+ vers[1] := LoWord (dwFileVersionMS);
+ vers[2] := HiWord (dwFileVersionLS);
+ vers[3] := LoWord (dwFileVersionLS);
+ end;
+ finally
+ FreeMem (Pt);
+ result := vers;
+ end;
+ end;
+end;
+
+procedure ActualizaApli(Formu: TForm; Modo,Escenario: Integer);
+var
+ Act: TUpdater;
+ i:Integer;
+begin
+
+ if modo >0 then
+ begin
+ if not TMensa.Pregunta(pChar('¿Desea buscar actualizaciones para el programa?'),pChar('Actualizador')) then
+ Exit;
+ end;
+
+ if length(frmPost)>0 then
+ for i:=0 to High(frmPost) do
+ if frmPost[i].Tag=0 then
+ begin
+ frmPost[i].Close;
+ Break;
+ end;
+ Act := TUpdater.Create(Formu, Modo, Escenario);
+ Act.Free;
+
+end;
+
+
+
+end.
\ No newline at end of file
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.output_ref.xmi b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.output_ref.xmi
new file mode 100644
index 000000000..679957806
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClAux.output_ref.xmi
@@ -0,0 +1,272 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.delphi b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.delphi
new file mode 100644
index 000000000..a66e10e23
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.delphi
@@ -0,0 +1,59 @@
+unit untClFormatos;
+
+interface
+
+uses
+ SysUtils, stdCtrls, untClMensa, StrUtils;
+type
+ TFecha = class
+ class function FechaSql(const fecha: string):string;overload;
+ class function FechaSql(const fecha: TDatetime):string;overload;
+ class procedure FechaEdtExit(ob: TObject);
+ end;
+
+ TNumber = class
+ class function FloatSql(const f: String): string;overload;
+ class function FloatSql(f:double):string;overload;
+ end;
+implementation
+
+{ TFecha }
+
+class function TFecha.FechaSql(const fecha: string): string;
+begin
+ result := ' DateValue(' + QuotedStr(fecha) + ')';
+end;
+
+class function TFecha.FechaSql(const fecha: TDatetime): string;
+begin
+ result := FechaSql(DateToStr(fecha));
+end;
+
+class procedure TFecha.FechaEdtExit(ob: TObject);
+var
+ ed: TEdit;
+begin
+ Assert(ob is TEdit, 'Clase de objeto no válida en el campo fecha');
+ ed := TEdit(ob);
+
+ try
+ if ed.Text <> '' then
+ StrToDate(Trim(ed.Text));
+ except
+ ed.SetFocus;
+ TMensa.Error(QuotedStr(ed.Text) + ' no es una fecha válida')
+ end;
+end;
+
+class function TNumber.FloatSql(const f: String):string;
+begin
+ Result := AnsiReplaceText(f, ',', '.');
+end;
+
+class function TNumber.FloatSql(f: double):string;
+begin
+ Result := FloatSql(FloatToStr(f));
+end;
+
+end.
+
\ No newline at end of file
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.output_ref.xmi b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.output_ref.xmi
new file mode 100644
index 000000000..a7e40ba6a
--- /dev/null
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/src/org/eclipse/qvtd/cs2as/compiler/tests/models/delphi/samples/untClFormatos.output_ref.xmi
@@ -0,0 +1,275 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/org.eclipse.qvtd.cs2as.compiler.tests/tests-gen/cg/.gitignore b/tests/org.eclipse.qvtd.cs2as.compiler.tests/tests-gen/cg/.gitignore
index e917c2b11..db56cc590 100644
--- a/tests/org.eclipse.qvtd.cs2as.compiler.tests/tests-gen/cg/.gitignore
+++ b/tests/org.eclipse.qvtd.cs2as.compiler.tests/tests-gen/cg/.gitignore
@@ -10,3 +10,4 @@
/_KiamaRewrite_qvtp_qvtcas/
/_classescs2as_qvtp_qvtcas/
/_companies_qvtp_qvtcas/
+/_Delphi_qvtp_qvtcas/
--
cgit v1.2.3