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 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 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