├── .gitignore ├── Examples ├── CurryingDemo.dpr ├── CurryingDemo.dproj ├── CurryingDemo.res ├── PCorrotina.dpr ├── PCorrotina.dproj ├── PCorrotina.dsv ├── PCorrotina.res ├── UCorrotina.dfm ├── UCorrotina.pas └── UCurryingDemo.pas ├── LICENSE ├── README.md ├── Source ├── System.Evolution.ArrowFun.pas ├── System.Evolution.Coroutine.pas ├── System.Evolution.Crypt.pas ├── System.Evolution.Currying.pas ├── System.Evolution.DotEnv.pas ├── System.Evolution.Match.pas ├── System.Evolution.Objects.pas ├── System.Evolution.Option.pas ├── System.Evolution.RegEx.pas ├── System.Evolution.ResultPair.pas ├── System.Evolution.Safetry.pas ├── System.Evolution.Std.pas ├── System.Evolution.Stream.pas ├── System.Evolution.System.pas ├── System.Evolution.Threading.pas ├── System.Evolution.Tuple.pas └── evolution4d.inc ├── Test Delphi ├── EclbrResultPair │ ├── PTestResultPair.dpr │ ├── PTestResultPair.dproj │ ├── PTestResultPair.res │ ├── UTestEvolution.ResultPair.pas │ ├── UTestResultPair.pas │ └── dunitx-results.xml └── EclbrSystem │ ├── DCC.bat │ ├── PTestCurrying.dpr │ ├── PTestCurrying.dproj │ ├── PTestCurrying.res │ ├── PTestDotEnv.dpr │ ├── PTestDotEnv.dproj │ ├── PTestDotEnv.res │ ├── PTestMatch.delphilint │ ├── PTestMatch.dpr │ ├── PTestMatch.dproj │ ├── PTestMatch.otares │ ├── PTestMatch.res │ ├── PTestMatch_Icon.ico │ ├── PTestObjectLib.res │ ├── PTestObjects.dpr │ ├── PTestObjects.dproj │ ├── PTestObjects.res │ ├── PTestOption.dpr │ ├── PTestOption.dproj │ ├── PTestOption.res │ ├── PTestSafeTry.dpr │ ├── PTestSafeTry.dproj │ ├── PTestSafeTry.res │ ├── PTestStd.dpr │ ├── PTestStd.dproj │ ├── PTestStd.res │ ├── PTestStream.dpr │ ├── PTestStream.dproj │ ├── PTestStream.res │ ├── PTestSysDictionary.res │ ├── PTestSysDirectory.res │ ├── PTestSysIfTuple.res │ ├── PTestSysMatch.res │ ├── PTestSysStream.res │ ├── PTestSysTuple.res │ ├── PTestThreading.dpr │ ├── PTestThreading.dproj │ ├── PTestThreading.res │ ├── PTestTuple.dpr │ ├── PTestTuple.dproj │ ├── PTestTuple.res │ ├── PTestUtils.res │ ├── PTestUtilsLib.res │ ├── TestEvolution4DGroup.groupproj │ ├── TestInsightSettings.ini │ ├── UTestEcl.Dictionary.pas │ ├── UTestEcl.Directory.pas │ ├── UTestEcl.List.pas │ ├── UTestEcl.Map.pas │ ├── UTestEcl.Str.pas │ ├── UTestEcl.Vector.pas │ ├── UTestEclbr.IfThen.pas │ ├── UTestEvolution.Currying.pas │ ├── UTestEvolution.DotEnv.pas │ ├── UTestEvolution.Match.pas │ ├── UTestEvolution.Muttle.pas │ ├── UTestEvolution.Option.pas │ ├── UTestEvolution.SafeTry.pas │ ├── UTestEvolution.Std.pas │ ├── UTestEvolution.StreamReader.pas │ ├── UTestEvolution.Threading.pas │ ├── UTestEvolution.Tuple.pas │ ├── UTestEvolutoin.Objects.pas │ ├── Win32 │ └── Debug │ │ └── dunitx-results.xml │ ├── dunitx-results.xml │ └── libFastMM_FullDebugMode.dylib ├── boss-lock.json └── boss.json /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Default Delphi compiler directories 30 | # Content of this directories are generated with each Compile/Construct of a project. 31 | # Most of the time, files here have not there place in a code repository. 32 | #Win32/ 33 | #Win64/ 34 | #OSX64/ 35 | #OSXARM64/ 36 | #Android/ 37 | #Android64/ 38 | #iOSDevice64/ 39 | #Linux64/ 40 | 41 | # Delphi compiler-generated binaries (safe to delete) 42 | *.exe 43 | *.dll 44 | *.bpl 45 | *.bpi 46 | *.dcp 47 | *.so 48 | *.apk 49 | *.drc 50 | *.map 51 | *.dres 52 | *.rsm 53 | *.tds 54 | *.dcu 55 | *.lib 56 | *.a 57 | *.o 58 | *.ocx 59 | 60 | # Delphi autogenerated files (duplicated info) 61 | *.cfg 62 | *.hpp 63 | *Resource.rc 64 | 65 | # Delphi local files (user-specific info) 66 | *.local 67 | *.identcache 68 | *.projdata 69 | *.tvsconfig 70 | *.dsk 71 | 72 | # Delphi history and backups 73 | __history/ 74 | __recovery/ 75 | *.~* 76 | 77 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 78 | *.stat 79 | 80 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 81 | modules/ 82 | -------------------------------------------------------------------------------- /Examples/CurryingDemo.dpr: -------------------------------------------------------------------------------- 1 | program CurryingDemo; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | SysUtils, 9 | UCurryingDemo in 'UCurryingDemo.pas', 10 | System.Evolution.Currying in '..\Source\System.Evolution.Currying.pas'; 11 | 12 | begin 13 | try 14 | Writeln('=== Demonstracao do TCurrying ==='); 15 | Writeln(''); 16 | 17 | ExampleOpByte; 18 | ExampleOpShortInt; 19 | ExampleOpWord; 20 | ExampleOpSmallInt; 21 | ExampleOpLongWord; 22 | ExampleOpInt64; 23 | ExampleOpSingle; 24 | ExampleOpDouble; 25 | ExampleOpInteger; 26 | ExampleOpExtended; 27 | ExampleOpBoolean; 28 | ExampleOpDateTime; 29 | ExampleOpString; 30 | ExampleOpCurrency; 31 | 32 | Writeln(''); 33 | Writeln('=== Fim da Demonstracao ==='); 34 | Writeln('Pressione Enter para sair...'); 35 | Readln; 36 | except 37 | on E: Exception do 38 | begin 39 | Writeln('Erro: ' + E.Message); 40 | Writeln('Pressione Enter para sair...'); 41 | Readln; 42 | end; 43 | end; 44 | end. 45 | 46 | -------------------------------------------------------------------------------- /Examples/CurryingDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Examples/CurryingDemo.res -------------------------------------------------------------------------------- /Examples/PCorrotina.dpr: -------------------------------------------------------------------------------- 1 | program PCorrotina; 2 | 3 | uses 4 | FastMM4, 5 | Vcl.Forms, 6 | UCorrotina in 'UCorrotina.pas' {Form2}, 7 | System.Evolution.Coroutine in '..\Source\System.Evolution.Coroutine.pas', 8 | System.Evolution.Std in '..\Source\System.Evolution.Std.pas', 9 | System.Evolution.System in '..\Source\System.Evolution.System.pas', 10 | System.Evolution.Threading in '..\Source\System.Evolution.Threading.pas'; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | ReportMemoryLeaksOnShutdown := True; 16 | 17 | Application.Initialize; 18 | Application.MainFormOnTaskbar := True; 19 | Application.CreateForm(TForm2, Form2); 20 | Application.Run; 21 | end. 22 | -------------------------------------------------------------------------------- /Examples/PCorrotina.dsv: -------------------------------------------------------------------------------- 1 | [ClosedView_RDpcUFJPSkVUT1MtQnJhc2lsXEVDTEJyXFNvdXJjZVxlY2xici5jb3JvdXRpbmUucGFz] 2 | Module=D:\PROJETOS-Brasil\ECLBr\Source\eclbr.coroutine.pas 3 | CursorX=10 4 | CursorY=382 5 | TopLine=379 6 | LeftCol=1 7 | Elisions= 8 | Bookmarks={1,276,1}{2,305,1} 9 | EditViewName=D:\PROJETOS-Brasil\ECLBr\Source\eclbr.coroutine.pas 10 | 11 | [ClosedView_RDpcUFJPSkVUT1MtQnJhc2lsXEVDTEJyXEV4YW1wbGVzXFVDb3Jyb3RpbmEucGFz] 12 | Module=D:\PROJETOS-Brasil\ECLBr\Examples\UCorrotina.pas 13 | CursorX=28 14 | CursorY=210 15 | TopLine=187 16 | LeftCol=1 17 | Elisions= 18 | Bookmarks= 19 | EditViewName=D:\PROJETOS-Brasil\ECLBr\Examples\UCorrotina.pas 20 | 21 | [ClosedView_RDpcUFJPSkVUT1MtQnJhc2lsXEVDTEJyXEV4YW1wbGVzXFBDb3Jyb3RpbmEuZHBy] 22 | Module=D:\PROJETOS-Brasil\ECLBr\Examples\PCorrotina.dpr 23 | CursorX=1 24 | CursorY=14 25 | TopLine=1 26 | LeftCol=1 27 | Elisions= 28 | Bookmarks= 29 | EditViewName=D:\PROJETOS-Brasil\ECLBr\Examples\PCorrotina.dpr 30 | [ClosedView_YzpccHJvZ3JhbSBmaWxlcyAoeDg2KVxlbWJhcmNhZGVyb1xzdHVkaW9cMjMuMFxzb3VyY2VccnRs 31 | XGNvbW1vblxTeXN0ZW0uUnR0aS5wYXM=] 32 | Module=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 33 | CursorX=1 34 | CursorY=2685 35 | TopLine=2673 36 | LeftCol=1 37 | Elisions= 38 | Bookmarks= 39 | EditViewName=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 40 | [ClosedView_YzpccHJvZ3JhbSBmaWxlcyAoeDg2KVxlbWJhcmNhZGVyb1xzdHVkaW9cMjMuMFxzb3VyY2VccnRs 41 | XGNvbW1vblxTeXN0ZW0uUnR0aS5wYXM=] 42 | Module=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 43 | CursorX=1 44 | CursorY=2685 45 | TopLine=2673 46 | LeftCol=1 47 | Elisions= 48 | Bookmarks= 49 | EditViewName=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 50 | 51 | [ClosedView_RDpcUFJPSkVUT1MtQnJhc2lsXEVDTEJyXFNvdXJjZVxlY2xici50aHJlYWRpbmcucGFz] 52 | Module=D:\PROJETOS-Brasil\ECLBr\Source\eclbr.threading.pas 53 | CursorX=15 54 | CursorY=75 55 | TopLine=67 56 | LeftCol=1 57 | Elisions= 58 | Bookmarks= 59 | EditViewName=D:\PROJETOS-Brasil\ECLBr\Source\eclbr.threading.pas 60 | [ClosedView_YzpccHJvZ3JhbSBmaWxlcyAoeDg2KVxlbWJhcmNhZGVyb1xzdHVkaW9cMjMuMFxzb3VyY2VccnRs 61 | XGNvbW1vblxTeXN0ZW0uUnR0aS5wYXM=] 62 | Module=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 63 | CursorX=1 64 | CursorY=2685 65 | TopLine=2673 66 | LeftCol=1 67 | Elisions= 68 | Bookmarks= 69 | EditViewName=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 70 | [ClosedView_YzpccHJvZ3JhbSBmaWxlcyAoeDg2KVxlbWJhcmNhZGVyb1xzdHVkaW9cMjMuMFxTT1VSQ0VcUlRM 71 | XFNZU1xTeXN0ZW0ucGFz] 72 | Module=c:\program files (x86)\embarcadero\studio\23.0\SOURCE\RTL\SYS\System.pas 73 | CursorX=1 74 | CursorY=26251 75 | TopLine=26239 76 | LeftCol=1 77 | Elisions= 78 | Bookmarks= 79 | EditViewName= 80 | [ClosedView_YzpccHJvZ3JhbSBmaWxlcyAoeDg2KVxlbWJhcmNhZGVyb1xzdHVkaW9cMjMuMFxzb3VyY2VccnRs 81 | XGNvbW1vblxTeXN0ZW0uUnR0aS5wYXM=] 82 | Module=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 83 | CursorX=1 84 | CursorY=2685 85 | TopLine=2673 86 | LeftCol=1 87 | Elisions= 88 | Bookmarks= 89 | EditViewName=c:\program files (x86)\embarcadero\studio\23.0\source\rtl\common\System.Rtti.pas 90 | 91 | [ClosedView_RDpcUFJPSkVUT1MtQnJhc2lsXEVDTEJyXFNvdXJjZVxlY2xici5zdGQucGFz] 92 | Module=D:\PROJETOS-Brasil\ECLBr\Source\eclbr.std.pas 93 | CursorX=14 94 | CursorY=82 95 | TopLine=67 96 | LeftCol=1 97 | Elisions= 98 | Bookmarks= 99 | EditViewName=D:\PROJETOS-Brasil\ECLBr\Source\eclbr.std.pas 100 | 101 | -------------------------------------------------------------------------------- /Examples/PCorrotina.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Examples/PCorrotina.res -------------------------------------------------------------------------------- /Examples/UCorrotina.dfm: -------------------------------------------------------------------------------- 1 | object Form2: TForm2 2 | Left = 0 3 | Top = 0 4 | Caption = 'Simulando Coroutines em Delphi' 5 | ClientHeight = 625 6 | ClientWidth = 863 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnCloseQuery = FormCloseQuery 14 | DesignSize = ( 15 | 863 16 | 625) 17 | TextHeight = 15 18 | object LBL: TLabel 19 | Left = 365 20 | Top = 188 21 | Width = 133 22 | Height = 99 23 | Alignment = taCenter 24 | AutoSize = False 25 | Font.Charset = DEFAULT_CHARSET 26 | Font.Color = clRed 27 | Font.Height = -80 28 | Font.Name = 'Segoe UI' 29 | Font.Style = [] 30 | ParentFont = False 31 | Layout = tlCenter 32 | end 33 | object Label1: TLabel 34 | Left = 8 35 | Top = 2 36 | Width = 116 37 | Height = 31 38 | Caption = 'Contador()' 39 | Font.Charset = DEFAULT_CHARSET 40 | Font.Color = clWindowText 41 | Font.Height = -23 42 | Font.Name = 'Segoe UI' 43 | Font.Style = [fsBold] 44 | ParentFont = False 45 | end 46 | object Label2: TLabel 47 | Left = 504 48 | Top = 2 49 | Width = 240 50 | Height = 31 51 | Caption = 'Contador_Regressivo()' 52 | Font.Charset = DEFAULT_CHARSET 53 | Font.Color = clWindowText 54 | Font.Height = -23 55 | Font.Name = 'Segoe UI' 56 | Font.Style = [fsBold] 57 | ParentFont = False 58 | end 59 | object Label3: TLabel 60 | Left = 8 61 | Top = 494 62 | Width = 155 63 | Height = 31 64 | Caption = 'Message/Error' 65 | Font.Charset = DEFAULT_CHARSET 66 | Font.Color = clWindowText 67 | Font.Height = -23 68 | Font.Name = 'Segoe UI' 69 | Font.Style = [fsBold] 70 | ParentFont = False 71 | end 72 | object Memo1: TMemo 73 | Left = 8 74 | Top = 34 75 | Width = 351 76 | Height = 460 77 | Alignment = taCenter 78 | Font.Charset = DEFAULT_CHARSET 79 | Font.Color = clWindowText 80 | Font.Height = -20 81 | Font.Name = 'Segoe UI' 82 | Font.Style = [] 83 | ParentFont = False 84 | TabOrder = 0 85 | end 86 | object Memo2: TMemo 87 | Left = 504 88 | Top = 34 89 | Width = 351 90 | Height = 460 91 | Alignment = taCenter 92 | Font.Charset = DEFAULT_CHARSET 93 | Font.Color = clWindowText 94 | Font.Height = -20 95 | Font.Name = 'Segoe UI' 96 | Font.Style = [] 97 | ParentFont = False 98 | TabOrder = 1 99 | end 100 | object BtnCoRoutine: TButton 101 | Left = 365 102 | Top = 34 103 | Width = 133 104 | Height = 52 105 | Anchors = [akLeft, akTop, akRight] 106 | Caption = 'Coroutine' 107 | Font.Charset = DEFAULT_CHARSET 108 | Font.Color = clWindowText 109 | Font.Height = -17 110 | Font.Name = 'Segoe UI' 111 | Font.Style = [fsBold] 112 | ParentFont = False 113 | TabOrder = 2 114 | OnClick = BtnCoRoutineClick 115 | ExplicitWidth = 131 116 | end 117 | object Button1: TButton 118 | Left = 365 119 | Top = 452 120 | Width = 133 121 | Height = 42 122 | Anchors = [akLeft, akTop, akRight] 123 | Caption = 'Clear' 124 | Font.Charset = DEFAULT_CHARSET 125 | Font.Color = clWindowText 126 | Font.Height = -17 127 | Font.Name = 'Segoe UI' 128 | Font.Style = [fsBold] 129 | ParentFont = False 130 | TabOrder = 3 131 | OnClick = Button1Click 132 | ExplicitWidth = 131 133 | end 134 | object BtnAsyncAwait: TButton 135 | Left = 365 136 | Top = 293 137 | Width = 133 138 | Height = 52 139 | Anchors = [akLeft, akTop, akRight] 140 | Caption = 'Coroutine Async/Await' 141 | Font.Charset = DEFAULT_CHARSET 142 | Font.Color = clWindowText 143 | Font.Height = -17 144 | Font.Name = 'Segoe UI' 145 | Font.Style = [fsBold] 146 | ParentFont = False 147 | TabOrder = 4 148 | WordWrap = True 149 | OnClick = BtnAsyncAwaitClick 150 | ExplicitWidth = 131 151 | end 152 | object Button2: TButton 153 | Left = 365 154 | Top = 96 155 | Width = 133 156 | Height = 42 157 | Anchors = [akLeft, akTop, akRight] 158 | Caption = 'Paused' 159 | Font.Charset = DEFAULT_CHARSET 160 | Font.Color = clWindowText 161 | Font.Height = -17 162 | Font.Name = 'Segoe UI' 163 | Font.Style = [fsBold] 164 | ParentFont = False 165 | TabOrder = 5 166 | OnClick = Button2Click 167 | ExplicitWidth = 131 168 | end 169 | object Button3: TButton 170 | Left = 365 171 | Top = 144 172 | Width = 133 173 | Height = 42 174 | Anchors = [akLeft, akTop, akRight] 175 | Caption = 'Resume' 176 | Font.Charset = DEFAULT_CHARSET 177 | Font.Color = clWindowText 178 | Font.Height = -17 179 | Font.Name = 'Segoe UI' 180 | Font.Style = [fsBold] 181 | ParentFont = False 182 | TabOrder = 6 183 | OnClick = Button3Click 184 | ExplicitWidth = 131 185 | end 186 | object Button4: TButton 187 | Left = 365 188 | Top = 352 189 | Width = 133 190 | Height = 42 191 | Anchors = [akLeft, akTop, akRight] 192 | Caption = 'Paused (Yield)' 193 | Font.Charset = DEFAULT_CHARSET 194 | Font.Color = clWindowText 195 | Font.Height = -17 196 | Font.Name = 'Segoe UI' 197 | Font.Style = [fsBold] 198 | ParentFont = False 199 | TabOrder = 7 200 | OnClick = Button4Click 201 | ExplicitWidth = 131 202 | end 203 | object Button5: TButton 204 | Left = 365 205 | Top = 401 206 | Width = 133 207 | Height = 42 208 | Anchors = [akLeft, akTop, akRight] 209 | Caption = 'Send (Value)' 210 | Font.Charset = DEFAULT_CHARSET 211 | Font.Color = clWindowText 212 | Font.Height = -17 213 | Font.Name = 'Segoe UI' 214 | Font.Style = [fsBold] 215 | ParentFont = False 216 | TabOrder = 8 217 | OnClick = Button5Click 218 | ExplicitWidth = 131 219 | end 220 | object Memo3: TMemo 221 | Left = 8 222 | Top = 528 223 | Width = 847 224 | Height = 89 225 | TabOrder = 9 226 | end 227 | end 228 | -------------------------------------------------------------------------------- /Examples/UCorrotina.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Examples/UCorrotina.pas -------------------------------------------------------------------------------- /Examples/UCurryingDemo.pas: -------------------------------------------------------------------------------- 1 | unit UCurryingDemo; 2 | 3 | interface 4 | 5 | uses 6 | Rtti, 7 | SysUtils, 8 | Generics.Collections, 9 | DateUtils, 10 | System.Evolution.Currying; 11 | 12 | procedure ExampleOpByte; 13 | procedure ExampleOpShortInt; 14 | procedure ExampleOpWord; 15 | procedure ExampleOpSmallInt; 16 | procedure ExampleOpLongWord; 17 | procedure ExampleOpInt64; 18 | procedure ExampleOpSingle; 19 | procedure ExampleOpDouble; 20 | procedure ExampleOpInteger; 21 | procedure ExampleOpExtended; 22 | procedure ExampleOpBoolean; 23 | procedure ExampleOpDateTime; 24 | procedure ExampleOpString; 25 | procedure ExampleOpCurrency; 26 | 27 | implementation 28 | 29 | procedure ExampleOpByte; 30 | var 31 | LCurrying, LResult: TCurrying; 32 | begin 33 | LCurrying := TCurrying.Create(TValue.From(100)); 34 | LResult := LCurrying.Op( 35 | function(A, B: Byte): Byte begin Result := A + B; end 36 | )(50); 37 | Writeln('Exemplo Op: 100 + 50 = ' + IntToStr(LResult.Value)); 38 | end; 39 | 40 | procedure ExampleOpShortInt; 41 | var 42 | LCurrying, LResult: TCurrying; 43 | begin 44 | LCurrying := TCurrying.Create(TValue.From(50)); 45 | LResult := LCurrying.Op( 46 | function(A, B: ShortInt): ShortInt begin Result := A + B; end 47 | )(20); 48 | Writeln('Exemplo Op: 50 + 20 = ' + IntToStr(LResult.Value)); 49 | end; 50 | 51 | procedure ExampleOpWord; 52 | var 53 | LCurrying, LResult: TCurrying; 54 | begin 55 | LCurrying := TCurrying.Create(TValue.From(1000)); 56 | LResult := LCurrying.Op( 57 | function(A, B: Word): Word begin Result := A + B; end 58 | )(500); 59 | Writeln('Exemplo Op: 1000 + 500 = ' + IntToStr(LResult.Value)); 60 | end; 61 | 62 | procedure ExampleOpSmallInt; 63 | var 64 | LCurrying, LResult: TCurrying; 65 | begin 66 | LCurrying := TCurrying.Create(TValue.From(1000)); 67 | LResult := LCurrying.Op( 68 | function(A, B: SmallInt): SmallInt begin Result := A + B; end 69 | )(500); 70 | Writeln('Exemplo Op: 1000 + 500 = ' + IntToStr(LResult.Value)); 71 | end; 72 | 73 | procedure ExampleOpLongWord; 74 | var 75 | LCurrying, LResult: TCurrying; 76 | begin 77 | LCurrying := TCurrying.Create(TValue.From(100000)); 78 | LResult := LCurrying.Op( 79 | function(A, B: LongWord): LongWord begin Result := A + B; end 80 | )(50000); 81 | Writeln('Exemplo Op: 100000 + 50000 = ' + IntToStr(LResult.Value)); 82 | end; 83 | 84 | procedure ExampleOpInt64; 85 | var 86 | LCurrying, LResult: TCurrying; 87 | begin 88 | LCurrying := TCurrying.Create(TValue.From(1000000)); 89 | LResult := LCurrying.Op( 90 | function(A, B: Int64): Int64 begin Result := A + B; end 91 | )(500000); 92 | Writeln('Exemplo Op: 1000000 + 500000 = ' + IntToStr(LResult.Value)); 93 | end; 94 | 95 | procedure ExampleOpSingle; 96 | var 97 | LCurrying, LResult: TCurrying; 98 | begin 99 | LCurrying := TCurrying.Create(TValue.From(5.5)); 100 | LResult := LCurrying.Op( 101 | function(A, B: Single): Single begin Result := A + B; end 102 | )(2.5); 103 | Writeln('Exemplo Op: 5.5 + 2.5 = ' + FloatToStr(LResult.Value)); 104 | end; 105 | 106 | procedure ExampleOpDouble; 107 | var 108 | LCurrying, LResult: TCurrying; 109 | begin 110 | LCurrying := TCurrying.Create(TValue.From(5.0)); 111 | LResult := LCurrying.Op( 112 | function(A, B: Double): Double begin Result := A + B; end 113 | )(3.0); 114 | Writeln('Exemplo Op: 5 + 3 = ' + FloatToStr(LResult.Value)); 115 | end; 116 | 117 | procedure ExampleOpInteger; 118 | var 119 | LCurrying, LResult: TCurrying; 120 | begin 121 | LCurrying := TCurrying.Create(TValue.From(5)); 122 | LResult := LCurrying.Op( 123 | function(A, B: Integer): Integer begin Result := A + B; end 124 | )(3); 125 | Writeln('Exemplo Op: 5 + 3 = ' + IntToStr(LResult.Value)); 126 | end; 127 | 128 | procedure ExampleOpExtended; 129 | var 130 | LCurrying, LResult: TCurrying; 131 | begin 132 | LCurrying := TCurrying.Create(TValue.From(5.0)); 133 | LResult := LCurrying.Op( 134 | function(A, B: Extended): Extended begin Result := A + B; end 135 | )(3.0); 136 | Writeln('Exemplo Op: 5 + 3 = ' + FloatToStr(LResult.Value)); 137 | end; 138 | 139 | procedure ExampleOpBoolean; 140 | var 141 | LCurrying, LResult: TCurrying; 142 | begin 143 | LCurrying := TCurrying.Create(TValue.From(True)); 144 | LResult := LCurrying.Op( 145 | function(A, B: Boolean): Boolean begin Result := A or B; end 146 | )(False); 147 | Writeln('Exemplo Op: True OR False = ' + BoolToStr(LResult.Value, True)); 148 | end; 149 | 150 | procedure ExampleOpDateTime; 151 | var 152 | LCurrying, LResult: TCurrying; 153 | begin 154 | LCurrying := TCurrying.Create(TValue.From(EncodeDate(2023, 1, 1))); 155 | LResult := LCurrying.Op( 156 | function(A, B: TDateTime): TDateTime begin Result := A + B; end 157 | )(5); 158 | Writeln('Exemplo Op: 01/01/2023 + 5 dias = ' + DateToStr(LResult.Value)); 159 | end; 160 | 161 | procedure ExampleOpString; 162 | var 163 | LCurrying, LResult: TCurrying; 164 | begin 165 | LCurrying := TCurrying.Create(TValue.From('Hello')); 166 | LResult := LCurrying.Op( 167 | function(A, B: string): string begin Result := A + B; end 168 | )(' World'); 169 | Writeln('Exemplo Op: Hello + World = ' + LResult.Value); 170 | end; 171 | 172 | procedure ExampleOpCurrency; 173 | var 174 | LCurrying, LResult: TCurrying; 175 | begin 176 | LCurrying := TCurrying.Create(TValue.From(100.00)); 177 | LResult := LCurrying.Op( 178 | function(A, B: Currency): Currency begin Result := A + B; end 179 | )(50.25); 180 | Writeln('Exemplo Op: 100.00 + 50.25 = ' + CurrToStr(LResult.Value)); 181 | end; 182 | 183 | end. 184 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Evolution4D: Functional Programming Toolkit for Delphi 2 | 3 | Welcome to **Evolution4D** — a solution that modernizes Delphi, bringing it on par with today’s most advanced languages like Rust, Kotlin, and Python. If you’re a Delphi developer who loves the language’s robustness but misses contemporary features such as *pattern matching*, *null safety*, *async/await*, or functional programming, Evolution4D is for you. Designed to bridge the gaps in native Delphi, this toolkit provides powerful tools that boost productivity, reduce errors, and make your code more elegant and maintainable. 4 | 5 | ## Why Evolution4D? 6 | 7 | Delphi remains a legend in desktop and enterprise development, but the programming world has evolved. Features like *Option/Maybe*, *Result/Either*, *tuples*, and *currying*—common in modern languages—are either absent or limited in native Delphi. Evolution4D changes that by offering: 8 | 9 | - **Null Safety:** With `TOption`, say goodbye to null pointer errors. Enforce safe handling of optional values, akin to Rust or Haskell. 10 | - **Typed Results:** Replace chaotic exceptions with `TResultPair`, a predictable and functional success/failure system. 11 | - **Pattern Matching:** Use `TMatch` to write expressive code and replace `if-else` chains, in the style of C# or F#. 12 | - **Simplified Asynchrony:** `TScheduler` brings the power of *async/await* to Delphi, eliminating the complexity of manual threading. 13 | - **Tuples and Destructuring:** `TTuple` and `TTuple` enable lightweight structures like `(1, 'a')`, with direct value extraction. 14 | - **Currying:** `TCurrying` introduces partial functions, such as `f(x)(y)`, in the style of Haskell or Scala. 15 | 16 | ### Compelling Advantages 17 | 18 | Why adopt Evolution4D? Because it transforms Delphi into a competitive tool for modern development without sacrificing what you already love about the language: 19 | 20 | - **Productivity:** Write less boilerplate code with simplified *lambdas*, *list comprehensions*, and *flatmaps*. 21 | - **Robustness:** Avoid common bugs with *null safety* and explicit error handling. 22 | - **Maintainability:** Functional and declarative code is easier to understand and update. 23 | - **Integration:** Evolution4D seamlessly fits into the Delphi ecosystem, preserving performance and compatibility. 24 | 25 | It’s not just a library—it’s an evolution. With Evolution4D, you take Delphi beyond its limitations, embracing the best of modern programming while retaining the essence that makes Delphi unique. Try it out and see how your next project can be faster, safer, and more elegant. 26 | -------------------------------------------------------------------------------- /Source/System.Evolution.ArrowFun.pas: -------------------------------------------------------------------------------- 1 | { 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | { 20 | @abstract(Evolution4D: Modern Delphi Development Library for Delphi) 21 | @description(Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.) 22 | @created(03 Abr 2025) 23 | @author(Isaque Pinheiro ) 24 | @Discord(https://discord.gg/T2zJC8zX) 25 | } 26 | 27 | unit System.Evolution.ArrowFun; 28 | 29 | interface 30 | 31 | uses 32 | Rtti, 33 | SysUtils, 34 | TypInfo, 35 | Generics.Collections, 36 | Evolution.Std, 37 | Evolution.System; 38 | 39 | type 40 | EArrowException = Exception; 41 | 42 | /// 43 | /// A utility record providing functional programming constructs for managing and manipulating values and variables. 44 | /// 45 | /// 46 | /// TArrow offers methods to create procedures and functions that operate on TValue instances, enabling side effects on variables 47 | /// or returning computed results. It supports both single-value and multi-value operations through arrays and tuples, with automatic 48 | /// type conversion and error handling. 49 | /// 50 | TArrow = record 51 | strict private 52 | class var FValue: TValue; // Internal storage for the last processed value 53 | 54 | /// 55 | /// Frees the internally stored TValue when the class is destroyed. 56 | /// 57 | class destructor Destroy; 58 | 59 | public 60 | /// 61 | /// Creates a procedure that sets an internal value without affecting external variables. 62 | /// 63 | /// The value to store internally. 64 | /// A procedure that assigns AValue to the internal FValue when executed. 65 | class function Fn(const AValue: TValue): TProc; overload; static; 66 | class function Fn(const AValue: string): TProc; overload; static; 67 | class function Fn(const AValue: Integer): TProc; overload; static; 68 | class function Fn(const AValue: Boolean): TProc; overload; static; 69 | class function Fn(const AValue: TObject): TProc; overload; static; 70 | class function Fn(const AVarRefs: TArray; const AValues: Tuple): TProc; overload; static; 71 | class function Fn(var AVar: T; const AValue: T): TProc; overload; static; 72 | 73 | /// 74 | /// Creates a function that sets an internal value and returns it. 75 | /// 76 | /// The value to store and return. 77 | /// A function that assigns AValue to FValue and returns it when executed. 78 | class function Result(const AValue: TValue): TFunc; overload; static; 79 | // class function Result(const AValue: string): TFunc; overload; static; 80 | // class function Result(const AValue: Integer): TFunc; overload; static; 81 | // class function Result(const AValue: Boolean): TFunc; overload; static; 82 | // class function Result(const AValue: Double): TFunc; overload; static; 83 | // class function Result(const AValue: TDateTime): TFunc; overload; static; 84 | // class function Result(const AValue: TObject): TFunc; overload; static; 85 | // class function Result(const AValue: T): TFunc; overload; static; 86 | 87 | /// 88 | /// Retrieves the last stored value as a specified type. 89 | /// 90 | /// 91 | /// Attempts to cast the internal FValue to type T. Raises EArrowException if the cast fails. 92 | /// 93 | /// The internal FValue cast to type T. 94 | class function Value: T; static; 95 | 96 | /// 97 | /// Retrieves the last stored value as a string. 98 | /// 99 | /// The internal FValue as a string. 100 | class function AsString: string; static; 101 | end; 102 | 103 | implementation 104 | 105 | { TArrow } 106 | 107 | class function TArrow.Fn(const AValue: TValue): TProc; 108 | begin 109 | Result := procedure 110 | begin 111 | FValue := AValue; 112 | end; 113 | end; 114 | 115 | class function TArrow.Result(const AValue: TValue): TFunc; 116 | begin 117 | Result := function: TValue 118 | begin 119 | FValue := AValue; 120 | Result := AValue; 121 | end; 122 | end; 123 | 124 | class function TArrow.Fn(var AVar: T; const AValue: T): TProc; 125 | var 126 | LVar: ^T; 127 | LValue: T; 128 | begin 129 | LVar := @AVar; 130 | LValue := AValue; 131 | Result := procedure(AValue: TValue) 132 | begin 133 | try 134 | FValue := nil; 135 | FValue := AValue; 136 | LVar^ := LValue; 137 | except 138 | on E: Exception do 139 | raise EArrowException.Create('Error in TArrow.Fn: ' + E.Message); 140 | end; 141 | end; 142 | end; 143 | 144 | //class function TArrow.Result(const AValue: TDateTime): TFunc; 145 | //begin 146 | // Result := function: TDateTime 147 | // begin 148 | // Result := AValue; 149 | // end; 150 | //end; 151 | 152 | //class function TArrow.Result(const AValue: string): TFunc; 153 | //begin 154 | // Result := function: string 155 | // begin 156 | // Result := AValue; 157 | // end; 158 | //end; 159 | 160 | class function TArrow.Value: T; 161 | begin 162 | try 163 | Result := FValue.AsType; 164 | except 165 | on E: Exception do 166 | raise EArrowException.Create('Error in TArrow.Value: Cannot cast value to specified type. ' + E.Message); 167 | end; 168 | end; 169 | 170 | class function TArrow.AsString: string; 171 | begin 172 | try 173 | Result := FValue.AsString; 174 | except 175 | on E: Exception do 176 | raise EArrowException.Create('Error in TArrow.AsString: Cannot cast value to string. ' + E.Message); 177 | end; 178 | end; 179 | 180 | class destructor TArrow.Destroy; 181 | begin 182 | FValue := nil; 183 | end; 184 | 185 | class function TArrow.Fn(const AVarRefs: TArray; const AValues: Tuple): TProc; 186 | var 187 | LVarRefs: TArray; 188 | begin 189 | if Length(AVarRefs) <> Length(AValues) then 190 | raise Exception.Create('Different-sized arrays in TArrow.Fn.'); 191 | 192 | LVarRefs := AVarRefs; 193 | Result := procedure(AValue: TValue) 194 | var 195 | LFor: Integer; 196 | LTypeInfo: PTypeInfo; 197 | begin 198 | try 199 | FValue := AValue; 200 | for LFor := 0 to High(LVarRefs) do 201 | begin 202 | case AValues[LFor].Kind of 203 | tkInt64: 204 | PInt64(LVarRefs[LFor])^ := AValues[LFor].AsInt64; 205 | tkInteger, tkSet: 206 | PInteger(LVarRefs[LFor])^ := AValues[LFor].AsInteger; 207 | tkFloat: 208 | PDouble(LVarRefs[LFor])^ := AValues[LFor].AsExtended; 209 | tkUString, tkLString, tkWString, tkString, tkChar, tkWChar: 210 | PUnicodeString(LVarRefs[LFor])^ := AValues[LFor].AsString; 211 | tkClass: 212 | PObject(LVarRefs[LFor])^ := AValues[LFor].AsObject; 213 | tkEnumeration: 214 | PBoolean(LVarRefs[LFor])^ := AValues[LFor].AsBoolean; 215 | tkRecord, tkVariant: 216 | PVariant(LVarRefs[LFor])^ := AValues[LFor].AsVariant; 217 | tkArray, tkDynArray: 218 | begin 219 | LTypeInfo := AValues[LFor].TypeInfo; 220 | case GetTypeData(LTypeInfo).elType2^.Kind of 221 | tkInt64: 222 | TArray(LVarRefs[LFor]) := AValues[LFor].AsType>; 223 | tkInteger, tkSet: 224 | TArray(LVarRefs[LFor]) := AValues[LFor].AsType>; 225 | tkFloat: 226 | TArray(LVarRefs[LFor]) := AValues[LFor].AsType>; 227 | tkUString, tkLString, tkWString, tkString, tkChar, tkWChar: 228 | TArray(LVarRefs[LFor]) := AValues[LFor].AsType>; 229 | tkClass: 230 | TArray(LVarRefs[LFor]) := AValues[LFor].AsType>; 231 | tkEnumeration: 232 | TArray(LVarRefs[LFor]) := AValues[LFor].AsType>; 233 | tkRecord, tkVariant: 234 | TArray(LVarRefs[LFor]) := AValues[LFor].AsType>; 235 | else 236 | raise EArrowException.Create('Unsupported array element type at index ' + IntToStr(LFor)); 237 | end; 238 | end; 239 | else 240 | raise EArrowException.Create('Unsupported type at index ' + IntToStr(LFor)); 241 | end; 242 | end; 243 | except 244 | on E: Exception do 245 | raise EArrowException.Create('Error in TArrow.Fn (array): ' + E.Message); 246 | end; 247 | end; 248 | end; 249 | 250 | class function TArrow.Fn(const AValue: TObject): TProc; 251 | begin 252 | Result := procedure 253 | begin 254 | FValue := TValue.From(AValue); 255 | end; 256 | end; 257 | 258 | class function TArrow.Fn(const AValue: Boolean): TProc; 259 | begin 260 | Result := procedure 261 | begin 262 | FValue := TValue.From(AValue); 263 | end; 264 | end; 265 | 266 | class function TArrow.Fn(const AValue: Integer): TProc; 267 | begin 268 | Result := procedure 269 | begin 270 | FValue := TValue.From(AValue); 271 | end; 272 | end; 273 | 274 | class function TArrow.Fn(const AValue: string): TProc; 275 | begin 276 | Result := procedure 277 | begin 278 | FValue := TValue.From(AValue); 279 | end; 280 | end; 281 | 282 | //class function TArrow.Result(const AValue: Integer): TFunc; 283 | //begin 284 | // Result := function: Integer 285 | // begin 286 | // Result := AValue; 287 | // end; 288 | //end; 289 | 290 | //class function TArrow.Result(const AValue: Boolean): TFunc; 291 | //begin 292 | // Result := function: Boolean 293 | // begin 294 | // Result := AValue; 295 | // end; 296 | //end; 297 | 298 | //class function TArrow.Result(const AValue: Double): TFunc; 299 | //begin 300 | // Result := function: Double 301 | // begin 302 | // Result := AValue; 303 | // end; 304 | //end; 305 | 306 | //class function TArrow.Result(const AValue: TObject): TFunc; 307 | //begin 308 | // Result := function: TObject 309 | // begin 310 | // Result := AValue; 311 | // end; 312 | //end; 313 | 314 | //class function TArrow.Result(const AValue: T): TFunc; 315 | //begin 316 | // Result := function: T 317 | // begin 318 | // Result := AValue; 319 | // end; 320 | //end; 321 | 322 | end. 323 | 324 | -------------------------------------------------------------------------------- /Source/System.Evolution.Crypt.pas: -------------------------------------------------------------------------------- 1 | { 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | { 20 | @abstract(Evolution4D: Modern Delphi Development Library for Delphi) 21 | @description(Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.) 22 | @created(03 Abr 2025) 23 | @author(Isaque Pinheiro ) 24 | @Discord(https://discord.gg/T2zJC8zX) 25 | } 26 | 27 | unit System.Evolution.Crypt; 28 | 29 | interface 30 | 31 | uses 32 | Classes, 33 | SysUtils, 34 | System.Evolution.Std; 35 | 36 | type 37 | PPacket = ^TPacket; 38 | TPacket = packed record 39 | case Integer of 40 | 0: (b0, b1, b2, b3: Byte); // As individual bytes 41 | 1: (i: Integer); // As a single integer 42 | 2: (a: array[0..3] of Byte); // As an array of bytes 43 | 3: (c: array[0..3] of AnsiChar); // As an array of AnsiChar 44 | end; 45 | 46 | TCrypt = record 47 | strict private 48 | class function _DecodePacket(AInBuf: PAnsiChar; var nChars: Integer): TPacket; static; 49 | class procedure _EncodePacket(const APacket: TPacket; NumChars: Integer; AOutBuf: PAnsiChar); static; 50 | public 51 | class function DecodeBase64(const AInput: String): TBytes; static; inline; 52 | class function EncodeBase64(const AInput: Pointer; const ASize: Integer): String; static; inline; 53 | class function EncodeString(const AInput: String): String; static; inline; 54 | class function DecodeString(const AInput: String): String; static; inline; 55 | class procedure EncodeStream(const AInput, AOutput: TStream); static; 56 | class procedure DecodeStream(const AInput, AOutput: TStream); static; 57 | class function Hash(const AValue: MarshaledAString): Cardinal; static; inline; 58 | class function MD5Simple(const AData: TDate; const ANr1, ANr2: Integer; const Akey: String): String; static; inline; 59 | end; 60 | 61 | implementation 62 | 63 | const 64 | C_BUFFERSIZE = 510; 65 | C_LINEBREAKINTERVAL = 75; 66 | 67 | C_ENCODETABLE: array[0..63] of AnsiChar = 68 | 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; 69 | 70 | C_DECODETABLE: array[#0..#127] of Integer = ( 71 | Byte('='), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 72 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 73 | 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63, 74 | 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64, 75 | 64, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 76 | 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64, 77 | 64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 78 | 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64); 79 | 80 | { TCrypt } 81 | 82 | class procedure TCrypt._EncodePacket(const APacket: TPacket; NumChars: Integer; AOutBuf: PAnsiChar); 83 | begin 84 | AOutBuf[0] := C_ENCODETABLE[APacket.a[0] shr 2]; 85 | AOutBuf[1] := C_ENCODETABLE[((APacket.a[0] shl 4) or (APacket.a[1] shr 4)) and $0000003f]; 86 | if NumChars < 2 then 87 | AOutBuf[2] := '=' 88 | else 89 | AOutBuf[2] := C_ENCODETABLE[((APacket.a[1] shl 2) or (APacket.a[2] shr 6)) and $0000003f]; 90 | if NumChars < 3 then 91 | AOutBuf[3] := '=' 92 | else 93 | AOutBuf[3] := C_ENCODETABLE[APacket.a[2] and $0000003f]; 94 | end; 95 | 96 | class function TCrypt._DecodePacket(AInBuf: PAnsiChar; var nChars: Integer): TPacket; 97 | begin 98 | Result.a[0] := (C_DECODETABLE[AInBuf[0]] shl 2) or (C_DECODETABLE[AInBuf[1]] shr 4); 99 | nChars := 1; 100 | if AInBuf[2] <> '=' then 101 | begin 102 | Inc(nChars); 103 | Result.a[1] := Byte((C_DECODETABLE[AInBuf[1]] shl 4) or (C_DECODETABLE[AInBuf[2]] shr 2)); 104 | end; 105 | if AInBuf[3] <> '=' then 106 | begin 107 | Inc(nChars); 108 | Result.a[2] := Byte((C_DECODETABLE[AInBuf[2]] shl 6) or C_DECODETABLE[AInBuf[3]]); 109 | end; 110 | end; 111 | 112 | class function TCrypt.DecodeBase64(const AInput: String): TBytes; 113 | var 114 | LInStr: TMemoryStream; 115 | LOutStr: TBytesStream; 116 | LStream: TStringStream; 117 | LSize: Integer; 118 | begin 119 | LInStr := TMemoryStream.Create; 120 | LStream := TStringStream.Create(AInput, TEncoding.ASCII); 121 | try 122 | LInStr.LoadFromStream(LStream); 123 | LOutStr := TBytesStream.Create; 124 | try 125 | DecodeStream(LInStr, LOutStr); 126 | LSize := LOutStr.Size; 127 | SetLength(Result, LSize); 128 | LOutStr.Position := 0; 129 | LOutStr.Read(Result[0], LSize); 130 | finally 131 | LOutStr.Free; 132 | end; 133 | finally 134 | LStream.Free; 135 | LInStr.Free; 136 | end; 137 | end; 138 | 139 | class function TCrypt.EncodeBase64(const AInput: Pointer; const ASize: Integer): String; 140 | var 141 | LInStream: TMemoryStream; 142 | LOutStream: TMemoryStream; 143 | begin 144 | LInStream := TMemoryStream.Create; 145 | try 146 | LInStream.WriteBuffer(AInput^, ASize); 147 | LInStream.Position := 0; 148 | LOutStream := TMemoryStream.Create; 149 | try 150 | EncodeStream(LInStream, LOutStream); 151 | SetString(Result, PAnsiChar(LOutStream.Memory), LOutStream.Size); 152 | finally 153 | LOutStream.Free; 154 | end; 155 | finally 156 | LInStream.Free; 157 | end; 158 | end; 159 | 160 | class function TCrypt.EncodeString(const AInput: String): String; 161 | var 162 | LInStr: TStringStream; 163 | LOutStr: TStringStream; 164 | begin 165 | LInStr := TStringStream.Create(AInput); 166 | try 167 | LOutStr := TStringStream.Create(''); 168 | try 169 | EncodeStream(LInStr, LOutStr); 170 | Result := LOutStr.DataString; 171 | finally 172 | LOutStr.Free; 173 | end; 174 | finally 175 | LInStr.Free; 176 | end; 177 | end; 178 | 179 | class function TCrypt.DecodeString(const AInput: String): String; 180 | var 181 | LInStr: TStringStream; 182 | LOutStr: TStringStream; 183 | begin 184 | LInStr := TStringStream.Create(AInput); 185 | try 186 | LOutStr := TStringStream.Create(''); 187 | try 188 | DecodeStream(LInStr, LOutStr); 189 | Result := LOutStr.DataString; 190 | finally 191 | LOutStr.Free; 192 | end; 193 | finally 194 | LInStr.Free; 195 | end; 196 | end; 197 | 198 | class procedure TCrypt.EncodeStream(const AInput, AOutput: TStream); 199 | var 200 | LInBuffer: array[0..C_BUFFERSIZE] of Byte; 201 | LOutBuffer: array[0..1023] of AnsiChar; 202 | LBufferPtr: PAnsiChar; 203 | LI: Integer; 204 | LJ: Integer; 205 | LBytesRead: Integer; 206 | LPacket: TPacket; 207 | 208 | procedure L_WriteLineBreak; 209 | begin 210 | LOutBuffer[0] := #$0D; 211 | LOutBuffer[1] := #$0A; 212 | LBufferPtr := @LOutBuffer[2]; 213 | end; 214 | 215 | begin 216 | LBufferPtr := @LOutBuffer[0]; 217 | repeat 218 | LBytesRead := AInput.Read(LInBuffer, SizeOf(LInBuffer)); 219 | LI := 0; 220 | while LI < LBytesRead do 221 | begin 222 | LJ := TStd.Min(3, LBytesRead - LI); 223 | FillChar(LPacket, SizeOf(LPacket), 0); 224 | Move(LInBuffer[LI], LPacket, LJ); 225 | _EncodePacket(LPacket, LJ, LBufferPtr); 226 | Inc(LI, 3); 227 | Inc(LBufferPtr, 4); 228 | if LBufferPtr - @LOutBuffer[0] > SizeOf(LOutBuffer) - C_LINEBREAKINTERVAL then 229 | begin 230 | L_WriteLineBreak; 231 | AOutput.Write(LOutBuffer, LBufferPtr - @LOutBuffer[0]); 232 | LBufferPtr := @LOutBuffer[0]; 233 | end; 234 | end; 235 | until LBytesRead = 0; 236 | if LBufferPtr <> @LOutBuffer[0] then 237 | AOutput.Write(LOutBuffer, LBufferPtr - @LOutBuffer[0]); 238 | end; 239 | 240 | class procedure TCrypt.DecodeStream(const AInput, AOutput: TStream); 241 | var 242 | LInBuf: array[0..75] of AnsiChar; 243 | LOutBuf: array[0..60] of Byte; 244 | LInBufPtr, LOutBufPtr: PAnsiChar; 245 | LI: Integer; 246 | LJ: Integer; 247 | LK: Integer; 248 | LBytesRead: Integer; 249 | LPacket: TPacket; 250 | 251 | procedure L_SkipWhite; 252 | var 253 | LC: AnsiChar; 254 | LNumRead: Integer; 255 | begin 256 | while True do 257 | begin 258 | LNumRead := AInput.Read(LC, 1); 259 | if LNumRead = 1 then 260 | begin 261 | if LC in ['0'..'9','A'..'Z','a'..'z','+','/','='] then 262 | begin 263 | AInput.Position := AInput.Position - 1; 264 | Break; 265 | end; 266 | end 267 | else 268 | Break; 269 | end; 270 | end; 271 | 272 | function L_ReadInput: Integer; 273 | var 274 | LWhiteFound: Boolean; 275 | LEndReached: Boolean; 276 | LCntRead: Integer; 277 | LIdx: Integer; 278 | LIdxEnd: Integer; 279 | begin 280 | LIdxEnd := 0; 281 | repeat 282 | LWhiteFound := False; 283 | LCntRead := AInput.Read(LInBuf[LIdxEnd], (SizeOf(LInBuf)-LIdxEnd)); 284 | LEndReached := LCntRead < (SizeOf(LInBuf)-LIdxEnd); 285 | LIdx := LIdxEnd; 286 | LIdxEnd := LCntRead + LIdxEnd; 287 | while (LIdx < LIdxEnd) do 288 | begin 289 | if not (LInBuf[LIdx] in ['0'..'9','A'..'Z','a'..'z','+','/','=']) then 290 | begin 291 | Dec(LIdxEnd); 292 | if LIdx < LIdxEnd then 293 | Move(LInBuf[LIdx+1], LInBuf[LIdx], LIdxEnd-LIdx); 294 | LWhiteFound := True; 295 | end 296 | else 297 | Inc(LIdx); 298 | end; 299 | until (not LWhiteFound) or (LEndReached); 300 | Result := LIdxEnd; 301 | end; 302 | 303 | begin 304 | repeat 305 | L_SkipWhite; 306 | LBytesRead := L_ReadInput; 307 | LInBufPtr := LInBuf; 308 | LOutBufPtr := @LOutBuf; 309 | LI := 0; 310 | while LI < LBytesRead do 311 | begin 312 | LPacket := _DecodePacket(LInBufPtr, LJ); 313 | LK := 0; 314 | while LJ > 0 do 315 | begin 316 | LOutBufPtr^ := AnsiChar(LPacket.a[LK]); 317 | Inc(LOutBufPtr); 318 | Dec(LJ); 319 | Inc(LK); 320 | end; 321 | Inc(LInBufPtr, 4); 322 | Inc(LI, 4); 323 | end; 324 | AOutput.Write(LOutBuf, LOutBufPtr - PAnsiChar(@LOutBuf)); 325 | until LBytesRead = 0; 326 | end; 327 | 328 | class function TCrypt.Hash(const AValue: MarshaledAString): Cardinal; 329 | begin 330 | Result := SysUtils.HashName(AValue); 331 | end; 332 | 333 | class function TCrypt.MD5Simple(const AData: TDate; const ANr1, ANr2: Integer; const Akey: String): String; 334 | var 335 | LData: String; 336 | LCode: String; 337 | LHash: String; 338 | LFor: Integer; 339 | begin 340 | LData := FormatDateTime('YYYYMMDD', AData); 341 | LCode := LData + IntToStr(ANr1) + IntToStr(ANr2) + Akey; 342 | LHash := ''; 343 | for LFor := 1 to Length(LCode) do 344 | LHash := LHash + IntToHex(Ord(LCode[LFor]), 2); 345 | Result := LHash; 346 | end; 347 | 348 | end. 349 | -------------------------------------------------------------------------------- /Source/System.Evolution.Safetry.pas: -------------------------------------------------------------------------------- 1 | { 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | { 20 | @abstract(Evolution4D: Modern Delphi Development Library for Delphi) 21 | @description(Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.) 22 | @created(03 Abr 2025) 23 | @author(Isaque Pinheiro ) 24 | @Discord(https://discord.gg/T2zJC8zX) 25 | } 26 | 27 | unit System.Evolution.Safetry; 28 | 29 | interface 30 | 31 | uses 32 | SysUtils, 33 | Rtti; 34 | 35 | type 36 | TSafeResult = record 37 | private 38 | FIsOk: Boolean; 39 | FValue: TValue; 40 | FException: String; 41 | procedure _Ok(const AValue: TValue); 42 | procedure _Err(const AException: String); 43 | class function _CreateOk(const AValue: TValue): TSafeResult; static; 44 | class function _CreateErr(const AException: String): TSafeResult; static; 45 | public 46 | function IsOk: Boolean; 47 | function IsErr: Boolean; 48 | function GetValue: TValue; 49 | function TryGetValue(out AValue: TValue): Boolean; 50 | function ExceptionMessage: String; 51 | function AsType: T; 52 | function IsType: Boolean; 53 | end; 54 | 55 | TSafeTry = record 56 | private 57 | FTryFunc: TFunc; 58 | FTryProc: TProc; 59 | FExcept: TProc; 60 | FFinally: TProc; 61 | function _EndExecute: TValue; 62 | public 63 | class function &Try(const AFunc: TFunc): TSafeTry; overload; static; 64 | class function &Try(const AProc: TProc = nil): TSafeTry; overload; static; 65 | function &Except(const AProc: TProc): TSafeTry; 66 | function &Finally(const AProc: TProc): TSafeTry; 67 | function &End: TSafeResult; 68 | end; 69 | 70 | function &Try(const AFunc: TFunc): TSafeTry; overload; 71 | function &Try(const AProc: TProc): TSafeTry; overload; 72 | function &Try: TSafeTry; overload; 73 | 74 | implementation 75 | 76 | { TSafeResult } 77 | 78 | procedure TSafeResult._Ok(const AValue: TValue); 79 | begin 80 | FIsOk := True; 81 | FValue := AValue; 82 | FException := ''; 83 | end; 84 | 85 | procedure TSafeResult._Err(const AException: String); 86 | begin 87 | FIsOk := False; 88 | FValue := TValue.Empty; 89 | FException := AException; 90 | end; 91 | 92 | function TSafeResult.IsOk: Boolean; 93 | begin 94 | Result := FIsOk; 95 | end; 96 | 97 | function TSafeResult.IsErr: Boolean; 98 | begin 99 | Result := not FIsOk; 100 | end; 101 | 102 | function TSafeResult.GetValue: TValue; 103 | begin 104 | if not FIsOk then 105 | raise Exception.Create('Cannot get value when result is an error.'); 106 | Result := FValue; 107 | end; 108 | 109 | function TSafeResult.TryGetValue(out AValue: TValue): Boolean; 110 | begin 111 | Result := FIsOk; 112 | if Result then 113 | AValue := FValue 114 | else 115 | AValue := TValue.Empty; 116 | end; 117 | 118 | function TSafeResult.ExceptionMessage: String; 119 | begin 120 | Result := FException; 121 | end; 122 | 123 | function TSafeResult.AsType: T; 124 | begin 125 | Result := GetValue.AsType; 126 | end; 127 | 128 | function TSafeResult.IsType: Boolean; 129 | begin 130 | Result := FIsOk and FValue.IsType(TypeInfo(T)); 131 | end; 132 | 133 | class function TSafeResult._CreateOk(const AValue: TValue): TSafeResult; 134 | begin 135 | Result._Ok(AValue); 136 | end; 137 | 138 | class function TSafeResult._CreateErr(const AException: String): TSafeResult; 139 | begin 140 | Result._Err(AException); 141 | end; 142 | 143 | { TSafeTry } 144 | 145 | class function TSafeTry.&Try(const AFunc: TFunc): TSafeTry; 146 | begin 147 | Result.FTryFunc := AFunc; 148 | Result.FTryProc := nil; 149 | Result.FExcept := nil; 150 | Result.FFinally := nil; 151 | end; 152 | 153 | class function TSafeTry.&Try(const AProc: TProc): TSafeTry; 154 | begin 155 | Result.FTryProc := AProc; 156 | Result.FTryFunc := nil; 157 | Result.FExcept := nil; 158 | Result.FFinally := nil; 159 | end; 160 | 161 | function TSafeTry.&Except(const AProc: TProc): TSafeTry; 162 | begin 163 | FExcept := AProc; 164 | Result := Self; 165 | end; 166 | 167 | function TSafeTry.&Finally(const AProc: TProc): TSafeTry; 168 | begin 169 | FFinally := AProc; 170 | Result := Self; 171 | end; 172 | 173 | function TSafeTry._EndExecute: TValue; 174 | var 175 | LExceptMessage: String; 176 | begin 177 | try 178 | try 179 | if Assigned(FTryFunc) then 180 | begin 181 | Result := FTryFunc(); 182 | if Result.IsEmpty then 183 | Result := TValue.From(True); 184 | end 185 | else if Assigned(FTryProc) then 186 | begin 187 | FTryProc(); 188 | Result := TValue.From(True); 189 | end 190 | else 191 | Result := TValue.From(True); 192 | except 193 | on E: Exception do 194 | begin 195 | LExceptMessage := E.Message; 196 | if Assigned(FExcept) then 197 | begin 198 | try 199 | FExcept(E); 200 | except 201 | on EInner: Exception do 202 | LExceptMessage := E.Message + ' (Except handler failed: ' + EInner.Message + ')'; 203 | end; 204 | end; 205 | raise Exception.Create(LExceptMessage); 206 | end; 207 | end; 208 | finally 209 | if Assigned(FFinally) then 210 | begin 211 | try 212 | FFinally(); 213 | except 214 | on E: Exception do 215 | // Ignora exceções em Finally silenciosamente 216 | // Futuro: Poderia logar se houver um mecanismo global 217 | end; 218 | end; 219 | end; 220 | end; 221 | 222 | function TSafeTry.&End: TSafeResult; 223 | var 224 | LValue: TValue; 225 | begin 226 | try 227 | LValue := _EndExecute; 228 | Result := TSafeResult._CreateOk(LValue); 229 | except 230 | on E: Exception do 231 | Result := TSafeResult._CreateErr(E.Message); 232 | end; 233 | end; 234 | 235 | { Função Auxiliar } 236 | 237 | function &Try(const AFunc: TFunc): TSafeTry; 238 | begin 239 | Result := TSafeTry.&Try(AFunc); 240 | end; 241 | 242 | function &Try(const AProc: TProc): TSafeTry; 243 | begin 244 | Result := TSafeTry.&Try(AProc); 245 | end; 246 | 247 | function &Try: TSafeTry; 248 | begin 249 | Result := TSafeTry.&Try; 250 | end; 251 | 252 | end. 253 | 254 | 255 | -------------------------------------------------------------------------------- /Source/System.Evolution.Std.pas: -------------------------------------------------------------------------------- 1 | { 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | { 20 | @abstract(Evolution4D: Modern Delphi Development Library for Delphi) 21 | @description(Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.) 22 | @created(03 Abr 2025) 23 | @author(Isaque Pinheiro ) 24 | @Discord(https://discord.gg/T2zJC8zX) 25 | } 26 | 27 | unit System.Evolution.Std; 28 | 29 | interface 30 | 31 | uses 32 | Math, 33 | Classes, 34 | Windows, 35 | SysUtils, 36 | DateUtils, 37 | Generics.Collections, 38 | Generics.Defaults, 39 | System.Evolution.System; 40 | 41 | type 42 | TPointerStream = class(TCustomMemoryStream) 43 | public 44 | constructor Create(P: Pointer; ASize: Integer); 45 | function Write(const Buffer; Count: Longint): Longint; override; 46 | end; 47 | 48 | TStd = class 49 | strict private 50 | FFormatSettings: TFormatSettings; 51 | protected 52 | class var FInstance: TStd; 53 | class var FSequenceCounter: Int64; 54 | public 55 | class function Get: TStd; static; inline; 56 | class function IfThen(AValue: Boolean; const ATrue: T; const AFalse: T): T; static; inline; 57 | class function JoinStrings(const AStrings: array of String; const ASeparator: String): String; overload; static; 58 | class function JoinStrings(const AStrings: TListString; const ASeparator: String): String; overload; static; inline; 59 | class function RemoveTrailingChars(const AStr: String; const AChars: TSysCharSet): String; static; inline; 60 | class function Iso8601ToDateTime(const AValue: String; const AUseISO8601DateFormat: Boolean): TDateTime; static; inline; 61 | class function DateTimeToIso8601(const AValue: TDateTime; const AUseISO8601DateFormat: Boolean): String; static; inline; 62 | class function Min(const A, B: Integer): Integer; overload; static; inline; 63 | class function Min(const A, B: Double): Double; overload; static; inline; 64 | class function Min(const A, B: Currency): Currency; overload; static; inline; 65 | class function Min(const A, B: Int64): Int64; overload; static; inline; 66 | class function Max(const A, B: Integer): Integer; overload; static; inline; 67 | class function Max(const A, B: Double): Double; overload; static; inline; 68 | class function Max(const A, B: Currency): Currency; overload; static; inline; 69 | class function Split(const S: String): TArray; static; inline; 70 | class function Clone(const AFirst: Pointer; ASize: Cardinal; var Return): Pointer; static; inline; 71 | class function ToCharArray(const S: String): TArray; static; inline; 72 | class procedure Fill(const AFirst: Pointer; ASize: Cardinal; const Value: T); static; inline; 73 | class function GenerateSequentialNumber: UInt64; static; inline; 74 | property FormatSettings: TFormatSettings read FFormatSettings write FFormatSettings; 75 | end; 76 | 77 | {$IFDEF DEBUG} 78 | procedure DebugPrint(const AMessage: String); 79 | {$ENDIF} 80 | 81 | implementation 82 | 83 | uses 84 | RTLConsts; 85 | 86 | {$IFDEF DEBUG} 87 | procedure DebugPrint(const AMessage: String); 88 | begin 89 | TThread.Queue(nil, 90 | procedure 91 | begin 92 | OutputDebugString(PWideChar('[ECL] - ' + FormatDateTime('mm/dd/yyyy, hh:mm:ss am/pm', Now) + ' LOG ' + AMessage)); 93 | end); 94 | end; 95 | {$ENDIF} 96 | 97 | { TStd } 98 | 99 | class function TStd.DateTimeToIso8601(const AValue: TDateTime; const AUseISO8601DateFormat: Boolean): String; 100 | var 101 | LDatePart: String; 102 | LTimePart: String; 103 | begin 104 | Result := ''; 105 | if AValue = 0 then 106 | Exit; 107 | 108 | if AUseISO8601DateFormat then 109 | LDatePart := FormatDateTime('yyyy-mm-dd', AValue) 110 | else 111 | LDatePart := DateToStr(AValue, TStd.Get.FormatSettings); 112 | 113 | if Frac(AValue) = 0 then 114 | Result := IfThen(AUseISO8601DateFormat, LDatePart, TimeToStr(AValue, TStd.Get.FormatSettings)) 115 | else 116 | begin 117 | LTimePart := FormatDateTime('hh:nn:ss', AValue); 118 | Result := IfThen(AUseISO8601DateFormat, LDatePart + 'T' + LTimePart, LDatePart + ' ' + LTimePart); 119 | end; 120 | end; 121 | 122 | class function TStd.IfThen(AValue: Boolean; const ATrue, AFalse: T): T; 123 | begin 124 | Result := AFalse; 125 | if AValue then 126 | Result := ATrue; 127 | end; 128 | 129 | class function TStd.Iso8601ToDateTime(const AValue: String; const AUseISO8601DateFormat: Boolean): TDateTime; 130 | var 131 | LYYYY: Integer; 132 | LMM: Integer; 133 | LDD: Integer; 134 | LHH: Integer; 135 | LMI: Integer; 136 | LSS: Integer; 137 | LMS: Integer; 138 | begin 139 | if not AUseISO8601DateFormat then 140 | begin 141 | Result := StrToDateTimeDef(AValue, 0); 142 | Exit; 143 | end; 144 | LYYYY := 0; LMM := 0; LDD := 0; LHH := 0; LMI := 0; LSS := 0; LMS := 0; 145 | if TryStrToInt(Copy(AValue, 1, 4), LYYYY) and 146 | TryStrToInt(Copy(AValue, 6, 2), LMM) and 147 | TryStrToInt(Copy(AValue, 9, 2), LDD) and 148 | TryStrToInt(Copy(AValue, 12, 2), LHH) and 149 | TryStrToInt(Copy(AValue, 15, 2), LMI) and 150 | TryStrToInt(Copy(AValue, 18, 2), LSS) then 151 | begin 152 | Result := EncodeDateTime(LYYYY, LMM, LDD, LHH, LMI, LSS, LMS); 153 | end 154 | else 155 | Result := 0; 156 | end; 157 | 158 | class function TStd.JoinStrings(const AStrings: TListString; const ASeparator: String): String; 159 | var 160 | LBuilder: TStringBuilder; 161 | LFor: Integer; 162 | begin 163 | LBuilder := TStringBuilder.Create; 164 | try 165 | for LFor := 0 to AStrings.Count - 1 do 166 | begin 167 | if LFor > 0 then 168 | LBuilder.Append(ASeparator); 169 | LBuilder.Append(AStrings[LFor]); 170 | end; 171 | Result := LBuilder.ToString; 172 | finally 173 | LBuilder.Free; 174 | end; 175 | end; 176 | 177 | class function TStd.Min(const A, B: Integer): Integer; 178 | begin 179 | Result := Math.Min(A, B); 180 | end; 181 | 182 | class function TStd.Min(const A, B: Double): Double; 183 | begin 184 | Result := Math.Min(A, B); 185 | end; 186 | 187 | class function TStd.Max(const A, B: Integer): Integer; 188 | begin 189 | Result := Math.Max(A, B); 190 | end; 191 | 192 | class function TStd.Max(const A, B: Double): Double; 193 | begin 194 | Result := Math.Max(A, B); 195 | end; 196 | 197 | class function TStd.Max(const A, B: Currency): Currency; 198 | begin 199 | Result := Math.Max(A, B); 200 | end; 201 | 202 | class function TStd.ToCharArray(const S: String): TArray; 203 | var 204 | LFor: Integer; 205 | begin 206 | SetLength(Result, Length(S)); 207 | for LFor := 1 to Length(S) do 208 | Result[LFor - 1] := S[LFor]; 209 | end; 210 | 211 | class function TStd.Min(const A, B: Int64): Int64; 212 | begin 213 | Result := Math.Min(A, B); 214 | end; 215 | 216 | class function TStd.Get: TStd; 217 | begin 218 | if not Assigned(FInstance) then 219 | FInstance := TStd.Create; 220 | Result := FInstance; 221 | end; 222 | 223 | class function TStd.Min(const A, B: Currency): Currency; 224 | begin 225 | Result := Math.Min(A, B); 226 | end; 227 | 228 | class function TStd.RemoveTrailingChars(const AStr: String; const AChars: TSysCharSet): String; 229 | var 230 | LLastCharIndex: Integer; 231 | begin 232 | LLastCharIndex := Length(AStr); 233 | while (LLastCharIndex > 0) and CharInSet(AStr[LLastCharIndex], AChars) do 234 | Dec(LLastCharIndex); 235 | Result := Copy(AStr, 1, LLastCharIndex); 236 | end; 237 | 238 | class function TStd.Split(const S: String): TArray; 239 | var 240 | LFor: Integer; 241 | begin 242 | SetLength(Result, Length(S)); 243 | for LFor := 1 to Length(S) do 244 | Result[LFor - 1] := S[LFor]; 245 | end; 246 | 247 | class function TStd.JoinStrings(const AStrings: array of String; const ASeparator: String): String; 248 | var 249 | LBuilder: TStringBuilder; 250 | LFor: Integer; 251 | begin 252 | LBuilder := TStringBuilder.Create; 253 | try 254 | for LFor := Low(AStrings) to High(AStrings) do 255 | begin 256 | if LFor > Low(AStrings) then 257 | LBuilder.Append(ASeparator); 258 | LBuilder.Append(AStrings[LFor]); 259 | end; 260 | Result := LBuilder.ToString; 261 | finally 262 | LBuilder.Free; 263 | end; 264 | end; 265 | 266 | class function TStd.Clone(const AFirst: Pointer; ASize: Cardinal; var Return): Pointer; 267 | var 268 | LSource: ^T; 269 | LTarget: ^T; 270 | begin 271 | if (ASize <= 0) or (AFirst = nil) then 272 | raise Exception.Create('Invalid parameters in TStd.Clone'); 273 | 274 | LSource := AFirst; 275 | LTarget := @Return; 276 | while ASize > 0 do 277 | begin 278 | LTarget^ := LSource^; 279 | Inc(PByte(LSource), sizeof(T)); 280 | Inc(PByte(LTarget), sizeof(T)); 281 | Dec(ASize); 282 | end; 283 | Result := @Return; 284 | end; 285 | 286 | class procedure TStd.Fill(const AFirst: Pointer; ASize: Cardinal; const Value: T); 287 | var 288 | LPointer: ^T; 289 | begin 290 | if (ASize <= 0) or (AFirst = nil) then 291 | raise Exception.Create('Invalid parameters in TStd.Fill'); 292 | 293 | LPointer := AFirst; 294 | repeat 295 | LPointer^ := Value; 296 | Inc(PByte(LPointer), sizeof(T)); 297 | Dec(ASize); 298 | until ASize = 0; 299 | end; 300 | 301 | class function TStd.GenerateSequentialNumber: UInt64; 302 | begin 303 | Result := InterlockedIncrement64(TStd.FSequenceCounter); 304 | end; 305 | 306 | { TPointerStream } 307 | 308 | constructor TPointerStream.Create(P: Pointer; ASize: Integer); 309 | begin 310 | SetPointer(P, ASize); 311 | end; 312 | 313 | function TPointerStream.Write(const Buffer; Count: Longint): Longint; 314 | var 315 | LPos: Longint; 316 | LEndPos: Longint; 317 | LSize: Longint; 318 | LMem: Pointer; 319 | begin 320 | LPos := Self.Position; 321 | Result := 0; 322 | if (LPos < 0) and (Count = 0) then 323 | Exit; 324 | LEndPos := LPos + Count; 325 | LSize := Self.Size; 326 | if LEndPos > LSize then 327 | raise EStreamError.Create('Out of memory while expanding memory stream'); 328 | LMem := Self.Memory; 329 | System.Move(Buffer, Pointer(Longint(LMem) + LPos)^, Count); 330 | Self.Position := LPos; 331 | Result := Count; 332 | end; 333 | 334 | initialization 335 | TStd.Get.FormatSettings := TFormatSettings.Create('en_US'); 336 | TStd.FSequenceCounter := Trunc((Now - EncodeDate(2022, 1, 1)) * 86400); 337 | 338 | finalization 339 | if Assigned(TStd.FInstance) then 340 | TStd.FInstance.Free; 341 | 342 | end. 343 | -------------------------------------------------------------------------------- /Source/System.Evolution.System.pas: -------------------------------------------------------------------------------- 1 | { 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | { 20 | @abstract(Evolution4D: Modern Delphi Development Library for Delphi) 21 | @description(Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.) 22 | @created(03 Abr 2025) 23 | @author(Isaque Pinheiro ) 24 | @Discord(https://discord.gg/T2zJC8zX) 25 | } 26 | 27 | unit System.Evolution.System; 28 | 29 | interface 30 | 31 | uses 32 | Rtti, 33 | SysUtils, 34 | Generics.Collections, 35 | Generics.Defaults; 36 | 37 | type 38 | TListString = TList; 39 | Tuple = array of TValue; 40 | 41 | IEvolutoinObserver = interface 42 | ['{5887CDFF-DA23-4466-A5CB-FBA1DFEAF907}'] 43 | procedure Update(const Progress: Integer); 44 | end; 45 | 46 | TFuture = record 47 | private 48 | FValue: TValue; 49 | FErr: String; 50 | FIsOK: Boolean; 51 | FIsErr: Boolean; 52 | public 53 | /// 54 | /// Checks if the future is in a successful state. 55 | /// 56 | /// 57 | /// True if the future is successful, otherwise False. 58 | /// 59 | function IsOk: Boolean; 60 | 61 | /// 62 | /// Checks if the future contains an error. 63 | /// 64 | /// 65 | /// True if the future contains an error, otherwise False. 66 | /// 67 | function IsErr: Boolean; 68 | 69 | /// 70 | /// Retrieves the successful value of the future. 71 | /// 72 | /// 73 | /// The value of type T. 74 | /// 75 | function Ok: T; 76 | 77 | /// 78 | /// Retrieves the error message of the future. 79 | /// 80 | /// 81 | /// The error message. 82 | /// 83 | function Err: String; 84 | 85 | /// 86 | /// Sets the future to a successful state with a value. 87 | /// 88 | /// 89 | /// The value to set. 90 | /// 91 | procedure SetOk(const AValue: TValue); 92 | 93 | /// 94 | /// Sets the future to an error state with an error message. 95 | /// 96 | /// 97 | /// The error message to set. 98 | /// 99 | procedure SetErr(const AErr: String); 100 | end; 101 | 102 | TSet = class sealed 103 | strict private 104 | FItems: TDictionary; 105 | FComparer: IEqualityComparer; 106 | function _GetCount: Integer; 107 | public 108 | /// 109 | /// Initializes a new instance of the TSet class. 110 | /// 111 | constructor Create; overload; 112 | 113 | /// 114 | /// Initializes a new instance of the TSet class with a custom comparer. 115 | /// 116 | /// 117 | /// The comparer to use for item equality. 118 | /// 119 | constructor Create(const Comparer: IEqualityComparer); overload; 120 | 121 | /// 122 | /// Destroys the TSet instance. 123 | /// 124 | destructor Destroy; override; 125 | 126 | /// 127 | /// Adds an item to the set. 128 | /// 129 | /// 130 | /// The item to add. 131 | /// 132 | /// 133 | /// True if the item was added, otherwise False. 134 | /// 135 | function Add(const Item: T): Boolean; 136 | 137 | /// 138 | /// Checks if the set contains a specific item. 139 | /// 140 | /// 141 | /// The item to check. 142 | /// 143 | /// 144 | /// True if the set contains the item, otherwise False. 145 | /// 146 | function Contains(const Item: T): Boolean; 147 | 148 | /// 149 | /// Removes an item from the set. 150 | /// 151 | /// 152 | /// The item to remove. 153 | /// 154 | /// 155 | /// True if the item was removed, otherwise False. 156 | /// 157 | function Remove(const Item: T): Boolean; 158 | 159 | /// 160 | /// Converts the set to an array. 161 | /// 162 | /// 163 | /// An array containing the items in the set. 164 | /// 165 | function ToArray: TArray; 166 | 167 | /// 168 | /// Creates a union of this set with another set. 169 | /// 170 | /// 171 | /// The other set to union with. 172 | /// 173 | /// 174 | /// A new set containing the union of both sets. 175 | /// 176 | function Union(const Other: TSet): TSet; 177 | 178 | /// 179 | /// Clears all items from the set. 180 | /// 181 | procedure Clear; 182 | 183 | /// 184 | /// Gets the number of items in the set. 185 | /// 186 | property Count: Integer read _GetCount; 187 | end; 188 | 189 | 190 | implementation 191 | 192 | { TFuture } 193 | 194 | function TFuture.Err: String; 195 | begin 196 | Result := FErr; 197 | end; 198 | 199 | function TFuture.IsErr: Boolean; 200 | begin 201 | Result := FIsErr; 202 | end; 203 | 204 | function TFuture.IsOk: Boolean; 205 | begin 206 | Result := FIsOK; 207 | end; 208 | 209 | function TFuture.Ok: T; 210 | begin 211 | if not FIsOK then 212 | raise Exception.Create('Future is not in a success state'); 213 | Result := FValue.AsType; 214 | end; 215 | 216 | procedure TFuture.SetErr(const AErr: String); 217 | begin 218 | FErr := AErr; 219 | FIsErr := True; 220 | FIsOK := False; 221 | end; 222 | 223 | procedure TFuture.SetOk(const AValue: TValue); 224 | begin 225 | FValue := AValue; 226 | FIsOK := True; 227 | FIsErr := False; 228 | end; 229 | 230 | { TSet } 231 | 232 | constructor TSet.Create; 233 | begin 234 | FComparer := TEqualityComparer.Default; 235 | FItems := TDictionary.Create(FComparer); 236 | end; 237 | 238 | constructor TSet.Create(const Comparer: IEqualityComparer); 239 | begin 240 | if Comparer = nil then 241 | FComparer := TEqualityComparer.Default 242 | else 243 | FComparer := Comparer; 244 | FItems := TDictionary.Create(FComparer); 245 | end; 246 | 247 | destructor TSet.Destroy; 248 | begin 249 | FItems.Free; 250 | inherited; 251 | end; 252 | 253 | function TSet.Add(const Item: T): Boolean; 254 | begin 255 | if not FItems.ContainsKey(Item) then 256 | begin 257 | FItems.Add(Item, True); 258 | Result := True; 259 | end 260 | else 261 | Result := False; 262 | end; 263 | 264 | function TSet.Contains(const Item: T): Boolean; 265 | begin 266 | Result := FItems.ContainsKey(Item); 267 | end; 268 | 269 | function TSet.Remove(const Item: T): Boolean; 270 | begin 271 | Result := FItems.ContainsKey(Item); 272 | if Result then 273 | FItems.Remove(Item); 274 | end; 275 | 276 | procedure TSet.Clear; 277 | begin 278 | FItems.Clear; 279 | end; 280 | 281 | function TSet.ToArray: TArray; 282 | begin 283 | Result := FItems.Keys.ToArray; 284 | end; 285 | 286 | function TSet._GetCount: Integer; 287 | begin 288 | Result := FItems.Count; 289 | end; 290 | 291 | function TSet.Union(const Other: TSet): TSet; 292 | var 293 | LItem: T; 294 | begin 295 | Result := TSet.Create(FComparer); 296 | for LItem in FItems.Keys do 297 | Result.Add(LItem); 298 | for LItem in Other.FItems.Keys do 299 | Result.Add(LItem); 300 | end; 301 | 302 | end. 303 | -------------------------------------------------------------------------------- /Source/System.Evolution.Threading.pas: -------------------------------------------------------------------------------- 1 | { 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | { 20 | @abstract(Evolution4D: Modern Delphi Development Library for Delphi) 21 | @description(Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.) 22 | @created(03 Abr 2025) 23 | @author(Isaque Pinheiro ) 24 | @Discord(https://discord.gg/T2zJC8zX) 25 | } 26 | 27 | {$T+} 28 | 29 | unit System.Evolution.Threading; 30 | 31 | interface 32 | 33 | uses 34 | Rtti, 35 | SysUtils, 36 | Classes, 37 | SyncObjs, 38 | Threading, 39 | System.Evolution.System; 40 | 41 | type 42 | TValue = Rtti.TValue; 43 | TFuture = System.Evolution.System.TFuture; 44 | EAsyncAwait = Exception; 45 | 46 | IAutoLock = interface 47 | ['{1857DCF0-4B4C-491B-A546-CB82B199E2E1}'] 48 | procedure Acquire; 49 | procedure Release; 50 | end; 51 | 52 | TAutoLock = class(TInterfacedObject, IAutoLock) 53 | private 54 | FCriticalSection: TCriticalSection; 55 | public 56 | constructor Create; 57 | destructor Destroy; override; 58 | procedure Acquire; inline; 59 | procedure Release; inline; 60 | end; 61 | 62 | PAsync = ^TAsync; 63 | TAsync = record 64 | strict private 65 | FTask: ITask; 66 | FProc: TProc; 67 | FFunc: TFunc; 68 | FError: TFunc; 69 | FLock: IAutoLock; 70 | 71 | function _AwaitProc(const AContinue: TProc; const ATimeout: Cardinal): TFuture; overload; 72 | function _AwaitFunc(const AContinue: TProc; const ATimeout: Cardinal): TFuture; overload; 73 | function _AwaitProc(const ATimeout: Cardinal): TFuture; overload; 74 | function _AwaitFunc(const ATimeout: Cardinal): TFuture; overload; 75 | function _ExecProc: TFuture; 76 | private 77 | constructor Create(const AProc: TProc); overload; 78 | constructor Create(const AFunc: TFunc); overload; 79 | public 80 | function Await(const AContinue: TProc; const ATimeout: Cardinal = INFINITE): TFuture; overload; inline; 81 | function Await(const ATimeout: Cardinal = INFINITE): TFuture; overload; inline; 82 | function Run: TFuture; overload; 83 | function Run(const AError: TFunc): TFuture; overload; inline; 84 | function NoAwait: TFuture; overload; 85 | function NoAwait(const AError: TFunc): TFuture; overload; inline; 86 | function Status: TTaskStatus; inline; 87 | function GetId: Integer; inline; 88 | procedure Cancel; inline; 89 | procedure CheckCanceled; inline; 90 | end; 91 | 92 | function Async(const AProc: TProc): TAsync; overload; inline; 93 | function Async(const AFunc: TFunc): TAsync; overload; inline; 94 | 95 | implementation 96 | 97 | function Async(const AProc: TProc): TAsync; 98 | var 99 | LAsync: TAsync; 100 | begin 101 | LAsync := TAsync.Create(AProc); 102 | Result := LAsync; 103 | end; 104 | 105 | function Async(const AFunc: TFunc): TAsync; 106 | begin 107 | Result := TAsync.Create(AFunc); 108 | end; 109 | 110 | function TAsync.Await(const AContinue: TProc; const ATimeout: Cardinal): TFuture; 111 | begin 112 | if Assigned(FProc) then 113 | Result := _AwaitProc(AContinue, ATimeout) 114 | else 115 | if Assigned(FFunc) then 116 | Result := _AwaitFunc(AContinue, ATimeout) 117 | end; 118 | 119 | constructor TAsync.Create(const AProc: TProc); 120 | begin 121 | FLock := TAutoLock.Create; 122 | FTask := nil; 123 | FProc := AProc; 124 | FFunc := nil; 125 | end; 126 | 127 | function TAsync.Await(const ATimeout: Cardinal): TFuture; 128 | begin 129 | if Assigned(FProc) then 130 | Result := _AwaitProc(ATimeout) 131 | else 132 | if Assigned(FFunc) then 133 | Result := _AwaitFunc(ATimeout) 134 | end; 135 | 136 | procedure TAsync.Cancel; 137 | begin 138 | FLock.Acquire; 139 | try 140 | if Assigned(FTask) then 141 | FTask.Cancel; 142 | finally 143 | FLock.Release; 144 | end; 145 | end; 146 | 147 | procedure TAsync.CheckCanceled; 148 | begin 149 | FLock.Acquire; 150 | try 151 | if Assigned(FTask) then 152 | FTask.CheckCanceled; 153 | finally 154 | FLock.Release; 155 | end; 156 | end; 157 | 158 | constructor TAsync.Create(const AFunc: TFunc); 159 | begin 160 | FLock := TAutoLock.Create; 161 | FTask := nil; 162 | FProc := nil; 163 | FFunc := AFunc; 164 | end; 165 | 166 | function TAsync.Run: TFuture; 167 | begin 168 | if Assigned(FProc) then 169 | Result := _ExecProc 170 | else 171 | if Assigned(FFunc) then 172 | Result.SetErr('The "Run" method should not be invoked as a function. Utilize the "Await" method to wait for task completion and access the result, or invoke it as a procedure.'); 173 | end; 174 | 175 | function TAsync.GetId: Integer; 176 | begin 177 | FLock.Acquire; 178 | try 179 | if Assigned(FTask) then 180 | Result := FTask.GetId 181 | else 182 | Result := -1; 183 | finally 184 | FLock.Release; 185 | end; 186 | end; 187 | 188 | function TAsync.NoAwait(const AError: TFunc): TFuture; 189 | begin 190 | Result := Run(AError); 191 | end; 192 | 193 | function TAsync.NoAwait: TFuture; 194 | begin 195 | Result := Run; 196 | end; 197 | 198 | function TAsync.Run(const AError: TFunc): TFuture; 199 | begin 200 | FError := AError; 201 | Result := Self.Run; 202 | end; 203 | 204 | function TAsync.Status: TTaskStatus; 205 | begin 206 | FLock.Acquire; 207 | try 208 | if Assigned(FTask) then 209 | Result := FTask.Status 210 | else 211 | Result := TTaskStatus.Created; 212 | finally 213 | FLock.Release; 214 | end; 215 | end; 216 | 217 | function TAsync._AwaitProc(const AContinue: TProc; const ATimeout: Cardinal): TFuture; 218 | var 219 | LSelf: PAsync; 220 | LMessage: String; 221 | begin 222 | LSelf := @Self; 223 | FLock.Acquire; 224 | try 225 | try 226 | FTask := TTask.Run(procedure 227 | begin 228 | try 229 | LSelf^.FProc(); 230 | except 231 | on E: Exception do 232 | LMessage := E.Message; 233 | end; 234 | end); 235 | FTask.Wait(ATimeout); 236 | if LMessage <> '' then 237 | raise EAsyncAwait.Create(LMessage); 238 | 239 | if Assigned(AContinue) then 240 | TThread.Queue(TThread.CurrentThread, 241 | procedure 242 | begin 243 | try 244 | AContinue(); 245 | except 246 | on E: Exception do 247 | LMessage := E.Message; 248 | end; 249 | end); 250 | if LMessage <> '' then 251 | raise EAsyncAwait.Create(LMessage); 252 | 253 | Result.SetOk(True); 254 | except 255 | on E: Exception do 256 | Result.SetErr(E.Message); 257 | end; 258 | finally 259 | FLock.Release; 260 | end; 261 | end; 262 | 263 | function TAsync._ExecProc: TFuture; 264 | var 265 | LProc: TProc; 266 | LError: TFunc; 267 | begin 268 | LProc := FProc; 269 | LError := FError; 270 | FLock.Acquire; 271 | try 272 | try 273 | FTask := TTask.Run(procedure 274 | var 275 | LMessage: String; 276 | begin 277 | try 278 | LProc(); 279 | except 280 | on E: Exception do 281 | begin 282 | LMessage := E.Message; 283 | if Assigned(LError) then 284 | TThread.Queue(TThread.CurrentThread, 285 | procedure 286 | begin 287 | LError(Exception.Create(LMessage)); 288 | end); 289 | end; 290 | end; 291 | end); 292 | Result.SetOk(True); 293 | except 294 | on E: Exception do 295 | Result.SetErr(E.Message); 296 | end; 297 | finally 298 | FLock.Release; 299 | end; 300 | end; 301 | 302 | function TAsync._AwaitFunc(const AContinue: TProc; const ATimeout: Cardinal): TFuture; 303 | var 304 | LValue: TValue; 305 | LSelf: PAsync; 306 | LMessage: String; 307 | begin 308 | LSelf := @Self; 309 | FLock.Acquire; 310 | try 311 | try 312 | FTask := TTask.Run(procedure 313 | begin 314 | try 315 | LValue := LSelf^.FFunc(); 316 | except 317 | on E: Exception do 318 | LMessage := E.Message; 319 | end; 320 | end); 321 | FTask.Wait(ATimeout); 322 | if LMessage <> '' then 323 | raise EAsyncAwait.Create(LMessage); 324 | 325 | if Assigned(AContinue) then 326 | TThread.Queue(TThread.CurrentThread, 327 | procedure 328 | begin 329 | try 330 | AContinue(); 331 | except 332 | on E: Exception do 333 | LMessage := E.Message; 334 | end; 335 | end); 336 | if LMessage <> '' then 337 | raise EAsyncAwait.Create(LMessage); 338 | 339 | Result.SetOk(LValue); 340 | except 341 | on E: Exception do 342 | Result.SetErr(E.Message); 343 | end; 344 | finally 345 | FLock.Release; 346 | end; 347 | end; 348 | 349 | function TAsync._AwaitFunc(const ATimeout: Cardinal): TFuture; 350 | var 351 | LValue: TValue; 352 | LSelf: PAsync; 353 | LMessage: String; 354 | begin 355 | LSelf := @Self; 356 | FLock.Acquire; 357 | try 358 | try 359 | FTask := TTask.Run(procedure 360 | begin 361 | try 362 | LValue := LSelf^.FFunc(); 363 | except 364 | on E: Exception do 365 | LMessage := E.Message; 366 | end; 367 | end); 368 | FTask.Wait(ATimeout); 369 | if LMessage <> '' then 370 | raise EAsyncAwait.Create(LMessage); 371 | 372 | Result.SetOk(LValue); 373 | except 374 | on E: Exception do 375 | Result.SetErr(E.Message); 376 | end; 377 | finally 378 | FLock.Release; 379 | end; 380 | end; 381 | 382 | function TAsync._AwaitProc(const ATimeout: Cardinal): TFuture; 383 | var 384 | LSelf: PAsync; 385 | LMessage: String; 386 | begin 387 | LSelf := @Self; 388 | FLock.Acquire; 389 | try 390 | try 391 | FTask := TTask.Run(procedure 392 | begin 393 | try 394 | LSelf^.FProc(); 395 | except 396 | on E: Exception do 397 | LMessage := E.Message; 398 | end; 399 | end); 400 | FTask.Wait(ATimeout); 401 | if LMessage <> '' then 402 | raise EAsyncAwait.Create(LMessage); 403 | 404 | Result.SetOk(True); 405 | except 406 | on E: Exception do 407 | Result.SetErr(E.Message); 408 | end; 409 | finally 410 | FLock.Release; 411 | end; 412 | end; 413 | 414 | { TCriticalSectionHelper } 415 | 416 | procedure TAutoLock.Acquire; 417 | begin 418 | FCriticalSection.Acquire; 419 | end; 420 | 421 | constructor TAutoLock.Create; 422 | begin 423 | inherited Create; 424 | FCriticalSection := TCriticalSection.Create; 425 | end; 426 | 427 | destructor TAutoLock.Destroy; 428 | begin 429 | FCriticalSection.Free; 430 | inherited; 431 | end; 432 | 433 | procedure TAutoLock.Release; 434 | begin 435 | FCriticalSection.Release; 436 | end; 437 | 438 | end. 439 | -------------------------------------------------------------------------------- /Source/System.Evolution.Tuple.pas: -------------------------------------------------------------------------------- 1 | { 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | Licensed under the Apache License, Version 2.0 (the "License"); 7 | you may not use this file except in compliance with the License. 8 | You may obtain a copy of the License at 9 | 10 | http://www.apache.org/licenses/LICENSE-2.0 11 | 12 | Unless required by applicable law or agreed to in writing, software 13 | distributed under the License is distributed on an "AS IS" BASIS, 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | See the License for the specific language governing permissions and 16 | limitations under the License. 17 | } 18 | 19 | { 20 | @abstract(Evolution4D: Modern Delphi Development Library for Delphi) 21 | @description(Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.) 22 | @created(03 Abr 2025) 23 | @author(Isaque Pinheiro ) 24 | @Discord(https://discord.gg/T2zJC8zX) 25 | } 26 | 27 | unit System.Evolution.Tuple; 28 | 29 | interface 30 | 31 | uses 32 | Rtti, 33 | TypInfo, 34 | SysUtils, 35 | Generics.Collections, 36 | Generics.Defaults; 37 | 38 | type 39 | ITupleDict = interface 40 | ['{73CD7882-7D2C-4842-A828-96CD6ECF417C}'] 41 | function GetDict: TDictionary; 42 | function Count: Integer; 43 | function GetItem(const AKey: K): TValue; 44 | function TryGetValue(const AKey: K; out AValue: TValue): Boolean; 45 | end; 46 | 47 | TTupleDict = class(TInterfacedObject, ITupleDict) 48 | private 49 | FTupleDict: TDictionary; 50 | public 51 | constructor Create(const ATuples: TArray>); 52 | destructor Destroy; override; 53 | function GetDict: TDictionary; 54 | function Count: Integer; 55 | function GetItem(const AKey: K): TValue; 56 | function TryGetValue(const AKey: K; out AValue: TValue): Boolean; 57 | end; 58 | 59 | TTuple = record 60 | strict private 61 | FTupleDict: ITupleDict; 62 | constructor Create(const ATuples: TArray>); 63 | function GetItem(const AKey: K): TValue; 64 | public 65 | class operator Implicit(const P: TTuple): TArray>; inline; 66 | class operator Implicit(const P: TArray>): TTuple; inline; 67 | class operator Equal(const Left, Right: TTuple): Boolean; inline; 68 | class operator NotEqual(const Left, Right: TTuple): Boolean; inline; 69 | class function New(const AKeys: TArray; 70 | const AValues: TArray): TTuple; static; inline; 71 | function Get(const AKey: K): T; inline; 72 | function TryGet(const AKey: K; out AValue: T): Boolean; inline; 73 | function Count: Integer; inline; 74 | function SetTuple(const AKeys: TArray; const AValues: TArray): TTuple; inline; 75 | property Items[const Key: K]: TValue read GetItem; default; 76 | end; 77 | 78 | TValueArray = array of TValue; 79 | 80 | PTuple = ^TTuple; 81 | TTuple = record 82 | strict private 83 | FTuples: TValueArray; 84 | constructor Create(const Args: TValueArray); 85 | function GetItem(const AIndex: Integer): TValue; 86 | public 87 | class operator Implicit(const Args: TTuple): TValueArray; 88 | class operator Implicit(const Args: array of Variant): TTuple; 89 | class operator Implicit(const Args: TValueArray): TTuple; 90 | class operator Equal(const Left, Right: TTuple): Boolean; inline; 91 | class operator NotEqual(const Left, Right: TTuple): Boolean; inline; 92 | class function New(const AValues: TValueArray): TTuple; static; inline; 93 | function Get(const AIndex: Integer): T; inline; 94 | function Count: Integer; inline; 95 | procedure Dest(const AVarRefs: TArray); 96 | property Items[const Key: Integer]: TValue read GetItem; default; 97 | end; 98 | 99 | TTupluString = TTuple; 100 | TTupluInteger = TTuple; 101 | TTupluInt16 = TTuple; 102 | TTupluInt32 = TTuple; 103 | TTupluInt64 = TTuple; 104 | TTupluDouble = TTuple; 105 | TTupluCurrency = TTuple; 106 | TTupluSingle = TTuple; 107 | TTupluDate = TTuple; 108 | TTupluTime = TTuple; 109 | TTupluDateTime = TTuple; 110 | TTupluChar = TTuple; 111 | TTupluVariant = TTuple; 112 | 113 | implementation 114 | 115 | { TTupleDict } 116 | 117 | constructor TTupleDict.Create(const ATuples: TArray>); 118 | var 119 | LFor: Integer; 120 | begin 121 | FTupleDict := TDictionary.Create; 122 | for LFor := 0 to High(ATuples) do 123 | FTupleDict.Add(ATuples[LFor].Key, ATuples[LFor].Value); 124 | end; 125 | 126 | destructor TTupleDict.Destroy; 127 | begin 128 | FTupleDict.Free; 129 | inherited; 130 | end; 131 | 132 | function TTupleDict.GetDict: TDictionary; 133 | begin 134 | Result := FTupleDict; 135 | end; 136 | 137 | function TTupleDict.Count: Integer; 138 | begin 139 | Result := FTupleDict.Count; 140 | end; 141 | 142 | function TTupleDict.GetItem(const AKey: K): TValue; 143 | begin 144 | Result := FTupleDict[AKey]; 145 | end; 146 | 147 | function TTupleDict.TryGetValue(const AKey: K; out AValue: TValue): Boolean; 148 | begin 149 | Result := FTupleDict.TryGetValue(AKey, AValue); 150 | end; 151 | 152 | { TTuple } 153 | 154 | function TTuple.Count: Integer; 155 | begin 156 | Result := FTupleDict.Count; 157 | end; 158 | 159 | constructor TTuple.Create(const ATuples: TArray>); 160 | begin 161 | FTupleDict := TTupleDict.Create(ATuples); 162 | end; 163 | 164 | class operator TTuple.Equal(const Left, Right: TTuple): Boolean; 165 | var 166 | LComp1: IEqualityComparer; 167 | LComp2: IEqualityComparer; 168 | LPair: TPair; 169 | begin 170 | Result := False; 171 | if Left.FTupleDict.Count <> Right.FTupleDict.Count then 172 | Exit; 173 | LComp1 := TEqualityComparer.Default; 174 | LComp2 := TEqualityComparer.Default; 175 | for LPair in Left.FTupleDict.GetDict do 176 | begin 177 | if not Right.FTupleDict.GetDict.ContainsKey(LPair.Key) then 178 | Exit; 179 | if not LComp2.Equals(LPair.Value, Right.FTupleDict.GetDict[LPair.Key]) then 180 | Exit; 181 | end; 182 | Result := True; 183 | end; 184 | 185 | function TTuple.SetTuple(const AKeys: TArray; 186 | const AValues: TArray): TTuple; 187 | begin 188 | Result := TTuple.New(AKeys, AValues); 189 | end; 190 | 191 | function TTuple.Get(const AKey: K): T; 192 | begin 193 | Result := FTupleDict.GetItem(AKey).AsType; 194 | end; 195 | 196 | function TTuple.TryGet(const AKey: K; out AValue: T): Boolean; 197 | var 198 | LValue: TValue; 199 | begin 200 | Result := FTupleDict.TryGetValue(AKey, LValue); 201 | if Result then 202 | AValue := LValue.AsType 203 | else 204 | AValue := Default(T); 205 | end; 206 | 207 | function TTuple.GetItem(const AKey: K): TValue; 208 | begin 209 | Result := FTupleDict.GetItem(AKey); 210 | end; 211 | 212 | class operator TTuple.Implicit(const P: TArray>): TTuple; 213 | begin 214 | Result := TTuple.Create(P); 215 | end; 216 | 217 | class operator TTuple.Implicit(const P: TTuple): TArray>; 218 | var 219 | LPair: TPair; 220 | LFor: Integer; 221 | begin 222 | SetLength(Result, P.FTupleDict.Count); 223 | LFor := 0; 224 | for LPair in P.FTupleDict.GetDict do 225 | begin 226 | Result[LFor] := LPair; 227 | Inc(LFor); 228 | end; 229 | end; 230 | 231 | class function TTuple.New(const AKeys: TArray; 232 | const AValues: TArray): TTuple; 233 | var 234 | LPairs: TArray>; 235 | LFor: Integer; 236 | begin 237 | if Length(AKeys) <> Length(AValues) then 238 | raise Exception.Create('Number of keys and values must match'); 239 | 240 | SetLength(LPairs, Length(AKeys)); 241 | for LFor := 0 to High(AKeys) do 242 | LPairs[LFor] := TPair.Create(AKeys[LFor], AValues[LFor]); 243 | Result := TTuple.Create(LPairs); 244 | end; 245 | 246 | class operator TTuple.NotEqual(const Left, Right: TTuple): Boolean; 247 | begin 248 | Result := not (Left = Right); 249 | end; 250 | 251 | { TTuple } 252 | 253 | function TTuple.Count: Integer; 254 | begin 255 | Result := Length(FTuples); 256 | end; 257 | 258 | constructor TTuple.Create(const Args: TValueArray); 259 | var 260 | LFor: Integer; 261 | begin 262 | SetLength(FTuples, Length(Args)); 263 | for LFor := Low(Args) to High(Args) do 264 | FTuples[LFor] := Args[LFor]; 265 | end; 266 | 267 | class operator TTuple.Equal(const Left, Right: TTuple): Boolean; 268 | var 269 | LFor: Integer; 270 | begin 271 | Result := False; 272 | if Length(Left.FTuples) <> Length(Right.FTuples) then 273 | Exit; 274 | for LFor := 0 to High(Left.FTuples) do 275 | begin 276 | if Left.FTuples[LFor].Kind <> Right.FTuples[LFor].Kind then 277 | Exit; 278 | if Left.FTuples[LFor].ToString <> Right.FTuples[LFor].ToString then 279 | Exit; 280 | end; 281 | Result := True; 282 | end; 283 | 284 | function TTuple.Get(const AIndex: Integer): T; 285 | begin 286 | Result := FTuples[AIndex].AsType; 287 | end; 288 | 289 | function TTuple.GetItem(const AIndex: Integer): TValue; 290 | begin 291 | Result := FTuples[AIndex]; 292 | end; 293 | 294 | procedure TTuple.Dest(const AVarRefs: TArray); 295 | var 296 | LFor: Integer; 297 | LTypeInfo: PTypeInfo; 298 | begin 299 | if Length(AVarRefs) <> Length(FTuples) then 300 | raise Exception.Create('Number of pointers (' + IntToStr(Length(AVarRefs)) + 301 | ') must match tuple length (' + IntToStr(Length(FTuples)) + ')'); 302 | 303 | for LFor := Low(AVarRefs) to High(AVarRefs) do 304 | begin 305 | case FTuples[LFor].Kind of 306 | tkInt64: 307 | PInt64(AVarRefs[LFor])^ := FTuples[LFor].AsInt64; 308 | tkInteger, tkSet: 309 | PInteger(AVarRefs[LFor])^ := FTuples[LFor].AsInteger; 310 | tkFloat: 311 | PDouble(AVarRefs[LFor])^ := FTuples[LFor].AsExtended; 312 | tkUString, tkLString, tkWString, tkString, tkChar, tkWChar: 313 | PUnicodeString(AVarRefs[LFor])^ := FTuples[LFor].AsString; 314 | tkClass: 315 | PObject(AVarRefs[LFor])^ := FTuples[LFor].AsObject; 316 | tkEnumeration: 317 | PBoolean(AVarRefs[LFor])^ := FTuples[LFor].AsBoolean; 318 | tkRecord, tkVariant: 319 | PVariant(AVarRefs[LFor])^ := FTuples[LFor].AsVariant; 320 | tkArray, tkDynArray: 321 | begin 322 | LTypeInfo := FTuples[LFor].TypeInfo; 323 | case GetTypeData(LTypeInfo).elType2^.Kind of 324 | tkInt64: 325 | TArray(AVarRefs[LFor]) := FTuples[LFor].AsType>; 326 | tkInteger, tkSet: 327 | TArray(AVarRefs[LFor]) := FTuples[LFor].AsType>; 328 | tkFloat: 329 | TArray(AVarRefs[LFor]) := FTuples[LFor].AsType>; 330 | tkUString, tkLString, tkWString, tkString, tkChar, tkWChar: 331 | TArray(AVarRefs[LFor]) := FTuples[LFor].AsType>; 332 | tkClass: 333 | TArray(AVarRefs[LFor]) := FTuples[LFor].AsType>; 334 | tkEnumeration: 335 | TArray(AVarRefs[LFor]) := FTuples[LFor].AsType>; 336 | tkRecord, tkVariant: 337 | TArray(AVarRefs[LFor]) := FTuples[LFor].AsType>; 338 | else 339 | raise Exception.Create('Unsupported array element type at index ' + IntToStr(LFor)); 340 | end; 341 | end; 342 | else 343 | raise Exception.Create('Unsupported type at index ' + IntToStr(LFor)); 344 | end; 345 | end; 346 | end; 347 | 348 | class operator TTuple.Implicit(const Args: TTuple): TValueArray; 349 | begin 350 | Result := Args.FTuples; 351 | end; 352 | 353 | class operator TTuple.Implicit(const Args: array of Variant): TTuple; 354 | var 355 | LFor: Integer; 356 | begin 357 | SetLength(Result.FTuples, Length(Args)); 358 | for LFor := Low(Args) to High(Args) do 359 | Result.FTuples[LFor] := TValue.FromVariant(Args[LFor]); 360 | end; 361 | 362 | class operator TTuple.Implicit(const Args: TValueArray): TTuple; 363 | begin 364 | Result := TTuple.Create(Args); 365 | end; 366 | 367 | class function TTuple.New(const AValues: TValueArray): TTuple; 368 | begin 369 | Result := TTuple.Create(AValues); 370 | end; 371 | 372 | class operator TTuple.NotEqual(const Left, Right: TTuple): Boolean; 373 | begin 374 | Result := not (Left = Right); 375 | end; 376 | 377 | end. 378 | 379 | -------------------------------------------------------------------------------- /Source/evolution4d.inc: -------------------------------------------------------------------------------- 1 | { 2 | ECL Brasil - Essential Core Library para quem utiliza Delphi 3 | 4 | Copyright (c) 2016, Isaque Pinheiro 5 | All rights reserved. 6 | 7 | GNU Lesser General Public License 8 | Versão 3, 29 de junho de 2007 9 | 10 | Copyright (C) 2007 Free Software Foundation, Inc. 11 | A todos é permitido copiar e distribuir cópias deste documento de 12 | licença, mas mudá-lo não é permitido. 13 | 14 | Esta versão da GNU Lesser General Public License incorpora 15 | os termos e condições da versão 3 da GNU General Public License 16 | Licença, complementado pelas permissões adicionais listadas no 17 | arquivo LICENSE na pasta principal. 18 | } 19 | 20 | { 21 | @abstract(ECLBr Library) 22 | @created(23 Abr 2023) 23 | @author(Isaque Pinheiro ) 24 | } 25 | 26 | { 27 | Compiler CompilerVersion Defined Symbol Used BPL 28 | Delphi 12 ?? 36 VER360 29 29 | Delphi 11.1 Alexandria 35 VER350 28 30 | Delphi 10.4 Sidney 34 VER340 27 31 | Delphi 10.3 Rio 33 VER330 26 32 | Delphi 10.2 Tokyo 32 VER320 25 33 | Delphi 10.1 Berlin 31 VER310 24 34 | Delphi 10 Seattle 30 VER300 23 35 | Delphi XE8 29 VER290 22 36 | Delphi XE7 28 VER280 21 37 | Delphi XE6 27 VER270 20 38 | Delphi XE5 26 VER260 19 39 | Delphi XE4 25 VER250 18 40 | Delphi XE3 24 VER240 17 41 | Delphi XE2 23 VER230 16 42 | Delphi XE 22 VER220 15 43 | Delphi 2010 21 VER210 14 44 | } 45 | 46 | {.$DEFINE FMX} 47 | {.$DEFINE LOAD_DYNAMICALLY} 48 | 49 | {$IFDEF FMX} 50 | {$DEFINE HAS_FMX} 51 | {$ELSE} 52 | {$DEFINE HAS_VCL} 53 | {$ENDIF} 54 | 55 | // Delphi ??? 56 | {$IFDEF VER360} 57 | {$DEFINE DELPHI14_UP} 58 | {$DEFINE DELPHI15_UP} 59 | {$DEFINE DELPHI16_UP} 60 | {$DEFINE DELPHI17_UP} 61 | {$DEFINE DELPHI18_UP} 62 | {$DEFINE DELPHI19_UP} 63 | {$DEFINE DELPHI20_UP} 64 | {$DEFINE DELPHI21_UP} 65 | {$DEFINE DELPHI22_UP} 66 | {$DEFINE DELPHI23_UP} 67 | {$DEFINE DELPHI24_UP} 68 | {$DEFINE DELPHI25_UP} 69 | {$DEFINE DELPHI26_UP} 70 | {$DEFINE DELPHI27_UP} 71 | {$DEFINE DELPHI28_UP} 72 | {$DEFINE DELPHI29_UP} 73 | {$ENDIF} 74 | 75 | // Delphi Alexandria 76 | {$IFDEF VER350} 77 | {$DEFINE DELPHI14_UP} 78 | {$DEFINE DELPHI15_UP} 79 | {$DEFINE DELPHI16_UP} 80 | {$DEFINE DELPHI17_UP} 81 | {$DEFINE DELPHI18_UP} 82 | {$DEFINE DELPHI19_UP} 83 | {$DEFINE DELPHI20_UP} 84 | {$DEFINE DELPHI21_UP} 85 | {$DEFINE DELPHI22_UP} 86 | {$DEFINE DELPHI23_UP} 87 | {$DEFINE DELPHI24_UP} 88 | {$DEFINE DELPHI25_UP} 89 | {$DEFINE DELPHI26_UP} 90 | {$DEFINE DELPHI27_UP} 91 | {$DEFINE DELPHI28_UP} 92 | {$ENDIF} 93 | 94 | // Delphi Sidney 95 | {$IFDEF VER340} 96 | {$DEFINE DELPHI14_UP} 97 | {$DEFINE DELPHI15_UP} 98 | {$DEFINE DELPHI16_UP} 99 | {$DEFINE DELPHI17_UP} 100 | {$DEFINE DELPHI18_UP} 101 | {$DEFINE DELPHI19_UP} 102 | {$DEFINE DELPHI20_UP} 103 | {$DEFINE DELPHI21_UP} 104 | {$DEFINE DELPHI22_UP} 105 | {$DEFINE DELPHI23_UP} 106 | {$DEFINE DELPHI24_UP} 107 | {$DEFINE DELPHI25_UP} 108 | {$DEFINE DELPHI26_UP} 109 | {$DEFINE DELPHI27_UP} 110 | {$ENDIF} 111 | 112 | // Delphi Rio 113 | {$IFDEF VER330} 114 | {$DEFINE DELPHI14_UP} 115 | {$DEFINE DELPHI15_UP} 116 | {$DEFINE DELPHI16_UP} 117 | {$DEFINE DELPHI17_UP} 118 | {$DEFINE DELPHI18_UP} 119 | {$DEFINE DELPHI19_UP} 120 | {$DEFINE DELPHI20_UP} 121 | {$DEFINE DELPHI21_UP} 122 | {$DEFINE DELPHI22_UP} 123 | {$DEFINE DELPHI23_UP} 124 | {$DEFINE DELPHI24_UP} 125 | {$DEFINE DELPHI25_UP} 126 | {$DEFINE DELPHI26_UP} 127 | {$ENDIF} 128 | 129 | // Delphi Tokyo 130 | {$IFDEF VER320} 131 | {$DEFINE DELPHI14_UP} 132 | {$DEFINE DELPHI15_UP} 133 | {$DEFINE DELPHI16_UP} 134 | {$DEFINE DELPHI17_UP} 135 | {$DEFINE DELPHI18_UP} 136 | {$DEFINE DELPHI19_UP} 137 | {$DEFINE DELPHI20_UP} 138 | {$DEFINE DELPHI21_UP} 139 | {$DEFINE DELPHI22_UP} 140 | {$DEFINE DELPHI23_UP} 141 | {$DEFINE DELPHI24_UP} 142 | {$DEFINE DELPHI25_UP} 143 | {$ENDIF} 144 | 145 | // Delphi BERLIN 146 | {$IFDEF VER310} 147 | {$DEFINE DELPHI14_UP} 148 | {$DEFINE DELPHI15_UP} 149 | {$DEFINE DELPHI16_UP} 150 | {$DEFINE DELPHI17_UP} 151 | {$DEFINE DELPHI18_UP} 152 | {$DEFINE DELPHI19_UP} 153 | {$DEFINE DELPHI20_UP} 154 | {$DEFINE DELPHI21_UP} 155 | {$DEFINE DELPHI22_UP} 156 | {$DEFINE DELPHI23_UP} 157 | {$DEFINE DELPHI24_UP} 158 | {$ENDIF} 159 | 160 | // Delphi SEATLLE 161 | {$IFDEF VER300} 162 | {$DEFINE DELPHI14_UP} 163 | {$DEFINE DELPHI15_UP} 164 | {$DEFINE DELPHI16_UP} 165 | {$DEFINE DELPHI17_UP} 166 | {$DEFINE DELPHI18_UP} 167 | {$DEFINE DELPHI19_UP} 168 | {$DEFINE DELPHI20_UP} 169 | {$DEFINE DELPHI21_UP} 170 | {$DEFINE DELPHI22_UP} 171 | {$DEFINE DELPHI23_UP} 172 | {$ENDIF} 173 | 174 | // Delphi XE8 175 | {$IFDEF VER290} 176 | {$DEFINE DELPHI14_UP} 177 | {$DEFINE DELPHI15_UP} 178 | {$DEFINE DELPHI16_UP} 179 | {$DEFINE DELPHI17_UP} 180 | {$DEFINE DELPHI18_UP} 181 | {$DEFINE DELPHI19_UP} 182 | {$DEFINE DELPHI20_UP} 183 | {$DEFINE DELPHI21_UP} 184 | {$DEFINE DELPHI22_UP} 185 | {$ENDIF} 186 | 187 | // Delphi XE7 188 | {$IFDEF VER280} 189 | {$DEFINE DELPHI14_UP} 190 | {$DEFINE DELPHI15_UP} 191 | {$DEFINE DELPHI16_UP} 192 | {$DEFINE DELPHI17_UP} 193 | {$DEFINE DELPHI18_UP} 194 | {$DEFINE DELPHI19_UP} 195 | {$DEFINE DELPHI20_UP} 196 | {$DEFINE DELPHI21_UP} 197 | {$ENDIF} 198 | 199 | // Delphi XE6 200 | {$IFDEF VER270} 201 | {$DEFINE DELPHI14_UP} 202 | {$DEFINE DELPHI15_UP} 203 | {$DEFINE DELPHI16_UP} 204 | {$DEFINE DELPHI17_UP} 205 | {$DEFINE DELPHI18_UP} 206 | {$DEFINE DELPHI19_UP} 207 | {$DEFINE DELPHI20_UP} 208 | {$ENDIF} 209 | 210 | // Delphi XE5 211 | {$IFDEF VER260} 212 | {$DEFINE DELPHI14_UP} 213 | {$DEFINE DELPHI15_UP} 214 | {$DEFINE DELPHI16_UP} 215 | {$DEFINE DELPHI17_UP} 216 | {$DEFINE DELPHI18_UP} 217 | {$DEFINE DELPHI19_UP} 218 | {$ENDIF} 219 | 220 | // Delphi XE4 221 | {$IFDEF VER250} 222 | {$DEFINE DELPHI14_UP} 223 | {$DEFINE DELPHI15_UP} 224 | {$DEFINE DELPHI16_UP} 225 | {$DEFINE DELPHI17_UP} 226 | {$DEFINE DELPHI18_UP} 227 | {$ENDIF} 228 | 229 | // Delphi XE3 230 | {$IFDEF VER240} 231 | {$DEFINE DELPHI14_UP} 232 | {$DEFINE DELPHI15_UP} 233 | {$DEFINE DELPHI16_UP} 234 | {$DEFINE DELPHI17_UP} 235 | {$ENDIF} 236 | 237 | // Delphi XE2 238 | {$IFDEF VER230} 239 | {$DEFINE DELPHI14_UP} 240 | {$DEFINE DELPHI15_UP} 241 | {$DEFINE DELPHI16_UP} 242 | {$ENDIF} 243 | 244 | // Delphi XE 245 | {$IFDEF VER220} 246 | {$DEFINE DELPHI14_UP} 247 | {$DEFINE DELPHI15_UP} 248 | {$ENDIF} 249 | 250 | //Delphi 2010 251 | {$IFDEF VER210} 252 | {$DEFINE DELPHI14_UP} 253 | {$ENDIF} 254 | 255 | //Lazarus 256 | {$IFDEF FCP} 257 | {$DEFINE DELPHI14_UP} 258 | {$ENDIF} 259 | 260 | {$IFDEF DELPHI15_UP} 261 | {$DEFINE FORMATSETTINGS} 262 | {$ENDIF} 263 | 264 | {$IFDEF DELPHI17_UP} 265 | {$DEFINE HAS_NET_ENCODING} 266 | {$ELSE IFDEF DELPHI16_UP} 267 | {$DEFINE HAS_SOAP_ENCODING} 268 | {$ELSE 269 | {$DEFINE HAS_ENCDDECD} 270 | {$ENDIF} 271 | -------------------------------------------------------------------------------- /Test Delphi/EclbrResultPair/PTestResultPair.dpr: -------------------------------------------------------------------------------- 1 | program PTestResultPair; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | System.SysUtils, 11 | {$IFDEF TESTINSIGHT} 12 | TestInsight.DUnitX, 13 | {$ELSE} 14 | DUnitX.Loggers.Console, 15 | DUnitX.Loggers.Xml.NUnit, 16 | {$ENDIF } 17 | DUnitX.TestFramework, 18 | UTestEvolution.ResultPair in 'UTestEvolution.ResultPair.pas', 19 | System.Evolution.ResultPair in '..\..\Source\System.Evolution.ResultPair.pas'; 20 | 21 | {$IFNDEF TESTINSIGHT} 22 | var 23 | runner: ITestRunner; 24 | results: IRunResults; 25 | logger: ITestLogger; 26 | nunitLogger : ITestLogger; 27 | {$ENDIF} 28 | begin 29 | {$IFDEF TESTINSIGHT} 30 | TestInsight.DUnitX.RunRegisteredTests; 31 | {$ELSE} 32 | try 33 | //Check command line options, will exit if invalid 34 | TDUnitX.CheckCommandLine; 35 | //Create the test runner 36 | runner := TDUnitX.CreateRunner; 37 | //Tell the runner to use RTTI to find Fixtures 38 | runner.UseRTTI := True; 39 | //When true, Assertions must be made during tests; 40 | runner.FailsOnNoAsserts := False; 41 | 42 | //tell the runner how we will log things 43 | //Log to the console window if desired 44 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 45 | begin 46 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 47 | runner.AddLogger(logger); 48 | end; 49 | //Generate an NUnit compatible XML File 50 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 51 | runner.AddLogger(nunitLogger); 52 | 53 | //Run tests 54 | results := runner.Execute; 55 | if not results.AllPassed then 56 | System.ExitCode := EXIT_ERRORS; 57 | 58 | {$IFNDEF CI} 59 | //We don't want this happening when running under CI. 60 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 61 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 62 | begin 63 | System.Write('Done.. press key to quit.'); 64 | System.Readln; 65 | end; 66 | {$ENDIF} 67 | except 68 | on E: Exception do 69 | System.Writeln(E.ClassName, ': ', E.Message); 70 | end; 71 | {$ENDIF} 72 | end. 73 | 74 | -------------------------------------------------------------------------------- /Test Delphi/EclbrResultPair/PTestResultPair.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrResultPair/PTestResultPair.res -------------------------------------------------------------------------------- /Test Delphi/EclbrResultPair/UTestEvolution.ResultPair.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrResultPair/UTestEvolution.ResultPair.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrResultPair/UTestResultPair.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrResultPair/UTestResultPair.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrResultPair/dunitx-results.xml: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/DCC.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | CodeCoverage.exe ^ 3 | -m PTestDictionary.map ^ 4 | -e PTestDictionary.exe ^ 5 | -dproj PTestDictionary.dproj ^ 6 | -od CodeCoverage/Dictionary ^ 7 | -emma ^ 8 | -xml ^ 9 | -html ^ 10 | -xmllines ^ 11 | -v 12 | 13 | CodeCoverage.exe ^ 14 | -m PTestMatch.map ^ 15 | -e PTestMatch.exe ^ 16 | -dproj PTestMatch.dproj ^ 17 | -od CodeCoverage/Match ^ 18 | -emma ^ 19 | -xml ^ 20 | -html ^ 21 | -xmllines ^ 22 | -v 23 | 24 | CodeCoverage.exe ^ 25 | -m PTestTuple.map ^ 26 | -e PTestTuple.exe ^ 27 | -dproj PTestTuple.dproj ^ 28 | -od CodeCoverage/Tuple ^ 29 | -emma ^ 30 | -xml ^ 31 | -html ^ 32 | -xmllines ^ 33 | -v 34 | 35 | CodeCoverage.exe ^ 36 | -m PTestVector.map ^ 37 | -e PTestVector.exe ^ 38 | -dproj PTestVector.dproj ^ 39 | -od CodeCoverage/Vector ^ 40 | -emma ^ 41 | -xml ^ 42 | -html ^ 43 | -xmllines ^ 44 | -v 45 | 46 | CodeCoverage.exe ^ 47 | -m PTestMap.map ^ 48 | -e PTestMap.exe ^ 49 | -dproj PTestMap.dproj ^ 50 | -od CodeCoverage/Map ^ 51 | -emma ^ 52 | -xml ^ 53 | -html ^ 54 | -xmllines ^ 55 | -v 56 | 57 | CodeCoverage.exe ^ 58 | -m PTestList.map ^ 59 | -e PTestList.exe ^ 60 | -dproj PTestList.dproj ^ 61 | -od CodeCoverage/List ^ 62 | -emma ^ 63 | -xml ^ 64 | -html ^ 65 | -xmllines ^ 66 | -v 67 | 68 | CodeCoverage.exe ^ 69 | -m PTestStream.map ^ 70 | -e PTestStream.exe ^ 71 | -dproj PTestStream.dproj ^ 72 | -od CodeCoverage/Stream ^ 73 | -emma ^ 74 | -xml ^ 75 | -html ^ 76 | -xmllines ^ 77 | -v 78 | 79 | CodeCoverage.exe ^ 80 | -m PTestDirectory.map ^ 81 | -e PTestDirectory.exe ^ 82 | -dproj PTestDirectory.dproj ^ 83 | -od CodeCoverage/Directory ^ 84 | -emma ^ 85 | -xml ^ 86 | -html ^ 87 | -xmllines ^ 88 | -v 89 | 90 | CodeCoverage.exe ^ 91 | -m PTestObjects.map ^ 92 | -e PTestObjects.exe ^ 93 | -dproj PTestObjects.dproj ^ 94 | -od CodeCoverage/Objects ^ 95 | -emma ^ 96 | -xml ^ 97 | -html ^ 98 | -xmllines ^ 99 | -v 100 | 101 | CodeCoverage.exe ^ 102 | -m PTestThreading.map ^ 103 | -e PTestThreading.exe ^ 104 | -dproj PTestThreading.dproj ^ 105 | -od CodeCoverage/Threading ^ 106 | -emma ^ 107 | -xml ^ 108 | -html ^ 109 | -xmllines ^ 110 | -v 111 | 112 | CodeCoverage.exe ^ 113 | -m PTestStd.map ^ 114 | -e PTestStd.exe ^ 115 | -dproj PTestStd.dproj ^ 116 | -od CodeCoverage/Std ^ 117 | -emma ^ 118 | -xml ^ 119 | -html ^ 120 | -xmllines ^ 121 | -v 122 | 123 | CodeCoverage.exe ^ 124 | -m PTestStr.map ^ 125 | -e PTestStr.exe ^ 126 | -dproj PTestStr.dproj ^ 127 | -od CodeCoverage/Str ^ 128 | -emma ^ 129 | -xml ^ 130 | -html ^ 131 | -xmllines ^ 132 | -v 133 | 134 | CodeCoverage.exe ^ 135 | -m PTestSafeTry.map ^ 136 | -e PTestSafeTry.exe ^ 137 | -dproj PTestSafeTry.dproj ^ 138 | -od CodeCoverage/SafeTry ^ 139 | -emma ^ 140 | -xml ^ 141 | -html ^ 142 | -xmllines ^ 143 | -v 144 | 145 | timeout /t -1 -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestCurrying.dpr: -------------------------------------------------------------------------------- 1 | program PTestCurrying; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | UTestEvolution.Currying in 'UTestEvolution.Currying.pas', 20 | System.Evolution.Currying in '..\..\Source\System.Evolution.Currying.pas'; 21 | 22 | { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } 23 | {$IFNDEF TESTINSIGHT} 24 | var 25 | runner: ITestRunner; 26 | results: IRunResults; 27 | logger: ITestLogger; 28 | nunitLogger : ITestLogger; 29 | {$ENDIF} 30 | begin 31 | {$IFDEF TESTINSIGHT} 32 | TestInsight.DUnitX.RunRegisteredTests; 33 | {$ELSE} 34 | try 35 | //Check command line options, will exit if invalid 36 | TDUnitX.CheckCommandLine; 37 | //Create the test runner 38 | runner := TDUnitX.CreateRunner; 39 | //Tell the runner to use RTTI to find Fixtures 40 | runner.UseRTTI := True; 41 | //When true, Assertions must be made during tests; 42 | runner.FailsOnNoAsserts := False; 43 | 44 | //tell the runner how we will log things 45 | //Log to the console window if desired 46 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 47 | begin 48 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 49 | runner.AddLogger(logger); 50 | end; 51 | //Generate an NUnit compatible XML File 52 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 53 | runner.AddLogger(nunitLogger); 54 | 55 | //Run tests 56 | results := runner.Execute; 57 | if not results.AllPassed then 58 | System.ExitCode := EXIT_ERRORS; 59 | 60 | {$IFNDEF CI} 61 | //We don't want this happening when running under CI. 62 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 63 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 64 | begin 65 | System.Write('Done.. press key to quit.'); 66 | System.Readln; 67 | end; 68 | {$ENDIF} 69 | except 70 | on E: Exception do 71 | System.Writeln(E.ClassName, ': ', E.Message); 72 | end; 73 | {$ENDIF} 74 | end. 75 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestCurrying.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestCurrying.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestDotEnv.dpr: -------------------------------------------------------------------------------- 1 | program PTestDotEnv; 2 | 3 | {$IFNDEF TESTINSIGHT} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF} 6 | {$STRONGLINKTYPES ON} 7 | uses 8 | FastMM4, 9 | System.SysUtils, 10 | {$IFDEF TESTINSIGHT} 11 | TestInsight.DUnitX, 12 | {$ELSE} 13 | DUnitX.Loggers.Console, 14 | DUnitX.Loggers.Xml.NUnit, 15 | {$ENDIF } 16 | DUnitX.TestFramework, 17 | UTestEvolution.DotEnv in 'UTestEvolution.DotEnv.pas', 18 | System.Evolution.DotEnv in '..\..\Source\System.Evolution.DotEnv.pas', 19 | System.Evolution.Crypt in '..\..\Source\System.Evolution.Crypt.pas', 20 | System.Evolution.Std in '..\..\Source\System.Evolution.Std.pas', 21 | System.Evolution.System in '..\..\Source\System.Evolution.System.pas'; 22 | 23 | { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } 24 | {$IFNDEF TESTINSIGHT} 25 | var 26 | runner: ITestRunner; 27 | results: IRunResults; 28 | logger: ITestLogger; 29 | nunitLogger : ITestLogger; 30 | {$ENDIF} 31 | begin 32 | {$IFDEF TESTINSIGHT} 33 | TestInsight.DUnitX.RunRegisteredTests; 34 | {$ELSE} 35 | try 36 | //Check command line options, will exit if invalid 37 | TDUnitX.CheckCommandLine; 38 | //Create the test runner 39 | runner := TDUnitX.CreateRunner; 40 | //Tell the runner to use RTTI to find Fixtures 41 | runner.UseRTTI := True; 42 | //When true, Assertions must be made during tests; 43 | runner.FailsOnNoAsserts := False; 44 | 45 | //tell the runner how we will log things 46 | //Log to the console window if desired 47 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 48 | begin 49 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 50 | runner.AddLogger(logger); 51 | end; 52 | //Generate an NUnit compatible XML File 53 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 54 | runner.AddLogger(nunitLogger); 55 | 56 | //Run tests 57 | results := runner.Execute; 58 | if not results.AllPassed then 59 | System.ExitCode := EXIT_ERRORS; 60 | 61 | {$IFNDEF CI} 62 | //We don't want this happening when running under CI. 63 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 64 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 65 | begin 66 | System.Write('Done.. press key to quit.'); 67 | System.Readln; 68 | end; 69 | {$ENDIF} 70 | except 71 | on E: Exception do 72 | System.Writeln(E.ClassName, ': ', E.Message); 73 | end; 74 | {$ENDIF} 75 | end. 76 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestDotEnv.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestDotEnv.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestMatch.delphilint: -------------------------------------------------------------------------------- 1 | [SonarHost] 2 | ProjectKey=eclbr 3 | Url=127.0.0.1:9000 4 | DownloadPlugin=1 5 | [Analysis] 6 | BaseDir=D:\PROJETOS-Brasil\ECLBr\Source 7 | ReadProperties=1 8 | ConnectedMode=1 9 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestMatch.dpr: -------------------------------------------------------------------------------- 1 | program PTestMatch; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | UTestEvolution.Match in 'UTestEvolution.Match.pas', 20 | System.Evolution.Match in '..\..\Source\System.Evolution.Match.pas', 21 | System.Evolution.RegEx in '..\..\Source\System.Evolution.RegEx.pas', 22 | System.Evolution.ResultPair in '..\..\Source\System.Evolution.ResultPair.pas', 23 | System.Evolution.Tuple in '..\..\Source\System.Evolution.Tuple.pas', 24 | System.Evolution.ArrowFun in '..\..\Source\System.Evolution.ArrowFun.pas', 25 | System.Evolution.Std in '..\..\Source\System.Evolution.Std.pas', 26 | System.Evolution.System in '..\..\Source\System.Evolution.System.pas'; 27 | 28 | {$IFNDEF TESTINSIGHT} 29 | var 30 | runner: ITestRunner; 31 | results: IRunResults; 32 | logger: ITestLogger; 33 | nunitLogger : ITestLogger; 34 | {$ENDIF} 35 | begin 36 | {$IFDEF TESTINSIGHT} 37 | TestInsight.DUnitX.RunRegisteredTests; 38 | {$ELSE} 39 | try 40 | //Check command line options, will exit if invalid 41 | TDUnitX.CheckCommandLine; 42 | //Create the test runner 43 | runner := TDUnitX.CreateRunner; 44 | //Tell the runner to use RTTI to find Fixtures 45 | runner.UseRTTI := True; 46 | //When true, Assertions must be made during tests; 47 | runner.FailsOnNoAsserts := False; 48 | 49 | //tell the runner how we will log things 50 | //Log to the console window if desired 51 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 52 | begin 53 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 54 | runner.AddLogger(logger); 55 | end; 56 | //Generate an NUnit compatible XML File 57 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 58 | runner.AddLogger(nunitLogger); 59 | 60 | //Run tests 61 | results := runner.Execute; 62 | if not results.AllPassed then 63 | System.ExitCode := EXIT_ERRORS; 64 | 65 | {$IFNDEF CI} 66 | //We don't want this happening when running under CI. 67 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 68 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 69 | begin 70 | System.Write('Done.. press key to quit.'); 71 | System.Readln; 72 | end; 73 | {$ENDIF} 74 | except 75 | on E: Exception do 76 | System.Writeln(E.ClassName, ': ', E.Message); 77 | end; 78 | {$ENDIF} 79 | end. 80 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestMatch.otares: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestMatch.otares -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestMatch.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestMatch.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestMatch_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestMatch_Icon.ico -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestObjectLib.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestObjectLib.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestObjects.dpr: -------------------------------------------------------------------------------- 1 | program PTestObjects; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | UTestEvolutoin.Objects in 'UTestEvolutoin.Objects.pas', 20 | System.Evolution.Objects in '..\..\Source\System.Evolution.Objects.pas', 21 | UTestEvolution.Muttle in 'UTestEvolution.Muttle.pas'; 22 | 23 | {$IFNDEF TESTINSIGHT} 24 | var 25 | runner: ITestRunner; 26 | results: IRunResults; 27 | logger: ITestLogger; 28 | nunitLogger : ITestLogger; 29 | {$ENDIF} 30 | begin 31 | {$IFDEF TESTINSIGHT} 32 | TestInsight.DUnitX.RunRegisteredTests; 33 | {$ELSE} 34 | try 35 | //Check command line options, will exit if invalid 36 | TDUnitX.CheckCommandLine; 37 | //Create the test runner 38 | runner := TDUnitX.CreateRunner; 39 | //Tell the runner to use RTTI to find Fixtures 40 | runner.UseRTTI := True; 41 | //When true, Assertions must be made during tests; 42 | runner.FailsOnNoAsserts := False; 43 | 44 | //tell the runner how we will log things 45 | //Log to the console window if desired 46 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 47 | begin 48 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 49 | runner.AddLogger(logger); 50 | end; 51 | //Generate an NUnit compatible XML File 52 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 53 | runner.AddLogger(nunitLogger); 54 | 55 | //Run tests 56 | results := runner.Execute; 57 | if not results.AllPassed then 58 | System.ExitCode := EXIT_ERRORS; 59 | 60 | {$IFNDEF CI} 61 | //We don't want this happening when running under CI. 62 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 63 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 64 | begin 65 | System.Write('Done.. press key to quit.'); 66 | System.Readln; 67 | end; 68 | {$ENDIF} 69 | except 70 | on E: Exception do 71 | System.Writeln(E.ClassName, ': ', E.Message); 72 | end; 73 | {$ENDIF} 74 | end. 75 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestObjects.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestObjects.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestOption.dpr: -------------------------------------------------------------------------------- 1 | program PTestOption; 2 | 3 | {$IFNDEF TESTINSIGHT} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF} 6 | {$STRONGLINKTYPES ON} 7 | uses 8 | FastMM4, 9 | DUnitX.MemoryLeakMonitor.FastMM4, 10 | System.SysUtils, 11 | {$IFDEF TESTINSIGHT} 12 | TestInsight.DUnitX, 13 | {$ELSE} 14 | DUnitX.Loggers.Console, 15 | DUnitX.Loggers.Xml.NUnit, 16 | {$ENDIF } 17 | DUnitX.TestFramework, 18 | UTestEvolution.Option in 'UTestEvolution.Option.pas', 19 | System.Evolution.Option in '..\..\Source\System.Evolution.Option.pas', 20 | System.Evolution.ResultPair in '..\..\Source\System.Evolution.ResultPair.pas'; 21 | 22 | { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } 23 | {$IFNDEF TESTINSIGHT} 24 | var 25 | runner: ITestRunner; 26 | results: IRunResults; 27 | logger: ITestLogger; 28 | nunitLogger : ITestLogger; 29 | {$ENDIF} 30 | begin 31 | {$IFDEF TESTINSIGHT} 32 | TestInsight.DUnitX.RunRegisteredTests; 33 | {$ELSE} 34 | try 35 | //Check command line options, will exit if invalid 36 | TDUnitX.CheckCommandLine; 37 | //Create the test runner 38 | runner := TDUnitX.CreateRunner; 39 | //Tell the runner to use RTTI to find Fixtures 40 | runner.UseRTTI := True; 41 | //When true, Assertions must be made during tests; 42 | runner.FailsOnNoAsserts := False; 43 | 44 | //tell the runner how we will log things 45 | //Log to the console window if desired 46 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 47 | begin 48 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 49 | runner.AddLogger(logger); 50 | end; 51 | //Generate an NUnit compatible XML File 52 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 53 | runner.AddLogger(nunitLogger); 54 | 55 | //Run tests 56 | results := runner.Execute; 57 | if not results.AllPassed then 58 | System.ExitCode := EXIT_ERRORS; 59 | 60 | {$IFNDEF CI} 61 | //We don't want this happening when running under CI. 62 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 63 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 64 | begin 65 | System.Write('Done.. press key to quit.'); 66 | System.Readln; 67 | end; 68 | {$ENDIF} 69 | except 70 | on E: Exception do 71 | System.Writeln(E.ClassName, ': ', E.Message); 72 | end; 73 | {$ENDIF} 74 | end. 75 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestOption.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestOption.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSafeTry.dpr: -------------------------------------------------------------------------------- 1 | program PTestSafeTry; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | DUnitX.MemoryLeakMonitor.FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | UTestEvolution.SafeTry in 'UTestEvolution.SafeTry.pas', 20 | System.Evolution.Safetry in '..\..\Source\System.Evolution.Safetry.pas'; 21 | 22 | { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } 23 | {$IFNDEF TESTINSIGHT} 24 | var 25 | runner: ITestRunner; 26 | results: IRunResults; 27 | logger: ITestLogger; 28 | nunitLogger : ITestLogger; 29 | {$ENDIF} 30 | begin 31 | {$IFDEF TESTINSIGHT} 32 | TestInsight.DUnitX.RunRegisteredTests; 33 | {$ELSE} 34 | try 35 | //Check command line options, will exit if invalid 36 | TDUnitX.CheckCommandLine; 37 | //Create the test runner 38 | runner := TDUnitX.CreateRunner; 39 | //Tell the runner to use RTTI to find Fixtures 40 | runner.UseRTTI := True; 41 | //When true, Assertions must be made during tests; 42 | runner.FailsOnNoAsserts := False; 43 | 44 | //tell the runner how we will log things 45 | //Log to the console window if desired 46 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 47 | begin 48 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 49 | runner.AddLogger(logger); 50 | end; 51 | //Generate an NUnit compatible XML File 52 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 53 | runner.AddLogger(nunitLogger); 54 | 55 | //Run tests 56 | results := runner.Execute; 57 | if not results.AllPassed then 58 | System.ExitCode := EXIT_ERRORS; 59 | 60 | {$IFNDEF CI} 61 | //We don't want this happening when running under CI. 62 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 63 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 64 | begin 65 | System.Write('Done.. press key to quit.'); 66 | System.Readln; 67 | end; 68 | {$ENDIF} 69 | except 70 | on E: Exception do 71 | System.Writeln(E.ClassName, ': ', E.Message); 72 | end; 73 | {$ENDIF} 74 | end. 75 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSafeTry.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestSafeTry.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestStd.dpr: -------------------------------------------------------------------------------- 1 | program PTestStd; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | UTestEvolution.Std in 'UTestEvolution.Std.pas', 20 | System.Evolution.Objects in '..\..\Source\System.Evolution.Objects.pas', 21 | System.Evolution.Crypt in '..\..\Source\System.Evolution.Crypt.pas', 22 | System.Evolution.Std in '..\..\Source\System.Evolution.Std.pas', 23 | System.Evolution.System in '..\..\Source\System.Evolution.System.pas'; 24 | 25 | {$IFNDEF TESTINSIGHT} 26 | var 27 | runner: ITestRunner; 28 | results: IRunResults; 29 | logger: ITestLogger; 30 | nunitLogger : ITestLogger; 31 | {$ENDIF} 32 | begin 33 | {$IFDEF TESTINSIGHT} 34 | TestInsight.DUnitX.RunRegisteredTests; 35 | {$ELSE} 36 | try 37 | //Check command line options, will exit if invalid 38 | TDUnitX.CheckCommandLine; 39 | //Create the test runner 40 | runner := TDUnitX.CreateRunner; 41 | //Tell the runner to use RTTI to find Fixtures 42 | runner.UseRTTI := True; 43 | //When true, Assertions must be made during tests; 44 | runner.FailsOnNoAsserts := False; 45 | 46 | //tell the runner how we will log things 47 | //Log to the console window if desired 48 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 49 | begin 50 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 51 | runner.AddLogger(logger); 52 | end; 53 | //Generate an NUnit compatible XML File 54 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 55 | runner.AddLogger(nunitLogger); 56 | 57 | //Run tests 58 | results := runner.Execute; 59 | if not results.AllPassed then 60 | System.ExitCode := EXIT_ERRORS; 61 | 62 | {$IFNDEF CI} 63 | //We don't want this happening when running under CI. 64 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 65 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 66 | begin 67 | System.Write('Done.. press key to quit.'); 68 | System.Readln; 69 | end; 70 | {$ENDIF} 71 | except 72 | on E: Exception do 73 | System.Writeln(E.ClassName, ': ', E.Message); 74 | end; 75 | {$ENDIF} 76 | end. 77 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestStd.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestStd.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestStream.dpr: -------------------------------------------------------------------------------- 1 | program PTestStream; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | System.Evolution.Stream in '..\..\Source\System.Evolution.Stream.pas', 20 | UTestEvolution.StreamReader in 'UTestEvolution.StreamReader.pas', 21 | System.Evolution.ArrowFun in '..\..\Source\System.Evolution.ArrowFun.pas', 22 | System.Evolution.Objects in '..\..\Source\System.Evolution.Objects.pas', 23 | System.Evolution.Std in '..\..\Source\System.Evolution.Std.pas', 24 | System.Evolution.Threading in '..\..\Source\System.Evolution.Threading.pas', 25 | System.Evolution.System in '..\..\Source\System.Evolution.System.pas'; 26 | 27 | {$IFNDEF TESTINSIGHT} 28 | var 29 | runner: ITestRunner; 30 | results: IRunResults; 31 | logger: ITestLogger; 32 | nunitLogger : ITestLogger; 33 | {$ENDIF} 34 | begin 35 | {$IFDEF TESTINSIGHT} 36 | TestInsight.DUnitX.RunRegisteredTests; 37 | {$ELSE} 38 | try 39 | //Check command line options, will exit if invalid 40 | TDUnitX.CheckCommandLine; 41 | //Create the test runner 42 | runner := TDUnitX.CreateRunner; 43 | //Tell the runner to use RTTI to find Fixtures 44 | runner.UseRTTI := True; 45 | //When true, Assertions must be made during tests; 46 | runner.FailsOnNoAsserts := False; 47 | 48 | //tell the runner how we will log things 49 | //Log to the console window if desired 50 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 51 | begin 52 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 53 | runner.AddLogger(logger); 54 | end; 55 | //Generate an NUnit compatible XML File 56 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 57 | runner.AddLogger(nunitLogger); 58 | 59 | //Run tests 60 | results := runner.Execute; 61 | if not results.AllPassed then 62 | System.ExitCode := EXIT_ERRORS; 63 | 64 | {$IFNDEF CI} 65 | //We don't want this happening when running under CI. 66 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 67 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 68 | begin 69 | System.Write('Done.. press key to quit.'); 70 | System.Readln; 71 | end; 72 | {$ENDIF} 73 | except 74 | on E: Exception do 75 | System.Writeln(E.ClassName, ': ', E.Message); 76 | end; 77 | {$ENDIF} 78 | end. 79 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestStream.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestStream.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSysDictionary.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestSysDictionary.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSysDirectory.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestSysDirectory.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSysIfTuple.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestSysIfTuple.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSysMatch.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestSysMatch.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSysStream.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestSysStream.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestSysTuple.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestSysTuple.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestThreading.dpr: -------------------------------------------------------------------------------- 1 | program PTestThreading; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | UTestEvolution.Threading in 'UTestEvolution.Threading.pas', 20 | System.Evolution.Threading in '..\..\Source\System.Evolution.Threading.pas', 21 | System.Evolution.Std in '..\..\Source\System.Evolution.Std.pas', 22 | System.Evolution.System in '..\..\Source\System.Evolution.System.pas'; 23 | 24 | {$IFNDEF TESTINSIGHT} 25 | var 26 | runner: ITestRunner; 27 | results: IRunResults; 28 | logger: ITestLogger; 29 | nunitLogger : ITestLogger; 30 | {$ENDIF} 31 | begin 32 | {$IFDEF TESTINSIGHT} 33 | TestInsight.DUnitX.RunRegisteredTests; 34 | {$ELSE} 35 | try 36 | //Check command line options, will exit if invalid 37 | TDUnitX.CheckCommandLine; 38 | //Create the test runner 39 | runner := TDUnitX.CreateRunner; 40 | //Tell the runner to use RTTI to find Fixtures 41 | runner.UseRTTI := True; 42 | //When true, Assertions must be made during tests; 43 | runner.FailsOnNoAsserts := False; 44 | 45 | //tell the runner how we will log things 46 | //Log to the console window if desired 47 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 48 | begin 49 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 50 | runner.AddLogger(logger); 51 | end; 52 | //Generate an NUnit compatible XML File 53 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 54 | runner.AddLogger(nunitLogger); 55 | 56 | //Run tests 57 | results := runner.Execute; 58 | if not results.AllPassed then 59 | System.ExitCode := EXIT_ERRORS; 60 | 61 | {$IFNDEF CI} 62 | //We don't want this happening when running under CI. 63 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 64 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 65 | begin 66 | System.Write('Done.. press key to quit.'); 67 | System.Readln; 68 | end; 69 | {$ENDIF} 70 | except 71 | on E: Exception do 72 | System.Writeln(E.ClassName, ': ', E.Message); 73 | end; 74 | {$ENDIF} 75 | end. 76 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestThreading.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestThreading.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestTuple.dpr: -------------------------------------------------------------------------------- 1 | program PTestTuple; 2 | 3 | //{$DEFINE CI} 4 | 5 | {$IFNDEF TESTINSIGHT} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | {$STRONGLINKTYPES ON} 9 | uses 10 | FastMM4, 11 | System.SysUtils, 12 | {$IFDEF TESTINSIGHT} 13 | TestInsight.DUnitX, 14 | {$ELSE} 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | {$ENDIF } 18 | DUnitX.TestFramework, 19 | UTestEvolution.Tuple in 'UTestEvolution.Tuple.pas', 20 | System.Evolution.Tuple in '..\..\Source\System.Evolution.Tuple.pas', 21 | System.Evolution.Match in '..\..\Source\System.Evolution.Match.pas', 22 | System.Evolution.ArrowFun in '..\..\Source\System.Evolution.ArrowFun.pas', 23 | System.Evolution.RegEx in '..\..\Source\System.Evolution.RegEx.pas', 24 | System.Evolution.ResultPair in '..\..\Source\System.Evolution.ResultPair.pas', 25 | System.Evolution.Std in '..\..\Source\System.Evolution.Std.pas', 26 | System.Evolution.System in '..\..\Source\System.Evolution.System.pas'; 27 | 28 | {$IFNDEF TESTINSIGHT} 29 | var 30 | runner: ITestRunner; 31 | results: IRunResults; 32 | logger: ITestLogger; 33 | nunitLogger : ITestLogger; 34 | {$ENDIF} 35 | begin 36 | {$IFDEF TESTINSIGHT} 37 | TestInsight.DUnitX.RunRegisteredTests; 38 | {$ELSE} 39 | try 40 | //Check command line options, will exit if invalid 41 | TDUnitX.CheckCommandLine; 42 | //Create the test runner 43 | runner := TDUnitX.CreateRunner; 44 | //Tell the runner to use RTTI to find Fixtures 45 | runner.UseRTTI := True; 46 | //When true, Assertions must be made during tests; 47 | runner.FailsOnNoAsserts := False; 48 | 49 | //tell the runner how we will log things 50 | //Log to the console window if desired 51 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 52 | begin 53 | logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 54 | runner.AddLogger(logger); 55 | end; 56 | //Generate an NUnit compatible XML File 57 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 58 | runner.AddLogger(nunitLogger); 59 | 60 | //Run tests 61 | results := runner.Execute; 62 | if not results.AllPassed then 63 | System.ExitCode := EXIT_ERRORS; 64 | 65 | {$IFNDEF CI} 66 | //We don't want this happening when running under CI. 67 | TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; 68 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 69 | begin 70 | System.Write('Done.. press key to quit.'); 71 | System.Readln; 72 | end; 73 | {$ENDIF} 74 | except 75 | on E: Exception do 76 | System.Writeln(E.ClassName, ': ', E.Message); 77 | end; 78 | {$ENDIF} 79 | end. 80 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestTuple.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestTuple.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestUtils.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestUtils.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/PTestUtilsLib.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/PTestUtilsLib.res -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/TestEvolution4DGroup.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {EF844C65-F513-421D-B3D0-B4D5EABA97EC} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | Default.Personality.12 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/TestInsightSettings.ini: -------------------------------------------------------------------------------- 1 | [Config] 2 | BaseUrl=http://DESKTOP-ISAQUEP:8102 3 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEcl.Dictionary.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEcl.Dictionary.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEcl.Directory.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEcl.Directory.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEcl.List.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEcl.List.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEcl.Map.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEcl.Map.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEcl.Str.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEcl.Str.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEcl.Vector.pas: -------------------------------------------------------------------------------- 1 | unit UTestEcl.Vector; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | SysUtils, 8 | StrUtils, 9 | Generics.Collections, 10 | ecl.std, 11 | ecl.vector; 12 | 13 | type 14 | TVectorTest = class 15 | public 16 | [Setup] 17 | procedure Setup; 18 | [TearDown] 19 | procedure TearDown; 20 | [Test] 21 | procedure TestAdd; 22 | [Test] 23 | procedure TestInsert; 24 | [Test] 25 | procedure TestDelete; 26 | [Test] 27 | procedure TestRemove; 28 | [Test] 29 | procedure TestLength; 30 | [Test] 31 | procedure TestIsEmpty; 32 | [Test] 33 | procedure TestJoinStrings; 34 | [Test] 35 | procedure TestClear; 36 | [Test] 37 | procedure TestUnique; 38 | [Test] 39 | procedure TestContains; 40 | [Test] 41 | procedure TestIndexOf; 42 | [Test] 43 | procedure TestMerge; 44 | [Test] 45 | procedure TestFilter; 46 | [Test] 47 | procedure TestFirst; 48 | [Test] 49 | procedure TestLast; 50 | [Test] 51 | procedure TestAsType; 52 | [Test] 53 | procedure TestAsList; 54 | [Test] 55 | procedure TestToString; 56 | [Test] 57 | procedure TestEnumerator; 58 | [Test] 59 | procedure TestFormatCPF; 60 | [Test] 61 | procedure TestFactorialCalculation; 62 | end; 63 | 64 | implementation 65 | 66 | { TArrayDataTest } 67 | 68 | procedure TVectorTest.Setup; 69 | begin 70 | 71 | end; 72 | 73 | procedure TVectorTest.TearDown; 74 | begin 75 | 76 | end; 77 | 78 | procedure TVectorTest.TestAdd; 79 | var 80 | LVector: TVector; 81 | begin 82 | LVector.Add(10); 83 | LVector.Add(20); 84 | LVector.Add(30); 85 | Assert.AreEqual(3, LVector.Length); 86 | Assert.AreEqual(10, LVector[0]); 87 | Assert.AreEqual(20, LVector[1]); 88 | Assert.AreEqual(30, LVector[2]); 89 | end; 90 | 91 | procedure TVectorTest.TestInsert; 92 | var 93 | LVector: TVector; 94 | begin 95 | LVector.Add(10); 96 | LVector.Add(20); 97 | LVector.Insert(1, 15); 98 | LVector.Insert(3, 25); 99 | Assert.AreEqual(4, LVector.Length); 100 | Assert.AreEqual(10, LVector[0]); 101 | Assert.AreEqual(15, LVector[1]); 102 | Assert.AreEqual(20, LVector[2]); 103 | Assert.AreEqual(25, LVector[3]); 104 | end; 105 | 106 | procedure TVectorTest.TestDelete; 107 | var 108 | LVector: TVector; 109 | begin 110 | LVector.Add(10); 111 | LVector.Add(20); 112 | LVector.Add(30); 113 | LVector.Delete(1); 114 | Assert.AreEqual(2, LVector.Length); 115 | Assert.AreEqual(10, LVector[0]); 116 | Assert.AreEqual(30, LVector[1]); 117 | end; 118 | 119 | procedure TVectorTest.TestRemove; 120 | var 121 | LVector: TVector; 122 | begin 123 | LVector.Add(10); 124 | LVector.Add(20); 125 | LVector.Add(30); 126 | LVector.Remove(20); 127 | Assert.AreEqual(2, LVector.Length); 128 | Assert.AreEqual(10, LVector[0]); 129 | Assert.AreEqual(30, LVector[1]); 130 | end; 131 | 132 | procedure TVectorTest.TestLength; 133 | var 134 | LVector: TVector; 135 | begin 136 | Assert.AreEqual(0, LVector.Length); 137 | LVector.Add(10); 138 | LVector.Add(20); 139 | LVector.Add(30); 140 | Assert.AreEqual(3, LVector.Length); 141 | LVector.Delete(1); 142 | Assert.AreEqual(2, LVector.Length); 143 | end; 144 | 145 | procedure TVectorTest.TestIsEmpty; 146 | var 147 | LVector: TVector; 148 | begin 149 | Assert.IsTrue(LVector.IsEmpty); 150 | LVector.Add(10); 151 | Assert.IsFalse(LVector.IsEmpty); 152 | LVector.Delete(0); 153 | Assert.IsTrue(LVector.IsEmpty); 154 | end; 155 | 156 | procedure TVectorTest.TestJoinStrings; 157 | var 158 | LVector: TVector; 159 | begin 160 | LVector.JoinStrings('10,20,30', ','); 161 | Assert.AreEqual(3, LVector.Length); 162 | Assert.AreEqual(10, LVector[0]); 163 | Assert.AreEqual(20, LVector[1]); 164 | Assert.AreEqual(30, LVector[2]); 165 | end; 166 | 167 | procedure TVectorTest.TestClear; 168 | var 169 | LVector: TVector; 170 | begin 171 | LVector.Add(10); 172 | LVector.Add(20); 173 | LVector.Add(30); 174 | LVector.Clear; 175 | Assert.AreEqual(0, LVector.Length); 176 | end; 177 | 178 | procedure TVectorTest.TestUnique; 179 | var 180 | LVector: TVector; 181 | begin 182 | LVector.Add(10); 183 | LVector.Add(20); 184 | LVector.Add(10); 185 | LVector.Add(30); 186 | LVector.Unique; 187 | Assert.AreEqual(3, LVector.Length); 188 | Assert.AreEqual(10, LVector[0]); 189 | Assert.AreEqual(20, LVector[1]); 190 | Assert.AreEqual(30, LVector[2]); 191 | end; 192 | 193 | procedure TVectorTest.TestContains; 194 | var 195 | LVector: TVector; 196 | begin 197 | LVector.Add(10); 198 | LVector.Add(20); 199 | LVector.Add(30); 200 | Assert.IsTrue(LVector.Contains(10)); 201 | Assert.IsTrue(LVector.Contains(20)); 202 | Assert.IsTrue(LVector.Contains(30)); 203 | Assert.IsFalse(LVector.Contains(40)); 204 | end; 205 | 206 | procedure TVectorTest.TestIndexOf; 207 | var 208 | LVector: TVector; 209 | begin 210 | LVector.Add(10); 211 | LVector.Add(20); 212 | LVector.Add(30); 213 | Assert.AreEqual(0, LVector.IndexOf(10)); 214 | Assert.AreEqual(1, LVector.IndexOf(20)); 215 | Assert.AreEqual(2, LVector.IndexOf(30)); 216 | Assert.AreEqual(-1, LVector.IndexOf(40)); 217 | end; 218 | 219 | procedure TVectorTest.TestMerge; 220 | var 221 | LVector: TVector; 222 | begin 223 | LVector.Add(10); 224 | LVector.Add(20); 225 | LVector.Add(30); 226 | Assert.AreEqual(3, LVector.Length); 227 | LVector.Merge([20, 30, 40, 50]); 228 | Assert.AreEqual(5, LVector.Length); 229 | Assert.AreEqual(10, LVector[0]); 230 | Assert.AreEqual(20, LVector[1]); 231 | Assert.AreEqual(30, LVector[2]); 232 | Assert.AreEqual(40, LVector[3]); 233 | Assert.AreEqual(50, LVector[4]); 234 | end; 235 | 236 | procedure TVectorTest.TestFactorialCalculation; 237 | var 238 | LVector: TVector; 239 | LFactorial: Integer; 240 | begin 241 | // Arrange 242 | LVector := TVector.Create([1, 2, 3, 4, 5, 6, 7]); 243 | // Act 244 | LFactorial := LVector.Reduce(function(Acc: Integer; Item: Integer): Integer 245 | begin 246 | Result := Acc * Item; 247 | end, 1); 248 | // Assert 249 | Assert.AreEqual(5040, LFactorial, 'Factorial calculation is incorrect.'); 250 | end; 251 | 252 | procedure TVectorTest.TestFilter; 253 | var 254 | LVector: TVector; 255 | LArrayFiltered: TVector; 256 | begin 257 | LVector.Add(10); 258 | LVector.Add(20); 259 | LVector.Add(33); 260 | LVector.Add(40); 261 | LVector.Add(53); 262 | LArrayFiltered := LVector.Filter( 263 | function(AValue: Integer): Boolean 264 | begin 265 | Result := AValue mod 2 = 0; 266 | end 267 | ); 268 | Assert.AreEqual(3, LArrayFiltered.Length); 269 | Assert.AreEqual(10, LArrayFiltered[0]); 270 | Assert.AreEqual(20, LArrayFiltered[1]); 271 | Assert.AreEqual(40, LArrayFiltered[2]); 272 | end; 273 | 274 | procedure TVectorTest.TestFirst; 275 | var 276 | LVector: TVector; 277 | begin 278 | LVector.Add(10); 279 | LVector.Add(20); 280 | LVector.Add(30); 281 | Assert.AreEqual(10, LVector.First); 282 | end; 283 | 284 | procedure TVectorTest.TestFormatCPF; 285 | var 286 | LNumbers: TVector; 287 | LResult: Tuple; 288 | begin 289 | LNumbers := TVector.Create(TStd.Split('12345678900')); 290 | LResult := LNumbers.Filter(function(Value: String): Boolean 291 | begin 292 | Result := Pos(Value, '0123456789') > 0; 293 | end) 294 | .Filter(function(Value: String; Index: Integer): Boolean 295 | begin 296 | Result := Index <= 10; 297 | end) 298 | .Reduce(function(Arg1: String; Arg2: Tuple): Tuple 299 | var 300 | LPonto, LTraco, LCpf: String; 301 | begin 302 | LPonto := TStd.IfThen((Arg2[1].AsType = 3) or 303 | (Arg2[1].AsType = 6), '.', ''); 304 | LTraco := TStd.IfThen((Arg2[1].AsType = 9), '-', ''); 305 | LCpf := Arg2[0].AsType + LPonto + LTraco + Arg1; 306 | 307 | Result := [LCpf, Arg2[1].AsType + 1]; 308 | end, 309 | ['', 0]); 310 | 311 | Assert.AreEqual('123.456.789-00', LResult[0].AsType); 312 | end; 313 | 314 | procedure TVectorTest.TestLast; 315 | var 316 | LVector: TVector; 317 | begin 318 | LVector.Add(10); 319 | LVector.Add(20); 320 | LVector.Add(30); 321 | Assert.AreEqual(30, LVector.Last); 322 | end; 323 | 324 | procedure TVectorTest.TestAsType; 325 | var 326 | PTypeInfo: System.TypInfo.PTypeInfo; 327 | LVector: TVector; 328 | begin 329 | PTypeInfo := LVector.AsType; 330 | Assert.IsNotNull(PTypeInfo); 331 | end; 332 | 333 | procedure TVectorTest.TestAsList; 334 | var 335 | LVector: TVector; 336 | LList: TList; 337 | begin 338 | LVector.Add(10); 339 | LVector.Add(20); 340 | LVector.Add(30); 341 | LList := LVector.AsList; 342 | try 343 | Assert.IsNotNull(LList); 344 | Assert.AreEqual(LVector.Length, Integer(LList.Count)); 345 | Assert.AreEqual(LVector[0], LList[0]); 346 | Assert.AreEqual(LVector[1], LList[1]); 347 | Assert.AreEqual(LVector[2], LList[2]); 348 | finally 349 | LList.Free; 350 | end; 351 | end; 352 | 353 | procedure TVectorTest.TestToString; 354 | var 355 | LVector: TVector; 356 | LStr: String; 357 | begin 358 | LVector.Add(10); 359 | LVector.Add(20); 360 | LVector.Add(30); 361 | LStr := LVector.ToString; 362 | Assert.AreEqual('[10, 20, 30]', LStr); 363 | end; 364 | 365 | procedure TVectorTest.TestEnumerator; 366 | var 367 | LVector: TVector; 368 | Item: String; 369 | Last: String; 370 | begin 371 | LVector.Add('One'); 372 | LVector.Add('Two'); 373 | LVector.Add('Three'); 374 | for Item in LVector do 375 | begin 376 | Last := Item; 377 | end; 378 | Assert.AreEqual('Three', Last); 379 | end; 380 | 381 | initialization 382 | TDUnitX.RegisterTestFixture(TVectorTest); 383 | 384 | end. 385 | 386 | 387 | 388 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEclbr.IfThen.pas: -------------------------------------------------------------------------------- 1 | unit UTestecl.IfThen; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, ecl.ifthen; 7 | 8 | type 9 | [TestFixture] 10 | TestTIfThen = class 11 | public 12 | [Test] 13 | procedure TestIfThenWithTrueCondition; 14 | [Test] 15 | procedure TestIfThenWithFalseCondition; 16 | [Test] 17 | procedure TestIfThenWithFalseMultipleCondition; 18 | [Test] 19 | procedure TestWhenTrueThenString; 20 | [Test] 21 | procedure TestWhenTrueThenBoolean; 22 | [Test] 23 | procedure TestWithCondition; 24 | [Test] 25 | procedure TestWithConditionFunc; 26 | [Test] 27 | procedure TestIfThenWithMultipleElseOf; 28 | [Test] 29 | procedure TestMultipleIfThens; 30 | end; 31 | 32 | implementation 33 | 34 | procedure TestTIfThen.TestIfThenWithFalseMultipleCondition; 35 | var 36 | LValue: Integer; 37 | begin 38 | // ECLBr lib 39 | // ==========================Option 1 40 | LValue := TIfThen.When(-1 > 0).ThenOf(42).ElseOf(0 > 1, 45).ElseOf(1 > 0, 35).Return; 41 | 42 | // ==========================Option 2 43 | // LValue := TIfThen.When(-1 > 0) 44 | // .ThenOf(42) 45 | // .ElseOf(0 > 1, 45) 46 | // .ElseOf(1 > 0, 35) 47 | // .Return; 48 | 49 | // TRADICIONAL 50 | // =========================Option 1 51 | //if (-1 > 0) then LValue := 42 else if (0 > 1) then LValue := 45 else if (1 > 0) then LValue := 35; 52 | 53 | // =========================Option 2 54 | //if (-1 > 0) then LValue := 42 55 | //else if (0 > 1) then LValue := 45 56 | //else if (1 > 0) then LValue := 35; 57 | 58 | // =========================Option 3 59 | // if (-1 > 0) then 60 | // LValue := 42 61 | // else if 0 > 1 then 62 | // LValue := 45 63 | // else if 1 > 0 then 64 | // LValue := 35; 65 | 66 | Assert.AreEqual(35, LValue); 67 | end; 68 | 69 | procedure TestTIfThen.TestIfThenWithMultipleElseOf; 70 | var 71 | LResult: Integer; 72 | LValue: Integer; 73 | begin 74 | LValue := 500; 75 | 76 | LResult := TIfThen.When(False) 77 | .ThenOf(42) 78 | .ElseOf(LValue > 500, 79 | function: Integer 80 | begin 81 | Result := 99; 82 | end) 83 | .ElseOf(LValue < 1000, 84 | function: Integer 85 | begin 86 | Result := 1000; 87 | end) 88 | .Return; 89 | 90 | Assert.AreEqual(1000, LResult); 91 | end; 92 | 93 | procedure TestTIfThen.TestIfThenWithTrueCondition; 94 | var 95 | LValue: Integer; 96 | begin 97 | LValue := TIfThen.When(True).ThenOf(42).ElseOf(45).Return; 98 | 99 | Assert.AreEqual(42, LValue); 100 | end; 101 | 102 | procedure TestTIfThen.TestMultipleIfThens; 103 | var 104 | LResultValue1: Integer; 105 | LResultValue2: Integer; 106 | begin 107 | LResultValue1 := TIfThen 108 | .When( 109 | function: Boolean 110 | begin 111 | Result := True; 112 | end) 113 | .ThenOf( 114 | function: Integer 115 | begin 116 | Result := 42; 117 | end) 118 | .ElseOf( 119 | function: Integer 120 | begin 121 | Result := 99; 122 | end) 123 | .Return; 124 | 125 | Assert.AreEqual(42, LResultValue1); 126 | 127 | LResultValue2 := TIfThen 128 | .When( 129 | function: Boolean 130 | begin 131 | Result := True; 132 | end) 133 | .ThenOf( 134 | function: Integer 135 | begin 136 | Result := 99; 137 | end) 138 | .ElseOf( 139 | function: Integer 140 | begin 141 | Result := 42; 142 | end) 143 | .Return; 144 | 145 | Assert.AreEqual(99, LResultValue2); 146 | end; 147 | 148 | procedure TestTIfThen.TestWhenTrueThenBoolean; 149 | var 150 | LValue: Boolean; 151 | begin 152 | LValue := TIfThen.When(True) 153 | .ThenOf(True) 154 | .ElseOf(False) 155 | .Return; 156 | 157 | Assert.IsTrue(LValue); 158 | end; 159 | 160 | procedure TestTIfThen.TestWhenTrueThenString; 161 | var 162 | LValue: String; 163 | begin 164 | LValue := TIfThen.When(True) 165 | .ThenOf('True value') 166 | .ElseOf('False value') 167 | .Return; 168 | 169 | Assert.AreEqual('True value', LValue); 170 | end; 171 | 172 | procedure TestTIfThen.TestWithCondition; 173 | var 174 | ResultValue: Integer; 175 | begin 176 | ResultValue := TIfThen 177 | .When(True) 178 | .ThenOf( 179 | function: Integer 180 | begin 181 | Result := 42; 182 | end) 183 | .ElseOf( 184 | function: Integer 185 | begin 186 | Result := 99; 187 | end) 188 | .Return; 189 | 190 | Assert.AreEqual(42, ResultValue); 191 | end; 192 | 193 | procedure TestTIfThen.TestWithConditionFunc; 194 | var 195 | LResultValue: Integer; 196 | begin 197 | LResultValue := TIfThen 198 | .When( 199 | function: Boolean 200 | begin 201 | Result := True; 202 | end) 203 | .ThenOf( 204 | function: Integer 205 | begin 206 | Result := 42; 207 | end) 208 | .ElseOf( 209 | function: Integer 210 | begin 211 | Result := 99; 212 | end) 213 | .Return; 214 | 215 | Assert.AreEqual(42, LResultValue); 216 | end; 217 | 218 | procedure TestTIfThen.TestIfThenWithFalseCondition; 219 | var 220 | LValue: Integer; 221 | begin 222 | LValue := TIfThen.When(False).ThenOf(42).ElseOf(0).Return; 223 | 224 | Assert.AreEqual(0, LValue); 225 | end; 226 | 227 | initialization 228 | TDUnitX.RegisterTestFixture(TestTIfThen); 229 | 230 | end. 231 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.Currying.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEvolution.Currying.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.DotEnv.pas: -------------------------------------------------------------------------------- 1 | unit UTestEvolution.DotEnv; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | Classes, 8 | SysUtils, 9 | System.Evolution.DotEnv; 10 | 11 | type 12 | [TestFixture] 13 | TTestDotEnv = class 14 | private 15 | FEnv: TDotEnv; 16 | FTempFile: String; 17 | public 18 | [Setup] 19 | procedure Setup; 20 | [TearDown] 21 | procedure TearDown; 22 | [Test] 23 | procedure TestCreateLoadsFile; 24 | [Test] 25 | procedure TestAddAndGetValue; 26 | [Test] 27 | procedure TestGetOrDefault; 28 | [Test] 29 | procedure TestSaveToFile; 30 | [Test] 31 | procedure TestDeleteVariable; 32 | [Test] 33 | procedure TestEnvCreateAndLoad; 34 | [Test] 35 | procedure TestEnvUpdate; 36 | [Test] 37 | procedure TestEnvDelete; 38 | [Test] 39 | procedure TestPropertyAccess; 40 | [Test] 41 | procedure TestPushChaining; 42 | [Test] 43 | procedure TestEmptyFile; 44 | [Test] 45 | procedure TestInterpolation; 46 | [Test] 47 | procedure TestLoadFiles; 48 | [Test] 49 | procedure TestTryGet; 50 | [Test] 51 | procedure TestSystemFallback; 52 | end; 53 | 54 | implementation 55 | 56 | procedure TTestDotEnv.Setup; 57 | begin 58 | FTempFile := 'test.env'; 59 | FEnv := TDotEnv.Create(FTempFile); 60 | Writeln('Setup: Created TDotEnv with file ' + FTempFile); 61 | end; 62 | 63 | procedure TTestDotEnv.TearDown; 64 | begin 65 | FEnv.Free; 66 | if FileExists(FTempFile) then 67 | DeleteFile(FTempFile); 68 | if FileExists('test1.env') then 69 | DeleteFile('test1.env'); 70 | if FileExists('test2.env') then 71 | DeleteFile('test2.env'); 72 | Writeln('TearDown: Freed TDotEnv and deleted temp files'); 73 | end; 74 | 75 | procedure TTestDotEnv.TestCreateLoadsFile; 76 | var 77 | LLines: TStringList; 78 | begin 79 | LLines := TStringList.Create; 80 | try 81 | LLines.Add(' PORT = 8080 '); 82 | LLines.Add('# Comment'); 83 | LLines.Add('HOST=localhost'); 84 | LLines.SaveToFile(FTempFile); 85 | Writeln('TestCreateLoadsFile: Created test.env with PORT=8080, HOST=localhost'); 86 | finally 87 | LLines.Free; 88 | end; 89 | 90 | FEnv.Free; 91 | FEnv := TDotEnv.Create(FTempFile); 92 | Writeln('TestCreateLoadsFile: Loaded file, Variables Count = ' + IntToStr(FEnv.Count)); 93 | 94 | Assert.AreEqual(8080, FEnv.Get('PORT'), 'PORT should be 8080'); 95 | Writeln('TestCreateLoadsFile: PORT = ' + IntToStr(FEnv.Get('PORT'))); 96 | Assert.AreEqual('localhost', FEnv.Get('HOST'), 'HOST should be localhost'); 97 | Writeln('TestCreateLoadsFile: HOST = ' + FEnv.Get('HOST')); 98 | end; 99 | 100 | procedure TTestDotEnv.TestAddAndGetValue; 101 | begin 102 | FEnv.Add('DB', 'mysql'); 103 | Writeln('TestAddAndGetValue: Added DB=mysql'); 104 | Assert.AreEqual('mysql', FEnv.Value('DB'), 'DB should be mysql'); 105 | Writeln('TestAddAndGetValue: DB = ' + FEnv.Value('DB')); 106 | end; 107 | 108 | procedure TTestDotEnv.TestGetOrDefault; 109 | begin 110 | Assert.AreEqual(8080, FEnv.GetOr('PORT', 8080), 'PORT should default to 8080'); 111 | Writeln('TestGetOrDefault: PORT (default) = ' + IntToStr(FEnv.GetOr('PORT', 8080))); 112 | FEnv.Add('PORT', 3000); 113 | Assert.AreEqual(3000, FEnv.GetOr('PORT', 8080), 'PORT should be 3000'); 114 | Writeln('TestGetOrDefault: PORT (set) = ' + IntToStr(FEnv.GetOr('PORT', 8080))); 115 | end; 116 | 117 | procedure TTestDotEnv.TestSaveToFile; 118 | var 119 | LLines: TStringList; 120 | begin 121 | FEnv.Add('PORT', 8080); 122 | FEnv.Add('HOST', 'localhost'); 123 | FEnv.Save; 124 | Writeln('TestSaveToFile: Saved PORT=8080, HOST=localhost to ' + FTempFile); 125 | 126 | LLines := TStringList.Create; 127 | try 128 | LLines.LoadFromFile(FTempFile); 129 | Assert.AreEqual(2, LLines.Count, 'File should have 2 lines'); 130 | Assert.AreEqual('PORT=8080', LLines[0], 'First line should be PORT=8080'); 131 | Assert.AreEqual('HOST=localhost', LLines[1], 'Second line should be HOST=localhost'); 132 | Writeln('TestSaveToFile: File lines = ' + LLines.Text); 133 | finally 134 | LLines.Free; 135 | end; 136 | end; 137 | 138 | procedure TTestDotEnv.TestDeleteVariable; 139 | begin 140 | FEnv.Add('PORT', 8080); 141 | Writeln('TestDeleteVariable: Added PORT=8080'); 142 | FEnv.Delete('PORT'); 143 | Writeln('TestDeleteVariable: Deleted PORT'); 144 | Assert.WillRaise( 145 | procedure begin FEnv.Value('PORT') end, 146 | Exception, 147 | 'PORT should be gone' 148 | ); 149 | end; 150 | 151 | procedure TTestDotEnv.TestEnvCreateAndLoad; 152 | begin 153 | FEnv.EnvCreate('TEST_VAR', '123'); 154 | Writeln('TestEnvCreateAndLoad: Created TEST_VAR=123'); 155 | Assert.AreEqual('123', FEnv.EnvLoad('TEST_VAR'), 'TEST_VAR should be 123'); 156 | Writeln('TestEnvCreateAndLoad: Loaded TEST_VAR = ' + FEnv.EnvLoad('TEST_VAR')); 157 | end; 158 | 159 | procedure TTestDotEnv.TestEnvUpdate; 160 | begin 161 | FEnv.EnvCreate('TEST_VAR', '123'); 162 | Writeln('TestEnvUpdate: Created TEST_VAR=123'); 163 | FEnv.EnvUpdate('TEST_VAR', '456'); 164 | Writeln('TestEnvUpdate: Updated TEST_VAR=456'); 165 | Assert.AreEqual('456', FEnv.EnvLoad('TEST_VAR'), 'TEST_VAR should be updated to 456'); 166 | Writeln('TestEnvUpdate: Loaded TEST_VAR = ' + FEnv.EnvLoad('TEST_VAR')); 167 | end; 168 | 169 | procedure TTestDotEnv.TestEnvDelete; 170 | begin 171 | FEnv.EnvCreate('TEST_VAR', '123'); 172 | Writeln('TestEnvDelete: Created TEST_VAR=123'); 173 | FEnv.EnvDelete('TEST_VAR'); 174 | Writeln('TestEnvDelete: Deleted TEST_VAR'); 175 | Assert.AreEqual('', FEnv.EnvLoad('TEST_VAR'), 'TEST_VAR should be deleted'); 176 | Writeln('TestEnvDelete: Loaded TEST_VAR = ' + FEnv.EnvLoad('TEST_VAR')); 177 | end; 178 | 179 | procedure TTestDotEnv.TestPropertyAccess; 180 | begin 181 | FEnv.Add('PORT', 8080); 182 | Writeln('TestPropertyAccess: Added PORT=8080'); 183 | Assert.AreEqual(8080, FEnv['PORT'].AsInteger, 'Property access should return 8080'); 184 | Writeln('TestPropertyAccess: PORT = ' + IntToStr(FEnv['PORT'].AsInteger)); 185 | end; 186 | 187 | procedure TTestDotEnv.TestPushChaining; 188 | begin 189 | FEnv.Push('PORT', 8080).Push('HOST', 'localhost'); 190 | Writeln('TestPushChaining: Pushed PORT=8080, HOST=localhost'); 191 | Assert.AreEqual(8080, FEnv['PORT'].AsInteger, 'PORT should be 8080'); 192 | Assert.AreEqual('localhost', FEnv['HOST'].AsString, 'HOST should be localhost'); 193 | Writeln('TestPushChaining: PORT = ' + IntToStr(FEnv['PORT'].AsInteger) + ', HOST = ' + FEnv['HOST'].AsString); 194 | end; 195 | 196 | procedure TTestDotEnv.TestEmptyFile; 197 | begin 198 | if FileExists(FTempFile) then 199 | DeleteFile(FTempFile); 200 | Writeln('TestEmptyFile: Ensured no file exists'); 201 | 202 | FEnv.Free; 203 | FEnv := TDotEnv.Create(FTempFile); 204 | Writeln('TestEmptyFile: Created with no file'); 205 | 206 | Assert.AreEqual(0, FEnv.Count, 'Variables should be empty'); 207 | Writeln('TestEmptyFile: Variables Count = ' + IntToStr(FEnv.Count)); 208 | end; 209 | 210 | procedure TTestDotEnv.TestInterpolation; 211 | begin 212 | FEnv.Push('USER', 'admin').Push('DB', 'postgres://${USER}@localhost'); 213 | Writeln('TestInterpolation: Pushed USER=admin, DB=postgres://${USER}@localhost'); 214 | Assert.AreEqual('postgres://admin@localhost', FEnv['DB'].AsString, 'DB should interpolate USER'); 215 | Writeln('TestInterpolation: DB = ' + FEnv['DB'].AsString); 216 | end; 217 | 218 | procedure TTestDotEnv.TestLoadFiles; 219 | var 220 | LLines: TStringList; 221 | begin 222 | LLines := TStringList.Create; 223 | try 224 | LLines.Add('PORT=8080'); 225 | LLines.SaveToFile('test1.env'); 226 | Writeln('TestLoadFiles: Created test1.env with PORT=8080'); 227 | LLines.Clear; 228 | LLines.Add('PORT=3000'); 229 | LLines.Add('HOST=localhost'); 230 | LLines.SaveToFile('test2.env'); 231 | Writeln('TestLoadFiles: Created test2.env with PORT=3000, HOST=localhost'); 232 | finally 233 | LLines.Free; 234 | end; 235 | 236 | FEnv.Free; 237 | FEnv := TDotEnv.Create; 238 | FEnv.LoadFiles(['test1.env', 'test2.env']); 239 | Writeln('TestLoadFiles: Loaded test1.env and test2.env'); 240 | 241 | Assert.AreEqual(3000, FEnv.Get('PORT'), 'PORT should be 3000 from test2.env'); 242 | Assert.AreEqual('localhost', FEnv.Get('HOST'), 'HOST should be localhost from test2.env'); 243 | Writeln('TestLoadFiles: PORT = ' + IntToStr(FEnv.Get('PORT')) + ', HOST = ' + FEnv.Get('HOST')); 244 | end; 245 | 246 | procedure TTestDotEnv.TestTryGet; 247 | var 248 | LPort: Integer; 249 | begin 250 | FEnv.Push('PORT', 8080); 251 | Writeln('TestTryGet: Pushed PORT=8080'); 252 | Assert.IsTrue(FEnv.TryGet('PORT', LPort), 'TryGet should succeed'); 253 | Assert.AreEqual(8080, LPort, 'PORT should be 8080'); 254 | Writeln('TestTryGet: PORT = ' + IntToStr(LPort)); 255 | 256 | Assert.IsFalse(FEnv.TryGet('MISSING', LPort), 'TryGet should fail'); 257 | Writeln('TestTryGet: MISSING not found, LPort = ' + IntToStr(LPort)); 258 | end; 259 | 260 | procedure TTestDotEnv.TestSystemFallback; 261 | begin 262 | FEnv.EnvCreate('SYSTEM_VAR', 'test'); 263 | Writeln('TestSystemFallback: Created SYSTEM_VAR=test in system'); 264 | 265 | FEnv.Free; 266 | FEnv := TDotEnv.Create(FTempFile, True); // Com fallback 267 | Assert.AreEqual('test', FEnv.Get('SYSTEM_VAR'), 'Should fallback to system'); 268 | Writeln('TestSystemFallback: With fallback, SYSTEM_VAR = ' + FEnv.Get('SYSTEM_VAR')); 269 | 270 | FEnv.Free; 271 | FEnv := TDotEnv.Create(FTempFile, False); // Sem fallback 272 | Assert.WillRaise( 273 | procedure begin FEnv.Value('SYSTEM_VAR') end, 274 | Exception, 275 | 'Should not fallback to system' 276 | ); 277 | Writeln('TestSystemFallback: Without fallback, SYSTEM_VAR not found'); 278 | end; 279 | 280 | initialization 281 | TDUnitX.RegisterTestFixture(TTestDotEnv); 282 | 283 | end. 284 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.Match.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEvolution.Match.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.Muttle.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEvolution.Muttle.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.Option.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEvolution.Option.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.SafeTry.pas: -------------------------------------------------------------------------------- 1 | unit UTestEvolution.SafeTry; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | System.Evolution.Safetry, 8 | SysUtils, 9 | Rtti; 10 | 11 | type 12 | [TestFixture] 13 | TTestSafeTry = class 14 | public 15 | [Test] 16 | procedure TestTryExceptFinally_Ok; 17 | [Test] 18 | procedure TestTryExceptFinally_Exception; 19 | [Test] 20 | procedure TestTryOnly_Ok; 21 | [Test] 22 | procedure TestTryOnly_Exception; 23 | [Test] 24 | procedure TestTryFinally_Ok; 25 | [Test] 26 | procedure TestTryFinally_Exception; 27 | [Test] 28 | procedure TestFinallyOnly; 29 | [Test] 30 | procedure TestNoTry; 31 | [Test] 32 | procedure TestEndWithoutException; 33 | [Test] 34 | procedure TestEndWithException; 35 | [Test] 36 | procedure TestTryFuncInteger_Ok; 37 | [Test] 38 | procedure TestTryFuncInteger_Exception; 39 | [Test] 40 | procedure TestTryFuncString_Ok; 41 | [Test] 42 | procedure TestTryFuncString_Exception; 43 | [Test] 44 | procedure TestTryFuncDouble_Ok; 45 | [Test] 46 | procedure TestTryFuncDouble_Exception; 47 | end; 48 | 49 | implementation 50 | 51 | procedure TTestSafeTry.TestTryExceptFinally_Ok; 52 | var 53 | LResult: TSafeResult; 54 | begin 55 | LResult := &Try(procedure 56 | begin 57 | WriteLn('Executando try'); 58 | end) 59 | .&Except(procedure(E: Exception) 60 | begin 61 | WriteLn('Executando except'); 62 | end) 63 | .&Finally(procedure 64 | begin 65 | WriteLn('Executando finally'); 66 | end) 67 | .&End; 68 | 69 | Assert.IsTrue(LResult.IsOk); 70 | Assert.IsFalse(LResult.IsErr); 71 | Assert.IsTrue(LResult.AsType); 72 | end; 73 | 74 | procedure TTestSafeTry.TestTryExceptFinally_Exception; 75 | var 76 | LResult: TSafeResult; 77 | begin 78 | LResult := &Try(procedure 79 | begin 80 | raise Exception.Create('Erro no bloco try'); 81 | end) 82 | .&Except(procedure(E: Exception) 83 | begin 84 | WriteLn('Executando except'); 85 | end) 86 | .&Finally(procedure 87 | begin 88 | WriteLn('Executando finally'); 89 | end) 90 | .&End; 91 | 92 | Assert.IsTrue(LResult.IsErr); 93 | Assert.AreEqual('Erro no bloco try', LResult.ExceptionMessage); 94 | end; 95 | 96 | procedure TTestSafeTry.TestTryOnly_Ok; 97 | var 98 | LResult: TSafeResult; 99 | begin 100 | LResult := &Try(procedure 101 | begin 102 | WriteLn('Executando try'); 103 | end) 104 | .&End; 105 | 106 | Assert.IsTrue(LResult.IsOk); 107 | Assert.IsFalse(LResult.IsErr); 108 | Assert.IsTrue(LResult.AsType); 109 | end; 110 | 111 | procedure TTestSafeTry.TestTryOnly_Exception; 112 | var 113 | LResult: TSafeResult; 114 | begin 115 | LResult := &Try(procedure 116 | begin 117 | raise Exception.Create('Erro no bloco try'); 118 | end) 119 | .&End; 120 | 121 | Assert.IsTrue(LResult.IsErr); 122 | Assert.AreEqual('Erro no bloco try', LResult.ExceptionMessage); 123 | end; 124 | 125 | procedure TTestSafeTry.TestTryFinally_Ok; 126 | var 127 | LResult: TSafeResult; 128 | begin 129 | LResult := &Try(procedure 130 | begin 131 | WriteLn('Executando try'); 132 | end) 133 | .&Finally(procedure 134 | begin 135 | WriteLn('Executando finally'); 136 | end) 137 | .&End; 138 | 139 | Assert.IsTrue(LResult.IsOk); 140 | Assert.IsFalse(LResult.IsErr); 141 | Assert.IsTrue(LResult.AsType); 142 | end; 143 | 144 | procedure TTestSafeTry.TestTryFinally_Exception; 145 | var 146 | LResult: TSafeResult; 147 | begin 148 | LResult := &Try(procedure 149 | begin 150 | raise Exception.Create('Erro no bloco try'); 151 | end) 152 | .&Finally(procedure 153 | begin 154 | WriteLn('Executando finally'); 155 | end) 156 | .&End; 157 | 158 | Assert.IsTrue(LResult.IsErr); 159 | Assert.AreEqual('Erro no bloco try', LResult.ExceptionMessage); 160 | end; 161 | 162 | procedure TTestSafeTry.TestFinallyOnly; 163 | var 164 | LResult: TSafeResult; 165 | begin 166 | LResult := &Try 167 | .&Finally(procedure 168 | begin 169 | WriteLn('Executando finally'); 170 | end) 171 | .&End; 172 | 173 | Assert.IsTrue(LResult.IsOk); 174 | Assert.IsFalse(LResult.IsErr); 175 | Assert.IsTrue(LResult.AsType); 176 | end; 177 | 178 | procedure TTestSafeTry.TestNoTry; 179 | var 180 | LResult: TSafeResult; 181 | begin 182 | LResult := &Try 183 | .&End; 184 | 185 | Assert.IsTrue(LResult.IsOk); 186 | Assert.IsFalse(LResult.IsErr); 187 | Assert.IsTrue(LResult.AsType); 188 | end; 189 | 190 | procedure TTestSafeTry.TestEndWithoutException; 191 | var 192 | LResult: TSafeResult; 193 | begin 194 | LResult := &Try(procedure 195 | begin 196 | WriteLn('Executando try'); 197 | end) 198 | .&End; 199 | 200 | Assert.IsTrue(LResult.IsOk); 201 | Assert.IsFalse(LResult.IsErr); 202 | Assert.IsTrue(LResult.AsType); 203 | end; 204 | 205 | procedure TTestSafeTry.TestEndWithException; 206 | var 207 | LResult: TSafeResult; 208 | begin 209 | LResult := &Try(procedure 210 | begin 211 | raise Exception.Create('Erro no bloco try'); 212 | end) 213 | .&End; 214 | 215 | Assert.IsTrue(LResult.IsErr); 216 | Assert.AreEqual('Erro no bloco try', LResult.ExceptionMessage); 217 | end; 218 | 219 | procedure TTestSafeTry.TestTryFuncInteger_Ok; 220 | var 221 | LResult: TSafeResult; 222 | begin 223 | LResult := &Try(function: TValue 224 | begin 225 | WriteLn('Executando try com Integer'); 226 | Result := 42; 227 | end) 228 | .&End; 229 | 230 | Assert.IsTrue(LResult.IsOk); 231 | Assert.IsFalse(LResult.IsErr); 232 | Assert.AreEqual(42, LResult.AsType); 233 | end; 234 | 235 | procedure TTestSafeTry.TestTryFuncInteger_Exception; 236 | var 237 | LResult: TSafeResult; 238 | begin 239 | LResult := &Try(function: TValue 240 | begin 241 | raise Exception.Create('Erro no bloco try com Integer'); 242 | Result := 42; 243 | end) 244 | .&End; 245 | 246 | Assert.IsTrue(LResult.IsErr); 247 | Assert.AreEqual('Erro no bloco try com Integer', LResult.ExceptionMessage); 248 | end; 249 | 250 | procedure TTestSafeTry.TestTryFuncString_Ok; 251 | var 252 | LResult: TSafeResult; 253 | begin 254 | LResult := &Try(function: TValue 255 | begin 256 | WriteLn('Executando try com String'); 257 | Result := 'Hello, SafeTry!'; 258 | end) 259 | .&End; 260 | 261 | Assert.IsTrue(LResult.IsOk); 262 | Assert.IsFalse(LResult.IsErr); 263 | Assert.AreEqual('Hello, SafeTry!', LResult.AsType); 264 | end; 265 | 266 | procedure TTestSafeTry.TestTryFuncString_Exception; 267 | var 268 | LResult: TSafeResult; 269 | begin 270 | LResult := &Try(function: TValue 271 | begin 272 | raise Exception.Create('Erro no bloco try com String'); 273 | Result := 'Hello, SafeTry!'; 274 | end) 275 | .&End; 276 | 277 | Assert.IsTrue(LResult.IsErr); 278 | Assert.AreEqual('Erro no bloco try com String', LResult.ExceptionMessage); 279 | end; 280 | 281 | procedure TTestSafeTry.TestTryFuncDouble_Ok; 282 | var 283 | LResult: TSafeResult; 284 | LValue: Double; 285 | begin 286 | LValue := 3.14; 287 | LResult := &Try(function: TValue 288 | begin 289 | WriteLn('Executando try com Double'); 290 | Result := 3.14; 291 | end) 292 | .&End; 293 | 294 | Assert.IsTrue(LResult.IsOk); 295 | Assert.IsFalse(LResult.IsErr); 296 | Assert.AreEqual(LValue, LResult.AsType); 297 | end; 298 | 299 | procedure TTestSafeTry.TestTryFuncDouble_Exception; 300 | var 301 | LResult: TSafeResult; 302 | begin 303 | LResult := &Try(function: TValue 304 | begin 305 | raise Exception.Create('Erro no bloco try com Double'); 306 | Result := 3.14; 307 | end) 308 | .&End; 309 | 310 | Assert.IsTrue(LResult.IsErr); 311 | Assert.AreEqual('Erro no bloco try com Double', LResult.ExceptionMessage); 312 | end; 313 | 314 | initialization 315 | TDUnitX.RegisterTestFixture(TTestSafeTry); 316 | 317 | end. 318 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.Std.pas: -------------------------------------------------------------------------------- 1 | unit UTestEvolution.Std; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | SysUtils, 8 | DateUtils, 9 | StrUtils, 10 | Classes, 11 | Generics.Collections, 12 | Evolution.Objects, 13 | Evolution.System, 14 | Evolution.Std, 15 | Evolution.Crypt; 16 | 17 | type 18 | [TestFixture] 19 | TTestStd = class 20 | public 21 | [Setup] 22 | procedure Setup; 23 | [TearDown] 24 | procedure TearDown; 25 | [Test] 26 | procedure TestJoinStrings_StringArray; 27 | [Test] 28 | procedure TestJoinStrings_StringList; 29 | [Test] 30 | procedure TestRemoveTrailingChars; 31 | [Test] 32 | procedure TestIso8601ToDateTime; 33 | [Test] 34 | procedure TestDateTimeToIso8601; 35 | [Test] 36 | procedure TestDecodeBase64; 37 | [Test] 38 | procedure TestEncodeBase64; 39 | [Test] 40 | procedure TestEncodeString; 41 | [Test] 42 | procedure TestDecodeString; 43 | [Test] 44 | procedure TestMinInteger; 45 | [Test] 46 | procedure TestMinDouble; 47 | [Test] 48 | procedure TestMinCurrency; 49 | [Test] 50 | procedure TestSplit; 51 | end; 52 | 53 | implementation 54 | 55 | procedure TTestStd.Setup; 56 | begin 57 | Writeln('Setup: Initializing test environment'); 58 | end; 59 | 60 | procedure TTestStd.TearDown; 61 | begin 62 | Writeln('TearDown: Cleaning up test environment'); 63 | end; 64 | 65 | procedure TTestStd.TestJoinStrings_StringArray; 66 | var 67 | LStrings: TArray; 68 | LSeparator, LResultString: String; 69 | begin 70 | Writeln('TestJoinStrings_StringArray: Starting join test'); 71 | LStrings := TArray.Create('Hello', 'World', 'DUnitX', 'Testing'); 72 | Writeln('TestJoinStrings_StringArray: Input array = [Hello, World, DUnitX, Testing]'); 73 | LSeparator := ', '; 74 | LResultString := TStd.JoinStrings(LStrings, LSeparator); 75 | Assert.AreEqual('Hello, World, DUnitX, Testing', LResultString, 'Joined string should match'); 76 | Writeln('TestJoinStrings_StringArray: Joined string = ' + LResultString); 77 | end; 78 | 79 | procedure TTestStd.TestJoinStrings_StringList; 80 | var 81 | LSeparator, LResultString: String; 82 | LIAutoRef: TSmartPtr; 83 | begin 84 | Writeln('TestJoinStrings_StringList: Starting join test'); 85 | LIAutoRef := TListString.Create; 86 | LIAutoRef.AsRef.Add('Hello'); 87 | LIAutoRef.AsRef.Add('World'); 88 | LIAutoRef.AsRef.Add('DUnitX'); 89 | LIAutoRef.AsRef.Add('Testing'); 90 | Writeln('TestJoinStrings_StringList: Input list = [Hello, World, DUnitX, Testing]'); 91 | LSeparator := ', '; 92 | LResultString := TStd.JoinStrings(LIAutoRef.AsRef, LSeparator); 93 | Assert.AreEqual('Hello, World, DUnitX, Testing', LResultString, 'Joined string should match'); 94 | Writeln('TestJoinStrings_StringList: Joined string = ' + LResultString); 95 | end; 96 | 97 | procedure TTestStd.TestRemoveTrailingChars; 98 | var 99 | LInputString, LResultString: String; 100 | LTrailingChars: TSysCharSet; 101 | begin 102 | Writeln('TestRemoveTrailingChars: Starting remove test'); 103 | LInputString := 'Hello, World!!!'; 104 | Writeln('TestRemoveTrailingChars: Input string = ' + LInputString); 105 | LTrailingChars := ['!', ',']; 106 | LResultString := TStd.RemoveTrailingChars(LInputString, LTrailingChars); 107 | Assert.AreEqual('Hello, World', LResultString, 'String should have trailing chars removed'); 108 | Writeln('TestRemoveTrailingChars: Result string = ' + LResultString); 109 | end; 110 | 111 | procedure TTestStd.TestIso8601ToDateTime; 112 | var 113 | LIso8601DateString: String; 114 | LResultDateTime: TDateTime; 115 | begin 116 | Writeln('TestIso8601ToDateTime: Starting ISO conversion test'); 117 | LIso8601DateString := '2023-09-26T14:30:00'; 118 | Writeln('TestIso8601ToDateTime: Input ISO string = ' + LIso8601DateString); 119 | LResultDateTime := TStd.Iso8601ToDateTime(LIso8601DateString, True); 120 | Assert.AreEqual(2023, YearOf(LResultDateTime), 'Year should be 2023'); 121 | Assert.AreEqual(9, MonthOf(LResultDateTime), 'Month should be 9'); 122 | Assert.AreEqual(26, DayOf(LResultDateTime), 'Day should be 26'); 123 | Assert.AreEqual(14, HourOf(LResultDateTime), 'Hour should be 14'); 124 | Assert.AreEqual(30, MinuteOf(LResultDateTime), 'Minute should be 30'); 125 | Assert.AreEqual(0, SecondOf(LResultDateTime), 'Second should be 0'); 126 | Writeln('TestIso8601ToDateTime: Converted datetime = ' + DateTimeToStr(LResultDateTime)); 127 | end; 128 | 129 | procedure TTestStd.TestDateTimeToIso8601; 130 | var 131 | LInputDateTime: TDateTime; 132 | LResultString: String; 133 | begin 134 | Writeln('TestDateTimeToIso8601: Starting ISO conversion test'); 135 | LInputDateTime := EncodeDateTime(2023, 9, 26, 14, 30, 0, 0); 136 | Writeln('TestDateTimeToIso8601: Input datetime = ' + DateTimeToStr(LInputDateTime)); 137 | LResultString := TStd.DateTimeToIso8601(LInputDateTime, True); 138 | Assert.AreEqual('2023-09-26T14:30:00', LResultString, 'ISO string should match'); 139 | Writeln('TestDateTimeToIso8601: Result ISO string = ' + LResultString); 140 | end; 141 | 142 | procedure TTestStd.TestDecodeBase64; 143 | var 144 | LInputBase64: String; 145 | LResultBytes: TBytes; 146 | LDecodedString: String; 147 | begin 148 | Writeln('TestDecodeBase64: Starting decode test'); 149 | LInputBase64 := 'SGVsbG8sIFdvcmxkIQ=='; 150 | Writeln('TestDecodeBase64: Input base64 = ' + LInputBase64); 151 | LResultBytes := TCrypt.DecodeBase64(LInputBase64); 152 | LDecodedString := StringOf(LResultBytes); 153 | Assert.AreEqual('Hello, World!', LDecodedString, 'Decoded string should match'); 154 | Writeln('TestDecodeBase64: Decoded string = ' + LDecodedString); 155 | end; 156 | 157 | procedure TTestStd.TestEncodeBase64; 158 | var 159 | LInputData: TBytes; 160 | LResultString: String; 161 | begin 162 | Writeln('TestEncodeBase64: Starting encode test'); 163 | SetLength(LInputData, 13); 164 | LInputData[0] := Ord('H'); LInputData[1] := Ord('e'); LInputData[2] := Ord('l'); 165 | LInputData[3] := Ord('l'); LInputData[4] := Ord('o'); LInputData[5] := Ord(','); 166 | LInputData[6] := Ord(' '); LInputData[7] := Ord('W'); LInputData[8] := Ord('o'); 167 | LInputData[9] := Ord('r'); LInputData[10] := Ord('l'); LInputData[11] := Ord('d'); 168 | LInputData[12] := Ord('!'); 169 | Writeln('TestEncodeBase64: Input string = Hello, World!'); 170 | LResultString := TCrypt.EncodeBase64(@LInputData[0], Length(LInputData)); 171 | Assert.AreEqual('SGVsbG8sIFdvcmxkIQ==', LResultString, 'Encoded base64 should match'); 172 | Writeln('TestEncodeBase64: Encoded base64 = ' + LResultString); 173 | end; 174 | 175 | procedure TTestStd.TestEncodeString; 176 | var 177 | LInputString, LResultString: String; 178 | begin 179 | Writeln('TestEncodeString: Starting encode test'); 180 | LInputString := 'Hello, World!'; 181 | Writeln('TestEncodeString: Input string = ' + LInputString); 182 | LResultString := TCrypt.EncodeString(LInputString); 183 | Assert.AreEqual('SGVsbG8sIFdvcmxkIQ==', LResultString, 'Encoded base64 should match'); 184 | Writeln('TestEncodeString: Encoded base64 = ' + LResultString); 185 | end; 186 | 187 | procedure TTestStd.TestDecodeString; 188 | var 189 | LInputString, LResultString: String; 190 | begin 191 | Writeln('TestDecodeString: Starting decode test'); 192 | LInputString := 'SGVsbG8sIFdvcmxkIQ=='; 193 | Writeln('TestDecodeString: Input base64 = ' + LInputString); 194 | LResultString := TCrypt.DecodeString(LInputString); 195 | Assert.AreEqual('Hello, World!', LResultString, 'Decoded string should match'); 196 | Writeln('TestDecodeString: Decoded string = ' + LResultString); 197 | end; 198 | 199 | procedure TTestStd.TestMinInteger; 200 | var 201 | LA, LB, LResultValue: Integer; 202 | begin 203 | Writeln('TestMinInteger: Starting min test'); 204 | LA := 5; LB := 10; 205 | Writeln('TestMinInteger: Input A = ' + IntToStr(LA) + ', B = ' + IntToStr(LB)); 206 | LResultValue := TStd.Min(LA, LB); 207 | Assert.AreEqual(5, LResultValue, 'Min(A, B) should return 5'); 208 | Writeln('TestMinInteger: Min result = ' + IntToStr(LResultValue)); 209 | end; 210 | 211 | procedure TTestStd.TestMinDouble; 212 | var 213 | LA, LB, LResultValue: Double; 214 | begin 215 | Writeln('TestMinDouble: Starting min test'); 216 | LA := 3.14; LB := 2.71; 217 | Writeln('TestMinDouble: Input A = ' + FloatToStr(LA) + ', B = ' + FloatToStr(LB)); 218 | LResultValue := TStd.Min(LA, LB); 219 | Assert.AreEqual(2.71, LResultValue, 0.001, 'Min(A, B) should return 2.71'); 220 | Writeln('TestMinDouble: Min result = ' + FloatToStr(LResultValue)); 221 | end; 222 | 223 | procedure TTestStd.TestMinCurrency; 224 | var 225 | LA, LB, LResultValue: Currency; 226 | begin 227 | Writeln('TestMinCurrency: Starting min test'); 228 | LA := 100.50; LB := 99.99; 229 | Writeln('TestMinCurrency: Input A = ' + CurrToStr(LA) + ', B = ' + CurrToStr(LB)); 230 | LResultValue := TStd.Min(LA, LB); 231 | Assert.AreEqual(Currency(99.99), LResultValue, 'Min(A, B) should return 99.99'); 232 | Writeln('TestMinCurrency: Min result = ' + CurrToStr(LResultValue)); 233 | end; 234 | 235 | procedure TTestStd.TestSplit; 236 | var 237 | LS: String; 238 | LResultArray: TArray; 239 | LFor: Integer; 240 | begin 241 | Writeln('TestSplit: Starting split test'); 242 | LS := 'Hello,World'; 243 | Writeln('TestSplit: Input string = ' + LS); 244 | LResultArray := TStd.Split(LS); 245 | Assert.AreEqual(11, Length(LResultArray), 'Split should return 11 elements'); 246 | Writeln('TestSplit: Split array length = ' + IntToStr(Length(LResultArray))); 247 | Assert.AreEqual('H', LResultArray[0], 'Element[0] should be "H"'); 248 | Assert.AreEqual('e', LResultArray[1], 'Element[1] should be "e"'); 249 | Assert.AreEqual('l', LResultArray[2], 'Element[2] should be "l"'); 250 | Assert.AreEqual('l', LResultArray[3], 'Element[3] should be "l"'); 251 | Assert.AreEqual('o', LResultArray[4], 'Element[4] should be "o"'); 252 | Assert.AreEqual(',', LResultArray[5], 'Element[5] should be ","'); 253 | Assert.AreEqual('W', LResultArray[6], 'Element[6] should be "W"'); 254 | Assert.AreEqual('o', LResultArray[7], 'Element[7] should be "o"'); 255 | Assert.AreEqual('r', LResultArray[8], 'Element[8] should be "r"'); 256 | Assert.AreEqual('l', LResultArray[9], 'Element[9] should be "l"'); 257 | Assert.AreEqual('d', LResultArray[10], 'Element[10] should be "d"'); 258 | for LFor := 0 to High(LResultArray) do 259 | Writeln('TestSplit: Element[' + IntToStr(LFor) + '] = ' + LResultArray[LFor]); 260 | end; 261 | 262 | initialization 263 | TDUnitX.RegisterTestFixture(TTestStd); 264 | 265 | end. 266 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.Threading.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEvolution.Threading.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolution.Tuple.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEvolution.Tuple.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/UTestEvolutoin.Objects.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/UTestEvolutoin.Objects.pas -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/Win32/Debug/dunitx-results.xml: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/dunitx-results.xml: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | -------------------------------------------------------------------------------- /Test Delphi/EclbrSystem/libFastMM_FullDebugMode.dylib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ModernDelphiWorks/evolution4d/d0bdd93a977fe30d044f665c4f25297c1d0b9ca4/Test Delphi/EclbrSystem/libFastMM_FullDebugMode.dylib -------------------------------------------------------------------------------- /boss-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "hash": "d41d8cd98f00b204e9800998ecf8427e", 3 | "updated": "2025-04-25T14:29:27.410062-03:00", 4 | "installedModules": {} 5 | } -------------------------------------------------------------------------------- /boss.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Evolution4D", 3 | "description": "Evolution4D brings modern, fluent, and expressive syntax to Delphi, making code cleaner and development more productive.", 4 | "version": "1.0.0", 5 | "homepage": "https://github.com/moderndelphiworks", 6 | "mainsrc": "./Source", 7 | "projects": [], 8 | "dependencies": {} 9 | } --------------------------------------------------------------------------------