summaryrefslogtreecommitdiffstats
path: root/basic
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--basic/AllLangMoTarget_sb.mk13
-rw-r--r--basic/CppunitTest_basic_macros.mk71
-rw-r--r--basic/CppunitTest_basic_scanner.mk48
-rw-r--r--basic/IwyuFilter_basic.yaml22
-rw-r--r--basic/Library_sb.mk160
-rw-r--r--basic/Makefile14
-rw-r--r--basic/Module_basic.mk29
-rw-r--r--basic/README8
-rw-r--r--basic/inc/basic.hrc161
-rw-r--r--basic/inc/global.hxx25
-rw-r--r--basic/inc/pch/precompiled_sb.cxx12
-rw-r--r--basic/inc/pch/precompiled_sb.hxx129
-rw-r--r--basic/inc/sb.hxx32
-rw-r--r--basic/inc/sbobjmod.hxx99
-rw-r--r--basic/inc/sbprop.hxx63
-rw-r--r--basic/inc/sbstdobj.hxx109
-rw-r--r--basic/inc/sbxbase.hxx61
-rw-r--r--basic/inc/sbxfac.hxx37
-rw-r--r--basic/inc/sbxform.hxx154
-rw-r--r--basic/inc/sbxprop.hxx37
-rw-r--r--basic/inc/strings.hrc38
-rw-r--r--basic/qa/basic_coverage/da-DK/cdbl-2.vb14
-rw-r--r--basic/qa/basic_coverage/da-DK/cdbl.vb14
-rw-r--r--basic/qa/basic_coverage/string_left_01.vb25
-rw-r--r--basic/qa/basic_coverage/string_right_01.vb24
-rw-r--r--basic/qa/basic_coverage/test_Property.GetLet.vb27
-rw-r--r--basic/qa/basic_coverage/test_Property.GetSet.vb37
-rw-r--r--basic/qa/basic_coverage/test_abs_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_array_method.vb20
-rw-r--r--basic/qa/basic_coverage/test_asc_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_atn_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_beep_method.vb12
-rw-r--r--basic/qa/basic_coverage/test_cbool_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_cbyte_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_ccur_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_cdate_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_cdatetofromiso_methods.vb41
-rw-r--r--basic/qa/basic_coverage/test_cdatetounodatecdatefromunodate_methods.vb18
-rw-r--r--basic/qa/basic_coverage/test_cdatetounodatetimecdatefromunodatetime_methods.vb18
-rw-r--r--basic/qa/basic_coverage/test_cdatetounotimecdatefromunotime_methods.vb18
-rw-r--r--basic/qa/basic_coverage/test_cdbl_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_chdircurdir_methods.vb12
-rw-r--r--basic/qa/basic_coverage/test_choose_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_chr_method.vb64
-rw-r--r--basic/qa/basic_coverage/test_cint_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_compatibilitymode_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_converttofromurl_methods.vb15
-rw-r--r--basic/qa/basic_coverage/test_cossin_methods.vb15
-rw-r--r--basic/qa/basic_coverage/test_createobject_method.vb21
-rw-r--r--basic/qa/basic_coverage/test_createunolistener_method.vb13
-rw-r--r--basic/qa/basic_coverage/test_createunoservice_method.vb13
-rw-r--r--basic/qa/basic_coverage/test_createunostruct_method.vb13
-rw-r--r--basic/qa/basic_coverage/test_createunovalue_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_csng_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_cstr_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_cvar_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_cverr_method.vb36
-rw-r--r--basic/qa/basic_coverage/test_date_literal.vb16
-rw-r--r--basic/qa/basic_coverage/test_datedateadddatediff_methods.vb18
-rw-r--r--basic/qa/basic_coverage/test_datedatepartday_methods.vb18
-rw-r--r--basic/qa/basic_coverage/test_dimarray_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_empty_parameter.vb22
-rw-r--r--basic/qa/basic_coverage/test_environ_method.vb12
-rw-r--r--basic/qa/basic_coverage/test_equalunoobjects_method.vb25
-rw-r--r--basic/qa/basic_coverage/test_erl_method.vb22
-rw-r--r--basic/qa/basic_coverage/test_err_method.vb22
-rw-r--r--basic/qa/basic_coverage/test_falsetrue_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_filedatetime_nonexistent.vb20
-rw-r--r--basic/qa/basic_coverage/test_filedatetime_nonexistent2.vb20
-rw-r--r--basic/qa/basic_coverage/test_fix_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_for_each.vb43
-rw-r--r--basic/qa/basic_coverage/test_frac_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_freefile_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_freelibrary_method.vb12
-rw-r--r--basic/qa/basic_coverage/test_getdefaultcontext_method.vb12
-rw-r--r--basic/qa/basic_coverage/test_getdialogzoomfactorx_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_getdialogzoomfactory_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_getguitype_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_getguiversion_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_getpathseparator_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_getprocessservicemanager_method.vb12
-rw-r--r--basic/qa/basic_coverage/test_getsolarversion_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_getsystemtype_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_hasunointerfaces_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_hex_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_hour_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_iif_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_instr_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_int_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_isarray_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_isdate_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_isempty_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_iserror_method.vb22
-rw-r--r--basic/qa/basic_coverage/test_ismissing_basic.vb190
-rw-r--r--basic/qa/basic_coverage/test_ismissing_cascade.vb51
-rw-r--r--basic/qa/basic_coverage/test_ismissing_compatible.vb193
-rw-r--r--basic/qa/basic_coverage/test_isnull_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_isnumeric_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_isobject_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_isunostruct_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_join_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_lbound_method.vb19
-rw-r--r--basic/qa/basic_coverage/test_lcase_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_len_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_lenb_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_logexp_methods.vb15
-rw-r--r--basic/qa/basic_coverage/test_ltrim_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_mid_CountNegative_3args.vb15
-rw-r--r--basic/qa/basic_coverage/test_mid_EndOutOfBounds_3args.vb15
-rw-r--r--basic/qa/basic_coverage/test_mid_StartOutOfBounds_2args.vb15
-rw-r--r--basic/qa/basic_coverage/test_mid_StartOutOfBounds_3args.vb15
-rw-r--r--basic/qa/basic_coverage/test_mid_firstletter_3args.vb15
-rw-r--r--basic/qa/basic_coverage/test_mid_replace_less.vb19
-rw-r--r--basic/qa/basic_coverage/test_mid_replace_more.vb19
-rw-r--r--basic/qa/basic_coverage/test_mid_replace_more_end.vb19
-rw-r--r--basic/qa/basic_coverage/test_mid_sub2letters_2args.vb15
-rw-r--r--basic/qa/basic_coverage/test_minute_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_month_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_nowtimevalue_methods.vb20
-rw-r--r--basic/qa/basic_coverage/test_numeric_constant_parameter.vb34
-rw-r--r--basic/qa/basic_coverage/test_oct_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_optional_paramter_type.vb33
-rw-r--r--basic/qa/basic_coverage/test_optional_paramters_basic.vb208
-rw-r--r--basic/qa/basic_coverage/test_optional_paramters_compatible.vb210
-rw-r--r--basic/qa/basic_coverage/test_qbcolor_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_random_methods.vb16
-rw-r--r--basic/qa/basic_coverage/test_resolvepath_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_rgb_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_rtrim_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_second_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_sgn_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_space_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_spc_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_split_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_sqr_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_strcomp_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_string_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_string_overflow_safe.vb22
-rw-r--r--basic/qa/basic_coverage/test_string_replace.vb37
-rw-r--r--basic/qa/basic_coverage/test_strtrim_methods.vb15
-rw-r--r--basic/qa/basic_coverage/test_switch_method.vb20
-rw-r--r--basic/qa/basic_coverage/test_tab_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_tan_method.vb15
-rw-r--r--basic/qa/basic_coverage/test_timer_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_timeserialtimevalue_methods.vb16
-rw-r--r--basic/qa/basic_coverage/test_twipsperpixelx_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_twipsperpixely_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_typelen_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_typename_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_types_conversion.vb64
-rw-r--r--basic/qa/basic_coverage/test_ucase_method.vb17
-rw-r--r--basic/qa/basic_coverage/test_val_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_vartype_method.vb16
-rw-r--r--basic/qa/basic_coverage/test_wait_method.vb12
-rw-r--r--basic/qa/basic_coverage/test_weekday_method.vb18
-rw-r--r--basic/qa/basic_coverage/test_year_method.vb18
-rw-r--r--basic/qa/basic_coverage/uno_struct_assign.vb15
-rw-r--r--basic/qa/cppunit/basic_coverage.cxx161
-rw-r--r--basic/qa/cppunit/basictest.cxx125
-rw-r--r--basic/qa/cppunit/basictest.hxx55
-rw-r--r--basic/qa/cppunit/test_append.cxx80
-rw-r--r--basic/qa/cppunit/test_compiler_checks.cxx36
-rw-r--r--basic/qa/cppunit/test_language_conditionals.cxx173
-rw-r--r--basic/qa/cppunit/test_nested_struct.cxx303
-rw-r--r--basic/qa/cppunit/test_scanner.cxx1166
-rw-r--r--basic/qa/cppunit/test_vba.cxx256
-rw-r--r--basic/qa/vba_tests/Err.Raise.vb86
-rw-r--r--basic/qa/vba_tests/abs.vb70
-rw-r--r--basic/qa/vba_tests/array.vb97
-rw-r--r--basic/qa/vba_tests/asc.vb71
-rw-r--r--basic/qa/vba_tests/atn.vb77
-rw-r--r--basic/qa/vba_tests/bytearraystring.vb68
-rw-r--r--basic/qa/vba_tests/cbool.vb104
-rw-r--r--basic/qa/vba_tests/cdate.vb68
-rw-r--r--basic/qa/vba_tests/cdbl.vb73
-rw-r--r--basic/qa/vba_tests/cdec.vb86
-rw-r--r--basic/qa/vba_tests/choose.vb80
-rw-r--r--basic/qa/vba_tests/chr.vb69
-rw-r--r--basic/qa/vba_tests/cint.vb103
-rw-r--r--basic/qa/vba_tests/clng.vb95
-rw-r--r--basic/qa/vba_tests/constants.vb57
-rw-r--r--basic/qa/vba_tests/cos.vb71
-rw-r--r--basic/qa/vba_tests/csng.vb71
-rw-r--r--basic/qa/vba_tests/cstr.vb66
-rw-r--r--basic/qa/vba_tests/cvdate.vb68
-rw-r--r--basic/qa/vba_tests/cverr.vb99
-rw-r--r--basic/qa/vba_tests/data/ADODBdata.xlsbin0 -> 16384 bytes
-rw-r--r--basic/qa/vba_tests/dateadd.vb114
-rw-r--r--basic/qa/vba_tests/datediff.vb137
-rw-r--r--basic/qa/vba_tests/datepart.vb94
-rw-r--r--basic/qa/vba_tests/dateserial.vb63
-rw-r--r--basic/qa/vba_tests/datevalue.vb63
-rw-r--r--basic/qa/vba_tests/day.vb60
-rw-r--r--basic/qa/vba_tests/enum.vb87
-rw-r--r--basic/qa/vba_tests/error.vb60
-rw-r--r--basic/qa/vba_tests/exp.vb60
-rw-r--r--basic/qa/vba_tests/fix.vb68
-rw-r--r--basic/qa/vba_tests/format.vb450
-rw-r--r--basic/qa/vba_tests/formatnumber.vb83
-rw-r--r--basic/qa/vba_tests/hex.vb85
-rw-r--r--basic/qa/vba_tests/hour.vb71
-rw-r--r--basic/qa/vba_tests/iif.vb69
-rw-r--r--basic/qa/vba_tests/instr.vb86
-rw-r--r--basic/qa/vba_tests/instrrev.vb86
-rw-r--r--basic/qa/vba_tests/int.vb76
-rw-r--r--basic/qa/vba_tests/isarray.vb70
-rw-r--r--basic/qa/vba_tests/isdate.vb68
-rw-r--r--basic/qa/vba_tests/isempty.vb70
-rw-r--r--basic/qa/vba_tests/iserror.vb64
-rw-r--r--basic/qa/vba_tests/ismissing.vb196
-rw-r--r--basic/qa/vba_tests/isnull.vb64
-rw-r--r--basic/qa/vba_tests/isnumeric.vb80
-rw-r--r--basic/qa/vba_tests/isobject.vb67
-rw-r--r--basic/qa/vba_tests/join.vb76
-rw-r--r--basic/qa/vba_tests/lbound.vb66
-rw-r--r--basic/qa/vba_tests/lcase.vb73
-rw-r--r--basic/qa/vba_tests/left.vb68
-rw-r--r--basic/qa/vba_tests/len.vb69
-rw-r--r--basic/qa/vba_tests/log.vb68
-rw-r--r--basic/qa/vba_tests/ltrim.vb60
-rw-r--r--basic/qa/vba_tests/mid.vb69
-rw-r--r--basic/qa/vba_tests/minute.vb60
-rw-r--r--basic/qa/vba_tests/month.vb79
-rw-r--r--basic/qa/vba_tests/monthname.vb68
-rw-r--r--basic/qa/vba_tests/oct.vb68
-rw-r--r--basic/qa/vba_tests/ole_ObjAssignNoDflt.vb30
-rw-r--r--basic/qa/vba_tests/ole_ObjAssignToNothing.vb19
-rw-r--r--basic/qa/vba_tests/optional_paramters.vb215
-rw-r--r--basic/qa/vba_tests/partition.vb71
-rw-r--r--basic/qa/vba_tests/qbcolor.vb92
-rw-r--r--basic/qa/vba_tests/rate.vb84
-rw-r--r--basic/qa/vba_tests/replace.vb77
-rw-r--r--basic/qa/vba_tests/rgb.vb72
-rw-r--r--basic/qa/vba_tests/right.vb68
-rw-r--r--basic/qa/vba_tests/rtrim.vb60
-rw-r--r--basic/qa/vba_tests/second.vb64
-rw-r--r--basic/qa/vba_tests/sgn.vb76
-rw-r--r--basic/qa/vba_tests/sin.vb60
-rw-r--r--basic/qa/vba_tests/space.vb60
-rw-r--r--basic/qa/vba_tests/sqr.vb60
-rw-r--r--basic/qa/vba_tests/str.vb73
-rw-r--r--basic/qa/vba_tests/strcomp.vb95
-rw-r--r--basic/qa/vba_tests/strconv.vb90
-rw-r--r--basic/qa/vba_tests/string.vb69
-rw-r--r--basic/qa/vba_tests/stringplusdouble.vb328
-rw-r--r--basic/qa/vba_tests/strreverse.vb72
-rw-r--r--basic/qa/vba_tests/switch.vb67
-rw-r--r--basic/qa/vba_tests/timeserial.vb69
-rw-r--r--basic/qa/vba_tests/timevalue.vb59
-rw-r--r--basic/qa/vba_tests/trim.vb60
-rw-r--r--basic/qa/vba_tests/typename.vb96
-rw-r--r--basic/qa/vba_tests/ubound.vb69
-rw-r--r--basic/qa/vba_tests/ucase.vb60
-rw-r--r--basic/qa/vba_tests/val.vb92
-rw-r--r--basic/qa/vba_tests/vartype.vb86
-rw-r--r--basic/qa/vba_tests/weekday.vb81
-rw-r--r--basic/qa/vba_tests/weekdayname.vb84
-rw-r--r--basic/qa/vba_tests/win32compat.vb86
-rw-r--r--basic/qa/vba_tests/win32compatb.vb104
-rw-r--r--basic/qa/vba_tests/year.vb64
-rw-r--r--basic/source/basmgr/basicmanagerrepository.cxx626
-rw-r--r--basic/source/basmgr/basmgr.cxx2141
-rw-r--r--basic/source/basmgr/vbahelper.cxx187
-rw-r--r--basic/source/classes/codecompletecache.cxx193
-rw-r--r--basic/source/classes/errobject.cxx215
-rw-r--r--basic/source/classes/eventatt.cxx548
-rw-r--r--basic/source/classes/global.cxx46
-rw-r--r--basic/source/classes/image.cxx713
-rw-r--r--basic/source/classes/propacc.cxx191
-rw-r--r--basic/source/classes/sb.cxx2240
-rw-r--r--basic/source/classes/sbintern.cxx64
-rw-r--r--basic/source/classes/sbunoobj.cxx4935
-rw-r--r--basic/source/classes/sbxmod.cxx2673
-rw-r--r--basic/source/comp/basiccharclass.cxx58
-rw-r--r--basic/source/comp/buffer.cxx221
-rw-r--r--basic/source/comp/codegen.cxx585
-rw-r--r--basic/source/comp/dim.cxx1328
-rw-r--r--basic/source/comp/exprgen.cxx281
-rw-r--r--basic/source/comp/exprnode.cxx474
-rw-r--r--basic/source/comp/exprtree.cxx1134
-rw-r--r--basic/source/comp/io.cxx309
-rw-r--r--basic/source/comp/loops.cxx572
-rw-r--r--basic/source/comp/parser.cxx874
-rw-r--r--basic/source/comp/sbcomp.cxx85
-rw-r--r--basic/source/comp/scanner.cxx712
-rw-r--r--basic/source/comp/symtbl.cxx502
-rw-r--r--basic/source/comp/token.cxx572
-rw-r--r--basic/source/inc/basiccharclass.hxx36
-rw-r--r--basic/source/inc/buffer.hxx53
-rw-r--r--basic/source/inc/codegen.hxx85
-rw-r--r--basic/source/inc/date.hxx61
-rw-r--r--basic/source/inc/dlgcont.hxx152
-rw-r--r--basic/source/inc/errobject.hxx43
-rw-r--r--basic/source/inc/eventatt.hxx34
-rw-r--r--basic/source/inc/expr.hxx230
-rw-r--r--basic/source/inc/filefmt.hxx192
-rw-r--r--basic/source/inc/image.hxx104
-rw-r--r--basic/source/inc/iosys.hxx112
-rw-r--r--basic/source/inc/namecont.hxx660
-rw-r--r--basic/source/inc/opcodes.hxx159
-rw-r--r--basic/source/inc/parser.hxx144
-rw-r--r--basic/source/inc/propacc.hxx79
-rw-r--r--basic/source/inc/rtlproto.hxx365
-rw-r--r--basic/source/inc/runtime.hxx421
-rw-r--r--basic/source/inc/sbintern.hxx118
-rw-r--r--basic/source/inc/sbjsmeth.hxx42
-rw-r--r--basic/source/inc/sbjsmod.hxx41
-rw-r--r--basic/source/inc/sbunoobj.hxx395
-rw-r--r--basic/source/inc/sbxmod.hxx30
-rw-r--r--basic/source/inc/scanner.hxx96
-rw-r--r--basic/source/inc/scriptcont.hxx163
-rw-r--r--basic/source/inc/stdobj.hxx44
-rw-r--r--basic/source/inc/symtbl.hxx222
-rw-r--r--basic/source/inc/token.hxx140
-rw-r--r--basic/source/runtime/basrdll.cxx126
-rw-r--r--basic/source/runtime/comenumwrapper.cxx67
-rw-r--r--basic/source/runtime/comenumwrapper.hxx44
-rw-r--r--basic/source/runtime/ddectrl.cxx198
-rw-r--r--basic/source/runtime/ddectrl.hxx54
-rw-r--r--basic/source/runtime/dllmgr-none.cxx114
-rw-r--r--basic/source/runtime/dllmgr-x64.cxx794
-rw-r--r--basic/source/runtime/dllmgr-x86.cxx734
-rw-r--r--basic/source/runtime/dllmgr.hxx53
-rw-r--r--basic/source/runtime/inputbox.cxx143
-rw-r--r--basic/source/runtime/iosys.cxx849
-rw-r--r--basic/source/runtime/methods.cxx4826
-rw-r--r--basic/source/runtime/methods1.cxx3066
-rw-r--r--basic/source/runtime/props.cxx448
-rw-r--r--basic/source/runtime/runtime.cxx4641
-rw-r--r--basic/source/runtime/stdobj.cxx898
-rw-r--r--basic/source/runtime/stdobj1.cxx422
-rw-r--r--basic/source/runtime/wnt-x86.asm47
-rw-r--r--basic/source/sbx/sbxarray.cxx561
-rw-r--r--basic/source/sbx/sbxbase.cxx335
-rw-r--r--basic/source/sbx/sbxbool.cxx221
-rw-r--r--basic/source/sbx/sbxbyte.cxx312
-rw-r--r--basic/source/sbx/sbxchar.cxx300
-rw-r--r--basic/source/sbx/sbxcoll.cxx307
-rw-r--r--basic/source/sbx/sbxconv.hxx132
-rw-r--r--basic/source/sbx/sbxcurr.cxx486
-rw-r--r--basic/source/sbx/sbxdate.cxx460
-rw-r--r--basic/source/sbx/sbxdbl.cxx315
-rw-r--r--basic/source/sbx/sbxdec.cxx685
-rw-r--r--basic/source/sbx/sbxdec.hxx99
-rw-r--r--basic/source/sbx/sbxexec.cxx381
-rw-r--r--basic/source/sbx/sbxform.cxx1001
-rw-r--r--basic/source/sbx/sbxint.cxx905
-rw-r--r--basic/source/sbx/sbxlng.cxx318
-rw-r--r--basic/source/sbx/sbxobj.cxx868
-rw-r--r--basic/source/sbx/sbxres.cxx80
-rw-r--r--basic/source/sbx/sbxres.hxx51
-rw-r--r--basic/source/sbx/sbxscan.cxx900
-rw-r--r--basic/source/sbx/sbxsng.cxx343
-rw-r--r--basic/source/sbx/sbxstr.cxx331
-rw-r--r--basic/source/sbx/sbxuint.cxx317
-rw-r--r--basic/source/sbx/sbxulng.cxx293
-rw-r--r--basic/source/sbx/sbxvalue.cxx1588
-rw-r--r--basic/source/sbx/sbxvar.cxx650
-rw-r--r--basic/source/uno/dlgcont.cxx584
-rw-r--r--basic/source/uno/modsizeexceeded.cxx59
-rw-r--r--basic/source/uno/namecont.cxx3462
-rw-r--r--basic/source/uno/scriptcont.cxx1230
-rw-r--r--basic/util/sb.component32
363 files changed, 76571 insertions, 0 deletions
diff --git a/basic/AllLangMoTarget_sb.mk b/basic/AllLangMoTarget_sb.mk
new file mode 100644
index 000000000..90ece5be3
--- /dev/null
+++ b/basic/AllLangMoTarget_sb.mk
@@ -0,0 +1,13 @@
+# -*- Mode: makefile-gmake; tab-width: 4; indent-tabs-mode: t -*-
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+$(eval $(call gb_AllLangMoTarget_AllLangMoTarget,sb))
+
+$(eval $(call gb_AllLangMoTarget_set_polocation,sb,basic))
+
+# vim: set noet sw=4 ts=4:
diff --git a/basic/CppunitTest_basic_macros.mk b/basic/CppunitTest_basic_macros.mk
new file mode 100644
index 000000000..6cce94737
--- /dev/null
+++ b/basic/CppunitTest_basic_macros.mk
@@ -0,0 +1,71 @@
+# -*- Mode: makefile-gmake; tab-width: 4; indent-tabs-mode: t -*-
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+
+$(eval $(call gb_CppunitTest_CppunitTest,basic_macros))
+
+$(eval $(call gb_CppunitTest_use_external,basic_macros,boost_headers))
+
+$(eval $(call gb_CppunitTest_add_exception_objects,basic_macros, \
+ basic/qa/cppunit/basictest \
+ basic/qa/cppunit/basic_coverage \
+ basic/qa/cppunit/test_append \
+ basic/qa/cppunit/test_compiler_checks \
+ basic/qa/cppunit/test_language_conditionals \
+ basic/qa/cppunit/test_nested_struct \
+ basic/qa/cppunit/test_vba \
+))
+
+$(eval $(call gb_CppunitTest_use_libraries,basic_macros, \
+ comphelper \
+ cppu \
+ cppuhelper \
+ i18nlangtag \
+ sal \
+ salhelper \
+ sb \
+ sot \
+ svl \
+ svt \
+ test \
+ tl \
+ unotest \
+ utl \
+ vcl \
+ xmlscript \
+))
+
+ifeq ($(OS),WNT)
+$(eval $(call gb_CppunitTest_use_system_win32_libs,basic_macros, \
+ oleaut32 \
+ legacy_stdio_definitions \
+ odbc32 \
+ odbccp32 \
+))
+endif
+
+$(eval $(call gb_CppunitTest_use_api,basic_macros,\
+ offapi \
+ udkapi \
+ oovbaapi \
+))
+
+$(eval $(call gb_CppunitTest_use_ure,basic_macros))
+$(eval $(call gb_CppunitTest_use_vcl,basic_macros))
+
+$(eval $(call gb_CppunitTest_use_components,basic_macros,\
+ configmgr/source/configmgr \
+ i18npool/util/i18npool \
+ ucb/source/core/ucb1 \
+ ucb/source/ucp/file/ucpfile1 \
+ $(if $(filter $(OS),WNT), \
+ extensions/source/ole/oleautobridge) \
+))
+$(eval $(call gb_CppunitTest_use_configuration,basic_macros))
+
+# vim: set noet sw=4 ts=4:
diff --git a/basic/CppunitTest_basic_scanner.mk b/basic/CppunitTest_basic_scanner.mk
new file mode 100644
index 000000000..55a6e0faf
--- /dev/null
+++ b/basic/CppunitTest_basic_scanner.mk
@@ -0,0 +1,48 @@
+# -*- Mode: makefile-gmake; tab-width: 4; indent-tabs-mode: t -*-
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+
+$(eval $(call gb_CppunitTest_CppunitTest,basic_scanner))
+
+$(eval $(call gb_CppunitTest_use_ure,basic_scanner))
+
+$(eval $(call gb_CppunitTest_add_exception_objects,basic_scanner, \
+ basic/qa/cppunit/test_scanner \
+))
+
+$(eval $(call gb_CppunitTest_use_library_objects,basic_scanner,sb))
+
+$(eval $(call gb_CppunitTest_use_libraries,basic_scanner, \
+ comphelper \
+ cppu \
+ cppuhelper \
+ sal \
+ salhelper \
+ i18nlangtag \
+ sot \
+ svl \
+ svt \
+ tl \
+ utl \
+ vcl \
+ xmlscript \
+))
+
+ifeq ($(OS),WNT)
+$(eval $(call gb_CppunitTest_use_system_win32_libs,basic_scanner, \
+ oleaut32 \
+))
+endif
+
+$(eval $(call gb_CppunitTest_set_include,basic_scanner,\
+ -I$(SRCDIR)/basic/source/inc \
+ -I$(SRCDIR)/basic/inc \
+ $$(INCLUDE) \
+))
+
+# vim: set noet sw=4 ts=4:
diff --git a/basic/IwyuFilter_basic.yaml b/basic/IwyuFilter_basic.yaml
new file mode 100644
index 000000000..215692ada
--- /dev/null
+++ b/basic/IwyuFilter_basic.yaml
@@ -0,0 +1,22 @@
+---
+assumeFilename: basic/source/classes/global.cxx
+blacklist:
+ basic/source/runtime/methods.cxx:
+ # Needed on WIN
+ - o3tl/char16_t2wchar_t.hxx
+ - rtl/character.hxx
+ basic/source/sbx/sbxdec.cxx:
+ # Needed on WIN
+ - o3tl/char16_t2wchar_t.hxx
+ basic/source/sbx/sbxbyte.cxx:
+ # math::round is used
+ - rtl/math.hxx
+ basic/source/sbx/sbxchar.cxx:
+ # math::round is used
+ - rtl/math.hxx
+ basic/source/sbx/sbxint.cxx:
+ # math::round is used
+ - rtl/math.hxx
+ basic/source/sbx/sbxlng.cxx:
+ # math::round is used
+ - rtl/math.hxx
diff --git a/basic/Library_sb.mk b/basic/Library_sb.mk
new file mode 100644
index 000000000..6a27b15ed
--- /dev/null
+++ b/basic/Library_sb.mk
@@ -0,0 +1,160 @@
+# -*- Mode: makefile-gmake; tab-width: 4; indent-tabs-mode: t -*-
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+# This file incorporates work covered by the following license notice:
+#
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed
+# with this work for additional information regarding copyright
+# ownership. The ASF licenses this file to you under the Apache
+# License, Version 2.0 (the "License"); you may not use this file
+# except in compliance with the License. You may obtain a copy of
+# the License at http://www.apache.org/licenses/LICENSE-2.0 .
+#
+
+$(eval $(call gb_Library_Library,sb))
+
+$(eval $(call gb_Library_set_componentfile,sb,basic/util/sb))
+
+$(eval $(call gb_Library_set_include,sb,\
+ $$(INCLUDE) \
+ -I$(SRCDIR)/basic/inc \
+ -I$(SRCDIR)/basic/source/inc \
+))
+
+$(eval $(call gb_Library_set_precompiled_header,sb,basic/inc/pch/precompiled_sb))
+
+$(eval $(call gb_Library_use_external,sb,boost_headers))
+
+$(eval $(call gb_Library_use_custom_headers,sb,\
+ officecfg/registry \
+))
+
+$(eval $(call gb_Library_use_sdk_api,sb))
+$(eval $(call gb_Library_use_api,sb,oovbaapi))
+
+$(eval $(call gb_Library_add_defs,sb,\
+ -DBASIC_DLLIMPLEMENTATION \
+))
+
+$(eval $(call gb_Library_use_libraries,sb,\
+ comphelper \
+ cppu \
+ cppuhelper \
+ sal \
+ salhelper \
+ i18nlangtag \
+ sot \
+ svl \
+ svt \
+ tl \
+ utl \
+ vcl \
+ xmlscript \
+))
+
+ifneq ($(filter SCRIPTING,$(BUILD_TYPE)),)
+
+$(eval $(call gb_Library_add_exception_objects,sb,\
+ basic/source/basmgr/basicmanagerrepository \
+ basic/source/basmgr/basmgr \
+ basic/source/basmgr/vbahelper \
+ basic/source/classes/codecompletecache \
+ basic/source/classes/eventatt \
+ basic/source/classes/global \
+ basic/source/classes/image \
+ basic/source/classes/propacc \
+ basic/source/classes/sb \
+ basic/source/classes/sbunoobj \
+ basic/source/classes/sbxmod \
+ basic/source/comp/basiccharclass \
+ basic/source/comp/buffer \
+ basic/source/comp/codegen \
+ basic/source/comp/dim \
+ basic/source/comp/exprtree \
+ basic/source/comp/exprgen \
+ basic/source/comp/exprnode \
+ basic/source/comp/io \
+ basic/source/comp/loops \
+ basic/source/comp/parser \
+ basic/source/comp/sbcomp \
+ basic/source/comp/scanner \
+ basic/source/comp/symtbl \
+ basic/source/comp/token \
+ basic/source/uno/dlgcont \
+ basic/source/uno/modsizeexceeded \
+ basic/source/uno/namecont \
+ basic/source/uno/scriptcont \
+ basic/source/runtime/comenumwrapper \
+ basic/source/runtime/ddectrl \
+ basic/source/runtime/inputbox \
+ basic/source/runtime/iosys \
+ basic/source/runtime/props \
+ basic/source/runtime/stdobj \
+ basic/source/runtime/stdobj1 \
+ basic/source/runtime/runtime \
+ basic/source/classes/errobject \
+))
+endif
+
+$(eval $(call gb_Library_add_exception_objects,sb,\
+ basic/source/runtime/basrdll \
+ basic/source/runtime/methods \
+ basic/source/runtime/methods1 \
+ basic/source/classes/sbintern \
+ basic/source/sbx/sbxarray \
+ basic/source/sbx/sbxbool \
+ basic/source/sbx/sbxbyte \
+ basic/source/sbx/sbxchar \
+ basic/source/sbx/sbxcoll \
+ basic/source/sbx/sbxcurr \
+ basic/source/sbx/sbxbase \
+ basic/source/sbx/sbxdate \
+ basic/source/sbx/sbxdbl \
+ basic/source/sbx/sbxdec \
+ basic/source/sbx/sbxexec \
+ basic/source/sbx/sbxform \
+ basic/source/sbx/sbxint \
+ basic/source/sbx/sbxlng \
+ basic/source/sbx/sbxobj \
+ basic/source/sbx/sbxres \
+ basic/source/sbx/sbxscan \
+ basic/source/sbx/sbxsng \
+ basic/source/sbx/sbxstr \
+ basic/source/sbx/sbxuint \
+ basic/source/sbx/sbxulng \
+ basic/source/sbx/sbxvalue \
+ basic/source/sbx/sbxvar \
+))
+
+ifeq ($(OS),WNT)
+$(eval $(call gb_Library_use_system_win32_libs,sb,\
+ oleaut32 \
+))
+endif
+
+ifeq ($(OS)$(CPUNAME),WNTINTEL)
+$(eval $(call gb_Library_add_exception_objects,sb,\
+ basic/source/runtime/dllmgr-x86 \
+))
+$(eval $(call gb_Library_add_asmobjects,sb,\
+ basic/source/runtime/wnt-x86 \
+))
+else
+ifeq ($(OS)$(CPUNAME),WNTX86_64)
+$(eval $(call gb_Library_add_exception_objects,sb,\
+ basic/source/runtime/dllmgr-x64 \
+))
+else
+$(eval $(call gb_Library_add_exception_objects,sb,\
+ basic/source/runtime/dllmgr-none \
+))
+endif
+endif
+
+# vim: set noet sw=4 ts=4:
diff --git a/basic/Makefile b/basic/Makefile
new file mode 100644
index 000000000..0997e6284
--- /dev/null
+++ b/basic/Makefile
@@ -0,0 +1,14 @@
+# -*- Mode: makefile-gmake; tab-width: 4; indent-tabs-mode: t -*-
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+
+module_directory:=$(dir $(realpath $(firstword $(MAKEFILE_LIST))))
+
+include $(module_directory)/../solenv/gbuild/partial_build.mk
+
+# vim: set noet sw=4 ts=4:
diff --git a/basic/Module_basic.mk b/basic/Module_basic.mk
new file mode 100644
index 000000000..a01c88326
--- /dev/null
+++ b/basic/Module_basic.mk
@@ -0,0 +1,29 @@
+# -*- Mode: makefile-gmake; tab-width: 4; indent-tabs-mode: t -*-
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+
+$(eval $(call gb_Module_Module,basic))
+
+ifneq ($(filter SCRIPTING,$(BUILD_TYPE)),)
+
+$(eval $(call gb_Module_add_l10n_targets,basic,\
+ AllLangMoTarget_sb \
+))
+
+$(eval $(call gb_Module_add_check_targets,basic,\
+ CppunitTest_basic_scanner \
+ CppunitTest_basic_macros \
+))
+
+endif
+
+$(eval $(call gb_Module_add_targets,basic,\
+ Library_sb \
+))
+
+# vim: set noet sw=4 ts=4:
diff --git a/basic/README b/basic/README
new file mode 100644
index 000000000..c7e6654c1
--- /dev/null
+++ b/basic/README
@@ -0,0 +1,8 @@
+Contains the StarBASIC Interpreter
+
+This implements a macro language that, when in VBA compatibility mode,
+is intended to be interoperable with Visual Basic for Applications,
+allowing people to run macros embedded in their documents.
+
+See also:
+[http://wiki.openoffice.org/wiki/Basic]
diff --git a/basic/inc/basic.hrc b/basic/inc/basic.hrc
new file mode 100644
index 000000000..c860fce7a
--- /dev/null
+++ b/basic/inc/basic.hrc
@@ -0,0 +1,161 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the N_("License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_INC_STRINGS_HRC
+#define INCLUDED_BASIC_INC_STRINGS_HRC
+
+#define NC_(Context, String) reinterpret_cast<char const *>(Context "\004" u8##String)
+
+std::pair<const char*, ErrCode> const RID_BASIC_START[] =
+{
+ { NC_("RID_BASIC_START", "Syntax error."), ERRCODE_BASIC_SYNTAX },
+ { NC_("RID_BASIC_START", "Return without Gosub."), ERRCODE_BASIC_NO_GOSUB },
+ { NC_("RID_BASIC_START", "Incorrect entry; please retry."), ERRCODE_BASIC_REDO_FROM_START },
+ { NC_("RID_BASIC_START", "Invalid procedure call."), ERRCODE_BASIC_BAD_ARGUMENT },
+ { NC_("RID_BASIC_START", "Overflow."), ERRCODE_BASIC_MATH_OVERFLOW },
+ { NC_("RID_BASIC_START", "Not enough memory."), ERRCODE_BASIC_NO_MEMORY },
+ { NC_("RID_BASIC_START", "Array already dimensioned."), ERRCODE_BASIC_ALREADY_DIM },
+ { NC_("RID_BASIC_START", "Index out of defined range."), ERRCODE_BASIC_OUT_OF_RANGE },
+ { NC_("RID_BASIC_START", "Duplicate definition."), ERRCODE_BASIC_DUPLICATE_DEF },
+ { NC_("RID_BASIC_START", "Division by zero."), ERRCODE_BASIC_ZERODIV },
+ { NC_("RID_BASIC_START", "Variable not defined."), ERRCODE_BASIC_VAR_UNDEFINED },
+ { NC_("RID_BASIC_START", "Data type mismatch."), ERRCODE_BASIC_CONVERSION },
+ { NC_("RID_BASIC_START", "Invalid parameter."), ERRCODE_BASIC_BAD_PARAMETER },
+ { NC_("RID_BASIC_START", "Process interrupted by user."), ERRCODE_BASIC_USER_ABORT },
+ { NC_("RID_BASIC_START", "Resume without error."), ERRCODE_BASIC_BAD_RESUME },
+ { NC_("RID_BASIC_START", "Not enough stack memory."), ERRCODE_BASIC_STACK_OVERFLOW },
+ { NC_("RID_BASIC_START", "Sub-procedure or function procedure not defined."), ERRCODE_BASIC_PROC_UNDEFINED },
+ { NC_("RID_BASIC_START", "Error loading DLL file."), ERRCODE_BASIC_BAD_DLL_LOAD },
+ { NC_("RID_BASIC_START", "Wrong DLL call convention."), ERRCODE_BASIC_BAD_DLL_CALL },
+ { NC_("RID_BASIC_START", "Internal error $(ARG1)."), ERRCODE_BASIC_INTERNAL_ERROR },
+ { NC_("RID_BASIC_START", "Invalid file name or file number."), ERRCODE_BASIC_BAD_CHANNEL },
+ { NC_("RID_BASIC_START", "File not found."), ERRCODE_BASIC_FILE_NOT_FOUND },
+ { NC_("RID_BASIC_START", "Incorrect file mode."), ERRCODE_BASIC_BAD_FILE_MODE },
+ { NC_("RID_BASIC_START", "File already open."), ERRCODE_BASIC_FILE_ALREADY_OPEN },
+ { NC_("RID_BASIC_START", "Device I/O error."), ERRCODE_BASIC_IO_ERROR },
+ { NC_("RID_BASIC_START", "File already exists."), ERRCODE_BASIC_FILE_EXISTS },
+ { NC_("RID_BASIC_START", "Incorrect record length."), ERRCODE_BASIC_BAD_RECORD_LENGTH },
+ { NC_("RID_BASIC_START", "Disk or hard drive full."), ERRCODE_BASIC_DISK_FULL },
+ { NC_("RID_BASIC_START", "Reading exceeds EOF."), ERRCODE_BASIC_READ_PAST_EOF },
+ { NC_("RID_BASIC_START", "Incorrect record number."), ERRCODE_BASIC_BAD_RECORD_NUMBER },
+ { NC_("RID_BASIC_START", "Too many files."), ERRCODE_BASIC_TOO_MANY_FILES },
+ { NC_("RID_BASIC_START", "Device not available."), ERRCODE_BASIC_NO_DEVICE },
+ { NC_("RID_BASIC_START", "Access denied."), ERRCODE_BASIC_ACCESS_DENIED },
+ { NC_("RID_BASIC_START", "Disk not ready."), ERRCODE_BASIC_NOT_READY },
+ { NC_("RID_BASIC_START", "Not implemented."), ERRCODE_BASIC_NOT_IMPLEMENTED },
+ { NC_("RID_BASIC_START", "Renaming on different drives impossible."), ERRCODE_BASIC_DIFFERENT_DRIVE },
+ { NC_("RID_BASIC_START", "Path/File access error."), ERRCODE_BASIC_ACCESS_ERROR },
+ { NC_("RID_BASIC_START", "Path not found."), ERRCODE_BASIC_PATH_NOT_FOUND },
+ { NC_("RID_BASIC_START", "Object variable not set."), ERRCODE_BASIC_NO_OBJECT },
+ { NC_("RID_BASIC_START", "Invalid string pattern."), ERRCODE_BASIC_BAD_PATTERN },
+ { NC_("RID_BASIC_START", "Use of zero not permitted."), ERRCODE_BASIC_IS_NULL },
+ { NC_("RID_BASIC_START", "DDE Error."), ERRCODE_BASIC_DDE_ERROR },
+ { NC_("RID_BASIC_START", "Awaiting response to DDE connection."), ERRCODE_BASIC_DDE_WAITINGACK },
+ { NC_("RID_BASIC_START", "No DDE channels available."), ERRCODE_BASIC_DDE_OUTOFCHANNELS },
+ { NC_("RID_BASIC_START", "No application responded to DDE connect initiation."), ERRCODE_BASIC_DDE_NO_RESPONSE },
+ { NC_("RID_BASIC_START", "Too many applications responded to DDE connect initiation."), ERRCODE_BASIC_DDE_MULT_RESPONSES },
+ { NC_("RID_BASIC_START", "DDE channel locked."), ERRCODE_BASIC_DDE_CHANNEL_LOCKED },
+ { NC_("RID_BASIC_START", "External application cannot execute DDE operation."), ERRCODE_BASIC_DDE_NOTPROCESSED },
+ { NC_("RID_BASIC_START", "Timeout while waiting for DDE response."), ERRCODE_BASIC_DDE_TIMEOUT },
+ { NC_("RID_BASIC_START", "User pressed ESCAPE during DDE operation."), ERRCODE_BASIC_DDE_USER_INTERRUPT },
+ { NC_("RID_BASIC_START", "External application busy."), ERRCODE_BASIC_DDE_BUSY },
+ { NC_("RID_BASIC_START", "DDE operation without data."), ERRCODE_BASIC_DDE_NO_DATA },
+ { NC_("RID_BASIC_START", "Data are in wrong format."), ERRCODE_BASIC_DDE_WRONG_DATA_FORMAT },
+ { NC_("RID_BASIC_START", "External application has been terminated."), ERRCODE_BASIC_DDE_PARTNER_QUIT },
+ { NC_("RID_BASIC_START", "DDE connection interrupted or modified."), ERRCODE_BASIC_DDE_CONV_CLOSED },
+ { NC_("RID_BASIC_START", "DDE method invoked with no channel open."), ERRCODE_BASIC_DDE_NO_CHANNEL },
+ { NC_("RID_BASIC_START", "Invalid DDE link format."), ERRCODE_BASIC_DDE_INVALID_LINK },
+ { NC_("RID_BASIC_START", "DDE message has been lost."), ERRCODE_BASIC_DDE_QUEUE_OVERFLOW },
+ { NC_("RID_BASIC_START", "Paste link already performed."), ERRCODE_BASIC_DDE_LINK_ALREADY_EST },
+ { NC_("RID_BASIC_START", "Link mode cannot be set due to invalid link topic."), ERRCODE_BASIC_DDE_LINK_INV_TOPIC },
+ { NC_("RID_BASIC_START", "DDE requires the DDEML.DLL file."), ERRCODE_BASIC_DDE_DLL_NOT_FOUND },
+ { NC_("RID_BASIC_START", "Module cannot be loaded; invalid format."), ERRCODE_BASIC_CANNOT_LOAD },
+ { NC_("RID_BASIC_START", "Invalid object index."), ERRCODE_BASIC_BAD_INDEX },
+ { NC_("RID_BASIC_START", "Object is not available."), ERRCODE_BASIC_NO_ACTIVE_OBJECT },
+ { NC_("RID_BASIC_START", "Incorrect property value."), ERRCODE_BASIC_BAD_PROP_VALUE },
+ { NC_("RID_BASIC_START", "This property is read-only."), ERRCODE_BASIC_PROP_READONLY },
+ { NC_("RID_BASIC_START", "This property is write only."), ERRCODE_BASIC_PROP_WRITEONLY },
+ { NC_("RID_BASIC_START", "Invalid object reference."), ERRCODE_BASIC_INVALID_OBJECT },
+ { NC_("RID_BASIC_START", "Property or method not found: $(ARG1)."), ERRCODE_BASIC_NO_METHOD },
+ { NC_("RID_BASIC_START", "Object required."), ERRCODE_BASIC_NEEDS_OBJECT },
+ { NC_("RID_BASIC_START", "Invalid use of an object."), ERRCODE_BASIC_INVALID_USAGE_OBJECT },
+ { NC_("RID_BASIC_START", "OLE Automation is not supported by this object."), ERRCODE_BASIC_NO_OLE },
+ { NC_("RID_BASIC_START", "This property or method is not supported by the object."), ERRCODE_BASIC_BAD_METHOD },
+ { NC_("RID_BASIC_START", "OLE Automation Error."), ERRCODE_BASIC_OLE_ERROR },
+ { NC_("RID_BASIC_START", "This action is not supported by given object."), ERRCODE_BASIC_BAD_ACTION },
+ { NC_("RID_BASIC_START", "Named arguments are not supported by given object."), ERRCODE_BASIC_NO_NAMED_ARGS },
+ { NC_("RID_BASIC_START", "The current locale setting is not supported by the given object."), ERRCODE_BASIC_BAD_LOCALE },
+ { NC_("RID_BASIC_START", "Named argument not found."), ERRCODE_BASIC_NAMED_NOT_FOUND },
+ { NC_("RID_BASIC_START", "Argument is not optional."), ERRCODE_BASIC_NOT_OPTIONAL },
+ { NC_("RID_BASIC_START", "Invalid number of arguments."), ERRCODE_BASIC_WRONG_ARGS },
+ { NC_("RID_BASIC_START", "Object is not a list."), ERRCODE_BASIC_NOT_A_COLL },
+ { NC_("RID_BASIC_START", "Invalid ordinal number."), ERRCODE_BASIC_BAD_ORDINAL },
+ { NC_("RID_BASIC_START", "Specified DLL function not found."), ERRCODE_BASIC_DLLPROC_NOT_FOUND },
+ { NC_("RID_BASIC_START", "Invalid clipboard format."), ERRCODE_BASIC_BAD_CLIPBD_FORMAT },
+ { NC_("RID_BASIC_START", "Object does not have this property."), ERRCODE_BASIC_PROPERTY_NOT_FOUND },
+ { NC_("RID_BASIC_START", "Object does not have this method."), ERRCODE_BASIC_METHOD_NOT_FOUND },
+ { NC_("RID_BASIC_START", "Required argument lacking."), ERRCODE_BASIC_ARG_MISSING },
+ { NC_("RID_BASIC_START", "Invalid number of arguments."), ERRCODE_BASIC_BAD_NUMBER_OF_ARGS },
+ { NC_("RID_BASIC_START", "Error executing a method."), ERRCODE_BASIC_METHOD_FAILED },
+ { NC_("RID_BASIC_START", "Unable to set property."), ERRCODE_BASIC_SETPROP_FAILED },
+ { NC_("RID_BASIC_START", "Unable to determine property."), ERRCODE_BASIC_GETPROP_FAILED },
+ // Compiler errors. These are not runtime errors.
+ { NC_("RID_BASIC_START", "Unexpected symbol: $(ARG1)."), ERRCODE_BASIC_UNEXPECTED },
+ { NC_("RID_BASIC_START", "Expected: $(ARG1)."), ERRCODE_BASIC_EXPECTED },
+ { NC_("RID_BASIC_START", "Symbol expected."), ERRCODE_BASIC_SYMBOL_EXPECTED },
+ { NC_("RID_BASIC_START", "Variable expected."), ERRCODE_BASIC_VAR_EXPECTED },
+ { NC_("RID_BASIC_START", "Label expected."), ERRCODE_BASIC_LABEL_EXPECTED },
+ { NC_("RID_BASIC_START", "Value cannot be applied."), ERRCODE_BASIC_LVALUE_EXPECTED },
+ { NC_("RID_BASIC_START", "Variable $(ARG1) already defined."), ERRCODE_BASIC_VAR_DEFINED },
+ { NC_("RID_BASIC_START", "Sub procedure or function procedure $(ARG1) already defined."), ERRCODE_BASIC_PROC_DEFINED },
+ { NC_("RID_BASIC_START", "Label $(ARG1) already defined."), ERRCODE_BASIC_LABEL_DEFINED },
+ { NC_("RID_BASIC_START", "Variable $(ARG1) not found."), ERRCODE_BASIC_UNDEF_VAR },
+ { NC_("RID_BASIC_START", "Array or procedure $(ARG1) not found."), ERRCODE_BASIC_UNDEF_ARRAY },
+ { NC_("RID_BASIC_START", "Procedure $(ARG1) not found."), ERRCODE_BASIC_UNDEF_PROC },
+ { NC_("RID_BASIC_START", "Label $(ARG1) undefined."), ERRCODE_BASIC_UNDEF_LABEL },
+ { NC_("RID_BASIC_START", "Unknown data type $(ARG1)."), ERRCODE_BASIC_UNDEF_TYPE },
+ { NC_("RID_BASIC_START", "Exit $(ARG1) expected."), ERRCODE_BASIC_BAD_EXIT },
+ { NC_("RID_BASIC_START", "Statement block still open: $(ARG1) missing."), ERRCODE_BASIC_BAD_BLOCK },
+ { NC_("RID_BASIC_START", "Parentheses do not match."), ERRCODE_BASIC_BAD_BRACKETS },
+ { NC_("RID_BASIC_START", "Symbol $(ARG1) already defined differently."), ERRCODE_BASIC_BAD_DECLARATION },
+ { NC_("RID_BASIC_START", "Parameters do not correspond to procedure."), ERRCODE_BASIC_BAD_PARAMETERS },
+ { NC_("RID_BASIC_START", "Invalid character in number."), ERRCODE_BASIC_BAD_CHAR_IN_NUMBER },
+ { NC_("RID_BASIC_START", "Array must be dimensioned."), ERRCODE_BASIC_MUST_HAVE_DIMS },
+ { NC_("RID_BASIC_START", "Else/Endif without If."), ERRCODE_BASIC_NO_IF },
+ { NC_("RID_BASIC_START", "$(ARG1) not allowed within a procedure."), ERRCODE_BASIC_NOT_IN_SUBR },
+ { NC_("RID_BASIC_START", "$(ARG1) not allowed outside a procedure."), ERRCODE_BASIC_NOT_IN_MAIN },
+ { NC_("RID_BASIC_START", "Dimension specifications do not match."), ERRCODE_BASIC_WRONG_DIMS },
+ { NC_("RID_BASIC_START", "Unknown option: $(ARG1)."), ERRCODE_BASIC_BAD_OPTION },
+ { NC_("RID_BASIC_START", "Constant $(ARG1) redefined."), ERRCODE_BASIC_CONSTANT_REDECLARED },
+ { NC_("RID_BASIC_START", "Program too large."), ERRCODE_BASIC_PROG_TOO_LARGE },
+ { NC_("RID_BASIC_START", "Strings or arrays not permitted."), ERRCODE_BASIC_NO_STRINGS_ARRAYS },
+ { NC_("RID_BASIC_START", "An exception occurred $(ARG1)."), ERRCODE_BASIC_EXCEPTION },
+ { NC_("RID_BASIC_START", "This array is fixed or temporarily locked."), ERRCODE_BASIC_ARRAY_FIX },
+ { NC_("RID_BASIC_START", "Out of string space."), ERRCODE_BASIC_STRING_OVERFLOW },
+ { NC_("RID_BASIC_START", "Expression Too Complex."), ERRCODE_BASIC_EXPR_TOO_COMPLEX },
+ { NC_("RID_BASIC_START", "Can't perform requested operation."), ERRCODE_BASIC_OPER_NOT_PERFORM },
+ { NC_("RID_BASIC_START", "Too many DLL application clients."), ERRCODE_BASIC_TOO_MANY_DLL },
+ { NC_("RID_BASIC_START", "For loop not initialized."), ERRCODE_BASIC_LOOP_NOT_INIT },
+ { NC_("RID_BASIC_START", "$(ARG1)"), ERRCODE_BASIC_COMPAT },
+ { nullptr, ERRCODE_NONE }
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/global.hxx b/basic/inc/global.hxx
new file mode 100644
index 000000000..640759ef8
--- /dev/null
+++ b/basic/inc/global.hxx
@@ -0,0 +1,25 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#ifndef INCLUDED_BASIC_INC_GLOBAL_HXX
+#define INCLUDED_BASIC_INC_GLOBAL_HXX
+
+namespace utl {
+ class TransliterationWrapper;
+}
+
+class SbGlobal
+{
+public:
+ static utl::TransliterationWrapper& GetTransliteration();
+};
+
+#endif // INCLUDED_BASIC_INC_GLOBAL_HXX
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/pch/precompiled_sb.cxx b/basic/inc/pch/precompiled_sb.cxx
new file mode 100644
index 000000000..5b62b93c6
--- /dev/null
+++ b/basic/inc/pch/precompiled_sb.cxx
@@ -0,0 +1,12 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include "precompiled_sb.hxx"
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/pch/precompiled_sb.hxx b/basic/inc/pch/precompiled_sb.hxx
new file mode 100644
index 000000000..6784722ae
--- /dev/null
+++ b/basic/inc/pch/precompiled_sb.hxx
@@ -0,0 +1,129 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+/*
+ This file has been autogenerated by update_pch.sh. It is possible to edit it
+ manually (such as when an include file has been moved/renamed/removed). All such
+ manual changes will be rewritten by the next run of update_pch.sh (which presumably
+ also fixes all possible problems, so it's usually better to use it).
+
+ Generated on 2020-04-25 20:54:48 using:
+ ./bin/update_pch basic sb --cutoff=2 --exclude:system --exclude:module --include:local
+
+ If after updating build fails, use the following command to locate conflicting headers:
+ ./bin/update_pch_bisect ./basic/inc/pch/precompiled_sb.hxx "make basic.build" --find-conflicts
+*/
+
+#if PCH_LEVEL >= 1
+#include <cstddef>
+#include <math.h>
+#include <memory>
+#include <ostream>
+#include <stdio.h>
+#include <stdlib.h>
+#include <vector>
+#include <boost/property_tree/ptree_fwd.hpp>
+#endif // PCH_LEVEL >= 1
+#if PCH_LEVEL >= 2
+#include <osl/endian.h>
+#include <osl/file.hxx>
+#include <osl/process.h>
+#include <osl/thread.h>
+#include <osl/time.h>
+#include <rtl/character.hxx>
+#include <rtl/math.hxx>
+#include <rtl/string.hxx>
+#include <rtl/textenc.h>
+#include <rtl/ustrbuf.hxx>
+#include <rtl/ustring.hxx>
+#include <sal/config.h>
+#include <sal/log.hxx>
+#include <sal/saldllapi.h>
+#include <sal/types.h>
+#include <vcl/bitmap.hxx>
+#include <vcl/cairo.hxx>
+#include <vcl/devicecoordinate.hxx>
+#include <vcl/dllapi.h>
+#include <vcl/errcode.hxx>
+#include <vcl/font.hxx>
+#include <vcl/mapmod.hxx>
+#include <vcl/metaactiontypes.hxx>
+#include <vcl/outdev.hxx>
+#include <vcl/outdevmap.hxx>
+#include <vcl/outdevstate.hxx>
+#include <vcl/region.hxx>
+#include <vcl/salnativewidgets.hxx>
+#include <vcl/settings.hxx>
+#include <vcl/svapp.hxx>
+#include <vcl/vclreferencebase.hxx>
+#include <vcl/wall.hxx>
+#include <vcl/weld.hxx>
+#endif // PCH_LEVEL >= 2
+#if PCH_LEVEL >= 3
+#include <basegfx/color/bcolor.hxx>
+#include <basegfx/numeric/ftools.hxx>
+#include <basegfx/polygon/b2dpolypolygon.hxx>
+#include <basegfx/vector/b2enums.hxx>
+#include <com/sun/star/drawing/LineCap.hpp>
+#include <com/sun/star/uno/Any.hxx>
+#include <com/sun/star/uno/Reference.h>
+#include <com/sun/star/uno/Reference.hxx>
+#include <com/sun/star/uno/Sequence.hxx>
+#include <comphelper/processfactory.hxx>
+#include <comphelper/string.hxx>
+#include <i18nlangtag/lang.h>
+#include <o3tl/char16_t2wchar_t.hxx>
+#include <o3tl/cow_wrapper.hxx>
+#include <o3tl/float_int_conversion.hxx>
+#include <o3tl/safeint.hxx>
+#include <o3tl/typed_flags_set.hxx>
+#include <svl/SfxBroadcaster.hxx>
+#include <svl/zforlist.hxx>
+#include <tools/color.hxx>
+#include <tools/debug.hxx>
+#include <tools/gen.hxx>
+#include <tools/link.hxx>
+#include <tools/mapunit.hxx>
+#include <tools/poly.hxx>
+#include <tools/ref.hxx>
+#include <tools/solar.h>
+#include <tools/stream.hxx>
+#include <tools/toolsdllapi.h>
+#include <tools/urlobj.hxx>
+#include <tools/wintypes.hxx>
+#include <unotools/charclass.hxx>
+#include <unotools/fontdefs.hxx>
+#include <unotools/syslocale.hxx>
+#include <unotools/unotoolsdllapi.h>
+#endif // PCH_LEVEL >= 3
+#if PCH_LEVEL >= 4
+#include <basic/basicdllapi.h>
+#include <basic/sbdef.hxx>
+#include <basic/sberrors.hxx>
+#include <basic/sbmod.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/sbuno.hxx>
+#include <basic/sbx.hxx>
+#include <basic/sbxmeth.hxx>
+#include <basic/sbxobj.hxx>
+#include <basic/sbxvar.hxx>
+#include <date.hxx>
+#include <iosys.hxx>
+#include <rtlproto.hxx>
+#include <runtime.hxx>
+#include <sbintern.hxx>
+#include <sbobjmod.hxx>
+#include <sbunoobj.hxx>
+#include <sbxbase.hxx>
+#include <sbxfac.hxx>
+#include <sbxform.hxx>
+#include <sbxprop.hxx>
+#endif // PCH_LEVEL >= 4
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sb.hxx b/basic/inc/sb.hxx
new file mode 100644
index 000000000..bfac343fb
--- /dev/null
+++ b/basic/inc/sb.hxx
@@ -0,0 +1,32 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_INC_SB_HXX
+#define INCLUDED_BASIC_INC_SB_HXX
+
+#include <basic/sbxobj.hxx>
+
+// create object from user-type (+StringID+StringID)
+SbxObject* createUserTypeImpl( const OUString& rClassName );
+
+SbxObject* cloneTypeObjectImpl( const SbxObject& rTypeObj );
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sbobjmod.hxx b/basic/inc/sbobjmod.hxx
new file mode 100644
index 000000000..b87892f52
--- /dev/null
+++ b/basic/inc/sbobjmod.hxx
@@ -0,0 +1,99 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_INC_SBOBJMOD_HXX
+#define INCLUDED_BASIC_INC_SBOBJMOD_HXX
+
+#include <rtl/ref.hxx>
+#include <basic/sbmod.hxx>
+#include <com/sun/star/script/ModuleInfo.hpp>
+#include <com/sun/star/awt/XDialog.hpp>
+#include <com/sun/star/frame/XModel.hpp>
+#include <basic/basicdllapi.h>
+
+// Basic-Module for excel object.
+
+class SbObjModule : public SbModule
+{
+protected:
+ virtual ~SbObjModule() override;
+
+public:
+ SbObjModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVbaCompatible );
+ virtual SbxVariable* Find( const OUString& rName, SbxClassType t ) override;
+
+ virtual void Notify( SfxBroadcaster& rBC, const SfxHint& rHint ) override;
+
+ using SbxValue::GetObject;
+ SbxVariable* GetObject();
+ /// @throws css::uno::RuntimeException
+ void SetUnoObject( const css::uno::Any& aObj ) ;
+};
+
+class FormObjEventListenerImpl;
+
+class SbUserFormModule : public SbObjModule
+{
+ css::script::ModuleInfo m_mInfo;
+ ::rtl::Reference< FormObjEventListenerImpl > m_DialogListener;
+ css::uno::Reference<css::awt::XDialog> m_xDialog;
+ css::uno::Reference<css::frame::XModel> m_xModel;
+ bool mbInit;
+
+//protected:
+ void InitObject();
+public:
+ SbUserFormModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVBACompat );
+ virtual ~SbUserFormModule() override;
+ virtual SbxVariable* Find( const OUString& rName, SbxClassType t ) override;
+ void ResetApiObj( bool bTriggerTerminateEvent = true );
+ void Unload();
+ void Load();
+ void triggerMethod( const OUString& );
+ void triggerMethod( const OUString&, css::uno::Sequence< css::uno::Any >& );
+ void triggerActivateEvent();
+ void triggerDeactivateEvent();
+ void triggerInitializeEvent();
+ void triggerTerminateEvent();
+ void triggerLayoutEvent();
+ void triggerResizeEvent();
+
+ bool getInitState() const
+ { return mbInit; }
+ void setInitState( bool bInit )
+ { mbInit = bInit; }
+
+ class SbUserFormModuleInstance* CreateInstance();
+};
+
+class SbUserFormModuleInstance : public SbUserFormModule
+{
+ SbUserFormModule* m_pParentModule;
+
+public:
+ SbUserFormModuleInstance( SbUserFormModule* pParentModule, const OUString& rName,
+ const css::script::ModuleInfo& mInfo, bool bIsVBACompat );
+
+ virtual bool IsClass( const OUString& ) const override;
+ virtual SbxVariable* Find( const OUString& rName, SbxClassType t ) override;
+};
+
+#endif // INCLUDED_BASIC_INC_SBOBJMOD_HXX
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sbprop.hxx b/basic/inc/sbprop.hxx
new file mode 100644
index 000000000..bd4a8b117
--- /dev/null
+++ b/basic/inc/sbprop.hxx
@@ -0,0 +1,63 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_INC_SBPROP_HXX
+#define INCLUDED_BASIC_INC_SBPROP_HXX
+
+#include "sbxprop.hxx"
+#include <basic/sbdef.hxx>
+
+class SbModule;
+
+class SbProperty : public SbxProperty
+{
+ friend class SbiFactory;
+ friend class SbModule;
+ friend class SbProcedureProperty;
+ SbModule* pMod;
+ SbProperty( const OUString&, SbxDataType, SbModule* );
+ virtual ~SbProperty() override;
+public:
+ SBX_DECL_PERSIST_NODATA(SBXID_BASICPROP,1);
+ SbModule* GetModule() { return pMod; }
+};
+
+typedef tools::SvRef<SbProperty> SbPropertyRef;
+
+class SbProcedureProperty : public SbxProperty
+{
+ bool mbSet; // Flag for set command
+
+ virtual ~SbProcedureProperty() override;
+
+public:
+ SbProcedureProperty( const OUString& r, SbxDataType t )
+ : SbxProperty( r, t ) // , pMod( p )
+ , mbSet( false )
+ {}
+
+ bool isSet() const
+ { return mbSet; }
+ void setSet( bool bSet )
+ { mbSet = bSet; }
+};
+
+#endif // INCLUDED_BASIC_INC_SBPROP_HXX
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sbstdobj.hxx b/basic/inc/sbstdobj.hxx
new file mode 100644
index 000000000..ad242dfb1
--- /dev/null
+++ b/basic/inc/sbstdobj.hxx
@@ -0,0 +1,109 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_INC_SBSTDOBJ_HXX
+#define INCLUDED_BASIC_INC_SBSTDOBJ_HXX
+
+#include <basic/sbxobj.hxx>
+#include <vcl/graph.hxx>
+#include "sbxfac.hxx"
+#include <basic/basicdllapi.h>
+
+class SbStdFactory final : public SbxFactory
+{
+public:
+ SbStdFactory();
+
+ virtual SbxObject* CreateObject( const OUString& rClassName ) override;
+};
+
+class SbStdPicture final : public SbxObject
+{
+ Graphic aGraphic;
+
+ virtual ~SbStdPicture() override;
+ virtual void Notify( SfxBroadcaster& rBC, const SfxHint& rHint ) override;
+
+ void PropType( SbxVariable* pVar, bool bWrite );
+ void PropWidth( SbxVariable* pVar, bool bWrite );
+ void PropHeight( SbxVariable* pVar, bool bWrite );
+
+public:
+
+ SbStdPicture();
+
+ const Graphic& GetGraphic() const { return aGraphic; }
+ void SetGraphic( const Graphic& rGrf ) { aGraphic = rGrf; }
+};
+
+class SbStdFont final : public SbxObject
+{
+ bool bBold;
+ bool bItalic;
+ bool bStrikeThrough;
+ bool bUnderline;
+ sal_uInt16 nSize;
+ OUString aName;
+
+ virtual ~SbStdFont() override;
+ virtual void Notify( SfxBroadcaster& rBC, const SfxHint& rHint ) override;
+
+ void PropBold( SbxVariable* pVar, bool bWrite );
+ void PropItalic( SbxVariable* pVar, bool bWrite );
+ void PropStrikeThrough( SbxVariable* pVar, bool bWrite );
+ void PropUnderline( SbxVariable* pVar, bool bWrite );
+ void PropSize( SbxVariable* pVar, bool bWrite );
+ void PropName( SbxVariable* pVar, bool bWrite );
+
+public:
+
+ SbStdFont();
+
+ void SetBold( bool bB ) { bBold = bB; }
+ bool IsBold() const { return bBold; }
+ void SetItalic( bool bI ) { bItalic = bI; }
+ bool IsItalic() const { return bItalic; }
+ void SetStrikeThrough( bool bS ) { bStrikeThrough = bS; }
+ bool IsStrikeThrough() const { return bStrikeThrough; }
+ void SetUnderline( bool bU ) { bUnderline = bU; }
+ bool IsUnderline() const { return bUnderline; }
+ void SetSize( sal_uInt16 nS ) { nSize = nS; }
+ sal_uInt16 GetSize() const { return nSize; }
+};
+
+class SbStdClipboard final : public SbxObject
+{
+ virtual ~SbStdClipboard() override;
+ virtual void Notify( SfxBroadcaster& rBC, const SfxHint& rHint ) override;
+
+ static void MethClear( SbxArray const * pPar_ );
+ static void MethGetData( SbxArray* pPar_ );
+ static void MethGetFormat( SbxVariable* pVar, SbxArray* pPar_ );
+ static void MethGetText( SbxVariable* pVar, SbxArray const * pPar_ );
+ static void MethSetData( SbxArray* pPar_ );
+ static void MethSetText( SbxArray const * pPar_ );
+
+public:
+
+ SbStdClipboard();
+};
+
+#endif // INCLUDED_BASIC_INC_SBSTDOBJ_HXX
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sbxbase.hxx b/basic/inc/sbxbase.hxx
new file mode 100644
index 000000000..269f6029a
--- /dev/null
+++ b/basic/inc/sbxbase.hxx
@@ -0,0 +1,61 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_INC_SBXBASE_HXX
+#define INCLUDED_BASIC_INC_SBXBASE_HXX
+
+#include <sal/config.h>
+
+#include <basic/sbxvar.hxx>
+#include <i18nlangtag/lang.h>
+#include <vcl/errcode.hxx>
+
+#include <memory>
+#include <vector>
+
+class SbxFactory;
+class SbxVariable;
+class SbxBasicFormater;
+
+// AppData structure for SBX:
+struct SbxAppData
+{
+ ErrCode eErrCode; // Error code
+ SbxVariableRef m_aGlobErr; // Global error object
+ std::vector<std::unique_ptr<SbxFactory>>
+ m_Factories;
+ tools::SvRef<SvRefBase> mrImplRepository;
+
+ // Pointer to Format()-Command helper class
+ std::unique_ptr<SbxBasicFormater> pBasicFormater;
+
+ LanguageType eBasicFormaterLangType;
+ // It might be useful to store this class 'global' because some string resources are saved here
+
+ SbxAppData();
+ SbxAppData(const SbxAppData&) = delete;
+ const SbxAppData& operator=(const SbxAppData&) = delete;
+ ~SbxAppData();
+};
+
+SbxAppData& GetSbxData_Impl();
+
+#endif // INCLUDED_BASIC_INC_SBXBASE_HXX
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sbxfac.hxx b/basic/inc/sbxfac.hxx
new file mode 100644
index 000000000..e9b130eec
--- /dev/null
+++ b/basic/inc/sbxfac.hxx
@@ -0,0 +1,37 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#pragma once
+
+#include <rtl/ustring.hxx>
+#include <basic/basicdllapi.h>
+
+class SbxBase;
+class SbxObject;
+
+class SbxFactory
+{
+public:
+ virtual ~SbxFactory();
+ SbxFactory() {}
+ virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 );
+ virtual SbxObject* CreateObject( const OUString& );
+};
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sbxform.hxx b/basic/inc/sbxform.hxx
new file mode 100644
index 000000000..94dece698
--- /dev/null
+++ b/basic/inc/sbxform.hxx
@@ -0,0 +1,154 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#pragma once
+
+
+// Implementation class for Basic command: Format$( d,formatStr )
+
+/*
+ Grammar of format string (a try):
+ -----------------------------------------------
+
+ format_string := {\special_char} general_format | scientific_format {\special_char} {;format_string}
+ general_format := {#[,]}{0[,]}[.{0}{#}]
+ scientific_format := {0}[.{0}{#}](e | E)(+ | -){#}{0}
+
+ percent_char := '%'
+ special_char := \char | + | - | ( | ) | $ | space_char
+ char := all_ascii_chars
+ space_char := ' '
+
+ {} repeated multiple times (incl. zero times)
+ [] exactly one or zero times
+ () parenthesis, e.g. (e | E) means e or E times
+
+ Additional predefined formats for the format string:
+ "General Number"
+ "Currency"
+ "Fixed"
+ "Standard"
+ "Percent"
+ "Scientific"
+ "Yes/No"
+ "True/False"
+ "On/Off"
+
+ Note: invalid format string are ignored just as in VisualBasic, the output is
+ probably 'undefined'. ASCII letters are outputted directly.
+
+ Constraints in VisualBasic:
+ - the exponent (scientific syntax) has a maximum of three digits!
+
+ Constraints of new implementation:
+ - the '+' sign is not allowed as wildcard in the mantissa
+
+ TODO:
+ - Date formatting
+ Wildcards are: 'h', 'm', 's', 'y'
+ predefined String-Constants/Commands:
+ "AMPM", "Long Date", "Long Time"
+*/
+
+#include <rtl/ustring.hxx>
+#include <rtl/ustrbuf.hxx>
+
+class SbxBasicFormater {
+ public:
+ // Constructor takes signs for decimal point, thousand separation sign
+ // and necessary resource strings.
+ SbxBasicFormater( sal_Unicode _cDecPoint, sal_Unicode _cThousandSep,
+ const OUString& _sOnStrg,
+ const OUString& _sOffStrg,
+ const OUString& _sYesStrg,
+ const OUString& _sNoStrg,
+ const OUString& _sTrueStrg,
+ const OUString& _sFalseStrg,
+ const OUString& _sCurrencyStrg,
+ const OUString& _sCurrencyFormatStrg );
+
+ /* Basic command: Format$( number,format-string )
+
+ Parameter:
+ dNumber : number to be formatted
+ sFormatStrg : the Format-String, e.g. ###0.0###
+
+ Return value:
+ String containing the formatted output
+ */
+ OUString BasicFormat( double dNumber, const OUString& sFormatStrg );
+ static OUString BasicFormatNull( const OUString& sFormatStrg );
+
+ static bool isBasicFormat( const OUString& sFormatStrg );
+
+ private:
+ static inline void ShiftString( OUStringBuffer& sStrg, sal_uInt16 nStartPos );
+ static void AppendDigit( OUStringBuffer& sStrg, short nDigit );
+ void LeftShiftDecimalPoint( OUStringBuffer& sStrg );
+ void StrRoundDigit( OUStringBuffer& sStrg, short nPos, bool& bOverflow );
+ void StrRoundDigit( OUStringBuffer& sStrg, short nPos );
+ static void ParseBack( OUStringBuffer& sStrg, const OUString& sFormatStrg,
+ short nFormatPos );
+ // Methods for string conversion with sprintf():
+ void InitScan( double _dNum );
+ void InitExp( double _dNewExp );
+ short GetDigitAtPosScan( short nPos, bool& bFoundFirstDigit );
+ short GetDigitAtPosExpScan( double dNewExponent, short nPos,
+ bool& bFoundFirstDigit );
+ short GetDigitAtPosExpScan( short nPos, bool& bFoundFirstDigit );
+ static OUString GetPosFormatString( const OUString& sFormatStrg, bool & bFound );
+ static OUString GetNegFormatString( const OUString& sFormatStrg, bool & bFound );
+ static OUString Get0FormatString( const OUString& sFormatStrg, bool & bFound );
+ static OUString GetNullFormatString( const OUString& sFormatStrg, bool & bFound );
+ static void AnalyseFormatString( const OUString& sFormatStrg,
+ short& nNoOfDigitsLeft, short& nNoOfDigitsRight,
+ short& nNoOfOptionalDigitsLeft,
+ short& nNoOfExponentDigits,
+ short& nNoOfOptionalExponentDigits,
+ bool& bPercent, bool& bCurrency, bool& bScientific,
+ bool& bGenerateThousandSeparator,
+ short& nMultipleThousandSeparators );
+ void ScanFormatString( double dNumber, const OUString& sFormatStrg,
+ OUString& sReturnStrg, bool bCreateSign );
+
+ //*** Data ***
+ sal_Unicode cDecPoint; // sign for the decimal point
+ sal_Unicode cThousandSep; // sign for thousand delimiter
+ // Text for output:
+ OUString sOnStrg;
+ OUString sOffStrg;
+ OUString sYesStrg;
+ OUString sNoStrg;
+ OUString sTrueStrg;
+ OUString sFalseStrg;
+ OUString sCurrencyStrg;
+ OUString sCurrencyFormatStrg;
+
+ //*** temporary data for scan loop ***
+
+ // String containing the number in scientific format
+ OUString sSciNumStrg;
+ // String containing the exponent of the number
+ OUString sNumExpStrg;
+ double dNum; // the number that is scanned
+ short nNumExp; // the exponent of the number
+ short nExpExp; // the number of digits in the exponent
+};
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/sbxprop.hxx b/basic/inc/sbxprop.hxx
new file mode 100644
index 000000000..0c57d0b72
--- /dev/null
+++ b/basic/inc/sbxprop.hxx
@@ -0,0 +1,37 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#pragma once
+
+#include <basic/sbxvar.hxx>
+
+class SbxProperty : public SbxVariable
+{
+public:
+ SBX_DECL_PERSIST_NODATA(SBXID_PROPERTY,1);
+ SbxProperty( const OUString& r, SbxDataType t );
+ SbxProperty( const SbxProperty& r ) : SvRefBase( r ), SbxVariable( r ) {}
+ virtual ~SbxProperty() override;
+ SbxProperty& operator=( const SbxProperty& r )
+ { SbxVariable::operator=( r ); return *this; }
+ virtual SbxClassType GetClass() const override;
+};
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/inc/strings.hrc b/basic/inc/strings.hrc
new file mode 100644
index 000000000..c257ac2fd
--- /dev/null
+++ b/basic/inc/strings.hrc
@@ -0,0 +1,38 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_INC_STRINGS_HRC
+#define INCLUDED_BASIC_INC_STRINGS_HRC
+
+#define NC_(Context, String) reinterpret_cast<char const *>(Context "\004" u8##String)
+
+#define STR_BASICKEY_FORMAT_ON NC_("STR_BASICKEY_FORMAT_ON", "On")
+#define STR_BASICKEY_FORMAT_OFF NC_("STR_BASICKEY_FORMAT_OFF", "Off")
+#define STR_BASICKEY_FORMAT_TRUE NC_("STR_BASICKEY_FORMAT_TRUE", "True")
+#define STR_BASICKEY_FORMAT_FALSE NC_("STR_BASICKEY_FORMAT_FALSE", "False")
+#define STR_BASICKEY_FORMAT_YES NC_("STR_BASICKEY_FORMAT_YES", "Yes")
+#define STR_BASICKEY_FORMAT_NO NC_("STR_BASICKEY_FORMAT_NO", "No")
+//format currency
+#define STR_BASICKEY_FORMAT_CURRENCY NC_("STR_BASICKEY_FORMAT_CURRENCY", "@0.00 $;@(0.00 $)")
+
+#define IDS_SBERR_TERMINATED NC_("IDS_SBERR_TERMINATED", "The macro running has been interrupted")
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/basic_coverage/da-DK/cdbl-2.vb b/basic/qa/basic_coverage/da-DK/cdbl-2.vb
new file mode 100644
index 000000000..a219304d4
--- /dev/null
+++ b/basic/qa/basic_coverage/da-DK/cdbl-2.vb
@@ -0,0 +1,14 @@
+Function doUnitTest() as Integer
+ Dim A As String
+ Dim B As Double
+ Dim Expected As Double
+ A = "222,222"
+ ' in da-DK locale ',' is the decimal separator
+ Expected = 222.222
+ B = Cdbl(A)
+ If B <> Expected Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/da-DK/cdbl.vb b/basic/qa/basic_coverage/da-DK/cdbl.vb
new file mode 100644
index 000000000..128cfcc99
--- /dev/null
+++ b/basic/qa/basic_coverage/da-DK/cdbl.vb
@@ -0,0 +1,14 @@
+Function doUnitTest() as Integer
+ Dim A As String
+ Dim B As Double
+ Dim Expected As String
+ A = "222.222"
+ ' in da-DK locale ',' is the decimal separator
+ Expected = "222222"
+ B = Cdbl(A)
+ If B <> Expected Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/string_left_01.vb b/basic/qa/basic_coverage/string_left_01.vb
new file mode 100644
index 000000000..ef896bef1
--- /dev/null
+++ b/basic/qa/basic_coverage/string_left_01.vb
@@ -0,0 +1,25 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+
+Function doUnitTest as Integer
+
+Dim s1 As String
+Dim s2 As String
+
+ s1 = "abc"
+
+ s2 = Left(s1, 2)
+
+ If s2 = "ab" Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+
+End Function
diff --git a/basic/qa/basic_coverage/string_right_01.vb b/basic/qa/basic_coverage/string_right_01.vb
new file mode 100644
index 000000000..65b16c6a8
--- /dev/null
+++ b/basic/qa/basic_coverage/string_right_01.vb
@@ -0,0 +1,24 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+
+Dim s1 As String
+Dim s2 As String
+
+ s1 = "abc"
+
+ s2 = Right(s1, 2)
+
+ If s2 = "bc" Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+
+End Function
diff --git a/basic/qa/basic_coverage/test_Property.GetLet.vb b/basic/qa/basic_coverage/test_Property.GetLet.vb
new file mode 100644
index 000000000..992496a21
--- /dev/null
+++ b/basic/qa/basic_coverage/test_Property.GetLet.vb
@@ -0,0 +1,27 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Option Compatible
+
+Function doUnitTest as Integer
+ ' PROPERTY GET/LET
+ aString = "Office"
+ If ( aString <> "LibreOffice") Then
+ doUnitTest = 0 ' Ko
+ Else
+ doUnitTest = 1 ' Ok
+ End If
+End Function
+
+Dim _pn As String
+Property Get aString As String
+ aString = _pn
+End Property
+Property Let aString(value As String)
+ _pn = "Libre"& value
+End Property
diff --git a/basic/qa/basic_coverage/test_Property.GetSet.vb b/basic/qa/basic_coverage/test_Property.GetSet.vb
new file mode 100644
index 000000000..4a23867c2
--- /dev/null
+++ b/basic/qa/basic_coverage/test_Property.GetSet.vb
@@ -0,0 +1,37 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Option Compatible
+
+Function doUnitTest as Integer
+ ' PROPERTY GET/SET for classes or UNO services
+
+ Set objSetter = New Collection ' OR objLetter = New Collection
+ If ( objGetter.Count <> 3 ) Then
+ doUnitTest = 0 ' not Ok
+ Else
+ doUnitTest = 1 ' Ok
+ End If
+End Function
+
+Sub DEV_TST : MsgBox doUnitTesT : End Sub
+
+Property Get objGetter As Object
+ _obj.add "roots"
+ Set objGetter = _obj
+End Property
+
+Private _obj As Object
+
+Property Set objSetter(value As Object)
+ Set _obj = value
+ With _obj
+ .add "branches"
+ .add "leaves"
+ End With
+End Property
diff --git a/basic/qa/basic_coverage/test_abs_method.vb b/basic/qa/basic_coverage/test_abs_method.vb
new file mode 100644
index 000000000..b79b9bcbb
--- /dev/null
+++ b/basic/qa/basic_coverage/test_abs_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' ABS
+ If (Abs(-3.5) <> 3.5) Then
+ doUnitTest = 0
+ ElseIf (Abs(3.5) <> 3.5) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_array_method.vb b/basic/qa/basic_coverage/test_array_method.vb
new file mode 100644
index 000000000..42f10a25a
--- /dev/null
+++ b/basic/qa/basic_coverage/test_array_method.vb
@@ -0,0 +1,20 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVector as Variant
+ ' ARRAY
+ aVector = Array( "Hello", -3.14)
+ If (aVector(0) <> "Hello") Then
+ doUnitTest = 0
+ ElseIf ( aVector(1) <> -3.14 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_asc_method.vb b/basic/qa/basic_coverage/test_asc_method.vb
new file mode 100644
index 000000000..48b88933f
--- /dev/null
+++ b/basic/qa/basic_coverage/test_asc_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' ASC
+ If (Asc("€a") <> 8364) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_atn_method.vb b/basic/qa/basic_coverage/test_atn_method.vb
new file mode 100644
index 000000000..771714134
--- /dev/null
+++ b/basic/qa/basic_coverage/test_atn_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' ATN (arc tan)
+ If (Atn(1) <> PI/4) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_beep_method.vb b/basic/qa/basic_coverage/test_beep_method.vb
new file mode 100644
index 000000000..28eed61a6
--- /dev/null
+++ b/basic/qa/basic_coverage/test_beep_method.vb
@@ -0,0 +1,12 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' BEEP
+ Beep
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_cbool_method.vb b/basic/qa/basic_coverage/test_cbool_method.vb
new file mode 100644
index 000000000..d1d995f19
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cbool_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CBOOL
+ If (CBool(3) <> True) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cbyte_method.vb b/basic/qa/basic_coverage/test_cbyte_method.vb
new file mode 100644
index 000000000..35bb1654c
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cbyte_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CBYTE
+ If (CByte("3") <> 3) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_ccur_method.vb b/basic/qa/basic_coverage/test_ccur_method.vb
new file mode 100644
index 000000000..b84ddafd5
--- /dev/null
+++ b/basic/qa/basic_coverage/test_ccur_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CCUR
+ If (CCur("100") <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cdate_method.vb b/basic/qa/basic_coverage/test_cdate_method.vb
new file mode 100644
index 000000000..c26287b1f
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cdate_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CDATE
+ If (CDate(100) <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cdatetofromiso_methods.vb b/basic/qa/basic_coverage/test_cdatetofromiso_methods.vb
new file mode 100644
index 000000000..d2f4ce9c7
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cdatetofromiso_methods.vb
@@ -0,0 +1,41 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CDateFromIso CDateToIso
+ If ( CDateToIso( CDateFromIso("20161016") ) <> "20161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("2016-10-16") ) <> "20161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("-2016-10-16") ) <> "-20161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("-20161016") ) <> "-20161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("12016-10-16") ) <> "120161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("120161016") ) <> "120161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("-12016-10-16") ) <> "-120161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("-120161016") ) <> "-120161016" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("0001-01-01") ) <> "00010101" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("00010101") ) <> "00010101" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("-0001-12-31") ) <> "-00011231" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("-00011231") ) <> "-00011231" ) Then
+ doUnitTest = 0
+ ElseIf ( CDateToIso( CDateFromIso("991231") ) <> "19991231" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+ ' TODO: add some failure tests for misformed input, On Error whatever?
+End Function
diff --git a/basic/qa/basic_coverage/test_cdatetounodatecdatefromunodate_methods.vb b/basic/qa/basic_coverage/test_cdatetounodatecdatefromunodate_methods.vb
new file mode 100644
index 000000000..2aa735c54
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cdatetounodatecdatefromunodate_methods.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Date()
+ ' CDateToUnoDate CDateFromUnoDate
+ If ( CDateFromUnoDate( CDateToUnoDate( aDate ) ) <> aDate ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cdatetounodatetimecdatefromunodatetime_methods.vb b/basic/qa/basic_coverage/test_cdatetounodatetimecdatefromunodatetime_methods.vb
new file mode 100644
index 000000000..9aa5680b1
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cdatetounodatetimecdatefromunodatetime_methods.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Now()
+ ' CDateToUnoDateTime CDateFromUnoDateTime
+ If ( CDateFromUnoDateTime( CDateToUnoDateTime( aDate ) ) <> aDate ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cdatetounotimecdatefromunotime_methods.vb b/basic/qa/basic_coverage/test_cdatetounotimecdatefromunotime_methods.vb
new file mode 100644
index 000000000..38fd9da45
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cdatetounotimecdatefromunotime_methods.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Time()
+ ' CDateToUnoTime CDateFromUnoTime
+ If ( CDateFromUnoTime( CDateToUnoTime( aDate ) ) <> aDate ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cdbl_method.vb b/basic/qa/basic_coverage/test_cdbl_method.vb
new file mode 100644
index 000000000..a0ba8f029
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cdbl_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CDBL
+ If (CDbl("100") <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_chdircurdir_methods.vb b/basic/qa/basic_coverage/test_chdircurdir_methods.vb
new file mode 100644
index 000000000..dadd65b10
--- /dev/null
+++ b/basic/qa/basic_coverage/test_chdircurdir_methods.vb
@@ -0,0 +1,12 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CHDIR CURDIR
+ ChDir( CurDir )
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_choose_method.vb b/basic/qa/basic_coverage/test_choose_method.vb
new file mode 100644
index 000000000..6ab2aea80
--- /dev/null
+++ b/basic/qa/basic_coverage/test_choose_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CHOOSE
+ If (Choose(2, 1, 100, 3) <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_chr_method.vb b/basic/qa/basic_coverage/test_chr_method.vb
new file mode 100644
index 000000000..8e8179463
--- /dev/null
+++ b/basic/qa/basic_coverage/test_chr_method.vb
@@ -0,0 +1,64 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+Function overflow1 as Integer
+ On Error GoTo handler
+ Chr(-32769)
+ overflow1 = 0
+ Exit Function
+handler:
+ if (Err <> 6) Then
+ overflow1 = 0
+ Exit Function
+ Endif
+ overflow1 = 1
+End Function
+
+Function overflow2 as Integer
+ On Error GoTo handler
+ Chr(65536)
+ overflow2 = 0
+ Exit Function
+handler:
+ if (Err <> 6) Then
+ overflow2 = 0
+ Exit Function
+ Endif
+ overflow2 = 1
+End Function
+
+Function overflow3 as Integer
+ On Error GoTo handler
+ Chr(&H10000)
+ overflow3 = 0
+ Exit Function
+handler:
+ if (Err <> 6) Then
+ overflow3 = 0
+ Exit Function
+ Endif
+ overflow3 = 1
+End Function
+
+Function doUnitTest as Integer
+ Chr(-32768)
+ Chr(65535)
+ Chr(&H8000)
+ Chr(&HFFFF)
+ if (overflow1 = 0) Then
+ doUnitTest = 0
+ Exit Function
+ Endif
+ if (overflow2 = 0) Then
+ doUnitTest = 0
+ Exit Function
+ Endif
+ if (overflow3 = 0) Then
+ doUnitTest = 0
+ Exit Function
+ Endif
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_cint_method.vb b/basic/qa/basic_coverage/test_cint_method.vb
new file mode 100644
index 000000000..b84af04d7
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cint_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CINT
+ If (CInt("100") <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_compatibilitymode_method.vb b/basic/qa/basic_coverage/test_compatibilitymode_method.vb
new file mode 100644
index 000000000..599adb963
--- /dev/null
+++ b/basic/qa/basic_coverage/test_compatibilitymode_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CompatibilityMode
+ If (CompatibilityMode(True) <> True) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_converttofromurl_methods.vb b/basic/qa/basic_coverage/test_converttofromurl_methods.vb
new file mode 100644
index 000000000..40c6494bd
--- /dev/null
+++ b/basic/qa/basic_coverage/test_converttofromurl_methods.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' ConvertFromUrl ConvertToUrl
+ If ( ConvertToUrl( ConvertFromUrl("") ) <> "") Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cossin_methods.vb b/basic/qa/basic_coverage/test_cossin_methods.vb
new file mode 100644
index 000000000..c4a5cc5e5
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cossin_methods.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' COS SIN
+ If ( Abs(Cos(PI/3) - Sin(PI/6)) > 1E-6 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_createobject_method.vb b/basic/qa/basic_coverage/test_createobject_method.vb
new file mode 100644
index 000000000..6ae316b57
--- /dev/null
+++ b/basic/qa/basic_coverage/test_createobject_method.vb
@@ -0,0 +1,21 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Type address
+ Name1 As String
+ City As String
+End Type
+
+Function doUnitTest as Integer
+ ' CREATEOBJECT
+ If ( IsObject( CreateObject("address") ) = False ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_createunolistener_method.vb b/basic/qa/basic_coverage/test_createunolistener_method.vb
new file mode 100644
index 000000000..08c71fd8a
--- /dev/null
+++ b/basic/qa/basic_coverage/test_createunolistener_method.vb
@@ -0,0 +1,13 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CreateUnoListener
+ Dim oListener
+ oListener = CreateUnoListener( "ContListener_","com.sun.star.container.XContainerListener" )
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_createunoservice_method.vb b/basic/qa/basic_coverage/test_createunoservice_method.vb
new file mode 100644
index 000000000..8fc043fd3
--- /dev/null
+++ b/basic/qa/basic_coverage/test_createunoservice_method.vb
@@ -0,0 +1,13 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CreateUnoService
+ Dim filepicker
+ filepicker = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_createunostruct_method.vb b/basic/qa/basic_coverage/test_createunostruct_method.vb
new file mode 100644
index 000000000..f08368fed
--- /dev/null
+++ b/basic/qa/basic_coverage/test_createunostruct_method.vb
@@ -0,0 +1,13 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CreateUnoStruct
+ Dim oStruct
+ oStruct = CreateUnoStruct( "com.sun.star.beans.Property" )
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_createunovalue_method.vb b/basic/qa/basic_coverage/test_createunovalue_method.vb
new file mode 100644
index 000000000..e640354ac
--- /dev/null
+++ b/basic/qa/basic_coverage/test_createunovalue_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CreateUnoValue
+ Dim oUnoValue as Variant
+ Dim aValue as Variant
+ aValue = Array ( 1, 1 )
+ oUnoValue = CreateUnoValue( "[]byte", aValue )
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_csng_method.vb b/basic/qa/basic_coverage/test_csng_method.vb
new file mode 100644
index 000000000..87704ec1d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_csng_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CSNG
+ If (CSng("100") <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cstr_method.vb b/basic/qa/basic_coverage/test_cstr_method.vb
new file mode 100644
index 000000000..53484b06f
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cstr_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CSTR
+ If (CStr(100) <> "100") Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cvar_method.vb b/basic/qa/basic_coverage/test_cvar_method.vb
new file mode 100644
index 000000000..cc13bef6c
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cvar_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CVAR
+ If (CVar(100) <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_cverr_method.vb b/basic/qa/basic_coverage/test_cverr_method.vb
new file mode 100644
index 000000000..f74445c20
--- /dev/null
+++ b/basic/qa/basic_coverage/test_cverr_method.vb
@@ -0,0 +1,36 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' CVERR
+ If (CVerr(100) <> 100) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+
+ ' tdf#79426 - passing an error object to a function
+ if ( TestCVErr( CVErr( 2 ) ) <> 2 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+
+ ' tdf#79426 - test with Error-Code 448 ( ERRCODE_BASIC_NAMED_NOT_FOUND )
+ if ( TestCVErr( CVErr( 448 ) ) <> 448 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+Function TestCVErr(vErr As Variant)
+ Dim nValue As Integer
+ nValue = vErr
+ TestCVErr = nValue
+End Function \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_date_literal.vb b/basic/qa/basic_coverage/test_date_literal.vb
new file mode 100644
index 000000000..a175368f3
--- /dev/null
+++ b/basic/qa/basic_coverage/test_date_literal.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+
+Function doUnitTest as Integer
+ If #07/28/1977# = 28334 And #1977-07-28# = 28334 Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_datedateadddatediff_methods.vb b/basic/qa/basic_coverage/test_datedateadddatediff_methods.vb
new file mode 100644
index 000000000..4ba40f8eb
--- /dev/null
+++ b/basic/qa/basic_coverage/test_datedateadddatediff_methods.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Date()
+ ' DATE DATEDIFF DATEADD
+ If ( DateDiff( "d", aDate, DateAdd("d", 1, aDate) ) <> 1 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_datedatepartday_methods.vb b/basic/qa/basic_coverage/test_datedatepartday_methods.vb
new file mode 100644
index 000000000..04cc326f7
--- /dev/null
+++ b/basic/qa/basic_coverage/test_datedatepartday_methods.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Date()
+ ' DATEPART DAY
+ If ( DatePart( "d", aDate ) <> Day( aDate ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_dimarray_method.vb b/basic/qa/basic_coverage/test_dimarray_method.vb
new file mode 100644
index 000000000..f92c7459d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_dimarray_method.vb
@@ -0,0 +1,18 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ Dim aValue as variant
+ aValue = DimArray( 1, 2, 4 )
+ aValue( 1, 2, 4 ) = 3
+ ' DIMARRAY
+ If ( aValue( 1, 2, 4 ) <> 3 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_empty_parameter.vb b/basic/qa/basic_coverage/test_empty_parameter.vb
new file mode 100644
index 000000000..fe6e2651c
--- /dev/null
+++ b/basic/qa/basic_coverage/test_empty_parameter.vb
@@ -0,0 +1,22 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Sub assignVar(v As Variant)
+ v = 1
+End Sub
+
+Function doUnitTest() As Integer
+ ' tdf#132563 - check if empty parameters are converted to their respective types
+ anEmptyVar = Empty
+ assignVar(anEmptyVar)
+ If (anEmptyVar = 1 And TypeName(anEmptyVar) = "Integer") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_environ_method.vb b/basic/qa/basic_coverage/test_environ_method.vb
new file mode 100644
index 000000000..63b6f360a
--- /dev/null
+++ b/basic/qa/basic_coverage/test_environ_method.vb
@@ -0,0 +1,12 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' ENVIRON
+ Environ ("TMP")
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_equalunoobjects_method.vb b/basic/qa/basic_coverage/test_equalunoobjects_method.vb
new file mode 100644
index 000000000..b48111546
--- /dev/null
+++ b/basic/qa/basic_coverage/test_equalunoobjects_method.vb
@@ -0,0 +1,25 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' EqualUnoObjects
+ ' Copy of objects -> same instance
+ oIntrospection = CreateUnoService( "com.sun.star.beans.Introspection" )
+ oIntro2 = oIntrospection
+ If ( EqualUnoObjects( oIntrospection, oIntro2 ) = False ) Then
+ doUnitTest = 0
+ Else
+ ' Copy of structs as value -> new instance
+ Dim Struct1 as new com.sun.star.beans.Property
+ Struct2 = Struct1
+ If ( EqualUnoObjects( Struct1, Struct2 ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_erl_method.vb b/basic/qa/basic_coverage/test_erl_method.vb
new file mode 100644
index 000000000..b541b15fa
--- /dev/null
+++ b/basic/qa/basic_coverage/test_erl_method.vb
@@ -0,0 +1,22 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' ERL
+ On Error GoTo ErrorHandler ' Set up error handler
+ Dim nVar As Integer
+ nVar = 0
+ nVar = 1/nVar
+ doUnitTest = 0
+ Exit Function
+ErrorHandler:
+ If ( Erl <> 13 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ Endif
+End Function
diff --git a/basic/qa/basic_coverage/test_err_method.vb b/basic/qa/basic_coverage/test_err_method.vb
new file mode 100644
index 000000000..c21b417b4
--- /dev/null
+++ b/basic/qa/basic_coverage/test_err_method.vb
@@ -0,0 +1,22 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' ERR
+ On Error GoTo ErrorHandler ' Set up error handler
+ Dim nVar As Integer
+ nVar = 0
+ nVar = 1/nVar
+ doUnitTest = 0
+ Exit Function
+ErrorHandler:
+ If ( Err <> 11 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ Endif
+End Function
diff --git a/basic/qa/basic_coverage/test_falsetrue_method.vb b/basic/qa/basic_coverage/test_falsetrue_method.vb
new file mode 100644
index 000000000..f99b8032b
--- /dev/null
+++ b/basic/qa/basic_coverage/test_falsetrue_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' FALSE TRUE
+ If (False = True) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_filedatetime_nonexistent.vb b/basic/qa/basic_coverage/test_filedatetime_nonexistent.vb
new file mode 100644
index 000000000..53a72549c
--- /dev/null
+++ b/basic/qa/basic_coverage/test_filedatetime_nonexistent.vb
@@ -0,0 +1,20 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+'Bug 121337 - FileDateTime("\\nonexistent\smb\path") returns bogus result rather than throwing error
+Function doUnitTest as Integer
+ On Error GoTo ErrorHandler ' Set up error handler
+ Dim result
+ result = FileDateTime("/bogus/unix/path")
+ doUnitTest = 0
+ Exit Function
+ErrorHandler:
+ If ( Err <> 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ Endif
+End Function
diff --git a/basic/qa/basic_coverage/test_filedatetime_nonexistent2.vb b/basic/qa/basic_coverage/test_filedatetime_nonexistent2.vb
new file mode 100644
index 000000000..2135b25d2
--- /dev/null
+++ b/basic/qa/basic_coverage/test_filedatetime_nonexistent2.vb
@@ -0,0 +1,20 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+'Bug 121337 - FileDateTime("\\nonexistent\smb\path") returns bogus result rather than throwing error
+Function doUnitTest as Integer
+ On Error GoTo ErrorHandler ' Set up error handler
+ Dim result
+ result = FileDateTime("\\bogus\smb\path")
+ doUnitTest = 0
+ Exit Function
+ErrorHandler:
+ If ( Err <> 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ Endif
+End Function
diff --git a/basic/qa/basic_coverage/test_fix_method.vb b/basic/qa/basic_coverage/test_fix_method.vb
new file mode 100644
index 000000000..91d2f01fc
--- /dev/null
+++ b/basic/qa/basic_coverage/test_fix_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' FIX
+ If (Fix(PI) <> 3) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_for_each.vb b/basic/qa/basic_coverage/test_for_each.vb
new file mode 100644
index 000000000..654513e88
--- /dev/null
+++ b/basic/qa/basic_coverage/test_for_each.vb
@@ -0,0 +1,43 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ Dim n As Integer, i
+ Dim a(3)
+ n = 0
+ For Each i In a
+ n = n + 1
+ Next i
+ If n <> 4 Then
+ doUnitTest = "For Each over array failed"
+ Exit Function
+ End If
+
+ If TestInvalidForEachWithErrorHandler <> "13 91 14 " Then
+ doUnitTest = "For Each doesn't generate proper errors on bad arguments"
+ Exit Function
+ End If
+
+ doUnitTest = 1
+End Function
+
+Function TestInvalidForEachWithErrorHandler
+ Dim s As String
+ On Error Goto ErrHandler
+' This For Each is given a bad iterable; it must generate first error ("Data type mismatch") for b;
+ For Each a In b
+' Then proceed here (Resume Next from ErrHandler), and generate "Object variable not set" for c;
+ c.d
+' Then proceed here (Resume Next from ErrHandler), and generate "Invalid parameter" at Next.
+ Next
+ TestInvalidForEachWithErrorHandler = s
+ Exit Function
+ErrHandler:
+ s = s & Err & " "
+ Resume Next
+End Function
diff --git a/basic/qa/basic_coverage/test_frac_method.vb b/basic/qa/basic_coverage/test_frac_method.vb
new file mode 100644
index 000000000..14d6863db
--- /dev/null
+++ b/basic/qa/basic_coverage/test_frac_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' FRAC
+ If ( 3+Frac(PI) <> PI) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_freefile_method.vb b/basic/qa/basic_coverage/test_freefile_method.vb
new file mode 100644
index 000000000..d2a5cb93b
--- /dev/null
+++ b/basic/qa/basic_coverage/test_freefile_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' FREEFILE
+ If ( FreeFile < 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_freelibrary_method.vb b/basic/qa/basic_coverage/test_freelibrary_method.vb
new file mode 100644
index 000000000..4f6f9cd2d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_freelibrary_method.vb
@@ -0,0 +1,12 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' FREELIBRARY
+ FreeLibrary("")
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_getdefaultcontext_method.vb b/basic/qa/basic_coverage/test_getdefaultcontext_method.vb
new file mode 100644
index 000000000..8a90d6e96
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getdefaultcontext_method.vb
@@ -0,0 +1,12 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GetDefaultContext
+ GetDefaultContext()
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_getdialogzoomfactorx_method.vb b/basic/qa/basic_coverage/test_getdialogzoomfactorx_method.vb
new file mode 100644
index 000000000..279fc005d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getdialogzoomfactorx_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GETDIALOGFACTORX
+ If ( GetDialogZoomFactorX(100) < 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_getdialogzoomfactory_method.vb b/basic/qa/basic_coverage/test_getdialogzoomfactory_method.vb
new file mode 100644
index 000000000..f4139bed5
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getdialogzoomfactory_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GETDIALOGFACTORY
+ If ( GetDialogZoomFactorY(100) < 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_getguitype_method.vb b/basic/qa/basic_coverage/test_getguitype_method.vb
new file mode 100644
index 000000000..c1606da10
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getguitype_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GETGUITYPE
+ If ( GetGuiType = 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_getguiversion_method.vb b/basic/qa/basic_coverage/test_getguiversion_method.vb
new file mode 100644
index 000000000..a70ff07e6
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getguiversion_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GETGUIVERSION
+ If ( GetGuiVersion = 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_getpathseparator_method.vb b/basic/qa/basic_coverage/test_getpathseparator_method.vb
new file mode 100644
index 000000000..63a7b6737
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getpathseparator_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GETPATHSEPARATOR
+ If ( GetPathSeparator = "" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_getprocessservicemanager_method.vb b/basic/qa/basic_coverage/test_getprocessservicemanager_method.vb
new file mode 100644
index 000000000..90e2012d6
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getprocessservicemanager_method.vb
@@ -0,0 +1,12 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GetProcessServiceManager
+ GetProcessServiceManager()
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_getsolarversion_method.vb b/basic/qa/basic_coverage/test_getsolarversion_method.vb
new file mode 100644
index 000000000..c2a75d11d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getsolarversion_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GetSolarVersion
+ If ( GetSolarVersion() < 50000) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_getsystemtype_method.vb b/basic/qa/basic_coverage/test_getsystemtype_method.vb
new file mode 100644
index 000000000..eced70204
--- /dev/null
+++ b/basic/qa/basic_coverage/test_getsystemtype_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' GETSYSTEMTYPE
+ If ( GetSystemType <> -1 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_hasunointerfaces_method.vb b/basic/qa/basic_coverage/test_hasunointerfaces_method.vb
new file mode 100644
index 000000000..06472d847
--- /dev/null
+++ b/basic/qa/basic_coverage/test_hasunointerfaces_method.vb
@@ -0,0 +1,16 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' HASUNOINTERFACES
+ dim aObject as Object
+ If ( HasUnoInterfaces( aObject, "com.sun.star.beans.XIntrospection" ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_hex_method.vb b/basic/qa/basic_coverage/test_hex_method.vb
new file mode 100644
index 000000000..72edd9d8e
--- /dev/null
+++ b/basic/qa/basic_coverage/test_hex_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' HEX
+ If ( Hex(100) <> "64") Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_hour_method.vb b/basic/qa/basic_coverage/test_hour_method.vb
new file mode 100644
index 000000000..e132775f8
--- /dev/null
+++ b/basic/qa/basic_coverage/test_hour_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' HOUR
+ If ( Hour(TimeSerial(12,30,41)) <> 12 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_iif_method.vb b/basic/qa/basic_coverage/test_iif_method.vb
new file mode 100644
index 000000000..502cadcb3
--- /dev/null
+++ b/basic/qa/basic_coverage/test_iif_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' IIF
+ If ( IIF(True, 10, 12) <> 10 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_instr_method.vb b/basic/qa/basic_coverage/test_instr_method.vb
new file mode 100644
index 000000000..716aa2158
--- /dev/null
+++ b/basic/qa/basic_coverage/test_instr_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' InStr
+ If ( InStr( 1, aString, "l", 1) <> 3 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_int_method.vb b/basic/qa/basic_coverage/test_int_method.vb
new file mode 100644
index 000000000..69e811648
--- /dev/null
+++ b/basic/qa/basic_coverage/test_int_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' INT
+ If ( Int(PI) <> 3 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_isarray_method.vb b/basic/qa/basic_coverage/test_isarray_method.vb
new file mode 100644
index 000000000..9d73984b5
--- /dev/null
+++ b/basic/qa/basic_coverage/test_isarray_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVector as Variant
+ aVector = Array( 123, "Hello", -3.14)
+ ' ISARRAY
+ If ( IsArray( aVector ) = False ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_isdate_method.vb b/basic/qa/basic_coverage/test_isdate_method.vb
new file mode 100644
index 000000000..5ce72f87b
--- /dev/null
+++ b/basic/qa/basic_coverage/test_isdate_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Date( )
+ ' ISDATE
+ If ( IsDate( aDate ) = False ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_isempty_method.vb b/basic/qa/basic_coverage/test_isempty_method.vb
new file mode 100644
index 000000000..6ca2fae6d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_isempty_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVariant as Variant
+ aVariant = Date( )
+ ' ISEMPTY
+ If ( IsEmpty( aVariant ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_iserror_method.vb b/basic/qa/basic_coverage/test_iserror_method.vb
new file mode 100644
index 000000000..fb12abe6a
--- /dev/null
+++ b/basic/qa/basic_coverage/test_iserror_method.vb
@@ -0,0 +1,22 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Type MyType
+ tName as String
+End Type
+
+Function doUnitTest as Integer
+ dim aVariant as MyType
+ aVariant.tName = "A string"
+ ' ISERROR
+ If ( IsError( aVariant ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_ismissing_basic.vb b/basic/qa/basic_coverage/test_ismissing_basic.vb
new file mode 100644
index 000000000..b838ce718
--- /dev/null
+++ b/basic/qa/basic_coverage/test_ismissing_basic.vb
@@ -0,0 +1,190 @@
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Const IsMissingNone = -1
+Const IsMissingA = 0
+Const IsMissingB = 1
+Const IsMissingAB = 2
+
+Function doUnitTest() As String
+ result = verify_testIsMissingBasic()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+' tdf#36737 - Test optionals with different datatypes. In LO Basic, optional
+' parameters are allowed, but without any default values. Missing optional parameters
+' will not be initialized to their respective default values of its datatype, either.
+Function verify_testIsMissingBasic() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+ testName = "Test missing (Basic)"
+ On Error GoTo errorHandler
+
+ ' optionals with variant datatypes
+ TestLog_ASSERT TestOptVariant(), IsMissingAB, "TestOptVariant()"
+ TestLog_ASSERT TestOptVariant(123), IsMissingB, "TestOptVariant(123)"
+ TestLog_ASSERT TestOptVariant(, 456), IsMissingA, "TestOptVariant(, 456)"
+ TestLog_ASSERT TestOptVariant(123, 456), IsMissingNone, "TestOptVariant(123, 456)"
+
+ ' optionals with variant datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptVariantByRefByVal(), IsMissingAB, "TestOptVariantByRefByVal()"
+ TestLog_ASSERT TestOptVariantByRefByVal(123), IsMissingB, "TestOptVariantByRefByVal(123)"
+ TestLog_ASSERT TestOptVariantByRefByVal(, 456), IsMissingA, "TestOptVariantByRefByVal(, 456)"
+ TestLog_ASSERT TestOptVariantByRefByVal(123, 456), IsMissingNone, "TestOptVariantByRefByVal(123, 456)"
+
+ ' optionals with double datatypes
+ TestLog_ASSERT TestOptDouble(), IsMissingAB, "TestOptDouble()"
+ TestLog_ASSERT TestOptDouble(123.4), IsMissingB, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDouble(, 567.8), IsMissingA, "TestOptDouble(, 567.8)"
+ TestLog_ASSERT TestOptDouble(123.4, 567.8), IsMissingNone, "TestOptDouble(123.4, 567.8)"
+
+ ' optionals with double datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptDoubleByRefByVal(), IsMissingAB, "TestOptDouble()"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4), IsMissingB, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), IsMissingA, "TestOptDoubleByRefByVal(, 567.8)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(123.4, 567.8)"
+
+ ' optionals with integer datatypes
+ TestLog_ASSERT TestOptInteger(), IsMissingAB, "TestOptInteger()"
+ TestLog_ASSERT TestOptInteger(123), IsMissingB, "TestOptInteger(123)"
+ TestLog_ASSERT TestOptInteger(, 456), IsMissingA, "TestOptInteger(, 456)"
+ TestLog_ASSERT TestOptInteger(123, 456), IsMissingNone, "TestOptInteger(123, 456)"
+
+ ' optionals with integer datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptIntegerByRefByVal(), IsMissingAB, "TestOptIntegerByRefByVal()"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123), IsMissingB, "TestOptIntegerByRefByVal(123)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(, 456), IsMissingA, "TestOptIntegerByRefByVal(, 456)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), IsMissingNone, "TestOptIntegerByRefByVal(123, 456)"
+
+ ' optionals with string datatypes
+ TestLog_ASSERT TestOptString(), IsMissingAB, "TestOptString()"
+ TestLog_ASSERT TestOptString("123"), IsMissingB, "TestOptString(""123"")"
+ TestLog_ASSERT TestOptString(, "456"), IsMissingA, "TestOptString(, ""456"")"
+ TestLog_ASSERT TestOptString("123", "456"), IsMissingNone, "TestOptString(""123"", ""456"")"
+
+ ' optionals with string datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptStringByRefByVal(), IsMissingAB, "TestOptStringByRefByVal()"
+ TestLog_ASSERT TestOptStringByRefByVal("123"), IsMissingB, "TestOptStringByRefByVal(""123"")"
+ TestLog_ASSERT TestOptStringByRefByVal(, "456"), IsMissingA, "TestOptStringByRefByVal(, ""456"")"
+ TestLog_ASSERT TestOptStringByRefByVal("123", "456"), IsMissingNone, "TestOptStringByRefByVal(""123"", ""456"")"
+
+ ' optionals with object datatypes
+ Dim cA As New Collection
+ cA.Add (123)
+ cA.Add (456)
+ Dim cB As New Collection
+ cB.Add (123.4)
+ cB.Add (567.8)
+ TestLog_ASSERT TestOptObject(), IsMissingAB, "TestOptObject()"
+ TestLog_ASSERT TestOptObject(cA), IsMissingB, "TestOptObject(A)"
+ TestLog_ASSERT TestOptObject(, cB), IsMissingA, "TestOptObject(, B)"
+ TestLog_ASSERT TestOptObject(cA, cB), IsMissingNone, "TestOptObject(A, B)"
+
+ ' optionals with object datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptObjectByRefByVal(), IsMissingAB, "TestOptObjectByRefByVal()"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA), IsMissingB, "TestOptObjectByRefByVal(A)"
+ TestLog_ASSERT TestOptObjectByRefByVal(, cB), IsMissingA, "TestOptObjectByRefByVal(, B)"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA, cB), IsMissingNone, "TestOptObjectByRefByVal(A, B)"
+
+ ' optionals with array datatypes
+ Dim aA(0 To 1) As Integer
+ aA(0) = 123
+ aA(1) = 456
+ Dim aB(0 To 1) As Variant
+ aB(0) = 123.4
+ aB(1) = 567.8
+ TestLog_ASSERT TestOptArray(), IsMissingAB, "TestOptArray()"
+ TestLog_ASSERT TestOptArray(aA), IsMissingB, "TestOptArray(A)"
+ TestLog_ASSERT TestOptArray(, aB), IsMissingA, "TestOptArray(, B)"
+ TestLog_ASSERT TestOptArray(aA, aB), IsMissingNone, "TestOptArray(A, B)"
+
+ ' optionals with array datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptArrayByRefByVal(), IsMissingAB, "TestOptArrayByRefByVal()"
+ TestLog_ASSERT TestOptArrayByRefByVal(aA), IsMissingB, "TestOptArrayByRefByVal(A)"
+ TestLog_ASSERT TestOptArrayByRefByVal(, aB), IsMissingA, "TestOptArrayByRefByVal(, B)"
+ TestLog_ASSERT TestOptArrayByRefByVal(aA, aB), IsMissingNone, "TestOptArrayByRefByVal(A, B)"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsMissingBasic = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, True, Err.Description
+End Function
+
+Function TestOptVariant(Optional A, Optional B As Variant)
+ TestOptVariant = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant)
+ TestOptVariantByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptDouble(Optional A As Double, Optional B As Double)
+ TestOptDouble = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double)
+ TestOptDoubleByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptInteger(Optional A As Integer, Optional B As Integer)
+ TestOptInteger = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer)
+ TestOptIntegerByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptString(Optional A As String, Optional B As String)
+ TestOptString = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String)
+ TestOptStringByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptObject(Optional A As Collection, Optional B As Collection)
+ TestOptObject = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection)
+ TestOptObjectByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptArray(Optional A() As Integer, Optional B() As Variant)
+ TestOptArray = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant)
+ TestOptArrayByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function WhatIsMissing(is_missingA, is_missingB)
+ If is_missingA And is_missingB Then
+ WhatIsMissing = IsMissingAB
+ ElseIf is_missingA Then
+ WhatIsMissing = IsMissingA
+ ElseIf is_missingB Then
+ WhatIsMissing = IsMissingB
+ Else
+ WhatIsMissing = IsMissingNone
+ End If
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Integer, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_ismissing_cascade.vb b/basic/qa/basic_coverage/test_ismissing_cascade.vb
new file mode 100644
index 000000000..ad967c7bb
--- /dev/null
+++ b/basic/qa/basic_coverage/test_ismissing_cascade.vb
@@ -0,0 +1,51 @@
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+ result = verify_testIsMissingCascade()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+Function verify_testIsMissingCascade() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+ testName = "Test missing (IsMissing with cascading optionals)"
+ On Error GoTo errorHandler
+
+ ' tdf#136143 - test cascading optionals in order to prevent type conversion errors, because
+ ' optional arguments are of type SbxERROR and set to not fixed.
+ TestLog_ASSERT TestOpt(), 2, "Cascading optionals"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsMissingCascade = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, True, Err.Description
+End Function
+
+Function TestOpt(Optional A)
+ TestOpt = TestOptCascade(A)
+End Function
+
+Function TestOptCascade(Optional A)
+ If IsMissing(A) Then A = 2
+ TestOptCascade = A
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Integer, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_ismissing_compatible.vb b/basic/qa/basic_coverage/test_ismissing_compatible.vb
new file mode 100644
index 000000000..dbe2a815d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_ismissing_compatible.vb
@@ -0,0 +1,193 @@
+Option Compatible
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Const IsMissingNone = -1
+Const IsMissingA = 0
+Const IsMissingB = 1
+Const IsMissingAB = 2
+
+Function doUnitTest() As String
+ result = verify_testIsMissingCompatible()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+' tdf#36737 - Test isMissing function with different datatypes. In LO Basic
+' with option Compatible, optional parameters are allowed with default values.
+' Missing optional parameters that don't have explicit default values will
+' not be initialized to their default values of its datatype.
+Function verify_testIsMissingCompatible() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+ testName = "Test missing (Compatible)"
+ On Error GoTo errorHandler
+
+ ' optionals with variant datatypes
+ TestLog_ASSERT TestOptVariant(), IsMissingA, "TestOptVariant()"
+ TestLog_ASSERT TestOptVariant(123), IsMissingNone, "TestOptVariant(123)"
+ TestLog_ASSERT TestOptVariant(, 456), IsMissingA, "TestOptVariant(, 456)"
+ TestLog_ASSERT TestOptVariant(123, 456), IsMissingNone, "TestOptVariant(123, 456)"
+
+ ' optionals with variant datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptVariantByRefByVal(), IsMissingA, "TestOptVariantByRefByVal()"
+ TestLog_ASSERT TestOptVariantByRefByVal(123), IsMissingNone, "TestOptVariantByRefByVal(123)"
+ TestLog_ASSERT TestOptVariantByRefByVal(, 456), IsMissingA, "TestOptVariantByRefByVal(, 456)"
+ TestLog_ASSERT TestOptVariantByRefByVal(123, 456), IsMissingNone, "TestOptVariantByRefByVal(123, 456)"
+
+ ' optionals with double datatypes
+ TestLog_ASSERT TestOptDouble(), IsMissingA, "TestOptDouble()"
+ TestLog_ASSERT TestOptDouble(123.4), IsMissingNone, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDouble(, 567.8), IsMissingA, "TestOptDouble(, 567.8)"
+ TestLog_ASSERT TestOptDouble(123.4, 567.8), IsMissingNone, "TestOptDouble(123.4, 567.8)"
+
+ ' optionals with double datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptDoubleByRefByVal(), IsMissingA, "TestOptDouble()"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4), IsMissingNone, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), IsMissingA, "TestOptDoubleByRefByVal(, 567.8)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(123.4, 567.8)"
+
+ ' optionals with integer datatypes
+ TestLog_ASSERT TestOptInteger(), IsMissingA, "TestOptInteger()"
+ TestLog_ASSERT TestOptInteger(123), IsMissingNone, "TestOptInteger(123)"
+ TestLog_ASSERT TestOptInteger(, 456), IsMissingA, "TestOptInteger(, 456)"
+ TestLog_ASSERT TestOptInteger(123, 456), IsMissingNone, "TestOptInteger(123, 456)"
+
+ ' optionals with integer datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptIntegerByRefByVal(), IsMissingA, "TestOptIntegerByRefByVal()"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123), IsMissingNone, "TestOptIntegerByRefByVal(123)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(, 456), IsMissingA, "TestOptIntegerByRefByVal(, 456)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), IsMissingNone, "TestOptIntegerByRefByVal(123, 456)"
+
+ ' optionals with string datatypes
+ TestLog_ASSERT TestOptString(), IsMissingA, "TestOptString()"
+ TestLog_ASSERT TestOptString("123"), IsMissingNone, "TestOptString(""123"")"
+ TestLog_ASSERT TestOptString(, "456"), IsMissingA, "TestOptString(, ""456"")"
+ TestLog_ASSERT TestOptString("123", "456"), IsMissingNone, "TestOptString(""123"", ""456"")"
+
+ ' optionals with string datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptStringByRefByVal(), IsMissingA, "TestOptStringByRefByVal()"
+ TestLog_ASSERT TestOptStringByRefByVal("123"), IsMissingNone, "TestOptStringByRefByVal(""123"")"
+ TestLog_ASSERT TestOptStringByRefByVal(, "456"), IsMissingA, "TestOptStringByRefByVal(, ""456"")"
+ TestLog_ASSERT TestOptStringByRefByVal("123", "456"), IsMissingNone, "TestOptStringByRefByVal(""123"", ""456"")"
+
+ ' optionals with object datatypes
+ Dim cA As New Collection
+ cA.Add (123)
+ cA.Add (456)
+ Dim cB As New Collection
+ cB.Add (123.4)
+ cB.Add (567.8)
+ TestLog_ASSERT TestOptObject(), IsMissingAB, "TestOptObject()"
+ TestLog_ASSERT TestOptObject(cA), IsMissingB, "TestOptObject(A)"
+ TestLog_ASSERT TestOptObject(, cB), IsMissingA, "TestOptObject(, B)"
+ TestLog_ASSERT TestOptObject(cA, cB), IsMissingNone, "TestOptObject(A, B)"
+
+ ' optionals with object datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptObjectByRefByVal(), IsMissingAB, "TestOptObjectByRefByVal()"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA), IsMissingB, "TestOptObjectByRefByVal(A)"
+ TestLog_ASSERT TestOptObjectByRefByVal(, cB), IsMissingA, "TestOptObjectByRefByVal(, B)"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA, cB), IsMissingNone, "TestOptObjectByRefByVal(A, B)"
+
+ ' optionals with array datatypes
+ Dim aA(0 To 1) As Integer
+ aA(0) = 123
+ aA(1) = 456
+ Dim aB(0 To 1) As Variant
+ aB(0) = 123.4
+ aB(1) = 567.8
+ TestLog_ASSERT TestOptArray(), IsMissingAB, "TestOptArray()"
+ TestLog_ASSERT TestOptArray(aA), IsMissingB, "TestOptArray(A)"
+ TestLog_ASSERT TestOptArray(, aB), IsMissingA, "TestOptArray(, B)"
+ TestLog_ASSERT TestOptArray(aA, aB), IsMissingNone, "TestOptArray(A, B)"
+
+ ' optionals with array datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptArrayByRefByVal(), IsMissingAB, "TestOptArrayByRefByVal()"
+ TestLog_ASSERT TestOptArrayByRefByVal(aA), IsMissingB, "TestOptArrayByRefByVal(A)"
+ TestLog_ASSERT TestOptArrayByRefByVal(, aB), IsMissingA, "TestOptArrayByRefByVal(, B)"
+ TestLog_ASSERT TestOptArrayByRefByVal(aA, aB), IsMissingNone, "TestOptArrayByRefByVal(A, B)"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsMissingCompatible = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, True, Err.Description
+End Function
+
+Function TestOptVariant(Optional A, Optional B As Variant = 123)
+ TestOptVariant = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123)
+ TestOptVariantByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4)
+ TestOptDouble = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4)
+ TestOptDoubleByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123)
+ TestOptInteger = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123)
+ TestOptIntegerByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptString(Optional A As String, Optional B As String = "123")
+ TestOptString = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123")
+ TestOptStringByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptObject(Optional A As Collection, Optional B As Collection)
+ TestOptObject = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection)
+ TestOptObjectByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptArray(Optional A() As Integer, Optional B() As Variant)
+ TestOptArray = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant)
+ TestOptArrayByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function WhatIsMissing(is_missingA, is_missingB)
+ If is_missingA And is_missingB Then
+ WhatIsMissing = IsMissingAB
+ ElseIf is_missingA Then
+ WhatIsMissing = IsMissingA
+ ElseIf is_missingB Then
+ WhatIsMissing = IsMissingB
+ Else
+ WhatIsMissing = IsMissingNone
+ End If
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_isnull_method.vb b/basic/qa/basic_coverage/test_isnull_method.vb
new file mode 100644
index 000000000..0d9044d8f
--- /dev/null
+++ b/basic/qa/basic_coverage/test_isnull_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVariant as Variant
+ aVariant = Null
+ ' ISNULL
+ If ( IsNull( aVariant ) = False ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_isnumeric_method.vb b/basic/qa/basic_coverage/test_isnumeric_method.vb
new file mode 100644
index 000000000..d3b614f56
--- /dev/null
+++ b/basic/qa/basic_coverage/test_isnumeric_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVariant as Variant
+ aVariant = 3
+ ' ISNUMERIC
+ If ( IsNumeric( aVariant ) = False ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_isobject_method.vb b/basic/qa/basic_coverage/test_isobject_method.vb
new file mode 100644
index 000000000..bb5e270b3
--- /dev/null
+++ b/basic/qa/basic_coverage/test_isobject_method.vb
@@ -0,0 +1,17 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVariant as Object
+ ' ISOBJECT
+ If ( IsObject( aVariant ) = False ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_isunostruct_method.vb b/basic/qa/basic_coverage/test_isunostruct_method.vb
new file mode 100644
index 000000000..ac45f1961
--- /dev/null
+++ b/basic/qa/basic_coverage/test_isunostruct_method.vb
@@ -0,0 +1,17 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVariant as Object
+ ' ISUNOSTRUCT
+ If ( IsUnoStruct( aVariant ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_join_method.vb b/basic/qa/basic_coverage/test_join_method.vb
new file mode 100644
index 000000000..236062516
--- /dev/null
+++ b/basic/qa/basic_coverage/test_join_method.vb
@@ -0,0 +1,18 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' Join
+ Dim aStrings(2) as String
+ aStrings(0) = "Hello"
+ aStrings(1) = "world"
+ If ( Join( aStrings, " " ) <> "Hello world " ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_lbound_method.vb b/basic/qa/basic_coverage/test_lbound_method.vb
new file mode 100644
index 000000000..b7a91fd3f
--- /dev/null
+++ b/basic/qa/basic_coverage/test_lbound_method.vb
@@ -0,0 +1,19 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVector as Variant
+ ' ARRAY
+ aVector = Array( "Hello", -3.14)
+ ' LBOUND
+ If ( LBound( aVector() ) <> 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_lcase_method.vb b/basic/qa/basic_coverage/test_lcase_method.vb
new file mode 100644
index 000000000..65df764ef
--- /dev/null
+++ b/basic/qa/basic_coverage/test_lcase_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' LCASE
+ If ( LCase( aString ) <> "hello" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_len_method.vb b/basic/qa/basic_coverage/test_len_method.vb
new file mode 100644
index 000000000..0a7e1abf2
--- /dev/null
+++ b/basic/qa/basic_coverage/test_len_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' LEN
+ If ( Len( aString ) <> 5 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_lenb_method.vb b/basic/qa/basic_coverage/test_lenb_method.vb
new file mode 100644
index 000000000..550b8313a
--- /dev/null
+++ b/basic/qa/basic_coverage/test_lenb_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' LENB
+ If ( LenB( aString ) <> 5 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_logexp_methods.vb b/basic/qa/basic_coverage/test_logexp_methods.vb
new file mode 100644
index 000000000..00db99837
--- /dev/null
+++ b/basic/qa/basic_coverage/test_logexp_methods.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' EXP LOG
+ If ( Log( Exp(1) ) <> 1 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_ltrim_method.vb b/basic/qa/basic_coverage/test_ltrim_method.vb
new file mode 100644
index 000000000..562193c8b
--- /dev/null
+++ b/basic/qa/basic_coverage/test_ltrim_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' LTRIM
+ If ( LTrim( " Hello" ) <> aString ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_CountNegative_3args.vb b/basic/qa/basic_coverage/test_mid_CountNegative_3args.vb
new file mode 100644
index 000000000..d67370626
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_CountNegative_3args.vb
@@ -0,0 +1,15 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ If (Mid("abc", 5, -3) = "") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_EndOutOfBounds_3args.vb b/basic/qa/basic_coverage/test_mid_EndOutOfBounds_3args.vb
new file mode 100644
index 000000000..f54ee9444
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_EndOutOfBounds_3args.vb
@@ -0,0 +1,15 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ If (Mid("abc", 1, 4) = "abc") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_StartOutOfBounds_2args.vb b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_2args.vb
new file mode 100644
index 000000000..5ab01f987
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_2args.vb
@@ -0,0 +1,15 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ If (Mid("abc", 5) = "") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_StartOutOfBounds_3args.vb b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_3args.vb
new file mode 100644
index 000000000..9c623ce51
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_3args.vb
@@ -0,0 +1,15 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ If (Mid("abc", 5, 1) = "") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_firstletter_3args.vb b/basic/qa/basic_coverage/test_mid_firstletter_3args.vb
new file mode 100644
index 000000000..72c65099f
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_firstletter_3args.vb
@@ -0,0 +1,15 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ If (Mid("abc", 1, 1) = "a") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_replace_less.vb b/basic/qa/basic_coverage/test_mid_replace_less.vb
new file mode 100644
index 000000000..27a02382c
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_replace_less.vb
@@ -0,0 +1,19 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+' cf. <https://bugs.documentfoundation.org/show_bug.cgi?id=62090> "Mid statement doesn't work as
+' expected":
+Function doUnitTest as Integer
+ s = "The lightbrown fox"
+ Mid(s, 5, 10, "lazy")
+ If (s = "The lazy fox") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_replace_more.vb b/basic/qa/basic_coverage/test_mid_replace_more.vb
new file mode 100644
index 000000000..880a3f200
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_replace_more.vb
@@ -0,0 +1,19 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+' cf. examples at <https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/
+' statements/mid-statement>:
+Function doUnitTest as Integer
+ s = "The fox jumps"
+ Mid(s, 5, 3, "duck")
+ If (s = "The duc jumps") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_replace_more_end.vb b/basic/qa/basic_coverage/test_mid_replace_more_end.vb
new file mode 100644
index 000000000..c5d26a46a
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_replace_more_end.vb
@@ -0,0 +1,19 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+' cf. examples at <https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/
+' statements/mid-statement>:
+Function doUnitTest as Integer
+ s = "The fox jumps"
+ Mid(s, 5, 100, "cow jumped over")
+ If (s = "The cow jumpe") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_mid_sub2letters_2args.vb b/basic/qa/basic_coverage/test_mid_sub2letters_2args.vb
new file mode 100644
index 000000000..76c5360d8
--- /dev/null
+++ b/basic/qa/basic_coverage/test_mid_sub2letters_2args.vb
@@ -0,0 +1,15 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ If (Mid("abc", 2) = "bc") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_minute_method.vb b/basic/qa/basic_coverage/test_minute_method.vb
new file mode 100644
index 000000000..0f1230462
--- /dev/null
+++ b/basic/qa/basic_coverage/test_minute_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' MINUTE
+ If ( Minute(TimeSerial(12,30,41)) <> 30 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_month_method.vb b/basic/qa/basic_coverage/test_month_method.vb
new file mode 100644
index 000000000..38d8ae406
--- /dev/null
+++ b/basic/qa/basic_coverage/test_month_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Date()
+ ' MONTH
+ If ( DatePart( "m", aDate ) <> Month( aDate ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_nowtimevalue_methods.vb b/basic/qa/basic_coverage/test_nowtimevalue_methods.vb
new file mode 100644
index 000000000..42dce2fc6
--- /dev/null
+++ b/basic/qa/basic_coverage/test_nowtimevalue_methods.vb
@@ -0,0 +1,20 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ dim aTime as Date
+ aDate = Date()
+ aTime = Time()
+ ' NOW TIMEVALUE
+ If ( Now() < aDate + TimeValue(aTime) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_numeric_constant_parameter.vb b/basic/qa/basic_coverage/test_numeric_constant_parameter.vb
new file mode 100644
index 000000000..96a7e8f9c
--- /dev/null
+++ b/basic/qa/basic_coverage/test_numeric_constant_parameter.vb
@@ -0,0 +1,34 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+' assigns a numeric constant (integer) to a parameter of type variant
+Function assignInteger( numericConstant ) As String
+ numericConstant = 1
+ assignInteger = TypeName( numericConstant )
+End Function
+
+' assigns a numeric constant (long) to a parameter of type variant
+Function assignLong( numericConstant ) As String
+ numericConstant = 32768
+ assignLong = TypeName( numericConstant )
+End Function
+
+Function doUnitTest() As Integer
+ ' tdf#133913 - check if numeric constants are converted correctly to
+ ' their respective types, if they are passed as arguments to a function
+ ' with variant parameter types.
+ On Error GoTo errorHandler
+ If (assignInteger( 1 ) = "Integer" And assignLong( 1 ) = "Long") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+ Exit Function
+errorHandler:
+ doUnitTest = 0
+End Function \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_oct_method.vb b/basic/qa/basic_coverage/test_oct_method.vb
new file mode 100644
index 000000000..4c610539d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_oct_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' OCT
+ If ( Oct(100) <> "144" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_optional_paramter_type.vb b/basic/qa/basic_coverage/test_optional_paramter_type.vb
new file mode 100644
index 000000000..37198ea38
--- /dev/null
+++ b/basic/qa/basic_coverage/test_optional_paramter_type.vb
@@ -0,0 +1,33 @@
+REM ***** BASIC *****
+Option Compatible
+
+Function doUnitTest() As Integer
+ doUnitTest = 0
+ If CheckType1(32) = 0 Then
+ Exit Function
+ End If
+ If CheckType2(32) = 0 Then
+ Exit Function
+ End If
+ If CheckType2() = 0 Then
+ Exit Function
+ End If
+ doUnitTest = 1
+End Function
+
+Function CheckType1(x As Integer) As Integer
+ If TypeName(x) = "Integer" Then
+ CheckType1 = 1
+ Else
+ CheckType1 = 0
+ End If
+End Function
+
+
+Function CheckType2(Optional y As Integer = 32 ) As Integer
+ If TypeName(y) = "Integer" Then
+ CheckType2 = 1
+ Else
+ CheckType2 = 0
+ End If
+End Function \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_optional_paramters_basic.vb b/basic/qa/basic_coverage/test_optional_paramters_basic.vb
new file mode 100644
index 000000000..92a81a861
--- /dev/null
+++ b/basic/qa/basic_coverage/test_optional_paramters_basic.vb
@@ -0,0 +1,208 @@
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+ result = verify_testOptionalsBasic()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+' tdf#36737 - Test optionals with different datatypes. In LO Basic, optional
+' parameters are allowed, but without any default values. Missing optional
+' parameters will not be initialized to their respective default values of
+' its datatype, either.
+Function verify_testOptionalsBasic() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+ testName = "Test optionals (Basic)"
+ On Error GoTo errorHandler
+
+ ' optionals with variant datatypes
+ TestLog_ASSERT TestOptVariant(), 0, "TestOptVariant()"
+ TestLog_ASSERT TestOptVariant(123), 123, "TestOptVariant(123)"
+ TestLog_ASSERT TestOptVariant(, 456), 456, "TestOptVariant(, 456)"
+ TestLog_ASSERT TestOptVariant(123, 456), 579, "TestOptVariant(123, 456)"
+
+ ' optionals with variant datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptVariantByRefByVal(), 0, "TestOptVariantByRefByVal()"
+ TestLog_ASSERT TestOptVariantByRefByVal(123), 123, "TestOptVariantByRefByVal(123)"
+ TestLog_ASSERT TestOptVariantByRefByVal(, 456), 456, "TestOptVariantByRefByVal(, 456)"
+ TestLog_ASSERT TestOptVariantByRefByVal(123, 456), 579, "TestOptVariantByRefByVal(123, 456)"
+
+ ' optionals with double datatypes
+ TestLog_ASSERT TestOptDouble(), 0, "TestOptDouble()"
+ TestLog_ASSERT TestOptDouble(123.4), 123.4, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDouble(, 567.8), 567.8, "TestOptDouble(, 567.8)"
+ TestLog_ASSERT CDbl(Format(TestOptDouble(123.4, 567.8), "0.0")), 691.2, "TestOptDouble(123.4, 567.8)"
+
+ ' optionals with double datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptDoubleByRefByVal(), 0, "TestOptDouble()"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4), 123.4, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), 567.8, "TestOptDoubleByRefByVal(, 567.8)"
+ TestLog_ASSERT CDbl(Format(TestOptDoubleByRefByVal(123.4, 567.8), "0.0")), 691.2, "TestOptDoubleByRefByVal(123.4, 567.8)"
+
+ ' optionals with integer datatypes
+ TestLog_ASSERT TestOptInteger(), 0, "TestOptInteger()"
+ TestLog_ASSERT TestOptInteger(123), 123, "TestOptInteger(123)"
+ TestLog_ASSERT TestOptInteger(, 456), 456, "TestOptInteger(, 456)"
+ TestLog_ASSERT TestOptInteger(123, 456), 579, "TestOptInteger(123, 456)"
+
+ ' optionals with integer datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptIntegerByRefByVal(), 0, "TestOptIntegerByRefByVal()"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123), 123, "TestOptIntegerByRefByVal(123)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(, 456), 456, "TestOptIntegerByRefByVal(, 456)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), 579, "TestOptIntegerByRefByVal(123, 456)"
+
+ ' optionals with string datatypes
+ TestLog_ASSERT TestOptString(), "", "TestOptString()"
+ TestLog_ASSERT TestOptString("123"), "123", "TestOptString(""123"")"
+ TestLog_ASSERT TestOptString(, "456"), "456", "TestOptString(, ""456"")"
+ TestLog_ASSERT TestOptString("123", "456"), "123456", "TestOptString(""123"", ""456"")"
+
+ ' optionals with string datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptStringByRefByVal(), "", "TestOptStringByRefByVal()"
+ TestLog_ASSERT TestOptStringByRefByVal("123"), "123", "TestOptStringByRefByVal(""123"")"
+ TestLog_ASSERT TestOptStringByRefByVal(, "456"), "456", "TestOptStringByRefByVal(, ""456"")"
+ TestLog_ASSERT TestOptStringByRefByVal("123", "456"), "123456", "TestOptStringByRefByVal(""123"", ""456"")"
+
+ ' optionals with object datatypes
+ Dim cA As New Collection
+ cA.Add (123)
+ cA.Add (456)
+ Dim cB As New Collection
+ cB.Add (123.4)
+ cB.Add (567.8)
+ TestLog_ASSERT TestOptObject(), 0, "TestOptObject()"
+ TestLog_ASSERT TestOptObject(cA), 579, "TestOptObject(A)"
+ TestLog_ASSERT CDbl(Format(TestOptObject(, cB), "0.0")), 691.2, "TestOptObject(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptObject(cA, cB), "0.0")), 1270.2, "TestOptObject(A, B)"
+
+ ' optionals with object datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptObjectByRefByVal(), 0, "TestOptObjectByRefByVal()"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA), 579, "TestOptObjectByRefByVal(A)"
+ TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(, cB), "0.0")), 691.2, "TestOptObjectByRefByVal(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(cA, cB), "0.0")), 1270.2, "TestOptObjectByRefByVal(A, B)"
+
+ ' optionals with array datatypes
+ Dim aA(0 To 1) As Integer
+ aA(0) = 123
+ aA(1) = 456
+ Dim aB(0 To 1) As Variant
+ aB(0) = 123.4
+ aB(1) = 567.8
+ TestLog_ASSERT TestOptArray(), 0, "TestOptArray()"
+ TestLog_ASSERT TestOptArray(aA), 579, "TestOptArray(A)"
+ TestLog_ASSERT CDbl(Format(TestOptArray(, aB), "0.0")), 691.2, "TestOptArray(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptArray(aA, aB), "0.0")), 1270.2, "TestOptArray(A, B)"
+
+ ' optionals with array datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptArrayByRefByVal(), 0, "TestOptArrayByRefByVal()"
+ TestLog_ASSERT TestOptArrayByRefByVal(aA), 579, "TestOptArrayByRefByVal(A)"
+ TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(, aB), "0.0")), 691.2, "TestOptArrayByRefByVal(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(aA, aB), "0.0")), 1270.2, "TestOptArrayByRefByVal(A, B)"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testOptionalsBasic = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, True, Err.Description
+End Function
+
+Function TestOptVariant(Optional A, Optional B As Variant)
+ TestOptVariant = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant)
+ TestOptVariantByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptDouble(Optional A As Double, Optional B As Double)
+ TestOptDouble = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double)
+ TestOptDoubleByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptInteger(Optional A As Integer, Optional B As Integer)
+ TestOptInteger = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer)
+ TestOptIntegerByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptString(Optional A As String, Optional B As String)
+ TestOptString = OptStringConcat(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String)
+ TestOptStringByRefByVal = OptStringConcat(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptObject(Optional A As Collection, Optional B As Collection)
+ TestOptObject = 0
+ If Not IsMissing(A) Then TestOptObject = CollectionSum(A)
+ If Not IsMissing(B) Then TestOptObject = TestOptObject + CollectionSum(B)
+End Function
+
+Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection)
+ TestOptObjectByRefByVal = 0
+ If Not IsMissing(A) Then TestOptObjectByRefByVal = CollectionSum(A)
+ If Not IsMissing(B) Then TestOptObjectByRefByVal = TestOptObjectByRefByVal + CollectionSum(B)
+End Function
+
+Function TestOptArray(Optional A() As Integer, Optional B() As Variant)
+ TestOptArray = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B)
+End Function
+
+Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant)
+ TestOptArrayByRefByVal = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B)
+End Function
+
+Function OptNumberSum(is_missingA As Boolean, A, is_missingB As Boolean, B)
+ OptNumberSum = 0
+ If Not is_missingA Then OptNumberSum = A
+ If Not is_missingB Then OptNumberSum = OptNumberSum + B
+End Function
+
+Function OptStringConcat(is_missingA As Boolean, A, is_missingB As Boolean, B)
+ OptStringConcat = ""
+ If Not is_missingA Then OptStringConcat = A
+ If Not is_missingB Then OptStringConcat = OptStringConcat & B
+End Function
+
+Function CollectionSum(C)
+ Dim idx As Integer
+ CollectionSum = 0
+ For idx = 1 To C.Count
+ CollectionSum = CollectionSum + C.Item(idx)
+ Next idx
+End Function
+
+Function ArraySum(is_missingC As Boolean, C)
+ Dim idx As Integer
+ ArraySum = 0
+ If Not is_missingC Then
+ For idx = LBound(C) To UBound(C)
+ ArraySum = ArraySum + C(idx)
+ Next idx
+ End If
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_optional_paramters_compatible.vb b/basic/qa/basic_coverage/test_optional_paramters_compatible.vb
new file mode 100644
index 000000000..9ea475508
--- /dev/null
+++ b/basic/qa/basic_coverage/test_optional_paramters_compatible.vb
@@ -0,0 +1,210 @@
+Option Compatible
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+ result = verify_testOptionalsCompatible()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+' tdf#36737 - Test optionals with different datatypes. In LO Basic
+' with option Compatible, optional parameters are allowed with default values.
+' Missing optional parameters that don't have explicit default values will
+' not be initialized to their default values of its datatype.
+Function verify_testOptionalsCompatible() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+ testName = "Test optionals (Compatible)"
+ On Error GoTo errorHandler
+
+ ' optionals with variant datatypes
+ TestLog_ASSERT TestOptVariant(), 123, "TestOptVariant()"
+ TestLog_ASSERT TestOptVariant(123), 246, "TestOptVariant(123)"
+ TestLog_ASSERT TestOptVariant(, 456), 456, "TestOptVariant(, 456)"
+ TestLog_ASSERT TestOptVariant(123, 456), 579, "TestOptVariant(123, 456)"
+
+ ' optionals with variant datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptVariantByRefByVal(), 123, "TestOptVariantByRefByVal()"
+ TestLog_ASSERT TestOptVariantByRefByVal(123), 246, "TestOptVariantByRefByVal(123)"
+ TestLog_ASSERT TestOptVariantByRefByVal(, 456), 456, "TestOptVariantByRefByVal(, 456)"
+ TestLog_ASSERT TestOptVariantByRefByVal(123, 456), 579, "TestOptVariantByRefByVal(123, 456)"
+
+ ' optionals with double datatypes
+ TestLog_ASSERT TestOptDouble(), 123.4, "TestOptDouble()"
+ TestLog_ASSERT TestOptDouble(123.4), 246.8, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDouble(, 567.8), 567.8, "TestOptDouble(, 567.8)"
+ TestLog_ASSERT CDbl(Format(TestOptDouble(123.4, 567.8), "0.0")), 691.2, "TestOptDouble(123.4, 567.8)"
+
+ ' optionals with double datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptDoubleByRefByVal(), 123.4, "TestOptDouble()"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4), 246.8, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), 567.8, "TestOptDoubleByRefByVal(, 567.8)"
+ TestLog_ASSERT CDbl(Format(TestOptDoubleByRefByVal(123.4, 567.8), "0.0")), 691.2, "TestOptDoubleByRefByVal(123.4, 567.8)"
+
+ ' optionals with integer datatypes
+ TestLog_ASSERT TestOptInteger(), 123, "TestOptInteger()"
+ TestLog_ASSERT TestOptInteger(123), 246, "TestOptInteger(123)"
+ TestLog_ASSERT TestOptInteger(, 456), 456, "TestOptInteger(, 456)"
+ TestLog_ASSERT TestOptInteger(123, 456), 579, "TestOptInteger(123, 456)"
+
+ ' optionals with integer datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptIntegerByRefByVal(), 123, "TestOptIntegerByRefByVal()"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123), 246, "TestOptIntegerByRefByVal(123)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(, 456), 456, "TestOptIntegerByRefByVal(, 456)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), 579, "TestOptIntegerByRefByVal(123, 456)"
+
+ ' optionals with string datatypes
+ TestLog_ASSERT TestOptString(), "123", "TestOptString()"
+ TestLog_ASSERT TestOptString("123"), "123123", "TestOptString(""123"")"
+ TestLog_ASSERT TestOptString(, "456"), "456", "TestOptString(, ""456"")"
+ TestLog_ASSERT TestOptString("123", "456"), "123456", "TestOptString(""123"", ""456"")"
+
+ ' optionals with string datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptStringByRefByVal(), "123", "TestOptStringByRefByVal()"
+ TestLog_ASSERT TestOptStringByRefByVal("123"), "123123", "TestOptStringByRefByVal(""123"")"
+ TestLog_ASSERT TestOptStringByRefByVal(, "456"), "456", "TestOptStringByRefByVal(, ""456"")"
+ TestLog_ASSERT TestOptStringByRefByVal("123", "456"), "123456", "TestOptStringByRefByVal(""123"", ""456"")"
+
+ ' optionals with object datatypes
+ Dim cA As New Collection
+ cA.Add (123)
+ cA.Add (456)
+ Dim cB As New Collection
+ cB.Add (123.4)
+ cB.Add (567.8)
+ TestLog_ASSERT TestOptObject(), 0, "TestOptObject()"
+ TestLog_ASSERT TestOptObject(cA), 579, "TestOptObject(A)"
+ TestLog_ASSERT CDbl(Format(TestOptObject(, cB), "0.0")), 691.2, "TestOptObject(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptObject(cA, cB), "0.0")), 1270.2, "TestOptObject(A, B)"
+
+ ' optionals with object datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptObjectByRefByVal(), 0, "TestOptObjectByRefByVal()"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA), 579, "TestOptObjectByRefByVal(A)"
+ TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(, cB), "0.0")), 691.2, "TestOptObjectByRefByVal(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(cA, cB), "0.0")), 1270.2, "TestOptObjectByRefByVal(A, B)"
+
+ ' optionals with array datatypes
+ Dim aA(0 To 1) As Integer
+ aA(0) = 123
+ aA(1) = 456
+ Dim aB(0 To 1) As Variant
+ aB(0) = 123.4
+ aB(1) = 567.8
+ TestLog_ASSERT TestOptArray(), 0, "TestOptArray()"
+ TestLog_ASSERT TestOptArray(aA), 579, "TestOptArray(A)"
+ TestLog_ASSERT CDbl(Format(TestOptArray(, aB), "0.0")), 691.2, "TestOptArray(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptArray(aA, aB), "0.0")), 1270.2, "TestOptArray(A, B)"
+
+ ' optionals with array datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptArrayByRefByVal(), 0, "TestOptArrayByRefByVal()"
+ TestLog_ASSERT TestOptArrayByRefByVal(aA), 579, "TestOptArrayByRefByVal(A)"
+ TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(, aB), "0.0")), 691.2, "TestOptArrayByRefByVal(, B)"
+ TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(aA, aB), "0.0")), 1270.2, "TestOptArrayByRefByVal(A, B)"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testOptionalsCompatible = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, True, Err.Description
+End Function
+
+Function TestOptVariant(Optional A, Optional B As Variant = 123)
+ TestOptVariant = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123)
+ TestOptVariantByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4)
+ TestOptDouble = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4)
+ TestOptDoubleByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123)
+ TestOptInteger = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123)
+ TestOptIntegerByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptString(Optional A As String, Optional B As String = "123")
+ TestOptString = OptStringConcat(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123")
+ TestOptStringByRefByVal = OptStringConcat(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptObject(Optional A As Collection, Optional B As Collection)
+ TestOptObject = 0
+ If Not IsMissing(A) Then TestOptObject = CollectionSum(A)
+ If Not IsMissing(B) Then TestOptObject = TestOptObject + CollectionSum(B)
+End Function
+
+Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection)
+ TestOptObjectByRefByVal = 0
+ If Not IsMissing(A) Then TestOptObjectByRefByVal = CollectionSum(A)
+ If Not IsMissing(B) Then TestOptObjectByRefByVal = TestOptObjectByRefByVal + CollectionSum(B)
+End Function
+
+Function TestOptArray(Optional A() As Integer, Optional B() As Variant)
+ TestOptArray = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B)
+End Function
+
+Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant)
+ TestOptArrayByRefByVal = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B)
+End Function
+
+Function OptNumberSum(is_missingA As Boolean, A, is_missingB As Boolean, B)
+ OptNumberSum = 0
+ If Not is_missingA Then OptNumberSum = A
+ If Not is_missingB Then OptNumberSum = OptNumberSum + B
+End Function
+
+Function OptStringConcat(is_missingA As Boolean, A, is_missingB As Boolean, B)
+ OptStringConcat = ""
+ If Not is_missingA Then OptStringConcat = A
+ If Not is_missingB Then OptStringConcat = OptStringConcat & B
+End Function
+
+Function CollectionSum(C)
+ Dim idx As Integer
+ CollectionSum = 0
+ For idx = 1 To C.Count
+ CollectionSum = CollectionSum + C.Item(idx)
+ Next idx
+End Function
+
+Function ArraySum(is_missingC As Boolean, C)
+ Dim idx As Integer
+ ArraySum = 0
+ If Not is_missingC Then
+ For idx = LBound(C) To UBound(C)
+ ArraySum = ArraySum + C(idx)
+ Next idx
+ End If
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub \ No newline at end of file
diff --git a/basic/qa/basic_coverage/test_qbcolor_method.vb b/basic/qa/basic_coverage/test_qbcolor_method.vb
new file mode 100644
index 000000000..8051a80b6
--- /dev/null
+++ b/basic/qa/basic_coverage/test_qbcolor_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' QBCOLOR
+ If ( QBColor(7) <> 12632256 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_random_methods.vb b/basic/qa/basic_coverage/test_random_methods.vb
new file mode 100644
index 000000000..ea5d1c979
--- /dev/null
+++ b/basic/qa/basic_coverage/test_random_methods.vb
@@ -0,0 +1,16 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ Randomize 42
+ ' RND
+ If ( Rnd >= 1 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_resolvepath_method.vb b/basic/qa/basic_coverage/test_resolvepath_method.vb
new file mode 100644
index 000000000..888a29dfb
--- /dev/null
+++ b/basic/qa/basic_coverage/test_resolvepath_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' RESOLVEPATH
+ If ( ResolvePath( "" ) <> "" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_rgb_method.vb b/basic/qa/basic_coverage/test_rgb_method.vb
new file mode 100644
index 000000000..7bdaf9660
--- /dev/null
+++ b/basic/qa/basic_coverage/test_rgb_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' RGB
+ If ( RGB( 128, 50, 200 ) <> 8401608 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_rtrim_method.vb b/basic/qa/basic_coverage/test_rtrim_method.vb
new file mode 100644
index 000000000..79a8093fe
--- /dev/null
+++ b/basic/qa/basic_coverage/test_rtrim_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' RTRIM
+ If ( RTrim( "Hello " ) <> aString ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_second_method.vb b/basic/qa/basic_coverage/test_second_method.vb
new file mode 100644
index 000000000..77311e9d3
--- /dev/null
+++ b/basic/qa/basic_coverage/test_second_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' SECOND
+ If ( Second(TimeSerial(12,30,41)) <> 41 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_sgn_method.vb b/basic/qa/basic_coverage/test_sgn_method.vb
new file mode 100644
index 000000000..da2cf6757
--- /dev/null
+++ b/basic/qa/basic_coverage/test_sgn_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' SGN
+ If ( Sgn(-3.14) <> -1 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_space_method.vb b/basic/qa/basic_coverage/test_space_method.vb
new file mode 100644
index 000000000..8b35b108b
--- /dev/null
+++ b/basic/qa/basic_coverage/test_space_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' SPACE
+ If ( Space(3) <> " " ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_spc_method.vb b/basic/qa/basic_coverage/test_spc_method.vb
new file mode 100644
index 000000000..7ed291e13
--- /dev/null
+++ b/basic/qa/basic_coverage/test_spc_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' SPC
+ If ( Spc(3) <> " " ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_split_method.vb b/basic/qa/basic_coverage/test_split_method.vb
new file mode 100644
index 000000000..d09e8c3e7
--- /dev/null
+++ b/basic/qa/basic_coverage/test_split_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' SPLIT
+ If ( Split( "Hello world" )(1) <> "world" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_sqr_method.vb b/basic/qa/basic_coverage/test_sqr_method.vb
new file mode 100644
index 000000000..55db95403
--- /dev/null
+++ b/basic/qa/basic_coverage/test_sqr_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' SQR
+ If ( Sqr( 4 ) <> 2 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_strcomp_method.vb b/basic/qa/basic_coverage/test_strcomp_method.vb
new file mode 100644
index 000000000..aeb146e57
--- /dev/null
+++ b/basic/qa/basic_coverage/test_strcomp_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' STRCOMP
+ If ( StrComp( aString, "Hello" ) <> 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_string_method.vb b/basic/qa/basic_coverage/test_string_method.vb
new file mode 100644
index 000000000..8664ac011
--- /dev/null
+++ b/basic/qa/basic_coverage/test_string_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' STRING
+ If ( String( 3, "H" ) <> "HHH" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_string_overflow_safe.vb b/basic/qa/basic_coverage/test_string_overflow_safe.vb
new file mode 100644
index 000000000..148cc910c
--- /dev/null
+++ b/basic/qa/basic_coverage/test_string_overflow_safe.vb
@@ -0,0 +1,22 @@
+Option Explicit
+
+Function doUnitTest As Integer
+ ' Trying to create too long string should generate proper BASIC overflow error.
+ ' Longest possible string is 2147483638 wchar_t (2G - 10).
+ ' This tries to create string with 2G wchar_t. If it does not overflow, test fails.
+ ' If overflow is not safe, it segfaults.
+ On Error GoTo errorHandler
+ Dim s As String, i As Integer
+ s = "0"
+ For i=1 To 31
+ s = s & s
+ Next i
+ doUnitTest = 0
+ Exit Function
+errorHandler:
+ If ( Err <> 6 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ Endif
+End Function
diff --git a/basic/qa/basic_coverage/test_string_replace.vb b/basic/qa/basic_coverage/test_string_replace.vb
new file mode 100644
index 000000000..99eafdba6
--- /dev/null
+++ b/basic/qa/basic_coverage/test_string_replace.vb
@@ -0,0 +1,37 @@
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+ result = verify_stringReplace()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+Function verify_stringReplace() As String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ ' tdf#132389 - case-insensitive operation for non-ASCII characters
+ retStr = Replace("ABCabc", "b", "*")
+ TestLog_ASSERT retStr, "A*Ca*c", "case-insensitive ASCII: " & retStr
+ retStr = Replace("АБВабв", "б", "*")
+ TestLog_ASSERT retStr, "А*Ва*в", "case-insensitive non-ASCII: " & retStr
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_stringReplace = result
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & "Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub
diff --git a/basic/qa/basic_coverage/test_strtrim_methods.vb b/basic/qa/basic_coverage/test_strtrim_methods.vb
new file mode 100644
index 000000000..b9da11d7f
--- /dev/null
+++ b/basic/qa/basic_coverage/test_strtrim_methods.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' STR TRIM
+ If ( Trim( Str( 4 ) ) <> "4" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_switch_method.vb b/basic/qa/basic_coverage/test_switch_method.vb
new file mode 100644
index 000000000..9dc00fa52
--- /dev/null
+++ b/basic/qa/basic_coverage/test_switch_method.vb
@@ -0,0 +1,20 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aVariant as Object
+ ' SWITCH
+ If ( Switch( False, 10,_
+ True, 11,_
+ False, 12,_
+ True, 13 ) <> 11 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_tab_method.vb b/basic/qa/basic_coverage/test_tab_method.vb
new file mode 100644
index 000000000..a5e4e9815
--- /dev/null
+++ b/basic/qa/basic_coverage/test_tab_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TAB
+ If ( "Hello" & Tab(0) & "World" <> "HelloWorld" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_tan_method.vb b/basic/qa/basic_coverage/test_tan_method.vb
new file mode 100644
index 000000000..117d2824b
--- /dev/null
+++ b/basic/qa/basic_coverage/test_tan_method.vb
@@ -0,0 +1,15 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TAN
+ If ( Abs( Tan(PI/4) - 1 ) > 1E-6 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_timer_method.vb b/basic/qa/basic_coverage/test_timer_method.vb
new file mode 100644
index 000000000..3ccb120f6
--- /dev/null
+++ b/basic/qa/basic_coverage/test_timer_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TIMER max value = 24*3600
+ If ( Timer() > 86400 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_timeserialtimevalue_methods.vb b/basic/qa/basic_coverage/test_timeserialtimevalue_methods.vb
new file mode 100644
index 000000000..6e84329d0
--- /dev/null
+++ b/basic/qa/basic_coverage/test_timeserialtimevalue_methods.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TIMESERIAL TIMEVALUE
+ If ( TimeSerial(13,54,48) <> TimeValue("13:54:48") ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_twipsperpixelx_method.vb b/basic/qa/basic_coverage/test_twipsperpixelx_method.vb
new file mode 100644
index 000000000..2b8890ad7
--- /dev/null
+++ b/basic/qa/basic_coverage/test_twipsperpixelx_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TWIPSPERPIXELX
+ If ( TwipsPerPixelX < 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_twipsperpixely_method.vb b/basic/qa/basic_coverage/test_twipsperpixely_method.vb
new file mode 100644
index 000000000..efc41e1ff
--- /dev/null
+++ b/basic/qa/basic_coverage/test_twipsperpixely_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TWIPSPERPIXELY
+ If ( TwipsPerPixelY < 0 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_typelen_method.vb b/basic/qa/basic_coverage/test_typelen_method.vb
new file mode 100644
index 000000000..468479007
--- /dev/null
+++ b/basic/qa/basic_coverage/test_typelen_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TYPELEN
+ If ( TypeLen("Hello") <> 5 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_typename_method.vb b/basic/qa/basic_coverage/test_typename_method.vb
new file mode 100644
index 000000000..eba2d86c4
--- /dev/null
+++ b/basic/qa/basic_coverage/test_typename_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' TYPENAME
+ If ( TypeName("Hello") <> "String" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_types_conversion.vb b/basic/qa/basic_coverage/test_types_conversion.vb
new file mode 100644
index 000000000..0868f4d3e
--- /dev/null
+++ b/basic/qa/basic_coverage/test_types_conversion.vb
@@ -0,0 +1,64 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+Option Explicit
+
+Dim nTotalCount As Integer
+Dim nPassCount As Integer
+Dim nFailCount As Integer
+
+' For the following tests the en-US (English - United States) locale is required
+Function doUnitTest() As Integer
+ nTotalCount = 0
+ nPassCount = 0
+ nFailCount = 0
+
+ ' Test implicit conversions from string to number
+ Dim nVal As Double
+ ' Simple integer
+ StartTest()
+ nVal = "123"
+ AssertTest(nVal = 123)
+
+ ' Negative integer
+ StartTest()
+ nVal = "-123"
+ AssertTest(nVal = -123)
+
+ ' Negative floating-point
+ StartTest()
+ nVal = "-123.45"
+ AssertTest(nVal = -123.45)
+
+ ' Negative floating-point with leading and trailing spaces
+ StartTest()
+ nVal = " -123.456 "
+ AssertTest(nVal = -123.456)
+
+ ' Wrong decimal separator (interpreted as group separator)
+ StartTest()
+ nVal = " -123,456 "
+ AssertTest(nVal = -123456)
+
+ If ((nFailCount > 0) Or (nPassCount <> nTotalCount)) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
+
+Sub StartTest()
+ nTotalCount = nTotalCount + 1
+End Sub
+
+Sub AssertTest(testResult As Boolean)
+ If (testResult) Then
+ nPassCount = nPassCount + 1
+ Else
+ nFailCount = nFailCount + 1
+ End If
+End Sub
diff --git a/basic/qa/basic_coverage/test_ucase_method.vb b/basic/qa/basic_coverage/test_ucase_method.vb
new file mode 100644
index 000000000..940c0897b
--- /dev/null
+++ b/basic/qa/basic_coverage/test_ucase_method.vb
@@ -0,0 +1,17 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aString as Variant
+ aString = "Hello"
+ ' UCASE
+ If ( UCase( aString ) <> "HELLO" ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_val_method.vb b/basic/qa/basic_coverage/test_val_method.vb
new file mode 100644
index 000000000..c25610ceb
--- /dev/null
+++ b/basic/qa/basic_coverage/test_val_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' VAL
+ If ( Val("4") <> 4 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_vartype_method.vb b/basic/qa/basic_coverage/test_vartype_method.vb
new file mode 100644
index 000000000..bd45adef0
--- /dev/null
+++ b/basic/qa/basic_coverage/test_vartype_method.vb
@@ -0,0 +1,16 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' VARTYPE
+ If ( VarType("Hello") <> 8 ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_wait_method.vb b/basic/qa/basic_coverage/test_wait_method.vb
new file mode 100644
index 000000000..776a2efad
--- /dev/null
+++ b/basic/qa/basic_coverage/test_wait_method.vb
@@ -0,0 +1,12 @@
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ ' WAIT
+ Wait(0)
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/basic_coverage/test_weekday_method.vb b/basic/qa/basic_coverage/test_weekday_method.vb
new file mode 100644
index 000000000..48279434d
--- /dev/null
+++ b/basic/qa/basic_coverage/test_weekday_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Date()
+ ' WEEKDAY
+ If ( Weekday( aDate ) <> WeekDay( aDate ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/test_year_method.vb b/basic/qa/basic_coverage/test_year_method.vb
new file mode 100644
index 000000000..0863e11b3
--- /dev/null
+++ b/basic/qa/basic_coverage/test_year_method.vb
@@ -0,0 +1,18 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Function doUnitTest as Integer
+ dim aDate as Date
+ aDate = Date()
+ ' YEAR
+ If ( DatePart( "yyyy", aDate ) <> Year( aDate ) ) Then
+ doUnitTest = 0
+ Else
+ doUnitTest = 1
+ End If
+End Function
diff --git a/basic/qa/basic_coverage/uno_struct_assign.vb b/basic/qa/basic_coverage/uno_struct_assign.vb
new file mode 100644
index 000000000..23812de2c
--- /dev/null
+++ b/basic/qa/basic_coverage/uno_struct_assign.vb
@@ -0,0 +1,15 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+
+Function doUnitTest as Integer
+ Dim oNamedValue as new com.sun.star.beans.NamedValue
+ Dim oCellAddress as new com.sun.star.table.CellAddress
+ oNamedValue.Value = oCellAddress ' fdo#60065 - this would throw an error
+ doUnitTest = 1
+End Function
diff --git a/basic/qa/cppunit/basic_coverage.cxx b/basic/qa/cppunit/basic_coverage.cxx
new file mode 100644
index 000000000..0dfc7d94e
--- /dev/null
+++ b/basic/qa/cppunit/basic_coverage.cxx
@@ -0,0 +1,161 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include "basictest.hxx"
+#include <osl/file.hxx>
+#include <i18nlangtag/languagetag.hxx>
+#include <unotools/syslocaleoptions.hxx>
+
+namespace
+{
+
+class Coverage : public test::BootstrapFixture
+{
+private:
+ int m_nb_tests_ok;
+ OUString m_sCurrentTest;
+ void process_directory(const OUString& sDirName);
+ void run_test(const OUString& sFileName);
+ void test_failed();
+ void test_success();
+ std::vector< OUString > get_subdirnames( const OUString& sDirName );
+
+public:
+ Coverage();
+ virtual ~Coverage() override;
+
+ void Coverage_Iterator();
+
+ // Adds code needed to register the test suite
+ CPPUNIT_TEST_SUITE(Coverage);
+
+ // Declares the method as a test to call
+ CPPUNIT_TEST(Coverage_Iterator);
+
+ // End of test suite definition
+ CPPUNIT_TEST_SUITE_END();
+};
+
+Coverage::Coverage()
+ : BootstrapFixture(true, false)
+ , m_nb_tests_ok(0)
+{
+}
+
+Coverage::~Coverage()
+{
+ fprintf(stderr,"basic coverage Summary : pass:%d\n", m_nb_tests_ok );
+}
+
+void Coverage::test_failed()
+{
+ CPPUNIT_FAIL(
+ OUStringToOString(m_sCurrentTest, RTL_TEXTENCODING_UTF8).getStr());
+}
+
+void Coverage::test_success()
+{
+ m_nb_tests_ok += 1;
+ fprintf(stderr,"%s,PASS\n", OUStringToOString( m_sCurrentTest, RTL_TEXTENCODING_UTF8 ).getStr() );
+}
+
+void Coverage::run_test(const OUString& sFileURL)
+{
+ m_sCurrentTest = sFileURL;
+ bool bResult = false;
+ MacroSnippet testMacro;
+ testMacro.LoadSourceFromFile( sFileURL );
+ testMacro.Compile();
+ if( !testMacro.HasError() )
+ {
+ SbxVariableRef pResult = testMacro.Run();
+ if( pResult.is() && pResult->GetInteger() == 1 )
+ {
+ bResult = true;
+ }
+ }
+ if(bResult)
+ {
+ test_success();
+ }
+ else
+ {
+ test_failed();
+ }
+}
+
+std::vector< OUString > Coverage::get_subdirnames( const OUString& sDirName )
+{
+ std::vector< OUString > sSubDirNames;
+ osl::Directory aDir(sDirName);
+ osl::DirectoryItem aItem;
+ osl::FileStatus aFileStatus(osl_FileStatus_Mask_FileURL|osl_FileStatus_Mask_Type);
+
+ if(aDir.open() == osl::FileBase::E_None)
+ {
+ while (aDir.getNextItem(aItem) == osl::FileBase::E_None)
+ {
+ aItem.getFileStatus(aFileStatus);
+ if(aFileStatus.isDirectory())
+ sSubDirNames.push_back( aFileStatus.getFileURL() );
+ }
+ }
+ return sSubDirNames;
+}
+void Coverage::process_directory(const OUString& sDirName)
+{
+ osl::Directory aDir(sDirName);
+ osl::DirectoryItem aItem;
+ osl::FileStatus aFileStatus(osl_FileStatus_Mask_FileURL|osl_FileStatus_Mask_Type);
+
+ if(aDir.open() == osl::FileBase::E_None)
+ {
+ while (aDir.getNextItem(aItem) == osl::FileBase::E_None)
+ {
+ aItem.getFileStatus(aFileStatus);
+ if(aFileStatus.isRegular())
+ {
+ run_test(aFileStatus.getFileURL());
+ }
+ }
+ }
+ fprintf(stderr,"end process directory\n");
+}
+
+void Coverage::Coverage_Iterator()
+{
+ OUString sDirName = m_directories.getURLFromSrc("/basic/qa/basic_coverage/");
+
+ CPPUNIT_ASSERT(!sDirName.isEmpty());
+ process_directory(sDirName); // any files in the root test dir are run in test harness default locale ( en-US )
+ std::vector< OUString > sLangDirs = get_subdirnames( sDirName );
+
+ for (auto const& langDir : sLangDirs)
+ {
+ sal_Int32 nSlash = langDir.lastIndexOf('/');
+ if ( nSlash != -1 )
+ {
+ OUString sLangISO = langDir.copy( nSlash + 1 );
+ LanguageTag aLocale( sLangISO );
+ if ( aLocale.isValidBcp47() )
+ {
+ SvtSysLocaleOptions aLocalOptions;
+ // set locale for test dir
+ aLocalOptions.SetLocaleConfigString( sLangISO );
+ process_directory(langDir);
+ }
+ }
+ }
+}
+
+ CPPUNIT_TEST_SUITE_REGISTRATION(Coverage);
+
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/cppunit/basictest.cxx b/basic/qa/cppunit/basictest.cxx
new file mode 100644
index 000000000..635da6e5e
--- /dev/null
+++ b/basic/qa/cppunit/basictest.cxx
@@ -0,0 +1,125 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include "basictest.hxx"
+#include <cppunit/plugin/TestPlugIn.h>
+#include <basic/sbstar.hxx>
+#include <basic/sbmod.hxx>
+#include <basic/sbmeth.hxx>
+#include <basic/sbuno.hxx>
+#include <osl/file.hxx>
+
+void MacroSnippet::InitSnippet()
+{
+ mpBasic = new StarBASIC();
+ StarBASIC::SetGlobalErrorHdl( LINK( this, MacroSnippet, BasicErrorHdl ) );
+}
+
+void MacroSnippet::MakeModule( const OUString& sSource )
+{
+ mpMod = mpBasic->MakeModule( "TestModule", sSource );
+}
+
+MacroSnippet::MacroSnippet( const OUString& sSource )
+ : mbError(false)
+{
+ InitSnippet();
+ MakeModule( sSource );
+}
+
+MacroSnippet::MacroSnippet()
+ : mbError(false)
+{
+ InitSnippet();
+}
+
+void MacroSnippet::LoadSourceFromFile( const OUString& sMacroFileURL )
+{
+ OUString sSource;
+ fprintf(stderr,"loadSource opening macro file %s\n", OUStringToOString( sMacroFileURL, RTL_TEXTENCODING_UTF8 ).getStr() );
+
+ osl::File aFile(sMacroFileURL);
+ if(aFile.open(osl_File_OpenFlag_Read) == osl::FileBase::E_None)
+ {
+ sal_uInt64 size;
+ sal_uInt64 size_read;
+ if(aFile.getSize(size) == osl::FileBase::E_None)
+ {
+ void* buffer = calloc(1, size+1);
+ CPPUNIT_ASSERT(buffer);
+ if(aFile.read( buffer, size, size_read) == osl::FileBase::E_None)
+ {
+ if(size == size_read)
+ {
+ OUString sCode(static_cast<char*>(buffer), size, RTL_TEXTENCODING_UTF8);
+ sSource = sCode;
+ }
+ }
+
+ free(buffer);
+ }
+ }
+ CPPUNIT_ASSERT_MESSAGE( "Source is empty", ( sSource.getLength() > 0 ) );
+ MakeModule( sSource );
+}
+
+SbxVariableRef MacroSnippet::Run( const css::uno::Sequence< css::uno::Any >& rArgs )
+{
+ SbxVariableRef pReturn;
+ if ( !Compile() )
+ return pReturn;
+ SbMethod* pMeth = mpMod.is() ? static_cast<SbMethod*>(mpMod->Find( "doUnitTest", SbxClassType::Method )) : nullptr;
+ if ( pMeth )
+ {
+ if ( rArgs.hasElements() )
+ {
+ SbxArrayRef aArgs = new SbxArray;
+ for ( int i=0; i < rArgs.getLength(); ++i )
+ {
+ SbxVariable* pVar = new SbxVariable();
+ unoToSbxValue( pVar, rArgs[ i ] );
+ aArgs->Put32( pVar, i + 1 );
+ }
+ pMeth->SetParameters( aArgs.get() );
+ }
+ pReturn = new SbxMethod( *static_cast<SbxMethod*>(pMeth));
+ }
+ return pReturn;
+}
+
+SbxVariableRef MacroSnippet::Run()
+{
+ css::uno::Sequence< css::uno::Any > aArgs;
+ return Run( aArgs );
+}
+
+bool MacroSnippet::Compile()
+{
+ CPPUNIT_ASSERT_MESSAGE("module is NULL", mpMod.get() != nullptr );
+ mpMod->Compile();
+ return !mbError;
+}
+
+bool MacroSnippet::HasError() const { return mbError; }
+
+const ErrCode& MacroSnippet::getError() const { return maErrCode; }
+
+IMPL_LINK( MacroSnippet, BasicErrorHdl, StarBASIC *, /*pBasic*/, bool)
+{
+ fprintf(stderr,"(%d:%d)\n",
+ StarBASIC::GetLine(), StarBASIC::GetCol1());
+ fprintf(stderr,"Basic error: %s\n", OUStringToOString( StarBASIC::GetErrorText(), RTL_TEXTENCODING_UTF8 ).getStr() );
+ mbError = true;
+ maErrCode = StarBASIC::GetErrorCode();
+ return false;
+}
+
+CPPUNIT_PLUGIN_IMPLEMENT();
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/cppunit/basictest.hxx b/basic/qa/cppunit/basictest.hxx
new file mode 100644
index 000000000..c8d262ee6
--- /dev/null
+++ b/basic/qa/cppunit/basictest.hxx
@@ -0,0 +1,55 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+#ifndef INCLUDED_BASIC_QA_CPPUNIT_BASICTEST_HXX
+#define INCLUDED_BASIC_QA_CPPUNIT_BASICTEST_HXX
+
+#include <sal/types.h>
+#include <cppunit/TestFixture.h>
+#include <cppunit/extensions/HelperMacros.h>
+#include <cppunit/plugin/TestPlugIn.h>
+#include <test/bootstrapfixture.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/basrdll.hxx>
+#include <basic/sbmod.hxx>
+#include <basic/sbmeth.hxx>
+#include <basic/sbuno.hxx>
+
+class MacroSnippet
+{
+private:
+ bool mbError;
+ ErrCode maErrCode;
+ BasicDLL maDll; // we need a dll instance for resource manager etc.
+ SbModuleRef mpMod;
+ StarBASICRef mpBasic;
+
+ void InitSnippet();
+ void MakeModule( const OUString& sSource );
+
+public:
+ explicit MacroSnippet( const OUString& sSource );
+ MacroSnippet();
+
+ void LoadSourceFromFile( const OUString& sMacroFileURL );
+
+ SbxVariableRef Run( const css::uno::Sequence< css::uno::Any >& rArgs );
+
+ SbxVariableRef Run();
+
+ bool Compile();
+
+ DECL_LINK( BasicErrorHdl, StarBASIC *, bool );
+
+ bool HasError() const;
+ const ErrCode& getError() const;
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/cppunit/test_append.cxx b/basic/qa/cppunit/test_append.cxx
new file mode 100644
index 000000000..7ff58012b
--- /dev/null
+++ b/basic/qa/cppunit/test_append.cxx
@@ -0,0 +1,80 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include "basictest.hxx"
+
+namespace
+{
+ class EnableTest : public test::BootstrapFixture
+ {
+ public:
+ EnableTest() : BootstrapFixture(true, false) {};
+ void testDimEnable();
+ void testWin64();
+ void testEnableRuntime();
+ // Adds code needed to register the test suite
+ CPPUNIT_TEST_SUITE(EnableTest);
+
+ // Declares the method as a test to call
+ CPPUNIT_TEST(testDimEnable);
+ CPPUNIT_TEST(testWin64);
+ CPPUNIT_TEST(testEnableRuntime);
+
+ // End of test suite definition
+ CPPUNIT_TEST_SUITE_END();
+ };
+
+OUString sTestEnableRuntime(
+ "Function doUnitTest as Integer\n"
+ "Dim Enable as Integer\n"
+ "Enable = 1\n"
+ "Enable = Enable + 2\n"
+ "doUnitTest = Enable\n"
+ "End Function\n"
+);
+
+OUString sTestDimEnable(
+ "Sub doUnitTest\n"
+ "Dim Enable as String\n"
+ "End Sub\n"
+);
+
+void EnableTest::testEnableRuntime()
+{
+ MacroSnippet myMacro(sTestEnableRuntime);
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testEnableRuntime fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(3), pNew->GetInteger());
+}
+
+void EnableTest::testDimEnable()
+{
+ MacroSnippet myMacro(sTestDimEnable);
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("Dim causes compile error", !myMacro.HasError() );
+}
+
+void EnableTest::testWin64()
+{
+ OUString aSource1 = " #If Win64\n"
+ "Declare PtrSafe Function aht_apiGetOpenFileName Lib \"comdlg32.dll\""
+ "\n"
+ "#End if\n";
+
+ MacroSnippet myMacro(aSource1);
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("#if Win64 Declare PtrSafe causes compile error", !myMacro.HasError() );
+}
+
+ // Put the test suite in the registry
+ CPPUNIT_TEST_SUITE_REGISTRATION(EnableTest);
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/cppunit/test_compiler_checks.cxx b/basic/qa/cppunit/test_compiler_checks.cxx
new file mode 100644
index 000000000..24b380ed2
--- /dev/null
+++ b/basic/qa/cppunit/test_compiler_checks.cxx
@@ -0,0 +1,36 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; fill-column: 100 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include <sal/config.h>
+#include "basictest.hxx"
+#include <basic/sberrors.hxx>
+#include <unotest/bootstrapfixturebase.hxx>
+
+CPPUNIT_TEST_FIXTURE(CppUnit::TestFixture, testRedefineArgument)
+{
+ MacroSnippet aMacro("Sub doUnitTest(argName)\n"
+ " If False Then\n"
+ " Dim argName\n"
+ " End If\n"
+ "End Sub\n");
+ aMacro.Compile();
+ CPPUNIT_ASSERT(aMacro.HasError());
+ CPPUNIT_ASSERT_EQUAL(ERRCODE_BASIC_VAR_DEFINED, aMacro.getError().StripDynamic());
+}
+
+CPPUNIT_TEST_FIXTURE(CppUnit::TestFixture, testDoubleArgument)
+{
+ MacroSnippet aMacro("Sub doUnitTest(argName, argName)\n"
+ "End Sub\n");
+ aMacro.Compile();
+ CPPUNIT_ASSERT(aMacro.HasError());
+ CPPUNIT_ASSERT_EQUAL(ERRCODE_BASIC_VAR_DEFINED, aMacro.getError().StripDynamic());
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab cinoptions=b1,g0,N-s cinkeys+=0=break: */
diff --git a/basic/qa/cppunit/test_language_conditionals.cxx b/basic/qa/cppunit/test_language_conditionals.cxx
new file mode 100644
index 000000000..53d6b6ec4
--- /dev/null
+++ b/basic/qa/cppunit/test_language_conditionals.cxx
@@ -0,0 +1,173 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; fill-column: 100 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include "basictest.hxx"
+#include <rtl/ustring.hxx>
+
+#include <cppunit/TestAssert.h>
+#include <cppunit/TestFixture.h>
+#include <cppunit/extensions/HelperMacros.h>
+
+namespace
+{
+class Language_Conditionals : public CppUnit::TestFixture
+{
+public:
+ void testIfNot();
+ void testIfAndNot();
+ void testNENot();
+
+ CPPUNIT_TEST_SUITE(Language_Conditionals);
+
+ CPPUNIT_TEST(testIfNot);
+ CPPUNIT_TEST(testIfAndNot);
+ CPPUNIT_TEST(testNENot);
+
+ CPPUNIT_TEST_SUITE_END();
+};
+
+void Language_Conditionals::testIfNot()
+{
+ { // need a block to ensure MacroSnippet is cleaned properly
+ const OUString aSnippet("Option VBASupport 1\n"
+ "Option Explicit\n"
+ "\n"
+ "Function doUnitTest() As Integer\n"
+ "Dim op1 As Boolean\n"
+ "op1 = False\n"
+ "If Not op1 Then\n"
+ "doUnitTest = 1\n"
+ "Else\n"
+ "doUnitTest = 0\n"
+ "End If\n"
+ "End Function\n");
+ MacroSnippet myMacro(aSnippet);
+ myMacro.Compile();
+ CPPUNIT_ASSERT(!myMacro.HasError());
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger());
+ }
+ { // need a block to ensure MacroSnippet is cleaned properly
+ const OUString aSnippet("Option VBASupport 0\n"
+ "Option Explicit\n"
+ "\n"
+ "Function doUnitTest() As Integer\n"
+ "Dim op1 As Boolean\n"
+ "op1 = False\n"
+ "If Not op1 Then\n"
+ "doUnitTest = 1\n"
+ "Else\n"
+ "doUnitTest = 0\n"
+ "End If\n"
+ "End Function\n");
+ MacroSnippet myMacro(aSnippet);
+ myMacro.Compile();
+ CPPUNIT_ASSERT(!myMacro.HasError());
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger());
+ }
+}
+
+void Language_Conditionals::testIfAndNot()
+{
+ { // need a block to ensure MacroSnippet is cleaned properly
+ const OUString aSnippet("Option VBASupport 1\n"
+ "Option Explicit\n"
+ "\n"
+ "Function doUnitTest() As Integer\n"
+ "Dim op1 As Boolean\n"
+ "Dim op2 As Boolean\n"
+ "op1 = True\n"
+ "op2 = False\n"
+ "If op1 And Not op2 Then\n"
+ "doUnitTest = 1\n"
+ "Else\n"
+ "doUnitTest = 0\n"
+ "End If\n"
+ "End Function\n");
+ MacroSnippet myMacro(aSnippet);
+ myMacro.Compile();
+ CPPUNIT_ASSERT(!myMacro.HasError());
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger());
+ }
+ { // need a block to ensure MacroSnippet is cleaned properly
+ const OUString aSnippet("Option VBASupport 0\n"
+ "Option Explicit\n"
+ "\n"
+ "Function doUnitTest() As Integer\n"
+ "Dim op1 As Boolean\n"
+ "Dim op2 As Boolean\n"
+ "op1 = True\n"
+ "op2 = False\n"
+ "If op1 And Not op2 Then\n"
+ "doUnitTest = 1\n"
+ "Else\n"
+ "doUnitTest = 0\n"
+ "End If\n"
+ "End Function\n");
+ MacroSnippet myMacro(aSnippet);
+ myMacro.Compile();
+ CPPUNIT_ASSERT(!myMacro.HasError());
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger());
+ }
+}
+
+void Language_Conditionals::testNENot()
+{
+ { // need a block to ensure MacroSnippet is cleaned properly
+ const OUString aSnippet("Option VBASupport 1\n"
+ "Option Explicit\n"
+ "\n"
+ "Function doUnitTest() As Integer\n"
+ "Dim op1 As Boolean\n"
+ "Dim op2 As Boolean\n"
+ "op1 = False\n"
+ "op2 = False\n"
+ "If op1 <> Not op2 Then\n"
+ "doUnitTest = 1\n"
+ "Else\n"
+ "doUnitTest = 0\n"
+ "End If\n"
+ "End Function\n");
+ MacroSnippet myMacro(aSnippet);
+ myMacro.Compile();
+ CPPUNIT_ASSERT(!myMacro.HasError());
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger());
+ }
+ { // need a block to ensure MacroSnippet is cleaned properly
+ const OUString aSnippet("Option VBASupport 0\n"
+ "Option Explicit\n"
+ "\n"
+ "Function doUnitTest() As Integer\n"
+ "Dim op1 As Boolean\n"
+ "Dim op2 As Boolean\n"
+ "op1 = False\n"
+ "op2 = False\n"
+ "If op1 <> Not op2 Then\n"
+ "doUnitTest = 1\n"
+ "Else\n"
+ "doUnitTest = 0\n"
+ "End If\n"
+ "End Function\n");
+ MacroSnippet myMacro(aSnippet);
+ myMacro.Compile();
+ CPPUNIT_ASSERT(!myMacro.HasError());
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger());
+ }
+}
+
+CPPUNIT_TEST_SUITE_REGISTRATION(Language_Conditionals);
+
+} // namespace
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab cinoptions=b1,g0,N-s cinkeys+=0=break: */
diff --git a/basic/qa/cppunit/test_nested_struct.cxx b/basic/qa/cppunit/test_nested_struct.cxx
new file mode 100644
index 000000000..009d832b1
--- /dev/null
+++ b/basic/qa/cppunit/test_nested_struct.cxx
@@ -0,0 +1,303 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+#include "basictest.hxx"
+
+#include <com/sun/star/awt/WindowDescriptor.hpp>
+#include <com/sun/star/table/TableBorder.hpp>
+#include <basic/sbuno.hxx>
+
+namespace
+{
+ using namespace com::sun::star;
+ class Nested_Struct : public test::BootstrapFixture
+ {
+ public:
+ Nested_Struct(): BootstrapFixture(true, false) {};
+ void testAssign1();
+ void testAssign1Alt(); // result is uno-ised and tested
+ void testOldAssign();
+ void testOldAssignAlt(); // result is uno-ised and tested
+ void testUnfixedVarAssign();
+ void testUnfixedVarAssignAlt(); // result is uno-ised and tested
+ void testFixedVarAssign();
+ void testFixedVarAssignAlt(); // result is uno-ised and tested
+ void testUnoAccess(); // fdo#60117 specific test
+
+ // Adds code needed to register the test suite
+ CPPUNIT_TEST_SUITE(Nested_Struct);
+
+ // Declares the method as a test to call
+ CPPUNIT_TEST(testAssign1);
+ CPPUNIT_TEST(testAssign1Alt);
+ CPPUNIT_TEST(testOldAssign);
+ CPPUNIT_TEST(testOldAssignAlt);
+ CPPUNIT_TEST(testUnfixedVarAssign);
+ CPPUNIT_TEST(testUnfixedVarAssignAlt);
+ CPPUNIT_TEST(testFixedVarAssign);
+ CPPUNIT_TEST(testFixedVarAssignAlt);
+ CPPUNIT_TEST(testUnoAccess);
+
+ // End of test suite definition
+ CPPUNIT_TEST_SUITE_END();
+ };
+
+// tests the new behaviour, we should be able to
+// directly modify the value of the nested 'HorizontalLine' struct
+OUString sTestSource1(
+ "Function doUnitTest() as Integer\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
+ "b0.HorizontalLine.OuterLineWidth = 9\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth\n"
+ "End Function\n"
+);
+
+OUString sTestSource1Alt(
+ "Function doUnitTest() as Object\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
+ "b0.HorizontalLine.OuterLineWidth = 9\n"
+ "doUnitTest = b0\n"
+ "End Function\n"
+);
+
+// tests the old behaviour, we should still be able
+// to use the old workaround of
+// a) creating a new instance BorderLine,
+// b) cloning the new instance with the value of b0.HorizontalLine
+// c) modifying the new instance
+// d) setting b0.HorizontalLine with the value of the new instance
+OUString sTestSource2(
+ "Function doUnitTest()\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
+ "l = b0.HorizontalLine\n"
+ "l.OuterLineWidth = 9\n"
+ "b0.HorizontalLine = l\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth\n"
+"End Function\n"
+);
+
+OUString sTestSource2Alt(
+ "Function doUnitTest()\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
+ "l = b0.HorizontalLine\n"
+ "l.OuterLineWidth = 9\n"
+ "b0.HorizontalLine = l\n"
+ "doUnitTest = b0\n"
+"End Function\n"
+);
+// it should be legal to assign a variant to a struct ( and copy by val )
+// make sure we aren't copying by reference, we make sure that l is not
+// a reference copy of b0.HorizontalLine, each one should have an
+// OuterLineWidth of 4 & 9 respectively and we should be returning
+// 13 the sum of the two ( hopefully unique values if we haven't copied by reference )
+OUString sTestSource3(
+ "Function doUnitTest()\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
+ "l = b0.HorizontalLine\n"
+ "l.OuterLineWidth = 9\n"
+ "b0.HorizontalLine = l\n"
+ "l.OuterLineWidth = 4\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n"
+"End Function\n"
+);
+
+OUString sTestSource3Alt(
+ "Function doUnitTest()\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
+ "l = b0.HorizontalLine\n"
+ "l.OuterLineWidth = 9\n"
+ "b0.HorizontalLine = l\n"
+ "l.OuterLineWidth = 4\n"
+ "Dim result(1)\n"
+ "result(0) = b0\n"
+ "result(1) = l\n"
+ "doUnitTest = result\n"
+"End Function\n"
+);
+
+// nearly the same as above but this time for a fixed type
+// variable
+OUString sTestSource4(
+ "Function doUnitTest()\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
+ "l = b0.HorizontalLine\n"
+ "l.OuterLineWidth = 9\n"
+ "b0.HorizontalLine = l\n"
+ "l.OuterLineWidth = 4\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n"
+"End Function\n"
+);
+
+OUString sTestSource4Alt(
+ "Function doUnitTest()\n"
+ "Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
+ "l = b0.HorizontalLine\n"
+ "l.OuterLineWidth = 9\n"
+ "b0.HorizontalLine = l\n"
+ "l.OuterLineWidth = 4\n"
+ "Dim result(1)\n"
+ "result(0) = b0\n"
+ "result(1) = l\n"
+ "doUnitTest = result\n"
+"End Function\n"
+);
+
+// Although basic might appear to correctly change nested struct elements
+// fdo#60117 shows that basic can be fooled ( and even the watch(ed) variable
+// in the debugger shows the expected values )
+// We need to additionally check the actual uno struct to see if the
+// changes made are *really* reflected in the object
+OUString sTestSource5(
+ "Function doUnitTest() as Object\n"
+ "Dim aWinDesc as new \"com.sun.star.awt.WindowDescriptor\"\n"
+ "Dim aRect as new \"com.sun.star.awt.Rectangle\"\n"
+ "aRect.X = 200\n"
+ "aWinDesc.Bounds = aRect\n"
+ "doUnitTest = aWinDesc\n"
+"End Function\n"
+);
+
+
+void Nested_Struct::testAssign1()
+{
+ MacroSnippet myMacro( sTestSource1 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testAssign1 fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(9), pNew->GetInteger());
+}
+
+void Nested_Struct::testAssign1Alt()
+{
+ MacroSnippet myMacro( sTestSource1Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testAssign1Alt fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ uno::Any aRet = sbxToUnoValue( pNew.get() );
+ table::TableBorder aBorder;
+ aRet >>= aBorder;
+
+ int result = aBorder.HorizontalLine.OuterLineWidth;
+ CPPUNIT_ASSERT_EQUAL( 9, result );
+}
+
+void Nested_Struct::testOldAssign()
+{
+ MacroSnippet myMacro( sTestSource2 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(9), pNew->GetInteger());
+}
+
+void Nested_Struct::testOldAssignAlt()
+{
+ MacroSnippet myMacro( sTestSource2Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ uno::Any aRet = sbxToUnoValue( pNew.get() );
+ table::TableBorder aBorder;
+ aRet >>= aBorder;
+
+ int result = aBorder.HorizontalLine.OuterLineWidth;
+ CPPUNIT_ASSERT_EQUAL( 9, result );
+}
+
+void Nested_Struct::testUnfixedVarAssign()
+{
+ MacroSnippet myMacro( sTestSource3 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssign fails with compile error",!myMacro.HasError() );
+ // forces a broadcast
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(13), pNew->GetInteger());
+}
+
+void Nested_Struct::testUnfixedVarAssignAlt()
+{
+ MacroSnippet myMacro( sTestSource3Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssignAlt fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ uno::Any aRet = sbxToUnoValue( pNew.get() );
+
+ uno::Sequence< uno::Any > aResult;
+ bool bRes = aRet >>= aResult;
+ CPPUNIT_ASSERT_EQUAL(true, bRes );
+
+ int result = aResult.getLength();
+ // should have 2 elements in a sequence returned
+ CPPUNIT_ASSERT_EQUAL(2, result );
+
+ table::TableBorder aBorder;
+ aResult[0] >>= aBorder;
+
+ table::BorderLine aBorderLine;
+ aResult[1] >>= aBorderLine;
+ result = aBorder.HorizontalLine.OuterLineWidth;
+ CPPUNIT_ASSERT_EQUAL(9, result );
+ result = aBorderLine.OuterLineWidth;
+ CPPUNIT_ASSERT_EQUAL(4, result );
+}
+
+void Nested_Struct::testFixedVarAssign()
+{
+ MacroSnippet myMacro( sTestSource4 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testFixedVarAssign fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(13), pNew->GetInteger());
+}
+
+void Nested_Struct::testFixedVarAssignAlt()
+{
+ MacroSnippet myMacro( sTestSource4Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testFixedVarAssignAlt fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ uno::Any aRet = sbxToUnoValue( pNew.get() );
+
+ uno::Sequence< uno::Any > aResult;
+ bool bRes = aRet >>= aResult;
+ CPPUNIT_ASSERT_EQUAL(true, bRes );
+
+ int result = aResult.getLength();
+ // should have 2 elements in a sequence returned
+ CPPUNIT_ASSERT_EQUAL(2, result );
+
+ table::TableBorder aBorder;
+ aResult[0] >>= aBorder;
+
+ table::BorderLine aBorderLine;
+ aResult[1] >>= aBorderLine;
+ result = aBorder.HorizontalLine.OuterLineWidth;
+ CPPUNIT_ASSERT_EQUAL(9, result );
+ result = aBorderLine.OuterLineWidth;
+ CPPUNIT_ASSERT_EQUAL(4, result );
+}
+
+void Nested_Struct::testUnoAccess()
+{
+ MacroSnippet myMacro( sTestSource5 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testUnoAccess fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
+ uno::Any aRet = sbxToUnoValue( pNew.get() );
+ awt::WindowDescriptor aWinDesc;
+ aRet >>= aWinDesc;
+
+ int result = aWinDesc.Bounds.X;
+ CPPUNIT_ASSERT_EQUAL(200, result );
+}
+
+ // Put the test suite in the registry
+ CPPUNIT_TEST_SUITE_REGISTRATION(Nested_Struct);
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/cppunit/test_scanner.cxx b/basic/qa/cppunit/test_scanner.cxx
new file mode 100644
index 000000000..068006128
--- /dev/null
+++ b/basic/qa/cppunit/test_scanner.cxx
@@ -0,0 +1,1166 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include <sal/types.h>
+#include <cppunit/TestAssert.h>
+#include <cppunit/TestFixture.h>
+#include <cppunit/extensions/HelperMacros.h>
+#include <cppunit/plugin/TestPlugIn.h>
+
+#include <rtl/math.hxx>
+
+#include <scanner.hxx>
+
+namespace
+{
+ struct Symbol
+ {
+ sal_uInt16 line;
+ sal_uInt16 col1;
+ OUString text;
+ double number;
+ SbxDataType type;
+ bool ws;
+ };
+
+ /**
+ * Perform tests on Scanner.
+ */
+ class ScannerTest : public CppUnit::TestFixture
+ {
+ private:
+ void testBlankLines();
+ void testOperators();
+ void testAlphanum();
+ void testComments();
+ void testGoto();
+ void testGotoCompatible();
+ void testExclamation();
+ void testNumbers();
+ void testDataType();
+ void testHexOctal();
+ void testTdf103104();
+ void testTdf136032();
+
+ // Adds code needed to register the test suite
+ CPPUNIT_TEST_SUITE(ScannerTest);
+
+ // Declares the method as a test to call
+ CPPUNIT_TEST(testBlankLines);
+ CPPUNIT_TEST(testOperators);
+ CPPUNIT_TEST(testAlphanum);
+ CPPUNIT_TEST(testComments);
+ CPPUNIT_TEST(testGoto);
+ CPPUNIT_TEST(testGotoCompatible);
+ CPPUNIT_TEST(testExclamation);
+ CPPUNIT_TEST(testNumbers);
+ CPPUNIT_TEST(testDataType);
+ CPPUNIT_TEST(testHexOctal);
+ CPPUNIT_TEST(testTdf103104);
+ CPPUNIT_TEST(testTdf136032);
+
+ // End of test suite definition
+ CPPUNIT_TEST_SUITE_END();
+ };
+
+ static const OUString cr = "\n";
+ static const OUString rem = "REM";
+ static const OUString asdf = "asdf";
+ static const OUString dot = ".";
+ static const OUString goto_ = "goto";
+ static const OUString excl = "!";
+
+ std::vector<Symbol> getSymbols(const OUString& source, sal_Int32& errors, bool bCompatible = false)
+ {
+ std::vector<Symbol> symbols;
+ SbiScanner scanner(source);
+ scanner.EnableErrors();
+ scanner.SetCompatible(bCompatible);
+ while(scanner.NextSym())
+ {
+ Symbol symbol;
+ symbol.line = scanner.GetLine();
+ symbol.col1 = scanner.GetCol1();
+ symbol.text = scanner.GetSym();
+ symbol.number = scanner.GetDbl();
+ symbol.type = scanner.GetType();
+ symbol.ws = scanner.WhiteSpace();
+ symbols.push_back(symbol);
+ }
+ errors = scanner.GetErrors();
+ return symbols;
+ }
+
+ std::vector<Symbol> getSymbols(const OUString& source, bool bCompatible = false)
+ {
+ sal_Int32 i;
+ return getSymbols(source, i, bCompatible);
+ }
+
+ void ScannerTest::testBlankLines()
+ {
+ const OUString source1("");
+ const OUString source2("\r\n");
+ const OUString source3("\n");
+ const OUString source4("\r");
+ const OUString source5("\r\n\r\n");
+ const OUString source6("\n\r");
+ const OUString source7("\n\r\n");
+ const OUString source8("\r\n\r");
+ const OUString source9(" ");
+
+ std::vector<Symbol> symbols;
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT(symbols.empty());
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+
+ symbols = getSymbols(source4);
+ CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+
+ symbols = getSymbols(source5);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source6);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source7);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source8);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source9);
+ CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ }
+
+ void ScannerTest::testOperators()
+ {
+ const OUString sourceE("=");
+ const OUString sourceLT("<");
+ const OUString sourceGT(">");
+ const OUString sourceLTE("<=");
+ const OUString sourceGTE(">=");
+ const OUString sourceEE("==");
+ const OUString sourceNE("<>");
+ const OUString sourceA(":=");
+ const OUString sourceNot("Not");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(sourceE);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceE, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(sourceLT);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceLT, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(sourceGT);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceGT, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(sourceLTE);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceLTE, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(sourceGTE);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceGTE, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(sourceEE);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceE, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(sourceE, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+
+ symbols = getSymbols(sourceNE);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceNE, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(sourceA);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceA, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(sourceNot);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(sourceNot, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ }
+
+ void ScannerTest::testAlphanum()
+ {
+ const OUString source1("asdfghefg");
+ const OUString source2("1asfdasfd");
+ const OUString source3("AdfsaAUdsl10987");
+ const OUString source4("asdfa_mnvcnm");
+ const OUString source5("_asdf1");
+ const OUString source6("_6");
+ const OUString source7("joxclk_");
+ const OUString source8(" asdf ");
+ const OUString source9(" 19395 asdfa ");
+ const OUString source10("\n1\n2\na sdf");
+ const OUString source11("asdf.asdf");
+ const OUString source12("..");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(source1, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT(symbols[0].text.isEmpty()); // Can't start symbol with a digit
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("asfdasfd"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(source3, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source4);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(source4, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source5);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(source5, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source6);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(source6, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source7);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("joxclk_"), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("joxclk "), source7); // Change the trailing '_' to a ' '
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source8);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("asdf"), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source9);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT(symbols[0].text.isEmpty());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(19395.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("asdfa"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+
+ symbols = getSymbols(source10);
+ CPPUNIT_ASSERT_EQUAL(size_t(8), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT(symbols[1].text.isEmpty());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+ CPPUNIT_ASSERT(symbols[3].text.isEmpty());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(2.0, symbols[3].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[3].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[4].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[4].type);
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(symbols[5].text.getLength()));
+ CPPUNIT_ASSERT_EQUAL('a', static_cast<char>(symbols[5].text[0]));
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[5].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("sdf"), symbols[6].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[6].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[7].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[7].type);
+
+ symbols = getSymbols(source11);
+ CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[3].type);
+
+ symbols = getSymbols(source12);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(dot, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+ }
+
+ void ScannerTest::testComments()
+ {
+ const OUString source1("REM asdf");
+ const OUString source2("REMasdf");
+ const OUString source3("'asdf");
+ const OUString source4("asdf _\n'100");
+ const OUString source5("'asdf _\n100");
+ const OUString source6("'asdf _\n'100");
+ const OUString source7("'asdf _\n 1234 _\n asdf'");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("REMasdf"), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+
+ symbols = getSymbols(source4);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source5);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT(symbols[1].text.isEmpty());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(100.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+
+ symbols = getSymbols(source6);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source7);
+ CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT(symbols[1].text.isEmpty());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1234.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+ CPPUNIT_ASSERT_EQUAL(rem, symbols[3].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[3].type);
+ }
+
+ void ScannerTest::testGoto()
+ {
+ const OUString source1("goto");
+ const OUString source2("go to");
+ const OUString source3("go\nto");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(goto_, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("go"), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("to"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("go"), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("to"), symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[3].type);
+ }
+
+ void ScannerTest::testGotoCompatible()
+ {
+ const OUString source1("goto");
+ const OUString source2("go to");
+ const OUString source3("go\nto");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1, true);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(goto_, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source2, true);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(goto_, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source3, true);
+ CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("go"), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(OUString("to"), symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text);
+ }
+
+ void ScannerTest::testExclamation()
+ {
+ const OUString source1("asdf!asdf");
+ const OUString source2("!1234");
+ const OUString source3("!_3");
+ const OUString source4("!$");
+ const OUString source5("!%");
+ const OUString source6("!\n");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(excl, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text);
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text);
+ CPPUNIT_ASSERT(symbols[1].text.isEmpty());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1234.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(OUString("_3"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+
+ symbols = getSymbols(source4);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(OUString("$"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+
+ symbols = getSymbols(source5);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(OUString("%"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+
+ symbols = getSymbols(source6);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ }
+
+ void ScannerTest::testNumbers()
+ {
+ const OUString source1("12345");
+ const OUString source2("1.2.3");
+ const OUString source3("123.4");
+ const OUString source4("0.5");
+ const OUString source5("5.0");
+ const OUString source6("0.0");
+ const OUString source7("-3");
+ const OUString source8("-0.0");
+ const OUString source9("12dE3");
+ const OUString source10("12e3");
+ const OUString source11("12D+3");
+ const OUString source12("12e++3");
+ const OUString source13("12e-3");
+ const OUString source14("12e-3+");
+ const OUString source15("1,2,3");
+ const OUString source16("1.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000");
+ const OUString source17("10e308");
+
+ std::vector<Symbol> symbols;
+ sal_Int32 errors;
+
+ symbols = getSymbols(source1, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(12345.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source2, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.2, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(.3, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source3, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(123.4, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source4, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(.5, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source5, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(5.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source6, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source7, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("-"), symbols[0].text);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(3.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source8, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString("-"), symbols[0].text);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source9, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(12.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("dE3"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source10, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(12000.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source11, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(12000.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source12, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(6), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(12.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("e"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(OUString("+"), symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(OUString("+"), symbols[3].text);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(3.0, symbols[4].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[4].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[5].text);
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source13, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(.012, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source14, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(.012, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString("+"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source15, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(6), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(OUString(","), symbols[1].text);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(2.0, symbols[2].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[2].type);
+ CPPUNIT_ASSERT_EQUAL(OUString(","), symbols[3].text);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(3.0, symbols[4].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[4].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[5].text);
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+
+ symbols = getSymbols(source16, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ // This error is from a "buffer overflow" which is stupid because
+ // the buffer is artificially constrained by the scanner.
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); // HACK
+
+ double fInf = 0.0;
+ rtl::math::setInf( &fInf, false);
+ symbols = getSymbols(source17, errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(fInf, symbols[0].number);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); // math error, overflow
+
+ // trailing data type character % = SbxINTEGER
+ symbols = getSymbols("1.23%");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // trailing data type character & = SbxLONG
+ symbols = getSymbols("1.23&");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // trailing data type character ! = SbxSINGLE
+ symbols = getSymbols("1.23!");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // trailing data type character # = SbxDOUBLE
+ symbols = getSymbols("1.23#");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // trailing data type character @ = SbxCURRENCY
+ symbols = getSymbols("1.23@");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // trailing data type character $ = SbxSTRING
+ symbols = getSymbols("1.23$", errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ // ERRCODE_BASIC_SYNTAX
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+ }
+
+ void ScannerTest::testDataType()
+ {
+ const OUString source1("asdf%");
+ const OUString source2("asdf&");
+ const OUString source3("asdf!");
+ const OUString source4("asdf#");
+ const OUString source5("asdf@");
+ const OUString source6("asdf$");
+ const OUString source7("asdf ");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source4);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source5);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source6);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source7);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ }
+
+ void ScannerTest::testHexOctal()
+ {
+ const OUString source1("&HA");
+ const OUString source2("&HASDF");
+ const OUString source3("&H10");
+ const OUString source4("&&H&1H1&H1");
+ const OUString source5("&O&O12");
+ const OUString source6("&O10");
+ const OUString source7("&HO");
+ const OUString source8("&O123000000000000000000000");
+ const OUString source9("&H1.23");
+
+ sal_Int32 errors;
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(10.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(2783.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(16.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source4);
+ CPPUNIT_ASSERT_EQUAL(size_t(6), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString("&"), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[1].type);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[2].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[2].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[2].type);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[3].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString("H1"), symbols[3].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[3].type);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[4].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString("H1"), symbols[4].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[4].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[5].text);
+
+ symbols = getSymbols(source5);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString("O12"), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+
+ symbols = getSymbols(source6);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(8.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source7);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source8);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ // TODO: this line fails on 64 bit systems!!!
+ // CPPUNIT_ASSERT_EQUAL(symbols[0].number, -1744830464);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ symbols = getSymbols(source9);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(.23, symbols[1].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[1].text);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[1].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+
+ /* tdf#62323, tdf#62326 - conversion of Hex literals to basic signed Integers */
+
+ // &H0 = 0
+ symbols = getSymbols("&H0");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // &H8000 = -32768
+ symbols = getSymbols("&H8000");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMININT, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // &H80000000 = -2147483648
+ symbols = getSymbols("&H80000000");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMINLNG, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // &HFFFF = -1
+ symbols = getSymbols("&HFFFF");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // &HFFFFFFFF = -1
+ symbols = getSymbols("&HFFFFFFFF");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // &H7FFF = 32767
+ symbols = getSymbols("&H7FFF");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMAXINT, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // &H7FFFFFFF = 2147483647
+ symbols = getSymbols("&H7FFFFFFF");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMAXLNG, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ /* tdf#130476 - trailing data type characters */
+
+ // % = SbxINTEGER
+ symbols = getSymbols("&H0%");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // & = SbxLONG
+ symbols = getSymbols("&H0&");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // ! = SbxSINGLE
+ symbols = getSymbols("&H0!");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // # = SbxDOUBLE
+ symbols = getSymbols("&H0#");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // @ = SbxCURRENCY
+ symbols = getSymbols("&H0@");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // $ = SbxSTRING
+ symbols = getSymbols("&H0$", errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ // ERRCODE_BASIC_SYNTAX
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+
+ // % = SbxINTEGER
+ symbols = getSymbols("&O0%");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // & = SbxLONG
+ symbols = getSymbols("&O0&");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // ! = SbxSINGLE
+ symbols = getSymbols("&O0!");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // # = SbxDOUBLE
+ symbols = getSymbols("&O0#");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // @ = SbxCURRENCY
+ symbols = getSymbols("&O0@");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // $ = SbxSTRING
+ symbols = getSymbols("&O0$", errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ // ERRCODE_BASIC_SYNTAX
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+
+ // maximum for Hex % = SbxINTEGER
+ symbols = getSymbols("&HFFFF%");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // overflow for Hex % = SbxINTEGER
+ symbols = getSymbols("&H10000%", errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ // ERRCODE_BASIC_MATH_OVERFLOW
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+
+ // maximum for Octal % = SbxINTEGER
+ symbols = getSymbols("&O177777%");
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+
+ // overflow for Octal % = SbxINTEGER
+ symbols = getSymbols("&O200000%", errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size());
+ CPPUNIT_ASSERT_DOUBLES_EQUAL(0, symbols[0].number, 1E-12);
+ CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text);
+ // ERRCODE_BASIC_MATH_OVERFLOW
+ CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors));
+ }
+
+ void ScannerTest::testTdf103104()
+ {
+ const OUString source1("asdf _\n asdf");
+ const OUString source2("asdf. _\n asdf");
+ const OUString source3("asdf _\n .asdf");
+
+ std::vector<Symbol> symbols;
+
+ symbols = getSymbols(source1);
+ CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[1].text);
+ CPPUNIT_ASSERT(symbols[1].ws);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text);
+
+ symbols = getSymbols(source2);
+ CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text);
+ CPPUNIT_ASSERT(!symbols[1].ws);
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text);
+ CPPUNIT_ASSERT(symbols[2].ws);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text);
+
+ symbols = getSymbols(source3);
+ CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text);
+ CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text);
+ CPPUNIT_ASSERT(!symbols[1].ws);
+ CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text);
+ CPPUNIT_ASSERT(!symbols[2].ws);
+ CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text);
+ }
+
+ void ScannerTest::testTdf136032()
+ {
+ std::vector<Symbol> symbols;
+ sal_Int32 errors;
+
+ // tdf#136032 - abort scan of a string beginning with a hashtag,
+ // if a comma/whitespace is found. Otherwise, the compiler raises a syntax error.
+ symbols = getSymbols("Print #i,\"A#B\"", errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(5), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+ symbols = getSymbols("Print #i, \"A#B\"", errors);
+ CPPUNIT_ASSERT_EQUAL(size_t(5), symbols.size());
+ CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors));
+ }
+
+ // Put the test suite in the registry
+ CPPUNIT_TEST_SUITE_REGISTRATION(ScannerTest);
+} // namespace
+CPPUNIT_PLUGIN_IMPLEMENT();
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx
new file mode 100644
index 000000000..235bcc2cf
--- /dev/null
+++ b/basic/qa/cppunit/test_vba.cxx
@@ -0,0 +1,256 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+#include "basictest.hxx"
+#include <unotools/syslocaleoptions.hxx>
+
+#ifdef _WIN32
+#include <string.h>
+#include <comphelper/processfactory.hxx>
+#include <o3tl/char16_t2wchar_t.hxx>
+
+#if !defined WIN32_LEAN_AND_MEAN
+# define WIN32_LEAN_AND_MEAN
+#endif
+#include <windows.h>
+#include <odbcinst.h>
+#endif
+
+using namespace ::com::sun::star;
+
+namespace
+{
+ class VBATest : public test::BootstrapFixture
+ {
+ public:
+ VBATest() : BootstrapFixture(true, false) {}
+ void testMiscVBAFunctions();
+ void testMiscOLEStuff();
+ // Adds code needed to register the test suite
+ CPPUNIT_TEST_SUITE(VBATest);
+
+ // Declares the method as a test to call
+ CPPUNIT_TEST(testMiscVBAFunctions);
+ CPPUNIT_TEST(testMiscOLEStuff);
+
+ // End of test suite definition
+ CPPUNIT_TEST_SUITE_END();
+
+ };
+
+void VBATest::testMiscVBAFunctions()
+{
+ const char* macroSource[] = {
+ "bytearraystring.vb",
+#ifdef _WIN32
+ "cdec.vb", // currently CDec is implemented only on Windows
+#endif
+ "constants.vb",
+// datevalue test seems to depend on both locale and language
+// settings, should try and rewrite the test to deal with that
+// for some reason tinderboxes don't seem to complain leaving enabled
+// for the moment
+ "datevalue.vb",
+ "partition.vb",
+ "strconv.vb",
+ "dateserial.vb",
+ "format.vb",
+ "replace.vb",
+ "stringplusdouble.vb",
+ "chr.vb",
+ "abs.vb",
+ "array.vb",
+ "asc.vb",
+ "atn.vb",
+ "cbool.vb",
+ "cdate.vb",
+ "cdbl.vb",
+ "choose.vb",
+ "cos.vb",
+ "cint.vb",
+ "clng.vb",
+ "csng.vb",
+ "cstr.vb",
+ "cvdate.vb",
+ "cverr.vb",
+ "dateadd.vb",
+ "datediff.vb",
+ "datepart.vb",
+ "day.vb",
+ "enum.vb",
+ "error.vb",
+ "Err.Raise.vb",
+ "exp.vb",
+ "fix.vb",
+ "hex.vb",
+ "hour.vb",
+ "formatnumber.vb",
+ "iif.vb",
+ "instr.vb",
+ "instrrev.vb",
+ "int.vb",
+ "iserror.vb",
+ "ismissing.vb",
+ "isnull.vb",
+ "isobject.vb",
+ "join.vb",
+ "lbound.vb",
+ "isarray.vb",
+ "isdate.vb",
+ "isempty.vb",
+ "isnumeric.vb",
+ "lcase.vb",
+ "left.vb",
+ "len.vb",
+ "log.vb",
+ "ltrim.vb",
+ "mid.vb",
+ "minute.vb",
+ "month.vb",
+ "monthname.vb",
+ "oct.vb",
+ "optional_paramters.vb",
+ "qbcolor.vb",
+ "rgb.vb",
+ "rtrim.vb",
+ "right.vb",
+ "second.vb",
+ "sgn.vb",
+ "sin.vb",
+ "space.vb",
+ "sqr.vb",
+ "str.vb",
+ "strcomp.vb",
+ "string.vb",
+ "strreverse.vb",
+ "switch.vb",
+ "timeserial.vb",
+ "timevalue.vb",
+ "trim.vb",
+ "typename.vb",
+ "ubound.vb",
+ "ucase.vb",
+ "val.vb",
+ "vartype.vb",
+ "weekday.vb",
+ "weekdayname.vb",
+ "year.vb",
+#ifndef _WIN32 // missing 64bit Currency marshalling.
+ "win32compat.vb", // windows compatibility hooks.
+#endif
+ "win32compatb.vb" // same methods, different signatures.
+ };
+ OUString sMacroPathURL = m_directories.getURLFromSrc("/basic/qa/vba_tests/");
+ // Some test data expects the uk locale
+ LanguageTag aLocale(LANGUAGE_ENGLISH_UK);
+ SvtSysLocaleOptions aLocalOptions;
+ aLocalOptions.SetLocaleConfigString( aLocale.getBcp47() );
+
+ for ( size_t i=0; i<SAL_N_ELEMENTS( macroSource ); ++i )
+ {
+ OUString sMacroURL = sMacroPathURL
+ + OUString::createFromAscii( macroSource[ i ] );
+
+ MacroSnippet myMacro;
+ myMacro.LoadSourceFromFile( sMacroURL );
+ SbxVariableRef pReturn = myMacro.Run();
+ CPPUNIT_ASSERT_MESSAGE("No return variable huh?", pReturn.is());
+ fprintf(stderr, "macro result for %s\n", macroSource[i]);
+ fprintf(stderr, "macro returned:\n%s\n",
+ OUStringToOString(pReturn->GetOUString(), RTL_TEXTENCODING_UTF8).getStr());
+ CPPUNIT_ASSERT_EQUAL_MESSAGE("Result not as expected", OUString("OK"),
+ pReturn->GetOUString());
+ }
+}
+
+void VBATest::testMiscOLEStuff()
+{
+// Not much point even trying to run except on Windows.
+// (Without Excel doesn't really do anything anyway,
+// see "so skip test" below.)
+
+// Since some time, on a properly updated Windows 10, this works
+// only with a 64-bit LibreOffice
+
+#if defined(_WIN64)
+ // test if we have the necessary runtime environment
+ // to run the OLE tests.
+ uno::Reference< lang::XMultiServiceFactory > xOLEFactory;
+ uno::Reference< uno::XComponentContext > xContext(
+ comphelper::getProcessComponentContext() );
+ if( xContext.is() )
+ {
+ uno::Reference<lang::XMultiComponentFactory> xSMgr = xContext->getServiceManager();
+ xOLEFactory.set( xSMgr->createInstanceWithContext( "com.sun.star.bridge.OleObjectFactory", xContext ),
+ uno::UNO_QUERY );
+ }
+ bool bOk = false;
+ if( xOLEFactory.is() )
+ {
+ uno::Reference< uno::XInterface > xADODB = xOLEFactory->createInstance( "ADODB.Connection" );
+ bOk = xADODB.is();
+ }
+ if ( !bOk )
+ return; // can't do anything, skip test
+
+ const int nBufSize = 1024 * 4;
+ wchar_t sBuf[nBufSize];
+ SQLGetInstalledDriversW( sBuf, nBufSize, nullptr );
+
+ const wchar_t *pODBCDriverName = sBuf;
+ bool bFound = false;
+ for (; wcslen( pODBCDriverName ) != 0; pODBCDriverName += wcslen( pODBCDriverName ) + 1 ) {
+ if( wcscmp( pODBCDriverName, L"Microsoft Excel Driver (*.xls)" ) == 0 ||
+ wcscmp( pODBCDriverName, L"Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)" ) == 0 ) {
+ bFound = true;
+ break;
+ }
+ }
+ if ( !bFound )
+ return; // can't find ODBC driver needed test, so skip test
+
+ const char* macroSource[] = {
+ "ole_ObjAssignNoDflt.vb",
+ "ole_ObjAssignToNothing.vb",
+ };
+
+ OUString sMacroPathURL = m_directories.getURLFromSrc("/basic/qa/vba_tests/");
+
+ uno::Sequence< uno::Any > aArgs(2);
+ // path to test document
+ OUString sPath = m_directories.getPathFromSrc("/basic/qa/vba_tests/data/ADODBdata.xls");
+ sPath = sPath.replaceAll( "/", "\\" );
+
+ aArgs[ 0 ] <<= sPath;
+ aArgs[ 1 ] <<= OUString(o3tl::toU(pODBCDriverName));
+
+ for ( sal_uInt32 i=0; i<SAL_N_ELEMENTS( macroSource ); ++i )
+ {
+ OUString sMacroURL = sMacroPathURL
+ + OUString::createFromAscii( macroSource[ i ] );
+ MacroSnippet myMacro;
+ myMacro.LoadSourceFromFile( sMacroURL );
+ SbxVariableRef pReturn = myMacro.Run( aArgs );
+ CPPUNIT_ASSERT_MESSAGE("No return variable huh?", pReturn.is());
+ fprintf(stderr, "macro result for %s\n", macroSource[i]);
+ fprintf(stderr, "macro returned:\n%s\n",
+ OUStringToOString(pReturn->GetOUString(), RTL_TEXTENCODING_UTF8).getStr());
+ CPPUNIT_ASSERT_EQUAL_MESSAGE("Result not as expected", OUString("OK"),
+ pReturn->GetOUString());
+ }
+#else
+ // Avoid "this method is empty and should be removed" warning
+ (void) 42;
+#endif
+}
+
+ // Put the test suite in the registry
+ CPPUNIT_TEST_SUITE_REGISTRATION(VBATest);
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/vba_tests/Err.Raise.vb b/basic/qa/vba_tests/Err.Raise.vb
new file mode 100644
index 000000000..fa04856cc
--- /dev/null
+++ b/basic/qa/vba_tests/Err.Raise.vb
@@ -0,0 +1,86 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest()
+ ''' This routine is QA/…/test_vba.cxx main entry point '''
+ passCount = 0 : failCount = 0
+ Const MIN_ERR = &hFFFFFFFF : Const MAX_ERR = 2^31-1
+
+ ''' Raise one-to-many User-Defined Errors as signed Int32 '''
+ result = "Test Results" & vbNewLine & "============" & vbNewLine
+ ' test_Description | Err # | Err_Source | Err_Description
+ Call TestErrRaise("MAXimum error value", MAX_ERR, "doUnitTest.vb", "Custom Error Maximum value")
+ Call TestErrRaise("Positive custom error", 1789, "" , "User-Defined Error Number")
+ Call TestErrRaise("Negative custom error", -1793, "doUnitTest.vb", "Negative User-Defined Error Number")
+ Call TestErrRaise("MINimum error value", MIN_ERR, "" , "Custom Error Minimum value")
+
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+ Else
+ doUnitTest = "OK"
+ End If
+End Function
+
+Sub TestErrRaise(TestName As String, CurErrNo As Long, CurErrSource As String, CurErrDescription As String)
+ result = result & vbNewLine & TestName
+ Dim origPassCount As Integer, origFailCount As Integer
+ origPassCount = passCount
+ origFailCount = failCount
+
+try: On Error Goto catch
+ Err.Raise(CurErrNo, CurErrSource, CurErrDescription, "", "")
+
+ 'result = result & vbNewLine & "Testing after error handler"
+ TestLog_ASSERT (passCount + failCount) > (origPassCount + origFailCount), TestName, "error handler did not execute!"
+ TestLog_ASSERT Erl = 0, TestName, "Erl = " & Erl
+ TestLog_ASSERT Err = 0, TestName, "Err = " & Err
+ TestLog_ASSERT Error = "", TestName, "Error = " & Error
+ TestLog_ASSERT Err.Description = "", "Err.Description reset", "Err.Description = "& Err.Description
+ TestLog_ASSERT Err.Number = 0, "Err.Number reset", "Err.Number = " & Err.Number
+ TestLog_ASSERT Err.Source = "", "Err.Source reset", "Err.Source = " & Err.Source
+ Exit Sub
+
+catch:
+ 'result = result & vbNewLine & "Testing in error handler"
+ TestLog_ASSERT Err.Number = CurErrNo, "Err.Number failure", "Err.Number = " & Err.Number
+ TestLog_ASSERT Err.Source = CurErrSource, "Err.Source failure", "Err.Source = " & Err.Source
+ TestLog_ASSERT Err.Description = CurErrDescription, "Err.Description failure", "Err.Description = " & Err.Description
+
+ TestLog_ASSERT Erl = 42, "line# failure", "Erl = " & Erl ' WATCH OUT for HARDCODED LINE # HERE !
+ TestLog_ASSERT Err = CurErrNo, "Err# failure", "Err = " & Err
+ TestLog_ASSERT Error = CurErrDescription, "Error description failure", "Error$ = " & Error$
+
+ Resume Next ' Err object properties reset from here …
+End Sub
+
+Sub DEV_TEST : doUnitTest : MsgBox result : End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + testId + ":"
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & vbNewLine & "Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/abs.vb b/basic/qa/vba_tests/abs.vb
new file mode 100644
index 000000000..bc9516fb6
--- /dev/null
+++ b/basic/qa/vba_tests/abs.vb
@@ -0,0 +1,70 @@
+Rem Attribute VBA_ModuleType=VBAModule
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testABS()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testABS() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Double
+
+ testName = "Test ABS function"
+ On Error GoTo errorHandler
+
+ nr2 = 5
+ nr1 = Abs(-5)
+ TestLog_ASSERT nr1 = nr2, "the return ABS is: " & nr1
+
+ nr2 = 5
+ nr1 = Abs(5)
+ TestLog_ASSERT nr1 = nr2, "the return ABS is: " & nr1
+
+ nr2 = 21.7
+ nr1 = Abs(-21.7)
+ TestLog_ASSERT nr1 = nr2, "the return ABS is: " & nr1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testABS = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/array.vb b/basic/qa/vba_tests/array.vb
new file mode 100644
index 000000000..63f39bed7
--- /dev/null
+++ b/basic/qa/vba_tests/array.vb
@@ -0,0 +1,97 @@
+Rem Attribute VBA_ModuleType=VBAModule
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+Type MyType
+ ax(3) As Integer
+ bx As Double
+End Type
+
+Function doUnitTest() As String
+result = verify_testARRAY()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testARRAY() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim a, b, C As Variant
+ a = Array(10, 20, 30)
+ testName = "Test ARRAY function"
+ On Error GoTo errorHandler
+
+ b = 10
+ C = a(0)
+ TestLog_ASSERT b = C, "the return ARRAY is: " & C
+
+ b = 20
+ C = a(1)
+ TestLog_ASSERT b = C, "the return ARRAY is: " & C
+
+ b = 30
+ C = a(2)
+ TestLog_ASSERT b = C, "the return ARRAY is: " & C
+
+ Dim MyWeek, MyDay
+ MyWeek = Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
+
+ b = "Tue"
+ MyDay = MyWeek(1) ' MyDay contains "Tue".
+ TestLog_ASSERT b = MyDay, "the return ARRAY is: " & MyDay
+
+ b = "Thu"
+ MyDay = MyWeek(3) ' MyDay contains "Thu".
+ TestLog_ASSERT b = MyDay, "the return ARRAY is: " & MyDay
+
+Dim mt As MyType
+ mt.ax(0) = 42
+ mt.ax(1) = 43
+ mt.bx = 3.14
+ b = 43
+ C = mt.ax(1)
+ TestLog_ASSERT b = C, "the return ARRAY is: " & C
+
+ b = 3.14
+ C = mt.bx
+ TestLog_ASSERT b = C, "the return ARRAY is: " & C
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testARRAY = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/asc.vb b/basic/qa/vba_tests/asc.vb
new file mode 100644
index 000000000..813abe9f8
--- /dev/null
+++ b/basic/qa/vba_tests/asc.vb
@@ -0,0 +1,71 @@
+Rem Attribute VBA_ModuleType=VBAModule
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testASC()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testASC() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Double
+
+ testName = "Test ASC function"
+ On Error GoTo errorHandler
+
+ nr2 = 65
+ nr1 = Asc("A")
+ TestLog_ASSERT nr1 = nr2, "the return ASC is: " & nr1
+
+ nr2 = 97
+ nr1 = Asc("a")
+ TestLog_ASSERT nr1 = nr2, "the return ASC is: " & nr1
+
+
+ nr2 = 65
+ nr1 = Asc("Apple")
+ TestLog_ASSERT nr1 = nr2, "the return ASC is: " & nr1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testASC = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/atn.vb b/basic/qa/vba_tests/atn.vb
new file mode 100644
index 000000000..145584ee6
--- /dev/null
+++ b/basic/qa/vba_tests/atn.vb
@@ -0,0 +1,77 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testATN()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testATN() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Double
+ testName = "Test ATN function"
+ On Error GoTo errorHandler
+
+ nr2 = 1.10714871779409
+ nr1 = Atn(2)
+ TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1
+
+ nr2 = 1.19166451926354
+ nr1 = Atn(2.51)
+ TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1
+
+ nr2 = -1.27229739520872
+ nr1 = Atn(-3.25)
+ TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1
+
+ nr2 = 1.56603445802574
+ nr1 = Atn(210)
+ TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1
+
+ nr2 = 0
+ nr1 = Atn(0)
+ TestLog_ASSERT nr1 = nr2, "the return ATN is: " & nr1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testATN = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
+
diff --git a/basic/qa/vba_tests/bytearraystring.vb b/basic/qa/vba_tests/bytearraystring.vb
new file mode 100644
index 000000000..c404b6e9a
--- /dev/null
+++ b/basic/qa/vba_tests/bytearraystring.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim displayMessage As Boolean
+Dim thisTest As String
+
+Function doUnitTest() As String
+Dim result As String
+result = verify_ByteArrayString()
+If failCount <> 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Sub Main()
+MsgBox verify_ByteArrayString()
+End Sub
+
+Function verify_ByteArrayString() As String
+ passCount = 0
+ failCount = 0
+ Dim result As String
+
+ Dim testName As String
+ Dim MyString As String
+ Dim x() As Byte
+ Dim count As Integer
+ testName = "Test the conversion between bytearray and string"
+
+
+ On Error GoTo errorHandler
+
+ MyString = "abc"
+ x = MyString ' string -> byte array
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ count = UBound(x) ' 6 byte
+
+ ' test bytes in string
+ result = result + updateResultString("test1 numbytes ", (count), 5)
+
+
+ MyString = x 'byte array -> string
+ result = result + updateResultString("test assign byte array to string", MyString, "abc")
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_ByteArrayString = result
+ Exit Function
+errorHandler:
+ failCount = failCount + 1
+ verify_ByteArrayString = "Error Handler hit"
+End Function
+
+Function updateResultString(testDesc As String, actual As String, expected As String) As String
+Dim result As String
+If actual <> expected Then
+ result = result & Chr$(10) & testDesc & " Failed: expected " & expected & " got " & actual
+ failCount = failCount + 1
+Else
+ passCount = passCount + 1
+End If
+updateResultString = result
+End Function
diff --git a/basic/qa/vba_tests/cbool.vb b/basic/qa/vba_tests/cbool.vb
new file mode 100644
index 000000000..cf3b8224d
--- /dev/null
+++ b/basic/qa/vba_tests/cbool.vb
@@ -0,0 +1,104 @@
+Option VBASupport 1
+Rem Option VBASupport 1 'unREM in .vb file
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCBool()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCBool() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim res2, res1 As Boolean
+ Dim a1, a2 As Integer
+ testName = "Test CBool function"
+ On Error GoTo errorHandler
+
+ res2 = True
+ res1 = CBool(1)
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = False
+ res1 = CBool(1 = 2)
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = False
+ res1 = CBool(0)
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = True
+ res1 = CBool(21)
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = True
+ res1 = CBool("true")
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = False
+ res1 = CBool("false")
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = True
+ res1 = CBool("1")
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = True
+ res1 = CBool("-1")
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = False
+ res1 = CBool("0")
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = False
+ a1 = 1: a2 = 10
+ res1 = CBool(a1 = a2)
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ res2 = True
+ a1 = 10: a2 = 10
+ res1 = CBool(a1 = a2)
+ TestLog_ASSERT res1 = res2, "the return CBool is: " & res1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCBool = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/cdate.vb b/basic/qa/vba_tests/cdate.vb
new file mode 100644
index 000000000..d04ecc004
--- /dev/null
+++ b/basic/qa/vba_tests/cdate.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCDate()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCDate() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2 As Date 'variables for test
+ testName = "Test CDate function"
+ On Error GoTo errorHandler
+
+ date2 = 25246
+ date1 = CDate("12/02/1969") '02/12/1969
+ TestLog_ASSERT date1 = date2, "the return CDate is: " & date1
+
+ date2 = 28313
+ date1 = CDate("07/07/1977")
+ TestLog_ASSERT date1 = date2, "the return CDate is: " & date1
+
+ date2 = 28313
+ date1 = CDate(#7/7/1977#)
+ TestLog_ASSERT date1 = date2, "the return CDate is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCDate = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/cdbl.vb b/basic/qa/vba_tests/cdbl.vb
new file mode 100644
index 000000000..bb51c6a00
--- /dev/null
+++ b/basic/qa/vba_tests/cdbl.vb
@@ -0,0 +1,73 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCdbl()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCdbl() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Double 'variables for test
+ testName = "Test Cdbl function"
+ On Error GoTo errorHandler
+
+ nr2 = 0
+ nr1 = CDbl(0)
+ TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1
+
+ nr2 = 10.1234567890123
+ nr1 = CDbl(10.1234567890123)
+ TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1
+
+ nr2 = 0.00005
+ nr1 = CDbl(0.005 * 0.01)
+ TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1
+
+ nr2 = 20
+ nr1 = CDbl("20")
+ TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCdbl = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/cdec.vb b/basic/qa/vba_tests/cdec.vb
new file mode 100644
index 000000000..af919a7cb
--- /dev/null
+++ b/basic/qa/vba_tests/cdec.vb
@@ -0,0 +1,86 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCDec()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testCDec() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim ret As Double
+ testName = "Test CDec function"
+ On Error GoTo errorHandler
+
+ ret = CDec("")
+ TestLog_ASSERT ret = 0, "Empty string test:" & ret
+
+ ret = CDec("1234")
+ TestLog_ASSERT ret = 1234, "Simple number:" & ret
+
+ ret = CDec(" 1234 ")
+ TestLog_ASSERT ret = 1234, "Simple number with whitespaces:" & ret
+
+ ret = CDec("-1234")
+ TestLog_ASSERT ret = -1234, "Simple negative number:" & ret
+
+ ret = CDec(" - 1234 ")
+ TestLog_ASSERT ret = -1234, "Simple negative number with whitespaces:" & ret
+
+ '''''''''''''''
+ ' Those are erroneous, see i#64348
+ ret = CDec("1234-")
+ TestLog_ASSERT ret = -1234, "Wrong negative number1:" & ret
+
+ ret = CDec(" 1234 -")
+ TestLog_ASSERT ret = -1234, "Wrong negative number2:" & ret
+
+ 'ret = CDec("79228162514264300000000000001")
+ 'TestLog_ASSERT ret = 79228162514264300000000000001, "Very long number1:" & ret
+ 'ret = ret+1
+ 'TestLog_ASSERT ret = 79228162514264300000000000002, "Very long number2:" & ret
+
+ ret = CDec("79228162514264400000000000000")
+ TestLog_ASSERT ret = 62406456049664, "Very long number3:" & ret
+
+ ret = CDec("79228162514264340000000000000") ' gives zero
+ TestLog_ASSERT ret = 0, "Very long number4:" & ret
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCDec = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/choose.vb b/basic/qa/vba_tests/choose.vb
new file mode 100644
index 000000000..3d30cfce1
--- /dev/null
+++ b/basic/qa/vba_tests/choose.vb
@@ -0,0 +1,80 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testChoose()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testChoose() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim var1, var2
+ testName = "Test Choose function"
+
+
+ On Error GoTo errorHandler
+
+ var2 = "Libre"
+ var1 = Choose(1, "Libre", "Office", "Suite")
+ TestLog_ASSERT var1 = var2, "the return Choose is: " & var1
+
+ var2 = "Office"
+ var1 = Choose(2, "Libre", "Office", "Suite")
+ TestLog_ASSERT var1 = var2, "the return Choose is: " & var1
+
+ var2 = "Suite"
+ var1 = Choose(3, "Libre", "Office", "Suite")
+ TestLog_ASSERT var1 = var2, "the return Choose is: " & var1
+
+
+ var1 = Choose(4, "Libre", "Office", "Suite")
+ TestLog_ASSERT IsNull(var1), "the return Choose is: Null4 "
+
+ var1 = Choose(0, "Libre", "Office", "Suite")
+ TestLog_ASSERT IsNull(var1), "the return Choose is: Null0 "
+
+ var1 = Choose(-1, "Libre", "Office", "Suite")
+ TestLog_ASSERT IsNull(var1), "the return Choose is: Null-1"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testChoose = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/chr.vb b/basic/qa/vba_tests/chr.vb
new file mode 100644
index 000000000..eb5aeb8df
--- /dev/null
+++ b/basic/qa/vba_tests/chr.vb
@@ -0,0 +1,69 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCHR()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCHR() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim str1, str2 As String
+ testName = "Test CHR function"
+ On Error GoTo errorHandler
+
+ str2 = "W"
+ str1 = Chr(87)
+ TestLog_ASSERT str1 = str2, "the return CHR is: " & str1
+
+ str2 = "i"
+ str1 = Chr(105)
+ TestLog_ASSERT str1 = str2, "the return CHR is: " & str1
+
+ str2 = "#"
+ str1 = Chr(35)
+ TestLog_ASSERT str1 = str2, "the return CHR is: " & str1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCHR = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
+
diff --git a/basic/qa/vba_tests/cint.vb b/basic/qa/vba_tests/cint.vb
new file mode 100644
index 000000000..6c1d53c93
--- /dev/null
+++ b/basic/qa/vba_tests/cint.vb
@@ -0,0 +1,103 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCInt()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCInt() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Integer 'variables for test
+ testName = "Test CInt function"
+
+
+ On Error GoTo errorHandler
+
+ nr2 = -1
+ nr1 = CInt(-1.1)
+ TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+ nr2 = -1
+ nr1 = CInt(-1.1)
+ TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+ nr2 = -2
+ nr1 = CInt(-1.9)
+ TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+ nr2 = 0
+ nr1 = CInt(0.2)
+ TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+REM In excel:
+REM If the fraction is less than or equal to .5, the result will round down.
+REM If the fraction is greater than .5, the result will round up.
+
+REM nr2 = 0
+REM nr1 = CInt(0.5)
+REM TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+REM nr2 = 2
+REM nr1 = CInt(1.5)
+REM TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+REM nr2 = 2
+REM nr1 = CInt(2.5)
+REM TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+ nr2 = 11
+ nr1 = CInt(10.51)
+ TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+ nr2 = 30207
+ nr1 = CInt("&H75FF")
+ TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+ nr2 = 1876
+ nr1 = CInt("&H754")
+ TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCInt = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
+
diff --git a/basic/qa/vba_tests/clng.vb b/basic/qa/vba_tests/clng.vb
new file mode 100644
index 000000000..768bafee1
--- /dev/null
+++ b/basic/qa/vba_tests/clng.vb
@@ -0,0 +1,95 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCLng()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCLng() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Long 'variables for test
+ testName = "Test CLng function"
+
+
+ On Error GoTo errorHandler
+
+ nr2 = -1
+ nr1 = CLng(-1.1)
+ TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+ nr2 = -1
+ nr1 = CLng(-1.1)
+ TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+ nr2 = -2
+ nr1 = CLng(-1.9)
+ TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+ nr2 = 0
+ nr1 = CLng(0.2)
+ TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+REM nr2 = 0
+REM nr1 = CLng(0.5)
+REM TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+REM If the fraction is less than or equal to .5, the result will round down.
+REM If the fraction is greater than .5, the result will round up.
+
+ nr2 = 11
+ nr1 = CLng(10.51)
+ TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+ nr2 = 30207
+ nr1 = CLng("&H75FF")
+ TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+ nr2 = 1876
+ nr1 = CLng("&H754")
+ TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCLng = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
+
+
diff --git a/basic/qa/vba_tests/constants.vb b/basic/qa/vba_tests/constants.vb
new file mode 100644
index 000000000..e879ce5ab
--- /dev/null
+++ b/basic/qa/vba_tests/constants.vb
@@ -0,0 +1,57 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testConstants()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testConstants() As String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ testName = "Test Constants"
+ On Error GoTo errorHandler
+
+ If GetGuiType() = 1 Then
+ TestLog_ASSERT vbNewline = vbCrLf, "vbNewLine is the same as vbCrLf on Windows"
+ Else
+ TestLog_ASSERT vbNewLine = vbLf, "vbNewLine is the same as vbLf on others than Windows"
+ End If
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testConstants = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/cos.vb b/basic/qa/vba_tests/cos.vb
new file mode 100644
index 000000000..993794b70
--- /dev/null
+++ b/basic/qa/vba_tests/cos.vb
@@ -0,0 +1,71 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCOS()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCOS() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Double 'variables for test
+ testName = "Test COS function"
+
+
+ On Error GoTo errorHandler
+
+ nr2 = -0.532833020333398
+ nr1 = Cos(23)
+ TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return COS is: " & nr1
+
+ nr2 = 0.980066577841242
+ nr1 = Cos(0.2)
+ TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return COS is: " & nr1
+
+ nr2 = 0.487187675007006
+ nr1 = Cos(200)
+ TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return COS is: " & nr1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCOS = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/csng.vb b/basic/qa/vba_tests/csng.vb
new file mode 100644
index 000000000..476cc6a6f
--- /dev/null
+++ b/basic/qa/vba_tests/csng.vb
@@ -0,0 +1,71 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCSng()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCSng() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim nr1, nr2 As Single 'variables for test
+ Dim nr3 As Double
+
+ testName = "Test CSng function"
+ On Error GoTo errorHandler
+
+ nr2 = 8.534535408
+ nr1 = CSng(8.534535408)
+ TestLog_ASSERT nr1 = nr2, "the return CSng is: " & nr1
+
+ nr3 = 100.1234
+ nr2 = 100.1234
+ nr1 = CSng(nr3)
+ TestLog_ASSERT nr1 = nr2, "the return CSng is: " & nr1
+
+ nr2 = 0
+ nr1 = CSng(0)
+ TestLog_ASSERT nr1 = nr2, "the return CSng is: " & nr1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCSng = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/cstr.vb b/basic/qa/vba_tests/cstr.vb
new file mode 100644
index 000000000..62258962a
--- /dev/null
+++ b/basic/qa/vba_tests/cstr.vb
@@ -0,0 +1,66 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCStr()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCStr() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim str2, str3
+ Dim str1 As String 'variables for test
+ testName = "Test CStr function"
+ On Error GoTo errorHandler
+
+ str3 = 437.324
+ str2 = "437.324"
+ str1 = CStr(str3)
+ TestLog_ASSERT str1 = str2, "the return CStr is: " & str1
+
+ str2 = "500"
+ str1 = CStr(500)
+ TestLog_ASSERT str1 = str2, "the return CStr is: " & str1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCStr = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/cvdate.vb b/basic/qa/vba_tests/cvdate.vb
new file mode 100644
index 000000000..58ef6ca7d
--- /dev/null
+++ b/basic/qa/vba_tests/cvdate.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCVDate()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCVDate() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2 As Date 'variables for test
+ testName = "Test CVDate function"
+ On Error GoTo errorHandler
+
+ date2 = 25246
+ date1 = CVDate("12.2.1969") '2/12/1969
+ TestLog_ASSERT date1 = date2, "the return CVDate is: " & date1
+
+ date2 = 28313
+ date1 = CVDate("07/07/1977")
+ TestLog_ASSERT date1 = date2, "the return CVDate is: " & date1
+
+ date2 = 28313
+ date1 = CVDate(#7/7/1977#)
+ TestLog_ASSERT date1 = date2, "the return CVDate is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCVDate = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/cverr.vb b/basic/qa/vba_tests/cverr.vb
new file mode 100644
index 000000000..4aa646ae8
--- /dev/null
+++ b/basic/qa/vba_tests/cverr.vb
@@ -0,0 +1,99 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testCVErr()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testCVErr() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test CVErr function"
+ On Error GoTo errorHandler
+
+ date2 = "Error 3001"
+ date1 = CStr(CVErr(3001))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ date2 = "Error 2007"
+ date1 = CStr(CVErr(xlErrDiv0))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ date2 = "Error 2042"
+ date1 = CStr(CVErr(xlErrNA))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ date2 = "Error 2029"
+ date1 = CStr(CVErr(xlErrName))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ date2 = "Error 2000"
+ date1 = CStr(CVErr(xlErrNull))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ date2 = "Error 2036"
+ date1 = CStr(CVErr(xlErrNum))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ date2 = "Error 2023"
+ date1 = CStr(CVErr(xlErrRef))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ date2 = "Error 2015"
+ date1 = CStr(CVErr(xlErrValue))
+ TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1
+
+ ' tdf#79426 - passing an error object to a function
+ TestLog_ASSERT TestCVErr( CVErr( 2 ) ) = 2
+ ' tdf#79426 - test with Error-Code 448 ( ERRCODE_BASIC_NAMED_NOT_FOUND )
+ TestLog_ASSERT TestCVErr( CVErr( 448 ) ) = 448
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testCVErr = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Function TestCVErr(vErr As Variant)
+ Dim nValue As Integer
+ nValue = vErr
+ TestCVErr = nValue
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/data/ADODBdata.xls b/basic/qa/vba_tests/data/ADODBdata.xls
new file mode 100644
index 000000000..655b38a90
--- /dev/null
+++ b/basic/qa/vba_tests/data/ADODBdata.xls
Binary files differ
diff --git a/basic/qa/vba_tests/dateadd.vb b/basic/qa/vba_tests/dateadd.vb
new file mode 100644
index 000000000..84135f34c
--- /dev/null
+++ b/basic/qa/vba_tests/dateadd.vb
@@ -0,0 +1,114 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testDateAdd()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testDateAdd() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2 As Date 'variables for test
+ testName = "Test DateAdd function"
+ On Error GoTo errorHandler
+
+ date2 = CDate("1995-02-28")
+ date1 = DateAdd("m", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-02-28")
+ date1 = DateAdd("m", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-02-28")
+ date1 = DateAdd("m", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1996-01-31")
+ date1 = DateAdd("yyyy", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-04-30")
+ date1 = DateAdd("q", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-02-01")
+ date1 = DateAdd("y", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-02-01")
+ date1 = DateAdd("d", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-02-01")
+ date1 = DateAdd("w", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-02-07")
+ date1 = DateAdd("ww", 1, "1995-01-31")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+Rem This fails when directly comparing date1=date2, probably due to rounding.
+Rem Workaround convert to string which does the rounding.
+ Dim date1s, date2s As String
+ date2 = CDate("1995-01-01 22:48:29")
+ date1 = DateAdd("h", 1, "1995-01-01 21:48:29")
+ date1s = "" & date1
+ date2s = "" & date2
+ TestLog_ASSERT date1s = date2s, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-01-31 21:49:29")
+ date1 = DateAdd("n", 1, "1995-01-31 21:48:29")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+ date2 = CDate("1995-01-31 21:48:30")
+ date1 = DateAdd("s", 1, "1995-01-31 21:48:29")
+ TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1
+
+exitFunc:
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testDateAdd = result
+
+ Exit Function
+
+errorHandler:
+ On Error GoTo 0
+ TestLog_ASSERT (False), testName & ": hit error handler"
+ GoTo exitFunc
+
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/datediff.vb b/basic/qa/vba_tests/datediff.vb
new file mode 100644
index 000000000..1b5e7ebf4
--- /dev/null
+++ b/basic/qa/vba_tests/datediff.vb
@@ -0,0 +1,137 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testDateDiff()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testDateDiff() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1
+ Dim date2
+ testName = "Test DateDiff function"
+ On Error GoTo errorHandler
+
+ date2 = 10
+ date1 = DateDiff("yyyy", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 40
+ date1 = DateDiff("q", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 120
+ date1 = DateDiff("m", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("y", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 521
+ date1 = DateDiff("w", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 522
+ date1 = DateDiff("ww", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 87672
+ date1 = DateDiff("h", "22/11/2003", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 525600
+ date1 = DateDiff("n", "22/11/2012", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 2678400
+ date1 = DateDiff("s", "22/10/2013", "22/11/2013")
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbFriday)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbMonday)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3623
+ date1 = DateDiff("d", "22/12/2003", "22/11/2013", vbSaturday)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3684
+ date1 = DateDiff("d", "22/10/2003", "22/11/2013", vbSunday)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbThursday)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbTuesday)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbFriday, vbFirstJan1)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbThursday, vbFirstFourDays)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbSunday, vbFirstFullWeek)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ date2 = 3653
+ date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbSaturday, vbFirstFullWeek)
+ TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testDateDiff = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/datepart.vb b/basic/qa/vba_tests/datepart.vb
new file mode 100644
index 000000000..5b9ab2b7f
--- /dev/null
+++ b/basic/qa/vba_tests/datepart.vb
@@ -0,0 +1,94 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testDatePart()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testDatePart() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1 'variables for test
+ Dim date2
+ testName = "Test DatePart function"
+ On Error GoTo errorHandler
+
+ date2 = 1969
+ date1 = DatePart("yyyy", "1969-02-12")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 1
+ date1 = DatePart("q", "1969-02-12")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 43
+ date1 = DatePart("y", "1969-02-12")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 12
+ date1 = DatePart("d", "1969-02-12")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 4
+ date1 = DatePart("w", "1969-02-12")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 7
+ date1 = DatePart("ww", "1969-02-12")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 16
+ date1 = DatePart("h", "1969-02-12 16:32:00")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 32
+ date1 = DatePart("n", "1969-02-12 16:32:00")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+ date2 = 0
+ date1 = DatePart("s", "1969-02-12 16:32:00")
+ TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testDatePart = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/dateserial.vb b/basic/qa/vba_tests/dateserial.vb
new file mode 100644
index 000000000..4b28f09d5
--- /dev/null
+++ b/basic/qa/vba_tests/dateserial.vb
@@ -0,0 +1,63 @@
+Option VBASupport 1
+Option Explicit
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testDateSerial()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testDateSerial() as String
+ Dim testName As String
+ Dim date1, date2 As Date
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ testName = "Test DateSerial function"
+ date2 = 36326
+
+ On Error GoTo errorHandler
+
+ date1 = DateSerial(1999, 6, 15) '6/15/1999
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ date1 = DateSerial(2000, 1 - 7, 15) '6/15/1999
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ date1 = DateSerial(1999, 1, 166) '6/15/1999
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+
+ verify_testDateSerial = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/datevalue.vb b/basic/qa/vba_tests/datevalue.vb
new file mode 100644
index 000000000..6ece72a6d
--- /dev/null
+++ b/basic/qa/vba_tests/datevalue.vb
@@ -0,0 +1,63 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testDateValue()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testDateValue() as String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2 As Date
+ testName = "Test DateValue function"
+ date2 = 25246
+
+ On Error GoTo errorHandler
+
+ date1 = DateValue("February 12, 1969") '2/12/1969
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+
+ date2 = 39468
+ date1 = DateValue("21/01/2008") '1/21/2008
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testDateValue = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/day.vb b/basic/qa/vba_tests/day.vb
new file mode 100644
index 000000000..e33a7b846
--- /dev/null
+++ b/basic/qa/vba_tests/day.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testday()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testday() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2 'variables for test
+ testName = "Test day function"
+ On Error GoTo errorHandler
+
+ date2 = 12
+ date1 = Day("1969-02-12") '2/12/1969
+ TestLog_ASSERT date1 = date2, "the return day is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testday = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/enum.vb b/basic/qa/vba_tests/enum.vb
new file mode 100644
index 000000000..52dc95a7c
--- /dev/null
+++ b/basic/qa/vba_tests/enum.vb
@@ -0,0 +1,87 @@
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Enum CountDown ' Values get ROUNDED to Int32
+ FIVE = 4.11
+ FOUR = -4.25
+ THREE = 5
+ TWO = -.315E1
+ ONE = 286.0E-2 ' equals 3
+ LIFT_OFF = 7
+End Enum ' CountDown
+
+Function doUnitTest()
+ ''' test_vba.cxx main entry point '''
+ Call ENUM_TestCases
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+ Else
+ doUnitTest = "OK"
+ End If
+End Function
+
+
+Sub ENUM_TestCases()
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & vbNewLine & "============" & vbNewLine
+
+try:
+ On Error Goto catch
+
+ With CountDown
+
+a: TestLog_ASSERT .ONE = 3, "case a", "CountDown.ONE equals " & Str(.ONE)
+
+b: TestLog_ASSERT .TWO = -3, "case b", "CountDown.TWO equals " & Str(.TWO)
+
+c: TestLog_ASSERT TypeName(.FOUR) = "Long", "case c", "CountDown.FOUR type is: " & TypeName(.FOUR)
+
+d: Dim sum As Double
+ sum = .FIVE + .FOUR + .THREE + .TWO + .ONE + .LIFT_OFF
+ TestLog_Assert sum = 12, "case d", "SUM of CountDown values is: " & Str(sum)
+
+ End With ' CountDown
+
+finally:
+ result = result & vbNewLine & "Tests passed: " & passCount & vbNewLine & "Tests failed: " & failCount & vbNewLine
+ Exit Sub
+
+catch:
+ TestLog_ASSERT (False), "ERROR", "#"& Str(Err.Number) &" in 'ENUM_TestCases' at line"& Str(Erl) &" - "& Error$
+ Resume Next
+End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + testId + ":"
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & vbNewLine & "Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
+'Sub DEV_TEST : doUnitTest : MsgBox result : End Sub
diff --git a/basic/qa/vba_tests/error.vb b/basic/qa/vba_tests/error.vb
new file mode 100644
index 000000000..e36661253
--- /dev/null
+++ b/basic/qa/vba_tests/error.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testError()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testError() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Error function"
+ On Error GoTo errorHandler
+
+ date2 = Error(11) 'https://help.libreoffice.org/Basic/Error_Function_Runtime
+ date1 = "Division by zero."
+ TestLog_ASSERT date1 = date2, "the return Error is: " & date2
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testError = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/exp.vb b/basic/qa/vba_tests/exp.vb
new file mode 100644
index 000000000..669f0d6b0
--- /dev/null
+++ b/basic/qa/vba_tests/exp.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testExp()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testExp() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Exp function"
+ On Error GoTo errorHandler
+
+ date2 = 2.7183
+ date1 = Exp(1)
+ TestLog_ASSERT Round(date1, 4) = Round(date2, 4), "the return Exp is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testExp = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/fix.vb b/basic/qa/vba_tests/fix.vb
new file mode 100644
index 000000000..95235f335
--- /dev/null
+++ b/basic/qa/vba_tests/fix.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testFix()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testFix() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Fix function"
+ On Error GoTo errorHandler
+
+ date2 = 12
+ date1 = Fix(12.34)
+ TestLog_ASSERT date1 = date2, "the return Fix is: " & date1
+
+ date2 = 12
+ date1 = Fix(12.99)
+ TestLog_ASSERT date1 = date2, "the return Fix is: " & date1
+
+ date2 = -8
+ date1 = Fix(-8.4)
+ TestLog_ASSERT date1 = date2, "the return Fix is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testFix = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/format.vb b/basic/qa/vba_tests/format.vb
new file mode 100644
index 000000000..6d3fcba8e
--- /dev/null
+++ b/basic/qa/vba_tests/format.vb
@@ -0,0 +1,450 @@
+Option VBASupport 1
+Option Explicit
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_format()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_format() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ 'Predefined_Datetime_Format_Sample
+ Predefined_Number_Format_Sample
+ 'Custom_Datetime_Format_Sample
+ Custom_Number_Format_Sample
+ Custom_Text_Format_Sample
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_format = result
+
+End Sub
+
+
+Sub Predefined_Datetime_Format_Sample()
+ Dim testName As String
+ Dim myDate, MyTime, TestStr As String
+ myDate = "01/06/98"
+ MyTime = "17:08:06"
+ testName = "Test Predefined_Datetime_Format_Sample function"
+
+ On Error GoTo errorHandler
+
+ ' The date/time format have a little different between ms office and OOo due to different locale and system...
+ TestStr = Format(myDate, "General Date") ' 1/6/98
+
+ TestLog_ASSERT IsDate(TestStr), "General Date: " & TestStr & " (Test only applies to en_US locale)"
+ 'TestLog_ASSERT TestStr = "1/6/98", "General Date: " & TestStr
+
+ TestStr = Format(myDate, "Long Date") ' Tuesday, January 06, 1998
+ TestLog_ASSERT TestStr = "Tuesday, January 06, 1998", "Long Date: " & TestStr & " (Test only applies to en_US locale)"
+ 'TestLog_ASSERT IsDate(TestStr), "Long Date: " & TestStr
+
+ TestStr = Format(myDate, "Medium Date") ' 06-Jan-98
+ 'TestLog_ASSERT TestStr = "06-Jan-98", "Medium Date: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Medium Date: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(myDate, "Short Date") ' 1/6/98
+ 'TestLog_ASSERT TestStr = "1/6/98", "Short Date: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Short Date: " & TestStr & " (Test only applies to en_US locale)"
+
+ TestStr = Format(MyTime, "Long Time") ' 5:08:06 PM
+ 'TestLog_ASSERT TestStr = "5:08:06 PM", "Long Time: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Long Time: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(MyTime, "Medium Time") ' 05:08 PM
+ 'TestLog_ASSERT TestStr = "05:08 PM", "Medium Time: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Medium Time: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(MyTime, "Short Time") ' 17:08
+ 'TestLog_ASSERT TestStr = "17:08", "Short Time: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Short Time: " & TestStr & " (Test only applies to en_US locale)"
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub Predefined_Number_Format_Sample()
+ Dim myNumber, TestStr As String
+ Dim testName As String
+ testName = "Test Predefined_Number_Format_Sample function"
+ myNumber = 562486.2356
+
+ On Error GoTo errorHandler
+
+ TestStr = Format(myNumber, "General Number") '562486.2356
+ TestLog_ASSERT TestStr = "562486.2356", "General Number: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.2, "Fixed") '0.20
+ TestLog_ASSERT TestStr = "0.20", "Fixed: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(myNumber, "Standard") '562,486.24
+ TestLog_ASSERT TestStr = "562,486.24", "Standard: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.7521, "Percent") '75.21%
+ TestLog_ASSERT TestStr = "75.21%", "Percent: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(myNumber, "Scientific") '5.62E+05
+ TestLog_ASSERT TestStr = "5.62E+05", "Scientific: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(-3456.789, "Scientific") '-3.46E+03
+ TestLog_ASSERT TestStr = "-3.46E+03", "Scientific: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0, "Yes/No") 'No
+ TestLog_ASSERT TestStr = "No", "Yes/No: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23, "Yes/No") 'Yes
+ TestLog_ASSERT TestStr = "Yes", "Yes/No: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0, "True/False") 'False
+ TestLog_ASSERT TestStr = "False", "True/False: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23, "True/False") 'True
+ TestLog_ASSERT TestStr = "True", "True/False: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0, "On/Off") 'Off
+ TestLog_ASSERT TestStr = "Off", "On/Off: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23, "On/Off") 'On
+ TestLog_ASSERT TestStr = "On", "On/Off: " & TestStr
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+
+End Sub
+
+Sub Custom_Datetime_Format_Sample()
+ Dim myDate, MyTime, TestStr As String
+ Dim testName As String
+
+ myDate = "01/06/98"
+ MyTime = "05:08:06"
+
+ testName = "Test Custom_Datetime_Format_Sample function"
+ On Error GoTo errorHandler
+
+ TestStr = Format("01/06/98 17:08:06", "c") ' 1/6/98 5:08:06 PM
+ TestLog_ASSERT TestStr = "1/6/98 5:08:06 PM", "c: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "dddddd") ' (Long Date), Tuesday, January 06, 1998
+ TestLog_ASSERT TestStr = "Tuesday, January 06, 1998", "dddddd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mm-dd-yyyy") ' 01-06-19s98
+ TestLog_ASSERT TestStr = "01-06-1998", "mm-dd-yyyy: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "d") ' 6
+ TestLog_ASSERT TestStr = "6", "d: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "dd") ' 06
+ TestLog_ASSERT TestStr = "06", "dd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "ddd") ' Tue
+ TestLog_ASSERT TestStr = "Tue", "ddd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "dddd") ' Tuesday
+ TestLog_ASSERT TestStr = "Tuesday", "dddd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "h") ' 5
+ TestLog_ASSERT TestStr = "5", "h: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "hh") ' 05
+ TestLog_ASSERT TestStr = "05", "hh: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "n") ' 8
+ TestLog_ASSERT TestStr = "8", "n: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "nn") ' 08
+ TestLog_ASSERT TestStr = "08", "nn: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "m") ' 1
+ TestLog_ASSERT TestStr = "1", "m: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mm") ' 01
+ TestLog_ASSERT TestStr = "01", "mm: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mmm") ' Jan
+ TestLog_ASSERT TestStr = "Jan", "mmm: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mmmm") ' January
+ TestLog_ASSERT TestStr = "January", "mmmm: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "s") ' 6
+ TestLog_ASSERT TestStr = "6", "s: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "ss") ' 06
+ TestLog_ASSERT TestStr = "06", "ss: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+
+ MyTime = "17:08:06"
+
+ TestStr = Format(MyTime, "hh:mm:ss AM/PM") ' 05:08:06 PM
+ TestLog_ASSERT TestStr = "05:08:06 PM", "hh:mm:ss AM/PM: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(MyTime, "hh:mm:ss") ' 17:08:06
+ TestLog_ASSERT TestStr = "17:08:06", "hh:mm:ss: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "ww") ' 2
+ TestLog_ASSERT TestStr = "2", "ww: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "w") ' 3
+ TestLog_ASSERT TestStr = "3", "w: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "y") ' 6
+ TestLog_ASSERT TestStr = "6", "y: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "yy") ' 98
+ TestLog_ASSERT TestStr = "98", "yy: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "yyyy") ' 1998
+ TestLog_ASSERT TestStr = "1998", "yyyy: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub Custom_Number_Format_Sample()
+ Dim TestStr As String
+ Dim testName As String
+
+ testName = "Test Custom_Number_Format_Sample function"
+ On Error GoTo errorHandler
+
+ TestStr = Format(23.675, "00.0000") ' 23.6750
+ TestLog_ASSERT TestStr = "23.6750", "00.0000: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23.675, "00.00") ' 23.68
+ TestLog_ASSERT TestStr = "23.68", "00.00: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(2658, "00000") ' 02658
+ TestLog_ASSERT TestStr = "02658", "00000: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(2658, "00.00") ' 2658.00
+ TestLog_ASSERT TestStr = "2658.00", "00.00: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23.675, "##.####") ' 23.675
+ TestLog_ASSERT TestStr = "23.675", "##.####: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23.675, "##.##") ' 23.68
+ TestLog_ASSERT TestStr = "23.68", "##.##: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(12345.25, "#,###.##") '12,345.25
+ TestLog_ASSERT TestStr = "12,345.25", "#,###.##: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.25, "##.00%") '25.00%
+ TestLog_ASSERT TestStr = "25.00%", "##.00%: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1000000, "#,###") '1,000,000
+ TestLog_ASSERT TestStr = "1,000,000", "#,###: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1.09837555, "#.#####E+###") '1.09838E+000
+ TestLog_ASSERT TestStr = "1.09838E+000", "#.#####E+###: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1.09837555, "###.####E#") '1.0984E0 with engineering notation
+ TestLog_ASSERT TestStr = "1.0984E0", "###.####E#: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1098.37555, "###.####E#") '1.0984E3 with engineering notation
+ TestLog_ASSERT TestStr = "1.0984E3", "###.####E#: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1098375.55, "###.####E#") '1.0984E6 with engineering notation
+ TestLog_ASSERT TestStr = "1.0984E6", "###.####E#: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1.09837555, "######E#") '1E0 with engineering notation
+ TestLog_ASSERT TestStr = "1E0", "######E#: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(123456.789, "###E0") '123E3 with engineering notation
+ TestLog_ASSERT TestStr = "123E3", "###E0: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(123567.89, "###E0") '124E3 with engineering notation
+ TestLog_ASSERT TestStr = "124E3", "###E0: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(12, "###E0") '12E0 with engineering notation
+ TestLog_ASSERT TestStr = "12E0", "###E0: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(12, "000E0") '012E0 with engineering notation
+ TestLog_ASSERT TestStr = "012E0", "000E0: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.12345, "###E0") '123E-3 with engineering notation
+ TestLog_ASSERT TestStr = "123E-3", "###E0: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(123456, "####E0") '12E4 with interval-4 notation
+ TestLog_ASSERT TestStr = "12E4", "####E0: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(2345.25, "$#,###.##") '$2.345.25
+ TestLog_ASSERT TestStr = "$2,345.25", "$#,###.##: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.25, "##.###\%") '.25%
+ TestLog_ASSERT TestStr = ".25%", "##.###\%: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(12.25, "0.???") '12.25_
+ TestLog_ASSERT TestStr = "12.25 ", "0.???: " & TestStr
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub Custom_Text_Format_Sample()
+ Dim myText, TestStr As String
+ myText = "VBA"
+
+ Dim testName As String
+
+ testName = "Test Custom_Text_Format_Sample function"
+ On Error GoTo errorHandler
+
+ TestStr = Format(myText, "<") 'vba
+ TestLog_ASSERT TestStr = "vba", "<: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format("vba", ">") 'VBA
+ TestLog_ASSERT TestStr = "VBA", ">: " & TestStr
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & "hit error handler"
+End Sub
+
+
+
+Sub testFormat()
+ Dim testName As String
+ Dim TestDateTime As Date
+ Dim TestStr As String
+ testName = "Test Format function"
+
+ On Error GoTo errorHandler
+
+ TestDateTime = "1/27/2001 5:04:23 PM"
+
+ ' Returns the value of TestDateTime in user-defined date/time formats.
+ ' Returns "17:4:23".
+ TestStr = Format(TestDateTime, "h:m:s")
+ TestLog_ASSERT TestStr = "17:4:23", "the format of h:m:s: " & TestStr
+
+ ' Returns "05:04:23 PM".
+ TestStr = Format(TestDateTime, "ttttt")
+ TestLog_ASSERT TestStr = "5:04:23 PM", "the format of ttttt: " & TestStr
+
+ ' Returns "Saturday, Jan 27 2001".
+ TestStr = Format(TestDateTime, "dddd, MMM d yyyy")
+ TestLog_ASSERT TestStr = "Saturday, Jan 27 2001", "the format of dddd, MMM d yyyy: " & TestStr
+
+ ' Returns "17:04:23".
+ TestStr = Format(TestDateTime, "HH:mm:ss")
+ TestLog_ASSERT TestStr = "17:04:23", "the format of HH:mm:ss: " & TestStr
+
+ ' Returns "23".
+ TestStr = Format(23)
+ TestLog_ASSERT TestStr = "23", "no format:" & TestStr
+
+ ' User-defined numeric formats.
+ ' Returns "5,459.40".
+ TestStr = Format(5459.4, "##,##0.00")
+ TestLog_ASSERT TestStr = "5,459.40", "the format of ##,##0.00: " & TestStr
+
+ ' Returns "334.90".
+ TestStr = Format(334.9, "###0.00")
+ TestLog_ASSERT TestStr = "334.90", "the format of ###0.00: " & TestStr
+
+ ' Returns "500.00%".
+ TestStr = Format(5, "0.00%")
+ TestLog_ASSERT TestStr = "500.00%", "the format of 0.00%: " & TestStr
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/formatnumber.vb b/basic/qa/vba_tests/formatnumber.vb
new file mode 100644
index 000000000..357fd1942
--- /dev/null
+++ b/basic/qa/vba_tests/formatnumber.vb
@@ -0,0 +1,83 @@
+Option VBASupport 1
+Option Explicit
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testFormatNumber()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testFormatNumber() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim str1 As String, str2 As String
+ On Error GoTo errorHandler
+
+ testName = "Test 1: positive, 2 decimals"
+ str2 = "12.20"
+ str1 = FormatNumber("12.2", 2, vbFalse, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 2: negative, 20 decimals, use leading zero"
+ str2 = "-0.20000000000000000000"
+ str1 = FormatNumber("-.2", 20, vbTrue, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 3: negative, 20 decimals, no leading zero"
+ str2 = "-.20000000000000000000"
+ str1 = FormatNumber("-0.2", 20, vbFalse, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 4: negative, no leading zero, use parens"
+ str2 = "(.20)"
+ str1 = FormatNumber("-0.2", -1, vbFalse, vbTrue, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 5: negative, default leading zero, use parens"
+ str2 = "(0.20)"
+ str1 = FormatNumber("-0.2", -1, vbUseDefault, vbTrue, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 6: group digits"
+ str2 = "-12,345,678.00"
+ str1 = FormatNumber("-12345678", -1, vbUseDefault, vbUseDefault, vbTrue)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testFormatNumber = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testId & " "
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + "(" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/hex.vb b/basic/qa/vba_tests/hex.vb
new file mode 100644
index 000000000..83af4c148
--- /dev/null
+++ b/basic/qa/vba_tests/hex.vb
@@ -0,0 +1,85 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testHex()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testHex() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Hex function"
+ On Error GoTo errorHandler
+
+ date2 = "9"
+ date1 = Hex(9)
+ TestLog_ASSERT date1 = date2, "the return Hex is: " & date1
+
+ date2 = "9"
+ date1 = Hex(9)
+ TestLog_ASSERT date1 = date2, "the return Hex is: " & date1
+
+ date2 = "A"
+ date1 = Hex(10)
+ TestLog_ASSERT date1 = date2, "the return Hex is: " & date1
+
+ date2 = "10"
+ date1 = Hex(16)
+ TestLog_ASSERT date1 = date2, "the return Hex is: " & date1
+
+ date2 = "FF"
+ date1 = Hex(255)
+ TestLog_ASSERT date1 = date2, "the return Hex is: " & date1
+
+ date2 = "100"
+ date1 = Hex(256)
+ TestLog_ASSERT date1 = date2, "the return Hex is: " & date1
+
+ date2 = "1CB"
+ date1 = Hex(459)
+ TestLog_ASSERT date1 = date2, "the return Hex is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testHex = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/hour.vb b/basic/qa/vba_tests/hour.vb
new file mode 100644
index 000000000..9236463f4
--- /dev/null
+++ b/basic/qa/vba_tests/hour.vb
@@ -0,0 +1,71 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testHour()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testHour() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2, myTime
+ testName = "Test Hour function"
+ On Error GoTo errorHandler
+
+ myTime = "6:25:39 AM"
+ date2 = 6
+ date1 = Hour(myTime)
+ TestLog_ASSERT date1 = date2, "the return Hour is: " & date1
+
+ myTime = "6:25:39 PM"
+ date2 = 18
+ date1 = Hour(myTime)
+ TestLog_ASSERT date1 = date2, "the return Hour is: " & date1
+
+ myTime = "06:25:39 AM"
+ date2 = 6
+ date1 = Hour(myTime)
+ TestLog_ASSERT date1 = date2, "the return Hour is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testHour = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/iif.vb b/basic/qa/vba_tests/iif.vb
new file mode 100644
index 000000000..fd77563e5
--- /dev/null
+++ b/basic/qa/vba_tests/iif.vb
@@ -0,0 +1,69 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIIf()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIIf() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2, testnr
+ testName = "Test IIf function"
+ On Error GoTo errorHandler
+
+ date2 = "it is true"
+ date1 = IIf(True, "it is true", "it is false")
+ TestLog_ASSERT date1 = date2, "the return IIf is: " & date1
+
+ date2 = "it is false"
+ date1 = IIf(False, "It is true", "it is false")
+ TestLog_ASSERT date1 = date2, "the return IIf is: " & date1
+
+ testnr = 1001
+ date2 = "Large"
+ date1 = IIf(testnr > 1000, "Large", "Small")
+ TestLog_ASSERT date1 = date2, "the return IIf is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIIf = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/instr.vb b/basic/qa/vba_tests/instr.vb
new file mode 100644
index 000000000..b8977088b
--- /dev/null
+++ b/basic/qa/vba_tests/instr.vb
@@ -0,0 +1,86 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testInStr()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testInStr() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2, SearchString, SearchChar
+ testName = "Test InStr function"
+ On Error GoTo errorHandler
+
+ date2 = 5
+ date1 = InStr(1, "somemoretext", "more")
+ TestLog_ASSERT date1 = date2, "the return InStr is: " & date1
+
+ date2 = 5
+ date1 = InStr("somemoretext", "more")
+ TestLog_ASSERT date1 = date2, "the return InStr is: " & date1
+
+ date2 = 1
+ date1 = InStr("somemoretext", "somemoretext")
+ TestLog_ASSERT date1 = date2, "the return InStr is: " & date1
+
+ date2 = 0
+ date1 = InStr("somemoretext", "nothing")
+ TestLog_ASSERT date1 = date2, "the return InStr is: " & date1
+
+ SearchString = "XXpXXpXXPXXP" ' String to search in.
+ SearchChar = "P" ' Search for "P".
+ date2 = 6
+ date1 = InStr(4, SearchString, SearchChar, 1)
+ TestLog_ASSERT date1 = date2, "the return InStr is: " & date1
+
+ date2 = 9
+ date1 = InStr(1, SearchString, SearchChar, 0)
+ TestLog_ASSERT date1 = date2, "the return InStr is: " & date1
+
+ date2 = 0
+ date1 = InStr(1, SearchString, "W")
+ TestLog_ASSERT date1 = date2, "the return InStr is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testInStr = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/instrrev.vb b/basic/qa/vba_tests/instrrev.vb
new file mode 100644
index 000000000..7fe02cd60
--- /dev/null
+++ b/basic/qa/vba_tests/instrrev.vb
@@ -0,0 +1,86 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testInStrRev()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testInStrRev() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2, SearchString, SearchChar
+ testName = "Test InStrRev function"
+ On Error GoTo errorHandler
+
+ date2 = 5
+ date1 = InStrRev("somemoretext", "more", -1)
+ TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1
+
+ date2 = 5
+ date1 = InStrRev("somemoretext", "more")
+ TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1
+
+ date2 = 1
+ date1 = InStrRev("somemoretext", "somemoretext")
+ TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1
+
+ date2 = 0
+ date1 = InStrRev("somemoretext", "nothing")
+ TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1
+
+ SearchString = "XXpXXpXXPXXP" ' String to search in.
+ SearchChar = "P" ' Search for "P".
+ date2 = 3
+ date1 = InStrRev(SearchString, SearchChar, 4, 1)
+ TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1
+
+ date2 = 12
+ date1 = InStrRev(SearchString, SearchChar, -1, 0)
+ TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1
+
+ date2 = 0
+ date1 = InStrRev(SearchString, "W", 1)
+ TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testInStrRev = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/int.vb b/basic/qa/vba_tests/int.vb
new file mode 100644
index 000000000..c5495a87d
--- /dev/null
+++ b/basic/qa/vba_tests/int.vb
@@ -0,0 +1,76 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testInt()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testInt() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Int function"
+ On Error GoTo errorHandler
+
+ date2 = 99
+ date1 = Int(99.8)
+ TestLog_ASSERT date1 = date2, "the return Int is: " & date1
+
+ date2 = -100
+ date1 = Int(-99.8)
+ TestLog_ASSERT date1 = date2, "the return Int is: " & date1
+
+ date2 = -100
+ date1 = Int(-99.2)
+ TestLog_ASSERT date1 = date2, "the return Int is: " & date1
+
+ date2 = 0
+ date1 = Int(0.2)
+ TestLog_ASSERT date1 = date2, "the return Int is: " & date1
+
+ date2 = 0
+ date1 = Int(0)
+ TestLog_ASSERT date1 = date2, "the return Int is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testInt = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/isarray.vb b/basic/qa/vba_tests/isarray.vb
new file mode 100644
index 000000000..3f7dc8a8c
--- /dev/null
+++ b/basic/qa/vba_tests/isarray.vb
@@ -0,0 +1,70 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIsArray()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIsArray() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ Dim MyArray(1 To 5) As Integer, YourArray ' Declare array variables.
+ testName = "Test IsArray function"
+ On Error GoTo errorHandler
+ YourArray = Array(1, 2, 3) ' Use Array function.
+
+ date2 = True
+ date1 = IsArray(MyArray)
+ TestLog_ASSERT date1 = date2, "the return IsArray is: " & date1
+
+ date2 = True
+ date1 = IsArray(YourArray)
+ TestLog_ASSERT date1 = date2, "the return IsArray is: " & date1
+
+ date2 = False
+ date1 = IsArray(date2)
+ TestLog_ASSERT date1 = date2, "the return IsArray is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsArray = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/isdate.vb b/basic/qa/vba_tests/isdate.vb
new file mode 100644
index 000000000..355c9bb8b
--- /dev/null
+++ b/basic/qa/vba_tests/isdate.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIsDate()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIsDate() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test IsDate function"
+ On Error GoTo errorHandler
+
+ date2 = True
+ date1 = IsDate(cdate("12/2/1969"))
+ TestLog_ASSERT date1 = date2, "the return IsDate is: " & date1
+
+ date2 = True
+ date1 = IsDate("12:22:12")
+ TestLog_ASSERT date1 = date2, "the return IsDate is: " & date1
+
+ date2 = False
+ date1 = IsDate("a12.2.1969")
+ TestLog_ASSERT date1 = date2, "the return IsDate is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsDate = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/isempty.vb b/basic/qa/vba_tests/isempty.vb
new file mode 100644
index 000000000..1080122fa
--- /dev/null
+++ b/basic/qa/vba_tests/isempty.vb
@@ -0,0 +1,70 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIsEmpty()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIsEmpty() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2, MyVar
+ testName = "Test IsEmpty function"
+ On Error GoTo errorHandler
+
+ date2 = True
+ date1 = IsEmpty(MyVar)
+ TestLog_ASSERT date1 = date2, "the return IsEmpty is: " & date1
+
+ MyVar = Null ' Assign Null.
+ date2 = False
+ date1 = IsEmpty(MyVar)
+ TestLog_ASSERT date1 = date2, "the return IsEmpty is: " & date1
+
+ MyVar = Empty ' Assign Empty.
+ date2 = True
+ date1 = IsEmpty(MyVar)
+ TestLog_ASSERT date1 = date2, "the return IsEmpty is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsEmpty = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/iserror.vb b/basic/qa/vba_tests/iserror.vb
new file mode 100644
index 000000000..d1a9b2d85
--- /dev/null
+++ b/basic/qa/vba_tests/iserror.vb
@@ -0,0 +1,64 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIsError()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIsError() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test IsError function"
+ On Error GoTo errorHandler
+
+ date2 = False
+ date1 = IsError("12.2.1969")
+ TestLog_ASSERT date1 = date2, "the return IsError is: " & date1
+
+ date2 = True
+ date1 = IsError(CVErr(64))
+ TestLog_ASSERT date1 = date2, "the return IsError is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsError = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/ismissing.vb b/basic/qa/vba_tests/ismissing.vb
new file mode 100644
index 000000000..623c153d4
--- /dev/null
+++ b/basic/qa/vba_tests/ismissing.vb
@@ -0,0 +1,196 @@
+Option VBASupport 1
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Const IsMissingNone = -1
+Const IsMissingA = 0
+Const IsMissingB = 1
+Const IsMissingAB = 2
+
+Function doUnitTest() As String
+ result = verify_testIsMissingVba()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+ Else
+ doUnitTest = "OK"
+ End If
+End Function
+
+' tdf#36737 - Test isMissing function with different datatypes. In LO Basic
+' with option VBASupport, optional parameters are allowed including additional
+' default values. Missing optional parameters having types other than variant,
+' which don't have explicit default values, will be initialized to their
+' respective default value of its datatype.
+Function verify_testIsMissingVba() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+ testName = "Test missing (VBA)"
+ On Error GoTo errorHandler
+
+ ' optionals with variant datatypes
+ TestLog_ASSERT TestOptVariant(), IsMissingA, "TestOptVariant()"
+ TestLog_ASSERT TestOptVariant(123), IsMissingNone, "TestOptVariant(123)"
+ TestLog_ASSERT TestOptVariant(, 456), IsMissingA, "TestOptVariant(, 456)"
+ TestLog_ASSERT TestOptVariant(123, 456), IsMissingNone, "TestOptVariant(123, 456)"
+
+ ' optionals with variant datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptVariantByRefByVal(), IsMissingA, "TestOptVariantByRefByVal()"
+ TestLog_ASSERT TestOptVariantByRefByVal(123),IsMissingNone, "TestOptVariantByRefByVal(123)"
+ TestLog_ASSERT TestOptVariantByRefByVal(, 456), IsMissingA, "TestOptVariantByRefByVal(, 456)"
+ TestLog_ASSERT TestOptVariantByRefByVal(123, 456), IsMissingNone, "TestOptVariantByRefByVal(123, 456)"
+
+ ' optionals with double datatypes
+ TestLog_ASSERT TestOptDouble(), IsMissingNone, "TestOptDouble()"
+ TestLog_ASSERT TestOptDouble(123.4), IsMissingNone, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDouble(, 567.8), IsMissingNone, "TestOptDouble(, 567.8)"
+ TestLog_ASSERT TestOptDouble(123.4, 567.8), IsMissingNone, "TestOptDouble(123.4, 567.8)"
+
+ ' optionals with double datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptDoubleByRefByVal(), IsMissingNone, "TestOptDouble()"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4), IsMissingNone, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(, 567.8)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(123.4, 567.8)"
+
+ ' optionals with integer datatypes
+ TestLog_ASSERT TestOptInteger(), IsMissingNone, "TestOptInteger()"
+ TestLog_ASSERT TestOptInteger(123), IsMissingNone, "TestOptInteger(123)"
+ TestLog_ASSERT TestOptInteger(, 456), IsMissingNone, "TestOptInteger(, 456)"
+ TestLog_ASSERT TestOptInteger(123, 456), IsMissingNone, "TestOptInteger(123, 456)"
+
+ ' optionals with integer datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptIntegerByRefByVal(), IsMissingNone, "TestOptIntegerByRefByVal()"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123), IsMissingNone, "TestOptIntegerByRefByVal(123)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(, 456), IsMissingNone, "TestOptIntegerByRefByVal(, 456)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), IsMissingNone, "TestOptIntegerByRefByVal(123, 456)"
+
+ ' optionals with string datatypes
+ TestLog_ASSERT TestOptString(), IsMissingNone, "TestOptString()"
+ TestLog_ASSERT TestOptString("123"), IsMissingNone, "TestOptString(""123"")"
+ TestLog_ASSERT TestOptString(, "456"), IsMissingNone, "TestOptString(, ""456"")"
+ TestLog_ASSERT TestOptString("123", "456"), IsMissingNone, "TestOptString(""123"", ""456"")"
+
+ ' optionals with string datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptStringByRefByVal(), IsMissingNone, "TestOptStringByRefByVal()"
+ TestLog_ASSERT TestOptStringByRefByVal("123"), IsMissingNone, "TestOptStringByRefByVal(""123"")"
+ TestLog_ASSERT TestOptStringByRefByVal(, "456"), IsMissingNone, "TestOptStringByRefByVal(, ""456"")"
+ TestLog_ASSERT TestOptStringByRefByVal("123", "456"), IsMissingNone, "TestOptStringByRefByVal(""123"", ""456"")"
+
+ ' optionals with object datatypes
+ Dim cA As New Collection
+ cA.Add (123)
+ cA.Add (456)
+ Dim cB As New Collection
+ cB.Add (123.4)
+ cB.Add (567.8)
+ TestLog_ASSERT TestOptObject(), IsMissingAB, "TestOptObject()"
+ TestLog_ASSERT TestOptObject(cA), IsMissingB, "TestOptObject(A)"
+ TestLog_ASSERT TestOptObject(, cB), IsMissingA, "TestOptObject(, B)"
+ TestLog_ASSERT TestOptObject(cA, cB), IsMissingNone, "TestOptObject(A, B)"
+
+ ' optionals with object datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptObjectByRefByVal(), IsMissingAB, "TestOptObjectByRefByVal()"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA), IsMissingB, "TestOptObjectByRefByVal(A)"
+ TestLog_ASSERT TestOptObjectByRefByVal(, cB), IsMissingA, "TestOptObjectByRefByVal(, B)"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA, cB), IsMissingNone, "TestOptObjectByRefByVal(A, B)"
+
+ ' optionals with array datatypes
+ Dim aA(0 To 1) As Integer
+ aA(0) = 123
+ aA(1) = 456
+ Dim aB(0 To 1) As Variant
+ aB(0) = 123.4
+ aB(1) = 567.8
+ ' TODO - New bug report? Scanner initializes variable not as an array
+ ' TestLog_ASSERT TestOptArray(), IsMissingAB, "TestOptArray()"
+ ' TestLog_ASSERT TestOptArray(aA), IsMissingB, "TestOptArray(A)"
+ ' TestLog_ASSERT TestOptArray(, aB), IsMissingA, "TestOptArray(, B)"
+ TestLog_ASSERT TestOptArray(aA, aB), IsMissingNone, "TestOptArray(A, B)"
+
+ ' optionals with array datatypes (ByRef and ByVal)
+ ' TODO - New bug report? Scanner initializes variable not as an array
+ ' TestLog_ASSERT TestOptArrayByRefByVal(), IsMissingAB, "TestOptArrayByRefByVal()"
+ ' TestLog_ASSERT TestOptArrayByRefByVal(aA), IsMissingB, "TestOptArrayByRefByVal(A)"
+ ' TestLog_ASSERT TestOptArrayByRefByVal(, aB), IsMissingA, "TestOptArrayByRefByVal(, B)"
+ TestLog_ASSERT TestOptArrayByRefByVal(aA, aB), IsMissingNone, "TestOptArrayByRefByVal(A, B)"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsMissingVba = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, True, Err.Description
+End Function
+
+Function TestOptVariant(Optional A, Optional B As Variant = 123)
+ TestOptVariant = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123)
+ TestOptVariantByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4)
+ TestOptDouble = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4)
+ TestOptDoubleByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123)
+ TestOptInteger = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123)
+ TestOptIntegerByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptString(Optional A As String, Optional B As String = "123")
+ TestOptString = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123")
+ TestOptStringByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B))
+End Function
+
+Function TestOptObject(Optional A As Collection, Optional B As Collection)
+ TestOptObject = WhatIsMissing(IsNull(A), IsNull(B))
+End Function
+
+Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection)
+ TestOptObjectByRefByVal = WhatIsMissing(IsNull(A), IsNull(B))
+End Function
+
+Function TestOptArray(Optional A() As Integer, Optional B() As Variant)
+ TestOptArray = WhatIsMissing(IsEmpty(A), IsEmpty(B))
+End Function
+
+Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant)
+ TestOptArrayByRefByVal = WhatIsMissing(IsEmpty(A), IsEmpty(B))
+End Function
+
+Function WhatIsMissing(is_missingA, is_missingB)
+ If is_missingA And is_missingB Then
+ WhatIsMissing = IsMissingAB
+ ElseIf is_missingA Then
+ WhatIsMissing = IsMissingA
+ ElseIf is_missingB Then
+ WhatIsMissing = IsMissingB
+ Else
+ WhatIsMissing = IsMissingNone
+ End If
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Integer, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub \ No newline at end of file
diff --git a/basic/qa/vba_tests/isnull.vb b/basic/qa/vba_tests/isnull.vb
new file mode 100644
index 000000000..145294f6d
--- /dev/null
+++ b/basic/qa/vba_tests/isnull.vb
@@ -0,0 +1,64 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIsNull()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIsNull() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test IsNull function"
+ On Error GoTo errorHandler
+
+ date2 = True
+ date1 = IsNull(Null)
+ TestLog_ASSERT date1 = date2, "the return IsNull is: " & date1
+
+ date2 = False
+ date1 = IsNull("")
+ TestLog_ASSERT date1 = date2, "the return IsNull is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsNull = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/isnumeric.vb b/basic/qa/vba_tests/isnumeric.vb
new file mode 100644
index 000000000..2383f4bfe
--- /dev/null
+++ b/basic/qa/vba_tests/isnumeric.vb
@@ -0,0 +1,80 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIsNumeric()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIsNumeric() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test IsNumeric function"
+ On Error GoTo errorHandler
+
+ date2 = True
+ date1 = IsNumeric(123)
+ TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1
+
+ date2 = True
+ date1 = IsNumeric(-123)
+ TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1
+
+ date2 = True
+ date1 = IsNumeric(123.8)
+ TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1
+
+ date2 = False
+ date1 = IsNumeric("a")
+ TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1
+
+rem date2 = True
+rem date1 = IsNumeric(True)
+rem TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1
+
+ date2 = True
+ date1 = IsNumeric("123")
+ TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsNumeric = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/isobject.vb b/basic/qa/vba_tests/isobject.vb
new file mode 100644
index 000000000..82a1a0aa3
--- /dev/null
+++ b/basic/qa/vba_tests/isobject.vb
@@ -0,0 +1,67 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testIsObject()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testIsObject() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim TestStr As String
+ Dim MyObject As Object
+ Dim date1, date2, YourObject
+ testName = "Test IsObject function"
+ On Error GoTo errorHandler
+
+ Set YourObject = MyObject ' Assign an object reference.
+ date2 = True
+ date1 = IsObject(YourObject)
+ TestLog_ASSERT date1 = date2, "the return IsObject is: " & date1
+
+ date2 = False
+ date1 = IsObject(TestStr)
+ TestLog_ASSERT date1 = date2, "the return IsObject is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testIsObject = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/join.vb b/basic/qa/vba_tests/join.vb
new file mode 100644
index 000000000..e09cf8ac8
--- /dev/null
+++ b/basic/qa/vba_tests/join.vb
@@ -0,0 +1,76 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testJoin()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testJoin() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim str1, str2 As String
+ Dim vaArray(2) As String
+ testName = "Test Join function"
+ On Error GoTo errorHandler
+ vaArray(0) = "string1"
+ vaArray(1) = "string2"
+ vaArray(2) = "string3"
+
+ str2 = "string1 string2 string3"
+ str1 = Join(vaArray)
+ TestLog_ASSERT str1 = str2, "the return Join is: " & str1
+
+ str2 = "string1 string2 string3"
+ str1 = Join(vaArray, " ")
+ TestLog_ASSERT str1 = str2, "the return Join is: " & str1
+
+ str2 = "string1<>string2<>string3"
+ str1 = Join(vaArray, "<>")
+ TestLog_ASSERT str1 = str2, "the return Join is: " & str1
+
+ str2 = "string1string2string3"
+ str1 = Join(vaArray, "")
+ TestLog_ASSERT str1 = str2, "the return Join is: " & str1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testJoin = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/lbound.vb b/basic/qa/vba_tests/lbound.vb
new file mode 100644
index 000000000..34999c534
--- /dev/null
+++ b/basic/qa/vba_tests/lbound.vb
@@ -0,0 +1,66 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testLBound()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testLBound() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ Dim MyArray(1 To 10, 5 To 15, 10 To 20) ' Declare array variables.
+ testName = "Test LBound function"
+ On Error GoTo errorHandler
+
+ date2 = 1
+ date1 = LBound(MyArray, 1)
+ TestLog_ASSERT date1 = date2, "the return LBound is: " & date1
+
+ date2 = 10
+ date1 = LBound(MyArray, 3)
+ TestLog_ASSERT date1 = date2, "the return LBound is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testLBound = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/lcase.vb b/basic/qa/vba_tests/lcase.vb
new file mode 100644
index 000000000..d0916341d
--- /dev/null
+++ b/basic/qa/vba_tests/lcase.vb
@@ -0,0 +1,73 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testLCase()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testLCase() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim str1, str2 As String 'variables for test
+ testName = "Test LCase function"
+ On Error GoTo errorHandler
+
+ str2 = "lowercase"
+ str1 = LCase("LOWERCASE")
+ TestLog_ASSERT str1 = str2, "the return LCase is: " & str1
+
+ str2 = "lowercase"
+ str1 = LCase("LowerCase")
+ TestLog_ASSERT str1 = str2, "the return LCase is: " & str1
+
+ str2 = "lowercase"
+ str1 = LCase("lowercase")
+ TestLog_ASSERT str1 = str2, "the return LCase is: " & str1
+
+ str2 = "lower case"
+ str1 = LCase("LOWER CASE")
+ TestLog_ASSERT str1 = str2, "the return LCase is: " & str1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testLCase = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/left.vb b/basic/qa/vba_tests/left.vb
new file mode 100644
index 000000000..8a6576fd2
--- /dev/null
+++ b/basic/qa/vba_tests/left.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testLeft()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testLeft() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Left function"
+ On Error GoTo errorHandler
+
+ date2 = "some"
+ date1 = Left("sometext", 4)
+ TestLog_ASSERT date1 = date2, "the return Left is: " & date1
+
+ date2 = "sometext"
+ date1 = Left("sometext", 48)
+ TestLog_ASSERT date1 = date2, "the return Left is: " & date1
+
+ date2 = ""
+ date1 = Left("", 4)
+ TestLog_ASSERT date1 = date2, "the return Left is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testLeft = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/len.vb b/basic/qa/vba_tests/len.vb
new file mode 100644
index 000000000..d524d96b8
--- /dev/null
+++ b/basic/qa/vba_tests/len.vb
@@ -0,0 +1,69 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testLen()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testLen() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Len function"
+ On Error GoTo errorHandler
+
+ date2 = 8
+ date1 = Len("sometext")
+ TestLog_ASSERT date1 = date2, "the return Len is: " & date1
+
+ date2 = 9
+ date1 = Len("some text")
+ TestLog_ASSERT date1 = date2, "the return Len is: " & date1
+
+ date2 = 0
+ date1 = Len("")
+ TestLog_ASSERT date1 = date2, "the return Len is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testLen = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/log.vb b/basic/qa/vba_tests/log.vb
new file mode 100644
index 000000000..08656bdf5
--- /dev/null
+++ b/basic/qa/vba_tests/log.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testLog()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testLog() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Log function"
+ On Error GoTo errorHandler
+
+ date2 = 4.454
+ date1 = Log(86)
+ TestLog_ASSERT Round(date1, 3) = Round(date2, 3), "the return Log is: " & date1
+
+ date2 = 4
+ date1 = Exp(Log(4))
+ TestLog_ASSERT date1 = date2, "the return Log is: " & date1
+
+ date2 = 1
+ date1 = Log(2.7182818)
+ TestLog_ASSERT Round(date1, 3) = Round(date2, 3), "the return Log is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testLog = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/ltrim.vb b/basic/qa/vba_tests/ltrim.vb
new file mode 100644
index 000000000..d85d02a76
--- /dev/null
+++ b/basic/qa/vba_tests/ltrim.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testLTrim()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testLTrim() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test LTrim function"
+ On Error GoTo errorHandler
+
+ date2 = "some text "
+ date1 = LTrim(" some text ")
+ TestLog_ASSERT date1 = date2, "the return LTrim is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testLTrim = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/mid.vb b/basic/qa/vba_tests/mid.vb
new file mode 100644
index 000000000..b7070b33b
--- /dev/null
+++ b/basic/qa/vba_tests/mid.vb
@@ -0,0 +1,69 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testMid()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testMid() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Mid function"
+ On Error GoTo errorHandler
+
+ date2 = "Mid"
+ date1 = Mid("Mid Function Demo", 1, 3)
+ TestLog_ASSERT date1 = date2, "the return Mid is: " & date1
+
+ date2 = "Demo"
+ date1 = Mid("Mid Function Demo", 14, 4)
+ TestLog_ASSERT date1 = date2, "the return Mid is: " & date1
+
+ date2 = "Function Demo"
+ date1 = Mid("Mid Function Demo", 5)
+ TestLog_ASSERT date1 = date2, "the return Mid is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testMid = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/minute.vb b/basic/qa/vba_tests/minute.vb
new file mode 100644
index 000000000..20761b1e7
--- /dev/null
+++ b/basic/qa/vba_tests/minute.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testMinute()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testMinute() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Minute function"
+ On Error GoTo errorHandler
+
+ date2 = 34
+ date1 = Minute("09:34:20")
+ TestLog_ASSERT date1 = date2, "the return Minute is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testMinute = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/month.vb b/basic/qa/vba_tests/month.vb
new file mode 100644
index 000000000..98d614a57
--- /dev/null
+++ b/basic/qa/vba_tests/month.vb
@@ -0,0 +1,79 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testMonth()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testMonth() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ Dim ldate As Date
+ testName = "Test Month function"
+ On Error GoTo errorHandler
+ ldate = 32616
+
+ date2 = 4
+ date1 = Month(ldate)
+ TestLog_ASSERT date1 = date2, "the return Month is: " & date1
+
+ date2 = 2
+ date1 = Month("01/02/2007")
+ TestLog_ASSERT date1 = date2, "the return Month is: " & date1
+
+ date2 = 12
+ date1 = Month(1)
+ TestLog_ASSERT date1 = date2, "the return Month is: " & date1
+
+ date2 = 2
+ date1 = Month(60)
+ TestLog_ASSERT date1 = date2, "the return Month is: " & date1
+
+ date2 = 6
+ date1 = Month(2000)
+ TestLog_ASSERT date1 = date2, "the return Month is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testMonth = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/monthname.vb b/basic/qa/vba_tests/monthname.vb
new file mode 100644
index 000000000..627f9095b
--- /dev/null
+++ b/basic/qa/vba_tests/monthname.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testMonthName()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testMonthName() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test MonthName function"
+ On Error GoTo errorHandler
+
+ date2 = "February"
+ date1 = MonthName(2)
+ TestLog_ASSERT date1 = date2, "the return MonthName is: " & date1
+
+ date2 = "Feb"
+ date1 = MonthName(2, True)
+ TestLog_ASSERT date1 = date2, "the return MonthName is: " & date1
+
+ date2 = "February"
+ date1 = MonthName(2, False)
+ TestLog_ASSERT date1 = date2, "the return MonthName is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testMonthName = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/oct.vb b/basic/qa/vba_tests/oct.vb
new file mode 100644
index 000000000..52feef2c8
--- /dev/null
+++ b/basic/qa/vba_tests/oct.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testOct()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testOct() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Oct function"
+ On Error GoTo errorHandler
+
+ date2 = 4
+ date1 = Oct(4)
+ TestLog_ASSERT date1 = date2, "the return Oct is: " & date1
+
+ date2 = 10
+ date1 = Oct(8)
+ TestLog_ASSERT date1 = date2, "the return Oct is: " & date1
+
+ date2 = 713
+ date1 = Oct(459)
+ TestLog_ASSERT date1 = date2, "the return Oct is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testOct = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb b/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb
new file mode 100644
index 000000000..b1a591b0c
--- /dev/null
+++ b/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb
@@ -0,0 +1,30 @@
+Option VBASupport 1
+Function doUnitTest(TestData as String, Driver as String) as String
+Rem Ensure object assignment is by reference
+Rem when object member is used ( as lhs )
+Dim origTimeout As Long
+Dim modifiedTimeout As Long
+Set cn = New ADODB.Connection
+origTimeout = cn.CommandTimeout
+modifiedTimeout = origTimeout * 2
+cn.CommandTimeout = modifiedTimeout
+Dim conStr As String
+conStr = "Provider=MSDASQL;Driver={" & Driver & "};DBQ="
+conStr = conStr & TestData & "; ReadOnly=False;"
+cn.Open conStr
+Set objCmd = New ADODB.Command
+objCmd.ActiveConnection = cn
+If objCmd.ActiveConnection.CommandTimeout <> modifiedTimeout Then
+ Rem if we copied the object by reference then we should have the
+ Rem modified timeout ( because we should be just pointing as cn )
+ doUnitTest = "FAIL expected modified timeout " & modifiedTimeout & " but got " & objCmd.ActiveConnection.CommandTimeout
+ Exit Function
+End If
+cn.CommandTimeout = origTimeout ' restore timeout
+Rem Double check objCmd.ActiveConnection is pointing to objCmd.ActiveConnection
+If objCmd.ActiveConnection.CommandTimeout <> origTimeout Then
+ doUnitTest = "FAIL expected original timeout " & origTimeout & " but got " & objCmd.ActiveConnection.CommandTimeout
+ Exit Function
+End If
+doUnitTest = "OK" ' no error
+End Function
diff --git a/basic/qa/vba_tests/ole_ObjAssignToNothing.vb b/basic/qa/vba_tests/ole_ObjAssignToNothing.vb
new file mode 100644
index 000000000..d68664b41
--- /dev/null
+++ b/basic/qa/vba_tests/ole_ObjAssignToNothing.vb
@@ -0,0 +1,19 @@
+Option VBASupport 1
+Function doUnitTest(TestData as String, Driver as String) as String
+Rem Ensure object assignment is by reference
+Rem when object member is used ( as lhs )
+Rem This time we are testing assigning with special Nothing
+Rem keyword
+Set cn = New ADODB.Connection
+Dim conStr As String
+conStr = "Provider=MSDASQL;Driver={" & Driver & "};DBQ="
+conStr = conStr & TestData & "; ReadOnly=False;"
+cn.Open conStr
+Set objCmd = New ADODB.Command
+objCmd.ActiveConnection = Nothing
+if objCmd.ActiveConnection Is Nothing Then
+ doUnitTest = "OK" ' no error
+Else
+ doUnitTest = "Fail - expected objCmd.ActiveConnection be Nothing"
+End If
+End Function
diff --git a/basic/qa/vba_tests/optional_paramters.vb b/basic/qa/vba_tests/optional_paramters.vb
new file mode 100644
index 000000000..2f527e5d7
--- /dev/null
+++ b/basic/qa/vba_tests/optional_paramters.vb
@@ -0,0 +1,215 @@
+Option VBASupport 1
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+ result = verify_testOptionalsVba()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+ Else
+ doUnitTest = "OK"
+ End If
+End Function
+
+' tdf#36737 - Test optionals with different datatypes. In LO Basic
+' with option VBASupport, optional parameters are allowed including additional
+' default values. Missing optional parameters having types other than variant,
+' which don't have explicit default values, will be initialized to their
+' respective default value of its datatype
+Function verify_testOptionalsVba() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+ testName = "Test optionals (VBA)"
+ On Error GoTo errorHandler
+
+ ' optionals with variant datatypes
+ TestLog_ASSERT TestOptVariant(), 123, "TestOptVariant()"
+ TestLog_ASSERT TestOptVariant(123), 246, "TestOptVariant(123)"
+ TestLog_ASSERT TestOptVariant(, 456), 456, "TestOptVariant(, 456)"
+ TestLog_ASSERT TestOptVariant(123, 456), 579, "TestOptVariant(123, 456)"
+
+ ' optionals with variant datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptVariantByRefByVal(), 123, "TestOptVariantByRefByVal()"
+ TestLog_ASSERT TestOptVariantByRefByVal(123), 246, "TestOptVariantByRefByVal(123)"
+ TestLog_ASSERT TestOptVariantByRefByVal(, 456), 456, "TestOptVariantByRefByVal(, 456)"
+ TestLog_ASSERT TestOptVariantByRefByVal(123, 456), 579, "TestOptVariantByRefByVal(123, 456)"
+
+ ' optionals with double datatypes
+ TestLog_ASSERT TestOptDouble(), 123.4, "TestOptDouble()"
+ TestLog_ASSERT TestOptDouble(123.4), 246.8, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDouble(, 567.8), 567.8, "TestOptDouble(, 567.8)"
+ TestLog_ASSERT Format(TestOptDouble(123.4, 567.8), "0.0"), 691.2, "TestOptDouble(123.4, 567.8)"
+
+ ' optionals with double datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptDoubleByRefByVal(), 123.4, "TestOptDouble()"
+ TestLog_ASSERT TestOptDoubleByRefByVal(123.4), 246.8, "TestOptDouble(123.4)"
+ TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), 567.8, "TestOptDoubleByRefByVal(, 567.8)"
+ TestLog_ASSERT Format(TestOptDoubleByRefByVal(123.4, 567.8), "0.0"), 691.2, "TestOptDoubleByRefByVal(123.4, 567.8)"
+
+ ' optionals with integer datatypes
+ TestLog_ASSERT TestOptInteger(), 123, "TestOptInteger()"
+ TestLog_ASSERT TestOptInteger(123), 246, "TestOptInteger(123)"
+ TestLog_ASSERT TestOptInteger(, 456), 456, "TestOptInteger(, 456)"
+ TestLog_ASSERT TestOptInteger(123, 456), 579, "TestOptInteger(123, 456)"
+
+ ' optionals with integer datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptIntegerByRefByVal(), 123, "TestOptIntegerByRefByVal()"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123), 246, "TestOptIntegerByRefByVal(123)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(, 456), 456, "TestOptIntegerByRefByVal(, 456)"
+ TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), 579, "TestOptIntegerByRefByVal(123, 456)"
+
+ ' optionals with string datatypes
+ TestLog_ASSERT TestOptString(), "123", "TestOptString()"
+ TestLog_ASSERT TestOptString("123"), "123123", "TestOptString(""123"")"
+ TestLog_ASSERT TestOptString(, "456"), "456", "TestOptString(, ""456"")"
+ TestLog_ASSERT TestOptString("123", "456"), "123456", "TestOptString(""123"", ""456"")"
+
+ ' optionals with string datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptStringByRefByVal(), "123", "TestOptStringByRefByVal()"
+ TestLog_ASSERT TestOptStringByRefByVal("123"), "123123", "TestOptStringByRefByVal(""123"")"
+ TestLog_ASSERT TestOptStringByRefByVal(, "456"), "456", "TestOptStringByRefByVal(, ""456"")"
+ TestLog_ASSERT TestOptStringByRefByVal("123", "456"), "123456", "TestOptStringByRefByVal(""123"", ""456"")"
+
+ ' optionals with object datatypes
+ Dim cA As New Collection
+ cA.Add (123)
+ cA.Add (456)
+ Dim cB As New Collection
+ cB.Add (123.4)
+ cB.Add (567.8)
+ TestLog_ASSERT TestOptObject(), 0, "TestOptObject()"
+ TestLog_ASSERT TestOptObject(cA), 579, "TestOptObject(A)"
+ TestLog_ASSERT Format(TestOptObject(, cB), "0.0"), 691.2, "TestOptObject(, B)"
+ TestLog_ASSERT Format(TestOptObject(cA, cB), "0.0"), 1270.2, "TestOptObject(A, B)"
+
+ ' optionals with object datatypes (ByRef and ByVal)
+ TestLog_ASSERT TestOptObjectByRefByVal(), 0, "TestOptObjectByRefByVal()"
+ TestLog_ASSERT TestOptObjectByRefByVal(cA), 579, "TestOptObjectByRefByVal(A)"
+ TestLog_ASSERT Format(TestOptObjectByRefByVal(, cB), "0.0"), 691.2, "TestOptObjectByRefByVal(, B)"
+ TestLog_ASSERT Format(TestOptObjectByRefByVal(cA, cB), "0.0"), 1270.2, "TestOptObjectByRefByVal(A, B)"
+
+ ' optionals with array datatypes
+ Dim aA(0 To 1) As Integer
+ aA(0) = 123
+ aA(1) = 456
+ Dim aB(0 To 1) As Variant
+ aB(0) = 123.4
+ aB(1) = 567.8
+ ' TODO - New bug report? Scanner initializes variable not as an array
+ ' TestLog_ASSERT TestOptArray(), 0, "TestOptArray()"
+ ' TestLog_ASSERT TestOptArray(aA), 579, "TestOptArray(A)"
+ ' TestLog_ASSERT Format(TestOptArray(, aB), "0.0"), 691.2, "TestOptArray(, B)"
+ TestLog_ASSERT Format(TestOptArray(aA, aB), "0.0"), 1270.2, "TestOptArray(A, B)"
+
+ ' optionals with array datatypes (ByRef and ByVal)
+ ' TODO - New bug report? Scanner initializes variable not as an array
+ ' TestLog_ASSERT TestOptArrayByRefByVal(), 0, "TestOptArrayByRefByVal()"
+ ' TestLog_ASSERT TestOptArrayByRefByVal(aA), 579, "TestOptArrayByRefByVal(A)"
+ ' TestLog_ASSERT Format(TestOptArrayByRefByVal(, aB), "0.0"), 691.2, "TestOptArrayByRefByVal(, B)"
+ TestLog_ASSERT Format(TestOptArrayByRefByVal(aA, aB), "0.0"), 1270.2, "TestOptArrayByRefByVal(A, B)"
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testOptionalsVba = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, True, Err.Description
+End Function
+
+Function TestOptVariant(Optional A, Optional B As Variant = 123)
+ TestOptVariant = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123)
+ TestOptVariantByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4)
+ TestOptDouble = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4)
+ TestOptDoubleByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123)
+ TestOptInteger = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123)
+ TestOptIntegerByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptString(Optional A As String, Optional B As String = "123")
+ TestOptString = OptStringConcat(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123")
+ TestOptStringByRefByVal = OptStringConcat(IsMissing(A), A, IsMissing(B), B)
+End Function
+
+Function TestOptObject(Optional A As Collection, Optional B As Collection)
+ ' TODO - isMissing returns false even though the collection is null and is missing?
+ TestOptObject = 0
+ If Not IsNull(A) Then TestOptObject = CollectionSum(A)
+ If Not IsNull(B) Then TestOptObject = TestOptObject + CollectionSum(B)
+End Function
+
+Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection)
+ ' TODO - isMissing returns false even though the collection is null and is missing?
+ TestOptObjectByRefByVal = 0
+ If Not IsNull(A) Then TestOptObjectByRefByVal = CollectionSum(A)
+ If Not IsNull(B) Then TestOptObjectByRefByVal = TestOptObjectByRefByVal + CollectionSum(B)
+End Function
+
+Function TestOptArray(Optional A() As Integer, Optional B() As Variant)
+ TestOptArray = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B)
+End Function
+
+Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant)
+ TestOptArrayByRefByVal = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B)
+End Function
+
+Function OptNumberSum(is_missingA As Boolean, A, is_missingB As Boolean, B)
+ OptNumberSum = 0
+ If Not is_missingA Then OptNumberSum = A
+ If Not is_missingB Then OptNumberSum = OptNumberSum + B
+End Function
+
+Function OptStringConcat(is_missingA As Boolean, A, is_missingB As Boolean, B)
+ OptStringConcat = ""
+ If Not is_missingA Then OptStringConcat = A
+ If Not is_missingB Then OptStringConcat = OptStringConcat & B
+End Function
+
+Function CollectionSum(C)
+ Dim idx As Integer
+ CollectionSum = 0
+ For idx = 1 To C.Count
+ CollectionSum = CollectionSum + C.Item(idx)
+ Next idx
+End Function
+
+Function ArraySum(is_missingC As Boolean, C)
+ Dim idx As Integer
+ ArraySum = 0
+ If Not is_missingC Then
+ For idx = LBound(C) To UBound(C)
+ ArraySum = ArraySum + C(idx)
+ Next idx
+ End If
+End Function
+
+Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String)
+ If expected = actual Then
+ passCount = passCount + 1
+ Else
+ result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected
+ failCount = failCount + 1
+ End If
+End Sub \ No newline at end of file
diff --git a/basic/qa/vba_tests/partition.vb b/basic/qa/vba_tests/partition.vb
new file mode 100644
index 000000000..d134a4227
--- /dev/null
+++ b/basic/qa/vba_tests/partition.vb
@@ -0,0 +1,71 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testPartition()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testPartition() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+
+ Dim testName As String
+ Dim retStr As String
+ testName = "Test Partition function"
+ On Error GoTo errorHandler
+
+ retStr = Partition(20, 0, 98, 5)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "20:24", "the number 20 occurs in the range:" & retStr
+
+ retStr = Partition(20, 0, 99, 1)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = " 20: 20", "the number 20 occurs in the range:" & retStr
+
+ retStr = Partition(120, 0, 99, 5)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "100: ", "the number 120 occurs in the range:" & retStr
+
+ retStr = Partition(-5, 0, 99, 5)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = " : -1", "the number -5 occurs in the range:" & retStr
+
+ retStr = Partition(2, 0, 5, 2)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = " 2: 3", "the number 2 occurs in the range:" & retStr
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testPartition = result
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (false), "verify_testPartion failed, hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/qbcolor.vb b/basic/qa/vba_tests/qbcolor.vb
new file mode 100644
index 000000000..d9f617219
--- /dev/null
+++ b/basic/qa/vba_tests/qbcolor.vb
@@ -0,0 +1,92 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testQBcolor()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testQBcolor() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2 As Long
+ testName = "Test QBcolor function"
+ On Error GoTo errorHandler
+
+ date2 = 0
+ date1 = QBColor(0)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 8388608
+ date1 = QBColor(1)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 32768
+ date1 = QBColor(2)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 8421376
+ date1 = QBColor(3)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 128
+ date1 = QBColor(4)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 8388736
+ date1 = QBColor(5)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 32896
+ date1 = QBColor(6)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 12632256
+ date1 = QBColor(7)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ date2 = 8421504
+ date1 = QBColor(8)
+ TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testQBcolor = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/rate.vb b/basic/qa/vba_tests/rate.vb
new file mode 100644
index 000000000..898705911
--- /dev/null
+++ b/basic/qa/vba_tests/rate.vb
@@ -0,0 +1,84 @@
+Option VBASupport 1
+Rem Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testRATE()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testRATE() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim TestDateTime As Date
+ Dim TestStr As String
+ Dim date1, date2
+ testName = "Test RATE function"
+ On Error GoTo errorHandler
+
+ date2 = 0.07
+ date1 = Rate(3, -5, 0, 16)
+ TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1
+
+ date2 = 0
+ date1 = Rate(3, -5, 0, 15)
+ TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1
+
+ date2 = 0.79
+ date1 = Rate(3, -5, 0, 30)
+ TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1
+
+ date2 = 1
+ date1 = Rate(3, -5, 0, 35)
+ TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1
+
+ date2 = 0.077
+ date1 = Rate(4, -300, 1000, 0, 0)
+ TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1
+
+ date2 = 0.14
+ date1 = Rate(4, -300, 1000, 0, 1)
+ TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testRATE = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/replace.vb b/basic/qa/vba_tests/replace.vb
new file mode 100644
index 000000000..1349c10fa
--- /dev/null
+++ b/basic/qa/vba_tests/replace.vb
@@ -0,0 +1,77 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testReplace()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testReplace() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim srcStr, destStr, repStr, start, count, retStr
+ testName = "Test Replace function"
+ On Error GoTo errorHandler
+ srcStr = "abcbcdBc"
+ destStr = "bc"
+ repStr = "ef"
+ retStr = Replace(srcStr, destStr, repStr)
+ TestLog_ASSERT retStr = "aefefdBc", "common string:" & retStr
+ retStr = Replace("abcbcdbc", destStr, repStr)
+ TestLog_ASSERT retStr = "aefefdef", "expression string:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, -1, vbBinaryCompare)
+ TestLog_ASSERT retStr = "aefefdBc", "binary compare:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, -1, vbTextCompare)
+ TestLog_ASSERT retStr = "aefefdef", "text compare:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, compare:=vbTextCompare)
+ TestLog_ASSERT retStr = "aefefdef", "text compare:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 3, -1, vbBinaryCompare)
+ TestLog_ASSERT retStr = "cefdBc", "start = 3:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, 2, vbBinaryCompare)
+ TestLog_ASSERT retStr = "aefefdBc", "count = 2: " & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, 0, vbBinaryCompare)
+ TestLog_ASSERT retStr = "abcbcdBc", "start = 1, count = 0, not support in Unix: " & retStr
+
+ ' tdf#132389 - case-insensitive operation for non-ASCII characters
+ retStr = Replace("ABCabc", "b", "*", 1, 2, vbTextCompare)
+ TestLog_ASSERT retStr = "A*Ca*c", "case-insensitive ASCII: " & retStr
+ retStr = Replace("АБВабв", "б", "*", 1, 2, vbTextCompare)
+ TestLog_ASSERT retStr = "А*Ва*в", "case-insensitive non-ASCII: " & retStr
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testReplace = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/rgb.vb b/basic/qa/vba_tests/rgb.vb
new file mode 100644
index 000000000..b36f3e099
--- /dev/null
+++ b/basic/qa/vba_tests/rgb.vb
@@ -0,0 +1,72 @@
+Option VBASupport 1
+Rem Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testRGB()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testRGB() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim TestDateTime As Date
+ Dim TestStr As String
+ Dim date1, date2
+ testName = "Test RGB function"
+ On Error GoTo errorHandler
+
+ date2 = 255
+ date1 = RGB(255, 0, 0)
+ TestLog_ASSERT date1 = date2, "the return RGB is: " & date1
+
+ date2 = 13339467
+ date1 = RGB(75, 139, 203)
+ TestLog_ASSERT date1 = date2, "the return RGB is: " & date1
+
+ date2 = 16777215
+ date1 = RGB(255, 255, 255)
+ TestLog_ASSERT date1 = date2, "the return RGB is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testRGB = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/right.vb b/basic/qa/vba_tests/right.vb
new file mode 100644
index 000000000..0e09bc11c
--- /dev/null
+++ b/basic/qa/vba_tests/right.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testRight()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testRight() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Right function"
+ On Error GoTo errorHandler
+
+ date2 = "text"
+ date1 = Right("sometext", 4)
+ TestLog_ASSERT date1 = date2, "the return Right is: " & date1
+
+ date2 = "sometext"
+ date1 = Right("sometext", 48)
+ TestLog_ASSERT date1 = date2, "the return Right is: " & date1
+
+ date2 = ""
+ date1 = Right("", 4)
+ TestLog_ASSERT date1 = date2, "the return Right is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testRight = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/rtrim.vb b/basic/qa/vba_tests/rtrim.vb
new file mode 100644
index 000000000..d99cfd85f
--- /dev/null
+++ b/basic/qa/vba_tests/rtrim.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testRTrim()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testRTrim() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test RTrim function"
+ On Error GoTo errorHandler
+
+ date2 = " some text"
+ date1 = RTrim(" some text ")
+ TestLog_ASSERT date1 = date2, "the return RTrim is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testRTrim = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/second.vb b/basic/qa/vba_tests/second.vb
new file mode 100644
index 000000000..4d84b4f73
--- /dev/null
+++ b/basic/qa/vba_tests/second.vb
@@ -0,0 +1,64 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testSecond()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testSecond() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Second function"
+ On Error GoTo errorHandler
+
+ date2 = 0
+ date1 = Second(37566.3)
+ TestLog_ASSERT date1 = date2, "the return Second is: " & date1
+
+ date2 = 17
+ date1 = Second("4:35:17")
+ TestLog_ASSERT date1 = date2, "the return Second is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testSecond = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/sgn.vb b/basic/qa/vba_tests/sgn.vb
new file mode 100644
index 000000000..e72215679
--- /dev/null
+++ b/basic/qa/vba_tests/sgn.vb
@@ -0,0 +1,76 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_SGN()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_SGN() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test SGN function"
+ On Error GoTo errorHandler
+
+ date2 = 0
+ date1 = sgn(0)
+ TestLog_ASSERT date1 = date2, "the return SGN is: " & date1
+
+ date2 = -1
+ date1 = sgn(-1)
+ TestLog_ASSERT date1 = date2, "the return SGN is: " & date1
+
+ date2 = 1
+ date1 = sgn(1)
+ TestLog_ASSERT date1 = date2, "the return SGN is: " & date1
+
+ date2 = 1
+ date1 = sgn(50)
+ TestLog_ASSERT date1 = date2, "the return SGN is: " & date1
+
+ date2 = -1
+ date1 = sgn(-50)
+ TestLog_ASSERT date1 = date2, "the return SGN is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_SGN = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/sin.vb b/basic/qa/vba_tests/sin.vb
new file mode 100644
index 000000000..af2e73bd9
--- /dev/null
+++ b/basic/qa/vba_tests/sin.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testSIN()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testSIN() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test SIN function"
+ On Error GoTo errorHandler
+
+ date2 = 0.43
+ date1 = Sin(0.45)
+ TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return SIN is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testSIN = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/space.vb b/basic/qa/vba_tests/space.vb
new file mode 100644
index 000000000..efcc9c992
--- /dev/null
+++ b/basic/qa/vba_tests/space.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testSpace()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testSpace() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Space function"
+ On Error GoTo errorHandler
+
+ date2 = " "
+ date1 = Space(2)
+ TestLog_ASSERT date1 = date2, "the return Space is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testSpace = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/sqr.vb b/basic/qa/vba_tests/sqr.vb
new file mode 100644
index 000000000..75a4ae7c1
--- /dev/null
+++ b/basic/qa/vba_tests/sqr.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testSQR()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testSQR() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test SQR function"
+ On Error GoTo errorHandler
+
+ date2 = 3
+ date1 = Sqr(9)
+ TestLog_ASSERT date1 = date2, "the return SQR is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testSQR = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/str.vb b/basic/qa/vba_tests/str.vb
new file mode 100644
index 000000000..e46371ed5
--- /dev/null
+++ b/basic/qa/vba_tests/str.vb
@@ -0,0 +1,73 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testSTR()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testSTR() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test STR function"
+ On Error GoTo errorHandler
+
+ date2 = " 459"
+ date1 = Str(459)
+ TestLog_ASSERT date1 = date2, "the return STR is: " & date1
+
+ date2 = "-459.65"
+ date1 = Str(-459.65)
+ TestLog_ASSERT date1 = date2, "the return STR is: " & date1
+
+ date2 = " 459.001"
+ date1 = Str(459.001)
+ TestLog_ASSERT date1 = date2, "the return STR is: " & date1
+
+ date2 = " .24"
+ date1 = Str(0.24)
+ TestLog_ASSERT date1 = date2, "the return STR is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testSTR = result
+
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/strcomp.vb b/basic/qa/vba_tests/strcomp.vb
new file mode 100644
index 000000000..487358358
--- /dev/null
+++ b/basic/qa/vba_tests/strcomp.vb
@@ -0,0 +1,95 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testSTRcomp()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testSTRcomp() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim TestStr, TestStr1, TestStr2 As String
+ Dim date1, date2
+ testName = "Test STRcomp function"
+ On Error GoTo errorHandler
+ TestStr1 = "ABCD"
+ TestStr2 = "abcd"
+
+ date2 = 0
+ date1 = StrComp(TestStr1, TestStr2, vbTextCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = -1
+ date1 = StrComp(TestStr1, TestStr2, vbBinaryCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = -1
+ date1 = StrComp(TestStr1, TestStr2)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = 0
+ date1 = StrComp("text", "text", vbBinaryCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = 1
+ date1 = StrComp("text ", "text", vbBinaryCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = -1
+ date1 = StrComp("Text", "text", vbBinaryCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = 0
+ date1 = StrComp("text", "text", vbTextCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = 1
+ date1 = StrComp("text ", "text", vbTextCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ date2 = 0
+ date1 = StrComp("Text", "text", vbTextCompare)
+ TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testSTRcomp = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/strconv.vb b/basic/qa/vba_tests/strconv.vb
new file mode 100644
index 000000000..35a73af17
--- /dev/null
+++ b/basic/qa/vba_tests/strconv.vb
@@ -0,0 +1,90 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testStrConv()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testStrConv() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim srcStr, retStr As String
+ Dim x() As Byte
+ srcStr = "abc EFG hij"
+ testName = "Test StrConv function"
+ On Error GoTo errorHandler
+
+ retStr = StrConv(srcStr, vbUpperCase)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "ABC EFG HIJ", "Converts the string to uppercase characters:" & retStr
+
+ retStr = StrConv(srcStr, vbLowerCase)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "abc efg hij", "Converts the string to lowercase characters:" & retStr
+
+ retStr = StrConv(srcStr, vbProperCase)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "Abc Efg Hij", "Converts the first letter of every word in string to uppercase:" & retStr
+
+ 'retStr = StrConv("ABCDEVB¥ì¥¹¥­¥å©`", vbWide)
+ 'MsgBox retStr
+ 'TestLog_ASSERT retStr = "£Á£Â£Ã£Ä£ÅVB¥ì¥¹¥­¥å©`", "Converts narrow (single-byte) characters in string to wide"
+
+ 'retStr = StrConv("£Á£Â£Ã£Ä£ÅVB¥ì¥¹¥­¥å©`", vbNarrow)
+ 'MsgBox retStr
+ 'TestLog_ASSERT retStr = "ABCDEVB¥ì¥¹¥­¥å©`", "Converts wide (double-byte) characters in string to narrow (single-byte) characters." & retStr
+
+ 'retStr = StrConv("¤Ï¤Ê¤Á¤ã¤ó", vbKatakana)
+ 'MsgBox retStr
+ 'TestLog_ASSERT retStr = "¥Ï¥Ê¥Á¥ã¥ó", "Converts Hiragana characters in string to Katakana characters.." & retStr
+
+ ' retStr = StrConv("¥Ï¥Ê¥Á¥ã¥ó", vbHiragana)
+ 'MsgBox retStr
+ ' TestLog_ASSERT retStr = "¤Ï¤Ê¤Á¤ã¤ó", "Converts Katakana characters in string to Hiragana characters.." & retStr
+
+ 'x = StrConv("ÉϺ£ÊÐABC", vbFromUnicode)
+ 'MsgBox retStr
+ 'TestLog_ASSERT UBound(x) = 8, "Converts the string from Unicode, the length is : " & UBound(x) + 1
+
+ ' retStr = StrConv(x, vbUnicode)
+ 'MsgBox retStr
+ ' TestLog_ASSERT retStr = "ÉϺ£ÊÐABC", "Converts the string to Unicode: " & retStr
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testStrConv = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/string.vb b/basic/qa/vba_tests/string.vb
new file mode 100644
index 000000000..79496738c
--- /dev/null
+++ b/basic/qa/vba_tests/string.vb
@@ -0,0 +1,69 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testString()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testString() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim TestStr As String
+ Dim date1, date2
+ testName = "Test String function"
+ On Error GoTo errorHandler
+
+ date2 = "PPPPP"
+ date1 = String(5, "P")
+ TestLog_ASSERT date1 = date2, "the return String is: " & date1
+
+ date2 = "aaaaa"
+ date1 = String(5, "a")
+ TestLog_ASSERT date1 = date2, "the return String is: " & date1
+
+ date2 = ""
+ date1 = String(0, "P")
+ TestLog_ASSERT date1 = date2, "the return String is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testString = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/stringplusdouble.vb b/basic/qa/vba_tests/stringplusdouble.vb
new file mode 100644
index 000000000..cfe4a5bc6
--- /dev/null
+++ b/basic/qa/vba_tests/stringplusdouble.vb
@@ -0,0 +1,328 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_stringplusdouble()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_stringplusdouble() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ DSD
+ SSD
+ DSS
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_stringplusdouble = result
+End Function
+
+Sub DSD()
+ Dim testName As String
+ testName = "double = string + double"
+ Dim testCompute As String
+
+ Dim s As String
+ Dim d As Double
+ Dim r As Double
+
+ On Error GoTo ErrorHandler
+
+ testCompute = "s = null, d = null, r = s + d"
+ r = s + d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = null, r = s & d"
+ r = s & d
+ TestLog_ASSERT r = 0, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s + d"
+ d = 20
+ r = s + d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s & d"
+ d = 20
+ r = s & d
+ TestLog_ASSERT r = 20, testCompute & " .The result is: " & r
+
+
+ ''''''''''''''
+ s = "10"
+ Dim d2 As Double
+ testCompute = "s = '10', d = null, r = s + d"
+ r = s + d2
+ TestLog_ASSERT r = 10, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = null, r = s & d"
+ r = s & d2
+ TestLog_ASSERT r = 100, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s + d"
+ d2 = 20
+ r = s + d2
+ TestLog_ASSERT r = 30, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s & d"
+ d2 = 20
+ r = s & d2
+ TestLog_ASSERT r = 1020, testCompute & " .The result is: " & r
+
+ ''''''''''''''
+ s = "abc"
+ Dim d3 As Double
+ testCompute = "s = 'abc', d = null, r = s + d"
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = null, r = s & d"
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s + d"
+ d3 = 20
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s & d"
+ d3 = 20
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ Exit Sub
+
+ErrorHandler:
+ r = -1
+' TestLog_Comment "The next compute raises error: " & testCompute
+ Resume Next
+End Sub
+
+
+Sub SSD()
+ Dim testName As String
+ testName = "string = string + double"
+ Dim testCompute As String
+
+ Dim s As String
+ Dim d As Double
+ Dim r As String
+
+ On Error GoTo ErrorHandler
+
+ testCompute = "s = null, d = null, r = s + d"
+ r = s + d
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = null, r = s & d"
+ r = s & d
+ TestLog_ASSERT r = "0", testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s + d"
+ d = 20
+ r = s + d
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s & d"
+ d = 20
+ r = s & d
+ TestLog_ASSERT r = "20", testCompute & " .The result is: " & r
+
+
+ ''''''''''''''
+ s = "10"
+ Dim d2 As Double
+ testCompute = "s = '10', d = null, r = s + d"
+ r = s + d2
+ TestLog_ASSERT r = "10", testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = null, r = s & d"
+ r = s & d2
+ TestLog_ASSERT r = "100", testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s + d"
+ d2 = 20
+ r = s + d2
+ TestLog_ASSERT r = "30", testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s & d"
+ d2 = 20
+ r = s & d2
+ TestLog_ASSERT r = "1020", testCompute & " .The result is: " & r
+
+ ''''''''''''''
+ s = "abc"
+ Dim d3 As Double
+ testCompute = "s = 'abc', d = null, r = s + d"
+ r = s + d3
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = null, r = s & d"
+ r = s & d3
+ TestLog_ASSERT r = "abc0", testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s + d"
+ d3 = 20
+ r = s + d3
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s & d"
+ d3 = 20
+ r = s & d3
+ TestLog_ASSERT r = "abc20", testCompute & " .The result is: " & r
+ Exit Sub
+
+ErrorHandler:
+ r = "-1"
+' TestLog_Comment "The next compute raises error: " & testCompute
+ Resume Next
+End Sub
+
+Sub DSS()
+ Dim testName As String
+ testName = "double = string + string"
+ Dim testCompute As String
+
+ Dim s As String
+ Dim d As String
+ Dim r As Double
+
+ On Error GoTo ErrorHandler
+
+ testCompute = "s = null, d = null, r = s + d"
+ r = s + d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = null, r = s & d"
+ r = s & d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s + d"
+ d = "20"
+ r = s + d
+ TestLog_ASSERT r = 20, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s & d"
+ d = "20"
+ r = s & d
+ TestLog_ASSERT r = 20, testCompute & " .The result is: " & r
+
+
+ ''''''''''''''
+ s = "10"
+ Dim d2 As String
+ testCompute = "s = '10', d = null, r = s + d"
+ r = s + d2
+ TestLog_ASSERT r = 10, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = null, r = s & d"
+ r = s & d2
+ TestLog_ASSERT r = 10, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s + d"
+ d2 = "20"
+ r = s + d2
+ TestLog_ASSERT r = 1020, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s & d"
+ d2 = "20"
+ r = s & d2
+ TestLog_ASSERT r = 1020, testCompute & " .The result is: " & r
+
+ ''''''''''''''
+ s = "abc"
+ Dim d3 As String
+ testCompute = "s = 'abc', d = null, r = s + d"
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = null, r = s & d"
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s + d"
+ d3 = "20"
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s & d"
+ d3 = "20"
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+ Exit Sub
+
+ErrorHandler:
+ r = -1
+' TestLog_Comment "The next compute raises error: " & testCompute
+ Resume Next
+End Sub
+
+
+
+Sub test2()
+ Dim s As String
+ Dim d As Double
+ s = ""
+ d = s ' fail in MSO
+ MsgBox d
+End Sub
+
+Sub testBolean()
+ Dim a As String
+ Dim b As Boolean
+ Dim c As Boolean
+ Dim d As String
+
+ b = True
+
+ a = "1"
+ c = a + b ' c = false
+ MsgBox c
+
+ d = a + b 'd = 0
+ MsgBox d
+End Sub
+
+Sub testCurrency()
+ Dim a As String
+ Dim b As Currency
+ Dim c As Currency
+ Dim d As String
+
+ a = "10"
+ b = 30.3
+
+ c = a + b ' c = 40.3
+ MsgBox c
+
+ d = a + b ' c =40.3
+ MsgBox d
+
+End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/strreverse.vb b/basic/qa/vba_tests/strreverse.vb
new file mode 100644
index 000000000..e0866a008
--- /dev/null
+++ b/basic/qa/vba_tests/strreverse.vb
@@ -0,0 +1,72 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testStrReverse()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testStrReverse() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test StrReverse function"
+ On Error GoTo errorHandler
+
+ date2 = "dcba"
+ date1 = StrReverse("abcd")
+ TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1
+
+ date2 = "BABABA"
+ date1 = StrReverse("ABABAB")
+ TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1
+
+ date2 = "654321"
+ date1 = StrReverse("123456")
+ TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1
+
+ date2 = "6"
+ date1 = StrReverse(6)
+ TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testStrReverse = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/switch.vb b/basic/qa/vba_tests/switch.vb
new file mode 100644
index 000000000..a6acea77d
--- /dev/null
+++ b/basic/qa/vba_tests/switch.vb
@@ -0,0 +1,67 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testSwitch()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testSwitch() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Switch function"
+ On Error GoTo errorHandler
+
+ date2 = "French"
+ date1 = MatchUp("Paris")
+ TestLog_ASSERT date1 = date2, "the return Switch is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testSwitch = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Function MatchUp(CityName As String)
+ MatchUp = Switch(CityName = "London", "English", CityName _
+ = "Rome", "Italian", CityName = "Paris", "French")
+End Function
+
+
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/timeserial.vb b/basic/qa/vba_tests/timeserial.vb
new file mode 100644
index 000000000..a663d516c
--- /dev/null
+++ b/basic/qa/vba_tests/timeserial.vb
@@ -0,0 +1,69 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testTimeSerial()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testTimeSerial() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2 As Date
+ testName = "Test TimeSerial function"
+ On Error GoTo errorHandler
+
+rem bug 114229
+rem date2 = "5:45:00"
+rem date1 = (TimeSerial(12 - 6, -15, 0))
+rem TestLog_ASSERT date1 = date2, "the return TimeSerial is: " & date1
+
+ date2 = "12:30:00"
+ date1 = TimeSerial(12, 30, 0)
+ TestLog_ASSERT date1 = date2, "the return TimeSerial is: " & date1
+
+rem date2 = "11:30:00"
+rem date1 = TimeSerial(10, 90, 0)
+rem TestLog_ASSERT date1 = date2, "the return TimeSerial is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testTimeSerial = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/timevalue.vb b/basic/qa/vba_tests/timevalue.vb
new file mode 100644
index 000000000..a27feb35a
--- /dev/null
+++ b/basic/qa/vba_tests/timevalue.vb
@@ -0,0 +1,59 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testTimeValue()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testTimeValue() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+
+ Dim date1, date2 As Date 'variables for test
+ testName = "Test TimeValue function"
+ On Error GoTo errorHandler
+
+ date2 = "16:35:17"
+ date1 = TimeValue("4:35:17 PM")
+ TestLog_ASSERT date1 = date2, "the return TimeValue is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testTimeValue = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/trim.vb b/basic/qa/vba_tests/trim.vb
new file mode 100644
index 000000000..c61845d5d
--- /dev/null
+++ b/basic/qa/vba_tests/trim.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testTrim()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testTrim() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Trim function"
+ On Error GoTo errorHandler
+
+ date2 = "some text"
+ date1 = Trim(" some text ")
+ TestLog_ASSERT date1 = date2, "the return Trim is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testTrim = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/typename.vb b/basic/qa/vba_tests/typename.vb
new file mode 100644
index 000000000..7e49a4d61
--- /dev/null
+++ b/basic/qa/vba_tests/typename.vb
@@ -0,0 +1,96 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testTypeName()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testTypeName() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test TypeName function"
+ On Error GoTo errorHandler
+ Dim b1 As Boolean
+ Dim c1 As Byte
+ Dim d1 As Date
+ Dim d2 As Double
+ Dim i1 As Integer
+ Dim l1 As Long
+
+ date2 = "String"
+ date1 = TypeName(testName)
+ TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1
+
+ date2 = "Boolean"
+ date1 = TypeName(b1)
+ TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1
+
+ date2 = "Byte"
+ date1 = TypeName(c1)
+ TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1
+
+ date2 = "Date"
+ date1 = TypeName(d1)
+ TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1
+
+ date2 = "Double"
+ date1 = TypeName(d2)
+ TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1
+
+ date2 = "Integer"
+ date1 = TypeName(i1)
+ TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1
+
+ date2 = "Long"
+ date1 = TypeName(l1)
+ TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1
+
+ ' tdf#129596 - Types of constant values
+ TestLog_ASSERT TypeName(32767) = "Integer", "the return TypeName(32767) is: " & TypeName(32767)
+ TestLog_ASSERT TypeName(-32767) = "Integer", "the return TypeName(-32767) is: " & TypeName(-32767)
+ TestLog_ASSERT TypeName(1048575) = "Long", "the return TypeName(1048575) is: " & TypeName(1048575)
+ TestLog_ASSERT TypeName(-1048575) = "Long", "the return TypeName(-1048575) is: " & TypeName(-1048575)
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testTypeName = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/ubound.vb b/basic/qa/vba_tests/ubound.vb
new file mode 100644
index 000000000..e52299fb4
--- /dev/null
+++ b/basic/qa/vba_tests/ubound.vb
@@ -0,0 +1,69 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testUBound()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testUBound() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test UBound function"
+ On Error GoTo errorHandler
+ Dim A(1 To 100, 0 To 3, -3 To 4)
+
+ date2 = 100
+ date1 = UBound(A, 1)
+ TestLog_ASSERT date1 = date2, "the return UBound is: " & date1
+
+ date2 = 3
+ date1 = UBound(A, 2)
+ TestLog_ASSERT date1 = date2, "the return UBound is: " & date1
+
+ date2 = 4
+ date1 = UBound(A, 3)
+ TestLog_ASSERT date1 = date2, "the return UBound is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testUBound = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/ucase.vb b/basic/qa/vba_tests/ucase.vb
new file mode 100644
index 000000000..369be4f8e
--- /dev/null
+++ b/basic/qa/vba_tests/ucase.vb
@@ -0,0 +1,60 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testUCase()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testUCase() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test UCase function"
+ On Error GoTo errorHandler
+
+ date2 = "HELLO 12"
+ date1 = UCase("hello 12") '2/12/1969
+ TestLog_ASSERT date1 = date2, "the return UCase is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testUCase = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/val.vb b/basic/qa/vba_tests/val.vb
new file mode 100644
index 000000000..39796d7b4
--- /dev/null
+++ b/basic/qa/vba_tests/val.vb
@@ -0,0 +1,92 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testVal()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testVal() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Val function"
+ On Error GoTo errorHandler
+
+ date2 = 2
+ date1 = Val("02/04/2010")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+
+ date2 = 1050
+ date1 = Val("1050")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+
+ date2 = 130.75
+ date1 = Val("130.75")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+
+ date2 = 50
+ date1 = Val("50 Park Lane")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+
+ date2 = 1320
+ date1 = Val("1320 then some text")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+
+ date2 = 0
+ date1 = Val("L13.5")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+
+ date2 = 0
+ date1 = Val("sometext")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+
+REM date2 = 1
+REM date1 = Val("1, 2")
+REM TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+REM tdf#111999
+
+ date2 = -1
+ date1 = Val("&HFFFF")
+ TestLog_ASSERT date1 = date2, "the return Val is: " & date1
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testVal = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/vartype.vb b/basic/qa/vba_tests/vartype.vb
new file mode 100644
index 000000000..f500268ae
--- /dev/null
+++ b/basic/qa/vba_tests/vartype.vb
@@ -0,0 +1,86 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testVarType()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testVarType() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim TestDateTime As Date
+ Dim TestStr As String
+ Dim TestInt As Integer
+ Dim TestLong As Long
+ Dim TestDouble As Double
+ Dim TestBoo As Boolean
+ Dim date1, date2
+ testName = "Test VarType function"
+ On Error GoTo errorHandler
+
+ date2 = 8
+ date1 = VarType(testName)
+ TestLog_ASSERT date1 = date2, "the return VarType is: " & date1
+
+ date2 = 11
+ date1 = VarType(TestBoo)
+ TestLog_ASSERT date1 = date2, "the return VarType is: " & date1
+
+ date2 = 5
+ date1 = VarType(TestDouble)
+ TestLog_ASSERT date1 = date2, "the return VarType is: " & date1
+
+ date2 = 3
+ date1 = VarType(TestLong)
+ TestLog_ASSERT date1 = date2, "the return VarType is: " & date1
+
+ date2 = 2
+ date1 = VarType(TestInt)
+ TestLog_ASSERT date1 = date2, "the return VarType is: " & date1
+
+ date2 = 7
+ date1 = VarType(TestDateTime)
+ TestLog_ASSERT date1 = date2, "the return VarType is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testVarType = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/weekday.vb b/basic/qa/vba_tests/weekday.vb
new file mode 100644
index 000000000..a37f07d1f
--- /dev/null
+++ b/basic/qa/vba_tests/weekday.vb
@@ -0,0 +1,81 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testWeekDay()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testWeekDay() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test WeekDay function"
+ On Error GoTo errorHandler
+
+ date2 = 7
+ date1 = Weekday(#6/7/2009#, vbMonday)
+ TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1
+
+ date2 = 2
+ date1 = Weekday(#7/7/2009#, vbMonday)
+ TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1
+
+ date2 = 5
+ date1 = Weekday(#8/7/2009#, vbMonday)
+ TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1
+
+ date2 = 1
+ date1 = Weekday(#12/7/2009#, vbMonday)
+ TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1
+
+ date2 = 1
+ date1 = Weekday(#6/7/2009#, vbSunday)
+ TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1
+
+ date2 = 5
+ date1 = Weekday(#6/7/2009#, 4)
+ TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1
+
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testWeekDay = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/weekdayname.vb b/basic/qa/vba_tests/weekdayname.vb
new file mode 100644
index 000000000..6c8f0b575
--- /dev/null
+++ b/basic/qa/vba_tests/weekdayname.vb
@@ -0,0 +1,84 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testWeekDayName()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testWeekDayName() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test WeekDayName function"
+ On Error GoTo errorHandler
+
+ date2 = "Sunday"
+ date1 = WeekdayName(1)
+ TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1
+
+ date2 = "Sunday"
+ date1 = WeekdayName(1, , vbSunday)
+ TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1
+
+ date2 = "Monday"
+ date1 = WeekdayName(1, , vbMonday)
+ TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1
+
+ date2 = "Monday"
+ date1 = WeekdayName(2)
+ TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1
+
+ date2 = "Tue"
+ date1 = WeekdayName(2, True, vbMonday)
+ TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1
+
+ date2 = "Wed"
+ date1 = WeekdayName(2, True, vbTuesday)
+ TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1
+
+ date2 = "Thu"
+ date1 = WeekdayName(2, True, vbWednesday)
+ TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testWeekDayName = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/win32compat.vb b/basic/qa/vba_tests/win32compat.vb
new file mode 100644
index 000000000..58a8e4e51
--- /dev/null
+++ b/basic/qa/vba_tests/win32compat.vb
@@ -0,0 +1,86 @@
+Option VBASupport 1
+Option Explicit
+
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+'
+' Test built-in compatibility versions of methods whose absence
+' is really felt in VBA, and large numbers of macros import from
+' the system.
+'
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As Currency) As Long
+Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As Currency) As Long
+
+' FIXME: all this cut/paste should be factored out !
+
+Function doUnitTest() As String
+ result = verify_win32compat()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+ Else
+ doUnitTest = "OK"
+ End If
+End Function
+
+
+Function verify_win32compat() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "================" & Chr$(10)
+
+ Dim freq As Currency
+ Dim count_a As Currency
+ Dim count_b As Currency
+ Dim success As Long
+
+ On Error GoTo errorHandler
+
+ success = QueryPerformanceFrequency(freq)
+ TestLog_ASSERT success <> 0, "fetching perf. frequency"
+ TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq
+
+ success = QueryPerformanceCounter(count_a)
+ TestLog_ASSERT success <> 0, "fetching performance count"
+
+ success = QueryPerformanceCounter(count_b)
+ TestLog_ASSERT success <> 0, "fetching performance count"
+ TestLog_ASSERT count_a < count_b, "count mismatch " & count_a & " is > " & count_b
+
+ verify_win32compat = "OK"
+ Exit Function
+
+errorHandler:
+ TestLog_ASSERT (False), "hit error handler - " & Err & ": " & Error$ & " (line : " & Erl & ")"
+ verify_win32compat = result
+
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/win32compatb.vb b/basic/qa/vba_tests/win32compatb.vb
new file mode 100644
index 000000000..56335c62f
--- /dev/null
+++ b/basic/qa/vba_tests/win32compatb.vb
@@ -0,0 +1,104 @@
+Option VBASupport 1
+Option Explicit
+
+'
+' This file is part of the LibreOffice project.
+'
+' This Source Code Form is subject to the terms of the Mozilla Public
+' License, v. 2.0. If a copy of the MPL was not distributed with this
+' file, You can obtain one at http://mozilla.org/MPL/2.0/.
+'
+'
+' Test built-in compatibility versions of methods whose absence
+' is really felt in VBA, and large numbers of macros import from
+' the system.
+'
+' This module tests different signatures for the same methods.
+'
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Private Type LARGE_INTEGER
+ lowpart As Long
+ highpart As Long
+End Type
+
+Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
+Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
+
+' FIXME: all this cut/paste should be factored out !
+
+Function doUnitTest() As String
+ result = verify_win32compat()
+ If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+ Else
+ doUnitTest = "OK"
+ End If
+End Function
+
+Function convertLarge(scratch As LARGE_INTEGER) As Double
+ Dim ret As Double
+ ret = scratch.highpart
+ ret = ret * 65536 * 65536
+ ret = ret + scratch.lowpart
+ convertLarge = ret
+End Function
+
+Function verify_win32compat() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "================" & Chr$(10)
+
+ Dim scratch as LARGE_INTEGER
+ Dim freq As Double
+ Dim count_a As Double
+ Dim count_b As Double
+ Dim success As Long
+
+ On Error GoTo errorHandler
+
+ success = QueryPerformanceFrequency(scratch)
+ TestLog_ASSERT success <> 0, "fetching perf. frequency"
+ freq = convertLarge(scratch)
+ TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq
+
+ success = QueryPerformanceCounter(scratch)
+ TestLog_ASSERT success <> 0, "fetching performance count"
+ count_a = convertLarge(scratch)
+
+' success = QueryPerformanceCounter(scratch)
+' TestLog_ASSERT success <> 0, "fetching performance count"
+' count_b = convertLarge(scratch)
+' TestLog_ASSERT count_a < count_b, "count mismatch " & count_a & " is > " & count_b
+
+ verify_win32compat = "OK"
+ Exit Function
+
+errorHandler:
+ TestLog_ASSERT (False), "hit error handler - " & Err & ": " & Error$ & " (line : " & Erl & ")"
+ verify_win32compat = result
+
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/year.vb b/basic/qa/vba_tests/year.vb
new file mode 100644
index 000000000..62d08234d
--- /dev/null
+++ b/basic/qa/vba_tests/year.vb
@@ -0,0 +1,64 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testYear()
+If failCount <> 0 or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testYear() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim date1, date2
+ testName = "Test Year function"
+ On Error GoTo errorHandler
+
+ date2 = 1969
+ date1 = Year("12/2/1969")
+ TestLog_ASSERT date1 = date2, "the return Year is: " & date1
+
+ date2 = 1900
+ date1 = Year(256)
+ TestLog_ASSERT date1 = date2, "the return Year is: " & date1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testYear = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/source/basmgr/basicmanagerrepository.cxx b/basic/source/basmgr/basicmanagerrepository.cxx
new file mode 100644
index 000000000..01ca8759e
--- /dev/null
+++ b/basic/source/basmgr/basicmanagerrepository.cxx
@@ -0,0 +1,626 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/basicmanagerrepository.hxx>
+#include <basic/basmgr.hxx>
+#include <scriptcont.hxx>
+#include <dlgcont.hxx>
+#include <sbintern.hxx>
+#include <sbxbase.hxx>
+
+#include <com/sun/star/document/XStorageBasedDocument.hpp>
+#include <com/sun/star/document/XEmbeddedScripts.hpp>
+#include <com/sun/star/frame/Desktop.hpp>
+#include <svtools/ehdl.hxx>
+#include <svtools/sfxecode.hxx>
+#include <unotools/pathoptions.hxx>
+#include <svl/hint.hxx>
+#include <vcl/svapp.hxx>
+#include <tools/debug.hxx>
+#include <tools/diagnose_ex.h>
+#include <tools/urlobj.hxx>
+#include <comphelper/processfactory.hxx>
+#include <comphelper/documentinfo.hxx>
+#include <unotools/eventlisteneradapter.hxx>
+
+#include <sot/storage.hxx>
+
+#include <map>
+
+
+namespace basic
+{
+ using ::com::sun::star::uno::Reference;
+ using ::com::sun::star::uno::XComponentContext;
+ using ::com::sun::star::frame::XModel;
+ using ::com::sun::star::frame::Desktop;
+ using ::com::sun::star::uno::XInterface;
+ using ::com::sun::star::uno::UNO_QUERY;
+ using ::com::sun::star::embed::XStorage;
+ using ::com::sun::star::script::XPersistentLibraryContainer;
+ using ::com::sun::star::uno::UNO_QUERY_THROW;
+ using ::com::sun::star::uno::Exception;
+ using ::com::sun::star::document::XStorageBasedDocument;
+ using ::com::sun::star::document::XEmbeddedScripts;
+
+ typedef std::map< Reference< XInterface >, std::unique_ptr<BasicManager> > BasicManagerStore;
+
+ typedef std::vector< BasicManagerCreationListener* > CreationListeners;
+
+ class ImplRepository : public ::utl::OEventListenerAdapter, public SfxListener, public SvRefBase
+ {
+ private:
+ ImplRepository();
+ ~ImplRepository();
+
+ private:
+ BasicManagerStore m_aStore;
+ CreationListeners m_aCreationListeners;
+
+ public:
+ static ImplRepository& Instance();
+
+ BasicManager* getDocumentBasicManager( const Reference< XModel >& _rxDocumentModel );
+ BasicManager* getOrCreateApplicationBasicManager();
+ static BasicManager* getApplicationBasicManager();
+ static void setApplicationBasicManager( std::unique_ptr<BasicManager> _pBasicManager );
+ void registerCreationListener( BasicManagerCreationListener& _rListener );
+ void revokeCreationListener( BasicManagerCreationListener& _rListener );
+
+ private:
+ /** retrieves the location at which the BasicManager for the given model
+ is stored.
+
+ If previously, the BasicManager for this model has never been requested,
+ then the model is added to the map, with an initial NULL BasicManager.
+
+ @param _rxDocumentModel
+ the model whose BasicManager's location is to be retrieved. Must not be <NULL/>.
+
+ @precond
+ our mutex is locked
+ */
+ BasicManagerStore::iterator
+ impl_getLocationForModel( const Reference< XModel >& _rxDocumentModel );
+
+ /** tests if there is a location set at which the BasicManager for the given model
+ is stored.
+
+ @param _rxDocumentModel
+ the model whose BasicManager's location is to be retrieved. Must not be <NULL/>.
+
+ @precond
+ our mutex is locked
+ */
+ bool impl_hasLocationForModel( const Reference< XModel >& _rxDocumentModel ) const;
+
+ /** creates a new BasicManager instance for the given model
+
+ @param _out_rpBasicManager
+ reference to the pointer variable that will hold the new
+ BasicManager.
+
+ @param _rxDocumentModel
+ the model whose BasicManager will be created. Must not be <NULL/>.
+ */
+ bool impl_createManagerForModel(
+ BasicManagerStore::iterator location,
+ const Reference< XModel >& _rxDocumentModel );
+
+ /** creates the application-wide BasicManager
+ */
+ BasicManager* impl_createApplicationBasicManager();
+
+ /** notifies all listeners which expressed interest in the creation of BasicManager instances.
+ */
+ void impl_notifyCreationListeners(
+ const Reference< XModel >& _rxDocumentModel,
+ BasicManager& _rManager
+ );
+
+ /** retrieves the current storage of a given document
+
+ @param _rxDocument
+ the document whose storage is to be retrieved.
+
+ @param _out_rStorage
+ takes the storage upon successful return. Note that this might be <NULL/> even
+ if <TRUE/> is returned. In this case, the document has not yet been saved.
+
+ @return
+ <TRUE/> if the storage could be successfully retrieved (in which case
+ <arg>_out_rStorage</arg> might or might not be <NULL/>), <FALSE/> otherwise.
+ In the latter case, processing this document should stop.
+ */
+ static bool impl_getDocumentStorage_nothrow( const Reference< XModel >& _rxDocument, Reference< XStorage >& _out_rStorage );
+
+ /** retrieves the containers for Basic and Dialog libraries for a given document
+
+ @param _rxDocument
+ the document whose containers are to be retrieved.
+
+ @param _out_rxBasicLibraries
+ takes the basic library container upon successful return
+
+ @param _out_rxDialogLibraries
+ takes the dialog library container upon successful return
+
+ @return
+ <TRUE/> if and only if both containers exist, and could successfully be retrieved
+ */
+ static bool impl_getDocumentLibraryContainers_nothrow(
+ const Reference< XModel >& _rxDocument,
+ Reference< XPersistentLibraryContainer >& _out_rxBasicLibraries,
+ Reference< XPersistentLibraryContainer >& _out_rxDialogLibraries
+ );
+
+ /** initializes the given library containers, which belong to a document
+ */
+ static void impl_initDocLibraryContainers_nothrow(
+ const Reference< XPersistentLibraryContainer >& _rxBasicLibraries,
+ const Reference< XPersistentLibraryContainer >& _rxDialogLibraries
+ );
+
+ // OEventListenerAdapter overridables
+ virtual void _disposing( const css::lang::EventObject& _rSource ) override;
+
+ // SfxListener overridables
+ virtual void Notify( SfxBroadcaster& _rBC, const SfxHint& _rHint ) override;
+
+ /** removes the Model/BasicManager pair given by iterator from our store
+ */
+ void impl_removeFromRepository( const BasicManagerStore::iterator& _pos );
+
+ private:
+ StarBASIC* impl_getDefaultAppBasicLibrary();
+ };
+
+ ImplRepository::ImplRepository()
+ {
+ }
+
+ ImplRepository::~ImplRepository()
+ {
+ // Avoid double-delete of managers when they are destroyed in our dtor, and start notify us
+ for (auto& it : m_aStore)
+ EndListening(*it.second);
+ }
+
+ ImplRepository& ImplRepository::Instance()
+ {
+ tools::SvRef<SvRefBase>& repository = GetSbxData_Impl().mrImplRepository;
+ {
+ static osl::Mutex aMutex;
+ osl::MutexGuard aGuard(aMutex);
+ if (!repository)
+ repository = new ImplRepository;
+ }
+ return *static_cast<ImplRepository*>(repository.get());
+ }
+
+ BasicManager* ImplRepository::getDocumentBasicManager( const Reference< XModel >& _rxDocumentModel )
+ {
+ SolarMutexGuard g;
+
+ /* #163556# (DR) - This function may be called recursively while
+ constructing the Basic manager and loading the Basic storage. By
+ passing the map entry received from impl_getLocationForModel() to
+ the function impl_createManagerForModel(), the new Basic manager
+ will be put immediately into the map of existing Basic managers,
+ thus a recursive call of this function will find and return it
+ without creating another instance.
+ */
+ auto const loc = impl_getLocationForModel( _rxDocumentModel );
+ if (loc->second != nullptr)
+ return loc->second.get();
+ if (impl_createManagerForModel(loc, _rxDocumentModel))
+ return loc->second.get();
+ return nullptr;
+ }
+
+ BasicManager* ImplRepository::getOrCreateApplicationBasicManager()
+ {
+ SolarMutexGuard g;
+
+ BasicManager* pAppManager = GetSbData()->pAppBasMgr.get();
+ if (pAppManager == nullptr)
+ pAppManager = impl_createApplicationBasicManager();
+ return pAppManager;
+ }
+
+ BasicManager* ImplRepository::getApplicationBasicManager()
+ {
+ SolarMutexGuard g;
+
+ return GetSbData()->pAppBasMgr.get();
+ }
+
+ void ImplRepository::setApplicationBasicManager( std::unique_ptr<BasicManager> _pBasicManager )
+ {
+ SolarMutexGuard g;
+
+ GetSbData()->pAppBasMgr = std::move(_pBasicManager);
+ }
+
+
+ BasicManager* ImplRepository::impl_createApplicationBasicManager()
+ {
+ SolarMutexGuard g;
+
+ OSL_PRECOND(getApplicationBasicManager() == nullptr, "ImplRepository::impl_createApplicationBasicManager: there already is one!");
+
+ // Determine Directory
+ SvtPathOptions aPathCFG;
+ OUString aAppBasicDir( aPathCFG.GetBasicPath() );
+ if ( aAppBasicDir.isEmpty() )
+ {
+ aPathCFG.SetBasicPath("$(prog)");
+ }
+
+ // Create basic and load it
+ // AppBasicDir is now a PATH
+ INetURLObject aAppBasic( SvtPathOptions().SubstituteVariable("$(progurl)") );
+ aAppBasic.insertName( Application::GetAppName() );
+
+ BasicManager* pBasicManager = new BasicManager( new StarBASIC, &aAppBasicDir );
+ setApplicationBasicManager( std::unique_ptr<BasicManager>(pBasicManager) );
+
+ // The first dir in the path as destination:
+ OUString aFileName( aAppBasic.getName() );
+ aAppBasic = INetURLObject( aAppBasicDir.getToken(1, ';') );
+ DBG_ASSERT(aAppBasic.GetProtocol() != INetProtocol::NotValid,
+ OString("Invalid URL: \"" +
+ OUStringToOString(aAppBasicDir, osl_getThreadTextEncoding()) +
+ "\"").getStr());
+ aAppBasic.insertName( aFileName );
+ pBasicManager->SetStorageName( aAppBasic.PathToFileName() );
+
+ // Basic container
+ SfxScriptLibraryContainer* pBasicCont = new SfxScriptLibraryContainer( Reference< XStorage >() );
+ Reference< XPersistentLibraryContainer > xBasicCont( pBasicCont );
+ pBasicCont->setBasicManager( pBasicManager );
+
+ // Dialog container
+ SfxDialogLibraryContainer* pDialogCont = new SfxDialogLibraryContainer( Reference< XStorage >() );
+ Reference< XPersistentLibraryContainer > xDialogCont( pDialogCont );
+
+ LibraryContainerInfo aInfo( xBasicCont, xDialogCont, static_cast< OldBasicPassword* >( pBasicCont ) );
+ pBasicManager->SetLibraryContainerInfo( aInfo );
+
+ // global constants
+
+ // StarDesktop
+ Reference< XComponentContext > xContext = ::comphelper::getProcessComponentContext();
+ pBasicManager->SetGlobalUNOConstant( "StarDesktop", css::uno::Any( Desktop::create(xContext)));
+
+ // (BasicLibraries and DialogLibraries have automatically been added in SetLibraryContainerInfo)
+
+ // notify
+ impl_notifyCreationListeners( nullptr, *pBasicManager );
+
+ // outta here
+ return pBasicManager;
+ }
+
+
+ void ImplRepository::registerCreationListener( BasicManagerCreationListener& _rListener )
+ {
+ SolarMutexGuard g;
+
+ m_aCreationListeners.push_back( &_rListener );
+ }
+
+
+ void ImplRepository::revokeCreationListener( BasicManagerCreationListener& _rListener )
+ {
+ SolarMutexGuard g;
+
+ CreationListeners::iterator pos = std::find( m_aCreationListeners.begin(), m_aCreationListeners.end(), &_rListener );
+ if ( pos != m_aCreationListeners.end() )
+ m_aCreationListeners.erase( pos );
+ else {
+ OSL_FAIL( "ImplRepository::revokeCreationListener: listener is not registered!" );
+ }
+ }
+
+
+ void ImplRepository::impl_notifyCreationListeners( const Reference< XModel >& _rxDocumentModel, BasicManager& _rManager )
+ {
+ for (auto const& creationListener : m_aCreationListeners)
+ {
+ creationListener->onBasicManagerCreated( _rxDocumentModel, _rManager );
+ }
+ }
+
+
+ StarBASIC* ImplRepository::impl_getDefaultAppBasicLibrary()
+ {
+ BasicManager* pAppManager = getOrCreateApplicationBasicManager();
+
+ StarBASIC* pAppBasic = pAppManager ? pAppManager->GetLib(0) : nullptr;
+ DBG_ASSERT( pAppBasic != nullptr, "impl_getApplicationBasic: unable to determine the default application's Basic library!" );
+ return pAppBasic;
+ }
+
+ BasicManagerStore::iterator ImplRepository::impl_getLocationForModel( const Reference< XModel >& _rxDocumentModel )
+ {
+ Reference< XInterface > xNormalized( _rxDocumentModel, UNO_QUERY );
+ DBG_ASSERT( _rxDocumentModel.is(), "ImplRepository::impl_getLocationForModel: invalid model!" );
+
+ return m_aStore.try_emplace(xNormalized).first;
+ }
+
+ bool ImplRepository::impl_hasLocationForModel( const Reference< XModel >& _rxDocumentModel ) const
+ {
+ Reference< XInterface > xNormalized( _rxDocumentModel, UNO_QUERY );
+ DBG_ASSERT( _rxDocumentModel.is(), "ImplRepository::impl_getLocationForModel: invalid model!" );
+
+ return m_aStore.find(xNormalized) != m_aStore.end();
+ }
+
+ void ImplRepository::impl_initDocLibraryContainers_nothrow( const Reference< XPersistentLibraryContainer >& _rxBasicLibraries, const Reference< XPersistentLibraryContainer >& _rxDialogLibraries )
+ {
+ OSL_PRECOND( _rxBasicLibraries.is() && _rxDialogLibraries.is(),
+ "ImplRepository::impl_initDocLibraryContainers_nothrow: illegal library containers, this will crash!" );
+
+ try
+ {
+ // ensure there's a standard library in the basic container
+ OUString aStdLibName( "Standard" );
+ if ( !_rxBasicLibraries->hasByName( aStdLibName ) )
+ {
+ _rxBasicLibraries->createLibrary( aStdLibName );
+ }
+ // as well as in the dialog container
+ if ( !_rxDialogLibraries->hasByName( aStdLibName ) )
+ {
+ _rxDialogLibraries->createLibrary( aStdLibName );
+ }
+ }
+ catch( const Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ }
+ }
+
+ bool ImplRepository::impl_createManagerForModel( BasicManagerStore::iterator location, const Reference< XModel >& _rxDocumentModel )
+ {
+ auto & _out_rpBasicManager = location->second;
+
+ StarBASIC* pAppBasic = impl_getDefaultAppBasicLibrary();
+
+ _out_rpBasicManager = nullptr;
+ Reference< XStorage > xStorage;
+ if ( !impl_getDocumentStorage_nothrow( _rxDocumentModel, xStorage ) )
+ {
+ m_aStore.erase(location);
+ // the document is not able to provide the storage it is based on.
+ return false;
+ }
+ Reference< XPersistentLibraryContainer > xBasicLibs;
+ Reference< XPersistentLibraryContainer > xDialogLibs;
+ if ( !impl_getDocumentLibraryContainers_nothrow( _rxDocumentModel, xBasicLibs, xDialogLibs ) )
+ {
+ m_aStore.erase(location);
+ // the document does not have BasicLibraries and DialogLibraries
+ return false;
+ }
+
+ if ( xStorage.is() )
+ {
+ // load BASIC-manager
+ SfxErrorContext aErrContext( ERRCTX_SFX_LOADBASIC,
+ ::comphelper::DocumentInfo::getDocumentTitle( _rxDocumentModel ) );
+ OUString aAppBasicDir = SvtPathOptions().GetBasicPath();
+
+ // Storage and BaseURL are only needed by binary documents!
+ tools::SvRef<SotStorage> xDummyStor = new SotStorage( OUString() );
+ _out_rpBasicManager.reset(new BasicManager( *xDummyStor, OUString() /* TODO/LATER: xStorage */,
+ pAppBasic,
+ &aAppBasicDir, true ));
+ if ( !_out_rpBasicManager->GetErrors().empty() )
+ {
+ // handle errors
+ std::vector<BasicError>& aErrors = _out_rpBasicManager->GetErrors();
+ for(const auto& rError : aErrors)
+ {
+ // show message to user
+ if ( ErrorHandler::HandleError( rError.GetErrorId() ) == DialogMask::ButtonsCancel )
+ {
+ // user wants to break loading of BASIC-manager
+ _out_rpBasicManager.reset();
+ xStorage.clear();
+ break;
+ }
+ }
+ }
+ }
+
+ // not loaded?
+ if ( !xStorage.is() )
+ {
+ // create new BASIC-manager
+ StarBASIC* pBasic = new StarBASIC( pAppBasic );
+ pBasic->SetFlag( SbxFlagBits::ExtSearch );
+ _out_rpBasicManager.reset(new BasicManager( pBasic, nullptr, true ));
+ }
+
+ // knit the containers with the BasicManager
+ LibraryContainerInfo aInfo( xBasicLibs, xDialogLibs, dynamic_cast< OldBasicPassword* >( xBasicLibs.get() ) );
+ OSL_ENSURE( aInfo.mpOldBasicPassword, "ImplRepository::impl_createManagerForModel: wrong BasicLibraries implementation!" );
+ _out_rpBasicManager->SetLibraryContainerInfo( aInfo );
+
+ // initialize the containers
+ impl_initDocLibraryContainers_nothrow( xBasicLibs, xDialogLibs );
+
+ // so that also dialogs etc. could be 'qualified' addressed
+ _out_rpBasicManager->GetLib(0)->SetParent( pAppBasic );
+
+ // global properties in the document's Basic
+ _out_rpBasicManager->SetGlobalUNOConstant( "ThisComponent", css::uno::Any( _rxDocumentModel ) );
+
+ // notify
+ impl_notifyCreationListeners( _rxDocumentModel, *_out_rpBasicManager );
+
+ // register as listener for this model being disposed/closed
+ OSL_ENSURE( _rxDocumentModel.is(), "ImplRepository::impl_createManagerForModel: the document must be an XComponent!" );
+ assert(impl_hasLocationForModel(_rxDocumentModel));
+ startComponentListening( _rxDocumentModel );
+
+ bool bOk = false;
+ // startComponentListening may fail in a disposed _rxDocumentModel, in which case _out_rpBasicManager will be removed
+ // from the map and destroyed
+ if (impl_hasLocationForModel(_rxDocumentModel))
+ {
+ bOk = true;
+ // register as listener for the BasicManager being destroyed
+ StartListening( *_out_rpBasicManager );
+ }
+
+ // #i104876: Library container must not be modified just after
+ // creation. This happens as side effect when creating default
+ // "Standard" libraries and needs to be corrected here
+ xBasicLibs->setModified( false );
+ xDialogLibs->setModified( false );
+ return bOk;
+ }
+
+ bool ImplRepository::impl_getDocumentStorage_nothrow( const Reference< XModel >& _rxDocument, Reference< XStorage >& _out_rStorage )
+ {
+ _out_rStorage.clear();
+ try
+ {
+ Reference< XStorageBasedDocument > xStorDoc( _rxDocument, UNO_QUERY_THROW );
+ _out_rStorage.set( xStorDoc->getDocumentStorage() );
+ }
+ catch( const Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ return false;
+ }
+ return true;
+ }
+
+
+ bool ImplRepository::impl_getDocumentLibraryContainers_nothrow( const Reference< XModel >& _rxDocument,
+ Reference< XPersistentLibraryContainer >& _out_rxBasicLibraries, Reference< XPersistentLibraryContainer >& _out_rxDialogLibraries )
+ {
+ _out_rxBasicLibraries.clear();
+ _out_rxDialogLibraries.clear();
+ try
+ {
+ Reference< XEmbeddedScripts > xScripts( _rxDocument, UNO_QUERY_THROW );
+ _out_rxBasicLibraries.set( xScripts->getBasicLibraries(), UNO_QUERY_THROW );
+ _out_rxDialogLibraries.set( xScripts->getDialogLibraries(), UNO_QUERY_THROW );
+ }
+ catch( const Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ }
+ return _out_rxBasicLibraries.is() && _out_rxDialogLibraries.is();
+ }
+
+
+ void ImplRepository::impl_removeFromRepository( const BasicManagerStore::iterator& _pos )
+ {
+ OSL_PRECOND( _pos != m_aStore.end(), "ImplRepository::impl_removeFromRepository: invalid position!" );
+
+ std::unique_ptr<BasicManager> pManager = std::move(_pos->second);
+ Reference<XModel> xModel(_pos->first, UNO_QUERY);
+
+ // *first* remove from map (else Notify won't work properly)
+ m_aStore.erase( _pos );
+
+ EndListening( *pManager );
+
+ assert(xModel.is());
+ if (xModel.is())
+ stopComponentListening(xModel);
+ }
+
+
+ void ImplRepository::_disposing( const css::lang::EventObject& _rSource )
+ {
+ SolarMutexGuard g;
+
+ Reference< XInterface > xNormalizedSource( _rSource.Source, UNO_QUERY );
+
+ BasicManagerStore::iterator it = std::find_if(m_aStore.begin(), m_aStore.end(),
+ [&xNormalizedSource](BasicManagerStore::reference rEntry) {
+ return rEntry.first.get() == xNormalizedSource.get(); });
+ if (it != m_aStore.end())
+ {
+ impl_removeFromRepository( it );
+ return;
+ }
+
+ OSL_FAIL( "ImplRepository::_disposing: where does this come from?" );
+ }
+
+
+ void ImplRepository::Notify( SfxBroadcaster& _rBC, const SfxHint& _rHint )
+ {
+ if ( _rHint.GetId() != SfxHintId::Dying )
+ // not interested in
+ return;
+
+ BasicManager* pManager = dynamic_cast< BasicManager* >( &_rBC );
+ OSL_ENSURE( pManager, "ImplRepository::Notify: where does this come from?" );
+
+ BasicManagerStore::iterator it = std::find_if(m_aStore.begin(), m_aStore.end(),
+ [&pManager](BasicManagerStore::reference rEntry) { return rEntry.second.get() == pManager; });
+ if (it != m_aStore.end())
+ {
+ // a BasicManager which is still in our repository is being deleted.
+ // That's bad, since by definition, we *own* all instances in our
+ // repository.
+ OSL_FAIL( "ImplRepository::Notify: nobody should tamper with the managers, except ourself!" );
+ m_aStore.erase( it );
+ }
+ }
+
+ BasicManager* BasicManagerRepository::getDocumentBasicManager( const Reference< XModel >& _rxDocumentModel )
+ {
+ return ImplRepository::Instance().getDocumentBasicManager( _rxDocumentModel );
+ }
+
+ BasicManager* BasicManagerRepository::getApplicationBasicManager()
+ {
+ return ImplRepository::Instance().getOrCreateApplicationBasicManager();
+ }
+
+ void BasicManagerRepository::resetApplicationBasicManager()
+ {
+ ImplRepository::setApplicationBasicManager( nullptr );
+ }
+
+ void BasicManagerRepository::registerCreationListener( BasicManagerCreationListener& _rListener )
+ {
+ ImplRepository::Instance().registerCreationListener( _rListener );
+ }
+
+ void BasicManagerRepository::revokeCreationListener( BasicManagerCreationListener& _rListener )
+ {
+ ImplRepository::Instance().revokeCreationListener( _rListener );
+ }
+
+} // namespace basic
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/basmgr/basmgr.cxx b/basic/source/basmgr/basmgr.cxx
new file mode 100644
index 000000000..753aaf04b
--- /dev/null
+++ b/basic/source/basmgr/basmgr.cxx
@@ -0,0 +1,2141 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <vcl/errinf.hxx>
+#include <tools/stream.hxx>
+#include <sot/storage.hxx>
+#include <tools/urlobj.hxx>
+#include <svl/hint.hxx>
+#include <basic/sbx.hxx>
+#include <basic/sbmeth.hxx>
+#include <sot/storinfo.hxx>
+#include <unotools/pathoptions.hxx>
+#include <tools/debug.hxx>
+#include <tools/diagnose_ex.h>
+#include <basic/sbmod.hxx>
+#include <unotools/transliterationwrapper.hxx>
+#include <sal/log.hxx>
+
+#include <basic/sberrors.hxx>
+#include <basic/sbuno.hxx>
+#include <basic/basmgr.hxx>
+#include <global.hxx>
+#include <com/sun/star/script/XLibraryContainer.hpp>
+#include <com/sun/star/script/XPersistentLibraryContainer.hpp>
+
+#include <memory>
+#include <vector>
+
+#define LIB_SEP 0x01
+#define LIBINFO_SEP 0x02
+#define LIBINFO_ID 0x1491
+#define PASSWORD_MARKER 0x31452134
+
+
+// Library API, implemented for XML import/export
+
+#include <com/sun/star/container/XNameContainer.hpp>
+#include <com/sun/star/container/XContainer.hpp>
+#include <com/sun/star/script/XStarBasicAccess.hpp>
+#include <com/sun/star/script/XStarBasicModuleInfo.hpp>
+#include <com/sun/star/script/XStarBasicDialogInfo.hpp>
+#include <com/sun/star/script/XStarBasicLibraryInfo.hpp>
+#include <com/sun/star/script/XLibraryContainerPassword.hpp>
+#include <com/sun/star/script/ModuleInfo.hpp>
+#include <com/sun/star/script/vba/XVBACompatibility.hpp>
+#include <com/sun/star/script/vba/XVBAModuleInfo.hpp>
+#include <com/sun/star/ucb/ContentCreationException.hpp>
+
+#include <cppuhelper/implbase.hxx>
+
+using com::sun::star::uno::Reference;
+using namespace com::sun::star;
+using namespace com::sun::star::script;
+using namespace cppu;
+
+typedef WeakImplHelper< container::XNameContainer > NameContainerHelper;
+typedef WeakImplHelper< script::XStarBasicModuleInfo > ModuleInfoHelper;
+typedef WeakImplHelper< script::XStarBasicAccess > StarBasicAccessHelper;
+
+// Version 1
+// sal_uInt32 nEndPos
+// sal_uInt16 nId
+// sal_uInt16 nVer
+// bool bDoLoad
+// String LibName
+// String AbsStorageName
+// String RelStorageName
+// Version 2
+// + bool bReference
+
+static const char szStdLibName[] = "Standard";
+static const char szBasicStorage[] = "StarBASIC";
+static const char szOldManagerStream[] = "BasicManager";
+static const char szManagerStream[] = "BasicManager2";
+static const char szImbedded[] = "LIBIMBEDDED";
+static const char szCryptingKey[] = "CryptedBasic";
+
+
+const StreamMode eStreamReadMode = StreamMode::READ | StreamMode::NOCREATE | StreamMode::SHARE_DENYALL;
+const StreamMode eStorageReadMode = StreamMode::READ | StreamMode::SHARE_DENYWRITE;
+
+
+// BasicManager impl data
+struct BasicManagerImpl
+{
+ LibraryContainerInfo maContainerInfo;
+
+ std::vector<std::unique_ptr<BasicLibInfo>> aLibs;
+ OUString aBasicLibPath;
+
+ BasicManagerImpl()
+ {}
+};
+
+// BasMgrContainerListenerImpl
+
+
+typedef ::cppu::WeakImplHelper< container::XContainerListener > ContainerListenerHelper;
+
+class BasMgrContainerListenerImpl: public ContainerListenerHelper
+{
+ BasicManager* mpMgr;
+ OUString maLibName; // empty -> no lib, but lib container
+
+public:
+ BasMgrContainerListenerImpl( BasicManager* pMgr, const OUString& aLibName )
+ : mpMgr( pMgr )
+ , maLibName( aLibName ) {}
+
+ static void insertLibraryImpl( const uno::Reference< script::XLibraryContainer >& xScriptCont, BasicManager* pMgr,
+ const uno::Any& aLibAny, const OUString& aLibName );
+ static void addLibraryModulesImpl( BasicManager const * pMgr, const uno::Reference< container::XNameAccess >& xLibNameAccess,
+ const OUString& aLibName );
+
+
+ // XEventListener
+ virtual void SAL_CALL disposing( const lang::EventObject& Source ) override;
+
+ // XContainerListener
+ virtual void SAL_CALL elementInserted( const container::ContainerEvent& Event ) override;
+ virtual void SAL_CALL elementReplaced( const container::ContainerEvent& Event ) override;
+ virtual void SAL_CALL elementRemoved( const container::ContainerEvent& Event ) override;
+};
+
+
+// BasMgrContainerListenerImpl
+
+
+void BasMgrContainerListenerImpl::insertLibraryImpl( const uno::Reference< script::XLibraryContainer >& xScriptCont,
+ BasicManager* pMgr, const uno::Any& aLibAny, const OUString& aLibName )
+{
+ Reference< container::XNameAccess > xLibNameAccess;
+ aLibAny >>= xLibNameAccess;
+
+ if( !pMgr->GetLib( aLibName ) )
+ {
+ StarBASIC* pLib =
+ pMgr->CreateLibForLibContainer( aLibName, xScriptCont );
+ DBG_ASSERT( pLib, "XML Import: Basic library could not be created");
+ }
+
+ uno::Reference< container::XContainer> xLibContainer( xLibNameAccess, uno::UNO_QUERY );
+ if( xLibContainer.is() )
+ {
+ // Register listener for library
+ Reference< container::XContainerListener > xLibraryListener
+ = new BasMgrContainerListenerImpl( pMgr, aLibName );
+ xLibContainer->addContainerListener( xLibraryListener );
+ }
+
+ if( xScriptCont->isLibraryLoaded( aLibName ) )
+ {
+ addLibraryModulesImpl( pMgr, xLibNameAccess, aLibName );
+ }
+}
+
+
+void BasMgrContainerListenerImpl::addLibraryModulesImpl( BasicManager const * pMgr,
+ const uno::Reference< container::XNameAccess >& xLibNameAccess, const OUString& aLibName )
+{
+ uno::Sequence< OUString > aModuleNames = xLibNameAccess->getElementNames();
+ sal_Int32 nModuleCount = aModuleNames.getLength();
+
+ StarBASIC* pLib = pMgr->GetLib( aLibName );
+ DBG_ASSERT( pLib, "BasMgrContainerListenerImpl::addLibraryModulesImpl: Unknown lib!");
+ if( !pLib )
+ return;
+
+ const OUString* pNames = aModuleNames.getConstArray();
+ for( sal_Int32 j = 0 ; j < nModuleCount ; j++ )
+ {
+ OUString aModuleName = pNames[ j ];
+ uno::Any aElement = xLibNameAccess->getByName( aModuleName );
+ OUString aMod;
+ aElement >>= aMod;
+ uno::Reference< vba::XVBAModuleInfo > xVBAModuleInfo( xLibNameAccess, uno::UNO_QUERY );
+ if ( xVBAModuleInfo.is() && xVBAModuleInfo->hasModuleInfo( aModuleName ) )
+ {
+ ModuleInfo aInfo = xVBAModuleInfo->getModuleInfo( aModuleName );
+ pLib->MakeModule( aModuleName, aInfo, aMod );
+ }
+ else
+ pLib->MakeModule( aModuleName, aMod );
+ }
+
+ pLib->SetModified( false );
+}
+
+
+// XEventListener
+
+
+void SAL_CALL BasMgrContainerListenerImpl::disposing( const lang::EventObject& ) {}
+
+// XContainerListener
+
+
+void SAL_CALL BasMgrContainerListenerImpl::elementInserted( const container::ContainerEvent& Event )
+{
+ bool bLibContainer = maLibName.isEmpty();
+ OUString aName;
+ Event.Accessor >>= aName;
+
+ if( bLibContainer )
+ {
+ uno::Reference< script::XLibraryContainer > xScriptCont( Event.Source, uno::UNO_QUERY );
+ if (xScriptCont.is())
+ insertLibraryImpl(xScriptCont, mpMgr, Event.Element, aName);
+ StarBASIC* pLib = mpMgr->GetLib( aName );
+ if ( pLib )
+ {
+ uno::Reference< vba::XVBACompatibility > xVBACompat( xScriptCont, uno::UNO_QUERY );
+ if ( xVBACompat.is() )
+ pLib->SetVBAEnabled( xVBACompat->getVBACompatibilityMode() );
+ }
+ }
+ else
+ {
+
+ StarBASIC* pLib = mpMgr->GetLib( maLibName );
+ DBG_ASSERT( pLib, "BasMgrContainerListenerImpl::elementInserted: Unknown lib!");
+ if( pLib )
+ {
+ SbModule* pMod = pLib->FindModule( aName );
+ if( !pMod )
+ {
+ OUString aMod;
+ Event.Element >>= aMod;
+ uno::Reference< vba::XVBAModuleInfo > xVBAModuleInfo( Event.Source, uno::UNO_QUERY );
+ if ( xVBAModuleInfo.is() && xVBAModuleInfo->hasModuleInfo( aName ) )
+ {
+ ModuleInfo aInfo = xVBAModuleInfo->getModuleInfo( aName );
+ pLib->MakeModule( aName, aInfo, aMod );
+ }
+ else
+ pLib->MakeModule( aName, aMod );
+ pLib->SetModified( false );
+ }
+ }
+ }
+}
+
+
+void SAL_CALL BasMgrContainerListenerImpl::elementReplaced( const container::ContainerEvent& Event )
+{
+ OUString aName;
+ Event.Accessor >>= aName;
+
+ // Replace not possible for library container
+ DBG_ASSERT( !maLibName.isEmpty(), "library container fired elementReplaced()");
+
+ StarBASIC* pLib = mpMgr->GetLib( maLibName );
+ if( !pLib )
+ return;
+
+ SbModule* pMod = pLib->FindModule( aName );
+ OUString aMod;
+ Event.Element >>= aMod;
+
+ if( pMod )
+ pMod->SetSource32( aMod );
+ else
+ pLib->MakeModule( aName, aMod );
+
+ pLib->SetModified( false );
+}
+
+
+void SAL_CALL BasMgrContainerListenerImpl::elementRemoved( const container::ContainerEvent& Event )
+{
+ OUString aName;
+ Event.Accessor >>= aName;
+
+ bool bLibContainer = maLibName.isEmpty();
+ if( bLibContainer )
+ {
+ StarBASIC* pLib = mpMgr->GetLib( aName );
+ if( pLib )
+ {
+ sal_uInt16 nLibId = mpMgr->GetLibId( aName );
+ mpMgr->RemoveLib( nLibId, false );
+ }
+ }
+ else
+ {
+ StarBASIC* pLib = mpMgr->GetLib( maLibName );
+ SbModule* pMod = pLib ? pLib->FindModule( aName ) : nullptr;
+ if( pMod )
+ {
+ pLib->Remove( pMod );
+ pLib->SetModified( false );
+ }
+ }
+}
+
+BasicError::BasicError( ErrCode nId, BasicErrorReason nR )
+{
+ nErrorId = nId;
+ nReason = nR;
+}
+
+BasicError::BasicError( const BasicError& rErr )
+{
+ nErrorId = rErr.nErrorId;
+ nReason = rErr.nReason;
+}
+
+
+class BasicLibInfo
+{
+private:
+ StarBASICRef xLib;
+ OUString aLibName;
+ OUString aStorageName; // string is sufficient, unique at runtime
+ OUString aRelStorageName;
+ OUString aPassword;
+
+ bool bDoLoad;
+ bool bReference;
+
+ // Lib represents library in new UNO library container
+ uno::Reference< script::XLibraryContainer > mxScriptCont;
+
+public:
+ BasicLibInfo();
+
+ bool IsReference() const { return bReference; }
+ void SetReference(bool b) { bReference = b; }
+
+ bool IsExtern() const { return aStorageName != szImbedded; }
+
+ void SetStorageName( const OUString& rName ) { aStorageName = rName; }
+ const OUString& GetStorageName() const { return aStorageName; }
+
+ void SetRelStorageName( const OUString& rN ) { aRelStorageName = rN; }
+ const OUString& GetRelStorageName() const { return aRelStorageName; }
+
+ StarBASICRef GetLib() const
+ {
+ if( mxScriptCont.is() && mxScriptCont->hasByName( aLibName ) &&
+ !mxScriptCont->isLibraryLoaded( aLibName ) )
+ return StarBASICRef();
+ return xLib;
+ }
+ StarBASICRef& GetLibRef() { return xLib; }
+ void SetLib( StarBASIC* pBasic ) { xLib = pBasic; }
+
+ const OUString& GetLibName() const { return aLibName; }
+ void SetLibName( const OUString& rName ) { aLibName = rName; }
+
+ // Only temporary for Load/Save
+ bool DoLoad() { return bDoLoad; }
+
+ bool HasPassword() const { return !aPassword.isEmpty(); }
+ const OUString& GetPassword() const { return aPassword; }
+ void SetPassword( const OUString& rNewPassword )
+ { aPassword = rNewPassword; }
+
+ static BasicLibInfo* Create( SotStorageStream& rSStream );
+
+ const uno::Reference< script::XLibraryContainer >& GetLibraryContainer() const
+ { return mxScriptCont; }
+ void SetLibraryContainer( const uno::Reference< script::XLibraryContainer >& xScriptCont )
+ { mxScriptCont = xScriptCont; }
+};
+
+
+BasicLibInfo::BasicLibInfo()
+ : aStorageName(szImbedded)
+ , aRelStorageName(szImbedded)
+ , bDoLoad(false)
+ , bReference(false)
+{
+}
+
+BasicLibInfo* BasicLibInfo::Create( SotStorageStream& rSStream )
+{
+ BasicLibInfo* pInfo = new BasicLibInfo;
+
+ sal_uInt32 nEndPos;
+ sal_uInt16 nId;
+ sal_uInt16 nVer;
+
+ rSStream.ReadUInt32( nEndPos );
+ rSStream.ReadUInt16( nId );
+ rSStream.ReadUInt16( nVer );
+
+ DBG_ASSERT( nId == LIBINFO_ID, "No BasicLibInfo?!" );
+ if( nId == LIBINFO_ID )
+ {
+ // Reload?
+ bool bDoLoad;
+ rSStream.ReadCharAsBool( bDoLoad );
+ pInfo->bDoLoad = bDoLoad;
+
+ // The name of the lib...
+ OUString aName = rSStream.ReadUniOrByteString(rSStream.GetStreamCharSet());
+ pInfo->SetLibName( aName );
+
+ // Absolute path...
+ OUString aStorageName = rSStream.ReadUniOrByteString(rSStream.GetStreamCharSet());
+ pInfo->SetStorageName( aStorageName );
+
+ // Relative path...
+ OUString aRelStorageName = rSStream.ReadUniOrByteString(rSStream.GetStreamCharSet());
+ pInfo->SetRelStorageName( aRelStorageName );
+
+ if ( nVer >= 2 )
+ {
+ bool bReferenz;
+ rSStream.ReadCharAsBool( bReferenz );
+ pInfo->SetReference(bReferenz);
+ }
+
+ rSStream.Seek( nEndPos );
+ }
+ return pInfo;
+}
+
+BasicManager::BasicManager( SotStorage& rStorage, const OUString& rBaseURL, StarBASIC* pParentFromStdLib, OUString const * pLibPath, bool bDocMgr ) : mbDocMgr( bDocMgr )
+{
+ Init();
+
+ if( pLibPath )
+ {
+ mpImpl->aBasicLibPath = *pLibPath;
+ }
+ OUString aStorName( rStorage.GetName() );
+ maStorageName = INetURLObject(aStorName, INetProtocol::File).GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+
+ // If there is no Manager Stream, no further actions are necessary
+ if ( rStorage.IsStream( szManagerStream ) )
+ {
+ LoadBasicManager( rStorage, rBaseURL );
+ // StdLib contains Parent:
+ StarBASIC* pStdLib = GetStdLib();
+ DBG_ASSERT( pStdLib, "Standard-Lib not loaded?" );
+ if ( !pStdLib )
+ {
+ // Should never happen, but if it happens we won't crash...
+ pStdLib = new StarBASIC( nullptr, mbDocMgr );
+
+ if (mpImpl->aLibs.empty())
+ CreateLibInfo();
+
+ BasicLibInfo& rStdLibInfo = *mpImpl->aLibs.front();
+
+ rStdLibInfo.SetLib( pStdLib );
+ StarBASICRef xStdLib = rStdLibInfo.GetLib();
+ xStdLib->SetName( szStdLibName );
+ rStdLibInfo.SetLibName( szStdLibName );
+ xStdLib->SetFlag( SbxFlagBits::DontStore | SbxFlagBits::ExtSearch );
+ xStdLib->SetModified( false );
+ }
+ else
+ {
+ pStdLib->SetParent( pParentFromStdLib );
+ // The other get StdLib as parent:
+
+ for ( sal_uInt16 nBasic = 1; nBasic < GetLibCount(); nBasic++ )
+ {
+ StarBASIC* pBasic = GetLib( nBasic );
+ if ( pBasic )
+ {
+ pStdLib->Insert( pBasic );
+ pBasic->SetFlag( SbxFlagBits::ExtSearch );
+ }
+ }
+ // Modified through insert
+ pStdLib->SetModified( false );
+ }
+ }
+ else
+ {
+ ImpCreateStdLib( pParentFromStdLib );
+ if ( rStorage.IsStream( szOldManagerStream ) )
+ LoadOldBasicManager( rStorage );
+ }
+}
+
+static void copyToLibraryContainer( StarBASIC* pBasic, const LibraryContainerInfo& rInfo )
+{
+ uno::Reference< script::XLibraryContainer > xScriptCont( rInfo.mxScriptCont.get() );
+ if ( !xScriptCont.is() )
+ return;
+
+ OUString aLibName = pBasic->GetName();
+ if( !xScriptCont->hasByName( aLibName ) )
+ xScriptCont->createLibrary( aLibName );
+
+ uno::Any aLibAny = xScriptCont->getByName( aLibName );
+ uno::Reference< container::XNameContainer > xLib;
+ aLibAny >>= xLib;
+ if ( !xLib.is() )
+ return;
+
+ for ( const auto& pModule: pBasic->GetModules() )
+ {
+ OUString aModName = pModule->GetName();
+ if( !xLib->hasByName( aModName ) )
+ {
+ OUString aSource = pModule->GetSource32();
+ uno::Any aSourceAny;
+ aSourceAny <<= aSource;
+ xLib->insertByName( aModName, aSourceAny );
+ }
+ }
+}
+
+const uno::Reference< script::XPersistentLibraryContainer >& BasicManager::GetDialogLibraryContainer() const
+{
+ return mpImpl->maContainerInfo.mxDialogCont;
+}
+
+const uno::Reference< script::XPersistentLibraryContainer >& BasicManager::GetScriptLibraryContainer() const
+{
+ return mpImpl->maContainerInfo.mxScriptCont;
+}
+
+void BasicManager::SetLibraryContainerInfo( const LibraryContainerInfo& rInfo )
+{
+ mpImpl->maContainerInfo = rInfo;
+
+ uno::Reference< script::XLibraryContainer > xScriptCont( mpImpl->maContainerInfo.mxScriptCont.get() );
+ if( xScriptCont.is() )
+ {
+ // Register listener for lib container
+ uno::Reference< container::XContainerListener > xLibContainerListener
+ = new BasMgrContainerListenerImpl( this, "" );
+
+ uno::Reference< container::XContainer> xLibContainer( xScriptCont, uno::UNO_QUERY );
+ xLibContainer->addContainerListener( xLibContainerListener );
+
+ const uno::Sequence< OUString > aScriptLibNames = xScriptCont->getElementNames();
+
+ if( aScriptLibNames.hasElements() )
+ {
+ for(const auto& rScriptLibName : aScriptLibNames)
+ {
+ uno::Any aLibAny = xScriptCont->getByName( rScriptLibName );
+
+ if ( rScriptLibName == "Standard" || rScriptLibName == "VBAProject")
+ xScriptCont->loadLibrary( rScriptLibName );
+
+ BasMgrContainerListenerImpl::insertLibraryImpl
+ ( xScriptCont, this, aLibAny, rScriptLibName );
+ }
+ }
+ else
+ {
+ // No libs? Maybe an 5.2 document already loaded
+ for (auto const& rpBasLibInfo : mpImpl->aLibs)
+ {
+ StarBASIC* pLib = rpBasLibInfo->GetLib().get();
+ if( !pLib )
+ {
+ bool bLoaded = ImpLoadLibrary( rpBasLibInfo.get(), nullptr );
+ if( bLoaded )
+ pLib = rpBasLibInfo->GetLib().get();
+ }
+ if( pLib )
+ {
+ copyToLibraryContainer( pLib, mpImpl->maContainerInfo );
+ if (rpBasLibInfo->HasPassword())
+ {
+ OldBasicPassword* pOldBasicPassword =
+ mpImpl->maContainerInfo.mpOldBasicPassword;
+ if( pOldBasicPassword )
+ {
+ pOldBasicPassword->setLibraryPassword(
+ pLib->GetName(), rpBasLibInfo->GetPassword() );
+ }
+ }
+ }
+ }
+ }
+ }
+
+ SetGlobalUNOConstant( "BasicLibraries", uno::Any( mpImpl->maContainerInfo.mxScriptCont ) );
+ SetGlobalUNOConstant( "DialogLibraries", uno::Any( mpImpl->maContainerInfo.mxDialogCont ) );
+}
+
+BasicManager::BasicManager( StarBASIC* pSLib, OUString const * pLibPath, bool bDocMgr ) : mbDocMgr( bDocMgr )
+{
+ Init();
+ DBG_ASSERT( pSLib, "BasicManager cannot be created with a NULL-Pointer!" );
+
+ if( pLibPath )
+ {
+ mpImpl->aBasicLibPath = *pLibPath;
+ }
+ BasicLibInfo* pStdLibInfo = CreateLibInfo();
+ pStdLibInfo->SetLib( pSLib );
+ StarBASICRef xStdLib = pStdLibInfo->GetLib();
+ xStdLib->SetName(szStdLibName);
+ pStdLibInfo->SetLibName(szStdLibName );
+ pSLib->SetFlag( SbxFlagBits::DontStore | SbxFlagBits::ExtSearch );
+
+ // Save is only necessary if basic has changed
+ xStdLib->SetModified( false );
+}
+
+void BasicManager::ImpMgrNotLoaded( const OUString& rStorageName )
+{
+ // pErrInf is only destroyed if the error os processed by an
+ // ErrorHandler
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_MGROPEN, rStorageName, DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::OPENMGRSTREAM);
+
+ // Create a stdlib otherwise we crash!
+ BasicLibInfo* pStdLibInfo = CreateLibInfo();
+ pStdLibInfo->SetLib( new StarBASIC( nullptr, mbDocMgr ) );
+ StarBASICRef xStdLib = pStdLibInfo->GetLib();
+ xStdLib->SetName( szStdLibName );
+ pStdLibInfo->SetLibName( szStdLibName );
+ xStdLib->SetFlag( SbxFlagBits::DontStore | SbxFlagBits::ExtSearch );
+ xStdLib->SetModified( false );
+}
+
+
+void BasicManager::ImpCreateStdLib( StarBASIC* pParentFromStdLib )
+{
+ BasicLibInfo* pStdLibInfo = CreateLibInfo();
+ StarBASIC* pStdLib = new StarBASIC( pParentFromStdLib, mbDocMgr );
+ pStdLibInfo->SetLib( pStdLib );
+ pStdLib->SetName( szStdLibName );
+ pStdLibInfo->SetLibName( szStdLibName );
+ pStdLib->SetFlag( SbxFlagBits::DontStore | SbxFlagBits::ExtSearch );
+}
+
+void BasicManager::LoadBasicManager( SotStorage& rStorage, const OUString& rBaseURL )
+{
+ tools::SvRef<SotStorageStream> xManagerStream = rStorage.OpenSotStream( szManagerStream, eStreamReadMode );
+
+ OUString aStorName( rStorage.GetName() );
+ // #i13114 removed, DBG_ASSERT( aStorName.Len(), "No Storage Name!" );
+
+ if ( !xManagerStream.is() || xManagerStream->GetError() || ( xManagerStream->TellEnd() == 0 ) )
+ {
+ ImpMgrNotLoaded( aStorName );
+ return;
+ }
+
+ maStorageName = INetURLObject(aStorName, INetProtocol::File).GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ // #i13114 removed, DBG_ASSERT(aStorageName.Len() != 0, "Bad storage name");
+
+ OUString aRealStorageName = maStorageName; // for relative paths, can be modified through BaseURL
+
+ if ( !rBaseURL.isEmpty() )
+ {
+ INetURLObject aObj( rBaseURL );
+ if ( aObj.GetProtocol() == INetProtocol::File )
+ {
+ aRealStorageName = aObj.PathToFileName();
+ }
+ }
+
+ xManagerStream->SetBufferSize( 1024 );
+ xManagerStream->Seek( STREAM_SEEK_TO_BEGIN );
+
+ sal_uInt32 nEndPos;
+ xManagerStream->ReadUInt32( nEndPos );
+
+ sal_uInt16 nLibs;
+ xManagerStream->ReadUInt16( nLibs );
+ // Plausibility!
+ if( nLibs & 0xF000 )
+ {
+ SAL_WARN( "basic", "BasicManager-Stream defect!" );
+ return;
+ }
+ const size_t nMinBasicLibSize(8);
+ const size_t nMaxPossibleLibs = xManagerStream->remainingSize() / nMinBasicLibSize;
+ if (nLibs > nMaxPossibleLibs)
+ {
+ SAL_WARN("basic", "Parsing error: " << nMaxPossibleLibs <<
+ " max possible entries, but " << nLibs << " claimed, truncating");
+ nLibs = nMaxPossibleLibs;
+ }
+ for (sal_uInt16 nL = 0; nL < nLibs; ++nL)
+ {
+ BasicLibInfo* pInfo = BasicLibInfo::Create( *xManagerStream );
+
+ // Correct absolute pathname if relative is existing.
+ // Always try relative first if there are two stands on disk
+ if ( !pInfo->GetRelStorageName().isEmpty() && pInfo->GetRelStorageName() != szImbedded )
+ {
+ INetURLObject aObj( aRealStorageName, INetProtocol::File );
+ aObj.removeSegment();
+ bool bWasAbsolute = false;
+ aObj = aObj.smartRel2Abs( pInfo->GetRelStorageName(), bWasAbsolute );
+
+ //*** TODO: Replace if still necessary
+ //*** TODO-End
+ if ( ! mpImpl->aBasicLibPath.isEmpty() )
+ {
+ // Search lib in path
+ OUString aSearchFile = pInfo->GetRelStorageName();
+ OUString aSearchFileOldFormat(aSearchFile);
+ SvtPathOptions aPathCFG;
+ if( aPathCFG.SearchFile( aSearchFileOldFormat, SvtPathOptions::PATH_BASIC ) )
+ {
+ pInfo->SetStorageName( aSearchFile );
+ }
+ }
+ }
+
+ mpImpl->aLibs.push_back(std::unique_ptr<BasicLibInfo>(pInfo));
+ // Libs from external files should be loaded only when necessary.
+ // But references are loaded at once, otherwise some big customers get into trouble
+ if ( pInfo->DoLoad() &&
+ ( !pInfo->IsExtern() || pInfo->IsReference()))
+ {
+ ImpLoadLibrary( pInfo, &rStorage );
+ }
+ }
+
+ xManagerStream->Seek( nEndPos );
+ xManagerStream->SetBufferSize( 0 );
+ xManagerStream.clear();
+}
+
+void BasicManager::LoadOldBasicManager( SotStorage& rStorage )
+{
+ tools::SvRef<SotStorageStream> xManagerStream = rStorage.OpenSotStream( szOldManagerStream, eStreamReadMode );
+
+ OUString aStorName( rStorage.GetName() );
+ DBG_ASSERT( aStorName.getLength(), "No Storage Name!" );
+
+ if ( !xManagerStream.is() || xManagerStream->GetError() || ( xManagerStream->TellEnd() == 0 ) )
+ {
+ ImpMgrNotLoaded( aStorName );
+ return;
+ }
+
+ xManagerStream->SetBufferSize( 1024 );
+ xManagerStream->Seek( STREAM_SEEK_TO_BEGIN );
+ sal_uInt32 nBasicStartOff, nBasicEndOff;
+ xManagerStream->ReadUInt32( nBasicStartOff );
+ xManagerStream->ReadUInt32( nBasicEndOff );
+
+ DBG_ASSERT( !xManagerStream->GetError(), "Invalid Manager-Stream!" );
+
+ xManagerStream->Seek( nBasicStartOff );
+ if (!ImplLoadBasic( *xManagerStream, mpImpl->aLibs.front()->GetLibRef() ))
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_MGROPEN, aStorName, DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::OPENMGRSTREAM);
+ // and it proceeds ...
+ }
+ xManagerStream->Seek( nBasicEndOff+1 ); // +1: 0x00 as separator
+ OUString aLibs = xManagerStream->ReadUniOrByteString(xManagerStream->GetStreamCharSet());
+ xManagerStream->SetBufferSize( 0 );
+ xManagerStream.clear(); // Close stream
+
+ if ( aLibs.isEmpty() )
+ return;
+
+ INetURLObject aCurStorage( aStorName, INetProtocol::File );
+ sal_Int32 nLibPos {0};
+ do {
+ const OUString aLibInfo(aLibs.getToken(0, LIB_SEP, nLibPos));
+ sal_Int32 nInfoPos {0};
+ const OUString aLibName( aLibInfo.getToken( 0, LIBINFO_SEP, nInfoPos ) );
+ DBG_ASSERT( nInfoPos >= 0, "Invalid Lib-Info!" );
+ const OUString aLibAbsStorageName( aLibInfo.getToken( 0, LIBINFO_SEP, nInfoPos ) );
+ // TODO: fail also here if there are no more tokens?
+ const OUString aLibRelStorageName( aLibInfo.getToken( 0, LIBINFO_SEP, nInfoPos ) );
+ DBG_ASSERT( nInfoPos < 0, "Invalid Lib-Info!" );
+ INetURLObject aLibAbsStorage( aLibAbsStorageName, INetProtocol::File );
+
+ INetURLObject aLibRelStorage( aStorName );
+ aLibRelStorage.removeSegment();
+ bool bWasAbsolute = false;
+ aLibRelStorage = aLibRelStorage.smartRel2Abs( aLibRelStorageName, bWasAbsolute);
+ DBG_ASSERT(!bWasAbsolute, "RelStorageName was absolute!" );
+
+ tools::SvRef<SotStorage> xStorageRef;
+ if ( aLibAbsStorage == aCurStorage || aLibRelStorageName == szImbedded )
+ {
+ xStorageRef = &rStorage;
+ }
+ else
+ {
+ xStorageRef = new SotStorage( false, aLibAbsStorage.GetMainURL
+ ( INetURLObject::DecodeMechanism::NONE ), eStorageReadMode );
+ if ( xStorageRef->GetError() != ERRCODE_NONE )
+ xStorageRef = new SotStorage( false, aLibRelStorage.
+ GetMainURL( INetURLObject::DecodeMechanism::NONE ), eStorageReadMode );
+ }
+ if ( xStorageRef.is() )
+ {
+ AddLib( *xStorageRef, aLibName, false );
+ }
+ else
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_LIBLOAD, aStorName, DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::STORAGENOTFOUND);
+ }
+ } while (nLibPos>=0);
+}
+
+BasicManager::~BasicManager()
+{
+ // Notify listener if something needs to be saved
+ Broadcast( SfxHint( SfxHintId::Dying) );
+}
+
+bool BasicManager::HasExeCode( const OUString& sLib )
+{
+ StarBASIC* pLib = GetLib(sLib);
+ if ( pLib )
+ {
+ for (const auto& pModule: pLib->GetModules())
+ {
+ if (pModule->HasExeCode())
+ return true;
+ }
+ }
+ return false;
+}
+
+void BasicManager::Init()
+{
+ mpImpl.reset( new BasicManagerImpl );
+}
+
+BasicLibInfo* BasicManager::CreateLibInfo()
+{
+ BasicLibInfo* pInf(new BasicLibInfo);
+ mpImpl->aLibs.push_back(std::unique_ptr<BasicLibInfo>(pInf));
+ return pInf;
+}
+
+bool BasicManager::ImpLoadLibrary( BasicLibInfo* pLibInfo, SotStorage* pCurStorage )
+{
+ try {
+ DBG_ASSERT( pLibInfo, "LibInfo!?" );
+
+ OUString aStorageName( pLibInfo->GetStorageName() );
+ if ( aStorageName.isEmpty() || aStorageName == szImbedded )
+ {
+ aStorageName = GetStorageName();
+ }
+ tools::SvRef<SotStorage> xStorage;
+ // The current must not be opened again...
+ if ( pCurStorage )
+ {
+ OUString aStorName( pCurStorage->GetName() );
+ // #i13114 removed, DBG_ASSERT( aStorName.Len(), "No Storage Name!" );
+
+ INetURLObject aCurStorageEntry(aStorName, INetProtocol::File);
+ // #i13114 removed, DBG_ASSERT(aCurStorageEntry.GetMainURL( INetURLObject::DecodeMechanism::NONE ).Len() != 0, "Bad storage name");
+
+ INetURLObject aStorageEntry(aStorageName, INetProtocol::File);
+ // #i13114 removed, DBG_ASSERT(aCurStorageEntry.GetMainURL( INetURLObject::DecodeMechanism::NONE ).Len() != 0, "Bad storage name");
+
+ if ( aCurStorageEntry == aStorageEntry )
+ {
+ xStorage = pCurStorage;
+ }
+ }
+
+ if ( !xStorage.is() )
+ {
+ xStorage = new SotStorage( false, aStorageName, eStorageReadMode );
+ }
+ tools::SvRef<SotStorage> xBasicStorage = xStorage->OpenSotStorage( szBasicStorage, eStorageReadMode, false );
+
+ if ( !xBasicStorage.is() || xBasicStorage->GetError() )
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_MGROPEN, xStorage->GetName(), DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::OPENLIBSTORAGE);
+ }
+ else
+ {
+ // In the Basic-Storage every lib is in a Stream...
+ tools::SvRef<SotStorageStream> xBasicStream = xBasicStorage->OpenSotStream( pLibInfo->GetLibName(), eStreamReadMode );
+ if ( !xBasicStream.is() || xBasicStream->GetError() )
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_LIBLOAD , pLibInfo->GetLibName(), DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::OPENLIBSTREAM);
+ }
+ else
+ {
+ bool bLoaded = false;
+ if ( xBasicStream->TellEnd() != 0 )
+ {
+ if ( !pLibInfo->GetLib().is() )
+ {
+ pLibInfo->SetLib( new StarBASIC( GetStdLib(), mbDocMgr ) );
+ }
+ xBasicStream->SetBufferSize( 1024 );
+ xBasicStream->Seek( STREAM_SEEK_TO_BEGIN );
+ bLoaded = ImplLoadBasic( *xBasicStream, pLibInfo->GetLibRef() );
+ xBasicStream->SetBufferSize( 0 );
+ StarBASICRef xStdLib = pLibInfo->GetLib();
+ xStdLib->SetName( pLibInfo->GetLibName() );
+ xStdLib->SetModified( false );
+ xStdLib->SetFlag( SbxFlagBits::DontStore );
+ }
+ if ( !bLoaded )
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_LIBLOAD, pLibInfo->GetLibName(), DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::BASICLOADERROR);
+ }
+ else
+ {
+ // Perhaps there are additional information in the stream...
+ xBasicStream->SetCryptMaskKey(szCryptingKey);
+ xBasicStream->RefreshBuffer();
+ sal_uInt32 nPasswordMarker = 0;
+ xBasicStream->ReadUInt32( nPasswordMarker );
+ if ( ( nPasswordMarker == PASSWORD_MARKER ) && !xBasicStream->eof() )
+ {
+ OUString aPassword = xBasicStream->ReadUniOrByteString(
+ xBasicStream->GetStreamCharSet());
+ pLibInfo->SetPassword( aPassword );
+ }
+ xBasicStream->SetCryptMaskKey(OString());
+ CheckModules( pLibInfo->GetLib().get(), pLibInfo->IsReference() );
+ }
+ return bLoaded;
+ }
+ }
+ }
+ catch (const css::ucb::ContentCreationException&)
+ {
+ }
+ return false;
+}
+
+bool BasicManager::ImplEncryptStream( SvStream& rStrm )
+{
+ sal_uInt64 const nPos = rStrm.Tell();
+ sal_uInt32 nCreator;
+ rStrm.ReadUInt32( nCreator );
+ rStrm.Seek( nPos );
+ bool bProtected = false;
+ if ( nCreator != SBXCR_SBX )
+ {
+ // Should only be the case for encrypted Streams
+ bProtected = true;
+ rStrm.SetCryptMaskKey(szCryptingKey);
+ rStrm.RefreshBuffer();
+ }
+ return bProtected;
+}
+
+// This code is necessary to load the BASIC of Beta 1
+// TODO: Which Beta 1?
+bool BasicManager::ImplLoadBasic( SvStream& rStrm, StarBASICRef& rOldBasic ) const
+{
+ bool bProtected = ImplEncryptStream( rStrm );
+ SbxBaseRef xNew = SbxBase::Load( rStrm );
+ bool bLoaded = false;
+ if( xNew.is() )
+ {
+ if( auto pNew = dynamic_cast<StarBASIC*>( xNew.get() ) )
+ {
+ // Use the Parent of the old BASICs
+ if( rOldBasic.is() )
+ {
+ pNew->SetParent( rOldBasic->GetParent() );
+ if( pNew->GetParent() )
+ {
+ pNew->GetParent()->Insert( pNew );
+ }
+ pNew->SetFlag( SbxFlagBits::ExtSearch );
+ }
+ rOldBasic = pNew;
+
+ // Fill new library container (5.2 -> 6.0)
+ copyToLibraryContainer( pNew, mpImpl->maContainerInfo );
+
+ pNew->SetModified( false );
+ bLoaded = true;
+ }
+ }
+ if ( bProtected )
+ {
+ rStrm.SetCryptMaskKey(OString());
+ }
+ return bLoaded;
+}
+
+void BasicManager::CheckModules( StarBASIC* pLib, bool bReference )
+{
+ if ( !pLib )
+ {
+ return;
+ }
+ bool bModified = pLib->IsModified();
+
+ for ( const auto& pModule: pLib->GetModules() )
+ {
+ DBG_ASSERT(pModule, "Module not received!");
+ if ( !pModule->IsCompiled() && !StarBASIC::GetErrorCode() )
+ {
+ pModule->Compile();
+ }
+ }
+
+ // #67477, AB 8.12.99 On demand compile in referenced libs should not
+ // cause modified
+ if( !bModified && bReference )
+ {
+ OSL_FAIL( "Referenced basic library is not compiled!" );
+ pLib->SetModified( false );
+ }
+}
+
+StarBASIC* BasicManager::AddLib( SotStorage& rStorage, const OUString& rLibName, bool bReference )
+{
+ OUString aStorName( rStorage.GetName() );
+ DBG_ASSERT( !aStorName.isEmpty(), "No Storage Name!" );
+
+ OUString aStorageName = INetURLObject(aStorName, INetProtocol::File).GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ DBG_ASSERT(!aStorageName.isEmpty(), "Bad storage name");
+
+ OUString aNewLibName( rLibName );
+ while ( HasLib( aNewLibName ) )
+ {
+ aNewLibName += "_";
+ }
+ BasicLibInfo* pLibInfo = CreateLibInfo();
+ // Use original name otherwise ImpLoadLibrary fails...
+ pLibInfo->SetLibName( rLibName );
+ // but doesn't work this way if name exists twice
+ sal_uInt16 nLibId = static_cast<sal_uInt16>(mpImpl->aLibs.size()) - 1;
+
+ // Set StorageName before load because it is compared with pCurStorage
+ pLibInfo->SetStorageName( aStorageName );
+ bool bLoaded = ImpLoadLibrary( pLibInfo, &rStorage );
+
+ if ( bLoaded )
+ {
+ if ( aNewLibName != rLibName )
+ {
+ pLibInfo->SetLibName(aNewLibName);
+ }
+ if ( bReference )
+ {
+ pLibInfo->GetLib()->SetModified( false ); // Don't save in this case
+ pLibInfo->SetRelStorageName( OUString() );
+ pLibInfo->SetReference(true);
+ }
+ else
+ {
+ pLibInfo->GetLib()->SetModified( true ); // Must be saved after Add!
+ pLibInfo->SetStorageName( szImbedded ); // Save in BasicManager-Storage
+ }
+ }
+ else
+ {
+ RemoveLib( nLibId, false );
+ pLibInfo = nullptr;
+ }
+
+ return pLibInfo ? &*pLibInfo->GetLib() : nullptr;
+
+}
+
+bool BasicManager::IsReference( sal_uInt16 nLib )
+{
+ DBG_ASSERT( nLib < mpImpl->aLibs.size(), "Lib does not exist!" );
+ if ( nLib < mpImpl->aLibs.size() )
+ {
+ return mpImpl->aLibs[nLib]->IsReference();
+ }
+ return false;
+}
+
+void BasicManager::RemoveLib( sal_uInt16 nLib )
+{
+ // Only physical deletion if no reference
+ RemoveLib( nLib, !IsReference( nLib ) );
+}
+
+bool BasicManager::RemoveLib( sal_uInt16 nLib, bool bDelBasicFromStorage )
+{
+ DBG_ASSERT( nLib, "Standard-Lib cannot be removed!" );
+
+ DBG_ASSERT( !nLib || nLib < mpImpl->aLibs.size(), "Lib not found!" );
+
+ if( !nLib || nLib < mpImpl->aLibs.size() )
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_REMOVELIB, OUString(), DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::STDLIB);
+ return false;
+ }
+
+ auto const itLibInfo = mpImpl->aLibs.begin() + nLib;
+
+ // If one of the streams cannot be opened, this is not an error,
+ // because BASIC was never written before...
+ if (bDelBasicFromStorage && !(*itLibInfo)->IsReference() &&
+ (!(*itLibInfo)->IsExtern() || SotStorage::IsStorageFile((*itLibInfo)->GetStorageName())))
+ {
+ tools::SvRef<SotStorage> xStorage;
+ try
+ {
+ if (!(*itLibInfo)->IsExtern())
+ {
+ xStorage = new SotStorage(false, GetStorageName());
+ }
+ else
+ {
+ xStorage = new SotStorage(false, (*itLibInfo)->GetStorageName());
+ }
+ }
+ catch (const css::ucb::ContentCreationException&)
+ {
+ TOOLS_WARN_EXCEPTION("basic", "BasicManager::RemoveLib:");
+ }
+
+ if (xStorage.is() && xStorage->IsStorage(szBasicStorage))
+ {
+ tools::SvRef<SotStorage> xBasicStorage = xStorage->OpenSotStorage
+ ( szBasicStorage, StreamMode::STD_READWRITE, false );
+
+ if ( !xBasicStorage.is() || xBasicStorage->GetError() )
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_REMOVELIB, OUString(), DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::OPENLIBSTORAGE);
+ }
+ else if (xBasicStorage->IsStream((*itLibInfo)->GetLibName()))
+ {
+ xBasicStorage->Remove((*itLibInfo)->GetLibName());
+ xBasicStorage->Commit();
+
+ // If no further stream available,
+ // delete the SubStorage.
+ SvStorageInfoList aInfoList;
+ xBasicStorage->FillInfoList( &aInfoList );
+ if ( aInfoList.empty() )
+ {
+ xBasicStorage.clear();
+ xStorage->Remove( szBasicStorage );
+ xStorage->Commit();
+ // If no further Streams or SubStorages available,
+ // delete the Storage, too.
+ aInfoList.clear();
+ xStorage->FillInfoList( &aInfoList );
+ if ( aInfoList.empty() )
+ {
+ //OUString aName_( xStorage->GetName() );
+ xStorage.clear();
+ //*** TODO: Replace if still necessary
+ //SfxContentHelper::Kill( aName );
+ //*** TODO-End
+ }
+ }
+ }
+ }
+ }
+ if ((*itLibInfo)->GetLib().is())
+ {
+ GetStdLib()->Remove( (*itLibInfo)->GetLib().get() );
+ }
+ mpImpl->aLibs.erase(itLibInfo);
+ return true; // Remove was successful, del unimportant
+}
+
+sal_uInt16 BasicManager::GetLibCount() const
+{
+ return static_cast<sal_uInt16>(mpImpl->aLibs.size());
+}
+
+StarBASIC* BasicManager::GetLib( sal_uInt16 nLib ) const
+{
+ DBG_ASSERT( nLib < mpImpl->aLibs.size(), "Lib does not exist!" );
+ if ( nLib < mpImpl->aLibs.size() )
+ {
+ return mpImpl->aLibs[nLib]->GetLib().get();
+ }
+ return nullptr;
+}
+
+StarBASIC* BasicManager::GetStdLib() const
+{
+ StarBASIC* pLib = GetLib( 0 );
+ return pLib;
+}
+
+StarBASIC* BasicManager::GetLib( const OUString& rName ) const
+{
+ for (auto const& rpLib : mpImpl->aLibs)
+ {
+ if (rpLib->GetLibName().equalsIgnoreAsciiCase(rName)) // Check if available...
+ {
+ return rpLib->GetLib().get();
+ }
+ }
+ return nullptr;
+}
+
+sal_uInt16 BasicManager::GetLibId( const OUString& rName ) const
+{
+ for (size_t i = 0; i < mpImpl->aLibs.size(); i++)
+ {
+ if (mpImpl->aLibs[i]->GetLibName().equalsIgnoreAsciiCase( rName ))
+ {
+ return static_cast<sal_uInt16>(i);
+ }
+ }
+ return LIB_NOTFOUND;
+}
+
+bool BasicManager::HasLib( const OUString& rName ) const
+{
+ for (const auto& rpLib : mpImpl->aLibs)
+ {
+ if (rpLib->GetLibName().equalsIgnoreAsciiCase(rName)) // Check if available...
+ {
+ return true;
+ }
+ }
+ return false;
+}
+
+OUString BasicManager::GetLibName( sal_uInt16 nLib )
+{
+ DBG_ASSERT( nLib < mpImpl->aLibs.size(), "Lib?!" );
+ if ( nLib < mpImpl->aLibs.size() )
+ {
+ return mpImpl->aLibs[nLib]->GetLibName();
+ }
+ return OUString();
+}
+
+bool BasicManager::LoadLib( sal_uInt16 nLib )
+{
+ bool bDone = false;
+ DBG_ASSERT( nLib < mpImpl->aLibs.size() , "Lib?!" );
+ if ( nLib < mpImpl->aLibs.size() )
+ {
+ BasicLibInfo& rLibInfo = *mpImpl->aLibs[nLib];
+ uno::Reference< script::XLibraryContainer > xLibContainer = rLibInfo.GetLibraryContainer();
+ if( xLibContainer.is() )
+ {
+ OUString aLibName = rLibInfo.GetLibName();
+ xLibContainer->loadLibrary( aLibName );
+ bDone = xLibContainer->isLibraryLoaded( aLibName );
+ }
+ else
+ {
+ bDone = ImpLoadLibrary( &rLibInfo, nullptr );
+ StarBASIC* pLib = GetLib( nLib );
+ if ( pLib )
+ {
+ GetStdLib()->Insert( pLib );
+ pLib->SetFlag( SbxFlagBits::ExtSearch );
+ }
+ }
+ }
+ else
+ {
+ StringErrorInfo* pErrInf = new StringErrorInfo( ERRCODE_BASMGR_LIBLOAD, OUString(), DialogMask::ButtonsOk );
+ aErrors.emplace_back(*pErrInf, BasicErrorReason::LIBNOTFOUND);
+ }
+ return bDone;
+}
+
+StarBASIC* BasicManager::CreateLib( const OUString& rLibName )
+{
+ if ( GetLib( rLibName ) )
+ {
+ return nullptr;
+ }
+ BasicLibInfo* pLibInfo = CreateLibInfo();
+ StarBASIC* pNew = new StarBASIC( GetStdLib(), mbDocMgr );
+ GetStdLib()->Insert( pNew );
+ pNew->SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::DontStore );
+ pLibInfo->SetLib( pNew );
+ pLibInfo->SetLibName( rLibName );
+ pLibInfo->GetLib()->SetName( rLibName );
+ return pLibInfo->GetLib().get();
+}
+
+// For XML import/export:
+StarBASIC* BasicManager::CreateLib( const OUString& rLibName, const OUString& Password,
+ const OUString& LinkTargetURL )
+{
+ // Ask if lib exists because standard lib is always there
+ StarBASIC* pLib = GetLib( rLibName );
+ if( !pLib )
+ {
+ if( !LinkTargetURL.isEmpty())
+ {
+ try
+ {
+ tools::SvRef<SotStorage> xStorage = new SotStorage(false, LinkTargetURL, StreamMode::READ | StreamMode::SHARE_DENYWRITE);
+ if (!xStorage->GetError())
+ {
+ pLib = AddLib(*xStorage, rLibName, true);
+ }
+ }
+ catch (const css::ucb::ContentCreationException&)
+ {
+ TOOLS_WARN_EXCEPTION("basic", "BasicManager::RemoveLib:");
+ }
+ DBG_ASSERT( pLib, "XML Import: Linked basic library could not be loaded");
+ }
+ else
+ {
+ pLib = CreateLib( rLibName );
+ if( Password.isEmpty())
+ {
+ BasicLibInfo* pLibInfo = FindLibInfo( pLib );
+ pLibInfo ->SetPassword( Password );
+ }
+ }
+ //ExternalSourceURL ?
+ }
+ return pLib;
+}
+
+StarBASIC* BasicManager::CreateLibForLibContainer( const OUString& rLibName,
+ const uno::Reference< script::XLibraryContainer >& xScriptCont )
+{
+ if ( GetLib( rLibName ) )
+ {
+ return nullptr;
+ }
+ BasicLibInfo* pLibInfo = CreateLibInfo();
+ StarBASIC* pNew = new StarBASIC( GetStdLib(), mbDocMgr );
+ GetStdLib()->Insert( pNew );
+ pNew->SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::DontStore );
+ pLibInfo->SetLib( pNew );
+ pLibInfo->SetLibName( rLibName );
+ pLibInfo->GetLib()->SetName( rLibName );
+ pLibInfo->SetLibraryContainer( xScriptCont );
+ return pNew;
+}
+
+
+BasicLibInfo* BasicManager::FindLibInfo( StarBASIC const * pBasic )
+{
+ for (auto const& rpLib : mpImpl->aLibs)
+ {
+ if (rpLib->GetLib().get() == pBasic)
+ {
+ return rpLib.get();
+ }
+ }
+ return nullptr;
+}
+
+
+bool BasicManager::IsBasicModified() const
+{
+ for (auto const& rpLib : mpImpl->aLibs)
+ {
+ if (rpLib->GetLib().is() && rpLib->GetLib()->IsModified())
+ {
+ return true;
+ }
+ }
+ return false;
+}
+
+
+bool BasicManager::GetGlobalUNOConstant( const OUString& rName, uno::Any& aOut )
+{
+ bool bRes = false;
+ StarBASIC* pStandardLib = GetStdLib();
+ OSL_PRECOND( pStandardLib, "BasicManager::GetGlobalUNOConstant: no lib to read from!" );
+ if ( pStandardLib )
+ bRes = pStandardLib->GetUNOConstant( rName, aOut );
+ return bRes;
+}
+
+uno::Any BasicManager::SetGlobalUNOConstant( const OUString& rName, const uno::Any& _rValue )
+{
+ uno::Any aOldValue;
+
+ StarBASIC* pStandardLib = GetStdLib();
+ OSL_PRECOND( pStandardLib, "BasicManager::SetGlobalUNOConstant: no lib to insert into!" );
+ if ( !pStandardLib )
+ return aOldValue;
+
+ // obtain the old value
+ SbxVariable* pVariable = pStandardLib->Find( rName, SbxClassType::Object );
+ if ( pVariable )
+ aOldValue = sbxToUnoValue( pVariable );
+ SbxObjectRef xUnoObj = GetSbUnoObject( _rValue.getValueType ().getTypeName () , _rValue );
+ xUnoObj->SetName(rName);
+ xUnoObj->SetFlag( SbxFlagBits::DontStore );
+ pStandardLib->Insert( xUnoObj.get() );
+
+ return aOldValue;
+}
+
+bool BasicManager::LegacyPsswdBinaryLimitExceeded( std::vector< OUString >& _out_rModuleNames )
+{
+ try
+ {
+ uno::Reference< container::XNameAccess > xScripts( GetScriptLibraryContainer(), uno::UNO_QUERY_THROW );
+ uno::Reference< script::XLibraryContainerPassword > xPassword( GetScriptLibraryContainer(), uno::UNO_QUERY_THROW );
+
+ const uno::Sequence< OUString > aNames( xScripts->getElementNames() );
+ for ( auto const & scriptElementName : aNames )
+ {
+ if( !xPassword->isLibraryPasswordProtected( scriptElementName ) )
+ continue;
+
+ StarBASIC* pBasicLib = GetLib( scriptElementName );
+ if ( !pBasicLib )
+ continue;
+
+ uno::Reference< container::XNameAccess > xScriptLibrary( xScripts->getByName( scriptElementName ), uno::UNO_QUERY_THROW );
+ const uno::Sequence< OUString > aElementNames( xScriptLibrary->getElementNames() );
+ sal_Int32 nLen = aElementNames.getLength();
+
+ std::vector< OUString > aBigModules( nLen );
+ sal_Int32 nBigModules = 0;
+
+ for ( auto const & libraryElementName : aElementNames )
+ {
+ SbModule* pMod = pBasicLib->FindModule( libraryElementName );
+ if ( pMod && pMod->ExceedsLegacyModuleSize() )
+ aBigModules[ nBigModules++ ] = libraryElementName;
+ }
+
+ if ( nBigModules )
+ {
+ _out_rModuleNames.swap(aBigModules);
+ return true;
+ }
+ }
+ }
+ catch( const uno::Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ }
+ return false;
+}
+
+
+namespace
+{
+ SbMethod* lcl_queryMacro( BasicManager* i_manager, OUString const& i_fullyQualifiedName )
+ {
+ sal_Int32 nLast = 0;
+ const OUString sLibName {i_fullyQualifiedName.getToken( 0, '.', nLast )};
+ const OUString sModule {i_fullyQualifiedName.getToken( 0, '.', nLast )};
+ OUString sMacro;
+ if(nLast >= 0)
+ {
+ sMacro = i_fullyQualifiedName.copy(nLast);
+ }
+ else
+ {
+ sMacro = i_fullyQualifiedName;
+ }
+
+ utl::TransliterationWrapper& rTransliteration = SbGlobal::GetTransliteration();
+ sal_uInt16 nLibCount = i_manager->GetLibCount();
+ for ( sal_uInt16 nLib = 0; nLib < nLibCount; ++nLib )
+ {
+ if ( rTransliteration.isEqual( i_manager->GetLibName( nLib ), sLibName ) )
+ {
+ StarBASIC* pLib = i_manager->GetLib( nLib );
+ if( !pLib )
+ {
+ bool const bLoaded = i_manager->LoadLib( nLib );
+ if (bLoaded)
+ {
+ pLib = i_manager->GetLib( nLib );
+ }
+ }
+
+ if( pLib )
+ {
+ for ( const auto& pMod: pLib->GetModules() )
+ {
+ if ( rTransliteration.isEqual( pMod->GetName(), sModule ) )
+ {
+ SbMethod* pMethod = static_cast<SbMethod*>(pMod->Find( sMacro, SbxClassType::Method ));
+ if( pMethod )
+ {
+ return pMethod;
+ }
+ }
+ }
+ }
+ }
+ }
+ return nullptr;
+ }
+}
+
+bool BasicManager::HasMacro( OUString const& i_fullyQualifiedName ) const
+{
+ return ( lcl_queryMacro( const_cast< BasicManager* >( this ), i_fullyQualifiedName ) != nullptr );
+}
+
+ErrCode BasicManager::ExecuteMacro( OUString const& i_fullyQualifiedName, SbxArray* i_arguments, SbxValue* i_retValue )
+{
+ SbMethod* pMethod = lcl_queryMacro( this, i_fullyQualifiedName );
+ ErrCode nError = ERRCODE_NONE;
+ if ( pMethod )
+ {
+ if ( i_arguments )
+ pMethod->SetParameters( i_arguments );
+ nError = pMethod->Call( i_retValue );
+ }
+ else
+ nError = ERRCODE_BASIC_PROC_UNDEFINED;
+ return nError;
+}
+
+ErrCode BasicManager::ExecuteMacro( OUString const& i_fullyQualifiedName, OUString const& i_commaSeparatedArgs, SbxValue* i_retValue )
+{
+ SbMethod* pMethod = lcl_queryMacro( this, i_fullyQualifiedName );
+ if ( !pMethod )
+ {
+ return ERRCODE_BASIC_PROC_UNDEFINED;
+ }
+ // arguments must be quoted
+ OUString sQuotedArgs;
+ OUStringBuffer sArgs( i_commaSeparatedArgs );
+ if ( sArgs.getLength()<2 || sArgs[1] == '\"')
+ {
+ // no args or already quoted args
+ sQuotedArgs = sArgs.makeStringAndClear();
+ }
+ else
+ {
+ // quote parameters
+ sArgs.remove( 0, 1 );
+ sArgs.remove( sArgs.getLength() - 1, 1 );
+
+ OUStringBuffer aBuff;
+ OUString sArgs2 = sArgs.makeStringAndClear();
+
+ aBuff.append("(");
+ if (!sArgs2.isEmpty())
+ {
+
+ sal_Int32 nPos {0};
+ for (;;)
+ {
+ aBuff.append( "\"" );
+ aBuff.append( sArgs2.getToken(0, ',', nPos) );
+ aBuff.append( "\"" );
+ if (nPos<0)
+ break;
+ aBuff.append( "," );
+ }
+ }
+ aBuff.append( ")" );
+
+ sQuotedArgs = aBuff.makeStringAndClear();
+ }
+
+ // add quoted arguments and do the call
+ OUString sCall = "["
+ + pMethod->GetName()
+ + sQuotedArgs
+ + "]";
+
+ SbxVariable* pRet = pMethod->GetParent()->Execute( sCall );
+ if ( pRet && ( pRet != pMethod ) )
+ {
+ *i_retValue = *pRet;
+ }
+ return SbxBase::GetError();
+}
+
+namespace {
+
+class ModuleInfo_Impl : public ModuleInfoHelper
+{
+ OUString maName;
+ OUString maLanguage;
+ OUString maSource;
+
+public:
+ ModuleInfo_Impl( const OUString& aName, const OUString& aLanguage, const OUString& aSource )
+ : maName( aName ), maLanguage( aLanguage), maSource( aSource ) {}
+
+ // Methods XStarBasicModuleInfo
+ virtual OUString SAL_CALL getName() override
+ { return maName; }
+ virtual OUString SAL_CALL getLanguage() override
+ { return maLanguage; }
+ virtual OUString SAL_CALL getSource() override
+ { return maSource; }
+};
+
+
+class DialogInfo_Impl : public WeakImplHelper< script::XStarBasicDialogInfo >
+{
+ OUString maName;
+ uno::Sequence< sal_Int8 > mData;
+
+public:
+ DialogInfo_Impl( const OUString& aName, const uno::Sequence< sal_Int8 >& Data )
+ : maName( aName ), mData( Data ) {}
+
+ // Methods XStarBasicDialogInfo
+ virtual OUString SAL_CALL getName() override
+ { return maName; }
+ virtual uno::Sequence< sal_Int8 > SAL_CALL getData() override
+ { return mData; }
+};
+
+
+class LibraryInfo_Impl : public WeakImplHelper< script::XStarBasicLibraryInfo >
+{
+ OUString maName;
+ uno::Reference< container::XNameContainer > mxModuleContainer;
+ uno::Reference< container::XNameContainer > mxDialogContainer;
+ OUString maPassword;
+ OUString maExternaleSourceURL;
+ OUString maLinkTargetURL;
+
+public:
+ LibraryInfo_Impl
+ (
+ const OUString& aName,
+ uno::Reference< container::XNameContainer > const & xModuleContainer,
+ uno::Reference< container::XNameContainer > const & xDialogContainer,
+ const OUString& aPassword,
+ const OUString& aExternaleSourceURL,
+ const OUString& aLinkTargetURL
+ )
+ : maName( aName )
+ , mxModuleContainer( xModuleContainer )
+ , mxDialogContainer( xDialogContainer )
+ , maPassword( aPassword )
+ , maExternaleSourceURL( aExternaleSourceURL )
+ , maLinkTargetURL( aLinkTargetURL )
+ {}
+
+ // Methods XStarBasicLibraryInfo
+ virtual OUString SAL_CALL getName() override
+ { return maName; }
+ virtual uno::Reference< container::XNameContainer > SAL_CALL getModuleContainer() override
+ { return mxModuleContainer; }
+ virtual uno::Reference< container::XNameContainer > SAL_CALL getDialogContainer() override
+ { return mxDialogContainer; }
+ virtual OUString SAL_CALL getPassword() override
+ { return maPassword; }
+ virtual OUString SAL_CALL getExternalSourceURL() override
+ { return maExternaleSourceURL; }
+ virtual OUString SAL_CALL getLinkTargetURL() override
+ { return maLinkTargetURL; }
+};
+
+
+class ModuleContainer_Impl : public NameContainerHelper
+{
+ StarBASIC* mpLib;
+
+public:
+ explicit ModuleContainer_Impl( StarBASIC* pLib )
+ :mpLib( pLib ) {}
+
+ // Methods XElementAccess
+ virtual uno::Type SAL_CALL getElementType() override;
+ virtual sal_Bool SAL_CALL hasElements() override;
+
+ // Methods XNameAccess
+ virtual uno::Any SAL_CALL getByName( const OUString& aName ) override;
+ virtual uno::Sequence< OUString > SAL_CALL getElementNames() override;
+ virtual sal_Bool SAL_CALL hasByName( const OUString& aName ) override;
+
+ // Methods XNameReplace
+ virtual void SAL_CALL replaceByName( const OUString& aName, const uno::Any& aElement ) override;
+
+ // Methods XNameContainer
+ virtual void SAL_CALL insertByName( const OUString& aName, const uno::Any& aElement ) override;
+ virtual void SAL_CALL removeByName( const OUString& Name ) override;
+};
+
+}
+
+// Methods XElementAccess
+uno::Type ModuleContainer_Impl::getElementType()
+{
+ uno::Type aModuleType = cppu::UnoType<script::XStarBasicModuleInfo>::get();
+ return aModuleType;
+}
+
+sal_Bool ModuleContainer_Impl::hasElements()
+{
+ return mpLib && !mpLib->GetModules().empty();
+}
+
+// Methods XNameAccess
+uno::Any ModuleContainer_Impl::getByName( const OUString& aName )
+{
+ SbModule* pMod = mpLib ? mpLib->FindModule( aName ) : nullptr;
+ if( !pMod )
+ throw container::NoSuchElementException();
+ uno::Reference< script::XStarBasicModuleInfo > xMod = new ModuleInfo_Impl( aName, "StarBasic", pMod->GetSource32() );
+ uno::Any aRetAny;
+ aRetAny <<= xMod;
+ return aRetAny;
+}
+
+uno::Sequence< OUString > ModuleContainer_Impl::getElementNames()
+{
+ sal_uInt16 nMods = mpLib ? mpLib->GetModules().size() : 0;
+ uno::Sequence< OUString > aRetSeq( nMods );
+ OUString* pRetSeq = aRetSeq.getArray();
+ for( sal_uInt16 i = 0 ; i < nMods ; i++ )
+ {
+ pRetSeq[i] = mpLib->GetModules()[i]->GetName();
+ }
+ return aRetSeq;
+}
+
+sal_Bool ModuleContainer_Impl::hasByName( const OUString& aName )
+{
+ SbModule* pMod = mpLib ? mpLib->FindModule( aName ) : nullptr;
+ bool bRet = (pMod != nullptr);
+ return bRet;
+}
+
+
+// Methods XNameReplace
+void ModuleContainer_Impl::replaceByName( const OUString& aName, const uno::Any& aElement )
+{
+ removeByName( aName );
+ insertByName( aName, aElement );
+}
+
+
+// Methods XNameContainer
+void ModuleContainer_Impl::insertByName( const OUString& aName, const uno::Any& aElement )
+{
+ uno::Type aModuleType = cppu::UnoType<script::XStarBasicModuleInfo>::get();
+ const uno::Type& aAnyType = aElement.getValueType();
+ if( aModuleType != aAnyType )
+ {
+ throw lang::IllegalArgumentException();
+ }
+ uno::Reference< script::XStarBasicModuleInfo > xMod;
+ aElement >>= xMod;
+ mpLib->MakeModule( aName, xMod->getSource() );
+}
+
+void ModuleContainer_Impl::removeByName( const OUString& Name )
+{
+ SbModule* pMod = mpLib ? mpLib->FindModule( Name ) : nullptr;
+ if( !pMod )
+ {
+ throw container::NoSuchElementException();
+ }
+ mpLib->Remove( pMod );
+}
+
+
+static uno::Sequence< sal_Int8 > implGetDialogData( SbxObject* pDialog )
+{
+ SvMemoryStream aMemStream;
+ pDialog->Store( aMemStream );
+ sal_Int32 nLen = aMemStream.Tell();
+ if (nLen < 0) { abort(); }
+ uno::Sequence< sal_Int8 > aData( nLen );
+ sal_Int8* pDestData = aData.getArray();
+ const sal_Int8* pSrcData = static_cast<const sal_Int8*>(aMemStream.GetData());
+ memcpy( pDestData, pSrcData, nLen );
+ return aData;
+}
+
+static SbxObject* implCreateDialog( const uno::Sequence< sal_Int8 >& aData )
+{
+ sal_Int8* pData = const_cast< uno::Sequence< sal_Int8 >& >(aData).getArray();
+ SvMemoryStream aMemStream( pData, aData.getLength(), StreamMode::READ );
+ SbxBase* pBase = SbxBase::Load( aMemStream );
+ return dynamic_cast<SbxObject*>(pBase);
+}
+
+// HACK! Because this value is defined in basctl/inc/vcsbxdef.hxx
+// which we can't include here, we have to use the value directly
+#define SBXID_DIALOG 101
+
+namespace {
+
+class DialogContainer_Impl : public NameContainerHelper
+{
+ StarBASIC* mpLib;
+
+public:
+ explicit DialogContainer_Impl( StarBASIC* pLib )
+ :mpLib( pLib ) {}
+
+ // Methods XElementAccess
+ virtual uno::Type SAL_CALL getElementType() override;
+ virtual sal_Bool SAL_CALL hasElements() override;
+
+ // Methods XNameAccess
+ virtual uno::Any SAL_CALL getByName( const OUString& aName ) override;
+ virtual uno::Sequence< OUString > SAL_CALL getElementNames() override;
+ virtual sal_Bool SAL_CALL hasByName( const OUString& aName ) override;
+
+ // Methods XNameReplace
+ virtual void SAL_CALL replaceByName( const OUString& aName, const uno::Any& aElement ) override;
+
+ // Methods XNameContainer
+ virtual void SAL_CALL insertByName( const OUString& aName, const uno::Any& aElement ) override;
+ virtual void SAL_CALL removeByName( const OUString& Name ) override;
+};
+
+}
+
+// Methods XElementAccess
+uno::Type DialogContainer_Impl::getElementType()
+{
+ uno::Type aModuleType = cppu::UnoType<script::XStarBasicDialogInfo>::get();
+ return aModuleType;
+}
+
+sal_Bool DialogContainer_Impl::hasElements()
+{
+ bool bRet = false;
+
+ sal_Int32 nCount = mpLib->GetObjects()->Count32();
+ for( sal_Int32 nObj = 0; nObj < nCount ; nObj++ )
+ {
+ SbxVariable* pVar = mpLib->GetObjects()->Get32( nObj );
+ SbxObject* pObj = dynamic_cast<SbxObject*>(pVar);
+ if ( pObj && (pObj->GetSbxId() == SBXID_DIALOG ) )
+ {
+ bRet = true;
+ break;
+ }
+ }
+ return bRet;
+}
+
+// Methods XNameAccess
+uno::Any DialogContainer_Impl::getByName( const OUString& aName )
+{
+ SbxVariable* pVar = mpLib->GetObjects()->Find( aName, SbxClassType::DontCare );
+ SbxObject* pObj = dynamic_cast<SbxObject*>(pVar);
+ if( !( pObj && pObj->GetSbxId() == SBXID_DIALOG ) )
+ {
+ throw container::NoSuchElementException();
+ }
+
+ uno::Reference< script::XStarBasicDialogInfo > xDialog =
+ new DialogInfo_Impl(aName, implGetDialogData(pObj));
+
+ uno::Any aRetAny;
+ aRetAny <<= xDialog;
+ return aRetAny;
+}
+
+uno::Sequence< OUString > DialogContainer_Impl::getElementNames()
+{
+ sal_Int32 nCount = mpLib->GetObjects()->Count32();
+ uno::Sequence< OUString > aRetSeq( nCount );
+ OUString* pRetSeq = aRetSeq.getArray();
+ sal_Int32 nDialogCounter = 0;
+
+ for( sal_Int32 nObj = 0; nObj < nCount ; nObj++ )
+ {
+ SbxVariable* pVar = mpLib->GetObjects()->Get32( nObj );
+ SbxObject* pObj = dynamic_cast<SbxObject*> (pVar);
+ if ( pObj && ( pObj->GetSbxId() == SBXID_DIALOG ) )
+ {
+ pRetSeq[ nDialogCounter ] = pVar->GetName();
+ nDialogCounter++;
+ }
+ }
+ aRetSeq.realloc( nDialogCounter );
+ return aRetSeq;
+}
+
+sal_Bool DialogContainer_Impl::hasByName( const OUString& aName )
+{
+ bool bRet = false;
+ SbxVariable* pVar = mpLib->GetObjects()->Find( aName, SbxClassType::DontCare );
+ SbxObject* pObj = dynamic_cast<SbxObject*>(pVar);
+ if( pObj && ( pObj->GetSbxId() == SBXID_DIALOG ) )
+ {
+ bRet = true;
+ }
+ return bRet;
+}
+
+
+// Methods XNameReplace
+void DialogContainer_Impl::replaceByName( const OUString& aName, const uno::Any& aElement )
+{
+ removeByName( aName );
+ insertByName( aName, aElement );
+}
+
+
+// Methods XNameContainer
+void DialogContainer_Impl::insertByName( const OUString&, const uno::Any& aElement )
+{
+ uno::Type aModuleType = cppu::UnoType<script::XStarBasicDialogInfo>::get();
+ const uno::Type& aAnyType = aElement.getValueType();
+ if( aModuleType != aAnyType )
+ {
+ throw lang::IllegalArgumentException();
+ }
+ uno::Reference< script::XStarBasicDialogInfo > xMod;
+ aElement >>= xMod;
+ SbxObjectRef xDialog = implCreateDialog( xMod->getData() );
+ mpLib->Insert( xDialog.get() );
+}
+
+void DialogContainer_Impl::removeByName( const OUString& Name )
+{
+ SbxVariable* pVar = mpLib->GetObjects()->Find( Name, SbxClassType::DontCare );
+ SbxObject* pObj = dynamic_cast<SbxObject*>(pVar);
+ if( !( pObj && ( pObj->GetSbxId() == SBXID_DIALOG ) ) )
+ {
+ throw container::NoSuchElementException();
+ }
+ mpLib->Remove( pVar );
+}
+
+
+class LibraryContainer_Impl : public NameContainerHelper
+{
+ BasicManager* mpMgr;
+
+public:
+ explicit LibraryContainer_Impl( BasicManager* pMgr )
+ :mpMgr( pMgr ) {}
+
+ // Methods XElementAccess
+ virtual uno::Type SAL_CALL getElementType() override;
+ virtual sal_Bool SAL_CALL hasElements() override;
+
+ // Methods XNameAccess
+ virtual uno::Any SAL_CALL getByName( const OUString& aName ) override;
+ virtual uno::Sequence< OUString > SAL_CALL getElementNames() override;
+ virtual sal_Bool SAL_CALL hasByName( const OUString& aName ) override;
+
+ // Methods XNameReplace
+ virtual void SAL_CALL replaceByName( const OUString& aName, const uno::Any& aElement ) override;
+
+ // Methods XNameContainer
+ virtual void SAL_CALL insertByName( const OUString& aName, const uno::Any& aElement ) override;
+ virtual void SAL_CALL removeByName( const OUString& Name ) override;
+};
+
+
+// Methods XElementAccess
+uno::Type LibraryContainer_Impl::getElementType()
+{
+ uno::Type aType = cppu::UnoType<script::XStarBasicLibraryInfo>::get();
+ return aType;
+}
+
+sal_Bool LibraryContainer_Impl::hasElements()
+{
+ sal_Int32 nLibs = mpMgr->GetLibCount();
+ bool bRet = (nLibs > 0);
+ return bRet;
+}
+
+// Methods XNameAccess
+uno::Any LibraryContainer_Impl::getByName( const OUString& aName )
+{
+ uno::Any aRetAny;
+ if( !mpMgr->HasLib( aName ) )
+ throw container::NoSuchElementException();
+ StarBASIC* pLib = mpMgr->GetLib( aName );
+
+ uno::Reference< container::XNameContainer > xModuleContainer =
+ new ModuleContainer_Impl( pLib );
+
+ uno::Reference< container::XNameContainer > xDialogContainer =
+ new DialogContainer_Impl( pLib );
+
+ BasicLibInfo* pLibInfo = mpMgr->FindLibInfo( pLib );
+
+ OUString aPassword = pLibInfo->GetPassword();
+
+ // TODO Only provide extern info!
+ OUString aExternaleSourceURL;
+ OUString aLinkTargetURL;
+ if( pLibInfo->IsReference() )
+ {
+ aLinkTargetURL = pLibInfo->GetStorageName();
+ }
+ else if( pLibInfo->IsExtern() )
+ {
+ aExternaleSourceURL = pLibInfo->GetStorageName();
+ }
+ uno::Reference< script::XStarBasicLibraryInfo > xLibInfo = new LibraryInfo_Impl
+ (
+ aName,
+ xModuleContainer,
+ xDialogContainer,
+ aPassword,
+ aExternaleSourceURL,
+ aLinkTargetURL
+ );
+
+ aRetAny <<= xLibInfo;
+ return aRetAny;
+}
+
+uno::Sequence< OUString > LibraryContainer_Impl::getElementNames()
+{
+ sal_uInt16 nLibs = mpMgr->GetLibCount();
+ uno::Sequence< OUString > aRetSeq( nLibs );
+ OUString* pRetSeq = aRetSeq.getArray();
+ for( sal_uInt16 i = 0 ; i < nLibs ; i++ )
+ {
+ pRetSeq[i] = mpMgr->GetLibName( i );
+ }
+ return aRetSeq;
+}
+
+sal_Bool LibraryContainer_Impl::hasByName( const OUString& aName )
+{
+ bool bRet = mpMgr->HasLib( aName );
+ return bRet;
+}
+
+// Methods XNameReplace
+void LibraryContainer_Impl::replaceByName( const OUString& aName, const uno::Any& aElement )
+{
+ removeByName( aName );
+ insertByName( aName, aElement );
+}
+
+// Methods XNameContainer
+void LibraryContainer_Impl::insertByName( const OUString&, const uno::Any& )
+{
+ // TODO: Insert a complete Library?!
+}
+
+void LibraryContainer_Impl::removeByName( const OUString& Name )
+{
+ StarBASIC* pLib = mpMgr->GetLib( Name );
+ if( !pLib )
+ {
+ throw container::NoSuchElementException();
+ }
+ sal_uInt16 nLibId = mpMgr->GetLibId( Name );
+ mpMgr->RemoveLib( nLibId );
+}
+
+
+typedef WeakImplHelper< script::XStarBasicAccess > StarBasicAccessHelper;
+
+
+class StarBasicAccess_Impl : public StarBasicAccessHelper
+{
+ BasicManager* mpMgr;
+ uno::Reference< container::XNameContainer > mxLibContainer;
+
+public:
+ explicit StarBasicAccess_Impl( BasicManager* pMgr )
+ :mpMgr( pMgr ) {}
+
+public:
+ // Methods
+ virtual uno::Reference< container::XNameContainer > SAL_CALL getLibraryContainer() override;
+ virtual void SAL_CALL createLibrary( const OUString& LibName, const OUString& Password,
+ const OUString& ExternalSourceURL, const OUString& LinkTargetURL ) override;
+ virtual void SAL_CALL addModule( const OUString& LibraryName, const OUString& ModuleName,
+ const OUString& Language, const OUString& Source ) override;
+ virtual void SAL_CALL addDialog( const OUString& LibraryName, const OUString& DialogName,
+ const uno::Sequence< sal_Int8 >& Data ) override;
+};
+
+uno::Reference< container::XNameContainer > SAL_CALL StarBasicAccess_Impl::getLibraryContainer()
+{
+ if( !mxLibContainer.is() )
+ mxLibContainer = new LibraryContainer_Impl( mpMgr );
+ return mxLibContainer;
+}
+
+void SAL_CALL StarBasicAccess_Impl::createLibrary
+(
+ const OUString& LibName,
+ const OUString& Password,
+ const OUString&,
+ const OUString& LinkTargetURL
+)
+{
+ StarBASIC* pLib = mpMgr->CreateLib( LibName, Password, LinkTargetURL );
+ DBG_ASSERT( pLib, "XML Import: Basic library could not be created");
+}
+
+void SAL_CALL StarBasicAccess_Impl::addModule
+(
+ const OUString& LibraryName,
+ const OUString& ModuleName,
+ const OUString&,
+ const OUString& Source
+)
+{
+ StarBASIC* pLib = mpMgr->GetLib( LibraryName );
+ DBG_ASSERT( pLib, "XML Import: Lib for module unknown");
+ if( pLib )
+ {
+ pLib->MakeModule( ModuleName, Source );
+ }
+}
+
+void SAL_CALL StarBasicAccess_Impl::addDialog
+(
+ const OUString&,
+ const OUString&,
+ const uno::Sequence< sal_Int8 >&
+)
+{}
+
+// Basic XML Import/Export
+uno::Reference< script::XStarBasicAccess > getStarBasicAccess( BasicManager* pMgr )
+{
+ uno::Reference< script::XStarBasicAccess > xRet =
+ new StarBasicAccess_Impl( pMgr );
+ return xRet;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/basmgr/vbahelper.cxx b/basic/source/basmgr/vbahelper.cxx
new file mode 100644
index 000000000..83165374a
--- /dev/null
+++ b/basic/source/basmgr/vbahelper.cxx
@@ -0,0 +1,187 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <basic/vbahelper.hxx>
+
+#include <map>
+#include <vector>
+#include <com/sun/star/container/XEnumeration.hpp>
+#include <com/sun/star/frame/Desktop.hpp>
+#include <com/sun/star/frame/XModel2.hpp>
+#include <com/sun/star/frame/ModuleManager.hpp>
+#include <comphelper/processfactory.hxx>
+#include <rtl/instance.hxx>
+
+namespace basic::vba {
+
+using namespace ::com::sun::star;
+
+
+namespace {
+
+/** Create an instance of a module manager.
+ */
+uno::Reference< frame::XModuleManager2 > lclCreateModuleManager()
+{
+ uno::Reference< uno::XComponentContext > xContext( ::comphelper::getProcessComponentContext(), uno::UNO_SET_THROW );
+ return frame::ModuleManager::create(xContext);
+}
+
+typedef std::vector<uno::Reference<frame::XModel>> ModelVector;
+
+ModelVector CreateDocumentsEnumeration(
+ const uno::Reference< frame::XModel >& rxModel)
+{
+ ModelVector models;
+ try
+ {
+ uno::Reference< frame::XModuleManager2 > xModuleManager( lclCreateModuleManager() );
+ OUString aIdentifier = xModuleManager->identify( rxModel );
+ uno::Reference< frame::XDesktop2 > xDesktop = frame::Desktop::create( ::comphelper::getProcessComponentContext() );
+ uno::Reference< container::XEnumerationAccess > xComponentsEA( xDesktop->getComponents(), uno::UNO_SET_THROW );
+ uno::Reference< container::XEnumeration > xEnumeration( xComponentsEA->createEnumeration(), uno::UNO_SET_THROW );
+ while( xEnumeration->hasMoreElements() )
+ {
+ uno::Reference< frame::XModel > xCurrModel( xEnumeration->nextElement(), uno::UNO_QUERY_THROW );
+ if( xModuleManager->identify( xCurrModel ) == aIdentifier )
+ models.push_back( xCurrModel );
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ }
+ return models;
+}
+
+/** Locks or unlocks the controllers of the specified document model.
+ */
+void lclLockControllers( const uno::Reference< frame::XModel >& rxModel, bool bLockControllers )
+{
+ if( rxModel.is() ) try
+ {
+ if( bLockControllers )
+ rxModel->lockControllers();
+ else
+ rxModel->unlockControllers();
+ }
+ catch(const uno::Exception& )
+ {
+ }
+}
+
+
+/** Enables or disables the container windows of all controllers of the
+ specified document model.
+ */
+void lclEnableContainerWindows( const uno::Reference< frame::XModel >& rxModel, bool bEnableWindows )
+{
+ try
+ {
+ uno::Reference< frame::XModel2 > xModel2( rxModel, uno::UNO_QUERY_THROW );
+ uno::Reference< container::XEnumeration > xControllersEnum( xModel2->getControllers(), uno::UNO_SET_THROW );
+ // iterate over all controllers
+ while( xControllersEnum->hasMoreElements() )
+ {
+ try
+ {
+ uno::Reference< frame::XController > xController( xControllersEnum->nextElement(), uno::UNO_QUERY_THROW );
+ uno::Reference< frame::XFrame > xFrame( xController->getFrame(), uno::UNO_SET_THROW );
+ uno::Reference< awt::XWindow > xWindow( xFrame->getContainerWindow(), uno::UNO_SET_THROW );
+ xWindow->setEnable( bEnableWindows );
+ }
+ catch(const uno::Exception& )
+ {
+ }
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ }
+}
+
+
+typedef void (*ModifyDocumentFunc)( const uno::Reference< frame::XModel >&, bool );
+
+/** Implementation iterating over all documents that have the same type as the
+ specified model, and calling the passed functor.
+ */
+void lclIterateDocuments( ModifyDocumentFunc pModifyDocumentFunc, const uno::Reference< frame::XModel >& rxModel, bool bModificator )
+{
+ ModelVector models(CreateDocumentsEnumeration(rxModel));
+ // iterate over all open documents
+ for (auto const& xCurrModel : models)
+ {
+ try
+ {
+ pModifyDocumentFunc(xCurrModel, bModificator);
+ }
+ catch (const uno::Exception&)
+ {
+ }
+ }
+}
+
+
+struct CurrDirPool
+{
+ ::osl::Mutex maMutex;
+ std::map< OUString, OUString > maCurrDirs;
+};
+
+struct StaticCurrDirPool : public ::rtl::Static< CurrDirPool, StaticCurrDirPool > {};
+
+} // namespace
+
+
+void lockControllersOfAllDocuments( const uno::Reference< frame::XModel >& rxModel, bool bLockControllers )
+{
+ lclIterateDocuments( &lclLockControllers, rxModel, bLockControllers );
+}
+
+
+void enableContainerWindowsOfAllDocuments( const uno::Reference< frame::XModel >& rxModel, bool bEnableWindows )
+{
+ lclIterateDocuments( &lclEnableContainerWindows, rxModel, bEnableWindows );
+}
+
+
+void registerCurrentDirectory( const uno::Reference< frame::XModel >& rxModel, const OUString& rPath )
+{
+ if( rPath.isEmpty() )
+ return;
+
+ CurrDirPool& rPool = StaticCurrDirPool::get();
+ ::osl::MutexGuard aGuard( rPool.maMutex );
+ try
+ {
+ uno::Reference< frame::XModuleManager2 > xModuleManager( lclCreateModuleManager() );
+ OUString aIdentifier = xModuleManager->identify( rxModel );
+ if( !aIdentifier.isEmpty() )
+ rPool.maCurrDirs[ aIdentifier ] = rPath;
+ }
+ catch(const uno::Exception& )
+ {
+ }
+}
+
+
+} // namespace
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/codecompletecache.cxx b/basic/source/classes/codecompletecache.cxx
new file mode 100644
index 000000000..7c54a66e9
--- /dev/null
+++ b/basic/source/classes/codecompletecache.cxx
@@ -0,0 +1,193 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/codecompletecache.hxx>
+#include <iostream>
+#include <rtl/instance.hxx>
+#include <officecfg/Office/BasicIDE.hxx>
+
+namespace
+{
+ class theCodeCompleteOptions: public ::rtl::Static< CodeCompleteOptions, theCodeCompleteOptions >{};
+}
+
+CodeCompleteOptions::CodeCompleteOptions()
+{
+ bIsAutoCorrectOn = officecfg::Office::BasicIDE::Autocomplete::AutoCorrect::get();
+ bIsAutoCloseParenthesisOn = officecfg::Office::BasicIDE::Autocomplete::AutocloseParenthesis::get();
+ bIsAutoCloseQuotesOn = officecfg::Office::BasicIDE::Autocomplete::AutocloseDoubleQuotes::get();
+ bIsProcedureAutoCompleteOn = officecfg::Office::BasicIDE::Autocomplete::AutocloseProc::get();
+ bIsCodeCompleteOn = officecfg::Office::BasicIDE::Autocomplete::CodeComplete::get();
+ bExtendedTypeDeclarationOn = officecfg::Office::BasicIDE::Autocomplete::UseExtended::get();
+}
+
+bool CodeCompleteOptions::IsCodeCompleteOn()
+{
+ return theCodeCompleteOptions::get().aMiscOptions.IsExperimentalMode() && theCodeCompleteOptions::get().bIsCodeCompleteOn;
+}
+
+void CodeCompleteOptions::SetCodeCompleteOn( bool b )
+{
+ theCodeCompleteOptions::get().bIsCodeCompleteOn = b;
+}
+
+bool CodeCompleteOptions::IsExtendedTypeDeclaration()
+{
+ return theCodeCompleteOptions::get().aMiscOptions.IsExperimentalMode() && theCodeCompleteOptions::get().bExtendedTypeDeclarationOn;
+}
+
+void CodeCompleteOptions::SetExtendedTypeDeclaration( bool b )
+{
+ theCodeCompleteOptions::get().bExtendedTypeDeclarationOn = b;
+}
+
+bool CodeCompleteOptions::IsProcedureAutoCompleteOn()
+{
+ return theCodeCompleteOptions::get().aMiscOptions.IsExperimentalMode() && theCodeCompleteOptions::get().bIsProcedureAutoCompleteOn;
+}
+
+void CodeCompleteOptions::SetProcedureAutoCompleteOn( bool b )
+{
+ theCodeCompleteOptions::get().bIsProcedureAutoCompleteOn = b;
+}
+
+bool CodeCompleteOptions::IsAutoCloseQuotesOn()
+{
+ return theCodeCompleteOptions::get().aMiscOptions.IsExperimentalMode() && theCodeCompleteOptions::get().bIsAutoCloseQuotesOn;
+}
+
+void CodeCompleteOptions::SetAutoCloseQuotesOn( bool b )
+{
+ theCodeCompleteOptions::get().bIsAutoCloseQuotesOn = b;
+}
+
+bool CodeCompleteOptions::IsAutoCloseParenthesisOn()
+{
+ return theCodeCompleteOptions::get().aMiscOptions.IsExperimentalMode() && theCodeCompleteOptions::get().bIsAutoCloseParenthesisOn;
+}
+
+void CodeCompleteOptions::SetAutoCloseParenthesisOn( bool b )
+{
+ theCodeCompleteOptions::get().bIsAutoCloseParenthesisOn = b;
+}
+
+bool CodeCompleteOptions::IsAutoCorrectOn()
+{
+ return theCodeCompleteOptions::get().aMiscOptions.IsExperimentalMode() && theCodeCompleteOptions::get().bIsAutoCorrectOn;
+}
+
+void CodeCompleteOptions::SetAutoCorrectOn( bool b )
+{
+ theCodeCompleteOptions::get().bIsAutoCorrectOn = b;
+}
+
+std::ostream& operator<< (std::ostream& aStream, const CodeCompleteDataCache& aCache)
+{
+ aStream << "Global variables" << std::endl;
+ for (auto const& globalVar : aCache.aGlobalVars)
+ {
+ aStream << globalVar.first << "," << globalVar.second << std::endl;
+ }
+ aStream << "Local variables" << std::endl;
+ for (auto const& varScope : aCache.aVarScopes)
+ {
+ aStream << varScope.first << std::endl;
+ CodeCompleteVarTypes aVarTypes = varScope.second;
+ for (auto const& varType : aVarTypes)
+ {
+ aStream << "\t" << varType.first << "," << varType.second << std::endl;
+ }
+ }
+ aStream << "-----------------" << std::endl;
+ return aStream;
+}
+
+void CodeCompleteDataCache::Clear()
+{
+ aVarScopes.clear();
+ aGlobalVars.clear();
+}
+
+void CodeCompleteDataCache::InsertGlobalVar( const OUString& sVarName, const OUString& sVarType )
+{
+ aGlobalVars.emplace( sVarName, sVarType );
+}
+
+void CodeCompleteDataCache::InsertLocalVar( const OUString& sProcName, const OUString& sVarName, const OUString& sVarType )
+{
+ CodeCompleteVarScopes::const_iterator aIt = aVarScopes.find( sProcName );
+ if( aIt == aVarScopes.end() ) //new procedure
+ {
+ CodeCompleteVarTypes aTypes;
+ aTypes.emplace( sVarName, sVarType );
+ aVarScopes.emplace( sProcName, aTypes );
+ }
+ else
+ {
+ CodeCompleteVarTypes aTypes = aVarScopes[ sProcName ];
+ aTypes.emplace( sVarName, sVarType );
+ aVarScopes[ sProcName ] = aTypes;
+ }
+}
+
+OUString CodeCompleteDataCache::GetVarType( const OUString& sVarName ) const
+{
+ for (auto const& varScope : aVarScopes)
+ {
+ CodeCompleteVarTypes aTypes = varScope.second;
+ for (auto const& elem : aTypes)
+ {
+ if( elem.first.equalsIgnoreAsciiCase( sVarName ) )
+ {
+ return elem.second;
+ }
+ }
+ }
+ //not a local, search global scope
+ for (auto const& globalVar : aGlobalVars)
+ {
+ if( globalVar.first.equalsIgnoreAsciiCase( sVarName ) )
+ return globalVar.second;
+ }
+ return OUString(); //not found
+}
+
+OUString CodeCompleteDataCache::GetCorrectCaseVarName( const OUString& sVarName, const OUString& sActProcName ) const
+{
+ for (auto const& varScope : aVarScopes)
+ {
+ CodeCompleteVarTypes aTypes = varScope.second;
+ for (auto const& elem : aTypes)
+ {
+ if( elem.first.equalsIgnoreAsciiCase( sVarName ) && varScope.first.equalsIgnoreAsciiCase( sActProcName ) )
+ {
+ return elem.first;
+ }
+ }
+ }
+ // search global scope
+ for (auto const& globalVar : aGlobalVars)
+ {
+ if( globalVar.first.equalsIgnoreAsciiCase( sVarName ) )
+ return globalVar.first;
+ }
+ return OUString(); //not found
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/errobject.cxx b/basic/source/classes/errobject.cxx
new file mode 100644
index 000000000..b961e1698
--- /dev/null
+++ b/basic/source/classes/errobject.cxx
@@ -0,0 +1,215 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <errobject.hxx>
+#include <sbxbase.hxx>
+
+#include <cppuhelper/implbase.hxx>
+#include <com/sun/star/script/XDefaultProperty.hpp>
+#include <sbintern.hxx>
+#include <runtime.hxx>
+
+using namespace ::com::sun::star;
+using namespace ::ooo;
+
+class ErrObject : public ::cppu::WeakImplHelper< vba::XErrObject,
+ script::XDefaultProperty >
+{
+ OUString m_sHelpFile;
+ OUString m_sSource;
+ OUString m_sDescription;
+ sal_Int32 m_nNumber;
+ sal_Int32 m_nHelpContext;
+
+public:
+ ErrObject();
+
+ // Attributes
+ virtual ::sal_Int32 SAL_CALL getNumber() override;
+ virtual void SAL_CALL setNumber( ::sal_Int32 _number ) override;
+ virtual ::sal_Int32 SAL_CALL getHelpContext() override;
+ virtual void SAL_CALL setHelpContext( ::sal_Int32 _helpcontext ) override;
+ virtual OUString SAL_CALL getHelpFile() override;
+ virtual void SAL_CALL setHelpFile( const OUString& _helpfile ) override;
+ virtual OUString SAL_CALL getDescription() override;
+ virtual void SAL_CALL setDescription( const OUString& _description ) override;
+ virtual OUString SAL_CALL getSource() override;
+ virtual void SAL_CALL setSource( const OUString& _source ) override;
+
+ // Methods
+ virtual void SAL_CALL Clear( ) override;
+ virtual void SAL_CALL Raise( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext ) override;
+ // XDefaultProperty
+ virtual OUString SAL_CALL getDefaultPropertyName( ) override;
+
+ // Helper method
+ /// @throws css::uno::RuntimeException
+ void setData( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description,
+ const uno::Any& HelpFile, const uno::Any& HelpContext );
+};
+
+ErrObject::ErrObject() : m_nNumber(0), m_nHelpContext(0)
+{
+}
+
+sal_Int32 SAL_CALL
+ErrObject::getNumber()
+{
+ return m_nNumber;
+}
+
+void SAL_CALL
+ErrObject::setNumber( ::sal_Int32 _number )
+{
+ GetSbData()->pInst->setErrorVB( _number );
+ OUString _description = GetSbData()->pInst->GetErrorMsg();
+ setData( uno::Any( _number ), uno::Any(), uno::Any( _description ), uno::Any(), uno::Any() );
+}
+
+::sal_Int32 SAL_CALL
+ErrObject::getHelpContext()
+{
+ return m_nHelpContext;
+}
+void SAL_CALL
+ErrObject::setHelpContext( ::sal_Int32 _helpcontext )
+{
+ m_nHelpContext = _helpcontext;
+}
+
+OUString SAL_CALL
+ErrObject::getHelpFile()
+{
+ return m_sHelpFile;
+}
+
+void SAL_CALL
+ErrObject::setHelpFile( const OUString& _helpfile )
+{
+ m_sHelpFile = _helpfile;
+}
+
+OUString SAL_CALL
+ErrObject::getDescription()
+{
+ return m_sDescription;
+}
+
+void SAL_CALL
+ErrObject::setDescription( const OUString& _description )
+{
+ m_sDescription = _description;
+}
+
+OUString SAL_CALL
+ErrObject::getSource()
+{
+ return m_sSource;
+}
+
+void SAL_CALL
+ErrObject::setSource( const OUString& _source )
+{
+ m_sSource = _source;
+}
+
+// Methods
+void SAL_CALL
+ErrObject::Clear( )
+{
+ m_sHelpFile.clear();
+ m_sSource = m_sHelpFile;
+ m_sDescription = m_sSource;
+ m_nNumber = 0;
+ m_nHelpContext = 0;
+}
+
+void SAL_CALL
+ErrObject::Raise( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext )
+{
+ setData( Number, Source, Description, HelpFile, HelpContext );
+ if ( m_nNumber )
+ GetSbData()->pInst->ErrorVB( m_nNumber, m_sDescription );
+}
+
+// XDefaultProperty
+OUString SAL_CALL
+ErrObject::getDefaultPropertyName( )
+{
+ return "Number";
+}
+
+void ErrObject::setData( const uno::Any& Number, const uno::Any& Source, const uno::Any& Description, const uno::Any& HelpFile, const uno::Any& HelpContext )
+{
+ if ( !Number.hasValue() )
+ throw uno::RuntimeException("Missing Required Parameter" );
+ Number >>= m_nNumber;
+ Description >>= m_sDescription;
+ Source >>= m_sSource;
+ HelpFile >>= m_sHelpFile;
+ HelpContext >>= m_nHelpContext;
+}
+
+// SbxErrObject
+SbxErrObject::SbxErrObject( const OUString& rName, const uno::Any& rUnoObj )
+ : SbUnoObject( rName, rUnoObj )
+ , m_pErrObject( nullptr )
+{
+ rUnoObj >>= m_xErr;
+ if ( m_xErr.is() )
+ {
+ SetDfltProperty( uno::Reference< script::XDefaultProperty >( m_xErr, uno::UNO_QUERY_THROW )->getDefaultPropertyName() ) ;
+ m_pErrObject = static_cast< ErrObject* >( m_xErr.get() );
+ }
+}
+
+SbxErrObject::~SbxErrObject()
+{
+}
+
+uno::Reference< vba::XErrObject > const &
+SbxErrObject::getUnoErrObject()
+{
+ SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( getErrObject().get() );
+ return pGlobErr->m_xErr;
+}
+
+SbxVariableRef const &
+SbxErrObject::getErrObject()
+{
+ SbxVariableRef& rGlobErr = GetSbxData_Impl().m_aGlobErr;
+ {
+ static osl::Mutex aMutex;
+ osl::MutexGuard aGuard(aMutex);
+ if (!rGlobErr)
+ rGlobErr = new SbxErrObject("Err",
+ uno::Any(uno::Reference<vba::XErrObject>(new ErrObject())));
+ }
+ return rGlobErr;
+}
+
+void SbxErrObject::setNumberAndDescription( ::sal_Int32 _number, const OUString& _description )
+{
+ if( m_pErrObject != nullptr )
+ {
+ m_pErrObject->setData( uno::Any( _number ), uno::Any(), uno::Any( _description ), uno::Any(), uno::Any() );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/eventatt.cxx b/basic/source/classes/eventatt.cxx
new file mode 100644
index 000000000..2a4127159
--- /dev/null
+++ b/basic/source/classes/eventatt.cxx
@@ -0,0 +1,548 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <comphelper/processfactory.hxx>
+#include <comphelper/string.hxx>
+
+#include <com/sun/star/awt/XControlContainer.hpp>
+#include <com/sun/star/awt/XControl.hpp>
+#include <com/sun/star/awt/DialogProvider.hpp>
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/container/XEnumerationAccess.hpp>
+#include <com/sun/star/container/XNameContainer.hpp>
+#include <com/sun/star/frame/XModel.hpp>
+#include <com/sun/star/frame/Desktop.hpp>
+#include <com/sun/star/script/XLibraryContainer.hpp>
+#include <com/sun/star/script/provider/theMasterScriptProviderFactory.hpp>
+#include <com/sun/star/script/provider/XScriptProviderSupplier.hpp>
+#include <com/sun/star/script/provider/XScriptProvider.hpp>
+#include <com/sun/star/io/XInputStreamProvider.hpp>
+
+#include <basic/basicmanagerrepository.hxx>
+#include <basic/basmgr.hxx>
+
+#include <sal/log.hxx>
+#include <tools/diagnose_ex.h>
+#include <vcl/svapp.hxx>
+#include <sbunoobj.hxx>
+#include <basic/sberrors.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/sbmeth.hxx>
+#include <basic/sbuno.hxx>
+#include <runtime.hxx>
+#include <sbintern.hxx>
+#include <eventatt.hxx>
+
+#include <cppuhelper/implbase.hxx>
+
+using namespace ::com::sun::star;
+using namespace ::com::sun::star::uno;
+using namespace ::com::sun::star::script;
+using namespace ::com::sun::star::lang;
+using namespace ::com::sun::star::beans;
+using namespace ::com::sun::star::container;
+using namespace ::com::sun::star::reflection;
+using namespace ::com::sun::star::awt;
+using namespace ::com::sun::star::io;
+using namespace ::cppu;
+
+namespace {
+
+void SFURL_firing_impl( const ScriptEvent& aScriptEvent, Any* pRet, const Reference< frame::XModel >& xModel )
+{
+ SAL_INFO("basic", "Processing script url " << aScriptEvent.ScriptCode);
+ try
+ {
+ Reference< provider::XScriptProvider > xScriptProvider;
+ if ( xModel.is() )
+ {
+ Reference< provider::XScriptProviderSupplier > xSupplier( xModel, UNO_QUERY );
+ OSL_ENSURE( xSupplier.is(), "SFURL_firing_impl: failed to get script provider supplier" );
+ if ( xSupplier.is() )
+ xScriptProvider.set( xSupplier->getScriptProvider() );
+ }
+ else
+ {
+ Reference< XComponentContext > xContext(
+ comphelper::getProcessComponentContext() );
+ Reference< provider::XScriptProviderFactory > xFactory =
+ provider::theMasterScriptProviderFactory::get( xContext );
+
+ Any aCtx;
+ aCtx <<= OUString("user");
+ xScriptProvider = xFactory->createScriptProvider( aCtx );
+ }
+
+ if ( !xScriptProvider.is() )
+ {
+ SAL_INFO("basic", "Failed to create msp");
+ return;
+ }
+ Sequence< Any > inArgs( 0 );
+ Sequence< Any > outArgs( 0 );
+ Sequence< sal_Int16 > outIndex;
+
+ // get Arguments for script
+ inArgs = aScriptEvent.Arguments;
+
+ Reference< provider::XScript > xScript = xScriptProvider->getScript( aScriptEvent.ScriptCode );
+
+ if ( !xScript.is() )
+ {
+ SAL_INFO("basic", "Failed to Failed to obtain XScript");
+ return;
+ }
+
+ Any result = xScript->invoke( inArgs, outIndex, outArgs );
+ if ( pRet )
+ {
+ *pRet = result;
+ }
+ }
+ catch ( const RuntimeException& )
+ {
+ TOOLS_INFO_EXCEPTION("basic", "" );
+ }
+ catch ( const Exception& )
+ {
+ TOOLS_INFO_EXCEPTION("basic", "" );
+ }
+
+}
+
+
+class BasicScriptListener_Impl : public WeakImplHelper< XScriptListener >
+{
+ StarBASICRef maBasicRef;
+ Reference< frame::XModel > m_xModel;
+
+ void firing_impl(const ScriptEvent& aScriptEvent, Any* pRet);
+
+public:
+ BasicScriptListener_Impl( StarBASIC* pBasic, const Reference< frame::XModel >& xModel )
+ : maBasicRef( pBasic ), m_xModel( xModel ) {}
+
+ // Methods of XAllListener
+ virtual void SAL_CALL firing(const ScriptEvent& aScriptEvent) override;
+ virtual Any SAL_CALL approveFiring(const ScriptEvent& aScriptEvent) override;
+
+ // Methods of XEventListener
+ virtual void SAL_CALL disposing(const EventObject& Source) override;
+};
+
+// Methods XAllListener
+void BasicScriptListener_Impl::firing( const ScriptEvent& aScriptEvent )
+{
+ SolarMutexGuard g;
+
+ firing_impl( aScriptEvent, nullptr );
+}
+
+Any BasicScriptListener_Impl::approveFiring( const ScriptEvent& aScriptEvent )
+{
+ SolarMutexGuard g;
+
+ Any aRetAny;
+ firing_impl( aScriptEvent, &aRetAny );
+ return aRetAny;
+}
+
+// Methods XEventListener
+void BasicScriptListener_Impl::disposing(const EventObject& )
+{
+ // TODO: ???
+ //SolarMutexGuard aGuard;
+ //xSbxObj.Clear();
+}
+
+
+void BasicScriptListener_Impl::firing_impl( const ScriptEvent& aScriptEvent, Any* pRet )
+{
+ if( aScriptEvent.ScriptType == "StarBasic" )
+ {
+ // Full qualified name?
+ OUString aMacro( aScriptEvent.ScriptCode );
+ OUString aLibName;
+ OUString aLocation;
+ if( comphelper::string::getTokenCount(aMacro, '.') == 3 )
+ {
+ sal_Int32 nLast = 0;
+ OUString aFullLibName = aMacro.getToken( 0, '.', nLast );
+
+ sal_Int32 nIndex = aFullLibName.indexOf( ':' );
+ if (nIndex >= 0)
+ {
+ aLocation = aFullLibName.copy( 0, nIndex );
+ aLibName = aFullLibName.copy( nIndex + 1 );
+ }
+
+ aMacro = aMacro.copy( nLast );
+ }
+
+ SbxObject* p = maBasicRef.get();
+ SbxObject* pParent = p->GetParent();
+ SbxObject* pParentParent = pParent ? pParent->GetParent() : nullptr;
+
+ StarBASICRef xAppStandardBasic;
+ StarBASICRef xDocStandardBasic;
+ if( pParentParent )
+ {
+ // Own basic must be document library
+ xAppStandardBasic = static_cast<StarBASIC*>(pParentParent);
+ xDocStandardBasic = static_cast<StarBASIC*>(pParent);
+ }
+ else if( pParent )
+ {
+ OUString aName = p->GetName();
+ if( aName == "Standard" )
+ {
+ // Own basic is doc standard lib
+ xDocStandardBasic = static_cast<StarBASIC*>(p);
+ }
+ xAppStandardBasic = static_cast<StarBASIC*>(pParent);
+ }
+ else
+ {
+ xAppStandardBasic = static_cast<StarBASIC*>(p);
+ }
+
+ bool bSearchLib = true;
+ StarBASICRef xLibSearchBasic;
+ if( aLocation == "application" )
+ {
+ xLibSearchBasic = xAppStandardBasic;
+ }
+ else if( aLocation == "document" )
+ {
+ xLibSearchBasic = xDocStandardBasic;
+ }
+ else
+ {
+ bSearchLib = false;
+ }
+ SbxVariable* pMethVar = nullptr;
+ // Be still tolerant and make default search if no search basic exists
+ if( bSearchLib && xLibSearchBasic.is() )
+ {
+ sal_Int32 nCount = xLibSearchBasic->GetObjects()->Count32();
+ for( sal_Int32 nObj = -1; nObj < nCount ; nObj++ )
+ {
+ StarBASIC* pBasic;
+ if( nObj == -1 )
+ {
+ pBasic = xLibSearchBasic.get();
+ }
+ else
+ {
+ SbxVariable* pVar = xLibSearchBasic->GetObjects()->Get32( nObj );
+ pBasic = dynamic_cast<StarBASIC*>( pVar );
+ }
+ if( pBasic )
+ {
+ OUString aName = pBasic->GetName();
+ if( aName == aLibName )
+ {
+ // Search only in the lib, not automatically in application basic
+ SbxFlagBits nFlags = pBasic->GetFlags();
+ pBasic->ResetFlag( SbxFlagBits::GlobalSearch );
+ pMethVar = pBasic->Find( aMacro, SbxClassType::DontCare );
+ pBasic->SetFlags( nFlags );
+ break;
+ }
+ }
+ }
+ }
+
+ // Default: Be tolerant and search everywhere
+ if( (!pMethVar || dynamic_cast<const SbMethod*>( pMethVar) == nullptr) && maBasicRef.is() )
+ {
+ pMethVar = maBasicRef->FindQualified( aMacro, SbxClassType::DontCare );
+ }
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( pMethVar );
+ if( !pMeth )
+ {
+ return;
+ }
+ // Setup parameters
+ SbxArrayRef xArray;
+ sal_Int32 nCnt = aScriptEvent.Arguments.getLength();
+ if( nCnt )
+ {
+ xArray = new SbxArray;
+ const Any *pArgs = aScriptEvent.Arguments.getConstArray();
+ for( sal_Int32 i = 0; i < nCnt; i++ )
+ {
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( xVar.get(), pArgs[i] );
+ xArray->Put32( xVar.get(), sal::static_int_cast< sal_uInt32 >(i+1) );
+ }
+ }
+
+ // Call method
+ SbxVariableRef xValue = pRet ? new SbxVariable : nullptr;
+ if( xArray.is() )
+ {
+ pMeth->SetParameters( xArray.get() );
+ }
+ pMeth->Call( xValue.get() );
+ if( pRet )
+ {
+ *pRet = sbxToUnoValue( xValue.get() );
+ }
+ pMeth->SetParameters( nullptr );
+ }
+ else // scripting framework script
+ {
+ //callBasic via scripting framework
+ SFURL_firing_impl( aScriptEvent, pRet, m_xModel );
+ }
+}
+
+css::uno::Reference< css::container::XNameContainer > implFindDialogLibForDialog( const Any& rDlgAny, SbxObject* pBasic )
+{
+ css::uno::Reference< css::container::XNameContainer > aRetDlgLib;
+
+ SbxVariable* pDlgLibContVar = pBasic->Find("DialogLibraries", SbxClassType::Object);
+ if( auto pDlgLibContUnoObj = dynamic_cast<SbUnoObject*>( pDlgLibContVar) )
+ {
+ Any aDlgLibContAny = pDlgLibContUnoObj->getUnoAny();
+
+ Reference< XLibraryContainer > xDlgLibContNameAccess( aDlgLibContAny, UNO_QUERY );
+ OSL_ENSURE( xDlgLibContNameAccess.is(), "implFindDialogLibForDialog: no lib container for the given dialog!" );
+ if( xDlgLibContNameAccess.is() )
+ {
+ Sequence< OUString > aLibNames = xDlgLibContNameAccess->getElementNames();
+ const OUString* pLibNames = aLibNames.getConstArray();
+ sal_Int32 nLibNameCount = aLibNames.getLength();
+
+ for( sal_Int32 iLib = 0 ; iLib < nLibNameCount ; iLib++ )
+ {
+ if ( !xDlgLibContNameAccess->isLibraryLoaded( pLibNames[ iLib ] ) )
+ // if the library isn't loaded, then the dialog cannot originate from this lib
+ continue;
+
+ Any aDlgLibAny = xDlgLibContNameAccess->getByName( pLibNames[ iLib ] );
+
+ Reference< XNameContainer > xDlgLibNameCont( aDlgLibAny, UNO_QUERY );
+ OSL_ENSURE( xDlgLibNameCont.is(), "implFindDialogLibForDialog: invalid dialog lib!" );
+ if( xDlgLibNameCont.is() )
+ {
+ Sequence< OUString > aDlgNames = xDlgLibNameCont->getElementNames();
+ const OUString* pDlgNames = aDlgNames.getConstArray();
+ sal_Int32 nDlgNameCount = aDlgNames.getLength();
+
+ for( sal_Int32 iDlg = 0 ; iDlg < nDlgNameCount ; iDlg++ )
+ {
+ Any aDlgAny = xDlgLibNameCont->getByName( pDlgNames[ iDlg ] );
+ if( aDlgAny == rDlgAny )
+ {
+ aRetDlgLib = xDlgLibNameCont;
+ break;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return aRetDlgLib;
+}
+
+css::uno::Reference< css::container::XNameContainer > implFindDialogLibForDialogBasic( const Any& aAnyISP, SbxObject* pBasic, StarBASIC*& pFoundBasic )
+{
+ css::uno::Reference< css::container::XNameContainer > aDlgLib;
+ // Find dialog library for dialog, direct access is not possible here
+ StarBASIC* pStartedBasic = static_cast<StarBASIC*>(pBasic);
+ SbxObject* pParentBasic = pStartedBasic ? pStartedBasic->GetParent() : nullptr;
+ SbxObject* pParentParentBasic = pParentBasic ? pParentBasic->GetParent() : nullptr;
+
+ SbxObject* pSearchBasic1 = nullptr;
+ SbxObject* pSearchBasic2 = nullptr;
+ if( pParentParentBasic )
+ {
+ pSearchBasic1 = pParentBasic;
+ pSearchBasic2 = pParentParentBasic;
+ }
+ else
+ {
+ pSearchBasic1 = pStartedBasic;
+ pSearchBasic2 = pParentBasic;
+ }
+ if( pSearchBasic1 )
+ {
+ aDlgLib = implFindDialogLibForDialog( aAnyISP, pSearchBasic1 );
+
+ if ( aDlgLib.is() )
+ pFoundBasic = static_cast<StarBASIC*>(pSearchBasic1);
+
+ else if( pSearchBasic2 )
+ {
+ aDlgLib = implFindDialogLibForDialog( aAnyISP, pSearchBasic2 );
+ if ( aDlgLib.is() )
+ pFoundBasic = static_cast<StarBASIC*>(pSearchBasic2);
+ }
+ }
+ return aDlgLib;
+}
+
+}
+
+void RTL_Impl_CreateUnoDialog( SbxArray& rPar )
+{
+ Reference< XComponentContext > xContext( comphelper::getProcessComponentContext() );
+
+ // We need at least 1 parameter
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // Get dialog
+ SbxBaseRef pObj = rPar.Get32( 1 )->GetObject();
+ if( !(pObj.is() && dynamic_cast<const SbUnoObject*>( pObj.get() ) != nullptr) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ SbUnoObject* pUnoObj = static_cast<SbUnoObject*>(pObj.get());
+ Any aAnyISP = pUnoObj->getUnoAny();
+ TypeClass eType = aAnyISP.getValueType().getTypeClass();
+
+ if( eType != TypeClass_INTERFACE )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // Create new uno dialog
+ Reference< XNameContainer > xDialogModel( xContext->getServiceManager()->createInstanceWithContext(
+ "com.sun.star.awt.UnoControlDialogModel", xContext), UNO_QUERY );
+ if( !xDialogModel.is() )
+ {
+ return;
+ }
+ Reference< XInputStreamProvider > xISP;
+ aAnyISP >>= xISP;
+ if( !xISP.is() )
+ {
+ return;
+ }
+
+ // Import the DialogModel
+ Reference< XInputStream > xInput( xISP->createInputStream() );
+
+ // i83963 Force decoration
+ uno::Reference< beans::XPropertySet > xDlgModPropSet( xDialogModel, uno::UNO_QUERY );
+ if( xDlgModPropSet.is() )
+ {
+ try
+ {
+ bool bDecoration = true;
+ OUString aDecorationPropName("Decoration");
+ Any aDecorationAny = xDlgModPropSet->getPropertyValue( aDecorationPropName );
+ aDecorationAny >>= bDecoration;
+ if( !bDecoration )
+ {
+ xDlgModPropSet->setPropertyValue( aDecorationPropName, Any( true ) );
+ xDlgModPropSet->setPropertyValue( "Title", Any( OUString() ) );
+ }
+ }
+ catch(const UnknownPropertyException& )
+ {}
+ }
+
+ css::uno::Reference< css::container::XNameContainer > aDlgLib;
+ bool bDocDialog = false;
+ StarBASIC* pFoundBasic = nullptr;
+ SAL_INFO("basic", "About to try get a hold of ThisComponent");
+ Reference< frame::XModel > xModel = StarBASIC::GetModelFromBasic( GetSbData()->pInst->GetBasic() ) ;
+ aDlgLib = implFindDialogLibForDialogBasic( aAnyISP, GetSbData()->pInst->GetBasic(), pFoundBasic );
+ // If we found the dialog then it belongs to the Search basic
+ if ( !pFoundBasic )
+ {
+ Reference< frame::XDesktop2 > xDesktop = frame::Desktop::create( xContext );
+ Reference< container::XEnumeration > xModels;
+ Reference< container::XEnumerationAccess > xComponents = xDesktop->getComponents();
+ if ( xComponents.is() )
+ {
+ xModels = xComponents->createEnumeration();
+ }
+ if ( xModels.is() )
+ {
+ while ( xModels->hasMoreElements() )
+ {
+ Reference< frame::XModel > xNextModel( xModels->nextElement(), UNO_QUERY );
+ if ( xNextModel.is() )
+ {
+ BasicManager* pMgr = basic::BasicManagerRepository::getDocumentBasicManager( xNextModel );
+ if ( pMgr )
+ {
+ aDlgLib = implFindDialogLibForDialogBasic( aAnyISP, pMgr->GetLib(0), pFoundBasic );
+ }
+ if ( aDlgLib.is() )
+ {
+ bDocDialog = true;
+ xModel = xNextModel;
+ break;
+ }
+ }
+ }
+ }
+ }
+ if ( pFoundBasic )
+ {
+ bDocDialog = pFoundBasic->IsDocBasic();
+ }
+ Reference< XScriptListener > xScriptListener = new BasicScriptListener_Impl( GetSbData()->pInst->GetBasic(), xModel );
+
+ // Create a "living" Dialog
+ Reference< XControl > xCntrl;
+ try
+ {
+ Reference< XDialogProvider > xDlgProv;
+ if( bDocDialog )
+ xDlgProv = css::awt::DialogProvider::createWithModelAndScripting( xContext, xModel, xInput, aDlgLib, xScriptListener );
+ else
+ xDlgProv = css::awt::DialogProvider::createWithModelAndScripting( xContext, uno::Reference< frame::XModel >(), xInput, aDlgLib, xScriptListener );
+
+ xCntrl.set( xDlgProv->createDialog(OUString() ), UNO_QUERY_THROW );
+ // Add dialog model to dispose vector
+ Reference< XComponent > xDlgComponent( xCntrl->getModel(), UNO_QUERY );
+ GetSbData()->pInst->getComponentVector().push_back( xDlgComponent );
+ // need ThisComponent from calling script
+ }
+ // preserve existing bad behaviour, it's possible... but probably
+ // illegal to open 2 dialogs ( they ARE modal ) when this happens, sometimes
+ // create dialog fails. So, in this case let's not throw, just leave basic
+ // detect the unset object.
+ catch(const uno::Exception& )
+ {
+ }
+
+ // Return dialog
+ Any aRetVal;
+ aRetVal <<= xCntrl;
+ SbxVariableRef refVar = rPar.Get32(0);
+ unoToSbxValue( refVar.get(), aRetVal );
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/global.cxx b/basic/source/classes/global.cxx
new file mode 100644
index 000000000..1e72e242d
--- /dev/null
+++ b/basic/source/classes/global.cxx
@@ -0,0 +1,46 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+
+#include <comphelper/processfactory.hxx>
+#include <i18nlangtag/lang.h>
+#include <i18nutil/transliteration.hxx>
+#include <rtl/instance.hxx>
+#include <unotools/transliterationwrapper.hxx>
+#include <vcl/svapp.hxx>
+#include <vcl/settings.hxx>
+
+#include <global.hxx>
+
+namespace
+{
+ class lclTransliterationWrapper
+ {
+ private:
+ utl::TransliterationWrapper m_aTransliteration;
+ public:
+ lclTransliterationWrapper()
+ : m_aTransliteration(
+ comphelper::getProcessComponentContext(),
+ TransliterationFlags::IGNORE_CASE )
+ {
+ const LanguageType eOfficeLanguage = Application::GetSettings().GetLanguageTag().getLanguageType();
+ m_aTransliteration.loadModuleIfNeeded( eOfficeLanguage );
+ }
+ utl::TransliterationWrapper& getTransliteration() { return m_aTransliteration; }
+ };
+
+ class theTransliterationWrapper : public rtl::Static<lclTransliterationWrapper, theTransliterationWrapper> {};
+}
+
+utl::TransliterationWrapper& SbGlobal::GetTransliteration()
+{
+ return theTransliterationWrapper::get().getTransliteration();
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/image.cxx b/basic/source/classes/image.cxx
new file mode 100644
index 000000000..edee7686e
--- /dev/null
+++ b/basic/source/classes/image.cxx
@@ -0,0 +1,713 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <tools/stream.hxx>
+#include <tools/tenccvt.hxx>
+#include <osl/thread.h>
+#include <sal/log.hxx>
+#include <basic/sbx.hxx>
+#include <sb.hxx>
+#include <sbxprop.hxx>
+#include <string.h>
+#include <image.hxx>
+#include <codegen.hxx>
+#include <memory>
+
+SbiImage::SbiImage()
+{
+ pStrings = nullptr;
+ pCode = nullptr;
+ pLegacyPCode = nullptr;
+ nFlags = SbiImageFlags::NONE;
+ nStringSize= 0;
+ nCodeSize = 0;
+ nLegacyCodeSize =
+ nDimBase = 0;
+ bInit =
+ bError = false;
+ bFirstInit = true;
+ eCharSet = osl_getThreadTextEncoding();
+ nStringIdx = 0;
+ nStringOff = 0;
+}
+
+SbiImage::~SbiImage()
+{
+ Clear();
+}
+
+void SbiImage::Clear()
+{
+ mvStringOffsets.clear();
+ pStrings.reset();
+ pCode.reset();
+ pLegacyPCode.reset();
+ nFlags = SbiImageFlags::NONE;
+ nStringSize= 0;
+ nLegacyCodeSize = 0;
+ nCodeSize = 0;
+ eCharSet = osl_getThreadTextEncoding();
+ nDimBase = 0;
+ bError = false;
+}
+
+static bool SbiGood( SvStream const & r )
+{
+ return r.good();
+}
+
+// Open Record
+static sal_uInt64 SbiOpenRecord( SvStream& r, FileOffset nSignature, sal_uInt16 nElem )
+{
+ sal_uInt64 nPos = r.Tell();
+ r.WriteUInt16( static_cast<sal_uInt16>( nSignature ) )
+ .WriteInt32( 0 ).WriteUInt16( nElem );
+ return nPos;
+}
+
+// Close Record
+static void SbiCloseRecord( SvStream& r, sal_uInt64 nOff )
+{
+ sal_uInt64 nPos = r.Tell();
+ r.Seek( nOff + 2 );
+ r.WriteInt32(nPos - nOff - 8 );
+ r.Seek( nPos );
+}
+
+static constexpr sal_uInt32 nUnicodeDataMagicNumber = 0x556E6920; // "Uni " BE
+
+static bool GetToUnicodePoolData(SvStream& r, sal_uInt64 nLen, sal_uInt64 nNext)
+{
+ const auto nPos = r.Tell();
+ // Check space for legacy data, magic number and Unicode data
+ bool bResult = nPos + nLen + sizeof(sal_uInt32) + nLen * sizeof(sal_Unicode) <= nNext;
+ if (bResult)
+ {
+ r.SeekRel(nLen); // Skip legacy data
+ sal_uInt32 nMagic = 0;
+ r.ReadUInt32(nMagic);
+ if (nMagic != nUnicodeDataMagicNumber)
+ {
+ r.Seek(nPos); // return
+ bResult = false;
+ }
+ }
+ return bResult;
+}
+
+bool SbiImage::Load( SvStream& r, sal_uInt32& nVersion )
+{
+
+ sal_uInt16 nSign, nCount;
+ sal_uInt32 nLen, nOff;
+
+ Clear();
+ // Read Master-Record
+ r.ReadUInt16( nSign ).ReadUInt32( nLen ).ReadUInt16( nCount );
+ sal_uInt64 nLast = r.Tell() + nLen;
+ sal_uInt32 nCharSet; // System charset
+ sal_uInt32 lDimBase;
+ sal_uInt16 nReserved1;
+ sal_uInt32 nReserved2;
+ sal_uInt32 nReserved3;
+ bool bBadVer = false;
+ if( nSign == static_cast<sal_uInt16>( FileOffset::Module ) )
+ {
+ sal_uInt16 nTmpFlags;
+ r.ReadUInt32( nVersion ).ReadUInt32( nCharSet ).ReadUInt32( lDimBase )
+ .ReadUInt16( nTmpFlags ).ReadUInt16( nReserved1 ).ReadUInt32( nReserved2 ).ReadUInt32( nReserved3 );
+ nFlags = static_cast<SbiImageFlags>(nTmpFlags);
+ eCharSet = nCharSet;
+ eCharSet = GetSOLoadTextEncoding( eCharSet );
+ bBadVer = ( nVersion > B_CURVERSION );
+ nDimBase = static_cast<sal_uInt16>(lDimBase);
+ }
+
+ bool bLegacy = ( nVersion < B_EXT_IMG_VERSION );
+
+ sal_uInt64 nNext;
+ while( ( nNext = r.Tell() ) < nLast )
+ {
+
+ r.ReadUInt16( nSign ).ReadUInt32( nLen ).ReadUInt16( nCount );
+ nNext += nLen + 8;
+ if( r.GetError() == ERRCODE_NONE )
+ {
+ switch( static_cast<FileOffset>( nSign ) )
+ {
+ case FileOffset::Name:
+ aName = r.ReadUniOrByteString(eCharSet);
+ break;
+ case FileOffset::Comment:
+ aComment = r.ReadUniOrByteString(eCharSet );
+ break;
+ case FileOffset::Source:
+ {
+ aOUSource = r.ReadUniOrByteString(eCharSet);
+ break;
+ }
+ case FileOffset::ExtSource:
+ {
+ //assuming an empty string with just the lead 32bit/16bit len indicator
+ const size_t nMinStringSize = (eCharSet == RTL_TEXTENCODING_UNICODE) ? 4 : 2;
+ const sal_uInt64 nMaxStrings = r.remainingSize() / nMinStringSize;
+ if (nCount > nMaxStrings)
+ {
+ SAL_WARN("basic", "Parsing error: " << nMaxStrings <<
+ " max possible entries, but " << nCount << " claimed, truncating");
+ nCount = nMaxStrings;
+ }
+ for( sal_uInt16 j = 0; j < nCount; ++j)
+ {
+ aOUSource += r.ReadUniOrByteString(eCharSet);
+ }
+ break;
+ }
+ case FileOffset::PCode:
+ if( bBadVer ) break;
+ pCode.reset(new char[ nLen ]);
+ nCodeSize = nLen;
+ r.ReadBytes(pCode.get(), nCodeSize);
+ if ( bLegacy )
+ {
+ nLegacyCodeSize = static_cast<sal_uInt16>(nCodeSize);
+ pLegacyPCode = std::move(pCode);
+
+ PCodeBuffConvertor< sal_uInt16, sal_uInt32 > aLegacyToNew( reinterpret_cast<sal_uInt8*>(pLegacyPCode.get()), nLegacyCodeSize );
+ aLegacyToNew.convert();
+ pCode.reset(reinterpret_cast<char*>(aLegacyToNew.GetBuffer()));
+ nCodeSize = aLegacyToNew.GetSize();
+ // we don't release the legacy buffer
+ // right now, that's because the module
+ // needs it to fix up the method
+ // nStart members. When that is done
+ // the module can release the buffer
+ // or it can wait until this routine
+ // is called again or when this class // destructs all of which will trigger
+ // release of the buffer.
+ }
+ break;
+ case FileOffset::Publics:
+ case FileOffset::PoolDir:
+ case FileOffset::SymPool:
+ case FileOffset::LineRanges:
+ break;
+ case FileOffset::StringPool:
+ {
+ // the data layout is: nCount of 32-bit offsets into both legacy 1-byte char stream
+ // and resulting char buffer (1:1 correspondence assumed; 16 of 32 bits used);
+ // 32-bit length N of following 1-byte char stream (16 bits used); N bytes of 1-byte
+ // char stream; then optional magic number and stream of N sal_Unicode characters.
+
+ if( bBadVer ) break;
+ //assuming an empty string with just the lead 32bit len indicator
+ const sal_uInt64 nMinStringSize = 4;
+ const sal_uInt64 nMaxStrings = r.remainingSize() / nMinStringSize;
+ if (nCount > nMaxStrings)
+ {
+ SAL_WARN("basic", "Parsing error: " << nMaxStrings <<
+ " max possible entries, but " << nCount << " claimed, truncating");
+ nCount = nMaxStrings;
+ }
+ MakeStrings( nCount );
+ for( size_t i = 0; i < mvStringOffsets.size() && SbiGood( r ); i++ )
+ {
+ r.ReadUInt32( nOff );
+ mvStringOffsets[ i ] = static_cast<sal_uInt16>(nOff);
+ }
+ r.ReadUInt32( nLen );
+ if( SbiGood( r ) )
+ {
+ pStrings.reset(new sal_Unicode[ nLen ]);
+ nStringSize = static_cast<sal_uInt16>(nLen);
+
+ if (GetToUnicodePoolData(r, nLen, nNext))
+ {
+ OUString s = read_uInt16s_ToOUString(r, nLen);
+ memcpy(pStrings.get(), s.getStr(), s.getLength() * sizeof(sal_Unicode));
+ }
+ else
+ {
+ std::unique_ptr<char[]> pByteStrings(new char[nLen]);
+ r.ReadBytes(pByteStrings.get(), nLen);
+ for (size_t j = 0; j < mvStringOffsets.size(); j++)
+ {
+ sal_uInt16 nOff2 = static_cast<sal_uInt16>(mvStringOffsets[j]);
+ OUString aStr(pByteStrings.get() + nOff2, strlen(pByteStrings.get() + nOff2), eCharSet);
+ memcpy(pStrings.get() + nOff2, aStr.getStr(), (aStr.getLength() + 1) * sizeof(sal_Unicode));
+ }
+ }
+ }
+ break;
+ }
+ case FileOffset::UserTypes:
+ {
+ //assuming an empty string with just the lead 32bit/16bit len indicator
+ const size_t nMinStringSize = (eCharSet == RTL_TEXTENCODING_UNICODE) ? 4 : 2;
+ const sal_uInt64 nMinRecordSize = nMinStringSize + sizeof(sal_Int16);
+ const sal_uInt64 nMaxRecords = r.remainingSize() / nMinRecordSize;
+ if (nCount > nMaxRecords)
+ {
+ SAL_WARN("basic", "Parsing error: " << nMaxRecords <<
+ " max possible entries, but " << nCount << " claimed, truncating");
+ nCount = nMaxRecords;
+ }
+
+ // User defined types; ref.: SbiParser::DefType
+ for (sal_uInt16 i = 0; i < nCount; i++)
+ {
+ OUString aTypeName = r.ReadUniOrByteString(eCharSet);
+
+ sal_uInt16 nTypeMembers;
+ r.ReadUInt16(nTypeMembers);
+
+ const sal_uInt64 nMaxTypeMembers = r.remainingSize() / 8;
+ if (nTypeMembers > nMaxTypeMembers)
+ {
+ SAL_WARN("basic", "Parsing error: " << nMaxTypeMembers <<
+ " max possible entries, but " << nTypeMembers << " claimed, truncating");
+ nTypeMembers = nMaxTypeMembers;
+ }
+
+ SbxObject *pType = new SbxObject(aTypeName);
+ SbxArray *pTypeMembers = pType->GetProperties();
+
+ for (sal_uInt16 j = 0; j < nTypeMembers; j++)
+ {
+ OUString aMemberName = r.ReadUniOrByteString(eCharSet);
+
+ sal_Int16 aIntMemberType;
+ r.ReadInt16(aIntMemberType);
+ SbxDataType aMemberType = static_cast< SbxDataType > ( aIntMemberType );
+
+ SbxProperty *pTypeElem = new SbxProperty( aMemberName, aMemberType );
+
+ sal_uInt32 aIntFlag;
+ r.ReadUInt32(aIntFlag);
+ SbxFlagBits nElemFlags = static_cast< SbxFlagBits > ( aIntFlag );
+
+ pTypeElem->SetFlags(nElemFlags);
+
+ sal_Int16 hasObject;
+ r.ReadInt16(hasObject);
+
+ if (hasObject == 1)
+ {
+ if(aMemberType == SbxOBJECT)
+ {
+ // nested user defined types
+ // declared before use, so it is ok to reference it by name on load
+ OUString aNestedTypeName = r.ReadUniOrByteString(eCharSet);
+ SbxObject* pNestedTypeObj = static_cast< SbxObject* >( rTypes->Find( aNestedTypeName, SbxClassType::Object ) );
+ if (pNestedTypeObj)
+ {
+ SbxObject* pCloneObj = cloneTypeObjectImpl( *pNestedTypeObj );
+ pTypeElem->PutObject( pCloneObj );
+ }
+ }
+ else
+ {
+ // an array
+ SbxDimArray* pArray = new SbxDimArray(
+ static_cast<SbxDataType>(aMemberType & 0x0FFF));
+
+ sal_Int16 isFixedSize;
+ r.ReadInt16(isFixedSize);
+ if (isFixedSize == 1)
+ pArray->setHasFixedSize( true );
+
+ sal_Int32 nDims;
+ r.ReadInt32(nDims);
+ for (sal_Int32 d = 0; d < nDims; d++)
+ {
+ sal_Int32 lBound;
+ sal_Int32 uBound;
+ r.ReadInt32(lBound).ReadInt32(uBound);
+ pArray->unoAddDim32(lBound, uBound);
+ }
+
+ const SbxFlagBits nSavFlags = pTypeElem->GetFlags();
+ // need to reset the FIXED flag
+ // when calling PutObject ( because the type will not match Object )
+ pTypeElem->ResetFlag(SbxFlagBits::Fixed);
+ pTypeElem->PutObject( pArray );
+ pTypeElem->SetFlags(nSavFlags);
+ }
+ }
+
+ pTypeMembers->Insert32( pTypeElem, pTypeMembers->Count32() );
+
+ }
+
+ pType->Remove( "Name", SbxClassType::DontCare );
+ pType->Remove( "Parent", SbxClassType::DontCare );
+
+ AddType(pType);
+ }
+ break;
+ }
+ case FileOffset::ModEnd:
+ goto done;
+ default:
+ break;
+ }
+ }
+ else
+ {
+ break;
+ }
+ r.Seek( nNext );
+ }
+done:
+ r.Seek( nLast );
+ if( !SbiGood( r ) )
+ {
+ bError = true;
+ }
+ return !bError;
+}
+
+bool SbiImage::Save( SvStream& r, sal_uInt32 nVer )
+{
+ bool bLegacy = ( nVer < B_EXT_IMG_VERSION );
+
+ // detect if old code exceeds legacy limits
+ // if so, then disallow save
+ if ( bLegacy && ExceedsLegacyLimits() )
+ {
+ SbiImage aEmptyImg;
+ aEmptyImg.aName = aName;
+ aEmptyImg.Save( r, B_LEGACYVERSION );
+ return true;
+ }
+ // First of all the header
+ sal_uInt64 nStart = SbiOpenRecord( r, FileOffset::Module, 1 );
+ sal_uInt64 nPos;
+
+ eCharSet = GetSOStoreTextEncoding( eCharSet );
+ if ( bLegacy )
+ {
+ r.WriteInt32( B_LEGACYVERSION );
+ }
+ else
+ {
+ r.WriteInt32( B_CURVERSION );
+ }
+ r .WriteInt32( eCharSet )
+ .WriteInt32( nDimBase )
+ .WriteInt16( static_cast<sal_uInt16>(nFlags) )
+ .WriteInt16( 0 )
+ .WriteInt32( 0 )
+ .WriteInt32( 0 );
+
+ // Name?
+ if( !aName.isEmpty() && SbiGood( r ) )
+ {
+ nPos = SbiOpenRecord( r, FileOffset::Name, 1 );
+ r.WriteUniOrByteString( aName, eCharSet );
+ SbiCloseRecord( r, nPos );
+ }
+ // Comment?
+ if( !aComment.isEmpty() && SbiGood( r ) )
+ {
+ nPos = SbiOpenRecord( r, FileOffset::Comment, 1 );
+ r.WriteUniOrByteString( aComment, eCharSet );
+ SbiCloseRecord( r, nPos );
+ }
+ // Source?
+ if( !aOUSource.isEmpty() && SbiGood( r ) )
+ {
+ nPos = SbiOpenRecord( r, FileOffset::Source, 1 );
+ r.WriteUniOrByteString( aOUSource, eCharSet );
+ SbiCloseRecord( r, nPos );
+ }
+ // Binary data?
+ if( pCode && SbiGood( r ) )
+ {
+ nPos = SbiOpenRecord( r, FileOffset::PCode, 1 );
+ if ( bLegacy )
+ {
+ PCodeBuffConvertor< sal_uInt32, sal_uInt16 > aNewToLegacy( reinterpret_cast<sal_uInt8*>(pCode.get()), nCodeSize );
+ aNewToLegacy.convert();
+ pLegacyPCode.reset(reinterpret_cast<char*>(aNewToLegacy.GetBuffer()));
+ nLegacyCodeSize = aNewToLegacy.GetSize();
+ r.WriteBytes(pLegacyPCode.get(), nLegacyCodeSize);
+ }
+ else
+ {
+ r.WriteBytes(pCode.get(), nCodeSize);
+ }
+ SbiCloseRecord( r, nPos );
+ }
+ // String-Pool?
+ if( !mvStringOffsets.empty() )
+ {
+ nPos = SbiOpenRecord( r, FileOffset::StringPool, mvStringOffsets.size() );
+ // For every String:
+ // sal_uInt32 Offset of the Strings in the Stringblock
+ for( size_t i = 0; i < mvStringOffsets.size() && SbiGood( r ); i++ )
+ {
+ r.WriteUInt32( mvStringOffsets[ i ] );
+ }
+ // Then the String-Block
+ std::unique_ptr<char[]> pByteStrings(new char[ nStringSize ]);
+ for( size_t i = 0; i < mvStringOffsets.size(); i++ )
+ {
+ sal_uInt16 nOff = static_cast<sal_uInt16>(mvStringOffsets[ i ]);
+ OString aStr(OUStringToOString(OUString(pStrings.get() + nOff), eCharSet));
+ memcpy( pByteStrings.get() + nOff, aStr.getStr(), (aStr.getLength() + 1) * sizeof( char ) );
+ }
+ r.WriteUInt32( nStringSize );
+ r.WriteBytes(pByteStrings.get(), nStringSize);
+ pByteStrings.reset();
+
+ // Now write magic number and store the same data in UTF-16; this is backward compatible:
+ // old readers will not read this data after having read legacy data, and will proceed
+ // straight to the end of the record. So no version restriction here.
+ r.WriteUInt32(nUnicodeDataMagicNumber);
+ write_uInt16s_FromOUString(r, OUString(pStrings.get(), nStringSize));
+
+ SbiCloseRecord( r, nPos );
+ }
+ // User defined types
+ if ( rTypes.is() )
+ {
+ sal_uInt32 nTypes = rTypes->Count32();
+ assert(nTypes <= std::numeric_limits<sal_uInt16>::max());
+ if (nTypes > 0 )
+ {
+ nPos = SbiOpenRecord( r, FileOffset::UserTypes, sal::static_int_cast<sal_uInt16>(nTypes) );
+
+ for (sal_uInt32 i = 0; i < nTypes; i++)
+ {
+ SbxObject* pType = static_cast< SbxObject* > ( rTypes->Get32(i) );
+ OUString aTypeName = pType->GetClassName();
+
+ r.WriteUniOrByteString( aTypeName, eCharSet );
+
+ SbxArray *pTypeMembers = pType->GetProperties();
+ sal_uInt32 nTypeMembers = pTypeMembers->Count32();
+ assert(nTypeMembers <= std::numeric_limits<sal_uInt16>::max());
+
+ r.WriteInt16(sal::static_int_cast<sal_uInt16>(nTypeMembers));
+
+ for (sal_uInt32 j = 0; j < nTypeMembers; j++)
+ {
+
+ SbxProperty* pTypeElem = static_cast< SbxProperty* > ( pTypeMembers->Get32(j) );
+
+ const OUString& aElemName = pTypeElem->GetName();
+ r.WriteUniOrByteString( aElemName, eCharSet );
+
+ SbxDataType dataType = pTypeElem->GetType();
+ r.WriteInt16(dataType);
+
+ SbxFlagBits nElemFlags = pTypeElem->GetFlags();
+ r.WriteUInt32(static_cast< sal_uInt32 > (nElemFlags) );
+
+ SbxBase* pElemObject = pTypeElem->GetObject();
+
+ if (pElemObject)
+ {
+ r.WriteInt16(1); // has elem Object
+
+ if( dataType == SbxOBJECT )
+ {
+ // nested user defined types
+ // declared before use, so it is ok to reference it by name on load
+ SbxObject* pNestedType = static_cast< SbxObject* > ( pElemObject );
+ r.WriteUniOrByteString( pNestedType->GetClassName(), eCharSet );
+ }
+ else
+ {
+ // an array
+ SbxDimArray* pArray = static_cast< SbxDimArray* > ( pElemObject );
+
+ bool bFixedSize = pArray->hasFixedSize();
+ if (bFixedSize)
+ r.WriteInt16(1);
+ else
+ r.WriteInt16(0);
+
+ sal_Int32 nDims = pArray->GetDims32();
+ r.WriteInt32(nDims);
+
+ for (sal_Int32 d = 1; d <= nDims; d++)
+ {
+ sal_Int32 lBound;
+ sal_Int32 uBound;
+ pArray->GetDim32(d, lBound, uBound);
+ r.WriteInt32(lBound).WriteInt32(uBound);
+ }
+ }
+ }
+ else
+ r.WriteInt16(0); // no elem Object
+
+ }
+ }
+ SbiCloseRecord( r, nPos );
+ }
+ }
+ // Set overall length
+ SbiCloseRecord( r, nStart );
+ if( !SbiGood( r ) )
+ {
+ bError = true;
+ }
+ return !bError;
+}
+
+void SbiImage::MakeStrings( short nSize )
+{
+ nStringIdx = 0;
+ nStringOff = 0;
+ nStringSize = 1024;
+ pStrings.reset( new sal_Unicode[ nStringSize ]);
+ mvStringOffsets.resize(nSize);
+ if (nSize != 0) {
+ memset( mvStringOffsets.data(), 0, nSize * sizeof( sal_uInt32 ) );
+ }
+ memset( pStrings.get(), 0, nStringSize * sizeof( sal_Unicode ) );
+}
+
+// Add a string to StringPool. The String buffer is dynamically
+// growing in 1K-Steps
+void SbiImage::AddString( const OUString& r )
+{
+ if( nStringIdx >= short(mvStringOffsets.size()) )
+ {
+ bError = true;
+ }
+ if( bError )
+ return;
+
+ sal_Int32 len = r.getLength() + 1;
+ sal_uInt32 needed = nStringOff + len;
+ if( needed > 0xFFFFFF00 )
+ {
+ bError = true; // out of mem!
+ }
+ else if( needed > nStringSize )
+ {
+ sal_uInt32 nNewLen = needed + 1024;
+ nNewLen &= 0xFFFFFC00; // trim to 1K border
+ std::unique_ptr<sal_Unicode[]> p(new sal_Unicode[nNewLen]);
+ memcpy( p.get(), pStrings.get(), nStringSize * sizeof( sal_Unicode ) );
+ pStrings = std::move(p);
+ nStringSize = sal::static_int_cast< sal_uInt16 >(nNewLen);
+ }
+ if( !bError )
+ {
+ mvStringOffsets[ nStringIdx++ ] = nStringOff;
+ memcpy( pStrings.get() + nStringOff, r.getStr(), len * sizeof( sal_Unicode ) );
+ nStringOff = nStringOff + len;
+ // Last String? The update the size of the buffer
+ if( nStringIdx >= short(mvStringOffsets.size()) )
+ {
+ nStringSize = nStringOff;
+ }
+ }
+}
+
+// Add code block
+// The block was fetched by the compiler from class SbBuffer and
+// is already created with new. Additionally it contains all Integers
+// in Big Endian format, so can be directly read/written.
+void SbiImage::AddCode( std::unique_ptr<char[]> p, sal_uInt32 s )
+{
+ pCode = std::move(p);
+ nCodeSize = s;
+}
+
+// Add user type
+void SbiImage::AddType(SbxObject const * pObject)
+{
+ if( !rTypes.is() )
+ {
+ rTypes = new SbxArray;
+ }
+ SbxObject *pCopyObject = new SbxObject(*pObject);
+ rTypes->Insert32 (pCopyObject,rTypes->Count32());
+}
+
+void SbiImage::AddEnum(SbxObject* pObject) // Register enum type
+{
+ if( !rEnums.is() )
+ {
+ rEnums = new SbxArray;
+ }
+ rEnums->Insert32( pObject, rEnums->Count32() );
+}
+
+// Note: IDs start with 1
+OUString SbiImage::GetString( short nId ) const
+{
+ if( nId && nId <= short(mvStringOffsets.size()) )
+ {
+ sal_uInt32 nOff = mvStringOffsets[ nId - 1 ];
+ sal_Unicode* pStr = pStrings.get() + nOff;
+
+ // #i42467: Special treatment for vbNullChar
+ if( *pStr == 0 )
+ {
+ sal_uInt32 nNextOff = (nId < short(mvStringOffsets.size())) ? mvStringOffsets[ nId ] : nStringOff;
+ sal_uInt32 nLen = nNextOff - nOff - 1;
+ if( nLen == 1 )
+ {
+ // Force length 1 and make char 0 afterwards
+ OUString aNullCharStr( u'\0');
+ return aNullCharStr;
+ }
+ }
+ else
+ {
+ return OUString(pStr);
+ }
+ }
+ return OUString();
+}
+
+const SbxObject* SbiImage::FindType (const OUString& aTypeName) const
+{
+ return rTypes.is() ? static_cast<SbxObject*>(rTypes->Find(aTypeName,SbxClassType::Object)) : nullptr;
+}
+
+sal_uInt16 SbiImage::CalcLegacyOffset( sal_Int32 nOffset )
+{
+ return SbiCodeGen::calcLegacyOffSet( reinterpret_cast<sal_uInt8*>(pCode.get()), nOffset ) ;
+}
+
+sal_uInt32 SbiImage::CalcNewOffset( sal_Int16 nOffset )
+{
+ return SbiCodeGen::calcNewOffSet( reinterpret_cast<sal_uInt8*>(pLegacyPCode.get()), nOffset ) ;
+}
+
+void SbiImage::ReleaseLegacyBuffer()
+{
+ pLegacyPCode.reset();
+ nLegacyCodeSize = 0;
+}
+
+bool SbiImage::ExceedsLegacyLimits()
+{
+ return ( nStringSize > 0xFF00 ) || ( CalcLegacyOffset( nCodeSize ) > 0xFF00 );
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/propacc.cxx b/basic/source/classes/propacc.cxx
new file mode 100644
index 000000000..45d13ffbb
--- /dev/null
+++ b/basic/source/classes/propacc.cxx
@@ -0,0 +1,191 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <propacc.hxx>
+
+#include <basic/sberrors.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/sbuno.hxx>
+#include <sbunoobj.hxx>
+
+#include <comphelper/propertysetinfo.hxx>
+#include <comphelper/sequence.hxx>
+#include <o3tl/any.hxx>
+
+#include <algorithm>
+
+using com::sun::star::uno::Reference;
+using namespace com::sun::star;
+using namespace com::sun::star::uno;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::beans;
+using namespace cppu;
+
+static bool SbCompare_UString_PropertyValue_Impl(PropertyValue const & lhs, const OUString& rhs)
+{
+ return lhs.Name.compareTo(rhs) < 0;
+}
+
+
+SbPropertyValues::SbPropertyValues()
+{
+}
+
+
+SbPropertyValues::~SbPropertyValues()
+{
+ m_xInfo.clear();
+}
+
+Reference< XPropertySetInfo > SbPropertyValues::getPropertySetInfo()
+{
+ // create on demand?
+ if (!m_xInfo.is())
+ {
+ uno::Sequence<beans::Property> props(m_aPropVals.size());
+ for (size_t n = 0; n < m_aPropVals.size(); ++n)
+ {
+ Property &rProp = props.getArray()[n];
+ const PropertyValue &rPropVal = m_aPropVals[n];
+ rProp.Name = rPropVal.Name;
+ rProp.Handle = rPropVal.Handle;
+ rProp.Type = cppu::UnoType<void>::get();
+ rProp.Attributes = 0;
+ }
+ m_xInfo.set(new ::comphelper::PropertySetInfo(props));
+ }
+ return m_xInfo;
+}
+
+
+size_t SbPropertyValues::GetIndex_Impl( const OUString &rPropName ) const
+{
+ SbPropertyValueArr_Impl::const_iterator it = std::lower_bound(
+ m_aPropVals.begin(), m_aPropVals.end(), rPropName,
+ SbCompare_UString_PropertyValue_Impl );
+ if (it == m_aPropVals.end() || it->Name != rPropName)
+ {
+ throw beans::UnknownPropertyException(
+ "Property not found: " + rPropName,
+ const_cast<SbPropertyValues&>(*this));
+ }
+ return it - m_aPropVals.begin();
+}
+
+
+void SbPropertyValues::setPropertyValue(
+ const OUString& aPropertyName,
+ const Any& aValue)
+{
+ size_t const nIndex = GetIndex_Impl( aPropertyName );
+ PropertyValue & rPropVal = m_aPropVals[nIndex];
+ rPropVal.Value = aValue;
+}
+
+
+Any SbPropertyValues::getPropertyValue(
+ const OUString& aPropertyName)
+{
+ size_t const nIndex = GetIndex_Impl( aPropertyName );
+ return m_aPropVals[nIndex].Value;
+}
+
+
+void SbPropertyValues::addPropertyChangeListener(
+ const OUString&,
+ const Reference< XPropertyChangeListener >& )
+{}
+
+
+void SbPropertyValues::removePropertyChangeListener(
+ const OUString&,
+ const Reference< XPropertyChangeListener >& )
+{}
+
+
+void SbPropertyValues::addVetoableChangeListener(
+ const OUString&,
+ const Reference< XVetoableChangeListener >& )
+{}
+
+
+void SbPropertyValues::removeVetoableChangeListener(
+ const OUString&,
+ const Reference< XVetoableChangeListener >& )
+{}
+
+
+Sequence< PropertyValue > SbPropertyValues::getPropertyValues()
+{
+ return comphelper::containerToSequence(m_aPropVals);
+}
+
+
+void SbPropertyValues::setPropertyValues(const Sequence< PropertyValue >& rPropertyValues )
+{
+ if (!m_aPropVals.empty())
+ throw IllegalArgumentException();
+
+ for (const PropertyValue& i : rPropertyValues)
+ {
+ m_aPropVals.push_back(i);
+ }
+}
+
+
+void RTL_Impl_CreatePropertySet( SbxArray& rPar )
+{
+ // We need at least one parameter
+ // TODO: In this case < 2 is not correct ;-)
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // Get class names of struct
+
+ Reference< XInterface > xInterface = static_cast<OWeakObject*>(new SbPropertyValues());
+
+ SbxVariableRef refVar = rPar.Get32(0);
+ if( xInterface.is() )
+ {
+ // Set PropertyValues
+ Any aArgAsAny = sbxToUnoValue( rPar.Get32(1),
+ cppu::UnoType<Sequence<PropertyValue>>::get() );
+ auto pArg = o3tl::doAccess<Sequence<PropertyValue>>(aArgAsAny);
+ Reference< XPropertyAccess > xPropAcc( xInterface, UNO_QUERY );
+ xPropAcc->setPropertyValues( *pArg );
+
+ // Build a SbUnoObject and return it
+ auto xUnoObj = tools::make_ref<SbUnoObject>( "stardiv.uno.beans.PropertySet", Any(xInterface) );
+ if( xUnoObj->getUnoAny().hasValue() )
+ {
+ // Return object
+ refVar->PutObject( xUnoObj.get() );
+ return;
+ }
+ }
+
+ // Object could not be created
+ refVar->PutObject( nullptr );
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/sb.cxx b/basic/source/classes/sb.cxx
new file mode 100644
index 000000000..fb80efdcb
--- /dev/null
+++ b/basic/source/classes/sb.cxx
@@ -0,0 +1,2240 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sb.hxx>
+#include <tools/stream.hxx>
+#include <tools/debug.hxx>
+#include <vcl/errinf.hxx>
+#include <comphelper/solarmutex.hxx>
+#include <basic/sbx.hxx>
+#include <vcl/svapp.hxx>
+#include <comphelper/processfactory.hxx>
+#include <image.hxx>
+#include <sbunoobj.hxx>
+#include <sbjsmeth.hxx>
+#include <sbjsmod.hxx>
+#include <sbintern.hxx>
+#include <runtime.hxx>
+#include <basic/sberrors.hxx>
+#include <basic/sbuno.hxx>
+#include <sbprop.hxx>
+#include <sbobjmod.hxx>
+#include <stdobj.hxx>
+#include <basic.hrc>
+#include <cppuhelper/implbase.hxx>
+#include <com/sun/star/lang/XMultiServiceFactory.hpp>
+#include <com/sun/star/util/XCloseBroadcaster.hpp>
+#include <com/sun/star/util/XCloseListener.hpp>
+#include <sal/log.hxx>
+#include <errobject.hxx>
+#include <memory>
+#include <unordered_map>
+
+#include <com/sun/star/script/ModuleType.hpp>
+#include <com/sun/star/script/ModuleInfo.hpp>
+
+using namespace ::com::sun::star::script;
+
+#define SB_RTLNAME "@SBRTL"
+// i#i68894#
+using namespace ::com::sun::star;
+using namespace ::com::sun::star::uno;
+using com::sun::star::uno::Reference;
+using com::sun::star::uno::Any;
+using com::sun::star::uno::UNO_QUERY;
+using com::sun::star::lang::XMultiServiceFactory;
+
+
+class DocBasicItem : public ::cppu::WeakImplHelper< util::XCloseListener >
+{
+public:
+ explicit DocBasicItem( StarBASIC& rDocBasic );
+ virtual ~DocBasicItem() override;
+
+ const SbxObjectRef& getClassModules() const { return mxClassModules; }
+ bool isDocClosed() const { return mbDocClosed; }
+
+ void clearDependingVarsOnDelete( StarBASIC& rDeletedBasic );
+
+ void startListening();
+ void stopListening();
+
+ void setDisposed( bool bDisposed )
+ {
+ mbDisposed = bDisposed;
+ }
+
+ virtual void SAL_CALL queryClosing( const lang::EventObject& rSource, sal_Bool bGetsOwnership ) override;
+ virtual void SAL_CALL notifyClosing( const lang::EventObject& rSource ) override;
+ virtual void SAL_CALL disposing( const lang::EventObject& rSource ) override;
+
+private:
+ StarBASIC& mrDocBasic;
+ SbxObjectRef mxClassModules;
+ bool mbDocClosed;
+ bool mbDisposed;
+};
+
+
+DocBasicItem::DocBasicItem( StarBASIC& rDocBasic ) :
+ mrDocBasic( rDocBasic ),
+ mxClassModules( new SbxObject( OUString() ) ),
+ mbDocClosed( false ),
+ mbDisposed( false )
+{
+}
+
+DocBasicItem::~DocBasicItem()
+{
+ // tdf#90969 HACK: don't use SolarMutexGuard - there is a horrible global
+ // map GaDocBasicItems holding instances, and these get deleted from exit
+ // handlers, when the SolarMutex is already dead
+ comphelper::SolarMutex *pSolarMutex = comphelper::SolarMutex::get();
+ if ( pSolarMutex )
+ pSolarMutex->acquire();
+
+ try
+ {
+ stopListening();
+ mxClassModules.clear(); // release with SolarMutex locked
+ }
+ catch (...)
+ {
+ assert(false);
+ }
+
+ pSolarMutex = comphelper::SolarMutex::get();
+ if ( pSolarMutex )
+ pSolarMutex->release();
+}
+
+void DocBasicItem::clearDependingVarsOnDelete( StarBASIC& rDeletedBasic )
+{
+ mrDocBasic.implClearDependingVarsOnDelete( &rDeletedBasic );
+}
+
+void DocBasicItem::startListening()
+{
+ Any aThisComp;
+ mrDocBasic.GetUNOConstant( "ThisComponent", aThisComp );
+ Reference< util::XCloseBroadcaster > xCloseBC( aThisComp, UNO_QUERY );
+ mbDisposed = !xCloseBC.is();
+ if( xCloseBC.is() )
+ {
+ try { xCloseBC->addCloseListener( this ); } catch(const uno::Exception& ) {}
+ }
+}
+
+void DocBasicItem::stopListening()
+{
+ if( mbDisposed ) return;
+ mbDisposed = true;
+ Any aThisComp;
+ if (!mrDocBasic.GetUNOConstant("ThisComponent", aThisComp))
+ return;
+
+ Reference< util::XCloseBroadcaster > xCloseBC( aThisComp, UNO_QUERY );
+ if( xCloseBC.is() )
+ {
+ try { xCloseBC->removeCloseListener( this ); } catch(const uno::Exception& ) {}
+ }
+}
+
+void SAL_CALL DocBasicItem::queryClosing( const lang::EventObject& /*rSource*/, sal_Bool /*bGetsOwnership*/ )
+{
+}
+
+void SAL_CALL DocBasicItem::notifyClosing( const lang::EventObject& /*rEvent*/ )
+{
+ stopListening();
+ mbDocClosed = true;
+}
+
+void SAL_CALL DocBasicItem::disposing( const lang::EventObject& /*rEvent*/ )
+{
+ stopListening();
+}
+
+
+namespace {
+
+typedef ::rtl::Reference< DocBasicItem > DocBasicItemRef;
+
+class GaDocBasicItems : public rtl::Static<std::unordered_map< const StarBASIC *, DocBasicItemRef >,GaDocBasicItems> {};
+
+const DocBasicItem* lclFindDocBasicItem( const StarBASIC* pDocBasic )
+{
+ auto it = GaDocBasicItems::get().find( pDocBasic );
+ auto end = GaDocBasicItems::get().end();
+ return (it != end) ? it->second.get() : nullptr;
+}
+
+void lclInsertDocBasicItem( StarBASIC& rDocBasic )
+{
+ DocBasicItemRef& rxDocBasicItem = GaDocBasicItems::get()[ &rDocBasic ];
+ rxDocBasicItem.set( new DocBasicItem( rDocBasic ) );
+ rxDocBasicItem->startListening();
+}
+
+void lclRemoveDocBasicItem( StarBASIC& rDocBasic )
+{
+ auto it = GaDocBasicItems::get().find( &rDocBasic );
+ if( it != GaDocBasicItems::get().end() )
+ {
+ it->second->stopListening();
+ GaDocBasicItems::get().erase( it );
+ }
+ for( auto& rEntry : GaDocBasicItems::get() )
+ {
+ rEntry.second->clearDependingVarsOnDelete( rDocBasic );
+ }
+}
+
+StarBASIC* lclGetDocBasicForModule( SbModule* pModule )
+{
+ StarBASIC* pRetBasic = nullptr;
+ SbxObject* pCurParent = pModule;
+ while( pCurParent->GetParent() != nullptr )
+ {
+ pCurParent = pCurParent->GetParent();
+ StarBASIC* pDocBasic = dynamic_cast<StarBASIC*>( pCurParent );
+ if( pDocBasic != nullptr && pDocBasic->IsDocBasic() )
+ {
+ pRetBasic = pDocBasic;
+ break;
+ }
+ }
+ return pRetBasic;
+}
+
+} // namespace
+
+
+SbxObject* StarBASIC::getVBAGlobals( )
+{
+ if ( !pVBAGlobals.is() )
+ {
+ Any aThisDoc;
+ if ( GetUNOConstant("ThisComponent", aThisDoc) )
+ {
+ Reference< XMultiServiceFactory > xDocFac( aThisDoc, UNO_QUERY );
+ if ( xDocFac.is() )
+ {
+ try
+ {
+ xDocFac->createInstance("ooo.vba.VBAGlobals");
+ }
+ catch(const Exception& )
+ {
+ // Ignore
+ }
+ }
+ }
+ const OUString aVBAHook("VBAGlobals");
+ pVBAGlobals = static_cast<SbUnoObject*>(Find( aVBAHook , SbxClassType::DontCare ));
+ }
+ return pVBAGlobals.get();
+}
+
+// i#i68894#
+SbxVariable* StarBASIC::VBAFind( const OUString& rName, SbxClassType t )
+{
+ if( rName == "ThisComponent" )
+ {
+ return nullptr;
+ }
+ // rename to init globals
+ if ( getVBAGlobals( ) )
+ {
+ return pVBAGlobals->Find( rName, t );
+ }
+ return nullptr;
+}
+
+namespace {
+
+// Create array for conversion SFX <-> VB error code
+struct SFX_VB_ErrorItem
+{
+ sal_uInt16 nErrorVB;
+ ErrCode nErrorSFX;
+};
+
+}
+
+const SFX_VB_ErrorItem SFX_VB_ErrorTab[] =
+{
+ { 1, ERRCODE_BASIC_EXCEPTION }, // #87844 Map exception to error code 1
+ { 2, ERRCODE_BASIC_SYNTAX },
+ { 3, ERRCODE_BASIC_NO_GOSUB },
+ { 4, ERRCODE_BASIC_REDO_FROM_START },
+ { 5, ERRCODE_BASIC_BAD_ARGUMENT },
+ { 6, ERRCODE_BASIC_MATH_OVERFLOW },
+ { 7, ERRCODE_BASIC_NO_MEMORY },
+ { 8, ERRCODE_BASIC_ALREADY_DIM },
+ { 9, ERRCODE_BASIC_OUT_OF_RANGE },
+ { 10, ERRCODE_BASIC_DUPLICATE_DEF },
+ { 11, ERRCODE_BASIC_ZERODIV },
+ { 12, ERRCODE_BASIC_VAR_UNDEFINED },
+ { 13, ERRCODE_BASIC_CONVERSION },
+ { 14, ERRCODE_BASIC_BAD_PARAMETER },
+ { 18, ERRCODE_BASIC_USER_ABORT },
+ { 20, ERRCODE_BASIC_BAD_RESUME },
+ { 28, ERRCODE_BASIC_STACK_OVERFLOW },
+ { 35, ERRCODE_BASIC_PROC_UNDEFINED },
+ { 48, ERRCODE_BASIC_BAD_DLL_LOAD },
+ { 49, ERRCODE_BASIC_BAD_DLL_CALL },
+ { 51, ERRCODE_BASIC_INTERNAL_ERROR },
+ { 52, ERRCODE_BASIC_BAD_CHANNEL },
+ { 53, ERRCODE_BASIC_FILE_NOT_FOUND },
+ { 54, ERRCODE_BASIC_BAD_FILE_MODE },
+ { 55, ERRCODE_BASIC_FILE_ALREADY_OPEN },
+ { 57, ERRCODE_BASIC_IO_ERROR },
+ { 58, ERRCODE_BASIC_FILE_EXISTS },
+ { 59, ERRCODE_BASIC_BAD_RECORD_LENGTH },
+ { 61, ERRCODE_BASIC_DISK_FULL },
+ { 62, ERRCODE_BASIC_READ_PAST_EOF },
+ { 63, ERRCODE_BASIC_BAD_RECORD_NUMBER },
+ { 67, ERRCODE_BASIC_TOO_MANY_FILES },
+ { 68, ERRCODE_BASIC_NO_DEVICE },
+ { 70, ERRCODE_BASIC_ACCESS_DENIED },
+ { 71, ERRCODE_BASIC_NOT_READY },
+ { 73, ERRCODE_BASIC_NOT_IMPLEMENTED },
+ { 74, ERRCODE_BASIC_DIFFERENT_DRIVE },
+ { 75, ERRCODE_BASIC_ACCESS_ERROR },
+ { 76, ERRCODE_BASIC_PATH_NOT_FOUND },
+ { 91, ERRCODE_BASIC_NO_OBJECT },
+ { 93, ERRCODE_BASIC_BAD_PATTERN },
+ { 94, ERRCODE_BASIC_IS_NULL },
+ { 250, ERRCODE_BASIC_DDE_ERROR },
+ { 280, ERRCODE_BASIC_DDE_WAITINGACK },
+ { 281, ERRCODE_BASIC_DDE_OUTOFCHANNELS },
+ { 282, ERRCODE_BASIC_DDE_NO_RESPONSE },
+ { 283, ERRCODE_BASIC_DDE_MULT_RESPONSES },
+ { 284, ERRCODE_BASIC_DDE_CHANNEL_LOCKED },
+ { 285, ERRCODE_BASIC_DDE_NOTPROCESSED },
+ { 286, ERRCODE_BASIC_DDE_TIMEOUT },
+ { 287, ERRCODE_BASIC_DDE_USER_INTERRUPT },
+ { 288, ERRCODE_BASIC_DDE_BUSY },
+ { 289, ERRCODE_BASIC_DDE_NO_DATA },
+ { 290, ERRCODE_BASIC_DDE_WRONG_DATA_FORMAT },
+ { 291, ERRCODE_BASIC_DDE_PARTNER_QUIT },
+ { 292, ERRCODE_BASIC_DDE_CONV_CLOSED },
+ { 293, ERRCODE_BASIC_DDE_NO_CHANNEL },
+ { 294, ERRCODE_BASIC_DDE_INVALID_LINK },
+ { 295, ERRCODE_BASIC_DDE_QUEUE_OVERFLOW },
+ { 296, ERRCODE_BASIC_DDE_LINK_ALREADY_EST },
+ { 297, ERRCODE_BASIC_DDE_LINK_INV_TOPIC },
+ { 298, ERRCODE_BASIC_DDE_DLL_NOT_FOUND },
+ { 323, ERRCODE_BASIC_CANNOT_LOAD },
+ { 341, ERRCODE_BASIC_BAD_INDEX },
+ { 366, ERRCODE_BASIC_NO_ACTIVE_OBJECT },
+ { 380, ERRCODE_BASIC_BAD_PROP_VALUE },
+ { 382, ERRCODE_BASIC_PROP_READONLY },
+ { 394, ERRCODE_BASIC_PROP_WRITEONLY },
+ { 420, ERRCODE_BASIC_INVALID_OBJECT },
+ { 423, ERRCODE_BASIC_NO_METHOD },
+ { 424, ERRCODE_BASIC_NEEDS_OBJECT },
+ { 425, ERRCODE_BASIC_INVALID_USAGE_OBJECT },
+ { 430, ERRCODE_BASIC_NO_OLE },
+ { 438, ERRCODE_BASIC_BAD_METHOD },
+ { 440, ERRCODE_BASIC_OLE_ERROR },
+ { 445, ERRCODE_BASIC_BAD_ACTION },
+ { 446, ERRCODE_BASIC_NO_NAMED_ARGS },
+ { 447, ERRCODE_BASIC_BAD_LOCALE },
+ { 448, ERRCODE_BASIC_NAMED_NOT_FOUND },
+ { 449, ERRCODE_BASIC_NOT_OPTIONAL },
+ { 450, ERRCODE_BASIC_WRONG_ARGS },
+ { 451, ERRCODE_BASIC_NOT_A_COLL },
+ { 452, ERRCODE_BASIC_BAD_ORDINAL },
+ { 453, ERRCODE_BASIC_DLLPROC_NOT_FOUND },
+ { 460, ERRCODE_BASIC_BAD_CLIPBD_FORMAT },
+ { 951, ERRCODE_BASIC_UNEXPECTED },
+ { 952, ERRCODE_BASIC_EXPECTED },
+ { 953, ERRCODE_BASIC_SYMBOL_EXPECTED },
+ { 954, ERRCODE_BASIC_VAR_EXPECTED },
+ { 955, ERRCODE_BASIC_LABEL_EXPECTED },
+ { 956, ERRCODE_BASIC_LVALUE_EXPECTED },
+ { 957, ERRCODE_BASIC_VAR_DEFINED },
+ { 958, ERRCODE_BASIC_PROC_DEFINED },
+ { 959, ERRCODE_BASIC_LABEL_DEFINED },
+ { 960, ERRCODE_BASIC_UNDEF_VAR },
+ { 961, ERRCODE_BASIC_UNDEF_ARRAY },
+ { 962, ERRCODE_BASIC_UNDEF_PROC },
+ { 963, ERRCODE_BASIC_UNDEF_LABEL },
+ { 964, ERRCODE_BASIC_UNDEF_TYPE },
+ { 965, ERRCODE_BASIC_BAD_EXIT },
+ { 966, ERRCODE_BASIC_BAD_BLOCK },
+ { 967, ERRCODE_BASIC_BAD_BRACKETS },
+ { 968, ERRCODE_BASIC_BAD_DECLARATION },
+ { 969, ERRCODE_BASIC_BAD_PARAMETERS },
+ { 970, ERRCODE_BASIC_BAD_CHAR_IN_NUMBER },
+ { 971, ERRCODE_BASIC_MUST_HAVE_DIMS },
+ { 972, ERRCODE_BASIC_NO_IF },
+ { 973, ERRCODE_BASIC_NOT_IN_SUBR },
+ { 974, ERRCODE_BASIC_NOT_IN_MAIN },
+ { 975, ERRCODE_BASIC_WRONG_DIMS },
+ { 976, ERRCODE_BASIC_BAD_OPTION },
+ { 977, ERRCODE_BASIC_CONSTANT_REDECLARED },
+ { 978, ERRCODE_BASIC_PROG_TOO_LARGE },
+ { 979, ERRCODE_BASIC_NO_STRINGS_ARRAYS },
+ { 1000, ERRCODE_BASIC_PROPERTY_NOT_FOUND },
+ { 1001, ERRCODE_BASIC_METHOD_NOT_FOUND },
+ { 1002, ERRCODE_BASIC_ARG_MISSING },
+ { 1003, ERRCODE_BASIC_BAD_NUMBER_OF_ARGS },
+ { 1004, ERRCODE_BASIC_METHOD_FAILED },
+ { 1005, ERRCODE_BASIC_SETPROP_FAILED },
+ { 1006, ERRCODE_BASIC_GETPROP_FAILED },
+ { 1007, ERRCODE_BASIC_COMPAT },
+ { 0xFFFF, ErrCode(0xFFFFFFFFUL) } // End mark
+};
+
+// The StarBASIC factory is a hack. When a SbModule is created, its pointer
+// is saved and given to the following SbProperties/SbMethods. This restores
+// the Module-relationship. But it works only when a module is loaded.
+// Can cause troubles with separately loaded properties!
+
+SbxBase* SbiFactory::Create( sal_uInt16 nSbxId, sal_uInt32 nCreator )
+{
+ if( nCreator == SBXCR_SBX )
+ {
+ switch( nSbxId )
+ {
+ case SBXID_BASIC:
+ return new StarBASIC( nullptr );
+ case SBXID_BASICMOD:
+ return new SbModule( "" );
+ case SBXID_BASICPROP:
+ return new SbProperty( "", SbxVARIANT, nullptr );
+ case SBXID_BASICMETHOD:
+ return new SbMethod( "", SbxVARIANT, nullptr );
+ case SBXID_JSCRIPTMOD:
+ return new SbJScriptModule;
+ case SBXID_JSCRIPTMETH:
+ return new SbJScriptMethod( SbxVARIANT );
+ }
+ }
+ return nullptr;
+}
+
+SbxObject* SbiFactory::CreateObject( const OUString& rClass )
+{
+ if( rClass.equalsIgnoreAsciiCase( "StarBASIC" ) )
+ {
+ return new StarBASIC( nullptr );
+ }
+ else if( rClass.equalsIgnoreAsciiCase( "StarBASICModule" ) )
+ {
+ return new SbModule( OUString() );
+ }
+ else if( rClass.equalsIgnoreAsciiCase( "Collection" ) )
+ {
+ return new BasicCollection( "Collection" );
+ }
+ else if( rClass.equalsIgnoreAsciiCase( "FileSystemObject" ) )
+ {
+ try
+ {
+ Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory(), UNO_SET_THROW );
+ OUString aServiceName("ooo.vba.FileSystemObject");
+ Reference< XInterface > xInterface( xFactory->createInstance( aServiceName ), UNO_SET_THROW );
+ return new SbUnoObject( aServiceName, uno::Any( xInterface ) );
+ }
+ catch(const Exception& )
+ {
+ }
+ }
+ return nullptr;
+}
+
+
+// Factory class to create OLE objects
+class SbOLEFactory : public SbxFactory
+{
+public:
+ virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 ) override;
+ virtual SbxObject* CreateObject( const OUString& ) override;
+};
+
+SbxBase* SbOLEFactory::Create( sal_uInt16, sal_uInt32 )
+{
+ // Not supported
+ return nullptr;
+}
+
+SbxObject* SbOLEFactory::CreateObject( const OUString& rClassName )
+{
+ SbxObject* pRet = createOLEObject_Impl( rClassName );
+ return pRet;
+}
+
+
+// SbFormFactory, show user forms by: dim as new <user form name>
+
+class SbFormFactory : public SbxFactory
+{
+public:
+ virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 ) override;
+ virtual SbxObject* CreateObject( const OUString& ) override;
+};
+
+SbxBase* SbFormFactory::Create( sal_uInt16, sal_uInt32 )
+{
+ // Not supported
+ return nullptr;
+}
+
+SbxObject* SbFormFactory::CreateObject( const OUString& rClassName )
+{
+ if( SbModule* pMod = GetSbData()->pMod )
+ {
+ if( SbxVariable* pVar = pMod->Find( rClassName, SbxClassType::Object ) )
+ {
+ if( SbUserFormModule* pFormModule = dynamic_cast<SbUserFormModule*>( pVar->GetObject() ) )
+ {
+ bool bInitState = pFormModule->getInitState();
+ if( bInitState )
+ {
+ // Not the first instantiate, reset
+ pFormModule->ResetApiObj( false/*bTriggerTerminateEvent*/ );
+ pFormModule->setInitState( false );
+ }
+ else
+ {
+ pFormModule->Load();
+ }
+ return pFormModule->CreateInstance();
+ }
+ }
+ }
+ return nullptr;
+}
+
+
+// SbTypeFactory
+
+SbxObject* cloneTypeObjectImpl( const SbxObject& rTypeObj )
+{
+ SbxObject* pRet = new SbxObject( rTypeObj );
+ pRet->PutObject( pRet );
+
+ // Copy the properties, not only the reference to them
+ SbxArray* pProps = pRet->GetProperties();
+ sal_uInt32 nCount = pProps->Count32();
+ for( sal_uInt32 i = 0 ; i < nCount ; i++ )
+ {
+ SbxVariable* pVar = pProps->Get32( i );
+ SbxProperty* pProp = dynamic_cast<SbxProperty*>( pVar );
+ if( pProp )
+ {
+ SbxProperty* pNewProp = new SbxProperty( *pProp );
+ SbxDataType eVarType = pVar->GetType();
+ if( eVarType & SbxARRAY )
+ {
+ SbxBase* pParObj = pVar->GetObject();
+ SbxDimArray* pSource = dynamic_cast<SbxDimArray*>( pParObj );
+ SbxDimArray* pDest = new SbxDimArray( pVar->GetType() );
+
+ pDest->setHasFixedSize( pSource && pSource->hasFixedSize() );
+ if ( pSource && pSource->GetDims32() && pSource->hasFixedSize() )
+ {
+ sal_Int32 lb = 0;
+ sal_Int32 ub = 0;
+ for ( sal_Int32 j = 1 ; j <= pSource->GetDims32(); ++j )
+ {
+ pSource->GetDim32( j, lb, ub );
+ pDest->AddDim32( lb, ub );
+ }
+ }
+ else
+ {
+ pDest->unoAddDim32( 0, -1 ); // variant array
+ }
+ SbxFlagBits nSavFlags = pVar->GetFlags();
+ pNewProp->ResetFlag( SbxFlagBits::Fixed );
+ // need to reset the FIXED flag
+ // when calling PutObject ( because the type will not match Object )
+ pNewProp->PutObject( pDest );
+ pNewProp->SetFlags( nSavFlags );
+ }
+ if( eVarType == SbxOBJECT )
+ {
+ SbxBase* pObjBase = pVar->GetObject();
+ SbxObject* pSrcObj = dynamic_cast<SbxObject*>( pObjBase );
+ SbxObject* pDestObj = nullptr;
+ if( pSrcObj != nullptr )
+ pDestObj = cloneTypeObjectImpl( *pSrcObj );
+ pNewProp->PutObject( pDestObj );
+ }
+ pProps->PutDirect( pNewProp, i );
+ }
+ }
+ return pRet;
+}
+
+// Factory class to create user defined objects (type command)
+class SbTypeFactory : public SbxFactory
+{
+public:
+ virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 ) override;
+ virtual SbxObject* CreateObject( const OUString& ) override;
+};
+
+SbxBase* SbTypeFactory::Create( sal_uInt16, sal_uInt32 )
+{
+ // Not supported
+ return nullptr;
+}
+
+SbxObject* SbTypeFactory::CreateObject( const OUString& rClassName )
+{
+ SbxObject* pRet = nullptr;
+ SbModule* pMod = GetSbData()->pMod;
+ if( pMod )
+ {
+ const SbxObject* pObj = pMod->FindType( rClassName );
+ if( pObj )
+ {
+ pRet = cloneTypeObjectImpl( *pObj );
+ }
+ }
+ return pRet;
+}
+
+SbxObject* createUserTypeImpl( const OUString& rClassName )
+{
+ SbxObject* pRetObj = GetSbData()->pTypeFac->CreateObject( rClassName );
+ return pRetObj;
+}
+
+
+SbClassModuleObject::SbClassModuleObject( SbModule* pClassModule )
+ : SbModule( pClassModule->GetName() )
+ , mpClassModule( pClassModule )
+ , mbInitializeEventDone( false )
+{
+ aOUSource = pClassModule->aOUSource;
+ aComment = pClassModule->aComment;
+ // see comment in destructor about these two
+ pImage = pClassModule->pImage;
+ pBreaks = pClassModule->pBreaks;
+
+ SetClassName( pClassModule->GetName() );
+
+ // Allow search only internally
+ ResetFlag( SbxFlagBits::GlobalSearch );
+
+ // Copy the methods from original class module
+ SbxArray* pClassMethods = pClassModule->GetMethods().get();
+ sal_uInt32 nMethodCount = pClassMethods->Count32();
+ sal_uInt32 i;
+ for( i = 0 ; i < nMethodCount ; i++ )
+ {
+ SbxVariable* pVar = pClassMethods->Get32( i );
+
+ // Exclude SbIfaceMapperMethod to copy them in a second step
+ SbIfaceMapperMethod* pIfaceMethod = dynamic_cast<SbIfaceMapperMethod*>( pVar );
+ if( !pIfaceMethod )
+ {
+ SbMethod* pMethod = dynamic_cast<SbMethod*>( pVar );
+ if( pMethod )
+ {
+ SbxFlagBits nFlags_ = pMethod->GetFlags();
+ pMethod->SetFlag( SbxFlagBits::NoBroadcast );
+ SbMethod* pNewMethod = new SbMethod( *pMethod );
+ pNewMethod->ResetFlag( SbxFlagBits::NoBroadcast );
+ pMethod->SetFlags( nFlags_ );
+ pNewMethod->pMod = this;
+ pNewMethod->SetParent( this );
+ pMethods->PutDirect( pNewMethod, i );
+ StartListening(pNewMethod->GetBroadcaster(), DuplicateHandling::Prevent);
+ }
+ }
+ }
+
+ // Copy SbIfaceMapperMethod in a second step to ensure that
+ // the corresponding base methods have already been copied
+ for( i = 0 ; i < nMethodCount ; i++ )
+ {
+ SbxVariable* pVar = pClassMethods->Get32( i );
+
+ SbIfaceMapperMethod* pIfaceMethod = dynamic_cast<SbIfaceMapperMethod*>( pVar );
+ if( pIfaceMethod )
+ {
+ SbMethod* pImplMethod = pIfaceMethod->getImplMethod();
+ if( !pImplMethod )
+ {
+ OSL_FAIL( "No ImplMethod" );
+ continue;
+ }
+
+ // Search for own copy of ImplMethod
+ SbxVariable* p = pMethods->Find( pImplMethod->GetName(), SbxClassType::Method );
+ SbMethod* pImplMethodCopy = dynamic_cast<SbMethod*>( p );
+ if( !pImplMethodCopy )
+ {
+ OSL_FAIL( "Found no ImplMethod copy" );
+ continue;
+ }
+ SbIfaceMapperMethod* pNewIfaceMethod =
+ new SbIfaceMapperMethod( pIfaceMethod->GetName(), pImplMethodCopy );
+ pMethods->PutDirect( pNewIfaceMethod, i );
+ }
+ }
+
+ // Copy the properties from original class module
+ SbxArray* pClassProps = pClassModule->GetProperties();
+ sal_uInt32 nPropertyCount = pClassProps->Count32();
+ for( i = 0 ; i < nPropertyCount ; i++ )
+ {
+ SbxVariable* pVar = pClassProps->Get32( i );
+ SbProcedureProperty* pProcedureProp = dynamic_cast<SbProcedureProperty*>( pVar );
+ if( pProcedureProp )
+ {
+ SbxFlagBits nFlags_ = pProcedureProp->GetFlags();
+ pProcedureProp->SetFlag( SbxFlagBits::NoBroadcast );
+ SbProcedureProperty* pNewProp = new SbProcedureProperty
+ ( pProcedureProp->GetName(), pProcedureProp->GetType() );
+ pNewProp->SetFlags( nFlags_ ); // Copy flags
+ pNewProp->ResetFlag( SbxFlagBits::NoBroadcast ); // except the Broadcast if it was set
+ pProcedureProp->SetFlags( nFlags_ );
+ pProps->PutDirect( pNewProp, i );
+ StartListening(pNewProp->GetBroadcaster(), DuplicateHandling::Prevent);
+ }
+ else
+ {
+ SbxProperty* pProp = dynamic_cast<SbxProperty*>( pVar );
+ if( pProp )
+ {
+ SbxFlagBits nFlags_ = pProp->GetFlags();
+ pProp->SetFlag( SbxFlagBits::NoBroadcast );
+ SbxProperty* pNewProp = new SbxProperty( *pProp );
+
+ // Special handling for modules instances and collections, they need
+ // to be instantiated, otherwise all refer to the same base object
+ SbxDataType eVarType = pProp->GetType();
+ if( eVarType == SbxOBJECT )
+ {
+ SbxBase* pObjBase = pProp->GetObject();
+ SbxObject* pObj = dynamic_cast<SbxObject*>( pObjBase );
+ if( pObj != nullptr )
+ {
+ const OUString& aObjClass = pObj->GetClassName();
+
+ SbClassModuleObject* pClassModuleObj = dynamic_cast<SbClassModuleObject*>( pObjBase );
+ if( pClassModuleObj != nullptr )
+ {
+ SbModule* pLclClassModule = pClassModuleObj->getClassModule();
+ SbClassModuleObject* pNewObj = new SbClassModuleObject( pLclClassModule );
+ pNewObj->SetName( pProp->GetName() );
+ pNewObj->SetParent( pLclClassModule->pParent );
+ pNewProp->PutObject( pNewObj );
+ }
+ else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
+ {
+ BasicCollection* pNewCollection = new BasicCollection( "Collection" );
+ pNewCollection->SetName( pProp->GetName() );
+ pNewCollection->SetParent( pClassModule->pParent );
+ pNewProp->PutObject( pNewCollection );
+ }
+ }
+ }
+
+ pNewProp->ResetFlag( SbxFlagBits::NoBroadcast );
+ pNewProp->SetParent( this );
+ pProps->PutDirect( pNewProp, i );
+ pProp->SetFlags( nFlags_ );
+ }
+ }
+ }
+ SetModuleType( ModuleType::CLASS );
+ mbVBACompat = pClassModule->mbVBACompat;
+}
+
+SbClassModuleObject::~SbClassModuleObject()
+{
+ // do not trigger termination event when document is already closed
+ if( StarBASIC::IsRunning() )
+ if( StarBASIC* pDocBasic = lclGetDocBasicForModule( this ) )
+ if( const DocBasicItem* pDocBasicItem = lclFindDocBasicItem( pDocBasic ) )
+ if( !pDocBasicItem->isDocClosed() )
+ triggerTerminateEvent();
+
+ // prevent the base class destructor from deleting these because
+ // we do not actually own them
+ pImage = nullptr;
+ pBreaks = nullptr;
+}
+
+void SbClassModuleObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ handleProcedureProperties( rBC, rHint );
+}
+
+SbxVariable* SbClassModuleObject::Find( const OUString& rName, SbxClassType t )
+{
+ SbxVariable* pRes = SbxObject::Find( rName, t );
+ if( pRes )
+ {
+ triggerInitializeEvent();
+
+ SbIfaceMapperMethod* pIfaceMapperMethod = dynamic_cast<SbIfaceMapperMethod*>( pRes );
+ if( pIfaceMapperMethod )
+ {
+ pRes = pIfaceMapperMethod->getImplMethod();
+ pRes->SetFlag( SbxFlagBits::ExtFound );
+ }
+ }
+ return pRes;
+}
+
+void SbClassModuleObject::triggerInitializeEvent()
+{
+ if( mbInitializeEventDone )
+ {
+ return;
+ }
+
+ mbInitializeEventDone = true;
+
+ // Search method
+ SbxVariable* pMeth = SbxObject::Find("Class_Initialize", SbxClassType::Method);
+ if( pMeth )
+ {
+ SbxValues aVals;
+ pMeth->Get( aVals );
+ }
+}
+
+void SbClassModuleObject::triggerTerminateEvent()
+{
+ if( !mbInitializeEventDone || GetSbData()->bRunInit )
+ {
+ return;
+ }
+ // Search method
+ SbxVariable* pMeth = SbxObject::Find("Class_Terminate", SbxClassType::Method );
+ if( pMeth )
+ {
+ SbxValues aVals;
+ pMeth->Get( aVals );
+ }
+}
+
+
+SbClassData::SbClassData()
+{
+ mxIfaces = new SbxArray();
+}
+
+void SbClassData::clear()
+{
+ mxIfaces->Clear();
+ maRequiredTypes.clear();
+}
+
+SbClassFactory::SbClassFactory()
+{
+ xClassModules = new SbxObject( OUString() );
+}
+
+SbClassFactory::~SbClassFactory()
+{}
+
+void SbClassFactory::AddClassModule( SbModule* pClassModule )
+{
+ SbxObjectRef xToUseClassModules = xClassModules;
+
+ if( StarBASIC* pDocBasic = lclGetDocBasicForModule( pClassModule ) )
+ if( const DocBasicItem* pDocBasicItem = lclFindDocBasicItem( pDocBasic ) )
+ xToUseClassModules = pDocBasicItem->getClassModules();
+
+ SbxObject* pParent = pClassModule->GetParent();
+ xToUseClassModules->Insert( pClassModule );
+ pClassModule->SetParent( pParent );
+}
+
+void SbClassFactory::RemoveClassModule( SbModule* pClassModule )
+{
+ xClassModules->Remove( pClassModule );
+}
+
+SbxBase* SbClassFactory::Create( sal_uInt16, sal_uInt32 )
+{
+ // Not supported
+ return nullptr;
+}
+
+SbxObject* SbClassFactory::CreateObject( const OUString& rClassName )
+{
+ SbxObjectRef xToUseClassModules = xClassModules;
+
+ if( SbModule* pMod = GetSbData()->pMod )
+ {
+ if( StarBASIC* pDocBasic = lclGetDocBasicForModule( pMod ) )
+ {
+ if( const DocBasicItem* pDocBasicItem = lclFindDocBasicItem( pDocBasic ) )
+ {
+ xToUseClassModules = pDocBasicItem->getClassModules();
+ }
+ }
+ }
+ SbxVariable* pVar = xToUseClassModules->Find( rClassName, SbxClassType::Object );
+ SbxObject* pRet = nullptr;
+ if( pVar )
+ {
+ SbModule* pVarMod = static_cast<SbModule*>(pVar);
+ pRet = new SbClassModuleObject( pVarMod );
+ }
+ return pRet;
+}
+
+SbModule* SbClassFactory::FindClass( const OUString& rClassName )
+{
+ SbxVariable* pVar = xClassModules->Find( rClassName, SbxClassType::DontCare );
+ SbModule* pMod = pVar ? static_cast<SbModule*>(pVar) : nullptr;
+ return pMod;
+}
+
+StarBASIC::StarBASIC( StarBASIC* p, bool bIsDocBasic )
+ : SbxObject("StarBASIC"), bDocBasic( bIsDocBasic )
+{
+ SetParent( p );
+ bNoRtl = bBreak = false;
+ bVBAEnabled = false;
+
+ if( !GetSbData()->nInst++ )
+ {
+ GetSbData()->pSbFac.reset( new SbiFactory );
+ AddFactory( GetSbData()->pSbFac.get() );
+ GetSbData()->pTypeFac = new SbTypeFactory;
+ AddFactory( GetSbData()->pTypeFac );
+ GetSbData()->pClassFac = new SbClassFactory;
+ AddFactory( GetSbData()->pClassFac );
+ GetSbData()->pOLEFac = new SbOLEFactory;
+ AddFactory( GetSbData()->pOLEFac );
+ GetSbData()->pFormFac = new SbFormFactory;
+ AddFactory( GetSbData()->pFormFac );
+ GetSbData()->pUnoFac.reset( new SbUnoFactory );
+ AddFactory( GetSbData()->pUnoFac.get() );
+ }
+ pRtl = new SbiStdObject(SB_RTLNAME, this );
+ // Search via StarBasic is always global
+ SetFlag( SbxFlagBits::GlobalSearch );
+ pVBAGlobals = nullptr;
+ bQuit = false;
+
+ if( bDocBasic )
+ {
+ lclInsertDocBasicItem( *this );
+ }
+}
+
+// #51727 Override SetModified so that the modified state
+// is not given to the parent
+void StarBASIC::SetModified( bool b )
+{
+ SbxBase::SetModified( b );
+}
+
+StarBASIC::~StarBASIC()
+{
+ // Needs to be first action as it can trigger events
+ disposeComVariablesForBasic( this );
+
+ if( !--GetSbData()->nInst )
+ {
+ RemoveFactory( GetSbData()->pSbFac.get() );
+ GetSbData()->pSbFac.reset();
+ RemoveFactory( GetSbData()->pUnoFac.get() );
+ GetSbData()->pUnoFac.reset();
+ RemoveFactory( GetSbData()->pTypeFac );
+ delete GetSbData()->pTypeFac; GetSbData()->pTypeFac = nullptr;
+ RemoveFactory( GetSbData()->pClassFac );
+ delete GetSbData()->pClassFac; GetSbData()->pClassFac = nullptr;
+ RemoveFactory( GetSbData()->pOLEFac );
+ delete GetSbData()->pOLEFac; GetSbData()->pOLEFac = nullptr;
+ RemoveFactory( GetSbData()->pFormFac );
+ delete GetSbData()->pFormFac; GetSbData()->pFormFac = nullptr;
+
+ if( SbiGlobals::pGlobals )
+ {
+ delete SbiGlobals::pGlobals;
+ SbiGlobals::pGlobals = nullptr;
+ }
+ }
+ else if( bDocBasic )
+ {
+ ErrCode eOld = SbxBase::GetError();
+
+ lclRemoveDocBasicItem( *this );
+
+ SbxBase::ResetError();
+ if( eOld != ERRCODE_NONE )
+ {
+ SbxBase::SetError( eOld );
+ }
+ }
+
+ // #100326 Set Parent NULL in registered listeners
+ if( xUnoListeners.is() )
+ {
+ sal_uInt32 uCount = xUnoListeners->Count32();
+ for( sal_uInt32 i = 0 ; i < uCount ; i++ )
+ {
+ SbxVariable* pListenerObj = xUnoListeners->Get32( i );
+ pListenerObj->SetParent( nullptr );
+ }
+ xUnoListeners = nullptr;
+ }
+
+ clearUnoMethodsForBasic( this );
+}
+
+void StarBASIC::implClearDependingVarsOnDelete( StarBASIC* pDeletedBasic )
+{
+ if( this != pDeletedBasic )
+ {
+ for( const auto& pModule: pModules)
+ {
+ pModule->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
+ }
+ }
+
+ for( sal_uInt32 nObj = 0; nObj < pObjs->Count32(); nObj++ )
+ {
+ SbxVariable* pVar = pObjs->Get32( nObj );
+ StarBASIC* pBasic = dynamic_cast<StarBASIC*>( pVar );
+ if( pBasic && pBasic != pDeletedBasic )
+ {
+ pBasic->implClearDependingVarsOnDelete( pDeletedBasic );
+ }
+ }
+}
+
+
+SbModule* StarBASIC::MakeModule( const OUString& rName, const OUString& rSrc )
+{
+ ModuleInfo aInfo;
+ aInfo.ModuleType = ModuleType::NORMAL;
+ return MakeModule( rName, aInfo, rSrc );
+}
+SbModule* StarBASIC::MakeModule( const OUString& rName, const ModuleInfo& mInfo, const OUString& rSrc )
+{
+
+ SAL_INFO(
+ "basic",
+ "create module " << rName << " type mInfo " << mInfo.ModuleType);
+ SbModule* p = nullptr;
+ switch ( mInfo.ModuleType )
+ {
+ case ModuleType::DOCUMENT:
+ // In theory we should be able to create Object modules
+ // in ordinary basic ( in vba mode thought these are create
+ // by the application/basic and not by the user )
+ p = new SbObjModule( rName, mInfo, isVBAEnabled() );
+ break;
+ case ModuleType::CLASS:
+ p = new SbModule( rName, isVBAEnabled() );
+ p->SetModuleType( ModuleType::CLASS );
+ break;
+ case ModuleType::FORM:
+ p = new SbUserFormModule( rName, mInfo, isVBAEnabled() );
+ break;
+ default:
+ p = new SbModule( rName, isVBAEnabled() );
+ break;
+ }
+ p->SetSource32( rSrc );
+ p->SetParent( this );
+ pModules.emplace_back(p);
+ SetModified( true );
+ return p;
+}
+
+void StarBASIC::Insert( SbxVariable* pVar )
+{
+ if( dynamic_cast<const SbModule*>(pVar) != nullptr)
+ {
+ pModules.emplace_back(static_cast<SbModule*>(pVar));
+ pVar->SetParent( this );
+ StartListening(pVar->GetBroadcaster(), DuplicateHandling::Prevent);
+ }
+ else
+ {
+ bool bWasModified = IsModified();
+ SbxObject::Insert( pVar );
+ if( !bWasModified && pVar->IsSet( SbxFlagBits::DontStore ) )
+ {
+ SetModified( false );
+ }
+ }
+}
+
+void StarBASIC::Remove( SbxVariable* pVar )
+{
+ SbModule* pModule = dynamic_cast<SbModule*>(pVar);
+ if( pModule )
+ {
+ // #87540 Can be last reference!
+ SbModuleRef xVar = pModule;
+ pModules.erase(std::remove(pModules.begin(), pModules.end(), xVar));
+ pVar->SetParent( nullptr );
+ EndListening( pVar->GetBroadcaster() );
+ }
+ else
+ {
+ SbxObject::Remove( pVar );
+ }
+}
+
+void StarBASIC::Clear()
+{
+ pModules.clear();
+}
+
+SbModule* StarBASIC::FindModule( const OUString& rName )
+{
+ for (const auto& pModule: pModules)
+ {
+ if( pModule->GetName().equalsIgnoreAsciiCase( rName ) )
+ {
+ return pModule.get();
+ }
+ }
+ return nullptr;
+}
+
+
+struct ClassModuleRunInitItem
+{
+ SbModule* m_pModule;
+ bool m_bProcessing;
+ bool m_bRunInitDone;
+
+ ClassModuleRunInitItem()
+ : m_pModule( nullptr )
+ , m_bProcessing( false )
+ , m_bRunInitDone( false )
+ {}
+ explicit ClassModuleRunInitItem( SbModule* pModule )
+ : m_pModule( pModule )
+ , m_bProcessing( false )
+ , m_bRunInitDone( false )
+ {}
+};
+
+// Derive from unordered_map type instead of typedef
+// to allow forward declaration in sbmod.hxx
+class ModuleInitDependencyMap : public
+ std::unordered_map< OUString, ClassModuleRunInitItem >
+{};
+
+void SbModule::implProcessModuleRunInit( ModuleInitDependencyMap& rMap, ClassModuleRunInitItem& rItem )
+{
+ rItem.m_bProcessing = true;
+
+ SbModule* pModule = rItem.m_pModule;
+ if( pModule->pClassData != nullptr )
+ {
+ std::vector< OUString >& rReqTypes = pModule->pClassData->maRequiredTypes;
+ for( const auto& rStr : rReqTypes )
+ {
+ // Is required type a class module?
+ ModuleInitDependencyMap::iterator itFind = rMap.find( rStr );
+ if( itFind != rMap.end() )
+ {
+ ClassModuleRunInitItem& rParentItem = itFind->second;
+ if( rParentItem.m_bProcessing )
+ {
+ // TODO: raise error?
+ OSL_FAIL( "Cyclic module dependency detected" );
+ continue;
+ }
+
+ if( !rParentItem.m_bRunInitDone )
+ {
+ implProcessModuleRunInit( rMap, rParentItem );
+ }
+ }
+ }
+ }
+
+ pModule->RunInit();
+ rItem.m_bRunInitDone = true;
+ rItem.m_bProcessing = false;
+}
+
+// Run Init-Code of all modules (including inserted libraries)
+void StarBASIC::InitAllModules( StarBASIC const * pBasicNotToInit )
+{
+ SolarMutexGuard guard;
+
+ // Init own modules
+ for (const auto& pModule: pModules)
+ {
+ pModule->Compile();
+ }
+ // compile modules first then RunInit ( otherwise there is
+ // can be order dependency, e.g. classmodule A has a member
+ // of type classmodule B and classmodule B hasn't been compiled yet )
+
+ // Consider required types to init in right order. Class modules
+ // that are required by other modules have to be initialized first.
+ ModuleInitDependencyMap aMIDMap;
+ for (const auto& pModule: pModules)
+ {
+ OUString aModuleName = pModule->GetName();
+ if( pModule->isProxyModule() )
+ {
+ aMIDMap[aModuleName] = ClassModuleRunInitItem( pModule.get() );
+ }
+ }
+
+ for (auto & elem : aMIDMap)
+ {
+ ClassModuleRunInitItem& rItem = elem.second;
+ SbModule::implProcessModuleRunInit( aMIDMap, rItem );
+ }
+
+ // Call RunInit on standard modules
+ for (const auto& pModule: pModules)
+ {
+ if( !pModule->isProxyModule() )
+ {
+ pModule->RunInit();
+ }
+ }
+
+ // Check all objects if they are BASIC,
+ // if yes initialize
+ for ( sal_uInt32 nObj = 0; nObj < pObjs->Count32(); nObj++ )
+ {
+ SbxVariable* pVar = pObjs->Get32( nObj );
+ StarBASIC* pBasic = dynamic_cast<StarBASIC*>( pVar );
+ if( pBasic && pBasic != pBasicNotToInit )
+ {
+ pBasic->InitAllModules();
+ }
+ }
+}
+
+// #88329 Put modules back to not initialised state to
+// force reinitialisation at next start
+void StarBASIC::DeInitAllModules()
+{
+ // Deinit own modules
+ for (const auto& pModule: pModules)
+ {
+ if( pModule->pImage && !pModule->isProxyModule() && dynamic_cast<SbObjModule*>( pModule.get()) == nullptr )
+ {
+ pModule->pImage->bInit = false;
+ }
+ }
+
+ for ( sal_uInt32 nObj = 0; nObj < pObjs->Count32(); nObj++ )
+ {
+ SbxVariable* pVar = pObjs->Get32( nObj );
+ StarBASIC* pBasic = dynamic_cast<StarBASIC*>( pVar );
+ if( pBasic )
+ {
+ pBasic->DeInitAllModules();
+ }
+ }
+}
+
+// This implementation at first searches within the runtime library,
+// then it looks for an element within one module. This module can be
+// a public var or an entrypoint. If it is not found and we look for a
+// method and a module with the given name is found the search continues
+// for entrypoint "Main".
+// If this fails again a conventional search over objects is performend.
+SbxVariable* StarBASIC::Find( const OUString& rName, SbxClassType t )
+{
+ SbxVariable* pRes = nullptr;
+ SbModule* pNamed = nullptr;
+ // "Extended" search in Runtime Lib
+ // but only if SbiRuntime has not set the flag
+ if( !bNoRtl )
+ {
+ if( t == SbxClassType::DontCare || t == SbxClassType::Object )
+ {
+ if( rName.equalsIgnoreAsciiCase( SB_RTLNAME ) )
+ {
+ pRes = pRtl.get();
+ }
+ }
+ if( !pRes )
+ {
+ pRes = static_cast<SbiStdObject*>(pRtl.get())->Find( rName, t );
+ }
+ if( pRes )
+ {
+ pRes->SetFlag( SbxFlagBits::ExtFound );
+ }
+ }
+ // Search module
+ if( !pRes )
+ {
+ for (const auto& pModule: pModules)
+ {
+ if( pModule->IsVisible() )
+ {
+ // Remember module for Main() call
+ // or is the name equal?!?
+ if( pModule->GetName().equalsIgnoreAsciiCase( rName ) )
+ {
+ if( t == SbxClassType::Object || t == SbxClassType::DontCare )
+ {
+ pRes = pModule.get(); break;
+ }
+ pNamed = pModule.get();
+ }
+ // Only variables qualified by the Module Name e.g. Sheet1.foo
+ // should work for Document && Class type Modules
+ sal_Int32 nType = pModule->GetModuleType();
+ if ( nType == ModuleType::DOCUMENT || nType == ModuleType::FORM )
+ {
+ continue;
+ }
+ // otherwise check if the element is available
+ // unset GBLSEARCH-Flag (due to recursion)
+ SbxFlagBits nGblFlag = pModule->GetFlags() & SbxFlagBits::GlobalSearch;
+ pModule->ResetFlag( SbxFlagBits::GlobalSearch );
+ pRes = pModule->Find( rName, t );
+ pModule->SetFlag( nGblFlag );
+ if( pRes )
+ {
+ break;
+ }
+ }
+ }
+ }
+ OUString aMainStr("Main");
+ if( !pRes && pNamed && ( t == SbxClassType::Method || t == SbxClassType::DontCare ) &&
+ !pNamed->GetName().equalsIgnoreAsciiCase( aMainStr ) )
+ {
+ pRes = pNamed->Find( aMainStr, SbxClassType::Method );
+ }
+ if( !pRes )
+ {
+ pRes = SbxObject::Find( rName, t );
+ }
+ return pRes;
+}
+
+bool StarBASIC::Call( const OUString& rName, SbxArray* pParam )
+{
+ bool bRes = SbxObject::Call( rName, pParam );
+ if( !bRes )
+ {
+ ErrCode eErr = SbxBase::GetError();
+ SbxBase::ResetError();
+ if( eErr != ERRCODE_NONE )
+ {
+ RTError( eErr, OUString(), 0, 0, 0 );
+ }
+ }
+ return bRes;
+}
+
+// Find method via name (e.g. query via BASIC IDE)
+SbxBase* StarBASIC::FindSBXInCurrentScope( const OUString& rName )
+{
+ if( !GetSbData()->pInst )
+ {
+ return nullptr;
+ }
+ if( !GetSbData()->pInst->pRun )
+ {
+ return nullptr;
+ }
+ return GetSbData()->pInst->pRun->FindElementExtern( rName );
+}
+
+void StarBASIC::QuitAndExitApplication()
+{
+ Stop();
+ bQuit = true;
+}
+
+void StarBASIC::Stop()
+{
+ SbiInstance* p = GetSbData()->pInst;
+ if( p )
+ p->Stop();
+}
+
+bool StarBASIC::IsRunning()
+{
+ return GetSbData()->pInst != nullptr;
+}
+
+SbMethod* StarBASIC::GetActiveMethod( sal_uInt16 nLevel )
+{
+ if( GetSbData()->pInst )
+ {
+ return GetSbData()->pInst->GetCaller( nLevel );
+ }
+ else
+ {
+ return nullptr;
+ }
+}
+
+SbModule* StarBASIC::GetActiveModule()
+{
+ if( GetSbData()->pInst && !GetSbData()->bCompilerError )
+ {
+ return GetSbData()->pInst->GetActiveModule();
+ }
+ else
+ {
+ return GetSbData()->pCompMod;
+ }
+}
+
+BasicDebugFlags StarBASIC::BreakPoint( sal_Int32 l, sal_Int32 c1, sal_Int32 c2 )
+{
+ SetErrorData( ERRCODE_NONE, l, c1, c2 );
+ bBreak = true;
+ if( GetSbData()->aBreakHdl.IsSet() )
+ {
+ return GetSbData()->aBreakHdl.Call( this );
+ }
+ else
+ {
+ return BreakHdl();
+ }
+}
+
+BasicDebugFlags StarBASIC::StepPoint( sal_Int32 l, sal_Int32 c1, sal_Int32 c2 )
+{
+ SetErrorData( ERRCODE_NONE, l, c1, c2 );
+ bBreak = false;
+ if( GetSbData()->aBreakHdl.IsSet() )
+ {
+ return GetSbData()->aBreakHdl.Call( this );
+ }
+ else
+ {
+ return BreakHdl();
+ }
+}
+
+BasicDebugFlags StarBASIC::BreakHdl()
+{
+ return aBreakHdl.IsSet() ? aBreakHdl.Call( this ) : BasicDebugFlags::Continue;
+}
+
+// Calls for error handler and break handler
+sal_uInt16 StarBASIC::GetLine() { return GetSbData()->nLine; }
+sal_uInt16 StarBASIC::GetCol1() { return GetSbData()->nCol1; }
+sal_uInt16 StarBASIC::GetCol2() { return GetSbData()->nCol2; }
+
+// Specific to error handler
+ErrCode const & StarBASIC::GetErrorCode() { return GetSbData()->nCode; }
+const OUString& StarBASIC::GetErrorText() { return GetSbData()->aErrMsg; }
+
+// From 1996-03-29:
+// The mapping between the old and the new error codes take place by searching
+// through the table SFX_VB_ErrorTab[]. This is indeed not with good performance,
+// but it consumes much less memory than corresponding switch blocks.
+// Because the conversion of error codes has not to be fast. There is no
+// binary search by VB Error -> Error SFX.
+
+// Map back new error codes to old, Sbx-compatible
+sal_uInt16 StarBASIC::GetVBErrorCode( ErrCode nError )
+{
+ sal_uInt16 nRet = 0;
+
+ if( SbiRuntime::isVBAEnabled() )
+ {
+ if ( nError == ERRCODE_BASIC_ARRAY_FIX )
+ return 10;
+ else if ( nError == ERRCODE_BASIC_STRING_OVERFLOW )
+ return 14;
+ else if ( nError == ERRCODE_BASIC_EXPR_TOO_COMPLEX )
+ return 16;
+ else if ( nError == ERRCODE_BASIC_OPER_NOT_PERFORM )
+ return 17;
+ else if ( nError == ERRCODE_BASIC_TOO_MANY_DLL )
+ return 47;
+ else if ( nError == ERRCODE_BASIC_LOOP_NOT_INIT )
+ return 92;
+ else
+ nRet = 0;
+ }
+
+ // search loop
+ const SFX_VB_ErrorItem* pErrItem;
+ sal_uInt16 nIndex = 0;
+ do
+ {
+ pErrItem = SFX_VB_ErrorTab + nIndex;
+ if( pErrItem->nErrorSFX == nError )
+ {
+ nRet = pErrItem->nErrorVB;
+ break;
+ }
+ nIndex++;
+ }
+ while( pErrItem->nErrorVB != 0xFFFF ); // up to end mark
+ return nRet;
+}
+
+ErrCode StarBASIC::GetSfxFromVBError( sal_uInt16 nError )
+{
+ ErrCode nRet = ERRCODE_NONE;
+
+ if( SbiRuntime::isVBAEnabled() )
+ {
+ switch( nError )
+ {
+ case 1:
+ case 2:
+ case 4:
+ case 8:
+ case 12:
+ case 73:
+ return ERRCODE_NONE;
+ case 10:
+ return ERRCODE_BASIC_ARRAY_FIX;
+ case 14:
+ return ERRCODE_BASIC_STRING_OVERFLOW;
+ case 16:
+ return ERRCODE_BASIC_EXPR_TOO_COMPLEX;
+ case 17:
+ return ERRCODE_BASIC_OPER_NOT_PERFORM;
+ case 47:
+ return ERRCODE_BASIC_TOO_MANY_DLL;
+ case 92:
+ return ERRCODE_BASIC_LOOP_NOT_INIT;
+ default:
+ nRet = ERRCODE_NONE;
+ }
+ }
+ const SFX_VB_ErrorItem* pErrItem;
+ sal_uInt16 nIndex = 0;
+ do
+ {
+ pErrItem = SFX_VB_ErrorTab + nIndex;
+ if( pErrItem->nErrorVB == nError )
+ {
+ nRet = pErrItem->nErrorSFX;
+ break;
+ }
+ else if( pErrItem->nErrorVB > nError )
+ {
+ break; // couldn't found anymore
+ }
+ nIndex++;
+ }
+ while( pErrItem->nErrorVB != 0xFFFF ); // up to end mark
+ return nRet;
+}
+
+// set Error- / Break-data
+void StarBASIC::SetErrorData( ErrCode nCode, sal_uInt16 nLine,
+ sal_uInt16 nCol1, sal_uInt16 nCol2 )
+{
+ SbiGlobals& aGlobals = *GetSbData();
+ aGlobals.nCode = nCode;
+ aGlobals.nLine = nLine;
+ aGlobals.nCol1 = nCol1;
+ aGlobals.nCol2 = nCol2;
+}
+
+void StarBASIC::MakeErrorText( ErrCode nId, const OUString& aMsg )
+{
+ SolarMutexGuard aSolarGuard;
+ sal_uInt16 nOldID = GetVBErrorCode( nId );
+
+ const char* pErrorMsg = nullptr;
+ for (std::pair<const char *, ErrCode> const *pItem = RID_BASIC_START; pItem->second; ++pItem)
+ {
+ if (nId == pItem->second)
+ {
+ pErrorMsg = pItem->first;
+ break;
+ }
+ }
+
+ if (pErrorMsg)
+ {
+ // merge message with additional text
+ OUString sError = BasResId(pErrorMsg);
+ OUStringBuffer aMsg1(sError);
+ // replace argument placeholder with %s
+ OUString aSrgStr( "$(ARG1)" );
+ sal_Int32 nResult = sError.indexOf(aSrgStr);
+
+ if( nResult >= 0 )
+ {
+ aMsg1.remove(nResult, aSrgStr.getLength());
+ aMsg1.insert(nResult, aMsg);
+ }
+ GetSbData()->aErrMsg = aMsg1.makeStringAndClear();
+ }
+ else if( nOldID != 0 )
+ {
+ OUString aStdMsg = "Error " + OUString::number(nOldID) +
+ ": No error text available!";
+ GetSbData()->aErrMsg = aStdMsg;
+ }
+ else
+ {
+ GetSbData()->aErrMsg.clear();
+ }
+}
+
+bool StarBASIC::CError( ErrCode code, const OUString& rMsg,
+ sal_Int32 l, sal_Int32 c1, sal_Int32 c2 )
+{
+ SolarMutexGuard aSolarGuard;
+
+ // compiler error during runtime -> stop program
+ if( IsRunning() )
+ {
+ // #109018 Check if running Basic is affected
+ StarBASIC* pStartedBasic = GetSbData()->pInst->GetBasic();
+ if( pStartedBasic != this )
+ {
+ return false;
+ }
+ Stop();
+ }
+
+ // set flag, so that GlobalRunInit notice the error
+ GetSbData()->bGlobalInitErr = true;
+
+ // tinker the error message
+ MakeErrorText( code, rMsg );
+
+ // Implementation of the code for the string transport to SFX-Error
+ if( !rMsg.isEmpty() )
+ {
+ code = *new StringErrorInfo( code, rMsg );
+ }
+ SetErrorData( code, l, c1, c2 );
+ GetSbData()->bCompilerError = true;
+ bool bRet;
+ if( GetSbData()->aErrHdl.IsSet() )
+ {
+ bRet = GetSbData()->aErrHdl.Call( this );
+ }
+ else
+ {
+ bRet = ErrorHdl();
+ }
+ GetSbData()->bCompilerError = false; // only true for error handler
+ return bRet;
+}
+
+bool StarBASIC::RTError( ErrCode code, const OUString& rMsg, sal_Int32 l, sal_Int32 c1, sal_Int32 c2 )
+{
+ SolarMutexGuard aSolarGuard;
+
+ ErrCode c = code;
+ if( c.GetClass() == ErrCodeClass::Compiler )
+ {
+ c = ERRCODE_NONE;
+ }
+ MakeErrorText( c, rMsg );
+
+ // Implementation of the code for the string transport to SFX-Error
+ if( !rMsg.isEmpty() )
+ {
+ // very confusing, even though MakeErrorText sets up the error text
+ // seems that this is not used ( if rMsg already has content )
+ // In the case of VBA MakeErrorText also formats the error to be a little more
+ // like vba ( adds an error number etc )
+ if ( SbiRuntime::isVBAEnabled() && ( code == ERRCODE_BASIC_COMPAT ) )
+ {
+ OUString aTmp = "\'" + OUString::number(SbxErrObject::getUnoErrObject()->getNumber()) +
+ "\'\n" + (!GetSbData()->aErrMsg.isEmpty() ? GetSbData()->aErrMsg : rMsg);
+ code = *new StringErrorInfo( code, aTmp );
+ }
+ else
+ {
+ code = *new StringErrorInfo( code, rMsg );
+ }
+ }
+
+ SetErrorData( code, l, c1, c2 );
+ if( GetSbData()->aErrHdl.IsSet() )
+ {
+ return GetSbData()->aErrHdl.Call( this );
+ }
+ else
+ {
+ return ErrorHdl();
+ }
+}
+
+void StarBASIC::Error( ErrCode n )
+{
+ Error( n, OUString() );
+}
+
+void StarBASIC::Error( ErrCode n, const OUString& rMsg )
+{
+ if( GetSbData()->pInst )
+ {
+ GetSbData()->pInst->Error( n, rMsg );
+ }
+}
+
+void StarBASIC::FatalError( ErrCode n )
+{
+ if( GetSbData()->pInst )
+ {
+ GetSbData()->pInst->FatalError( n );
+ }
+}
+
+void StarBASIC::FatalError( ErrCode _errCode, const OUString& _details )
+{
+ if( GetSbData()->pInst )
+ {
+ GetSbData()->pInst->FatalError( _errCode, _details );
+ }
+}
+
+ErrCode StarBASIC::GetErrBasic()
+{
+ if( GetSbData()->pInst )
+ {
+ return GetSbData()->pInst->GetErr();
+ }
+ else
+ {
+ return ERRCODE_NONE;
+ }
+}
+
+// make the additional message for the RTL function error accessible
+OUString StarBASIC::GetErrorMsg()
+{
+ if( GetSbData()->pInst )
+ {
+ return GetSbData()->pInst->GetErrorMsg();
+ }
+ else
+ {
+ return OUString();
+ }
+}
+
+sal_Int32 StarBASIC::GetErl()
+{
+ if( GetSbData()->pInst )
+ {
+ return GetSbData()->pInst->GetErl();
+ }
+ else
+ {
+ return 0;
+ }
+}
+
+bool StarBASIC::ErrorHdl()
+{
+ return aErrorHdl.Call( this );
+}
+
+Link<StarBASIC*,bool> const & StarBASIC::GetGlobalErrorHdl()
+{
+ return GetSbData()->aErrHdl;
+}
+
+void StarBASIC::SetGlobalErrorHdl( const Link<StarBASIC*,bool>& rLink )
+{
+ GetSbData()->aErrHdl = rLink;
+}
+
+void StarBASIC::SetGlobalBreakHdl( const Link<StarBASIC*,BasicDebugFlags>& rLink )
+{
+ GetSbData()->aBreakHdl = rLink;
+}
+
+SbxArrayRef const & StarBASIC::getUnoListeners()
+{
+ if( !xUnoListeners.is() )
+ {
+ xUnoListeners = new SbxArray();
+ }
+ return xUnoListeners;
+}
+
+
+bool StarBASIC::LoadData( SvStream& r, sal_uInt16 nVer )
+{
+ if( !SbxObject::LoadData( r, nVer ) )
+ {
+ return false;
+ }
+ // #95459 Delete dialogs, otherwise endless recursion
+ // in SbxVarable::GetType() if dialogs are accessed
+ sal_uInt32 nObjCount = pObjs->Count32();
+ std::unique_ptr<SbxVariable*[]> ppDeleteTab(new SbxVariable*[ nObjCount ]);
+ sal_uInt32 nObj;
+
+ for( nObj = 0 ; nObj < nObjCount ; nObj++ )
+ {
+ SbxVariable* pVar = pObjs->Get32( nObj );
+ StarBASIC* pBasic = dynamic_cast<StarBASIC*>( pVar );
+ ppDeleteTab[nObj] = pBasic ? nullptr : pVar;
+ }
+ for( nObj = 0 ; nObj < nObjCount ; nObj++ )
+ {
+ SbxVariable* pVar = ppDeleteTab[nObj];
+ if( pVar )
+ {
+ pObjs->Remove( pVar );
+ }
+ }
+ ppDeleteTab.reset();
+
+ sal_uInt16 nMod(0);
+ pModules.clear();
+ r.ReadUInt16( nMod );
+ const size_t nMinSbxSize(14);
+ const size_t nMaxPossibleEntries = r.remainingSize() / nMinSbxSize;
+ if (nMod > nMaxPossibleEntries)
+ {
+ nMod = nMaxPossibleEntries;
+ SAL_WARN("basic", "Parsing error: " << nMaxPossibleEntries <<
+ " max possible entries, but " << nMod << " claimed, truncating");
+ }
+ for (sal_uInt16 i = 0; i < nMod; ++i)
+ {
+ SbxBase* pBase = SbxBase::Load( r );
+ SbModule* pMod = dynamic_cast<SbModule*>(pBase);
+ if( !pMod )
+ {
+ return false;
+ }
+ else if( dynamic_cast<const SbJScriptModule*>( pMod) != nullptr )
+ {
+ // assign Ref, so that pMod will be deleted
+ SbModuleRef xDeleteRef = pMod;
+ }
+ else
+ {
+ pMod->SetParent( this );
+ pModules.emplace_back(pMod );
+ }
+ }
+ // HACK for SFX-Bullshit!
+ SbxVariable* p = Find( "FALSE", SbxClassType::Property );
+ if( p )
+ {
+ Remove( p );
+ }
+ p = Find( "TRUE", SbxClassType::Property );
+ if( p )
+ {
+ Remove( p );
+ }
+ // End of the hacks!
+ // Search via StarBASIC is at all times global
+ DBG_ASSERT( IsSet( SbxFlagBits::GlobalSearch ), "Basic loaded without GBLSEARCH" );
+ SetFlag( SbxFlagBits::GlobalSearch );
+ return true;
+}
+
+bool StarBASIC::StoreData( SvStream& r ) const
+{
+ if( !SbxObject::StoreData( r ) )
+ {
+ return false;
+ }
+ assert(pModules.size() < SAL_MAX_UINT16);
+ r.WriteUInt16( static_cast<sal_uInt16>(pModules.size()));
+ for( const auto& rpModule: pModules )
+ {
+ if( !rpModule->Store( r ) )
+ {
+ return false;
+ }
+ }
+ return true;
+}
+
+bool StarBASIC::GetUNOConstant( const OUString& rName, css::uno::Any& aOut )
+{
+ bool bRes = false;
+ SbUnoObject* pGlobs = dynamic_cast<SbUnoObject*>( Find( rName, SbxClassType::DontCare ) );
+ if ( pGlobs )
+ {
+ aOut = pGlobs->getUnoAny();
+ bRes = true;
+ }
+ return bRes;
+}
+
+Reference< frame::XModel > StarBASIC::GetModelFromBasic( SbxObject* pBasic )
+{
+ OSL_PRECOND( pBasic != nullptr, "getModelFromBasic: illegal call!" );
+ if ( !pBasic )
+ {
+ return nullptr;
+ }
+ // look for the ThisComponent variable, first in the parent (which
+ // might be the document's Basic), then in the parent's parent (which might be
+ // the application Basic)
+ const OUString sThisComponent( "ThisComponent");
+ SbxVariable* pThisComponent = nullptr;
+
+ SbxObject* pLookup = pBasic->GetParent();
+ while ( pLookup && !pThisComponent )
+ {
+ pThisComponent = pLookup->Find( sThisComponent, SbxClassType::Object );
+ pLookup = pLookup->GetParent();
+ }
+ if ( !pThisComponent )
+ {
+ SAL_WARN("basic", "Failed to get ThisComponent");
+ // the application Basic, at the latest, should have this variable
+ return nullptr;
+ }
+
+ Any aThisComponentAny( sbxToUnoValue( pThisComponent ) );
+ Reference< frame::XModel > xModel( aThisComponentAny, UNO_QUERY );
+ if ( !xModel.is() )
+ {
+ // it's no XModel. Okay, ThisComponent nowadays is allowed to be a controller.
+ Reference< frame::XController > xController( aThisComponentAny, UNO_QUERY );
+ if ( xController.is() )
+ {
+ xModel = xController->getModel();
+ }
+ }
+ if ( !xModel.is() )
+ {
+ return nullptr;
+ }
+
+ return xModel;
+}
+
+void StarBASIC::DetachAllDocBasicItems()
+{
+ std::unordered_map< const StarBASIC *, DocBasicItemRef >& rItems = GaDocBasicItems::get();
+ for (auto const& item : rItems)
+ {
+ DocBasicItemRef xItem = item.second;
+ xItem->setDisposed(true);
+ }
+}
+
+// #118116 Implementation Collection object
+
+
+static const char pCountStr[] = "Count";
+static const char pAddStr[] = "Add";
+static const char pItemStr[] = "Item";
+static const char pRemoveStr[] = "Remove";
+static sal_uInt16 nCountHash = 0, nAddHash, nItemHash, nRemoveHash;
+
+SbxInfoRef BasicCollection::xAddInfo;
+SbxInfoRef BasicCollection::xItemInfo;
+
+BasicCollection::BasicCollection( const OUString& rClass )
+ : SbxObject( rClass )
+{
+ if( !nCountHash )
+ {
+ nCountHash = MakeHashCode( pCountStr );
+ nAddHash = MakeHashCode( pAddStr );
+ nItemHash = MakeHashCode( pItemStr );
+ nRemoveHash = MakeHashCode( pRemoveStr );
+ }
+ Initialize();
+
+}
+
+BasicCollection::~BasicCollection()
+{}
+
+void BasicCollection::Clear()
+{
+ SbxObject::Clear();
+ Initialize();
+}
+
+void BasicCollection::Initialize()
+{
+ xItemArray = new SbxArray();
+ SetType( SbxOBJECT );
+ SetFlag( SbxFlagBits::Fixed );
+ ResetFlag( SbxFlagBits::Write );
+ SbxVariable* p;
+ p = Make( pCountStr, SbxClassType::Property, SbxINTEGER );
+ p->ResetFlag( SbxFlagBits::Write );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p = Make( pAddStr, SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p = Make( pItemStr, SbxClassType::Method, SbxVARIANT );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p = Make( pRemoveStr, SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ if ( !xAddInfo.is() )
+ {
+ xAddInfo = new SbxInfo;
+ xAddInfo->AddParam( "Item", SbxVARIANT );
+ xAddInfo->AddParam( "Key", SbxVARIANT, SbxFlagBits::Read | SbxFlagBits::Optional );
+ xAddInfo->AddParam( "Before", SbxVARIANT, SbxFlagBits::Read | SbxFlagBits::Optional );
+ xAddInfo->AddParam( "After", SbxVARIANT, SbxFlagBits::Read | SbxFlagBits::Optional );
+ }
+ if ( !xItemInfo.is() )
+ {
+ xItemInfo = new SbxInfo;
+ xItemInfo->AddParam( "Index", SbxVARIANT, SbxFlagBits::Read | SbxFlagBits::Optional);
+ }
+}
+
+void BasicCollection::Notify( SfxBroadcaster& rCst, const SfxHint& rHint )
+{
+ const SbxHint* p = dynamic_cast<const SbxHint*>(&rHint);
+ if( p )
+ {
+ const SfxHintId nId = p->GetId();
+ bool bRead = nId == SfxHintId::BasicDataWanted;
+ bool bWrite = nId == SfxHintId::BasicDataChanged;
+ bool bRequestInfo = nId == SfxHintId::BasicInfoWanted;
+ SbxVariable* pVar = p->GetVar();
+ SbxArray* pArg = pVar->GetParameters();
+ OUString aVarName( pVar->GetName() );
+ if( bRead || bWrite )
+ {
+ if( pVar->GetHashCode() == nCountHash
+ && aVarName.equalsIgnoreAsciiCase( pCountStr ) )
+ {
+ pVar->PutLong( xItemArray->Count32() );
+ }
+ else if( pVar->GetHashCode() == nAddHash
+ && aVarName.equalsIgnoreAsciiCase( pAddStr ) )
+ {
+ CollAdd( pArg );
+ }
+ else if( pVar->GetHashCode() == nItemHash
+ && aVarName.equalsIgnoreAsciiCase( pItemStr ) )
+ {
+ CollItem( pArg );
+ }
+ else if( pVar->GetHashCode() == nRemoveHash
+ && aVarName.equalsIgnoreAsciiCase( pRemoveStr ) )
+ {
+ CollRemove( pArg );
+ }
+ else
+ {
+ SbxObject::Notify( rCst, rHint );
+ }
+ return;
+ }
+ else if ( bRequestInfo )
+ {
+ if( pVar->GetHashCode() == nAddHash
+ && aVarName.equalsIgnoreAsciiCase( pAddStr ) )
+ {
+ pVar->SetInfo( xAddInfo.get() );
+ }
+ else if( pVar->GetHashCode() == nItemHash
+ && aVarName.equalsIgnoreAsciiCase( pItemStr ) )
+ {
+ pVar->SetInfo( xItemInfo.get() );
+ }
+ }
+ }
+ SbxObject::Notify( rCst, rHint );
+}
+
+sal_Int32 BasicCollection::implGetIndex( SbxVariable const * pIndexVar )
+{
+ sal_Int32 nIndex = -1;
+ if( pIndexVar->GetType() == SbxSTRING )
+ {
+ nIndex = implGetIndexForName( pIndexVar->GetOUString() );
+ }
+ else
+ {
+ nIndex = pIndexVar->GetLong() - 1;
+ }
+ return nIndex;
+}
+
+sal_Int32 BasicCollection::implGetIndexForName( const OUString& rName )
+{
+ sal_Int32 nIndex = -1;
+ sal_Int32 nCount = xItemArray->Count32();
+ sal_Int32 nNameHash = MakeHashCode( rName );
+ for( sal_Int32 i = 0 ; i < nCount ; i++ )
+ {
+ SbxVariable* pVar = xItemArray->Get32( i );
+ if( pVar->GetHashCode() == nNameHash &&
+ pVar->GetName().equalsIgnoreAsciiCase( rName ) )
+ {
+ nIndex = i;
+ break;
+ }
+ }
+ return nIndex;
+}
+
+void BasicCollection::CollAdd( SbxArray* pPar_ )
+{
+ sal_uInt32 nCount = pPar_->Count32();
+ if( nCount < 2 || nCount > 5 )
+ {
+ SetError( ERRCODE_BASIC_WRONG_ARGS );
+ return;
+ }
+
+ SbxVariable* pItem = pPar_->Get32(1);
+ if( pItem )
+ {
+ sal_uInt32 nNextIndex;
+ if( nCount < 4 )
+ {
+ nNextIndex = xItemArray->Count32();
+ }
+ else
+ {
+ SbxVariable* pBefore = pPar_->Get32(3);
+ if( nCount == 5 )
+ {
+ if( !( pBefore->IsErr() || ( pBefore->GetType() == SbxEMPTY ) ) )
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ SbxVariable* pAfter = pPar_->Get32(4);
+ sal_Int32 nAfterIndex = implGetIndex( pAfter );
+ if( nAfterIndex == -1 )
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ nNextIndex = sal::static_int_cast<sal_uInt32>(nAfterIndex + 1);
+ }
+ else // if( nCount == 4 )
+ {
+ sal_Int32 nBeforeIndex = implGetIndex( pBefore );
+ if( nBeforeIndex == -1 )
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ nNextIndex = sal::static_int_cast<sal_uInt32>(nBeforeIndex);
+ }
+ }
+
+ auto pNewItem = tools::make_ref<SbxVariable>( *pItem );
+ if( nCount >= 3 )
+ {
+ SbxVariable* pKey = pPar_->Get32(2);
+ if( !( pKey->IsErr() || ( pKey->GetType() == SbxEMPTY ) ) )
+ {
+ if( pKey->GetType() != SbxSTRING )
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ OUString aKey = pKey->GetOUString();
+ if( implGetIndexForName( aKey ) != -1 )
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ pNewItem->SetName( aKey );
+ }
+ }
+ pNewItem->SetFlag( SbxFlagBits::ReadWrite );
+ xItemArray->Insert32( pNewItem.get(), nNextIndex );
+ }
+ else
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+}
+
+void BasicCollection::CollItem( SbxArray* pPar_ )
+{
+ if( pPar_->Count32() != 2 )
+ {
+ SetError( ERRCODE_BASIC_WRONG_ARGS );
+ return;
+ }
+ SbxVariable* pRes = nullptr;
+ SbxVariable* p = pPar_->Get32( 1 );
+ sal_Int32 nIndex = implGetIndex( p );
+ if( nIndex >= 0 && nIndex < static_cast<sal_Int32>(xItemArray->Count32()) )
+ {
+ pRes = xItemArray->Get32( nIndex );
+ }
+ if( !pRes )
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ *(pPar_->Get32(0)) = *pRes;
+ }
+}
+
+void BasicCollection::CollRemove( SbxArray* pPar_ )
+{
+ if( pPar_ == nullptr || pPar_->Count32() != 2 )
+ {
+ SetError( ERRCODE_BASIC_WRONG_ARGS );
+ return;
+ }
+
+ SbxVariable* p = pPar_->Get32( 1 );
+ sal_Int32 nIndex = implGetIndex( p );
+ if( nIndex >= 0 && nIndex < static_cast<sal_Int32>(xItemArray->Count32()) )
+ {
+ xItemArray->Remove( nIndex );
+
+ // Correct for stack if necessary
+ SbiInstance* pInst = GetSbData()->pInst;
+ SbiRuntime* pRT = pInst ? pInst->pRun : nullptr;
+ if( pRT )
+ {
+ SbiForStack* pStack = pRT->FindForStackItemForCollection( this );
+ if( pStack != nullptr )
+ {
+ if( pStack->nCurCollectionIndex >= nIndex )
+ {
+ --pStack->nCurCollectionIndex;
+ }
+ }
+ }
+ }
+ else
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/sbintern.cxx b/basic/source/classes/sbintern.cxx
new file mode 100644
index 000000000..aaf26ee2a
--- /dev/null
+++ b/basic/source/classes/sbintern.cxx
@@ -0,0 +1,64 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sbintern.hxx>
+#include <sbunoobj.hxx>
+#include <basic/basmgr.hxx>
+
+SbiGlobals* SbiGlobals::pGlobals = nullptr;
+
+SbiGlobals* GetSbData()
+{
+ if (!SbiGlobals::pGlobals)
+ SbiGlobals::pGlobals = new SbiGlobals;
+ return SbiGlobals::pGlobals;
+}
+
+SbiGlobals::SbiGlobals()
+{
+ pInst = nullptr;
+ pSbFac = nullptr;
+ pUnoFac = nullptr;
+ pTypeFac = nullptr;
+ pClassFac = nullptr;
+ pOLEFac = nullptr;
+ pFormFac = nullptr;
+ pMod = nullptr;
+ pCompMod = nullptr; // JSM
+ nInst = 0;
+ nCode = ERRCODE_NONE;
+ nLine = 0;
+ nCol1 = nCol2 = 0;
+ bCompilerError = false;
+ bGlobalInitErr = false;
+ bRunInit = false;
+ pTransliterationWrapper = nullptr;
+ bBlockCompilerError = false;
+ pAppBasMgr = nullptr;
+ pMSOMacroRuntimLib = nullptr;
+}
+
+SbiGlobals::~SbiGlobals()
+{
+ pSbFac.reset();
+ pUnoFac.reset();
+ pTransliterationWrapper.reset();
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/sbunoobj.cxx b/basic/source/classes/sbunoobj.cxx
new file mode 100644
index 000000000..3f5da99a6
--- /dev/null
+++ b/basic/source/classes/sbunoobj.cxx
@@ -0,0 +1,4935 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#include <o3tl/any.hxx>
+#include <osl/mutex.hxx>
+#include <vcl/svapp.hxx>
+#include <vcl/errcode.hxx>
+#include <svl/hint.hxx>
+
+#include <cppuhelper/implbase.hxx>
+#include <cppuhelper/exc_hlp.hxx>
+#include <comphelper/interfacecontainer2.hxx>
+#include <comphelper/extract.hxx>
+#include <comphelper/processfactory.hxx>
+#include <cppuhelper/weakref.hxx>
+
+#include <rtl/instance.hxx>
+#include <rtl/ustrbuf.hxx>
+
+#include <com/sun/star/script/ArrayWrapper.hpp>
+#include <com/sun/star/script/CannotConvertException.hpp>
+#include <com/sun/star/script/NativeObjectWrapper.hpp>
+
+#include <com/sun/star/uno/XComponentContext.hpp>
+#include <com/sun/star/uno/DeploymentException.hpp>
+#include <com/sun/star/lang/XTypeProvider.hpp>
+#include <com/sun/star/lang/XSingleServiceFactory.hpp>
+#include <com/sun/star/lang/XMultiServiceFactory.hpp>
+#include <com/sun/star/lang/XServiceInfo.hpp>
+#include <com/sun/star/beans/PropertyAttribute.hpp>
+#include <com/sun/star/beans/PropertyConcept.hpp>
+#include <com/sun/star/beans/MethodConcept.hpp>
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/beans/theIntrospection.hpp>
+#include <com/sun/star/script/BasicErrorException.hpp>
+#include <com/sun/star/script/InvocationAdapterFactory.hpp>
+#include <com/sun/star/script/XAllListener.hpp>
+#include <com/sun/star/script/Converter.hpp>
+#include <com/sun/star/script/XDefaultProperty.hpp>
+#include <com/sun/star/script/XDirectInvocation.hpp>
+#include <com/sun/star/container/XNameAccess.hpp>
+#include <com/sun/star/container/XHierarchicalNameAccess.hpp>
+#include <com/sun/star/reflection/XIdlArray.hpp>
+#include <com/sun/star/reflection/XIdlReflection.hpp>
+#include <com/sun/star/reflection/XServiceConstructorDescription.hpp>
+#include <com/sun/star/reflection/XSingletonTypeDescription.hpp>
+#include <com/sun/star/reflection/theCoreReflection.hpp>
+#include <com/sun/star/bridge/oleautomation/NamedArgument.hpp>
+#include <com/sun/star/bridge/oleautomation/Date.hpp>
+#include <com/sun/star/bridge/oleautomation/Decimal.hpp>
+#include <com/sun/star/bridge/oleautomation/Currency.hpp>
+#include <com/sun/star/bridge/oleautomation/XAutomationObject.hpp>
+#include <com/sun/star/script/XAutomationInvocation.hpp>
+
+#include <rtlproto.hxx>
+
+#include <basic/sbstar.hxx>
+#include <basic/sbuno.hxx>
+#include <basic/sberrors.hxx>
+#include <sbunoobj.hxx>
+#include <sbintern.hxx>
+#include <runtime.hxx>
+
+#include <algorithm>
+#include <math.h>
+#include <memory>
+#include <unordered_map>
+#include <com/sun/star/reflection/XTypeDescriptionEnumerationAccess.hpp>
+#include <com/sun/star/reflection/XConstantsTypeDescription.hpp>
+
+using com::sun::star::uno::Reference;
+using namespace com::sun::star::uno;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::reflection;
+using namespace com::sun::star::beans;
+using namespace com::sun::star::script;
+using namespace com::sun::star::container;
+using namespace com::sun::star::bridge;
+using namespace cppu;
+
+
+// Identifiers for creating the strings for dbg_Properties
+static char const ID_DBG_SUPPORTEDINTERFACES[] = "Dbg_SupportedInterfaces";
+static char const ID_DBG_PROPERTIES[] = "Dbg_Properties";
+static char const ID_DBG_METHODS[] = "Dbg_Methods";
+
+static char const aSeqLevelStr[] = "[]";
+
+// Gets the default property for a uno object. Note: There is some
+// redirection built in. The property name specifies the name
+// of the default property.
+
+bool SbUnoObject::getDefaultPropName( SbUnoObject const * pUnoObj, OUString& sDfltProp )
+{
+ bool bResult = false;
+ Reference< XDefaultProperty> xDefaultProp( pUnoObj->maTmpUnoObj, UNO_QUERY );
+ if ( xDefaultProp.is() )
+ {
+ sDfltProp = xDefaultProp->getDefaultPropertyName();
+ if ( !sDfltProp.isEmpty() )
+ bResult = true;
+ }
+ return bResult;
+}
+
+SbxVariable* getDefaultProp( SbxVariable* pRef )
+{
+ SbxVariable* pDefaultProp = nullptr;
+ if ( pRef->GetType() == SbxOBJECT )
+ {
+ SbxObject* pObj = dynamic_cast<SbxObject*>(pRef);
+ if (!pObj)
+ {
+ SbxBase* pObjVarObj = pRef->GetObject();
+ pObj = dynamic_cast<SbxObject*>( pObjVarObj );
+ }
+ if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
+ {
+ pDefaultProp = pUnoObj->GetDfltProperty();
+ }
+ }
+ return pDefaultProp;
+}
+
+void SetSbUnoObjectDfltPropName( SbxObject* pObj )
+{
+ SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
+ if ( pUnoObj )
+ {
+ OUString sDfltPropName;
+
+ if ( SbUnoObject::getDefaultPropName( pUnoObj, sDfltPropName ) )
+ {
+ pUnoObj->SetDfltProperty( sDfltPropName );
+ }
+ }
+}
+
+// save CoreReflection statically
+static Reference< XIdlReflection > getCoreReflection_Impl()
+{
+ return css::reflection::theCoreReflection::get(
+ comphelper::getProcessComponentContext());
+}
+
+// save CoreReflection statically
+static Reference< XHierarchicalNameAccess > const & getCoreReflection_HierarchicalNameAccess_Impl()
+{
+ static Reference< XHierarchicalNameAccess > xCoreReflection_HierarchicalNameAccess;
+
+ if( !xCoreReflection_HierarchicalNameAccess.is() )
+ {
+ Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
+ if( xCoreReflection.is() )
+ {
+ xCoreReflection_HierarchicalNameAccess =
+ Reference< XHierarchicalNameAccess >( xCoreReflection, UNO_QUERY );
+ }
+ }
+ return xCoreReflection_HierarchicalNameAccess;
+}
+
+// Hold TypeProvider statically
+static Reference< XHierarchicalNameAccess > const & getTypeProvider_Impl()
+{
+ static Reference< XHierarchicalNameAccess > xAccess;
+
+ // Do we have already CoreReflection; if not obtain it
+ if( !xAccess.is() )
+ {
+ Reference< XComponentContext > xContext(
+ comphelper::getProcessComponentContext() );
+ if( xContext.is() )
+ {
+ xContext->getValueByName(
+ "/singletons/com.sun.star.reflection.theTypeDescriptionManager" )
+ >>= xAccess;
+ OSL_ENSURE( xAccess.is(), "### TypeDescriptionManager singleton not accessible!?" );
+ }
+ if( !xAccess.is() )
+ {
+ throw DeploymentException(
+ "/singletons/com.sun.star.reflection.theTypeDescriptionManager singleton not accessible" );
+ }
+ }
+ return xAccess;
+}
+
+// Hold TypeConverter statically
+static Reference< XTypeConverter > const & getTypeConverter_Impl()
+{
+ static Reference< XTypeConverter > xTypeConverter;
+
+ // Do we have already CoreReflection; if not obtain it
+ if( !xTypeConverter.is() )
+ {
+ Reference< XComponentContext > xContext(
+ comphelper::getProcessComponentContext() );
+ if( xContext.is() )
+ {
+ xTypeConverter = Converter::create(xContext);
+ }
+ if( !xTypeConverter.is() )
+ {
+ throw DeploymentException(
+ "com.sun.star.script.Converter service not accessible" );
+ }
+ }
+ return xTypeConverter;
+}
+
+
+// #111851 factory function to create an OLE object
+SbUnoObject* createOLEObject_Impl( const OUString& aType )
+{
+ static Reference< XMultiServiceFactory > xOLEFactory;
+ static bool bNeedsInit = true;
+
+ if( bNeedsInit )
+ {
+ bNeedsInit = false;
+
+ Reference< XComponentContext > xContext( comphelper::getProcessComponentContext() );
+ if( xContext.is() )
+ {
+ Reference<XMultiComponentFactory> xSMgr = xContext->getServiceManager();
+ xOLEFactory.set(
+ xSMgr->createInstanceWithContext( "com.sun.star.bridge.OleObjectFactory", xContext ),
+ UNO_QUERY );
+ }
+ }
+
+ SbUnoObject* pUnoObj = nullptr;
+ if( xOLEFactory.is() )
+ {
+ // some type names available in VBA can not be directly used in COM
+ OUString aOLEType = aType;
+ if ( aOLEType == "SAXXMLReader30" )
+ {
+ aOLEType = "Msxml2.SAXXMLReader.3.0";
+ }
+ Reference< XInterface > xOLEObject = xOLEFactory->createInstance( aOLEType );
+ if( xOLEObject.is() )
+ {
+ pUnoObj = new SbUnoObject( aType, Any(xOLEObject) );
+ OUString sDfltPropName;
+
+ if ( SbUnoObject::getDefaultPropName( pUnoObj, sDfltPropName ) )
+ pUnoObj->SetDfltProperty( sDfltPropName );
+ }
+ }
+ return pUnoObj;
+}
+
+
+namespace
+{
+ void lcl_indent( OUStringBuffer& _inout_rBuffer, sal_Int32 _nLevel )
+ {
+ while ( _nLevel-- > 0 )
+ {
+ _inout_rBuffer.append( " " );
+ }
+ }
+}
+
+static void implAppendExceptionMsg( OUStringBuffer& _inout_rBuffer, const Exception& _e, const OUString& _rExceptionType, sal_Int32 _nLevel )
+{
+ _inout_rBuffer.append( "\n" );
+ lcl_indent( _inout_rBuffer, _nLevel );
+ _inout_rBuffer.append( "Type: " );
+
+ if ( _rExceptionType.isEmpty() )
+ _inout_rBuffer.append( "Unknown" );
+ else
+ _inout_rBuffer.append( _rExceptionType );
+
+ _inout_rBuffer.append( "\n" );
+ lcl_indent( _inout_rBuffer, _nLevel );
+ _inout_rBuffer.append( "Message: " );
+ _inout_rBuffer.append( _e.Message );
+
+}
+
+// construct an error message for the exception
+static OUString implGetExceptionMsg( const Exception& e, const OUString& aExceptionType_ )
+{
+ OUStringBuffer aMessageBuf;
+ implAppendExceptionMsg( aMessageBuf, e, aExceptionType_, 0 );
+ return aMessageBuf.makeStringAndClear();
+}
+
+static OUString implGetExceptionMsg( const Any& _rCaughtException )
+{
+ auto e = o3tl::tryAccess<Exception>(_rCaughtException);
+ OSL_PRECOND( e, "implGetExceptionMsg: illegal argument!" );
+ if ( !e )
+ {
+ return OUString();
+ }
+ return implGetExceptionMsg( *e, _rCaughtException.getValueTypeName() );
+}
+
+static Any convertAny( const Any& rVal, const Type& aDestType )
+{
+ Any aConvertedVal;
+ const Reference< XTypeConverter >& xConverter = getTypeConverter_Impl();
+ try
+ {
+ aConvertedVal = xConverter->convertTo( rVal, aDestType );
+ }
+ catch( const IllegalArgumentException& )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
+ implGetExceptionMsg( ::cppu::getCaughtException() ) );
+ return aConvertedVal;
+ }
+ catch( const CannotConvertException& e2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
+ implGetExceptionMsg( e2, "com.sun.star.lang.IllegalArgumentException" ) );
+ return aConvertedVal;
+ }
+ return aConvertedVal;
+}
+
+
+// #105565 Special Object to wrap a strongly typed Uno Any
+
+
+// TODO: source out later
+static Reference<XIdlClass> TypeToIdlClass( const Type& rType )
+{
+ return getCoreReflection_Impl()->forName(rType.getTypeName());
+}
+
+// Exception type unknown
+template< class EXCEPTION >
+static OUString implGetExceptionMsg( const EXCEPTION& e )
+{
+ return implGetExceptionMsg( e, cppu::UnoType<decltype(e)>::get().getTypeName() );
+}
+
+static void implHandleBasicErrorException( BasicErrorException const & e )
+{
+ ErrCode nError = StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(e.ErrorCode) );
+ StarBASIC::Error( nError, e.ErrorMessageArgument );
+}
+
+static void implHandleWrappedTargetException( const Any& _rWrappedTargetException )
+{
+ Any aExamine( _rWrappedTargetException );
+
+ // completely strip the first InvocationTargetException, its error message isn't of any
+ // interest to the user, it just says something like "invoking the UNO method went wrong.".
+ InvocationTargetException aInvocationError;
+ if ( aExamine >>= aInvocationError )
+ aExamine = aInvocationError.TargetException;
+
+ BasicErrorException aBasicError;
+
+ ErrCode nError( ERRCODE_BASIC_EXCEPTION );
+ OUStringBuffer aMessageBuf;
+
+ // strip any other WrappedTargetException instances, but this time preserve the error messages.
+ WrappedTargetException aWrapped;
+ sal_Int32 nLevel = 0;
+ while ( aExamine >>= aWrapped )
+ {
+ // special handling for BasicErrorException errors
+ if ( aWrapped.TargetException >>= aBasicError )
+ {
+ nError = StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(aBasicError.ErrorCode) );
+ aMessageBuf.append( aBasicError.ErrorMessageArgument );
+ aExamine.clear();
+ break;
+ }
+
+ // append this round's message
+ implAppendExceptionMsg( aMessageBuf, aWrapped, aExamine.getValueTypeName(), nLevel );
+ if ( aWrapped.TargetException.getValueTypeClass() == TypeClass_EXCEPTION )
+ // there is a next chain element
+ aMessageBuf.append( "\nTargetException:" );
+
+ // next round
+ aExamine = aWrapped.TargetException;
+ ++nLevel;
+ }
+
+ if ( auto e = o3tl::tryAccess<Exception>(aExamine) )
+ {
+ // the last element in the chain is still an exception, but no WrappedTargetException
+ implAppendExceptionMsg( aMessageBuf, *e, aExamine.getValueTypeName(), nLevel );
+ }
+
+ StarBASIC::Error( nError, aMessageBuf.makeStringAndClear() );
+}
+
+static void implHandleAnyException( const Any& _rCaughtException )
+{
+ BasicErrorException aBasicError;
+ WrappedTargetException aWrappedError;
+
+ if ( _rCaughtException >>= aBasicError )
+ {
+ implHandleBasicErrorException( aBasicError );
+ }
+ else if ( _rCaughtException >>= aWrappedError )
+ {
+ implHandleWrappedTargetException( _rCaughtException );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( _rCaughtException ) );
+ }
+}
+
+namespace {
+
+// NativeObjectWrapper handling
+struct ObjectItem
+{
+ SbxObjectRef m_xNativeObj;
+
+ explicit ObjectItem( SbxObject* pNativeObj )
+ : m_xNativeObj( pNativeObj )
+ {}
+};
+
+}
+
+typedef std::vector< ObjectItem > NativeObjectWrapperVector;
+
+namespace {
+
+class GaNativeObjectWrapperVector : public rtl::Static<NativeObjectWrapperVector, GaNativeObjectWrapperVector> {};
+
+}
+
+void clearNativeObjectWrapperVector()
+{
+ GaNativeObjectWrapperVector::get().clear();
+}
+
+static sal_uInt32 lcl_registerNativeObjectWrapper( SbxObject* pNativeObj )
+{
+ NativeObjectWrapperVector &rNativeObjectWrapperVector = GaNativeObjectWrapperVector::get();
+ sal_uInt32 nIndex = rNativeObjectWrapperVector.size();
+ rNativeObjectWrapperVector.emplace_back( pNativeObj );
+ return nIndex;
+}
+
+static SbxObject* lcl_getNativeObject( sal_uInt32 nIndex )
+{
+ SbxObjectRef xRetObj;
+ NativeObjectWrapperVector &rNativeObjectWrapperVector = GaNativeObjectWrapperVector::get();
+ if( nIndex < rNativeObjectWrapperVector.size() )
+ {
+ ObjectItem& rItem = rNativeObjectWrapperVector[ nIndex ];
+ xRetObj = rItem.m_xNativeObj;
+ }
+ return xRetObj.get();
+}
+
+// convert from Uno to Sbx
+static SbxDataType unoToSbxType( TypeClass eType )
+{
+ SbxDataType eRetType = SbxVOID;
+
+ switch( eType )
+ {
+ case TypeClass_INTERFACE:
+ case TypeClass_TYPE:
+ case TypeClass_STRUCT:
+ case TypeClass_EXCEPTION: eRetType = SbxOBJECT; break;
+
+ case TypeClass_ENUM: eRetType = SbxLONG; break;
+ case TypeClass_SEQUENCE:
+ eRetType = SbxDataType( SbxOBJECT | SbxARRAY );
+ break;
+
+
+ case TypeClass_ANY: eRetType = SbxVARIANT; break;
+ case TypeClass_BOOLEAN: eRetType = SbxBOOL; break;
+ case TypeClass_CHAR: eRetType = SbxCHAR; break;
+ case TypeClass_STRING: eRetType = SbxSTRING; break;
+ case TypeClass_FLOAT: eRetType = SbxSINGLE; break;
+ case TypeClass_DOUBLE: eRetType = SbxDOUBLE; break;
+ case TypeClass_BYTE: eRetType = SbxINTEGER; break;
+ case TypeClass_SHORT: eRetType = SbxINTEGER; break;
+ case TypeClass_LONG: eRetType = SbxLONG; break;
+ case TypeClass_HYPER: eRetType = SbxSALINT64; break;
+ case TypeClass_UNSIGNED_SHORT: eRetType = SbxUSHORT; break;
+ case TypeClass_UNSIGNED_LONG: eRetType = SbxULONG; break;
+ case TypeClass_UNSIGNED_HYPER: eRetType = SbxSALUINT64;break;
+ default: break;
+ }
+ return eRetType;
+}
+
+static SbxDataType unoToSbxType( const Reference< XIdlClass >& xIdlClass )
+{
+ SbxDataType eRetType = SbxVOID;
+ if( xIdlClass.is() )
+ {
+ TypeClass eType = xIdlClass->getTypeClass();
+ eRetType = unoToSbxType( eType );
+ }
+ return eRetType;
+}
+
+static void implSequenceToMultiDimArray( SbxDimArray*& pArray, Sequence< sal_Int32 >& indices, Sequence< sal_Int32 >& sizes, const Any& aValue, sal_Int32 dimension, bool bIsZeroIndex, Type const * pType )
+{
+ const Type& aType = aValue.getValueType();
+ TypeClass eTypeClass = aType.getTypeClass();
+
+ sal_Int32 dimCopy = dimension;
+
+ if ( eTypeClass == TypeClass_SEQUENCE )
+ {
+ Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aType );
+ Reference< XIdlArray > xIdlArray = xIdlTargetClass->getArray();
+ typelib_TypeDescription * pTD = nullptr;
+ aType.getDescription( &pTD );
+ Type aElementType( reinterpret_cast<typelib_IndirectTypeDescription *>(pTD)->pType );
+ ::typelib_typedescription_release( pTD );
+
+ sal_Int32 nLen = xIdlArray->getLen( aValue );
+ for ( sal_Int32 index = 0; index < nLen; ++index )
+ {
+ Any aElementAny = xIdlArray->get( aValue, static_cast<sal_uInt32>(index) );
+ // This detects the dimension were currently processing
+ if ( dimCopy == dimension )
+ {
+ ++dimCopy;
+ if ( sizes.getLength() < dimCopy )
+ {
+ sizes.realloc( sizes.getLength() + 1 );
+ sizes[ sizes.getLength() - 1 ] = nLen;
+ indices.realloc( indices.getLength() + 1 );
+ }
+ }
+
+ if ( bIsZeroIndex )
+ indices[ dimCopy - 1 ] = index;
+ else
+ indices[ dimCopy - 1] = index + 1;
+
+ implSequenceToMultiDimArray( pArray, indices, sizes, aElementAny, dimCopy, bIsZeroIndex, &aElementType );
+ }
+
+ }
+ else
+ {
+ if ( !indices.hasElements() )
+ {
+ // Should never ever get here ( indices.getLength()
+ // should equal number of dimensions in the array )
+ // And that should at least be 1 !
+ // #QUESTION is there a better error?
+ StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT );
+ return;
+ }
+
+ SbxDataType eSbxElementType = unoToSbxType( pType ? pType->getTypeClass() : aValue.getValueTypeClass() );
+ if ( !pArray )
+ {
+ pArray = new SbxDimArray( eSbxElementType );
+ sal_Int32 nIndexLen = indices.getLength();
+
+ // Dimension the array
+ for ( sal_Int32 index = 0; index < nIndexLen; ++index )
+ {
+ if ( bIsZeroIndex )
+ pArray->unoAddDim32( 0, sizes[ index ] - 1);
+ else
+ pArray->unoAddDim32( 1, sizes[ index ] );
+
+ }
+ }
+
+ if ( pArray )
+ {
+ auto xVar = tools::make_ref<SbxVariable>( eSbxElementType );
+ unoToSbxValue( xVar.get(), aValue );
+
+ sal_Int32* pIndices = indices.getArray();
+ pArray->Put32( xVar.get(), pIndices );
+
+ }
+ }
+}
+
+void unoToSbxValue( SbxVariable* pVar, const Any& aValue )
+{
+ const Type& aType = aValue.getValueType();
+ TypeClass eTypeClass = aType.getTypeClass();
+ switch( eTypeClass )
+ {
+ case TypeClass_TYPE:
+ {
+ // Map Type to IdlClass
+ Type aType_;
+ aValue >>= aType_;
+ Reference<XIdlClass> xClass = TypeToIdlClass( aType_ );
+ Any aClassAny;
+ aClassAny <<= xClass;
+
+ // instantiate SbUnoObject
+ SbUnoObject* pSbUnoObject = new SbUnoObject( OUString(), aClassAny );
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(pSbUnoObject);
+
+ // If the object is invalid deliver null
+ if( !pSbUnoObject->getUnoAny().hasValue() )
+ {
+ pVar->PutObject( nullptr );
+ }
+ else
+ {
+ pVar->PutObject( xWrapper.get() );
+ }
+ }
+ break;
+ // Interfaces and Structs must be wrapped in a SbUnoObject
+ case TypeClass_INTERFACE:
+ case TypeClass_STRUCT:
+ case TypeClass_EXCEPTION:
+ {
+ if( eTypeClass == TypeClass_STRUCT )
+ {
+ ArrayWrapper aWrap;
+ NativeObjectWrapper aNativeObjectWrapper;
+ if ( aValue >>= aWrap )
+ {
+ SbxDimArray* pArray = nullptr;
+ Sequence< sal_Int32 > indices;
+ Sequence< sal_Int32 > sizes;
+ implSequenceToMultiDimArray( pArray, indices, sizes, aWrap.Array, /*dimension*/0, aWrap.IsZeroIndex, nullptr );
+ if ( pArray )
+ {
+ SbxDimArrayRef xArray = pArray;
+ SbxFlagBits nFlags = pVar->GetFlags();
+ pVar->ResetFlag( SbxFlagBits::Fixed );
+ pVar->PutObject( xArray.get() );
+ pVar->SetFlags( nFlags );
+ }
+ else
+ pVar->PutEmpty();
+ break;
+ }
+ else if ( aValue >>= aNativeObjectWrapper )
+ {
+ sal_uInt32 nIndex = 0;
+ if( aNativeObjectWrapper.ObjectId >>= nIndex )
+ {
+ SbxObject* pObj = lcl_getNativeObject( nIndex );
+ pVar->PutObject( pObj );
+ }
+ else
+ pVar->PutEmpty();
+ break;
+ }
+ else
+ {
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst && pInst->IsCompatibility() )
+ {
+ oleautomation::Date aDate;
+ if( aValue >>= aDate )
+ {
+ pVar->PutDate( aDate.Value );
+ break;
+ }
+ else
+ {
+ oleautomation::Decimal aDecimal;
+ if( aValue >>= aDecimal )
+ {
+ pVar->PutDecimal( aDecimal );
+ break;
+ }
+ else
+ {
+ oleautomation::Currency aCurrency;
+ if( aValue >>= aCurrency )
+ {
+ pVar->PutCurrency( aCurrency.Value );
+ break;
+ }
+ }
+ }
+ }
+ }
+ }
+ // instantiate a SbUnoObject
+ SbUnoObject* pSbUnoObject = new SbUnoObject( OUString(), aValue );
+ //If this is called externally e.g. from the scripting
+ //framework then there is no 'active' runtime the default property will not be set up
+ //only a vba object will have XDefaultProp set anyway so... this
+ //test seems a bit of overkill
+ //if ( SbiRuntime::isVBAEnabled() )
+ {
+ OUString sDfltPropName;
+
+ if ( SbUnoObject::getDefaultPropName( pSbUnoObject, sDfltPropName ) )
+ {
+ pSbUnoObject->SetDfltProperty( sDfltPropName );
+ }
+ }
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(pSbUnoObject);
+
+ // If the object is invalid deliver null
+ if( !pSbUnoObject->getUnoAny().hasValue() )
+ {
+ pVar->PutObject( nullptr );
+ }
+ else
+ {
+ pVar->PutObject( xWrapper.get() );
+ }
+ }
+ break;
+
+
+ case TypeClass_ENUM:
+ {
+ sal_Int32 nEnum = 0;
+ enum2int( nEnum, aValue );
+ pVar->PutLong( nEnum );
+ }
+ break;
+
+ case TypeClass_SEQUENCE:
+ {
+ Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aType );
+ Reference< XIdlArray > xIdlArray = xIdlTargetClass->getArray();
+ sal_Int32 i, nLen = xIdlArray->getLen( aValue );
+
+ typelib_TypeDescription * pTD = nullptr;
+ aType.getDescription( &pTD );
+ assert( pTD && pTD->eTypeClass == typelib_TypeClass_SEQUENCE );
+ Type aElementType( reinterpret_cast<typelib_IndirectTypeDescription *>(pTD)->pType );
+ ::typelib_typedescription_release( pTD );
+
+ // build an Array in Basic
+ SbxDimArrayRef xArray;
+ SbxDataType eSbxElementType = unoToSbxType( aElementType.getTypeClass() );
+ xArray = new SbxDimArray( eSbxElementType );
+ if( nLen > 0 )
+ {
+ xArray->unoAddDim32( 0, nLen - 1 );
+
+ // register the elements as variables
+ for( i = 0 ; i < nLen ; i++ )
+ {
+ // convert elements
+ Any aElementAny = xIdlArray->get( aValue, static_cast<sal_uInt32>(i) );
+ auto xVar = tools::make_ref<SbxVariable>( eSbxElementType );
+ unoToSbxValue( xVar.get(), aElementAny );
+
+ // put into the Array
+ xArray->Put32( xVar.get(), &i );
+ }
+ }
+ else
+ {
+ xArray->unoAddDim32( 0, -1 );
+ }
+
+ // return the Array
+ SbxFlagBits nFlags = pVar->GetFlags();
+ pVar->ResetFlag( SbxFlagBits::Fixed );
+ pVar->PutObject( xArray.get() );
+ pVar->SetFlags( nFlags );
+
+ }
+ break;
+
+
+ case TypeClass_BOOLEAN: pVar->PutBool( *o3tl::forceAccess<bool>(aValue) ); break;
+ case TypeClass_CHAR:
+ {
+ pVar->PutChar( *o3tl::forceAccess<sal_Unicode>(aValue) );
+ break;
+ }
+ case TypeClass_STRING: { OUString val; aValue >>= val; pVar->PutString( val ); } break;
+ case TypeClass_FLOAT: { float val = 0; aValue >>= val; pVar->PutSingle( val ); } break;
+ case TypeClass_DOUBLE: { double val = 0; aValue >>= val; pVar->PutDouble( val ); } break;
+ case TypeClass_BYTE: { sal_Int8 val = 0; aValue >>= val; pVar->PutInteger( val ); } break;
+ case TypeClass_SHORT: { sal_Int16 val = 0; aValue >>= val; pVar->PutInteger( val ); } break;
+ case TypeClass_LONG: { sal_Int32 val = 0; aValue >>= val; pVar->PutLong( val ); } break;
+ case TypeClass_HYPER: { sal_Int64 val = 0; aValue >>= val; pVar->PutInt64( val ); } break;
+ case TypeClass_UNSIGNED_SHORT: { sal_uInt16 val = 0; aValue >>= val; pVar->PutUShort( val ); } break;
+ case TypeClass_UNSIGNED_LONG: { sal_uInt32 val = 0; aValue >>= val; pVar->PutULong( val ); } break;
+ case TypeClass_UNSIGNED_HYPER: { sal_uInt64 val = 0; aValue >>= val; pVar->PutUInt64( val ); } break;
+ default: pVar->PutEmpty(); break;
+ }
+}
+
+// Deliver the reflection for Sbx types
+static Type getUnoTypeForSbxBaseType( SbxDataType eType )
+{
+ Type aRetType = cppu::UnoType<void>::get();
+ switch( eType )
+ {
+ case SbxNULL: aRetType = cppu::UnoType<XInterface>::get(); break;
+ case SbxINTEGER: aRetType = cppu::UnoType<sal_Int16>::get(); break;
+ case SbxLONG: aRetType = cppu::UnoType<sal_Int32>::get(); break;
+ case SbxSINGLE: aRetType = cppu::UnoType<float>::get(); break;
+ case SbxDOUBLE: aRetType = cppu::UnoType<double>::get(); break;
+ case SbxCURRENCY: aRetType = cppu::UnoType<oleautomation::Currency>::get(); break;
+ case SbxDECIMAL: aRetType = cppu::UnoType<oleautomation::Decimal>::get(); break;
+ case SbxDATE: {
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst && pInst->IsCompatibility() )
+ aRetType = cppu::UnoType<double>::get();
+ else
+ aRetType = cppu::UnoType<oleautomation::Date>::get();
+ }
+ break;
+ case SbxSTRING: aRetType = cppu::UnoType<OUString>::get(); break;
+ case SbxBOOL: aRetType = cppu::UnoType<sal_Bool>::get(); break;
+ case SbxVARIANT: aRetType = cppu::UnoType<Any>::get(); break;
+ case SbxCHAR: aRetType = cppu::UnoType<cppu::UnoCharType>::get(); break;
+ case SbxBYTE: aRetType = cppu::UnoType<sal_Int8>::get(); break;
+ case SbxUSHORT: aRetType = cppu::UnoType<cppu::UnoUnsignedShortType>::get(); break;
+ case SbxULONG: aRetType = ::cppu::UnoType<sal_uInt32>::get(); break;
+ // map machine-dependent ones to long for consistency
+ case SbxINT: aRetType = ::cppu::UnoType<sal_Int32>::get(); break;
+ case SbxUINT: aRetType = ::cppu::UnoType<sal_uInt32>::get(); break;
+ default: break;
+ }
+ return aRetType;
+}
+
+// Converting of Sbx to Uno without a know target class for TypeClass_ANY
+static Type getUnoTypeForSbxValue( const SbxValue* pVal )
+{
+ Type aRetType = cppu::UnoType<void>::get();
+ if( !pVal )
+ return aRetType;
+
+ // convert SbxType to Uno
+ SbxDataType eBaseType = pVal->SbxValue::GetType();
+ if( eBaseType == SbxOBJECT )
+ {
+ SbxBaseRef xObj = pVal->GetObject();
+ if( !xObj.is() )
+ {
+ aRetType = cppu::UnoType<XInterface>::get();
+ return aRetType;
+ }
+
+ if( auto pArray = dynamic_cast<SbxDimArray*>( xObj.get() ) )
+ {
+ sal_Int32 nDims = pArray->GetDims32();
+ Type aElementType = getUnoTypeForSbxBaseType( static_cast<SbxDataType>(pArray->GetType() & 0xfff) );
+ TypeClass eElementTypeClass = aElementType.getTypeClass();
+
+ // Normal case: One dimensional array
+ sal_Int32 nLower, nUpper;
+ if( nDims == 1 && pArray->GetDim32( 1, nLower, nUpper ) )
+ {
+ if( eElementTypeClass == TypeClass_VOID || eElementTypeClass == TypeClass_ANY )
+ {
+ // If all elements of the arrays are from the same type, take
+ // this one - otherwise the whole will be considered as Any-Sequence
+ bool bNeedsInit = true;
+
+ for (sal_Int32 aIdx[1] = { nLower }; aIdx[0] <= nUpper; ++aIdx[0])
+ {
+ SbxVariableRef xVar = pArray->Get32(aIdx);
+ Type aType = getUnoTypeForSbxValue( xVar.get() );
+ if( bNeedsInit )
+ {
+ if( aType.getTypeClass() == TypeClass_VOID )
+ {
+ // if only first element is void: different types -> []any
+ // if all elements are void: []void is not allowed -> []any
+ aElementType = cppu::UnoType<Any>::get();
+ break;
+ }
+ aElementType = aType;
+ bNeedsInit = false;
+ }
+ else if( aElementType != aType )
+ {
+ // different types -> AnySequence
+ aElementType = cppu::UnoType<Any>::get();
+ break;
+ }
+ }
+ }
+
+ OUString aSeqTypeName = aSeqLevelStr + aElementType.getTypeName();
+ aRetType = Type( TypeClass_SEQUENCE, aSeqTypeName );
+ }
+ // #i33795 Map also multi dimensional arrays to corresponding sequences
+ else if( nDims > 1 )
+ {
+ if( eElementTypeClass == TypeClass_VOID || eElementTypeClass == TypeClass_ANY )
+ {
+ // For this check the array's dim structure does not matter
+ sal_uInt32 nFlatArraySize = pArray->Count32();
+
+ bool bNeedsInit = true;
+ for( sal_uInt32 i = 0 ; i < nFlatArraySize ; i++ )
+ {
+ SbxVariableRef xVar = pArray->SbxArray::Get32( i );
+ Type aType = getUnoTypeForSbxValue( xVar.get() );
+ if( bNeedsInit )
+ {
+ if( aType.getTypeClass() == TypeClass_VOID )
+ {
+ // if only first element is void: different types -> []any
+ // if all elements are void: []void is not allowed -> []any
+ aElementType = cppu::UnoType<Any>::get();
+ break;
+ }
+ aElementType = aType;
+ bNeedsInit = false;
+ }
+ else if( aElementType != aType )
+ {
+ // different types -> AnySequence
+ aElementType = cppu::UnoType<Any>::get();
+ break;
+ }
+ }
+ }
+
+ OUStringBuffer aSeqTypeName;
+ for(sal_Int32 iDim = 0 ; iDim < nDims ; iDim++ )
+ {
+ aSeqTypeName.append(aSeqLevelStr);
+ }
+ aSeqTypeName.append(aElementType.getTypeName());
+ aRetType = Type( TypeClass_SEQUENCE, aSeqTypeName.makeStringAndClear() );
+ }
+ }
+ // No array, but ...
+ else if( auto obj = dynamic_cast<SbUnoObject*>( xObj.get() ) )
+ {
+ aRetType = obj->getUnoAny().getValueType();
+ }
+ // SbUnoAnyObject?
+ else if( auto any = dynamic_cast<SbUnoAnyObject*>( xObj.get() ) )
+ {
+ aRetType = any->getValue().getValueType();
+ }
+ // Otherwise it is a No-Uno-Basic-Object -> default==deliver void
+ }
+ // No object, convert basic type
+ else
+ {
+ aRetType = getUnoTypeForSbxBaseType( eBaseType );
+ }
+ return aRetType;
+}
+
+// converting of Sbx to Uno without known target class for TypeClass_ANY
+static Any sbxToUnoValueImpl( const SbxValue* pVar, bool bBlockConversionToSmallestType = false )
+{
+ SbxDataType eBaseType = pVar->SbxValue::GetType();
+ if( eBaseType == SbxOBJECT )
+ {
+ SbxBaseRef xObj = pVar->GetObject();
+ if( xObj.is() )
+ {
+ if( auto obj = dynamic_cast<SbUnoAnyObject*>( xObj.get() ) )
+ return obj->getValue();
+ if( auto pClassModuleObj = dynamic_cast<SbClassModuleObject*>( xObj.get() ) )
+ {
+ Any aRetAny;
+ SbModule* pClassModule = pClassModuleObj->getClassModule();
+ if( pClassModule->createCOMWrapperForIface( aRetAny, pClassModuleObj ) )
+ return aRetAny;
+ }
+ if( dynamic_cast<const SbUnoObject*>( xObj.get() ) == nullptr )
+ {
+ // Create NativeObjectWrapper to identify object in case of callbacks
+ SbxObject* pObj = dynamic_cast<SbxObject*>( pVar->GetObject() );
+ if( pObj != nullptr )
+ {
+ NativeObjectWrapper aNativeObjectWrapper;
+ sal_uInt32 nIndex = lcl_registerNativeObjectWrapper( pObj );
+ aNativeObjectWrapper.ObjectId <<= nIndex;
+ Any aRetAny;
+ aRetAny <<= aNativeObjectWrapper;
+ return aRetAny;
+ }
+ }
+ }
+ }
+
+ Type aType = getUnoTypeForSbxValue( pVar );
+ TypeClass eType = aType.getTypeClass();
+
+ if( !bBlockConversionToSmallestType )
+ {
+ // #79615 Choose "smallest" representation for int values
+ // because up cast is allowed, downcast not
+ switch( eType )
+ {
+ case TypeClass_FLOAT:
+ case TypeClass_DOUBLE:
+ {
+ double d = pVar->GetDouble();
+ if( rtl::math::approxEqual(d, floor( d )) )
+ {
+ if( d >= -128 && d <= 127 )
+ aType = ::cppu::UnoType<sal_Int8>::get();
+ else if( d >= SbxMININT && d <= SbxMAXINT )
+ aType = ::cppu::UnoType<sal_Int16>::get();
+ else if( d >= -SbxMAXLNG && d <= SbxMAXLNG )
+ aType = ::cppu::UnoType<sal_Int32>::get();
+ }
+ break;
+ }
+ case TypeClass_SHORT:
+ {
+ sal_Int16 n = pVar->GetInteger();
+ if( n >= -128 && n <= 127 )
+ aType = ::cppu::UnoType<sal_Int8>::get();
+ break;
+ }
+ case TypeClass_LONG:
+ {
+ sal_Int32 n = pVar->GetLong();
+ if( n >= -128 && n <= 127 )
+ aType = ::cppu::UnoType<sal_Int8>::get();
+ else if( n >= SbxMININT && n <= SbxMAXINT )
+ aType = ::cppu::UnoType<sal_Int16>::get();
+ break;
+ }
+ case TypeClass_UNSIGNED_SHORT:
+ {
+ sal_uInt16 n = pVar->GetUShort();
+ if( n <= 255 )
+ aType = cppu::UnoType<sal_uInt8>::get();
+ break;
+ }
+ case TypeClass_UNSIGNED_LONG:
+ {
+ sal_uInt32 n = pVar->GetLong();
+ if( n <= 255 )
+ aType = cppu::UnoType<sal_uInt8>::get();
+ else if( n <= SbxMAXUINT )
+ aType = cppu::UnoType<cppu::UnoUnsignedShortType>::get();
+ break;
+ }
+ // TODO: need to add hyper types ?
+ default: break;
+ }
+ }
+
+ return sbxToUnoValue( pVar, aType );
+}
+
+
+// Helper function for StepREDIMP
+static Any implRekMultiDimArrayToSequence( SbxDimArray* pArray,
+ const Type& aElemType, sal_Int32 nMaxDimIndex, sal_Int32 nActualDim,
+ sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
+{
+ sal_Int32 nSeqLevel = nMaxDimIndex - nActualDim + 1;
+ OUStringBuffer aSeqTypeName;
+ sal_Int32 i;
+ for( i = 0 ; i < nSeqLevel ; i++ )
+ {
+ aSeqTypeName.append(aSeqLevelStr);
+ }
+ aSeqTypeName.append(aElemType.getTypeName());
+ Type aSeqType( TypeClass_SEQUENCE, aSeqTypeName.makeStringAndClear() );
+
+ // Create Sequence instance
+ Any aRetVal;
+ Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( aSeqType );
+ xIdlTargetClass->createObject( aRetVal );
+
+ // Alloc sequence according to array bounds
+ sal_Int32 nUpper = pUpperBounds[nActualDim];
+ sal_Int32 nLower = pLowerBounds[nActualDim];
+ sal_Int32 nSeqSize = nUpper - nLower + 1;
+ Reference< XIdlArray > xArray = xIdlTargetClass->getArray();
+ xArray->realloc( aRetVal, nSeqSize );
+
+ sal_Int32& ri = pActualIndices[nActualDim];
+
+ for( ri = nLower,i = 0 ; ri <= nUpper ; ri++,i++ )
+ {
+ Any aElementVal;
+
+ if( nActualDim < nMaxDimIndex )
+ {
+ aElementVal = implRekMultiDimArrayToSequence( pArray, aElemType,
+ nMaxDimIndex, nActualDim + 1, pActualIndices, pLowerBounds, pUpperBounds );
+ }
+ else
+ {
+ SbxVariable* pSource = pArray->Get32( pActualIndices );
+ aElementVal = sbxToUnoValue( pSource, aElemType );
+ }
+
+ try
+ {
+ // transfer to the sequence
+ xArray->set( aRetVal, i, aElementVal );
+ }
+ catch( const IllegalArgumentException& )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
+ implGetExceptionMsg( ::cppu::getCaughtException() ) );
+ }
+ catch (const IndexOutOfBoundsException&)
+ {
+ StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ }
+ }
+ return aRetVal;
+}
+
+// Map old interface
+Any sbxToUnoValue( const SbxValue* pVar )
+{
+ return sbxToUnoValueImpl( pVar );
+}
+
+// function to find a global identifier in
+// the UnoScope and to wrap it for Sbx
+static bool implGetTypeByName( const OUString& rName, Type& rRetType )
+{
+ bool bSuccess = false;
+
+ const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
+ if( xTypeAccess->hasByHierarchicalName( rName ) )
+ {
+ Any aRet = xTypeAccess->getByHierarchicalName( rName );
+ Reference< XTypeDescription > xTypeDesc;
+ aRet >>= xTypeDesc;
+
+ if( xTypeDesc.is() )
+ {
+ rRetType = Type( xTypeDesc->getTypeClass(), xTypeDesc->getName() );
+ bSuccess = true;
+ }
+ }
+ return bSuccess;
+}
+
+
+// converting of Sbx to Uno with known target class
+Any sbxToUnoValue( const SbxValue* pVar, const Type& rType, Property const * pUnoProperty )
+{
+ Any aRetVal;
+
+ // #94560 No conversion of empty/void for MAYBE_VOID properties
+ if( pUnoProperty && pUnoProperty->Attributes & PropertyAttribute::MAYBEVOID )
+ {
+ if( pVar->IsEmpty() )
+ return aRetVal;
+ }
+
+ SbxDataType eBaseType = pVar->SbxValue::GetType();
+ if( eBaseType == SbxOBJECT )
+ {
+ SbxBaseRef xObj = pVar->GetObject();
+ if ( auto obj = dynamic_cast<SbUnoAnyObject*>( xObj.get() ) )
+ {
+ return obj->getValue();
+ }
+ }
+
+ TypeClass eType = rType.getTypeClass();
+ switch( eType )
+ {
+ case TypeClass_INTERFACE:
+ case TypeClass_STRUCT:
+ case TypeClass_EXCEPTION:
+ {
+ Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( rType );
+
+ // null reference?
+ if( pVar->IsNull() && eType == TypeClass_INTERFACE )
+ {
+ Reference< XInterface > xRef;
+ OUString aClassName = xIdlTargetClass->getName();
+ Type aClassType( xIdlTargetClass->getTypeClass(), aClassName );
+ aRetVal.setValue( &xRef, aClassType );
+ }
+ else
+ {
+ // #112368 Special conversion for Decimal, Currency and Date
+ if( eType == TypeClass_STRUCT )
+ {
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst && pInst->IsCompatibility() )
+ {
+ if( rType == cppu::UnoType<oleautomation::Decimal>::get())
+ {
+ oleautomation::Decimal aDecimal;
+ pVar->fillAutomationDecimal( aDecimal );
+ aRetVal <<= aDecimal;
+ break;
+ }
+ else if( rType == cppu::UnoType<oleautomation::Currency>::get())
+ {
+ // assumes per previous code that ole Currency is Int64
+ aRetVal <<= pVar->GetInt64();
+ break;
+ }
+ else if( rType == cppu::UnoType<oleautomation::Date>::get())
+ {
+ oleautomation::Date aDate;
+ aDate.Value = pVar->GetDate();
+ aRetVal <<= aDate;
+ break;
+ }
+ }
+ }
+
+ SbxBaseRef pObj = pVar->GetObject();
+ if( auto obj = dynamic_cast<SbUnoObject*>( pObj.get() ) )
+ {
+ aRetVal = obj->getUnoAny();
+ }
+ else if( auto structRef = dynamic_cast<SbUnoStructRefObject*>( pObj.get() ) )
+ {
+ aRetVal = structRef->getUnoAny();
+ }
+ else
+ {
+ // null object -> null XInterface
+ Reference<XInterface> xInt;
+ aRetVal <<= xInt;
+ }
+ }
+ }
+ break;
+
+ case TypeClass_TYPE:
+ {
+ if( eBaseType == SbxOBJECT )
+ {
+ // XIdlClass?
+ Reference< XIdlClass > xIdlClass;
+
+ SbxBaseRef pObj = pVar->GetObject();
+ if( auto obj = dynamic_cast<SbUnoObject*>( pObj.get() ) )
+ {
+ Any aUnoAny = obj->getUnoAny();
+ aUnoAny >>= xIdlClass;
+ }
+
+ if( xIdlClass.is() )
+ {
+ OUString aClassName = xIdlClass->getName();
+ Type aType( xIdlClass->getTypeClass(), aClassName );
+ aRetVal <<= aType;
+ }
+ }
+ else if( eBaseType == SbxSTRING )
+ {
+ OUString aTypeName = pVar->GetOUString();
+ Type aType;
+ bool bSuccess = implGetTypeByName( aTypeName, aType );
+ if( bSuccess )
+ {
+ aRetVal <<= aType;
+ }
+ }
+ }
+ break;
+
+
+ case TypeClass_ENUM:
+ {
+ aRetVal = int2enum( pVar->GetLong(), rType );
+ }
+ break;
+
+ case TypeClass_SEQUENCE:
+ {
+ SbxBaseRef xObj = pVar->GetObject();
+ if( auto pArray = dynamic_cast<SbxDimArray*>( xObj.get() ) )
+ {
+ sal_Int32 nDims = pArray->GetDims32();
+
+ // Normal case: One dimensional array
+ sal_Int32 nLower, nUpper;
+ if( nDims == 1 && pArray->GetDim32( 1, nLower, nUpper ) )
+ {
+ sal_Int32 nSeqSize = nUpper - nLower + 1;
+
+ // create the instance of the required sequence
+ Reference< XIdlClass > xIdlTargetClass = TypeToIdlClass( rType );
+ xIdlTargetClass->createObject( aRetVal );
+ Reference< XIdlArray > xArray = xIdlTargetClass->getArray();
+ xArray->realloc( aRetVal, nSeqSize );
+
+ // Element-Type
+ OUString aClassName = xIdlTargetClass->getName();
+ typelib_TypeDescription * pSeqTD = nullptr;
+ typelib_typedescription_getByName( &pSeqTD, aClassName.pData );
+ assert( pSeqTD );
+ Type aElemType( reinterpret_cast<typelib_IndirectTypeDescription *>(pSeqTD)->pType );
+
+ // convert all array member and register them
+ sal_Int32 aIdx[1];
+ aIdx[0] = nLower;
+ for (sal_Int32 i = 0 ; i < nSeqSize; ++i, ++aIdx[0])
+ {
+ SbxVariableRef xVar = pArray->Get32(aIdx);
+
+ // Convert the value of Sbx to Uno
+ Any aAnyValue = sbxToUnoValue( xVar.get(), aElemType );
+
+ try
+ {
+ // insert in the sequence
+ xArray->set( aRetVal, i, aAnyValue );
+ }
+ catch( const IllegalArgumentException& )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
+ implGetExceptionMsg( ::cppu::getCaughtException() ) );
+ }
+ catch (const IndexOutOfBoundsException&)
+ {
+ StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ }
+ }
+ }
+ // #i33795 Map also multi dimensional arrays to corresponding sequences
+ else if( nDims > 1 )
+ {
+ // Element-Type
+ typelib_TypeDescription * pSeqTD = nullptr;
+ Type aCurType( rType );
+ sal_Int32 nSeqLevel = 0;
+ Type aElemType;
+ do
+ {
+ OUString aTypeName = aCurType.getTypeName();
+ typelib_typedescription_getByName( &pSeqTD, aTypeName.pData );
+ assert( pSeqTD );
+ if( pSeqTD->eTypeClass == typelib_TypeClass_SEQUENCE )
+ {
+ aCurType = Type( reinterpret_cast<typelib_IndirectTypeDescription *>(pSeqTD)->pType );
+ nSeqLevel++;
+ }
+ else
+ {
+ aElemType = aCurType;
+ break;
+ }
+ }
+ while( true );
+
+ if( nSeqLevel == nDims )
+ {
+ std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDims]);
+ std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDims]);
+ std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDims]);
+ for(sal_Int32 i = 1 ; i <= nDims ; i++ )
+ {
+ sal_Int32 lBound, uBound;
+ pArray->GetDim32( i, lBound, uBound );
+
+ sal_Int32 j = i - 1;
+ pActualIndices[j] = pLowerBounds[j] = lBound;
+ pUpperBounds[j] = uBound;
+ }
+
+ aRetVal = implRekMultiDimArrayToSequence( pArray, aElemType,
+ nDims - 1, 0, pActualIndices.get(), pLowerBounds.get(), pUpperBounds.get() );
+ }
+ }
+ }
+ }
+ break;
+
+
+ // for Any use the class independent converting routine
+ case TypeClass_ANY:
+ {
+ aRetVal = sbxToUnoValueImpl( pVar );
+ }
+ break;
+
+ case TypeClass_BOOLEAN:
+ {
+ aRetVal <<= pVar->GetBool();
+ break;
+ }
+ case TypeClass_CHAR:
+ {
+ aRetVal <<= pVar->GetChar();
+ break;
+ }
+ case TypeClass_STRING: aRetVal <<= pVar->GetOUString(); break;
+ case TypeClass_FLOAT: aRetVal <<= pVar->GetSingle(); break;
+ case TypeClass_DOUBLE: aRetVal <<= pVar->GetDouble(); break;
+
+ case TypeClass_BYTE:
+ {
+ sal_Int16 nVal = pVar->GetInteger();
+ bool bOverflow = false;
+ if( nVal < -128 )
+ {
+ bOverflow = true;
+ nVal = -128;
+ }
+ else if( nVal > 255 ) // 128..255 map to -128..-1
+ {
+ bOverflow = true;
+ nVal = 127;
+ }
+ if( bOverflow )
+ StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW );
+
+ sal_Int8 nByteVal = static_cast<sal_Int8>(nVal);
+ aRetVal <<= nByteVal;
+ break;
+ }
+ case TypeClass_SHORT: aRetVal <<= pVar->GetInteger(); break;
+ case TypeClass_LONG: aRetVal <<= pVar->GetLong(); break;
+ case TypeClass_HYPER: aRetVal <<= pVar->GetInt64(); break;
+ case TypeClass_UNSIGNED_SHORT: aRetVal <<= pVar->GetUShort(); break;
+ case TypeClass_UNSIGNED_LONG: aRetVal <<= pVar->GetULong(); break;
+ case TypeClass_UNSIGNED_HYPER: aRetVal <<= pVar->GetUInt64(); break;
+ default: break;
+ }
+
+ return aRetVal;
+}
+
+static void processAutomationParams( SbxArray* pParams, Sequence< Any >& args, sal_uInt32 nParamCount )
+{
+ AutomationNamedArgsSbxArray* pArgNamesArray = dynamic_cast<AutomationNamedArgsSbxArray*>( pParams );
+
+ args.realloc( nParamCount );
+ Any* pAnyArgs = args.getArray();
+ bool bBlockConversionToSmallestType = GetSbData()->pInst->IsCompatibility();
+ sal_uInt32 i = 0;
+ if( pArgNamesArray )
+ {
+ Sequence< OUString >& rNameSeq = pArgNamesArray->getNames();
+ OUString* pNames = rNameSeq.getArray();
+ Any aValAny;
+ for( i = 0 ; i < nParamCount ; i++ )
+ {
+ sal_uInt32 iSbx = i + 1;
+
+ aValAny = sbxToUnoValueImpl( pParams->Get32( iSbx ),
+ bBlockConversionToSmallestType );
+
+ OUString aParamName = pNames[iSbx];
+ if( !aParamName.isEmpty() )
+ {
+ oleautomation::NamedArgument aNamedArgument;
+ aNamedArgument.Name = aParamName;
+ aNamedArgument.Value = aValAny;
+ pAnyArgs[i] <<= aNamedArgument;
+ }
+ else
+ {
+ pAnyArgs[i] = aValAny;
+ }
+ }
+ }
+ else
+ {
+ for( i = 0 ; i < nParamCount ; i++ )
+ {
+ pAnyArgs[i] = sbxToUnoValueImpl(pParams->Get32(i + 1),
+ bBlockConversionToSmallestType );
+ }
+ }
+
+}
+
+namespace {
+
+enum class INVOKETYPE
+{
+ GetProp = 0,
+ Func
+};
+
+}
+
+static Any invokeAutomationMethod( const OUString& Name, Sequence< Any > const & args, SbxArray* pParams, sal_uInt32 nParamCount, Reference< XInvocation > const & rxInvocation, INVOKETYPE invokeType )
+{
+ Sequence< sal_Int16 > OutParamIndex;
+ Sequence< Any > OutParam;
+
+ Any aRetAny;
+ switch( invokeType )
+ {
+ case INVOKETYPE::Func:
+ aRetAny = rxInvocation->invoke( Name, args, OutParamIndex, OutParam );
+ break;
+ case INVOKETYPE::GetProp:
+ {
+ Reference< XAutomationInvocation > xAutoInv( rxInvocation, UNO_QUERY );
+ aRetAny = xAutoInv->invokeGetProperty( Name, args, OutParamIndex, OutParam );
+ break;
+ }
+ default:
+ assert(false); break;
+
+ }
+ const sal_Int16* pIndices = OutParamIndex.getConstArray();
+ sal_uInt32 nLen = OutParamIndex.getLength();
+ if( nLen )
+ {
+ const Any* pNewValues = OutParam.getConstArray();
+ for( sal_uInt32 j = 0 ; j < nLen ; j++ )
+ {
+ sal_Int16 iTarget = pIndices[ j ];
+ if( iTarget >= static_cast<sal_Int16>(nParamCount) )
+ break;
+ unoToSbxValue( pParams->Get32(j + 1), pNewValues[ j ] );
+ }
+ }
+ return aRetAny;
+}
+
+// Debugging help method to readout the imlemented interfaces of an object
+static OUString Impl_GetInterfaceInfo( const Reference< XInterface >& x, const Reference< XIdlClass >& xClass, sal_uInt16 nRekLevel )
+{
+ Type aIfaceType = cppu::UnoType<XInterface>::get();
+ static Reference< XIdlClass > xIfaceClass = TypeToIdlClass( aIfaceType );
+
+ OUStringBuffer aRetStr;
+ for( sal_uInt16 i = 0 ; i < nRekLevel ; i++ )
+ aRetStr.append( " " );
+ aRetStr.append( xClass->getName() );
+ OUString aClassName = xClass->getName();
+ Type aClassType( xClass->getTypeClass(), aClassName );
+
+ // checking if the interface is really supported
+ if( !x->queryInterface( aClassType ).hasValue() )
+ {
+ aRetStr.append( " (ERROR: Not really supported!)\n" );
+ }
+ // Are there super interfaces?
+ else
+ {
+ aRetStr.append( "\n" );
+
+ // get the super interfaces
+ Sequence< Reference< XIdlClass > > aSuperClassSeq = xClass->getSuperclasses();
+ const Reference< XIdlClass >* pClasses = aSuperClassSeq.getConstArray();
+ sal_uInt32 nSuperIfaceCount = aSuperClassSeq.getLength();
+ for( sal_uInt32 j = 0 ; j < nSuperIfaceCount ; j++ )
+ {
+ const Reference< XIdlClass >& rxIfaceClass = pClasses[j];
+ if( !rxIfaceClass->equals( xIfaceClass ) )
+ aRetStr.append( Impl_GetInterfaceInfo( x, rxIfaceClass, nRekLevel + 1 ) );
+ }
+ }
+ return aRetStr.makeStringAndClear();
+}
+
+static OUString getDbgObjectNameImpl(SbUnoObject& rUnoObj)
+{
+ OUString aName = rUnoObj.GetClassName();
+ if( aName.isEmpty() )
+ {
+ Any aToInspectObj = rUnoObj.getUnoAny();
+ Reference< XInterface > xObj(aToInspectObj, css::uno::UNO_QUERY);
+ if( xObj.is() )
+ {
+ Reference< XServiceInfo > xServiceInfo( xObj, UNO_QUERY );
+ if( xServiceInfo.is() )
+ aName = xServiceInfo->getImplementationName();
+ }
+ }
+ return aName;
+}
+
+static OUString getDbgObjectName(SbUnoObject& rUnoObj)
+{
+ OUString aName = getDbgObjectNameImpl(rUnoObj);
+ if( aName.isEmpty() )
+ aName += "Unknown";
+
+ OUStringBuffer aRet;
+ if( aName.getLength() > 20 )
+ {
+ aRet.append( "\n" );
+ }
+ aRet.append( "\"" );
+ aRet.append( aName );
+ aRet.append( "\":" );
+ return aRet.makeStringAndClear();
+}
+
+OUString getBasicObjectTypeName( SbxObject* pObj )
+{
+ if (pObj)
+ {
+ if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
+ {
+ return getDbgObjectNameImpl(*pUnoObj);
+ }
+ else if (SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>(pObj))
+ {
+ return pUnoStructObj->GetClassName();
+ }
+ }
+ return OUString();
+}
+
+namespace {
+
+bool matchesBasicTypeName(
+ css::uno::Reference<css::reflection::XIdlClass> const & unoType, OUString const & basicTypeName)
+{
+ if (unoType->getName().endsWithIgnoreAsciiCase(basicTypeName)) {
+ return true;
+ }
+ auto const sups = unoType->getSuperclasses();
+ return std::any_of(
+ sups.begin(), sups.end(),
+ [&basicTypeName](auto const & t) { return matchesBasicTypeName(t, basicTypeName); });
+}
+
+}
+
+bool checkUnoObjectType(SbUnoObject& rUnoObj, const OUString& rClass)
+{
+ Any aToInspectObj = rUnoObj.getUnoAny();
+
+ // Return true for XInvocation based objects as interface type names don't count then
+ Reference< XInvocation > xInvocation( aToInspectObj, UNO_QUERY );
+ if( xInvocation.is() )
+ {
+ return true;
+ }
+ bool bResult = false;
+ Reference< XTypeProvider > xTypeProvider( aToInspectObj, UNO_QUERY );
+ if( xTypeProvider.is() )
+ {
+ /* Although interfaces in the ooo.vba namespace obey the IDL rules and
+ have a leading 'X', in Basic we want to be able to do something
+ like 'Dim wb As Workbooks' or 'Dim lb As MSForms.Label'. Here we
+ add a leading 'X' to the class name and a leading dot to the entire
+ type name. This results e.g. in '.XWorkbooks' or '.MSForms.XLabel'
+ which matches the interface names 'ooo.vba.excel.XWorkbooks' or
+ 'ooo.vba.msforms.XLabel'.
+ */
+ OUString aClassName;
+ if ( SbiRuntime::isVBAEnabled() )
+ {
+ aClassName = ".";
+ sal_Int32 nClassNameDot = rClass.lastIndexOf( '.' );
+ if( nClassNameDot >= 0 )
+ {
+ aClassName += rClass.copy( 0, nClassNameDot + 1 ) + "X" + rClass.copy( nClassNameDot + 1 );
+ }
+ else
+ {
+ aClassName += "X" + rClass;
+ }
+ }
+ else // assume extended type declaration support for basic ( can't get here
+ // otherwise.
+ aClassName = rClass;
+
+ Sequence< Type > aTypeSeq = xTypeProvider->getTypes();
+ const Type* pTypeArray = aTypeSeq.getConstArray();
+ sal_uInt32 nIfaceCount = aTypeSeq.getLength();
+ for( sal_uInt32 j = 0 ; j < nIfaceCount ; j++ )
+ {
+ const Type& rType = pTypeArray[j];
+
+ Reference<XIdlClass> xClass = TypeToIdlClass( rType );
+ if( !xClass.is() )
+ {
+ OSL_FAIL("failed to get XIdlClass for type");
+ break;
+ }
+ OUString aInterfaceName = xClass->getName();
+ if ( aInterfaceName == "com.sun.star.bridge.oleautomation.XAutomationObject" )
+ {
+ // there is a hack in the extensions/source/ole/oleobj.cxx to return the typename of the automation object, lets check if it
+ // matches
+ Reference< XInvocation > xInv( aToInspectObj, UNO_QUERY );
+ if ( xInv.is() )
+ {
+ OUString sTypeName;
+ xInv->getValue( "$GetTypeName" ) >>= sTypeName;
+ if ( sTypeName.isEmpty() || sTypeName == "IDispatch" )
+ {
+ // can't check type, leave it pass
+ bResult = true;
+ }
+ else
+ {
+ bResult = sTypeName == rClass;
+ }
+ }
+ break; // finished checking automation object
+ }
+
+ if ( matchesBasicTypeName(xClass, aClassName) )
+ {
+ bResult = true;
+ break;
+ }
+ }
+ }
+ return bResult;
+}
+
+// Debugging help method to readout the imlemented interfaces of an object
+static OUString Impl_GetSupportedInterfaces(SbUnoObject& rUnoObj)
+{
+ Any aToInspectObj = rUnoObj.getUnoAny();
+
+ // allow only TypeClass interface
+ OUStringBuffer aRet;
+ auto x = o3tl::tryAccess<Reference<XInterface>>(aToInspectObj);
+ if( !x )
+ {
+ aRet.append( ID_DBG_SUPPORTEDINTERFACES );
+ aRet.append( " not available.\n(TypeClass is not TypeClass_INTERFACE)\n" );
+ }
+ else
+ {
+ Reference< XTypeProvider > xTypeProvider( *x, UNO_QUERY );
+
+ aRet.append( "Supported interfaces by object " );
+ aRet.append(getDbgObjectName(rUnoObj));
+ aRet.append( "\n" );
+ if( xTypeProvider.is() )
+ {
+ // get the interfaces of the implementation
+ Sequence< Type > aTypeSeq = xTypeProvider->getTypes();
+ const Type* pTypeArray = aTypeSeq.getConstArray();
+ sal_uInt32 nIfaceCount = aTypeSeq.getLength();
+ for( sal_uInt32 j = 0 ; j < nIfaceCount ; j++ )
+ {
+ const Type& rType = pTypeArray[j];
+
+ Reference<XIdlClass> xClass = TypeToIdlClass( rType );
+ if( xClass.is() )
+ {
+ aRet.append( Impl_GetInterfaceInfo( *x, xClass, 1 ) );
+ }
+ else
+ {
+ typelib_TypeDescription * pTD = nullptr;
+ rType.getDescription( &pTD );
+
+ aRet.append( "*** ERROR: No IdlClass for type \"" );
+ aRet.append( pTD->pTypeName );
+ aRet.append( "\"\n*** Please check type library\n" );
+ }
+ }
+ }
+ }
+ return aRet.makeStringAndClear();
+}
+
+
+// Debugging help method SbxDataType -> String
+static OUString Dbg_SbxDataType2String( SbxDataType eType )
+{
+ OUStringBuffer aRet;
+ switch( +eType )
+ {
+ case SbxEMPTY: aRet.append("SbxEMPTY"); break;
+ case SbxNULL: aRet.append("SbxNULL"); break;
+ case SbxINTEGER: aRet.append("SbxINTEGER"); break;
+ case SbxLONG: aRet.append("SbxLONG"); break;
+ case SbxSINGLE: aRet.append("SbxSINGLE"); break;
+ case SbxDOUBLE: aRet.append("SbxDOUBLE"); break;
+ case SbxCURRENCY: aRet.append("SbxCURRENCY"); break;
+ case SbxDECIMAL: aRet.append("SbxDECIMAL"); break;
+ case SbxDATE: aRet.append("SbxDATE"); break;
+ case SbxSTRING: aRet.append("SbxSTRING"); break;
+ case SbxOBJECT: aRet.append("SbxOBJECT"); break;
+ case SbxERROR: aRet.append("SbxERROR"); break;
+ case SbxBOOL: aRet.append("SbxBOOL"); break;
+ case SbxVARIANT: aRet.append("SbxVARIANT"); break;
+ case SbxDATAOBJECT: aRet.append("SbxDATAOBJECT"); break;
+ case SbxCHAR: aRet.append("SbxCHAR"); break;
+ case SbxBYTE: aRet.append("SbxBYTE"); break;
+ case SbxUSHORT: aRet.append("SbxUSHORT"); break;
+ case SbxULONG: aRet.append("SbxULONG"); break;
+ case SbxSALINT64: aRet.append("SbxINT64"); break;
+ case SbxSALUINT64: aRet.append("SbxUINT64"); break;
+ case SbxINT: aRet.append("SbxINT"); break;
+ case SbxUINT: aRet.append("SbxUINT"); break;
+ case SbxVOID: aRet.append("SbxVOID"); break;
+ case SbxHRESULT: aRet.append("SbxHRESULT"); break;
+ case SbxPOINTER: aRet.append("SbxPOINTER"); break;
+ case SbxDIMARRAY: aRet.append("SbxDIMARRAY"); break;
+ case SbxCARRAY: aRet.append("SbxCARRAY"); break;
+ case SbxUSERDEF: aRet.append("SbxUSERDEF"); break;
+ case SbxLPSTR: aRet.append("SbxLPSTR"); break;
+ case SbxLPWSTR: aRet.append("SbxLPWSTR"); break;
+ case SbxCoreSTRING: aRet.append("SbxCoreSTRING"); break;
+ case SbxOBJECT | SbxARRAY: aRet.append("SbxARRAY"); break;
+ default: aRet.append("Unknown Sbx-Type!");break;
+ }
+ return aRet.makeStringAndClear();
+}
+
+// Debugging help method to display the properties of a SbUnoObjects
+static OUString Impl_DumpProperties(SbUnoObject& rUnoObj)
+{
+ OUStringBuffer aRet;
+ aRet.append("Properties of object ");
+ aRet.append(getDbgObjectName(rUnoObj));
+
+ // analyse the Uno-Infos to recognise the arrays
+ Reference< XIntrospectionAccess > xAccess = rUnoObj.getIntrospectionAccess();
+ if( !xAccess.is() )
+ {
+ Reference< XInvocation > xInvok = rUnoObj.getInvocation();
+ if( xInvok.is() )
+ xAccess = xInvok->getIntrospection();
+ }
+ if( !xAccess.is() )
+ {
+ aRet.append( "\nUnknown, no introspection available\n" );
+ return aRet.makeStringAndClear();
+ }
+
+ Sequence<Property> props = xAccess->getProperties( PropertyConcept::ALL - PropertyConcept::DANGEROUS );
+ sal_uInt32 nUnoPropCount = props.getLength();
+ const Property* pUnoProps = props.getConstArray();
+
+ SbxArray* pProps = rUnoObj.GetProperties();
+ sal_uInt32 nPropCount = pProps->Count32();
+ sal_uInt32 nPropsPerLine = 1 + nPropCount / 30;
+ for( sal_uInt32 i = 0; i < nPropCount; i++ )
+ {
+ SbxVariable* pVar = pProps->Get32( i );
+ if( pVar )
+ {
+ OUStringBuffer aPropStr;
+ if( (i % nPropsPerLine) == 0 )
+ aPropStr.append( "\n" );
+
+ // output the type and name
+ // Is it in Uno a sequence?
+ SbxDataType eType = pVar->GetFullType();
+
+ bool bMaybeVoid = false;
+ if( i < nUnoPropCount )
+ {
+ const Property& rProp = pUnoProps[ i ];
+
+ // For MAYBEVOID freshly convert the type from Uno,
+ // so not just SbxEMPTY is returned.
+ if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
+ {
+ eType = unoToSbxType( rProp.Type.getTypeClass() );
+ bMaybeVoid = true;
+ }
+ if( eType == SbxOBJECT )
+ {
+ Type aType = rProp.Type;
+ if( aType.getTypeClass() == TypeClass_SEQUENCE )
+ eType = SbxDataType( SbxOBJECT | SbxARRAY );
+ }
+ }
+ aPropStr.append( Dbg_SbxDataType2String( eType ) );
+ if( bMaybeVoid )
+ aPropStr.append( "/void" );
+ aPropStr.append( " " );
+ aPropStr.append( pVar->GetName() );
+
+ if( i == nPropCount - 1 )
+ aPropStr.append( "\n" );
+ else
+ aPropStr.append( "; " );
+
+ aRet.append( aPropStr.makeStringAndClear() );
+ }
+ }
+ return aRet.makeStringAndClear();
+}
+
+// Debugging help method to display the methods of an SbUnoObjects
+static OUString Impl_DumpMethods(SbUnoObject& rUnoObj)
+{
+ OUStringBuffer aRet;
+ aRet.append("Methods of object ");
+ aRet.append(getDbgObjectName(rUnoObj));
+
+ // XIntrospectionAccess, so that the types of the parameter could be outputted
+ Reference< XIntrospectionAccess > xAccess = rUnoObj.getIntrospectionAccess();
+ if( !xAccess.is() )
+ {
+ Reference< XInvocation > xInvok = rUnoObj.getInvocation();
+ if( xInvok.is() )
+ xAccess = xInvok->getIntrospection();
+ }
+ if( !xAccess.is() )
+ {
+ aRet.append( "\nUnknown, no introspection available\n" );
+ return aRet.makeStringAndClear();
+ }
+ Sequence< Reference< XIdlMethod > > methods = xAccess->getMethods
+ ( MethodConcept::ALL - MethodConcept::DANGEROUS );
+ const Reference< XIdlMethod >* pUnoMethods = methods.getConstArray();
+
+ SbxArray* pMethods = rUnoObj.GetMethods();
+ sal_uInt32 nMethodCount = pMethods->Count32();
+ if( !nMethodCount )
+ {
+ aRet.append( "\nNo methods found\n" );
+ return aRet.makeStringAndClear();
+ }
+ sal_uInt32 nPropsPerLine = 1 + nMethodCount / 30;
+ for( sal_uInt32 i = 0; i < nMethodCount; i++ )
+ {
+ SbxVariable* pVar = pMethods->Get32( i );
+ if( pVar )
+ {
+ if( (i % nPropsPerLine) == 0 )
+ aRet.append( "\n" );
+
+ // address the method
+ const Reference< XIdlMethod >& rxMethod = pUnoMethods[i];
+
+ // Is it in Uno a sequence?
+ SbxDataType eType = pVar->GetFullType();
+ if( eType == SbxOBJECT )
+ {
+ Reference< XIdlClass > xClass = rxMethod->getReturnType();
+ if( xClass.is() && xClass->getTypeClass() == TypeClass_SEQUENCE )
+ eType = SbxDataType( SbxOBJECT | SbxARRAY );
+ }
+ // output the name and the type
+ aRet.append( Dbg_SbxDataType2String( eType ) );
+ aRet.append( " " );
+ aRet.append ( pVar->GetName() );
+ aRet.append( " ( " );
+
+ // the get-method mustn't have a parameter
+ Sequence< Reference< XIdlClass > > aParamsSeq = rxMethod->getParameterTypes();
+ sal_uInt32 nParamCount = aParamsSeq.getLength();
+ const Reference< XIdlClass >* pParams = aParamsSeq.getConstArray();
+
+ if( nParamCount > 0 )
+ {
+ for( sal_uInt32 j = 0; j < nParamCount; j++ )
+ {
+ aRet.append ( Dbg_SbxDataType2String( unoToSbxType( pParams[ j ] ) ) );
+ if( j < nParamCount - 1 )
+ aRet.append( ", " );
+ }
+ }
+ else
+ aRet.append( "void" );
+
+ aRet.append( " ) " );
+
+ if( i == nMethodCount - 1 )
+ aRet.append( "\n" );
+ else
+ aRet.append( "; " );
+ }
+ }
+ return aRet.makeStringAndClear();
+}
+
+
+// Implementation SbUnoObject
+void SbUnoObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ if( bNeedIntrospection )
+ doIntrospection();
+
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+ if( !pHint )
+ return;
+
+ SbxVariable* pVar = pHint->GetVar();
+ SbxArray* pParams = pVar->GetParameters();
+ SbUnoProperty* pProp = dynamic_cast<SbUnoProperty*>( pVar );
+ SbUnoMethod* pMeth = dynamic_cast<SbUnoMethod*>( pVar );
+ if( pProp )
+ {
+ bool bInvocation = pProp->isInvocationBased();
+ if( pHint->GetId() == SfxHintId::BasicDataWanted )
+ {
+ // Test-Properties
+ sal_Int32 nId = pProp->nId;
+ if( nId < 0 )
+ {
+ // Id == -1: Display implemented interfaces according the ClassProvider
+ if( nId == -1 ) // Property ID_DBG_SUPPORTEDINTERFACES"
+ {
+ OUString aRetStr = Impl_GetSupportedInterfaces(*this);
+ pVar->PutString( aRetStr );
+ }
+ // Id == -2: output properties
+ else if( nId == -2 ) // Property ID_DBG_PROPERTIES
+ {
+ // now all properties must be created
+ implCreateAll();
+ OUString aRetStr = Impl_DumpProperties(*this);
+ pVar->PutString( aRetStr );
+ }
+ // Id == -3: output the methods
+ else if( nId == -3 ) // Property ID_DBG_METHODS
+ {
+ // now all properties must be created
+ implCreateAll();
+ OUString aRetStr = Impl_DumpMethods(*this);
+ pVar->PutString( aRetStr );
+ }
+ return;
+ }
+
+ if( !bInvocation && mxUnoAccess.is() )
+ {
+ try
+ {
+ if ( maStructInfo )
+ {
+ StructRefInfo aMember = maStructInfo->getStructMember( pProp->GetName() );
+ if ( aMember.isEmpty() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
+ }
+ else
+ {
+ if ( pProp->isUnoStruct() )
+ {
+ SbUnoStructRefObject* pSbUnoObject = new SbUnoStructRefObject( pProp->GetName(), aMember );
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(pSbUnoObject);
+ pVar->PutObject( xWrapper.get() );
+ }
+ else
+ {
+ Any aRetAny = aMember.getValue();
+ // take over the value from Uno to Sbx
+ unoToSbxValue( pVar, aRetAny );
+ }
+ return;
+ }
+ }
+ // get the value
+ Reference< XPropertySet > xPropSet( mxUnoAccess->queryAdapter( cppu::UnoType<XPropertySet>::get()), UNO_QUERY );
+ Any aRetAny = xPropSet->getPropertyValue( pProp->GetName() );
+ // The use of getPropertyValue (instead of using the index) is
+ // suboptimal, but the refactoring to XInvocation is already pending
+ // Otherwise it is possible to use FastPropertySet
+
+ // take over the value from Uno to Sbx
+ unoToSbxValue( pVar, aRetAny );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ }
+ else if( bInvocation && mxInvocation.is() )
+ {
+ try
+ {
+ sal_uInt32 nParamCount = pParams ? (pParams->Count32() - 1) : 0;
+ bool bCanBeConsideredAMethod = mxInvocation->hasMethod( pProp->GetName() );
+ Any aRetAny;
+ if ( bCanBeConsideredAMethod && nParamCount )
+ {
+ // Automation properties have methods, so... we need to invoke this through
+ // XInvocation
+ Sequence<Any> args;
+ processAutomationParams( pParams, args, nParamCount );
+ aRetAny = invokeAutomationMethod( pProp->GetName(), args, pParams, nParamCount, mxInvocation, INVOKETYPE::GetProp );
+ }
+ else
+ aRetAny = mxInvocation->getValue( pProp->GetName() );
+ // take over the value from Uno to Sbx
+ unoToSbxValue( pVar, aRetAny );
+ if( pParams && bCanBeConsideredAMethod )
+ pVar->SetParameters( nullptr );
+
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ }
+ }
+ else if( pHint->GetId() == SfxHintId::BasicDataChanged )
+ {
+ if( !bInvocation && mxUnoAccess.is() )
+ {
+ if( pProp->aUnoProp.Attributes & PropertyAttribute::READONLY )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROP_READONLY );
+ return;
+ }
+ if ( maStructInfo )
+ {
+ StructRefInfo aMember = maStructInfo->getStructMember( pProp->GetName() );
+ if ( aMember.isEmpty() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
+ }
+ else
+ {
+ Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
+ aMember.setValue( aAnyValue );
+ }
+ return;
+ }
+ // take over the value from Uno to Sbx
+ Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
+ try
+ {
+ // set the value
+ Reference< XPropertySet > xPropSet( mxUnoAccess->queryAdapter( cppu::UnoType<XPropertySet>::get()), UNO_QUERY );
+ xPropSet->setPropertyValue( pProp->GetName(), aAnyValue );
+ // The use of getPropertyValue (instead of using the index) is
+ // suboptimal, but the refactoring to XInvocation is already pending
+ // Otherwise it is possible to use FastPropertySet
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ }
+ else if( bInvocation && mxInvocation.is() )
+ {
+ // take over the value from Uno to Sbx
+ Any aAnyValue = sbxToUnoValueImpl( pVar );
+ try
+ {
+ // set the value
+ mxInvocation->setValue( pProp->GetName(), aAnyValue );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ }
+ }
+ }
+ else if( pMeth )
+ {
+ bool bInvocation = pMeth->isInvocationBased();
+ if( pHint->GetId() == SfxHintId::BasicDataWanted )
+ {
+ // number of Parameter -1 because of Param0 == this
+ sal_uInt32 nParamCount = pParams ? (pParams->Count32() - 1) : 0;
+ Sequence<Any> args;
+ bool bOutParams = false;
+
+ if( !bInvocation && mxUnoAccess.is() )
+ {
+ // get info
+ const Sequence<ParamInfo>& rInfoSeq = pMeth->getParamInfos();
+ const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
+ sal_uInt32 nUnoParamCount = rInfoSeq.getLength();
+ sal_uInt32 nAllocParamCount = nParamCount;
+
+ // ignore surplus parameter; alternative: throw an error
+ if( nParamCount > nUnoParamCount )
+ {
+ nParamCount = nUnoParamCount;
+ nAllocParamCount = nParamCount;
+ }
+ else if( nParamCount < nUnoParamCount )
+ {
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst && pInst->IsCompatibility() )
+ {
+ // Check types
+ bool bError = false;
+ for( sal_uInt32 i = nParamCount ; i < nUnoParamCount ; i++ )
+ {
+ const ParamInfo& rInfo = pParamInfos[i];
+ const Reference< XIdlClass >& rxClass = rInfo.aType;
+ if( rxClass->getTypeClass() != TypeClass_ANY )
+ {
+ bError = true;
+ StarBASIC::Error( ERRCODE_BASIC_NOT_OPTIONAL );
+ }
+ }
+ if( !bError )
+ nAllocParamCount = nUnoParamCount;
+ }
+ }
+
+ if( nAllocParamCount > 0 )
+ {
+ args.realloc( nAllocParamCount );
+ Any* pAnyArgs = args.getArray();
+ for( sal_uInt32 i = 0 ; i < nParamCount ; i++ )
+ {
+ const ParamInfo& rInfo = pParamInfos[i];
+ const Reference< XIdlClass >& rxClass = rInfo.aType;
+
+ css::uno::Type aType( rxClass->getTypeClass(), rxClass->getName() );
+
+ // ATTENTION: Don't forget for Sbx-Parameter the offset!
+ pAnyArgs[i] = sbxToUnoValue( pParams->Get32(i + 1), aType );
+
+ // If it is not certain check whether the out-parameter are available.
+ if( !bOutParams )
+ {
+ ParamMode aParamMode = rInfo.aMode;
+ if( aParamMode != ParamMode_IN )
+ bOutParams = true;
+ }
+ }
+ }
+ }
+ else if( bInvocation && pParams && mxInvocation.is() )
+ {
+ processAutomationParams( pParams, args, nParamCount );
+ }
+
+ // call the method
+ GetSbData()->bBlockCompilerError = true; // #106433 Block compiler errors for API calls
+ try
+ {
+ if( !bInvocation && mxUnoAccess.is() )
+ {
+ Any aRetAny = pMeth->m_xUnoMethod->invoke( getUnoAny(), args );
+
+ // take over the value from Uno to Sbx
+ unoToSbxValue( pVar, aRetAny );
+
+ // Did we to copy back the Out-Parameter?
+ if( bOutParams )
+ {
+ const Any* pAnyArgs = args.getConstArray();
+
+ // get info
+ const Sequence<ParamInfo>& rInfoSeq = pMeth->getParamInfos();
+ const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
+
+ sal_uInt32 j;
+ for( j = 0 ; j < nParamCount ; j++ )
+ {
+ const ParamInfo& rInfo = pParamInfos[j];
+ ParamMode aParamMode = rInfo.aMode;
+ if( aParamMode != ParamMode_IN )
+ unoToSbxValue( pParams->Get32(j + 1), pAnyArgs[ j ] );
+ }
+ }
+ }
+ else if( bInvocation && mxInvocation.is() )
+ {
+ Any aRetAny = invokeAutomationMethod( pMeth->GetName(), args, pParams, nParamCount, mxInvocation, INVOKETYPE::Func );
+ unoToSbxValue( pVar, aRetAny );
+ }
+
+ // remove parameter here, because this was not done anymore in unoToSbxValue()
+ // for arrays
+ if( pParams )
+ pVar->SetParameters( nullptr );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ GetSbData()->bBlockCompilerError = false; // #106433 Unblock compiler errors
+ }
+ }
+ else
+ SbxObject::Notify( rBC, rHint );
+}
+
+
+SbUnoObject::SbUnoObject( const OUString& aName_, const Any& aUnoObj_ )
+ : SbxObject( aName_ )
+ , bNeedIntrospection( true )
+ , bNativeCOMObject( false )
+{
+ // beat out again the default properties of Sbx
+ Remove( "Name", SbxClassType::DontCare );
+ Remove( "Parent", SbxClassType::DontCare );
+
+ // check the type of the objects
+ TypeClass eType = aUnoObj_.getValueType().getTypeClass();
+ Reference< XInterface > x;
+ if( eType == TypeClass_INTERFACE )
+ {
+ // get the interface from the Any
+ aUnoObj_ >>= x;
+ if( !x.is() )
+ return;
+ }
+
+ Reference< XTypeProvider > xTypeProvider;
+ // Did the object have an invocation itself?
+ mxInvocation.set( x, UNO_QUERY );
+
+ xTypeProvider.set( x, UNO_QUERY );
+
+ if( mxInvocation.is() )
+ {
+
+ // get the ExactName
+ mxExactNameInvocation.set( mxInvocation, UNO_QUERY );
+
+ // The remainder refers only to the introspection
+ if( !xTypeProvider.is() )
+ {
+ bNeedIntrospection = false;
+ return;
+ }
+
+ // Ignore introspection based members for COM objects to avoid
+ // hiding of equally named COM symbols, e.g. XInvocation::getValue
+ Reference< oleautomation::XAutomationObject > xAutomationObject( aUnoObj_, UNO_QUERY );
+ if( xAutomationObject.is() )
+ bNativeCOMObject = true;
+ }
+
+ maTmpUnoObj = aUnoObj_;
+
+
+ //*** Define the name ***
+ bool bFatalError = true;
+
+ // Is it an interface or a struct?
+ bool bSetClassName = false;
+ OUString aClassName_;
+ if( eType == TypeClass_STRUCT || eType == TypeClass_EXCEPTION )
+ {
+ // Struct is Ok
+ bFatalError = false;
+
+ // insert the real name of the class
+ if( aName_.isEmpty() )
+ {
+ aClassName_ = aUnoObj_.getValueType().getTypeName();
+ bSetClassName = true;
+ }
+ StructRefInfo aThisStruct( maTmpUnoObj, maTmpUnoObj.getValueType(), 0 );
+ maStructInfo = std::make_shared<SbUnoStructRefObject>( GetName(), aThisStruct );
+ }
+ else if( eType == TypeClass_INTERFACE )
+ {
+ // Interface works always through the type in the Any
+ bFatalError = false;
+ }
+ if( bSetClassName )
+ SetClassName( aClassName_ );
+
+ // Neither interface nor Struct -> FatalError
+ if( bFatalError )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_EXCEPTION );
+ return;
+ }
+
+ // pass the introspection primal on demand
+}
+
+SbUnoObject::~SbUnoObject()
+{
+}
+
+
+// pass the introspection on Demand
+void SbUnoObject::doIntrospection()
+{
+ if( !bNeedIntrospection )
+ return;
+
+ Reference<XComponentContext> xContext = comphelper::getProcessComponentContext();
+
+ if (!xContext.is())
+ return;
+
+
+ // get the introspection service
+ Reference<XIntrospection> xIntrospection;
+
+ try
+ {
+ xIntrospection = theIntrospection::get(xContext);
+ }
+ catch ( const css::uno::DeploymentException& )
+ {
+ }
+
+ if (!xIntrospection.is())
+ return;
+
+ bNeedIntrospection = false;
+
+ // pass the introspection
+ try
+ {
+ mxUnoAccess = xIntrospection->inspect( maTmpUnoObj );
+ }
+ catch( const RuntimeException& e )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
+ }
+
+ if( !mxUnoAccess.is() )
+ {
+ // #51475 mark to indicate an invalid object (no mxMaterialHolder)
+ return;
+ }
+
+ // get MaterialHolder from access
+ mxMaterialHolder.set( mxUnoAccess, UNO_QUERY );
+
+ // get ExactName from access
+ mxExactName.set( mxUnoAccess, UNO_QUERY );
+}
+
+
+// Start of a list of all SbUnoMethod-Instances
+static SbUnoMethod* pFirst = nullptr;
+
+void clearUnoMethodsForBasic( StarBASIC const * pBasic )
+{
+ SbUnoMethod* pMeth = pFirst;
+ while( pMeth )
+ {
+ SbxObject* pObject = pMeth->GetParent();
+ if ( pObject )
+ {
+ StarBASIC* pModBasic = dynamic_cast< StarBASIC* >( pObject->GetParent() );
+ if ( pModBasic == pBasic )
+ {
+ // for now the solution is to remove the method from the list and to clear it,
+ // but in case the element should be correctly transferred to another StarBASIC,
+ // we should either set module parent to NULL without clearing it, or even
+ // set the new StarBASIC as the parent of the module
+ // pObject->SetParent( NULL );
+
+ if( pMeth == pFirst )
+ pFirst = pMeth->pNext;
+ else if( pMeth->pPrev )
+ pMeth->pPrev->pNext = pMeth->pNext;
+ if( pMeth->pNext )
+ pMeth->pNext->pPrev = pMeth->pPrev;
+
+ pMeth->pPrev = nullptr;
+ pMeth->pNext = nullptr;
+
+ pMeth->SbxValue::Clear();
+ pObject->SbxValue::Clear();
+
+ // start from the beginning after object clearing, the cycle will end since the method is removed each time
+ pMeth = pFirst;
+ }
+ else
+ pMeth = pMeth->pNext;
+ }
+ else
+ pMeth = pMeth->pNext;
+ }
+}
+
+void clearUnoMethods()
+{
+ SbUnoMethod* pMeth = pFirst;
+ while( pMeth )
+ {
+ pMeth->SbxValue::Clear();
+ pMeth = pMeth->pNext;
+ }
+}
+
+
+SbUnoMethod::SbUnoMethod
+(
+ const OUString& aName_,
+ SbxDataType eSbxType,
+ Reference< XIdlMethod > const & xUnoMethod_,
+ bool bInvocation
+)
+ : SbxMethod( aName_, eSbxType )
+ , mbInvocation( bInvocation )
+{
+ m_xUnoMethod = xUnoMethod_;
+ pParamInfoSeq = nullptr;
+
+ // enregister the method in a list
+ pNext = pFirst;
+ pPrev = nullptr;
+ pFirst = this;
+ if( pNext )
+ pNext->pPrev = this;
+}
+
+SbUnoMethod::~SbUnoMethod()
+{
+ pParamInfoSeq.reset();
+
+ if( this == pFirst )
+ pFirst = pNext;
+ else if( pPrev )
+ pPrev->pNext = pNext;
+ if( pNext )
+ pNext->pPrev = pPrev;
+}
+
+SbxInfo* SbUnoMethod::GetInfo()
+{
+ if( !pInfo.is() && m_xUnoMethod.is() )
+ {
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst && pInst->IsCompatibility() )
+ {
+ pInfo = new SbxInfo();
+
+ const Sequence<ParamInfo>& rInfoSeq = getParamInfos();
+ const ParamInfo* pParamInfos = rInfoSeq.getConstArray();
+ sal_uInt32 nParamCount = rInfoSeq.getLength();
+
+ for( sal_uInt32 i = 0 ; i < nParamCount ; i++ )
+ {
+ const ParamInfo& rInfo = pParamInfos[i];
+ OUString aParamName = rInfo.aName;
+
+ pInfo->AddParam( aParamName, SbxVARIANT, SbxFlagBits::Read );
+ }
+ }
+ }
+ return pInfo.get();
+}
+
+const Sequence<ParamInfo>& SbUnoMethod::getParamInfos()
+{
+ if (!pParamInfoSeq)
+ {
+ Sequence<ParamInfo> aTmp;
+ if (m_xUnoMethod.is())
+ aTmp = m_xUnoMethod->getParameterInfos();
+ pParamInfoSeq.reset( new Sequence<ParamInfo>(aTmp) );
+ }
+ return *pParamInfoSeq;
+}
+
+SbUnoProperty::SbUnoProperty
+(
+ const OUString& aName_,
+ SbxDataType eSbxType,
+ SbxDataType eRealSbxType,
+ const Property& aUnoProp_,
+ sal_Int32 nId_,
+ bool bInvocation,
+ bool bUnoStruct
+)
+ : SbxProperty( aName_, eSbxType )
+ , aUnoProp( aUnoProp_ )
+ , nId( nId_ )
+ , mbInvocation( bInvocation )
+ , mRealType( eRealSbxType )
+ , mbUnoStruct( bUnoStruct )
+{
+ // as needed establish a dummy array so that SbiRuntime::CheckArray() works
+ static SbxArrayRef xDummyArray = new SbxArray( SbxVARIANT );
+ if( eSbxType & SbxARRAY )
+ PutObject( xDummyArray.get() );
+}
+
+SbUnoProperty::~SbUnoProperty()
+{}
+
+
+SbxVariable* SbUnoObject::Find( const OUString& rName, SbxClassType t )
+{
+ static Reference< XIdlMethod > xDummyMethod;
+ static Property aDummyProp;
+
+ SbxVariable* pRes = SbxObject::Find( rName, t );
+
+ if( bNeedIntrospection )
+ doIntrospection();
+
+ // New 1999-03-04: Create properties on demand. Therefore search now via
+ // IntrospectionAccess if a property or a method of the required name exist
+ if( !pRes )
+ {
+ OUString aUName( rName );
+ if( mxUnoAccess.is() && !bNativeCOMObject )
+ {
+ if( mxExactName.is() )
+ {
+ OUString aUExactName = mxExactName->getExactName( aUName );
+ if( !aUExactName.isEmpty() )
+ {
+ aUName = aUExactName;
+ }
+ }
+ if( mxUnoAccess->hasProperty( aUName, PropertyConcept::ALL - PropertyConcept::DANGEROUS ) )
+ {
+ const Property& rProp = mxUnoAccess->
+ getProperty( aUName, PropertyConcept::ALL - PropertyConcept::DANGEROUS );
+
+ // If the property could be void the type had to be set to Variant
+ SbxDataType eSbxType;
+ if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
+ eSbxType = SbxVARIANT;
+ else
+ eSbxType = unoToSbxType( rProp.Type.getTypeClass() );
+
+ SbxDataType eRealSbxType = ( ( rProp.Attributes & PropertyAttribute::MAYBEVOID ) ? unoToSbxType( rProp.Type.getTypeClass() ) : eSbxType );
+ // create the property and superimpose it
+ auto pProp = tools::make_ref<SbUnoProperty>( rProp.Name, eSbxType, eRealSbxType, rProp, 0, false, ( rProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT ) );
+ QuickInsert( pProp.get() );
+ pRes = pProp.get();
+ }
+ else if( mxUnoAccess->hasMethod( aUName,
+ MethodConcept::ALL - MethodConcept::DANGEROUS ) )
+ {
+ // address the method
+ const Reference< XIdlMethod >& rxMethod = mxUnoAccess->
+ getMethod( aUName, MethodConcept::ALL - MethodConcept::DANGEROUS );
+
+ // create SbUnoMethod and superimpose it
+ auto xMethRef = tools::make_ref<SbUnoMethod>( rxMethod->getName(),
+ unoToSbxType( rxMethod->getReturnType() ), rxMethod, false );
+ QuickInsert( xMethRef.get() );
+ pRes = xMethRef.get();
+ }
+
+ // If nothing was found check via XNameAccess
+ if( !pRes )
+ {
+ try
+ {
+ Reference< XNameAccess > xNameAccess( mxUnoAccess->queryAdapter( cppu::UnoType<XPropertySet>::get()), UNO_QUERY );
+
+ if( xNameAccess.is() && xNameAccess->hasByName( rName ) )
+ {
+ Any aAny = xNameAccess->getByName( rName );
+
+ // ATTENTION: Because of XNameAccess, the variable generated here
+ // may not be included as a fixed property in the object and therefore
+ // won't be stored anywhere.
+ // If this leads to problems, it has to be created
+ // synthetically or a class SbUnoNameAccessProperty,
+ // which checks the existence on access and which
+ // is disposed if the name is not found anymore.
+ pRes = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( pRes, aAny );
+ }
+ }
+ catch( const NoSuchElementException& e )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
+ }
+ catch( const Exception& )
+ {
+ // Establish so that the exception error will not be overwritten
+ if( !pRes )
+ pRes = new SbxVariable( SbxVARIANT );
+
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ }
+ }
+ if( !pRes && mxInvocation.is() )
+ {
+ if( mxExactNameInvocation.is() )
+ {
+ OUString aUExactName = mxExactNameInvocation->getExactName( aUName );
+ if( !aUExactName.isEmpty() )
+ {
+ aUName = aUExactName;
+ }
+ }
+
+ try
+ {
+ if( mxInvocation->hasProperty( aUName ) )
+ {
+ // create a property and superimpose it
+ auto xVarRef = tools::make_ref<SbUnoProperty>( aUName, SbxVARIANT, SbxVARIANT, aDummyProp, 0, true, false );
+ QuickInsert( xVarRef.get() );
+ pRes = xVarRef.get();
+ }
+ else if( mxInvocation->hasMethod( aUName ) )
+ {
+ // create SbUnoMethode and superimpose it
+ auto xMethRef = tools::make_ref<SbUnoMethod>( aUName, SbxVARIANT, xDummyMethod, true );
+ QuickInsert( xMethRef.get() );
+ pRes = xMethRef.get();
+ }
+ else
+ {
+ Reference< XDirectInvocation > xDirectInvoke( mxInvocation, UNO_QUERY );
+ if ( xDirectInvoke.is() && xDirectInvoke->hasMember( aUName ) )
+ {
+ auto xMethRef = tools::make_ref<SbUnoMethod>( aUName, SbxVARIANT, xDummyMethod, true );
+ QuickInsert( xMethRef.get() );
+ pRes = xMethRef.get();
+ }
+
+ }
+ }
+ catch( const RuntimeException& e )
+ {
+ // Establish so that the exception error will not be overwritten
+ if( !pRes )
+ pRes = new SbxVariable( SbxVARIANT );
+
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION, implGetExceptionMsg( e ) );
+ }
+ }
+ }
+
+ // At the very end checking if the Dbg_-Properties are meant
+
+ if( !pRes )
+ {
+ if( rName.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES) ||
+ rName.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES) ||
+ rName.equalsIgnoreAsciiCase(ID_DBG_METHODS) )
+ {
+ // Create
+ implCreateDbgProperties();
+
+ // Now they have to be found regular
+ pRes = SbxObject::Find( rName, SbxClassType::DontCare );
+ }
+ }
+ return pRes;
+}
+
+
+// help method to create the dbg_-Properties
+void SbUnoObject::implCreateDbgProperties()
+{
+ Property aProp;
+
+ // Id == -1: display the implemented interfaces corresponding the ClassProvider
+ auto xVarRef = tools::make_ref<SbUnoProperty>( OUString(ID_DBG_SUPPORTEDINTERFACES), SbxSTRING, SbxSTRING, aProp, -1, false, false );
+ QuickInsert( xVarRef.get() );
+
+ // Id == -2: output the properties
+ xVarRef = tools::make_ref<SbUnoProperty>( OUString(ID_DBG_PROPERTIES), SbxSTRING, SbxSTRING, aProp, -2, false, false );
+ QuickInsert( xVarRef.get() );
+
+ // Id == -3: output the Methods
+ xVarRef = tools::make_ref<SbUnoProperty>( OUString(ID_DBG_METHODS), SbxSTRING, SbxSTRING, aProp, -3, false, false );
+ QuickInsert( xVarRef.get() );
+}
+
+void SbUnoObject::implCreateAll()
+{
+ // throw away all existing methods and properties
+ pMethods = tools::make_ref<SbxArray>();
+ pProps = tools::make_ref<SbxArray>();
+
+ if( bNeedIntrospection ) doIntrospection();
+
+ // get introspection
+ Reference< XIntrospectionAccess > xAccess = mxUnoAccess;
+ if( !xAccess.is() || bNativeCOMObject )
+ {
+ if( mxInvocation.is() )
+ xAccess = mxInvocation->getIntrospection();
+ else if( bNativeCOMObject )
+ return;
+ }
+ if( !xAccess.is() )
+ return;
+
+ // Establish properties
+ Sequence<Property> props = xAccess->getProperties( PropertyConcept::ALL - PropertyConcept::DANGEROUS );
+ sal_uInt32 nPropCount = props.getLength();
+ const Property* pProps_ = props.getConstArray();
+
+ sal_uInt32 i;
+ for( i = 0 ; i < nPropCount ; i++ )
+ {
+ const Property& rProp = pProps_[ i ];
+
+ // If the property could be void the type had to be set to Variant
+ SbxDataType eSbxType;
+ if( rProp.Attributes & PropertyAttribute::MAYBEVOID )
+ eSbxType = SbxVARIANT;
+ else
+ eSbxType = unoToSbxType( rProp.Type.getTypeClass() );
+
+ SbxDataType eRealSbxType = ( ( rProp.Attributes & PropertyAttribute::MAYBEVOID ) ? unoToSbxType( rProp.Type.getTypeClass() ) : eSbxType );
+ // Create property and superimpose it
+ auto xVarRef = tools::make_ref<SbUnoProperty>( rProp.Name, eSbxType, eRealSbxType, rProp, i, false, ( rProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT ) );
+ QuickInsert( xVarRef.get() );
+ }
+
+ // Create Dbg_-Properties
+ implCreateDbgProperties();
+
+ // Create methods
+ Sequence< Reference< XIdlMethod > > aMethodSeq = xAccess->getMethods
+ ( MethodConcept::ALL - MethodConcept::DANGEROUS );
+ sal_uInt32 nMethCount = aMethodSeq.getLength();
+ const Reference< XIdlMethod >* pMethods_ = aMethodSeq.getConstArray();
+ for( i = 0 ; i < nMethCount ; i++ )
+ {
+ // address method
+ const Reference< XIdlMethod >& rxMethod = pMethods_[i];
+
+ // Create SbUnoMethod and superimpose it
+ auto xMethRef = tools::make_ref<SbUnoMethod>
+ ( rxMethod->getName(), unoToSbxType( rxMethod->getReturnType() ), rxMethod, false );
+ QuickInsert( xMethRef.get() );
+ }
+}
+
+
+// output the value
+Any SbUnoObject::getUnoAny()
+{
+ Any aRetAny;
+ if( bNeedIntrospection ) doIntrospection();
+ if ( maStructInfo )
+ aRetAny = maTmpUnoObj;
+ else if( mxMaterialHolder.is() )
+ aRetAny = mxMaterialHolder->getMaterial();
+ else if( mxInvocation.is() )
+ aRetAny <<= mxInvocation;
+ return aRetAny;
+}
+
+// help method to create a Uno-Struct per CoreReflection
+static SbUnoObject* Impl_CreateUnoStruct( const OUString& aClassName )
+{
+ // get CoreReflection
+ Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
+ if( !xCoreReflection.is() )
+ return nullptr;
+
+ // search for the class
+ Reference< XIdlClass > xClass;
+ const Reference< XHierarchicalNameAccess >& xHarryName =
+ getCoreReflection_HierarchicalNameAccess_Impl();
+ if( xHarryName.is() && xHarryName->hasByHierarchicalName( aClassName ) )
+ xClass = xCoreReflection->forName( aClassName );
+ if( !xClass.is() )
+ return nullptr;
+
+ // Is it really a struct?
+ TypeClass eType = xClass->getTypeClass();
+ if ( ( eType != TypeClass_STRUCT ) && ( eType != TypeClass_EXCEPTION ) )
+ return nullptr;
+
+ // create an instance
+ Any aNewAny;
+ xClass->createObject( aNewAny );
+ // make a SbUnoObject out of it
+ SbUnoObject* pUnoObj = new SbUnoObject( aClassName, aNewAny );
+ return pUnoObj;
+}
+
+
+// Factory-Class to create Uno-Structs per DIM AS NEW
+SbxBase* SbUnoFactory::Create( sal_uInt16, sal_uInt32 )
+{
+ // Via SbxId nothing works in Uno
+ return nullptr;
+}
+
+SbxObject* SbUnoFactory::CreateObject( const OUString& rClassName )
+{
+ return Impl_CreateUnoStruct( rClassName );
+}
+
+
+// Provisional interface for the UNO-Connection
+// Deliver a SbxObject, that wrap a Uno-Interface
+SbxObjectRef GetSbUnoObject( const OUString& aName, const Any& aUnoObj_ )
+{
+ return new SbUnoObject( aName, aUnoObj_ );
+}
+
+// Force creation of all properties for debugging
+void createAllObjectProperties( SbxObject* pObj )
+{
+ if( !pObj )
+ return;
+
+ SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
+ SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( pObj );
+ if( pUnoObj )
+ {
+ pUnoObj->createAllProperties();
+ }
+ else if ( pUnoStructObj )
+ {
+ pUnoStructObj->createAllProperties();
+ }
+}
+
+
+void RTL_Impl_CreateUnoStruct( SbxArray& rPar )
+{
+ // We need 1 parameter minimum
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // get the name of the class of the struct
+ OUString aClassName = rPar.Get32(1)->GetOUString();
+
+ // try to create Struct with the same name
+ SbUnoObjectRef xUnoObj = Impl_CreateUnoStruct( aClassName );
+ if( !xUnoObj.is() )
+ {
+ return;
+ }
+ // return the object
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutObject( xUnoObj.get() );
+}
+
+void RTL_Impl_CreateUnoService( SbxArray& rPar )
+{
+ // We need 1 Parameter minimum
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // get the name of the class of the struct
+ OUString aServiceName = rPar.Get32(1)->GetOUString();
+
+ // search for the service and instantiate it
+ Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
+ Reference< XInterface > xInterface;
+ try
+ {
+ xInterface = xFactory->createInstance( aServiceName );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+
+ SbxVariableRef refVar = rPar.Get32(0);
+ if( xInterface.is() )
+ {
+ // Create a SbUnoObject out of it and return it
+ SbUnoObjectRef xUnoObj = new SbUnoObject( aServiceName, Any(xInterface) );
+ if( xUnoObj->getUnoAny().hasValue() )
+ {
+ // return the object
+ refVar->PutObject( xUnoObj.get() );
+ }
+ else
+ {
+ refVar->PutObject( nullptr );
+ }
+ }
+ else
+ {
+ refVar->PutObject( nullptr );
+ }
+}
+
+void RTL_Impl_CreateUnoServiceWithArguments( SbxArray& rPar )
+{
+ // We need 2 parameter minimum
+ if ( rPar.Count32() < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // get the name of the class of the struct
+ OUString aServiceName = rPar.Get32(1)->GetOUString();
+ Any aArgAsAny = sbxToUnoValue( rPar.Get32(2),
+ cppu::UnoType<Sequence<Any>>::get() );
+ Sequence< Any > aArgs;
+ aArgAsAny >>= aArgs;
+
+ // search for the service and instantiate it
+ Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
+ Reference< XInterface > xInterface;
+ try
+ {
+ xInterface = xFactory->createInstanceWithArguments( aServiceName, aArgs );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+
+ SbxVariableRef refVar = rPar.Get32(0);
+ if( xInterface.is() )
+ {
+ // Create a SbUnoObject out of it and return it
+ SbUnoObjectRef xUnoObj = new SbUnoObject( aServiceName, Any(xInterface) );
+ if( xUnoObj->getUnoAny().hasValue() )
+ {
+ // return the object
+ refVar->PutObject( xUnoObj.get() );
+ }
+ else
+ {
+ refVar->PutObject( nullptr );
+ }
+ }
+ else
+ {
+ refVar->PutObject( nullptr );
+ }
+}
+
+void RTL_Impl_GetProcessServiceManager( SbxArray& rPar )
+{
+ SbxVariableRef refVar = rPar.Get32(0);
+
+ // get the global service manager
+ Reference< XMultiServiceFactory > xFactory( comphelper::getProcessServiceFactory() );
+
+ // Create a SbUnoObject out of it and return it
+ SbUnoObjectRef xUnoObj = new SbUnoObject( "ProcessServiceManager", Any(xFactory) );
+ refVar->PutObject( xUnoObj.get() );
+}
+
+void RTL_Impl_HasInterfaces( SbxArray& rPar )
+{
+ // We need 2 parameter minimum
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // variable for the return value
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutBool( false );
+
+ // get the Uno-Object
+ SbxBaseRef pObj = rPar.Get32( 1 )->GetObject();
+ auto obj = dynamic_cast<SbUnoObject*>( pObj.get() );
+ if( obj == nullptr )
+ {
+ return;
+ }
+ Any aAny = obj->getUnoAny();
+ auto x = o3tl::tryAccess<Reference<XInterface>>(aAny);
+ if( !x )
+ {
+ return;
+ }
+
+ // get CoreReflection
+ Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
+ if( !xCoreReflection.is() )
+ {
+ return;
+ }
+ for( sal_uInt32 i = 2 ; i < nParCount ; i++ )
+ {
+ // get the name of the interface of the struct
+ OUString aIfaceName = rPar.Get32( i )->GetOUString();
+
+ // search for the class
+ Reference< XIdlClass > xClass = xCoreReflection->forName( aIfaceName );
+ if( !xClass.is() )
+ {
+ return;
+ }
+ // check if the interface will be supported
+ OUString aClassName = xClass->getName();
+ Type aClassType( xClass->getTypeClass(), aClassName );
+ if( !(*x)->queryInterface( aClassType ).hasValue() )
+ {
+ return;
+ }
+ }
+
+ // Everything works; then return TRUE
+ refVar->PutBool( true );
+}
+
+void RTL_Impl_IsUnoStruct( SbxArray& rPar )
+{
+ // We need 1 parameter minimum
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // variable for the return value
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutBool( false );
+
+ // get the Uno-Object
+ SbxVariableRef xParam = rPar.Get32( 1 );
+ if( !xParam->IsObject() )
+ {
+ return;
+ }
+ SbxBaseRef pObj = xParam->GetObject();
+ auto obj = dynamic_cast<SbUnoObject*>( pObj.get() );
+ if( obj == nullptr )
+ {
+ return;
+ }
+ Any aAny = obj->getUnoAny();
+ TypeClass eType = aAny.getValueType().getTypeClass();
+ if( eType == TypeClass_STRUCT )
+ {
+ refVar->PutBool( true );
+ }
+}
+
+
+void RTL_Impl_EqualUnoObjects( SbxArray& rPar )
+{
+ if ( rPar.Count32() < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // variable for the return value
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutBool( false );
+
+ // get the Uno-Objects
+ SbxVariableRef xParam1 = rPar.Get32( 1 );
+ if( !xParam1->IsObject() )
+ {
+ return;
+ }
+ SbxBaseRef pObj1 = xParam1->GetObject();
+ auto obj1 = dynamic_cast<SbUnoObject*>( pObj1.get() );
+ if( obj1 == nullptr )
+ {
+ return;
+ }
+ Any aAny1 = obj1->getUnoAny();
+ TypeClass eType1 = aAny1.getValueType().getTypeClass();
+ if( eType1 != TypeClass_INTERFACE )
+ {
+ return;
+ }
+ Reference< XInterface > x1;
+ aAny1 >>= x1;
+
+ SbxVariableRef xParam2 = rPar.Get32( 2 );
+ if( !xParam2->IsObject() )
+ {
+ return;
+ }
+ SbxBaseRef pObj2 = xParam2->GetObject();
+ auto obj2 = dynamic_cast<SbUnoObject*>( pObj2.get() );
+ if( obj2 == nullptr )
+ {
+ return;
+ }
+ Any aAny2 = obj2->getUnoAny();
+ TypeClass eType2 = aAny2.getValueType().getTypeClass();
+ if( eType2 != TypeClass_INTERFACE )
+ {
+ return;
+ }
+ Reference< XInterface > x2;
+ aAny2 >>= x2;
+
+ if( x1 == x2 )
+ {
+ refVar->PutBool( true );
+ }
+}
+
+
+// helper wrapper function to interact with TypeProvider and
+// XTypeDescriptionEnumerationAccess.
+// if it fails for whatever reason
+// returned Reference<> be null e.g. .is() will be false
+
+static Reference< XTypeDescriptionEnumeration > getTypeDescriptorEnumeration( const OUString& sSearchRoot,
+ const Sequence< TypeClass >& types,
+ TypeDescriptionSearchDepth depth )
+{
+ Reference< XTypeDescriptionEnumeration > xEnum;
+ Reference< XTypeDescriptionEnumerationAccess> xTypeEnumAccess( getTypeProvider_Impl(), UNO_QUERY );
+ if ( xTypeEnumAccess.is() )
+ {
+ try
+ {
+ xEnum = xTypeEnumAccess->createTypeDescriptionEnumeration(
+ sSearchRoot, types, depth );
+ }
+ catch(const NoSuchTypeNameException& /*nstne*/ ) {}
+ catch(const InvalidTypeNameException& /*nstne*/ ) {}
+ }
+ return xEnum;
+}
+
+VBAConstantHelper&
+VBAConstantHelper::instance()
+{
+ static VBAConstantHelper aHelper;
+ return aHelper;
+}
+
+void VBAConstantHelper::init()
+{
+ if ( isInited )
+ return;
+
+ Reference< XTypeDescriptionEnumeration > xEnum = getTypeDescriptorEnumeration( "ooo.vba", {TypeClass_CONSTANTS}, TypeDescriptionSearchDepth_INFINITE );
+
+ if ( !xEnum.is())
+ {
+ return; //NULL;
+ }
+ while ( xEnum->hasMoreElements() )
+ {
+ Reference< XConstantsTypeDescription > xConstants( xEnum->nextElement(), UNO_QUERY );
+ if ( xConstants.is() )
+ {
+ // store constant group name
+ OUString sFullName = xConstants->getName();
+ sal_Int32 indexLastDot = sFullName.lastIndexOf('.');
+ OUString sLeafName( sFullName );
+ if ( indexLastDot > -1 )
+ {
+ sLeafName = sFullName.copy( indexLastDot + 1);
+ }
+ aConstCache.push_back( sLeafName ); // assume constant group names are unique
+ const Sequence< Reference< XConstantTypeDescription > > aConsts = xConstants->getConstants();
+ for (const auto& ctd : aConsts)
+ {
+ // store constant member name
+ sFullName = ctd->getName();
+ indexLastDot = sFullName.lastIndexOf('.');
+ sLeafName = sFullName;
+ if ( indexLastDot > -1 )
+ {
+ sLeafName = sFullName.copy( indexLastDot + 1);
+ }
+ aConstHash[ sLeafName.toAsciiLowerCase() ] = ctd->getConstantValue();
+ }
+ }
+ }
+ isInited = true;
+}
+
+bool
+VBAConstantHelper::isVBAConstantType( const OUString& rName )
+{
+ init();
+ bool bConstant = false;
+
+ for (auto const& elem : aConstCache)
+ {
+ if( rName.equalsIgnoreAsciiCase(elem) )
+ {
+ bConstant = true;
+ break;
+ }
+ }
+ return bConstant;
+}
+
+SbxVariable*
+VBAConstantHelper::getVBAConstant( const OUString& rName )
+{
+ SbxVariable* pConst = nullptr;
+ init();
+
+ auto it = aConstHash.find( rName.toAsciiLowerCase() );
+
+ if ( it != aConstHash.end() )
+ {
+ pConst = new SbxVariable( SbxVARIANT );
+ pConst->SetName( rName );
+ unoToSbxValue( pConst, it->second );
+ }
+
+ return pConst;
+}
+
+// Function to search for a global identifier in the
+// UnoScope and to wrap it for Sbx
+SbUnoClass* findUnoClass( const OUString& rName )
+{
+ // #105550 Check if module exists
+ SbUnoClass* pUnoClass = nullptr;
+
+ const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
+ if( xTypeAccess->hasByHierarchicalName( rName ) )
+ {
+ Any aRet = xTypeAccess->getByHierarchicalName( rName );
+ Reference< XTypeDescription > xTypeDesc;
+ aRet >>= xTypeDesc;
+
+ if( xTypeDesc.is() )
+ {
+ TypeClass eTypeClass = xTypeDesc->getTypeClass();
+ if( eTypeClass == TypeClass_MODULE || eTypeClass == TypeClass_CONSTANTS )
+ {
+ pUnoClass = new SbUnoClass( rName );
+ }
+ }
+ }
+ return pUnoClass;
+}
+
+SbxVariable* SbUnoClass::Find( const OUString& rName, SbxClassType )
+{
+ SbxVariable* pRes = SbxObject::Find( rName, SbxClassType::Variable );
+
+ // If nothing were located the submodule isn't known yet
+ if( !pRes )
+ {
+ // If it is already a class, ask for the field
+ if( m_xClass.is() )
+ {
+ // Is it a field(?)
+ Reference< XIdlField > xField = m_xClass->getField( rName );
+ if( xField.is() )
+ {
+ try
+ {
+ Any aAny = xField->get( {} ); //TODO: does this make sense?
+
+ // Convert to Sbx
+ pRes = new SbxVariable( SbxVARIANT );
+ pRes->SetName( rName );
+ unoToSbxValue( pRes, aAny );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ }
+ }
+ else
+ {
+ // expand fully qualified name
+ OUString aNewName = GetName()
+ + "."
+ + rName;
+
+ // get CoreReflection
+ Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
+ if( xCoreReflection.is() )
+ {
+ // Is it a constant?
+ Reference< XHierarchicalNameAccess > xHarryName( xCoreReflection, UNO_QUERY );
+ if( xHarryName.is() )
+ {
+ try
+ {
+ Any aValue = xHarryName->getByHierarchicalName( aNewName );
+ TypeClass eType = aValue.getValueType().getTypeClass();
+
+ // Interface located? Then it is a class
+ if( eType == TypeClass_INTERFACE )
+ {
+ Reference< XIdlClass > xClass( aValue, UNO_QUERY );
+ if( xClass.is() )
+ {
+ pRes = new SbxVariable( SbxVARIANT );
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoClass( aNewName, xClass ));
+ pRes->PutObject( xWrapper.get() );
+ }
+ }
+ else
+ {
+ pRes = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( pRes, aValue );
+ }
+ }
+ catch( const NoSuchElementException& )
+ {
+ }
+ }
+
+ // Otherwise take it again as class
+ if( !pRes )
+ {
+ SbUnoClass* pNewClass = findUnoClass( aNewName );
+ if( pNewClass )
+ {
+ pRes = new SbxVariable( SbxVARIANT );
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(pNewClass);
+ pRes->PutObject( xWrapper.get() );
+ }
+ }
+
+ // A UNO service?
+ if( !pRes )
+ {
+ SbUnoService* pUnoService = findUnoService( aNewName );
+ if( pUnoService )
+ {
+ pRes = new SbxVariable( SbxVARIANT );
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(pUnoService);
+ pRes->PutObject( xWrapper.get() );
+ }
+ }
+
+ // A UNO singleton?
+ if( !pRes )
+ {
+ SbUnoSingleton* pUnoSingleton = findUnoSingleton( aNewName );
+ if( pUnoSingleton )
+ {
+ pRes = new SbxVariable( SbxVARIANT );
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(pUnoSingleton);
+ pRes->PutObject( xWrapper.get() );
+ }
+ }
+ }
+ }
+
+ if( pRes )
+ {
+ pRes->SetName( rName );
+
+ // Insert variable, so that it could be found later
+ QuickInsert( pRes );
+
+ // Take us out as listener at once,
+ // the values are all constant
+ if( pRes->IsBroadcaster() )
+ EndListening( pRes->GetBroadcaster(), true );
+ }
+ }
+ return pRes;
+}
+
+
+SbUnoService* findUnoService( const OUString& rName )
+{
+ SbUnoService* pSbUnoService = nullptr;
+
+ const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
+ if( xTypeAccess->hasByHierarchicalName( rName ) )
+ {
+ Any aRet = xTypeAccess->getByHierarchicalName( rName );
+ Reference< XTypeDescription > xTypeDesc;
+ aRet >>= xTypeDesc;
+
+ if( xTypeDesc.is() )
+ {
+ TypeClass eTypeClass = xTypeDesc->getTypeClass();
+ if( eTypeClass == TypeClass_SERVICE )
+ {
+ Reference< XServiceTypeDescription2 > xServiceTypeDesc( xTypeDesc, UNO_QUERY );
+ if( xServiceTypeDesc.is() )
+ pSbUnoService = new SbUnoService( rName, xServiceTypeDesc );
+ }
+ }
+ }
+ return pSbUnoService;
+}
+
+SbxVariable* SbUnoService::Find( const OUString& rName, SbxClassType )
+{
+ SbxVariable* pRes = SbxObject::Find( rName, SbxClassType::Method );
+
+ if( !pRes )
+ {
+ // If it is already a class ask for a field
+ if( m_bNeedsInit && m_xServiceTypeDesc.is() )
+ {
+ m_bNeedsInit = false;
+
+ Sequence< Reference< XServiceConstructorDescription > > aSCDSeq = m_xServiceTypeDesc->getConstructors();
+ const Reference< XServiceConstructorDescription >* pCtorSeq = aSCDSeq.getConstArray();
+ int nCtorCount = aSCDSeq.getLength();
+ for( int i = 0 ; i < nCtorCount ; ++i )
+ {
+ Reference< XServiceConstructorDescription > xCtor = pCtorSeq[i];
+
+ OUString aName( xCtor->getName() );
+ if( aName.isEmpty() )
+ {
+ if( xCtor->isDefaultConstructor() )
+ {
+ aName = "create";
+ }
+ }
+
+ if( !aName.isEmpty() )
+ {
+ // Create and insert SbUnoServiceCtor
+ SbxVariableRef xSbCtorRef = new SbUnoServiceCtor( aName, xCtor );
+ QuickInsert( xSbCtorRef.get() );
+ }
+ }
+ pRes = SbxObject::Find( rName, SbxClassType::Method );
+ }
+ }
+
+ return pRes;
+}
+
+void SbUnoService::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+ if( !pHint )
+ return;
+
+ SbxVariable* pVar = pHint->GetVar();
+ SbxArray* pParams = pVar->GetParameters();
+ SbUnoServiceCtor* pUnoCtor = dynamic_cast<SbUnoServiceCtor*>( pVar );
+ if( pUnoCtor && pHint->GetId() == SfxHintId::BasicDataWanted )
+ {
+ // Parameter count -1 because of Param0 == this
+ sal_uInt32 nParamCount = pParams ? (pParams->Count32() - 1) : 0;
+ Sequence<Any> args;
+
+ Reference< XServiceConstructorDescription > xCtor = pUnoCtor->getServiceCtorDesc();
+ Sequence< Reference< XParameter > > aParameterSeq = xCtor->getParameters();
+ const Reference< XParameter >* pParameterSeq = aParameterSeq.getConstArray();
+ sal_uInt32 nUnoParamCount = aParameterSeq.getLength();
+
+ // Default: Ignore not needed parameters
+ bool bParameterError = false;
+
+ // Is the last parameter a rest parameter?
+ bool bRestParameterMode = false;
+ if( nUnoParamCount > 0 )
+ {
+ Reference< XParameter > xLastParam = pParameterSeq[ nUnoParamCount - 1 ];
+ if( xLastParam.is() )
+ {
+ if( xLastParam->isRestParameter() )
+ bRestParameterMode = true;
+ }
+ }
+
+ // Too many parameters with context as first parameter?
+ sal_uInt32 nSbxParameterOffset = 1;
+ sal_uInt32 nParameterOffsetByContext = 0;
+ Reference < XComponentContext > xFirstParamContext;
+ if( nParamCount > nUnoParamCount )
+ {
+ // Check if first parameter is a context and use it
+ // then in createInstanceWithArgumentsAndContext
+ Any aArg0 = sbxToUnoValue( pParams->Get32( nSbxParameterOffset ) );
+ if( (aArg0 >>= xFirstParamContext) && xFirstParamContext.is() )
+ nParameterOffsetByContext = 1;
+ }
+
+ sal_uInt32 nEffectiveParamCount = nParamCount - nParameterOffsetByContext;
+ sal_uInt32 nAllocParamCount = nEffectiveParamCount;
+ if( nEffectiveParamCount > nUnoParamCount )
+ {
+ if( !bRestParameterMode )
+ {
+ nEffectiveParamCount = nUnoParamCount;
+ nAllocParamCount = nUnoParamCount;
+ }
+ }
+ // Not enough parameters?
+ else if( nUnoParamCount > nEffectiveParamCount )
+ {
+ // RestParameterMode only helps if one (the last) parameter is missing
+ int nDiff = nUnoParamCount - nEffectiveParamCount;
+ if( !bRestParameterMode || nDiff > 1 )
+ {
+ bParameterError = true;
+ StarBASIC::Error( ERRCODE_BASIC_NOT_OPTIONAL );
+ }
+ }
+
+ if( !bParameterError )
+ {
+ bool bOutParams = false;
+ if( nAllocParamCount > 0 )
+ {
+ args.realloc( nAllocParamCount );
+ Any* pAnyArgs = args.getArray();
+ for( sal_uInt32 i = 0 ; i < nEffectiveParamCount ; i++ )
+ {
+ sal_uInt32 iSbx = i + nSbxParameterOffset + nParameterOffsetByContext;
+
+ // bRestParameterMode allows nEffectiveParamCount > nUnoParamCount
+ Reference< XParameter > xParam;
+ if( i < nUnoParamCount )
+ {
+ xParam = pParameterSeq[i];
+ if( !xParam.is() )
+ continue;
+
+ Reference< XTypeDescription > xParamTypeDesc = xParam->getType();
+ if( !xParamTypeDesc.is() )
+ continue;
+ css::uno::Type aType( xParamTypeDesc->getTypeClass(), xParamTypeDesc->getName() );
+
+ // sbx parameter needs offset 1
+ pAnyArgs[i] = sbxToUnoValue( pParams->Get32( iSbx ), aType );
+
+ // Check for out parameter if not already done
+ if( !bOutParams && xParam->isOut() )
+ bOutParams = true;
+ }
+ else
+ {
+ pAnyArgs[i] = sbxToUnoValue( pParams->Get32( iSbx ) );
+ }
+ }
+ }
+
+ // "Call" ctor using createInstanceWithArgumentsAndContext
+ Reference < XComponentContext > xContext(
+ xFirstParamContext.is()
+ ? xFirstParamContext
+ : comphelper::getProcessComponentContext() );
+ Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
+
+ Any aRetAny;
+ OUString aServiceName = GetName();
+ Reference < XInterface > xRet;
+ try
+ {
+ xRet = xServiceMgr->createInstanceWithArgumentsAndContext( aServiceName, args, xContext );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+ aRetAny <<= xRet;
+ unoToSbxValue( pVar, aRetAny );
+
+ // Copy back out parameters?
+ if( bOutParams )
+ {
+ const Any* pAnyArgs = args.getConstArray();
+
+ for( sal_uInt32 j = 0 ; j < nUnoParamCount ; j++ )
+ {
+ Reference< XParameter > xParam = pParameterSeq[j];
+ if( !xParam.is() )
+ continue;
+
+ if( xParam->isOut() )
+ unoToSbxValue( pParams->Get32(j + 1), pAnyArgs[ j ] );
+ }
+ }
+ }
+ }
+ else
+ SbxObject::Notify( rBC, rHint );
+}
+
+
+SbUnoServiceCtor::SbUnoServiceCtor( const OUString& aName_, Reference< XServiceConstructorDescription > const & xServiceCtorDesc )
+ : SbxMethod( aName_, SbxOBJECT )
+ , m_xServiceCtorDesc( xServiceCtorDesc )
+{
+}
+
+SbUnoServiceCtor::~SbUnoServiceCtor()
+{
+}
+
+SbxInfo* SbUnoServiceCtor::GetInfo()
+{
+ SbxInfo* pRet = nullptr;
+
+ return pRet;
+}
+
+
+SbUnoSingleton* findUnoSingleton( const OUString& rName )
+{
+ SbUnoSingleton* pSbUnoSingleton = nullptr;
+
+ const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
+ if( xTypeAccess->hasByHierarchicalName( rName ) )
+ {
+ Any aRet = xTypeAccess->getByHierarchicalName( rName );
+ Reference< XTypeDescription > xTypeDesc;
+ aRet >>= xTypeDesc;
+
+ if( xTypeDesc.is() )
+ {
+ TypeClass eTypeClass = xTypeDesc->getTypeClass();
+ if( eTypeClass == TypeClass_SINGLETON )
+ {
+ Reference< XSingletonTypeDescription > xSingletonTypeDesc( xTypeDesc, UNO_QUERY );
+ if( xSingletonTypeDesc.is() )
+ pSbUnoSingleton = new SbUnoSingleton( rName );
+ }
+ }
+ }
+ return pSbUnoSingleton;
+}
+
+SbUnoSingleton::SbUnoSingleton( const OUString& aName_ )
+ : SbxObject( aName_ )
+{
+ SbxVariableRef xGetMethodRef = new SbxMethod( "get", SbxOBJECT );
+ QuickInsert( xGetMethodRef.get() );
+}
+
+void SbUnoSingleton::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+ if( pHint )
+ {
+ SbxVariable* pVar = pHint->GetVar();
+ SbxArray* pParams = pVar->GetParameters();
+ sal_uInt32 nParamCount = pParams ? (pParams->Count32() - 1) : 0;
+ sal_uInt32 nAllowedParamCount = 1;
+
+ Reference < XComponentContext > xContextToUse;
+ if( nParamCount > 0 )
+ {
+ // Check if first parameter is a context and use it then
+ Reference < XComponentContext > xFirstParamContext;
+ Any aArg1 = sbxToUnoValue( pParams->Get32( 1 ) );
+ if( (aArg1 >>= xFirstParamContext) && xFirstParamContext.is() )
+ xContextToUse = xFirstParamContext;
+ }
+
+ if( !xContextToUse.is() )
+ {
+ xContextToUse = comphelper::getProcessComponentContext();
+ --nAllowedParamCount;
+ }
+
+ if( nParamCount > nAllowedParamCount )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ Any aRetAny;
+ if( xContextToUse.is() )
+ {
+ OUString aSingletonName = "/singletons/"
+ + GetName();
+ Reference < XInterface > xRet;
+ xContextToUse->getValueByName( aSingletonName ) >>= xRet;
+ aRetAny <<= xRet;
+ }
+ unoToSbxValue( pVar, aRetAny );
+ }
+ else
+ {
+ SbxObject::Notify( rBC, rHint );
+ }
+}
+
+namespace {
+
+// Implementation of an EventAttacher-drawn AllListener, which
+// solely transmits several events to a general AllListener
+class BasicAllListener_Impl : public WeakImplHelper< XAllListener >
+{
+ void firing_impl(const AllEventObject& Event, Any* pRet);
+
+public:
+ SbxObjectRef xSbxObj;
+ OUString aPrefixName;
+
+ explicit BasicAllListener_Impl( const OUString& aPrefixName );
+
+ // Methods of XAllListener
+ virtual void SAL_CALL firing(const AllEventObject& Event) override;
+ virtual Any SAL_CALL approveFiring(const AllEventObject& Event) override;
+
+ // Methods of XEventListener
+ virtual void SAL_CALL disposing(const EventObject& Source) override;
+};
+
+}
+
+BasicAllListener_Impl::BasicAllListener_Impl(const OUString& aPrefixName_)
+ : aPrefixName( aPrefixName_ )
+{
+}
+
+void BasicAllListener_Impl::firing_impl( const AllEventObject& Event, Any* pRet )
+{
+ SolarMutexGuard guard;
+
+ if( !xSbxObj.is() )
+ return;
+
+ OUString aMethodName = aPrefixName + Event.MethodName;
+
+ SbxVariable * pP = xSbxObj.get();
+ while( pP->GetParent() )
+ {
+ pP = pP->GetParent();
+ StarBASIC * pLib = dynamic_cast<StarBASIC*>( pP );
+ if( pLib )
+ {
+ // Create in a Basic Array
+ SbxArrayRef xSbxArray = new SbxArray( SbxVARIANT );
+ const Any * pArgs = Event.Arguments.getConstArray();
+ sal_Int32 nCount = Event.Arguments.getLength();
+ for( sal_Int32 i = 0; i < nCount; i++ )
+ {
+ // Convert elements
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( xVar.get(), pArgs[i] );
+ xSbxArray->Put32( xVar.get(), i + 1 );
+ }
+
+ pLib->Call( aMethodName, xSbxArray.get() );
+
+ // get the return value from the Param-Array, if requested
+ if( pRet )
+ {
+ SbxVariable* pVar = xSbxArray->Get32( 0 );
+ if( pVar )
+ {
+ // #95792 Avoid a second call
+ SbxFlagBits nFlags = pVar->GetFlags();
+ pVar->SetFlag( SbxFlagBits::NoBroadcast );
+ *pRet = sbxToUnoValueImpl( pVar );
+ pVar->SetFlags( nFlags );
+ }
+ }
+ break;
+ }
+ }
+}
+
+
+// Methods of Listener
+void BasicAllListener_Impl::firing( const AllEventObject& Event )
+{
+ firing_impl( Event, nullptr );
+}
+
+Any BasicAllListener_Impl::approveFiring( const AllEventObject& Event )
+{
+ Any aRetAny;
+ firing_impl( Event, &aRetAny );
+ return aRetAny;
+}
+
+
+// Methods of XEventListener
+void BasicAllListener_Impl ::disposing(const EventObject& )
+{
+ SolarMutexGuard guard;
+
+ xSbxObj.clear();
+}
+
+
+// class InvocationToAllListenerMapper
+// helper class to map XInvocation to XAllListener (also in project eventattacher!)
+
+namespace {
+
+class InvocationToAllListenerMapper : public WeakImplHelper< XInvocation >
+{
+public:
+ InvocationToAllListenerMapper( const Reference< XIdlClass >& ListenerType,
+ const Reference< XAllListener >& AllListener, const Any& Helper );
+
+ // XInvocation
+ virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection() override;
+ virtual Any SAL_CALL invoke(const OUString& FunctionName, const Sequence< Any >& Params, Sequence< sal_Int16 >& OutParamIndex, Sequence< Any >& OutParam) override;
+ virtual void SAL_CALL setValue(const OUString& PropertyName, const Any& Value) override;
+ virtual Any SAL_CALL getValue(const OUString& PropertyName) override;
+ virtual sal_Bool SAL_CALL hasMethod(const OUString& Name) override;
+ virtual sal_Bool SAL_CALL hasProperty(const OUString& Name) override;
+
+private:
+ Reference< XAllListener > m_xAllListener;
+ Reference< XIdlClass > m_xListenerType;
+ Any m_Helper;
+};
+
+}
+
+// Function to replace AllListenerAdapterService::createAllListerAdapter
+static Reference< XInterface > createAllListenerAdapter
+(
+ const Reference< XInvocationAdapterFactory2 >& xInvocationAdapterFactory,
+ const Reference< XIdlClass >& xListenerType,
+ const Reference< XAllListener >& xListener,
+ const Any& Helper
+)
+{
+ Reference< XInterface > xAdapter;
+ if( xInvocationAdapterFactory.is() && xListenerType.is() && xListener.is() )
+ {
+ Reference< XInvocation > xInvocationToAllListenerMapper =
+ new InvocationToAllListenerMapper(xListenerType, xListener, Helper);
+ Type aListenerType( xListenerType->getTypeClass(), xListenerType->getName() );
+ xAdapter = xInvocationAdapterFactory->createAdapter( xInvocationToAllListenerMapper, {aListenerType} );
+ }
+ return xAdapter;
+}
+
+
+// InvocationToAllListenerMapper
+InvocationToAllListenerMapper::InvocationToAllListenerMapper
+ ( const Reference< XIdlClass >& ListenerType, const Reference< XAllListener >& AllListener, const Any& Helper )
+ : m_xAllListener( AllListener )
+ , m_xListenerType( ListenerType )
+ , m_Helper( Helper )
+{
+}
+
+
+Reference< XIntrospectionAccess > SAL_CALL InvocationToAllListenerMapper::getIntrospection()
+{
+ return Reference< XIntrospectionAccess >();
+}
+
+
+Any SAL_CALL InvocationToAllListenerMapper::invoke(const OUString& FunctionName, const Sequence< Any >& Params,
+ Sequence< sal_Int16 >&, Sequence< Any >&)
+{
+ Any aRet;
+
+ // Check if to firing or approveFiring has to be called
+ Reference< XIdlMethod > xMethod = m_xListenerType->getMethod( FunctionName );
+ bool bApproveFiring = false;
+ if( !xMethod.is() )
+ return aRet;
+ Reference< XIdlClass > xReturnType = xMethod->getReturnType();
+ Sequence< Reference< XIdlClass > > aExceptionSeq = xMethod->getExceptionTypes();
+ if( ( xReturnType.is() && xReturnType->getTypeClass() != TypeClass_VOID ) ||
+ aExceptionSeq.hasElements() )
+ {
+ bApproveFiring = true;
+ }
+ else
+ {
+ Sequence< ParamInfo > aParamSeq = xMethod->getParameterInfos();
+ sal_uInt32 nParamCount = aParamSeq.getLength();
+ if( nParamCount > 1 )
+ {
+ const ParamInfo* pInfo = aParamSeq.getConstArray();
+ for( sal_uInt32 i = 0 ; i < nParamCount ; i++ )
+ {
+ if( pInfo[ i ].aMode != ParamMode_IN )
+ {
+ bApproveFiring = true;
+ break;
+ }
+ }
+ }
+ }
+
+ AllEventObject aAllEvent;
+ aAllEvent.Source = static_cast<OWeakObject*>(this);
+ aAllEvent.Helper = m_Helper;
+ aAllEvent.ListenerType = Type(m_xListenerType->getTypeClass(), m_xListenerType->getName() );
+ aAllEvent.MethodName = FunctionName;
+ aAllEvent.Arguments = Params;
+ if( bApproveFiring )
+ aRet = m_xAllListener->approveFiring( aAllEvent );
+ else
+ m_xAllListener->firing( aAllEvent );
+ return aRet;
+}
+
+
+void SAL_CALL InvocationToAllListenerMapper::setValue(const OUString&, const Any&)
+{}
+
+
+Any SAL_CALL InvocationToAllListenerMapper::getValue(const OUString&)
+{
+ return Any();
+}
+
+
+sal_Bool SAL_CALL InvocationToAllListenerMapper::hasMethod(const OUString& Name)
+{
+ Reference< XIdlMethod > xMethod = m_xListenerType->getMethod( Name );
+ return xMethod.is();
+}
+
+
+sal_Bool SAL_CALL InvocationToAllListenerMapper::hasProperty(const OUString& Name)
+{
+ Reference< XIdlField > xField = m_xListenerType->getField( Name );
+ return xField.is();
+}
+
+
+// create Uno-Service
+// 1. Parameter == Prefix-Name of the macro
+// 2. Parameter == fully qualified name of the listener
+void SbRtl_CreateUnoListener(StarBASIC * pBasic, SbxArray & rPar, bool)
+{
+ // We need 2 parameters
+ if ( rPar.Count32() != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // get the name of the class of the struct
+ OUString aPrefixName = rPar.Get32(1)->GetOUString();
+ OUString aListenerClassName = rPar.Get32(2)->GetOUString();
+
+ // get the CoreReflection
+ Reference< XIdlReflection > xCoreReflection = getCoreReflection_Impl();
+ if( !xCoreReflection.is() )
+ return;
+
+ // get the AllListenerAdapterService
+ Reference< XComponentContext > xContext( comphelper::getProcessComponentContext() );
+
+ // search the class
+ Reference< XIdlClass > xClass = xCoreReflection->forName( aListenerClassName );
+ if( !xClass.is() )
+ return;
+
+ // From 1999-11-30: get the InvocationAdapterFactory
+ Reference< XInvocationAdapterFactory2 > xInvocationAdapterFactory =
+ InvocationAdapterFactory::create( xContext );
+
+ BasicAllListener_Impl * p;
+ Reference< XAllListener > xAllLst = p = new BasicAllListener_Impl( aPrefixName );
+ Any aTmp;
+ Reference< XInterface > xLst = createAllListenerAdapter( xInvocationAdapterFactory, xClass, xAllLst, aTmp );
+ if( !xLst.is() )
+ return;
+
+ OUString aClassName = xClass->getName();
+ Type aClassType( xClass->getTypeClass(), aClassName );
+ aTmp = xLst->queryInterface( aClassType );
+ if( !aTmp.hasValue() )
+ return;
+
+ SbUnoObject* pUnoObj = new SbUnoObject( aListenerClassName, aTmp );
+ p->xSbxObj = pUnoObj;
+ p->xSbxObj->SetParent( pBasic );
+
+ // #100326 Register listener object to set Parent NULL in Dtor
+ SbxArrayRef xBasicUnoListeners = pBasic->getUnoListeners();
+ xBasicUnoListeners->Insert32( pUnoObj, xBasicUnoListeners->Count32() );
+
+ // return the object
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutObject( p->xSbxObj.get() );
+}
+
+
+// Represents the DefaultContext property of the ProcessServiceManager
+// in the Basic runtime system.
+void RTL_Impl_GetDefaultContext( SbxArray& rPar )
+{
+ SbxVariableRef refVar = rPar.Get32(0);
+
+ Any aContextAny( comphelper::getProcessComponentContext() );
+
+ SbUnoObjectRef xUnoObj = new SbUnoObject( "DefaultContext", aContextAny );
+ refVar->PutObject( xUnoObj.get() );
+}
+
+
+// Creates a Basic wrapper object for a strongly typed Uno value
+// 1. parameter: Uno type as full qualified type name, e.g. "byte[]"
+void RTL_Impl_CreateUnoValue( SbxArray& rPar )
+{
+ // 2 parameters needed
+ if ( rPar.Count32() != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // get the name of the class of the struct
+ OUString aTypeName = rPar.Get32(1)->GetOUString();
+ SbxVariable* pVal = rPar.Get32(2);
+
+ if( aTypeName == "type" )
+ {
+ SbxDataType eBaseType = pVal->SbxValue::GetType();
+ OUString aValTypeName;
+ if( eBaseType == SbxSTRING )
+ {
+ aValTypeName = pVal->GetOUString();
+ }
+ else if( eBaseType == SbxOBJECT )
+ {
+ // XIdlClass?
+ Reference< XIdlClass > xIdlClass;
+
+ SbxBaseRef pObj = pVal->GetObject();
+ if( auto obj = dynamic_cast<SbUnoObject*>( pObj.get() ) )
+ {
+ Any aUnoAny = obj->getUnoAny();
+ aUnoAny >>= xIdlClass;
+ }
+
+ if( xIdlClass.is() )
+ {
+ aValTypeName = xIdlClass->getName();
+ }
+ }
+ Type aType;
+ bool bSuccess = implGetTypeByName( aValTypeName, aType );
+ if( bSuccess )
+ {
+ Any aTypeAny( aType );
+ SbxVariableRef refVar = rPar.Get32(0);
+ SbxObjectRef xUnoAnyObject = new SbUnoAnyObject( aTypeAny );
+ refVar->PutObject( xUnoAnyObject.get() );
+ }
+ return;
+ }
+
+ // Check the type
+ const Reference< XHierarchicalNameAccess >& xTypeAccess = getTypeProvider_Impl();
+ Any aRet;
+ try
+ {
+ aRet = xTypeAccess->getByHierarchicalName( aTypeName );
+ }
+ catch( const NoSuchElementException& e1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_EXCEPTION,
+ implGetExceptionMsg( e1, "com.sun.star.container.NoSuchElementException" ) );
+ return;
+ }
+ Reference< XTypeDescription > xTypeDesc;
+ aRet >>= xTypeDesc;
+ TypeClass eTypeClass = xTypeDesc->getTypeClass();
+ Type aDestType( eTypeClass, aTypeName );
+
+
+ // Preconvert value
+ Any aVal = sbxToUnoValueImpl( pVal );
+ Any aConvertedVal = convertAny( aVal, aDestType );
+
+ SbxVariableRef refVar = rPar.Get32(0);
+ SbxObjectRef xUnoAnyObject = new SbUnoAnyObject( aConvertedVal );
+ refVar->PutObject( xUnoAnyObject.get() );
+}
+
+namespace {
+
+class ModuleInvocationProxy : public WeakImplHelper< XInvocation, XComponent >
+{
+ ::osl::Mutex m_aMutex;
+ OUString m_aPrefix;
+ SbxObjectRef m_xScopeObj;
+ bool m_bProxyIsClassModuleObject;
+
+ ::comphelper::OInterfaceContainerHelper2 m_aListeners;
+
+public:
+ ModuleInvocationProxy( OUString const & aPrefix, SbxObjectRef const & xScopeObj );
+
+ // XInvocation
+ virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection() override;
+ virtual void SAL_CALL setValue( const OUString& rProperty, const Any& rValue ) override;
+ virtual Any SAL_CALL getValue( const OUString& rProperty ) override;
+ virtual sal_Bool SAL_CALL hasMethod( const OUString& rName ) override;
+ virtual sal_Bool SAL_CALL hasProperty( const OUString& rProp ) override;
+
+ virtual Any SAL_CALL invoke( const OUString& rFunction,
+ const Sequence< Any >& rParams,
+ Sequence< sal_Int16 >& rOutParamIndex,
+ Sequence< Any >& rOutParam ) override;
+
+ // XComponent
+ virtual void SAL_CALL dispose() override;
+ virtual void SAL_CALL addEventListener( const Reference< XEventListener >& xListener ) override;
+ virtual void SAL_CALL removeEventListener( const Reference< XEventListener >& aListener ) override;
+};
+
+}
+
+ModuleInvocationProxy::ModuleInvocationProxy( OUString const & aPrefix, SbxObjectRef const & xScopeObj )
+ : m_aMutex()
+ , m_aPrefix( aPrefix + "_" )
+ , m_xScopeObj( xScopeObj )
+ , m_aListeners( m_aMutex )
+{
+ m_bProxyIsClassModuleObject = xScopeObj.is() && dynamic_cast<const SbClassModuleObject*>( xScopeObj.get() ) != nullptr;
+}
+
+Reference< XIntrospectionAccess > SAL_CALL ModuleInvocationProxy::getIntrospection()
+{
+ return Reference< XIntrospectionAccess >();
+}
+
+void SAL_CALL ModuleInvocationProxy::setValue(const OUString& rProperty, const Any& rValue)
+{
+ if( !m_bProxyIsClassModuleObject )
+ throw UnknownPropertyException();
+
+ SolarMutexGuard guard;
+
+ OUString aPropertyFunctionName = "Property Set "
+ + m_aPrefix
+ + rProperty;
+
+ SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxClassType::Method );
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
+ if( pMeth == nullptr )
+ {
+ // TODO: Check vba behavior concerning missing function
+ //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
+ throw UnknownPropertyException(aPropertyFunctionName);
+ }
+
+ // Setup parameter
+ SbxArrayRef xArray = new SbxArray;
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( xVar.get(), rValue );
+ xArray->Put32( xVar.get(), 1 );
+
+ // Call property method
+ SbxVariableRef xValue = new SbxVariable;
+ pMeth->SetParameters( xArray.get() );
+ pMeth->Call( xValue.get() );
+ pMeth->SetParameters( nullptr );
+
+ // TODO: OutParameter?
+
+
+}
+
+Any SAL_CALL ModuleInvocationProxy::getValue(const OUString& rProperty)
+{
+ if( !m_bProxyIsClassModuleObject )
+ {
+ throw UnknownPropertyException();
+ }
+ SolarMutexGuard guard;
+
+ OUString aPropertyFunctionName = "Property Get "
+ + m_aPrefix
+ + rProperty;
+
+ SbxVariable* p = m_xScopeObj->Find( aPropertyFunctionName, SbxClassType::Method );
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
+ if( pMeth == nullptr )
+ {
+ // TODO: Check vba behavior concerning missing function
+ //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
+ throw UnknownPropertyException(aPropertyFunctionName);
+ }
+
+ // Call method
+ SbxVariableRef xValue = new SbxVariable;
+ pMeth->Call( xValue.get() );
+ Any aRet = sbxToUnoValue( xValue.get() );
+ return aRet;
+}
+
+sal_Bool SAL_CALL ModuleInvocationProxy::hasMethod( const OUString& )
+{
+ return false;
+}
+
+sal_Bool SAL_CALL ModuleInvocationProxy::hasProperty( const OUString& )
+{
+ return false;
+}
+
+Any SAL_CALL ModuleInvocationProxy::invoke( const OUString& rFunction,
+ const Sequence< Any >& rParams,
+ Sequence< sal_Int16 >&,
+ Sequence< Any >& )
+{
+ SolarMutexGuard guard;
+
+ Any aRet;
+ SbxObjectRef xScopeObj = m_xScopeObj;
+ if( !xScopeObj.is() )
+ {
+ return aRet;
+ }
+ OUString aFunctionName = m_aPrefix
+ + rFunction;
+
+ bool bSetRescheduleBack = false;
+ bool bOldReschedule = true;
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst && pInst->IsCompatibility() )
+ {
+ bOldReschedule = pInst->IsReschedule();
+ if ( bOldReschedule )
+ {
+ pInst->EnableReschedule( false );
+ bSetRescheduleBack = true;
+ }
+ }
+
+ SbxVariable* p = xScopeObj->Find( aFunctionName, SbxClassType::Method );
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
+ if( pMeth == nullptr )
+ {
+ // TODO: Check vba behavior concerning missing function
+ //StarBASIC::Error( ERRCODE_BASIC_NO_METHOD, aFunctionName );
+ return aRet;
+ }
+
+ // Setup parameters
+ SbxArrayRef xArray;
+ sal_Int32 nParamCount = rParams.getLength();
+ if( nParamCount )
+ {
+ xArray = new SbxArray;
+ const Any *pArgs = rParams.getConstArray();
+ for( sal_Int32 i = 0 ; i < nParamCount ; i++ )
+ {
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( xVar.get(), pArgs[i] );
+ xArray->Put32( xVar.get(), sal::static_int_cast< sal_uInt16 >(i+1) );
+ }
+ }
+
+ // Call method
+ SbxVariableRef xValue = new SbxVariable;
+ if( xArray.is() )
+ pMeth->SetParameters( xArray.get() );
+ pMeth->Call( xValue.get() );
+ aRet = sbxToUnoValue( xValue.get() );
+ pMeth->SetParameters( nullptr );
+
+ if( bSetRescheduleBack )
+ pInst->EnableReschedule( bOldReschedule );
+
+ // TODO: OutParameter?
+
+ return aRet;
+}
+
+void SAL_CALL ModuleInvocationProxy::dispose()
+{
+ ::osl::MutexGuard aGuard( m_aMutex );
+
+ EventObject aEvent( static_cast<XComponent*>(this) );
+ m_aListeners.disposeAndClear( aEvent );
+
+ m_xScopeObj = nullptr;
+}
+
+void SAL_CALL ModuleInvocationProxy::addEventListener( const Reference< XEventListener >& xListener )
+{
+ m_aListeners.addInterface( xListener );
+}
+
+void SAL_CALL ModuleInvocationProxy::removeEventListener( const Reference< XEventListener >& xListener )
+{
+ m_aListeners.removeInterface( xListener );
+}
+
+
+Reference< XInterface > createComListener( const Any& aControlAny, const OUString& aVBAType,
+ const OUString& aPrefix, const SbxObjectRef& xScopeObj )
+{
+ Reference< XInterface > xRet;
+
+ Reference< XComponentContext > xContext(
+ comphelper::getProcessComponentContext() );
+ Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
+
+ Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPrefix, xScopeObj );
+
+ Sequence<Any> args( 3 );
+ args[0] = aControlAny;
+ args[1] <<= aVBAType;
+ args[2] <<= xProxy;
+
+ try
+ {
+ xRet = xServiceMgr->createInstanceWithArgumentsAndContext(
+ "com.sun.star.custom.UnoComListener",
+ args, xContext );
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+
+ return xRet;
+}
+
+typedef std::vector< WeakReference< XComponent > > ComponentRefVector;
+
+namespace {
+
+struct StarBasicDisposeItem
+{
+ StarBASIC* m_pBasic;
+ SbxArrayRef m_pRegisteredVariables;
+ ComponentRefVector m_vComImplementsObjects;
+
+ explicit StarBasicDisposeItem( StarBASIC* pBasic )
+ : m_pBasic( pBasic )
+ , m_pRegisteredVariables(new SbxArray())
+ {
+ }
+};
+
+}
+
+typedef std::vector< StarBasicDisposeItem* > DisposeItemVector;
+
+static DisposeItemVector GaDisposeItemVector;
+
+static DisposeItemVector::iterator lcl_findItemForBasic( StarBASIC const * pBasic )
+{
+ return std::find_if(GaDisposeItemVector.begin(), GaDisposeItemVector.end(),
+ [&pBasic](StarBasicDisposeItem* pItem) { return pItem->m_pBasic == pBasic; });
+}
+
+static StarBasicDisposeItem* lcl_getOrCreateItemForBasic( StarBASIC* pBasic )
+{
+ DisposeItemVector::iterator it = lcl_findItemForBasic( pBasic );
+ StarBasicDisposeItem* pItem = (it != GaDisposeItemVector.end()) ? *it : nullptr;
+ if( pItem == nullptr )
+ {
+ pItem = new StarBasicDisposeItem( pBasic );
+ GaDisposeItemVector.push_back( pItem );
+ }
+ return pItem;
+}
+
+void registerComponentToBeDisposedForBasic
+ ( const Reference< XComponent >& xComponent, StarBASIC* pBasic )
+{
+ StarBasicDisposeItem* pItem = lcl_getOrCreateItemForBasic( pBasic );
+ pItem->m_vComImplementsObjects.emplace_back(xComponent );
+}
+
+void registerComListenerVariableForBasic( SbxVariable* pVar, StarBASIC* pBasic )
+{
+ StarBasicDisposeItem* pItem = lcl_getOrCreateItemForBasic( pBasic );
+ SbxArray* pArray = pItem->m_pRegisteredVariables.get();
+ pArray->Put32( pVar, pArray->Count32() );
+}
+
+void disposeComVariablesForBasic( StarBASIC const * pBasic )
+{
+ DisposeItemVector::iterator it = lcl_findItemForBasic( pBasic );
+ if( it == GaDisposeItemVector.end() )
+ return;
+
+ StarBasicDisposeItem* pItem = *it;
+
+ SbxArray* pArray = pItem->m_pRegisteredVariables.get();
+ sal_uInt32 nCount = pArray->Count32();
+ for( sal_uInt32 i = 0 ; i < nCount ; ++i )
+ {
+ SbxVariable* pVar = pArray->Get32( i );
+ pVar->ClearComListener();
+ }
+
+ ComponentRefVector& rv = pItem->m_vComImplementsObjects;
+ for (auto const& elem : rv)
+ {
+ Reference< XComponent > xComponent( elem.get(), UNO_QUERY );
+ if (xComponent.is())
+ xComponent->dispose();
+ }
+
+ delete pItem;
+ GaDisposeItemVector.erase( it );
+}
+
+
+// Handle module implements mechanism for OLE types
+bool SbModule::createCOMWrapperForIface( Any& o_rRetAny, SbClassModuleObject* pProxyClassModuleObject )
+{
+ // For now: Take first interface that allows to instantiate COM wrapper
+ // TODO: Check if support for multiple interfaces is needed
+
+ Reference< XComponentContext > xContext(
+ comphelper::getProcessComponentContext() );
+ Reference< XMultiComponentFactory > xServiceMgr( xContext->getServiceManager() );
+ Reference< XSingleServiceFactory > xComImplementsFactory
+ (
+ xServiceMgr->createInstanceWithContext( "com.sun.star.custom.ComImplementsFactory", xContext ),
+ UNO_QUERY
+ );
+ if( !xComImplementsFactory.is() )
+ return false;
+
+ bool bSuccess = false;
+
+ SbxArray* pModIfaces = pClassData->mxIfaces.get();
+ sal_uInt32 nCount = pModIfaces->Count32();
+ for( sal_uInt32 i = 0 ; i < nCount ; ++i )
+ {
+ SbxVariable* pVar = pModIfaces->Get32( i );
+ const OUString& aIfaceName = pVar->GetName();
+
+ if( !aIfaceName.isEmpty() )
+ {
+ OUString aPureIfaceName = aIfaceName;
+ sal_Int32 indexLastDot = aIfaceName.lastIndexOf('.');
+ if ( indexLastDot > -1 )
+ {
+ aPureIfaceName = aIfaceName.copy( indexLastDot + 1 );
+ }
+ Reference< XInvocation > xProxy = new ModuleInvocationProxy( aPureIfaceName, pProxyClassModuleObject );
+
+ Sequence<Any> args( 2 );
+ args[0] <<= aIfaceName;
+ args[1] <<= xProxy;
+
+ Reference< XInterface > xRet;
+ try
+ {
+ xRet = xComImplementsFactory->createInstanceWithArguments( args );
+ bSuccess = true;
+ }
+ catch( const Exception& )
+ {
+ implHandleAnyException( ::cppu::getCaughtException() );
+ }
+
+ if( bSuccess )
+ {
+ Reference< XComponent > xComponent( xProxy, UNO_QUERY );
+ if( xComponent.is() )
+ {
+ StarBASIC* pParentBasic = nullptr;
+ SbxObject* pCurObject = this;
+ do
+ {
+ SbxObject* pObjParent = pCurObject->GetParent();
+ pParentBasic = dynamic_cast<StarBASIC*>( pObjParent );
+ pCurObject = pObjParent;
+ }
+ while( pParentBasic == nullptr && pCurObject != nullptr );
+
+ assert( pParentBasic != nullptr );
+ registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
+ }
+
+ o_rRetAny <<= xRet;
+ break;
+ }
+ }
+ }
+
+ return bSuccess;
+}
+
+
+// Due to an incorrect behavior IE returns an object instead of a string
+// in some scenarios. Calling toString at the object may correct this.
+// Helper function used in sbxvalue.cxx
+bool handleToStringForCOMObjects( SbxObject* pObj, SbxValue* pVal )
+{
+ bool bSuccess = false;
+
+ if( auto pUnoObj = dynamic_cast<SbUnoObject*>( pObj) )
+ {
+ // Only for native COM objects
+ if( pUnoObj->isNativeCOMObject() )
+ {
+ SbxVariableRef pMeth = pObj->Find( "toString", SbxClassType::Method );
+ if ( pMeth.is() )
+ {
+ SbxValues aRes;
+ pMeth->Get( aRes );
+ pVal->Put( aRes );
+ bSuccess = true;
+ }
+ }
+ }
+ return bSuccess;
+}
+
+Any StructRefInfo::getValue()
+{
+ Any aRet;
+ uno_any_destruct(
+ &aRet, reinterpret_cast< uno_ReleaseFunc >(cpp_release) );
+ typelib_TypeDescription * pTD = nullptr;
+ maType.getDescription(&pTD);
+ uno_any_construct(
+ &aRet, getInst(), pTD,
+ reinterpret_cast< uno_AcquireFunc >(cpp_acquire) );
+ typelib_typedescription_release(pTD);
+ return aRet;
+}
+
+void StructRefInfo::setValue( const Any& rValue )
+{
+ bool bSuccess = uno_type_assignData( getInst(),
+ maType.getTypeLibType(),
+ const_cast<void*>(rValue.getValue()),
+ rValue.getValueTypeRef(),
+ reinterpret_cast< uno_QueryInterfaceFunc >(cpp_queryInterface),
+ reinterpret_cast< uno_AcquireFunc >(cpp_acquire),
+ reinterpret_cast< uno_ReleaseFunc >(cpp_release) );
+ OSL_ENSURE(bSuccess,
+ "StructRefInfo::setValue: ooops... the value could not be assigned!");
+}
+
+OUString StructRefInfo::getTypeName() const
+{
+ return maType.getTypeName();
+}
+
+void* StructRefInfo::getInst()
+{
+ return const_cast<char *>(static_cast<char const *>(maAny.getValue()) + mnPos);
+}
+
+TypeClass StructRefInfo::getTypeClass() const
+{
+ return maType.getTypeClass();
+}
+
+SbUnoStructRefObject::SbUnoStructRefObject( const OUString& aName_, const StructRefInfo& rMemberInfo ) : SbxObject( aName_ ), maMemberInfo( rMemberInfo ), mbMemberCacheInit( false )
+{
+ SetClassName( maMemberInfo.getTypeName() );
+}
+
+SbUnoStructRefObject::~SbUnoStructRefObject()
+{
+}
+
+void SbUnoStructRefObject::initMemberCache()
+{
+ if ( mbMemberCacheInit )
+ return;
+ typelib_TypeDescription * pTD = nullptr;
+ maMemberInfo.getType().getDescription(&pTD);
+ for ( typelib_CompoundTypeDescription * pCompTypeDescr = reinterpret_cast<typelib_CompoundTypeDescription *>(pTD);
+ pCompTypeDescr;
+ pCompTypeDescr = pCompTypeDescr->pBaseTypeDescription )
+ {
+ typelib_TypeDescriptionReference ** ppTypeRefs = pCompTypeDescr->ppTypeRefs;
+ rtl_uString ** ppNames = pCompTypeDescr->ppMemberNames;
+ sal_Int32 * pMemberOffsets = pCompTypeDescr->pMemberOffsets;
+ for ( sal_Int32 nPos = pCompTypeDescr->nMembers; nPos--; )
+ {
+ OUString aName( ppNames[nPos] );
+ maFields[ aName ] = std::make_unique<StructRefInfo>( maMemberInfo.getRootAnyRef(), ppTypeRefs[nPos], maMemberInfo.getPos() + pMemberOffsets[nPos] );
+ }
+ }
+ typelib_typedescription_release(pTD);
+ mbMemberCacheInit = true;
+}
+
+SbxVariable* SbUnoStructRefObject::Find( const OUString& rName, SbxClassType t )
+{
+ SbxVariable* pRes = SbxObject::Find( rName, t );
+ if ( !pRes )
+ {
+ if ( !mbMemberCacheInit )
+ initMemberCache();
+ StructFieldInfo::iterator it = maFields.find( rName );
+ if ( it != maFields.end() )
+ {
+ SbxDataType eSbxType;
+ eSbxType = unoToSbxType( it->second->getTypeClass() );
+ SbxDataType eRealSbxType = eSbxType;
+ Property aProp;
+ aProp.Name = rName;
+ aProp.Type = css::uno::Type( it->second->getTypeClass(), it->second->getTypeName() );
+ SbUnoProperty* pProp = new SbUnoProperty( rName, eSbxType, eRealSbxType, aProp, 0, false, ( aProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT) );
+ SbxVariableRef xVarRef = pProp;
+ QuickInsert( xVarRef.get() );
+ pRes = xVarRef.get();
+ }
+ }
+
+ if( !pRes )
+ {
+ if( rName.equalsIgnoreAsciiCase(ID_DBG_SUPPORTEDINTERFACES) ||
+ rName.equalsIgnoreAsciiCase(ID_DBG_PROPERTIES) ||
+ rName.equalsIgnoreAsciiCase(ID_DBG_METHODS) )
+ {
+ // Create
+ implCreateDbgProperties();
+
+ // Now they have to be found regular
+ pRes = SbxObject::Find( rName, SbxClassType::DontCare );
+ }
+ }
+
+ return pRes;
+}
+
+// help method to create the dbg_-Properties
+void SbUnoStructRefObject::implCreateDbgProperties()
+{
+ Property aProp;
+
+ // Id == -1: display the implemented interfaces corresponding the ClassProvider
+ SbxVariableRef xVarRef = new SbUnoProperty( ID_DBG_SUPPORTEDINTERFACES, SbxSTRING, SbxSTRING, aProp, -1, false, false );
+ QuickInsert( xVarRef.get() );
+
+ // Id == -2: output the properties
+ xVarRef = new SbUnoProperty( ID_DBG_PROPERTIES, SbxSTRING, SbxSTRING, aProp, -2, false, false );
+ QuickInsert( xVarRef.get() );
+
+ // Id == -3: output the Methods
+ xVarRef = new SbUnoProperty( ID_DBG_METHODS, SbxSTRING, SbxSTRING, aProp, -3, false, false );
+ QuickInsert( xVarRef.get() );
+}
+
+void SbUnoStructRefObject::implCreateAll()
+{
+ // throw away all existing methods and properties
+ pMethods = new SbxArray;
+ pProps = new SbxArray;
+
+ if (!mbMemberCacheInit)
+ initMemberCache();
+
+ for (auto const& field : maFields)
+ {
+ const OUString& rName = field.first;
+ SbxDataType eSbxType;
+ eSbxType = unoToSbxType( field.second->getTypeClass() );
+ SbxDataType eRealSbxType = eSbxType;
+ Property aProp;
+ aProp.Name = rName;
+ aProp.Type = css::uno::Type( field.second->getTypeClass(), field.second->getTypeName() );
+ SbUnoProperty* pProp = new SbUnoProperty( rName, eSbxType, eRealSbxType, aProp, 0, false, ( aProp.Type.getTypeClass() == css::uno::TypeClass_STRUCT) );
+ SbxVariableRef xVarRef = pProp;
+ QuickInsert( xVarRef.get() );
+ }
+
+ // Create Dbg_-Properties
+ implCreateDbgProperties();
+}
+
+ // output the value
+Any SbUnoStructRefObject::getUnoAny()
+{
+ return maMemberInfo.getValue();
+}
+
+OUString SbUnoStructRefObject::Impl_DumpProperties()
+{
+ OUStringBuffer aRet;
+ aRet.append("Properties of object ");
+ aRet.append( getDbgObjectName() );
+
+ sal_uInt32 nPropCount = pProps->Count32();
+ sal_uInt32 nPropsPerLine = 1 + nPropCount / 30;
+ for( sal_uInt32 i = 0; i < nPropCount; i++ )
+ {
+ SbxVariable* pVar = pProps->Get32( i );
+ if( pVar )
+ {
+ OUStringBuffer aPropStr;
+ if( (i % nPropsPerLine) == 0 )
+ {
+ aPropStr.append( "\n" );
+ }
+ // output the type and name
+ // Is it in Uno a sequence?
+ SbxDataType eType = pVar->GetFullType();
+
+ const OUString& aName( pVar->GetName() );
+ StructFieldInfo::iterator it = maFields.find( aName );
+
+ if ( it != maFields.end() )
+ {
+ const StructRefInfo& rPropInfo = *it->second;
+
+ if( eType == SbxOBJECT )
+ {
+ if( rPropInfo.getTypeClass() == TypeClass_SEQUENCE )
+ {
+ eType = SbxDataType( SbxOBJECT | SbxARRAY );
+ }
+ }
+ }
+ aPropStr.append( Dbg_SbxDataType2String( eType ) );
+
+ aPropStr.append( " " );
+ aPropStr.append( pVar->GetName() );
+
+ if( i == nPropCount - 1 )
+ {
+ aPropStr.append( "\n" );
+ }
+ else
+ {
+ aPropStr.append( "; " );
+ }
+ aRet.append( aPropStr.makeStringAndClear() );
+ }
+ }
+ return aRet.makeStringAndClear();
+}
+
+void SbUnoStructRefObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ if ( !mbMemberCacheInit )
+ initMemberCache();
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+ if( !pHint )
+ return;
+
+ SbxVariable* pVar = pHint->GetVar();
+ SbUnoProperty* pProp = dynamic_cast<SbUnoProperty*>( pVar );
+ if( pProp )
+ {
+ StructFieldInfo::iterator it = maFields.find( pProp->GetName() );
+ // handle get/set of members of struct
+ if( pHint->GetId() == SfxHintId::BasicDataWanted )
+ {
+ // Test-Properties
+ sal_Int32 nId = pProp->nId;
+ if( nId < 0 )
+ {
+ // Id == -1: Display implemented interfaces according the ClassProvider
+ if( nId == -1 ) // Property ID_DBG_SUPPORTEDINTERFACES"
+ {
+ OUString aRet = OUStringLiteral( ID_DBG_SUPPORTEDINTERFACES )
+ + " not available.\n(TypeClass is not TypeClass_INTERFACE)\n";
+
+ pVar->PutString( aRet );
+ }
+ // Id == -2: output properties
+ else if( nId == -2 ) // Property ID_DBG_PROPERTIES
+ {
+ // by now all properties must be established
+ implCreateAll();
+ OUString aRetStr = Impl_DumpProperties();
+ pVar->PutString( aRetStr );
+ }
+ // Id == -3: output the methods
+ else if( nId == -3 ) // Property ID_DBG_METHODS
+ {
+ // by now all properties must be established
+ implCreateAll();
+ OUString aRet = "Methods of object "
+ + getDbgObjectName()
+ + "\nNo methods found\n";
+ pVar->PutString( aRet );
+ }
+ return;
+ }
+
+ if ( it != maFields.end() )
+ {
+ Any aRetAny = it->second->getValue();
+ unoToSbxValue( pVar, aRetAny );
+ }
+ else
+ StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
+ }
+ else if( pHint->GetId() == SfxHintId::BasicDataChanged )
+ {
+ if ( it != maFields.end() )
+ {
+ // take over the value from Uno to Sbx
+ Any aAnyValue = sbxToUnoValue( pVar, pProp->aUnoProp.Type, &pProp->aUnoProp );
+ it->second->setValue( aAnyValue );
+ }
+ else
+ StarBASIC::Error( ERRCODE_BASIC_PROPERTY_NOT_FOUND );
+ }
+ }
+ else
+ SbxObject::Notify( rBC, rHint );
+}
+
+StructRefInfo SbUnoStructRefObject::getStructMember( const OUString& rMemberName )
+{
+ if (!mbMemberCacheInit)
+ {
+ initMemberCache();
+ }
+ StructFieldInfo::iterator it = maFields.find( rMemberName );
+
+ css::uno::Type aFoundType;
+ sal_Int32 nFoundPos = -1;
+
+ if ( it != maFields.end() )
+ {
+ aFoundType = it->second->getType();
+ nFoundPos = it->second->getPos();
+ }
+ StructRefInfo aRet( maMemberInfo.getRootAnyRef(), aFoundType, nFoundPos );
+ return aRet;
+}
+
+OUString SbUnoStructRefObject::getDbgObjectName() const
+{
+ OUString aName = GetClassName();
+ if( aName.isEmpty() )
+ {
+ aName += "Unknown";
+ }
+ OUStringBuffer aRet;
+ if( aName.getLength() > 20 )
+ {
+ aRet.append( "\n" );
+ }
+ aRet.append( "\"" );
+ aRet.append( aName );
+ aRet.append( "\":" );
+ return aRet.makeStringAndClear();
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/classes/sbxmod.cxx b/basic/source/classes/sbxmod.cxx
new file mode 100644
index 000000000..0232c01ca
--- /dev/null
+++ b/basic/source/classes/sbxmod.cxx
@@ -0,0 +1,2673 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <vcl/svapp.hxx>
+#include <tools/stream.hxx>
+#include <tools/diagnose_ex.h>
+#include <svl/SfxBroadcaster.hxx>
+#include <basic/codecompletecache.hxx>
+#include <basic/sbx.hxx>
+#include <basic/sbuno.hxx>
+#include <sbjsmeth.hxx>
+#include <sbjsmod.hxx>
+#include <sbintern.hxx>
+#include <sbprop.hxx>
+#include <image.hxx>
+#include <opcodes.hxx>
+#include <runtime.hxx>
+#include <token.hxx>
+#include <sbunoobj.hxx>
+
+#include <sal/log.hxx>
+
+#include <basic/sberrors.hxx>
+#include <sbobjmod.hxx>
+#include <basic/vbahelper.hxx>
+#include <comphelper/sequence.hxx>
+#include <cppuhelper/implbase.hxx>
+#include <unotools/eventcfg.hxx>
+#include <com/sun/star/lang/XServiceInfo.hpp>
+#include <com/sun/star/script/ModuleType.hpp>
+#include <com/sun/star/script/vba/XVBACompatibility.hpp>
+#include <com/sun/star/script/vba/VBAScriptEventId.hpp>
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/document/XDocumentEventBroadcaster.hpp>
+#include <com/sun/star/document/XDocumentEventListener.hpp>
+
+#ifdef UNX
+#include <sys/resource.h>
+#endif
+
+#include <com/sun/star/lang/XMultiServiceFactory.hpp>
+#include <comphelper/processfactory.hxx>
+#include <comphelper/asyncquithandler.hxx>
+#include <map>
+#include <com/sun/star/reflection/ProxyFactory.hpp>
+#include <com/sun/star/uno/XAggregation.hpp>
+#include <com/sun/star/script/XInvocation.hpp>
+
+#include <com/sun/star/awt/DialogProvider.hpp>
+#include <com/sun/star/awt/XTopWindow.hpp>
+#include <com/sun/star/awt/XWindow.hpp>
+#include <ooo/vba/VbQueryClose.hpp>
+#include <memory>
+#include <sbxmod.hxx>
+#include <parser.hxx>
+
+#include <limits>
+
+using namespace com::sun::star;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::reflection;
+using namespace com::sun::star::beans;
+using namespace com::sun::star::script;
+using namespace com::sun::star::uno;
+
+typedef ::cppu::WeakImplHelper< XInvocation > DocObjectWrapper_BASE;
+typedef std::map< sal_Int16, Any > OutParamMap;
+
+namespace {
+
+class DocObjectWrapper : public DocObjectWrapper_BASE
+{
+ Reference< XAggregation > m_xAggProxy;
+ Reference< XInvocation > m_xAggInv;
+ Reference< XTypeProvider > m_xAggregateTypeProv;
+ Sequence< Type > m_Types;
+ SbModule* m_pMod;
+ /// @throws css::uno::RuntimeException
+ SbMethodRef getMethod( const OUString& aName );
+ /// @throws css::uno::RuntimeException
+ SbPropertyRef getProperty( const OUString& aName );
+
+public:
+ explicit DocObjectWrapper( SbModule* pMod );
+
+ virtual Sequence< sal_Int8 > SAL_CALL getImplementationId() override
+ {
+ return css::uno::Sequence<sal_Int8>();
+ }
+
+ virtual Reference< XIntrospectionAccess > SAL_CALL getIntrospection( ) override;
+
+ virtual Any SAL_CALL invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam ) override;
+ virtual void SAL_CALL setValue( const OUString& aPropertyName, const Any& aValue ) override;
+ virtual Any SAL_CALL getValue( const OUString& aPropertyName ) override;
+ virtual sal_Bool SAL_CALL hasMethod( const OUString& aName ) override;
+ virtual sal_Bool SAL_CALL hasProperty( const OUString& aName ) override;
+ virtual Any SAL_CALL queryInterface( const Type& aType ) override;
+
+ virtual Sequence< Type > SAL_CALL getTypes() override;
+};
+
+}
+
+DocObjectWrapper::DocObjectWrapper( SbModule* pVar ) : m_pMod( pVar )
+{
+ SbObjModule* pMod = dynamic_cast<SbObjModule*>( pVar );
+ if ( !pMod )
+ return;
+
+ if ( pMod->GetModuleType() != ModuleType::DOCUMENT )
+ return;
+
+ // Use proxy factory service to create aggregatable proxy.
+ SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pMod->GetObject() );
+ Reference< XInterface > xIf;
+ if ( pUnoObj )
+ {
+ Any aObj = pUnoObj->getUnoAny();
+ aObj >>= xIf;
+ if ( xIf.is() )
+ {
+ m_xAggregateTypeProv.set( xIf, UNO_QUERY );
+ m_xAggInv.set( xIf, UNO_QUERY );
+ }
+ }
+ if ( xIf.is() )
+ {
+ try
+ {
+ Reference< XProxyFactory > xProxyFac = ProxyFactory::create( comphelper::getProcessComponentContext() );
+ m_xAggProxy = xProxyFac->createProxy( xIf );
+ }
+ catch(const Exception& )
+ {
+ TOOLS_WARN_EXCEPTION( "basic", "DocObjectWrapper::DocObjectWrapper" );
+ }
+ }
+
+ if ( !m_xAggProxy.is() )
+ return;
+
+ osl_atomic_increment( &m_refCount );
+
+ /* i35609 - Fix crash on Solaris. The setDelegator call needs
+ to be in its own block to ensure that all temporary Reference
+ instances that are acquired during the call are released
+ before m_refCount is decremented again */
+ {
+ m_xAggProxy->setDelegator( static_cast< cppu::OWeakObject * >( this ) );
+ }
+
+ osl_atomic_decrement( &m_refCount );
+}
+
+Sequence< Type > SAL_CALL DocObjectWrapper::getTypes()
+{
+ if ( !m_Types.hasElements() )
+ {
+ Sequence< Type > sTypes;
+ if ( m_xAggregateTypeProv.is() )
+ {
+ sTypes = m_xAggregateTypeProv->getTypes();
+ }
+ m_Types = comphelper::concatSequences(sTypes,
+ Sequence { cppu::UnoType<XInvocation>::get() });
+ }
+ return m_Types;
+}
+
+Reference< XIntrospectionAccess > SAL_CALL
+DocObjectWrapper::getIntrospection( )
+{
+ return nullptr;
+}
+
+Any SAL_CALL
+DocObjectWrapper::invoke( const OUString& aFunctionName, const Sequence< Any >& aParams, Sequence< ::sal_Int16 >& aOutParamIndex, Sequence< Any >& aOutParam )
+{
+ if ( m_xAggInv.is() && m_xAggInv->hasMethod( aFunctionName ) )
+ return m_xAggInv->invoke( aFunctionName, aParams, aOutParamIndex, aOutParam );
+ SbMethodRef pMethod = getMethod( aFunctionName );
+ if ( !pMethod.is() )
+ throw RuntimeException();
+ // check number of parameters
+ sal_Int32 nParamsCount = aParams.getLength();
+ SbxInfo* pInfo = pMethod->GetInfo();
+ if ( pInfo )
+ {
+ sal_Int32 nSbxOptional = 0;
+ sal_uInt16 n = 1;
+ for ( const SbxParamInfo* pParamInfo = pInfo->GetParam( n ); pParamInfo; pParamInfo = pInfo->GetParam( ++n ) )
+ {
+ if ( pParamInfo->nFlags & SbxFlagBits::Optional )
+ ++nSbxOptional;
+ else
+ nSbxOptional = 0;
+ }
+ sal_Int32 nSbxCount = n - 1;
+ if ( nParamsCount < nSbxCount - nSbxOptional )
+ {
+ throw RuntimeException( "wrong number of parameters!" );
+ }
+ }
+ // set parameters
+ SbxArrayRef xSbxParams;
+ if ( nParamsCount > 0 )
+ {
+ xSbxParams = new SbxArray;
+ const Any* pParams = aParams.getConstArray();
+ for ( sal_Int32 i = 0; i < nParamsCount; ++i )
+ {
+ SbxVariableRef xSbxVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( xSbxVar.get(), pParams[i] );
+ xSbxParams->Put32( xSbxVar.get(), static_cast< sal_uInt32 >( i ) + 1 );
+
+ // Enable passing by ref
+ if ( xSbxVar->GetType() != SbxVARIANT )
+ xSbxVar->SetFlag( SbxFlagBits::Fixed );
+ }
+ }
+ if ( xSbxParams.is() )
+ pMethod->SetParameters( xSbxParams.get() );
+
+ // call method
+ SbxVariableRef xReturn = new SbxVariable;
+
+ pMethod->Call( xReturn.get() );
+ Any aReturn;
+ // get output parameters
+ if ( xSbxParams.is() )
+ {
+ SbxInfo* pInfo_ = pMethod->GetInfo();
+ if ( pInfo_ )
+ {
+ OutParamMap aOutParamMap;
+ for ( sal_uInt32 n = 1, nCount = xSbxParams->Count32(); n < nCount; ++n )
+ {
+ assert(n <= std::numeric_limits<sal_uInt16>::max());
+ const SbxParamInfo* pParamInfo = pInfo_->GetParam( sal::static_int_cast<sal_uInt16>(n) );
+ if ( pParamInfo && ( pParamInfo->eType & SbxBYREF ) != 0 )
+ {
+ SbxVariable* pVar = xSbxParams->Get32( n );
+ if ( pVar )
+ {
+ SbxVariableRef xVar = pVar;
+ aOutParamMap.emplace( n - 1, sbxToUnoValue( xVar.get() ) );
+ }
+ }
+ }
+ sal_Int32 nOutParamCount = aOutParamMap.size();
+ aOutParamIndex.realloc( nOutParamCount );
+ aOutParam.realloc( nOutParamCount );
+ sal_Int16* pOutParamIndex = aOutParamIndex.getArray();
+ Any* pOutParam = aOutParam.getArray();
+ for (auto const& outParam : aOutParamMap)
+ {
+ *pOutParamIndex = outParam.first;
+ *pOutParam = outParam.second;
+ ++pOutParamIndex;
+ ++pOutParam;
+ }
+ }
+ }
+
+ // get return value
+ aReturn = sbxToUnoValue( xReturn.get() );
+
+ pMethod->SetParameters( nullptr );
+
+ return aReturn;
+}
+
+void SAL_CALL
+DocObjectWrapper::setValue( const OUString& aPropertyName, const Any& aValue )
+{
+ if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
+ return m_xAggInv->setValue( aPropertyName, aValue );
+
+ SbPropertyRef pProperty = getProperty( aPropertyName );
+ if ( !pProperty.is() )
+ throw UnknownPropertyException(aPropertyName);
+ unoToSbxValue( pProperty.get(), aValue );
+}
+
+Any SAL_CALL
+DocObjectWrapper::getValue( const OUString& aPropertyName )
+{
+ if ( m_xAggInv.is() && m_xAggInv->hasProperty( aPropertyName ) )
+ return m_xAggInv->getValue( aPropertyName );
+
+ SbPropertyRef pProperty = getProperty( aPropertyName );
+ if ( !pProperty.is() )
+ throw UnknownPropertyException(aPropertyName);
+
+ SbxVariable* pProp = pProperty.get();
+ if ( pProp->GetType() == SbxEMPTY )
+ pProperty->Broadcast( SfxHintId::BasicDataWanted );
+
+ Any aRet = sbxToUnoValue( pProp );
+ return aRet;
+}
+
+sal_Bool SAL_CALL
+DocObjectWrapper::hasMethod( const OUString& aName )
+{
+ if ( m_xAggInv.is() && m_xAggInv->hasMethod( aName ) )
+ return true;
+ return getMethod( aName ).is();
+}
+
+sal_Bool SAL_CALL
+DocObjectWrapper::hasProperty( const OUString& aName )
+{
+ bool bRes = false;
+ if ( m_xAggInv.is() && m_xAggInv->hasProperty( aName ) )
+ bRes = true;
+ else bRes = getProperty( aName ).is();
+ return bRes;
+}
+
+Any SAL_CALL DocObjectWrapper::queryInterface( const Type& aType )
+{
+ Any aRet = DocObjectWrapper_BASE::queryInterface( aType );
+ if ( aRet.hasValue() )
+ return aRet;
+ else if ( m_xAggProxy.is() )
+ aRet = m_xAggProxy->queryAggregation( aType );
+ return aRet;
+}
+
+SbMethodRef DocObjectWrapper::getMethod( const OUString& aName )
+{
+ SbMethodRef pMethod;
+ if ( m_pMod )
+ {
+ SbxFlagBits nSaveFlgs = m_pMod->GetFlags();
+ // Limit search to this module
+ m_pMod->ResetFlag( SbxFlagBits::GlobalSearch );
+ pMethod = dynamic_cast<SbMethod*>(m_pMod->SbModule::Find(aName, SbxClassType::Method));
+ m_pMod->SetFlags( nSaveFlgs );
+ }
+
+ return pMethod;
+}
+
+SbPropertyRef DocObjectWrapper::getProperty( const OUString& aName )
+{
+ SbPropertyRef pProperty;
+ if ( m_pMod )
+ {
+ SbxFlagBits nSaveFlgs = m_pMod->GetFlags();
+ // Limit search to this module.
+ m_pMod->ResetFlag( SbxFlagBits::GlobalSearch );
+ pProperty = dynamic_cast<SbProperty*>(m_pMod->SbModule::Find(aName, SbxClassType::Property));
+ m_pMod->SetFlag( nSaveFlgs );
+ }
+
+ return pProperty;
+}
+
+
+uno::Reference< frame::XModel > getDocumentModel( StarBASIC* pb )
+{
+ uno::Reference< frame::XModel > xModel;
+ if( pb && pb->IsDocBasic() )
+ {
+ uno::Any aDoc;
+ if( pb->GetUNOConstant( "ThisComponent", aDoc ) )
+ xModel.set( aDoc, uno::UNO_QUERY );
+ }
+ return xModel;
+}
+
+static uno::Reference< vba::XVBACompatibility > getVBACompatibility( const uno::Reference< frame::XModel >& rxModel )
+{
+ uno::Reference< vba::XVBACompatibility > xVBACompat;
+ try
+ {
+ uno::Reference< beans::XPropertySet > xModelProps( rxModel, uno::UNO_QUERY_THROW );
+ xVBACompat.set( xModelProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY );
+ }
+ catch(const uno::Exception& )
+ {
+ }
+ return xVBACompat;
+}
+
+static bool getDefaultVBAMode( StarBASIC* pb )
+{
+ uno::Reference< frame::XModel > xModel( getDocumentModel( pb ) );
+ if (!xModel.is())
+ return false;
+ uno::Reference< vba::XVBACompatibility > xVBACompat = getVBACompatibility( xModel );
+ return xVBACompat.is() && xVBACompat->getVBACompatibilityMode();
+}
+
+// A Basic module has set EXTSEARCH, so that the elements, that the module contains,
+// could be found from other module.
+
+SbModule::SbModule( const OUString& rName, bool bVBACompat )
+ : SbxObject( "StarBASICModule" ),
+ pImage(nullptr), pBreaks(nullptr), mbVBACompat( bVBACompat ), bIsProxyModule( false )
+{
+ SetName( rName );
+ SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::GlobalSearch );
+ SetModuleType( script::ModuleType::NORMAL );
+
+ // #i92642: Set name property to initial name
+ SbxVariable* pNameProp = pProps->Find( "Name", SbxClassType::Property );
+ if( pNameProp != nullptr )
+ {
+ pNameProp->PutString( GetName() );
+ }
+}
+
+SbModule::~SbModule()
+{
+ SAL_INFO("basic","Module named " << GetName() << " is destructing");
+ delete pImage;
+ delete pBreaks;
+ pClassData.reset();
+ mxWrapper = nullptr;
+}
+
+uno::Reference< script::XInvocation > const &
+SbModule::GetUnoModule()
+{
+ if ( !mxWrapper.is() )
+ mxWrapper = new DocObjectWrapper( this );
+
+ SAL_INFO("basic","Module named " << GetName() << " returning wrapper mxWrapper (0x" << mxWrapper.get() <<")" );
+ return mxWrapper;
+}
+
+bool SbModule::IsCompiled() const
+{
+ return pImage != nullptr;
+}
+
+const SbxObject* SbModule::FindType( const OUString& aTypeName ) const
+{
+ return pImage ? pImage->FindType( aTypeName ) : nullptr;
+}
+
+
+// From the code generator: deletion of images and the opposite of validation for entries
+
+void SbModule::StartDefinitions()
+{
+ delete pImage; pImage = nullptr;
+ if( pClassData )
+ pClassData->clear();
+
+ // methods and properties persist, but they are invalid;
+ // at least are the information under certain conditions clogged
+ sal_uInt32 i;
+ for( i = 0; i < pMethods->Count32(); i++ )
+ {
+ SbMethod* p = dynamic_cast<SbMethod*>( pMethods->Get32( i ) );
+ if( p )
+ p->bInvalid = true;
+ }
+ for( i = 0; i < pProps->Count32(); )
+ {
+ SbProperty* p = dynamic_cast<SbProperty*>( pProps->Get32( i ) );
+ if( p )
+ pProps->Remove( i );
+ else
+ i++;
+ }
+}
+
+// request/create method
+
+SbMethod* SbModule::GetMethod( const OUString& rName, SbxDataType t )
+{
+ SbxVariable* p = pMethods->Find( rName, SbxClassType::Method );
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( p );
+ if( p && !pMeth )
+ {
+ pMethods->Remove( p );
+ }
+ if( !pMeth )
+ {
+ pMeth = new SbMethod( rName, t, this );
+ pMeth->SetParent( this );
+ pMeth->SetFlags( SbxFlagBits::Read );
+ pMethods->Put32( pMeth, pMethods->Count32() );
+ StartListening(pMeth->GetBroadcaster(), DuplicateHandling::Prevent);
+ }
+ // The method is per default valid, because it could be
+ // created from the compiler (code generator) as well.
+ pMeth->bInvalid = false;
+ pMeth->ResetFlag( SbxFlagBits::Fixed );
+ pMeth->SetFlag( SbxFlagBits::Write );
+ pMeth->SetType( t );
+ pMeth->ResetFlag( SbxFlagBits::Write );
+ if( t != SbxVARIANT )
+ {
+ pMeth->SetFlag( SbxFlagBits::Fixed );
+ }
+ return pMeth;
+}
+
+SbMethod* SbModule::FindMethod( const OUString& rName, SbxClassType t )
+{
+ return dynamic_cast<SbMethod*> (pMethods->Find( rName, t ));
+}
+
+
+// request/create property
+
+SbProperty* SbModule::GetProperty( const OUString& rName, SbxDataType t )
+{
+ SbxVariable* p = pProps->Find( rName, SbxClassType::Property );
+ SbProperty* pProp = dynamic_cast<SbProperty*>( p );
+ if( p && !pProp )
+ {
+ pProps->Remove( p );
+ }
+ if( !pProp )
+ {
+ pProp = new SbProperty( rName, t, this );
+ pProp->SetFlag( SbxFlagBits::ReadWrite );
+ pProp->SetParent( this );
+ pProps->Put32( pProp, pProps->Count32() );
+ StartListening(pProp->GetBroadcaster(), DuplicateHandling::Prevent);
+ }
+ return pProp;
+}
+
+void SbModule::GetProcedureProperty( const OUString& rName, SbxDataType t )
+{
+ SbxVariable* p = pProps->Find( rName, SbxClassType::Property );
+ SbProcedureProperty* pProp = dynamic_cast<SbProcedureProperty*>( p );
+ if( p && !pProp )
+ {
+ pProps->Remove( p );
+ }
+ if( !pProp )
+ {
+ pProp = new SbProcedureProperty( rName, t );
+ pProp->SetFlag( SbxFlagBits::ReadWrite );
+ pProp->SetParent( this );
+ pProps->Put32( pProp, pProps->Count32() );
+ StartListening(pProp->GetBroadcaster(), DuplicateHandling::Prevent);
+ }
+}
+
+void SbModule::GetIfaceMapperMethod( const OUString& rName, SbMethod* pImplMeth )
+{
+ SbxVariable* p = pMethods->Find( rName, SbxClassType::Method );
+ SbIfaceMapperMethod* pMapperMethod = dynamic_cast<SbIfaceMapperMethod*>( p );
+ if( p && !pMapperMethod )
+ {
+ pMethods->Remove( p );
+ }
+ if( !pMapperMethod )
+ {
+ pMapperMethod = new SbIfaceMapperMethod( rName, pImplMeth );
+ pMapperMethod->SetParent( this );
+ pMapperMethod->SetFlags( SbxFlagBits::Read );
+ pMethods->Put32( pMapperMethod, pMethods->Count32() );
+ }
+ pMapperMethod->bInvalid = false;
+}
+
+SbIfaceMapperMethod::~SbIfaceMapperMethod()
+{
+}
+
+
+// From the code generator: remove invalid entries
+
+void SbModule::EndDefinitions( bool bNewState )
+{
+ for( sal_uInt32 i = 0; i < pMethods->Count32(); )
+ {
+ SbMethod* p = dynamic_cast<SbMethod*>( pMethods->Get32( i ) );
+ if( p )
+ {
+ if( p->bInvalid )
+ {
+ pMethods->Remove( p );
+ }
+ else
+ {
+ p->bInvalid = bNewState;
+ i++;
+ }
+ }
+ else
+ i++;
+ }
+ SetModified( true );
+}
+
+void SbModule::Clear()
+{
+ delete pImage; pImage = nullptr;
+ if( pClassData )
+ pClassData->clear();
+ SbxObject::Clear();
+}
+
+
+SbxVariable* SbModule::Find( const OUString& rName, SbxClassType t )
+{
+ // make sure a search in an uninstantiated class module will fail
+ SbxVariable* pRes = SbxObject::Find( rName, t );
+ if ( bIsProxyModule && !GetSbData()->bRunInit )
+ {
+ return nullptr;
+ }
+ if( !pRes && pImage )
+ {
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst && pInst->IsCompatibility() )
+ {
+ // Put enum types as objects into module,
+ // allows MyEnum.First notation
+ SbxArrayRef xArray = pImage->GetEnums();
+ if( xArray.is() )
+ {
+ SbxVariable* pEnumVar = xArray->Find( rName, SbxClassType::DontCare );
+ SbxObject* pEnumObject = dynamic_cast<SbxObject*>( pEnumVar );
+ if( pEnumObject )
+ {
+ bool bPrivate = pEnumObject->IsSet( SbxFlagBits::Private );
+ OUString aEnumName = pEnumObject->GetName();
+
+ pRes = new SbxVariable( SbxOBJECT );
+ pRes->SetName( aEnumName );
+ pRes->SetParent( this );
+ pRes->SetFlag( SbxFlagBits::Read );
+ if( bPrivate )
+ {
+ pRes->SetFlag( SbxFlagBits::Private );
+ }
+ pRes->PutObject( pEnumObject );
+ }
+ }
+ }
+ }
+ return pRes;
+}
+
+// Parent and BASIC are one!
+
+void SbModule::SetParent( SbxObject* p )
+{
+ pParent = p;
+}
+
+void SbModule::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+ if( !pHint )
+ return;
+
+ SbxVariable* pVar = pHint->GetVar();
+ SbProperty* pProp = dynamic_cast<SbProperty*>( pVar );
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( pVar );
+ SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( pVar );
+ if( pProcProperty )
+ {
+
+ if( pHint->GetId() == SfxHintId::BasicDataWanted )
+ {
+ OUString aProcName = "Property Get "
+ + pProcProperty->GetName();
+
+ SbxVariable* pMethVar = Find( aProcName, SbxClassType::Method );
+ if( pMethVar )
+ {
+ SbxValues aVals;
+ aVals.eType = SbxVARIANT;
+
+ SbxArray* pArg = pVar->GetParameters();
+ sal_uInt32 nVarParCount = (pArg != nullptr) ? pArg->Count32() : 0;
+ if( nVarParCount > 1 )
+ {
+ auto xMethParameters = tools::make_ref<SbxArray>();
+ xMethParameters->Put32( pMethVar, 0 ); // Method as parameter 0
+ for( sal_uInt32 i = 1 ; i < nVarParCount ; ++i )
+ {
+ SbxVariable* pPar = pArg->Get32( i );
+ xMethParameters->Put32( pPar, i );
+ }
+
+ pMethVar->SetParameters( xMethParameters.get() );
+ pMethVar->Get( aVals );
+ pMethVar->SetParameters( nullptr );
+ }
+ else
+ {
+ pMethVar->Get( aVals );
+ }
+
+ pVar->Put( aVals );
+ }
+ }
+ else if( pHint->GetId() == SfxHintId::BasicDataChanged )
+ {
+ SbxVariable* pMethVar = nullptr;
+
+ bool bSet = pProcProperty->isSet();
+ if( bSet )
+ {
+ pProcProperty->setSet( false );
+
+ OUString aProcName = "Property Set "
+ + pProcProperty->GetName();
+ pMethVar = Find( aProcName, SbxClassType::Method );
+ }
+ if( !pMethVar ) // Let
+ {
+ OUString aProcName = "Property Let "
+ + pProcProperty->GetName();
+ pMethVar = Find( aProcName, SbxClassType::Method );
+ }
+
+ if( pMethVar )
+ {
+ // Setup parameters
+ SbxArrayRef xArray = new SbxArray;
+ xArray->Put32( pMethVar, 0 ); // Method as parameter 0
+ xArray->Put32( pVar, 1 );
+ pMethVar->SetParameters( xArray.get() );
+
+ SbxValues aVals;
+ pMethVar->Get( aVals );
+ pMethVar->SetParameters( nullptr );
+ }
+ }
+ }
+ if( pProp )
+ {
+ if( pProp->GetModule() != this )
+ SetError( ERRCODE_BASIC_BAD_ACTION );
+ }
+ else if( pMeth )
+ {
+ if( pHint->GetId() == SfxHintId::BasicDataWanted )
+ {
+ if( pMeth->bInvalid && !Compile() )
+ {
+ // auto compile has not worked!
+ StarBASIC::Error( ERRCODE_BASIC_BAD_PROP_VALUE );
+ }
+ else
+ {
+ // Call of a subprogram
+ SbModule* pOld = GetSbData()->pMod;
+ GetSbData()->pMod = this;
+ Run( static_cast<SbMethod*>(pVar) );
+ GetSbData()->pMod = pOld;
+ }
+ }
+ }
+ else
+ {
+ // #i92642: Special handling for name property to avoid
+ // side effects when using name as variable implicitly
+ bool bForwardToSbxObject = true;
+
+ const SfxHintId nId = pHint->GetId();
+ if( (nId == SfxHintId::BasicDataWanted || nId == SfxHintId::BasicDataChanged) &&
+ pVar->GetName().equalsIgnoreAsciiCase( "name" ) )
+ {
+ bForwardToSbxObject = false;
+ }
+ if( bForwardToSbxObject )
+ {
+ SbxObject::Notify( rBC, rHint );
+ }
+ }
+}
+
+// The setting of the source makes the image invalid
+// and scans the method definitions newly in
+
+void SbModule::SetSource32( const OUString& r )
+{
+ // Default basic mode to library container mode, but... allow Option VBASupport 0/1 override
+ SetVBACompat( getDefaultVBAMode( static_cast< StarBASIC*>( GetParent() ) ) );
+ aOUSource = r;
+ StartDefinitions();
+ SbiTokenizer aTok( r );
+ aTok.SetCompatible( IsVBACompat() );
+
+ while( !aTok.IsEof() )
+ {
+ SbiToken eEndTok = NIL;
+
+ // Searching for SUB or FUNCTION
+ SbiToken eLastTok = NIL;
+ while( !aTok.IsEof() )
+ {
+ // #32385: not by declare
+ SbiToken eCurTok = aTok.Next();
+ if( eLastTok != DECLARE )
+ {
+ if( eCurTok == SUB )
+ {
+ eEndTok = ENDSUB; break;
+ }
+ if( eCurTok == FUNCTION )
+ {
+ eEndTok = ENDFUNC; break;
+ }
+ if( eCurTok == PROPERTY )
+ {
+ eEndTok = ENDPROPERTY; break;
+ }
+ if( eCurTok == OPTION )
+ {
+ eCurTok = aTok.Next();
+ if( eCurTok == COMPATIBLE )
+ {
+ aTok.SetCompatible( true );
+ }
+ else if ( ( eCurTok == VBASUPPORT ) && ( aTok.Next() == NUMBER ) )
+ {
+ bool bIsVBA = ( aTok.GetDbl()== 1 );
+ SetVBACompat( bIsVBA );
+ aTok.SetCompatible( bIsVBA );
+ }
+ }
+ }
+ eLastTok = eCurTok;
+ }
+ // Definition of the method
+ SbMethod* pMeth = nullptr;
+ if( eEndTok != NIL )
+ {
+ sal_uInt16 nLine1 = aTok.GetLine();
+ if( aTok.Next() == SYMBOL )
+ {
+ OUString aName_( aTok.GetSym() );
+ SbxDataType t = aTok.GetType();
+ if( t == SbxVARIANT && eEndTok == ENDSUB )
+ {
+ t = SbxVOID;
+ }
+ pMeth = GetMethod( aName_, t );
+ pMeth->nLine1 = pMeth->nLine2 = nLine1;
+ // The method is for a start VALID
+ pMeth->bInvalid = false;
+ }
+ else
+ {
+ eEndTok = NIL;
+ }
+ }
+ // Skip up to END SUB/END FUNCTION
+ if( eEndTok != NIL )
+ {
+ while( !aTok.IsEof() )
+ {
+ if( aTok.Next() == eEndTok )
+ {
+ pMeth->nLine2 = aTok.GetLine();
+ break;
+ }
+ }
+ if( aTok.IsEof() )
+ {
+ pMeth->nLine2 = aTok.GetLine();
+ }
+ }
+ }
+ EndDefinitions( true );
+}
+
+// Broadcast of a hint to all Basics
+
+static void SendHint_( SbxObject* pObj, SfxHintId nId, SbMethod* p )
+{
+ // Self a BASIC?
+ if( dynamic_cast<const StarBASIC *>(pObj) != nullptr && pObj->IsBroadcaster() )
+ pObj->GetBroadcaster().Broadcast( SbxHint( nId, p ) );
+ // Then ask for the subobjects
+ SbxArray* pObjs = pObj->GetObjects();
+ for( sal_uInt32 i = 0; i < pObjs->Count32(); i++ )
+ {
+ SbxVariable* pVar = pObjs->Get32( i );
+ if( dynamic_cast<const SbxObject *>(pVar) != nullptr )
+ SendHint_( dynamic_cast<SbxObject*>( pVar), nId, p );
+ }
+}
+
+static void SendHint( SbxObject* pObj, SfxHintId nId, SbMethod* p )
+{
+ while( pObj->GetParent() )
+ pObj = pObj->GetParent();
+ SendHint_( pObj, nId, p );
+}
+
+// #57841 Clear Uno-Objects, which were helt in RTL functions,
+// at the end of the program, so that nothing were helt.
+static void ClearUnoObjectsInRTL_Impl_Rek( StarBASIC* pBasic )
+{
+ // delete the return value of CreateUnoService
+ SbxVariable* pVar = pBasic->GetRtl()->Find( "CreateUnoService", SbxClassType::Method );
+ if( pVar )
+ {
+ pVar->SbxValue::Clear();
+ }
+ // delete the return value of CreateUnoDialog
+ pVar = pBasic->GetRtl()->Find( "CreateUnoDialog", SbxClassType::Method );
+ if( pVar )
+ {
+ pVar->SbxValue::Clear();
+ }
+ // delete the return value of CDec
+ pVar = pBasic->GetRtl()->Find( "CDec", SbxClassType::Method );
+ if( pVar )
+ {
+ pVar->SbxValue::Clear();
+ }
+ // delete return value of CreateObject
+ pVar = pBasic->GetRtl()->Find( "CreateObject", SbxClassType::Method );
+ if( pVar )
+ {
+ pVar->SbxValue::Clear();
+ }
+ // Go over all Sub-Basics
+ SbxArray* pObjs = pBasic->GetObjects();
+ sal_uInt32 nCount = pObjs->Count32();
+ for( sal_uInt32 i = 0 ; i < nCount ; i++ )
+ {
+ SbxVariable* pObjVar = pObjs->Get32( i );
+ StarBASIC* pSubBasic = dynamic_cast<StarBASIC*>( pObjVar );
+ if( pSubBasic )
+ {
+ ClearUnoObjectsInRTL_Impl_Rek( pSubBasic );
+ }
+ }
+}
+
+static void ClearUnoObjectsInRTL_Impl( StarBASIC* pBasic )
+{
+ // #67781 Delete return values of the Uno-methods
+ clearUnoMethods();
+
+ ClearUnoObjectsInRTL_Impl_Rek( pBasic );
+
+ // Search for the topmost Basic
+ SbxObject* p = pBasic;
+ while( p->GetParent() )
+ p = p->GetParent();
+ if( static_cast<StarBASIC*>(p) != pBasic )
+ ClearUnoObjectsInRTL_Impl_Rek( static_cast<StarBASIC*>(p) );
+}
+
+
+void SbModule::SetVBACompat( bool bCompat )
+{
+ if( mbVBACompat == bCompat )
+ return;
+
+ mbVBACompat = bCompat;
+ // initialize VBA document API
+ if( mbVBACompat ) try
+ {
+ StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
+ uno::Reference< lang::XMultiServiceFactory > xFactory( getDocumentModel( pBasic ), uno::UNO_QUERY_THROW );
+ xFactory->createInstance( "ooo.vba.VBAGlobals" );
+ }
+ catch( Exception& )
+ {
+ }
+}
+
+namespace
+{
+ class RunInitGuard
+ {
+ protected:
+ std::unique_ptr<SbiRuntime> m_xRt;
+ SbiGlobals* m_pSbData;
+ SbModule* m_pOldMod;
+ public:
+ RunInitGuard(SbModule* pModule, SbMethod* pMethod, sal_uInt32 nArg, SbiGlobals* pSbData)
+ : m_xRt(new SbiRuntime(pModule, pMethod, nArg))
+ , m_pSbData(pSbData)
+ , m_pOldMod(pSbData->pMod)
+ {
+ m_xRt->pNext = pSbData->pInst->pRun;
+ m_pSbData->pMod = pModule;
+ m_pSbData->pInst->pRun = m_xRt.get();
+ }
+ void run()
+ {
+ while (m_xRt->Step()) {}
+ }
+ virtual ~RunInitGuard()
+ {
+ m_pSbData->pInst->pRun = m_xRt->pNext;
+ m_pSbData->pMod = m_pOldMod;
+ m_xRt.reset();
+ }
+ };
+
+ class RunGuard : public RunInitGuard
+ {
+ private:
+ bool m_bDelInst;
+ public:
+ RunGuard(SbModule* pModule, SbMethod* pMethod, sal_uInt32 nArg, SbiGlobals* pSbData, bool bDelInst)
+ : RunInitGuard(pModule, pMethod, nArg, pSbData)
+ , m_bDelInst(bDelInst)
+ {
+ if (m_xRt->pNext)
+ m_xRt->pNext->block();
+ }
+ virtual ~RunGuard() override
+ {
+ if (m_xRt->pNext)
+ m_xRt->pNext->unblock();
+
+ // #63710 It can happen by an another thread handling at events,
+ // that the show call returns to a dialog (by closing the
+ // dialog per UI), before a by an event triggered further call returned,
+ // which stands in Basic more top in the stack and that had been run on
+ // a Basic-Breakpoint. Then would the instance below destroyed. And if the Basic,
+ // that stand still in the call, further runs, there is a GPF.
+ // Thus here had to be wait until the other call comes back.
+ if (m_bDelInst)
+ {
+ // Compare here with 1 instead of 0, because before nCallLvl--
+ while (m_pSbData->pInst->nCallLvl != 1)
+ Application::Yield();
+ }
+
+ m_pSbData->pInst->nCallLvl--; // Call-Level down again
+
+ // Exist an higher-ranking runtime instance?
+ // Then take over BasicDebugFlags::Break, if set
+ SbiRuntime* pRtNext = m_xRt->pNext;
+ if (pRtNext && (m_xRt->GetDebugFlags() & BasicDebugFlags::Break))
+ pRtNext->SetDebugFlags(BasicDebugFlags::Break);
+ }
+ };
+}
+
+// Run a Basic-subprogram
+void SbModule::Run( SbMethod* pMeth )
+{
+ SAL_INFO("basic","About to run " << pMeth->GetName() << ", vba compatmode is " << mbVBACompat );
+
+ static sal_uInt16 nMaxCallLevel = 0;
+
+ SbiGlobals* pSbData = GetSbData();
+
+ bool bDelInst = pSbData->pInst == nullptr;
+ bool bQuit = false;
+ StarBASICRef xBasic;
+ uno::Reference< frame::XModel > xModel;
+ uno::Reference< script::vba::XVBACompatibility > xVBACompat;
+ if( bDelInst )
+ {
+ // #32779: Hold Basic during the execution
+ xBasic = static_cast<StarBASIC*>( GetParent() );
+
+ pSbData->pInst = new SbiInstance( static_cast<StarBASIC*>(GetParent()) );
+
+ /* If a VBA script in a document is started, get the VBA compatibility
+ interface from the document Basic library container, and notify all
+ VBA script listeners about the started script. */
+ if( mbVBACompat )
+ {
+ StarBASIC* pBasic = static_cast< StarBASIC* >( GetParent() );
+ if( pBasic && pBasic->IsDocBasic() ) try
+ {
+ xModel.set( getDocumentModel( pBasic ), uno::UNO_SET_THROW );
+ xVBACompat.set( getVBACompatibility( xModel ), uno::UNO_SET_THROW );
+ xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STARTED, GetName() );
+ }
+ catch(const uno::Exception& )
+ {
+ }
+ }
+
+ // Launcher problem
+ // i80726 The Find below will generate an error in Testtool so we reset it unless there was one before already
+ bool bWasError = SbxBase::GetError() != ERRCODE_NONE;
+ SbxVariable* pMSOMacroRuntimeLibVar = Find( "Launcher", SbxClassType::Object );
+ if ( !bWasError && (SbxBase::GetError() == ERRCODE_BASIC_PROC_UNDEFINED) )
+ SbxBase::ResetError();
+ if( pMSOMacroRuntimeLibVar )
+ {
+ StarBASIC* pMSOMacroRuntimeLib = dynamic_cast<StarBASIC*>( pMSOMacroRuntimeLibVar );
+ if( pMSOMacroRuntimeLib )
+ {
+ SbxFlagBits nGblFlag = pMSOMacroRuntimeLib->GetFlags() & SbxFlagBits::GlobalSearch;
+ pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::GlobalSearch );
+ SbxVariable* pAppSymbol = pMSOMacroRuntimeLib->Find( "Application", SbxClassType::Method );
+ pMSOMacroRuntimeLib->SetFlag( nGblFlag );
+ if( pAppSymbol )
+ {
+ pMSOMacroRuntimeLib->SetFlag( SbxFlagBits::ExtSearch ); // Could have been disabled before
+ pSbData->pMSOMacroRuntimLib = pMSOMacroRuntimeLib;
+ }
+ }
+ }
+
+ if( nMaxCallLevel == 0 )
+ {
+#ifdef UNX
+ struct rlimit rl;
+ getrlimit ( RLIMIT_STACK, &rl );
+#endif
+#if defined LINUX
+ // Empiric value, 900 = needed bytes/Basic call level
+ // for Linux including 10% safety margin
+ nMaxCallLevel = rl.rlim_cur / 900;
+#elif defined __sun
+ // Empiric value, 1650 = needed bytes/Basic call level
+ // for Solaris including 10% safety margin
+ nMaxCallLevel = rl.rlim_cur / 1650;
+#elif defined _WIN32
+ nMaxCallLevel = 5800;
+#else
+ nMaxCallLevel = MAXRECURSION;
+#endif
+ }
+ }
+
+ // Recursion to deep?
+ if( ++pSbData->pInst->nCallLvl <= nMaxCallLevel )
+ {
+ // Define a globale variable in all Mods
+ GlobalRunInit( /* bBasicStart = */ bDelInst );
+
+ // Appeared a compiler error? Then we don't launch
+ if( !pSbData->bGlobalInitErr )
+ {
+ if( bDelInst )
+ {
+ SendHint( GetParent(), SfxHintId::BasicStart, pMeth );
+
+ // 1996-10-16: #31460 New concept for StepInto/Over/Out
+ // For an explanation see runtime.cxx at SbiInstance::CalcBreakCallLevel()
+ // Identify the BreakCallLevel
+ pSbData->pInst->CalcBreakCallLevel( pMeth->GetDebugFlags() );
+ }
+
+ auto xRuntimeGuard(std::make_unique<RunGuard>(this, pMeth, pMeth->nStart, pSbData, bDelInst));
+
+ if ( mbVBACompat )
+ {
+ pSbData->pInst->EnableCompatibility( true );
+ }
+
+ xRuntimeGuard->run();
+
+ xRuntimeGuard.reset();
+
+ if( bDelInst )
+ {
+ // #57841 Clear Uno-Objects, which were helt in RTL functions,
+ // at the end of the program, so that nothing were helt.
+ ClearUnoObjectsInRTL_Impl( xBasic.get() );
+
+ clearNativeObjectWrapperVector();
+
+ SAL_WARN_IF(pSbData->pInst->nCallLvl != 0,"basic","BASIC-Call-Level > 0");
+ delete pSbData->pInst;
+ pSbData->pInst = nullptr;
+ bDelInst = false;
+
+ // #i30690
+ SolarMutexGuard aSolarGuard;
+ SendHint( GetParent(), SfxHintId::BasicStop, pMeth );
+
+ GlobalRunDeInit();
+
+ if( xVBACompat.is() )
+ {
+ // notify all VBA script listeners about the stopped script
+ try
+ {
+ xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::SCRIPT_STOPPED, GetName() );
+ }
+ catch(const uno::Exception& )
+ {
+ }
+ // VBA always ensures screenupdating is enabled after completing
+ ::basic::vba::lockControllersOfAllDocuments( xModel, false );
+ ::basic::vba::enableContainerWindowsOfAllDocuments( xModel, true );
+ }
+ }
+ }
+ else
+ pSbData->pInst->nCallLvl--; // Call-Level down again
+ }
+ else
+ {
+ pSbData->pInst->nCallLvl--; // Call-Level down again
+ StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW );
+ }
+
+ StarBASIC* pBasic = dynamic_cast<StarBASIC*>( GetParent() );
+ if( bDelInst )
+ {
+ // #57841 Clear Uno-Objects, which were helt in RTL functions,
+ // the end of the program, so that nothing were helt.
+ ClearUnoObjectsInRTL_Impl( xBasic.get() );
+
+ delete pSbData->pInst;
+ pSbData->pInst = nullptr;
+ }
+ if ( pBasic && pBasic->IsDocBasic() && pBasic->IsQuitApplication() && !pSbData->pInst )
+ bQuit = true;
+ if ( bQuit )
+ {
+ Application::PostUserEvent( LINK( &AsyncQuitHandler::instance(), AsyncQuitHandler, OnAsyncQuit ) );
+ }
+}
+
+// Execute of the init method of a module after the loading
+// or the compilation
+void SbModule::RunInit()
+{
+ if( !(pImage
+ && !pImage->bInit
+ && pImage->IsFlag( SbiImageFlags::INITCODE )) )
+ return;
+
+ SbiGlobals* pSbData = GetSbData();
+
+ // Set flag, so that RunInit get active (Testtool)
+ pSbData->bRunInit = true;
+
+ // The init code starts always here
+ auto xRuntimeGuard(std::make_unique<RunInitGuard>(this, nullptr, 0, pSbData));
+ xRuntimeGuard->run();
+ xRuntimeGuard.reset();
+
+ pImage->bInit = true;
+ pImage->bFirstInit = false;
+
+ // RunInit is not active anymore
+ pSbData->bRunInit = false;
+}
+
+// Delete with private/dim declared variables
+
+void SbModule::AddVarName( const OUString& aName )
+{
+ // see if the name is added already
+ for ( const auto& rModuleVariableName: mModuleVariableNames )
+ {
+ if ( aName == rModuleVariableName )
+ return;
+ }
+ mModuleVariableNames.push_back( aName );
+}
+
+void SbModule::RemoveVars()
+{
+ for ( const auto& rModuleVariableName: mModuleVariableNames )
+ {
+ // We don't want a Find being called in a derived class ( e.g.
+ // SbUserform because it could trigger say an initialise event
+ // which would cause basic to be re-run in the middle of the init ( and remember RemoveVars is called from compile and we don't want code to run as part of the compile )
+ SbxVariableRef p = SbModule::Find( rModuleVariableName, SbxClassType::Property );
+ if( p.is() )
+ Remove( p.get() );
+ }
+}
+
+void SbModule::ClearPrivateVars()
+{
+ for( sal_uInt32 i = 0 ; i < pProps->Count32() ; i++ )
+ {
+ SbProperty* p = dynamic_cast<SbProperty*>( pProps->Get32( i ) );
+ if( p )
+ {
+ // Delete not the arrays, only their content
+ if( p->GetType() & SbxARRAY )
+ {
+ SbxArray* pArray = dynamic_cast<SbxArray*>( p->GetObject() );
+ if( pArray )
+ {
+ for( sal_uInt32 j = 0 ; j < pArray->Count32() ; j++ )
+ {
+ SbxVariable* pj = pArray->Get32( j );
+ pj->SbxValue::Clear();
+ }
+ }
+ }
+ else
+ {
+ p->SbxValue::Clear();
+ }
+ }
+ }
+}
+
+void SbModule::implClearIfVarDependsOnDeletedBasic( SbxVariable* pVar, StarBASIC* pDeletedBasic )
+{
+ if( pVar->SbxValue::GetType() != SbxOBJECT || dynamic_cast<const SbProcedureProperty*>( pVar) != nullptr )
+ return;
+
+ SbxObject* pObj = dynamic_cast<SbxObject*>( pVar->GetObject() );
+ if( pObj == nullptr )
+ return;
+
+ SbxObject* p = pObj;
+
+ SbModule* pMod = dynamic_cast<SbModule*>( p );
+ if( pMod != nullptr )
+ pMod->ClearVarsDependingOnDeletedBasic( pDeletedBasic );
+
+ while( (p = p->GetParent()) != nullptr )
+ {
+ StarBASIC* pBasic = dynamic_cast<StarBASIC*>( p );
+ if( pBasic != nullptr && pBasic == pDeletedBasic )
+ {
+ pVar->SbxValue::Clear();
+ break;
+ }
+ }
+}
+
+void SbModule::ClearVarsDependingOnDeletedBasic( StarBASIC* pDeletedBasic )
+{
+ for( sal_uInt32 i = 0 ; i < pProps->Count32() ; i++ )
+ {
+ SbProperty* p = dynamic_cast<SbProperty*>( pProps->Get32( i ) );
+ if( p )
+ {
+ if( p->GetType() & SbxARRAY )
+ {
+ SbxArray* pArray = dynamic_cast<SbxArray*>( p->GetObject() );
+ if( pArray )
+ {
+ for( sal_uInt32 j = 0 ; j < pArray->Count32() ; j++ )
+ {
+ SbxVariable* pVar = pArray->Get32( j );
+ implClearIfVarDependsOnDeletedBasic( pVar, pDeletedBasic );
+ }
+ }
+ }
+ else
+ {
+ implClearIfVarDependsOnDeletedBasic( p, pDeletedBasic );
+ }
+ }
+ }
+}
+
+void StarBASIC::ClearAllModuleVars()
+{
+ // Initialise the own module
+ for (const auto& rModule: pModules)
+ {
+ // Initialise only, if the startcode was already executed
+ if( rModule->pImage && rModule->pImage->bInit && !rModule->isProxyModule() && dynamic_cast<const SbObjModule*>( rModule.get()) == nullptr )
+ rModule->ClearPrivateVars();
+ }
+
+}
+
+// Execution of the init-code of all module
+void SbModule::GlobalRunInit( bool bBasicStart )
+{
+ // If no Basic-Start, only initialise, if the module is not initialised
+ if( !bBasicStart )
+ if( !(pImage && !pImage->bInit) )
+ return;
+
+ // Initialise GlobalInitErr-Flag for Compiler-Error
+ // With the help of this flags could be located in SbModule::Run() after the call of
+ // GlobalRunInit, if at the initialising of the module
+ // an error occurred. Then it will not be launched.
+ GetSbData()->bGlobalInitErr = false;
+
+ // Parent of the module is a Basic
+ StarBASIC *pBasic = dynamic_cast<StarBASIC*>( GetParent() );
+ if( !pBasic )
+ return;
+
+ pBasic->InitAllModules();
+
+ SbxObject* pParent_ = pBasic->GetParent();
+ if( !pParent_ )
+ return;
+
+ StarBASIC * pParentBasic = dynamic_cast<StarBASIC*>( pParent_ );
+ if( !pParentBasic )
+ return;
+
+ pParentBasic->InitAllModules( pBasic );
+
+ // #109018 Parent can also have a parent (library in doc)
+ SbxObject* pParentParent = pParentBasic->GetParent();
+ if( pParentParent )
+ {
+ StarBASIC * pParentParentBasic = dynamic_cast<StarBASIC*>( pParentParent );
+ if( pParentParentBasic )
+ pParentParentBasic->InitAllModules( pParentBasic );
+ }
+}
+
+void SbModule::GlobalRunDeInit()
+{
+ StarBASIC *pBasic = dynamic_cast<StarBASIC*>( GetParent() );
+ if( pBasic )
+ {
+ pBasic->DeInitAllModules();
+
+ SbxObject* pParent_ = pBasic->GetParent();
+ if( pParent_ )
+ pBasic = dynamic_cast<StarBASIC*>( pParent_ );
+ if( pBasic )
+ pBasic->DeInitAllModules();
+ }
+}
+
+// Search for the next STMNT-Command in the code. This was used from the STMNT-
+// Opcode to set the endcolumn.
+
+const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol ) const
+{
+ return FindNextStmnt( p, nLine, nCol, false );
+}
+
+const sal_uInt8* SbModule::FindNextStmnt( const sal_uInt8* p, sal_uInt16& nLine, sal_uInt16& nCol,
+ bool bFollowJumps, const SbiImage* pImg ) const
+{
+ sal_uInt32 nPC = static_cast<sal_uInt32>( p - reinterpret_cast<const sal_uInt8*>(pImage->GetCode()) );
+ while( nPC < pImage->GetCodeSize() )
+ {
+ SbiOpcode eOp = static_cast<SbiOpcode>( *p++ );
+ nPC++;
+ if( bFollowJumps && eOp == SbiOpcode::JUMP_ && pImg )
+ {
+ SAL_WARN_IF( !pImg, "basic", "FindNextStmnt: pImg==NULL with FollowJumps option" );
+ sal_uInt32 nOp1 = *p++; nOp1 |= *p++ << 8;
+ nOp1 |= *p++ << 16; nOp1 |= *p++ << 24;
+ p = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
+ }
+ else if( eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END )
+ {
+ p += 4;
+ nPC += 4;
+ }
+ else if( eOp == SbiOpcode::STMNT_ )
+ {
+ sal_uInt32 nl, nc;
+ nl = *p++; nl |= *p++ << 8;
+ nl |= *p++ << 16 ; nl |= *p++ << 24;
+ nc = *p++; nc |= *p++ << 8;
+ nc |= *p++ << 16 ; nc |= *p++ << 24;
+ nLine = static_cast<sal_uInt16>(nl); nCol = static_cast<sal_uInt16>(nc);
+ return p;
+ }
+ else if( eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END )
+ {
+ p += 8;
+ nPC += 8;
+ }
+ else if( !( eOp >= SbiOpcode::SbOP0_START && eOp <= SbiOpcode::SbOP0_END ) )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ break;
+ }
+ }
+ return nullptr;
+}
+
+// Test, if a line contains STMNT-Opcodes
+
+bool SbModule::IsBreakable( sal_uInt16 nLine ) const
+{
+ if( !pImage )
+ return false;
+ const sal_uInt8* p = reinterpret_cast<const sal_uInt8*>(pImage->GetCode());
+ sal_uInt16 nl, nc;
+ while( ( p = FindNextStmnt( p, nl, nc ) ) != nullptr )
+ if( nl == nLine )
+ return true;
+ return false;
+}
+
+bool SbModule::IsBP( sal_uInt16 nLine ) const
+{
+ if( pBreaks )
+ {
+ for( size_t i = 0; i < pBreaks->size(); i++ )
+ {
+ sal_uInt16 b = pBreaks->operator[]( i );
+ if( b == nLine )
+ return true;
+ if( b < nLine )
+ break;
+ }
+ }
+ return false;
+}
+
+bool SbModule::SetBP( sal_uInt16 nLine )
+{
+ if( !IsBreakable( nLine ) )
+ return false;
+ if( !pBreaks )
+ pBreaks = new SbiBreakpoints;
+ auto it = std::find_if(pBreaks->begin(), pBreaks->end(),
+ [&nLine](const sal_uInt16 b) { return b <= nLine; });
+ if (it != pBreaks->end() && *it == nLine)
+ return true;
+ pBreaks->insert( it, nLine );
+
+ // #38568: Set during runtime as well here BasicDebugFlags::Break
+ if( GetSbData()->pInst && GetSbData()->pInst->pRun )
+ GetSbData()->pInst->pRun->SetDebugFlags( BasicDebugFlags::Break );
+
+ return IsBreakable( nLine );
+}
+
+bool SbModule::ClearBP( sal_uInt16 nLine )
+{
+ bool bRes = false;
+ if( pBreaks )
+ {
+ auto it = std::find_if(pBreaks->begin(), pBreaks->end(),
+ [&nLine](const sal_uInt16 b) { return b <= nLine; });
+ bRes = (it != pBreaks->end()) && (*it == nLine);
+ if (bRes)
+ {
+ pBreaks->erase(it);
+ }
+ if( pBreaks->empty() )
+ {
+ delete pBreaks;
+ pBreaks = nullptr;
+ }
+ }
+ return bRes;
+}
+
+void SbModule::ClearAllBP()
+{
+ delete pBreaks;
+ pBreaks = nullptr;
+}
+
+void
+SbModule::fixUpMethodStart( bool bCvtToLegacy, SbiImage* pImg ) const
+{
+ if ( !pImg )
+ pImg = pImage;
+ for( sal_uInt32 i = 0; i < pMethods->Count32(); i++ )
+ {
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( pMethods->Get32(i) );
+ if( pMeth )
+ {
+ //fixup method start positions
+ if ( bCvtToLegacy )
+ pMeth->nStart = pImg->CalcLegacyOffset( pMeth->nStart );
+ else
+ pMeth->nStart = pImg->CalcNewOffset( static_cast<sal_uInt16>(pMeth->nStart) );
+ }
+ }
+
+}
+
+bool SbModule::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ Clear();
+ if( !SbxObject::LoadData( rStrm, 1 ) )
+ return false;
+ // As a precaution...
+ SetFlag( SbxFlagBits::ExtSearch | SbxFlagBits::GlobalSearch );
+ sal_uInt8 bImage;
+ rStrm.ReadUChar( bImage );
+ if( bImage )
+ {
+ SbiImage* p = new SbiImage;
+ sal_uInt32 nImgVer = 0;
+
+ if( !p->Load( rStrm, nImgVer ) )
+ {
+ delete p;
+ return false;
+ }
+ // If the image is in old format, we fix up the method start offsets
+ if ( nImgVer < B_EXT_IMG_VERSION )
+ {
+ fixUpMethodStart( false, p );
+ p->ReleaseLegacyBuffer();
+ }
+ aComment = p->aComment;
+ SetName( p->aName );
+ if( p->GetCodeSize() )
+ {
+ aOUSource = p->aOUSource;
+ // Old version: image away
+ if( nVer == 1 )
+ {
+ SetSource32( p->aOUSource );
+ delete p;
+ }
+ else
+ pImage = p;
+ }
+ else
+ {
+ SetSource32( p->aOUSource );
+ delete p;
+ }
+ }
+ return true;
+}
+
+bool SbModule::StoreData( SvStream& rStrm ) const
+{
+ bool bFixup = ( pImage && !pImage->ExceedsLegacyLimits() );
+ if ( bFixup )
+ fixUpMethodStart( true );
+ bool bRet = SbxObject::StoreData( rStrm );
+ if ( !bRet )
+ return false;
+
+ if( pImage )
+ {
+ pImage->aOUSource = aOUSource;
+ pImage->aComment = aComment;
+ pImage->aName = GetName();
+ rStrm.WriteUChar( 1 );
+ // # PCode is saved only for legacy formats only
+ // It should be noted that it probably isn't necessary
+ // It would be better not to store the image ( more flexible with
+ // formats )
+ bool bRes = pImage->Save( rStrm, B_LEGACYVERSION );
+ if ( bFixup )
+ fixUpMethodStart( false ); // restore method starts
+ return bRes;
+
+ }
+ else
+ {
+ SbiImage aImg;
+ aImg.aOUSource = aOUSource;
+ aImg.aComment = aComment;
+ aImg.aName = GetName();
+ rStrm.WriteUChar( 1 );
+ return aImg.Save( rStrm );
+ }
+}
+
+bool SbModule::ExceedsLegacyModuleSize()
+{
+ if ( !IsCompiled() )
+ Compile();
+ return pImage && pImage->ExceedsLegacyLimits();
+}
+
+namespace {
+
+class ErrorHdlResetter
+{
+ Link<StarBASIC*,bool> mErrHandler;
+ bool mbError;
+public:
+ ErrorHdlResetter()
+ : mErrHandler(StarBASIC::GetGlobalErrorHdl()) // save error handler
+ , mbError( false )
+ {
+ // set new error handler
+ StarBASIC::SetGlobalErrorHdl( LINK( this, ErrorHdlResetter, BasicErrorHdl ) );
+ }
+ ~ErrorHdlResetter()
+ {
+ // restore error handler
+ StarBASIC::SetGlobalErrorHdl(mErrHandler);
+ }
+ DECL_LINK( BasicErrorHdl, StarBASIC *, bool );
+ bool HasError() const { return mbError; }
+};
+
+}
+
+IMPL_LINK( ErrorHdlResetter, BasicErrorHdl, StarBASIC *, /*pBasic*/, bool)
+{
+ mbError = true;
+ return false;
+}
+
+void SbModule::GetCodeCompleteDataFromParse(CodeCompleteDataCache& aCache)
+{
+ ErrorHdlResetter aErrHdl;
+ SbxBase::ResetError();
+
+ std::unique_ptr<SbiParser> pParser(new SbiParser( static_cast<StarBASIC*>(GetParent()), this ));
+ pParser->SetCodeCompleting(true);
+
+ while( pParser->Parse() ) {}
+ SbiSymPool* pPool = pParser->pPool;
+ aCache.Clear();
+ for( sal_uInt16 i = 0; i < pPool->GetSize(); ++i )
+ {
+ SbiSymDef* pSymDef = pPool->Get(i);
+ //std::cerr << "i: " << i << ", type: " << pSymDef->GetType() << "; name:" << pSymDef->GetName() << std::endl;
+ if( (pSymDef->GetType() != SbxEMPTY) && (pSymDef->GetType() != SbxNULL) )
+ aCache.InsertGlobalVar( pSymDef->GetName(), pParser->aGblStrings.Find(pSymDef->GetTypeId()) );
+
+ SbiSymPool& rChildPool = pSymDef->GetPool();
+ for(sal_uInt16 j = 0; j < rChildPool.GetSize(); ++j )
+ {
+ SbiSymDef* pChildSymDef = rChildPool.Get(j);
+ //std::cerr << "j: " << j << ", type: " << pChildSymDef->GetType() << "; name:" << pChildSymDef->GetName() << std::endl;
+ if( (pChildSymDef->GetType() != SbxEMPTY) && (pChildSymDef->GetType() != SbxNULL) )
+ aCache.InsertLocalVar( pSymDef->GetName(), pChildSymDef->GetName(), pParser->aGblStrings.Find(pChildSymDef->GetTypeId()) );
+ }
+ }
+}
+
+
+OUString SbModule::GetKeywordCase( const OUString& sKeyword )
+{
+ return SbiParser::GetKeywordCase( sKeyword );
+}
+
+bool SbModule::HasExeCode()
+{
+ // And empty Image always has the Global Chain set up
+ static const unsigned char pEmptyImage[] = { 0x45, 0x0 , 0x0, 0x0, 0x0 };
+ // lets be stricter for the moment than VBA
+
+ if (!IsCompiled())
+ {
+ ErrorHdlResetter aGblErrHdl;
+ Compile();
+ if (aGblErrHdl.HasError()) //assume unsafe on compile error
+ return true;
+ }
+
+ bool bRes = false;
+ if (pImage && !(pImage->GetCodeSize() == 5 && (memcmp(pImage->GetCode(), pEmptyImage, pImage->GetCodeSize()) == 0 )))
+ bRes = true;
+
+ return bRes;
+}
+
+// Store only image, no source
+void SbModule::StoreBinaryData( SvStream& rStrm )
+{
+ if (!Compile())
+ return;
+
+ if (!SbxObject::StoreData(rStrm))
+ return;
+
+ pImage->aOUSource.clear();
+ pImage->aComment = aComment;
+ pImage->aName = GetName();
+
+ rStrm.WriteUChar(1);
+ pImage->Save(rStrm);
+
+ pImage->aOUSource = aOUSource;
+}
+
+// Called for >= OO 1.0 passwd protected libraries only
+
+void SbModule::LoadBinaryData( SvStream& rStrm )
+{
+ OUString aKeepSource = aOUSource;
+ LoadData( rStrm, 2 );
+ LoadCompleted();
+ aOUSource = aKeepSource;
+}
+
+bool SbModule::LoadCompleted()
+{
+ SbxArray* p = GetMethods().get();
+ sal_uInt32 i;
+ for( i = 0; i < p->Count32(); i++ )
+ {
+ SbMethod* q = dynamic_cast<SbMethod*>( p->Get32( i ) );
+ if( q )
+ q->pMod = this;
+ }
+ p = GetProperties();
+ for( i = 0; i < p->Count32(); i++ )
+ {
+ SbProperty* q = dynamic_cast<SbProperty*>( p->Get32( i ) );
+ if( q )
+ q->pMod = this;
+ }
+ return true;
+}
+
+void SbModule::handleProcedureProperties( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ bool bDone = false;
+
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+ if( pHint )
+ {
+ SbxVariable* pVar = pHint->GetVar();
+ SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( pVar );
+ if( pProcProperty )
+ {
+ bDone = true;
+
+ if( pHint->GetId() == SfxHintId::BasicDataWanted )
+ {
+ OUString aProcName = "Property Get "
+ + pProcProperty->GetName();
+
+ SbxVariable* pMeth = Find( aProcName, SbxClassType::Method );
+ if( pMeth )
+ {
+ SbxValues aVals;
+ aVals.eType = SbxVARIANT;
+
+ SbxArray* pArg = pVar->GetParameters();
+ sal_uInt32 nVarParCount = (pArg != nullptr) ? pArg->Count32() : 0;
+ if( nVarParCount > 1 )
+ {
+ SbxArrayRef xMethParameters = new SbxArray;
+ xMethParameters->Put32( pMeth, 0 ); // Method as parameter 0
+ for( sal_uInt32 i = 1 ; i < nVarParCount ; ++i )
+ {
+ SbxVariable* pPar = pArg->Get32( i );
+ xMethParameters->Put32( pPar, i );
+ }
+
+ pMeth->SetParameters( xMethParameters.get() );
+ pMeth->Get( aVals );
+ pMeth->SetParameters( nullptr );
+ }
+ else
+ {
+ pMeth->Get( aVals );
+ }
+
+ pVar->Put( aVals );
+ }
+ }
+ else if( pHint->GetId() == SfxHintId::BasicDataChanged )
+ {
+ SbxVariable* pMeth = nullptr;
+
+ bool bSet = pProcProperty->isSet();
+ if( bSet )
+ {
+ pProcProperty->setSet( false );
+
+ OUString aProcName = "Property Set "
+ + pProcProperty->GetName();
+ pMeth = Find( aProcName, SbxClassType::Method );
+ }
+ if( !pMeth ) // Let
+ {
+ OUString aProcName = "Property Let "
+ + pProcProperty->GetName();
+ pMeth = Find( aProcName, SbxClassType::Method );
+ }
+
+ if( pMeth )
+ {
+ // Setup parameters
+ SbxArrayRef xArray = new SbxArray;
+ xArray->Put32( pMeth, 0 ); // Method as parameter 0
+ xArray->Put32( pVar, 1 );
+ pMeth->SetParameters( xArray.get() );
+
+ SbxValues aVals;
+ pMeth->Get( aVals );
+ pMeth->SetParameters( nullptr );
+ }
+ }
+ }
+ }
+
+ if( !bDone )
+ SbModule::Notify( rBC, rHint );
+}
+
+
+// Implementation SbJScriptModule (Basic module for JavaScript source code)
+SbJScriptModule::SbJScriptModule()
+ :SbModule( "" )
+{
+}
+
+bool SbJScriptModule::LoadData( SvStream& rStrm, sal_uInt16 )
+{
+ Clear();
+ if( !SbxObject::LoadData( rStrm, 1 ) )
+ return false;
+
+ // Get the source string
+ aOUSource = rStrm.ReadUniOrByteString( osl_getThreadTextEncoding() );
+ return true;
+}
+
+bool SbJScriptModule::StoreData( SvStream& rStrm ) const
+{
+ if( !SbxObject::StoreData( rStrm ) )
+ return false;
+
+ // Write the source string
+ OUString aTmp = aOUSource;
+ rStrm.WriteUniOrByteString( aTmp, osl_getThreadTextEncoding() );
+ return true;
+}
+
+
+SbMethod::SbMethod( const OUString& r, SbxDataType t, SbModule* p )
+ : SbxMethod( r, t ), pMod( p )
+{
+ bInvalid = true;
+ nStart = 0;
+ nDebugFlags = BasicDebugFlags::NONE;
+ nLine1 = 0;
+ nLine2 = 0;
+ refStatics = new SbxArray;
+ mCaller = nullptr;
+ // HACK due to 'Reference could not be saved'
+ SetFlag( SbxFlagBits::NoModify );
+}
+
+SbMethod::SbMethod( const SbMethod& r )
+ : SvRefBase( r ), SbxMethod( r )
+{
+ pMod = r.pMod;
+ bInvalid = r.bInvalid;
+ nStart = r.nStart;
+ nDebugFlags = r.nDebugFlags;
+ nLine1 = r.nLine1;
+ nLine2 = r.nLine2;
+ refStatics = r.refStatics;
+ mCaller = r.mCaller;
+ SetFlag( SbxFlagBits::NoModify );
+}
+
+SbMethod::~SbMethod()
+{
+}
+
+void SbMethod::ClearStatics()
+{
+ refStatics = new SbxArray;
+
+}
+SbxArray* SbMethod::GetStatics()
+{
+ return refStatics.get();
+}
+
+bool SbMethod::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ if( !SbxMethod::LoadData( rStrm, 1 ) )
+ return false;
+
+ sal_uInt16 nFlag;
+ rStrm.ReadUInt16( nFlag );
+
+ sal_Int16 nTempStart = static_cast<sal_Int16>(nStart);
+
+ if( nVer == 2 )
+ {
+ rStrm.ReadUInt16( nLine1 ).ReadUInt16( nLine2 ).ReadInt16( nTempStart ).ReadCharAsBool( bInvalid );
+ //tdf#94617
+ if (nFlag & 0x8000)
+ {
+ sal_uInt16 nMult = nFlag & 0x7FFF;
+ sal_Int16 const nMax = std::numeric_limits<sal_Int16>::max();
+ nStart = nMult * nMax + nTempStart;
+ }
+ else
+ {
+ nStart = nTempStart;
+ }
+ }
+ else
+ {
+ nStart = nTempStart;
+ }
+
+ // HACK due to 'Reference could not be saved'
+ SetFlag( SbxFlagBits::NoModify );
+
+ return true;
+}
+
+bool SbMethod::StoreData( SvStream& rStrm ) const
+{
+ if( !SbxMethod::StoreData( rStrm ) )
+ return false;
+
+ //tdf#94617
+ sal_Int16 nMax = std::numeric_limits<sal_Int16>::max();
+ sal_Int16 nStartTemp = nStart % nMax;
+ sal_uInt16 nDebugFlagsTemp = nStart / nMax;
+ nDebugFlagsTemp |= 0x8000;
+
+ rStrm.WriteUInt16( nDebugFlagsTemp )
+ .WriteInt16( nLine1 )
+ .WriteInt16( nLine2 )
+ .WriteInt16( nStartTemp )
+ .WriteBool( bInvalid );
+
+ return true;
+}
+
+void SbMethod::GetLineRange( sal_uInt16& l1, sal_uInt16& l2 )
+{
+ l1 = nLine1; l2 = nLine2;
+}
+
+// Could later be deleted
+
+SbxInfo* SbMethod::GetInfo()
+{
+ return pInfo.get();
+}
+
+// Interface to execute a method of the applications
+// With special RefCounting, so that the Basic was not fired of by CloseDocument()
+// The return value will be delivered as string.
+ErrCode SbMethod::Call( SbxValue* pRet, SbxVariable* pCaller )
+{
+ if ( pCaller )
+ {
+ SAL_INFO("basic", "SbMethod::Call Have been passed a caller 0x" << pCaller );
+ mCaller = pCaller;
+ }
+ // Increment the RefCount of the module
+ tools::SvRef<SbModule> pMod_ = static_cast<SbModule*>(GetParent());
+
+ tools::SvRef<StarBASIC> xHolder = static_cast<StarBASIC*>(pMod_->GetParent());
+
+ // Establish the values to get the return value
+ SbxValues aVals;
+ aVals.eType = SbxVARIANT;
+
+ // #104083: Compile BEFORE get
+ if( bInvalid && !pMod_->Compile() )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_PROP_VALUE );
+
+ Get( aVals );
+ if ( pRet )
+ pRet->Put( aVals );
+
+ // Was there an error
+ ErrCode nErr = SbxBase::GetError();
+ SbxBase::ResetError();
+
+ mCaller = nullptr;
+ return nErr;
+}
+
+
+// #100883 Own Broadcast for SbMethod
+void SbMethod::Broadcast( SfxHintId nHintId )
+{
+ if( !(mpBroadcaster && !IsSet( SbxFlagBits::NoBroadcast )) )
+ return;
+
+ // Because the method could be called from outside, test here once again
+ // the authorisation
+ if( nHintId == SfxHintId::BasicDataWanted )
+ if( !CanRead() )
+ return;
+ if( nHintId == SfxHintId::BasicDataChanged )
+ if( !CanWrite() )
+ return;
+
+ if( pMod && !pMod->IsCompiled() )
+ pMod->Compile();
+
+ // Block broadcasts while creating new method
+ std::unique_ptr<SfxBroadcaster> pSaveBroadcaster = std::move(mpBroadcaster);
+ SbMethod* pThisCopy = new SbMethod( *this );
+ SbMethodRef xHolder = pThisCopy;
+ if( mpPar.is() )
+ {
+ // Enregister this as element 0, but don't reset the parent!
+ if( GetType() != SbxVOID ) {
+ mpPar->PutDirect( pThisCopy, 0 );
+ }
+ SetParameters( nullptr );
+ }
+
+ mpBroadcaster = std::move(pSaveBroadcaster);
+ mpBroadcaster->Broadcast( SbxHint( nHintId, pThisCopy ) );
+
+ SbxFlagBits nSaveFlags = GetFlags();
+ SetFlag( SbxFlagBits::ReadWrite );
+ pSaveBroadcaster = std::move(mpBroadcaster);
+ Put( pThisCopy->GetValues_Impl() );
+ mpBroadcaster = std::move(pSaveBroadcaster);
+ SetFlags( nSaveFlags );
+}
+
+
+// Implementation of SbJScriptMethod (method class as a wrapper for JavaScript-functions)
+
+SbJScriptMethod::SbJScriptMethod( SbxDataType t )
+ : SbMethod( "", t, nullptr )
+{
+}
+
+SbJScriptMethod::~SbJScriptMethod()
+{}
+
+
+SbObjModule::SbObjModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVbaCompatible )
+ : SbModule( rName, bIsVbaCompatible )
+{
+ SetModuleType( mInfo.ModuleType );
+ if ( mInfo.ModuleType == script::ModuleType::FORM )
+ {
+ SetClassName( "Form" );
+ }
+ else if ( mInfo.ModuleObject.is() )
+ {
+ SetUnoObject( uno::Any( mInfo.ModuleObject ) );
+ }
+}
+
+SbObjModule::~SbObjModule()
+{
+}
+
+void
+SbObjModule::SetUnoObject( const uno::Any& aObj )
+{
+ SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pDocObject.get() );
+ if ( pUnoObj && pUnoObj->getUnoAny() == aObj ) // object is equal, nothing to do
+ return;
+ pDocObject = new SbUnoObject( GetName(), aObj );
+
+ css::uno::Reference< css::lang::XServiceInfo > xServiceInfo( aObj, css::uno::UNO_QUERY_THROW );
+ if( xServiceInfo->supportsService( "ooo.vba.excel.Worksheet" ) )
+ {
+ SetClassName( "Worksheet" );
+ }
+ else if( xServiceInfo->supportsService( "ooo.vba.excel.Workbook" ) )
+ {
+ SetClassName( "Workbook" );
+ }
+}
+
+SbxVariable*
+SbObjModule::GetObject()
+{
+ return pDocObject.get();
+}
+SbxVariable*
+SbObjModule::Find( const OUString& rName, SbxClassType t )
+{
+ SbxVariable* pVar = nullptr;
+ if ( pDocObject )
+ pVar = pDocObject->Find( rName, t );
+ if ( !pVar )
+ pVar = SbModule::Find( rName, t );
+ return pVar;
+}
+
+void SbObjModule::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ SbModule::handleProcedureProperties( rBC, rHint );
+}
+
+
+typedef ::cppu::WeakImplHelper<
+ awt::XTopWindowListener,
+ awt::XWindowListener,
+ document::XDocumentEventListener > FormObjEventListener_BASE;
+
+class FormObjEventListenerImpl:
+ public FormObjEventListener_BASE
+{
+ SbUserFormModule* mpUserForm;
+ uno::Reference< lang::XComponent > mxComponent;
+ uno::Reference< frame::XModel > mxModel;
+ bool mbDisposed;
+ bool mbOpened;
+ bool mbActivated;
+ bool mbShowing;
+
+public:
+ FormObjEventListenerImpl(const FormObjEventListenerImpl&) = delete;
+ const FormObjEventListenerImpl& operator=(const FormObjEventListenerImpl&) = delete;
+ FormObjEventListenerImpl( SbUserFormModule* pUserForm, const uno::Reference< lang::XComponent >& xComponent, const uno::Reference< frame::XModel >& xModel ) :
+ mpUserForm( pUserForm ), mxComponent( xComponent), mxModel( xModel ),
+ mbDisposed( false ), mbOpened( false ), mbActivated( false ), mbShowing( false )
+ {
+ if ( mxComponent.is() )
+ {
+ try
+ {
+ uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->addTopWindowListener( this );
+ }
+ catch(const uno::Exception& ) {}
+ try
+ {
+ uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->addWindowListener( this );
+ }
+ catch(const uno::Exception& ) {}
+ }
+
+ if ( mxModel.is() )
+ {
+ try
+ {
+ uno::Reference< document::XDocumentEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->addDocumentEventListener( this );
+ }
+ catch(const uno::Exception& ) {}
+ }
+ }
+
+ virtual ~FormObjEventListenerImpl() override
+ {
+ removeListener();
+ }
+
+ bool isShowing() const { return mbShowing; }
+
+ void removeListener()
+ {
+ if ( mxComponent.is() && !mbDisposed )
+ {
+ try
+ {
+ uno::Reference< awt::XTopWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeTopWindowListener( this );
+ }
+ catch(const uno::Exception& ) {}
+ try
+ {
+ uno::Reference< awt::XWindow >( mxComponent, uno::UNO_QUERY_THROW )->removeWindowListener( this );
+ }
+ catch(const uno::Exception& ) {}
+ }
+ mxComponent.clear();
+
+ if ( mxModel.is() && !mbDisposed )
+ {
+ try
+ {
+ uno::Reference< document::XDocumentEventBroadcaster >( mxModel, uno::UNO_QUERY_THROW )->removeDocumentEventListener( this );
+ }
+ catch(const uno::Exception& ) {}
+ }
+ mxModel.clear();
+ }
+
+ virtual void SAL_CALL windowOpened( const lang::EventObject& /*e*/ ) override
+ {
+ if ( mpUserForm )
+ {
+ mbOpened = true;
+ mbShowing = true;
+ if ( mbActivated )
+ {
+ mbOpened = mbActivated = false;
+ mpUserForm->triggerActivateEvent();
+ }
+ }
+ }
+
+
+ virtual void SAL_CALL windowClosing( const lang::EventObject& /*e*/ ) override
+ {
+#ifdef IN_THE_FUTURE
+ uno::Reference< awt::XDialog > xDialog( e.Source, uno::UNO_QUERY );
+ if ( xDialog.is() )
+ {
+ uno::Reference< awt::XControl > xControl( xDialog, uno::UNO_QUERY );
+ if ( xControl->getPeer().is() )
+ {
+ uno::Reference< document::XVbaMethodParameter > xVbaMethodParameter( xControl->getPeer(), uno::UNO_QUERY );
+ if ( xVbaMethodParameter.is() )
+ {
+ sal_Int8 nCancel = 0;
+ sal_Int8 nCloseMode = ::ooo::vba::VbQueryClose::vbFormControlMenu;
+
+ Sequence< Any > aParams;
+ aParams.realloc(2);
+ aParams[0] <<= nCancel;
+ aParams[1] <<= nCloseMode;
+
+ mpUserForm->triggerMethod( "Userform_QueryClose", aParams);
+ return;
+
+ }
+ }
+ }
+
+ mpUserForm->triggerMethod( "Userform_QueryClose" );
+#endif
+ }
+
+
+ virtual void SAL_CALL windowClosed( const lang::EventObject& /*e*/ ) override
+ {
+ mbOpened = false;
+ mbShowing = false;
+ }
+
+ virtual void SAL_CALL windowMinimized( const lang::EventObject& /*e*/ ) override
+ {
+ }
+
+ virtual void SAL_CALL windowNormalized( const lang::EventObject& /*e*/ ) override
+ {
+ }
+
+ virtual void SAL_CALL windowActivated( const lang::EventObject& /*e*/ ) override
+ {
+ if ( mpUserForm )
+ {
+ mbActivated = true;
+ if ( mbOpened )
+ {
+ mbOpened = mbActivated = false;
+ mpUserForm->triggerActivateEvent();
+ }
+ }
+ }
+
+ virtual void SAL_CALL windowDeactivated( const lang::EventObject& /*e*/ ) override
+ {
+ if ( mpUserForm )
+ mpUserForm->triggerDeactivateEvent();
+ }
+
+ virtual void SAL_CALL windowResized( const awt::WindowEvent& /*e*/ ) override
+ {
+ if ( mpUserForm )
+ {
+ mpUserForm->triggerResizeEvent();
+ mpUserForm->triggerLayoutEvent();
+ }
+ }
+
+ virtual void SAL_CALL windowMoved( const awt::WindowEvent& /*e*/ ) override
+ {
+ if ( mpUserForm )
+ mpUserForm->triggerLayoutEvent();
+ }
+
+ virtual void SAL_CALL windowShown( const lang::EventObject& /*e*/ ) override
+ {
+ }
+
+ virtual void SAL_CALL windowHidden( const lang::EventObject& /*e*/ ) override
+ {
+ }
+
+ virtual void SAL_CALL documentEventOccured( const document::DocumentEvent& rEvent ) override
+ {
+ // early disposing on document event "OnUnload", to be sure Basic still exists when calling VBA "UserForm_Terminate"
+ if( rEvent.EventName == GlobalEventConfig::GetEventName( GlobalEventId::CLOSEDOC ) )
+ {
+ removeListener();
+ mbDisposed = true;
+ if ( mpUserForm )
+ mpUserForm->ResetApiObj(); // will trigger "UserForm_Terminate"
+ }
+ }
+
+ virtual void SAL_CALL disposing( const lang::EventObject& /*Source*/ ) override
+ {
+ removeListener();
+ mbDisposed = true;
+ if ( mpUserForm )
+ mpUserForm->ResetApiObj( false ); // pass false (too late to trigger VBA events here)
+ }
+};
+
+SbUserFormModule::SbUserFormModule( const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsCompat )
+ : SbObjModule( rName, mInfo, bIsCompat )
+ , m_mInfo( mInfo )
+ , mbInit( false )
+{
+ m_xModel.set( mInfo.ModuleObject, uno::UNO_QUERY_THROW );
+}
+
+SbUserFormModule::~SbUserFormModule()
+{
+}
+
+void SbUserFormModule::ResetApiObj( bool bTriggerTerminateEvent )
+{
+ SAL_INFO("basic", " SbUserFormModule::ResetApiObj( " << (bTriggerTerminateEvent ? "true )" : "false )") );
+ if ( bTriggerTerminateEvent && m_xDialog.is() ) // probably someone close the dialog window
+ {
+ triggerTerminateEvent();
+ }
+ pDocObject = nullptr;
+ m_xDialog = nullptr;
+}
+
+void SbUserFormModule::triggerMethod( const OUString& aMethodToRun )
+{
+ Sequence< Any > aArguments;
+ triggerMethod( aMethodToRun, aArguments );
+}
+
+void SbUserFormModule::triggerMethod( const OUString& aMethodToRun, Sequence< Any >& aArguments )
+{
+ SAL_INFO("basic", "trigger " << aMethodToRun);
+ // Search method
+ SbxVariable* pMeth = SbObjModule::Find( aMethodToRun, SbxClassType::Method );
+ if( !pMeth )
+ return;
+
+ if ( aArguments.hasElements() ) // Setup parameters
+ {
+ auto xArray = tools::make_ref<SbxArray>();
+ xArray->Put32( pMeth, 0 ); // Method as parameter 0
+
+ for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
+ {
+ auto xSbxVar = tools::make_ref<SbxVariable>( SbxVARIANT );
+ unoToSbxValue( xSbxVar.get(), aArguments[i] );
+ xArray->Put32( xSbxVar.get(), static_cast< sal_uInt32 >( i ) + 1 );
+
+ // Enable passing by ref
+ if ( xSbxVar->GetType() != SbxVARIANT )
+ xSbxVar->SetFlag( SbxFlagBits::Fixed );
+ }
+ pMeth->SetParameters( xArray.get() );
+
+ SbxValues aVals;
+ pMeth->Get( aVals );
+
+ for ( sal_Int32 i = 0; i < aArguments.getLength(); ++i )
+ {
+ aArguments[i] = sbxToUnoValue( xArray->Get32( static_cast< sal_uInt32 >(i) + 1) );
+ }
+ pMeth->SetParameters( nullptr );
+ }
+ else
+ {
+ SbxValues aVals;
+ pMeth->Get( aVals );
+ }
+}
+
+void SbUserFormModule::triggerActivateEvent()
+{
+ triggerMethod( "UserForm_Activate" );
+}
+
+void SbUserFormModule::triggerDeactivateEvent()
+{
+ triggerMethod( "Userform_Deactivate" );
+}
+
+void SbUserFormModule::triggerInitializeEvent()
+{
+ if ( mbInit )
+ return;
+ triggerMethod("Userform_Initialize");
+ mbInit = true;
+}
+
+void SbUserFormModule::triggerTerminateEvent()
+{
+ triggerMethod("Userform_Terminate");
+ mbInit=false;
+}
+
+void SbUserFormModule::triggerLayoutEvent()
+{
+ triggerMethod("Userform_Layout");
+}
+
+void SbUserFormModule::triggerResizeEvent()
+{
+ triggerMethod("Userform_Resize");
+}
+
+SbUserFormModuleInstance* SbUserFormModule::CreateInstance()
+{
+ SbUserFormModuleInstance* pInstance = new SbUserFormModuleInstance( this, GetName(), m_mInfo, IsVBACompat() );
+ return pInstance;
+}
+
+SbUserFormModuleInstance::SbUserFormModuleInstance( SbUserFormModule* pParentModule,
+ const OUString& rName, const css::script::ModuleInfo& mInfo, bool bIsVBACompat )
+ : SbUserFormModule( rName, mInfo, bIsVBACompat )
+ , m_pParentModule( pParentModule )
+{
+}
+
+bool SbUserFormModuleInstance::IsClass( const OUString& rName ) const
+{
+ bool bParentNameMatches = m_pParentModule->GetName().equalsIgnoreAsciiCase( rName );
+ bool bRet = bParentNameMatches || SbxObject::IsClass( rName );
+ return bRet;
+}
+
+SbxVariable* SbUserFormModuleInstance::Find( const OUString& rName, SbxClassType t )
+{
+ SbxVariable* pVar = m_pParentModule->Find( rName, t );
+ return pVar;
+}
+
+
+void SbUserFormModule::Load()
+{
+ // forces a load
+ if ( !pDocObject.is() )
+ InitObject();
+}
+
+
+void SbUserFormModule::Unload()
+{
+ sal_Int8 nCancel = 0;
+
+ Sequence< Any > aParams;
+ aParams.realloc(2);
+ aParams[0] <<= nCancel;
+ aParams[1] <<= sal_Int8(::ooo::vba::VbQueryClose::vbFormCode);
+
+ triggerMethod( "Userform_QueryClose", aParams);
+
+ aParams[0] >>= nCancel;
+ // basic boolean ( and what the user might use ) can be ambiguous ( e.g. basic true = -1 )
+ // test against 0 ( false ) and assume anything else is true
+ // ( Note: ) this used to work ( something changes somewhere )
+ if (nCancel != 0)
+ {
+ return;
+ }
+
+ if ( m_xDialog.is() )
+ {
+ triggerTerminateEvent();
+ }
+ // Search method
+ SbxVariable* pMeth = SbObjModule::Find( "UnloadObject", SbxClassType::Method );
+ if( !pMeth )
+ return;
+
+ SAL_INFO("basic", "Attempting to run the UnloadObjectMethod");
+ m_xDialog.clear(); //release ref to the uno object
+ SbxValues aVals;
+ bool bWaitForDispose = true; // assume dialog is showing
+ if (m_DialogListener)
+ {
+ bWaitForDispose = m_DialogListener->isShowing();
+ SAL_INFO("basic", "Showing " << bWaitForDispose );
+ }
+ pMeth->Get( aVals);
+ if ( !bWaitForDispose )
+ {
+ // we've either already got a dispose or we are never going to get one
+ ResetApiObj();
+ } // else wait for dispose
+ SAL_INFO("basic", "UnloadObject completed (we hope)");
+}
+
+
+void SbUserFormModule::InitObject()
+{
+ try
+ {
+ SbUnoObject* pGlobs = static_cast<SbUnoObject*>(GetParent()->Find( "VBAGlobals", SbxClassType::DontCare ));
+ if ( m_xModel.is() && pGlobs )
+ {
+ // broadcast INITIALIZE_USERFORM script event before the dialog is created
+ Reference< script::vba::XVBACompatibility > xVBACompat( getVBACompatibility( m_xModel ), uno::UNO_SET_THROW );
+ xVBACompat->broadcastVBAScriptEvent( script::vba::VBAScriptEventId::INITIALIZE_USERFORM, GetName() );
+ uno::Reference< lang::XMultiServiceFactory > xVBAFactory( pGlobs->getUnoAny(), uno::UNO_QUERY_THROW );
+ uno::Reference< uno::XComponentContext > xContext = comphelper::getProcessComponentContext();
+ OUString sDialogUrl( "vnd.sun.star.script:" );
+ OUString sProjectName( "Standard" );
+
+ try
+ {
+ Reference< beans::XPropertySet > xProps( m_xModel, UNO_QUERY_THROW );
+ uno::Reference< script::vba::XVBACompatibility > xVBAMode( xProps->getPropertyValue( "BasicLibraries" ), uno::UNO_QUERY_THROW );
+ sProjectName = xVBAMode->getProjectName();
+ }
+ catch(const Exception& ) {}
+
+ sDialogUrl += sProjectName + "." + GetName() + "?location=document";
+
+ uno::Reference< awt::XDialogProvider > xProvider = awt::DialogProvider::createWithModel( xContext, m_xModel );
+ m_xDialog = xProvider->createDialog( sDialogUrl );
+
+ // create vba api object
+ uno::Sequence< uno::Any > aArgs(4);
+ aArgs[ 0 ] = uno::Any();
+ aArgs[ 1 ] <<= m_xDialog;
+ aArgs[ 2 ] <<= m_xModel;
+ aArgs[ 3 ] <<= GetParent()->GetName();
+ pDocObject = new SbUnoObject( GetName(), uno::Any( xVBAFactory->createInstanceWithArguments( "ooo.vba.msforms.UserForm", aArgs ) ) );
+
+ uno::Reference< lang::XComponent > xComponent( m_xDialog, uno::UNO_QUERY_THROW );
+
+ // the dialog must be disposed at the end!
+ StarBASIC* pParentBasic = nullptr;
+ SbxObject* pCurObject = this;
+ do
+ {
+ SbxObject* pObjParent = pCurObject->GetParent();
+ pParentBasic = dynamic_cast<StarBASIC*>( pObjParent );
+ pCurObject = pObjParent;
+ }
+ while( pParentBasic == nullptr && pCurObject != nullptr );
+
+ SAL_WARN_IF( pParentBasic == nullptr, "basic", "pParentBasic == NULL" );
+ registerComponentToBeDisposedForBasic( xComponent, pParentBasic );
+
+ // if old listener object exists, remove it from dialog and document model
+ if( m_DialogListener.is() )
+ m_DialogListener->removeListener();
+ m_DialogListener.set( new FormObjEventListenerImpl( this, xComponent, m_xModel ) );
+
+ triggerInitializeEvent();
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ }
+
+}
+
+SbxVariable*
+SbUserFormModule::Find( const OUString& rName, SbxClassType t )
+{
+ if ( !pDocObject.is() && !GetSbData()->bRunInit && GetSbData()->pInst )
+ InitObject();
+ return SbObjModule::Find( rName, t );
+}
+
+SbProperty::SbProperty( const OUString& r, SbxDataType t, SbModule* p )
+ : SbxProperty( r, t ), pMod( p )
+{
+}
+
+SbProperty::~SbProperty()
+{}
+
+
+SbProcedureProperty::~SbProcedureProperty()
+{}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/basiccharclass.cxx b/basic/source/comp/basiccharclass.cxx
new file mode 100644
index 000000000..c06bd8bb6
--- /dev/null
+++ b/basic/source/comp/basiccharclass.cxx
@@ -0,0 +1,58 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basiccharclass.hxx>
+
+#include <unotools/charclass.hxx>
+#include <rtl/character.hxx>
+#include <vcl/svapp.hxx>
+#include <vcl/settings.hxx>
+
+bool BasicCharClass::isLetter( sal_Unicode c )
+{
+ //All characters from C0 to FF are letters except D7 and F7
+ return (c < 0xFF ?
+ ( (c >= 0xC0) && (c != 0xD7) && (c != 0xF7) ) :
+ BasicCharClass::isLetterUnicode( c ));
+}
+
+bool BasicCharClass::isLetterUnicode( sal_Unicode c )
+{
+ static CharClass* pCharClass = new CharClass( Application::GetSettings().GetLanguageTag() );
+ // can we get pCharClass to accept a sal_Unicode instead of this waste?
+ return pCharClass->isLetter( OUString(c), 0 );
+}
+
+bool BasicCharClass::isAlpha( sal_Unicode c, bool bCompatible )
+{
+ return rtl::isAsciiAlpha(c)
+ || (bCompatible && BasicCharClass::isLetter( c ));
+}
+
+bool BasicCharClass::isAlphaNumeric( sal_Unicode c, bool bCompatible )
+{
+ return rtl::isAsciiDigit( c ) || BasicCharClass::isAlpha( c, bCompatible );
+}
+
+bool BasicCharClass::isWhitespace( sal_Unicode c )
+{
+ return (c == ' ') || (c == '\t') || (c == '\f');
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/buffer.cxx b/basic/source/comp/buffer.cxx
new file mode 100644
index 000000000..80017fcca
--- /dev/null
+++ b/basic/source/comp/buffer.cxx
@@ -0,0 +1,221 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <buffer.hxx>
+#include <parser.hxx>
+
+#include <basic/sberrors.hxx>
+
+const static sal_uInt32 UP_LIMIT=0xFFFFFF00;
+
+// The SbiBuffer will be expanded in increments of at least 16 Bytes.
+// This is necessary, because many classes emanate from a buffer length
+// of x*16 Bytes.
+
+SbiBuffer::SbiBuffer( SbiParser* p, short n )
+{
+ pParser = p;
+ n = ( (n + 15 ) / 16 ) * 16;
+ if( !n ) n = 16;
+ pBuf = nullptr;
+ pCur = nullptr;
+ nInc = n;
+ nSize =
+ nOff = 0;
+}
+
+SbiBuffer::~SbiBuffer()
+{
+}
+
+// Reach out the buffer
+// This lead to the deletion of the buffer!
+
+char* SbiBuffer::GetBuffer()
+{
+ char* p = pBuf.release();
+ pCur = nullptr;
+ return p;
+}
+
+// Test, if the buffer can contain n Bytes.
+// In case of doubt it will be enlarged
+
+bool SbiBuffer::Check( sal_Int32 n )
+{
+ if( !n )
+ {
+ return true;
+ }
+ if( nOff + n > nSize )
+ {
+ if( nInc == 0 )
+ {
+ return false;
+ }
+
+ sal_Int32 nn = 0;
+ while( nn < n )
+ {
+ nn = nn + nInc;
+ }
+ char* p;
+ if( ( nSize + nn ) > UP_LIMIT )
+ {
+ p = nullptr;
+ }
+ else
+ {
+ p = new char [nSize + nn];
+ }
+ if( !p )
+ {
+ pParser->Error( ERRCODE_BASIC_PROG_TOO_LARGE );
+ nInc = 0;
+ pBuf.reset();
+ return false;
+ }
+ else
+ {
+ if( nSize ) memcpy( p, pBuf.get(), nSize );
+ pBuf.reset(p);
+ pCur = pBuf.get() + nOff;
+ nSize = nSize + nn;
+ }
+ }
+ return true;
+}
+
+// Patch of a Location
+
+void SbiBuffer::Patch( sal_uInt32 off, sal_uInt32 val )
+{
+ if( ( off + sizeof( sal_uInt32 ) ) < nOff )
+ {
+ sal_uInt16 val1 = static_cast<sal_uInt16>( val & 0xFFFF );
+ sal_uInt16 val2 = static_cast<sal_uInt16>( val >> 16 );
+ sal_uInt8* p = reinterpret_cast<sal_uInt8*>(pBuf.get()) + off;
+ *p++ = static_cast<char>( val1 & 0xFF );
+ *p++ = static_cast<char>( val1 >> 8 );
+ *p++ = static_cast<char>( val2 & 0xFF );
+ *p = static_cast<char>( val2 >> 8 );
+ }
+}
+
+// Forward References upon label and procedures
+// establish a linkage. The beginning of the linkage is at the passed parameter,
+// the end of the linkage is 0.
+
+void SbiBuffer::Chain( sal_uInt32 off )
+{
+ if( !(off && pBuf) )
+ return;
+
+ sal_uInt8 *ip;
+ sal_uInt32 i = off;
+ sal_uInt32 val1 = (nOff & 0xFFFF);
+ sal_uInt32 val2 = (nOff >> 16);
+ do
+ {
+ ip = reinterpret_cast<sal_uInt8*>(pBuf.get()) + i;
+ sal_uInt8* pTmp = ip;
+ i = *pTmp++; i |= *pTmp++ << 8; i |= *pTmp++ << 16; i |= *pTmp++ << 24;
+
+ if( i >= nOff )
+ {
+ pParser->Error( ERRCODE_BASIC_INTERNAL_ERROR, "BACKCHAIN" );
+ break;
+ }
+ *ip++ = static_cast<char>( val1 & 0xFF );
+ *ip++ = static_cast<char>( val1 >> 8 );
+ *ip++ = static_cast<char>( val2 & 0xFF );
+ *ip = static_cast<char>( val2 >> 8 );
+ } while( i );
+}
+
+void SbiBuffer::operator +=( sal_Int8 n )
+{
+ if( Check( 1 ) )
+ {
+ *pCur++ = static_cast<char>(n);
+ nOff += 1;
+ }
+}
+
+bool SbiBuffer::operator +=( sal_uInt8 n )
+{
+ if( Check( 1 ) )
+ {
+ *pCur++ = static_cast<char>(n);
+ nOff += 1;
+ return true;
+ }
+ else
+ {
+ return false;
+ }
+}
+
+void SbiBuffer::operator +=( sal_Int16 n )
+{
+ if( Check( 2 ) )
+ {
+ *pCur++ = static_cast<char>( n & 0xFF );
+ *pCur++ = static_cast<char>( n >> 8 );
+ nOff += 2;
+ }
+}
+
+bool SbiBuffer::operator +=( sal_uInt16 n )
+{
+ if( Check( 2 ) )
+ {
+ *pCur++ = static_cast<char>( n & 0xFF );
+ *pCur++ = static_cast<char>( n >> 8 );
+ nOff += 2;
+ return true;
+ }
+ else
+ {
+ return false;
+ }
+}
+
+bool SbiBuffer::operator +=( sal_uInt32 n )
+{
+ if( Check( 4 ) )
+ {
+ sal_uInt16 n1 = static_cast<sal_uInt16>( n & 0xFFFF );
+ sal_uInt16 n2 = static_cast<sal_uInt16>( n >> 16 );
+ operator +=(n1) && operator +=(n2);
+ return true;
+ }
+ else
+ {
+ return false;
+ }
+}
+
+void SbiBuffer::operator +=( sal_Int32 n )
+{
+ operator +=( static_cast<sal_uInt32>(n) );
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/codegen.cxx b/basic/source/comp/codegen.cxx
new file mode 100644
index 000000000..58e0e59c3
--- /dev/null
+++ b/basic/source/comp/codegen.cxx
@@ -0,0 +1,585 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <basic/sberrors.hxx>
+#include <basic/sbx.hxx>
+#include <basic/sbmeth.hxx>
+#include <basic/sbmod.hxx>
+#include <image.hxx>
+#include <codegen.hxx>
+#include <parser.hxx>
+#include <sbintern.hxx>
+#include <cstddef>
+#include <limits>
+#include <algorithm>
+#include <string_view>
+#include <osl/diagnose.h>
+#include <rtl/ustrbuf.hxx>
+#include <com/sun/star/script/ModuleType.hpp>
+
+// nInc is the increment size of the buffers
+
+SbiCodeGen::SbiCodeGen( SbModule& r, SbiParser* p, short nInc )
+ : rMod( r ), aCode( p, nInc )
+{
+ pParser = p;
+ bStmnt = false;
+ nLine = 0;
+ nCol = 0;
+ nForLevel = 0;
+}
+
+sal_uInt32 SbiCodeGen::GetPC() const
+{
+ return aCode.GetSize();
+}
+
+// memorize the statement
+
+void SbiCodeGen::Statement()
+{
+ if( pParser->IsCodeCompleting() )
+ return;
+
+ bStmnt = true;
+
+ nLine = pParser->GetLine();
+ nCol = pParser->GetCol1();
+
+ // #29955 Store the information of the for-loop-layer
+ // in the upper Byte of the column
+ nCol = (nCol & 0xff) + 0x100 * nForLevel;
+}
+
+// Mark the beginning of a statement
+
+void SbiCodeGen::GenStmnt()
+{
+ if( pParser->IsCodeCompleting() )
+ return;
+
+ if( bStmnt )
+ {
+ bStmnt = false;
+ Gen( SbiOpcode::STMNT_, nLine, nCol );
+ }
+}
+
+// The Gen-Routines return the offset of the 1. operand,
+// so that jumps can sink their backchain there.
+
+sal_uInt32 SbiCodeGen::Gen( SbiOpcode eOpcode )
+{
+ if( pParser->IsCodeCompleting() )
+ return 0;
+
+#ifdef DBG_UTIL
+ if( eOpcode < SbiOpcode::SbOP0_START || eOpcode > SbiOpcode::SbOP0_END )
+ pParser->Error( ERRCODE_BASIC_INTERNAL_ERROR, "OPCODE1" );
+#endif
+ GenStmnt();
+ aCode += static_cast<sal_uInt8>(eOpcode);
+ return GetPC();
+}
+
+sal_uInt32 SbiCodeGen::Gen( SbiOpcode eOpcode, sal_uInt32 nOpnd )
+{
+ if( pParser->IsCodeCompleting() )
+ return 0;
+
+#ifdef DBG_UTIL
+ if( eOpcode < SbiOpcode::SbOP1_START || eOpcode > SbiOpcode::SbOP1_END )
+ pParser->Error( ERRCODE_BASIC_INTERNAL_ERROR, "OPCODE2" );
+#endif
+ GenStmnt();
+ aCode += static_cast<sal_uInt8>(eOpcode);
+ sal_uInt32 n = GetPC();
+ aCode += nOpnd;
+ return n;
+}
+
+sal_uInt32 SbiCodeGen::Gen( SbiOpcode eOpcode, sal_uInt32 nOpnd1, sal_uInt32 nOpnd2 )
+{
+ if( pParser->IsCodeCompleting() )
+ return 0;
+
+#ifdef DBG_UTIL
+ if( eOpcode < SbiOpcode::SbOP2_START || eOpcode > SbiOpcode::SbOP2_END )
+ pParser->Error( ERRCODE_BASIC_INTERNAL_ERROR, "OPCODE3" );
+#endif
+ GenStmnt();
+ aCode += static_cast<sal_uInt8>(eOpcode);
+ sal_uInt32 n = GetPC();
+ aCode += nOpnd1;
+ aCode += nOpnd2;
+ return n;
+}
+
+// Storing of the created image in the module
+
+void SbiCodeGen::Save()
+{
+ if( pParser->IsCodeCompleting() )
+ return;
+
+ SbiImage* p = new SbiImage;
+ rMod.StartDefinitions();
+ // OPTION BASE-Value:
+ p->nDimBase = pParser->nBase;
+ // OPTION take over the EXPLICIT-Flag
+ if( pParser->bExplicit )
+ p->SetFlag( SbiImageFlags::EXPLICIT );
+
+ int nIfaceCount = 0;
+ if( rMod.mnType == css::script::ModuleType::CLASS )
+ {
+ rMod.bIsProxyModule = true;
+ p->SetFlag( SbiImageFlags::CLASSMODULE );
+ GetSbData()->pClassFac->AddClassModule( &rMod );
+
+ nIfaceCount = pParser->aIfaceVector.size();
+ if( !rMod.pClassData )
+ rMod.pClassData.reset(new SbClassData);
+ if( nIfaceCount )
+ {
+ for( int i = 0 ; i < nIfaceCount ; i++ )
+ {
+ const OUString& rIfaceName = pParser->aIfaceVector[i];
+ SbxVariable* pIfaceVar = new SbxVariable( SbxVARIANT );
+ pIfaceVar->SetName( rIfaceName );
+ SbxArray* pIfaces = rMod.pClassData->mxIfaces.get();
+ pIfaces->Insert32( pIfaceVar, pIfaces->Count32() );
+ }
+ }
+
+ rMod.pClassData->maRequiredTypes = pParser->aRequiredTypes;
+ }
+ else
+ {
+ GetSbData()->pClassFac->RemoveClassModule( &rMod );
+ // Only a ClassModule can revert to Normal
+ if ( rMod.mnType == css::script::ModuleType::CLASS )
+ {
+ rMod.mnType = css::script::ModuleType::NORMAL;
+ }
+ rMod.bIsProxyModule = false;
+ }
+
+ // GlobalCode-Flag
+ if( pParser->HasGlobalCode() )
+ {
+ p->SetFlag( SbiImageFlags::INITCODE );
+ }
+ // The entry points:
+ for( SbiSymDef* pDef = pParser->aPublics.First(); pDef;
+ pDef = pParser->aPublics.Next() )
+ {
+ SbiProcDef* pProc = pDef->GetProcDef();
+ if( pProc && pProc->IsDefined() )
+ {
+ OUString aProcName = pProc->GetName();
+ OUStringBuffer aIfaceProcName;
+ OUString aIfaceName;
+ sal_uInt16 nPassCount = 1;
+ if( nIfaceCount )
+ {
+ int nPropPrefixFound = aProcName.indexOf("Property ");
+ OUString aPureProcName = aProcName;
+ OUString aPropPrefix;
+ if( nPropPrefixFound == 0 )
+ {
+ aPropPrefix = aProcName.copy( 0, 13 ); // 13 == Len( "Property ?et " )
+ aPureProcName = aProcName.copy( 13 );
+ }
+ for( int i = 0 ; i < nIfaceCount ; i++ )
+ {
+ const OUString& rIfaceName = pParser->aIfaceVector[i];
+ int nFound = aPureProcName.indexOf( rIfaceName );
+ if( nFound == 0 && aPureProcName[rIfaceName.getLength()] == '_' )
+ {
+ if( nPropPrefixFound == 0 )
+ {
+ aIfaceProcName.append(aPropPrefix);
+ }
+ aIfaceProcName.append(std::u16string_view(aPureProcName).substr(rIfaceName.getLength() + 1) );
+ aIfaceName = rIfaceName;
+ nPassCount = 2;
+ break;
+ }
+ }
+ }
+ SbMethod* pMeth = nullptr;
+ for( sal_uInt16 nPass = 0 ; nPass < nPassCount ; nPass++ )
+ {
+ if( nPass == 1 )
+ {
+ aProcName = aIfaceProcName.toString();
+ }
+ PropertyMode ePropMode = pProc->getPropertyMode();
+ if( ePropMode != PropertyMode::NONE )
+ {
+ SbxDataType ePropType = SbxEMPTY;
+ switch( ePropMode )
+ {
+ case PropertyMode::Get:
+ ePropType = pProc->GetType();
+ break;
+ case PropertyMode::Let:
+ {
+ // type == type of first parameter
+ ePropType = SbxVARIANT; // Default
+ SbiSymPool* pPool = &pProc->GetParams();
+ if( pPool->GetSize() > 1 )
+ {
+ SbiSymDef* pPar = pPool->Get( 1 );
+ if( pPar )
+ {
+ ePropType = pPar->GetType();
+ }
+ }
+ break;
+ }
+ case PropertyMode::Set:
+ ePropType = SbxOBJECT;
+ break;
+ default:
+ OSL_FAIL("Illegal PropertyMode");
+ break;
+ }
+ OUString aPropName = pProc->GetPropName();
+ if( nPass == 1 )
+ {
+ aPropName = aPropName.copy( aIfaceName.getLength() + 1 );
+ }
+ rMod.GetProcedureProperty( aPropName, ePropType );
+ }
+ if( nPass == 1 )
+ {
+ rMod.GetIfaceMapperMethod( aProcName, pMeth );
+ }
+ else
+ {
+ pMeth = rMod.GetMethod( aProcName, pProc->GetType() );
+
+ if( !pProc->IsPublic() )
+ {
+ pMeth->SetFlag( SbxFlagBits::Private );
+ }
+ // Declare? -> Hidden
+ if( !pProc->GetLib().isEmpty())
+ {
+ pMeth->SetFlag( SbxFlagBits::Hidden );
+ }
+ pMeth->nStart = pProc->GetAddr();
+ pMeth->nLine1 = pProc->GetLine1();
+ pMeth->nLine2 = pProc->GetLine2();
+ // The parameter:
+ SbxInfo* pInfo = pMeth->GetInfo();
+ OUString aHelpFile, aComment;
+ sal_uInt32 nHelpId = 0;
+ if( pInfo )
+ {
+ // Rescue the additional data
+ aHelpFile = pInfo->GetHelpFile();
+ aComment = pInfo->GetComment();
+ nHelpId = pInfo->GetHelpId();
+ }
+ // And reestablish the parameter list
+ pInfo = new SbxInfo( aHelpFile, nHelpId );
+ pInfo->SetComment( aComment );
+ SbiSymPool* pPool = &pProc->GetParams();
+ // The first element is always the value of the function!
+ for( sal_uInt16 i = 1; i < pPool->GetSize(); i++ )
+ {
+ SbiSymDef* pPar = pPool->Get( i );
+ SbxDataType t = pPar->GetType();
+ if( !pPar->IsByVal() )
+ {
+ t = static_cast<SbxDataType>( t | SbxBYREF );
+ }
+ if( pPar->GetDims() )
+ {
+ t = static_cast<SbxDataType>( t | SbxARRAY );
+ }
+ // #33677 hand-over an Optional-Info
+ SbxFlagBits nFlags = SbxFlagBits::Read;
+ if( pPar->IsOptional() )
+ {
+ nFlags |= SbxFlagBits::Optional;
+ }
+ pInfo->AddParam( pPar->GetName(), t, nFlags );
+
+ sal_uInt32 nUserData = 0;
+ sal_uInt16 nDefaultId = pPar->GetDefaultId();
+ if( nDefaultId )
+ {
+ nUserData |= nDefaultId;
+ }
+ if( pPar->IsParamArray() )
+ {
+ nUserData |= PARAM_INFO_PARAMARRAY;
+ }
+ if( pPar->IsWithBrackets() )
+ {
+ nUserData |= PARAM_INFO_WITHBRACKETS;
+ }
+ SbxParamInfo* pParam = nullptr;
+ if( nUserData )
+ {
+ pParam = const_cast<SbxParamInfo*>(pInfo->GetParam( i ));
+ }
+ if( pParam )
+ {
+ pParam->nUserData = nUserData;
+ }
+ }
+ pMeth->SetInfo( pInfo );
+ }
+ } // for( iPass...
+ }
+ }
+ // The code
+ p->AddCode( std::unique_ptr<char[]>(aCode.GetBuffer()), aCode.GetSize() );
+
+ // The global StringPool. 0 is not occupied.
+ SbiStringPool* pPool = &pParser->aGblStrings;
+ sal_uInt16 nSize = pPool->GetSize();
+ p->MakeStrings( nSize );
+ sal_uInt32 i;
+ for( i = 1; i <= nSize; i++ )
+ {
+ p->AddString( pPool->Find( i ) );
+ }
+ // Insert types
+ sal_uInt32 nCount = pParser->rTypeArray->Count32();
+ for (i = 0; i < nCount; i++)
+ {
+ p->AddType(static_cast<SbxObject *>(pParser->rTypeArray->Get32(i)));
+ }
+ // Insert enum objects
+ nCount = pParser->rEnumArray->Count32();
+ for (i = 0; i < nCount; i++)
+ {
+ p->AddEnum(static_cast<SbxObject *>(pParser->rEnumArray->Get32(i)));
+ }
+ if( !p->IsError() )
+ {
+ rMod.pImage = p;
+ }
+ else
+ {
+ delete p;
+ }
+ rMod.EndDefinitions();
+}
+
+namespace {
+
+template < class T >
+class PCodeVisitor
+{
+public:
+ virtual ~PCodeVisitor();
+
+ virtual void start( const sal_uInt8* pStart ) = 0;
+ virtual void processOpCode0( SbiOpcode eOp ) = 0;
+ virtual void processOpCode1( SbiOpcode eOp, T nOp1 ) = 0;
+ virtual void processOpCode2( SbiOpcode eOp, T nOp1, T nOp2 ) = 0;
+ virtual bool processParams() = 0;
+};
+
+}
+
+template <class T> PCodeVisitor< T >::~PCodeVisitor()
+{}
+
+namespace {
+
+template <class T>
+class PCodeBufferWalker
+{
+private:
+ T m_nBytes;
+ const sal_uInt8* m_pCode;
+ static T readParam( sal_uInt8 const *& pCode )
+ {
+ T nOp1=0;
+ for ( std::size_t i=0; i<sizeof( T ); ++i )
+ nOp1 |= *pCode++ << ( i * 8);
+ return nOp1;
+ }
+public:
+ PCodeBufferWalker( const sal_uInt8* pCode, T nBytes ): m_nBytes( nBytes ), m_pCode( pCode )
+ {
+ }
+ void visitBuffer( PCodeVisitor< T >& visitor )
+ {
+ const sal_uInt8* pCode = m_pCode;
+ if ( !pCode )
+ return;
+ const sal_uInt8* pEnd = pCode + m_nBytes;
+ visitor.start( m_pCode );
+ T nOp1 = 0, nOp2 = 0;
+ for( ; pCode < pEnd; )
+ {
+ SbiOpcode eOp = static_cast<SbiOpcode>(*pCode++);
+
+ if ( eOp <= SbiOpcode::SbOP0_END )
+ visitor.processOpCode0( eOp );
+ else if( eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END )
+ {
+ if ( visitor.processParams() )
+ nOp1 = readParam( pCode );
+ else
+ pCode += sizeof( T );
+ visitor.processOpCode1( eOp, nOp1 );
+ }
+ else if( eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END )
+ {
+ if ( visitor.processParams() )
+ {
+ nOp1 = readParam( pCode );
+ nOp2 = readParam( pCode );
+ }
+ else
+ pCode += ( sizeof( T ) * 2 );
+ visitor.processOpCode2( eOp, nOp1, nOp2 );
+ }
+ }
+ }
+};
+
+template < class T, class S >
+class OffSetAccumulator : public PCodeVisitor< T >
+{
+ T m_nNumOp0;
+ T m_nNumSingleParams;
+ T m_nNumDoubleParams;
+public:
+
+ OffSetAccumulator() : m_nNumOp0(0), m_nNumSingleParams(0), m_nNumDoubleParams(0){}
+ virtual void start( const sal_uInt8* /*pStart*/ ) override {}
+ virtual void processOpCode0( SbiOpcode /*eOp*/ ) override { ++m_nNumOp0; }
+ virtual void processOpCode1( SbiOpcode /*eOp*/, T /*nOp1*/ ) override { ++m_nNumSingleParams; }
+ virtual void processOpCode2( SbiOpcode /*eOp*/, T /*nOp1*/, T /*nOp2*/ ) override { ++m_nNumDoubleParams; }
+ S offset()
+ {
+ typedef decltype(T(1) + S(1)) larger_t; // type capable to hold both value ranges of T and S
+ T result = 0 ;
+ static const S max = std::numeric_limits< S >::max();
+ result = m_nNumOp0 + ( ( sizeof(S) + 1 ) * m_nNumSingleParams ) + ( (( sizeof(S) * 2 )+ 1 ) * m_nNumDoubleParams );
+ return std::min<larger_t>(max, result);
+ }
+ virtual bool processParams() override { return false; }
+};
+
+
+template < class T, class S >
+class BufferTransformer : public PCodeVisitor< T >
+{
+ const sal_uInt8* m_pStart;
+ SbiBuffer m_ConvertedBuf;
+public:
+ BufferTransformer():m_pStart(nullptr), m_ConvertedBuf( nullptr, 1024 ) {}
+ virtual void start( const sal_uInt8* pStart ) override { m_pStart = pStart; }
+ virtual void processOpCode0( SbiOpcode eOp ) override
+ {
+ m_ConvertedBuf += static_cast<sal_uInt8>(eOp);
+ }
+ virtual void processOpCode1( SbiOpcode eOp, T nOp1 ) override
+ {
+ m_ConvertedBuf += static_cast<sal_uInt8>(eOp);
+ switch( eOp )
+ {
+ case SbiOpcode::JUMP_:
+ case SbiOpcode::JUMPT_:
+ case SbiOpcode::JUMPF_:
+ case SbiOpcode::GOSUB_:
+ case SbiOpcode::CASEIS_:
+ case SbiOpcode::RETURN_:
+ case SbiOpcode::ERRHDL_:
+ case SbiOpcode::TESTFOR_:
+ nOp1 = static_cast<T>( convertBufferOffSet(m_pStart, nOp1) );
+ break;
+ case SbiOpcode::RESUME_:
+ if ( nOp1 > 1 )
+ nOp1 = static_cast<T>( convertBufferOffSet(m_pStart, nOp1) );
+ break;
+ default:
+ break;
+
+ }
+ m_ConvertedBuf += static_cast<S>(nOp1);
+ }
+ virtual void processOpCode2( SbiOpcode eOp, T nOp1, T nOp2 ) override
+ {
+ m_ConvertedBuf += static_cast<sal_uInt8>(eOp);
+ if ( eOp == SbiOpcode::CASEIS_ && nOp1 )
+ nOp1 = static_cast<T>( convertBufferOffSet(m_pStart, nOp1) );
+ m_ConvertedBuf += static_cast<S>(nOp1);
+ m_ConvertedBuf += static_cast<S>(nOp2);
+
+ }
+ virtual bool processParams() override { return true; }
+ // yeuch, careful here, you can only call
+ // GetBuffer on the returned SbiBuffer once, also
+ // you (as the caller) get to own the memory
+ SbiBuffer& buffer()
+ {
+ return m_ConvertedBuf;
+ }
+ static S convertBufferOffSet( const sal_uInt8* pStart, T nOp1 )
+ {
+ PCodeBufferWalker< T > aBuff( pStart, nOp1);
+ OffSetAccumulator< T, S > aVisitor;
+ aBuff.visitBuffer( aVisitor );
+ return aVisitor.offset();
+ }
+};
+
+}
+
+sal_uInt32
+SbiCodeGen::calcNewOffSet( sal_uInt8 const * pCode, sal_uInt16 nOffset )
+{
+ return BufferTransformer< sal_uInt16, sal_uInt32 >::convertBufferOffSet( pCode, nOffset );
+}
+
+sal_uInt16
+SbiCodeGen::calcLegacyOffSet( sal_uInt8 const * pCode, sal_uInt32 nOffset )
+{
+ return BufferTransformer< sal_uInt32, sal_uInt16 >::convertBufferOffSet( pCode, nOffset );
+}
+
+template <class T, class S>
+void
+PCodeBuffConvertor<T,S>::convert()
+{
+ PCodeBufferWalker< T > aBuf( m_pStart, m_nSize );
+ BufferTransformer< T, S > aTrnsfrmer;
+ aBuf.visitBuffer( aTrnsfrmer );
+ m_pCnvtdBuf = reinterpret_cast<sal_uInt8*>(aTrnsfrmer.buffer().GetBuffer());
+ m_nCnvtdSize = static_cast<S>( aTrnsfrmer.buffer().GetSize() );
+}
+
+template class PCodeBuffConvertor< sal_uInt16, sal_uInt32 >;
+template class PCodeBuffConvertor< sal_uInt32, sal_uInt16 >;
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/dim.cxx b/basic/source/comp/dim.cxx
new file mode 100644
index 000000000..211d4e325
--- /dev/null
+++ b/basic/source/comp/dim.cxx
@@ -0,0 +1,1328 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/sberrors.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/sbx.hxx>
+#include <sbunoobj.hxx>
+#include <parser.hxx>
+#include <sb.hxx>
+#include <osl/diagnose.h>
+#include <com/sun/star/reflection/theCoreReflection.hpp>
+#include <comphelper/processfactory.hxx>
+#include <com/sun/star/uno/Exception.hpp>
+#include <basic/codecompletecache.hxx>
+#include <memory>
+
+using namespace ::com::sun::star;
+using namespace ::com::sun::star::uno;
+
+// Declaration of a variable
+// If there are errors it will be parsed up to the comma or the newline.
+// Return-value: a new instance, which were inserted and then deleted.
+// Array-Index were returned as SbiExprList
+
+SbiSymDef* SbiParser::VarDecl( SbiExprListPtr* ppDim, bool bStatic, bool bConst )
+{
+ bool bWithEvents = false;
+ if( Peek() == WITHEVENTS )
+ {
+ Next();
+ bWithEvents = true;
+ }
+ if( !TestSymbol() ) return nullptr;
+ SbxDataType t = eScanType;
+ SbiSymDef* pDef = bConst ? new SbiConstDef( aSym ) : new SbiSymDef( aSym );
+ SbiExprListPtr pDim;
+ // Brackets?
+ if( Peek() == LPAREN )
+ {
+ pDim = SbiExprList::ParseDimList( this );
+ if( !pDim->GetDims() )
+ pDef->SetWithBrackets();
+ }
+ pDef->SetType( t );
+ if( bStatic )
+ pDef->SetStatic();
+ if( bWithEvents )
+ pDef->SetWithEvents();
+ TypeDecl( *pDef );
+ if( !ppDim && pDim )
+ {
+ if(pDim->GetDims() )
+ Error( ERRCODE_BASIC_EXPECTED, "()" );
+ }
+ else if( ppDim )
+ *ppDim = std::move(pDim);
+ return pDef;
+}
+
+// Resolving of an AS-Type-Declaration
+// The data type were inserted into the handed over variable
+
+void SbiParser::TypeDecl( SbiSymDef& rDef, bool bAsNewAlreadyParsed )
+{
+ SbxDataType eType = rDef.GetType();
+ if( !(bAsNewAlreadyParsed || Peek() == AS) )
+ return;
+
+ short nSize = 0;
+ if( !bAsNewAlreadyParsed )
+ Next();
+ rDef.SetDefinedAs();
+ SbiToken eTok = Next();
+ if( !bAsNewAlreadyParsed && eTok == NEW )
+ {
+ rDef.SetNew();
+ eTok = Next();
+ }
+ switch( eTok )
+ {
+ case ANY:
+ if( rDef.IsNew() )
+ Error( ERRCODE_BASIC_SYNTAX );
+ eType = SbxVARIANT; break;
+ case TINTEGER:
+ case TLONG:
+ case TSINGLE:
+ case TDOUBLE:
+ case TCURRENCY:
+ case TDATE:
+ case TSTRING:
+ case TOBJECT:
+ case ERROR_:
+ case TBOOLEAN:
+ case TVARIANT:
+ case TBYTE:
+ if( rDef.IsNew() )
+ Error( ERRCODE_BASIC_SYNTAX );
+ eType = (eTok==TBYTE) ? SbxBYTE : SbxDataType( eTok - TINTEGER + SbxINTEGER );
+ if( eType == SbxSTRING )
+ {
+ // STRING*n ?
+ if( Peek() == MUL )
+ { // fixed size!
+ Next();
+ SbiConstExpression aSize( this );
+ nSize = aSize.GetShortValue();
+ if( nSize < 0 || (bVBASupportOn && nSize <= 0) )
+ Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ else
+ rDef.SetFixedStringLength( nSize );
+ }
+ }
+ break;
+ case SYMBOL: // can only be a TYPE or an object class!
+ if( eScanType != SbxVARIANT )
+ Error( ERRCODE_BASIC_SYNTAX );
+ else
+ {
+ OUString aCompleteName = aSym;
+
+ // #52709 DIM AS NEW for Uno with full-qualified name
+ if( Peek() == DOT )
+ {
+ OUString aDotStr( '.' );
+ while( Peek() == DOT )
+ {
+ aCompleteName += aDotStr;
+ Next();
+ SbiToken ePeekTok = Peek();
+ if( ePeekTok == SYMBOL || IsKwd( ePeekTok ) )
+ {
+ Next();
+ aCompleteName += aSym;
+ }
+ else
+ {
+ Next();
+ Error( ERRCODE_BASIC_UNEXPECTED, SYMBOL );
+ break;
+ }
+ }
+ }
+ else if( rEnumArray->Find( aCompleteName, SbxClassType::Object ) || ( IsVBASupportOn() && VBAConstantHelper::instance().isVBAConstantType( aCompleteName ) ) )
+ {
+ eType = SbxLONG;
+ break;
+ }
+
+ // Take over in the string pool
+ rDef.SetTypeId( aGblStrings.Add( aCompleteName ) );
+
+ if( rDef.IsNew() && pProc == nullptr )
+ aRequiredTypes.push_back( aCompleteName );
+ }
+ eType = SbxOBJECT;
+ break;
+ case FIXSTRING: // new syntax for complex UNO types
+ rDef.SetTypeId( aGblStrings.Add( aSym ) );
+ eType = SbxOBJECT;
+ break;
+ default:
+ Error( ERRCODE_BASIC_UNEXPECTED, eTok );
+ Next();
+ }
+ // The variable could have been declared with a suffix
+ if( rDef.GetType() != SbxVARIANT )
+ {
+ if( rDef.GetType() != eType )
+ Error( ERRCODE_BASIC_VAR_DEFINED, rDef.GetName() );
+ else if( eType == SbxSTRING && rDef.GetLen() != nSize )
+ Error( ERRCODE_BASIC_VAR_DEFINED, rDef.GetName() );
+ }
+ rDef.SetType( eType );
+ rDef.SetLen( nSize );
+}
+
+// Here variables, arrays and structures were defined.
+// DIM/PRIVATE/PUBLIC/GLOBAL
+
+void SbiParser::Dim()
+{
+ DefVar( SbiOpcode::DIM_, pProc && bVBASupportOn && pProc->IsStatic() );
+}
+
+void SbiParser::DefVar( SbiOpcode eOp, bool bStatic )
+{
+ SbiSymPool* pOldPool = pPool;
+ bool bSwitchPool = false;
+ bool bPersistentGlobal = false;
+ SbiToken eFirstTok = eCurTok;
+
+ if( pProc && ( eCurTok == GLOBAL || eCurTok == PUBLIC || eCurTok == PRIVATE ) )
+ Error( ERRCODE_BASIC_NOT_IN_SUBR, eCurTok );
+ if( eCurTok == PUBLIC || eCurTok == GLOBAL )
+ {
+ bSwitchPool = true; // at the right moment switch to the global pool
+ if( eCurTok == GLOBAL )
+ bPersistentGlobal = true;
+ }
+ // behavior in VBA is that a module scope variable's lifetime is
+ // tied to the document. e.g. a module scope variable is global
+ if( GetBasic()->IsDocBasic() && bVBASupportOn && !pProc )
+ bPersistentGlobal = true;
+ // PRIVATE is a synonymous for DIM
+ // _CONST_?
+ bool bConst = false;
+ if( eCurTok == CONST_ )
+ bConst = true;
+ else if( Peek() == CONST_ )
+ {
+ Next();
+ bConst = true;
+ }
+
+ // #110004 It can also be a sub/function
+ if( !bConst && (eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY ||
+ eCurTok == STATIC || eCurTok == ENUM || eCurTok == DECLARE || eCurTok == TYPE) )
+ {
+ // Next token is read here, because !bConst
+ bool bPrivate = ( eFirstTok == PRIVATE );
+
+ if( eCurTok == STATIC )
+ {
+ Next();
+ DefStatic( bPrivate );
+ }
+ else if( eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY )
+ {
+ // End global chain if necessary (not done in
+ // SbiParser::Parse() under these conditions
+ if( bNewGblDefs && nGblChain == 0 )
+ {
+ nGblChain = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ bNewGblDefs = false;
+ }
+ Next();
+ DefProc( false, bPrivate );
+ return;
+ }
+ else if( eCurTok == ENUM )
+ {
+ Next();
+ DefEnum( bPrivate );
+ return;
+ }
+ else if( eCurTok == DECLARE )
+ {
+ Next();
+ DefDeclare( bPrivate );
+ return;
+ }
+ // #i109049
+ else if( eCurTok == TYPE )
+ {
+ Next();
+ DefType(); // TODO: Use bPrivate in DefType()
+ return;
+ }
+ }
+
+ // SHARED were ignored
+ if( Peek() == SHARED ) Next();
+
+ // PRESERVE only at REDIM
+ if( Peek() == PRESERVE )
+ {
+ Next();
+ if( eOp == SbiOpcode::REDIM_ )
+ eOp = SbiOpcode::REDIMP_;
+ else
+ Error( ERRCODE_BASIC_UNEXPECTED, eCurTok );
+ }
+ SbiSymDef* pDef;
+ SbiExprListPtr pDim;
+
+ // #40689, Statics -> Module-Initialising, skip in Sub
+ sal_uInt32 nEndOfStaticLbl = 0;
+ if( !bVBASupportOn && bStatic )
+ {
+ nEndOfStaticLbl = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ aGen.Statement(); // catch up on static here
+ }
+
+ bool bDefined = false;
+ while( ( pDef = VarDecl( &pDim, bStatic, bConst ) ) != nullptr )
+ {
+ /*fprintf(stderr, "Actual sub: \n");
+ fprintf(stderr, "Symbol name: %s\n",OUStringToOString(pDef->GetName(),RTL_TEXTENCODING_UTF8).getStr());*/
+ EnableErrors();
+ // search variable:
+ if( bSwitchPool )
+ pPool = &aGlobals;
+ SbiSymDef* pOld = pPool->Find( pDef->GetName() );
+ // search also in the Runtime-Library
+ bool bRtlSym = false;
+ if( !pOld )
+ {
+ pOld = CheckRTLForSym( pDef->GetName(), SbxVARIANT );
+ if( pOld )
+ bRtlSym = true;
+ }
+ if( pOld && !(eOp == SbiOpcode::REDIM_ || eOp == SbiOpcode::REDIMP_) )
+ {
+ if( pDef->GetScope() == SbLOCAL )
+ if (auto eOldScope = pOld->GetScope(); eOldScope != SbLOCAL && eOldScope != SbPARAM)
+ pOld = nullptr;
+ }
+ if( pOld )
+ {
+ bDefined = true;
+ // always an error at a RTL-S
+ if( !bRtlSym && (eOp == SbiOpcode::REDIM_ || eOp == SbiOpcode::REDIMP_) )
+ {
+ // compare the attributes at a REDIM
+ SbxDataType eDefType;
+ bool bError_ = false;
+ if( pOld->IsStatic() )
+ {
+ bError_ = true;
+ }
+ else if( pOld->GetType() != ( eDefType = pDef->GetType() ) )
+ {
+ if( !( eDefType == SbxVARIANT && !pDef->IsDefinedAs() ) )
+ bError_ = true;
+ }
+ if( bError_ )
+ Error( ERRCODE_BASIC_VAR_DEFINED, pDef->GetName() );
+ }
+ else
+ Error( ERRCODE_BASIC_VAR_DEFINED, pDef->GetName() );
+ delete pDef; pDef = pOld;
+ }
+ else
+ pPool->Add( pDef );
+
+ // #36374: Create the variable in front of the distinction IsNew()
+ // Otherwise error at Dim Identifier As New Type and option explicit
+ if( !bDefined && !(eOp == SbiOpcode::REDIM_ || eOp == SbiOpcode::REDIMP_)
+ && ( !bConst || pDef->GetScope() == SbGLOBAL ) )
+ {
+ // Declare variable or global constant
+ SbiOpcode eOp2;
+ switch ( pDef->GetScope() )
+ {
+ case SbGLOBAL: eOp2 = bPersistentGlobal ? SbiOpcode::GLOBAL_P_ : SbiOpcode::GLOBAL_;
+ goto global;
+ case SbPUBLIC: eOp2 = bPersistentGlobal ? SbiOpcode::PUBLIC_P_ : SbiOpcode::PUBLIC_;
+ // #40689, no own Opcode anymore
+ if( bVBASupportOn && bStatic )
+ {
+ eOp2 = SbiOpcode::STATIC_;
+ break;
+ }
+ global: aGen.BackChain( nGblChain );
+ nGblChain = 0;
+ bGblDefs = bNewGblDefs = true;
+ break;
+ default: eOp2 = SbiOpcode::LOCAL_;
+ }
+ sal_uInt32 nOpnd2 = sal::static_int_cast< sal_uInt16 >( pDef->GetType() );
+ if( pDef->IsWithEvents() )
+ nOpnd2 |= SBX_TYPE_WITH_EVENTS_FLAG;
+
+ if( bCompatible && pDef->IsNew() )
+ nOpnd2 |= SBX_TYPE_DIM_AS_NEW_FLAG;
+
+ short nFixedStringLength = pDef->GetFixedStringLength();
+ if( nFixedStringLength >= 0 )
+ nOpnd2 |= (SBX_FIXED_LEN_STRING_FLAG + (sal_uInt32(nFixedStringLength) << 17)); // len = all bits above 0x10000
+
+ if( pDim != nullptr && pDim->GetDims() > 0 )
+ nOpnd2 |= SBX_TYPE_VAR_TO_DIM_FLAG;
+
+ aGen.Gen( eOp2, pDef->GetId(), nOpnd2 );
+ }
+
+ // Initialising for self-defined data types
+ // and per NEW created variable
+ if( pDef->GetType() == SbxOBJECT
+ && pDef->GetTypeId() )
+ {
+ if( !bCompatible && !pDef->IsNew() )
+ {
+ OUString aTypeName( aGblStrings.Find( pDef->GetTypeId() ) );
+ if( rTypeArray->Find( aTypeName, SbxClassType::Object ) == nullptr )
+ {
+ if( CodeCompleteOptions::IsExtendedTypeDeclaration() )
+ {
+ if(!IsUnoInterface(aTypeName))
+ Error( ERRCODE_BASIC_UNDEF_TYPE, aTypeName );
+ }
+ else
+ Error( ERRCODE_BASIC_UNDEF_TYPE, aTypeName );
+ }
+ }
+
+ if( bConst )
+ {
+ Error( ERRCODE_BASIC_SYNTAX );
+ }
+
+ if( pDim )
+ {
+ if( eOp == SbiOpcode::REDIMP_ )
+ {
+ SbiExpression aExpr( this, *pDef, nullptr );
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::REDIMP_ERASE_ );
+
+ pDef->SetDims( pDim->GetDims() );
+ SbiExpression aExpr2( this, *pDef, std::move(pDim) );
+ aExpr2.Gen();
+ aGen.Gen( SbiOpcode::DCREATE_REDIMP_, pDef->GetId(), pDef->GetTypeId() );
+ }
+ else
+ {
+ pDef->SetDims( pDim->GetDims() );
+ SbiExpression aExpr( this, *pDef, std::move(pDim) );
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::DCREATE_, pDef->GetId(), pDef->GetTypeId() );
+ }
+ }
+ else
+ {
+ SbiExpression aExpr( this, *pDef );
+ aExpr.Gen();
+ SbiOpcode eOp_ = pDef->IsNew() ? SbiOpcode::CREATE_ : SbiOpcode::TCREATE_;
+ aGen.Gen( eOp_, pDef->GetId(), pDef->GetTypeId() );
+ if ( bVBASupportOn )
+ aGen.Gen( SbiOpcode::VBASET_ );
+ else
+ aGen.Gen( SbiOpcode::SET_ );
+ }
+ }
+ else
+ {
+ if( bConst )
+ {
+ // Definition of the constants
+ if( pDim )
+ {
+ Error( ERRCODE_BASIC_SYNTAX );
+ }
+ SbiExpression aVar( this, *pDef );
+ if( !TestToken( EQ ) )
+ goto MyBreak; // (see below)
+ SbiConstExpression aExpr( this );
+ if( !bDefined && aExpr.IsValid() )
+ {
+ if( pDef->GetScope() == SbGLOBAL )
+ {
+ // Create code only for the global constant!
+ aVar.Gen();
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::PUTC_ );
+ }
+ SbiConstDef* pConst = pDef->GetConstDef();
+ if( aExpr.GetType() == SbxSTRING )
+ pConst->Set( aExpr.GetString() );
+ else
+ pConst->Set( aExpr.GetValue(), aExpr.GetType() );
+ }
+ }
+ else if( pDim )
+ {
+ // Dimension the variable
+ // Delete the var at REDIM beforehand
+ if( eOp == SbiOpcode::REDIM_ )
+ {
+ SbiExpression aExpr( this, *pDef, nullptr );
+ aExpr.Gen();
+ if ( bVBASupportOn )
+ // delete the array but
+ // clear the variable ( this
+ // allows the processing of
+ // the param to happen as normal without errors ( ordinary ERASE just clears the array )
+ aGen.Gen( SbiOpcode::ERASE_CLEAR_ );
+ else
+ aGen.Gen( SbiOpcode::ERASE_ );
+ }
+ else if( eOp == SbiOpcode::REDIMP_ )
+ {
+ SbiExpression aExpr( this, *pDef, nullptr );
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::REDIMP_ERASE_ );
+ }
+ pDef->SetDims( pDim->GetDims() );
+ if( bPersistentGlobal )
+ pDef->SetGlobal( true );
+ SbiExpression aExpr( this, *pDef, std::move(pDim) );
+ aExpr.Gen();
+ pDef->SetGlobal( false );
+ aGen.Gen( (eOp == SbiOpcode::STATIC_) ? SbiOpcode::DIM_ : eOp );
+ }
+ }
+ if( !TestComma() )
+ goto MyBreak;
+
+ // Implementation of bSwitchPool (see above): pPool must not be set to &aGlobals
+ // at the VarDecl-Call.
+ // Apart from that the behavior should be absolutely identical,
+ // i.e., pPool had to be reset always at the end of the loop.
+ // also at a break
+ pPool = pOldPool;
+ continue; // Skip MyBreak
+ MyBreak:
+ pPool = pOldPool;
+ break;
+ }
+
+ // #40689, finalize the jump over statics declarations
+ if( !bVBASupportOn && bStatic )
+ {
+ // maintain the global chain
+ nGblChain = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ bGblDefs = bNewGblDefs = true;
+
+ // Register for Sub a jump to the end of statics
+ aGen.BackChain( nEndOfStaticLbl );
+ }
+
+}
+
+// Here were Arrays redimensioned.
+
+void SbiParser::ReDim()
+{
+ DefVar( SbiOpcode::REDIM_, pProc && bVBASupportOn && pProc->IsStatic() );
+}
+
+// ERASE array, ...
+
+void SbiParser::Erase()
+{
+ while( !bAbort )
+ {
+ SbiExpression aExpr( this, SbLVALUE );
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::ERASE_ );
+ if( !TestComma() ) break;
+ }
+}
+
+// Declaration of a data type
+
+void SbiParser::Type()
+{
+ DefType();
+}
+
+void SbiParser::DefType()
+{
+ // Read the new Token lesen. It had to be a symbol
+ if (!TestSymbol())
+ return;
+
+ if (rTypeArray->Find(aSym,SbxClassType::Object))
+ {
+ Error( ERRCODE_BASIC_VAR_DEFINED, aSym );
+ return;
+ }
+
+ SbxObject *pType = new SbxObject(aSym);
+
+ bool bDone = false;
+
+ while( !bDone && !IsEof() )
+ {
+ std::unique_ptr<SbiSymDef> pElem;
+ SbiExprListPtr pDim;
+ switch( Peek() )
+ {
+ case ENDTYPE :
+ bDone = true;
+ Next();
+ break;
+
+ case EOLN :
+ case REM :
+ Next();
+ break;
+
+ default:
+ pElem.reset(VarDecl(&pDim, false, false));
+ if( !pElem )
+ bDone = true; // Error occurred
+ }
+ if( pElem )
+ {
+ SbxArray *pTypeMembers = pType->GetProperties();
+ OUString aElemName = pElem->GetName();
+ if( pTypeMembers->Find( aElemName, SbxClassType::DontCare) )
+ {
+ Error (ERRCODE_BASIC_VAR_DEFINED);
+ }
+ else
+ {
+ SbxDataType eElemType = pElem->GetType();
+ SbxProperty *pTypeElem = new SbxProperty( aElemName, eElemType );
+ if( pDim )
+ {
+ SbxDimArray* pArray = new SbxDimArray( pElem->GetType() );
+ if ( pDim->GetSize() )
+ {
+ // Dimension the target array
+
+ for ( short i=0; i<pDim->GetSize();++i )
+ {
+ sal_Int32 lb = nBase;
+ SbiExprNode* pNode = pDim->Get(i)->GetExprNode();
+ sal_Int32 ub = pNode->GetNumber();
+ if ( !pDim->Get( i )->IsBased() ) // each dim is low/up
+ {
+ if ( ++i >= pDim->GetSize() ) // trouble
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ pNode = pDim->Get(i)->GetExprNode();
+ lb = ub;
+ ub = pNode->GetNumber();
+ }
+ else if ( !bCompatible )
+ ub += nBase;
+ pArray->AddDim32( lb, ub );
+ }
+ pArray->setHasFixedSize( true );
+ }
+ else
+ pArray->unoAddDim32( 0, -1 ); // variant array
+ SbxFlagBits nSavFlags = pTypeElem->GetFlags();
+ // need to reset the FIXED flag
+ // when calling PutObject ( because the type will not match Object )
+ pTypeElem->ResetFlag( SbxFlagBits::Fixed );
+ pTypeElem->PutObject( pArray );
+ pTypeElem->SetFlags( nSavFlags );
+ }
+ // Nested user type?
+ if( eElemType == SbxOBJECT )
+ {
+ sal_uInt16 nElemTypeId = pElem->GetTypeId();
+ if( nElemTypeId != 0 )
+ {
+ OUString aTypeName( aGblStrings.Find( nElemTypeId ) );
+ SbxObject* pTypeObj = static_cast< SbxObject* >( rTypeArray->Find( aTypeName, SbxClassType::Object ) );
+ if( pTypeObj != nullptr )
+ {
+ SbxObject* pCloneObj = cloneTypeObjectImpl( *pTypeObj );
+ pTypeElem->PutObject( pCloneObj );
+ }
+ }
+ }
+ pTypeMembers->Insert32( pTypeElem, pTypeMembers->Count32() );
+ }
+ }
+ }
+
+ pType->Remove( "Name", SbxClassType::DontCare );
+ pType->Remove( "Parent", SbxClassType::DontCare );
+
+ rTypeArray->Insert32 (pType,rTypeArray->Count32());
+}
+
+
+// Declaration of Enum type
+
+void SbiParser::Enum()
+{
+ DefEnum( false );
+}
+
+void SbiParser::DefEnum( bool bPrivate )
+{
+ // Read the new Token. It had to be a symbol
+ if (!TestSymbol())
+ return;
+
+ OUString aEnumName = aSym;
+ if( rEnumArray->Find(aEnumName,SbxClassType::Object) )
+ {
+ Error( ERRCODE_BASIC_VAR_DEFINED, aSym );
+ return;
+ }
+
+ SbxObject *pEnum = new SbxObject( aEnumName );
+ if( bPrivate )
+ {
+ pEnum->SetFlag( SbxFlagBits::Private );
+ }
+ SbiSymDef* pElem;
+ bool bDone = false;
+
+ // Starting with -1 to make first default value 0 after ++
+ sal_Int32 nCurrentEnumValue = -1;
+ while( !bDone && !IsEof() )
+ {
+ switch( Peek() )
+ {
+ case ENDENUM :
+ pElem = nullptr;
+ bDone = true;
+ Next();
+ break;
+
+ case EOLN :
+ case REM :
+ pElem = nullptr;
+ Next();
+ break;
+
+ default:
+ {
+ SbiExprListPtr pDim;
+ pElem = VarDecl( &pDim, false, true );
+ if( !pElem )
+ {
+ bDone = true; // Error occurred
+ break;
+ }
+ else if( pDim )
+ {
+ Error( ERRCODE_BASIC_SYNTAX );
+ bDone = true; // Error occurred
+ break;
+ }
+
+ SbiExpression aVar( this, *pElem );
+ if( Peek() == EQ )
+ {
+ Next();
+
+ SbiConstExpression aExpr( this );
+ if( aExpr.IsValid() )
+ {
+ SbxVariableRef xConvertVar = new SbxVariable();
+ if( aExpr.GetType() == SbxSTRING )
+ xConvertVar->PutString( aExpr.GetString() );
+ else
+ xConvertVar->PutDouble( aExpr.GetValue() );
+
+ nCurrentEnumValue = xConvertVar->GetLong();
+ }
+ }
+ else
+ nCurrentEnumValue++;
+
+ SbiSymPool* pPoolToUse = bPrivate ? pPool : &aGlobals;
+
+ SbiSymDef* pOld = pPoolToUse->Find( pElem->GetName() );
+ if( pOld )
+ {
+ Error( ERRCODE_BASIC_VAR_DEFINED, pElem->GetName() );
+ bDone = true; // Error occurred
+ break;
+ }
+
+ pPool->Add( pElem );
+
+ if( !bPrivate )
+ {
+ aGen.BackChain( nGblChain );
+ nGblChain = 0;
+ bGblDefs = bNewGblDefs = true;
+ aGen.Gen(
+ SbiOpcode::GLOBAL_, pElem->GetId(),
+ sal::static_int_cast< sal_uInt16 >( pElem->GetType() ) );
+
+ aVar.Gen();
+ sal_uInt16 nStringId = aGen.GetParser()->aGblStrings.Add( nCurrentEnumValue, SbxLONG );
+ aGen.Gen( SbiOpcode::NUMBER_, nStringId );
+ aGen.Gen( SbiOpcode::PUTC_ );
+ }
+
+ SbiConstDef* pConst = pElem->GetConstDef();
+ pConst->Set( nCurrentEnumValue, SbxLONG );
+ }
+ }
+ if( pElem )
+ {
+ SbxArray *pEnumMembers = pEnum->GetProperties();
+ SbxProperty *pEnumElem = new SbxProperty( pElem->GetName(), SbxLONG );
+ pEnumElem->PutLong( nCurrentEnumValue );
+ pEnumElem->ResetFlag( SbxFlagBits::Write );
+ pEnumElem->SetFlag( SbxFlagBits::Const );
+ pEnumMembers->Insert32( pEnumElem, pEnumMembers->Count32() );
+ }
+ }
+
+ pEnum->Remove( "Name", SbxClassType::DontCare );
+ pEnum->Remove( "Parent", SbxClassType::DontCare );
+
+ rEnumArray->Insert32( pEnum, rEnumArray->Count32() );
+}
+
+
+// Procedure-Declaration
+// the first Token is already read in (SUB/FUNCTION)
+// xxx Name [LIB "name"[ALIAS "name"]][(Parameter)][AS TYPE]
+
+SbiProcDef* SbiParser::ProcDecl( bool bDecl )
+{
+ bool bFunc = ( eCurTok == FUNCTION );
+ bool bProp = ( eCurTok == GET || eCurTok == SET || eCurTok == LET );
+ if( !TestSymbol() ) return nullptr;
+ OUString aName( aSym );
+ SbxDataType eType = eScanType;
+ SbiProcDef* pDef = new SbiProcDef( this, aName, true );
+ pDef->SetType( eType );
+ if( Peek() == CDECL_ )
+ {
+ Next(); pDef->SetCdecl(true);
+ }
+ if( Peek() == LIB )
+ {
+ Next();
+ if( Next() == FIXSTRING )
+ {
+ pDef->GetLib() = aSym;
+ }
+ else
+ {
+ Error( ERRCODE_BASIC_SYNTAX );
+ }
+ }
+ if( Peek() == ALIAS )
+ {
+ Next();
+ if( Next() == FIXSTRING )
+ {
+ pDef->GetAlias() = aSym;
+ }
+ else
+ {
+ Error( ERRCODE_BASIC_SYNTAX );
+ }
+ }
+ if( !bDecl )
+ {
+ // CDECL, LIB and ALIAS are invalid
+ if( !pDef->GetLib().isEmpty() )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, LIB );
+ }
+ if( !pDef->GetAlias().isEmpty() )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, ALIAS );
+ }
+ if( pDef->IsCdecl() )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, CDECL_ );
+ }
+ pDef->SetCdecl( false );
+ pDef->GetLib().clear();
+ pDef->GetAlias().clear();
+ }
+ else if( pDef->GetLib().isEmpty() )
+ {
+ // ALIAS and CDECL only together with LIB
+ if( !pDef->GetAlias().isEmpty() )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, ALIAS );
+ }
+ if( pDef->IsCdecl() )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, CDECL_ );
+ }
+ pDef->SetCdecl( false );
+ pDef->GetAlias().clear();
+ }
+ // Brackets?
+ if( Peek() == LPAREN )
+ {
+ Next();
+ if( Peek() == RPAREN )
+ {
+ Next();
+ }
+ else
+ {
+ for(;;)
+ {
+ bool bByVal = false;
+ bool bOptional = false;
+ bool bParamArray = false;
+ while( Peek() == BYVAL || Peek() == BYREF || Peek() == OPTIONAL_ )
+ {
+ if( Peek() == BYVAL )
+ {
+ bByVal = true;
+ }
+ else if ( Peek() == BYREF )
+ {
+ bByVal = false;
+ }
+ else if ( Peek() == OPTIONAL_ )
+ {
+ bOptional = true;
+ }
+ Next();
+ }
+ if( bCompatible && Peek() == PARAMARRAY )
+ {
+ if( bByVal || bOptional )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, PARAMARRAY );
+ }
+ Next();
+ bParamArray = true;
+ }
+ SbiSymDef* pPar = VarDecl( nullptr, false, false );
+ if( !pPar )
+ {
+ break;
+ }
+ if( bByVal )
+ {
+ pPar->SetByVal(true);
+ }
+ if( bOptional )
+ {
+ pPar->SetOptional();
+ }
+ if( bParamArray )
+ {
+ pPar->SetParamArray();
+ }
+ if (SbiSymDef* pOldDef = pDef->GetParams().Find(pPar->GetName(), false))
+ {
+ Error(ERRCODE_BASIC_VAR_DEFINED, pPar->GetName());
+ delete pPar;
+ pPar = pOldDef;
+ }
+ else
+ pDef->GetParams().Add( pPar );
+ SbiToken eTok = Next();
+ if( eTok != COMMA && eTok != RPAREN )
+ {
+ bool bError2 = true;
+ if( bOptional && bCompatible && eTok == EQ )
+ {
+ std::unique_ptr<SbiConstExpression> pDefaultExpr(new SbiConstExpression( this ));
+ SbxDataType eType2 = pDefaultExpr->GetType();
+
+ sal_uInt16 nStringId;
+ if( eType2 == SbxSTRING )
+ {
+ nStringId = aGblStrings.Add( pDefaultExpr->GetString() );
+ }
+ else
+ {
+ nStringId = aGblStrings.Add( pDefaultExpr->GetValue(), eType2 );
+ }
+ pPar->SetDefaultId( nStringId );
+ pDefaultExpr.reset();
+
+ eTok = Next();
+ if( eTok == COMMA || eTok == RPAREN )
+ {
+ bError2 = false;
+ }
+ }
+ if( bError2 )
+ {
+ Error( ERRCODE_BASIC_EXPECTED, RPAREN );
+ break;
+ }
+ }
+ if( eTok == RPAREN )
+ {
+ break;
+ }
+ }
+ }
+ }
+ TypeDecl( *pDef );
+ if( eType != SbxVARIANT && pDef->GetType() != eType )
+ {
+ Error( ERRCODE_BASIC_BAD_DECLARATION, aName );
+ }
+ if( pDef->GetType() == SbxVARIANT && !( bFunc || bProp ) )
+ {
+ pDef->SetType( SbxEMPTY );
+ }
+ return pDef;
+}
+
+// DECLARE
+
+void SbiParser::Declare()
+{
+ DefDeclare( false );
+}
+
+void SbiParser::DefDeclare( bool bPrivate )
+{
+ Next();
+ if( eCurTok == PTRSAFE )
+ Next();
+
+ if( eCurTok != SUB && eCurTok != FUNCTION )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, eCurTok );
+ }
+ else
+ {
+ bool bFunction = (eCurTok == FUNCTION);
+
+ SbiProcDef* pDef = ProcDecl( true );
+ if( pDef )
+ {
+ if( pDef->GetLib().isEmpty() )
+ {
+ Error( ERRCODE_BASIC_EXPECTED, LIB );
+ }
+ // Is it already there?
+ SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
+ if( pOld )
+ {
+ SbiProcDef* p = pOld->GetProcDef();
+ if( !p )
+ {
+ // Declared as a variable
+ Error( ERRCODE_BASIC_BAD_DECLARATION, pDef->GetName() );
+ delete pDef;
+ pDef = nullptr;
+ }
+ else
+ {
+ pDef->Match( p );
+ }
+ }
+ else
+ {
+ aPublics.Add( pDef );
+ }
+ if ( pDef )
+ {
+ pDef->SetPublic( !bPrivate );
+
+ // New declare handling
+ if( !pDef->GetLib().isEmpty())
+ {
+ if( bNewGblDefs && nGblChain == 0 )
+ {
+ nGblChain = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ bNewGblDefs = false;
+ }
+
+ sal_uInt16 nSavLine = nLine;
+ aGen.Statement();
+ pDef->Define();
+ pDef->SetLine1( nSavLine );
+ pDef->SetLine2( nSavLine );
+
+ SbiSymPool& rPool = pDef->GetParams();
+ sal_uInt16 nParCount = rPool.GetSize();
+
+ SbxDataType eType = pDef->GetType();
+ if( bFunction )
+ {
+ aGen.Gen( SbiOpcode::PARAM_, 0, sal::static_int_cast< sal_uInt16 >( eType ) );
+ }
+ if( nParCount > 1 )
+ {
+ aGen.Gen( SbiOpcode::ARGC_ );
+
+ for( sal_uInt16 i = 1 ; i < nParCount ; ++i )
+ {
+ SbiSymDef* pParDef = rPool.Get( i );
+ SbxDataType eParType = pParDef->GetType();
+
+ aGen.Gen( SbiOpcode::PARAM_, i, sal::static_int_cast< sal_uInt16 >( eParType ) );
+ aGen.Gen( SbiOpcode::ARGV_ );
+
+ sal_uInt16 nTyp = sal::static_int_cast< sal_uInt16 >( pParDef->GetType() );
+ if( pParDef->IsByVal() )
+ {
+ // Reset to avoid additional byval in call to wrapper function
+ pParDef->SetByVal( false );
+ nTyp |= 0x8000;
+ }
+ aGen.Gen( SbiOpcode::ARGTYP_, nTyp );
+ }
+ }
+
+ aGen.Gen( SbiOpcode::LIB_, aGblStrings.Add( pDef->GetLib() ) );
+
+ SbiOpcode eOp = pDef->IsCdecl() ? SbiOpcode::CALLC_ : SbiOpcode::CALL_;
+ sal_uInt16 nId = pDef->GetId();
+ if( !pDef->GetAlias().isEmpty() )
+ {
+ nId = ( nId & 0x8000 ) | aGblStrings.Add( pDef->GetAlias() );
+ }
+ if( nParCount > 1 )
+ {
+ nId |= 0x8000;
+ }
+ aGen.Gen( eOp, nId, sal::static_int_cast< sal_uInt16 >( eType ) );
+
+ if( bFunction )
+ {
+ aGen.Gen( SbiOpcode::PUT_ );
+ }
+ aGen.Gen( SbiOpcode::LEAVE_ );
+ }
+ }
+ }
+ }
+}
+
+void SbiParser::Attribute()
+{
+ // TODO: Need to implement the method as an attributed object.
+ while( Next() != EQ )
+ {
+ if( Next() != DOT)
+ {
+ break;
+ }
+ }
+
+ if( eCurTok != EQ )
+ {
+ Error( ERRCODE_BASIC_SYNTAX );
+ }
+ else
+ {
+ SbiExpression aValue( this );
+ }
+ // Don't generate any code - just discard it.
+}
+
+// Call of a SUB or a FUNCTION
+
+void SbiParser::Call()
+{
+ SbiExpression aVar( this, SbSYMBOL );
+ aVar.Gen( FORCE_CALL );
+ aGen.Gen( SbiOpcode::GET_ );
+}
+
+// SUB/FUNCTION
+
+void SbiParser::SubFunc()
+{
+ DefProc( false, false );
+}
+
+// Read in of a procedure
+
+void SbiParser::DefProc( bool bStatic, bool bPrivate )
+{
+ sal_uInt16 l1 = nLine;
+ bool bSub = ( eCurTok == SUB );
+ bool bProperty = ( eCurTok == PROPERTY );
+ PropertyMode ePropertyMode = PropertyMode::NONE;
+ if( bProperty )
+ {
+ Next();
+ if( eCurTok == GET )
+ {
+ ePropertyMode = PropertyMode::Get;
+ }
+ else if( eCurTok == LET )
+ {
+ ePropertyMode = PropertyMode::Let;
+ }
+ else if( eCurTok == SET )
+ {
+ ePropertyMode = PropertyMode::Set;
+ }
+ else
+ {
+ Error( ERRCODE_BASIC_EXPECTED, "Get or Let or Set" );
+ }
+ }
+
+ SbiToken eExit = eCurTok;
+ SbiProcDef* pDef = ProcDecl( false );
+ if( !pDef )
+ {
+ return;
+ }
+ pDef->setPropertyMode( ePropertyMode );
+
+ // Is the Proc already declared?
+ SbiSymDef* pOld = aPublics.Find( pDef->GetName() );
+ if( pOld )
+ {
+ pProc = pOld->GetProcDef();
+ if( !pProc )
+ {
+ // Declared as a variable
+ Error( ERRCODE_BASIC_BAD_DECLARATION, pDef->GetName() );
+ delete pDef;
+ return;
+ }
+ // #100027: Multiple declaration -> Error
+ // #112787: Not for setup, REMOVE for 8
+ else if( pProc->IsUsedForProcDecl() )
+ {
+ PropertyMode ePropMode = pDef->getPropertyMode();
+ if( ePropMode == PropertyMode::NONE || ePropMode == pProc->getPropertyMode() )
+ {
+ Error( ERRCODE_BASIC_PROC_DEFINED, pDef->GetName() );
+ delete pDef;
+ return;
+ }
+ }
+
+ pDef->Match( pProc );
+ }
+ else
+ {
+ aPublics.Add( pDef );
+ }
+ assert(pDef);
+ pProc = pDef;
+ pProc->SetPublic( !bPrivate );
+
+ // Now we set the search hierarchy for symbols as well as the
+ // current procedure.
+ aPublics.SetProcId( pProc->GetId() );
+ pProc->GetParams().SetParent( &aPublics );
+ if( bStatic )
+ {
+ if ( bVBASupportOn )
+ {
+ pProc->SetStatic();
+ }
+ else
+ {
+ Error( ERRCODE_BASIC_NOT_IMPLEMENTED ); // STATIC SUB ...
+ }
+ }
+ else
+ {
+ pProc->SetStatic( false );
+ }
+ // Normal case: Local variable->parameter->global variable
+ pProc->GetLocals().SetParent( &pProc->GetParams() );
+ pPool = &pProc->GetLocals();
+
+ pProc->Define();
+ OpenBlock( eExit );
+ StmntBlock( bSub ? ENDSUB : (bProperty ? ENDPROPERTY : ENDFUNC) );
+ sal_uInt16 l2 = nLine;
+ pProc->SetLine1( l1 );
+ pProc->SetLine2( l2 );
+ pPool = &aPublics;
+ aPublics.SetProcId( 0 );
+ // Open labels?
+ pProc->GetLabels().CheckRefs();
+ CloseBlock();
+ aGen.Gen( SbiOpcode::LEAVE_ );
+ pProc = nullptr;
+}
+
+// STATIC variable|procedure
+
+void SbiParser::Static()
+{
+ DefStatic( false );
+}
+
+void SbiParser::DefStatic( bool bPrivate )
+{
+ SbiSymPool* p;
+
+ switch( Peek() )
+ {
+ case SUB:
+ case FUNCTION:
+ case PROPERTY:
+ // End global chain if necessary (not done in
+ // SbiParser::Parse() under these conditions
+ if( bNewGblDefs && nGblChain == 0 )
+ {
+ nGblChain = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ bNewGblDefs = false;
+ }
+ Next();
+ DefProc( true, bPrivate );
+ break;
+ default:
+ if( !pProc )
+ {
+ Error( ERRCODE_BASIC_NOT_IN_SUBR );
+ }
+ // Reset the Pool, so that STATIC-Declarations go into the
+ // global Pool
+ p = pPool;
+ pPool = &aPublics;
+ DefVar( SbiOpcode::STATIC_, true );
+ pPool = p;
+ break;
+ }
+}
+
+bool SbiParser::IsUnoInterface(const OUString& sTypeName)
+{
+ try
+ {
+ return css::reflection::theCoreReflection::get(
+ comphelper::getProcessComponentContext())->forName(sTypeName).is();
+ }
+ catch(const Exception&)
+ {
+ OSL_FAIL("Could not create reflection.CoreReflection.");
+ }
+ return false;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/exprgen.cxx b/basic/source/comp/exprgen.cxx
new file mode 100644
index 000000000..2baf28a80
--- /dev/null
+++ b/basic/source/comp/exprgen.cxx
@@ -0,0 +1,281 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/sberrors.hxx>
+
+#include <codegen.hxx>
+#include <expr.hxx>
+#include <parser.hxx>
+
+// Transform table for token operators and opcodes
+
+namespace {
+
+struct OpTable {
+ SbiToken eTok; // Token
+ SbiOpcode eOp; // Opcode
+};
+
+}
+
+static const OpTable aOpTable [] = {
+ { EXPON,SbiOpcode::EXP_ },
+ { MUL, SbiOpcode::MUL_ },
+ { DIV, SbiOpcode::DIV_ },
+ { IDIV, SbiOpcode::IDIV_ },
+ { MOD, SbiOpcode::MOD_ },
+ { PLUS, SbiOpcode::PLUS_ },
+ { MINUS,SbiOpcode::MINUS_ },
+ { EQ, SbiOpcode::EQ_ },
+ { NE, SbiOpcode::NE_ },
+ { LE, SbiOpcode::LE_ },
+ { GE, SbiOpcode::GE_ },
+ { LT, SbiOpcode::LT_ },
+ { GT, SbiOpcode::GT_ },
+ { AND, SbiOpcode::AND_ },
+ { OR, SbiOpcode::OR_ },
+ { XOR, SbiOpcode::XOR_ },
+ { EQV, SbiOpcode::EQV_ },
+ { IMP, SbiOpcode::IMP_ },
+ { NOT, SbiOpcode::NOT_ },
+ { NEG, SbiOpcode::NEG_ },
+ { CAT, SbiOpcode::CAT_ },
+ { LIKE, SbiOpcode::LIKE_ },
+ { IS, SbiOpcode::IS_ },
+ { NIL, SbiOpcode::NOP_ }};
+
+// Output of an element
+void SbiExprNode::Gen( SbiCodeGen& rGen, RecursiveMode eRecMode )
+{
+ sal_uInt16 nStringId;
+
+ if( IsConstant() )
+ {
+ switch( GetType() )
+ {
+ case SbxEMPTY:
+ rGen.Gen( SbiOpcode::EMPTY_ );
+ break;
+ case SbxSTRING:
+ nStringId = rGen.GetParser()->aGblStrings.Add( aStrVal );
+ rGen.Gen( SbiOpcode::SCONST_, nStringId );
+ break;
+ default:
+ // tdf#131296 - generate SbiOpcode::NUMBER_ instead of SbiOpcode::CONST_
+ // for SbxINTEGER and SbxLONG including their numeric value and its data type,
+ // which will be restored in SbiRuntime::StepLOADNC.
+ nStringId = rGen.GetParser()->aGblStrings.Add( nVal, eType );
+ rGen.Gen( SbiOpcode::NUMBER_, nStringId );
+ break;
+ }
+ }
+ else if( IsOperand() )
+ {
+ SbiExprNode* pWithParent_ = nullptr;
+ SbiOpcode eOp;
+ if( aVar.pDef->GetScope() == SbPARAM )
+ {
+ eOp = SbiOpcode::PARAM_;
+ if( aVar.pDef->GetPos() == 0 )
+ {
+ bool bTreatFunctionAsParam = true;
+ if( eRecMode == FORCE_CALL )
+ {
+ bTreatFunctionAsParam = false;
+ }
+ else if( eRecMode == UNDEFINED )
+ {
+ if( aVar.pPar && aVar.pPar->IsBracket() )
+ {
+ bTreatFunctionAsParam = false;
+ }
+ }
+ if( !bTreatFunctionAsParam )
+ {
+ eOp = aVar.pDef->IsGlobal() ? SbiOpcode::FIND_G_ : SbiOpcode::FIND_;
+ }
+ }
+ }
+ // special treatment for WITH
+ else if( (pWithParent_ = pWithParent) != nullptr )
+ {
+ eOp = SbiOpcode::ELEM_; // .-Term in WITH
+ }
+ else
+ {
+ eOp = ( aVar.pDef->GetScope() == SbRTL ) ? SbiOpcode::RTL_ :
+ (aVar.pDef->IsGlobal() ? SbiOpcode::FIND_G_ : SbiOpcode::FIND_);
+ }
+
+ if( eOp == SbiOpcode::FIND_ )
+ {
+
+ SbiProcDef* pProc = aVar.pDef->GetProcDef();
+ if ( rGen.GetParser()->bClassModule )
+ {
+ eOp = SbiOpcode::FIND_CM_;
+ }
+ else if ( aVar.pDef->IsStatic() || (pProc && pProc->IsStatic()) )
+ {
+ eOp = SbiOpcode::FIND_STATIC_;
+ }
+ }
+ for( SbiExprNode* p = this; p; p = p->aVar.pNext )
+ {
+ if( p == this && pWithParent_ != nullptr )
+ {
+ pWithParent_->Gen(rGen);
+ }
+ p->GenElement( rGen, eOp );
+ eOp = SbiOpcode::ELEM_;
+ }
+ }
+ else if( eNodeType == SbxTYPEOF )
+ {
+ pLeft->Gen(rGen);
+ rGen.Gen( SbiOpcode::TESTCLASS_, nTypeStrId );
+ }
+ else if( eNodeType == SbxNEW )
+ {
+ rGen.Gen( SbiOpcode::CREATE_, 0, nTypeStrId );
+ }
+ else
+ {
+ pLeft->Gen(rGen);
+ if( pRight )
+ {
+ pRight->Gen(rGen);
+ }
+ for( const OpTable* p = aOpTable; p->eTok != NIL; p++ )
+ {
+ if( p->eTok == eTok )
+ {
+ rGen.Gen( p->eOp ); break;
+ }
+ }
+ }
+}
+
+// Output of an operand element
+
+void SbiExprNode::GenElement( SbiCodeGen& rGen, SbiOpcode eOp )
+{
+#ifdef DBG_UTIL
+ if ((eOp < SbiOpcode::RTL_ || eOp > SbiOpcode::CALLC_) && eOp != SbiOpcode::FIND_G_ && eOp != SbiOpcode::FIND_CM_ && eOp != SbiOpcode::FIND_STATIC_)
+ rGen.GetParser()->Error( ERRCODE_BASIC_INTERNAL_ERROR, "Opcode" );
+#endif
+ SbiSymDef* pDef = aVar.pDef;
+ // The ID is either the position or the String-ID
+ // If the bit Bit 0x8000 is set, the variable have
+ // a parameter list.
+ sal_uInt16 nId = ( eOp == SbiOpcode::PARAM_ ) ? pDef->GetPos() : pDef->GetId();
+ // Build a parameter list
+ if( aVar.pPar && aVar.pPar->GetSize() )
+ {
+ nId |= 0x8000;
+ aVar.pPar->Gen(rGen);
+ }
+
+ rGen.Gen( eOp, nId, sal::static_int_cast< sal_uInt16 >( GetType() ) );
+
+ if( aVar.pvMorePar )
+ {
+ for( auto& pExprList: *aVar.pvMorePar )
+ {
+ pExprList->Gen(rGen);
+ rGen.Gen( SbiOpcode::ARRAYACCESS_ );
+ }
+ }
+}
+
+// Create an Argv-Table
+// The first element remain available for return value etc.
+// See as well SbiProcDef::SbiProcDef() in symtbl.cxx
+
+void SbiExprList::Gen(SbiCodeGen& rGen)
+{
+ if( aData.empty() )
+ return;
+
+ rGen.Gen( SbiOpcode::ARGC_ );
+ // Type adjustment at DECLARE
+
+ for( auto& pExpr: aData )
+ {
+ pExpr->Gen();
+ if( !pExpr->GetName().isEmpty() )
+ {
+ // named arg
+ sal_uInt16 nSid = rGen.GetParser()->aGblStrings.Add( pExpr->GetName() );
+ rGen.Gen( SbiOpcode::ARGN_, nSid );
+
+ /* TODO: Check after Declare concept change
+ // From 1996-01-10: Type adjustment at named -> search suitable parameter
+ if( pProc )
+ {
+ // For the present: trigger an error
+ pParser->Error( ERRCODE_BASIC_NO_NAMED_ARGS );
+
+ // Later, if Named Args at DECLARE is possible
+ //for( sal_uInt16 i = 1 ; i < nParAnz ; i++ )
+ //{
+ // SbiSymDef* pDef = pPool->Get( i );
+ // const String& rName = pDef->GetName();
+ // if( rName.Len() )
+ // {
+ // if( pExpr->GetName().ICompare( rName )
+ // == COMPARE_EQUAL )
+ // {
+ // pParser->aGen.Gen( ARGTYP_, pDef->GetType() );
+ // break;
+ // }
+ // }
+ //}
+ }
+ */
+ }
+ else
+ {
+ rGen.Gen( SbiOpcode::ARGV_ );
+ }
+ }
+}
+
+void SbiExpression::Gen( RecursiveMode eRecMode )
+{
+ // special treatment for WITH
+ // If pExpr == .-term in With, approximately Gen for Basis-Object
+ pExpr->Gen( pParser->aGen, eRecMode );
+ if( bByVal )
+ {
+ pParser->aGen.Gen( SbiOpcode::BYVAL_ );
+ }
+ if( bBased )
+ {
+ sal_uInt16 uBase = pParser->nBase;
+ if( pParser->IsCompatible() )
+ {
+ uBase |= 0x8000; // #109275 Flag compatibility
+ }
+ pParser->aGen.Gen( SbiOpcode::BASED_, uBase );
+ pParser->aGen.Gen( SbiOpcode::ARGV_ );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/exprnode.cxx b/basic/source/comp/exprnode.cxx
new file mode 100644
index 000000000..8fb38b44e
--- /dev/null
+++ b/basic/source/comp/exprnode.cxx
@@ -0,0 +1,474 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <math.h>
+
+#include <o3tl/temporary.hxx>
+#include <rtl/math.hxx>
+#include <parser.hxx>
+#include <expr.hxx>
+
+#include <basic/sberrors.hxx>
+
+SbiExprNode::SbiExprNode( std::unique_ptr<SbiExprNode> l, SbiToken t, std::unique_ptr<SbiExprNode> r ) :
+ pLeft(std::move(l)),
+ pRight(std::move(r)),
+ pWithParent(nullptr),
+ eNodeType(SbxNODE),
+ eType(SbxVARIANT), // Nodes are always Variant
+ eTok(t),
+ bError(false)
+{
+}
+
+SbiExprNode::SbiExprNode( double n, SbxDataType t ):
+ nVal(n),
+ pWithParent(nullptr),
+ eNodeType(SbxNUMVAL),
+ eType(t),
+ eTok(NIL),
+ bError(false)
+{
+}
+
+SbiExprNode::SbiExprNode( const OUString& rVal ):
+ aStrVal(rVal),
+ pWithParent(nullptr),
+ eNodeType(SbxSTRVAL),
+ eType(SbxSTRING),
+ eTok(NIL),
+ bError(false)
+{
+}
+
+SbiExprNode::SbiExprNode( const SbiSymDef& r, SbxDataType t, SbiExprListPtr l ) :
+ pWithParent(nullptr),
+ eNodeType(SbxVARVAL),
+ eTok(NIL),
+ bError(false)
+{
+ eType = ( t == SbxVARIANT ) ? r.GetType() : t;
+ aVar.pDef = const_cast<SbiSymDef*>(&r);
+ aVar.pPar = l.release();
+ aVar.pvMorePar = nullptr;
+ aVar.pNext= nullptr;
+}
+
+// #120061 TypeOf
+SbiExprNode::SbiExprNode( std::unique_ptr<SbiExprNode> l, sal_uInt16 nId ) :
+ nTypeStrId(nId),
+ pLeft(std::move(l)),
+ pWithParent(nullptr),
+ eNodeType(SbxTYPEOF),
+ eType(SbxBOOL),
+ eTok(NIL),
+ bError(false)
+{
+}
+
+// new <type>
+SbiExprNode::SbiExprNode( sal_uInt16 nId ) :
+ nTypeStrId(nId),
+ pWithParent(nullptr),
+ eNodeType(SbxNEW),
+ eType(SbxOBJECT),
+ eTok(NIL),
+ bError(false)
+{
+}
+
+SbiExprNode::SbiExprNode() :
+ pWithParent(nullptr),
+ eNodeType(SbxDUMMY),
+ eType(SbxVARIANT),
+ eTok(NIL),
+ bError(false)
+{
+}
+
+SbiExprNode::~SbiExprNode()
+{
+ if( IsVariable() )
+ {
+ delete aVar.pPar;
+ delete aVar.pNext;
+ delete aVar.pvMorePar;
+ }
+}
+
+SbiSymDef* SbiExprNode::GetVar()
+{
+ if( eNodeType == SbxVARVAL )
+ return aVar.pDef;
+ else
+ return nullptr;
+}
+
+SbiSymDef* SbiExprNode::GetRealVar()
+{
+ SbiExprNode* p = GetRealNode();
+ if( p )
+ return p->GetVar();
+ else
+ return nullptr;
+}
+
+// From 1995-12-18
+SbiExprNode* SbiExprNode::GetRealNode()
+{
+ if( eNodeType == SbxVARVAL )
+ {
+ SbiExprNode* p = this;
+ while( p->aVar.pNext )
+ p = p->aVar.pNext;
+ return p;
+ }
+ else
+ return nullptr;
+}
+
+// This method transform the type, if it fits into the Integer range
+
+void SbiExprNode::ConvertToIntConstIfPossible()
+{
+ if( eNodeType == SbxNUMVAL )
+ {
+ if( eType >= SbxINTEGER && eType <= SbxDOUBLE )
+ {
+ if( nVal >= SbxMININT && nVal <= SbxMAXINT && modf( nVal, &o3tl::temporary(double()) ) == 0 )
+ {
+ eType = SbxINTEGER;
+ }
+ }
+ }
+}
+
+bool SbiExprNode::IsNumber() const
+{
+ return eNodeType == SbxNUMVAL;
+}
+
+bool SbiExprNode::IsVariable() const
+{
+ return eNodeType == SbxVARVAL;
+}
+
+bool SbiExprNode::IsLvalue() const
+{
+ return IsVariable();
+}
+
+// Adjustment of a tree:
+// 1. Constant Folding
+// 2. Type-Adjustment
+// 3. Conversion of the operands into Strings
+// 4. Lifting of the composite- and error-bits
+
+void SbiExprNode::Optimize(SbiParser* pParser)
+{
+ FoldConstants(pParser);
+ CollectBits();
+}
+
+// Lifting of the error-bits
+
+void SbiExprNode::CollectBits()
+{
+ if( pLeft )
+ {
+ pLeft->CollectBits();
+ bError = bError || pLeft->bError;
+ }
+ if( pRight )
+ {
+ pRight->CollectBits();
+ bError = bError || pRight->bError;
+ }
+}
+
+// If a twig can be converted, True will be returned. In this case
+// the result is in the left twig.
+void SbiExprNode::FoldConstants(SbiParser* pParser)
+{
+ if( IsOperand() || eTok == LIKE ) return;
+
+ if (pLeft && !pRight)
+ FoldConstantsUnaryNode(pParser);
+ else if (pLeft && pRight)
+ FoldConstantsBinaryNode(pParser);
+
+ if( eNodeType == SbxNUMVAL )
+ {
+ // Potentially convolve in INTEGER (because of better opcode)?
+ if( eType == SbxSINGLE || eType == SbxDOUBLE )
+ {
+ if( nVal >= SbxMINLNG && nVal <= SbxMAXLNG
+ && !modf( nVal, &o3tl::temporary(double()) ) )
+ eType = SbxLONG;
+ }
+ if( eType == SbxLONG && nVal >= SbxMININT && nVal <= SbxMAXINT )
+ eType = SbxINTEGER;
+ }
+}
+
+void SbiExprNode::FoldConstantsBinaryNode(SbiParser* pParser)
+{
+ pLeft->FoldConstants(pParser);
+ pRight->FoldConstants(pParser);
+ if( !(pLeft->IsConstant() && pRight->IsConstant()
+ && pLeft->eNodeType == pRight->eNodeType) )
+ return;
+
+ CollectBits();
+ if( eTok == CAT )
+ // CAT affiliate also two numbers!
+ eType = SbxSTRING;
+ if( pLeft->eType == SbxSTRING )
+ // No Type Mismatch!
+ eType = SbxSTRING;
+ if( eType == SbxSTRING )
+ {
+ OUString rl( pLeft->GetString() );
+ OUString rr( pRight->GetString() );
+ pLeft.reset();
+ pRight.reset();
+ if( eTok == PLUS || eTok == CAT )
+ {
+ eTok = CAT;
+ // Linking:
+ aStrVal = rl;
+ aStrVal += rr;
+ eType = SbxSTRING;
+ eNodeType = SbxSTRVAL;
+ }
+ else
+ {
+ eType = SbxDOUBLE;
+ eNodeType = SbxNUMVAL;
+ int eRes = rr.compareTo( rl );
+ switch( eTok )
+ {
+ case EQ:
+ nVal = ( eRes == 0 ) ? SbxTRUE : SbxFALSE;
+ break;
+ case NE:
+ nVal = ( eRes != 0 ) ? SbxTRUE : SbxFALSE;
+ break;
+ case LT:
+ nVal = ( eRes < 0 ) ? SbxTRUE : SbxFALSE;
+ break;
+ case GT:
+ nVal = ( eRes > 0 ) ? SbxTRUE : SbxFALSE;
+ break;
+ case LE:
+ nVal = ( eRes <= 0 ) ? SbxTRUE : SbxFALSE;
+ break;
+ case GE:
+ nVal = ( eRes >= 0 ) ? SbxTRUE : SbxFALSE;
+ break;
+ default:
+ pParser->Error( ERRCODE_BASIC_CONVERSION );
+ bError = true;
+ break;
+ }
+ }
+ }
+ else
+ {
+ double nl = pLeft->nVal;
+ double nr = pRight->nVal;
+ long ll = 0, lr = 0;
+ long llMod = 0, lrMod = 0;
+ if( ( eTok >= AND && eTok <= IMP )
+ || eTok == IDIV || eTok == MOD )
+ {
+ // Integer operations
+ bool bErr = false;
+ if( nl > SbxMAXLNG )
+ {
+ bErr = true;
+ nl = SbxMAXLNG;
+ }
+ else if( nl < SbxMINLNG )
+ {
+ bErr = true;
+ nl = SbxMINLNG;
+ }
+ if( nr > SbxMAXLNG )
+ {
+ bErr = true;
+ nr = SbxMAXLNG;
+ }
+ else if( nr < SbxMINLNG )
+ {
+ bErr = true;
+ nr = SbxMINLNG;
+ }
+ ll = static_cast<long>(nl); lr = static_cast<long>(nr);
+ llMod = static_cast<long>(nl);
+ lrMod = static_cast<long>(nr);
+ if( bErr )
+ {
+ pParser->Error( ERRCODE_BASIC_MATH_OVERFLOW );
+ bError = true;
+ }
+ }
+ bool bBothInt = ( pLeft->eType < SbxSINGLE
+ && pRight->eType < SbxSINGLE );
+ pLeft.reset();
+ pRight.reset();
+ nVal = 0;
+ eType = SbxDOUBLE;
+ eNodeType = SbxNUMVAL;
+ bool bCheckType = false;
+ switch( eTok )
+ {
+ case EXPON:
+ nVal = pow( nl, nr ); break;
+ case MUL:
+ bCheckType = true;
+ nVal = nl * nr; break;
+ case DIV:
+ if( !nr )
+ {
+ pParser->Error( ERRCODE_BASIC_ZERODIV ); nVal = HUGE_VAL;
+ bError = true;
+ } else nVal = nl / nr;
+ break;
+ case PLUS:
+ bCheckType = true;
+ nVal = nl + nr; break;
+ case MINUS:
+ bCheckType = true;
+ nVal = nl - nr; break;
+ case EQ:
+ nVal = ( nl == nr ) ? SbxTRUE : SbxFALSE;
+ eType = SbxINTEGER; break;
+ case NE:
+ nVal = ( nl != nr ) ? SbxTRUE : SbxFALSE;
+ eType = SbxINTEGER; break;
+ case LT:
+ nVal = ( nl < nr ) ? SbxTRUE : SbxFALSE;
+ eType = SbxINTEGER; break;
+ case GT:
+ nVal = ( nl > nr ) ? SbxTRUE : SbxFALSE;
+ eType = SbxINTEGER; break;
+ case LE:
+ nVal = ( nl <= nr ) ? SbxTRUE : SbxFALSE;
+ eType = SbxINTEGER; break;
+ case GE:
+ nVal = ( nl >= nr ) ? SbxTRUE : SbxFALSE;
+ eType = SbxINTEGER; break;
+ case IDIV:
+ if( !lr )
+ {
+ pParser->Error( ERRCODE_BASIC_ZERODIV ); nVal = HUGE_VAL;
+ bError = true;
+ } else nVal = ll / lr;
+ eType = SbxLONG; break;
+ case MOD:
+ if( !lr )
+ {
+ pParser->Error( ERRCODE_BASIC_ZERODIV ); nVal = HUGE_VAL;
+ bError = true;
+ } else nVal = llMod - lrMod * (llMod/lrMod);
+ eType = SbxLONG; break;
+ case AND:
+ nVal = static_cast<double>( ll & lr ); eType = SbxLONG; break;
+ case OR:
+ nVal = static_cast<double>( ll | lr ); eType = SbxLONG; break;
+ case XOR:
+ nVal = static_cast<double>( ll ^ lr ); eType = SbxLONG; break;
+ case EQV:
+ nVal = static_cast<double>( ~ll ^ lr ); eType = SbxLONG; break;
+ case IMP:
+ nVal = static_cast<double>( ~ll | lr ); eType = SbxLONG; break;
+ default: break;
+ }
+
+ if( !std::isfinite( nVal ) )
+ pParser->Error( ERRCODE_BASIC_MATH_OVERFLOW );
+
+ // Recover the data type to kill rounding error
+ if( bCheckType && bBothInt
+ && nVal >= SbxMINLNG && nVal <= SbxMAXLNG )
+ {
+ // Decimal place away
+ long n = static_cast<long>(nVal);
+ nVal = n;
+ eType = ( n >= SbxMININT && n <= SbxMAXINT )
+ ? SbxINTEGER : SbxLONG;
+ }
+ }
+
+}
+void SbiExprNode::FoldConstantsUnaryNode(SbiParser* pParser)
+{
+ pLeft->FoldConstants(pParser);
+ if (pLeft->IsNumber())
+ {
+ nVal = pLeft->nVal;
+ pLeft.reset();
+ eType = SbxDOUBLE;
+ eNodeType = SbxNUMVAL;
+ switch( eTok )
+ {
+ case NEG:
+ nVal = -nVal; break;
+ case NOT: {
+ // Integer operation!
+ bool bErr = false;
+ if( nVal > SbxMAXLNG )
+ {
+ bErr = true;
+ nVal = SbxMAXLNG;
+ }
+ else if( nVal < SbxMINLNG )
+ {
+ bErr = true;
+ nVal = SbxMINLNG;
+ }
+ if( bErr )
+ {
+ pParser->Error( ERRCODE_BASIC_MATH_OVERFLOW );
+ bError = true;
+ }
+ nVal = static_cast<double>(~static_cast<long>(nVal));
+ eType = SbxLONG;
+ } break;
+ default: break;
+ }
+ }
+ if( eNodeType == SbxNUMVAL )
+ {
+ // Potentially convolve in INTEGER (because of better opcode)?
+ if( eType == SbxSINGLE || eType == SbxDOUBLE )
+ {
+ if( nVal >= SbxMINLNG && nVal <= SbxMAXLNG
+ && !modf( nVal, &o3tl::temporary(double()) ) )
+ eType = SbxLONG;
+ }
+ if( eType == SbxLONG && nVal >= SbxMININT && nVal <= SbxMAXINT )
+ eType = SbxINTEGER;
+ }
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/exprtree.cxx b/basic/source/comp/exprtree.cxx
new file mode 100644
index 000000000..cd6094db7
--- /dev/null
+++ b/basic/source/comp/exprtree.cxx
@@ -0,0 +1,1134 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <memory>
+#include <parser.hxx>
+#include <basic/sberrors.hxx>
+#include <basic/sbmod.hxx>
+#include <expr.hxx>
+#include <uno/current_context.hxx>
+
+SbiExpression::SbiExpression( SbiParser* p, SbiExprType t,
+ SbiExprMode eMode, const KeywordSymbolInfo* pKeywordSymbolInfo )
+{
+ pParser = p;
+ bBased = bError = bByVal = bBracket = false;
+ nParenLevel = 0;
+ eCurExpr = t;
+ m_eMode = eMode;
+ pExpr = (t != SbSTDEXPR ) ? Term( pKeywordSymbolInfo ) : Boolean();
+ if( t != SbSYMBOL )
+ {
+ pExpr->Optimize(pParser);
+ }
+ if( t == SbLVALUE && !pExpr->IsLvalue() )
+ {
+ p->Error( ERRCODE_BASIC_LVALUE_EXPECTED );
+ }
+ if( t == SbOPERAND && !IsVariable() )
+ {
+ p->Error( ERRCODE_BASIC_VAR_EXPECTED );
+ }
+}
+
+SbiExpression::SbiExpression( SbiParser* p, double n, SbxDataType t )
+{
+ pParser = p;
+ bBased = bError = bByVal = bBracket = false;
+ nParenLevel = 0;
+ eCurExpr = SbOPERAND;
+ m_eMode = EXPRMODE_STANDARD;
+ pExpr = std::make_unique<SbiExprNode>( n, t );
+ pExpr->Optimize(pParser);
+}
+
+SbiExpression::SbiExpression( SbiParser* p, const SbiSymDef& r, SbiExprListPtr pPar )
+{
+ pParser = p;
+ bBased = bError = bByVal = bBracket = false;
+ nParenLevel = 0;
+ eCurExpr = SbOPERAND;
+ m_eMode = EXPRMODE_STANDARD;
+ pExpr = std::make_unique<SbiExprNode>( r, SbxVARIANT, std::move(pPar) );
+}
+
+SbiExpression::~SbiExpression() { }
+
+// reading in a complete identifier
+// an identifier has the following form:
+// name[(Parameter)][.Name[(parameter)]]...
+// structure elements are coupled via the element pNext,
+// so that they're not in the tree.
+
+// Are there parameters without brackets following? This may be a number,
+// a string, a symbol or also a comma (if the 1st parameter is missing)
+
+static bool DoParametersFollow( SbiParser* p, SbiExprType eCurExpr, SbiToken eTok )
+{
+ if( eTok == LPAREN )
+ {
+ return true;
+ }
+ // but only if similar to CALL!
+ if( !p->WhiteSpace() || eCurExpr != SbSYMBOL )
+ {
+ return false;
+ }
+ if ( eTok == NUMBER || eTok == MINUS || eTok == FIXSTRING ||
+ eTok == SYMBOL || eTok == COMMA || eTok == DOT || eTok == NOT || eTok == BYVAL )
+ {
+ return true;
+ }
+ else // check for default params with reserved names ( e.g. names of tokens )
+ {
+ SbiTokenizer tokens( *static_cast<SbiTokenizer*>(p) );
+ // Urk the Next() / Peek() semantics are... weird
+ tokens.Next();
+ if ( tokens.Peek() == ASSIGN )
+ {
+ return true;
+ }
+ }
+ return false;
+}
+
+// definition of a new symbol
+
+static SbiSymDef* AddSym ( SbiToken eTok, SbiSymPool& rPool, SbiExprType eCurExpr,
+ const OUString& rName, SbxDataType eType, const SbiExprList* pPar )
+{
+ SbiSymDef* pDef;
+ // A= is not a procedure
+ bool bHasType = ( eTok == EQ || eTok == DOT );
+ if( ( !bHasType && eCurExpr == SbSYMBOL ) || pPar )
+ {
+ // so this is a procedure
+ // the correct pool should be found out, as
+ // procs must always get into a public pool
+ SbiSymPool* pPool = &rPool;
+ if( pPool->GetScope() != SbPUBLIC )
+ {
+ pPool = &rPool.GetParser()->aPublics;
+ }
+ SbiProcDef* pProc = pPool->AddProc( rName );
+
+ // special treatment for Colls like Documents(1)
+ if( eCurExpr == SbSTDEXPR )
+ {
+ bHasType = true;
+ }
+ pDef = pProc;
+ pDef->SetType( bHasType ? eType : SbxEMPTY );
+ if( pPar )
+ {
+ // generate dummy parameters
+ for( sal_Int32 n = 1; n <= pPar->GetSize(); n++ )
+ {
+ OUString aPar = "PAR" + OUString::number( n );
+ pProc->GetParams().AddSym( aPar );
+ }
+ }
+ }
+ else
+ {
+ // or a normal symbol
+ pDef = rPool.AddSym( rName );
+ pDef->SetType( eType );
+ }
+ return pDef;
+}
+
+// currently even keywords are allowed (because of Dflt properties of the same name)
+
+std::unique_ptr<SbiExprNode> SbiExpression::Term( const KeywordSymbolInfo* pKeywordSymbolInfo )
+{
+ if( pParser->Peek() == DOT )
+ {
+ SbiExprNode* pWithVar = pParser->GetWithVar();
+ // #26608: get to the node-chain's end to pass the correct object
+ SbiSymDef* pDef = pWithVar ? pWithVar->GetRealVar() : nullptr;
+ std::unique_ptr<SbiExprNode> pNd;
+ if( !pDef )
+ {
+ pParser->Next();
+ }
+ else
+ {
+ pNd = ObjTerm( *pDef );
+ if( pNd )
+ {
+ pNd->SetWithParent( pWithVar );
+ }
+ }
+ if( !pNd )
+ {
+ pParser->Error( ERRCODE_BASIC_UNEXPECTED, DOT );
+ pNd = std::make_unique<SbiExprNode>( 1.0, SbxDOUBLE );
+ }
+ return pNd;
+ }
+
+ SbiToken eTok = (pKeywordSymbolInfo == nullptr) ? pParser->Next() : SYMBOL;
+ // memorize the parsing's begin
+ pParser->LockColumn();
+ OUString aSym( (pKeywordSymbolInfo == nullptr) ? pParser->GetSym() : pKeywordSymbolInfo->m_aKeywordSymbol );
+ SbxDataType eType = (pKeywordSymbolInfo == nullptr) ? pParser->GetType() : pKeywordSymbolInfo->m_eSbxDataType;
+ SbiExprListPtr pPar;
+ std::unique_ptr<SbiExprListVector> pvMoreParLcl;
+ // are there parameters following?
+ SbiToken eNextTok = pParser->Peek();
+ // is it a known parameter?
+ // create a string constant then, which will be recognized
+ // in the SbiParameters-ctor and is continued to be handled
+ if( eNextTok == ASSIGN )
+ {
+ pParser->UnlockColumn();
+ return std::make_unique<SbiExprNode>( aSym );
+ }
+ // no keywords allowed from here on!
+ if( SbiTokenizer::IsKwd( eTok )
+ && (!pParser->IsCompatible() || eTok != INPUT) )
+ {
+ pParser->Error( ERRCODE_BASIC_SYNTAX );
+ bError = true;
+ }
+
+ eTok = eNextTok;
+ if( DoParametersFollow( pParser, eCurExpr, eTok ) )
+ {
+ bool bStandaloneExpression = (m_eMode == EXPRMODE_STANDALONE);
+ pPar = SbiExprList::ParseParameters( pParser, bStandaloneExpression );
+ bError = bError || !pPar->IsValid();
+ if( !bError )
+ bBracket = pPar->IsBracket();
+ eTok = pParser->Peek();
+
+ // i75443 check for additional sets of parameters
+ while( eTok == LPAREN )
+ {
+ if( pvMoreParLcl == nullptr )
+ {
+ pvMoreParLcl.reset(new SbiExprListVector);
+ }
+ SbiExprListPtr pAddPar = SbiExprList::ParseParameters( pParser );
+ bError = bError || !pAddPar->IsValid();
+ pvMoreParLcl->push_back( std::move(pAddPar) );
+ eTok = pParser->Peek();
+ }
+ }
+ // It might be an object part, if . or ! is following.
+ // In case of . the variable must already be defined;
+ // it's an object, if pDef is NULL after the search.
+ bool bObj = ( ( eTok == DOT || eTok == EXCLAM )
+ && !pParser->WhiteSpace() );
+ if( bObj )
+ {
+ bBracket = false; // Now the bracket for the first term is obsolete
+ if( eType == SbxVARIANT )
+ {
+ eType = SbxOBJECT;
+ }
+ else
+ {
+ // Name%. really does not work!
+ pParser->Error( ERRCODE_BASIC_BAD_DECLARATION, aSym );
+ bError = true;
+ }
+ }
+ // Search:
+ SbiSymDef* pDef = pParser->pPool->Find( aSym );
+ if( !pDef )
+ {
+ // Part of the Runtime-Library?
+ // from 31.3.1996: swapped out to parser-method
+ // (is also needed in SbiParser::DefVar() in DIM.CXX)
+ pDef = pParser->CheckRTLForSym( aSym, eType );
+
+ // #i109184: Check if symbol is or later will be defined inside module
+ SbModule& rMod = pParser->aGen.GetModule();
+ if( rMod.FindMethod( aSym, SbxClassType::DontCare ) )
+ {
+ pDef = nullptr;
+ }
+ }
+ if( !pDef )
+ {
+ if( bObj )
+ {
+ eType = SbxOBJECT;
+ }
+ pDef = AddSym( eTok, *pParser->pPool, eCurExpr, aSym, eType, pPar.get() );
+ // Looks like this is a local ( but undefined variable )
+ // if it is in a static procedure then make this Symbol
+ // static
+ if ( !bObj && pParser->pProc && pParser->pProc->IsStatic() )
+ {
+ pDef->SetStatic();
+ }
+ }
+ else
+ {
+
+ SbiConstDef* pConst = pDef->GetConstDef();
+ if( pConst )
+ {
+ pPar = nullptr;
+ pvMoreParLcl.reset();
+ if( pConst->GetType() == SbxSTRING )
+ {
+ return std::make_unique<SbiExprNode>( pConst->GetString() );
+ }
+ else
+ {
+ return std::make_unique<SbiExprNode>( pConst->GetValue(), pConst->GetType() );
+ }
+ }
+
+ // 0 parameters come up to ()
+ if( pDef->GetDims() )
+ {
+ if( pPar && pPar->GetSize() && pPar->GetSize() != pDef->GetDims() )
+ {
+ pParser->Error( ERRCODE_BASIC_WRONG_DIMS );
+ }
+ }
+ if( pDef->IsDefinedAs() )
+ {
+ SbxDataType eDefType = pDef->GetType();
+ // #119187 Only error if types conflict
+ if( eType >= SbxINTEGER && eType <= SbxSTRING && eType != eDefType )
+ {
+ // How? Define with AS first and take a Suffix then?
+ pParser->Error( ERRCODE_BASIC_BAD_DECLARATION, aSym );
+ bError = true;
+ }
+ else if ( eType == SbxVARIANT )
+ {
+ // if there's nothing named, take the type of the entry,
+ // but only if the var hasn't been defined with AS XXX
+ // so that we catch n% = 5 : print n
+ eType = eDefType;
+ }
+ }
+ // checking type of variables:
+ // is there named anything different in the scanner?
+ // That's OK for methods!
+ if( eType != SbxVARIANT && // Variant takes everything
+ eType != pDef->GetType() &&
+ !pDef->GetProcDef() )
+ {
+ // maybe pDef describes an object that so far has only been
+ // recognized as SbxVARIANT - then change type of pDef
+ // from 16.12.95 (similar cases possible perhaps?!?)
+ if( eType == SbxOBJECT && pDef->GetType() == SbxVARIANT )
+ {
+ pDef->SetType( SbxOBJECT );
+ }
+ else
+ {
+ pParser->Error( ERRCODE_BASIC_BAD_DECLARATION, aSym );
+ bError = true;
+ }
+ }
+ }
+ std::unique_ptr<SbiExprNode> pNd(new SbiExprNode( *pDef, eType ));
+ if( !pPar )
+ {
+ pPar = SbiExprList::ParseParameters( pParser,false,false );
+ }
+ pNd->aVar.pPar = pPar.release();
+ pNd->aVar.pvMorePar = pvMoreParLcl.release();
+ if( bObj )
+ {
+ // from 8.1.95: Object may also be of the type SbxVARIANT
+ if( pDef->GetType() == SbxVARIANT )
+ pDef->SetType( SbxOBJECT );
+ // if we scan something with point,
+ // the type must be SbxOBJECT
+ if( pDef->GetType() != SbxOBJECT && pDef->GetType() != SbxVARIANT )
+ {
+ // defer error until runtime if in vba mode
+ if ( !pParser->IsVBASupportOn() )
+ {
+ pParser->Error( ERRCODE_BASIC_BAD_DECLARATION, aSym );
+ bError = true;
+ }
+ }
+ if( !bError )
+ {
+ pNd->aVar.pNext = ObjTerm( *pDef ).release();
+ }
+ }
+
+ pParser->UnlockColumn();
+ return pNd;
+}
+
+// construction of an object term. A term of this kind is part
+// of an expression that begins with an object variable.
+
+std::unique_ptr<SbiExprNode> SbiExpression::ObjTerm( SbiSymDef& rObj )
+{
+ pParser->Next();
+ SbiToken eTok = pParser->Next();
+ if( eTok != SYMBOL && !SbiTokenizer::IsKwd( eTok ) && !SbiTokenizer::IsExtra( eTok ) )
+ {
+ // #66745 Some operators can also be allowed
+ // as identifiers, important for StarOne
+ if( eTok != MOD && eTok != NOT && eTok != AND && eTok != OR &&
+ eTok != XOR && eTok != EQV && eTok != IMP && eTok != IS )
+ {
+ pParser->Error( ERRCODE_BASIC_VAR_EXPECTED );
+ bError = true;
+ }
+ }
+
+ if( bError )
+ {
+ return nullptr;
+ }
+ OUString aSym( pParser->GetSym() );
+ SbxDataType eType = pParser->GetType();
+ SbiExprListPtr pPar;
+ SbiExprListVector* pvMoreParLcl = nullptr;
+ eTok = pParser->Peek();
+
+ if( DoParametersFollow( pParser, eCurExpr, eTok ) )
+ {
+ pPar = SbiExprList::ParseParameters( pParser, false/*bStandaloneExpression*/ );
+ bError = bError || !pPar->IsValid();
+ eTok = pParser->Peek();
+
+ // i109624 check for additional sets of parameters
+ while( eTok == LPAREN )
+ {
+ if( pvMoreParLcl == nullptr )
+ {
+ pvMoreParLcl = new SbiExprListVector;
+ }
+ SbiExprListPtr pAddPar = SbiExprList::ParseParameters( pParser );
+ bError = bError || !pPar->IsValid();
+ pvMoreParLcl->push_back( std::move(pAddPar) );
+ eTok = pParser->Peek();
+ }
+ }
+ bool bObj = ( ( eTok == DOT || eTok == EXCLAM ) && !pParser->WhiteSpace() );
+ if( bObj )
+ {
+ if( eType == SbxVARIANT )
+ {
+ eType = SbxOBJECT;
+ }
+ else
+ {
+ // Name%. does really not work!
+ pParser->Error( ERRCODE_BASIC_BAD_DECLARATION, aSym );
+ bError = true;
+ }
+ }
+
+ // an object's symbol pool is always PUBLIC
+ SbiSymPool& rPool = rObj.GetPool();
+ rPool.SetScope( SbPUBLIC );
+ SbiSymDef* pDef = rPool.Find( aSym );
+ if( !pDef )
+ {
+ pDef = AddSym( eTok, rPool, eCurExpr, aSym, eType, pPar.get() );
+ pDef->SetType( eType );
+ }
+
+ std::unique_ptr<SbiExprNode> pNd(new SbiExprNode( *pDef, eType ));
+ pNd->aVar.pPar = pPar.release();
+ pNd->aVar.pvMorePar = pvMoreParLcl;
+ if( bObj )
+ {
+ if( pDef->GetType() == SbxVARIANT )
+ {
+ pDef->SetType( SbxOBJECT );
+ }
+ if( pDef->GetType() != SbxOBJECT )
+ {
+ pParser->Error( ERRCODE_BASIC_BAD_DECLARATION, aSym );
+ bError = true;
+ }
+ if( !bError )
+ {
+ pNd->aVar.pNext = ObjTerm( *pDef ).release();
+ pNd->eType = eType;
+ }
+ }
+ return pNd;
+}
+
+// an operand can be:
+// constant
+// scalar variable
+// structure elements
+// array elements
+// functions
+// bracketed expressions
+
+std::unique_ptr<SbiExprNode> SbiExpression::Operand( bool bUsedForTypeOf )
+{
+ std::unique_ptr<SbiExprNode> pRes;
+
+ // test operand:
+ switch( SbiToken eTok = pParser->Peek() )
+ {
+ case SYMBOL:
+ pRes = Term();
+ // process something like "IF Not r Is Nothing Then .."
+ if( !bUsedForTypeOf && pParser->IsVBASupportOn() && pParser->Peek() == IS )
+ {
+ eTok = pParser->Next();
+ pRes = std::make_unique<SbiExprNode>( std::move(pRes), eTok, Like() );
+ }
+ break;
+ case DOT: // .with
+ pRes = Term(); break;
+ case NOT:
+ pRes = VBA_Not();
+ break;
+ case NUMBER:
+ pParser->Next();
+ pRes = std::make_unique<SbiExprNode>( pParser->GetDbl(), pParser->GetType() );
+ break;
+ case FIXSTRING:
+ pParser->Next();
+ pRes = std::make_unique<SbiExprNode>( pParser->GetSym() ); break;
+ case LPAREN:
+ pParser->Next();
+ if( nParenLevel == 0 && m_eMode == EXPRMODE_LPAREN_PENDING && pParser->Peek() == RPAREN )
+ {
+ m_eMode = EXPRMODE_EMPTY_PAREN;
+ pRes = std::make_unique<SbiExprNode>(); // Dummy node
+ pParser->Next();
+ break;
+ }
+ nParenLevel++;
+ pRes = Boolean();
+ if( pParser->Peek() != RPAREN )
+ {
+ // If there was a LPARAM, it does not belong to the expression
+ if( nParenLevel == 1 && m_eMode == EXPRMODE_LPAREN_PENDING )
+ {
+ m_eMode = EXPRMODE_LPAREN_NOT_NEEDED;
+ }
+ else
+ {
+ pParser->Error( ERRCODE_BASIC_BAD_BRACKETS );
+ }
+ }
+ else
+ {
+ pParser->Next();
+ if( nParenLevel == 1 && m_eMode == EXPRMODE_LPAREN_PENDING )
+ {
+ SbiToken eTokAfterRParen = pParser->Peek();
+ if( eTokAfterRParen == EQ || eTokAfterRParen == LPAREN || eTokAfterRParen == DOT )
+ {
+ m_eMode = EXPRMODE_ARRAY_OR_OBJECT;
+ }
+ else
+ {
+ m_eMode = EXPRMODE_STANDARD;
+ }
+ }
+ }
+ nParenLevel--;
+ break;
+ default:
+ // keywords here are OK at the moment!
+ if( SbiTokenizer::IsKwd( eTok ) )
+ {
+ pRes = Term();
+ }
+ else
+ {
+ pParser->Next();
+ pRes = std::make_unique<SbiExprNode>( 1.0, SbxDOUBLE );
+ pParser->Error( ERRCODE_BASIC_UNEXPECTED, eTok );
+ }
+ break;
+ }
+ return pRes;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::Unary()
+{
+ std::unique_ptr<SbiExprNode> pNd;
+ SbiToken eTok = pParser->Peek();
+ switch( eTok )
+ {
+ case MINUS:
+ eTok = NEG;
+ pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( Unary(), eTok, nullptr );
+ break;
+ case NOT:
+ if( pParser->IsVBASupportOn() )
+ {
+ pNd = Operand();
+ }
+ else
+ {
+ pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( Unary(), eTok, nullptr );
+ }
+ break;
+ case PLUS:
+ pParser->Next();
+ pNd = Unary();
+ break;
+ case TYPEOF:
+ {
+ pParser->Next();
+ std::unique_ptr<SbiExprNode> pObjNode = Operand( true/*bUsedForTypeOf*/ );
+ pParser->TestToken( IS );
+ SbiSymDef* pTypeDef = new SbiSymDef( OUString() );
+ pParser->TypeDecl( *pTypeDef, true );
+ pNd = std::make_unique<SbiExprNode>( std::move(pObjNode), pTypeDef->GetTypeId() );
+ break;
+ }
+ case NEW:
+ {
+ pParser->Next();
+ SbiSymDef* pTypeDef = new SbiSymDef( OUString() );
+ pParser->TypeDecl( *pTypeDef, true );
+ pNd = std::make_unique<SbiExprNode>( pTypeDef->GetTypeId() );
+ break;
+ }
+ default:
+ pNd = Operand();
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::Exp()
+{
+ std::unique_ptr<SbiExprNode> pNd = Unary();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ while( pParser->Peek() == EXPON )
+ {
+ SbiToken eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, Unary() );
+ }
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::MulDiv()
+{
+ std::unique_ptr<SbiExprNode> pNd = Exp();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ for( ;; )
+ {
+ SbiToken eTok = pParser->Peek();
+ if( eTok != MUL && eTok != DIV )
+ {
+ break;
+ }
+ eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, Exp() );
+ }
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::IntDiv()
+{
+ std::unique_ptr<SbiExprNode> pNd = MulDiv();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ while( pParser->Peek() == IDIV )
+ {
+ SbiToken eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, MulDiv() );
+ }
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::Mod()
+{
+ std::unique_ptr<SbiExprNode> pNd = IntDiv();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ while( pParser->Peek() == MOD )
+ {
+ SbiToken eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, IntDiv() );
+ }
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::AddSub()
+{
+ std::unique_ptr<SbiExprNode> pNd = Mod();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ for( ;; )
+ {
+ SbiToken eTok = pParser->Peek();
+ if( eTok != PLUS && eTok != MINUS )
+ {
+ break;
+ }
+ eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, Mod() );
+ }
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::Cat()
+{
+ std::unique_ptr<SbiExprNode> pNd = AddSub();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ for( ;; )
+ {
+ SbiToken eTok = pParser->Peek();
+ if( eTok != CAT )
+ {
+ break;
+ }
+ eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, AddSub() );
+ }
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::Comp()
+{
+ std::unique_ptr<SbiExprNode> pNd = Cat();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ short nCount = 0;
+ for( ;; )
+ {
+ SbiToken eTok = pParser->Peek();
+ if( m_eMode == EXPRMODE_ARRAY_OR_OBJECT )
+ {
+ break;
+ }
+ if( eTok != EQ && eTok != NE && eTok != LT &&
+ eTok != GT && eTok != LE && eTok != GE )
+ {
+ break;
+ }
+ eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, Cat() );
+ nCount++;
+ }
+ }
+ return pNd;
+}
+
+
+std::unique_ptr<SbiExprNode> SbiExpression::VBA_Not()
+{
+ std::unique_ptr<SbiExprNode> pNd;
+
+ SbiToken eTok = pParser->Peek();
+ if( eTok == NOT )
+ {
+ pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( VBA_Not(), eTok, nullptr );
+ }
+ else
+ {
+ pNd = Comp();
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::Like()
+{
+ std::unique_ptr<SbiExprNode> pNd = pParser->IsVBASupportOn() ? VBA_Not() : Comp();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ short nCount = 0;
+ while( pParser->Peek() == LIKE )
+ {
+ SbiToken eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, Comp() );
+ nCount++;
+ }
+ // multiple operands in a row does not work
+ if( nCount > 1 && !pParser->IsVBASupportOn() )
+ {
+ pParser->Error( ERRCODE_BASIC_SYNTAX );
+ bError = true;
+ }
+ }
+ return pNd;
+}
+
+std::unique_ptr<SbiExprNode> SbiExpression::Boolean()
+{
+ std::unique_ptr<SbiExprNode> pNd = Like();
+ if( m_eMode != EXPRMODE_EMPTY_PAREN )
+ {
+ for( ;; )
+ {
+ SbiToken eTok = pParser->Peek();
+ if( (eTok != AND) && (eTok != OR) &&
+ (eTok != XOR) && (eTok != EQV) &&
+ (eTok != IMP) && (eTok != IS) )
+ {
+ break;
+ }
+ eTok = pParser->Next();
+ pNd = std::make_unique<SbiExprNode>( std::move(pNd), eTok, Like() );
+ }
+ }
+ return pNd;
+}
+
+SbiConstExpression::SbiConstExpression( SbiParser* p ) : SbiExpression( p )
+{
+ if( pExpr->IsConstant() )
+ {
+ eType = pExpr->GetType();
+ if( pExpr->IsNumber() )
+ {
+ nVal = pExpr->nVal;
+ }
+ else
+ {
+ nVal = 0;
+ aVal = pExpr->aStrVal;
+ }
+ }
+ else
+ {
+ // #40204 special treatment for sal_Bool-constants
+ bool bIsBool = false;
+ if( pExpr->eNodeType == SbxVARVAL )
+ {
+ SbiSymDef* pVarDef = pExpr->GetVar();
+
+ bool bBoolVal = false;
+ if( pVarDef->GetName().equalsIgnoreAsciiCase( "true" ) )
+ {
+ bIsBool = true;
+ bBoolVal = true;
+ }
+ else if( pVarDef->GetName().equalsIgnoreAsciiCase( "false" ) )
+ //else if( pVarDef->GetName().ICompare( "false" ) == COMPARE_EQUAL )
+ {
+ bIsBool = true;
+ bBoolVal = false;
+ }
+
+ if( bIsBool )
+ {
+ pExpr = std::make_unique<SbiExprNode>( (bBoolVal ? SbxTRUE : SbxFALSE), SbxINTEGER );
+ eType = pExpr->GetType();
+ nVal = pExpr->nVal;
+ }
+ }
+
+ if( !bIsBool )
+ {
+ pParser->Error( ERRCODE_BASIC_SYNTAX );
+ eType = SbxDOUBLE;
+ nVal = 0;
+ }
+ }
+}
+
+short SbiConstExpression::GetShortValue()
+{
+ if( eType == SbxSTRING )
+ {
+ SbxVariableRef refConv = new SbxVariable;
+ refConv->PutString( aVal );
+ return refConv->GetInteger();
+ }
+ else
+ {
+ double n = nVal;
+ if( n > 0 )
+ {
+ n += .5;
+ }
+ else
+ {
+ n -= .5;
+ }
+ if( n > SbxMAXINT )
+ {
+ n = SbxMAXINT;
+ pParser->Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ }
+ else if( n < SbxMININT )
+ {
+ n = SbxMININT;
+ pParser->Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ }
+
+ return static_cast<short>(n);
+ }
+}
+
+
+SbiExprList::SbiExprList( )
+{
+ nDim = 0;
+ bError = false;
+ bBracket = false;
+}
+
+SbiExprList::~SbiExprList() {}
+
+SbiExpression* SbiExprList::Get( size_t n )
+{
+ return aData[n].get();
+}
+
+void SbiExprList::addExpression( std::unique_ptr<SbiExpression>&& pExpr )
+{
+ aData.push_back(std::move(pExpr));
+}
+
+// the parameter list is completely parsed
+// "procedurename()" is OK
+// it's a function without parameters then
+// i. e. you give an array as procedure parameter
+
+// #i79918/#i80532: bConst has never been set to true
+// -> reused as bStandaloneExpression
+//SbiParameters::SbiParameters( SbiParser* p, sal_Bool bConst, sal_Bool bPar) :
+SbiExprListPtr SbiExprList::ParseParameters( SbiParser* pParser, bool bStandaloneExpression, bool bPar)
+{
+ auto pExprList = std::make_unique<SbiExprList>();
+ if( !bPar )
+ {
+ return pExprList;
+ }
+
+ SbiToken eTok = pParser->Peek();
+
+ bool bAssumeExprLParenMode = false;
+ bool bAssumeArrayMode = false;
+ if( eTok == LPAREN )
+ {
+ if( bStandaloneExpression )
+ {
+ bAssumeExprLParenMode = true;
+ }
+ else
+ {
+ pExprList->bBracket = true;
+ pParser->Next();
+ eTok = pParser->Peek();
+ }
+ }
+
+
+ if( ( pExprList->bBracket && eTok == RPAREN ) || SbiTokenizer::IsEoln( eTok ) )
+ {
+ if( eTok == RPAREN )
+ {
+ pParser->Next();
+ }
+ return pExprList;
+ }
+ // read in parameter table and lay down in correct order!
+ while( !pExprList->bError )
+ {
+ std::unique_ptr<SbiExpression> pExpr;
+ // missing argument
+ if( eTok == COMMA )
+ {
+ pExpr = std::make_unique<SbiExpression>( pParser, 0, SbxEMPTY );
+ }
+ // named arguments: either .name= or name:=
+ else
+ {
+ bool bByVal = false;
+ if( eTok == BYVAL )
+ {
+ bByVal = true;
+ pParser->Next();
+ eTok = pParser->Peek();
+ }
+
+ if( bAssumeExprLParenMode )
+ {
+ pExpr = std::make_unique<SbiExpression>( pParser, SbSTDEXPR, EXPRMODE_LPAREN_PENDING );
+ bAssumeExprLParenMode = false;
+
+ SbiExprMode eModeAfter = pExpr->m_eMode;
+ if( eModeAfter == EXPRMODE_LPAREN_NOT_NEEDED )
+ {
+ pExprList->bBracket = true;
+ }
+ else if( eModeAfter == EXPRMODE_ARRAY_OR_OBJECT )
+ {
+ // Expression "looks" like an array assignment
+ // a(...)[(...)] = ? or a(...).b(...)
+ // RPAREN is already parsed
+ pExprList->bBracket = true;
+ bAssumeArrayMode = true;
+ eTok = NIL;
+ }
+ else if( eModeAfter == EXPRMODE_EMPTY_PAREN )
+ {
+ pExprList->bBracket = true;
+ return pExprList;
+ }
+ }
+ else
+ {
+ pExpr = std::make_unique<SbiExpression>( pParser );
+ }
+ if( bByVal && pExpr->IsLvalue() )
+ {
+ pExpr->SetByVal();
+ }
+ if( !bAssumeArrayMode )
+ {
+ OUString aName;
+ if( pParser->Peek() == ASSIGN )
+ {
+ // VBA mode: name:=
+ // SbiExpression::Term() has made as string out of it
+ aName = pExpr->GetString();
+ pParser->Next();
+ pExpr = std::make_unique<SbiExpression>( pParser );
+ }
+ pExpr->GetName() = aName;
+ }
+ }
+ pExprList->bError = pExprList->bError || !pExpr->IsValid();
+ pExprList->aData.push_back(std::move(pExpr));
+ if( bAssumeArrayMode )
+ {
+ break;
+ }
+ // next element?
+ eTok = pParser->Peek();
+ if( eTok != COMMA )
+ {
+ if( ( pExprList->bBracket && eTok == RPAREN ) || SbiTokenizer::IsEoln( eTok ) )
+ {
+ // tdf#80731
+ if (SbiTokenizer::IsEoln(eTok) && pExprList->bBracket)
+ {
+ // tdf#106529: only fail here in strict mode (i.e. when compiled from IDE), and
+ // allow legacy code with missing closing parenthesis when started e.g. from
+ // extensions and event handlers
+ bool bCheckStrict = false;
+ if (auto xContext = css::uno::getCurrentContext())
+ xContext->getValueByName("BasicStrict") >>= bCheckStrict;
+ if (bCheckStrict)
+ {
+ pParser->Error(ERRCODE_BASIC_EXPECTED, RPAREN);
+ pExprList->bError = true;
+ }
+ }
+ break;
+ }
+ pParser->Error( pExprList->bBracket ? ERRCODE_BASIC_BAD_BRACKETS : ERRCODE_BASIC_EXPECTED, COMMA );
+ pExprList->bError = true;
+ }
+ else
+ {
+ pParser->Next();
+ eTok = pParser->Peek();
+ if( ( pExprList->bBracket && eTok == RPAREN ) || SbiTokenizer::IsEoln( eTok ) )
+ {
+ break;
+ }
+ }
+ }
+ // closing bracket
+ if( eTok == RPAREN )
+ {
+ pParser->Next();
+ pParser->Peek();
+ if( !pExprList->bBracket )
+ {
+ pParser->Error( ERRCODE_BASIC_BAD_BRACKETS );
+ pExprList->bError = true;
+ }
+ }
+ pExprList->nDim = pExprList->GetSize();
+ return pExprList;
+}
+
+// A list of array dimensions is parsed.
+
+SbiExprListPtr SbiExprList::ParseDimList( SbiParser* pParser )
+{
+ auto pExprList = std::make_unique<SbiExprList>();
+
+ if( pParser->Next() != LPAREN )
+ {
+ pParser->Error( ERRCODE_BASIC_EXPECTED, LPAREN );
+ pExprList->bError = true; return pExprList;
+ }
+
+ if( pParser->Peek() != RPAREN )
+ {
+ SbiToken eTok;
+ for( ;; )
+ {
+ auto pExpr1 = std::make_unique<SbiExpression>( pParser );
+ eTok = pParser->Next();
+ if( eTok == TO )
+ {
+ auto pExpr2 = std::make_unique<SbiExpression>( pParser );
+ pExpr1->ConvertToIntConstIfPossible();
+ pExpr2->ConvertToIntConstIfPossible();
+ eTok = pParser->Next();
+ pExprList->bError = pExprList->bError || !pExpr1->IsValid() || !pExpr2->IsValid();
+ pExprList->aData.push_back(std::move(pExpr1));
+ pExprList->aData.push_back(std::move(pExpr2));
+ }
+ else
+ {
+ pExpr1->SetBased();
+ pExpr1->ConvertToIntConstIfPossible();
+ pExprList->bError = pExprList->bError || !pExpr1->IsValid();
+ pExprList->aData.push_back(std::move(pExpr1));
+ }
+ pExprList->nDim++;
+ if( eTok == RPAREN ) break;
+ if( eTok != COMMA )
+ {
+ pParser->Error( ERRCODE_BASIC_BAD_BRACKETS );
+ pParser->Next();
+ break;
+ }
+ }
+ }
+ else pParser->Next();
+ return pExprList;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/io.cxx b/basic/source/comp/io.cxx
new file mode 100644
index 000000000..45581c70e
--- /dev/null
+++ b/basic/source/comp/io.cxx
@@ -0,0 +1,309 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/sberrors.hxx>
+#include <parser.hxx>
+#include <iosys.hxx>
+#include <memory>
+
+// test if there's an I/O channel
+
+bool SbiParser::Channel( bool bAlways )
+{
+ bool bRes = false;
+ Peek();
+ if( IsHash() )
+ {
+ SbiExpression aExpr( this );
+ while( Peek() == COMMA || Peek() == SEMICOLON )
+ Next();
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::CHANNEL_ );
+ bRes = true;
+ }
+ else if( bAlways )
+ Error( ERRCODE_BASIC_EXPECTED, "#" );
+ return bRes;
+}
+
+// it's tried that at object variables the Default-
+// Property is addressed for PRINT and WRITE
+
+void SbiParser::Print()
+{
+ bool bChan = Channel();
+
+ while( !bAbort )
+ {
+ if( !IsEoln( Peek() ) )
+ {
+ std::unique_ptr<SbiExpression> pExpr(new SbiExpression( this ));
+ pExpr->Gen();
+ pExpr.reset();
+ Peek();
+ aGen.Gen( eCurTok == COMMA ? SbiOpcode::PRINTF_ : SbiOpcode::BPRINT_ );
+ }
+ if( eCurTok == COMMA || eCurTok == SEMICOLON )
+ {
+ Next();
+ if( IsEoln( Peek() ) ) break;
+ }
+ else
+ {
+ aGen.Gen( SbiOpcode::PRCHAR_, '\n' );
+ break;
+ }
+ }
+ if( bChan )
+ aGen.Gen( SbiOpcode::CHAN0_ );
+}
+
+// WRITE #chan, expr, ...
+
+void SbiParser::Write()
+{
+ bool bChan = Channel();
+
+ while( !bAbort )
+ {
+ std::unique_ptr<SbiExpression> pExpr(new SbiExpression( this ));
+ pExpr->Gen();
+ pExpr.reset();
+ aGen.Gen( SbiOpcode::BWRITE_ );
+ if( Peek() == COMMA )
+ {
+ aGen.Gen( SbiOpcode::PRCHAR_, ',' );
+ Next();
+ if( IsEoln( Peek() ) ) break;
+ }
+ else
+ {
+ aGen.Gen( SbiOpcode::PRCHAR_, '\n' );
+ break;
+ }
+ }
+ if( bChan )
+ aGen.Gen( SbiOpcode::CHAN0_ );
+}
+
+
+// #i92642 Handle LINE keyword outside ::Next()
+void SbiParser::Line()
+{
+ // #i92642: Special handling to allow name as symbol
+ if( Peek() == INPUT )
+ {
+ Next();
+ LineInput();
+ }
+ else
+ {
+ aGen.Statement();
+
+ KeywordSymbolInfo aInfo;
+ aInfo.m_aKeywordSymbol = "line";
+ aInfo.m_eSbxDataType = GetType();
+
+ Symbol( &aInfo );
+ }
+}
+
+
+// LINE INPUT [prompt], var$
+
+void SbiParser::LineInput()
+{
+ Channel( true );
+ std::unique_ptr<SbiExpression> pExpr(new SbiExpression( this, SbOPERAND ));
+ if( !pExpr->IsVariable() )
+ Error( ERRCODE_BASIC_VAR_EXPECTED );
+ if( pExpr->GetType() != SbxVARIANT && pExpr->GetType() != SbxSTRING )
+ Error( ERRCODE_BASIC_CONVERSION );
+ pExpr->Gen();
+ aGen.Gen( SbiOpcode::LINPUT_ );
+ pExpr.reset();
+ aGen.Gen( SbiOpcode::CHAN0_ ); // ResetChannel() not in StepLINPUT() anymore
+}
+
+// INPUT
+
+void SbiParser::Input()
+{
+ aGen.Gen( SbiOpcode::RESTART_ );
+ Channel( true );
+ std::unique_ptr<SbiExpression> pExpr(new SbiExpression( this, SbOPERAND ));
+ while( !bAbort )
+ {
+ if( !pExpr->IsVariable() )
+ Error( ERRCODE_BASIC_VAR_EXPECTED );
+ pExpr->Gen();
+ aGen.Gen( SbiOpcode::INPUT_ );
+ if( Peek() == COMMA )
+ {
+ Next();
+ pExpr.reset(new SbiExpression( this, SbOPERAND ));
+ }
+ else break;
+ }
+ pExpr.reset();
+ aGen.Gen( SbiOpcode::CHAN0_ );
+}
+
+// OPEN stringexpr FOR mode ACCESS access mode AS Channel [Len=n]
+
+void SbiParser::Open()
+{
+ bInStatement = true;
+ SbiExpression aFileName( this );
+ SbiToken eTok;
+ TestToken( FOR );
+ StreamMode nMode = StreamMode::NONE;
+ SbiStreamFlags nFlags = SbiStreamFlags::NONE;
+ switch( Next() )
+ {
+ case INPUT:
+ nMode = StreamMode::READ; nFlags |= SbiStreamFlags::Input; break;
+ case OUTPUT:
+ nMode = StreamMode::WRITE | StreamMode::TRUNC; nFlags |= SbiStreamFlags::Output; break;
+ case APPEND:
+ nMode = StreamMode::WRITE; nFlags |= SbiStreamFlags::Append; break;
+ case RANDOM:
+ nMode = StreamMode::READ | StreamMode::WRITE; nFlags |= SbiStreamFlags::Random; break;
+ case BINARY:
+ nMode = StreamMode::READ | StreamMode::WRITE; nFlags |= SbiStreamFlags::Binary; break;
+ default:
+ Error( ERRCODE_BASIC_SYNTAX );
+ }
+ if( Peek() == ACCESS )
+ {
+ Next();
+ eTok = Next();
+ // influence only READ,WRITE-Flags in nMode
+ nMode &= ~StreamMode(StreamMode::READ | StreamMode::WRITE); // delete
+ if( eTok == READ )
+ {
+ if( Peek() == WRITE )
+ {
+ Next();
+ nMode |= StreamMode::READ | StreamMode::WRITE;
+ }
+ else
+ nMode |= StreamMode::READ;
+ }
+ else if( eTok == WRITE )
+ nMode |= StreamMode::WRITE;
+ else
+ Error( ERRCODE_BASIC_SYNTAX );
+ }
+ switch( Peek() )
+ {
+ case SHARED:
+ Next(); nMode |= StreamMode::SHARE_DENYNONE; break;
+ case LOCK:
+ Next();
+ eTok = Next();
+ if( eTok == READ )
+ {
+ if( Peek() == WRITE )
+ {
+ Next();
+ nMode |= StreamMode::SHARE_DENYALL;
+ }
+ else nMode |= StreamMode::SHARE_DENYREAD;
+ }
+ else if( eTok == WRITE )
+ nMode |= StreamMode::SHARE_DENYWRITE;
+ else
+ Error( ERRCODE_BASIC_SYNTAX );
+ break;
+ default: break;
+ }
+ TestToken( AS );
+ // channel number
+ std::unique_ptr<SbiExpression> pChan(new SbiExpression( this ));
+ std::unique_ptr<SbiExpression> pLen;
+ if( Peek() == SYMBOL )
+ {
+ Next();
+ if( aSym.equalsIgnoreAsciiCase("LEN") )
+ {
+ TestToken( EQ );
+ pLen.reset(new SbiExpression( this ));
+ }
+ }
+ if( !pLen ) pLen.reset(new SbiExpression( this, 128, SbxINTEGER ));
+ // the stack for the OPEN command looks as follows:
+ // block length
+ // channel number
+ // file name
+ pLen->Gen();
+ pChan->Gen();
+ aFileName.Gen();
+ aGen.Gen( SbiOpcode::OPEN_, static_cast<sal_uInt32>(nMode), static_cast<sal_uInt32>(nFlags) );
+ bInStatement = false;
+}
+
+// NAME file AS file
+
+void SbiParser::Name()
+{
+ // #i92642: Special handling to allow name as symbol
+ if( Peek() == EQ )
+ {
+ aGen.Statement();
+
+ KeywordSymbolInfo aInfo;
+ aInfo.m_aKeywordSymbol = "name";
+ aInfo.m_eSbxDataType = GetType();
+
+ Symbol( &aInfo );
+ return;
+ }
+ SbiExpression aExpr1( this );
+ TestToken( AS );
+ SbiExpression aExpr2( this );
+ aExpr1.Gen();
+ aExpr2.Gen();
+ aGen.Gen( SbiOpcode::RENAME_ );
+}
+
+// CLOSE [n,...]
+
+void SbiParser::Close()
+{
+ Peek();
+ if( IsEoln( eCurTok ) )
+ aGen.Gen( SbiOpcode::CLOSE_, 0 );
+ else
+ for( ;; )
+ {
+ SbiExpression aExpr( this );
+ while( Peek() == COMMA || Peek() == SEMICOLON )
+ Next();
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::CHANNEL_ );
+ aGen.Gen( SbiOpcode::CLOSE_, 1 );
+
+ if( IsEoln( Peek() ) )
+ break;
+ }
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/loops.cxx b/basic/source/comp/loops.cxx
new file mode 100644
index 000000000..2d174efa2
--- /dev/null
+++ b/basic/source/comp/loops.cxx
@@ -0,0 +1,572 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <parser.hxx>
+#include <memory>
+
+#include <basic/sberrors.hxx>
+
+// Single-line IF and Multiline IF
+
+void SbiParser::If()
+{
+ sal_uInt32 nEndLbl;
+ SbiToken eTok = NIL;
+ // ignore end-tokens
+ SbiExpression aCond( this );
+ aCond.Gen();
+ TestToken( THEN );
+ if( IsEoln( Next() ) )
+ {
+ // At the end of each block a jump to ENDIF must be inserted,
+ // so that the condition is not evaluated again at ELSEIF.
+ // The table collects all jump points.
+#define JMP_TABLE_SIZE 100
+ sal_uInt32 pnJmpToEndLbl[JMP_TABLE_SIZE]; // 100 ELSEIFs allowed
+ sal_uInt16 iJmp = 0; // current table index
+
+ // multiline IF
+ nEndLbl = aGen.Gen( SbiOpcode::JUMPF_, 0 );
+ eTok = Peek();
+ while( !( eTok == ELSEIF || eTok == ELSE || eTok == ENDIF ) &&
+ !bAbort && Parse() )
+ {
+ eTok = Peek();
+ if( IsEof() )
+ {
+ Error( ERRCODE_BASIC_BAD_BLOCK, IF ); bAbort = true; return;
+ }
+ }
+ while( eTok == ELSEIF )
+ {
+ // jump to ENDIF in case of a successful IF/ELSEIF
+ if( iJmp >= JMP_TABLE_SIZE )
+ {
+ Error( ERRCODE_BASIC_PROG_TOO_LARGE ); bAbort = true; return;
+ }
+ pnJmpToEndLbl[iJmp++] = aGen.Gen( SbiOpcode::JUMP_, 0 );
+
+ Next();
+ aGen.BackChain( nEndLbl );
+
+ aGen.Statement();
+ std::unique_ptr<SbiExpression> pCond(new SbiExpression( this ));
+ pCond->Gen();
+ nEndLbl = aGen.Gen( SbiOpcode::JUMPF_, 0 );
+ pCond.reset();
+ TestToken( THEN );
+ eTok = Peek();
+ while( !( eTok == ELSEIF || eTok == ELSE || eTok == ENDIF ) &&
+ !bAbort && Parse() )
+ {
+ eTok = Peek();
+ if( IsEof() )
+ {
+ Error( ERRCODE_BASIC_BAD_BLOCK, ELSEIF ); bAbort = true; return;
+ }
+ }
+ }
+ if( eTok == ELSE )
+ {
+ Next();
+ sal_uInt32 nElseLbl = nEndLbl;
+ nEndLbl = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ aGen.BackChain( nElseLbl );
+
+ aGen.Statement();
+ StmntBlock( ENDIF );
+ }
+ else if( eTok == ENDIF )
+ Next();
+
+
+ while( iJmp > 0 )
+ {
+ iJmp--;
+ aGen.BackChain( pnJmpToEndLbl[iJmp] );
+ }
+ }
+ else
+ {
+ // single line IF
+ bSingleLineIf = true;
+ nEndLbl = aGen.Gen( SbiOpcode::JUMPF_, 0 );
+ Push( eCurTok );
+ // tdf#128263: update push positions to correctly restore in Next()
+ nPLine = nLine;
+ nPCol1 = nCol1;
+ nPCol2 = nCol2;
+
+ while( !bAbort )
+ {
+ if( !Parse() ) break;
+ eTok = Peek();
+ if( eTok == ELSE || eTok == EOLN || eTok == REM )
+ break;
+ }
+ if( eTok == ELSE )
+ {
+ Next();
+ sal_uInt32 nElseLbl = nEndLbl;
+ nEndLbl = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ aGen.BackChain( nElseLbl );
+ while( !bAbort )
+ {
+ if( !Parse() ) break;
+ eTok = Peek();
+ if( eTok == EOLN || eTok == REM )
+ break;
+ }
+ }
+ bSingleLineIf = false;
+ }
+ aGen.BackChain( nEndLbl );
+}
+
+// ELSE/ELSEIF/ENDIF without IF
+
+void SbiParser::NoIf()
+{
+ Error( ERRCODE_BASIC_NO_IF );
+ StmntBlock( ENDIF );
+}
+
+// DO WHILE...LOOP
+// DO ... LOOP WHILE
+
+void SbiParser::DoLoop()
+{
+ sal_uInt32 nStartLbl = aGen.GetPC();
+ OpenBlock( DO );
+ SbiToken eTok = Next();
+ if( IsEoln( eTok ) )
+ {
+ // DO ... LOOP [WHILE|UNTIL expr]
+ StmntBlock( LOOP );
+ eTok = Next();
+ if( eTok == UNTIL || eTok == WHILE )
+ {
+ SbiExpression aExpr( this );
+ aExpr.Gen();
+ aGen.Gen( eTok == UNTIL ? SbiOpcode::JUMPF_ : SbiOpcode::JUMPT_, nStartLbl );
+ } else
+ if (eTok == EOLN || eTok == REM)
+ aGen.Gen (SbiOpcode::JUMP_, nStartLbl);
+ else
+ Error( ERRCODE_BASIC_EXPECTED, WHILE );
+ }
+ else
+ {
+ // DO [WHILE|UNTIL expr] ... LOOP
+ if( eTok == UNTIL || eTok == WHILE )
+ {
+ SbiExpression aCond( this );
+ aCond.Gen();
+ }
+ sal_uInt32 nEndLbl = aGen.Gen( eTok == UNTIL ? SbiOpcode::JUMPT_ : SbiOpcode::JUMPF_, 0 );
+ StmntBlock( LOOP );
+ TestEoln();
+ aGen.Gen( SbiOpcode::JUMP_, nStartLbl );
+ aGen.BackChain( nEndLbl );
+ }
+ CloseBlock();
+}
+
+// WHILE ... WEND
+
+void SbiParser::While()
+{
+ SbiExpression aCond( this );
+ sal_uInt32 nStartLbl = aGen.GetPC();
+ aCond.Gen();
+ sal_uInt32 nEndLbl = aGen.Gen( SbiOpcode::JUMPF_, 0 );
+ StmntBlock( WEND );
+ aGen.Gen( SbiOpcode::JUMP_, nStartLbl );
+ aGen.BackChain( nEndLbl );
+}
+
+// FOR var = expr TO expr STEP
+
+void SbiParser::For()
+{
+ bool bForEach = ( Peek() == EACH );
+ if( bForEach )
+ Next();
+ SbiExpression aLvalue( this, SbOPERAND );
+ aLvalue.Gen(); // variable on the Stack
+
+ if( bForEach )
+ {
+ TestToken( IN_ );
+ SbiExpression aCollExpr( this, SbOPERAND );
+ aCollExpr.Gen(); // Collection var to for stack
+ TestEoln();
+ aGen.Gen( SbiOpcode::INITFOREACH_ );
+ }
+ else
+ {
+ TestToken( EQ );
+ SbiExpression aStartExpr( this );
+ aStartExpr.Gen();
+ TestToken( TO );
+ SbiExpression aStopExpr( this );
+ aStopExpr.Gen();
+ if( Peek() == STEP )
+ {
+ Next();
+ SbiExpression aStepExpr( this );
+ aStepExpr.Gen();
+ }
+ else
+ {
+ SbiExpression aOne( this, 1, SbxINTEGER );
+ aOne.Gen();
+ }
+ TestEoln();
+ // The stack has all 4 elements now: variable, start, end, increment
+ // bind start value
+ aGen.Gen( SbiOpcode::INITFOR_ );
+ }
+
+ sal_uInt32 nLoop = aGen.GetPC();
+ // do tests, maybe free the stack
+ sal_uInt32 nEndTarget = aGen.Gen( SbiOpcode::TESTFOR_, 0 );
+ OpenBlock( FOR );
+ StmntBlock( NEXT );
+ aGen.Gen( SbiOpcode::NEXT_ );
+ aGen.Gen( SbiOpcode::JUMP_, nLoop );
+ // are there variables after NEXT?
+ if( Peek() == SYMBOL )
+ {
+ SbiExpression aVar( this, SbOPERAND );
+ if( aVar.GetRealVar() != aLvalue.GetRealVar() )
+ Error( ERRCODE_BASIC_EXPECTED, aLvalue.GetRealVar()->GetName() );
+ }
+ aGen.BackChain( nEndTarget );
+ CloseBlock();
+}
+
+// WITH .. END WITH
+
+void SbiParser::With()
+{
+ SbiExpression aVar( this, SbOPERAND );
+
+ SbiExprNode *pNode = aVar.GetExprNode()->GetRealNode();
+ if (!pNode)
+ return;
+ SbiSymDef* pDef = pNode->GetVar();
+ // Variant, from 27.6.1997, #41090: empty -> must be Object
+ if( pDef->GetType() == SbxVARIANT || pDef->GetType() == SbxEMPTY )
+ pDef->SetType( SbxOBJECT );
+ else if( pDef->GetType() != SbxOBJECT )
+ Error( ERRCODE_BASIC_NEEDS_OBJECT );
+
+
+ pNode->SetType( SbxOBJECT );
+
+ OpenBlock( NIL, aVar.GetExprNode() );
+ StmntBlock( ENDWITH );
+ CloseBlock();
+}
+
+// LOOP/NEXT/WEND without construct
+
+void SbiParser::BadBlock()
+{
+ if( eEndTok )
+ Error( ERRCODE_BASIC_BAD_BLOCK, eEndTok );
+ else
+ Error( ERRCODE_BASIC_BAD_BLOCK, "Loop/Next/Wend" );
+}
+
+// On expr Goto/Gosub n,n,n...
+
+void SbiParser::OnGoto()
+{
+ SbiExpression aCond( this );
+ aCond.Gen();
+ sal_uInt32 nLabelsTarget = aGen.Gen( SbiOpcode::ONJUMP_, 0 );
+ SbiToken eTok = Next();
+ if( eTok != GOTO && eTok != GOSUB )
+ {
+ Error( ERRCODE_BASIC_EXPECTED, "GoTo/GoSub" );
+ eTok = GOTO;
+ }
+
+ sal_uInt32 nLbl = 0;
+ do
+ {
+ Next(); // get label
+ if( MayBeLabel() )
+ {
+ sal_uInt32 nOff = pProc->GetLabels().Reference( aSym );
+ aGen.Gen( SbiOpcode::JUMP_, nOff );
+ nLbl++;
+ }
+ else Error( ERRCODE_BASIC_LABEL_EXPECTED );
+ }
+ while( !bAbort && TestComma() );
+ if( eTok == GOSUB )
+ nLbl |= 0x8000;
+ aGen.Patch( nLabelsTarget, nLbl );
+}
+
+// GOTO/GOSUB
+
+void SbiParser::Goto()
+{
+ SbiOpcode eOp = eCurTok == GOTO ? SbiOpcode::JUMP_ : SbiOpcode::GOSUB_;
+ Next();
+ if( MayBeLabel() )
+ {
+ sal_uInt32 nOff = pProc->GetLabels().Reference( aSym );
+ aGen.Gen( eOp, nOff );
+ }
+ else Error( ERRCODE_BASIC_LABEL_EXPECTED );
+}
+
+// RETURN [label]
+
+void SbiParser::Return()
+{
+ Next();
+ if( MayBeLabel() )
+ {
+ sal_uInt32 nOff = pProc->GetLabels().Reference( aSym );
+ aGen.Gen( SbiOpcode::RETURN_, nOff );
+ }
+ else aGen.Gen( SbiOpcode::RETURN_, 0 );
+}
+
+// SELECT CASE
+
+void SbiParser::Select()
+{
+ TestToken( CASE );
+ SbiExpression aCase( this );
+ SbiToken eTok = NIL;
+ aCase.Gen();
+ aGen.Gen( SbiOpcode::CASE_ );
+ TestEoln();
+ sal_uInt32 nNextTarget = 0;
+ sal_uInt32 nDoneTarget = 0;
+ bool bElse = false;
+
+ while( !bAbort )
+ {
+ eTok = Next();
+ if( eTok == CASE )
+ {
+ if( nNextTarget )
+ {
+ aGen.BackChain( nNextTarget );
+ nNextTarget = 0;
+ }
+ aGen.Statement();
+
+ bool bDone = false;
+ sal_uInt32 nTrueTarget = 0;
+ if( Peek() == ELSE )
+ {
+ // CASE ELSE
+ Next();
+ bElse = true;
+ }
+ else while( !bDone )
+ {
+ if( bElse )
+ Error( ERRCODE_BASIC_SYNTAX );
+ SbiToken eTok2 = Peek();
+ if( eTok2 == IS || ( eTok2 >= EQ && eTok2 <= GE ) )
+ { // CASE [IS] operator expr
+ if( eTok2 == IS )
+ Next();
+ eTok2 = Peek();
+ if( eTok2 < EQ || eTok2 > GE )
+ Error( ERRCODE_BASIC_SYNTAX );
+ else Next();
+ SbiExpression aCompare( this );
+ aCompare.Gen();
+ nTrueTarget = aGen.Gen(
+ SbiOpcode::CASEIS_, nTrueTarget,
+ sal::static_int_cast< sal_uInt16 >(
+ SbxEQ + ( eTok2 - EQ ) ) );
+ }
+ else
+ { // CASE expr | expr TO expr
+ SbiExpression aCase1( this );
+ aCase1.Gen();
+ if( Peek() == TO )
+ {
+ // CASE a TO b
+ Next();
+ SbiExpression aCase2( this );
+ aCase2.Gen();
+ nTrueTarget = aGen.Gen( SbiOpcode::CASETO_, nTrueTarget );
+ }
+ else
+ // CASE a
+ nTrueTarget = aGen.Gen( SbiOpcode::CASEIS_, nTrueTarget, SbxEQ );
+
+ }
+ if( Peek() == COMMA ) Next();
+ else
+ {
+ TestEoln();
+ bDone = true;
+ }
+ }
+
+ if( !bElse )
+ {
+ nNextTarget = aGen.Gen( SbiOpcode::JUMP_, nNextTarget );
+ aGen.BackChain( nTrueTarget );
+ }
+ // build the statement body
+ while( !bAbort )
+ {
+ eTok = Peek();
+ if( eTok == CASE || eTok == ENDSELECT )
+ break;
+ if( !Parse() ) goto done;
+ eTok = Peek();
+ if( eTok == CASE || eTok == ENDSELECT )
+ break;
+ }
+ if( !bElse )
+ nDoneTarget = aGen.Gen( SbiOpcode::JUMP_, nDoneTarget );
+ }
+ else if( !IsEoln( eTok ) )
+ break;
+ }
+done:
+ if( eTok != ENDSELECT )
+ Error( ERRCODE_BASIC_EXPECTED, ENDSELECT );
+ if( nNextTarget )
+ aGen.BackChain( nNextTarget );
+ aGen.BackChain( nDoneTarget );
+ aGen.Gen( SbiOpcode::ENDCASE_ );
+}
+
+// ON Error/Variable
+
+void SbiParser::On()
+{
+ SbiToken eTok = Peek();
+ OUString aString = SbiTokenizer::Symbol(eTok);
+ if (aString.equalsIgnoreAsciiCase("ERROR"))
+ {
+ eTok = ERROR_; // Error comes as SYMBOL
+ }
+ if( eTok != ERROR_ && eTok != LOCAL )
+ {
+ OnGoto();
+ }
+ else
+ {
+ if( eTok == LOCAL )
+ {
+ Next();
+ }
+ Next (); // no more TestToken, as there'd be an error otherwise
+
+ Next(); // get token after error
+ if( eCurTok == GOTO )
+ {
+ // ON ERROR GOTO label|0
+ Next();
+ bool bError_ = false;
+ if( MayBeLabel() )
+ {
+ if( eCurTok == NUMBER && !nVal )
+ {
+ aGen.Gen( SbiOpcode::STDERROR_ );
+ }
+ else
+ {
+ sal_uInt32 nOff = pProc->GetLabels().Reference( aSym );
+ aGen.Gen( SbiOpcode::ERRHDL_, nOff );
+ }
+ }
+ else if( eCurTok == MINUS )
+ {
+ Next();
+ if( eCurTok == NUMBER && nVal == 1 )
+ {
+ aGen.Gen( SbiOpcode::STDERROR_ );
+ }
+ else
+ {
+ bError_ = true;
+ }
+ }
+ if( bError_ )
+ {
+ Error( ERRCODE_BASIC_LABEL_EXPECTED );
+ }
+ }
+ else if( eCurTok == RESUME )
+ {
+ TestToken( NEXT );
+ aGen.Gen( SbiOpcode::NOERROR_ );
+ }
+ else Error( ERRCODE_BASIC_EXPECTED, "GoTo/Resume" );
+ }
+}
+
+// RESUME [0]|NEXT|label
+
+void SbiParser::Resume()
+{
+ sal_uInt32 nLbl;
+
+ switch( Next() )
+ {
+ case EOS:
+ case EOLN:
+ aGen.Gen( SbiOpcode::RESUME_, 0 );
+ break;
+ case NEXT:
+ aGen.Gen( SbiOpcode::RESUME_, 1 );
+ Next();
+ break;
+ case NUMBER:
+ if( !nVal )
+ {
+ aGen.Gen( SbiOpcode::RESUME_, 0 );
+ break;
+ }
+ [[fallthrough]];
+ case SYMBOL:
+ if( MayBeLabel() )
+ {
+ nLbl = pProc->GetLabels().Reference( aSym );
+ aGen.Gen( SbiOpcode::RESUME_, nLbl );
+ Next();
+ break;
+ }
+ [[fallthrough]];
+ default:
+ Error( ERRCODE_BASIC_LABEL_EXPECTED );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/parser.cxx b/basic/source/comp/parser.cxx
new file mode 100644
index 000000000..d26f4de63
--- /dev/null
+++ b/basic/source/comp/parser.cxx
@@ -0,0 +1,874 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/sberrors.hxx>
+#include <basic/sbxmeth.hxx>
+#include <basic/sbmod.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/sbx.hxx>
+#include <parser.hxx>
+#include <com/sun/star/script/ModuleType.hpp>
+#include <rtl/character.hxx>
+
+struct SbiParseStack { // "Stack" for statement-blocks
+ SbiParseStack* pNext; // Chain
+ SbiExprNode* pWithVar;
+ SbiToken eExitTok;
+ sal_uInt32 nChain; // JUMP-Chain
+};
+
+namespace {
+
+struct SbiStatement {
+ SbiToken eTok;
+ void( SbiParser::*Func )();
+ bool bMain; // true: OK outside the SUB
+ bool bSubr; // true: OK inside the SUB
+};
+
+}
+
+#define Y true
+#define N false
+
+static const SbiStatement StmntTable [] = {
+{ ATTRIBUTE, &SbiParser::Attribute, Y, Y, }, // ATTRIBUTE
+{ CALL, &SbiParser::Call, N, Y, }, // CALL
+{ CLOSE, &SbiParser::Close, N, Y, }, // CLOSE
+{ CONST_, &SbiParser::Dim, Y, Y, }, // CONST
+{ DECLARE, &SbiParser::Declare, Y, N, }, // DECLARE
+{ DEFBOOL, &SbiParser::DefXXX, Y, N, }, // DEFBOOL
+{ DEFCUR, &SbiParser::DefXXX, Y, N, }, // DEFCUR
+{ DEFDATE, &SbiParser::DefXXX, Y, N, }, // DEFDATE
+{ DEFDBL, &SbiParser::DefXXX, Y, N, }, // DEFDBL
+{ DEFERR, &SbiParser::DefXXX, Y, N, }, // DEFERR
+{ DEFINT, &SbiParser::DefXXX, Y, N, }, // DEFINT
+{ DEFLNG, &SbiParser::DefXXX, Y, N, }, // DEFLNG
+{ DEFOBJ, &SbiParser::DefXXX, Y, N, }, // DEFOBJ
+{ DEFSNG, &SbiParser::DefXXX, Y, N, }, // DEFSNG
+{ DEFSTR, &SbiParser::DefXXX, Y, N, }, // DEFSTR
+{ DEFVAR, &SbiParser::DefXXX, Y, N, }, // DEFVAR
+{ DIM, &SbiParser::Dim, Y, Y, }, // DIM
+{ DO, &SbiParser::DoLoop, N, Y, }, // DO
+{ ELSE, &SbiParser::NoIf, N, Y, }, // ELSE
+{ ELSEIF, &SbiParser::NoIf, N, Y, }, // ELSEIF
+{ ENDIF, &SbiParser::NoIf, N, Y, }, // ENDIF
+{ END, &SbiParser::Stop, N, Y, }, // END
+{ ENUM, &SbiParser::Enum, Y, N, }, // TYPE
+{ ERASE, &SbiParser::Erase, N, Y, }, // ERASE
+{ ERROR_, &SbiParser::ErrorStmnt, N, Y, }, // ERROR
+{ EXIT, &SbiParser::Exit, N, Y, }, // EXIT
+{ FOR, &SbiParser::For, N, Y, }, // FOR
+{ FUNCTION, &SbiParser::SubFunc, Y, N, }, // FUNCTION
+{ GOSUB, &SbiParser::Goto, N, Y, }, // GOSUB
+{ GLOBAL, &SbiParser::Dim, Y, N, }, // GLOBAL
+{ GOTO, &SbiParser::Goto, N, Y, }, // GOTO
+{ IF, &SbiParser::If, N, Y, }, // IF
+{ IMPLEMENTS, &SbiParser::Implements, Y, N, }, // IMPLEMENTS
+{ INPUT, &SbiParser::Input, N, Y, }, // INPUT
+{ LET, &SbiParser::Assign, N, Y, }, // LET
+{ LINE, &SbiParser::Line, N, Y, }, // LINE, -> LINE INPUT (#i92642)
+{ LINEINPUT,&SbiParser::LineInput, N, Y, }, // LINE INPUT
+{ LOOP, &SbiParser::BadBlock, N, Y, }, // LOOP
+{ LSET, &SbiParser::LSet, N, Y, }, // LSET
+{ NAME, &SbiParser::Name, N, Y, }, // NAME
+{ NEXT, &SbiParser::BadBlock, N, Y, }, // NEXT
+{ ON, &SbiParser::On, N, Y, }, // ON
+{ OPEN, &SbiParser::Open, N, Y, }, // OPEN
+{ OPTION, &SbiParser::Option, Y, N, }, // OPTION
+{ PRINT, &SbiParser::Print, N, Y, }, // PRINT
+{ PRIVATE, &SbiParser::Dim, Y, N, }, // PRIVATE
+{ PROPERTY, &SbiParser::SubFunc, Y, N, }, // FUNCTION
+{ PUBLIC, &SbiParser::Dim, Y, N, }, // PUBLIC
+{ REDIM, &SbiParser::ReDim, N, Y, }, // DIM
+{ RESUME, &SbiParser::Resume, N, Y, }, // RESUME
+{ RETURN, &SbiParser::Return, N, Y, }, // RETURN
+{ RSET, &SbiParser::RSet, N, Y, }, // RSET
+{ SELECT, &SbiParser::Select, N, Y, }, // SELECT
+{ SET, &SbiParser::Set, N, Y, }, // SET
+{ STATIC, &SbiParser::Static, Y, Y, }, // STATIC
+{ STOP, &SbiParser::Stop, N, Y, }, // STOP
+{ SUB, &SbiParser::SubFunc, Y, N, }, // SUB
+{ TYPE, &SbiParser::Type, Y, N, }, // TYPE
+{ UNTIL, &SbiParser::BadBlock, N, Y, }, // UNTIL
+{ WHILE, &SbiParser::While, N, Y, }, // WHILE
+{ WEND, &SbiParser::BadBlock, N, Y, }, // WEND
+{ WITH, &SbiParser::With, N, Y, }, // WITH
+{ WRITE, &SbiParser::Write, N, Y, }, // WRITE
+
+{ NIL, nullptr, N, N }
+};
+
+
+SbiParser::SbiParser( StarBASIC* pb, SbModule* pm )
+ : SbiTokenizer( pm->GetSource32(), pb ),
+ aGlobals( aGblStrings, SbGLOBAL, this ),
+ aPublics( aGblStrings, SbPUBLIC, this ),
+ aRtlSyms( aGblStrings, SbRTL, this ),
+ aGen( *pm, this, 1024 )
+{
+ eEndTok = NIL;
+ pProc = nullptr;
+ pStack = nullptr;
+ pWithVar = nullptr;
+ nBase = 0;
+ bGblDefs =
+ bNewGblDefs =
+ bSingleLineIf =
+ bCodeCompleting =
+ bExplicit = false;
+ bClassModule = ( pm->GetModuleType() == css::script::ModuleType::CLASS );
+ pPool = &aPublics;
+ for(SbxDataType & eDefType : eDefTypes)
+ eDefType = SbxVARIANT; // no explicit default type
+
+ aPublics.SetParent( &aGlobals );
+ aGlobals.SetParent( &aRtlSyms );
+
+
+ nGblChain = aGen.Gen( SbiOpcode::JUMP_, 0 );
+
+ rTypeArray = new SbxArray; // array for user defined types
+ rEnumArray = new SbxArray; // array for Enum types
+ bVBASupportOn = pm->IsVBACompat();
+ if ( bVBASupportOn )
+ EnableCompatibility();
+
+}
+
+SbiParser::~SbiParser() { }
+
+// part of the runtime-library?
+SbiSymDef* SbiParser::CheckRTLForSym(const OUString& rSym, SbxDataType eType)
+{
+ SbxVariable* pVar = GetBasic()->GetRtl()->Find(rSym, SbxClassType::DontCare);
+ if (!pVar)
+ return nullptr;
+
+ if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pVar))
+ {
+ SbiProcDef* pProc_ = aRtlSyms.AddProc( rSym );
+ if (pMethod->IsRuntimeFunction())
+ {
+ pProc_->SetType( pMethod->GetRuntimeFunctionReturnType() );
+ }
+ else
+ {
+ pProc_->SetType( pVar->GetType() );
+ }
+ return pProc_;
+ }
+
+
+ SbiSymDef* pDef = aRtlSyms.AddSym(rSym);
+ pDef->SetType(eType);
+ return pDef;
+}
+
+// close global chain
+
+bool SbiParser::HasGlobalCode()
+{
+ if( bGblDefs && nGblChain )
+ {
+ aGen.BackChain( nGblChain );
+ aGen.Gen( SbiOpcode::LEAVE_ );
+ nGblChain = 0;
+ }
+ return bGblDefs;
+}
+
+void SbiParser::OpenBlock( SbiToken eTok, SbiExprNode* pVar )
+{
+ SbiParseStack* p = new SbiParseStack;
+ p->eExitTok = eTok;
+ p->nChain = 0;
+ p->pWithVar = pWithVar;
+ p->pNext = pStack;
+ pStack = p;
+ pWithVar = pVar;
+
+ // #29955 service the for-loop level
+ if( eTok == FOR )
+ aGen.IncForLevel();
+}
+
+void SbiParser::CloseBlock()
+{
+ if( !pStack )
+ return;
+
+ SbiParseStack* p = pStack;
+
+ // #29955 service the for-loop level
+ if( p->eExitTok == FOR )
+ aGen.DecForLevel();
+
+ aGen.BackChain( p->nChain );
+ pStack = p->pNext;
+ pWithVar = p->pWithVar;
+ delete p;
+}
+
+// EXIT ...
+
+void SbiParser::Exit()
+{
+ SbiToken eTok = Next();
+ for( SbiParseStack* p = pStack; p; p = p->pNext )
+ {
+ SbiToken eExitTok = p->eExitTok;
+ if( eTok == eExitTok ||
+ (eTok == PROPERTY && (eExitTok == GET || eExitTok == LET) ) ) // #i109051
+ {
+ p->nChain = aGen.Gen( SbiOpcode::JUMP_, p->nChain );
+ return;
+ }
+ }
+ if( pStack )
+ Error( ERRCODE_BASIC_EXPECTED, pStack->eExitTok );
+ else
+ Error( ERRCODE_BASIC_BAD_EXIT );
+}
+
+bool SbiParser::TestSymbol()
+{
+ Peek();
+ if( eCurTok == SYMBOL )
+ {
+ Next(); return true;
+ }
+ Error( ERRCODE_BASIC_SYMBOL_EXPECTED );
+ return false;
+}
+
+
+bool SbiParser::TestToken( SbiToken t )
+{
+ if( Peek() == t )
+ {
+ Next(); return true;
+ }
+ else
+ {
+ Error( ERRCODE_BASIC_EXPECTED, t );
+ return false;
+ }
+}
+
+
+bool SbiParser::TestComma()
+{
+ SbiToken eTok = Peek();
+ if( IsEoln( eTok ) )
+ {
+ Next();
+ return false;
+ }
+ else if( eTok != COMMA )
+ {
+ Error( ERRCODE_BASIC_EXPECTED, COMMA );
+ return false;
+ }
+ Next();
+ return true;
+}
+
+
+void SbiParser::TestEoln()
+{
+ if( !IsEoln( Next() ) )
+ {
+ Error( ERRCODE_BASIC_EXPECTED, EOLN );
+ while( !IsEoln( Next() ) ) {}
+ }
+}
+
+
+void SbiParser::StmntBlock( SbiToken eEnd )
+{
+ SbiToken xe = eEndTok;
+ eEndTok = eEnd;
+ while( !bAbort && Parse() ) {}
+ eEndTok = xe;
+ if( IsEof() )
+ {
+ Error( ERRCODE_BASIC_BAD_BLOCK, eEnd );
+ bAbort = true;
+ }
+}
+
+void SbiParser::SetCodeCompleting( bool b )
+{
+ bCodeCompleting = b;
+}
+
+
+bool SbiParser::Parse()
+{
+ if( bAbort ) return false;
+
+ EnableErrors();
+
+ bErrorIsSymbol = false;
+ Peek();
+ bErrorIsSymbol = true;
+
+ if( IsEof() )
+ {
+ // AB #33133: If no sub has been created before,
+ // the global chain must be closed here!
+ // AB #40689: Due to the new static-handling there
+ // can be another nGblChain, so ask for it before.
+ if( bNewGblDefs && nGblChain == 0 )
+ nGblChain = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ return false;
+ }
+
+
+ if( IsEoln( eCurTok ) )
+ {
+ Next(); return true;
+ }
+
+ if( !bSingleLineIf && MayBeLabel( true ) )
+ {
+ // is a label
+ if( !pProc )
+ Error( ERRCODE_BASIC_NOT_IN_MAIN, aSym );
+ else
+ pProc->GetLabels().Define( aSym );
+ Next(); Peek();
+
+ if( IsEoln( eCurTok ) )
+ {
+ Next(); return true;
+ }
+ }
+
+ // end of parsing?
+ if( eCurTok == eEndTok ||
+ ( bVBASupportOn && // #i109075
+ (eCurTok == ENDFUNC || eCurTok == ENDPROPERTY || eCurTok == ENDSUB) &&
+ (eEndTok == ENDFUNC || eEndTok == ENDPROPERTY || eEndTok == ENDSUB) ) )
+ {
+ Next();
+ if( eCurTok != NIL )
+ aGen.Statement();
+ return false;
+ }
+
+ // comment?
+ if( eCurTok == REM )
+ {
+ Next(); return true;
+ }
+
+ // In vba it's possible to do Error.foobar ( even if it results in
+ // a runtime error
+ if ( eCurTok == ERROR_ && IsVBASupportOn() ) // we probably need to define a subset of keywords where this madness applies e.g. if ( IsVBASupportOn() && SymbolCanBeRedined( eCurTok ) )
+ {
+ SbiTokenizer tokens( *this );
+ tokens.Next();
+ if ( tokens.Peek() == DOT )
+ {
+ eCurTok = SYMBOL;
+ ePush = eCurTok;
+ }
+ }
+ // if there's a symbol, it's either a variable (LET)
+ // or a SUB-procedure (CALL without brackets)
+ // DOT for assignments in the WITH-block: .A=5
+ if( eCurTok == SYMBOL || eCurTok == DOT )
+ {
+ if( !pProc )
+ Error( ERRCODE_BASIC_EXPECTED, SUB );
+ else
+ {
+ // for correct line and column...
+ Next();
+ Push( eCurTok );
+ aGen.Statement();
+ Symbol(nullptr);
+ }
+ }
+ else
+ {
+ Next();
+
+ // statement parsers
+
+ const SbiStatement* p;
+ for( p = StmntTable; p->eTok != NIL; p++ )
+ if( p->eTok == eCurTok )
+ break;
+ if( p->eTok != NIL )
+ {
+ if( !pProc && !p->bMain )
+ Error( ERRCODE_BASIC_NOT_IN_MAIN, eCurTok );
+ else if( pProc && !p->bSubr )
+ Error( ERRCODE_BASIC_NOT_IN_SUBR, eCurTok );
+ else
+ {
+ // AB #41606/#40689: Due to the new static-handling there
+ // can be another nGblChain, so ask for it before.
+ if( bNewGblDefs && nGblChain == 0 &&
+ ( eCurTok == SUB || eCurTok == FUNCTION || eCurTok == PROPERTY ) )
+ {
+ nGblChain = aGen.Gen( SbiOpcode::JUMP_, 0 );
+ bNewGblDefs = false;
+ }
+ // statement-opcode at the beginning of a sub, too, please
+ if( ( p->bSubr && (eCurTok != STATIC || Peek() == SUB || Peek() == FUNCTION ) ) ||
+ eCurTok == SUB || eCurTok == FUNCTION )
+ aGen.Statement();
+ (this->*( p->Func ) )();
+ ErrCode nSbxErr = SbxBase::GetError();
+ if( nSbxErr )
+ {
+ SbxBase::ResetError();
+ Error( nSbxErr );
+ }
+ }
+ }
+ else
+ Error( ERRCODE_BASIC_UNEXPECTED, eCurTok );
+ }
+
+ // test for the statement's end -
+ // might also be an ELSE, as there must not necessary be a : before the ELSE!
+
+ if( !IsEos() )
+ {
+ Peek();
+ if( !IsEos() && eCurTok != ELSE )
+ {
+ // if the parsing has been aborted, jump over to the ":"
+ Error( ERRCODE_BASIC_UNEXPECTED, eCurTok );
+ while( !IsEos() ) Next();
+ }
+ }
+ // The parser aborts at the end, the
+ // next token has not been fetched yet!
+ return true;
+}
+
+
+SbiExprNode* SbiParser::GetWithVar()
+{
+ if( pWithVar )
+ return pWithVar;
+
+ SbiParseStack* p = pStack;
+ while( p )
+ {
+ // LoopVar can at the moment only be for with
+ if( p->pWithVar )
+ return p->pWithVar;
+ p = p->pNext;
+ }
+ return nullptr;
+}
+
+
+// assignment or subroutine call
+
+void SbiParser::Symbol( const KeywordSymbolInfo* pKeywordSymbolInfo )
+{
+ SbiExprMode eMode = bVBASupportOn ? EXPRMODE_STANDALONE : EXPRMODE_STANDARD;
+ SbiExpression aVar( this, SbSYMBOL, eMode, pKeywordSymbolInfo );
+
+ bool bEQ = ( Peek() == EQ );
+ if( !bEQ && bVBASupportOn && aVar.IsBracket() )
+ Error( ERRCODE_BASIC_EXPECTED, "=" );
+
+ RecursiveMode eRecMode = ( bEQ ? PREVENT_CALL : FORCE_CALL );
+ bool bSpecialMidHandling = false;
+ SbiSymDef* pDef = aVar.GetRealVar();
+ if( bEQ && pDef && pDef->GetScope() == SbRTL )
+ {
+ OUString aRtlName = pDef->GetName();
+ if( aRtlName.equalsIgnoreAsciiCase("Mid") )
+ {
+ SbiExprNode* pExprNode = aVar.GetExprNode();
+ if( pExprNode && pExprNode->GetNodeType() == SbxVARVAL )
+ {
+ SbiExprList* pPar = pExprNode->GetParameters();
+ short nParCount = pPar ? pPar->GetSize() : 0;
+ if( nParCount == 2 || nParCount == 3 )
+ {
+ if( nParCount == 2 )
+ pPar->addExpression( std::make_unique<SbiExpression>( this, -1, SbxLONG ) );
+
+ TestToken( EQ );
+ pPar->addExpression( std::make_unique<SbiExpression>( this ) );
+
+ bSpecialMidHandling = true;
+ }
+ }
+ }
+ }
+ aVar.Gen( eRecMode );
+ if( bSpecialMidHandling )
+ return;
+
+ if( !bEQ )
+ {
+ aGen.Gen( SbiOpcode::GET_ );
+ }
+ else
+ {
+ // so it must be an assignment!
+ if( !aVar.IsLvalue() )
+ Error( ERRCODE_BASIC_LVALUE_EXPECTED );
+ TestToken( EQ );
+ SbiExpression aExpr( this );
+ aExpr.Gen();
+ SbiOpcode eOp = SbiOpcode::PUT_;
+ if( pDef )
+ {
+ if( pDef->GetConstDef() )
+ Error( ERRCODE_BASIC_DUPLICATE_DEF, pDef->GetName() );
+ if( pDef->GetType() == SbxOBJECT )
+ {
+ eOp = SbiOpcode::SET_;
+ if( pDef->GetTypeId() )
+ {
+ aGen.Gen( SbiOpcode::SETCLASS_, pDef->GetTypeId() );
+ return;
+ }
+ }
+ }
+ aGen.Gen( eOp );
+ }
+}
+
+
+void SbiParser::Assign()
+{
+ SbiExpression aLvalue( this, SbLVALUE );
+ TestToken( EQ );
+ SbiExpression aExpr( this );
+ aLvalue.Gen();
+ aExpr.Gen();
+ sal_uInt16 nLen = 0;
+ SbiSymDef* pDef = aLvalue.GetRealVar();
+ {
+ if( pDef->GetConstDef() )
+ Error( ERRCODE_BASIC_DUPLICATE_DEF, pDef->GetName() );
+ nLen = aLvalue.GetRealVar()->GetLen();
+ }
+ if( nLen )
+ aGen.Gen( SbiOpcode::PAD_, nLen );
+ aGen.Gen( SbiOpcode::PUT_ );
+}
+
+// assignments of an object-variable
+
+void SbiParser::Set()
+{
+ SbiExpression aLvalue( this, SbLVALUE );
+ SbxDataType eType = aLvalue.GetType();
+ if( eType != SbxOBJECT && eType != SbxEMPTY && eType != SbxVARIANT )
+ Error( ERRCODE_BASIC_INVALID_OBJECT );
+ TestToken( EQ );
+ SbiSymDef* pDef = aLvalue.GetRealVar();
+ if( pDef->GetConstDef() )
+ Error( ERRCODE_BASIC_DUPLICATE_DEF, pDef->GetName() );
+
+ SbiToken eTok = Peek();
+ if( eTok == NEW )
+ {
+ Next();
+ auto pTypeDef = std::make_unique<SbiSymDef>( OUString() );
+ TypeDecl( *pTypeDef, true );
+
+ aLvalue.Gen();
+ aGen.Gen( SbiOpcode::CREATE_, pDef->GetId(), pTypeDef->GetTypeId() );
+ aGen.Gen( SbiOpcode::SETCLASS_, pDef->GetTypeId() );
+ }
+ else
+ {
+ SbiExpression aExpr( this );
+ aLvalue.Gen();
+ aExpr.Gen();
+ // It's a good idea to distinguish between
+ // set something = another &
+ // something = another
+ // ( it's necessary for vba objects where set is object
+ // specific and also doesn't involve processing default params )
+ if( pDef->GetTypeId() )
+ {
+ if ( bVBASupportOn )
+ aGen.Gen( SbiOpcode::VBASETCLASS_, pDef->GetTypeId() );
+ else
+ aGen.Gen( SbiOpcode::SETCLASS_, pDef->GetTypeId() );
+ }
+ else
+ {
+ if ( bVBASupportOn )
+ aGen.Gen( SbiOpcode::VBASET_ );
+ else
+ aGen.Gen( SbiOpcode::SET_ );
+ }
+ }
+}
+
+// JSM 07.10.95
+void SbiParser::LSet()
+{
+ SbiExpression aLvalue( this, SbLVALUE );
+ if( aLvalue.GetType() != SbxSTRING )
+ {
+ Error( ERRCODE_BASIC_INVALID_OBJECT );
+ }
+ TestToken( EQ );
+ SbiSymDef* pDef = aLvalue.GetRealVar();
+ if( pDef && pDef->GetConstDef() )
+ {
+ Error( ERRCODE_BASIC_DUPLICATE_DEF, pDef->GetName() );
+ }
+ SbiExpression aExpr( this );
+ aLvalue.Gen();
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::LSET_ );
+}
+
+// JSM 07.10.95
+void SbiParser::RSet()
+{
+ SbiExpression aLvalue( this, SbLVALUE );
+ if( aLvalue.GetType() != SbxSTRING )
+ {
+ Error( ERRCODE_BASIC_INVALID_OBJECT );
+ }
+ TestToken( EQ );
+ SbiSymDef* pDef = aLvalue.GetRealVar();
+ if( pDef && pDef->GetConstDef() )
+ Error( ERRCODE_BASIC_DUPLICATE_DEF, pDef->GetName() );
+ SbiExpression aExpr( this );
+ aLvalue.Gen();
+ aExpr.Gen();
+ aGen.Gen( SbiOpcode::RSET_ );
+}
+
+// DEFINT, DEFLNG, DEFSNG, DEFDBL, DEFSTR and so on
+
+void SbiParser::DefXXX()
+{
+ sal_Unicode ch1, ch2;
+ SbxDataType t = SbxDataType( eCurTok - DEFINT + SbxINTEGER );
+
+ while( !bAbort )
+ {
+ if( Next() != SYMBOL ) break;
+ ch1 = rtl::toAsciiUpperCase(aSym[0]);
+ ch2 = 0;
+ if( Peek() == MINUS )
+ {
+ Next();
+ if( Next() != SYMBOL ) Error( ERRCODE_BASIC_SYMBOL_EXPECTED );
+ else
+ {
+ ch2 = rtl::toAsciiUpperCase(aSym[0]);
+ if( ch2 < ch1 )
+ {
+ Error( ERRCODE_BASIC_SYNTAX );
+ ch2 = 0;
+ }
+ }
+ }
+ if (!ch2) ch2 = ch1;
+ ch1 -= 'A'; ch2 -= 'A';
+ for (; ch1 <= ch2; ch1++) eDefTypes[ ch1 ] = t;
+ if( !TestComma() ) break;
+ }
+}
+
+// STOP/SYSTEM
+
+void SbiParser::Stop()
+{
+ aGen.Gen( SbiOpcode::STOP_ );
+ Peek(); // #35694: only Peek(), so that EOL is recognized in Single-Line-If
+}
+
+// IMPLEMENTS
+
+void SbiParser::Implements()
+{
+ if( !bClassModule )
+ {
+ Error( ERRCODE_BASIC_UNEXPECTED, IMPLEMENTS );
+ return;
+ }
+
+ Peek();
+ if( eCurTok != SYMBOL )
+ {
+ Error( ERRCODE_BASIC_SYMBOL_EXPECTED );
+ return;
+ }
+
+ OUString aImplementedIface = aSym;
+ Next();
+ if( Peek() == DOT )
+ {
+ OUString aDotStr( '.' );
+ while( Peek() == DOT )
+ {
+ aImplementedIface += aDotStr;
+ Next();
+ SbiToken ePeekTok = Peek();
+ if( ePeekTok == SYMBOL || IsKwd( ePeekTok ) )
+ {
+ Next();
+ aImplementedIface += aSym;
+ }
+ else
+ {
+ Next();
+ Error( ERRCODE_BASIC_SYMBOL_EXPECTED );
+ break;
+ }
+ }
+ }
+ aIfaceVector.push_back( aImplementedIface );
+}
+
+void SbiParser::EnableCompatibility()
+{
+ if( !bCompatible )
+ AddConstants();
+ bCompatible = true;
+}
+
+// OPTION
+
+void SbiParser::Option()
+{
+ switch( Next() )
+ {
+ case BASIC_EXPLICIT:
+ bExplicit = true; break;
+ case BASE:
+ if( Next() == NUMBER && ( nVal == 0 || nVal == 1 ) )
+ {
+ nBase = static_cast<short>(nVal);
+ break;
+ }
+ Error( ERRCODE_BASIC_EXPECTED, "0/1" );
+ break;
+ case PRIVATE:
+ {
+ OUString aString = SbiTokenizer::Symbol(Next());
+ if( !aString.equalsIgnoreAsciiCase("Module") )
+ {
+ Error( ERRCODE_BASIC_EXPECTED, "Module" );
+ }
+ break;
+ }
+ case COMPARE:
+ {
+ SbiToken eTok = Next();
+ if( eTok == BINARY )
+ {
+ }
+ else if( eTok == SYMBOL && GetSym().equalsIgnoreAsciiCase("text") )
+ {
+ }
+ else
+ {
+ Error( ERRCODE_BASIC_EXPECTED, "Text/Binary" );
+ }
+ break;
+ }
+ case COMPATIBLE:
+ EnableCompatibility();
+ break;
+
+ case CLASSMODULE:
+ bClassModule = true;
+ aGen.GetModule().SetModuleType( css::script::ModuleType::CLASS );
+ break;
+ case VBASUPPORT: // Option VBASupport used to override the module mode ( in fact this must reset the mode
+ if( Next() == NUMBER )
+ {
+ if ( nVal == 1 || nVal == 0 )
+ {
+ bVBASupportOn = ( nVal == 1 );
+ if ( bVBASupportOn )
+ {
+ EnableCompatibility();
+ }
+ // if the module setting is different
+ // reset it to what the Option tells us
+ if ( bVBASupportOn != aGen.GetModule().IsVBACompat() )
+ {
+ aGen.GetModule().SetVBACompat( bVBASupportOn );
+ }
+ break;
+ }
+ }
+ Error( ERRCODE_BASIC_EXPECTED, "0/1" );
+ break;
+ default:
+ Error( ERRCODE_BASIC_BAD_OPTION, eCurTok );
+ }
+}
+
+static void addStringConst( SbiSymPool& rPool, const OUString& pSym, const OUString& rStr )
+{
+ SbiConstDef* pConst = new SbiConstDef( pSym );
+ pConst->SetType( SbxSTRING );
+ pConst->Set( rStr );
+ rPool.Add( pConst );
+}
+
+void SbiParser::AddConstants()
+{
+ // #113063 Create constant RTL symbols
+ addStringConst( aPublics, "vbCr", "\x0D" );
+ addStringConst( aPublics, "vbCrLf", "\x0D\x0A" );
+ addStringConst( aPublics, "vbFormFeed", "\x0C" );
+ addStringConst( aPublics, "vbLf", "\x0A" );
+#ifdef _WIN32
+ addStringConst( aPublics, "vbNewLine", "\x0D\x0A" );
+#else
+ addStringConst( aPublics, "vbNewLine", "\x0A" );
+#endif
+ addStringConst( aPublics, "vbNullString", "" );
+ addStringConst( aPublics, "vbTab", "\x09" );
+ addStringConst( aPublics, "vbVerticalTab", "\x0B" );
+
+ // Force length 1 and make char 0 afterwards
+ OUString aNullCharStr(u'\0');
+ addStringConst( aPublics, "vbNullChar", aNullCharStr );
+}
+
+// ERROR n
+
+void SbiParser::ErrorStmnt()
+{
+ SbiExpression aPar( this );
+ aPar.Gen();
+ aGen.Gen( SbiOpcode::ERROR_ );
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/sbcomp.cxx b/basic/source/comp/sbcomp.cxx
new file mode 100644
index 000000000..bc8db7e34
--- /dev/null
+++ b/basic/source/comp/sbcomp.cxx
@@ -0,0 +1,85 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <basic/sbmeth.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/sbx.hxx>
+#include <parser.hxx>
+#include <image.hxx>
+#include <sbintern.hxx>
+#include <sbobjmod.hxx>
+#include <memory>
+
+// This routine is defined here, so that the
+// compiler can be loaded as a discrete segment.
+
+bool SbModule::Compile()
+{
+ if( pImage )
+ return true;
+ StarBASIC* pBasic = dynamic_cast<StarBASIC*>( GetParent() );
+ if( !pBasic )
+ return false;
+ SbxBase::ResetError();
+
+ SbModule* pOld = GetSbData()->pCompMod;
+ GetSbData()->pCompMod = this;
+
+ auto pParser = std::make_unique<SbiParser>( pBasic, this );
+ while( pParser->Parse() ) {}
+ if( !pParser->GetErrors() )
+ pParser->aGen.Save();
+ pParser.reset();
+ // for the disassembler
+ if( pImage )
+ pImage->aOUSource = aOUSource;
+
+ GetSbData()->pCompMod = pOld;
+
+ // compiling a module, the module-global
+ // variables of all modules become invalid
+ bool bRet = IsCompiled();
+ if( bRet )
+ {
+ if( dynamic_cast<const SbObjModule*>( this) == nullptr )
+ pBasic->ClearAllModuleVars();
+ RemoveVars(); // remove 'this' Modules variables
+ // clear all method statics
+ for( sal_uInt32 i = 0; i < pMethods->Count32(); i++ )
+ {
+ SbMethod* p = dynamic_cast<SbMethod*>( pMethods->Get32( i ) );
+ if( p )
+ p->ClearStatics();
+ }
+
+ // #i31510 Init other libs only if Basic isn't running
+ if( GetSbData()->pInst == nullptr )
+ {
+ SbxObject* pParent_ = pBasic->GetParent();
+ if( pParent_ )
+ pBasic = dynamic_cast<StarBASIC*>( pParent_ );
+ if( pBasic )
+ pBasic->ClearAllModuleVars();
+ }
+ }
+
+ return bRet;
+}
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/scanner.cxx b/basic/source/comp/scanner.cxx
new file mode 100644
index 000000000..0647a72ed
--- /dev/null
+++ b/basic/source/comp/scanner.cxx
@@ -0,0 +1,712 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basiccharclass.hxx>
+#include <scanner.hxx>
+#include <sbintern.hxx>
+#include <runtime.hxx>
+
+#include <basic/sberrors.hxx>
+#include <i18nlangtag/lang.h>
+#include <svl/zforlist.hxx>
+#include <rtl/character.hxx>
+
+SbiScanner::SbiScanner( const OUString& rBuf, StarBASIC* p ) : aBuf( rBuf )
+{
+ pBasic = p;
+ nLineIdx = -1;
+ nVal = 0;
+ eScanType = SbxVARIANT;
+ nErrors = 0;
+ nBufPos = 0;
+ nSavedCol1 = 0;
+ nColLock = 0;
+ nLine = 0;
+ nCol1 = 0;
+ nCol2 = 0;
+ nCol = 0;
+ bError =
+ bAbort =
+ bSpaces =
+ bNumber =
+ bSymbol =
+ bCompatible =
+ bVBASupportOn =
+ bInStatement =
+ bPrevLineExtentsComment = false;
+ bHash = true;
+ nSaveLineIdx = -1;
+}
+
+void SbiScanner::LockColumn()
+{
+ if( !nColLock++ )
+ nSavedCol1 = nCol1;
+}
+
+void SbiScanner::UnlockColumn()
+{
+ if( nColLock )
+ nColLock--;
+}
+
+void SbiScanner::GenError( ErrCode code )
+{
+ if( GetSbData()->bBlockCompilerError )
+ {
+ bAbort = true;
+ return;
+ }
+ if( !bError )
+ {
+ bool bRes = true;
+ // report only one error per statement
+ bError = true;
+ if( pBasic )
+ {
+ // in case of EXPECTED or UNEXPECTED it always refers
+ // to the last token, so take the Col1 over
+ sal_Int32 nc = nColLock ? nSavedCol1 : nCol1;
+ if ( code.anyOf(
+ ERRCODE_BASIC_EXPECTED,
+ ERRCODE_BASIC_UNEXPECTED,
+ ERRCODE_BASIC_SYMBOL_EXPECTED,
+ ERRCODE_BASIC_LABEL_EXPECTED) )
+ {
+ nc = nCol1;
+ if( nc > nCol2 ) nCol2 = nc;
+ }
+ bRes = pBasic->CError( code, aError, nLine, nc, nCol2 );
+ }
+ bAbort = bAbort || !bRes || ( code == ERRCODE_BASIC_NO_MEMORY || code == ERRCODE_BASIC_PROG_TOO_LARGE );
+ }
+ nErrors++;
+}
+
+
+// used by SbiTokenizer::MayBeLabel() to detect a label
+bool SbiScanner::DoesColonFollow()
+{
+ if(nCol < aLine.getLength() && aLine[nCol] == ':')
+ {
+ ++nLineIdx; ++nCol;
+ return true;
+ }
+ else
+ return false;
+}
+
+// test for legal suffix
+static SbxDataType GetSuffixType( sal_Unicode c )
+{
+ switch (c)
+ {
+ case '%':
+ return SbxINTEGER;
+ case '&':
+ return SbxLONG;
+ case '!':
+ return SbxSINGLE;
+ case '#':
+ return SbxDOUBLE;
+ case '@':
+ return SbxCURRENCY;
+ case '$':
+ return SbxSTRING;
+ default:
+ return SbxVARIANT;
+ }
+}
+
+// reading the next symbol into the variables aSym, nVal and eType
+// return value is sal_False at EOF or errors
+#define BUF_SIZE 80
+
+void SbiScanner::scanAlphanumeric()
+{
+ sal_Int32 n = nCol;
+ while(nCol < aLine.getLength() && (BasicCharClass::isAlphaNumeric(aLine[nCol], bCompatible) || aLine[nCol] == '_'))
+ {
+ ++nLineIdx;
+ ++nCol;
+ }
+ aSym = aLine.copy(n, nCol - n);
+}
+
+void SbiScanner::scanGoto()
+{
+ sal_Int32 n = nCol;
+ while(n < aLine.getLength() && BasicCharClass::isWhitespace(aLine[n]))
+ ++n;
+
+ if(n + 1 < aLine.getLength())
+ {
+ OUString aTemp = aLine.copy(n, 2);
+ if(aTemp.equalsIgnoreAsciiCase("to"))
+ {
+ aSym = "goto";
+ nLineIdx += n + 2 - nCol;
+ nCol = n + 2;
+ }
+ }
+}
+
+bool SbiScanner::readLine()
+{
+ if(nBufPos >= aBuf.getLength())
+ return false;
+
+ sal_Int32 n = nBufPos;
+ sal_Int32 nLen = aBuf.getLength();
+
+ while(n < nLen && aBuf[n] != '\r' && aBuf[n] != '\n')
+ ++n;
+
+ // Trim trailing whitespace
+ sal_Int32 nEnd = n;
+ while(nBufPos < nEnd && BasicCharClass::isWhitespace(aBuf[nEnd - 1]))
+ --nEnd;
+
+ aLine = aBuf.copy(nBufPos, nEnd - nBufPos);
+
+ // Fast-forward past the line ending
+ if(n + 1 < nLen && aBuf[n] == '\r' && aBuf[n + 1] == '\n')
+ n += 2;
+ else if(n < nLen)
+ ++n;
+
+ nBufPos = n;
+ nLineIdx = 0;
+
+ ++nLine;
+ nCol = nCol1 = nCol2 = 0;
+ nColLock = 0;
+
+ return true;
+}
+
+bool SbiScanner::NextSym()
+{
+ // memorize for the EOLN-case
+ sal_Int32 nOldLine = nLine;
+ sal_Int32 nOldCol1 = nCol1;
+ sal_Int32 nOldCol2 = nCol2;
+ sal_Unicode buf[ BUF_SIZE ], *p = buf;
+
+ eScanType = SbxVARIANT;
+ aSym.clear();
+ bHash = bSymbol = bNumber = bSpaces = false;
+ bool bCompilerDirective = false;
+
+ // read in line?
+ if (nLineIdx == -1)
+ {
+ if(!readLine())
+ return false;
+
+ nOldLine = nLine;
+ nOldCol1 = nOldCol2 = 0;
+ }
+
+ const sal_Int32 nLineIdxScanStart = nLineIdx;
+
+ if(nCol < aLine.getLength() && BasicCharClass::isWhitespace(aLine[nCol]))
+ {
+ bSpaces = true;
+ while(nCol < aLine.getLength() && BasicCharClass::isWhitespace(aLine[nCol]))
+ {
+ ++nLineIdx;
+ ++nCol;
+ }
+ }
+
+ nCol1 = nCol;
+
+ // only blank line?
+ if(nCol >= aLine.getLength())
+ goto eoln;
+
+ if( bPrevLineExtentsComment )
+ goto PrevLineCommentLbl;
+
+ if(nCol < aLine.getLength() && aLine[nCol] == '#')
+ {
+ sal_Int32 nLineTempIdx = nLineIdx;
+ do
+ {
+ nLineTempIdx++;
+ } while (nLineTempIdx < aLine.getLength() && !BasicCharClass::isWhitespace(aLine[nLineTempIdx])
+ && aLine[nLineTempIdx] != '#' && aLine[nLineTempIdx] != ',');
+ // leave it if it is a date literal - it will be handled later
+ if (nLineTempIdx >= aLine.getLength() || aLine[nLineTempIdx] != '#')
+ {
+ ++nLineIdx;
+ ++nCol;
+ //ignore compiler directives (# is first non-space character)
+ if (nOldCol2 == 0)
+ bCompilerDirective = true;
+ else
+ bHash = true;
+ }
+ }
+
+ // copy character if symbol
+ if(nCol < aLine.getLength() && (BasicCharClass::isAlpha(aLine[nCol], bCompatible) || aLine[nCol] == '_'))
+ {
+ // if there's nothing behind '_' , it's the end of a line!
+ if(nCol + 1 == aLine.getLength() && aLine[nCol] == '_')
+ {
+ // Note that nCol is not incremented here...
+ ++nLineIdx;
+ goto eoln;
+ }
+
+ bSymbol = true;
+
+ scanAlphanumeric();
+
+ // Special handling for "go to"
+ if(nCol < aLine.getLength() && bCompatible && aSym.equalsIgnoreAsciiCase("go"))
+ scanGoto();
+
+ // replace closing '_' by space when end of line is following
+ // (wrong line continuation otherwise)
+ if (nCol == aLine.getLength() && aLine[nCol - 1] == '_')
+ {
+ // We are going to modify a potentially shared string, so force
+ // a copy, so that aSym is not modified by the following operation
+ OUString aSymCopy( aSym.getStr(), aSym.getLength() );
+ aSym = aSymCopy;
+
+ // HACK: modifying a potentially shared string here!
+ const_cast<sal_Unicode*>(aLine.getStr())[nLineIdx - 1] = ' ';
+ }
+
+ // type recognition?
+ // don't test the exclamation mark
+ // if there's a symbol behind it
+ else if((nCol >= aLine.getLength() || aLine[nCol] != '!') ||
+ (nCol + 1 >= aLine.getLength() || !BasicCharClass::isAlpha(aLine[nCol + 1], bCompatible)))
+ {
+ if(nCol < aLine.getLength())
+ {
+ SbxDataType t(GetSuffixType(aLine[nCol]));
+ if( t != SbxVARIANT )
+ {
+ eScanType = t;
+ ++nLineIdx;
+ ++nCol;
+ }
+ }
+ }
+ }
+
+ // read in and convert if number
+ else if((nCol < aLine.getLength() && rtl::isAsciiDigit(aLine[nCol])) ||
+ (nCol + 1 < aLine.getLength() && aLine[nCol] == '.' && rtl::isAsciiDigit(aLine[nCol + 1])))
+ {
+ short exp = 0;
+ short dec = 0;
+ eScanType = SbxDOUBLE;
+ bool bScanError = false;
+ bool bBufOverflow = false;
+ // All this because of 'D' or 'd' floating point type, sigh...
+ while(!bScanError && nCol < aLine.getLength() && strchr("0123456789.DEde", aLine[nCol]))
+ {
+ // from 4.1.1996: buffer full? -> go on scanning empty
+ if( (p-buf) == (BUF_SIZE-1) )
+ {
+ bBufOverflow = true;
+ ++nLineIdx;
+ ++nCol;
+ continue;
+ }
+ // point or exponent?
+ if(aLine[nCol] == '.')
+ {
+ if( ++dec > 1 )
+ bScanError = true;
+ else
+ *p++ = '.';
+ }
+ else if(strchr("DdEe", aLine[nCol]))
+ {
+ if (++exp > 1)
+ bScanError = true;
+ else
+ {
+ *p++ = 'E';
+ if (nCol + 1 < aLine.getLength() && (aLine[nCol+1] == '+' || aLine[nCol+1] == '-'))
+ {
+ ++nLineIdx;
+ ++nCol;
+ if( (p-buf) == (BUF_SIZE-1) )
+ {
+ bBufOverflow = true;
+ continue;
+ }
+ *p++ = aLine[nCol];
+ }
+ }
+ }
+ else
+ {
+ *p++ = aLine[nCol];
+ }
+ ++nLineIdx;
+ ++nCol;
+ }
+ *p = 0;
+ aSym = p; bNumber = true;
+
+ // For bad characters, scan and parse errors generate only one error.
+ ErrCode nError = ERRCODE_NONE;
+ if (bScanError)
+ {
+ --nLineIdx;
+ --nCol;
+ aError = OUString( aLine[nCol]);
+ nError = ERRCODE_BASIC_BAD_CHAR_IN_NUMBER;
+ }
+
+ rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok;
+ const sal_Unicode* pParseEnd = buf;
+ nVal = rtl_math_uStringToDouble( buf, buf+(p-buf), '.', ',', &eStatus, &pParseEnd );
+ if (pParseEnd != buf+(p-buf))
+ {
+ // e.g. "12e" or "12e+", or with bScanError "12d"+"E".
+ sal_Int32 nChars = buf+(p-buf) - pParseEnd;
+ nLineIdx -= nChars;
+ nCol -= nChars;
+ // For bScanError, nLineIdx and nCol were already decremented, just
+ // add that character to the parse end.
+ if (bScanError)
+ ++nChars;
+ // Copy error position from original string, not the buffer
+ // replacement where "12dE" => "12EE".
+ aError = aLine.copy( nCol, nChars);
+ nError = ERRCODE_BASIC_BAD_CHAR_IN_NUMBER;
+ }
+ else if (eStatus != rtl_math_ConversionStatus_Ok)
+ {
+ // Keep the scan error and character at position, if any.
+ if (!nError)
+ nError = ERRCODE_BASIC_MATH_OVERFLOW;
+ }
+
+ if (nError)
+ GenError( nError );
+
+ if( !dec && !exp )
+ {
+ if( nVal >= SbxMININT && nVal <= SbxMAXINT )
+ eScanType = SbxINTEGER;
+ else if( nVal >= SbxMINLNG && nVal <= SbxMAXLNG )
+ eScanType = SbxLONG;
+ }
+
+ if( bBufOverflow )
+ GenError( ERRCODE_BASIC_MATH_OVERFLOW );
+
+ // type recognition?
+ if( nCol < aLine.getLength() )
+ {
+ SbxDataType t(GetSuffixType(aLine[nCol]));
+ if( t != SbxVARIANT )
+ {
+ eScanType = t;
+ ++nLineIdx;
+ ++nCol;
+ }
+ // tdf#130476 - don't allow String trailing data type character with numbers
+ if ( t == SbxSTRING )
+ {
+ GenError( ERRCODE_BASIC_SYNTAX );
+ }
+ }
+ }
+
+ // Hex/octal number? Read in and convert:
+ else if(aLine.getLength() - nCol > 1 && aLine[nCol] == '&')
+ {
+ ++nLineIdx; ++nCol;
+ sal_Unicode base = 16;
+ sal_Unicode xch = aLine[nCol];
+ ++nLineIdx; ++nCol;
+ switch( rtl::toAsciiUpperCase( xch ) )
+ {
+ case 'O':
+ base = 8;
+ break;
+ case 'H':
+ break;
+ default :
+ // treated as an operator
+ --nLineIdx; --nCol; nCol1 = nCol-1;
+ aSym = "&";
+ return true;
+ }
+ bNumber = true;
+ // Hex literals are signed Integers ( as defined by basic
+ // e.g. -2,147,483,648 through 2,147,483,647 (signed)
+ sal_uInt64 lu = 0;
+ bool bOverflow = false;
+ while(nCol < aLine.getLength() && BasicCharClass::isAlphaNumeric(aLine[nCol], false))
+ {
+ sal_Unicode ch = rtl::toAsciiUpperCase(aLine[nCol]);
+ ++nLineIdx; ++nCol;
+ if( ((base == 16 ) && rtl::isAsciiHexDigit( ch ) ) ||
+ ((base == 8) && rtl::isAsciiOctalDigit( ch )))
+ {
+ int i = ch - '0';
+ if( i > 9 ) i -= 7;
+ lu = ( lu * base ) + i;
+ if( lu > SAL_MAX_UINT32 )
+ {
+ bOverflow = true;
+ }
+ }
+ else
+ {
+ aError = OUString(ch);
+ GenError( ERRCODE_BASIC_BAD_CHAR_IN_NUMBER );
+ }
+ }
+
+ // tdf#130476 - take into account trailing data type characters
+ if( nCol < aLine.getLength() )
+ {
+ SbxDataType t(GetSuffixType(aLine[nCol]));
+ if( t != SbxVARIANT )
+ {
+ eScanType = t;
+ ++nLineIdx;
+ ++nCol;
+ }
+ // tdf#130476 - don't allow String trailing data type character with numbers
+ if ( t == SbxSTRING )
+ {
+ GenError( ERRCODE_BASIC_SYNTAX );
+ }
+ }
+
+ // tdf#130476 - take into account trailing data type characters
+ switch ( eScanType )
+ {
+ case SbxINTEGER:
+ nVal = static_cast<double>( static_cast<sal_Int16>(lu) );
+ if ( lu > SbxMAXUINT )
+ {
+ bOverflow = true;
+ }
+ break;
+ case SbxLONG: nVal = static_cast<double>( static_cast<sal_Int32>(lu) ); break;
+ case SbxVARIANT:
+ {
+ // tdf#62326 - If the value of the hex string without explicit type character lies within
+ // the range of 0x8000 (SbxMAXINT + 1) and 0xFFFF (SbxMAXUINT) inclusive, cast the value
+ // to 16 bit in order to get signed integers, e.g., SbxMININT through SbxMAXINT
+ sal_Int32 ls = (lu > SbxMAXINT && lu <= SbxMAXUINT) ? static_cast<sal_Int16>(lu) : static_cast<sal_Int32>(lu);
+ eScanType = ( ls >= SbxMININT && ls <= SbxMAXINT ) ? SbxINTEGER : SbxLONG;
+ nVal = static_cast<double>(ls);
+ break;
+ }
+ default:
+ nVal = static_cast<double>(lu);
+ break;
+ }
+ if( bOverflow )
+ GenError( ERRCODE_BASIC_MATH_OVERFLOW );
+ }
+
+ // Strings:
+ else if (nLineIdx < aLine.getLength() && (aLine[nLineIdx] == '"' || aLine[nLineIdx] == '['))
+ {
+ sal_Unicode cSep = aLine[nLineIdx];
+ if( cSep == '[' )
+ {
+ bSymbol = true;
+ cSep = ']';
+ }
+ sal_Int32 n = nCol + 1;
+ while (nLineIdx < aLine.getLength())
+ {
+ do
+ {
+ nLineIdx++;
+ nCol++;
+ }
+ while (nLineIdx < aLine.getLength() && (aLine[nLineIdx] != cSep));
+ if (nLineIdx < aLine.getLength() && aLine[nLineIdx] == cSep)
+ {
+ nLineIdx++; nCol++;
+ if (nLineIdx >= aLine.getLength() || aLine[nLineIdx] != cSep || cSep == ']')
+ {
+ // If VBA Interop then doesn't eat the [] chars
+ if ( cSep == ']' && bVBASupportOn )
+ aSym = aLine.copy( n - 1, nCol - n + 1);
+ else
+ aSym = aLine.copy( n, nCol - n - 1 );
+ // get out duplicate string delimiters
+ OUStringBuffer aSymBuf(aSym.getLength());
+ for ( sal_Int32 i = 0, len = aSym.getLength(); i < len; ++i )
+ {
+ aSymBuf.append( aSym[i] );
+ if ( aSym[i] == cSep && ( i+1 < len ) && aSym[i+1] == cSep )
+ ++i;
+ }
+ aSym = aSymBuf.makeStringAndClear();
+ if( cSep != ']' )
+ eScanType = SbxSTRING;
+ break;
+ }
+ }
+ else
+ {
+ aError = OUString(cSep);
+ GenError( ERRCODE_BASIC_EXPECTED );
+ }
+ }
+ }
+
+ // Date:
+ else if (nLineIdx < aLine.getLength() && aLine[nLineIdx] == '#')
+ {
+ sal_Int32 n = nCol + 1;
+ do
+ {
+ nLineIdx++;
+ nCol++;
+ }
+ while (nLineIdx < aLine.getLength() && (aLine[nLineIdx] != '#'));
+ if (nLineIdx < aLine.getLength() && aLine[nLineIdx] == '#')
+ {
+ nLineIdx++; nCol++;
+ aSym = aLine.copy( n, nCol - n - 1 );
+
+ // parse date literal
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ if (GetSbData()->pInst)
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ }
+ else
+ {
+ sal_uInt32 nDummy;
+ pFormatter = SbiInstance::PrepareNumberFormatter( nDummy, nDummy, nDummy );
+ }
+ sal_uInt32 nIndex = pFormatter->GetStandardIndex( LANGUAGE_ENGLISH_US);
+ bool bSuccess = pFormatter->IsNumberFormat(aSym, nIndex, nVal);
+ if( bSuccess )
+ {
+ SvNumFormatType nType_ = pFormatter->GetType(nIndex);
+ if( !(nType_ & SvNumFormatType::DATE) )
+ bSuccess = false;
+ }
+
+ if (!bSuccess)
+ GenError( ERRCODE_BASIC_CONVERSION );
+
+ bNumber = true;
+ eScanType = SbxDOUBLE;
+ }
+ else
+ {
+ aError = OUString('#');
+ GenError( ERRCODE_BASIC_EXPECTED );
+ }
+ }
+ // invalid characters:
+ else if (nLineIdx < aLine.getLength() && aLine[nLineIdx] >= 0x7F)
+ {
+ GenError( ERRCODE_BASIC_SYNTAX ); nLineIdx++; nCol++;
+ }
+ // other groups:
+ else
+ {
+ sal_Int32 n = 1;
+ auto nChar = nLineIdx < aLine.getLength() ? aLine[nLineIdx] : 0;
+ ++nLineIdx;
+ if (nLineIdx < aLine.getLength())
+ {
+ switch (nChar)
+ {
+ case '<': if( aLine[nLineIdx] == '>' || aLine[nLineIdx] == '=' ) n = 2; break;
+ case '>': if( aLine[nLineIdx] == '=' ) n = 2; break;
+ case ':': if( aLine[nLineIdx] == '=' ) n = 2; break;
+ }
+ }
+ aSym = aLine.copy(nCol, std::min(n, aLine.getLength() - nCol));
+ nLineIdx += n-1; nCol = nCol + n;
+ }
+
+ nCol2 = nCol-1;
+
+PrevLineCommentLbl:
+
+ if( bPrevLineExtentsComment || (eScanType != SbxSTRING &&
+ ( bCompilerDirective ||
+ aSym.startsWith("'") ||
+ aSym.equalsIgnoreAsciiCase( "REM" ) ) ) )
+ {
+ bPrevLineExtentsComment = false;
+ aSym = "REM";
+ sal_Int32 nLen = aLine.getLength() - nLineIdx;
+ if( bCompatible && aLine[nLineIdx + nLen - 1] == '_' && aLine[nLineIdx + nLen - 2] == ' ' )
+ bPrevLineExtentsComment = true;
+ nCol2 = nCol2 + nLen;
+ nLineIdx = -1;
+ }
+
+ if (nLineIdx == nLineIdxScanStart)
+ {
+ GenError( ERRCODE_BASIC_SYMBOL_EXPECTED );
+ return false;
+ }
+
+ return true;
+
+
+eoln:
+ if( nCol && aLine[--nLineIdx] == '_' )
+ {
+ nLineIdx = -1;
+ bool bRes = NextSym();
+ if( aSym.startsWith(".") )
+ {
+ // object _
+ // .Method
+ // ^^^ <- spaces is legal in MSO VBA
+ bSpaces = false;
+ }
+ return bRes;
+ }
+ else
+ {
+ nLineIdx = -1;
+ nLine = nOldLine;
+ nCol1 = nOldCol1;
+ nCol2 = nOldCol2;
+ aSym = "\n";
+ nColLock = 0;
+ return true;
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/symtbl.cxx b/basic/source/comp/symtbl.cxx
new file mode 100644
index 000000000..00a857aba
--- /dev/null
+++ b/basic/source/comp/symtbl.cxx
@@ -0,0 +1,502 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <memory>
+#include <parser.hxx>
+
+#include <osl/diagnose.h>
+
+#include <stdio.h>
+#include <rtl/character.hxx>
+#include <basic/sberrors.hxx>
+
+// All symbol names are laid down int the symbol-pool's stringpool, so that
+// all symbols are handled in the same case. On saving the code-image, the
+// global stringpool with the respective symbols is also saved.
+// The local stringpool holds all the symbols that don't move to the image
+// (labels, constant names etc.).
+
+SbiStringPool::SbiStringPool( )
+{}
+
+SbiStringPool::~SbiStringPool()
+{}
+
+OUString SbiStringPool::Find( sal_uInt32 n ) const
+{
+ if( n == 0 || n > aData.size() )
+ return OUString();
+ else
+ return aData[n - 1];
+}
+
+short SbiStringPool::Add( const OUString& rVal )
+{
+ sal_uInt32 n = aData.size();
+ for( sal_uInt32 i = 0; i < n; ++i )
+ {
+ OUString& p = aData[i];
+ if( p == rVal )
+ return i+1;
+ }
+
+ aData.push_back(rVal);
+ return static_cast<short>(++n);
+}
+
+short SbiStringPool::Add( double n, SbxDataType t )
+{
+ char buf[40]{};
+ switch( t )
+ {
+ // tdf#131296 - store numeric value including its type character
+ // See GetSuffixType in basic/source/comp/scanner.cxx for type characters
+ case SbxINTEGER: snprintf( buf, sizeof(buf), "%d%%", static_cast<short>(n) ); break;
+ case SbxLONG: snprintf( buf, sizeof(buf), "%ld&", static_cast<long>(n) ); break;
+ case SbxSINGLE: snprintf( buf, sizeof(buf), "%.6g!", static_cast<float>(n) ); break;
+ case SbxDOUBLE: snprintf( buf, sizeof(buf), "%.16g", n ); break; // default processing in SbiRuntime::StepLOADNC - no type character
+ case SbxCURRENCY: snprintf(buf, sizeof(buf), "%.16g@", n); break;
+ default: assert(false); break; // should not happen
+ }
+ return Add( OUString::createFromAscii( buf ) );
+}
+
+SbiSymPool::SbiSymPool( SbiStringPool& r, SbiSymScope s, SbiParser* pP ) : rStrings( r ), pParser( pP )
+{
+ eScope = s;
+ pParent = nullptr;
+ nCur =
+ nProcId = 0;
+}
+
+SbiSymPool::~SbiSymPool()
+{}
+
+
+SbiSymDef* SbiSymPool::First()
+{
+ nCur = sal_uInt16(-1);
+ return Next();
+}
+
+SbiSymDef* SbiSymPool::Next()
+{
+ if (m_Data.size() <= ++nCur)
+ return nullptr;
+ else
+ return m_Data[ nCur ].get();
+}
+
+
+SbiSymDef* SbiSymPool::AddSym( const OUString& rName )
+{
+ SbiSymDef* p = new SbiSymDef( rName );
+ p->nPos = m_Data.size();
+ p->nId = rStrings.Add( rName );
+ p->nProcId = nProcId;
+ p->pIn = this;
+ m_Data.insert( m_Data.begin() + p->nPos, std::unique_ptr<SbiSymDef>(p) );
+ return p;
+}
+
+SbiProcDef* SbiSymPool::AddProc( const OUString& rName )
+{
+ SbiProcDef* p = new SbiProcDef( pParser, rName );
+ p->nPos = m_Data.size();
+ p->nId = rStrings.Add( rName );
+ // procs are always local
+ p->nProcId = 0;
+ p->pIn = this;
+ m_Data.insert( m_Data.begin() + p->nPos, std::unique_ptr<SbiProcDef>(p) );
+ return p;
+}
+
+// adding an externally constructed symbol definition
+
+void SbiSymPool::Add( SbiSymDef* pDef )
+{
+ if( !(pDef && pDef->pIn != this) )
+ return;
+
+ if( pDef->pIn )
+ {
+#ifdef DBG_UTIL
+
+ pParser->Error( ERRCODE_BASIC_INTERNAL_ERROR, "Dbl Pool" );
+#endif
+ return;
+ }
+
+ pDef->nPos = m_Data.size();
+ if( !pDef->nId )
+ {
+ // A unique name must be created in the string pool
+ // for static variables (Form ProcName:VarName)
+ OUString aName( pDef->aName );
+ if( pDef->IsStatic() )
+ {
+ aName = pParser->aGblStrings.Find( nProcId )
+ + ":"
+ + pDef->aName;
+ }
+ pDef->nId = rStrings.Add( aName );
+ }
+
+ if( !pDef->GetProcDef() )
+ {
+ pDef->nProcId = nProcId;
+ }
+ pDef->pIn = this;
+ m_Data.insert( m_Data.begin() + pDef->nPos, std::unique_ptr<SbiSymDef>(pDef) );
+}
+
+
+SbiSymDef* SbiSymPool::Find( const OUString& rName, bool bSearchInParents )
+{
+ sal_uInt16 nCount = m_Data.size();
+ for( sal_uInt16 i = 0; i < nCount; i++ )
+ {
+ SbiSymDef &r = *m_Data[ nCount - i - 1 ];
+ if( ( !r.nProcId || ( r.nProcId == nProcId)) &&
+ ( r.aName.equalsIgnoreAsciiCase(rName)))
+ {
+ return &r;
+ }
+ }
+ if( bSearchInParents && pParent )
+ {
+ return pParent->Find( rName );
+ }
+ else
+ {
+ return nullptr;
+ }
+}
+
+
+// find via position (from 0)
+
+SbiSymDef* SbiSymPool::Get( sal_uInt16 n )
+{
+ if (m_Data.size() <= n)
+ {
+ return nullptr;
+ }
+ else
+ {
+ return m_Data[ n ].get();
+ }
+}
+
+sal_uInt32 SbiSymPool::Define( const OUString& rName )
+{
+ SbiSymDef* p = Find( rName );
+ if( p )
+ {
+ if( p->IsDefined() )
+ {
+ pParser->Error( ERRCODE_BASIC_LABEL_DEFINED, rName );
+ }
+ }
+ else
+ {
+ p = AddSym( rName );
+ }
+ return p->Define();
+}
+
+sal_uInt32 SbiSymPool::Reference( const OUString& rName )
+{
+ SbiSymDef* p = Find( rName );
+ if( !p )
+ {
+ p = AddSym( rName );
+ }
+ // to be sure
+ pParser->aGen.GenStmnt();
+ return p->Reference();
+}
+
+
+void SbiSymPool::CheckRefs()
+{
+ for (std::unique_ptr<SbiSymDef> & r : m_Data)
+ {
+ if( !r->IsDefined() )
+ {
+ pParser->Error( ERRCODE_BASIC_UNDEF_LABEL, r->GetName() );
+ }
+ }
+}
+
+SbiSymDef::SbiSymDef( const OUString& rName ) : aName( rName )
+{
+ eType = SbxEMPTY;
+ nDims = 0;
+ nTypeId = 0;
+ nProcId = 0;
+ nId = 0;
+ nPos = 0;
+ nLen = 0;
+ nChain = 0;
+ bAs =
+ bNew =
+ bStatic =
+ bOpt =
+ bParamArray =
+ bWithEvents =
+ bWithBrackets =
+ bByVal =
+ bChained =
+ bGlobal = false;
+ pIn = nullptr;
+ nDefaultId = 0;
+ nFixedStringLength = -1;
+}
+
+SbiSymDef::~SbiSymDef()
+{
+}
+
+SbiProcDef* SbiSymDef::GetProcDef()
+{
+ return nullptr;
+}
+
+SbiConstDef* SbiSymDef::GetConstDef()
+{
+ return nullptr;
+}
+
+
+const OUString& SbiSymDef::GetName()
+{
+ if( pIn )
+ {
+ aName = pIn->rStrings.Find( nId );
+ }
+ return aName;
+}
+
+
+void SbiSymDef::SetType( SbxDataType t )
+{
+ if( t == SbxVARIANT && pIn )
+ {
+ //See if there have been any deftype statements to set the default type
+ //of a variable based on its starting letter
+ sal_Unicode cu = aName[0];
+ if( cu < 256 )
+ {
+ unsigned char ch = static_cast<unsigned char>(cu);
+ if( ch == '_' )
+ {
+ ch = 'Z';
+ }
+ int ch2 = rtl::toAsciiUpperCase( ch );
+ int nIndex = ch2 - 'A';
+ if (nIndex >= 0 && nIndex < N_DEF_TYPES)
+ t = pIn->pParser->eDefTypes[nIndex];
+ }
+ }
+ eType = t;
+}
+
+// construct a backchain, if not yet defined
+// the value that shall be stored as an operand is returned
+
+sal_uInt32 SbiSymDef::Reference()
+{
+ if( !bChained )
+ {
+ sal_uInt32 n = nChain;
+ nChain = pIn->pParser->aGen.GetOffset();
+ return n;
+ }
+ else return nChain;
+}
+
+
+sal_uInt32 SbiSymDef::Define()
+{
+ sal_uInt32 n = pIn->pParser->aGen.GetPC();
+ pIn->pParser->aGen.GenStmnt();
+ if( nChain )
+ {
+ pIn->pParser->aGen.BackChain( nChain );
+ }
+ nChain = n;
+ bChained = true;
+ return nChain;
+}
+
+// A symbol definition may have its own pool. This is the case
+// for objects and procedures (local variable)
+
+SbiSymPool& SbiSymDef::GetPool()
+{
+ if( !pPool )
+ {
+ pPool = std::make_unique<SbiSymPool>( pIn->pParser->aGblStrings, SbLOCAL, pIn->pParser );// is dumped
+ }
+ return *pPool;
+}
+
+SbiSymScope SbiSymDef::GetScope() const
+{
+ return pIn ? pIn->GetScope() : SbLOCAL;
+}
+
+
+// The procedure definition has three pools:
+// 1) aParams: is filled by the definition. Contains the
+// parameters' names, like they're used inside the body.
+// The first element is the return value.
+// 2) pPool: all local variables
+// 3) aLabels: labels
+
+SbiProcDef::SbiProcDef( SbiParser* pParser, const OUString& rName,
+ bool bProcDecl )
+ : SbiSymDef( rName )
+ , aParams( pParser->aGblStrings, SbPARAM, pParser ) // is dumped
+ , aLabels( pParser->aLclStrings, SbLOCAL, pParser ) // is not dumped
+ , mbProcDecl( bProcDecl )
+{
+ aParams.SetParent( &pParser->aPublics );
+ pPool = std::make_unique<SbiSymPool>( pParser->aGblStrings, SbLOCAL, pParser );
+ pPool->SetParent( &aParams );
+ nLine1 =
+ nLine2 = 0;
+ mePropMode = PropertyMode::NONE;
+ bPublic = true;
+ bCdecl = false;
+ bStatic = false;
+ // For return values the first element of the parameter
+ // list is always defined with name and type of the proc
+ aParams.AddSym( aName );
+}
+
+SbiProcDef::~SbiProcDef()
+{}
+
+SbiProcDef* SbiProcDef::GetProcDef()
+{
+ return this;
+}
+
+void SbiProcDef::SetType( SbxDataType t )
+{
+ SbiSymDef::SetType( t );
+ aParams.Get( 0 )->SetType( eType );
+}
+
+// match with a forward-declaration
+// if the match is OK, pOld is replaced by this in the pool
+// pOld is deleted in any case!
+
+void SbiProcDef::Match( SbiProcDef* pOld )
+{
+ SbiSymDef *pn=nullptr;
+ // parameter 0 is the function name
+ sal_uInt16 i;
+ for( i = 1; i < aParams.GetSize(); i++ )
+ {
+ SbiSymDef* po = pOld->aParams.Get( i );
+ pn = aParams.Get( i );
+ // no type matching - that is done during running
+ // but is it maybe called with too little parameters?
+ if( !po && !pn->IsOptional() && !pn->IsParamArray() )
+ {
+ break;
+ }
+ pOld->aParams.Next();
+ }
+
+ if( pn && i < aParams.GetSize() && pOld->pIn )
+ {
+ // mark the whole line
+ pOld->pIn->GetParser()->SetCol1( 0 );
+ pOld->pIn->GetParser()->Error( ERRCODE_BASIC_BAD_DECLARATION, aName );
+ }
+
+ if( !pIn && pOld->pIn )
+ {
+ // Replace old entry with the new one
+ nPos = pOld->nPos;
+ nId = pOld->nId;
+ pIn = pOld->pIn;
+
+ // don't delete pOld twice, if it's stored in m_Data
+ if (pOld == pIn->m_Data[nPos].get())
+ pOld = nullptr;
+ pIn->m_Data[nPos].reset(this);
+ }
+ delete pOld;
+}
+
+void SbiProcDef::setPropertyMode( PropertyMode ePropMode )
+{
+ mePropMode = ePropMode;
+ if( mePropMode == PropertyMode::NONE )
+ return;
+
+ // Prop name = original scanned procedure name
+ maPropName = aName;
+
+ // CompleteProcName includes "Property xxx "
+ // to avoid conflicts with other symbols
+ OUString aCompleteProcName = "Property ";
+ switch( mePropMode )
+ {
+ case PropertyMode::Get: aCompleteProcName += "Get "; break;
+ case PropertyMode::Let: aCompleteProcName += "Let "; break;
+ case PropertyMode::Set: aCompleteProcName += "Set "; break;
+ case PropertyMode::NONE: OSL_FAIL( "Illegal PropertyMode PropertyMode::NONE" ); break;
+ }
+ aCompleteProcName += aName;
+ aName = aCompleteProcName;
+}
+
+
+SbiConstDef::SbiConstDef( const OUString& rName )
+ : SbiSymDef( rName )
+{
+ nVal = 0; eType = SbxINTEGER;
+}
+
+void SbiConstDef::Set( double n, SbxDataType t )
+{
+ aVal.clear(); nVal = n; eType = t;
+}
+
+void SbiConstDef::Set( const OUString& n )
+{
+ aVal = n; nVal = 0; eType = SbxSTRING;
+}
+
+SbiConstDef::~SbiConstDef()
+{}
+
+SbiConstDef* SbiConstDef::GetConstDef()
+{
+ return this;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/comp/token.cxx b/basic/source/comp/token.cxx
new file mode 100644
index 000000000..37c8f9b3a
--- /dev/null
+++ b/basic/source/comp/token.cxx
@@ -0,0 +1,572 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <array>
+
+#include <basic/sberrors.hxx>
+#include <rtl/instance.hxx>
+#include <sal/macros.h>
+#include <basiccharclass.hxx>
+#include <token.hxx>
+
+namespace {
+
+struct TokenTable { SbiToken t; const char *s; };
+
+}
+
+static const TokenTable aTokTable_Basic [] = {
+ { CAT, "&" },
+ { MUL, "*" },
+ { PLUS, "+" },
+ { MINUS, "-" },
+ { DIV, "/" },
+ { EOS, ":" },
+ { ASSIGN, ":=" },
+ { LT, "<" },
+ { LE, "<=" },
+ { NE, "<>" },
+ { EQ, "=" },
+ { GT, ">" },
+ { GE, ">=" },
+ { ACCESS, "Access" },
+ { ALIAS, "Alias" },
+ { AND, "And" },
+ { ANY, "Any" },
+ { APPEND, "Append" },
+ { AS, "As" },
+ { ATTRIBUTE,"Attribute" },
+ { BASE, "Base" },
+ { BINARY, "Binary" },
+ { TBOOLEAN, "Boolean" },
+ { BYREF, "ByRef", },
+ { TBYTE, "Byte", },
+ { BYVAL, "ByVal", },
+ { CALL, "Call" },
+ { CASE, "Case" },
+ { CDECL_, "Cdecl" },
+ { CLASSMODULE, "ClassModule" },
+ { CLOSE, "Close" },
+ { COMPARE, "Compare" },
+ { COMPATIBLE,"Compatible" },
+ { CONST_, "Const" },
+ { TCURRENCY,"Currency" },
+ { TDATE, "Date" },
+ { DECLARE, "Declare" },
+ { DEFBOOL, "DefBool" },
+ { DEFCUR, "DefCur" },
+ { DEFDATE, "DefDate" },
+ { DEFDBL, "DefDbl" },
+ { DEFERR, "DefErr" },
+ { DEFINT, "DefInt" },
+ { DEFLNG, "DefLng" },
+ { DEFOBJ, "DefObj" },
+ { DEFSNG, "DefSng" },
+ { DEFSTR, "DefStr" },
+ { DEFVAR, "DefVar" },
+ { DIM, "Dim" },
+ { DO, "Do" },
+ { TDOUBLE, "Double" },
+ { EACH, "Each" },
+ { ELSE, "Else" },
+ { ELSEIF, "ElseIf" },
+ { END, "End" },
+ { ENDENUM, "End Enum" },
+ { ENDFUNC, "End Function" },
+ { ENDIF, "End If" },
+ { ENDPROPERTY, "End Property" },
+ { ENDSELECT,"End Select" },
+ { ENDSUB, "End Sub" },
+ { ENDTYPE, "End Type" },
+ { ENDIF, "EndIf" },
+ { ENUM, "Enum" },
+ { EQV, "Eqv" },
+ { ERASE, "Erase" },
+ { ERROR_, "Error" },
+ { EXIT, "Exit" },
+ { BASIC_EXPLICIT, "Explicit" },
+ { FOR, "For" },
+ { FUNCTION, "Function" },
+ { GET, "Get" },
+ { GLOBAL, "Global" },
+ { GOSUB, "GoSub" },
+ { GOTO, "GoTo" },
+ { IF, "If" },
+ { IMP, "Imp" },
+ { IMPLEMENTS, "Implements" },
+ { IN_, "In" },
+ { INPUT, "Input" }, // also INPUT #
+ { TINTEGER, "Integer" },
+ { IS, "Is" },
+ { LET, "Let" },
+ { LIB, "Lib" },
+ { LIKE, "Like" },
+ { LINE, "Line" },
+ { LINEINPUT,"Line Input" },
+ { LOCAL, "Local" },
+ { LOCK, "Lock" },
+ { TLONG, "Long" },
+ { LOOP, "Loop" },
+ { LPRINT, "LPrint" },
+ { LSET, "LSet" }, // JSM
+ { MOD, "Mod" },
+ { NAME, "Name" },
+ { NEW, "New" },
+ { NEXT, "Next" },
+ { NOT, "Not" },
+ { TOBJECT, "Object" },
+ { ON, "On" },
+ { OPEN, "Open" },
+ { OPTION, "Option" },
+ { OPTIONAL_, "Optional" },
+ { OR, "Or" },
+ { OUTPUT, "Output" },
+ { PARAMARRAY, "ParamArray" },
+ { PRESERVE, "Preserve" },
+ { PRINT, "Print" },
+ { PRIVATE, "Private" },
+ { PROPERTY, "Property" },
+ { PTRSAFE, "PtrSafe" },
+ { PUBLIC, "Public" },
+ { RANDOM, "Random" },
+ { READ, "Read" },
+ { REDIM, "ReDim" },
+ { REM, "Rem" },
+ { RESUME, "Resume" },
+ { RETURN, "Return" },
+ { RSET, "RSet" }, // JSM
+ { SELECT, "Select" },
+ { SET, "Set" },
+ { SHARED, "Shared" },
+ { TSINGLE, "Single" },
+ { STATIC, "Static" },
+ { STEP, "Step" },
+ { STOP, "Stop" },
+ { TSTRING, "String" },
+ { SUB, "Sub" },
+ { STOP, "System" },
+ { TEXT, "Text" },
+ { THEN, "Then" },
+ { TO, "To", },
+ { TYPE, "Type" },
+ { TYPEOF, "TypeOf" },
+ { UNTIL, "Until" },
+ { TVARIANT, "Variant" },
+ { VBASUPPORT, "VbaSupport" },
+ { WEND, "Wend" },
+ { WHILE, "While" },
+ { WITH, "With" },
+ { WITHEVENTS, "WithEvents" },
+ { WRITE, "Write" }, // also WRITE #
+ { XOR, "Xor" },
+};
+
+namespace {
+
+// #i109076
+class TokenLabelInfo
+{
+ std::array<bool,VBASUPPORT+1> m_pTokenCanBeLabelTab;
+
+public:
+ TokenLabelInfo();
+
+ bool canTokenBeLabel( SbiToken eTok )
+ { return m_pTokenCanBeLabelTab[eTok]; }
+};
+
+class StaticTokenLabelInfo: public ::rtl::Static< TokenLabelInfo, StaticTokenLabelInfo >{};
+
+}
+
+// #i109076
+TokenLabelInfo::TokenLabelInfo()
+{
+ m_pTokenCanBeLabelTab.fill(false);
+
+ // Token accepted as label by VBA
+ static const SbiToken eLabelToken[] = { ACCESS, ALIAS, APPEND, BASE, BINARY, CLASSMODULE,
+ COMPARE, COMPATIBLE, DEFERR, ERROR_, BASIC_EXPLICIT, LIB, LINE, LPRINT, NAME,
+ TOBJECT, OUTPUT, PROPERTY, RANDOM, READ, STEP, STOP, TEXT, VBASUPPORT };
+ for( SbiToken eTok : eLabelToken )
+ {
+ m_pTokenCanBeLabelTab[eTok] = true;
+ }
+}
+
+
+SbiTokenizer::SbiTokenizer( const OUString& rSrc, StarBASIC* pb )
+ : SbiScanner(rSrc, pb)
+ , eCurTok(NIL)
+ , ePush(NIL)
+ , nPLine(0)
+ , nPCol1(0)
+ , nPCol2(0)
+ , bEof(false)
+ , bEos(true)
+ , bAs(false)
+ , bErrorIsSymbol(true)
+{
+}
+
+void SbiTokenizer::Push( SbiToken t )
+{
+ if( ePush != NIL )
+ Error( ERRCODE_BASIC_INTERNAL_ERROR, "PUSH" );
+ else ePush = t;
+}
+
+void SbiTokenizer::Error( ErrCode code, const OUString &aMsg )
+{
+ aError = aMsg;
+ Error( code );
+}
+
+void SbiTokenizer::Error( ErrCode code, SbiToken tok )
+{
+ aError = Symbol( tok );
+ Error( code );
+}
+
+// reading in the next token without absorbing it
+
+SbiToken SbiTokenizer::Peek()
+{
+ if( ePush == NIL )
+ {
+ sal_Int32 nOldLine = nLine;
+ sal_Int32 nOldCol1 = nCol1;
+ sal_Int32 nOldCol2 = nCol2;
+ ePush = Next();
+ nPLine = nLine; nLine = nOldLine;
+ nPCol1 = nCol1; nCol1 = nOldCol1;
+ nPCol2 = nCol2; nCol2 = nOldCol2;
+ }
+ eCurTok = ePush;
+ return eCurTok;
+}
+
+// For decompilation. Numbers and symbols return an empty string.
+
+const OUString& SbiTokenizer::Symbol( SbiToken t )
+{
+ // character token?
+ if( t < FIRSTKWD )
+ {
+ aSym = OUString(sal::static_int_cast<sal_Unicode>(t));
+ return aSym;
+ }
+ switch( t )
+ {
+ case NEG :
+ aSym = "-";
+ return aSym;
+ case EOS :
+ aSym = ":/CRLF";
+ return aSym;
+ case EOLN :
+ aSym = "CRLF";
+ return aSym;
+ default:
+ break;
+ }
+ for( auto& rTok : aTokTable_Basic )
+ {
+ if( rTok.t == t )
+ {
+ aSym = OStringToOUString(rTok.s, RTL_TEXTENCODING_ASCII_US);
+ return aSym;
+ }
+ }
+ const sal_Unicode *p = aSym.getStr();
+ if (*p <= ' ')
+ {
+ aSym = "???";
+ }
+ return aSym;
+}
+
+// Reading in the next token and put it down.
+// Tokens that don't appear in the token table
+// are directly returned as a character.
+// Some words are treated in a special way.
+
+SbiToken SbiTokenizer::Next()
+{
+ if (bEof)
+ {
+ return EOLN;
+ }
+ // have read in one already?
+ if( ePush != NIL )
+ {
+ eCurTok = ePush;
+ ePush = NIL;
+ nLine = nPLine;
+ nCol1 = nPCol1;
+ nCol2 = nPCol2;
+ bEos = IsEoln( eCurTok );
+ return eCurTok;
+ }
+ const TokenTable *tp;
+
+ if( !NextSym() )
+ {
+ bEof = bEos = true;
+ eCurTok = EOLN;
+ return eCurTok;
+ }
+
+ if( aSym.startsWith("\n") )
+ {
+ bEos = true;
+ eCurTok = EOLN;
+ return eCurTok;
+ }
+ bEos = false;
+
+ if( bNumber )
+ {
+ eCurTok = NUMBER;
+ return eCurTok;
+ }
+ else if( ( eScanType == SbxDATE || eScanType == SbxSTRING ) && !bSymbol )
+ {
+ eCurTok = FIXSTRING;
+ return eCurTok;
+ }
+ else if( aSym.isEmpty() )
+ {
+ //something went wrong
+ bEof = bEos = true;
+ eCurTok = EOLN;
+ return eCurTok;
+ }
+ // Special cases of characters that are between "Z" and "a". ICompare()
+ // evaluates the position of these characters in different ways.
+ else if( aSym[0] == '^' )
+ {
+ eCurTok = EXPON;
+ return eCurTok;
+ }
+ else if( aSym[0] == '\\' )
+ {
+ eCurTok = IDIV;
+ return eCurTok;
+ }
+ else
+ {
+ if( eScanType != SbxVARIANT )
+ {
+ eCurTok = SYMBOL;
+ return eCurTok;
+ }
+ // valid token?
+ short lb = 0;
+ short ub = SAL_N_ELEMENTS(aTokTable_Basic)-1;
+ short delta;
+ do
+ {
+ delta = (ub - lb) >> 1;
+ tp = &aTokTable_Basic[ lb + delta ];
+ sal_Int32 res = aSym.compareToIgnoreAsciiCaseAscii( tp->s );
+
+ if( res == 0 )
+ {
+ goto special;
+ }
+ if( res < 0 )
+ {
+ if ((ub - lb) == 2)
+ {
+ ub = lb;
+ }
+ else
+ {
+ ub = ub - delta;
+ }
+ }
+ else
+ {
+ if ((ub -lb) == 2)
+ {
+ lb = ub;
+ }
+ else
+ {
+ lb = lb + delta;
+ }
+ }
+ }
+ while( delta );
+ // Symbol? if not >= token
+ sal_Unicode ch = aSym[0];
+ if( !BasicCharClass::isAlpha( ch, bCompatible ) && !bSymbol )
+ {
+ eCurTok = static_cast<SbiToken>(ch & 0x00FF);
+ return eCurTok;
+ }
+ eCurTok = SYMBOL;
+ return eCurTok;
+ }
+special:
+ // #i92642
+ bool bStartOfLine = (eCurTok == NIL || eCurTok == REM || eCurTok == EOLN ||
+ eCurTok == THEN || eCurTok == ELSE); // single line If
+ if( !bStartOfLine && (tp->t == NAME || tp->t == LINE) )
+ {
+ eCurTok = SYMBOL;
+ return eCurTok;
+ }
+ else if( tp->t == TEXT )
+ {
+ eCurTok = SYMBOL;
+ return eCurTok;
+ }
+ // maybe we can expand this for other statements that have parameters
+ // that are keywords ( and those keywords are only used within such
+ // statements )
+ // what's happening here is that if we come across 'append' ( and we are
+ // not in the middle of parsing a special statement ( like 'Open')
+ // we just treat keyword 'append' as a normal 'SYMBOL'.
+ // Also we accept Dim APPEND
+ else if ( ( !bInStatement || eCurTok == DIM ) && tp->t == APPEND )
+ {
+ eCurTok = SYMBOL;
+ return eCurTok;
+ }
+ // #i92642: Special LINE token handling -> SbiParser::Line()
+
+ // END IF, CASE, SUB, DEF, FUNCTION, TYPE, CLASS, WITH
+ if( tp->t == END )
+ {
+ // from 15.3.96, special treatment for END, at Peek() the current
+ // time is lost, so memorize everything and restore after
+ sal_Int32 nOldLine = nLine;
+ sal_Int32 nOldCol = nCol;
+ sal_Int32 nOldCol1 = nCol1;
+ sal_Int32 nOldCol2 = nCol2;
+ OUString aOldSym = aSym;
+ SaveLine(); // save pLine in the scanner
+
+ eCurTok = Peek();
+ switch( eCurTok )
+ {
+ case IF: Next(); eCurTok = ENDIF; break;
+ case SELECT: Next(); eCurTok = ENDSELECT; break;
+ case SUB: Next(); eCurTok = ENDSUB; break;
+ case FUNCTION: Next(); eCurTok = ENDFUNC; break;
+ case PROPERTY: Next(); eCurTok = ENDPROPERTY; break;
+ case TYPE: Next(); eCurTok = ENDTYPE; break;
+ case ENUM: Next(); eCurTok = ENDENUM; break;
+ case WITH: Next(); eCurTok = ENDWITH; break;
+ default : eCurTok = END; break;
+ }
+ nCol1 = nOldCol1;
+ if( eCurTok == END )
+ {
+ // reset everything so that token is read completely newly after END
+ ePush = NIL;
+ nLine = nOldLine;
+ nCol = nOldCol;
+ nCol2 = nOldCol2;
+ aSym = aOldSym;
+ RestoreLine();
+ }
+ return eCurTok;
+ }
+ // are data types keywords?
+ // there is ERROR(), DATA(), STRING() etc.
+ eCurTok = tp->t;
+ // AS: data types are keywords
+ if( tp->t == AS )
+ {
+ bAs = true;
+ }
+ else
+ {
+ if( bAs )
+ {
+ bAs = false;
+ }
+ else if( eCurTok >= DATATYPE1 && eCurTok <= DATATYPE2 && (bErrorIsSymbol || eCurTok != ERROR_) )
+ {
+ eCurTok = SYMBOL;
+ }
+ }
+
+ // CLASSMODULE, PROPERTY, GET, ENUM token only visible in compatible mode
+ SbiToken eTok = tp->t;
+ if( bCompatible )
+ {
+ // #129904 Suppress system
+ if( eTok == STOP && aSym.equalsIgnoreAsciiCase("system") )
+ {
+ eCurTok = SYMBOL;
+ }
+ if( eTok == GET && bStartOfLine )
+ {
+ eCurTok = SYMBOL;
+ }
+ }
+ else
+ {
+ if( eTok == CLASSMODULE ||
+ eTok == IMPLEMENTS ||
+ eTok == PARAMARRAY ||
+ eTok == ENUM ||
+ eTok == PROPERTY ||
+ eTok == GET ||
+ eTok == TYPEOF )
+ {
+ eCurTok = SYMBOL;
+ }
+ }
+
+ bEos = IsEoln( eCurTok );
+ return eCurTok;
+}
+
+bool SbiTokenizer::MayBeLabel( bool bNeedsColon )
+{
+ if( eCurTok == SYMBOL || StaticTokenLabelInfo::get().canTokenBeLabel( eCurTok ) )
+ {
+ return !bNeedsColon || DoesColonFollow();
+ }
+ else
+ {
+ return ( eCurTok == NUMBER
+ && eScanType == SbxINTEGER
+ && nVal >= 0 );
+ }
+}
+
+
+OUString SbiTokenizer::GetKeywordCase( const OUString& sKeyword )
+{
+ for( auto& rTok : aTokTable_Basic )
+ {
+ if( sKeyword.equalsIgnoreAsciiCaseAscii(rTok.s) )
+ return OStringToOUString(rTok.s, RTL_TEXTENCODING_ASCII_US);
+ }
+ return OUString();
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/basiccharclass.hxx b/basic/source/inc/basiccharclass.hxx
new file mode 100644
index 000000000..3b8109b89
--- /dev/null
+++ b/basic/source/inc/basiccharclass.hxx
@@ -0,0 +1,36 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_BASICCHARCLASS_HXX
+#define INCLUDED_BASIC_SOURCE_INC_BASICCHARCLASS_HXX
+
+#include <sal/types.h>
+
+namespace BasicCharClass
+{
+ bool isLetter( sal_Unicode c );
+ bool isLetterUnicode( sal_Unicode c );
+ bool isAlpha( sal_Unicode c, bool bCompatible );
+ bool isAlphaNumeric( sal_Unicode c, bool bCompatible );
+ bool isWhitespace( sal_Unicode c );
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/buffer.hxx b/basic/source/inc/buffer.hxx
new file mode 100644
index 000000000..89d664453
--- /dev/null
+++ b/basic/source/inc/buffer.hxx
@@ -0,0 +1,53 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_BUFFER_HXX
+#define INCLUDED_BASIC_SOURCE_INC_BUFFER_HXX
+
+#include <sal/types.h>
+#include <memory>
+
+class SbiParser;
+
+class SbiBuffer {
+ SbiParser* pParser; // for error messages
+ std::unique_ptr<char[]> pBuf;
+ char* pCur;
+ sal_uInt32 nOff;
+ sal_uInt32 nSize;
+ short nInc;
+ bool Check( sal_Int32 );
+public:
+ SbiBuffer( SbiParser*, short ); // increment
+ ~SbiBuffer();
+ void Patch( sal_uInt32, sal_uInt32 );
+ void Chain( sal_uInt32 );
+ void operator += (sal_Int8); // save character
+ void operator += (sal_Int16); // save integer
+ bool operator += (sal_uInt8); // save character
+ bool operator += (sal_uInt16); // save integer
+ bool operator += (sal_uInt32); // save integer
+ void operator += (sal_Int32); // save integer
+ char* GetBuffer(); // give out buffer (delete yourself!)
+ sal_uInt32 GetSize() const { return nOff; }
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/codegen.hxx b/basic/source/inc/codegen.hxx
new file mode 100644
index 000000000..857968e26
--- /dev/null
+++ b/basic/source/inc/codegen.hxx
@@ -0,0 +1,85 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_CODEGEN_HXX
+#define INCLUDED_BASIC_SOURCE_INC_CODEGEN_HXX
+
+class SbiParser;
+class SbModule;
+#include "opcodes.hxx"
+#include "buffer.hxx"
+
+class SbiCodeGen {
+ SbiParser* pParser; // for error messages, line, column etc.
+ SbModule& rMod;
+ SbiBuffer aCode;
+ short nLine, nCol; // for stmnt command
+ short nForLevel; // #29955
+ bool bStmnt; // true: statement-opcode is pending
+
+public:
+ SbiCodeGen( SbModule&, SbiParser*, short );
+ SbiParser* GetParser() { return pParser; }
+ SbModule& GetModule() { return rMod; }
+ sal_uInt32 Gen( SbiOpcode );
+ sal_uInt32 Gen( SbiOpcode, sal_uInt32 );
+ sal_uInt32 Gen( SbiOpcode, sal_uInt32, sal_uInt32 );
+ void Patch( sal_uInt32 o, sal_uInt32 v ){ aCode.Patch( o, v ); }
+ void BackChain( sal_uInt32 off ) { aCode.Chain( off ); }
+ void Statement();
+ void GenStmnt(); // create statement-opcode maybe
+ sal_uInt32 GetPC() const;
+ sal_uInt32 GetOffset() const { return GetPC() + 1; }
+ void Save();
+
+ // #29955 service for-loop-level
+ void IncForLevel() { nForLevel++; }
+ void DecForLevel() { nForLevel--; }
+
+ static sal_uInt32 calcNewOffSet( sal_uInt8 const * pCode, sal_uInt16 nOffset );
+ static sal_uInt16 calcLegacyOffSet( sal_uInt8 const * pCode, sal_uInt32 nOffset );
+
+};
+
+template < class T, class S >
+class PCodeBuffConvertor
+{
+ T m_nSize;
+ sal_uInt8* m_pStart;
+ sal_uInt8* m_pCnvtdBuf;
+ S m_nCnvtdSize;
+
+ PCodeBuffConvertor(const PCodeBuffConvertor& ) = delete;
+ PCodeBuffConvertor& operator = ( const PCodeBuffConvertor& ) = delete;
+public:
+ PCodeBuffConvertor( sal_uInt8* pCode, T nSize ): m_nSize( nSize ), m_pStart( pCode ), m_pCnvtdBuf( nullptr ), m_nCnvtdSize( 0 ){ convert(); }
+ S GetSize(){ return m_nCnvtdSize; }
+ void convert();
+ // Caller owns the buffer returned
+ sal_uInt8* GetBuffer() { return m_pCnvtdBuf; }
+};
+
+// #111897 PARAM_INFO flags start at 0x00010000 to not
+// conflict with DefaultId in SbxParamInfo::nUserData
+#define PARAM_INFO_PARAMARRAY 0x0010000
+#define PARAM_INFO_WITHBRACKETS 0x0020000
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/date.hxx b/basic/source/inc/date.hxx
new file mode 100644
index 000000000..1a994ca3f
--- /dev/null
+++ b/basic/source/inc/date.hxx
@@ -0,0 +1,61 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_DATE_HXX
+#define INCLUDED_BASIC_SOURCE_INC_DATE_HXX
+
+#include <com/sun/star/util/Date.hpp>
+#include <com/sun/star/util/Time.hpp>
+#include <com/sun/star/util/DateTime.hpp>
+
+#include <basic/sbxvar.hxx>
+
+enum class SbDateCorrection
+{
+ None,
+ RollOver,
+ TruncateToMonth
+};
+
+bool implDateSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay, bool bUseTwoDigitYear, SbDateCorrection eCorr, double& rdRet );
+double implTimeSerial( sal_Int16 nHour, sal_Int16 nMinute, sal_Int16 nSecond);
+bool implDateTimeSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay,
+ sal_Int16 nHour, sal_Int16 nMinute, sal_Int16 nSecond,
+ double& rdRet );
+
+sal_Int16 implGetWeekDay( double aDate, bool bFirstDayParam = false, sal_Int16 nFirstDay = 0 );
+
+sal_Int16 implGetDateYear( double aDate );
+sal_Int16 implGetDateMonth( double aDate );
+sal_Int16 implGetDateDay( double aDate );
+
+sal_Int16 implGetHour( double dDate );
+sal_Int16 implGetMinute( double dDate );
+sal_Int16 implGetSecond( double dDate );
+
+css::util::Date SbxDateToUNODate( const SbxValue* );
+void SbxDateFromUNODate( SbxValue*, const css::util::Date& );
+css::util::Time SbxDateToUNOTime( const SbxValue* );
+void SbxDateFromUNOTime( SbxValue*, const css::util::Time& );
+css::util::DateTime SbxDateToUNODateTime( const SbxValue* );
+void SbxDateFromUNODateTime( SbxValue*, const css::util::DateTime& );
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/dlgcont.hxx b/basic/source/inc/dlgcont.hxx
new file mode 100644
index 000000000..582e462ab
--- /dev/null
+++ b/basic/source/inc/dlgcont.hxx
@@ -0,0 +1,152 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_DLGCONT_HXX
+#define INCLUDED_BASIC_SOURCE_INC_DLGCONT_HXX
+
+#include "namecont.hxx"
+
+#include <com/sun/star/resource/XStringResourceSupplier.hpp>
+#include <com/sun/star/resource/XStringResourcePersistence.hpp>
+
+#include <cppuhelper/implbase1.hxx>
+#include <comphelper/uno3.hxx>
+
+namespace basic
+{
+
+
+class SfxDialogLibraryContainer : public SfxLibraryContainer
+{
+ // Methods to distinguish between different library types
+ virtual SfxLibrary* implCreateLibrary( const OUString& aName ) override;
+ virtual SfxLibrary* implCreateLibraryLink
+ ( const OUString& aName, const OUString& aLibInfoFileURL,
+ const OUString& StorageURL, bool ReadOnly ) override;
+ virtual css::uno::Any createEmptyLibraryElement() override;
+ virtual bool isLibraryElementValid(const css::uno::Any& rElement) const override;
+ virtual void writeLibraryElement
+ (
+ const css::uno::Reference< css::container::XNameContainer>& xLibrary,
+ const OUString& aElementName,
+ const css::uno::Reference< css::io::XOutputStream >& xOutput
+ ) override;
+
+ virtual css::uno::Any importLibraryElement
+ (
+ const css::uno::Reference< css::container::XNameContainer>& xLibrary,
+ const OUString& aElementName,
+ const OUString& aFile,
+ const css::uno::Reference< css::io::XInputStream >& xElementStream ) override;
+
+ virtual void importFromOldStorage( const OUString& aFile ) override;
+
+ virtual SfxLibraryContainer* createInstanceImpl() override;
+
+ virtual void onNewRootStorage() override;
+
+ virtual const char* getInfoFileName() const override;
+ virtual const char* getOldInfoFileName() const override;
+ virtual const char* getLibElementFileExtension() const override;
+ virtual const char* getLibrariesDir() const override;
+
+public:
+ SfxDialogLibraryContainer();
+ SfxDialogLibraryContainer( const css::uno::Reference< css::embed::XStorage >& xStorage );
+
+ // Methods XStorageBasedLibraryContainer
+ virtual void SAL_CALL storeLibrariesToStorage(
+ const css::uno::Reference< css::embed::XStorage >& RootStorage ) override;
+
+ // Resource handling
+ css::uno::Reference< css::resource::XStringResourcePersistence >
+ implCreateStringResource( class SfxDialogLibrary* pDialog );
+
+ // Methods XServiceInfo
+ virtual OUString SAL_CALL getImplementationName( ) override;
+ virtual css::uno::Sequence< OUString > SAL_CALL getSupportedServiceNames( ) override;
+ // XLibraryQueryExecutable
+ virtual sal_Bool SAL_CALL HasExecutableCode(const OUString&) override;
+};
+
+
+typedef ::cppu::ImplHelper1 < css::resource::XStringResourceSupplier
+ > SfxDialogLibrary_BASE;
+
+class SfxDialogLibrary :public SfxLibrary
+ ,public SfxDialogLibrary_BASE
+{
+ SfxDialogLibraryContainer* m_pParent;
+ css::uno::Reference< css::resource::XStringResourcePersistence> m_xStringResourcePersistence;
+ OUString m_aName;
+
+ // Provide modify state including resources
+ virtual bool isModified() override;
+ virtual void storeResources() override;
+ virtual void storeResourcesAsURL( const OUString& URL, const OUString& NewName ) override;
+ virtual void storeResourcesToURL( const OUString& URL,
+ const css::uno::Reference< css::task::XInteractionHandler >& xHandler ) override;
+ virtual void storeResourcesToStorage( const css::uno::Reference
+ < css::embed::XStorage >& xStorage ) override;
+
+public:
+ SfxDialogLibrary
+ (
+ ModifiableHelper& _rModifiable,
+ const OUString& aName,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& xSFI,
+ SfxDialogLibraryContainer* pParent
+ );
+
+ SfxDialogLibrary
+ (
+ ModifiableHelper& _rModifiable,
+ const OUString& aName,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& xSFI,
+ const OUString& aLibInfoFileURL, const OUString& aStorageURL, bool ReadOnly,
+ SfxDialogLibraryContainer* pParent
+ );
+
+ DECLARE_XINTERFACE()
+ DECLARE_XTYPEPROVIDER()
+
+ // XStringResourceSupplier
+ virtual css::uno::Reference< css::resource::XStringResourceResolver >
+ SAL_CALL getStringResource( ) override;
+
+ const OUString& getName() const
+ { return m_aName; }
+
+ const css::uno::Reference< css::resource::XStringResourcePersistence >&
+ getStringResourcePersistence() const
+ {
+ return m_xStringResourcePersistence;
+ }
+
+ static bool containsValidDialog( const css::uno::Any& aElement );
+
+protected:
+ virtual bool isLibraryElementValid(const css::uno::Any& rElement) const override;
+};
+
+} // namespace basic
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/errobject.hxx b/basic/source/inc/errobject.hxx
new file mode 100644
index 000000000..65c4722e3
--- /dev/null
+++ b/basic/source/inc/errobject.hxx
@@ -0,0 +1,43 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_ERROBJECT_HXX
+#define INCLUDED_BASIC_SOURCE_INC_ERROBJECT_HXX
+#include "sbunoobj.hxx"
+#include <ooo/vba/XErrObject.hpp>
+
+
+class SbxErrObject : public SbUnoObject
+{
+ class ErrObject* m_pErrObject;
+ css::uno::Reference< ooo::vba::XErrObject > m_xErr;
+
+ SbxErrObject( const OUString& aName_, const css::uno::Any& aUnoObj_ );
+ virtual ~SbxErrObject() override;
+
+public:
+ static SbxVariableRef const & getErrObject();
+ static css::uno::Reference< ooo::vba::XErrObject > const & getUnoErrObject();
+
+ /// @throws css::uno::RuntimeException
+ void setNumberAndDescription( ::sal_Int32 _number, const OUString& _description );
+};
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/eventatt.hxx b/basic/source/inc/eventatt.hxx
new file mode 100644
index 000000000..b38c83c59
--- /dev/null
+++ b/basic/source/inc/eventatt.hxx
@@ -0,0 +1,34 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_EVENTATT_HXX
+#define INCLUDED_BASIC_SOURCE_INC_EVENTATT_HXX
+
+#include <sal/config.h>
+
+class SbxArray;
+
+// Instantiate "com.sun.star.awt.UnoControlDialog" on basis
+// of a DialogLibrary entry: Convert from XML-ByteSequence
+// and attach events.
+void RTL_Impl_CreateUnoDialog(SbxArray& rPar);
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/expr.hxx b/basic/source/inc/expr.hxx
new file mode 100644
index 000000000..d83594c49
--- /dev/null
+++ b/basic/source/inc/expr.hxx
@@ -0,0 +1,230 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_EXPR_HXX
+#define INCLUDED_BASIC_SOURCE_INC_EXPR_HXX
+
+#include <memory>
+
+#include "opcodes.hxx"
+#include "token.hxx"
+#include <vector>
+
+class SbiExprNode;
+class SbiExpression;
+class SbiExprList;
+class SbiParser;
+class SbiCodeGen;
+class SbiSymDef;
+class SbiProcDef;
+
+
+typedef std::unique_ptr<SbiExprList> SbiExprListPtr;
+typedef std::vector<SbiExprListPtr> SbiExprListVector;
+
+struct SbVar {
+ SbiExprNode* pNext; // next element (for structures)
+ SbiSymDef* pDef; // symbol definition
+ SbiExprList* pPar; // optional parameters (is deleted)
+ SbiExprListVector* pvMorePar; // Array of arrays foo(pPar)(avMorePar[0])(avMorePar[1])...
+};
+
+struct KeywordSymbolInfo
+{
+ OUString m_aKeywordSymbol;
+ SbxDataType m_eSbxDataType;
+};
+
+enum SbiExprType { // expression types:
+ SbSTDEXPR, // normal expression
+ SbLVALUE, // any lValue
+ SbSYMBOL, // any composite symbol
+ SbOPERAND // variable/function
+};
+
+enum SbiExprMode { // Expression context:
+ EXPRMODE_STANDARD, // default
+ EXPRMODE_STANDALONE, // a param1, param2 OR a( param1, param2 ) = 42
+ EXPRMODE_LPAREN_PENDING, // start of parameter list with bracket, special handling
+ EXPRMODE_LPAREN_NOT_NEEDED, // pending LPAREN has not been used
+ EXPRMODE_ARRAY_OR_OBJECT, // '=' or '(' or '.' found after ')' on ParenLevel 0, stopping
+ // expression, assuming array syntax a(...)[(...)] = ?
+ // or a(...).b(...)
+ EXPRMODE_EMPTY_PAREN // It turned out that the paren don't contain anything: a()
+};
+
+enum SbiNodeType {
+ SbxNUMVAL, // nVal = value
+ SbxSTRVAL, // aStrVal = value, before #i59791/#i45570: nStringId = value
+ SbxVARVAL, // aVar = value
+ SbxTYPEOF, // TypeOf ObjExpr Is Type
+ SbxNODE, // Node
+ SbxNEW, // new <type> expression
+ SbxDUMMY
+};
+
+enum RecursiveMode
+{
+ UNDEFINED,
+ FORCE_CALL,
+ PREVENT_CALL
+};
+
+class SbiExprNode final { // operators (and operands)
+ friend class SbiExpression;
+ friend class SbiConstExpression;
+ union {
+ sal_uInt16 nTypeStrId; // pooled String-ID, #i59791/#i45570 Now only for TypeOf
+ double nVal; // numeric value
+ SbVar aVar; // or variable
+ };
+ OUString aStrVal; // #i59791/#i45570 Store string directly
+ std::unique_ptr<SbiExprNode> pLeft; // left branch
+ std::unique_ptr<SbiExprNode> pRight; // right branch (NULL for unary ops)
+ SbiExprNode* pWithParent; // node, whose member is "this per with"
+ SbiNodeType eNodeType;
+ SbxDataType eType;
+ SbiToken eTok;
+ bool bError; // true: error
+ void FoldConstants(SbiParser*);
+ void FoldConstantsBinaryNode(SbiParser*);
+ void FoldConstantsUnaryNode(SbiParser*);
+ void CollectBits(); // converting numbers to strings
+ bool IsOperand() const
+ { return eNodeType != SbxNODE && eNodeType != SbxTYPEOF && eNodeType != SbxNEW; }
+ bool IsNumber() const;
+ bool IsLvalue() const; // true, if usable as Lvalue
+ void GenElement( SbiCodeGen&, SbiOpcode );
+
+public:
+ SbiExprNode();
+ SbiExprNode( double, SbxDataType );
+ SbiExprNode( const OUString& );
+ SbiExprNode( const SbiSymDef&, SbxDataType, SbiExprListPtr = nullptr );
+ SbiExprNode( std::unique_ptr<SbiExprNode>, SbiToken, std::unique_ptr<SbiExprNode> );
+ SbiExprNode( std::unique_ptr<SbiExprNode>, sal_uInt16 ); // #120061 TypeOf
+ SbiExprNode( sal_uInt16 ); // new <type>
+ ~SbiExprNode();
+
+ bool IsValid() const { return !bError; }
+ bool IsConstant() const // true: constant operand
+ { return eNodeType == SbxSTRVAL || eNodeType == SbxNUMVAL; }
+ void ConvertToIntConstIfPossible();
+ bool IsVariable() const;
+
+ void SetWithParent( SbiExprNode* p ) { pWithParent = p; }
+
+ SbxDataType GetType() const { return eType; }
+ void SetType( SbxDataType eTp ) { eType = eTp; }
+ SbiNodeType GetNodeType() const { return eNodeType; }
+ SbiSymDef* GetVar();
+ SbiSymDef* GetRealVar(); // last variable in x.y.z
+ SbiExprNode* GetRealNode(); // last node in x.y.z
+ const OUString& GetString() const { return aStrVal; }
+ short GetNumber() const { return static_cast<short>(nVal); }
+ SbiExprList* GetParameters() { return aVar.pPar; }
+
+ void Optimize(SbiParser*); // tree matching
+
+ void Gen( SbiCodeGen& rGen, RecursiveMode eRecMode = UNDEFINED ); // giving out a node
+};
+
+class SbiExpression {
+ friend class SbiExprList;
+protected:
+ OUString aArgName;
+ SbiParser* pParser;
+ std::unique_ptr<SbiExprNode> pExpr; // expression tree
+ SbiExprType eCurExpr; // type of expression
+ SbiExprMode m_eMode; // expression context
+ bool bBased; // true: easy DIM-part (+BASE)
+ bool bError;
+ bool bByVal; // true: ByVal-Parameter
+ bool bBracket; // true: Parameter list with brackets
+ sal_uInt16 nParenLevel;
+ std::unique_ptr<SbiExprNode> Term( const KeywordSymbolInfo* pKeywordSymbolInfo = nullptr );
+ std::unique_ptr<SbiExprNode> ObjTerm( SbiSymDef& );
+ std::unique_ptr<SbiExprNode> Operand( bool bUsedForTypeOf = false );
+ std::unique_ptr<SbiExprNode> Unary();
+ std::unique_ptr<SbiExprNode> Exp();
+ std::unique_ptr<SbiExprNode> MulDiv();
+ std::unique_ptr<SbiExprNode> IntDiv();
+ std::unique_ptr<SbiExprNode> Mod();
+ std::unique_ptr<SbiExprNode> AddSub();
+ std::unique_ptr<SbiExprNode> Cat();
+ std::unique_ptr<SbiExprNode> Like();
+ std::unique_ptr<SbiExprNode> VBA_Not();
+ std::unique_ptr<SbiExprNode> Comp();
+ std::unique_ptr<SbiExprNode> Boolean();
+public:
+ SbiExpression( SbiParser*, SbiExprType = SbSTDEXPR,
+ SbiExprMode eMode = EXPRMODE_STANDARD, const KeywordSymbolInfo* pKeywordSymbolInfo = nullptr ); // parsing Ctor
+ SbiExpression( SbiParser*, double, SbxDataType );
+ SbiExpression( SbiParser*, const SbiSymDef&, SbiExprListPtr = nullptr );
+ ~SbiExpression();
+ OUString& GetName() { return aArgName; }
+ void SetBased() { bBased = true; }
+ bool IsBased() const { return bBased; }
+ void SetByVal() { bByVal = true; }
+ bool IsBracket() const { return bBracket; }
+ bool IsValid() const { return pExpr->IsValid(); }
+ bool IsVariable() const { return pExpr->IsVariable(); }
+ bool IsLvalue() const { return pExpr->IsLvalue(); }
+ void ConvertToIntConstIfPossible() { pExpr->ConvertToIntConstIfPossible(); }
+ const OUString& GetString() const { return pExpr->GetString(); }
+ SbiSymDef* GetRealVar() { return pExpr->GetRealVar(); }
+ SbiExprNode* GetExprNode() { return pExpr.get(); }
+ SbxDataType GetType() const { return pExpr->GetType(); }
+ void Gen( RecursiveMode eRecMode = UNDEFINED );
+};
+
+class SbiConstExpression : public SbiExpression {
+ double nVal;
+ OUString aVal;
+ SbxDataType eType;
+public: // numeric constant
+ SbiConstExpression( SbiParser* );
+ SbxDataType GetType() const { return eType; }
+ const OUString& GetString() const { return aVal; }
+ double GetValue() const { return nVal; }
+ short GetShortValue();
+};
+
+class SbiExprList final { // class for parameters and dims
+ std::vector<std::unique_ptr<SbiExpression>> aData;
+ short nDim;
+ bool bError;
+ bool bBracket;
+public:
+ SbiExprList();
+ ~SbiExprList();
+ static SbiExprListPtr ParseParameters(SbiParser*, bool bStandaloneExpression = false, bool bPar = true);
+ static SbiExprListPtr ParseDimList( SbiParser* );
+ bool IsBracket() const { return bBracket; }
+ bool IsValid() const { return !bError; }
+ short GetSize() const { return aData.size(); }
+ short GetDims() const { return nDim; }
+ SbiExpression* Get( size_t );
+ void Gen( SbiCodeGen& rGen); // code generation
+ void addExpression( std::unique_ptr<SbiExpression>&& pExpr );
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/filefmt.hxx b/basic/source/inc/filefmt.hxx
new file mode 100644
index 000000000..eb1990087
--- /dev/null
+++ b/basic/source/inc/filefmt.hxx
@@ -0,0 +1,192 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_FILEFMT_HXX
+#define INCLUDED_BASIC_SOURCE_INC_FILEFMT_HXX
+
+class SvStream;
+
+// Version 2: data type of the return value for publics
+// Version 3: new opcodes
+// Version 4: new opcodes
+// Version 5: bug (entry of STATIC-variables in the init code)
+// Version 6: new opcodes and bug (construct globals, without ending the BASIC)
+// Version 7: correction concerning the WITH-Parsing
+// Version 8: correction concerning the IF-Parsing
+// Version 9: end init code with LEAVE, too, if no SUB/FUNCTION follows
+// Version A: #36374 at DIM AS NEW... construct variable too
+// Version B: #40689 reorganized static
+// Version C: #41606 bug at static
+// Version D: #42678 bug at RTL-function spc
+// Version E: #56204 DCREATE, to also construct arrays at DIM AS NEW
+// Version F: #57844 introduction of SvNumberformat::StringToDouble
+// Version 10: #29955 generate for-loop-level in Statement-PCodes
+// Version 11: #29955 force anew compilation because of build-inconsistences
+// Version 12: aoo#64377 increase code size that basic can handle
+// tdf#75973 support user defined types B_USERTYPES in password protected macros
+// Version 13: tdf#94617 store methods nStart information greater than sal_Int16 limit
+// tdf#57113 store UTF-16 strings after legacy 1-byte-encoded strings in pool (no
+// version number bump for backward compatibility; relies on magic number)
+//
+
+#define B_LEGACYVERSION 0x00000011
+#define B_EXT_IMG_VERSION 0x00000012
+#define B_CURVERSION 0x00000013
+
+// The file contains either a module- or a library-record.
+// Those records contain further records. Every record's got
+// the following header:
+
+// sal_uInt16 identifier
+// sal_uInt32 the record's length without the header
+// sal_uInt16 number of sub-elements
+
+// all the file-offsets in records are relative to the module's start!
+
+enum class FileOffset {
+ Library = 0x4C42, // BL Library Record
+ Module = 0x4D42, // BM Module Record
+ Name = 0x4E4D, // MN module name
+ Comment = 0x434D, // MC comment
+ Source = 0x4353, // SC source code
+ PCode = 0x4350, // PC p-code
+ OldPublics = 0x7550, // Pu publics
+ Publics = 0x5550, // PU publics
+ PoolDir = 0x4450, // PD symbol pool directory
+ SymPool = 0x5953, // SY symbol pool
+ StringPool = 0x5453, // ST symbol pool
+ LineRanges = 0x524C, // LR line ranges for publics
+ ModEnd = 0x454D, // ME module end
+ SbxObjects = 0x5853, // SX SBX objects
+ ExtSource = 0x5345, // ES extended source
+ UserTypes = 0x4369, // UT user defined types
+
+ LastValue = UserTypes
+};
+
+
+// A library record contains only module records
+// sal_uInt16 identifier BL
+// sal_uInt32 the record's length
+// sal_uInt16 number of modules
+
+// A module-record contains all the other record types
+// sal_uInt16 identifier BM
+// sal_uInt32 the record's length
+// sal_uInt16 1
+// Data:
+// sal_uInt32 version number
+// sal_uInt32 character set
+// sal_uInt32 starting address initialisation code
+// sal_uInt32 starting address sub main
+// sal_uInt32 reserved
+// sal_uInt32 reserved
+
+// module name, comment and source code:
+// sal_uInt16 identifier MN, MC or SC
+// sal_uInt32 the record's length
+// sal_uInt16 1
+// Data:
+// string instance
+
+// P-Code:
+// sal_uInt16 identifier PC
+// sal_uInt32 the record's length
+// sal_uInt16 1
+// Data:
+// the P-Code as bytesack
+
+// All symbols and strings are kept in a string-pool.
+// References to these strings are in this pool in the form of an index.
+
+// List of all publics:
+// sal_uInt16 identifier PU or Pu
+// sal_uInt32 the record's length
+// sal_uInt16 number of publics
+// Data for every public-entry:
+// sal_uInt16 string index
+// sal_uInt32 starting address in the p-code-image (sal_uInt16 for old publics)
+// sal_uInt16 data type of the return value (from version 2)
+
+// Register of the symbol tables:
+// sal_uInt16 identifier SP
+// sal_uInt32 the record's length
+// sal_uInt16 number of symbol tables
+// Data for every symbol table:
+// sal_uInt16 stringindex of the name
+// sal_uInt16 number of symbols
+// sal_uInt16 scope identifier
+
+// symbol table:
+// sal_uInt16 identifier SY
+// sal_uInt32 the record's length
+// sal_uInt16 number of symbols
+// Data:
+// sal_uInt16 stringindex of the name
+// sal_uInt16 number of symbols
+// Data for every symbol:
+// sal_uInt16 stringindex of the name
+// sal_uInt16 data type
+// sal_uInt16 length for STRING*n-symbols (0x8000: STATIC variable)
+
+// Stringpool:
+// sal_uInt16 identifier ST
+// sal_uInt32 the record's length
+// sal_uInt16 number of strings
+// Data for every string:
+// sal_uInt32 Offset in the block of all strings
+// the block of all strings (ASCIIZ) follows then
+
+// line ranges:
+// sal_uInt16 identifier LR
+// sal_uInt32 the record's length
+// sal_uInt16 number of strings
+// Data for every public:
+// sal_uInt16 1st line (Sub XXX)
+// sal_uInt16 2nd line (End Sub)
+
+// SBX-objects:
+// sal_uInt16 number of objects
+// ... object data
+
+// user defined types B_USERTYPES :
+// sal_uInt16 identifier UT
+// sal_uInt32 the record's length
+// sal_uInt16 number of types
+// Data for every user defined type:
+// string instance type name
+// sal_Int16 number of type members
+// Data for every type member:
+// string name
+// sal_Int16 type
+// sal_uInt32 flags
+// sal_Int16 hasObjects (0/1)
+// If hasObjects
+// If member type is nested type
+// string nested type name
+// Else (array declaration)
+// sal_Int16 isFixedSize (0/1)
+// sal_Int32 number of dimensions
+// Data for every dimension:
+// sal_Int32 lower bound
+// sal_Int32 upper bound
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/image.hxx b/basic/source/inc/image.hxx
new file mode 100644
index 000000000..ee1aaa416
--- /dev/null
+++ b/basic/source/inc/image.hxx
@@ -0,0 +1,104 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_IMAGE_HXX
+#define INCLUDED_BASIC_SOURCE_INC_IMAGE_HXX
+
+#include <basic/sbx.hxx>
+#include <rtl/ustring.hxx>
+#include "filefmt.hxx"
+#include <o3tl/typed_flags_set.hxx>
+
+// This class reads in the image that's been produced by the compiler
+// and manages the access to the single elements.
+
+enum class SbiImageFlags
+{
+ NONE = 0,
+ EXPLICIT = 0x0001, // OPTION EXPLICIT is active
+ COMPARETEXT = 0x0002, // OPTION COMPARE TEXT is active
+ INITCODE = 0x0004, // Init-Code does exist
+ CLASSMODULE = 0x0008, // OPTION ClassModule is active
+};
+namespace o3tl
+{
+ template<> struct typed_flags<SbiImageFlags> : is_typed_flags<SbiImageFlags, 0xf> {};
+}
+
+class SbiImage {
+ friend class SbiCodeGen; // compiler classes, that the private-
+
+ SbxArrayRef rTypes; // User defined types
+ SbxArrayRef rEnums; // Enum types
+ std::vector<sal_uInt32> mvStringOffsets; // StringId-Offsets
+ std::unique_ptr<sal_Unicode[]> pStrings; // StringPool
+ std::unique_ptr<char[]> pCode; // Code-Image
+ std::unique_ptr<char[]> pLegacyPCode; // Code-Image
+ bool bError;
+ SbiImageFlags nFlags;
+ sal_uInt32 nStringSize;
+ sal_uInt32 nCodeSize;
+ sal_uInt16 nLegacyCodeSize;
+ sal_uInt16 nDimBase; // OPTION BASE value
+ rtl_TextEncoding eCharSet;
+ // temporary management-variable:
+ short nStringIdx;
+ sal_uInt32 nStringOff; // current Pos in the stringbuffer
+ // routines for the compiler:
+ void MakeStrings( short ); // establish StringPool
+ void AddString( const OUString& );
+ void AddCode( std::unique_ptr<char[]>, sal_uInt32 );
+ void AddType(SbxObject const *);
+ void AddEnum(SbxObject *);
+
+public:
+ OUString aName; // macro name
+ OUString aOUSource; // source code
+ OUString aComment;
+ bool bInit;
+ bool bFirstInit;
+
+ SbiImage();
+ ~SbiImage();
+ void Clear();
+ bool Load( SvStream&, sal_uInt32& nVer );
+ // nVer is set to version
+ // of image
+ bool Save( SvStream&, sal_uInt32 = B_CURVERSION );
+ bool IsError() const { return bError; }
+
+ const char* GetCode() const { return pCode.get(); }
+ sal_uInt32 GetCodeSize() const { return nCodeSize; }
+ sal_uInt16 GetBase() const { return nDimBase; }
+ OUString GetString( short nId ) const;
+ const SbxObject* FindType (const OUString& aTypeName) const;
+
+ const SbxArrayRef& GetEnums() const { return rEnums; }
+
+ void SetFlag( SbiImageFlags n ) { nFlags |= n; }
+ bool IsFlag( SbiImageFlags n ) const { return bool(nFlags & n); }
+ sal_uInt16 CalcLegacyOffset( sal_Int32 nOffset );
+ sal_uInt32 CalcNewOffset( sal_Int16 nOffset );
+ void ReleaseLegacyBuffer();
+ bool ExceedsLegacyLimits();
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/iosys.hxx b/basic/source/inc/iosys.hxx
new file mode 100644
index 000000000..4931b86a3
--- /dev/null
+++ b/basic/source/inc/iosys.hxx
@@ -0,0 +1,112 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_IOSYS_HXX
+#define INCLUDED_BASIC_SOURCE_INC_IOSYS_HXX
+
+#include <memory>
+#include <tools/stream.hxx>
+#include <o3tl/typed_flags_set.hxx>
+
+class SvStream;
+
+// Global files (channel numbers 256 to 511) are not
+// implemented at the moment.
+
+#define CHANNELS 256
+
+enum class SbiStreamFlags
+{
+ NONE = 0x0000,
+ Input = 0x0001,
+ Output = 0x0002,
+ Random = 0x0004,
+ Append = 0x0008,
+ Binary = 0x0010,
+};
+namespace o3tl
+{
+ template<> struct typed_flags<SbiStreamFlags> : is_typed_flags<SbiStreamFlags, 0x1f> {};
+}
+
+class SbiStream
+{
+ std::unique_ptr<SvStream> pStrm;
+ sal_uInt64 nExpandOnWriteTo; // during writing access expand the stream to this size
+ OString aLine;
+ sal_uInt64 nLine;
+ short nLen; // buffer length
+ SbiStreamFlags nMode;
+ ErrCode nError;
+ void MapError();
+
+public:
+ SbiStream();
+ ~SbiStream();
+ ErrCode const & Open( const OString&, StreamMode, SbiStreamFlags, short );
+ ErrCode const & Close();
+ ErrCode Read(OString&, sal_uInt16 = 0, bool bForceReadingPerByte=false);
+ ErrCode const & Read( char& );
+ ErrCode Write( const OString& );
+
+ bool IsText() const { return !bool(nMode & SbiStreamFlags::Binary); }
+ bool IsRandom() const { return bool(nMode & SbiStreamFlags::Random); }
+ bool IsBinary() const { return bool(nMode & SbiStreamFlags::Binary); }
+ bool IsSeq() const { return !bool(nMode & SbiStreamFlags::Random); }
+ bool IsAppend() const { return bool(nMode & SbiStreamFlags::Append); }
+ short GetBlockLen() const { return nLen; }
+ SbiStreamFlags GetMode() const { return nMode; }
+ sal_uInt64 GetLine() const { return nLine; }
+ void SetExpandOnWriteTo( sal_uInt64 n ) { nExpandOnWriteTo = n; }
+ void ExpandFile();
+ SvStream* GetStrm() { return pStrm.get(); }
+};
+
+class SbiIoSystem
+{
+ SbiStream* pChan[ CHANNELS ];
+ OString aPrompt;
+ OString aIn;
+ OUString aOut;
+ short nChan;
+ ErrCode nError;
+ void ReadCon(OString&);
+ void WriteCon(const OUString&);
+public:
+ SbiIoSystem();
+ ~SbiIoSystem() COVERITY_NOEXCEPT_FALSE;
+ ErrCode GetError();
+ void Shutdown();
+ void SetPrompt(const OString& r) { aPrompt = r; }
+ void SetChannel( short n ) { nChan = n; }
+ short GetChannel() const { return nChan;}
+ void ResetChannel() { nChan = 0; }
+ void Open( short, const OString&, StreamMode, SbiStreamFlags, short );
+ void Close();
+ void Read(OString&);
+ char Read();
+ void Write(const OUString&);
+ // 0 == bad channel or no SvStream (nChannel=0..CHANNELS-1)
+ SbiStream* GetStream( short nChannel ) const;
+ void CloseAll(); // JSM
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/namecont.hxx b/basic/source/inc/namecont.hxx
new file mode 100644
index 000000000..3a86f059c
--- /dev/null
+++ b/basic/source/inc/namecont.hxx
@@ -0,0 +1,660 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_NAMECONT_HXX
+#define INCLUDED_BASIC_SOURCE_INC_NAMECONT_HXX
+
+#include <unordered_map>
+#include <com/sun/star/uno/XComponentContext.hpp>
+#include <com/sun/star/lang/XInitialization.hpp>
+#include <com/sun/star/script/XStorageBasedLibraryContainer.hpp>
+#include <com/sun/star/script/XLibraryContainerPassword.hpp>
+#include <com/sun/star/script/XLibraryContainerExport.hpp>
+#include <com/sun/star/script/XLibraryQueryExecutable.hpp>
+#include <com/sun/star/script/XLibraryContainer3.hpp>
+#include <com/sun/star/container/XNameContainer.hpp>
+#include <com/sun/star/container/XContainer.hpp>
+#include <com/sun/star/ucb/XSimpleFileAccess3.hpp>
+#include <com/sun/star/io/XOutputStream.hpp>
+#include <com/sun/star/io/XInputStream.hpp>
+#include <com/sun/star/util/XStringSubstitution.hpp>
+#include <com/sun/star/document/XStorageBasedDocument.hpp>
+#include <com/sun/star/lang/XServiceInfo.hpp>
+#include <com/sun/star/frame/XModel.hpp>
+#include <com/sun/star/deployment/XPackage.hpp>
+#include <com/sun/star/script/vba/XVBACompatibility.hpp>
+#include <com/sun/star/script/vba/XVBAScriptListener.hpp>
+#include <com/sun/star/util/XChangesNotifier.hpp>
+
+#include <osl/mutex.hxx>
+#include <unotools/eventlisteneradapter.hxx>
+#include <cppuhelper/implbase.hxx>
+#include <cppuhelper/compbase.hxx>
+#include <cppuhelper/weakref.hxx>
+#include <cppuhelper/component.hxx>
+#include <cppuhelper/basemutex.hxx>
+#include <rtl/ref.hxx>
+#include <comphelper/listenernotification.hxx>
+#include <xmlscript/xmllib_imexp.hxx>
+
+class BasicManager;
+
+namespace basic
+{
+typedef ::cppu::WeakImplHelper<
+ css::container::XNameContainer,
+ css::container::XContainer,
+ css::util::XChangesNotifier > NameContainer_BASE;
+
+
+class NameContainer : public ::cppu::BaseMutex, public NameContainer_BASE
+{
+ typedef std::unordered_map < OUString, sal_Int32 > NameContainerNameMap;
+
+ NameContainerNameMap mHashMap;
+ std::vector< OUString > mNames;
+ std::vector< css::uno::Any > mValues;
+ sal_Int32 mnElementCount;
+
+ css::uno::Type mType;
+ css::uno::XInterface* mpxEventSource;
+
+ ::comphelper::OInterfaceContainerHelper2 maContainerListeners;
+ ::comphelper::OInterfaceContainerHelper2 maChangesListeners;
+
+public:
+ NameContainer( const css::uno::Type& rType )
+ : mnElementCount( 0 )
+ , mType( rType )
+ , mpxEventSource( nullptr )
+ , maContainerListeners( m_aMutex )
+ , maChangesListeners( m_aMutex )
+ {}
+
+ void setEventSource( css::uno::XInterface* pxEventSource )
+ { mpxEventSource = pxEventSource; }
+
+ /// @throws css::lang::IllegalArgumentException
+ /// @throws css::container::ElementExistException
+ /// @throws css::lang::WrappedTargetException
+ /// @throws css::uno::RuntimeException
+ void insertCheck(const OUString& aName, const css::uno::Any& aElement);
+
+ /// @throws css::lang::IllegalArgumentException
+ /// @throws css::lang::WrappedTargetException
+ /// @throws css::uno::RuntimeException
+ void insertNoCheck(const OUString& aName, const css::uno::Any& aElement);
+
+ // Methods XElementAccess
+ virtual css::uno::Type SAL_CALL getElementType( ) override;
+ virtual sal_Bool SAL_CALL hasElements( ) override;
+
+ // Methods XNameAccess
+ virtual css::uno::Any SAL_CALL getByName( const OUString& aName ) override;
+ virtual css::uno::Sequence< OUString > SAL_CALL getElementNames( ) override;
+ virtual sal_Bool SAL_CALL hasByName( const OUString& aName ) override;
+
+ // Methods XNameReplace
+ virtual void SAL_CALL replaceByName( const OUString& aName, const css::uno::Any& aElement ) override;
+
+ // Methods XNameContainer
+ virtual void SAL_CALL insertByName( const OUString& aName, const css::uno::Any& aElement ) override;
+ virtual void SAL_CALL removeByName( const OUString& Name ) override;
+
+ // Methods XContainer
+ virtual void SAL_CALL addContainerListener( const css::uno::Reference<css::container::XContainerListener >& xListener ) override;
+ virtual void SAL_CALL removeContainerListener( const css::uno::Reference<css::container::XContainerListener >& xListener ) override;
+
+ // Methods XChangesNotifier
+ virtual void SAL_CALL addChangesListener( const css::uno::Reference<css::util::XChangesListener >& xListener ) override;
+ virtual void SAL_CALL removeChangesListener( const css::uno::Reference<css::util::XChangesListener >& xListener ) override;
+};
+
+
+class ModifiableHelper
+{
+private:
+ ::comphelper::OInterfaceContainerHelper2 m_aModifyListeners;
+ ::cppu::OWeakObject& m_rEventSource;
+ bool mbModified;
+
+public:
+ ModifiableHelper( ::cppu::OWeakObject& _rEventSource, ::osl::Mutex& _rMutex )
+ :m_aModifyListeners( _rMutex )
+ ,m_rEventSource( _rEventSource )
+ ,mbModified( false )
+ {
+ }
+
+ bool isModified() const { return mbModified; }
+ void setModified( bool _bModified );
+
+ void addModifyListener( const css::uno::Reference< css::util::XModifyListener >& _rxListener )
+ {
+ m_aModifyListeners.addInterface( _rxListener );
+ }
+
+ void removeModifyListener( const css::uno::Reference< css::util::XModifyListener >& _rxListener )
+ {
+ m_aModifyListeners.removeInterface( _rxListener );
+ }
+};
+
+
+typedef ::comphelper::OListenerContainerBase<
+ css::script::vba::XVBAScriptListener,
+ css::script::vba::VBAScriptEvent > VBAScriptListenerContainer_BASE;
+
+class VBAScriptListenerContainer : public VBAScriptListenerContainer_BASE
+{
+public:
+ explicit VBAScriptListenerContainer( ::osl::Mutex& rMutex );
+
+private:
+ virtual bool implTypedNotify(
+ const css::uno::Reference< css::script::vba::XVBAScriptListener >& rxListener,
+ const css::script::vba::VBAScriptEvent& rEvent ) override;
+};
+
+
+class SfxLibrary;
+
+typedef ::cppu::WeakComponentImplHelper<
+ css::lang::XInitialization,
+ css::script::XStorageBasedLibraryContainer,
+ css::script::XLibraryContainerPassword,
+ css::script::XLibraryContainerExport,
+ css::script::XLibraryContainer3,
+ css::container::XContainer,
+ css::script::XLibraryQueryExecutable,
+ css::script::vba::XVBACompatibility,
+ css::lang::XServiceInfo > SfxLibraryContainer_BASE;
+
+class SfxLibraryContainer
+ : public ::cppu::BaseMutex
+ , public SfxLibraryContainer_BASE
+ , public ::utl::OEventListenerAdapter
+{
+ VBAScriptListenerContainer maVBAScriptListeners;
+ sal_Int32 mnRunningVBAScripts;
+ bool mbVBACompat;
+ OUString msProjectName;
+protected:
+ css::uno::Reference< css::uno::XComponentContext > mxContext;
+ css::uno::Reference< css::ucb::XSimpleFileAccess3 > mxSFI;
+ css::uno::Reference< css::util::XStringSubstitution > mxStringSubstitution;
+ css::uno::WeakReference< css::frame::XModel > mxOwnerDocument;
+
+ ModifiableHelper maModifiable;
+
+ rtl::Reference<NameContainer> maNameContainer;
+ bool mbOldInfoFormat;
+ bool mbOasis2OOoFormat;
+
+ OUString maInitialDocumentURL;
+ OUString maInfoFileName;
+ OUString maOldInfoFileName;
+ OUString maLibElementFileExtension;
+ OUString maLibraryPath;
+ OUString maLibrariesDir;
+
+ css::uno::Reference< css::embed::XStorage > mxStorage;
+ BasicManager* mpBasMgr;
+ bool mbOwnBasMgr;
+
+ enum InitMode
+ {
+ DEFAULT,
+ CONTAINER_INIT_FILE,
+ LIBRARY_INIT_FILE,
+ OFFICE_DOCUMENT,
+ OLD_BASIC_STORAGE
+ } meInitMode;
+
+ void implStoreLibrary( SfxLibrary* pLib,
+ const OUString& rName,
+ const css::uno::Reference< css::embed::XStorage >& rStorage );
+
+ // New variant for library export
+ void implStoreLibrary( SfxLibrary* pLib,
+ const OUString& rName,
+ const css::uno::Reference< css::embed::XStorage >& rStorage,
+ const OUString& rTargetURL,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& rToUseSFI,
+ const css::uno::Reference< css::task::XInteractionHandler >& rHandler );
+
+ void implStoreLibraryIndexFile( SfxLibrary* pLib, const ::xmlscript::LibDescriptor& rLib,
+ const css::uno::Reference< css::embed::XStorage >& xStorage );
+
+ // New variant for library export
+ void implStoreLibraryIndexFile( SfxLibrary* pLib, const ::xmlscript::LibDescriptor& rLib,
+ const css::uno::Reference< css::embed::XStorage >& xStorage,
+ const OUString& aTargetURL,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& rToUseSFI );
+
+ bool implLoadLibraryIndexFile( SfxLibrary* pLib,
+ ::xmlscript::LibDescriptor& rLib,
+ const css::uno::Reference< css::embed::XStorage >& xStorage,
+ const OUString& aIndexFileName );
+
+ void implImportLibDescriptor( SfxLibrary* pLib, ::xmlscript::LibDescriptor const & rLib );
+
+ // Methods to distinguish between different library types
+ virtual SfxLibrary* implCreateLibrary( const OUString& aName ) = 0;
+ virtual SfxLibrary* implCreateLibraryLink
+ ( const OUString& aName, const OUString& aLibInfoFileURL,
+ const OUString& StorageURL, bool ReadOnly ) = 0;
+ virtual css::uno::Any createEmptyLibraryElement() = 0;
+ virtual bool isLibraryElementValid(const css::uno::Any& rElement) const = 0;
+ /// @throws css::uno::Exception
+ virtual void writeLibraryElement
+ (
+ const css::uno::Reference< css::container::XNameContainer>& xLibrary,
+ const OUString& aElementName,
+ const css::uno::Reference< css::io::XOutputStream >& xOutput
+ ) = 0;
+
+ virtual css::uno::Any importLibraryElement
+ (
+ const css::uno::Reference< css::container::XNameContainer>& xLibrary,
+ const OUString& aElementName,
+ const OUString& aFile,
+ const css::uno::Reference< css::io::XInputStream >& xElementStream ) = 0;
+ virtual void importFromOldStorage( const OUString& aFile ) = 0;
+
+ // Password encryption
+ virtual bool implStorePasswordLibrary( SfxLibrary* pLib, const OUString& aName,
+ const css::uno::Reference< css::embed::XStorage >& xStorage, const css::uno::Reference< css::task::XInteractionHandler >& Handler );
+
+ // New variant for library export
+ virtual bool implStorePasswordLibrary( SfxLibrary* pLib, const OUString& aName,
+ const css::uno::Reference< css::embed::XStorage >& rStorage,
+ const OUString& aTargetURL,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& rToUseSFI, const css::uno::Reference< css::task::XInteractionHandler >& Handler );
+
+ /// @throws css::lang::WrappedTargetException
+ /// @throws css::uno::RuntimeException
+ virtual bool implLoadPasswordLibrary( SfxLibrary* pLib, const OUString& Name,
+ bool bVerifyPasswordOnly=false );
+
+ virtual void onNewRootStorage() = 0;
+
+
+ // #56666, Creates another library container
+ // instance of the same derived class
+ virtual SfxLibraryContainer* createInstanceImpl() = 0;
+
+
+ // Interface to get the BasicManager (Hack for password implementation)
+ BasicManager* getBasicManager();
+ OUString createAppLibraryFolder( SfxLibrary* pLib, const OUString& aName );
+
+ void init( const OUString& rInitialDocumentURL,
+ const css::uno::Reference< css::embed::XStorage >& _rxInitialStorage );
+
+ virtual const char* getInfoFileName() const = 0;
+ virtual const char* getOldInfoFileName() const = 0;
+ virtual const char* getLibElementFileExtension() const = 0;
+ virtual const char* getLibrariesDir() const = 0;
+
+ // Handle maLibInfoFileURL and maStorageURL correctly
+ void checkStorageURL
+ (
+ const OUString& aSourceURL,
+ OUString& aLibInfoFileURL,
+ OUString& aStorageURL,
+ OUString& aUnexpandedStorageURL
+ );
+ /// @throws css::uno::RuntimeException
+ OUString expand_url( const OUString& url );
+
+ SfxLibrary* getImplLib( const OUString& rLibraryName );
+
+ void storeLibraries_Impl(
+ const css::uno::Reference< css::embed::XStorage >& xStorage,
+ bool bComplete );
+
+ void initializeFromDocument( const css::uno::Reference< css::document::XStorageBasedDocument >& _rxDocument );
+
+ // OEventListenerAdapter
+ virtual void _disposing( const css::lang::EventObject& _rSource ) override;
+
+ // OComponentHelper
+ virtual void SAL_CALL disposing() override;
+
+private:
+ void init_Impl( const OUString& rInitialDocumentURL,
+ const css::uno::Reference< css::embed::XStorage >& _rxInitialStorage );
+ void implScanExtensions();
+
+public:
+ SfxLibraryContainer();
+ virtual ~SfxLibraryContainer() override;
+
+
+ // Interface to set the BasicManager (Hack for password implementation)
+ void setBasicManager( BasicManager* pBasMgr )
+ {
+ mpBasMgr = pBasMgr;
+ }
+
+ void enterMethod();
+ static void leaveMethod();
+
+ // Methods XElementAccess
+ virtual css::uno::Type SAL_CALL getElementType() override;
+ virtual sal_Bool SAL_CALL hasElements() override;
+
+ // Methods XNameAccess
+ virtual css::uno::Any SAL_CALL getByName( const OUString& aName ) override;
+ virtual css::uno::Sequence< OUString > SAL_CALL getElementNames() override;
+ virtual sal_Bool SAL_CALL hasByName( const OUString& aName ) override;
+
+ // Members XStorageBasedLibraryContainer
+ virtual css::uno::Reference< css::embed::XStorage > SAL_CALL getRootStorage() override;
+ virtual void SAL_CALL setRootStorage( const css::uno::Reference< css::embed::XStorage >& _rootstorage ) override;
+ virtual void SAL_CALL storeLibrariesToStorage( const css::uno::Reference< css::embed::XStorage >& RootStorage ) override;
+
+ // Methods XModifiable (base of XPersistentLibraryContainer)
+ virtual sal_Bool SAL_CALL isModified( ) override;
+ virtual void SAL_CALL setModified( sal_Bool bModified ) override;
+ virtual void SAL_CALL addModifyListener( const css::uno::Reference< css::util::XModifyListener >& aListener ) override;
+ virtual void SAL_CALL removeModifyListener( const css::uno::Reference< css::util::XModifyListener >& aListener ) override;
+
+ // Methods XPersistentLibraryContainer (base of XStorageBasedLibraryContainer)
+ virtual css::uno::Any SAL_CALL getRootLocation() override;
+ virtual OUString SAL_CALL getContainerLocationName() override;
+ virtual void SAL_CALL storeLibraries( ) override;
+
+ //Methods XLibraryContainer3
+ virtual OUString SAL_CALL getOriginalLibraryLinkURL( const OUString& Name ) override;
+
+ // Methods XLibraryContainer2 (base of XPersistentLibraryContainer)
+ virtual sal_Bool SAL_CALL isLibraryLink( const OUString& Name ) override;
+ virtual OUString SAL_CALL getLibraryLinkURL( const OUString& Name ) override;
+ virtual sal_Bool SAL_CALL isLibraryReadOnly( const OUString& Name ) override;
+ virtual void SAL_CALL setLibraryReadOnly( const OUString& Name, sal_Bool bReadOnly ) override;
+ virtual void SAL_CALL renameLibrary( const OUString& Name, const OUString& NewName ) override;
+
+ // Methods XLibraryContainer (base of XLibraryContainer2)
+ virtual css::uno::Reference< css::container::XNameContainer > SAL_CALL
+ createLibrary( const OUString& Name ) override;
+ virtual css::uno::Reference< css::container::XNameAccess > SAL_CALL createLibraryLink
+ ( const OUString& Name, const OUString& StorageURL, sal_Bool ReadOnly ) override;
+ virtual void SAL_CALL removeLibrary( const OUString& Name ) override;
+ virtual sal_Bool SAL_CALL isLibraryLoaded( const OUString& Name ) override;
+ virtual void SAL_CALL loadLibrary( const OUString& Name ) override;
+
+ // Methods XInitialization
+ virtual void SAL_CALL initialize( const css::uno::Sequence<
+ css::uno::Any >& aArguments ) override;
+
+ // Methods XLibraryContainerPassword
+ virtual sal_Bool SAL_CALL isLibraryPasswordProtected( const OUString& Name ) override;
+ virtual sal_Bool SAL_CALL isLibraryPasswordVerified( const OUString& Name ) override;
+ virtual sal_Bool SAL_CALL verifyLibraryPassword( const OUString& Name, const OUString& Password ) override;
+ virtual void SAL_CALL changeLibraryPassword( const OUString& Name,
+ const OUString& OldPassword, const OUString& NewPassword ) override;
+
+ // Methods XContainer
+ virtual void SAL_CALL addContainerListener( const css::uno::Reference<
+ css::container::XContainerListener >& xListener ) override;
+ virtual void SAL_CALL removeContainerListener( const css::uno::Reference<
+ css::container::XContainerListener >& xListener ) override;
+
+ // Methods XLibraryContainerExport
+ virtual void SAL_CALL exportLibrary( const OUString& Name, const OUString& URL,
+ const css::uno::Reference< css::task::XInteractionHandler >& Handler ) override;
+
+ // Methods XServiceInfo
+ virtual OUString SAL_CALL getImplementationName( ) override = 0;
+ virtual sal_Bool SAL_CALL supportsService( const OUString& ServiceName ) override;
+ virtual css::uno::Sequence< OUString > SAL_CALL getSupportedServiceNames( ) override = 0;
+ // Methods XVBACompatibility
+ virtual sal_Bool SAL_CALL getVBACompatibilityMode() override;
+ virtual void SAL_CALL setVBACompatibilityMode( sal_Bool _vbacompatmodeon ) override;
+ virtual OUString SAL_CALL getProjectName() override { return msProjectName; }
+ virtual void SAL_CALL setProjectName( const OUString& _projectname ) override;
+ virtual sal_Int32 SAL_CALL getRunningVBAScripts() override;
+ virtual void SAL_CALL addVBAScriptListener(
+ const css::uno::Reference< css::script::vba::XVBAScriptListener >& Listener ) override;
+ virtual void SAL_CALL removeVBAScriptListener(
+ const css::uno::Reference< css::script::vba::XVBAScriptListener >& Listener ) override;
+ virtual void SAL_CALL broadcastVBAScriptEvent( sal_Int32 nIdentifier, const OUString& rModuleName ) override;
+};
+
+
+class LibraryContainerMethodGuard
+{
+public:
+ LibraryContainerMethodGuard( SfxLibraryContainer& _rContainer )
+ {
+ _rContainer.enterMethod();
+ }
+
+ ~LibraryContainerMethodGuard()
+ {
+ basic::SfxLibraryContainer::leaveMethod();
+ }
+};
+
+
+class SfxLibrary
+ : public css::container::XNameContainer
+ , public css::container::XContainer
+ , public css::util::XChangesNotifier
+ , public ::cppu::BaseMutex
+ , public ::cppu::OComponentHelper
+{
+ friend class SfxLibraryContainer;
+ friend class SfxDialogLibraryContainer;
+ friend class SfxScriptLibraryContainer;
+
+ css::uno::Reference< css::ucb::XSimpleFileAccess3 > mxSFI;
+
+ ModifiableHelper& mrModifiable;
+ rtl::Reference<NameContainer> maNameContainer;
+
+ bool mbLoaded;
+ bool mbIsModified;
+ bool mbInitialised;
+
+private:
+
+ OUString maLibElementFileExtension;
+ OUString maLibInfoFileURL;
+ OUString maStorageURL;
+ OUString maUnexpandedStorageURL;
+ OUString maOriginalStorageURL;
+
+ bool mbLink;
+ bool mbReadOnly;
+ bool mbReadOnlyLink;
+ bool mbPreload;
+
+protected:
+ bool mbPasswordProtected;
+private:
+ bool mbPasswordVerified;
+ bool mbDoc50Password;
+ OUString maPassword;
+
+ bool mbSharedIndexFile;
+ bool mbExtension;
+
+ // Additional functionality for localisation
+ // Provide modify state including resources
+ virtual bool isModified() = 0;
+ virtual void storeResources() = 0;
+ virtual void storeResourcesAsURL( const OUString& URL, const OUString& NewName ) = 0;
+ virtual void storeResourcesToURL( const OUString& URL,
+ const css::uno::Reference< css::task::XInteractionHandler >& xHandler ) = 0;
+ virtual void storeResourcesToStorage( const css::uno::Reference< css::embed::XStorage >& xStorage ) = 0;
+
+protected:
+ bool implIsModified() const { return mbIsModified; }
+ void implSetModified( bool _bIsModified );
+
+private:
+ /** checks whether the lib is readonly, or a readonly link, throws an IllegalArgumentException if so
+ */
+ void impl_checkReadOnly();
+ /** checks whether the library is loaded, throws a LibraryNotLoadedException (wrapped in a WrappedTargetException),
+ if not.
+ */
+ void impl_checkLoaded();
+
+private:
+ void impl_removeWithoutChecks( const OUString& _rElementName );
+
+public:
+ SfxLibrary(
+ ModifiableHelper& _rModifiable,
+ const css::uno::Type& aType,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& xSFI
+ );
+ SfxLibrary(
+ ModifiableHelper& _rModifiable,
+ const css::uno::Type& aType,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& xSFI,
+ const OUString& aLibInfoFileURL,
+ const OUString& aStorageURL,
+ bool ReadOnly
+ );
+
+ // Methods XInterface
+ virtual css::uno::Any SAL_CALL queryInterface( const css::uno::Type& rType ) override;
+ virtual void SAL_CALL acquire() throw() override { OComponentHelper::acquire(); }
+ virtual void SAL_CALL release() throw() override { OComponentHelper::release(); }
+
+ // Methods XElementAccess
+ virtual css::uno::Type SAL_CALL getElementType( ) override;
+ virtual sal_Bool SAL_CALL hasElements( ) override;
+
+ // Methods XNameAccess
+ virtual css::uno::Any SAL_CALL getByName( const OUString& aName ) override;
+ virtual css::uno::Sequence< OUString > SAL_CALL getElementNames( ) override;
+ virtual sal_Bool SAL_CALL hasByName( const OUString& aName ) override;
+
+ // Methods XNameReplace
+ virtual void SAL_CALL replaceByName( const OUString& aName, const css::uno::Any& aElement ) override;
+
+ // Methods XNameContainer
+ virtual void SAL_CALL insertByName( const OUString& aName, const css::uno::Any& aElement ) override;
+ virtual void SAL_CALL removeByName( const OUString& Name ) override;
+
+ // XTypeProvider
+ css::uno::Sequence< css::uno::Type > SAL_CALL getTypes( ) override;
+ css::uno::Sequence<sal_Int8> SAL_CALL getImplementationId( ) override;
+
+ // Methods XContainer
+ virtual void SAL_CALL addContainerListener( const css::uno::Reference<
+ css::container::XContainerListener >& xListener ) override;
+ virtual void SAL_CALL removeContainerListener( const css::uno::Reference<
+ css::container::XContainerListener >& xListener ) override;
+
+ // Methods XChangesNotifier
+ virtual void SAL_CALL addChangesListener( const css::uno::Reference<
+ css::util::XChangesListener >& xListener ) override;
+ virtual void SAL_CALL removeChangesListener( const css::uno::Reference<
+ css::util::XChangesListener >& xListener ) override;
+
+public:
+ struct LibraryContainerAccess { friend class SfxLibraryContainer; private: LibraryContainerAccess() { } };
+ void removeElementWithoutChecks( const OUString& _rElementName, LibraryContainerAccess )
+ {
+ impl_removeWithoutChecks( _rElementName );
+ }
+
+protected:
+ virtual bool isLoadedStorable();
+
+ virtual bool isLibraryElementValid(const css::uno::Any& rElement) const = 0;
+};
+
+
+class ScriptSubPackageIterator
+{
+ css::uno::Reference< css::deployment::XPackage > m_xMainPackage;
+
+ bool m_bIsValid;
+ bool m_bIsBundle;
+
+ css::uno::Sequence< css::uno::Reference< css::deployment::XPackage > > m_aSubPkgSeq;
+ sal_Int32 m_nSubPkgCount;
+ sal_Int32 m_iNextSubPkg;
+
+ static css::uno::Reference< css::deployment::XPackage >
+ implDetectScriptPackage( const css::uno::Reference
+ < css::deployment::XPackage >& rPackage, bool& rbPureDialogLib );
+
+public:
+ ScriptSubPackageIterator( css::uno::Reference< css::deployment::XPackage > const & xMainPackage );
+
+ css::uno::Reference< css::deployment::XPackage > getNextScriptSubPackage( bool& rbPureDialogLib );
+};
+
+
+class ScriptExtensionIterator final
+{
+public:
+ ScriptExtensionIterator();
+ OUString nextBasicOrDialogLibrary( bool& rbPureDialogLib );
+
+private:
+ css::uno::Reference< css::deployment::XPackage >
+ implGetNextUserScriptPackage( bool& rbPureDialogLib );
+ css::uno::Reference< css::deployment::XPackage >
+ implGetNextSharedScriptPackage( bool& rbPureDialogLib );
+ css::uno::Reference< css::deployment::XPackage >
+ implGetNextBundledScriptPackage( bool& rbPureDialogLib );
+
+ css::uno::Reference< css::uno::XComponentContext > m_xContext;
+
+ enum IteratorState
+ {
+ USER_EXTENSIONS,
+ SHARED_EXTENSIONS,
+ BUNDLED_EXTENSIONS,
+ END_REACHED
+ } m_eState;
+
+ css::uno::Sequence< css::uno::Reference< css::deployment::XPackage > > m_aUserPackagesSeq;
+ bool m_bUserPackagesLoaded;
+
+ css::uno::Sequence< css::uno::Reference< css::deployment::XPackage > > m_aSharedPackagesSeq;
+ bool m_bSharedPackagesLoaded;
+
+ css::uno::Sequence< css::uno::Reference< css::deployment::XPackage > > m_aBundledPackagesSeq;
+ bool m_bBundledPackagesLoaded;
+
+ int m_iUserPackage;
+ int m_iSharedPackage;
+ int m_iBundledPackage;
+
+ ScriptSubPackageIterator* m_pScriptSubPackageIterator;
+
+}; // end class ScriptExtensionIterator
+
+
+} // namespace basic
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/opcodes.hxx b/basic/source/inc/opcodes.hxx
new file mode 100644
index 000000000..cb9711036
--- /dev/null
+++ b/basic/source/inc/opcodes.hxx
@@ -0,0 +1,159 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_OPCODES_HXX
+#define INCLUDED_BASIC_SOURCE_INC_OPCODES_HXX
+
+// An opcode can have a length of 1, 3 or 5 bytes,
+// depending on its numeric value (see below).
+
+enum class SbiOpcode {
+ // all opcodes without operands
+ NOP_ = 0,
+
+ SbOP0_START = NOP_,
+
+ // operators
+ // the following operators are ordered
+ // the same way as the enum SbxVarOp
+ EXP_, MUL_, DIV_, MOD_, PLUS_, MINUS_, NEG_,
+ EQ_, NE_, LT_, GT_, LE_, GE_,
+ IDIV_, AND_, OR_, XOR_, EQV_, IMP_, NOT_,
+ CAT_,
+ // end of enum SbxVarOp
+ LIKE_, IS_,
+ // load/save
+ ARGC_, // establish new Argv
+ ARGV_, // TOS ==> current Argv
+ INPUT_, // Input ==> TOS
+ LINPUT_, // Line Input ==> TOS
+ GET_, // touch TOS
+ SET_, // save object TOS ==> TOS-1
+ PUT_, // TOS ==> TOS-1
+ PUTC_, // TOS ==> TOS-1, then ReadOnly
+ DIM_, // DIM
+ REDIM_, // REDIM
+ REDIMP_, // REDIM PRESERVE
+ ERASE_, // delete TOS
+ // branch
+ STOP_, // end of program
+ INITFOR_, // initialize FOR-variable
+ NEXT_, // increment FOR-variable
+ CASE_, // beginning CASE
+ ENDCASE_, // end CASE
+ STDERROR_, // standard error handling
+ NOERROR_, // no error handling
+ LEAVE_, // leave UP
+ // E/A
+ CHANNEL_, // TOS = channel number
+ BPRINT_, // print TOS
+ PRINTF_, // print TOS in field
+ BWRITE_, // write TOS
+ RENAME_, // Rename Tos+1 to Tos
+ PROMPT_, // TOS = Prompt for Input
+ RESTART_, // define restart point
+ CHAN0_, // I/O-channel 0
+ // miscellaneous
+ EMPTY_, // empty expression on stack
+ ERROR_, // TOS = error code
+ LSET_, // saving object TOS ==> TOS-1
+ RSET_, // saving object TOS ==> TOS-1
+ REDIMP_ERASE_, // Copies array to be later used by REDIM PRESERVE before erasing it
+ INITFOREACH_,
+ VBASET_, // VBA-like Set
+ ERASE_CLEAR_, // Erase array and clear variable
+ ARRAYACCESS_, // Assign parameters to TOS and get value, used for array of arrays
+ BYVAL_, // byref -> byval for lvalue parameter passed in call
+
+ SbOP0_END = BYVAL_,
+
+ // all opcodes with one operand
+
+ NUMBER_ = 0x40, // loading a numeric constant (+ID)
+
+ SbOP1_START = NUMBER_,
+
+ SCONST_, // loading a string constant (+ID)
+ CONST_, // Immediate Load (+ value)
+ ARGN_, // saving a named Arg in Argv (+StringID)
+ PAD_, // bring string to a firm length (+length)
+ // branch
+ JUMP_, // jump (+target)
+ JUMPT_, // evaluate TOS, conditional jump (+target)
+ JUMPF_, // evaluate TOS, conditional jump (+target)
+ ONJUMP_, // evaluate TOS, jump into JUMP-table (+MaxVal)
+ GOSUB_, // UP-call (+Target)
+ RETURN_, // UP-return (+0 or Target)
+ TESTFOR_, // test FOR-variable, increment (+Endlabel)
+ CASETO_, // Tos+1 <= Case <= Tos, 2xremove (+Target)
+ ERRHDL_, // error handler (+Offset)
+ RESUME_, // Resume after errors (+0 or 1 or Label)
+ // E/A
+ CLOSE_, // (+channel/0)
+ PRCHAR_, // (+char)
+ // management
+ SETCLASS_, // test set + class names (+StringId)
+ TESTCLASS_, // Check TOS class (+StringId)
+ LIB_, // set lib name for declare-procs (+StringId)
+ BASED_, // TOS is incremented by BASE, BASE is pushed before (+base)
+ // type adjustment in the Argv
+ ARGTYP_, // convert last parameter in Argv (+type)
+ VBASETCLASS_, // VBA-like Set
+
+ SbOP1_END = VBASETCLASS_,
+
+ // all opcodes with two operands
+
+ RTL_ = 0x80, // load from the RTL (+StringID+Typ)
+
+ SbOP2_START = RTL_,
+
+ FIND_, // load (+StringID+Typ)
+ ELEM_, // load element (+StringID+Typ)
+ PARAM_, // parameters (+Offset+Typ)
+ // branch
+ CALL_, // call DECLARE-method (+StringID+Typ)
+ CALLC_, // call Cdecl-DECLARE-Method (+StringID+Typ)
+ CASEIS_, // case-test (+Test-Opcode+True-Target)
+ // management
+ STMNT_, // begin of a statement (+Line+Col)
+ // E/A
+ OPEN_, // (+StreamMode+Flags)
+ // objects
+ LOCAL_, // define locals variables (+StringID+Typ)
+ PUBLIC_, // module global variables (+StringID+Typ)
+ GLOBAL_, // define global variables, public command (+StringID+Typ)
+ CREATE_, // create object (+StringId+StringID)
+ STATIC_, // static variable (+StringID+Typ) JSM
+ TCREATE_, // create user-defined object
+ DCREATE_, // create object-array (+StringId+StringID)
+ GLOBAL_P_, // define global variable that's not overwritten on restarting
+ // the Basic, P=PERSIST (+StringID+Typ)
+ FIND_G_, // finds global variable with special treatment due to GLOBAL_P_
+ DCREATE_REDIMP_, // redimension object-array (+StringId+StringID)
+ FIND_CM_, // Search inside a class module (CM) to enable global search in time
+ PUBLIC_P_, // Module global Variable (persisted between calls)(+StringID+Typ)
+ FIND_STATIC_, // local static var lookup (+StringID+Typ)
+
+ SbOP2_END = FIND_STATIC_
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/parser.hxx b/basic/source/inc/parser.hxx
new file mode 100644
index 000000000..88f4f34b2
--- /dev/null
+++ b/basic/source/inc/parser.hxx
@@ -0,0 +1,144 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_PARSER_HXX
+#define INCLUDED_BASIC_SOURCE_INC_PARSER_HXX
+
+#include "expr.hxx"
+#include "codegen.hxx"
+#include "symtbl.hxx"
+#include <basic/sbx.hxx>
+
+#include <vector>
+
+struct SbiParseStack;
+
+class SbiParser : public SbiTokenizer
+{
+ friend class SbiExpression;
+
+ SbiParseStack* pStack;
+ SbiProcDef* pProc;
+ SbiExprNode* pWithVar;
+ SbiToken eEndTok;
+ sal_uInt32 nGblChain; // for global DIMs
+ bool bGblDefs; // true: global definitions general
+ bool bNewGblDefs; // true: globale definitions before sub
+ bool bSingleLineIf;
+ bool bCodeCompleting;
+
+ SbiSymDef* VarDecl( SbiExprListPtr*, bool, bool );
+ SbiProcDef* ProcDecl(bool bDecl);
+ void DefStatic( bool bPrivate );
+ void DefProc( bool bStatic, bool bPrivate ); // read in procedure
+ void DefVar( SbiOpcode eOp, bool bStatic ); // read in DIM/REDIM
+ void TypeDecl( SbiSymDef&, bool bAsNewAlreadyParsed=false ); // AS-declaration
+ void OpenBlock( SbiToken, SbiExprNode* = nullptr );
+ void CloseBlock();
+ bool Channel( bool bAlways=false ); // parse channel number
+ void StmntBlock( SbiToken );
+ void DefType(); // Parse type declaration
+ void DefEnum( bool bPrivate ); // Parse enum declaration
+ void DefDeclare( bool bPrivate );
+ void EnableCompatibility();
+ static bool IsUnoInterface( const OUString& sTypeName );
+public:
+ SbxArrayRef rTypeArray;
+ SbxArrayRef rEnumArray;
+ SbiStringPool aGblStrings; // string-pool
+ SbiStringPool aLclStrings; // string-pool
+ SbiSymPool aGlobals;
+ SbiSymPool aPublics; // module global
+ SbiSymPool aRtlSyms; // Runtime-Library
+ SbiCodeGen aGen; // Code-Generator
+ SbiSymPool* pPool;
+ short nBase; // OPTION BASE-value
+ bool bExplicit; // true: OPTION EXPLICIT
+ bool bClassModule; // true: OPTION ClassModule
+ std::vector<OUString> aIfaceVector; // Holds all interfaces implemented by a class module
+ std::vector<OUString> aRequiredTypes; // Types used in Dim As New <type> outside subs
+# define N_DEF_TYPES 26
+ SbxDataType eDefTypes[N_DEF_TYPES]; // DEFxxx data types
+
+ SbiParser( StarBASIC*, SbModule* );
+ ~SbiParser( );
+ bool Parse();
+ void SetCodeCompleting( bool b );
+ bool IsCodeCompleting() const { return bCodeCompleting;}
+ SbiExprNode* GetWithVar();
+
+ // from 31.3.1996, search symbol in the runtime-library
+ SbiSymDef* CheckRTLForSym( const OUString& rSym, SbxDataType eType );
+ void AddConstants();
+
+ bool HasGlobalCode();
+
+ bool TestToken( SbiToken );
+ bool TestSymbol();
+ bool TestComma();
+ void TestEoln();
+
+ void Symbol( const KeywordSymbolInfo* pKeywordSymbolInfo ); // let or call
+ void ErrorStmnt(); // ERROR n
+ void BadBlock(); // LOOP/WEND/NEXT
+ void NoIf(); // ELSE/ELSE IF without IF
+ void Assign(); // LET
+ void Attribute();
+ void Call(); // CALL
+ void Close(); // CLOSE
+ void Declare(); // DECLARE
+ void DefXXX(); // DEFxxx
+ void Dim(); // DIM
+ void ReDim(); // ReDim();
+ void Erase(); // ERASE
+ void Exit(); // EXIT
+ void For(); // FOR...NEXT
+ void Goto(); // GOTO / GOSUB
+ void If(); // IF
+ void Implements(); // IMPLEMENTS
+ void Input(); // INPUT, INPUT #
+ void Line(); // LINE -> LINE INPUT [#] (#i92642)
+ void LineInput(); // LINE INPUT, LINE INPUT #
+ void LSet(); // LSET
+ void Name(); // NAME .. AS ..
+ void On(); // ON ERROR/variable
+ void OnGoto(); // ON...GOTO / GOSUB
+ void Open(); // OPEN
+ void Option(); // OPTION
+ void Print(); // PRINT, PRINT #
+ void SubFunc(); // SUB / FUNCTION
+ void Resume(); // RESUME
+ void Return(); // RETURN
+ void RSet(); // RSET
+ void DoLoop(); // DO...LOOP
+ void Select(); // SELECT ... CASE
+ void Set(); // SET
+ void Static(); // STATIC
+ void Stop(); // STOP/SYSTEM
+ void Type(); // TYPE...AS...END TYPE
+ void Enum(); // TYPE...END ENUM
+ void While(); // WHILE/WEND
+ void With(); // WITH
+ void Write(); // WRITE
+};
+
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/propacc.hxx b/basic/source/inc/propacc.hxx
new file mode 100644
index 000000000..c00673055
--- /dev/null
+++ b/basic/source/inc/propacc.hxx
@@ -0,0 +1,79 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+#ifndef INCLUDED_BASIC_SOURCE_INC_PROPACC_HXX
+#define INCLUDED_BASIC_SOURCE_INC_PROPACC_HXX
+
+#include <com/sun/star/beans/PropertyValue.hpp>
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/beans/XPropertySetInfo.hpp>
+#include <com/sun/star/beans/XPropertyAccess.hpp>
+#include <cppuhelper/implbase.hxx>
+
+#include <vector>
+
+typedef std::vector<css::beans::PropertyValue> SbPropertyValueArr_Impl;
+
+typedef ::cppu::WeakImplHelper< css::beans::XPropertySet,
+ css::beans::XPropertyAccess > SbPropertyValuesHelper;
+
+
+class SbPropertyValues: public SbPropertyValuesHelper
+{
+ SbPropertyValueArr_Impl m_aPropVals;
+ css::uno::Reference< css::beans::XPropertySetInfo > m_xInfo;
+
+private:
+ size_t GetIndex_Impl( const OUString &rPropName ) const;
+
+public:
+ SbPropertyValues();
+ virtual ~SbPropertyValues() override;
+
+ // XPropertySet
+ virtual css::uno::Reference< css::beans::XPropertySetInfo > SAL_CALL
+ getPropertySetInfo() override;
+ virtual void SAL_CALL setPropertyValue(
+ const OUString& aPropertyName,
+ const css::uno::Any& aValue) override;
+ virtual css::uno::Any SAL_CALL getPropertyValue( const OUString& PropertyName ) override;
+ virtual void SAL_CALL addPropertyChangeListener(
+ const OUString& aPropertyName,
+ const css::uno::Reference< css::beans::XPropertyChangeListener >& ) override;
+ virtual void SAL_CALL removePropertyChangeListener(
+ const OUString& aPropertyName,
+ const css::uno::Reference< css::beans::XPropertyChangeListener >& ) override;
+ virtual void SAL_CALL addVetoableChangeListener(
+ const OUString& aPropertyName,
+ const css::uno::Reference< css::beans::XVetoableChangeListener >& ) override;
+ virtual void SAL_CALL removeVetoableChangeListener(
+ const OUString& aPropertyName,
+ const css::uno::Reference< css::beans::XVetoableChangeListener >& ) override;
+
+ // XPropertyAccess
+ virtual css::uno::Sequence< css::beans::PropertyValue > SAL_CALL getPropertyValues() override;
+ virtual void SAL_CALL setPropertyValues(const css::uno::Sequence< css::beans::PropertyValue >& PropertyValues_) override;
+};
+
+class SbxArray;
+
+void RTL_Impl_CreatePropertySet( SbxArray& rPar );
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/rtlproto.hxx b/basic/source/inc/rtlproto.hxx
new file mode 100644
index 000000000..6e26f9316
--- /dev/null
+++ b/basic/source/inc/rtlproto.hxx
@@ -0,0 +1,365 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_RTLPROTO_HXX
+#define INCLUDED_BASIC_SOURCE_INC_RTLPROTO_HXX
+
+#include <basic/sbstar.hxx>
+
+#define RTLNAME( name ) &SbRtl_##name
+
+typedef void( *RtlCall ) ( StarBASIC* p, SbxArray& rArgs, bool bWrite );
+
+// Properties
+
+extern void SbRtl_Date(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Err(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Erl(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_False(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Empty(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Nothing(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Null(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_True(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_ATTR_NORMAL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ATTR_READONLY(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ATTR_HIDDEN(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ATTR_SYSTEM(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ATTR_VOLUME(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ATTR_DIRECTORY(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ATTR_ARCHIVE(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_V_EMPTY(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_NULL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_INTEGER(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_LONG(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_SINGLE(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_DOUBLE(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_CURRENCY(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_DATE(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_V_STRING(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_MB_OK(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_OKCANCEL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_ABORTRETRYIGNORE(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_YESNOCANCEL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_YESNO(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_RETRYCANCEL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_ICONSTOP(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_ICONQUESTION(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_ICONEXCLAMATION(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_ICONINFORMATION(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_DEFBUTTON1(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_DEFBUTTON2(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_DEFBUTTON3(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_APPLMODAL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MB_SYSTEMMODAL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_IDOK(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IDCANCEL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IDABORT(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IDRETRY(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IDYES(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IDNO(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_CF_TEXT(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CF_BITMAP(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CF_METAFILEPICT(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_PI(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_SET_OFF(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_SET_ON(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TOGGLE(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_TYP_AUTHORFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_CHAPTERFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_CONDTXTFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DATEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DBFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DBNAMEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DBNEXTSETFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DBNUMSETFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DBSETNUMBERFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DDEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DOCINFOFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_DOCSTATFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_EXTUSERFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_FILENAMEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_FIXDATEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_FIXTIMEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_FORMELFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_GETFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_GETREFFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_HIDDENPARAFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_HIDDENTXTFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_INPUTFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_MACROFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_NEXTPAGEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_PAGENUMBERFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_POSTITFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_PREVPAGEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_SEQFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_SETFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_SETINPFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_SETREFFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_TEMPLNAMEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_TIMEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_USERFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_USRINPFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_SETREFPAGEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_GETREFPAGEFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_INTERNETFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TYP_JUMPEDITFLD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_FRAMEANCHORPAGE(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FRAMEANCHORPARA(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FRAMEANCHORCHAR(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_CLEAR_ALLTABS(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CLEAR_TAB(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_SET_TAB(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+// Methods
+
+extern void SbRtl_CreateObject(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Error(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Sin(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Abs(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Asc(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Atn(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Chr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ChrW(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Cos(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CurDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ChDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_ChDrive(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_FileCopy(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_Kill(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_MkDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_RmDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_SendKeys(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_DDB(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DimArray(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Dir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DoEvents(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Exp(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FileLen(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Fix(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FV(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Hex(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Input(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_InStr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_InStrRev(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Int(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IPmt(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IRR(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Join(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_LCase(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Left(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Log(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_LTrim(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Mid(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MIRR(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_NPer(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_NPV(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Oct(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Pmt(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_PPmt(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_PV(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Rate(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Replace(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Right(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_RTrim(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_RTL(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Sgn(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_SLN(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Space(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Split(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Sqr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Str(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_StrComp(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_String(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_StrReverse(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_SYD(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Tab(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Tan(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_UCase(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Val(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Len(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Spc(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DateSerial(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TimeSerial(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DateValue(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TimeValue(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Day(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Hour(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Minute(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Month(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MonthName(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Now(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Second(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Time(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Timer(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Weekday(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_WeekdayName(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Year(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_InputBox(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Me(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_MsgBox(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsArray(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsDate(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsEmpty(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsError(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsNull(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsNumeric(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsObject(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsUnoStruct(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_FileDateTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Format(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FormatNumber(StarBASIC* pBasic, SbxArray& rPar, bool bWrite);
+extern void SbRtl_GetAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Randomize(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_Round(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Frac(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Rnd(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Shell(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_VarType(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TypeName(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TypeLen(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_EOF(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FileAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Loc(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Lof(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Seek(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_SetAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_Reset(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+
+extern void SbRtl_DDEInitiate(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DDETerminate(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DDETerminateAll(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DDERequest(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DDEExecute(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DDEPoke(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_FreeFile(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_IsMissing(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_LBound(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_UBound(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_RGB(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_QBColor(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_StrConv(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_Beep(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_Load(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Unload(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_LoadPicture(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_SavePicture(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_CallByName(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CBool(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CByte(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CCur(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CDate(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CDbl(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CInt(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CLng(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CSng(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CStr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CVar(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+extern void SbRtl_CVErr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+
+extern void SbRtl_Iif(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
+
+extern void SbRtl_DumpAllObjects(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_GetSystemType(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetGUIType(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Red(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Green(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Blue(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_Switch(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Wait(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+//i#64882# add new WaitUntil
+extern void SbRtl_WaitUntil(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FuncCaller(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_GetGUIVersion(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Choose(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Trim(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_DateAdd(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DateDiff(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_DatePart(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FormatDateTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetSolarVersion(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TwipsPerPixelX(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_TwipsPerPixelY(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FreeLibrary(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Array(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FindObject(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FindPropertyObject(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_EnableReschedule(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_Put(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Get(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_Environ(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetDialogZoomFactorX(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetDialogZoomFactorY(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetSystemTicks(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetPathSeparator(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ResolvePath(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CreateUnoStruct(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CreateUnoService(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CreateUnoServiceWithArguments(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CreateUnoValue(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetProcessServiceManager(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GetDefaultContext(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CreatePropertySet(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CreateUnoListener(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_HasUnoInterfaces(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_EqualUnoObjects(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CreateUnoDialog(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_GlobalScope(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FileExists(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ConvertToUrl(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_ConvertFromUrl(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateToUnoDate(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateFromUnoDate(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateToUnoTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateFromUnoTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateToUnoDateTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateFromUnoDateTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateToIso(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDateFromIso(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CompatibilityMode(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_CDec(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+
+extern void SbRtl_Partition(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // Fong
+
+extern double Now_Impl();
+extern void Wait_Impl( bool bDurationBased, SbxArray& rPar );
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/runtime.hxx b/basic/source/inc/runtime.hxx
new file mode 100644
index 000000000..65be051e7
--- /dev/null
+++ b/basic/source/inc/runtime.hxx
@@ -0,0 +1,421 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_RUNTIME_HXX
+#define INCLUDED_BASIC_SOURCE_INC_RUNTIME_HXX
+
+#include <basic/sberrors.hxx>
+#include <basic/sbmeth.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/sbx.hxx>
+
+#include <rtl/ustring.hxx>
+#include <com/sun/star/uno/Sequence.hxx>
+#include <osl/file.hxx>
+#include <rtl/math.hxx>
+#include <i18nlangtag/lang.h>
+
+#include <vector>
+#include <memory>
+#include <com/sun/star/lang/XComponent.hpp>
+#include <com/sun/star/container/XEnumeration.hpp>
+#include <unotools/localedatawrapper.hxx>
+#include <o3tl/deleter.hxx>
+#include <o3tl/typed_flags_set.hxx>
+
+class SbiInstance; // active StarBASIC process
+class SbiRuntime; // active StarBASIC procedure instance
+
+struct SbiArgv; // Argv stack element
+struct SbiGosub; // GOSUB stack element
+class SbiImage; // Code-Image
+class SbiIoSystem;
+class SbiDdeControl;
+class SbiDllMgr;
+class SvNumberFormatter; // time/date functions
+enum class SbiImageFlags;
+
+enum class ForType {
+ To,
+ EachArray,
+ EachCollection,
+ EachXEnumeration,
+ Error,
+};
+
+struct SbiForStack { // for/next stack:
+ SbiForStack* pNext; // Chain
+ SbxVariableRef refVar; // loop variable
+ SbxVariableRef refEnd; // end expression / for each: Array/BasicCollection object
+ SbxVariableRef refInc; // increment expression
+
+ // For each support
+ ForType eForType;
+ sal_Int32 nCurCollectionIndex;
+ std::unique_ptr<sal_Int32[]>
+ pArrayCurIndices;
+ std::unique_ptr<sal_Int32[]>
+ pArrayLowerBounds;
+ std::unique_ptr<sal_Int32[]>
+ pArrayUpperBounds;
+ css::uno::Reference< css::container::XEnumeration > xEnumeration;
+
+ SbiForStack()
+ : pNext(nullptr)
+ , eForType(ForType::To)
+ , nCurCollectionIndex(0)
+ {}
+};
+
+#define MAXRECURSION 500 //to prevent dead-recursions
+
+enum class SbAttributes {
+ NONE = 0x0000,
+ READONLY = 0x0001,
+ HIDDEN = 0x0002,
+ DIRECTORY = 0x0010
+};
+
+namespace o3tl
+{
+ template<> struct typed_flags<SbAttributes> : is_typed_flags<SbAttributes, 0x13> {};
+}
+
+class WildCard;
+
+class SbiRTLData
+{
+public:
+
+ std::unique_ptr<osl::Directory> pDir;
+ SbAttributes nDirFlags;
+ short nCurDirPos;
+
+ OUString sFullNameToBeChecked;
+ std::unique_ptr<WildCard> pWildCard;
+
+ css::uno::Sequence< OUString > aDirSeq;
+
+ SbiRTLData();
+ ~SbiRTLData();
+};
+
+// The instance matches a running StarBASIC. Many basics running at the same
+// time are managed by chained instances. There is all the data that only lives
+// when the BASIC is living too, like the I/O-system.
+
+typedef std::vector< css::uno::Reference< css::lang::XComponent > > ComponentVector_t;
+
+
+class SbiInstance
+{
+ friend class SbiRuntime;
+
+ SbiRTLData aRTLData;
+
+ // file system
+ std::unique_ptr<SbiIoSystem, o3tl::default_delete<SbiIoSystem>> pIosys;
+ // DDE
+ std::unique_ptr<SbiDdeControl> pDdeCtrl;
+ // DLL-Calls (DECLARE)
+ std::unique_ptr<SbiDllMgr> pDllMgr;
+ std::shared_ptr<SvNumberFormatter> pNumberFormatter;
+ StarBASIC* pBasic;
+ LanguageType meFormatterLangType;
+ DateOrder meFormatterDateOrder;
+ sal_uInt32 nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx;
+
+ ErrCode nErr;
+ OUString aErrorMsg; // last error message for $ARG
+ sal_Int32 nErl; // current error line
+ bool bReschedule; // Flag: sal_True = Reschedule in main loop
+ bool bCompatibility; // Flag: sal_True = VBA runtime compatibility mode
+
+ ComponentVector_t ComponentVector;
+public:
+ SbiRuntime* pRun; // Call-Stack
+
+ // #31460 new concept for StepInto/Over/Out,
+ // explanation see runtime.cxx at SbiInstance::CalcBreakCallLevel()
+ sal_uInt16 nCallLvl;
+ sal_uInt16 nBreakCallLvl;
+ void CalcBreakCallLevel( BasicDebugFlags nFlags );
+
+ SbiInstance( StarBASIC* );
+ ~SbiInstance();
+
+ void Error( ErrCode ); // trappable Error
+ void Error( ErrCode, const OUString& rMsg ); // trappable Error with message
+ void ErrorVB( sal_Int32 nVBNumber, const OUString& rMsg );
+ void setErrorVB( sal_Int32 nVBNumber );
+ void FatalError( ErrCode ); // non-trappable Error
+ void FatalError( ErrCode, const OUString& ); // non-trappable Error
+ void Abort(); // with current error code
+
+ void Stop();
+ ErrCode const & GetErr() const { return nErr; }
+ const OUString& GetErrorMsg() const { return aErrorMsg; }
+ sal_Int32 GetErl() const { return nErl; }
+ void EnableReschedule( bool bEnable ) { bReschedule = bEnable; }
+ bool IsReschedule() const { return bReschedule; }
+ void EnableCompatibility( bool bEnable ) { bCompatibility = bEnable; }
+ bool IsCompatibility() const { return bCompatibility; }
+
+ ComponentVector_t& getComponentVector() { return ComponentVector; }
+
+ SbMethod* GetCaller( sal_uInt16 );
+ SbModule* GetActiveModule();
+
+ SbiIoSystem* GetIoSystem() { return pIosys.get(); }
+ SbiDdeControl* GetDdeControl() { return pDdeCtrl.get(); }
+ StarBASIC* GetBasic() { return pBasic; }
+ SbiDllMgr* GetDllMgr();
+ SbiRTLData& GetRTLData() const { return const_cast<SbiRTLData&>(aRTLData); }
+
+ std::shared_ptr<SvNumberFormatter> const & GetNumberFormatter();
+ sal_uInt32 GetStdDateIdx() const { return nStdDateIdx; }
+ sal_uInt32 GetStdTimeIdx() const { return nStdTimeIdx; }
+ sal_uInt32 GetStdDateTimeIdx() const { return nStdDateTimeIdx; }
+
+ // offer NumberFormatter also static
+ static std::shared_ptr<SvNumberFormatter> PrepareNumberFormatter( sal_uInt32 &rnStdDateIdx,
+ sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx,
+ LanguageType const * peFormatterLangType=nullptr, DateOrder const * peFormatterDateOrder=nullptr );
+};
+
+// There's one instance of this class for every executed sub-program.
+// This instance is the heart of the BASIC-machine and contains only local data.
+
+class SbiRuntime
+{
+ friend void SbRtl_CallByName( StarBASIC* pBasic, SbxArray& rPar, bool bWrite );
+
+ typedef void( SbiRuntime::*pStep0 )();
+ typedef void( SbiRuntime::*pStep1 )( sal_uInt32 nOp1 );
+ typedef void( SbiRuntime::*pStep2 )( sal_uInt32 nOp1, sal_uInt32 nOp2 );
+ static pStep0 aStep0[]; // opcode-table group 0
+ static pStep1 aStep1[];
+ static pStep2 aStep2[];
+
+ StarBASIC& rBasic; // StarBASIC instance
+ SbiInstance* pInst; // current thread
+ SbModule* pMod; // current module
+ SbMethod* pMeth; // method instance
+ SbiIoSystem* pIosys; // I/O-System
+ const SbiImage* pImg; // Code-Image
+ SbxArrayRef refExprStk; // expression stack
+ SbxArrayRef refCaseStk; // CASE expression stack
+ SbxArrayRef refRedimpArray; // Array saved to use for REDIM PRESERVE
+ SbxVariableRef refRedim; // Array saved to use for REDIM
+ SbxVariableRef xDummyVar; // substitute for variables that weren't found
+ SbxVariable* mpExtCaller; // Caller ( external - e.g. button name, shape, range object etc. - only in vba mode )
+ SbiForStack* pForStk; // FOR/NEXT-Stack
+ sal_uInt16 nExprLvl; // depth of the expr-stack
+ sal_uInt16 nForLvl; // #118235: Maintain for level
+ const sal_uInt8* pCode; // current Code-Pointer
+ const sal_uInt8* pStmnt; // beginning of the last statement
+ const sal_uInt8* pError; // address of the current error handler
+ const sal_uInt8* pRestart; // restart-address
+ const sal_uInt8* pErrCode; // restart-address RESUME NEXT
+ const sal_uInt8* pErrStmnt; // restart-address RESUME 0
+ OUString aLibName; // Lib-name for declare-call
+ SbxArrayRef refParams; // current procedure parameters
+ SbxArrayRef refLocals; // local variable
+ SbxArrayRef refArgv;
+ // #74254, one refSaveObj is not enough! new: pRefSaveList (see above)
+ short nArgc;
+ bool bRun;
+ bool bError; // true: handle errors
+ bool bInError; // true: in an error handler
+ bool bBlocked; // true: blocked by next call level, #i48868
+ bool bVBAEnabled;
+ BasicDebugFlags nFlags; // Debugging-Flags
+ ErrCode nError;
+ sal_uInt16 nOps; // opcode counter
+ sal_uInt32 m_nLastTime;
+
+ std::vector<SbxVariableRef> aRefSaved; // #74254 save temporary references
+ std::vector<SbiGosub> pGosubStk; // GOSUB stack
+ std::vector<SbiArgv> pArgvStk; // ARGV-Stack
+
+
+ SbxVariable* FindElement
+ ( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, ErrCode, bool bLocal, bool bStatic = false );
+ void SetupArgs( SbxVariable*, sal_uInt32 );
+ SbxVariable* CheckArray( SbxVariable* );
+
+ void PushVar( SbxVariable* );
+ SbxVariableRef PopVar();
+ SbxVariable* GetTOS();
+ void TOSMakeTemp();
+ void ClearExprStack();
+
+ void PushGosub( const sal_uInt8* );
+ void PopGosub();
+
+ void PushArgv();
+ void PopArgv();
+ void ClearArgvStack();
+
+ void PushFor();
+ void PushForEach();
+ void PopFor();
+ void ClearForStack();
+
+ void StepArith( SbxOperator );
+ void StepUnary( SbxOperator );
+ void StepCompare( SbxOperator );
+
+ void SetParameters( SbxArray* );
+
+ // HAS TO BE IMPLEMENTED SOME TIME
+ void DllCall( const OUString&, const OUString&, SbxArray*, SbxDataType, bool );
+
+ // #56204 swap out DIM-functionality into help method (step0.cxx)
+ void DimImpl(const SbxVariableRef& refVar);
+
+ static bool implIsClass( SbxObject const * pObj, const OUString& aClass );
+
+ void StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt );
+
+ // the following routines are called by the single
+ // stepper and implement the single opcodes
+ void StepNOP(), StepEXP(), StepMUL(), StepDIV();
+ void StepMOD(), StepPLUS(), StepMINUS(), StepNEG();
+ void StepEQ(), StepNE(), StepLT(), StepGT();
+ void StepLE(), StepGE(), StepIDIV(), StepAND();
+ void StepOR(), StepXOR(), StepEQV(), StepIMP();
+ void StepNOT(), StepCAT(), StepLIKE(), StepIS();
+ void StepARGC();
+ void StepARGV(), StepINPUT(), StepLINPUT(), StepSTOP();
+ void StepGET(), StepSET(), StepVBASET(), StepPUT(), StepPUTC();
+ void StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bDefaultHandling = false );
+ void StepDIM(), StepREDIM(), StepREDIMP(), StepERASE();
+ void StepINITFOR(), StepNEXT(), StepERROR(), StepINITFOREACH();
+ void StepCASE(), StepENDCASE(), StepSTDERROR();
+ void StepNOERROR(), StepCHANNEL(), StepCHANNEL0(), StepPRINT();
+ void StepPRINTF(), StepWRITE(), StepRENAME(), StepPROMPT();
+ void StepRESTART(), StepEMPTY(), StepLEAVE();
+ void StepLSET(), StepRSET(), StepREDIMP_ERASE(), StepERASE_CLEAR();
+ void StepARRAYACCESS(), StepBYVAL();
+ // all opcodes with one operand
+ void StepLOADNC( sal_uInt32 ), StepLOADSC( sal_uInt32 ), StepLOADI( sal_uInt32 );
+ void StepARGN( sal_uInt32 ), StepBASED( sal_uInt32 ), StepPAD( sal_uInt32 );
+ void StepJUMP( sal_uInt32 ), StepJUMPT( sal_uInt32 );
+ void StepJUMPF( sal_uInt32 ), StepONJUMP( sal_uInt32 );
+ void StepGOSUB( sal_uInt32 ), StepRETURN( sal_uInt32 );
+ void StepTESTFOR( sal_uInt32 ), StepCASETO( sal_uInt32 ), StepERRHDL( sal_uInt32 );
+ void StepRESUME( sal_uInt32 ), StepSETCLASS( sal_uInt32 ), StepVBASETCLASS( sal_uInt32 ), StepTESTCLASS( sal_uInt32 ), StepLIB( sal_uInt32 );
+ bool checkClass_Impl( const SbxVariableRef& refVal, const OUString& aClass, bool bRaiseErrors, bool bDefault );
+ void StepCLOSE( sal_uInt32 ), StepPRCHAR( sal_uInt32 ), StepARGTYP( sal_uInt32 );
+ // all opcodes with two operands
+ void StepRTL( sal_uInt32, sal_uInt32 ), StepPUBLIC( sal_uInt32, sal_uInt32 ), StepPUBLIC_P( sal_uInt32, sal_uInt32 );
+ void StepPUBLIC_Impl( sal_uInt32, sal_uInt32, bool bUsedForClassModule );
+ void StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2, ErrCode, bool bStatic = false );
+ void StepFIND( sal_uInt32, sal_uInt32 ), StepELEM( sal_uInt32, sal_uInt32 );
+ void StepGLOBAL( sal_uInt32, sal_uInt32 ), StepLOCAL( sal_uInt32, sal_uInt32 );
+ void StepPARAM( sal_uInt32, sal_uInt32), StepCREATE( sal_uInt32, sal_uInt32 );
+ void StepCALL( sal_uInt32, sal_uInt32 ), StepCALLC( sal_uInt32, sal_uInt32 );
+ void StepCASEIS( sal_uInt32, sal_uInt32 ), StepSTMNT( sal_uInt32, sal_uInt32 );
+ SbxVariable* StepSTATIC_Impl(
+ OUString const & aName, SbxDataType t, sal_uInt32 nOp2 );
+ void StepOPEN( sal_uInt32, sal_uInt32 ), StepSTATIC( sal_uInt32, sal_uInt32 );
+ void StepTCREATE(sal_uInt32,sal_uInt32), StepDCREATE(sal_uInt32,sal_uInt32);
+ void StepGLOBAL_P( sal_uInt32, sal_uInt32 ),StepFIND_G( sal_uInt32, sal_uInt32 );
+ void StepDCREATE_REDIMP(sal_uInt32,sal_uInt32), StepDCREATE_IMPL(sal_uInt32,sal_uInt32);
+ void StepFIND_CM( sal_uInt32, sal_uInt32 );
+ void StepFIND_STATIC( sal_uInt32, sal_uInt32 );
+ static void implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 );
+public:
+ void SetVBAEnabled( bool bEnabled );
+ bool IsImageFlag( SbiImageFlags n ) const;
+ sal_uInt16 GetBase() const;
+ sal_Int32 nLine,nCol1,nCol2;
+ SbiRuntime* pNext; // Stack-Chain
+
+ // tdf#79426, tdf#125180 - adds the information about a missing parameter
+ static void SetIsMissing( SbxVariable* );
+ // tdf#79426, tdf#125180 - checks if a variable contains the information about a missing parameter
+ static bool IsMissing( SbxVariable*, sal_uInt16 );
+
+ SbiRuntime( SbModule*, SbMethod*, sal_uInt32 );
+ ~SbiRuntime();
+ void Error( ErrCode, bool bVBATranslationAlreadyDone = false ); // set error if != 0
+ void Error( ErrCode, const OUString& ); // set error if != 0
+ void FatalError( ErrCode ); // error handling = standard, set error
+ void FatalError( ErrCode, const OUString& ); // error handling = standard, set error
+ static sal_Int32 translateErrorToVba( ErrCode nError, OUString& rMsg );
+ bool Step(); // single step (one opcode)
+ void Stop() { bRun = false; }
+ void block() { bBlocked = true; }
+ void unblock() { bBlocked = false; }
+ SbModule* GetModule() { return pMod; }
+ BasicDebugFlags GetDebugFlags() const { return nFlags; }
+ void SetDebugFlags( BasicDebugFlags nFl ) { nFlags = nFl; }
+ SbMethod* GetCaller() { return pMeth;}
+ SbxVariable* GetExternalCaller(){ return mpExtCaller; }
+
+ SbiForStack* FindForStackItemForCollection( class BasicCollection const * pCollection );
+
+ SbxBase* FindElementExtern( const OUString& rName );
+ static bool isVBAEnabled();
+
+};
+
+inline void checkArithmeticOverflow( double d )
+{
+ if( !std::isfinite( d ) )
+ StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW );
+}
+
+inline void checkArithmeticOverflow( SbxVariable const * pVar )
+{
+ if( pVar->GetType() == SbxDOUBLE )
+ {
+ double d = pVar->GetDouble();
+ checkArithmeticOverflow( d );
+ }
+}
+
+
+StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic );
+
+// Returns true if UNO is available, otherwise the old
+// file system implementation has to be used
+// (Implemented in iosys.cxx)
+bool hasUno();
+
+// Converts possibly relative paths to absolute paths
+// according to the setting done by ChDir/ChDrive
+// (Implemented in methods.cxx)
+OUString getFullPath( const OUString& aRelPath );
+
+// Implementation of StepRENAME with UCB
+// (Implemented in methods.cxx, so step0.cxx
+// has not to be infected with UNO)
+void implStepRenameUCB( const OUString& aSource, const OUString& aDest );
+
+void implStepRenameOSL( const OUString& aSource, const OUString& aDest );
+bool IsBaseIndexOne();
+
+void removeDimAsNewRecoverItem( SbxVariable* pVar );
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/sbintern.hxx b/basic/source/inc/sbintern.hxx
new file mode 100644
index 000000000..75e3ede9a
--- /dev/null
+++ b/basic/source/inc/sbintern.hxx
@@ -0,0 +1,118 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_SBINTERN_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SBINTERN_HXX
+
+#include <basic/basicdllapi.h>
+#include <basic/sbstar.hxx>
+#include <sbxfac.hxx>
+#include <unotools/transliterationwrapper.hxx>
+#include <vcl/errcode.hxx>
+
+namespace utl
+{
+ class TransliterationWrapper;
+}
+class SbUnoFactory;
+class SbTypeFactory;
+class SbOLEFactory;
+class SbFormFactory;
+class SbiInstance;
+class SbModule;
+class BasicManager;
+
+class SbiFactory : public SbxFactory
+{
+public:
+ virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 ) override;
+ virtual SbxObject* CreateObject( const OUString& ) override;
+};
+
+struct SbClassData
+{
+ SbxArrayRef mxIfaces;
+
+ // types this module depends on because of use in Dim As New <type>
+ // needed for initialization order of class modules
+ std::vector< OUString > maRequiredTypes;
+
+ SbClassData();
+ ~SbClassData()
+ { clear(); }
+ void clear();
+};
+
+// #115824: Factory class to create class objects (type command)
+// Implementation: sb.cxx
+class SbClassFactory : public SbxFactory
+{
+ SbxObjectRef xClassModules;
+
+public:
+ SbClassFactory();
+ virtual ~SbClassFactory() override;
+
+ void AddClassModule( SbModule* pClassModule );
+ void RemoveClassModule( SbModule* pClassModule );
+
+ virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 ) override;
+ virtual SbxObject* CreateObject( const OUString& ) override;
+
+ SbModule* FindClass( const OUString& rClassName );
+};
+
+struct SbiGlobals
+{
+ static SbiGlobals* pGlobals;
+ SbiInstance* pInst; // all active runtime instances
+ std::unique_ptr<SbiFactory> pSbFac; // StarBASIC-Factory
+ std::unique_ptr<SbUnoFactory> pUnoFac; // Factory for Uno-Structs at DIM AS NEW
+ SbTypeFactory* pTypeFac; // Factory for user defined types
+ SbClassFactory* pClassFac; // Factory for user defined classes (based on class modules)
+ SbOLEFactory* pOLEFac; // Factory for OLE types
+ SbFormFactory* pFormFac; // Factory for user forms
+ SbModule* pMod; // currently active module
+ SbModule* pCompMod; // currently compiled module
+ short nInst; // number of BASICs
+ Link<StarBASIC*,bool> aErrHdl; // global error handler
+ Link<StarBASIC*,BasicDebugFlags> aBreakHdl; // global break handler
+ ErrCode nCode;
+ sal_Int32 nLine;
+ sal_Int32 nCol1,nCol2; // from... to...
+ bool bCompilerError; // flag for compiler error
+ bool bGlobalInitErr;
+ bool bRunInit; // true, if RunInit active from the Basic
+ OUString aErrMsg; // buffer for GetErrorText()
+ std::unique_ptr<::utl::TransliterationWrapper> pTransliterationWrapper; // For StrComp
+ bool bBlockCompilerError;
+ std::unique_ptr<BasicManager> pAppBasMgr;
+ StarBASIC* pMSOMacroRuntimLib; // Lib containing MSO Macro Runtime API entry symbols
+
+ SbiGlobals();
+ ~SbiGlobals();
+};
+
+// utility macros and routines
+
+SbiGlobals* GetSbData();
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/sbjsmeth.hxx b/basic/source/inc/sbjsmeth.hxx
new file mode 100644
index 000000000..2e4abc509
--- /dev/null
+++ b/basic/source/inc/sbjsmeth.hxx
@@ -0,0 +1,42 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_SBJSMETH_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SBJSMETH_HXX
+
+#include <basic/sbmeth.hxx>
+
+// basic module for JavaScript sources
+// All the basic-specific methods must be overridden virtually and must
+// be deactivated. The differentiation of normal modules is done by RTTI.
+
+class SbJScriptMethod : public SbMethod
+{
+public:
+ SbJScriptMethod( SbxDataType );
+ virtual ~SbJScriptMethod() override;
+
+ SBX_DECL_PERSIST_NODATA(SBXID_JSCRIPTMETH,2);
+};
+
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/sbjsmod.hxx b/basic/source/inc/sbjsmod.hxx
new file mode 100644
index 000000000..9d2d7d8f4
--- /dev/null
+++ b/basic/source/inc/sbjsmod.hxx
@@ -0,0 +1,41 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_SBJSMOD_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SBJSMOD_HXX
+
+#include <basic/sbmod.hxx>
+
+// basic module for JavaScript sources
+// All the basic-specific methods must be overridden virtually and must
+// be deactivated. The differentiation of normal modules is done by RTTI.
+
+class SbJScriptModule : public SbModule
+{
+ virtual bool LoadData( SvStream&, sal_uInt16 ) override;
+ virtual bool StoreData( SvStream& ) const override;
+public:
+ SBX_DECL_PERSIST_NODATA(SBXID_JSCRIPTMOD,1);
+ SbJScriptModule(); // hand through
+};
+
+#endif
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/sbunoobj.hxx b/basic/source/inc/sbunoobj.hxx
new file mode 100644
index 000000000..6827bf755
--- /dev/null
+++ b/basic/source/inc/sbunoobj.hxx
@@ -0,0 +1,395 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+#ifndef INCLUDED_BASIC_SOURCE_INC_SBUNOOBJ_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SBUNOOBJ_HXX
+
+#include <basic/sbxobj.hxx>
+#include <basic/sbxmeth.hxx>
+#include <sbxprop.hxx>
+#include <sbxfac.hxx>
+#include <basic/sbx.hxx>
+#include <com/sun/star/beans/XMaterialHolder.hpp>
+#include <com/sun/star/beans/XExactName.hpp>
+#include <com/sun/star/beans/XIntrospectionAccess.hpp>
+#include <com/sun/star/lang/XComponent.hpp>
+#include <com/sun/star/script/XInvocation.hpp>
+#include <com/sun/star/reflection/XIdlClass.hpp>
+#include <com/sun/star/reflection/XServiceTypeDescription2.hpp>
+#include <rtl/ustring.hxx>
+#include <unordered_map>
+#include <vector>
+#include <map>
+
+void registerComponentToBeDisposedForBasic( const css::uno::Reference< css::lang::XComponent >& xComponent, StarBASIC* pBasic );
+
+class StructRefInfo
+{
+ css::uno::Any& maAny;
+ css::uno::Type maType;
+ sal_Int32 mnPos;
+public:
+ StructRefInfo( css::uno::Any& aAny, css::uno::Type const & rType, sal_Int32 nPos ) : maAny( aAny ), maType( rType ), mnPos( nPos ) {}
+
+ sal_Int32 getPos() const { return mnPos; }
+ const css::uno::Type& getType() const { return maType; }
+ OUString getTypeName() const;
+ css::uno::Any& getRootAnyRef() { return maAny; };
+
+ css::uno::TypeClass getTypeClass() const;
+
+ void* getInst();
+ bool isEmpty() const { return (mnPos == -1); }
+
+ css::uno::Any getValue();
+ void setValue( const css::uno::Any& );
+};
+
+class SbUnoStructRefObject: public SbxObject
+{
+ struct caseLessComp
+ {
+ bool operator() (const OUString& rProp, const OUString& rOtherProp ) const
+ {
+ return rProp.compareToIgnoreAsciiCase( rOtherProp ) < 0;
+ }
+ };
+ typedef std::map< OUString, std::unique_ptr<StructRefInfo>, caseLessComp > StructFieldInfo;
+ StructFieldInfo maFields;
+ StructRefInfo maMemberInfo;
+ bool mbMemberCacheInit;
+ void implCreateAll();
+ void implCreateDbgProperties();
+ void initMemberCache();
+ OUString Impl_DumpProperties();
+ OUString getDbgObjectName() const;
+public:
+ StructRefInfo getStructMember( const OUString& rMember );
+ const StructRefInfo& getStructInfo() const { return maMemberInfo; }
+ SbUnoStructRefObject( const OUString& aName_, const StructRefInfo& rMemberInfo );
+ virtual ~SbUnoStructRefObject() override;
+
+ // override Find to support e. g. NameAccess
+ virtual SbxVariable* Find( const OUString&, SbxClassType ) override;
+
+ // Force creation of all properties for debugging
+ void createAllProperties()
+ { implCreateAll(); }
+
+ // give out value
+ css::uno::Any getUnoAny();
+ void Notify( SfxBroadcaster&, const SfxHint& rHint ) override;
+};
+
+class SbUnoObject: public SbxObject
+{
+ css::uno::Reference< css::beans::XIntrospectionAccess > mxUnoAccess;
+ css::uno::Reference< css::beans::XMaterialHolder > mxMaterialHolder;
+ css::uno::Reference< css::script::XInvocation > mxInvocation;
+ css::uno::Reference< css::beans::XExactName > mxExactName;
+ css::uno::Reference< css::beans::XExactName > mxExactNameInvocation;
+ bool bNeedIntrospection;
+ bool bNativeCOMObject;
+ css::uno::Any maTmpUnoObj; // Only to save obj for doIntrospection!
+ std::shared_ptr< SbUnoStructRefObject > maStructInfo;
+ // help method to establish the dbg_-properties
+ void implCreateDbgProperties();
+
+ // help method to establish all properties and methods
+ // (on the on-demand-mechanism required for the dbg_-properties)
+ void implCreateAll();
+
+public:
+ static bool getDefaultPropName( SbUnoObject const * pUnoObj, OUString& sDfltProp );
+ SbUnoObject( const OUString& aName_, const css::uno::Any& aUnoObj_ );
+ virtual ~SbUnoObject() override;
+
+ // #76470 do introspection on demand
+ void doIntrospection();
+
+ // override Find to support e. g. NameAccess
+ virtual SbxVariable* Find( const OUString&, SbxClassType ) override;
+
+ // Force creation of all properties for debugging
+ void createAllProperties()
+ { implCreateAll(); }
+
+ // give out value
+ css::uno::Any getUnoAny();
+ const css::uno::Reference< css::beans::XIntrospectionAccess >& getIntrospectionAccess() const { return mxUnoAccess; }
+ const css::uno::Reference< css::script::XInvocation >& getInvocation() const { return mxInvocation; }
+
+ void Notify( SfxBroadcaster&, const SfxHint& rHint ) override;
+
+ bool isNativeCOMObject() const
+ { return bNativeCOMObject; }
+};
+typedef tools::SvRef<SbUnoObject> SbUnoObjectRef;
+
+// #67781 delete return values of the uno-methods
+void clearUnoMethods();
+void clearUnoMethodsForBasic( StarBASIC const * pBasic );
+
+class SbUnoMethod : public SbxMethod
+{
+ friend class SbUnoObject;
+ friend void clearUnoMethods();
+ friend void clearUnoMethodsForBasic( StarBASIC const * pBasic );
+
+ css::uno::Reference< css::reflection::XIdlMethod > m_xUnoMethod;
+ std::unique_ptr<css::uno::Sequence< css::reflection::ParamInfo >> pParamInfoSeq;
+
+ // #67781 reference to the previous and the next method in the method list
+ SbUnoMethod* pPrev;
+ SbUnoMethod* pNext;
+
+ bool mbInvocation; // Method is based on invocation
+
+public:
+
+ SbUnoMethod( const OUString& aName_, SbxDataType eSbxType, css::uno::Reference< css::reflection::XIdlMethod > const & xUnoMethod_,
+ bool bInvocation );
+ virtual ~SbUnoMethod() override;
+ virtual SbxInfo* GetInfo() override;
+
+ const css::uno::Sequence< css::reflection::ParamInfo >& getParamInfos();
+
+ bool isInvocationBased() const
+ { return mbInvocation; }
+};
+
+
+class SbUnoProperty : public SbxProperty
+{
+ friend class SbUnoObject;
+ friend class SbUnoStructRefObject;
+
+ css::beans::Property aUnoProp;
+ sal_Int32 nId;
+
+ bool mbInvocation; // Property is based on invocation
+ SbxDataType mRealType;
+ virtual ~SbUnoProperty() override;
+ bool mbUnoStruct;
+ SbUnoProperty( const SbUnoProperty&) = delete;
+ SbUnoProperty& operator = ( const SbUnoProperty&) = delete;
+public:
+
+ SbUnoProperty( const OUString& aName_, SbxDataType eSbxType, SbxDataType eRealSbxType,
+ const css::beans::Property& aUnoProp_, sal_Int32 nId_, bool bInvocation, bool bUnoStruct );
+
+ bool isUnoStruct() const { return mbUnoStruct; }
+ bool isInvocationBased() const
+ { return mbInvocation; }
+ SbxDataType getRealType() const { return mRealType; }
+};
+
+// factory class to create uno-structs per DIM AS NEW
+class SbUnoFactory : public SbxFactory
+{
+public:
+ virtual SbxBase* Create( sal_uInt16 nSbxId, sal_uInt32 ) override;
+ virtual SbxObject* CreateObject( const OUString& ) override;
+};
+
+// wrapper for a uno-class
+class SbUnoClass : public SbxObject
+{
+ const css::uno::Reference< css::reflection::XIdlClass > m_xClass;
+
+public:
+ SbUnoClass( const OUString& aName_ )
+ : SbxObject( aName_ )
+ {}
+ SbUnoClass( const OUString& aName_, const css::uno::Reference< css::reflection::XIdlClass >& xClass_ )
+ : SbxObject( aName_ )
+ , m_xClass( xClass_ )
+ {}
+
+
+ virtual SbxVariable* Find( const OUString&, SbxClassType ) override;
+
+
+ const css::uno::Reference< css::reflection::XIdlClass >& getUnoClass() const { return m_xClass; }
+
+};
+
+
+// function to find a global identifier in
+// the UnoScope and to wrap it for Sbx
+SbUnoClass* findUnoClass( const OUString& rName );
+
+
+// Wrapper for UNO Service
+class SbUnoService : public SbxObject
+{
+ const css::uno::Reference< css::reflection::XServiceTypeDescription2 > m_xServiceTypeDesc;
+ bool m_bNeedsInit;
+
+public:
+ SbUnoService( const OUString& aName_,
+ const css::uno::Reference< css::reflection::XServiceTypeDescription2 >& xServiceTypeDesc )
+ : SbxObject( aName_ )
+ , m_xServiceTypeDesc( xServiceTypeDesc )
+ , m_bNeedsInit( true )
+ {}
+
+ virtual SbxVariable* Find( const OUString&, SbxClassType ) override;
+
+ void Notify( SfxBroadcaster&, const SfxHint& rHint ) override;
+};
+
+SbUnoService* findUnoService( const OUString& rName );
+
+
+class SbUnoServiceCtor : public SbxMethod
+{
+ friend class SbUnoService;
+
+ css::uno::Reference< css::reflection::XServiceConstructorDescription > m_xServiceCtorDesc;
+
+public:
+
+ SbUnoServiceCtor( const OUString& aName_, css::uno::Reference< css::reflection::XServiceConstructorDescription > const & xServiceCtorDesc );
+ virtual ~SbUnoServiceCtor() override;
+ virtual SbxInfo* GetInfo() override;
+
+ const css::uno::Reference< css::reflection::XServiceConstructorDescription >& getServiceCtorDesc() const
+ { return m_xServiceCtorDesc; }
+};
+
+
+// Wrapper for UNO Singleton
+class SbUnoSingleton : public SbxObject
+{
+public:
+ SbUnoSingleton( const OUString& aName_ );
+
+ void Notify( SfxBroadcaster&, const SfxHint& rHint ) override;
+};
+
+SbUnoSingleton* findUnoSingleton( const OUString& rName );
+
+
+// #105565 Special Object to wrap a strongly typed Uno Any
+class SbUnoAnyObject: public SbxObject
+{
+ css::uno::Any mVal;
+
+public:
+ SbUnoAnyObject( const css::uno::Any& rVal )
+ : SbxObject( OUString() )
+ , mVal( rVal )
+ {}
+
+ const css::uno::Any& getValue() const
+ { return mVal; }
+
+};
+
+
+// #112509 Special SbxArray to transport named parameters for calls
+// to OLEAutomation objects through the UNO OLE automation bridge
+
+class AutomationNamedArgsSbxArray : public SbxArray
+{
+ css::uno::Sequence< OUString > maNameSeq;
+public:
+ AutomationNamedArgsSbxArray( sal_Int32 nSeqSize )
+ : maNameSeq( nSeqSize )
+ {}
+
+ css::uno::Sequence< OUString >& getNames()
+ { return maNameSeq; }
+};
+
+
+class StarBASIC;
+
+// Impl-methods for RTL
+void RTL_Impl_CreateUnoStruct( SbxArray& rPar );
+void RTL_Impl_CreateUnoService( SbxArray& rPar );
+void RTL_Impl_CreateUnoServiceWithArguments( SbxArray& rPar );
+void RTL_Impl_CreateUnoValue( SbxArray& rPar );
+void RTL_Impl_GetProcessServiceManager( SbxArray& rPar );
+void RTL_Impl_HasInterfaces( SbxArray& rPar );
+void RTL_Impl_IsUnoStruct( SbxArray& rPar );
+void RTL_Impl_EqualUnoObjects( SbxArray& rPar );
+void RTL_Impl_GetDefaultContext( SbxArray& rPar );
+
+void disposeComVariablesForBasic( StarBASIC const * pBasic );
+void clearNativeObjectWrapperVector();
+
+
+// #118116 Collection object
+
+class BasicCollection : public SbxObject
+{
+ friend class SbiRuntime;
+ SbxArrayRef xItemArray;
+ static SbxInfoRef xAddInfo;
+ static SbxInfoRef xItemInfo;
+
+ void Initialize();
+ virtual ~BasicCollection() override;
+ virtual void Notify( SfxBroadcaster& rBC, const SfxHint& rHint ) override;
+ sal_Int32 implGetIndex( SbxVariable const * pIndexVar );
+ sal_Int32 implGetIndexForName( const OUString& rName );
+ void CollAdd( SbxArray* pPar_ );
+ void CollItem( SbxArray* pPar_ );
+ void CollRemove( SbxArray* pPar_ );
+
+public:
+ BasicCollection( const OUString& rClassname );
+ virtual void Clear() override;
+};
+
+class VBAConstantHelper
+{
+private:
+ std::vector< OUString > aConstCache;
+ std::unordered_map< OUString, css::uno::Any > aConstHash;
+ bool isInited;
+ VBAConstantHelper():isInited( false ) {}
+ VBAConstantHelper(const VBAConstantHelper&) = delete;
+ void init();
+public:
+ static VBAConstantHelper& instance();
+ SbxVariable* getVBAConstant( const OUString& rName );
+ bool isVBAConstantType( const OUString& rName );
+};
+
+SbxVariable* getDefaultProp( SbxVariable* pRef );
+
+css::uno::Reference< css::uno::XInterface > createComListener( const css::uno::Any& aControlAny,
+ const OUString& aVBAType,
+ const OUString& aPrefix,
+ const SbxObjectRef& xScopeObj );
+
+bool checkUnoObjectType(SbUnoObject& refVal, const OUString& aClass);
+
+SbUnoObject* createOLEObject_Impl( const OUString& aType );
+
+// #55226 ship additional information
+bool handleToStringForCOMObjects( SbxObject* pObj, SbxValue* pVal );
+
+void registerComListenerVariableForBasic( SbxVariable* pVar, StarBASIC* pBasic );
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/sbxmod.hxx b/basic/source/inc/sbxmod.hxx
new file mode 100644
index 000000000..853715c4b
--- /dev/null
+++ b/basic/source/inc/sbxmod.hxx
@@ -0,0 +1,30 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_SBXMOD_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SBXMOD_HXX
+
+#include <com/sun/star/frame/XModel.hpp>
+#include <basic/sbstar.hxx>
+
+css::uno::Reference<css::frame::XModel> getDocumentModel(StarBASIC*);
+
+#endif // INCLUDED_BASIC_SOURCE_INC_SBXMOD_HXX
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/scanner.hxx b/basic/source/inc/scanner.hxx
new file mode 100644
index 000000000..9b03b0adc
--- /dev/null
+++ b/basic/source/inc/scanner.hxx
@@ -0,0 +1,96 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_SCANNER_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SCANNER_HXX
+
+#include <basic/sbxdef.hxx>
+#include <vcl/errcode.hxx>
+
+// The scanner is stand-alone, i. e. it can be used from everywhere.
+// A BASIC-instance is necessary for error messages. Without BASIC
+// the errors are only counted. Also the BASIC is necessary when an
+// advanced SBX-variable shall be used for data type recognition etc.
+
+class StarBASIC;
+
+class SbiScanner
+{
+ OUString aBuf; // input buffer
+ OUString aLine;
+ sal_Int32 nLineIdx;
+ sal_Int32 nSaveLineIdx;
+ StarBASIC* pBasic; // instance for error callbacks
+
+ void scanAlphanumeric();
+ void scanGoto();
+ bool readLine();
+protected:
+ OUString aSym;
+ OUString aError;
+ SbxDataType eScanType;
+ double nVal; // numeric value
+ sal_Int32 nSavedCol1;
+ sal_Int32 nCol;
+ sal_Int32 nErrors;
+ sal_Int32 nColLock; // lock counter for Col1
+ sal_Int32 nBufPos;
+ sal_Int32 nLine;
+ sal_Int32 nCol1, nCol2;
+ bool bSymbol; // true: symbol scanned
+ bool bNumber; // true: number scanned
+ bool bSpaces; // true: whitespace before token
+ bool bAbort;
+ bool bHash; // true: # has been read in
+ bool bError; // true: generate error
+ bool bCompatible; // true: OPTION compatible
+ bool bVBASupportOn; // true: OPTION VBASupport 1 otherwise default False
+ bool bPrevLineExtentsComment; // true: Previous line is comment and ends on "... _"
+
+ bool bInStatement;
+ void GenError( ErrCode );
+public:
+ SbiScanner( const OUString&, StarBASIC* = nullptr );
+
+ void EnableErrors() { bError = false; }
+ bool IsHash() const { return bHash; }
+ bool IsCompatible() const { return bCompatible; }
+ void SetCompatible( bool b ) { bCompatible = b; } // #118206
+ bool IsVBASupportOn() const { return bVBASupportOn; }
+ bool WhiteSpace() { return bSpaces; }
+ sal_Int32 GetErrors() const { return nErrors; }
+ sal_Int32 GetLine() const { return nLine; }
+ sal_Int32 GetCol1() const { return nCol1; }
+ void SetCol1( sal_Int32 n ) { nCol1 = n; }
+ StarBASIC* GetBasic() { return pBasic; }
+ void SaveLine() { nSaveLineIdx = nLineIdx; }
+ void RestoreLine() { nLineIdx = nSaveLineIdx; }
+ void LockColumn();
+ void UnlockColumn();
+ bool DoesColonFollow();
+
+ bool NextSym();
+ const OUString& GetSym() const { return aSym; }
+ SbxDataType GetType() const { return eScanType; }
+ double GetDbl() const { return nVal; }
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/scriptcont.hxx b/basic/source/inc/scriptcont.hxx
new file mode 100644
index 000000000..98fce14b6
--- /dev/null
+++ b/basic/source/inc/scriptcont.hxx
@@ -0,0 +1,163 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_SCRIPTCONT_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SCRIPTCONT_HXX
+
+#include "namecont.hxx"
+#include <basic/basmgr.hxx>
+#include <com/sun/star/script/vba/XVBAModuleInfo.hpp>
+#include <comphelper/uno3.hxx>
+#include <cppuhelper/implbase1.hxx>
+
+namespace basic
+{
+
+
+class SfxScriptLibraryContainer : public SfxLibraryContainer, public OldBasicPassword
+{
+ css::uno::Reference< css::container::XNameAccess > mxCodeNameAccess;
+
+ // Methods to distinguish between different library types
+ virtual SfxLibrary* implCreateLibrary( const OUString& aName ) override;
+ virtual SfxLibrary* implCreateLibraryLink
+ ( const OUString& aName, const OUString& aLibInfoFileURL,
+ const OUString& StorageURL, bool ReadOnly ) override;
+ virtual css::uno::Any createEmptyLibraryElement() override;
+ virtual bool isLibraryElementValid(const css::uno::Any& rElement) const override;
+ virtual void writeLibraryElement
+ (
+ const css::uno::Reference< css::container::XNameContainer>& xLibrary,
+ const OUString& aElementName,
+ const css::uno::Reference< css::io::XOutputStream >& xOutput
+ ) override;
+
+ virtual css::uno::Any importLibraryElement
+ (
+ const css::uno::Reference< css::container::XNameContainer>& xLibrary,
+ const OUString& aElementName,
+ const OUString& aFile,
+ const css::uno::Reference< css::io::XInputStream >& xElementStream ) override;
+
+ virtual void importFromOldStorage( const OUString& aFile ) override;
+
+ virtual SfxLibraryContainer* createInstanceImpl() override;
+
+
+ // Password encryption
+ virtual bool implStorePasswordLibrary( SfxLibrary* pLib, const OUString& aName,
+ const css::uno::Reference< css::embed::XStorage>& xStorage, const css::uno::Reference< css::task::XInteractionHandler >& Handler ) override;
+
+ // New variant for library export
+ virtual bool implStorePasswordLibrary( SfxLibrary* pLib, const OUString& aName,
+ const css::uno::Reference< css::embed::XStorage >& xStorage,
+ const OUString& aTargetURL,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& rToUseSFI, const css::uno::Reference< css::task::XInteractionHandler >& Handler ) override;
+
+ virtual bool implLoadPasswordLibrary( SfxLibrary* pLib, const OUString& Name,
+ bool bVerifyPasswordOnly=false ) override;
+
+ virtual void onNewRootStorage() override;
+
+
+ // OldBasicPassword interface
+ virtual void setLibraryPassword( const OUString& rLibraryName, const OUString& rPassword ) override;
+
+ virtual const char* getInfoFileName() const override;
+ virtual const char* getOldInfoFileName() const override;
+ virtual const char* getLibElementFileExtension() const override;
+ virtual const char* getLibrariesDir() const override;
+
+public:
+ SfxScriptLibraryContainer();
+ SfxScriptLibraryContainer( const css::uno::Reference< css::embed::XStorage >& xStorage );
+
+
+ // Methods XLibraryContainerPassword
+ virtual sal_Bool SAL_CALL isLibraryPasswordProtected( const OUString& Name ) override;
+ virtual sal_Bool SAL_CALL isLibraryPasswordVerified( const OUString& Name ) override;
+ virtual sal_Bool SAL_CALL verifyLibraryPassword( const OUString& Name, const OUString& Password ) override;
+ virtual void SAL_CALL changeLibraryPassword( const OUString& Name,
+ const OUString& OldPassword, const OUString& NewPassword ) override;
+ // XLibraryQueryExecutable
+ virtual sal_Bool SAL_CALL HasExecutableCode(const OUString&) override;
+ // Methods XServiceInfo
+ virtual OUString SAL_CALL getImplementationName( ) override;
+ virtual css::uno::Sequence< OUString > SAL_CALL getSupportedServiceNames( ) override;
+};
+
+
+typedef std::unordered_map< OUString, css::script::ModuleInfo > ModuleInfoMap;
+
+typedef ::cppu::ImplHelper1< css::script::vba::XVBAModuleInfo > SfxScriptLibrary_BASE;
+
+class SfxScriptLibrary : public SfxLibrary, public SfxScriptLibrary_BASE
+{
+ friend class SfxScriptLibraryContainer;
+
+ typedef std::unordered_map< OUString, css::script::ModuleInfo > ModuleInfoMap;
+
+ bool mbLoadedSource;
+ bool mbLoadedBinary;
+ ModuleInfoMap mModuleInfo;
+
+ // Provide modify state including resources
+ virtual bool isModified() override;
+ virtual void storeResources() override;
+ virtual void storeResourcesAsURL( const OUString& URL, const OUString& NewName ) override;
+ virtual void storeResourcesToURL( const OUString& URL,
+ const css::uno::Reference< css::task::XInteractionHandler >& xHandler ) override;
+ virtual void storeResourcesToStorage( const css::uno::Reference< css::embed::XStorage >& xStorage ) override;
+ virtual bool isLoadedStorable() override;
+
+public:
+ SfxScriptLibrary
+ (
+ ModifiableHelper& _rModifiable,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& xSFI
+ );
+
+ SfxScriptLibrary
+ (
+ ModifiableHelper& _rModifiable,
+ const css::uno::Reference< css::ucb::XSimpleFileAccess3 >& xSFI,
+ const OUString& aLibInfoFileURL, const OUString& aStorageURL, bool ReadOnly
+ );
+
+ DECLARE_XINTERFACE()
+ DECLARE_XTYPEPROVIDER()
+
+ // XVBAModuleInfo
+ virtual css::script::ModuleInfo SAL_CALL getModuleInfo( const OUString& ModuleName ) override;
+ virtual sal_Bool SAL_CALL hasModuleInfo( const OUString& ModuleName ) override;
+ virtual void SAL_CALL insertModuleInfo( const OUString& ModuleName, const css::script::ModuleInfo& ModuleInfo ) override;
+ virtual void SAL_CALL removeModuleInfo( const OUString& ModuleName ) override;
+
+ static bool containsValidModule( const css::uno::Any& _rElement );
+
+protected:
+ virtual bool isLibraryElementValid(const css::uno::Any& rElement) const override;
+};
+
+
+} // namespace basic
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/stdobj.hxx b/basic/source/inc/stdobj.hxx
new file mode 100644
index 000000000..d7bc4c176
--- /dev/null
+++ b/basic/source/inc/stdobj.hxx
@@ -0,0 +1,44 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_STDOBJ_HXX
+#define INCLUDED_BASIC_SOURCE_INC_STDOBJ_HXX
+
+#include <basic/sbxobj.hxx>
+
+class StarBASIC;
+class SbStdFactory;
+
+class SbiStdObject : public SbxObject
+{
+ std::unique_ptr<SbStdFactory> pStdFactory;
+
+ virtual ~SbiStdObject() override;
+ using SbxVariable::GetInfo;
+ static SbxInfo* GetInfo( short );
+ virtual void Notify( SfxBroadcaster& rBC, const SfxHint& rHint ) override;
+public:
+ SbiStdObject( const OUString&, StarBASIC* );
+ virtual SbxVariable* Find( const OUString&, SbxClassType ) override;
+ virtual void SetModified( bool ) override;
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/symtbl.hxx b/basic/source/inc/symtbl.hxx
new file mode 100644
index 000000000..2dfc9c758
--- /dev/null
+++ b/basic/source/inc/symtbl.hxx
@@ -0,0 +1,222 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_SYMTBL_HXX
+#define INCLUDED_BASIC_SOURCE_INC_SYMTBL_HXX
+
+#include <memory>
+#include <vector>
+#include <basic/sbdef.hxx>
+
+class SbiConstDef;
+class SbiParser;
+class SbiProcDef;
+class SbiStringPool;
+class SbiSymDef; // base class
+
+enum SbiSymScope { SbLOCAL, SbPARAM, SbPUBLIC, SbGLOBAL, SbRTL };
+
+// The string-pool collects string entries and
+// makes sure that they don't exist twice.
+
+class SbiStringPool {
+ std::vector<OUString> aData;
+public:
+ SbiStringPool();
+ ~SbiStringPool();
+ sal_uInt32 GetSize() const { return aData.size(); }
+ short Add( const OUString& );
+ short Add( double, SbxDataType );
+ OUString Find( sal_uInt32 ) const;
+};
+
+
+class SbiSymPool final {
+ friend class SbiSymDef;
+ friend class SbiProcDef;
+ SbiStringPool& rStrings;
+ std::vector<std::unique_ptr<SbiSymDef>> m_Data;
+ SbiSymPool* pParent;
+ SbiParser* pParser;
+ SbiSymScope eScope;
+ sal_uInt16 nProcId; // for STATIC-variable
+ sal_uInt16 nCur; // iterator
+public:
+ SbiSymPool( SbiStringPool&, SbiSymScope, SbiParser* pParser_ );
+ ~SbiSymPool();
+
+ void SetParent( SbiSymPool* p ) { pParent = p; }
+ void SetProcId( short n ) { nProcId = n; }
+ sal_uInt16 GetSize() const { return m_Data.size(); }
+ SbiSymScope GetScope() const { return eScope; }
+ void SetScope( SbiSymScope s ) { eScope = s; }
+ SbiParser* GetParser() { return pParser; }
+
+ SbiSymDef* AddSym( const OUString& );
+ SbiProcDef* AddProc( const OUString& );
+ void Add( SbiSymDef* );
+ SbiSymDef* Find( const OUString&, bool bSearchInParents = true ); // variable name
+ SbiSymDef* Get( sal_uInt16 ); // find variable per position
+ SbiSymDef* First(), *Next(); // iterators
+
+ sal_uInt32 Define( const OUString& );
+ sal_uInt32 Reference( const OUString& );
+ void CheckRefs();
+};
+
+
+class SbiSymDef { // general symbol entry
+ friend class SbiSymPool;
+protected:
+ OUString aName;
+ SbxDataType eType;
+ SbiSymPool* pIn; // parent pool
+ std::unique_ptr<SbiSymPool> pPool; // pool for sub-elements
+ short nLen; // string length for STRING*n
+ short nDims;
+ sal_uInt16 nId;
+ sal_uInt16 nTypeId; // Dim X AS data type
+ sal_uInt16 nProcId;
+ sal_uInt16 nPos;
+ sal_uInt32 nChain;
+ bool bNew : 1; // true: Dim As New...
+ bool bChained : 1; // true: symbol is defined in code
+ bool bByVal : 1; // true: ByVal-parameter
+ bool bOpt : 1; // true: optional parameter
+ bool bStatic : 1; // true: STATIC variable
+ bool bAs : 1; // true: data type defined per AS XXX
+ bool bGlobal : 1; // true: global variable
+ bool bParamArray : 1; // true: ParamArray parameter
+ bool bWithEvents : 1; // true: Declared WithEvents
+ bool bWithBrackets : 1; // true: Followed by ()
+ sal_uInt16 nDefaultId; // Symbol number of default value
+ short nFixedStringLength; // String length in: Dim foo As String*Length
+public:
+ SbiSymDef( const OUString& );
+ virtual ~SbiSymDef();
+ virtual SbiProcDef* GetProcDef();
+ virtual SbiConstDef* GetConstDef();
+
+ SbxDataType GetType() const { return eType; }
+ virtual void SetType( SbxDataType );
+ const OUString& GetName();
+ SbiSymScope GetScope() const;
+ sal_uInt32 GetAddr() const { return nChain; }
+ sal_uInt16 GetId() const { return nId; }
+ sal_uInt16 GetTypeId() const{ return nTypeId; }
+ void SetTypeId( sal_uInt16 n ) { nTypeId = n; eType = SbxOBJECT; }
+ sal_uInt16 GetPos() const { return nPos; }
+ void SetLen( short n ){ nLen = n; }
+ short GetLen() const { return nLen; }
+ void SetDims( short n ) { nDims = n; }
+ short GetDims() const { return nDims; }
+ bool IsDefined() const{ return bChained; }
+ void SetOptional() { bOpt = true; }
+ void SetParamArray() { bParamArray = true; }
+ void SetWithEvents() { bWithEvents = true; }
+ void SetWithBrackets(){ bWithBrackets = true; }
+ void SetByVal( bool bByVal_ ) { bByVal = bByVal_; }
+ void SetStatic( bool bAsStatic = true ) { bStatic = bAsStatic; }
+ void SetNew() { bNew = true; }
+ void SetDefinedAs() { bAs = true; }
+ void SetGlobal(bool b){ bGlobal = b; }
+ void SetDefaultId( sal_uInt16 n ) { nDefaultId = n; }
+ sal_uInt16 GetDefaultId() const { return nDefaultId; }
+ bool IsOptional() const{ return bOpt; }
+ bool IsParamArray() const{ return bParamArray; }
+ bool IsWithEvents() const{ return bWithEvents; }
+ bool IsWithBrackets() const{ return bWithBrackets; }
+ bool IsByVal() const { return bByVal; }
+ bool IsStatic() const { return bStatic; }
+ bool IsNew() const { return bNew; }
+ bool IsDefinedAs() const { return bAs; }
+ bool IsGlobal() const { return bGlobal; }
+ short GetFixedStringLength() const { return nFixedStringLength; }
+ void SetFixedStringLength( short n ) { nFixedStringLength = n; }
+
+ SbiSymPool& GetPool();
+ sal_uInt32 Define(); // define symbol in code
+ sal_uInt32 Reference(); // reference symbol in code
+
+private:
+ SbiSymDef( const SbiSymDef& ) = delete;
+
+};
+
+class SbiProcDef : public SbiSymDef { // procedure definition (from basic):
+ SbiSymPool aParams;
+ SbiSymPool aLabels; // local jump targets
+ OUString aLibName;
+ OUString aAlias;
+ sal_uInt16 nLine1, nLine2; // line area
+ PropertyMode mePropMode; // Marks if this is a property procedure and which
+ OUString maPropName; // Property name if property procedure (!= proc name)
+ bool bCdecl : 1; // true: CDECL given
+ bool bPublic : 1; // true: proc is PUBLIC
+ bool mbProcDecl : 1; // true: instantiated by SbiParser::ProcDecl
+public:
+ SbiProcDef( SbiParser*, const OUString&, bool bProcDecl=false );
+ virtual ~SbiProcDef() override;
+ virtual SbiProcDef* GetProcDef() override;
+ virtual void SetType( SbxDataType ) override;
+ SbiSymPool& GetParams() { return aParams; }
+ SbiSymPool& GetLabels() { return aLabels; }
+ SbiSymPool& GetLocals() { return GetPool();}
+ OUString& GetLib() { return aLibName; }
+ OUString& GetAlias() { return aAlias; }
+ void SetPublic( bool b ) { bPublic = b; }
+ bool IsPublic() const { return bPublic; }
+ void SetCdecl( bool b ) { bCdecl = b; }
+ bool IsCdecl() const { return bCdecl; }
+ bool IsUsedForProcDecl() const { return mbProcDecl; }
+ void SetLine1( sal_uInt16 n ) { nLine1 = n; }
+ sal_uInt16 GetLine1() const { return nLine1; }
+ void SetLine2( sal_uInt16 n ) { nLine2 = n; }
+ sal_uInt16 GetLine2() const { return nLine2; }
+ PropertyMode getPropertyMode() const { return mePropMode; }
+ void setPropertyMode( PropertyMode ePropMode );
+ const OUString& GetPropName() const { return maPropName; }
+
+ // Match with a forward-declaration. The parameter names are
+ // compared and the forward declaration is replaced by this
+ void Match( SbiProcDef* pForward );
+
+private:
+ SbiProcDef( const SbiProcDef& ) = delete;
+
+};
+
+class SbiConstDef : public SbiSymDef
+{
+ double nVal;
+ OUString aVal;
+public:
+ SbiConstDef( const OUString& );
+ virtual ~SbiConstDef() override;
+ virtual SbiConstDef* GetConstDef() override;
+ void Set( double, SbxDataType );
+ void Set( const OUString& );
+ double GetValue() const { return nVal; }
+ const OUString& GetString() const { return aVal; }
+};
+
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/inc/token.hxx b/basic/source/inc/token.hxx
new file mode 100644
index 000000000..34abfce82
--- /dev/null
+++ b/basic/source/inc/token.hxx
@@ -0,0 +1,140 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_INC_TOKEN_HXX
+#define INCLUDED_BASIC_SOURCE_INC_TOKEN_HXX
+
+#include "scanner.hxx"
+
+// The tokenizer is stand-alone, i. e. he can be used from everywhere.
+// A BASIC-instance is necessary for error messages. Without BASIC the
+// errors are only counted. The BASIC is also necessary when an advanced
+// SBX-variable shall be used for recognition of data types etc.
+
+
+enum SbiToken {
+ NIL = 0,
+ // tokens between 0x20 and 0x3F are literals:
+ LPAREN = '(', RPAREN = ')', COMMA = ',', DOT = '.', EXCLAM = '!',
+ HASH = '#', SEMICOLON = ';',
+
+ // commands:
+ FIRSTKWD = 0x40,
+ AS = FIRSTKWD, ALIAS, ASSIGN,
+ CALL, CASE, CLOSE, COMPARE, CONST_,
+ DECLARE, DIM, DO,
+
+ // in the order of the data type enums!
+ DEFINT, DEFLNG, DEFSNG, DEFDBL, DEFCUR, DEFDATE, DEFSTR, DEFOBJ,
+ DEFERR, DEFBOOL, DEFVAR,
+ // in the order of the data type enums!
+ DATATYPE1,
+ TINTEGER = DATATYPE1,
+ TLONG, TSINGLE, TDOUBLE, TCURRENCY, TDATE, TSTRING, TOBJECT,
+ ERROR_, TBOOLEAN, TVARIANT, TBYTE,
+ DATATYPE2 = TBYTE,
+
+ EACH, ELSE, ELSEIF, END, ERASE, EXIT,
+ FOR, FUNCTION,
+ GET, GLOBAL, GOSUB, GOTO,
+ IF, IN_, INPUT,
+ LET, LINE, LINEINPUT, LOCAL, LOOP, LPRINT, LSET,
+ NAME, NEW, NEXT,
+ ON, OPEN, OPTION, ATTRIBUTE, IMPLEMENTS,
+ PRINT, PRIVATE, PROPERTY, PUBLIC,
+ REDIM, REM, RESUME, RETURN, RSET,
+ SELECT, SET, SHARED, STATIC, STEP, STOP, SUB,
+ TEXT, THEN, TO, TYPE, ENUM,
+ UNTIL,
+ WEND, WHILE, WITH, WRITE,
+ ENDENUM, ENDIF, ENDFUNC, ENDPROPERTY, ENDSUB, ENDTYPE, ENDSELECT, ENDWITH,
+ // end of all keywords
+ LASTKWD = ENDWITH,
+ // statement end
+ EOS, EOLN,
+ // operators:
+ EXPON, NEG, MUL,
+ DIV, IDIV, MOD, PLUS, MINUS,
+ EQ, NE, LT, GT, LE, GE,
+ NOT, AND, OR, XOR, EQV,
+ IMP, CAT, LIKE, IS, TYPEOF,
+ // miscellaneous:
+ FIRSTEXTRA,
+ NUMBER=FIRSTEXTRA, FIXSTRING, SYMBOL, CDECL_, BYVAL, BYREF,
+ OUTPUT, RANDOM, APPEND, BINARY, ACCESS,
+ LOCK, READ, PRESERVE, BASE, ANY, LIB, OPTIONAL_, PTRSAFE,
+ BASIC_EXPLICIT, COMPATIBLE, CLASSMODULE, PARAMARRAY, WITHEVENTS,
+
+ // from here there are JavaScript-tokens (same enum so that same type)
+ FIRSTJAVA,
+ JS_BREAK=FIRSTJAVA, JS_CONTINUE, JS_FOR, JS_FUNCTION, JS_IF, JS_NEW,
+ JS_RETURN, JS_THIS, JS_VAR, JS_WHILE, JS_WITH,
+
+ // JavaScript-operators
+ // _ASS_ = Assignment
+ JS_COMMA, JS_ASSIGNMENT, JS_ASS_PLUS, JS_ASS_MINUS, JS_ASS_MUL,
+ JS_ASS_DIV, JS_ASS_MOD, JS_ASS_LSHIFT, JS_ASS_RSHIFT, JS_ASS_RSHIFT_Z,
+ JS_ASS_AND, JS_ASS_XOR, JS_ASS_OR,
+ JS_COND_QUEST, JS_COND_SEL, JS_LOG_OR, JS_LOG_AND, JS_BIT_OR,
+ JS_BIT_XOR, JS_BIT_AND, JS_EQ, JS_NE, JS_LT, JS_LE,
+ JS_GT, JS_GE, JS_LSHIFT, JS_RSHIFT, JS_RSHIFT_Z,
+ JS_PLUS, JS_MINUS, JS_MUL, JS_DIV, JS_MOD, JS_LOG_NOT, JS_BIT_NOT,
+ JS_INC, JS_DEC, JS_LPAREN, JS_RPAREN, JS_LINDEX, JS_RINDEX
+ , VBASUPPORT
+};
+
+class SbiTokenizer : public SbiScanner {
+protected:
+ SbiToken eCurTok;
+ SbiToken ePush;
+ sal_uInt16 nPLine, nPCol1, nPCol2; // pushback location
+ bool bEof;
+ bool bEos;
+ bool bAs; // last keyword was AS
+ bool bErrorIsSymbol; // Handle Error token as Symbol, not keyword
+public:
+ SbiTokenizer( const OUString&, StarBASIC* = nullptr );
+
+ bool IsEof() const { return bEof; }
+ bool IsEos() const { return bEos; }
+
+ void Push( SbiToken );
+ const OUString& Symbol( SbiToken ); // reconversion
+
+ SbiToken Peek(); // read the next token
+ SbiToken Next(); // read a token
+ bool MayBeLabel( bool= false );
+
+ void Error( ErrCode c ) { GenError( c ); }
+ void Error( ErrCode, SbiToken );
+ void Error( ErrCode, const OUString &);
+
+ static bool IsEoln( SbiToken t )
+ { return t == EOS || t == EOLN || t == REM; }
+ static bool IsKwd( SbiToken t )
+ { return t >= FIRSTKWD && t <= LASTKWD; }
+ static bool IsExtra( SbiToken t )
+ { return t >= FIRSTEXTRA; }
+ static OUString GetKeywordCase( const OUString& sKeyword );
+};
+
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/basrdll.cxx b/basic/source/runtime/basrdll.cxx
new file mode 100644
index 000000000..6da6ed9e2
--- /dev/null
+++ b/basic/source/runtime/basrdll.cxx
@@ -0,0 +1,126 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <memory>
+#include <vcl/svapp.hxx>
+#include <tools/debug.hxx>
+#include <vcl/weld.hxx>
+
+#include <basic/sbstar.hxx>
+#include <basic/basrdll.hxx>
+#include <strings.hrc>
+#include <sbxbase.hxx>
+#include <config_features.h>
+
+namespace
+{
+struct BasicDLLImpl : public SvRefBase
+{
+ bool bDebugMode;
+ bool bBreakEnabled;
+
+ std::unique_ptr<SbxAppData> xSbxAppData;
+
+ BasicDLLImpl()
+ : bDebugMode(false)
+ , bBreakEnabled(true)
+ , xSbxAppData(new SbxAppData)
+ { }
+
+ static BasicDLLImpl* BASIC_DLL;
+ static osl::Mutex& getMutex()
+ {
+ static osl::Mutex aMutex;
+ return aMutex;
+ }
+};
+
+BasicDLLImpl* BasicDLLImpl::BASIC_DLL = nullptr;
+}
+
+BasicDLL::BasicDLL()
+{
+ osl::MutexGuard aGuard(BasicDLLImpl::getMutex());
+ if (!BasicDLLImpl::BASIC_DLL)
+ BasicDLLImpl::BASIC_DLL = new BasicDLLImpl;
+ m_xImpl = BasicDLLImpl::BASIC_DLL;
+}
+
+BasicDLL::~BasicDLL()
+{
+ osl::MutexGuard aGuard(BasicDLLImpl::getMutex());
+ const bool bLastRef = m_xImpl->GetRefCount() == 1;
+ if (bLastRef) {
+ BasicDLLImpl::BASIC_DLL->xSbxAppData->m_aGlobErr.clear();
+ }
+ m_xImpl.clear();
+ // only reset BASIC_DLL after the object had been destroyed
+ if (bLastRef)
+ BasicDLLImpl::BASIC_DLL = nullptr;
+}
+
+void BasicDLL::EnableBreak( bool bEnable )
+{
+ DBG_ASSERT( BasicDLLImpl::BASIC_DLL, "BasicDLL::EnableBreak: No instance yet!" );
+ if (BasicDLLImpl::BASIC_DLL)
+ {
+ BasicDLLImpl::BASIC_DLL->bBreakEnabled = bEnable;
+ }
+}
+
+void BasicDLL::SetDebugMode( bool bDebugMode )
+{
+ DBG_ASSERT( BasicDLLImpl::BASIC_DLL, "BasicDLL::EnableBreak: No instance yet!" );
+ if (BasicDLLImpl::BASIC_DLL)
+ {
+ BasicDLLImpl::BASIC_DLL->bDebugMode = bDebugMode;
+ }
+}
+
+
+void BasicDLL::BasicBreak()
+{
+ DBG_ASSERT( BasicDLLImpl::BASIC_DLL, "BasicDLL::EnableBreak: No instance yet!" );
+#if HAVE_FEATURE_SCRIPTING
+ if (!BasicDLLImpl::BASIC_DLL)
+ return;
+
+ // bJustStopping: if there's someone pressing STOP like crazy umpteen times,
+ // but the Basic doesn't stop early enough, the box might appear more often...
+ static bool bJustStopping = false;
+ if (StarBASIC::IsRunning() && !bJustStopping
+ && (BasicDLLImpl::BASIC_DLL->bBreakEnabled || BasicDLLImpl::BASIC_DLL->bDebugMode))
+ {
+ bJustStopping = true;
+ StarBASIC::Stop();
+ std::unique_ptr<weld::MessageDialog> xInfoBox(Application::CreateMessageDialog(nullptr,
+ VclMessageType::Info, VclButtonsType::Ok,
+ BasResId(IDS_SBERR_TERMINATED)));
+ xInfoBox->run();
+ bJustStopping = false;
+ }
+#endif
+}
+
+SbxAppData& GetSbxData_Impl()
+{
+ return *BasicDLLImpl::BASIC_DLL->xSbxAppData;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/comenumwrapper.cxx b/basic/source/runtime/comenumwrapper.cxx
new file mode 100644
index 000000000..7e2432e43
--- /dev/null
+++ b/basic/source/runtime/comenumwrapper.cxx
@@ -0,0 +1,67 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include "comenumwrapper.hxx"
+
+using namespace ::com::sun::star;
+
+sal_Bool SAL_CALL ComEnumerationWrapper::hasMoreElements()
+{
+ bool bResult = false;
+
+ try
+ {
+ if ( m_xInvocation.is() )
+ {
+ sal_Int32 nLength = 0;
+ bResult = ( ( m_xInvocation->getValue( "length" ) >>= nLength ) && nLength > m_nCurInd );
+ }
+ }
+ catch(const uno::Exception& )
+ {}
+
+ return bResult;
+}
+
+uno::Any SAL_CALL ComEnumerationWrapper::nextElement()
+{
+ try
+ {
+ if ( m_xInvocation.is() )
+ {
+ uno::Sequence< sal_Int16 > aNamedParamIndex;
+ uno::Sequence< uno::Any > aNamedParam;
+ uno::Sequence< uno::Any > aArgs( 1 );
+
+ aArgs[0] <<= m_nCurInd++;
+
+ return m_xInvocation->invoke( "item",
+ aArgs,
+ aNamedParamIndex,
+ aNamedParam );
+ }
+ }
+ catch(const uno::Exception& )
+ {}
+
+ throw container::NoSuchElementException();
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/comenumwrapper.hxx b/basic/source/runtime/comenumwrapper.hxx
new file mode 100644
index 000000000..5637a8b7c
--- /dev/null
+++ b/basic/source/runtime/comenumwrapper.hxx
@@ -0,0 +1,44 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#pragma once
+
+#include <com/sun/star/container/XEnumeration.hpp>
+#include <com/sun/star/script/XInvocation.hpp>
+
+#include <cppuhelper/implbase.hxx>
+
+class ComEnumerationWrapper : public ::cppu::WeakImplHelper< css::container::XEnumeration >
+{
+ css::uno::Reference< css::script::XInvocation > m_xInvocation;
+ sal_Int32 m_nCurInd;
+
+public:
+ explicit ComEnumerationWrapper( const css::uno::Reference< css::script::XInvocation >& xInvocation )
+ : m_xInvocation( xInvocation )
+ , m_nCurInd( 0 )
+ {
+ }
+
+ // container::XEnumeration
+ virtual sal_Bool SAL_CALL hasMoreElements() override;
+ virtual css::uno::Any SAL_CALL nextElement() override;
+};
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/ddectrl.cxx b/basic/source/runtime/ddectrl.cxx
new file mode 100644
index 000000000..37d3c7d0c
--- /dev/null
+++ b/basic/source/runtime/ddectrl.cxx
@@ -0,0 +1,198 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <vcl/errcode.hxx>
+#include <svl/svdde.hxx>
+#include "ddectrl.hxx"
+#include <basic/sberrors.hxx>
+
+#define DDE_FIRSTERR 0x4000
+#define DDE_LASTERR 0x4011
+
+static const ErrCode nDdeErrMap[] =
+{
+ /* DMLERR_ADVACKTIMEOUT */ ErrCode(0x4000), ERRCODE_BASIC_DDE_TIMEOUT,
+ /* DMLERR_BUSY */ ErrCode(0x4001), ERRCODE_BASIC_DDE_BUSY,
+ /* DMLERR_DATAACKTIMEOUT */ ErrCode(0x4002), ERRCODE_BASIC_DDE_TIMEOUT,
+ /* DMLERR_DLL_NOT_INITIALIZED */ ErrCode(0x4003), ERRCODE_BASIC_DDE_ERROR,
+ /* DMLERR_DLL_USAGE */ ErrCode(0x4004), ERRCODE_BASIC_DDE_ERROR,
+ /* DMLERR_EXECACKTIMEOUT */ ErrCode(0x4005), ERRCODE_BASIC_DDE_TIMEOUT,
+ /* DMLERR_INVALIDPARAMETER */ ErrCode(0x4006), ERRCODE_BASIC_DDE_ERROR,
+ /* DMLERR_LOW_MEMORY */ ErrCode(0x4007), ERRCODE_BASIC_DDE_ERROR,
+ /* DMLERR_MEMORY_ERROR */ ErrCode(0x4008), ERRCODE_BASIC_DDE_ERROR,
+ /* DMLERR_NOTPROCESSED */ ErrCode(0x4009), ERRCODE_BASIC_DDE_NOTPROCESSED,
+ /* DMLERR_NO_CONV_ESTABLISHED */ ErrCode(0x400a), ERRCODE_BASIC_DDE_NO_CHANNEL,
+ /* DMLERR_POKEACKTIMEOUT */ ErrCode(0x400b), ERRCODE_BASIC_DDE_TIMEOUT,
+ /* DMLERR_POSTMSG_FAILED */ ErrCode(0x400c), ERRCODE_BASIC_DDE_QUEUE_OVERFLOW,
+ /* DMLERR_REENTRANCY */ ErrCode(0x400d), ERRCODE_BASIC_DDE_ERROR,
+ /* DMLERR_SERVER_DIED */ ErrCode(0x400e), ERRCODE_BASIC_DDE_PARTNER_QUIT,
+ /* DMLERR_SYS_ERROR */ ErrCode(0x400f), ERRCODE_BASIC_DDE_ERROR,
+ /* DMLERR_UNADVACKTIMEOUT */ ErrCode(0x4010), ERRCODE_BASIC_DDE_TIMEOUT,
+ /* DMLERR_UNFOUND_QUEUE_ID */ ErrCode(0x4011), ERRCODE_BASIC_DDE_NO_CHANNEL
+};
+
+ErrCode SbiDdeControl::GetLastErr( const DdeConnection* pConv )
+{
+ if( !pConv )
+ {
+ return ERRCODE_NONE;
+ }
+ long nErr = pConv->GetError();
+ if( !nErr )
+ {
+ return ERRCODE_NONE;
+ }
+ if( nErr < DDE_FIRSTERR || nErr > DDE_LASTERR )
+ {
+ return ERRCODE_BASIC_DDE_ERROR;
+ }
+ return nDdeErrMap[ 2 * (nErr - DDE_FIRSTERR) + 1 ];
+}
+
+IMPL_LINK( SbiDdeControl, Data, const DdeData*, pData, void )
+{
+ aData = OUString::createFromAscii( static_cast<const char*>(pData->getData()) );
+}
+
+SbiDdeControl::SbiDdeControl()
+{
+}
+
+SbiDdeControl::~SbiDdeControl()
+{
+ TerminateAll();
+}
+
+size_t SbiDdeControl::GetFreeChannel()
+{
+ size_t nChannel = 0;
+ size_t nListSize = aConvList.size();
+
+ for (; nChannel < nListSize; ++nChannel)
+ {
+ if (!aConvList[nChannel])
+ {
+ return nChannel+1;
+ }
+ }
+
+ aConvList.push_back(nullptr);
+ return nChannel+1;
+}
+
+ErrCode SbiDdeControl::Initiate( const OUString& rService, const OUString& rTopic,
+ size_t& rnHandle )
+{
+ ErrCode nErr;
+ std::unique_ptr<DdeConnection> pConv(new DdeConnection( rService, rTopic ));
+ nErr = GetLastErr( pConv.get() );
+ if( nErr )
+ {
+ rnHandle = 0;
+ }
+ else
+ {
+ size_t nChannel = GetFreeChannel();
+ aConvList[nChannel-1] = std::move(pConv);
+ rnHandle = nChannel;
+ }
+ return ERRCODE_NONE;
+}
+
+ErrCode SbiDdeControl::Terminate( size_t nChannel )
+{
+ if (!nChannel || nChannel > aConvList.size())
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+ DdeConnection* pConv = aConvList[nChannel-1].get();
+
+ if( !pConv )
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+ aConvList[nChannel-1].reset();
+
+ return ERRCODE_NONE;
+}
+
+ErrCode SbiDdeControl::TerminateAll()
+{
+ aConvList.clear();
+ return ERRCODE_NONE;
+}
+
+ErrCode SbiDdeControl::Request( size_t nChannel, const OUString& rItem, OUString& rResult )
+{
+ if (!nChannel || nChannel > aConvList.size())
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+
+ DdeConnection* pConv = aConvList[nChannel-1].get();
+
+ if( !pConv )
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+
+ DdeRequest aRequest( *pConv, rItem, 30000 );
+ aRequest.SetDataHdl( LINK( this, SbiDdeControl, Data ) );
+ aRequest.Execute();
+ rResult = aData;
+ return GetLastErr( pConv );
+}
+
+ErrCode SbiDdeControl::Execute( size_t nChannel, const OUString& rCommand )
+{
+ if (!nChannel || nChannel > aConvList.size())
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+
+ DdeConnection* pConv = aConvList[nChannel-1].get();
+
+ if( !pConv )
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+ DdeExecute aRequest( *pConv, rCommand, 30000 );
+ aRequest.Execute();
+ return GetLastErr( pConv );
+}
+
+ErrCode SbiDdeControl::Poke( size_t nChannel, const OUString& rItem, const OUString& rData )
+{
+ if (!nChannel || nChannel > aConvList.size())
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+ DdeConnection* pConv = aConvList[nChannel-1].get();
+
+ if( !pConv )
+ {
+ return ERRCODE_BASIC_DDE_NO_CHANNEL;
+ }
+ DdePoke aRequest( *pConv, rItem, DdeData(rData), 30000 );
+ aRequest.Execute();
+ return GetLastErr( pConv );
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/ddectrl.hxx b/basic/source/runtime/ddectrl.hxx
new file mode 100644
index 000000000..3b4f3d9bb
--- /dev/null
+++ b/basic/source/runtime/ddectrl.hxx
@@ -0,0 +1,54 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#pragma once
+
+#include <tools/link.hxx>
+#include <vcl/errcode.hxx>
+
+#include <memory>
+#include <vector>
+
+class DdeConnection;
+class DdeData;
+
+class SbiDdeControl
+{
+private:
+ DECL_LINK( Data, const DdeData*, void );
+ static ErrCode GetLastErr( const DdeConnection* );
+ size_t GetFreeChannel();
+ std::vector<std::unique_ptr<DdeConnection>> aConvList;
+ OUString aData;
+
+public:
+
+ SbiDdeControl();
+ ~SbiDdeControl();
+
+ ErrCode Initiate( const OUString& rService, const OUString& rTopic,
+ size_t& rnHandle );
+ ErrCode Terminate( size_t nChannel );
+ ErrCode TerminateAll();
+ ErrCode Request( size_t nChannel, const OUString& rItem, OUString& rResult );
+ ErrCode Execute( size_t nChannel, const OUString& rCommand );
+ ErrCode Poke( size_t nChannel, const OUString& rItem, const OUString& rData );
+};
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/dllmgr-none.cxx b/basic/source/runtime/dllmgr-none.cxx
new file mode 100644
index 000000000..7ca7e5131
--- /dev/null
+++ b/basic/source/runtime/dllmgr-none.cxx
@@ -0,0 +1,114 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#if defined(_WIN32)
+#include <prewin.h>
+#include <postwin.h>
+#endif
+
+#include <basic/sberrors.hxx>
+#include <basic/sbx.hxx>
+#include <basic/sbxvar.hxx>
+#include <rtl/ustring.hxx>
+#include <osl/time.h>
+
+#include "dllmgr.hxx"
+
+struct SbiDllMgr::Impl {};
+
+namespace {
+
+// Overcome the mess of Currency vs. custom types etc.
+ErrCode returnInt64InOutArg(SbxArray *pArgs, SbxVariable &rRetVal,
+ sal_Int64 nValue)
+{
+ if (!rRetVal.PutLong(1) && !rRetVal.PutInteger(1))
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+ if (!pArgs || pArgs->Count32() != 2)
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+ SbxVariable *pOut = pArgs->Get32(1);
+ if (!pOut)
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+ if (pOut->IsCurrency())
+ {
+ pOut->PutCurrency(nValue);
+ return ERRCODE_NONE;
+ }
+ if (pOut->IsObject())
+ {
+ // FIXME: should we clone this and use pOut->PutObject ?
+ SbxObject* pObj = dynamic_cast<SbxObject*>( pOut->GetObject() );
+ if (!pObj)
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+
+ // We expect two Longs but other mappings could be possible too.
+ SbxArray* pProps = pObj->GetProperties();
+ if (pProps->Count32() != 2)
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+ SbxVariable* pLow = pProps->Get32( 0 );
+ SbxVariable* pHigh = pProps->Get32( 1 );
+ if (!pLow || !pLow->IsLong() ||
+ !pHigh || !pHigh->IsLong())
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+ pLow->PutLong(nValue & 0xffffffff);
+ pHigh->PutLong(nValue >> 32);
+ return ERRCODE_NONE;
+ }
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+}
+
+ErrCode builtin_kernel32(const OUString &aFuncName, SbxArray *pArgs,
+ SbxVariable &rRetVal)
+{
+ sal_Int64 nNanoSecsPerSec = 1000.0*1000*1000;
+ if (aFuncName == "QueryPerformanceFrequency")
+ return returnInt64InOutArg(pArgs, rRetVal, nNanoSecsPerSec);
+
+ else if (aFuncName == "QueryPerformanceCounter")
+ {
+ TimeValue aNow;
+ osl_getSystemTime( &aNow );
+ sal_Int64 nStamp = aNow.Nanosec + aNow.Seconds * nNanoSecsPerSec;
+ return returnInt64InOutArg(pArgs, rRetVal, nStamp);
+ }
+ return ERRCODE_BASIC_NOT_IMPLEMENTED;
+}
+
+};
+
+ErrCode SbiDllMgr::Call(
+ const OUString &aFuncName, const OUString &aDllName,
+ SbxArray *pArgs, SbxVariable &rRetVal,
+ SAL_UNUSED_PARAMETER bool /* bCDecl */)
+{
+ if (aDllName == "kernel32")
+ return builtin_kernel32(aFuncName, pArgs, rRetVal);
+ else
+ return ERRCODE_BASIC_NOT_IMPLEMENTED;
+}
+
+void SbiDllMgr::FreeDll(SAL_UNUSED_PARAMETER OUString const &) {}
+
+SbiDllMgr::SbiDllMgr(): impl_(new Impl) {}
+
+SbiDllMgr::~SbiDllMgr() {}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/dllmgr-x64.cxx b/basic/source/runtime/dllmgr-x64.cxx
new file mode 100644
index 000000000..0cc276192
--- /dev/null
+++ b/basic/source/runtime/dllmgr-x64.cxx
@@ -0,0 +1,794 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#if defined(_WIN32)
+#include <prewin.h>
+#include <postwin.h>
+#endif
+
+#include <algorithm>
+#include <cstddef>
+#include <map>
+#include <vector>
+
+#include <basic/sbx.hxx>
+#include <basic/sbxvar.hxx>
+#include <runtime.hxx>
+#include <osl/thread.h>
+#include <osl/diagnose.h>
+#include <rtl/ref.hxx>
+#include <rtl/string.hxx>
+#include <rtl/ustring.hxx>
+#include <sal/log.hxx>
+#include <salhelper/simplereferenceobject.hxx>
+#include <o3tl/char16_t2wchar_t.hxx>
+
+#undef max
+
+#include "dllmgr.hxx"
+
+using namespace css;
+
+/* Open issues:
+
+ Missing support for functions returning structs (see TODO in call()).
+
+ Missing support for additional data types (64 bit integers, Any, ...; would
+ trigger assert(false) in various switches).
+
+ It is assumed that the variables passed into SbiDllMgr::Call to represent
+ the arguments and return value have types that exactly match the Declare
+ statement; it would be better if this code had access to the function
+ signature from the Declare statement, so that it could convert the passed
+ variables accordingly.
+*/
+
+namespace {
+
+char * address(std::vector< char > & blob) {
+ return blob.empty() ? nullptr : blob.data();
+}
+
+ErrCode convert(OUString const & source, OString * target) {
+ return
+ source.convertToString(
+ target, osl_getThreadTextEncoding(),
+ (RTL_UNICODETOTEXT_FLAGS_UNDEFINED_ERROR |
+ RTL_UNICODETOTEXT_FLAGS_INVALID_ERROR))
+ ? ERRCODE_NONE : ERRCODE_BASIC_BAD_ARGUMENT;
+ //TODO: more specific errcode?
+}
+
+ErrCode convert(char const * source, sal_Int32 length, OUString * target) {
+ return
+ rtl_convertStringToUString(
+ &target->pData, source, length, osl_getThreadTextEncoding(),
+ (RTL_TEXTTOUNICODE_FLAGS_UNDEFINED_ERROR |
+ RTL_TEXTTOUNICODE_FLAGS_MBUNDEFINED_ERROR |
+ RTL_TEXTTOUNICODE_FLAGS_INVALID_ERROR))
+ ? ERRCODE_NONE : ERRCODE_BASIC_BAD_ARGUMENT;
+ //TODO: more specific errcode?
+}
+
+struct UnmarshalData {
+ UnmarshalData(SbxVariable * theVariable, void * theBuffer):
+ variable(theVariable), buffer(theBuffer) {}
+
+ SbxVariable * variable;
+ void * buffer;
+};
+
+struct StringData: public UnmarshalData {
+ StringData(SbxVariable * theVariable, void * theBuffer, bool theSpecial):
+ UnmarshalData(theVariable, theBuffer), special(theSpecial) {}
+
+ bool special;
+};
+
+class MarshalData {
+public:
+ MarshalData() = default;
+ MarshalData(const MarshalData&) = delete;
+ const MarshalData& operator=(const MarshalData&) = delete;
+
+ std::vector< char > * newBlob() {
+ blobs_.push_back(std::vector< char >());
+ return &blobs_.back();
+ }
+
+ std::vector< UnmarshalData > unmarshal;
+
+ std::vector< StringData > unmarshalStrings;
+
+private:
+ std::vector< std::vector< char > > blobs_;
+};
+
+std::size_t align(std::size_t address, std::size_t alignment) {
+ // alignment = 2^k for some k >= 0
+ return (address + (alignment - 1)) & ~(alignment - 1);
+}
+
+char * align(
+ std::vector< char > & blob, std::size_t alignment, std::size_t offset,
+ std::size_t add)
+{
+ std::vector< char >::size_type n = blob.size();
+ n = align(n - offset, alignment) + offset; //TODO: overflow in align()
+ blob.resize(n + add); //TODO: overflow
+ return address(blob) + n;
+}
+
+template< typename T > void add(
+ std::vector< char > & blob, T const & data, std::size_t alignment,
+ std::size_t offset)
+{
+ *reinterpret_cast< T * >(align(blob, alignment, offset, sizeof (T))) = data;
+}
+
+std::size_t alignment(SbxVariable const * variable) {
+ assert(variable != nullptr);
+ if ((variable->GetType() & SbxARRAY) == 0) {
+ switch (variable->GetType()) {
+ case SbxINTEGER:
+ return 2;
+ case SbxLONG:
+ case SbxSINGLE:
+ case SbxSTRING:
+ return 4;
+ case SbxDOUBLE:
+ return 8;
+ case SbxOBJECT:
+ {
+ std::size_t n = 1;
+ SbxObject* pobj = dynamic_cast<SbxObject*>(variable->GetObject());
+ assert(pobj);
+ SbxArray* props = pobj->GetProperties();
+ for (sal_uInt32 i = 0; i < props->Count32(); ++i) {
+ n = std::max(n, alignment(props->Get32(i)));
+ }
+ return n;
+ }
+ case SbxBOOL:
+ case SbxBYTE:
+ return 1;
+ default:
+ assert(false);
+ return 1;
+ }
+ } else {
+ SbxDimArray * arr = dynamic_cast<SbxDimArray*>( variable->GetObject() );
+ assert(arr);
+ sal_Int32 dims = arr->GetDims32();
+ std::vector< sal_Int32 > low(dims);
+ for (sal_Int32 i = 0; i < dims; ++i) {
+ sal_Int32 up;
+ arr->GetDim32(i + 1, low[i], up);
+ }
+ return alignment(arr->Get32(low.data()));
+ }
+}
+
+ErrCode marshal(
+ bool outer, SbxVariable * variable, bool special,
+ std::vector< char > & blob, std::size_t offset, MarshalData & data);
+
+ErrCode marshalString(
+ SbxVariable * variable, bool special, MarshalData & data, void ** buffer)
+{
+ assert(variable != nullptr && buffer != nullptr);
+ OString str;
+ ErrCode e = convert(variable->GetOUString(), &str);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ std::vector< char > * blob = data.newBlob();
+ blob->insert(blob->begin(), str.getStr(), str.getStr() + str.getLength() + 1);
+ *buffer = address(*blob);
+ data.unmarshalStrings.push_back(StringData(variable, *buffer, special));
+ return ERRCODE_NONE;
+}
+
+ErrCode marshalStruct(
+ SbxVariable const * variable, std::vector< char > & blob, std::size_t offset,
+ MarshalData & data)
+{
+ assert(variable != nullptr);
+ SbxObject* pobj = dynamic_cast<SbxObject*>(variable->GetObject());
+ assert(pobj);
+ SbxArray* props = pobj->GetProperties();
+ for (sal_uInt32 i = 0; i < props->Count32(); ++i) {
+ ErrCode e = marshal(false, props->Get32(i), false, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ return ERRCODE_NONE;
+}
+
+ErrCode marshalArray(
+ SbxVariable const * variable, std::vector< char > & blob, std::size_t offset,
+ MarshalData & data)
+{
+ assert(variable != nullptr);
+ SbxDimArray * arr = dynamic_cast<SbxDimArray*>( variable->GetObject() );
+ assert(arr);
+ sal_Int32 dims = arr->GetDims32();
+ std::vector< sal_Int32 > low(dims);
+ std::vector< sal_Int32 > up(dims);
+ for (sal_Int32 i = 0; i < dims; ++i) {
+ arr->GetDim32(i + 1, low[i], up[i]);
+ }
+ for (std::vector< sal_Int32 > idx = low;;) {
+ ErrCode e = marshal(
+ false, arr->Get32(idx.data()), false, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ sal_Int32 i = dims - 1;
+ while (idx[i] == up[i]) {
+ idx[i] = low[i];
+ if (i == 0) {
+ return ERRCODE_NONE;
+ }
+ --i;
+ }
+ ++idx[i];
+ }
+}
+
+// 8-aligned structs are only 4-aligned on stack, so alignment of members in
+// such structs must take that into account via "offset"
+ErrCode marshal(
+ bool outer, SbxVariable * variable, bool special,
+ std::vector< char > & blob, std::size_t offset, MarshalData & data)
+{
+ assert(variable != nullptr);
+
+ SbxDataType eVarType = variable->GetType();
+ bool bByVal = !(variable->GetFlags() & SbxFlagBits::Reference);
+ if( !bByVal && !SbiRuntime::isVBAEnabled() && eVarType == SbxSTRING )
+ bByVal = true;
+
+ if (bByVal) {
+ if ((eVarType & SbxARRAY) == 0) {
+ switch (eVarType) {
+ case SbxINTEGER:
+ add(blob, variable->GetInteger(), outer ? 8 : 2, offset);
+ break;
+ case SbxLONG:
+ add(blob, variable->GetLong(), outer ? 8 : 4, offset);
+ break;
+ case SbxSINGLE:
+ add(blob, variable->GetSingle(), outer ? 8 : 4, offset);
+ break;
+ case SbxDOUBLE:
+ add(blob, variable->GetDouble(), 8, offset);
+ break;
+ case SbxSTRING:
+ {
+ void * p;
+ ErrCode e = marshalString(variable, special, data, &p);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ add(blob, p, 8, offset);
+ break;
+ }
+ case SbxOBJECT:
+ {
+ align(blob, outer ? 8 : alignment(variable), offset, 0);
+ ErrCode e = marshalStruct(variable, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ break;
+ }
+ case SbxBOOL:
+ add(blob, variable->GetBool(), outer ? 8 : 1, offset);
+ break;
+ case SbxBYTE:
+ add(blob, variable->GetByte(), outer ? 8 : 1, offset);
+ break;
+ default:
+ assert(false);
+ break;
+ }
+ } else {
+ ErrCode e = marshalArray(variable, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ } else {
+ if ((eVarType & SbxARRAY) == 0) {
+ switch (eVarType) {
+ case SbxINTEGER:
+ case SbxLONG:
+ case SbxSINGLE:
+ case SbxDOUBLE:
+ case SbxBOOL:
+ case SbxBYTE:
+ add(blob, variable->data(), 8, offset);
+ break;
+ case SbxSTRING:
+ {
+ void * p;
+ ErrCode e = marshalString(variable, special, data, &p);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ std::vector< char >* blob2 = data.newBlob();
+ add(*blob2, p, 8, 0);
+ add(blob, address(*blob2), 8, offset);
+ break;
+ }
+ case SbxOBJECT:
+ {
+ std::vector< char > * blob2 = data.newBlob();
+ ErrCode e = marshalStruct(variable, *blob2, 0, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ void * p = address(*blob2);
+ if (outer) {
+ data.unmarshal.push_back(UnmarshalData(variable, p));
+ }
+ add(blob, p, 8, offset);
+ break;
+ }
+ default:
+ assert(false);
+ break;
+ }
+ } else {
+ std::vector< char > * blob2 = data.newBlob();
+ ErrCode e = marshalArray(variable, *blob2, 0, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ void * p = address(*blob2);
+ if (outer) {
+ data.unmarshal.push_back(UnmarshalData(variable, p));
+ }
+ add(blob, p, 8, offset);
+ }
+ }
+ return ERRCODE_NONE;
+}
+
+template< typename T > T read(void const ** pointer) {
+ T const * p = static_cast< T const * >(*pointer);
+ *pointer = static_cast< void const * >(p + 1);
+ return *p;
+}
+
+void const * unmarshal(SbxVariable * variable, void const * data) {
+ assert(variable != nullptr);
+ if ((variable->GetType() & SbxARRAY) == 0) {
+ switch (variable->GetType()) {
+ case SbxINTEGER:
+ variable->PutInteger(read< sal_Int16 >(&data));
+ break;
+ case SbxLONG:
+ variable->PutLong(read< sal_Int32 >(&data));
+ break;
+ case SbxSINGLE:
+ variable->PutSingle(read< float >(&data));
+ break;
+ case SbxDOUBLE:
+ variable->PutDouble(read< double >(&data));
+ break;
+ case SbxSTRING:
+ read< char * >(&data); // handled by unmarshalString
+ break;
+ case SbxOBJECT:
+ {
+ data = reinterpret_cast< void const * >(
+ align(
+ reinterpret_cast< sal_uIntPtr >(data),
+ alignment(variable)));
+ SbxObject* pobj = dynamic_cast<SbxObject*>(variable->GetObject());
+ assert(pobj);
+ SbxArray* props = pobj->GetProperties();
+ for (sal_uInt32 i = 0; i < props->Count32(); ++i) {
+ data = unmarshal(props->Get32(i), data);
+ }
+ break;
+ }
+ case SbxBOOL:
+ variable->PutBool(read< sal_Bool >(&data));
+ break;
+ case SbxBYTE:
+ variable->PutByte(read< sal_uInt8 >(&data));
+ break;
+ default:
+ assert(false);
+ break;
+ }
+ } else {
+ SbxDimArray * arr = dynamic_cast<SbxDimArray*>( variable->GetObject() );
+ assert(arr);
+ sal_Int32 dims = arr->GetDims32();
+ std::vector< sal_Int32 > low(dims);
+ std::vector< sal_Int32 > up(dims);
+ for (sal_Int32 i = 0; i < dims; ++i) {
+ arr->GetDim32(i + 1, low[i], up[i]);
+ }
+ for (std::vector< sal_Int32 > idx = low;;) {
+ data = unmarshal(arr->Get32(idx.data()), data);
+ sal_Int32 i = dims - 1;
+ while (idx[i] == up[i]) {
+ idx[i] = low[i];
+ if (i == 0) {
+ goto done;
+ }
+ --i;
+ }
+ ++idx[i];
+ }
+ done:;
+ }
+ return data;
+}
+
+ErrCode unmarshalString(StringData const & data, SbxVariable const & result) {
+ OUString str;
+ if (data.buffer != nullptr) {
+ char const * p = static_cast< char const * >(data.buffer);
+ sal_Int32 len;
+ if (data.special) {
+ len = static_cast< sal_Int32 >(result.GetULong());
+ if (len < 0) { // i.e., DWORD result >= 2^31
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+ //TODO: more specific errcode?
+ }
+ } else {
+ len = rtl_str_getLength(p);
+ }
+ ErrCode e = convert(p, len, &str);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ data.variable->PutString(str);
+ return ERRCODE_NONE;
+}
+
+struct ProcData {
+ OString name;
+ FARPROC proc;
+};
+
+ErrCode call(
+ OUString const & dll, ProcData const & proc, SbxArray * arguments,
+ SbxVariable & result)
+{
+ if (arguments && arguments->Count32() > 20)
+ return ERRCODE_BASIC_NOT_IMPLEMENTED;
+
+ std::vector< char > stack;
+ MarshalData data;
+
+ // For DWORD GetLogicalDriveStringsA(DWORD nBufferLength, LPSTR lpBuffer)
+ // from kernel32, upon return, filled lpBuffer length is result DWORD, which
+ // requires special handling in unmarshalString; other functions might
+ // require similar treatment, too:
+ bool special =
+ dll.equalsIgnoreAsciiCase("KERNEL32.DLL") &&
+ (proc.name == OString("GetLogicalDriveStringsA"));
+ for (sal_uInt32 i = 1; i < (arguments == nullptr ? 0 : arguments->Count32()); ++i) {
+ ErrCode e = marshal(
+ true, arguments->Get32(i), special && i == 2, stack, stack.size(),
+ data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ align(stack, 8, 0, 0);
+ }
+
+ stack.resize(20*8);
+
+ // We fake all calls as being to a varargs function,
+ // as this means any floating-point argument among the first four
+ // ones will end up in a XMM register where the callee expects it.
+ sal_Int32 (*proc_i)(double d, ...) = reinterpret_cast<sal_Int32 (*)(double, ...)>(proc.proc);
+ double (*proc_d)(double d, ...) = reinterpret_cast<double (*)(double, ...)>(proc.proc);
+
+ sal_Int64 iRetVal = 0;
+ double dRetVal = 0.0;
+
+ switch (result.GetType()) {
+ case SbxEMPTY:
+ case SbxINTEGER:
+ case SbxLONG:
+ case SbxSTRING:
+ case SbxOBJECT:
+ case SbxBOOL:
+ case SbxBYTE:
+ {
+ auto const st = stack.data();
+ iRetVal =
+ proc_i(*reinterpret_cast<double *>(st + 0),
+ *reinterpret_cast<double *>(st + 1*8),
+ *reinterpret_cast<double *>(st + 2*8),
+ *reinterpret_cast<double *>(st + 3*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 4*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 5*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 6*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 7*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 8*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 9*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 10*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 11*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 12*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 13*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 14*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 15*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 16*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 17*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 18*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 19*8));
+ break;
+ }
+ case SbxSINGLE:
+ case SbxDOUBLE:
+ {
+ auto const st = stack.data();
+ dRetVal =
+ proc_d(*reinterpret_cast<double *>(st + 0),
+ *reinterpret_cast<double *>(st + 1*8),
+ *reinterpret_cast<double *>(st + 2*8),
+ *reinterpret_cast<double *>(st + 3*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 4*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 5*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 6*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 7*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 8*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 9*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 10*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 11*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 12*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 13*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 14*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 15*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 16*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 17*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 18*8),
+ *reinterpret_cast<sal_uInt64 *>(st + 19*8));
+ break;
+ }
+ default:
+ break;
+ }
+
+ switch (result.GetType()) {
+ case SbxEMPTY:
+ break;
+ case SbxINTEGER:
+ result.PutInteger(static_cast< sal_Int16 >(iRetVal));
+ break;
+ case SbxLONG:
+ result.PutLong(static_cast< sal_Int32 >(iRetVal));
+ break;
+ case SbxSINGLE:
+ result.PutSingle(static_cast< float >(dRetVal));
+ break;
+ case SbxDOUBLE:
+ result.PutDouble(dRetVal);
+ break;
+ case SbxSTRING:
+ {
+ char const * s1 = reinterpret_cast< char const * >(iRetVal);
+ OUString s2;
+ ErrCode e = convert(s1, rtl_str_getLength(s1), &s2);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ result.PutString(s2);
+ break;
+ }
+ case SbxOBJECT:
+ //TODO
+ break;
+ case SbxBOOL:
+ result.PutBool(bool(iRetVal));
+ break;
+ case SbxBYTE:
+ result.PutByte(static_cast< sal_uInt8 >(iRetVal));
+ break;
+ default:
+ assert(false);
+ break;
+ }
+ for (sal_uInt32 i = 1; i < (arguments == nullptr ? 0 : arguments->Count32()); ++i) {
+ arguments->Get32(i)->ResetFlag(SbxFlagBits::Reference);
+ //TODO: skipped for errors?!?
+ }
+ for (auto const& elem : data.unmarshal)
+ {
+ unmarshal(elem.variable, elem.buffer);
+ }
+ for (auto const& elem : data.unmarshalStrings)
+ {
+ ErrCode e = unmarshalString(elem, result);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ return ERRCODE_NONE;
+}
+
+ErrCode getProcData(HMODULE handle, OUString const & name, ProcData * proc)
+{
+ assert(proc != nullptr);
+ if (name.getLength() != 0 && name[0] == '@') { //TODO: "@" vs. "#"???
+ sal_Int32 n = name.copy(1).toInt32(); //TODO: handle bad input
+ if (n <= 0 || n > 0xFFFF) {
+ return ERRCODE_BASIC_BAD_ARGUMENT; //TODO: more specific errcode?
+ }
+ FARPROC p = GetProcAddress(handle, reinterpret_cast< LPCSTR >(n));
+ if (p != nullptr) {
+ proc->name = "#" + OString::number(n);
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ } else {
+ OString name8;
+ ErrCode e = convert(name, &name8);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ FARPROC p = GetProcAddress(handle, name8.getStr());
+ if (p != nullptr) {
+ proc->name = name8;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ sal_Int32 i = name8.indexOf('#');
+ if (i != -1) {
+ name8 = name8.copy(0, i);
+ p = GetProcAddress(handle, name8.getStr());
+ if (p != nullptr) {
+ proc->name = name8;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ }
+ OString real("_" + name8);
+ p = GetProcAddress(handle, real.getStr());
+ if (p != nullptr) {
+ proc->name = real;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ real = name8 + "A";
+ p = GetProcAddress(handle, real.getStr());
+ if (p != nullptr) {
+ proc->name = real;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ }
+ return ERRCODE_BASIC_PROC_UNDEFINED;
+}
+
+struct Dll: public salhelper::SimpleReferenceObject {
+private:
+ typedef std::map< OUString, ProcData > Procs;
+
+ virtual ~Dll() override;
+
+public:
+ Dll(): handle(nullptr) {}
+
+ ErrCode getProc(OUString const & name, ProcData * proc);
+
+ HMODULE handle;
+ Procs procs;
+};
+
+Dll::~Dll() {
+ if (handle != nullptr && !FreeLibrary(handle)) {
+ SAL_WARN("basic", "FreeLibrary(" << handle << ") failed with " << GetLastError());
+ }
+}
+
+ErrCode Dll::getProc(OUString const & name, ProcData * proc) {
+ Procs::iterator i(procs.find(name));
+ if (i != procs.end()) {
+ *proc = i->second;
+ return ERRCODE_NONE;
+ }
+ ErrCode e = getProcData(handle, name, proc);
+ if (e == ERRCODE_NONE) {
+ procs.emplace(name, *proc);
+ }
+ return e;
+}
+
+OUString fullDllName(OUString const & name) {
+ OUString full(name);
+ if (full.indexOf('.') == -1) {
+ full += ".DLL";
+ }
+ return full;
+}
+
+}
+
+struct SbiDllMgr::Impl{
+private:
+ typedef std::map< OUString, ::rtl::Reference< Dll > > Dlls;
+
+public:
+ Impl() = default;
+ Impl(const Impl&) = delete;
+ const Impl& operator=(const Impl&) = delete;
+
+ Dll * getDll(OUString const & name);
+
+ Dlls dlls;
+};
+
+Dll * SbiDllMgr::Impl::getDll(OUString const & name) {
+ Dlls::iterator i(dlls.find(name));
+ if (i == dlls.end()) {
+ i = dlls.emplace(name, new Dll).first;
+ HMODULE h = LoadLibraryW(o3tl::toW(name.getStr()));
+ if (h == nullptr) {
+ dlls.erase(i);
+ return nullptr;
+ }
+ i->second->handle = h;
+ }
+ return i->second.get();
+}
+
+ErrCode SbiDllMgr::Call(
+ OUString const & function, OUString const & library,
+ SbxArray * arguments, SbxVariable & result, bool cdeclConvention)
+{
+ if (cdeclConvention) {
+ return ERRCODE_BASIC_NOT_IMPLEMENTED;
+ }
+ OUString dllName(fullDllName(library));
+ Dll * dll = impl_->getDll(dllName);
+ if (dll == nullptr) {
+ return ERRCODE_BASIC_BAD_DLL_LOAD;
+ }
+ ProcData proc;
+ ErrCode e = dll->getProc(function, &proc);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ return call(dllName, proc, arguments, result);
+}
+
+void SbiDllMgr::FreeDll(OUString const & library) {
+ impl_->dlls.erase(library);
+}
+
+SbiDllMgr::SbiDllMgr(): impl_(new Impl) {}
+
+SbiDllMgr::~SbiDllMgr() {}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/dllmgr-x86.cxx b/basic/source/runtime/dllmgr-x86.cxx
new file mode 100644
index 000000000..3220691bb
--- /dev/null
+++ b/basic/source/runtime/dllmgr-x86.cxx
@@ -0,0 +1,734 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#if defined(_WIN32)
+#include <prewin.h>
+#include <postwin.h>
+#endif
+
+#include <algorithm>
+#include <cstddef>
+#include <map>
+#include <vector>
+
+#include <basic/sbx.hxx>
+#include <basic/sbxvar.hxx>
+#include "runtime.hxx"
+#include <osl/thread.h>
+#include <rtl/ref.hxx>
+#include <rtl/string.hxx>
+#include <rtl/ustring.hxx>
+#include <sal/log.hxx>
+#include <salhelper/simplereferenceobject.hxx>
+#include <o3tl/char16_t2wchar_t.hxx>
+
+#undef max
+
+#include "dllmgr.hxx"
+
+using namespace css;
+using namespace css::uno;
+
+/* Open issues:
+
+ Missing support for functions returning structs (see TODO in call()).
+
+ Missing support for additional data types (64 bit integers, Any, ...; would
+ trigger assert(false) in various switches).
+
+ It is assumed that the variables passed into SbiDllMgr::Call to represent
+ the arguments and return value have types that exactly match the Declare
+ statement; it would be better if this code had access to the function
+ signature from the Declare statement, so that it could convert the passed
+ variables accordingly.
+*/
+
+extern "C" {
+
+int __stdcall DllMgr_call32(FARPROC, void const * stack, std::size_t size);
+double __stdcall DllMgr_callFp(FARPROC, void const * stack, std::size_t size);
+
+}
+
+namespace {
+
+char * address(std::vector< char > & blob) {
+ return blob.empty() ? 0 : &blob[0];
+}
+
+ErrCode convert(OUString const & source, OString * target) {
+ return
+ source.convertToString(
+ target, osl_getThreadTextEncoding(),
+ (RTL_UNICODETOTEXT_FLAGS_UNDEFINED_ERROR |
+ RTL_UNICODETOTEXT_FLAGS_INVALID_ERROR))
+ ? ERRCODE_NONE : ERRCODE_BASIC_BAD_ARGUMENT;
+ //TODO: more specific errcode?
+}
+
+ErrCode convert(char const * source, sal_Int32 length, OUString * target) {
+ return
+ rtl_convertStringToUString(
+ &target->pData, source, length, osl_getThreadTextEncoding(),
+ (RTL_TEXTTOUNICODE_FLAGS_UNDEFINED_ERROR |
+ RTL_TEXTTOUNICODE_FLAGS_MBUNDEFINED_ERROR |
+ RTL_TEXTTOUNICODE_FLAGS_INVALID_ERROR))
+ ? ERRCODE_NONE : ERRCODE_BASIC_BAD_ARGUMENT;
+ //TODO: more specific errcode?
+}
+
+struct UnmarshalData {
+ UnmarshalData(SbxVariable * theVariable, void * theBuffer):
+ variable(theVariable), buffer(theBuffer) {}
+
+ SbxVariable * variable;
+ void * buffer;
+};
+
+struct StringData: public UnmarshalData {
+ StringData(SbxVariable * theVariable, void * theBuffer, bool theSpecial):
+ UnmarshalData(theVariable, theBuffer), special(theSpecial) {}
+
+ bool special;
+};
+
+class MarshalData {
+public:
+ MarshalData() = default;
+ MarshalData(const MarshalData&) = delete;
+ const MarshalData& operator=(const MarshalData&) = delete;
+
+ std::vector< char > * newBlob() {
+ blobs_.push_back(std::vector< char >());
+ return &blobs_.back();
+ }
+
+ std::vector< UnmarshalData > unmarshal;
+
+ std::vector< StringData > unmarshalStrings;
+
+private:
+ std::vector< std::vector< char > > blobs_;
+};
+
+std::size_t align(std::size_t address, std::size_t alignment) {
+ // alignment = 2^k for some k >= 0
+ return (address + (alignment - 1)) & ~(alignment - 1);
+}
+
+char * align(
+ std::vector< char > & blob, std::size_t alignment, std::size_t offset,
+ std::size_t add)
+{
+ std::vector< char >::size_type n = blob.size();
+ n = align(n - offset, alignment) + offset; //TODO: overflow in align()
+ blob.resize(n + add); //TODO: overflow
+ return address(blob) + n;
+}
+
+template< typename T > void add(
+ std::vector< char > & blob, T const & data, std::size_t alignment,
+ std::size_t offset)
+{
+ *reinterpret_cast< T * >(align(blob, alignment, offset, sizeof (T))) = data;
+}
+
+std::size_t alignment(SbxVariable * variable) {
+ assert(variable != 0);
+ if ((variable->GetType() & SbxARRAY) == 0) {
+ switch (variable->GetType()) {
+ case SbxINTEGER:
+ return 2;
+ case SbxLONG:
+ case SbxSINGLE:
+ case SbxSTRING:
+ return 4;
+ case SbxDOUBLE:
+ return 8;
+ case SbxOBJECT:
+ {
+ std::size_t n = 1;
+ SbxObject* pobj = dynamic_cast<SbxObject*>(variable->GetObject());
+ assert(pobj);
+ SbxArray* props = pobj->GetProperties();
+ for (sal_uInt32 i = 0; i < props->Count32(); ++i) {
+ n = std::max(n, alignment(props->Get32(i)));
+ }
+ return n;
+ }
+ case SbxBOOL:
+ case SbxBYTE:
+ return 1;
+ default:
+ assert(false);
+ return 1;
+ }
+ } else {
+ SbxDimArray * arr = dynamic_cast<SbxDimArray*>( variable->GetObject() );
+ assert(arr);
+ sal_Int32 dims = arr->GetDims32();
+ std::vector< sal_Int32 > low(dims);
+ for (sal_Int32 i = 0; i < dims; ++i) {
+ sal_Int32 up;
+ arr->GetDim32(i + 1, low[i], up);
+ }
+ return alignment(arr->Get32(&low[0]));
+ }
+}
+
+ErrCode marshal(
+ bool outer, SbxVariable * variable, bool special,
+ std::vector< char > & blob, std::size_t offset, MarshalData & data);
+
+ErrCode marshalString(
+ SbxVariable * variable, bool special, MarshalData & data, void ** buffer)
+{
+ assert(variable != 0 && buffer != 0);
+ OString str;
+ ErrCode e = convert(variable->GetOUString(), &str);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ std::vector< char > * blob = data.newBlob();
+ blob->insert(
+ blob->begin(), str.getStr(), str.getStr() + str.getLength() + 1);
+ *buffer = address(*blob);
+ data.unmarshalStrings.push_back(StringData(variable, *buffer, special));
+ return ERRCODE_NONE;
+}
+
+ErrCode marshalStruct(
+ SbxVariable * variable, std::vector< char > & blob, std::size_t offset,
+ MarshalData & data)
+{
+ assert(variable != 0);
+ SbxObject* pobj = dynamic_cast<SbxObject*>(variable->GetObject());
+ assert(pobj);
+ SbxArray* props = pobj->GetProperties();
+ for (sal_uInt32 i = 0; i < props->Count32(); ++i) {
+ ErrCode e = marshal(false, props->Get32(i), false, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ return ERRCODE_NONE;
+}
+
+ErrCode marshalArray(
+ SbxVariable * variable, std::vector< char > & blob, std::size_t offset,
+ MarshalData & data)
+{
+ assert(variable != 0);
+ SbxDimArray * arr = dynamic_cast<SbxDimArray*>( variable->GetObject() );
+ assert(arr);
+ sal_Int32 dims = arr->GetDims32();
+ std::vector< sal_Int32 > low(dims);
+ std::vector< sal_Int32 > up(dims);
+ for (sal_Int32 i = 0; i < dims; ++i) {
+ arr->GetDim32(i + 1, low[i], up[i]);
+ }
+ for (std::vector< sal_Int32 > idx = low;;) {
+ ErrCode e = marshal(
+ false, arr->Get32(&idx[0]), false, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ sal_Int32 i = dims - 1;
+ while (idx[i] == up[i]) {
+ idx[i] = low[i];
+ if (i == 0) {
+ return ERRCODE_NONE;
+ }
+ --i;
+ }
+ ++idx[i];
+ }
+}
+
+// 8-aligned structs are only 4-aligned on stack, so alignment of members in
+// such structs must take that into account via "offset"
+ErrCode marshal(
+ bool outer, SbxVariable * variable, bool special,
+ std::vector< char > & blob, std::size_t offset, MarshalData & data)
+{
+ assert(variable != 0);
+
+ SbxDataType eVarType = variable->GetType();
+ bool bByVal = !(variable->GetFlags() & SbxFlagBits::Reference);
+ if( !bByVal && !SbiRuntime::isVBAEnabled() && eVarType == SbxSTRING )
+ bByVal = true;
+
+ if (bByVal) {
+ if ((eVarType & SbxARRAY) == 0) {
+ switch (eVarType) {
+ case SbxINTEGER:
+ add(blob, variable->GetInteger(), outer ? 4 : 2, offset);
+ break;
+ case SbxLONG:
+ add(blob, variable->GetLong(), 4, offset);
+ break;
+ case SbxSINGLE:
+ add(blob, variable->GetSingle(), 4, offset);
+ break;
+ case SbxDOUBLE:
+ add(blob, variable->GetDouble(), outer ? 4 : 8, offset);
+ break;
+ case SbxSTRING:
+ {
+ void * p;
+ ErrCode e = marshalString(variable, special, data, &p);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ add(blob, p, 4, offset);
+ break;
+ }
+ case SbxOBJECT:
+ {
+ align(blob, outer ? 4 : alignment(variable), offset, 0);
+ ErrCode e = marshalStruct(variable, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ break;
+ }
+ case SbxBOOL:
+ add(blob, variable->GetBool(), outer ? 4 : 1, offset);
+ break;
+ case SbxBYTE:
+ add(blob, variable->GetByte(), outer ? 4 : 1, offset);
+ break;
+ default:
+ assert(false);
+ break;
+ }
+ } else {
+ ErrCode e = marshalArray(variable, blob, offset, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ } else {
+ if ((eVarType & SbxARRAY) == 0) {
+ switch (eVarType) {
+ case SbxINTEGER:
+ case SbxLONG:
+ case SbxSINGLE:
+ case SbxDOUBLE:
+ case SbxBOOL:
+ case SbxBYTE:
+ add(blob, variable->data(), 4, offset);
+ break;
+ case SbxSTRING:
+ {
+ void * p;
+ ErrCode e = marshalString(variable, special, data, &p);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ std::vector< char > * blob2 = data.newBlob();
+ add(*blob2, p, 4, 0);
+ add(blob, address(*blob2), 4, offset);
+ break;
+ }
+ case SbxOBJECT:
+ {
+ std::vector< char > * blob2 = data.newBlob();
+ ErrCode e = marshalStruct(variable, *blob2, 0, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ void * p = address(*blob2);
+ if (outer) {
+ data.unmarshal.push_back(UnmarshalData(variable, p));
+ }
+ add(blob, p, 4, offset);
+ break;
+ }
+ default:
+ assert(false);
+ break;
+ }
+ } else {
+ std::vector< char > * blob2 = data.newBlob();
+ ErrCode e = marshalArray(variable, *blob2, 0, data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ void * p = address(*blob2);
+ if (outer) {
+ data.unmarshal.push_back(UnmarshalData(variable, p));
+ }
+ add(blob, p, 4, offset);
+ }
+ }
+ return ERRCODE_NONE;
+}
+
+template< typename T > T read(void const ** pointer) {
+ T const * p = static_cast< T const * >(*pointer);
+ *pointer = static_cast< void const * >(p + 1);
+ return *p;
+}
+
+void const * unmarshal(SbxVariable * variable, void const * data) {
+ assert(variable != 0);
+ if ((variable->GetType() & SbxARRAY) == 0) {
+ switch (variable->GetType()) {
+ case SbxINTEGER:
+ variable->PutInteger(read< sal_Int16 >(&data));
+ break;
+ case SbxLONG:
+ variable->PutLong(read< sal_Int32 >(&data));
+ break;
+ case SbxSINGLE:
+ variable->PutSingle(read< float >(&data));
+ break;
+ case SbxDOUBLE:
+ variable->PutDouble(read< double >(&data));
+ break;
+ case SbxSTRING:
+ read< char * >(&data); // handled by unmarshalString
+ break;
+ case SbxOBJECT:
+ {
+ data = reinterpret_cast< void const * >(
+ align(
+ reinterpret_cast< sal_uIntPtr >(data),
+ alignment(variable)));
+ SbxObject* pobj = dynamic_cast<SbxObject*>(variable->GetObject());
+ assert(pobj);
+ SbxArray* props = pobj->GetProperties();
+ for (sal_uInt32 i = 0; i < props->Count32(); ++i) {
+ data = unmarshal(props->Get32(i), data);
+ }
+ break;
+ }
+ case SbxBOOL:
+ variable->PutBool(read< sal_Bool >(&data));
+ break;
+ case SbxBYTE:
+ variable->PutByte(read< sal_uInt8 >(&data));
+ break;
+ default:
+ assert(false);
+ break;
+ }
+ } else {
+ SbxDimArray * arr = dynamic_cast<SbxDimArray*>( variable->GetObject() );
+ assert(arr);
+ sal_Int32 dims = arr->GetDims32();
+ std::vector< sal_Int32 > low(dims);
+ std::vector< sal_Int32 > up(dims);
+ for (sal_Int32 i = 0; i < dims; ++i) {
+ arr->GetDim32(i + 1, low[i], up[i]);
+ }
+ for (std::vector< sal_Int32 > idx = low;;) {
+ data = unmarshal(arr->Get32(&idx[0]), data);
+ sal_Int32 i = dims - 1;
+ while (idx[i] == up[i]) {
+ idx[i] = low[i];
+ if (i == 0) {
+ goto done;
+ }
+ --i;
+ }
+ ++idx[i];
+ }
+ done:;
+ }
+ return data;
+}
+
+ErrCode unmarshalString(StringData const & data, SbxVariable & result) {
+ OUString str;
+ if (data.buffer != 0) {
+ char const * p = static_cast< char const * >(data.buffer);
+ sal_Int32 len;
+ if (data.special) {
+ len = static_cast< sal_Int32 >(result.GetULong());
+ if (len < 0) { // i.e., DWORD result >= 2^31
+ return ERRCODE_BASIC_BAD_ARGUMENT;
+ //TODO: more specific errcode?
+ }
+ } else {
+ len = rtl_str_getLength(p);
+ }
+ ErrCode e = convert(p, len, &str);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ data.variable->PutString(str);
+ return ERRCODE_NONE;
+}
+
+struct ProcData {
+ OString name;
+ FARPROC proc;
+};
+
+ErrCode call(
+ OUString const & dll, ProcData const & proc, SbxArray * arguments,
+ SbxVariable & result)
+{
+ std::vector< char > stack;
+ MarshalData data;
+ // For DWORD GetLogicalDriveStringsA(DWORD nBufferLength, LPSTR lpBuffer)
+ // from kernel32, upon return, filled lpBuffer length is result DWORD, which
+ // requires special handling in unmarshalString; other functions might
+ // require similar treatment, too:
+ bool special = dll.equalsIgnoreAsciiCase("KERNEL32.DLL") &&
+ (proc.name == OString("GetLogicalDriveStringsA"));
+ for (sal_uInt32 i = 1; i < (arguments == 0 ? 0 : arguments->Count32()); ++i) {
+ ErrCode e = marshal(
+ true, arguments->Get32(i), special && i == 2, stack, stack.size(),
+ data);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ align(stack, 4, 0, 0);
+ }
+ switch (result.GetType()) {
+ case SbxEMPTY:
+ DllMgr_call32(proc.proc, address(stack), stack.size());
+ break;
+ case SbxINTEGER:
+ result.PutInteger(
+ static_cast< sal_Int16 >(
+ DllMgr_call32(proc.proc, address(stack), stack.size())));
+ break;
+ case SbxLONG:
+ result.PutLong(
+ static_cast< sal_Int32 >(
+ DllMgr_call32(proc.proc, address(stack), stack.size())));
+ break;
+ case SbxSINGLE:
+ result.PutSingle(
+ static_cast< float >(
+ DllMgr_callFp(proc.proc, address(stack), stack.size())));
+ break;
+ case SbxDOUBLE:
+ result.PutDouble(
+ DllMgr_callFp(proc.proc, address(stack), stack.size()));
+ break;
+ case SbxSTRING:
+ {
+ char const * s1 = reinterpret_cast< char const * >(
+ DllMgr_call32(proc.proc, address(stack), stack.size()));
+ OUString s2;
+ ErrCode e = convert(s1, rtl_str_getLength(s1), &s2);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ result.PutString(s2);
+ break;
+ }
+ case SbxOBJECT:
+ //TODO
+ DllMgr_call32(proc.proc, address(stack), stack.size());
+ break;
+ case SbxBOOL:
+ result.PutBool(
+ bool(DllMgr_call32(proc.proc, address(stack), stack.size())));
+ break;
+ case SbxBYTE:
+ result.PutByte(
+ static_cast< sal_uInt8 >(
+ DllMgr_call32(proc.proc, address(stack), stack.size())));
+ break;
+ default:
+ assert(false);
+ break;
+ }
+ for (sal_uInt32 i = 1; i < (arguments == 0 ? 0 : arguments->Count32()); ++i) {
+ arguments->Get32(i)->ResetFlag(SbxFlagBits::Reference);
+ //TODO: skipped for errors?!?
+ }
+ for (auto& rUnmarshalData : data.unmarshal)
+ {
+ unmarshal(rUnmarshalData.variable, rUnmarshalData.buffer);
+ }
+ for (const auto& rStringData : data.unmarshalStrings)
+ {
+ ErrCode e = unmarshalString(rStringData, result);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ }
+ return ERRCODE_NONE;
+}
+
+ErrCode getProcData(HMODULE handle, OUString const & name, ProcData * proc)
+{
+ assert(proc != 0);
+ if ( !name.isEmpty() && name[0] == '@' ) { //TODO: "@" vs. "#"???
+ sal_Int32 n = name.copy(1).toInt32(); //TODO: handle bad input
+ if (n <= 0 || n > 0xFFFF) {
+ return ERRCODE_BASIC_BAD_ARGUMENT; //TODO: more specific errcode?
+ }
+ FARPROC p = GetProcAddress(handle, reinterpret_cast< LPCSTR >(n));
+ if (p != 0) {
+ proc->name = OString("#") + OString::number(n);
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ } else {
+ OString name8;
+ ErrCode e = convert(name, &name8);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ FARPROC p = GetProcAddress(handle, name8.getStr());
+ if (p != 0) {
+ proc->name = name8;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ sal_Int32 i = name8.indexOf('#');
+ if (i != -1) {
+ name8 = name8.copy(0, i);
+ p = GetProcAddress(handle, name8.getStr());
+ if (p != 0) {
+ proc->name = name8;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ }
+ OString real(OString("_") + name8);
+ p = GetProcAddress(handle, real.getStr());
+ if (p != 0) {
+ proc->name = real;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ real = name8 + OString("A");
+ p = GetProcAddress(handle, real.getStr());
+ if (p != 0) {
+ proc->name = real;
+ proc->proc = p;
+ return ERRCODE_NONE;
+ }
+ }
+ return ERRCODE_BASIC_PROC_UNDEFINED;
+}
+
+struct Dll: public salhelper::SimpleReferenceObject {
+private:
+ typedef std::map< OUString, ProcData > Procs;
+
+ virtual ~Dll();
+
+public:
+ Dll(): handle(0) {}
+
+ ErrCode getProc(OUString const & name, ProcData * proc);
+
+ HMODULE handle;
+ Procs procs;
+};
+
+Dll::~Dll() {
+ if (handle != 0 && !FreeLibrary(handle)) {
+ SAL_WARN("basic", "FreeLibrary(" << handle << ") failed with " << GetLastError());
+ }
+}
+
+ErrCode Dll::getProc(OUString const & name, ProcData * proc) {
+ Procs::iterator i(procs.find(name));
+ if (i != procs.end()) {
+ *proc = i->second;
+ return ERRCODE_NONE;
+ }
+ ErrCode e = getProcData(handle, name, proc);
+ if (e == ERRCODE_NONE) {
+ procs.emplace(name, *proc);
+ }
+ return e;
+}
+
+OUString fullDllName(OUString const & name) {
+ OUString full(name);
+ if (full.indexOf('.') == -1) {
+ full += ".DLL";
+ }
+ return full;
+}
+
+}
+
+struct SbiDllMgr::Impl {
+private:
+ typedef std::map< OUString, rtl::Reference< Dll > > Dlls;
+
+public:
+ Impl() = default;
+ Impl(const Impl&) = delete;
+ const Impl& operator=(const Impl&) = delete;
+
+ Dll * getDll(OUString const & name);
+
+ Dlls dlls;
+};
+
+Dll * SbiDllMgr::Impl::getDll(OUString const & name) {
+ Dlls::iterator i(dlls.find(name));
+ if (i == dlls.end()) {
+ i = dlls.emplace(name, new Dll).first;
+ HMODULE h = LoadLibraryW(o3tl::toW(name.getStr()));
+ if (h == 0) {
+ dlls.erase(i);
+ return 0;
+ }
+ i->second->handle = h;
+ }
+ return i->second.get();
+}
+
+ErrCode SbiDllMgr::Call(
+ OUString const & function, OUString const & library,
+ SbxArray * arguments, SbxVariable & result, bool cdeclConvention)
+{
+ if (cdeclConvention) {
+ return ERRCODE_BASIC_NOT_IMPLEMENTED;
+ }
+ OUString dllName(fullDllName(library));
+ Dll * dll = impl_->getDll(dllName);
+ if (dll == 0) {
+ return ERRCODE_BASIC_BAD_DLL_LOAD;
+ }
+ ProcData proc;
+ ErrCode e = dll->getProc(function, &proc);
+ if (e != ERRCODE_NONE) {
+ return e;
+ }
+ return call(dllName, proc, arguments, result);
+}
+
+void SbiDllMgr::FreeDll(OUString const & library) {
+ impl_->dlls.erase(library);
+}
+
+SbiDllMgr::SbiDllMgr(): impl_(new Impl) {}
+
+SbiDllMgr::~SbiDllMgr() {}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/dllmgr.hxx b/basic/source/runtime/dllmgr.hxx
new file mode 100644
index 000000000..461375467
--- /dev/null
+++ b/basic/source/runtime/dllmgr.hxx
@@ -0,0 +1,53 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_RUNTIME_DLLMGR_HXX
+#define INCLUDED_BASIC_SOURCE_RUNTIME_DLLMGR_HXX
+
+#include <sal/config.h>
+#include <vcl/errcode.hxx>
+#include <memory>
+
+class SbxArray;
+class SbxVariable;
+
+class SbiDllMgr {
+public:
+ SbiDllMgr(const SbiDllMgr&) = delete;
+ const SbiDllMgr& operator=(const SbiDllMgr&) = delete;
+
+ SbiDllMgr();
+
+ ~SbiDllMgr();
+
+ ErrCode Call(
+ OUString const & function, OUString const & library,
+ SbxArray * arguments, SbxVariable & result, bool cdeclConvention);
+
+ void FreeDll(OUString const & library);
+
+private:
+ struct Impl;
+
+ std::unique_ptr< Impl > impl_;
+};
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/inputbox.cxx b/basic/source/runtime/inputbox.cxx
new file mode 100644
index 000000000..1d27b25ab
--- /dev/null
+++ b/basic/source/runtime/inputbox.cxx
@@ -0,0 +1,143 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/sberrors.hxx>
+#include <tools/lineend.hxx>
+#include <vcl/svapp.hxx>
+#include <vcl/weld.hxx>
+#include <vcl/window.hxx>
+#include <rtlproto.hxx>
+#include <memory>
+
+namespace {
+
+class SvRTLInputBox : public weld::GenericDialogController
+{
+ std::unique_ptr<weld::Entry> m_xEdit;
+ std::unique_ptr<weld::Button> m_xOk;
+ std::unique_ptr<weld::Button> m_xCancel;
+ std::unique_ptr<weld::Label> m_xPromptText;
+ OUString m_aText;
+
+ void PositionDialog( long nXTwips, long nYTwips );
+ void InitButtons();
+ void SetPrompt(const OUString& rPrompt);
+ DECL_LINK( OkHdl, weld::Button&, void );
+ DECL_LINK( CancelHdl, weld::Button&, void );
+
+public:
+ SvRTLInputBox(weld::Window* pParent, const OUString& rPrompt, const OUString& rTitle,
+ const OUString& rDefault, long nXTwips, long nYTwips );
+ OUString const & GetText() const { return m_aText; }
+};
+
+}
+
+SvRTLInputBox::SvRTLInputBox(weld::Window* pParent, const OUString& rPrompt,
+ const OUString& rTitle, const OUString& rDefault,
+ long nXTwips, long nYTwips)
+ : GenericDialogController(pParent, "svt/ui/inputbox.ui", "InputBox")
+ , m_xEdit(m_xBuilder->weld_entry("entry"))
+ , m_xOk(m_xBuilder->weld_button("ok"))
+ , m_xCancel(m_xBuilder->weld_button("cancel"))
+ , m_xPromptText(m_xBuilder->weld_label("prompt"))
+{
+ PositionDialog( nXTwips, nYTwips );
+ InitButtons();
+ SetPrompt(rPrompt);
+ m_xDialog->set_title(rTitle);
+ m_xEdit->set_text(rDefault);
+ m_xEdit->select_region(0, -1);
+}
+
+void SvRTLInputBox::InitButtons()
+{
+ m_xOk->connect_clicked(LINK(this,SvRTLInputBox, OkHdl));
+ m_xCancel->connect_clicked(LINK(this,SvRTLInputBox,CancelHdl));
+}
+
+void SvRTLInputBox::PositionDialog(long nXTwips, long nYTwips)
+{
+ if( nXTwips != -1 && nYTwips != -1 )
+ {
+ Point aDlgPosApp( nXTwips, nYTwips );
+ OutputDevice* pDefaultDevice = Application::GetDefaultDevice();
+ pDefaultDevice->Push(PushFlags::MAPMODE);
+ pDefaultDevice->SetMapMode(MapMode( MapUnit::MapAppFont));
+ aDlgPosApp = pDefaultDevice->LogicToPixel(aDlgPosApp, MapMode(MapUnit::MapTwip));
+ pDefaultDevice->Pop();
+ m_xDialog->window_move(aDlgPosApp.X(), aDlgPosApp.Y());
+ }
+}
+
+void SvRTLInputBox::SetPrompt(const OUString& rPrompt)
+{
+ if (rPrompt.isEmpty())
+ return;
+ OUString aText_(convertLineEnd(rPrompt, LINEEND_CR));
+ m_xPromptText->set_label( aText_ );
+}
+
+IMPL_LINK_NOARG( SvRTLInputBox, OkHdl, weld::Button&, void )
+{
+ m_aText = m_xEdit->get_text();
+ m_xDialog->response(RET_OK);
+}
+
+IMPL_LINK_NOARG( SvRTLInputBox, CancelHdl, weld::Button&, void )
+{
+ m_aText.clear();
+ m_xDialog->response(RET_CANCEL);
+}
+
+// Syntax: String InputBox( Prompt, [Title], [Default] [, nXpos, nYpos ] )
+
+void SbRtl_InputBox(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32();
+ if ( nArgCount < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ OUString aTitle;
+ OUString aDefault;
+ sal_Int32 nX = -1, nY = -1; // center
+ const OUString& rPrompt = rPar.Get32(1)->GetOUString();
+ if ( nArgCount > 2 && !rPar.Get32(2)->IsErr() )
+ aTitle = rPar.Get32(2)->GetOUString();
+ if ( nArgCount > 3 && !rPar.Get32(3)->IsErr() )
+ aDefault = rPar.Get32(3)->GetOUString();
+ if ( nArgCount > 4 )
+ {
+ if ( nArgCount != 6 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ nX = rPar.Get32(4)->GetLong();
+ nY = rPar.Get32(5)->GetLong();
+ }
+ vcl::Window* pParent = Application::GetDefDialogParent();
+ SvRTLInputBox aDlg(pParent ? pParent->GetFrameWeld() : nullptr,rPrompt,aTitle,aDefault,nX,nY);
+ aDlg.run();
+ rPar.Get32(0)->PutString(aDlg.GetText());
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/iosys.cxx b/basic/source/runtime/iosys.cxx
new file mode 100644
index 000000000..d525d1a13
--- /dev/null
+++ b/basic/source/runtime/iosys.cxx
@@ -0,0 +1,849 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <string.h>
+#include <vcl/svapp.hxx>
+#include <vcl/weld.hxx>
+#include <vcl/window.hxx>
+#include <osl/file.hxx>
+
+#include <runtime.hxx>
+
+#include <rtl/strbuf.hxx>
+#include <sal/log.hxx>
+
+#include <comphelper/processfactory.hxx>
+#include <comphelper/string.hxx>
+
+#include <com/sun/star/uno/Sequence.hxx>
+#include <com/sun/star/ucb/SimpleFileAccess.hpp>
+#include <com/sun/star/ucb/UniversalContentBroker.hpp>
+#include <com/sun/star/io/XInputStream.hpp>
+#include <com/sun/star/io/XOutputStream.hpp>
+#include <com/sun/star/io/XStream.hpp>
+#include <com/sun/star/io/XSeekable.hpp>
+
+using namespace com::sun::star::uno;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::ucb;
+using namespace com::sun::star::io;
+using namespace com::sun::star::bridge;
+
+#include <iosys.hxx>
+
+namespace {
+
+class SbiInputDialog : public weld::GenericDialogController
+{
+ std::unique_ptr<weld::Entry> m_xInput;
+ std::unique_ptr<weld::Button> m_xOk;
+ std::unique_ptr<weld::Button> m_xCancel;
+ std::unique_ptr<weld::Label> m_xPromptText;
+ OUString m_aText;
+ DECL_LINK(Ok, weld::Button&, void);
+ DECL_LINK(Cancel, weld::Button&, void);
+public:
+ SbiInputDialog(weld::Window*, const OUString&);
+ const OUString& GetInput() const { return m_aText; }
+};
+
+}
+
+SbiInputDialog::SbiInputDialog(weld::Window* pParent, const OUString& rPrompt)
+ : GenericDialogController(pParent, "svt/ui/inputbox.ui", "InputBox")
+ , m_xInput(m_xBuilder->weld_entry("entry"))
+ , m_xOk(m_xBuilder->weld_button("ok"))
+ , m_xCancel(m_xBuilder->weld_button("cancel"))
+ , m_xPromptText(m_xBuilder->weld_label("prompt"))
+{
+ m_xDialog->set_title(rPrompt);
+ m_xPromptText->set_label(rPrompt);
+ m_xOk->connect_clicked( LINK( this, SbiInputDialog, Ok ) );
+ m_xCancel->connect_clicked( LINK( this, SbiInputDialog, Cancel ) );
+}
+
+IMPL_LINK_NOARG( SbiInputDialog, Ok, weld::Button&, void )
+{
+ m_aText = m_xInput->get_text();
+ m_xDialog->response(RET_OK);
+}
+
+IMPL_LINK_NOARG( SbiInputDialog, Cancel, weld::Button&, void )
+{
+ m_xDialog->response(RET_CANCEL);
+}
+
+SbiStream::SbiStream()
+ : nExpandOnWriteTo(0)
+ , nLine(0)
+ , nLen(0)
+ , nMode(SbiStreamFlags::NONE)
+ , nError(0)
+{
+}
+
+SbiStream::~SbiStream()
+{
+}
+
+// map an SvStream-error to StarBASIC-code
+
+void SbiStream::MapError()
+{
+ if( !pStrm )
+ return;
+
+ ErrCode nEC = pStrm->GetError();
+ if (nEC == ERRCODE_NONE)
+ nError = ERRCODE_NONE;
+ else if (nEC == SVSTREAM_FILE_NOT_FOUND)
+ nError = ERRCODE_BASIC_FILE_NOT_FOUND;
+ else if (nEC ==SVSTREAM_PATH_NOT_FOUND)
+ nError = ERRCODE_BASIC_PATH_NOT_FOUND;
+ else if (nEC ==SVSTREAM_TOO_MANY_OPEN_FILES)
+ nError = ERRCODE_BASIC_TOO_MANY_FILES;
+ else if (nEC ==SVSTREAM_ACCESS_DENIED)
+ nError = ERRCODE_BASIC_ACCESS_DENIED;
+ else if (nEC ==SVSTREAM_INVALID_PARAMETER)
+ nError = ERRCODE_BASIC_BAD_ARGUMENT;
+ else if (nEC ==SVSTREAM_OUTOFMEMORY)
+ nError = ERRCODE_BASIC_NO_MEMORY;
+ else
+ nError = ERRCODE_BASIC_IO_ERROR;
+}
+
+// Returns sal_True if UNO is available, otherwise the old file
+// system implementation has to be used
+// #89378 New semantic: Don't just ask for UNO but for UCB
+bool hasUno()
+{
+ static bool bNeedInit = true;
+ static bool bRetVal = true;
+
+ if( bNeedInit )
+ {
+ bNeedInit = false;
+ Reference< XComponentContext > xContext = comphelper::getProcessComponentContext();
+ if( !xContext.is() )
+ {
+ // No service manager at all
+ bRetVal = false;
+ }
+ else
+ {
+ Reference< XUniversalContentBroker > xManager = UniversalContentBroker::create(xContext);
+
+ if ( !( xManager->queryContentProvider( "file:///" ).is() ) )
+ {
+ // No UCB
+ bRetVal = false;
+ }
+ }
+ }
+ return bRetVal;
+}
+
+namespace {
+
+class OslStream : public SvStream
+{
+ osl::File maFile;
+
+public:
+ OslStream( const OUString& rName, StreamMode nStrmMode );
+ virtual ~OslStream() override;
+ virtual std::size_t GetData(void* pData, std::size_t nSize) override;
+ virtual std::size_t PutData(const void* pData, std::size_t nSize) override;
+ virtual sal_uInt64 SeekPos( sal_uInt64 nPos ) override;
+ virtual void FlushData() override;
+ virtual void SetSize( sal_uInt64 nSize) override;
+};
+
+}
+
+OslStream::OslStream( const OUString& rName, StreamMode nStrmMode )
+ : maFile( rName )
+{
+ sal_uInt32 nFlags;
+
+ if( (nStrmMode & (StreamMode::READ | StreamMode::WRITE)) == (StreamMode::READ | StreamMode::WRITE) )
+ {
+ nFlags = osl_File_OpenFlag_Read | osl_File_OpenFlag_Write;
+ }
+ else if( nStrmMode & StreamMode::WRITE )
+ {
+ nFlags = osl_File_OpenFlag_Write;
+ }
+ else //if( nStrmMode & StreamMode::READ )
+ {
+ nFlags = osl_File_OpenFlag_Read;
+ }
+
+ osl::FileBase::RC nRet = maFile.open( nFlags );
+ if( nRet == osl::FileBase::E_NOENT && nFlags != osl_File_OpenFlag_Read )
+ {
+ nFlags |= osl_File_OpenFlag_Create;
+ nRet = maFile.open( nFlags );
+ }
+
+ if( nRet != osl::FileBase::E_None )
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+}
+
+
+OslStream::~OslStream()
+{
+ maFile.close();
+}
+
+std::size_t OslStream::GetData(void* pData, std::size_t nSize)
+{
+ sal_uInt64 nBytesRead = nSize;
+ maFile.read( pData, nBytesRead, nBytesRead );
+ return nBytesRead;
+}
+
+std::size_t OslStream::PutData(const void* pData, std::size_t nSize)
+{
+ sal_uInt64 nBytesWritten;
+ maFile.write( pData, nSize, nBytesWritten );
+ return nBytesWritten;
+}
+
+sal_uInt64 OslStream::SeekPos( sal_uInt64 nPos )
+{
+ ::osl::FileBase::RC rc = ::osl::FileBase::E_None;
+ // check if a truncated STREAM_SEEK_TO_END was passed
+ assert(nPos != SAL_MAX_UINT32);
+ if( nPos == STREAM_SEEK_TO_END )
+ {
+ rc = maFile.setPos( osl_Pos_End, 0 );
+ }
+ else
+ {
+ rc = maFile.setPos( osl_Pos_Absolut, nPos );
+ }
+ OSL_VERIFY(rc == ::osl::FileBase::E_None);
+ sal_uInt64 nRealPos(0);
+ rc = maFile.getPos( nRealPos );
+ OSL_VERIFY(rc == ::osl::FileBase::E_None);
+ return nRealPos;
+}
+
+void OslStream::FlushData()
+{
+}
+
+void OslStream::SetSize( sal_uInt64 nSize )
+{
+ maFile.setSize( nSize );
+}
+
+namespace {
+
+class UCBStream : public SvStream
+{
+ Reference< XInputStream > xIS;
+ Reference< XStream > xS;
+ Reference< XSeekable > xSeek;
+public:
+ explicit UCBStream( Reference< XInputStream > const & xIS );
+ explicit UCBStream( Reference< XStream > const & xS );
+ virtual ~UCBStream() override;
+ virtual std::size_t GetData( void* pData, std::size_t nSize ) override;
+ virtual std::size_t PutData( const void* pData, std::size_t nSize ) override;
+ virtual sal_uInt64 SeekPos( sal_uInt64 nPos ) override;
+ virtual void FlushData() override;
+ virtual void SetSize( sal_uInt64 nSize ) override;
+};
+
+}
+
+UCBStream::UCBStream( Reference< XInputStream > const & rStm )
+ : xIS( rStm )
+ , xSeek( rStm, UNO_QUERY )
+{
+}
+
+UCBStream::UCBStream( Reference< XStream > const & rStm )
+ : xS( rStm )
+ , xSeek( rStm, UNO_QUERY )
+{
+}
+
+
+UCBStream::~UCBStream()
+{
+ try
+ {
+ if( xIS.is() )
+ {
+ xIS->closeInput();
+ }
+ else if( xS.is() )
+ {
+ Reference< XInputStream > xIS_ = xS->getInputStream();
+ if( xIS_.is() )
+ {
+ xIS_->closeInput();
+ }
+ }
+ }
+ catch(const Exception & )
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+}
+
+std::size_t UCBStream::GetData(void* pData, std::size_t nSize)
+{
+ try
+ {
+ Reference< XInputStream > xISFromS;
+ if( xIS.is() )
+ {
+ Sequence<sal_Int8> aData;
+ nSize = xIS->readBytes( aData, nSize );
+ memcpy( pData, aData.getConstArray(), nSize );
+ return nSize;
+ }
+ else if( xS.is() && (xISFromS = xS->getInputStream()).is() )
+ {
+ Sequence<sal_Int8> aData;
+ nSize = xISFromS->readBytes( aData, nSize );
+ memcpy(pData, aData.getConstArray(), nSize );
+ return nSize;
+ }
+ else
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+ }
+ catch(const Exception & )
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+ return 0;
+}
+
+std::size_t UCBStream::PutData(const void* pData, std::size_t nSize)
+{
+ try
+ {
+ Reference< XOutputStream > xOSFromS;
+ if( xS.is() && (xOSFromS = xS->getOutputStream()).is() )
+ {
+ Sequence<sal_Int8> aData( static_cast<const sal_Int8 *>(pData), nSize );
+ xOSFromS->writeBytes( aData );
+ return nSize;
+ }
+ else
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+ }
+ catch(const Exception & )
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+ return 0;
+}
+
+sal_uInt64 UCBStream::SeekPos( sal_uInt64 nPos )
+{
+ try
+ {
+ if( xSeek.is() )
+ {
+ sal_uInt64 nLen = static_cast<sal_uInt64>( xSeek->getLength() );
+ if( nPos > nLen )
+ {
+ nPos = nLen;
+ }
+ xSeek->seek( nPos );
+ return nPos;
+ }
+ else
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+ }
+ catch(const Exception & )
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+ return 0;
+}
+
+void UCBStream::FlushData()
+{
+ try
+ {
+ Reference< XOutputStream > xOSFromS;
+ if( xS.is() && (xOSFromS = xS->getOutputStream()).is() )
+ {
+ xOSFromS->flush();
+ }
+ else
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+ }
+ catch(const Exception & )
+ {
+ SetError( ERRCODE_IO_GENERAL );
+ }
+}
+
+void UCBStream::SetSize( sal_uInt64 )
+{
+ SAL_WARN("basic", "UCBStream::SetSize not allowed to call from basic" );
+ SetError( ERRCODE_IO_GENERAL );
+}
+
+
+ErrCode const & SbiStream::Open
+( const OString& rName, StreamMode nStrmMode, SbiStreamFlags nFlags, short nL )
+{
+ nMode = nFlags;
+ nLen = nL;
+ nLine = 0;
+ nExpandOnWriteTo = 0;
+ if( ( nStrmMode & ( StreamMode::READ|StreamMode::WRITE ) ) == StreamMode::READ )
+ {
+ nStrmMode |= StreamMode::NOCREATE;
+ }
+ OUString aStr(OStringToOUString(rName, osl_getThreadTextEncoding()));
+ OUString aNameStr = getFullPath( aStr );
+
+ if( hasUno() )
+ {
+ Reference< XSimpleFileAccess3 > xSFI( SimpleFileAccess::create( comphelper::getProcessComponentContext() ) );
+ try
+ {
+
+ // #??? For write access delete file if it already exists (not for appending)
+ if( (nStrmMode & StreamMode::WRITE) && !IsAppend() && !IsBinary() && !IsRandom() &&
+ xSFI->exists( aNameStr ) && !xSFI->isFolder( aNameStr ) )
+ {
+ xSFI->kill( aNameStr );
+ }
+
+ if( (nStrmMode & (StreamMode::READ | StreamMode::WRITE)) == (StreamMode::READ | StreamMode::WRITE) )
+ {
+ Reference< XStream > xIS = xSFI->openFileReadWrite( aNameStr );
+ pStrm.reset( new UCBStream( xIS ) );
+ }
+ else if( nStrmMode & StreamMode::WRITE )
+ {
+ Reference< XStream > xIS = xSFI->openFileReadWrite( aNameStr );
+ pStrm.reset( new UCBStream( xIS ) );
+ }
+ else //if( nStrmMode & StreamMode::READ )
+ {
+ Reference< XInputStream > xIS = xSFI->openFileRead( aNameStr );
+ pStrm.reset( new UCBStream( xIS ) );
+ }
+
+ }
+ catch(const Exception & )
+ {
+ nError = ERRCODE_IO_GENERAL;
+ }
+ }
+
+ if( !pStrm )
+ {
+ pStrm.reset( new OslStream( aNameStr, nStrmMode ) );
+ }
+ if( IsAppend() )
+ {
+ pStrm->Seek( STREAM_SEEK_TO_END );
+ }
+ MapError();
+ if( nError )
+ {
+ pStrm.reset();
+ }
+ return nError;
+}
+
+ErrCode const & SbiStream::Close()
+{
+ if( pStrm )
+ {
+ MapError();
+ pStrm.reset();
+ }
+ return nError;
+}
+
+ErrCode SbiStream::Read(OString& rBuf, sal_uInt16 n, bool bForceReadingPerByte)
+{
+ nExpandOnWriteTo = 0;
+ if( !bForceReadingPerByte && IsText() )
+ {
+ pStrm->ReadLine(rBuf);
+ nLine++;
+ }
+ else
+ {
+ if( !n )
+ {
+ n = nLen;
+ }
+ if( !n )
+ {
+ return nError = ERRCODE_BASIC_BAD_RECORD_LENGTH;
+ }
+ OStringBuffer aBuffer(read_uInt8s_ToOString(*pStrm, n));
+ //Pad it out with ' ' to the requested length on short read
+ sal_Int32 nRequested = sal::static_int_cast<sal_Int32>(n);
+ comphelper::string::padToLength(aBuffer, nRequested, ' ');
+ rBuf = aBuffer.makeStringAndClear();
+ }
+ MapError();
+ if( !nError && pStrm->eof() )
+ {
+ nError = ERRCODE_BASIC_READ_PAST_EOF;
+ }
+ return nError;
+}
+
+ErrCode const & SbiStream::Read( char& ch )
+{
+ nExpandOnWriteTo = 0;
+ if (aLine.isEmpty())
+ {
+ Read( aLine );
+ aLine += OString('\n');
+ }
+ ch = aLine[0];
+ aLine = aLine.copy(1);
+ return nError;
+}
+
+void SbiStream::ExpandFile()
+{
+ if ( !nExpandOnWriteTo )
+ return;
+
+ sal_uInt64 nCur = pStrm->Seek(STREAM_SEEK_TO_END);
+ if( nCur < nExpandOnWriteTo )
+ {
+ sal_uInt64 nDiff = nExpandOnWriteTo - nCur;
+ while( nDiff-- )
+ {
+ pStrm->WriteChar( 0 );
+ }
+ }
+ else
+ {
+ pStrm->Seek( nExpandOnWriteTo );
+ }
+ nExpandOnWriteTo = 0;
+}
+
+namespace
+{
+ void WriteLines(SvStream &rStream, const OString& rStr)
+ {
+ OString aStr(convertLineEnd(rStr, rStream.GetLineDelimiter()) );
+ write_uInt8s_FromOString(rStream, aStr);
+ endl( rStream );
+ }
+}
+
+ErrCode SbiStream::Write( const OString& rBuf )
+{
+ ExpandFile();
+ if( IsAppend() )
+ {
+ pStrm->Seek( STREAM_SEEK_TO_END );
+ }
+ if( IsText() )
+ {
+ aLine += rBuf;
+ // Get it out, if the end is an LF, but strip CRLF before,
+ // because the SvStream adds a CRLF!
+ sal_Int32 nLineLen = aLine.getLength();
+ if (nLineLen && aLine[--nLineLen] == 0x0A)
+ {
+ aLine = aLine.copy(0, nLineLen);
+ if (nLineLen && aLine[--nLineLen] == 0x0D)
+ {
+ aLine = aLine.copy(0, nLineLen);
+ }
+ WriteLines(*pStrm, aLine);
+ aLine.clear();
+ }
+ }
+ else
+ {
+ if( !nLen )
+ {
+ return nError = ERRCODE_BASIC_BAD_RECORD_LENGTH;
+ }
+ pStrm->WriteBytes(rBuf.getStr(), nLen);
+ MapError();
+ }
+ return nError;
+}
+
+
+SbiIoSystem::SbiIoSystem()
+{
+ for(SbiStream* & i : pChan)
+ {
+ i = nullptr;
+ }
+ nChan = 0;
+ nError = ERRCODE_NONE;
+}
+
+SbiIoSystem::~SbiIoSystem() COVERITY_NOEXCEPT_FALSE
+{
+ Shutdown();
+}
+
+ErrCode SbiIoSystem::GetError()
+{
+ ErrCode n = nError;
+ nError = ERRCODE_NONE;
+ return n;
+}
+
+void SbiIoSystem::Open(short nCh, const OString& rName, StreamMode nMode, SbiStreamFlags nFlags, short nLen)
+{
+ nError = ERRCODE_NONE;
+ if( nCh >= CHANNELS || !nCh )
+ {
+ nError = ERRCODE_BASIC_BAD_CHANNEL;
+ }
+ else if( pChan[ nCh ] )
+ {
+ nError = ERRCODE_BASIC_FILE_ALREADY_OPEN;
+ }
+ else
+ {
+ pChan[ nCh ] = new SbiStream;
+ nError = pChan[ nCh ]->Open( rName, nMode, nFlags, nLen );
+ if( nError )
+ {
+ delete pChan[ nCh ];
+ pChan[ nCh ] = nullptr;
+ }
+ }
+ nChan = 0;
+}
+
+
+void SbiIoSystem::Close()
+{
+ if( !nChan )
+ {
+ nError = ERRCODE_BASIC_BAD_CHANNEL;
+ }
+ else if( !pChan[ nChan ] )
+ {
+ nError = ERRCODE_BASIC_BAD_CHANNEL;
+ }
+ else
+ {
+ nError = pChan[ nChan ]->Close();
+ delete pChan[ nChan ];
+ pChan[ nChan ] = nullptr;
+ }
+ nChan = 0;
+}
+
+
+void SbiIoSystem::Shutdown()
+{
+ for( short i = 1; i < CHANNELS; i++ )
+ {
+ if( pChan[ i ] )
+ {
+ ErrCode n = pChan[ i ]->Close();
+ delete pChan[ i ];
+ pChan[ i ] = nullptr;
+ if( n && !nError )
+ {
+ nError = n;
+ }
+ }
+ }
+ nChan = 0;
+ // anything left to PRINT?
+ if( !aOut.isEmpty() )
+ {
+ vcl::Window* pParent = Application::GetDefDialogParent();
+ std::unique_ptr<weld::MessageDialog> xBox(Application::CreateMessageDialog(pParent ? pParent->GetFrameWeld() : nullptr, VclMessageType::Warning,
+ VclButtonsType::Ok, aOut));
+ xBox->run();
+ }
+ aOut.clear();
+}
+
+
+void SbiIoSystem::Read(OString& rBuf)
+{
+ if( !nChan )
+ {
+ ReadCon( rBuf );
+ }
+ else if( !pChan[ nChan ] )
+ {
+ nError = ERRCODE_BASIC_BAD_CHANNEL;
+ }
+ else
+ {
+ nError = pChan[ nChan ]->Read( rBuf );
+ }
+}
+
+char SbiIoSystem::Read()
+{
+ char ch = ' ';
+ if( !nChan )
+ {
+ if( aIn.isEmpty() )
+ {
+ ReadCon( aIn );
+ aIn += OString('\n');
+ }
+ ch = aIn[0];
+ aIn = aIn.copy(1);
+ }
+ else if( !pChan[ nChan ] )
+ {
+ nError = ERRCODE_BASIC_BAD_CHANNEL;
+ }
+ else
+ {
+ nError = pChan[ nChan ]->Read( ch );
+ }
+ return ch;
+}
+
+void SbiIoSystem::Write(const OUString& rBuf)
+{
+ if( !nChan )
+ {
+ WriteCon( rBuf );
+ }
+ else if( !pChan[ nChan ] )
+ {
+ nError = ERRCODE_BASIC_BAD_CHANNEL;
+ }
+ else
+ {
+ nError = pChan[ nChan ]->Write( OUStringToOString(rBuf, osl_getThreadTextEncoding()) );
+ }
+}
+
+// nChannel == 0..CHANNELS-1
+
+SbiStream* SbiIoSystem::GetStream( short nChannel ) const
+{
+ SbiStream* pRet = nullptr;
+ if( nChannel >= 0 && nChannel < CHANNELS )
+ {
+ pRet = pChan[ nChannel ];
+ }
+ return pRet;
+}
+
+void SbiIoSystem::CloseAll()
+{
+ for( short i = 1; i < CHANNELS; i++ )
+ {
+ if( pChan[ i ] )
+ {
+ ErrCode n = pChan[ i ]->Close();
+ delete pChan[ i ];
+ pChan[ i ] = nullptr;
+ if( n && !nError )
+ {
+ nError = n;
+ }
+ }
+ }
+}
+
+void SbiIoSystem::ReadCon(OString& rIn)
+{
+ OUString aPromptStr(OStringToOUString(aPrompt, osl_getThreadTextEncoding()));
+ SbiInputDialog aDlg(nullptr, aPromptStr);
+ if (aDlg.run() == RET_OK)
+ {
+ rIn = OUStringToOString(aDlg.GetInput(), osl_getThreadTextEncoding());
+ }
+ else
+ {
+ nError = ERRCODE_BASIC_USER_ABORT;
+ }
+ aPrompt.clear();
+}
+
+// output of a MessageBox, if there's a CR in the console-buffer
+
+void SbiIoSystem::WriteCon(const OUString& rText)
+{
+ aOut += rText;
+ sal_Int32 n1 = aOut.indexOf('\n');
+ sal_Int32 n2 = aOut.indexOf('\r');
+ if( n1 == -1 && n2 == -1 )
+ return;
+
+ if( n1 == -1 )
+ {
+ n1 = n2;
+ }
+ else if( n2 == -1 )
+ {
+ n2 = n1;
+ }
+ if( n1 > n2 )
+ {
+ n1 = n2;
+ }
+ OUString s(aOut.copy(0, n1));
+ aOut = aOut.copy(n1);
+ while ( !aOut.isEmpty() && (aOut[0] == '\n' || aOut[0] == '\r') )
+ {
+ aOut = aOut.copy(1);
+ }
+ {
+ SolarMutexGuard aSolarGuard;
+
+ vcl::Window* pParent = Application::GetDefDialogParent();
+ std::unique_ptr<weld::MessageDialog> xBox(Application::CreateMessageDialog(pParent ? pParent->GetFrameWeld() : nullptr, VclMessageType::Warning,
+ VclButtonsType::OkCancel, s));
+ xBox->set_default_response(RET_OK);
+ if (!xBox->run())
+ {
+ nError = ERRCODE_BASIC_USER_ABORT;
+ }
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx
new file mode 100644
index 000000000..671cbe0a3
--- /dev/null
+++ b/basic/source/runtime/methods.cxx
@@ -0,0 +1,4826 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+
+#include <tools/date.hxx>
+#include <basic/sbxvar.hxx>
+#include <basic/sbuno.hxx>
+#include <osl/process.h>
+#include <vcl/dibtools.hxx>
+#include <vcl/window.hxx>
+#include <vcl/svapp.hxx>
+#include <vcl/settings.hxx>
+#include <vcl/sound.hxx>
+#include <tools/wintypes.hxx>
+#include <vcl/stdtext.hxx>
+#include <vcl/weld.hxx>
+#include <basic/sbx.hxx>
+#include <svl/zforlist.hxx>
+#include <rtl/character.hxx>
+#include <rtl/math.hxx>
+#include <tools/urlobj.hxx>
+#include <osl/time.h>
+#include <unotools/charclass.hxx>
+#include <unotools/ucbstreamhelper.hxx>
+#include <tools/wldcrd.hxx>
+#include <i18nlangtag/lang.h>
+#include <rtl/string.hxx>
+#include <sal/log.hxx>
+#include <comphelper/DirectoryHelper.hxx>
+
+#include <runtime.hxx>
+#include <sbunoobj.hxx>
+#include <osl/file.hxx>
+#include <errobject.hxx>
+
+#include <comphelper/string.hxx>
+#include <comphelper/processfactory.hxx>
+
+#include <com/sun/star/uno/Sequence.hxx>
+#include <com/sun/star/util/DateTime.hpp>
+#include <com/sun/star/lang/Locale.hpp>
+#include <com/sun/star/lang/XServiceInfo.hpp>
+#include <com/sun/star/ucb/SimpleFileAccess.hpp>
+#include <com/sun/star/script/XErrorQuery.hpp>
+#include <ooo/vba/VbTriState.hpp>
+#include <com/sun/star/bridge/oleautomation/XAutomationObject.hpp>
+#include <memory>
+#include <random>
+#include <o3tl/char16_t2wchar_t.hxx>
+
+using namespace comphelper;
+using namespace osl;
+using namespace com::sun::star;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::uno;
+
+#include <date.hxx>
+#include <sbstdobj.hxx>
+#include <rtlproto.hxx>
+#include <image.hxx>
+#include <iosys.hxx>
+#include "ddectrl.hxx"
+#include <sbintern.hxx>
+#include <basic/vbahelper.hxx>
+
+#include <vector>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+
+#include <sbobjmod.hxx>
+#include <sbxmod.hxx>
+
+#ifdef _WIN32
+#include <prewin.h>
+#include <direct.h>
+#include <io.h>
+#include <postwin.h>
+#else
+#include <unistd.h>
+#endif
+
+#include <com/sun/star/i18n/XCharacterClassification.hpp>
+#include <vcl/unohelp.hxx>
+
+#if HAVE_FEATURE_SCRIPTING
+
+static void FilterWhiteSpace( OUString& rStr )
+{
+ if (rStr.isEmpty())
+ {
+ return;
+ }
+ OUStringBuffer aRet;
+
+ for (sal_Int32 i = 0; i < rStr.getLength(); ++i)
+ {
+ sal_Unicode cChar = rStr[i];
+ if ((cChar != ' ') && (cChar != '\t') &&
+ (cChar != '\n') && (cChar != '\r'))
+ {
+ aRet.append(cChar);
+ }
+ }
+
+ rStr = aRet.makeStringAndClear();
+}
+
+static long GetDayDiff( const Date& rDate );
+
+static const CharClass& GetCharClass()
+{
+ static CharClass aCharClass( Application::GetSettings().GetLanguageTag() );
+ return aCharClass;
+}
+
+static bool isFolder( FileStatus::Type aType )
+{
+ return ( aType == FileStatus::Directory || aType == FileStatus::Volume );
+}
+
+
+//*** UCB file access ***
+
+// Converts possibly relative paths to absolute paths
+// according to the setting done by ChDir/ChDrive
+OUString getFullPath( const OUString& aRelPath )
+{
+ OUString aFileURL;
+
+ // #80204 Try first if it already is a valid URL
+ INetURLObject aURLObj( aRelPath );
+ aFileURL = aURLObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ if( aFileURL.isEmpty() )
+ {
+ File::getFileURLFromSystemPath( aRelPath, aFileURL );
+ }
+
+ return aFileURL;
+}
+
+// TODO: -> SbiGlobals
+static uno::Reference< ucb::XSimpleFileAccess3 > const & getFileAccess()
+{
+ static uno::Reference< ucb::XSimpleFileAccess3 > xSFI = ucb::SimpleFileAccess::create( comphelper::getProcessComponentContext() );
+ return xSFI;
+}
+
+
+// Properties and methods lie down the return value at the Get (bPut = sal_False) in the
+// element 0 of the Argv; the value of element 0 is saved at Put (bPut = sal_True)
+
+// CreateObject( class )
+
+void SbRtl_CreateObject(StarBASIC * pBasic, SbxArray & rPar, bool)
+{
+ OUString aClass( rPar.Get32(1)->GetOUString() );
+ SbxObjectRef p = SbxBase::CreateObject( aClass );
+ if( !p.is() )
+ StarBASIC::Error( ERRCODE_BASIC_CANNOT_LOAD );
+ else
+ {
+ // Convenience: enter BASIC as parent
+ p->SetParent( pBasic );
+ rPar.Get32(0)->PutObject( p.get() );
+ }
+}
+
+// Error( n )
+
+void SbRtl_Error(StarBASIC * pBasic, SbxArray & rPar, bool)
+{
+ if( !pBasic )
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+ else
+ {
+ OUString aErrorMsg;
+ ErrCode nErr = ERRCODE_NONE;
+ sal_Int32 nCode = 0;
+ if( rPar.Count32() == 1 )
+ {
+ nErr = StarBASIC::GetErrBasic();
+ aErrorMsg = StarBASIC::GetErrorMsg();
+ }
+ else
+ {
+ nCode = rPar.Get32(1)->GetLong();
+ if( nCode > 65535 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
+ }
+ else
+ {
+ nErr = StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(nCode) );
+ }
+ }
+
+ bool bVBA = SbiRuntime::isVBAEnabled();
+ OUString tmpErrMsg;
+ if( bVBA && !aErrorMsg.isEmpty())
+ {
+ tmpErrMsg = aErrorMsg;
+ }
+ else
+ {
+ StarBASIC::MakeErrorText( nErr, aErrorMsg );
+ tmpErrMsg = StarBASIC::GetErrorText();
+ }
+ // If this rtlfunc 'Error' passed an errcode the same as the active Err Objects's
+ // current err then return the description for the error message if it is set
+ // ( complicated isn't it ? )
+ if ( bVBA && rPar.Count32() > 1 )
+ {
+ uno::Reference< ooo::vba::XErrObject > xErrObj( SbxErrObject::getUnoErrObject() );
+ if ( xErrObj.is() && xErrObj->getNumber() == nCode && !xErrObj->getDescription().isEmpty() )
+ {
+ tmpErrMsg = xErrObj->getDescription();
+ }
+ }
+ rPar.Get32(0)->PutString( tmpErrMsg );
+ }
+}
+
+// Sinus
+
+void SbRtl_Sin(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ rPar.Get32(0)->PutDouble( sin( pArg->GetDouble() ) );
+ }
+}
+
+
+void SbRtl_Cos(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ rPar.Get32(0)->PutDouble( cos( pArg->GetDouble() ) );
+ }
+}
+
+
+void SbRtl_Atn(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ rPar.Get32(0)->PutDouble( atan( pArg->GetDouble() ) );
+ }
+}
+
+
+void SbRtl_Abs(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ rPar.Get32(0)->PutDouble( fabs( pArg->GetDouble() ) );
+ }
+}
+
+
+void SbRtl_Asc(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ OUString aStr( pArg->GetOUString() );
+ if ( aStr.isEmpty())
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ rPar.Get32(0)->PutEmpty();
+ }
+ else
+ {
+ sal_Unicode aCh = aStr[0];
+ rPar.Get32(0)->PutLong( aCh );
+ }
+ }
+}
+
+static void implChr( SbxArray& rPar, bool bChrW )
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+
+ OUString aStr;
+ if( !bChrW && SbiRuntime::isVBAEnabled() )
+ {
+ char c = static_cast<char>(pArg->GetByte());
+ aStr = OUString(&c, 1, osl_getThreadTextEncoding());
+ }
+ else
+ {
+ // Map negative 16-bit values to large positive ones, so that code like Chr(&H8000)
+ // still works after the fix for tdf#62326 changed those four-digit hex notations to
+ // produce negative values:
+ sal_Int32 aCh = pArg->GetLong();
+ if (aCh < -0x8000 || aCh > 0xFFFF) {
+ StarBASIC::Error(ERRCODE_BASIC_MATH_OVERFLOW);
+ aCh = 0;
+ }
+ aStr = OUString(static_cast<sal_Unicode>(aCh));
+ }
+ rPar.Get32(0)->PutString( aStr );
+ }
+}
+
+void SbRtl_Chr(StarBASIC *, SbxArray & rPar, bool)
+{
+ implChr( rPar, false/*bChrW*/ );
+}
+
+void SbRtl_ChrW(StarBASIC *, SbxArray & rPar, bool)
+{
+ implChr( rPar, true/*bChrW*/ );
+}
+
+#if defined _WIN32
+
+namespace {
+
+extern "C" void invalidParameterHandler(
+ wchar_t const * expression, wchar_t const * function, wchar_t const * file, unsigned int line,
+ uintptr_t)
+{
+ SAL_INFO(
+ "basic",
+ "invalid parameter during _wgetdcwd; \"" << (expression ? o3tl::toU(expression) : u"???")
+ << "\" (" << (function ? o3tl::toU(function) : u"???") << ") at "
+ << (file ? o3tl::toU(file) : u"???") << ":" << line);
+}
+
+}
+
+#endif
+
+void SbRtl_CurDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
+{
+ (void)pBasic;
+ (void)bWrite;
+
+ // #57064 Although this function doesn't work with DirEntry, it isn't touched
+ // by the adjustment to virtual URLs, as, using the DirEntry-functionality,
+ // there's no possibility to detect the current one in a way that a virtual URL
+ // could be delivered.
+
+#if defined(_WIN32)
+ int nCurDir = 0; // Current dir // JSM
+ if ( rPar.Count32() == 2 )
+ {
+ OUString aDrive = rPar.Get32(1)->GetOUString();
+ if ( aDrive.getLength() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ auto c = rtl::toAsciiUpperCase(aDrive[0]);
+ if ( !rtl::isAsciiUpperCase( c ) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ nCurDir = c - 'A' + 1;
+ }
+ wchar_t pBuffer[ _MAX_PATH ];
+ // _wgetdcwd calls the C runtime's invalid parameter handler (which by default terminates the
+ // process) if nCurDir does not correspond to an existing drive, so temporarily set a "harmless"
+ // handler:
+ auto const handler = _set_thread_local_invalid_parameter_handler(&invalidParameterHandler);
+ auto const ok = _wgetdcwd( nCurDir, pBuffer, _MAX_PATH ) != nullptr;
+ _set_thread_local_invalid_parameter_handler(handler);
+ if ( ok )
+ {
+ rPar.Get32(0)->PutString( o3tl::toU(pBuffer) );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_NO_DEVICE );
+ }
+
+#else
+
+ const int PATH_INCR = 250;
+
+ int nSize = PATH_INCR;
+ std::unique_ptr<char[]> pMem;
+ while( true )
+ {
+ pMem.reset(new char[nSize]);
+ if( !pMem )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_NO_MEMORY );
+ return;
+ }
+ if( getcwd( pMem.get(), nSize-1 ) != nullptr )
+ {
+ rPar.Get32(0)->PutString( OUString::createFromAscii(pMem.get()) );
+ return;
+ }
+ if( errno != ERANGE )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+ nSize += PATH_INCR;
+ };
+
+#endif
+}
+
+void SbRtl_ChDir(StarBASIC * pBasic, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if (rPar.Count32() == 2)
+ {
+ // VBA: track current directory per document type (separately for Writer, Calc, Impress, etc.)
+ if( SbiRuntime::isVBAEnabled() )
+ {
+ ::basic::vba::registerCurrentDirectory( getDocumentModel( pBasic ), rPar.Get32(1)->GetOUString() );
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_ChDrive(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if (rPar.Count32() != 2)
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+
+// Implementation of StepRENAME with UCB
+void implStepRenameUCB( const OUString& aSource, const OUString& aDest )
+{
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( !xSFI.is() )
+ return;
+
+ try
+ {
+ OUString aSourceFullPath = getFullPath( aSource );
+ if( !xSFI->exists( aSourceFullPath ) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
+ return;
+ }
+
+ OUString aDestFullPath = getFullPath( aDest );
+ if( xSFI->exists( aDestFullPath ) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_FILE_EXISTS );
+ }
+ else
+ {
+ xSFI->move( aSourceFullPath, aDestFullPath );
+ }
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
+ }
+}
+
+// Implementation of StepRENAME with OSL
+void implStepRenameOSL( const OUString& aSource, const OUString& aDest )
+{
+ FileBase::RC nRet = File::move( getFullPath( aSource ), getFullPath( aDest ) );
+ if( nRet != FileBase::E_None )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
+ }
+}
+
+void SbRtl_FileCopy(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if (rPar.Count32() == 3)
+ {
+ OUString aSource = rPar.Get32(1)->GetOUString();
+ OUString aDest = rPar.Get32(2)->GetOUString();
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ xSFI->copy( getFullPath( aSource ), getFullPath( aDest ) );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
+ }
+ }
+ }
+ else
+ {
+ FileBase::RC nRet = File::copy( getFullPath( aSource ), getFullPath( aDest ) );
+ if( nRet != FileBase::E_None )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
+ }
+ }
+ }
+ else
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+}
+
+void SbRtl_Kill(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if (rPar.Count32() == 2)
+ {
+ OUString aFileSpec = rPar.Get32(1)->GetOUString();
+
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ OUString aFullPath = getFullPath( aFileSpec );
+ if( !xSFI->exists( aFullPath ) || xSFI->isFolder( aFullPath ) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
+ return;
+ }
+ try
+ {
+ xSFI->kill( aFullPath );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ else
+ {
+ File::remove( getFullPath( aFileSpec ) );
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_MkDir(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
+{
+ rPar.Get32(0)->PutEmpty();
+ if (rPar.Count32() == 2)
+ {
+ OUString aPath = rPar.Get32(1)->GetOUString();
+ if ( SbiRuntime::isVBAEnabled() )
+ {
+ // In vba if the full path is not specified then
+ // folder is created relative to the curdir
+ INetURLObject aURLObj( getFullPath( aPath ) );
+ if ( aURLObj.GetProtocol() != INetProtocol::File )
+ {
+ SbxArrayRef pPar = new SbxArray();
+ SbxVariableRef pResult = new SbxVariable();
+ SbxVariableRef pParam = new SbxVariable();
+ pPar->Insert32( pResult.get(), pPar->Count32() );
+ pPar->Insert32( pParam.get(), pPar->Count32() );
+ SbRtl_CurDir( pBasic, *pPar, bWrite );
+
+ OUString sCurPathURL;
+ File::getFileURLFromSystemPath( pPar->Get32(0)->GetOUString(), sCurPathURL );
+
+ aURLObj.SetURL( sCurPathURL );
+ aURLObj.Append( aPath );
+ File::getSystemPathFromFileURL(aURLObj.GetMainURL( INetURLObject::DecodeMechanism::ToIUri ),aPath ) ;
+ }
+ }
+
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ xSFI->createFolder( getFullPath( aPath ) );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ else
+ {
+ Directory::create( getFullPath( aPath ) );
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+
+static void implRemoveDirRecursive( const OUString& aDirPath )
+{
+ DirectoryItem aItem;
+ FileBase::RC nRet = DirectoryItem::get( aDirPath, aItem );
+ bool bExists = (nRet == FileBase::E_None);
+
+ FileStatus aFileStatus( osl_FileStatus_Mask_Type );
+ nRet = aItem.getFileStatus( aFileStatus );
+ bool bFolder = nRet == FileBase::E_None
+ && isFolder( aFileStatus.getFileType() );
+
+ if( !bExists || !bFolder )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
+ return;
+ }
+
+ Directory aDir( aDirPath );
+ nRet = aDir.open();
+ if( nRet != FileBase::E_None )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
+ return;
+ }
+ aDir.close();
+
+ comphelper::DirectoryHelper::deleteDirRecursively(aDirPath);
+}
+
+
+void SbRtl_RmDir(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if (rPar.Count32() == 2)
+ {
+ OUString aPath = rPar.Get32(1)->GetOUString();
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ if( !xSFI->isFolder( aPath ) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PATH_NOT_FOUND );
+ return;
+ }
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ Sequence< OUString > aContent = xSFI->getFolderContents( aPath, true );
+ if( aContent.hasElements() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_ACCESS_ERROR );
+ return;
+ }
+ }
+
+ xSFI->kill( getFullPath( aPath ) );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ else
+ {
+ implRemoveDirRecursive( getFullPath( aPath ) );
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_SendKeys(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ StarBASIC::Error(ERRCODE_BASIC_NOT_IMPLEMENTED);
+}
+
+void SbRtl_Exp(StarBASIC *, SbxArray & rPar, bool)
+{
+ if( rPar.Count32() < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ double aDouble = rPar.Get32(1)->GetDouble();
+ aDouble = exp( aDouble );
+ checkArithmeticOverflow( aDouble );
+ rPar.Get32(0)->PutDouble( aDouble );
+ }
+}
+
+void SbRtl_FileLen(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ OUString aStr( pArg->GetOUString() );
+ sal_Int32 nLen = 0;
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ nLen = xSFI->getSize( getFullPath( aStr ) );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ else
+ {
+ DirectoryItem aItem;
+ (void)DirectoryItem::get( getFullPath( aStr ), aItem );
+ FileStatus aFileStatus( osl_FileStatus_Mask_FileSize );
+ (void)aItem.getFileStatus( aFileStatus );
+ nLen = static_cast<sal_Int32>(aFileStatus.getFileSize());
+ }
+ rPar.Get32(0)->PutLong( static_cast<long>(nLen) );
+ }
+}
+
+
+void SbRtl_Hex(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ // converting value to unsigned and limit to 2 or 4 byte representation
+ sal_uInt32 nVal = pArg->IsInteger() ?
+ static_cast<sal_uInt16>(pArg->GetInteger()) :
+ static_cast<sal_uInt32>(pArg->GetLong());
+ OUString aStr(OUString::number( nVal, 16 ));
+ aStr = aStr.toAsciiUpperCase();
+ rPar.Get32(0)->PutString( aStr );
+ }
+}
+
+void SbRtl_FuncCaller(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( SbiRuntime::isVBAEnabled() && GetSbData()->pInst && GetSbData()->pInst->pRun )
+ {
+ if ( GetSbData()->pInst->pRun->GetExternalCaller() )
+ *rPar.Get32(0) = *GetSbData()->pInst->pRun->GetExternalCaller();
+ else
+ {
+ SbxVariableRef pVar = new SbxVariable(SbxVARIANT);
+ *rPar.Get32(0) = *pVar;
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED );
+ }
+
+}
+// InStr( [start],string,string,[compare] )
+
+void SbRtl_InStr(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32()-1;
+ if ( nArgCount < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ sal_Int32 nStartPos = 1;
+ sal_Int32 nFirstStringPos = 1;
+
+ if ( nArgCount >= 3 )
+ {
+ nStartPos = rPar.Get32(1)->GetLong();
+ if( nStartPos <= 0 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ nStartPos = 1;
+ }
+ nFirstStringPos++;
+ }
+
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bTextMode;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ SbiRuntime* pRT = pInst->pRun;
+ bTextMode = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
+ }
+ else
+ {
+ bTextMode = true;
+ }
+ if ( nArgCount == 4 )
+ {
+ bTextMode = rPar.Get32(4)->GetInteger();
+ }
+ sal_Int32 nPos;
+ const OUString& rToken = rPar.Get32(nFirstStringPos+1)->GetOUString();
+
+ // #97545 Always find empty string
+ if( rToken.isEmpty() )
+ {
+ nPos = nStartPos;
+ }
+ else
+ {
+ if( !bTextMode )
+ {
+ const OUString& rStr1 = rPar.Get32(nFirstStringPos)->GetOUString();
+ nPos = rStr1.indexOf( rToken, nStartPos - 1 ) + 1;
+ }
+ else
+ {
+ OUString aStr1 = rPar.Get32(nFirstStringPos)->GetOUString();
+ OUString aToken = rToken;
+
+ aStr1 = aStr1.toAsciiUpperCase();
+ aToken = aToken.toAsciiUpperCase();
+
+ nPos = aStr1.indexOf( aToken, nStartPos-1 ) + 1;
+ }
+ }
+ rPar.Get32(0)->PutLong( nPos );
+ }
+}
+
+
+// InstrRev(string1, string2[, start[, compare]])
+
+void SbRtl_InStrRev(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32()-1;
+ if ( nArgCount < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aStr1 = rPar.Get32(1)->GetOUString();
+ OUString aToken = rPar.Get32(2)->GetOUString();
+
+ sal_Int32 nStartPos = -1;
+ if ( nArgCount >= 3 )
+ {
+ nStartPos = rPar.Get32(3)->GetLong();
+ if( nStartPos <= 0 && nStartPos != -1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ nStartPos = -1;
+ }
+ }
+
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bTextMode;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ SbiRuntime* pRT = pInst->pRun;
+ bTextMode = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
+ }
+ else
+ {
+ bTextMode = true;
+ }
+ if ( nArgCount == 4 )
+ {
+ bTextMode = rPar.Get32(4)->GetInteger();
+ }
+ sal_Int32 nStrLen = aStr1.getLength();
+ if( nStartPos == -1 )
+ {
+ nStartPos = nStrLen;
+ }
+
+ sal_Int32 nPos = 0;
+ if( nStartPos <= nStrLen )
+ {
+ sal_Int32 nTokenLen = aToken.getLength();
+ if( !nTokenLen )
+ {
+ // Always find empty string
+ nPos = nStartPos;
+ }
+ else if( nStrLen > 0 )
+ {
+ if( !bTextMode )
+ {
+ nPos = aStr1.lastIndexOf( aToken, nStartPos ) + 1;
+ }
+ else
+ {
+ aStr1 = aStr1.toAsciiUpperCase();
+ aToken = aToken.toAsciiUpperCase();
+
+ nPos = aStr1.lastIndexOf( aToken, nStartPos ) + 1;
+ }
+ }
+ }
+ rPar.Get32(0)->PutLong( nPos );
+ }
+}
+
+
+/*
+ Int( 2.8 ) = 2.0
+ Int( -2.8 ) = -3.0
+ Fix( 2.8 ) = 2.0
+ Fix( -2.8 ) = -2.0 <- !!
+*/
+
+void SbRtl_Int(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ double aDouble= pArg->GetDouble();
+ /*
+ floor( 2.8 ) = 2.0
+ floor( -2.8 ) = -3.0
+ */
+ aDouble = floor( aDouble );
+ rPar.Get32(0)->PutDouble( aDouble );
+ }
+}
+
+
+void SbRtl_Fix(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ double aDouble = pArg->GetDouble();
+ if ( aDouble >= 0.0 )
+ aDouble = floor( aDouble );
+ else
+ aDouble = ceil( aDouble );
+ rPar.Get32(0)->PutDouble( aDouble );
+ }
+}
+
+
+void SbRtl_LCase(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ const CharClass& rCharClass = GetCharClass();
+ OUString aStr( rPar.Get32(1)->GetOUString() );
+ aStr = rCharClass.lowercase(aStr);
+ rPar.Get32(0)->PutString( aStr );
+ }
+}
+
+void SbRtl_Left(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aStr( rPar.Get32(1)->GetOUString() );
+ sal_Int32 nResultLen = rPar.Get32(2)->GetLong();
+ if( nResultLen < 0 )
+ {
+ nResultLen = 0;
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else if(nResultLen > aStr.getLength())
+ {
+ nResultLen = aStr.getLength();
+ }
+ aStr = aStr.copy(0, nResultLen );
+ rPar.Get32(0)->PutString( aStr );
+ }
+}
+
+void SbRtl_Log(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double aArg = rPar.Get32(1)->GetDouble();
+ if ( aArg > 0 )
+ {
+ double d = log( aArg );
+ checkArithmeticOverflow( d );
+ rPar.Get32(0)->PutDouble( d );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ }
+}
+
+void SbRtl_LTrim(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aStr(comphelper::string::stripStart(rPar.Get32(1)->GetOUString(), ' '));
+ rPar.Get32(0)->PutString(aStr);
+ }
+}
+
+
+// Mid( String, nStart, nLength )
+
+void SbRtl_Mid(StarBASIC *, SbxArray & rPar, bool bWrite)
+{
+ int nArgCount = rPar.Count32()-1;
+ if ( nArgCount < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // #23178: replicate the functionality of Mid$ as a command
+ // by adding a replacement-string as a fourth parameter.
+ // In contrast to the original the third parameter (nLength)
+ // can't be left out here. That's considered in bWrite already.
+ if( nArgCount == 4 )
+ {
+ bWrite = true;
+ }
+ OUString aArgStr = rPar.Get32(1)->GetOUString();
+ sal_Int32 nStartPos = rPar.Get32(2)->GetLong();
+ if ( nStartPos < 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ nStartPos--;
+ sal_Int32 nLen = -1;
+ bool bWriteNoLenParam = false;
+ if ( nArgCount == 3 || bWrite )
+ {
+ sal_Int32 n = rPar.Get32(3)->GetLong();
+ if( bWrite && n == -1 )
+ {
+ bWriteNoLenParam = true;
+ }
+ nLen = n;
+ }
+ if ( bWrite )
+ {
+ sal_Int32 nArgLen = aArgStr.getLength();
+ if( nStartPos > nArgLen )
+ {
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ nStartPos = nArgLen;
+ }
+
+ OUString aReplaceStr = rPar.Get32(4)->GetOUString();
+ sal_Int32 nReplaceStrLen = aReplaceStr.getLength();
+ sal_Int32 nReplaceLen;
+ if( bWriteNoLenParam )
+ {
+ nReplaceLen = nArgLen - nStartPos;
+ }
+ else
+ {
+ nReplaceLen = nLen;
+ if( nReplaceLen < 0 || nReplaceLen > nArgLen - nStartPos )
+ {
+ nReplaceLen = nArgLen - nStartPos;
+ }
+ }
+
+ OUStringBuffer aResultStr = aArgStr;
+ sal_Int32 nErase = nReplaceLen;
+ aResultStr.remove( nStartPos, nErase );
+ aResultStr.insert(
+ nStartPos, aReplaceStr.getStr(), std::min(nReplaceLen, nReplaceStrLen));
+
+ rPar.Get32(1)->PutString( aResultStr.makeStringAndClear() );
+ }
+ else
+ {
+ OUString aResultStr;
+ if (nStartPos > aArgStr.getLength())
+ {
+ // do nothing
+ }
+ else if(nArgCount == 2)
+ {
+ aResultStr = aArgStr.copy( nStartPos);
+ }
+ else
+ {
+ if (nLen < 0)
+ nLen = 0;
+ if(nStartPos + nLen > aArgStr.getLength())
+ {
+ nLen = aArgStr.getLength() - nStartPos;
+ }
+ if (nLen > 0)
+ aResultStr = aArgStr.copy( nStartPos, nLen );
+ }
+ rPar.Get32(0)->PutString( aResultStr );
+ }
+ }
+ }
+}
+
+void SbRtl_Oct(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ char aBuffer[16];
+ SbxVariableRef pArg = rPar.Get32(1);
+ if ( pArg->IsInteger() )
+ {
+ snprintf( aBuffer, sizeof(aBuffer), "%o", pArg->GetInteger() );
+ }
+ else
+ {
+ snprintf( aBuffer, sizeof(aBuffer), "%lo", static_cast<long unsigned int>(pArg->GetLong()) );
+ }
+ rPar.Get32(0)->PutString( OUString::createFromAscii( aBuffer ) );
+ }
+}
+
+// Replace(expression, find, replace[, start[, count[, compare]]])
+
+void SbRtl_Replace(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32()-1;
+ if ( nArgCount < 3 || nArgCount > 6 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ sal_Int32 lStartPos = 1;
+ if (nArgCount >= 4)
+ {
+ if (rPar.Get32(4)->GetType() != SbxEMPTY)
+ {
+ lStartPos = rPar.Get32(4)->GetLong();
+ }
+ if (lStartPos < 1)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ sal_Int32 lCount = -1;
+ if (nArgCount >= 5)
+ {
+ if (rPar.Get32(5)->GetType() != SbxEMPTY)
+ {
+ lCount = rPar.Get32(5)->GetLong();
+ }
+ if (lCount < -1)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ bool bCaseInsensitive;
+ if (nArgCount == 6)
+ {
+ bCaseInsensitive = rPar.Get32(6)->GetInteger();
+ }
+ else
+ {
+ SbiInstance* pInst = GetSbData()->pInst;
+ if (pInst && pInst->IsCompatibility())
+ {
+ SbiRuntime* pRT = pInst->pRun;
+ bCaseInsensitive = pRT && pRT->IsImageFlag(SbiImageFlags::COMPARETEXT);
+ }
+ else
+ {
+ bCaseInsensitive = true;
+ }
+ }
+
+ const OUString aExpStr = rPar.Get32(1)->GetOUString();
+ OUString aFindStr = rPar.Get32(2)->GetOUString();
+ const OUString aReplaceStr = rPar.Get32(3)->GetOUString();
+ const sal_Int32 nExpStrLen = aExpStr.getLength();
+ const sal_Int32 nFindStrLen = aFindStr.getLength();
+
+ OUString aSrcStr(aExpStr);
+ if (bCaseInsensitive)
+ {
+ // tdf#132389 - case-insensitive operation for non-ASCII characters
+ const css::lang::Locale& rLocale = Application::GetSettings().GetUILanguageTag().getLocale();
+ css::uno::Reference < i18n::XCharacterClassification > xCharClass = vcl::unohelper::CreateCharacterClassification();
+ aSrcStr = xCharClass->toUpper(aSrcStr, 0, aSrcStr.getLength(), rLocale);
+ aFindStr = xCharClass->toUpper(aFindStr, 0, aSrcStr.getLength(), rLocale);
+ }
+
+ // Note: the result starts from lStartPos, removing everything to the left. See i#94895.
+ sal_Int32 nPrevPos = std::min(lStartPos - 1, nExpStrLen);
+ OUStringBuffer sResult(nExpStrLen - nPrevPos);
+ sal_Int32 nCounts = 0;
+ while (lCount == -1 || lCount > nCounts)
+ {
+ sal_Int32 nPos = aSrcStr.indexOf(aFindStr, nPrevPos);
+ if (nPos >= 0)
+ {
+ sResult.append(aExpStr.getStr() + nPrevPos, nPos - nPrevPos);
+ sResult.append(aReplaceStr);
+ nPrevPos = nPos + nFindStrLen;
+ nCounts++;
+ }
+ else
+ {
+ break;
+ }
+ }
+ sResult.append(aExpStr.getStr() + nPrevPos, nExpStrLen - nPrevPos);
+ rPar.Get32(0)->PutString(sResult.makeStringAndClear());
+}
+
+void SbRtl_Right(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ const OUString& rStr = rPar.Get32(1)->GetOUString();
+ int nResultLen = rPar.Get32(2)->GetLong();
+ if( nResultLen < 0 )
+ {
+ nResultLen = 0;
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ int nStrLen = rStr.getLength();
+ if ( nResultLen > nStrLen )
+ {
+ nResultLen = nStrLen;
+ }
+ OUString aResultStr = rStr.copy( nStrLen - nResultLen );
+ rPar.Get32(0)->PutString( aResultStr );
+ }
+}
+
+void SbRtl_RTL(StarBASIC * pBasic, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutObject( pBasic->getRTL().get() );
+}
+
+void SbRtl_RTrim(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aStr(comphelper::string::stripEnd(rPar.Get32(1)->GetOUString(), ' '));
+ rPar.Get32(0)->PutString(aStr);
+ }
+}
+
+void SbRtl_Sgn(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double aDouble = rPar.Get32(1)->GetDouble();
+ sal_Int16 nResult = 0;
+ if ( aDouble > 0 )
+ {
+ nResult = 1;
+ }
+ else if ( aDouble < 0 )
+ {
+ nResult = -1;
+ }
+ rPar.Get32(0)->PutInteger( nResult );
+ }
+}
+
+void SbRtl_Space(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUStringBuffer aBuf;
+ string::padToLength(aBuf, rPar.Get32(1)->GetLong(), ' ');
+ rPar.Get32(0)->PutString(aBuf.makeStringAndClear());
+ }
+}
+
+void SbRtl_Spc(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUStringBuffer aBuf;
+ string::padToLength(aBuf, rPar.Get32(1)->GetLong(), ' ');
+ rPar.Get32(0)->PutString(aBuf.makeStringAndClear());
+ }
+}
+
+void SbRtl_Sqr(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double aDouble = rPar.Get32(1)->GetDouble();
+ if ( aDouble >= 0 )
+ {
+ rPar.Get32(0)->PutDouble( sqrt( aDouble ));
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ }
+}
+
+void SbRtl_Str(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aStr;
+ OUString aStrNew("");
+ SbxVariableRef pArg = rPar.Get32(1);
+ pArg->Format( aStr );
+
+ // Numbers start with a space
+ if( pArg->IsNumericRTL() )
+ {
+ // replace commas by points so that it's symmetric to Val!
+ aStr = aStr.replaceFirst( ",", "." );
+
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ sal_Int32 nLen = aStr.getLength();
+
+ const sal_Unicode* pBuf = aStr.getStr();
+
+ bool bNeg = ( pBuf[0] == '-' );
+ sal_Int32 iZeroSearch = 0;
+ if( bNeg )
+ {
+ aStrNew += "-";
+ iZeroSearch++;
+ }
+ else
+ {
+ if( pBuf[0] != ' ' )
+ {
+ aStrNew += " ";
+ }
+ }
+ sal_Int32 iNext = iZeroSearch + 1;
+ if( pBuf[iZeroSearch] == '0' && nLen > iNext && pBuf[iNext] == '.' )
+ {
+ iZeroSearch += 1;
+ }
+ aStrNew += aStr.copy(iZeroSearch);
+ }
+ else
+ {
+ aStrNew = " " + aStr;
+ }
+ }
+ else
+ {
+ aStrNew = aStr;
+ }
+ rPar.Get32(0)->PutString( aStrNew );
+ }
+}
+
+void SbRtl_StrComp(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ rPar.Get32(0)->PutEmpty();
+ return;
+ }
+ const OUString& rStr1 = rPar.Get32(1)->GetOUString();
+ const OUString& rStr2 = rPar.Get32(2)->GetOUString();
+
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bTextCompare;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ SbiRuntime* pRT = pInst->pRun;
+ bTextCompare = pRT && pRT->IsImageFlag( SbiImageFlags::COMPARETEXT );
+ }
+ else
+ {
+ bTextCompare = true;
+ }
+ if ( rPar.Count32() == 4 )
+ bTextCompare = rPar.Get32(3)->GetInteger();
+
+ if( !bCompatibility )
+ {
+ bTextCompare = !bTextCompare;
+ }
+ sal_Int32 nRetValue = 0;
+ if( bTextCompare )
+ {
+ ::utl::TransliterationWrapper* pTransliterationWrapper = GetSbData()->pTransliterationWrapper.get();
+ if( !pTransliterationWrapper )
+ {
+ uno::Reference< uno::XComponentContext > xContext = getProcessComponentContext();
+ GetSbData()->pTransliterationWrapper.reset(
+ new ::utl::TransliterationWrapper( xContext,
+ TransliterationFlags::IGNORE_CASE |
+ TransliterationFlags::IGNORE_KANA |
+ TransliterationFlags::IGNORE_WIDTH ) );
+ pTransliterationWrapper = GetSbData()->pTransliterationWrapper.get();
+ }
+
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ pTransliterationWrapper->loadModuleIfNeeded( eLangType );
+ nRetValue = pTransliterationWrapper->compareString( rStr1, rStr2 );
+ }
+ else
+ {
+ sal_Int32 aResult;
+ aResult = rStr1.compareTo( rStr2 );
+ if ( aResult < 0 )
+ {
+ nRetValue = -1;
+ }
+ else if ( aResult > 0)
+ {
+ nRetValue = 1;
+ }
+ }
+ rPar.Get32(0)->PutInteger( sal::static_int_cast< sal_Int16 >( nRetValue ) );
+}
+
+void SbRtl_String(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Unicode aFiller;
+ sal_Int32 lCount = rPar.Get32(1)->GetLong();
+ if( lCount < 0 || lCount > 0xffff )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ if( rPar.Get32(2)->GetType() == SbxINTEGER )
+ {
+ aFiller = static_cast<sal_Unicode>(rPar.Get32(2)->GetInteger());
+ }
+ else
+ {
+ const OUString& rStr = rPar.Get32(2)->GetOUString();
+ aFiller = rStr[0];
+ }
+ OUStringBuffer aBuf(lCount);
+ string::padToLength(aBuf, lCount, aFiller);
+ rPar.Get32(0)->PutString(aBuf.makeStringAndClear());
+ }
+}
+
+void SbRtl_Tab(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ OUStringBuffer aStr;
+ comphelper::string::padToLength(aStr, rPar.Get32(1)->GetLong(), '\t');
+ rPar.Get32(0)->PutString(aStr.makeStringAndClear());
+ }
+}
+
+void SbRtl_Tan(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ rPar.Get32(0)->PutDouble( tan( pArg->GetDouble() ) );
+ }
+}
+
+void SbRtl_UCase(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ const CharClass& rCharClass = GetCharClass();
+ OUString aStr( rPar.Get32(1)->GetOUString() );
+ aStr = rCharClass.uppercase( aStr );
+ rPar.Get32(0)->PutString( aStr );
+ }
+}
+
+
+void SbRtl_Val(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
+{
+ (void)pBasic;
+ (void)bWrite;
+
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double nResult = 0.0;
+ char* pEndPtr;
+
+ OUString aStr( rPar.Get32(1)->GetOUString() );
+
+ FilterWhiteSpace( aStr );
+ if ( aStr.getLength() > 1 && aStr[0] == '&' )
+ {
+ int nRadix = 10;
+ char aChar = static_cast<char>(aStr[1]);
+ if ( aChar == 'h' || aChar == 'H' )
+ {
+ nRadix = 16;
+ }
+ else if ( aChar == 'o' || aChar == 'O' )
+ {
+ nRadix = 8;
+ }
+ if ( nRadix != 10 )
+ {
+ OString aByteStr(OUStringToOString(aStr, osl_getThreadTextEncoding()));
+ sal_Int16 nlResult = static_cast<sal_Int16>(strtol( aByteStr.getStr()+2, &pEndPtr, nRadix));
+ nResult = static_cast<double>(nlResult);
+ }
+ }
+ else
+ {
+ rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok;
+ sal_Int32 nParseEnd = 0;
+ nResult = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd );
+ if ( eStatus != rtl_math_ConversionStatus_Ok )
+ StarBASIC::Error( ERRCODE_BASIC_MATH_OVERFLOW );
+ /* TODO: we should check whether all characters were parsed here,
+ * but earlier code silently ignored trailing nonsense such as "1x"
+ * resulting in 1 with the side effect that any alpha-only-string
+ * like "x" resulted in 0. Not changing that now (2013-03-22) as
+ * user macros may rely on it. */
+#if 0
+ else if ( nParseEnd != aStr.getLength() )
+ StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
+#endif
+ }
+
+ rPar.Get32(0)->PutDouble( nResult );
+ }
+}
+
+
+// Helper functions for date conversion
+sal_Int16 implGetDateDay( double aDate )
+{
+ aDate -= 2.0; // standardize: 1.1.1900 => 0.0
+ aDate = floor( aDate );
+ Date aRefDate( 1, 1, 1900 );
+ aRefDate.AddDays( aDate );
+
+ sal_Int16 nRet = static_cast<sal_Int16>( aRefDate.GetDay() );
+ return nRet;
+}
+
+sal_Int16 implGetDateMonth( double aDate )
+{
+ Date aRefDate( 1,1,1900 );
+ sal_Int32 nDays = static_cast<sal_Int32>(aDate);
+ nDays -= 2; // standardize: 1.1.1900 => 0.0
+ aRefDate.AddDays( nDays );
+ sal_Int16 nRet = static_cast<sal_Int16>( aRefDate.GetMonth() );
+ return nRet;
+}
+
+css::util::Date SbxDateToUNODate( const SbxValue* const pVal )
+{
+ double aDate = pVal->GetDate();
+
+ css::util::Date aUnoDate;
+ aUnoDate.Day = implGetDateDay ( aDate );
+ aUnoDate.Month = implGetDateMonth( aDate );
+ aUnoDate.Year = implGetDateYear ( aDate );
+
+ return aUnoDate;
+}
+
+void SbxDateFromUNODate( SbxValue *pVal, const css::util::Date& aUnoDate)
+{
+ double dDate;
+ if( implDateSerial( aUnoDate.Year, aUnoDate.Month, aUnoDate.Day, false, SbDateCorrection::None, dDate ) )
+ {
+ pVal->PutDate( dDate );
+ }
+}
+
+// Function to convert date to UNO date (com.sun.star.util.Date)
+void SbRtl_CDateToUnoDate(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ unoToSbxValue(rPar.Get32(0), Any(SbxDateToUNODate(rPar.Get32(1))));
+}
+
+// Function to convert date from UNO date (com.sun.star.util.Date)
+void SbRtl_CDateFromUnoDate(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 || rPar.Get32(1)->GetType() != SbxOBJECT )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ Any aAny (sbxToUnoValue(rPar.Get32(1), cppu::UnoType<css::util::Date>::get()));
+ css::util::Date aUnoDate;
+ if(aAny >>= aUnoDate)
+ SbxDateFromUNODate(rPar.Get32(0), aUnoDate);
+ else
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+}
+
+css::util::Time SbxDateToUNOTime( const SbxValue* const pVal )
+{
+ double aDate = pVal->GetDate();
+
+ css::util::Time aUnoTime;
+ aUnoTime.Hours = implGetHour ( aDate );
+ aUnoTime.Minutes = implGetMinute ( aDate );
+ aUnoTime.Seconds = implGetSecond ( aDate );
+ aUnoTime.NanoSeconds = 0;
+
+ return aUnoTime;
+}
+
+void SbxDateFromUNOTime( SbxValue *pVal, const css::util::Time& aUnoTime)
+{
+ pVal->PutDate( implTimeSerial(aUnoTime.Hours, aUnoTime.Minutes, aUnoTime.Seconds) );
+}
+
+// Function to convert date to UNO time (com.sun.star.util.Time)
+void SbRtl_CDateToUnoTime(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ unoToSbxValue(rPar.Get32(0), Any(SbxDateToUNOTime(rPar.Get32(1))));
+}
+
+// Function to convert date from UNO time (com.sun.star.util.Time)
+void SbRtl_CDateFromUnoTime(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 || rPar.Get32(1)->GetType() != SbxOBJECT )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ Any aAny (sbxToUnoValue(rPar.Get32(1), cppu::UnoType<css::util::Time>::get()));
+ css::util::Time aUnoTime;
+ if(aAny >>= aUnoTime)
+ SbxDateFromUNOTime(rPar.Get32(0), aUnoTime);
+ else
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+}
+
+css::util::DateTime SbxDateToUNODateTime( const SbxValue* const pVal )
+{
+ double aDate = pVal->GetDate();
+
+ css::util::DateTime aUnoDT;
+ aUnoDT.Day = implGetDateDay ( aDate );
+ aUnoDT.Month = implGetDateMonth( aDate );
+ aUnoDT.Year = implGetDateYear ( aDate );
+ aUnoDT.Hours = implGetHour ( aDate );
+ aUnoDT.Minutes = implGetMinute ( aDate );
+ aUnoDT.Seconds = implGetSecond ( aDate );
+ aUnoDT.NanoSeconds = 0;
+
+ return aUnoDT;
+}
+
+void SbxDateFromUNODateTime( SbxValue *pVal, const css::util::DateTime& aUnoDT)
+{
+ double dDate(0.0);
+ if( implDateTimeSerial( aUnoDT.Year, aUnoDT.Month, aUnoDT.Day,
+ aUnoDT.Hours, aUnoDT.Minutes, aUnoDT.Seconds,
+ dDate ) )
+ {
+ pVal->PutDate( dDate );
+ }
+}
+
+// Function to convert date to UNO date (com.sun.star.util.Date)
+void SbRtl_CDateToUnoDateTime(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ unoToSbxValue(rPar.Get32(0), Any(SbxDateToUNODateTime(rPar.Get32(1))));
+}
+
+// Function to convert date from UNO date (com.sun.star.util.Date)
+void SbRtl_CDateFromUnoDateTime(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 || rPar.Get32(1)->GetType() != SbxOBJECT )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ Any aAny (sbxToUnoValue(rPar.Get32(1), cppu::UnoType<css::util::DateTime>::get()));
+ css::util::DateTime aUnoDT;
+ if(aAny >>= aUnoDT)
+ SbxDateFromUNODateTime(rPar.Get32(0), aUnoDT);
+ else
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+}
+
+// Function to convert date to ISO 8601 date format YYYYMMDD
+void SbRtl_CDateToIso(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() == 2 )
+ {
+ double aDate = rPar.Get32(1)->GetDate();
+
+ // Date may actually even be -YYYYYMMDD
+ char Buffer[11];
+ sal_Int16 nYear = implGetDateYear( aDate );
+ snprintf( Buffer, sizeof( Buffer ), (nYear < 0 ? "%05d%02d%02d" : "%04d%02d%02d"),
+ static_cast<int>(nYear),
+ static_cast<int>(implGetDateMonth( aDate )),
+ static_cast<int>(implGetDateDay( aDate )) );
+ OUString aRetStr = OUString::createFromAscii( Buffer );
+ rPar.Get32(0)->PutString( aRetStr );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+// Function to convert date from ISO 8601 date format YYYYMMDD or YYYY-MM-DD
+// And even YYMMDD for compatibility, sigh...
+void SbRtl_CDateFromIso(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() == 2 )
+ {
+ do
+ {
+ OUString aStr = rPar.Get32(1)->GetOUString();
+ if (aStr.isEmpty())
+ break;
+
+ // Valid formats are
+ // YYYYMMDD -YYYMMDD YYYYYMMDD -YYYYYMMDD YYMMDD
+ // YYYY-MM-DD -YYYY-MM-DD YYYYY-MM-DD -YYYYY-MM-DD
+
+ sal_Int32 nSign = 1;
+ if (aStr[0] == '-')
+ {
+ nSign = -1;
+ aStr = aStr.copy(1);
+ }
+ const sal_Int32 nLen = aStr.getLength();
+
+ // Signed YYMMDD two digit year is invalid.
+ if (nLen == 6 && nSign == -1)
+ break;
+
+ // Now valid
+ // YYYYMMDD YYYYYMMDD YYMMDD
+ // YYYY-MM-DD YYYYY-MM-DD
+ if (nLen != 6 && (nLen < 8 || 11 < nLen))
+ break;
+
+ bool bUseTwoDigitYear = false;
+ OUString aYearStr, aMonthStr, aDayStr;
+ if (nLen == 6 || nLen == 8 || nLen == 9)
+ {
+ // ((Y)YY)YYMMDD
+ if (!comphelper::string::isdigitAsciiString(aStr))
+ break;
+
+ const sal_Int32 nMonthPos = (nLen == 8 ? 4 : (nLen == 6 ? 2 : 5));
+ if (nMonthPos == 2)
+ bUseTwoDigitYear = true;
+ aYearStr = aStr.copy( 0, nMonthPos );
+ aMonthStr = aStr.copy( nMonthPos, 2 );
+ aDayStr = aStr.copy( nMonthPos + 2, 2 );
+ }
+ else
+ {
+ // (Y)YYYY-MM-DD
+ const sal_Int32 nMonthSep = (nLen == 11 ? 5 : 4);
+ if (aStr.indexOf('-') != nMonthSep)
+ break;
+ if (aStr.indexOf('-', nMonthSep + 1) != nMonthSep + 3)
+ break;
+
+ aYearStr = aStr.copy( 0, nMonthSep );
+ aMonthStr = aStr.copy( nMonthSep + 1, 2 );
+ aDayStr = aStr.copy( nMonthSep + 4, 2 );
+ if ( !comphelper::string::isdigitAsciiString(aYearStr) ||
+ !comphelper::string::isdigitAsciiString(aMonthStr) ||
+ !comphelper::string::isdigitAsciiString(aDayStr))
+ break;
+ }
+
+ double dDate;
+ if (!implDateSerial( static_cast<sal_Int16>(nSign * aYearStr.toInt32()),
+ static_cast<sal_Int16>(aMonthStr.toInt32()), static_cast<sal_Int16>(aDayStr.toInt32()),
+ bUseTwoDigitYear, SbDateCorrection::None, dDate ))
+ break;
+
+ rPar.Get32(0)->PutDate( dDate );
+
+ return;
+ }
+ while (false);
+
+ SbxBase::SetError( ERRCODE_BASIC_BAD_PARAMETER );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_DateSerial(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ sal_Int16 nYear = rPar.Get32(1)->GetInteger();
+ sal_Int16 nMonth = rPar.Get32(2)->GetInteger();
+ sal_Int16 nDay = rPar.Get32(3)->GetInteger();
+
+ double dDate;
+ if( implDateSerial( nYear, nMonth, nDay, true, SbDateCorrection::RollOver, dDate ) )
+ {
+ rPar.Get32(0)->PutDate( dDate );
+ }
+}
+
+void SbRtl_TimeSerial(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ sal_Int16 nHour = rPar.Get32(1)->GetInteger();
+ if ( nHour == 24 )
+ {
+ nHour = 0; // because of UNO DateTimes, which go till 24 o'clock
+ }
+ sal_Int16 nMinute = rPar.Get32(2)->GetInteger();
+ sal_Int16 nSecond = rPar.Get32(3)->GetInteger();
+ if ((nHour < 0 || nHour > 23) ||
+ (nMinute < 0 || nMinute > 59 ) ||
+ (nSecond < 0 || nSecond > 59 ))
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ rPar.Get32(0)->PutDate( implTimeSerial(nHour, nMinute, nSecond) ); // JSM
+}
+
+void SbRtl_DateValue(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // #39629 check GetSbData()->pInst, can be called from the URL line
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ if( GetSbData()->pInst )
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ }
+ else
+ {
+ sal_uInt32 n; // Dummy
+ pFormatter = SbiInstance::PrepareNumberFormatter( n, n, n );
+ }
+
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ sal_uInt32 nIndex = pFormatter->GetStandardIndex( eLangType);
+ double fResult;
+ OUString aStr( rPar.Get32(1)->GetOUString() );
+ bool bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, fResult );
+ SvNumFormatType nType = pFormatter->GetType( nIndex );
+
+ // DateValue("February 12, 1969") raises error if the system locale is not en_US
+ // It seems that both locale number formatter and English number
+ // formatter are supported in Visual Basic.
+ if( !bSuccess && ( eLangType != LANGUAGE_ENGLISH_US ) )
+ {
+ // Try using LANGUAGE_ENGLISH_US to get the date value.
+ nIndex = pFormatter->GetStandardIndex( LANGUAGE_ENGLISH_US);
+ bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, fResult );
+ nType = pFormatter->GetType( nIndex );
+ }
+
+ if(bSuccess && (nType==SvNumFormatType::DATE || nType==SvNumFormatType::DATETIME))
+ {
+ if ( nType == SvNumFormatType::DATETIME )
+ {
+ // cut time
+ if ( fResult > 0.0 )
+ {
+ fResult = floor( fResult );
+ }
+ else
+ {
+ fResult = ceil( fResult );
+ }
+ }
+ rPar.Get32(0)->PutDate( fResult );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
+ }
+ }
+}
+
+void SbRtl_TimeValue(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ if( GetSbData()->pInst )
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ else
+ {
+ sal_uInt32 n;
+ pFormatter = SbiInstance::PrepareNumberFormatter( n, n, n );
+ }
+
+ sal_uInt32 nIndex = 0;
+ double fResult;
+ bool bSuccess = pFormatter->IsNumberFormat( rPar.Get32(1)->GetOUString(),
+ nIndex, fResult );
+ SvNumFormatType nType = pFormatter->GetType(nIndex);
+ if(bSuccess && (nType==SvNumFormatType::TIME||nType==SvNumFormatType::DATETIME))
+ {
+ if ( nType == SvNumFormatType::DATETIME )
+ {
+ // cut days
+ fResult = fmod( fResult, 1 );
+ }
+ rPar.Get32(0)->PutDate( fResult );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_CONVERSION );
+ }
+ }
+}
+
+void SbRtl_Day(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariableRef pArg = rPar.Get32(1);
+ double aDate = pArg->GetDate();
+
+ sal_Int16 nDay = implGetDateDay( aDate );
+ rPar.Get32(0)->PutInteger( nDay );
+ }
+}
+
+void SbRtl_Year(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int16 nYear = implGetDateYear( rPar.Get32(1)->GetDate() );
+ rPar.Get32(0)->PutInteger( nYear );
+ }
+}
+
+sal_Int16 implGetHour( double dDate )
+{
+ double nFrac = dDate - floor( dDate );
+ nFrac *= 86400.0;
+ sal_Int32 nSeconds = static_cast<sal_Int32>(nFrac + 0.5);
+ sal_Int16 nHour = static_cast<sal_Int16>(nSeconds / 3600);
+ return nHour;
+}
+
+void SbRtl_Hour(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double nArg = rPar.Get32(1)->GetDate();
+ sal_Int16 nHour = implGetHour( nArg );
+ rPar.Get32(0)->PutInteger( nHour );
+ }
+}
+
+void SbRtl_Minute(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double nArg = rPar.Get32(1)->GetDate();
+ sal_Int16 nMin = implGetMinute( nArg );
+ rPar.Get32(0)->PutInteger( nMin );
+ }
+}
+
+void SbRtl_Month(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int16 nMonth = implGetDateMonth( rPar.Get32(1)->GetDate() );
+ rPar.Get32(0)->PutInteger( nMonth );
+ }
+}
+
+sal_Int16 implGetSecond( double dDate )
+{
+ double nFrac = dDate - floor( dDate );
+ nFrac *= 86400.0;
+ sal_Int32 nSeconds = static_cast<sal_Int32>(nFrac + 0.5);
+ sal_Int16 nTemp = static_cast<sal_Int16>(nSeconds / 3600);
+ nSeconds -= nTemp * 3600;
+ nTemp = static_cast<sal_Int16>(nSeconds / 60);
+ nSeconds -= nTemp * 60;
+
+ sal_Int16 nRet = static_cast<sal_Int16>(nSeconds);
+ return nRet;
+}
+
+void SbRtl_Second(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double nArg = rPar.Get32(1)->GetDate();
+ sal_Int16 nSecond = implGetSecond( nArg );
+ rPar.Get32(0)->PutInteger( nSecond );
+ }
+}
+
+double Now_Impl()
+{
+ DateTime aDateTime( DateTime::SYSTEM );
+ double aSerial = static_cast<double>(GetDayDiff( aDateTime ));
+ long nSeconds = aDateTime.GetHour();
+ nSeconds *= 3600;
+ nSeconds += aDateTime.GetMin() * 60;
+ nSeconds += aDateTime.GetSec();
+ double nDays = static_cast<double>(nSeconds) / (24.0*3600.0);
+ aSerial += nDays;
+ return aSerial;
+}
+
+// Date Now()
+
+void SbRtl_Now(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutDate( Now_Impl() );
+}
+
+// Date Time()
+
+void SbRtl_Time(StarBASIC *, SbxArray & rPar, bool bWrite)
+{
+ if ( !bWrite )
+ {
+ tools::Time aTime( tools::Time::SYSTEM );
+ SbxVariable* pMeth = rPar.Get32(0);
+ OUString aRes;
+ if( pMeth->IsFixed() )
+ {
+ // Time$: hh:mm:ss
+ char buf[ 20 ];
+ snprintf( buf, sizeof(buf), "%02d:%02d:%02d",
+ aTime.GetHour(), aTime.GetMin(), aTime.GetSec() );
+ aRes = OUString::createFromAscii( buf );
+ }
+ else
+ {
+ // Time: system dependent
+ long nSeconds=aTime.GetHour();
+ nSeconds *= 3600;
+ nSeconds += aTime.GetMin() * 60;
+ nSeconds += aTime.GetSec();
+ double nDays = static_cast<double>(nSeconds) * ( 1.0 / (24.0*3600.0) );
+ Color* pCol;
+
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ sal_uInt32 nIndex;
+ if( GetSbData()->pInst )
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ nIndex = GetSbData()->pInst->GetStdTimeIdx();
+ }
+ else
+ {
+ sal_uInt32 n; // Dummy
+ pFormatter = SbiInstance::PrepareNumberFormatter( n, nIndex, n );
+ }
+
+ pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
+ }
+ pMeth->PutString( aRes );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED );
+ }
+}
+
+void SbRtl_Timer(StarBASIC *, SbxArray & rPar, bool)
+{
+ tools::Time aTime( tools::Time::SYSTEM );
+ long nSeconds = aTime.GetHour();
+ nSeconds *= 3600;
+ nSeconds += aTime.GetMin() * 60;
+ nSeconds += aTime.GetSec();
+ rPar.Get32(0)->PutDate( static_cast<double>(nSeconds) );
+}
+
+
+void SbRtl_Date(StarBASIC *, SbxArray & rPar, bool bWrite)
+{
+ if ( !bWrite )
+ {
+ Date aToday( Date::SYSTEM );
+ double nDays = static_cast<double>(GetDayDiff( aToday ));
+ SbxVariable* pMeth = rPar.Get32(0);
+ if( pMeth->IsString() )
+ {
+ OUString aRes;
+ Color* pCol;
+
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ sal_uInt32 nIndex;
+ if( GetSbData()->pInst )
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ nIndex = GetSbData()->pInst->GetStdDateIdx();
+ }
+ else
+ {
+ sal_uInt32 n;
+ pFormatter = SbiInstance::PrepareNumberFormatter( nIndex, n, n );
+ }
+
+ pFormatter->GetOutputString( nDays, nIndex, aRes, &pCol );
+ pMeth->PutString( aRes );
+ }
+ else
+ {
+ pMeth->PutDate( nDays );
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_NOT_IMPLEMENTED );
+ }
+}
+
+void SbRtl_IsArray(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ rPar.Get32(0)->PutBool((rPar.Get32(1)->GetType() & SbxARRAY) != 0);
+ }
+}
+
+void SbRtl_IsObject(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariable* pVar = rPar.Get32(1);
+ bool bObject = pVar->IsObject();
+ SbxBase* pObj = (bObject ? pVar->GetObject() : nullptr);
+
+ if( auto pUnoClass = dynamic_cast<SbUnoClass*>( pObj) )
+ {
+ bObject = pUnoClass->getUnoClass().is();
+ }
+ rPar.Get32(0)->PutBool( bObject );
+ }
+}
+
+void SbRtl_IsDate(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // #46134 only string is converted, all other types result in sal_False
+ SbxVariableRef xArg = rPar.Get32(1);
+ SbxDataType eType = xArg->GetType();
+ bool bDate = false;
+
+ if( eType == SbxDATE )
+ {
+ bDate = true;
+ }
+ else if( eType == SbxSTRING )
+ {
+ ErrCode nPrevError = SbxBase::GetError();
+ SbxBase::ResetError();
+
+ // force conversion of the parameter to SbxDATE
+ xArg->SbxValue::GetDate();
+
+ bDate = !SbxBase::IsError();
+
+ SbxBase::ResetError();
+ SbxBase::SetError( nPrevError );
+ }
+ rPar.Get32(0)->PutBool( bDate );
+ }
+}
+
+void SbRtl_IsEmpty(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariable* pVar = nullptr;
+ if( SbiRuntime::isVBAEnabled() )
+ {
+ pVar = getDefaultProp( rPar.Get32(1) );
+ }
+ if ( pVar )
+ {
+ pVar->Broadcast( SfxHintId::BasicDataWanted );
+ rPar.Get32(0)->PutBool( pVar->IsEmpty() );
+ }
+ else
+ {
+ rPar.Get32(0)->PutBool( rPar.Get32(1)->IsEmpty() );
+ }
+ }
+}
+
+void SbRtl_IsError(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxVariable* pVar =rPar.Get32(1);
+ SbUnoObject* pObj = dynamic_cast<SbUnoObject*>( pVar );
+ if ( !pObj )
+ {
+ if ( SbxBase* pBaseObj = (pVar->IsObject() ? pVar->GetObject() : nullptr) )
+ {
+ pObj = dynamic_cast<SbUnoObject*>( pBaseObj );
+ }
+ }
+ uno::Reference< script::XErrorQuery > xError;
+ if ( pObj )
+ {
+ xError.set( pObj->getUnoAny(), uno::UNO_QUERY );
+ }
+ if ( xError.is() )
+ {
+ rPar.Get32(0)->PutBool( xError->hasError() );
+ }
+ else
+ {
+ rPar.Get32(0)->PutBool( rPar.Get32(1)->IsErr() );
+ }
+ }
+}
+
+void SbRtl_IsNull(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // #51475 because of Uno-objects return true
+ // even if the pObj value is NULL
+ SbxVariableRef pArg = rPar.Get32(1);
+ bool bNull = rPar.Get32(1)->IsNull();
+ if( !bNull && pArg->GetType() == SbxOBJECT )
+ {
+ SbxBase* pObj = pArg->GetObject();
+ if( !pObj )
+ {
+ bNull = true;
+ }
+ }
+ rPar.Get32(0)->PutBool( bNull );
+ }
+}
+
+void SbRtl_IsNumeric(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ rPar.Get32(0)->PutBool( rPar.Get32(1)->IsNumericRTL() );
+ }
+}
+
+
+void SbRtl_IsMissing(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // #57915 Missing is reported by an error
+ rPar.Get32(0)->PutBool( rPar.Get32(1)->IsErr() );
+ }
+}
+
+// Function looks for wildcards, removes them and always returns the pure path
+static OUString implSetupWildcard(const OUString& rFileParam, SbiRTLData& rRTLData)
+{
+ static const char cDelim1 = '/';
+ static const char cDelim2 = '\\';
+ static const char cWild1 = '*';
+ static const char cWild2 = '?';
+
+ rRTLData.pWildCard.reset();
+ rRTLData.sFullNameToBeChecked.clear();
+
+ OUString aFileParam = rFileParam;
+ sal_Int32 nLastWild = aFileParam.lastIndexOf( cWild1 );
+ if( nLastWild < 0 )
+ {
+ nLastWild = aFileParam.lastIndexOf( cWild2 );
+ }
+ bool bHasWildcards = ( nLastWild >= 0 );
+
+
+ sal_Int32 nLastDelim = aFileParam.lastIndexOf( cDelim1 );
+ if( nLastDelim < 0 )
+ {
+ nLastDelim = aFileParam.lastIndexOf( cDelim2 );
+ }
+ if( bHasWildcards )
+ {
+ // Wildcards in path?
+ if( nLastDelim >= 0 && nLastDelim > nLastWild )
+ {
+ return aFileParam;
+ }
+ }
+ else
+ {
+ OUString aPathStr = getFullPath( aFileParam );
+ if( nLastDelim != aFileParam.getLength() - 1 )
+ {
+ rRTLData.sFullNameToBeChecked = aPathStr;
+ }
+ return aPathStr;
+ }
+
+ OUString aPureFileName;
+ if( nLastDelim < 0 )
+ {
+ aPureFileName = aFileParam;
+ aFileParam.clear();
+ }
+ else
+ {
+ aPureFileName = aFileParam.copy( nLastDelim + 1 );
+ aFileParam = aFileParam.copy( 0, nLastDelim );
+ }
+
+ // Try again to get a valid URL/UNC-path with only the path
+ OUString aPathStr = getFullPath( aFileParam );
+
+ // Is there a pure file name left? Otherwise the path is
+ // invalid anyway because it was not accepted by OSL before
+ if (aPureFileName != "*")
+ {
+ rRTLData.pWildCard = std::make_unique<WildCard>(aPureFileName);
+ }
+ return aPathStr;
+}
+
+static bool implCheckWildcard(const OUString& rName, SbiRTLData const& rRTLData)
+{
+ bool bMatch = true;
+
+ if (rRTLData.pWildCard)
+ {
+ bMatch = rRTLData.pWildCard->Matches(rName);
+ }
+ return bMatch;
+}
+
+
+static bool isRootDir( const OUString& aDirURLStr )
+{
+ INetURLObject aDirURLObj( aDirURLStr );
+ bool bRoot = false;
+
+ // Check if it's a root directory
+ sal_Int32 nCount = aDirURLObj.getSegmentCount();
+
+ // No segment means Unix root directory "file:///"
+ if( nCount == 0 )
+ {
+ bRoot = true;
+ }
+ // Exactly one segment needs further checking, because it
+ // can be Unix "file:///foo/" -> no root
+ // or Windows "file:///c:/" -> root
+ else if( nCount == 1 )
+ {
+ OUString aSeg1 = aDirURLObj.getName( 0, true,
+ INetURLObject::DecodeMechanism::WithCharset );
+ if( aSeg1[1] == ':' )
+ {
+ bRoot = true;
+ }
+ }
+ // More than one segments can never be root
+ // so bRoot remains false
+
+ return bRoot;
+}
+
+void SbRtl_Dir(StarBASIC *, SbxArray & rPar, bool)
+{
+ OUString aPath;
+
+ const sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbiRTLData& rRTLData = GetSbData()->pInst->GetRTLData();
+
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ if ( nParCount >= 2 )
+ {
+ OUString aFileParam = rPar.Get32(1)->GetOUString();
+
+ OUString aFileURLStr = implSetupWildcard(aFileParam, rRTLData);
+ if (!rRTLData.sFullNameToBeChecked.isEmpty())
+ {
+ bool bExists = false;
+ try { bExists = xSFI->exists( aFileURLStr ); }
+ catch(const Exception & ) {}
+
+ OUString aNameOnlyStr;
+ if( bExists )
+ {
+ INetURLObject aFileURL( aFileURLStr );
+ aNameOnlyStr = aFileURL.getName( INetURLObject::LAST_SEGMENT,
+ true, INetURLObject::DecodeMechanism::WithCharset );
+ }
+ rPar.Get32(0)->PutString( aNameOnlyStr );
+ return;
+ }
+
+ try
+ {
+ OUString aDirURLStr;
+ bool bFolder = xSFI->isFolder( aFileURLStr );
+
+ if( bFolder )
+ {
+ aDirURLStr = aFileURLStr;
+ }
+ else
+ {
+ rPar.Get32(0)->PutString( "" );
+ }
+
+ SbAttributes nFlags = SbAttributes::NONE;
+ if ( nParCount > 2 )
+ {
+ rRTLData.nDirFlags = nFlags
+ = static_cast<SbAttributes>(rPar.Get32(2)->GetInteger());
+ }
+ else
+ {
+ rRTLData.nDirFlags = SbAttributes::NONE;
+ }
+ // Read directory
+ bool bIncludeFolders = bool(nFlags & SbAttributes::DIRECTORY);
+ rRTLData.aDirSeq = xSFI->getFolderContents(aDirURLStr, bIncludeFolders);
+ rRTLData.nCurDirPos = 0;
+
+ // #78651 Add "." and ".." directories for VB compatibility
+ if( bIncludeFolders )
+ {
+ bool bRoot = isRootDir( aDirURLStr );
+
+ // If it's no root directory we flag the need for
+ // the "." and ".." directories by the value -2
+ // for the actual position. Later for -2 will be
+ // returned "." and for -1 ".."
+ if( !bRoot )
+ {
+ rRTLData.nCurDirPos = -2;
+ }
+ }
+ }
+ catch(const Exception & )
+ {
+ }
+ }
+
+
+ if (rRTLData.aDirSeq.hasElements())
+ {
+ bool bFolderFlag = bool(rRTLData.nDirFlags & SbAttributes::DIRECTORY);
+
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ for( ;; )
+ {
+ if (rRTLData.nCurDirPos < 0)
+ {
+ if (rRTLData.nCurDirPos == -2)
+ {
+ aPath = ".";
+ }
+ else if (rRTLData.nCurDirPos == -1)
+ {
+ aPath = "..";
+ }
+ rRTLData.nCurDirPos++;
+ }
+ else if (rRTLData.nCurDirPos >= rRTLData.aDirSeq.getLength())
+ {
+ rRTLData.aDirSeq.realloc(0);
+ aPath.clear();
+ break;
+ }
+ else
+ {
+ OUString aFile
+ = rRTLData.aDirSeq.getConstArray()[rRTLData.nCurDirPos++];
+
+ if( bCompatibility )
+ {
+ if( !bFolderFlag )
+ {
+ bool bFolder = xSFI->isFolder( aFile );
+ if( bFolder )
+ {
+ continue;
+ }
+ }
+ }
+ else
+ {
+ // Only directories
+ if( bFolderFlag )
+ {
+ bool bFolder = xSFI->isFolder( aFile );
+ if( !bFolder )
+ {
+ continue;
+ }
+ }
+ }
+
+ INetURLObject aURL( aFile );
+ aPath = aURL.getName( INetURLObject::LAST_SEGMENT, true,
+ INetURLObject::DecodeMechanism::WithCharset );
+ }
+
+ bool bMatch = implCheckWildcard(aPath, rRTLData);
+ if( !bMatch )
+ {
+ continue;
+ }
+ break;
+ }
+ }
+ rPar.Get32(0)->PutString( aPath );
+ }
+ }
+ else
+ {
+ // TODO: OSL
+ if ( nParCount >= 2 )
+ {
+ OUString aFileParam = rPar.Get32(1)->GetOUString();
+
+ OUString aDirURL = implSetupWildcard(aFileParam, rRTLData);
+
+ SbAttributes nFlags = SbAttributes::NONE;
+ if ( nParCount > 2 )
+ {
+ rRTLData.nDirFlags = nFlags
+ = static_cast<SbAttributes>(rPar.Get32(2)->GetInteger());
+ }
+ else
+ {
+ rRTLData.nDirFlags = SbAttributes::NONE;
+ }
+
+ // Read directory
+ bool bIncludeFolders = bool(nFlags & SbAttributes::DIRECTORY);
+ rRTLData.pDir = std::make_unique<Directory>(aDirURL);
+ FileBase::RC nRet = rRTLData.pDir->open();
+ if( nRet != FileBase::E_None )
+ {
+ rRTLData.pDir.reset();
+ rPar.Get32(0)->PutString( OUString() );
+ return;
+ }
+
+ // #86950 Add "." and ".." directories for VB compatibility
+ rRTLData.nCurDirPos = 0;
+ if( bIncludeFolders )
+ {
+ bool bRoot = isRootDir( aDirURL );
+
+ // If it's no root directory we flag the need for
+ // the "." and ".." directories by the value -2
+ // for the actual position. Later for -2 will be
+ // returned "." and for -1 ".."
+ if( !bRoot )
+ {
+ rRTLData.nCurDirPos = -2;
+ }
+ }
+
+ }
+
+ if (rRTLData.pDir)
+ {
+ bool bFolderFlag = bool(rRTLData.nDirFlags & SbAttributes::DIRECTORY);
+ for( ;; )
+ {
+ if (rRTLData.nCurDirPos < 0)
+ {
+ if (rRTLData.nCurDirPos == -2)
+ {
+ aPath = ".";
+ }
+ else if (rRTLData.nCurDirPos == -1)
+ {
+ aPath = "..";
+ }
+ rRTLData.nCurDirPos++;
+ }
+ else
+ {
+ DirectoryItem aItem;
+ FileBase::RC nRet = rRTLData.pDir->getNextItem(aItem);
+ if( nRet != FileBase::E_None )
+ {
+ rRTLData.pDir.reset();
+ aPath.clear();
+ break;
+ }
+
+ // Handle flags
+ FileStatus aFileStatus( osl_FileStatus_Mask_Type | osl_FileStatus_Mask_FileName );
+ nRet = aItem.getFileStatus( aFileStatus );
+ if( nRet != FileBase::E_None )
+ {
+ SAL_WARN("basic", "getFileStatus failed");
+ continue;
+ }
+
+ // Only directories?
+ if( bFolderFlag )
+ {
+ FileStatus::Type aType = aFileStatus.getFileType();
+ bool bFolder = isFolder( aType );
+ if( !bFolder )
+ {
+ continue;
+ }
+ }
+
+ aPath = aFileStatus.getFileName();
+ }
+
+ bool bMatch = implCheckWildcard(aPath, rRTLData);
+ if( !bMatch )
+ {
+ continue;
+ }
+ break;
+ }
+ }
+ rPar.Get32(0)->PutString( aPath );
+ }
+ }
+}
+
+
+void SbRtl_GetAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
+{
+ (void)pBasic;
+ (void)bWrite;
+
+ if ( rPar.Count32() == 2 )
+ {
+ sal_Int16 nFlags = 0;
+
+ // In Windows, we want to use Windows API to get the file attributes
+ // for VBA interoperability.
+ #if defined(_WIN32)
+ if( SbiRuntime::isVBAEnabled() )
+ {
+ OUString aPathURL = getFullPath( rPar.Get32(1)->GetOUString() );
+ OUString aPath;
+ FileBase::getSystemPathFromFileURL( aPathURL, aPath );
+ DWORD nRealFlags = GetFileAttributesW (o3tl::toW(aPath.getStr()));
+ if (nRealFlags != 0xffffffff)
+ {
+ if (nRealFlags == FILE_ATTRIBUTE_NORMAL)
+ {
+ nRealFlags = 0;
+ }
+ nFlags = static_cast<sal_Int16>(nRealFlags);
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
+ }
+ rPar.Get32(0)->PutInteger( nFlags );
+
+ return;
+ }
+ #endif
+
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ OUString aPath = getFullPath( rPar.Get32(1)->GetOUString() );
+ bool bExists = false;
+ try { bExists = xSFI->exists( aPath ); }
+ catch(const Exception & ) {}
+ if( !bExists )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
+ return;
+ }
+
+ bool bReadOnly = xSFI->isReadOnly( aPath );
+ bool bHidden = xSFI->isHidden( aPath );
+ bool bDirectory = xSFI->isFolder( aPath );
+ if( bReadOnly )
+ {
+ nFlags |= sal_uInt16(SbAttributes::READONLY);
+ }
+ if( bHidden )
+ {
+ nFlags |= sal_uInt16(SbAttributes::HIDDEN);
+ }
+ if( bDirectory )
+ {
+ nFlags |= sal_uInt16(SbAttributes::DIRECTORY);
+ }
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ else
+ {
+ DirectoryItem aItem;
+ (void)DirectoryItem::get( getFullPath( rPar.Get32(1)->GetOUString() ), aItem );
+ FileStatus aFileStatus( osl_FileStatus_Mask_Attributes | osl_FileStatus_Mask_Type );
+ (void)aItem.getFileStatus( aFileStatus );
+ sal_uInt64 nAttributes = aFileStatus.getAttributes();
+ bool bReadOnly = (nAttributes & osl_File_Attribute_ReadOnly) != 0;
+
+ FileStatus::Type aType = aFileStatus.getFileType();
+ bool bDirectory = isFolder( aType );
+ if( bReadOnly )
+ {
+ nFlags |= sal_uInt16(SbAttributes::READONLY);
+ }
+ if( bDirectory )
+ {
+ nFlags |= sal_uInt16(SbAttributes::DIRECTORY);
+ }
+ }
+ rPar.Get32(0)->PutInteger( nFlags );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+
+void SbRtl_FileDateTime(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aPath = rPar.Get32(1)->GetOUString();
+ tools::Time aTime( tools::Time::EMPTY );
+ Date aDate( Date::EMPTY );
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ util::DateTime aUnoDT = xSFI->getDateTimeModified( aPath );
+ aTime = tools::Time( aUnoDT );
+ aDate = Date( aUnoDT );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ else
+ {
+ bool bSuccess = false;
+ do
+ {
+ DirectoryItem aItem;
+ if (DirectoryItem::get( getFullPath( aPath ), aItem ) != FileBase::E_None)
+ break;
+
+ FileStatus aFileStatus( osl_FileStatus_Mask_ModifyTime );
+ if (aItem.getFileStatus( aFileStatus ) != FileBase::E_None)
+ break;
+
+ TimeValue aTimeVal = aFileStatus.getModifyTime();
+ oslDateTime aDT;
+ if (!osl_getDateTimeFromTimeValue( &aTimeVal, &aDT ))
+ // Strictly spoken this is not an i/o error but some other failure.
+ break;
+
+ aTime = tools::Time( aDT.Hours, aDT.Minutes, aDT.Seconds, aDT.NanoSeconds );
+ aDate = Date( aDT.Day, aDT.Month, aDT.Year );
+ bSuccess = true;
+ }
+ while(false);
+
+ if (!bSuccess)
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+
+ // An empty date shall not result in a formatted null-date (1899-12-30
+ // or 1900-01-01) or even worse -0001-12-03 or some such due to how
+ // GetDayDiff() treats things. There should be an error set in this
+ // case anyway because of a missing file or other error above, but... so
+ // do not even bother to use the number formatter.
+ OUString aRes;
+ if (aDate.IsEmpty())
+ {
+ aRes = "0000-00-00 00:00:00";
+ }
+ else
+ {
+ double fSerial = static_cast<double>(GetDayDiff( aDate ));
+ long nSeconds = aTime.GetHour();
+ nSeconds *= 3600;
+ nSeconds += aTime.GetMin() * 60;
+ nSeconds += aTime.GetSec();
+ double nDays = static_cast<double>(nSeconds) / (24.0*3600.0);
+ fSerial += nDays;
+
+ Color* pCol;
+
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ sal_uInt32 nIndex;
+ if( GetSbData()->pInst )
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ nIndex = GetSbData()->pInst->GetStdDateTimeIdx();
+ }
+ else
+ {
+ sal_uInt32 n;
+ pFormatter = SbiInstance::PrepareNumberFormatter( n, n, nIndex );
+ }
+
+ pFormatter->GetOutputString( fSerial, nIndex, aRes, &pCol );
+ }
+ rPar.Get32(0)->PutString( aRes );
+ }
+}
+
+
+void SbRtl_EOF(StarBASIC *, SbxArray & rPar, bool)
+{
+ // No changes for UCB
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ SbiStream* pSbStrm = pIO->GetStream( nChannel );
+ if ( !pSbStrm )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
+ return;
+ }
+ bool beof;
+ SvStream* pSvStrm = pSbStrm->GetStrm();
+ if ( pSbStrm->IsText() )
+ {
+ char cBla;
+ (*pSvStrm).ReadChar( cBla ); // can we read another character?
+ beof = pSvStrm->eof();
+ if ( !beof )
+ {
+ pSvStrm->SeekRel( -1 );
+ }
+ }
+ else
+ {
+ beof = pSvStrm->eof(); // for binary data!
+ }
+ rPar.Get32(0)->PutBool( beof );
+ }
+}
+
+void SbRtl_FileAttr(StarBASIC *, SbxArray & rPar, bool)
+{
+ // No changes for UCB
+ // #57064 Although this function doesn't operate with DirEntry, it is
+ // not touched by the adjustment to virtual URLs, as it only works on
+ // already opened files and the name doesn't matter there.
+
+ if ( rPar.Count32() != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ SbiStream* pSbStrm = pIO->GetStream( nChannel );
+ if ( !pSbStrm )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
+ return;
+ }
+ sal_Int16 nRet;
+ if ( rPar.Get32(2)->GetInteger() == 1 )
+ {
+ nRet = static_cast<sal_Int16>(pSbStrm->GetMode());
+ }
+ else
+ {
+ nRet = 0; // System file handle not supported
+ }
+ rPar.Get32(0)->PutInteger( nRet );
+ }
+}
+void SbRtl_Loc(StarBASIC *, SbxArray & rPar, bool)
+{
+ // No changes for UCB
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ SbiStream* pSbStrm = pIO->GetStream( nChannel );
+ if ( !pSbStrm )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
+ return;
+ }
+ SvStream* pSvStrm = pSbStrm->GetStrm();
+ std::size_t nPos;
+ if( pSbStrm->IsRandom())
+ {
+ short nBlockLen = pSbStrm->GetBlockLen();
+ nPos = nBlockLen ? (pSvStrm->Tell() / nBlockLen) : 0;
+ nPos++; // block positions starting at 1
+ }
+ else if ( pSbStrm->IsText() )
+ {
+ nPos = pSbStrm->GetLine();
+ }
+ else if( pSbStrm->IsBinary() )
+ {
+ nPos = pSvStrm->Tell();
+ }
+ else if ( pSbStrm->IsSeq() )
+ {
+ nPos = ( pSvStrm->Tell()+1 ) / 128;
+ }
+ else
+ {
+ nPos = pSvStrm->Tell();
+ }
+ rPar.Get32(0)->PutLong( static_cast<sal_Int32>(nPos) );
+ }
+}
+
+void SbRtl_Lof(StarBASIC *, SbxArray & rPar, bool)
+{
+ // No changes for UCB
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ SbiStream* pSbStrm = pIO->GetStream( nChannel );
+ if ( !pSbStrm )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
+ return;
+ }
+ SvStream* pSvStrm = pSbStrm->GetStrm();
+ sal_uInt64 const nLen = pSvStrm->TellEnd();
+ rPar.Get32(0)->PutLong( static_cast<sal_Int32>(nLen) );
+ }
+}
+
+
+void SbRtl_Seek(StarBASIC *, SbxArray & rPar, bool)
+{
+ // No changes for UCB
+ int nArgs = static_cast<int>(rPar.Count32());
+ if ( nArgs < 2 || nArgs > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ sal_Int16 nChannel = rPar.Get32(1)->GetInteger();
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ SbiStream* pSbStrm = pIO->GetStream( nChannel );
+ if ( !pSbStrm )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
+ return;
+ }
+ SvStream* pStrm = pSbStrm->GetStrm();
+
+ if ( nArgs == 2 ) // Seek-Function
+ {
+ sal_uInt64 nPos = pStrm->Tell();
+ if( pSbStrm->IsRandom() )
+ {
+ nPos = nPos / pSbStrm->GetBlockLen();
+ }
+ nPos++; // Basic counts from 1
+ rPar.Get32(0)->PutLong( static_cast<sal_Int32>(nPos) );
+ }
+ else // Seek-Statement
+ {
+ sal_Int32 nPos = rPar.Get32(2)->GetLong();
+ if ( nPos < 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ nPos--; // Basic counts from 1, SvStreams count from 0
+ pSbStrm->SetExpandOnWriteTo( 0 );
+ if ( pSbStrm->IsRandom() )
+ {
+ nPos *= pSbStrm->GetBlockLen();
+ }
+ pStrm->Seek( static_cast<sal_uInt64>(nPos) );
+ pSbStrm->SetExpandOnWriteTo( nPos );
+ }
+}
+
+void SbRtl_Format(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32();
+ if ( nArgCount < 2 || nArgCount > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aResult;
+ if( nArgCount == 2 )
+ {
+ rPar.Get32(1)->Format( aResult );
+ }
+ else
+ {
+ OUString aFmt( rPar.Get32(2)->GetOUString() );
+ rPar.Get32(1)->Format( aResult, &aFmt );
+ }
+ rPar.Get32(0)->PutString( aResult );
+ }
+}
+
+// https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/formatnumber-function
+void SbRtl_FormatNumber(StarBASIC*, SbxArray& rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32();
+ if (nArgCount < 2 || nArgCount > 6)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+
+ // The UI locale never changes -> we can use static value here
+ static const LocaleDataWrapper localeData(Application::GetSettings().GetUILanguageTag());
+ sal_Int16 nNumDigitsAfterDecimal = -1;
+ if (nArgCount > 2 && !rPar.Get32(2)->IsEmpty())
+ {
+ nNumDigitsAfterDecimal = rPar.Get32(2)->GetInteger();
+ if (nNumDigitsAfterDecimal < -1)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ else if (nNumDigitsAfterDecimal > 255)
+ nNumDigitsAfterDecimal %= 256;
+ }
+ if (nNumDigitsAfterDecimal == -1)
+ nNumDigitsAfterDecimal = LocaleDataWrapper::getNumDigits();
+
+ bool bIncludeLeadingDigit = LocaleDataWrapper::isNumLeadingZero();
+ if (nArgCount > 3 && !rPar.Get32(3)->IsEmpty())
+ {
+ switch (rPar.Get32(3)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ bIncludeLeadingDigit = false;
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bIncludeLeadingDigit = true;
+ break;
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ bool bUseParensForNegativeNumbers = false;
+ if (nArgCount > 4 && !rPar.Get32(4)->IsEmpty())
+ {
+ switch (rPar.Get32(4)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bUseParensForNegativeNumbers = true;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ bool bGroupDigits = false;
+ if (nArgCount > 5 && !rPar.Get32(5)->IsEmpty())
+ {
+ switch (rPar.Get32(5)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bGroupDigits = true;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ double fVal = rPar.Get32(1)->GetDouble();
+ const bool bNegative = fVal < 0;
+ if (bNegative)
+ fVal = fabs(fVal); // Always work with non-negatives, to easily handle leading zero
+
+ static const sal_Unicode decSep = localeData.getNumDecimalSep().toChar();
+ OUString aResult = rtl::math::doubleToUString(
+ fVal, rtl_math_StringFormat_F, nNumDigitsAfterDecimal, decSep,
+ bGroupDigits ? localeData.getDigitGrouping().getConstArray() : nullptr,
+ localeData.getNumThousandSep().toChar());
+
+ if (!bIncludeLeadingDigit && aResult.getLength() > 1 && aResult.startsWith("0"))
+ aResult = aResult.copy(1);
+
+ if (nNumDigitsAfterDecimal > 0)
+ {
+ sal_Int32 nActualDigits;
+ const sal_Int32 nSepPos = aResult.indexOf(decSep);
+ if (nSepPos == -1)
+ nActualDigits = 0;
+ else
+ nActualDigits = aResult.getLength() - nSepPos - 1;
+
+ // VBA allows up to 255 digits; rtl::math::doubleToUString outputs up to 15 digits
+ // for ~small numbers, so pad them as appropriate.
+ if (nActualDigits < nNumDigitsAfterDecimal)
+ {
+ OUStringBuffer sBuf;
+ comphelper::string::padToLength(sBuf, nNumDigitsAfterDecimal - nActualDigits, '0');
+ aResult += sBuf;
+ }
+ }
+
+ if (bNegative)
+ {
+ if (bUseParensForNegativeNumbers)
+ aResult = "(" + aResult + ")";
+ else
+ aResult = "-" + aResult;
+ }
+
+ rPar.Get32(0)->PutString(aResult);
+}
+
+namespace {
+
+// note: BASIC does not use comphelper::random, because
+// Randomize(int) must be supported and should not affect non-BASIC random use
+struct RandomNumberGenerator
+{
+ std::mt19937 global_rng;
+
+ RandomNumberGenerator()
+ {
+ try
+ {
+ std::random_device rd;
+ // initialises the state of the global random number generator
+ // should only be called once.
+ // (note, a few std::variate_generator<> (like normal) have their
+ // own state which would need a reset as well to guarantee identical
+ // sequence of numbers, e.g. via myrand.distribution().reset())
+ global_rng.seed(rd() ^ time(nullptr));
+ }
+ catch (std::runtime_error& e)
+ {
+ SAL_WARN("basic", "Using std::random_device failed: " << e.what());
+ global_rng.seed(time(nullptr));
+ }
+ }
+};
+
+class theRandomNumberGenerator : public rtl::Static<RandomNumberGenerator, theRandomNumberGenerator> {};
+
+}
+
+void SbRtl_Randomize(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() > 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ if( rPar.Count32() == 2 )
+ {
+ int nSeed = static_cast<int>(rPar.Get32(1)->GetInteger());
+ theRandomNumberGenerator::get().global_rng.seed(nSeed);
+ }
+ // without parameter, no need to do anything - RNG is seeded at first use
+}
+
+void SbRtl_Rnd(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() > 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ std::uniform_real_distribution<double> dist(0.0, 1.0);
+ double const tmp(dist(theRandomNumberGenerator::get().global_rng));
+ rPar.Get32(0)->PutDouble(tmp);
+ }
+}
+
+
+// Syntax: Shell("Path",[ Window-Style,[ "Params", [ bSync = sal_False ]]])
+// WindowStyles (VBA compatible):
+// 2 == Minimized
+// 3 == Maximized
+// 10 == Full-Screen (text mode applications OS/2, WIN95, WNT)
+// HACK: The WindowStyle will be passed to
+// Application::StartApp in Creator. Format: "xxxx2"
+
+
+void SbRtl_Shell(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32();
+ if ( nArgCount < 2 || nArgCount > 5 )
+ {
+ rPar.Get32(0)->PutLong(0);
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ oslProcessOption nOptions = osl_Process_SEARCHPATH | osl_Process_DETACHED;
+
+ OUString aCmdLine = rPar.Get32(1)->GetOUString();
+ // attach additional parameters - everything must be parsed anyway
+ if( nArgCount >= 4 )
+ {
+ OUString tmp = rPar.Get32(3)->GetOUString().trim();
+ if (!tmp.isEmpty())
+ {
+ aCmdLine += " " + tmp;
+ }
+ }
+ else if( aCmdLine.isEmpty() )
+ {
+ // avoid special treatment (empty list)
+ aCmdLine += " ";
+ }
+ sal_Int32 nLen = aCmdLine.getLength();
+
+ // #55735 if there are parameters, they have to be separated
+ // #72471 also separate the single parameters
+ std::vector<OUString> aTokenVector;
+ OUString aToken;
+ sal_Int32 i = 0;
+ sal_Unicode c;
+ while( i < nLen )
+ {
+ for ( ;; ++i )
+ {
+ c = aCmdLine[ i ];
+ if ( c != ' ' && c != '\t' )
+ {
+ break;
+ }
+ }
+
+ if( c == '\"' || c == '\'' )
+ {
+ sal_Int32 iFoundPos = aCmdLine.indexOf( c, i + 1 );
+
+ if( iFoundPos < 0 )
+ {
+ aToken = aCmdLine.copy( i);
+ i = nLen;
+ }
+ else
+ {
+ aToken = aCmdLine.copy( i + 1, (iFoundPos - i - 1) );
+ i = iFoundPos + 1;
+ }
+ }
+ else
+ {
+ sal_Int32 iFoundSpacePos = aCmdLine.indexOf( ' ', i );
+ sal_Int32 iFoundTabPos = aCmdLine.indexOf( '\t', i );
+ sal_Int32 iFoundPos = iFoundSpacePos >= 0 ? iFoundTabPos >= 0 ? std::min( iFoundSpacePos, iFoundTabPos ) : iFoundSpacePos : -1;
+
+ if( iFoundPos < 0 )
+ {
+ aToken = aCmdLine.copy( i );
+ i = nLen;
+ }
+ else
+ {
+ aToken = aCmdLine.copy( i, (iFoundPos - i) );
+ i = iFoundPos;
+ }
+ }
+
+ // insert into the list
+ aTokenVector.push_back( aToken );
+ }
+ // #55735 / #72471 end
+
+ sal_Int16 nWinStyle = 0;
+ if( nArgCount >= 3 )
+ {
+ nWinStyle = rPar.Get32(2)->GetInteger();
+ switch( nWinStyle )
+ {
+ case 2:
+ nOptions |= osl_Process_MINIMIZED;
+ break;
+ case 3:
+ nOptions |= osl_Process_MAXIMIZED;
+ break;
+ case 10:
+ nOptions |= osl_Process_FULLSCREEN;
+ break;
+ }
+
+ bool bSync = false;
+ if( nArgCount >= 5 )
+ {
+ bSync = rPar.Get32(4)->GetBool();
+ }
+ if( bSync )
+ {
+ nOptions |= osl_Process_WAIT;
+ }
+ }
+
+ // #72471 work parameter(s) up
+ std::vector<OUString>::const_iterator iter = aTokenVector.begin();
+ OUString aOUStrProgURL = getFullPath( *iter );
+
+ ++iter;
+
+ sal_uInt16 nParamCount = sal::static_int_cast< sal_uInt16 >(aTokenVector.size() - 1 );
+ std::unique_ptr<rtl_uString*[]> pParamList;
+ if( nParamCount )
+ {
+ pParamList.reset( new rtl_uString*[nParamCount]);
+ for(int iVector = 0; iter != aTokenVector.end(); ++iVector, ++iter)
+ {
+ const OUString& rParamStr = *iter;
+ pParamList[iVector] = nullptr;
+ rtl_uString_assign(&(pParamList[iVector]), rParamStr.pData);
+ }
+ }
+
+ oslProcess pApp;
+ bool bSucc = osl_executeProcess(
+ aOUStrProgURL.pData,
+ pParamList.get(),
+ nParamCount,
+ nOptions,
+ nullptr,
+ nullptr,
+ nullptr, 0,
+ &pApp ) == osl_Process_E_None;
+
+ // 53521 only free process handle on success
+ if (bSucc)
+ {
+ osl_freeProcessHandle( pApp );
+ }
+
+ for(int j = 0; j < nParamCount; ++j)
+ {
+ rtl_uString_release(pParamList[j]);
+ }
+
+ if( !bSucc )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_FILE_NOT_FOUND );
+ }
+ else
+ {
+ rPar.Get32(0)->PutLong( 0 );
+ }
+ }
+}
+
+void SbRtl_VarType(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxDataType eType = rPar.Get32(1)->GetType();
+ rPar.Get32(0)->PutInteger( static_cast<sal_Int16>(eType) );
+ }
+}
+
+// Exported function
+OUString getBasicTypeName( SbxDataType eType )
+{
+ static const char* pTypeNames[] =
+ {
+ "Empty", // SbxEMPTY
+ "Null", // SbxNULL
+ "Integer", // SbxINTEGER
+ "Long", // SbxLONG
+ "Single", // SbxSINGLE
+ "Double", // SbxDOUBLE
+ "Currency", // SbxCURRENCY
+ "Date", // SbxDATE
+ "String", // SbxSTRING
+ "Object", // SbxOBJECT
+ "Error", // SbxERROR
+ "Boolean", // SbxBOOL
+ "Variant", // SbxVARIANT
+ "DataObject", // SbxDATAOBJECT
+ "Unknown Type",
+ "Unknown Type",
+ "Char", // SbxCHAR
+ "Byte", // SbxBYTE
+ "UShort", // SbxUSHORT
+ "ULong", // SbxULONG
+ "Long64", // SbxLONG64
+ "ULong64", // SbxULONG64
+ "Int", // SbxINT
+ "UInt", // SbxUINT
+ "Void", // SbxVOID
+ "HResult", // SbxHRESULT
+ "Pointer", // SbxPOINTER
+ "DimArray", // SbxDIMARRAY
+ "CArray", // SbxCARRAY
+ "Userdef", // SbxUSERDEF
+ "Lpstr", // SbxLPSTR
+ "Lpwstr", // SbxLPWSTR
+ "Unknown Type", // SbxCoreSTRING
+ "WString", // SbxWSTRING
+ "WChar", // SbxWCHAR
+ "Int64", // SbxSALINT64
+ "UInt64", // SbxSALUINT64
+ "Decimal", // SbxDECIMAL
+ };
+
+ size_t nPos = static_cast<size_t>(eType) & 0x0FFF;
+ const size_t nTypeNameCount = SAL_N_ELEMENTS( pTypeNames );
+ if ( nPos >= nTypeNameCount )
+ {
+ nPos = nTypeNameCount - 1;
+ }
+ return OUString::createFromAscii(pTypeNames[nPos]);
+}
+
+static OUString getObjectTypeName( SbxVariable* pVar )
+{
+ OUString sRet( "Object" );
+ if ( pVar )
+ {
+ SbxBase* pBaseObj = pVar->GetObject();
+ if( !pBaseObj )
+ {
+ sRet = "Nothing";
+ }
+ else
+ {
+ SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pVar );
+ if ( !pUnoObj )
+ {
+ pUnoObj = dynamic_cast<SbUnoObject*>( pBaseObj );
+ }
+ if ( pUnoObj )
+ {
+ Any aObj = pUnoObj->getUnoAny();
+ // For upstreaming unless we start to build oovbaapi by default
+ // we need to get detect the vba-ness of the object in some
+ // other way
+ // note: Automation objects do not support XServiceInfo
+ uno::Reference< XServiceInfo > xServInfo( aObj, uno::UNO_QUERY );
+ if ( xServInfo.is() )
+ {
+ // is this a VBA object ?
+ Sequence< OUString > sServices = xServInfo->getSupportedServiceNames();
+ if ( sServices.hasElements() )
+ {
+ sRet = sServices[ 0 ];
+ }
+ }
+ else
+ {
+ uno::Reference< bridge::oleautomation::XAutomationObject > xAutoMation( aObj, uno::UNO_QUERY );
+ if ( xAutoMation.is() )
+ {
+ uno::Reference< script::XInvocation > xInv( aObj, uno::UNO_QUERY );
+ if ( xInv.is() )
+ {
+ try
+ {
+ xInv->getValue( "$GetTypeName" ) >>= sRet;
+ }
+ catch(const Exception& )
+ {
+ }
+ }
+ }
+ }
+ sal_Int32 nDot = sRet.lastIndexOf( '.' );
+ if ( nDot != -1 && nDot < sRet.getLength() )
+ {
+ sRet = sRet.copy( nDot + 1 );
+ }
+ }
+ }
+ }
+ return sRet;
+}
+
+void SbRtl_TypeName(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxDataType eType = rPar.Get32(1)->GetType();
+ bool bIsArray = ( ( eType & SbxARRAY ) != 0 );
+
+ OUString aRetStr;
+ if ( SbiRuntime::isVBAEnabled() && eType == SbxOBJECT )
+ {
+ aRetStr = getObjectTypeName( rPar.Get32(1) );
+ }
+ else
+ {
+ aRetStr = getBasicTypeName( eType );
+ }
+ if( bIsArray )
+ {
+ aRetStr += "()";
+ }
+ rPar.Get32(0)->PutString( aRetStr );
+ }
+}
+
+void SbRtl_Len(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ const OUString& rStr = rPar.Get32(1)->GetOUString();
+ rPar.Get32(0)->PutLong( rStr.getLength() );
+ }
+}
+
+void SbRtl_DDEInitiate(StarBASIC *, SbxArray & rPar, bool)
+{
+ int nArgs = static_cast<int>(rPar.Count32());
+ if ( nArgs != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ const OUString& rApp = rPar.Get32(1)->GetOUString();
+ const OUString& rTopic = rPar.Get32(2)->GetOUString();
+
+ SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
+ size_t nChannel;
+ ErrCode nDdeErr = pDDE->Initiate( rApp, rTopic, nChannel );
+ if( nDdeErr )
+ {
+ StarBASIC::Error( nDdeErr );
+ }
+ else
+ {
+ rPar.Get32(0)->PutInteger( static_cast<sal_Int16>(nChannel) );
+ }
+}
+
+void SbRtl_DDETerminate(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ int nArgs = static_cast<int>(rPar.Count32());
+ if ( nArgs != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ size_t nChannel = rPar.Get32(1)->GetInteger();
+ SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
+ ErrCode nDdeErr = pDDE->Terminate( nChannel );
+ if( nDdeErr )
+ {
+ StarBASIC::Error( nDdeErr );
+ }
+}
+
+void SbRtl_DDETerminateAll(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ int nArgs = static_cast<int>(rPar.Count32());
+ if ( nArgs != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
+ ErrCode nDdeErr = pDDE->TerminateAll();
+ if( nDdeErr )
+ {
+ StarBASIC::Error( nDdeErr );
+ }
+}
+
+void SbRtl_DDERequest(StarBASIC *, SbxArray & rPar, bool)
+{
+ int nArgs = static_cast<int>(rPar.Count32());
+ if ( nArgs != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ size_t nChannel = rPar.Get32(1)->GetInteger();
+ const OUString& rItem = rPar.Get32(2)->GetOUString();
+ SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
+ OUString aResult;
+ ErrCode nDdeErr = pDDE->Request( nChannel, rItem, aResult );
+ if( nDdeErr )
+ {
+ StarBASIC::Error( nDdeErr );
+ }
+ else
+ {
+ rPar.Get32(0)->PutString( aResult );
+ }
+}
+
+void SbRtl_DDEExecute(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ int nArgs = static_cast<int>(rPar.Count32());
+ if ( nArgs != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ size_t nChannel = rPar.Get32(1)->GetInteger();
+ const OUString& rCommand = rPar.Get32(2)->GetOUString();
+ SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
+ ErrCode nDdeErr = pDDE->Execute( nChannel, rCommand );
+ if( nDdeErr )
+ {
+ StarBASIC::Error( nDdeErr );
+ }
+}
+
+void SbRtl_DDEPoke(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ int nArgs = static_cast<int>(rPar.Count32());
+ if ( nArgs != 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ size_t nChannel = rPar.Get32(1)->GetInteger();
+ const OUString& rItem = rPar.Get32(2)->GetOUString();
+ const OUString& rData = rPar.Get32(3)->GetOUString();
+ SbiDdeControl* pDDE = GetSbData()->pInst->GetDdeControl();
+ ErrCode nDdeErr = pDDE->Poke( nChannel, rItem, rData );
+ if( nDdeErr )
+ {
+ StarBASIC::Error( nDdeErr );
+ }
+}
+
+
+void SbRtl_FreeFile(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ short nChannel = 1;
+ while( nChannel < CHANNELS )
+ {
+ SbiStream* pStrm = pIO->GetStream( nChannel );
+ if( !pStrm )
+ {
+ rPar.Get32(0)->PutInteger( nChannel );
+ return;
+ }
+ nChannel++;
+ }
+ StarBASIC::Error( ERRCODE_BASIC_TOO_MANY_FILES );
+}
+
+void SbRtl_LBound(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nParCount = rPar.Count32();
+ if ( nParCount != 3 && nParCount != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ SbxBase* pParObj = rPar.Get32(1)->GetObject();
+ SbxDimArray* pArr = dynamic_cast<SbxDimArray*>( pParObj );
+ if( pArr )
+ {
+ sal_Int32 nLower, nUpper;
+ short nDim = (nParCount == 3) ? static_cast<short>(rPar.Get32(2)->GetInteger()) : 1;
+ if( !pArr->GetDim32( nDim, nLower, nUpper ) )
+ StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ else
+ rPar.Get32(0)->PutLong( nLower );
+ }
+ else
+ StarBASIC::Error( ERRCODE_BASIC_MUST_HAVE_DIMS );
+}
+
+void SbRtl_UBound(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nParCount = rPar.Count32();
+ if ( nParCount != 3 && nParCount != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ SbxBase* pParObj = rPar.Get32(1)->GetObject();
+ SbxDimArray* pArr = dynamic_cast<SbxDimArray*>( pParObj );
+ if( pArr )
+ {
+ sal_Int32 nLower, nUpper;
+ short nDim = (nParCount == 3) ? static_cast<short>(rPar.Get32(2)->GetInteger()) : 1;
+ if( !pArr->GetDim32( nDim, nLower, nUpper ) )
+ StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ else
+ rPar.Get32(0)->PutLong( nUpper );
+ }
+ else
+ StarBASIC::Error( ERRCODE_BASIC_MUST_HAVE_DIMS );
+}
+
+void SbRtl_RGB(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ sal_Int32 nRed = rPar.Get32(1)->GetInteger() & 0xFF;
+ sal_Int32 nGreen = rPar.Get32(2)->GetInteger() & 0xFF;
+ sal_Int32 nBlue = rPar.Get32(3)->GetInteger() & 0xFF;
+ sal_Int32 nRGB;
+
+ SbiInstance* pInst = GetSbData()->pInst;
+ bool bCompatibility = ( pInst && pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ nRGB = (nBlue << 16) | (nGreen << 8) | nRed;
+ }
+ else
+ {
+ nRGB = (nRed << 16) | (nGreen << 8) | nBlue;
+ }
+ rPar.Get32(0)->PutLong( nRGB );
+}
+
+void SbRtl_QBColor(StarBASIC *, SbxArray & rPar, bool)
+{
+ static const sal_Int32 pRGB[] =
+ {
+ 0x000000,
+ 0x800000,
+ 0x008000,
+ 0x808000,
+ 0x000080,
+ 0x800080,
+ 0x008080,
+ 0xC0C0C0,
+ 0x808080,
+ 0xFF0000,
+ 0x00FF00,
+ 0xFFFF00,
+ 0x0000FF,
+ 0xFF00FF,
+ 0x00FFFF,
+ 0xFFFFFF,
+ };
+
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ sal_Int16 nCol = rPar.Get32(1)->GetInteger();
+ if( nCol < 0 || nCol > 15 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ sal_Int32 nRGB = pRGB[ nCol ];
+ rPar.Get32(0)->PutLong( nRGB );
+}
+
+// StrConv(string, conversion, LCID)
+void SbRtl_StrConv(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32()-1;
+ if( nArgCount < 2 || nArgCount > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aOldStr = rPar.Get32(1)->GetOUString();
+ sal_Int32 nConversion = rPar.Get32(2)->GetLong();
+
+ LanguageType nLanguage = LANGUAGE_SYSTEM;
+
+ sal_Int32 nOldLen = aOldStr.getLength();
+ if( nOldLen == 0 )
+ {
+ // null string,return
+ rPar.Get32(0)->PutString(aOldStr);
+ return;
+ }
+
+ TransliterationFlags nType = TransliterationFlags::NONE;
+ if ( (nConversion & 0x03) == 3 ) // vbProperCase
+ {
+ const CharClass& rCharClass = GetCharClass();
+ aOldStr = rCharClass.titlecase( aOldStr.toAsciiLowerCase(), 0, nOldLen );
+ }
+ else if ( (nConversion & 0x01) == 1 ) // vbUpperCase
+ {
+ nType |= TransliterationFlags::LOWERCASE_UPPERCASE;
+ }
+ else if ( (nConversion & 0x02) == 2 ) // vbLowerCase
+ {
+ nType |= TransliterationFlags::UPPERCASE_LOWERCASE;
+ }
+ if ( (nConversion & 0x04) == 4 ) // vbWide
+ {
+ nType |= TransliterationFlags::HALFWIDTH_FULLWIDTH;
+ }
+ else if ( (nConversion & 0x08) == 8 ) // vbNarrow
+ {
+ nType |= TransliterationFlags::FULLWIDTH_HALFWIDTH;
+ }
+ if ( (nConversion & 0x10) == 16) // vbKatakana
+ {
+ nType |= TransliterationFlags::HIRAGANA_KATAKANA;
+ }
+ else if ( (nConversion & 0x20) == 32 ) // vbHiragana
+ {
+ nType |= TransliterationFlags::KATAKANA_HIRAGANA;
+ }
+ OUString aNewStr( aOldStr );
+ if( nType != TransliterationFlags::NONE )
+ {
+ uno::Reference< uno::XComponentContext > xContext = getProcessComponentContext();
+ ::utl::TransliterationWrapper aTransliterationWrapper( xContext, nType );
+ uno::Sequence<sal_Int32> aOffsets;
+ aTransliterationWrapper.loadModuleIfNeeded( nLanguage );
+ aNewStr = aTransliterationWrapper.transliterate( aOldStr, nLanguage, 0, nOldLen, &aOffsets );
+ }
+
+ if ( (nConversion & 0x40) == 64 ) // vbUnicode
+ {
+ // convert the string to byte string, preserving unicode (2 bytes per character)
+ sal_Int32 nSize = aNewStr.getLength()*2;
+ const sal_Unicode* pSrc = aNewStr.getStr();
+ std::unique_ptr<char[]> pChar(new char[nSize+1]);
+ for( sal_Int32 i=0; i < nSize; i++ )
+ {
+ pChar[i] = static_cast< char >( (i%2) ? ((*pSrc) >> 8) & 0xff : (*pSrc) & 0xff );
+ if( i%2 )
+ {
+ pSrc++;
+ }
+ }
+ pChar[nSize] = '\0';
+ OString aOStr(pChar.get());
+
+ // there is no concept about default codepage in unix. so it is incorrectly in unix
+ OUString aOUStr = OStringToOUString(aOStr, osl_getThreadTextEncoding());
+ rPar.Get32(0)->PutString( aOUStr );
+ return;
+ }
+ else if ( (nConversion & 0x80) == 128 ) // vbFromUnicode
+ {
+ // there is no concept about default codepage in unix. so it is incorrectly in unix
+ OString aOStr = OUStringToOString(aNewStr,osl_getThreadTextEncoding());
+ const char* pChar = aOStr.getStr();
+ sal_Int32 nArraySize = aOStr.getLength();
+ SbxDimArray* pArray = new SbxDimArray(SbxBYTE);
+ bool bIncIndex = (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() );
+ if(nArraySize)
+ {
+ if( bIncIndex )
+ {
+ pArray->AddDim32( 1, nArraySize );
+ }
+ else
+ {
+ pArray->AddDim32( 0, nArraySize-1 );
+ }
+ }
+ else
+ {
+ pArray->unoAddDim32( 0, -1 );
+ }
+
+ for( sal_Int32 i=0; i< nArraySize; i++)
+ {
+ SbxVariable* pNew = new SbxVariable( SbxBYTE );
+ pNew->PutByte(*pChar);
+ pChar++;
+ pNew->SetFlag( SbxFlagBits::Write );
+ sal_Int32 aIdx[1];
+ aIdx[0] = i;
+ if( bIncIndex )
+ {
+ ++aIdx[0];
+ }
+ pArray->Put32(pNew, aIdx);
+ }
+
+ SbxVariableRef refVar = rPar.Get32(0);
+ SbxFlagBits nFlags = refVar->GetFlags();
+ refVar->ResetFlag( SbxFlagBits::Fixed );
+ refVar->PutObject( pArray );
+ refVar->SetFlags( nFlags );
+ refVar->SetParameters( nullptr );
+ return;
+ }
+ rPar.Get32(0)->PutString(aNewStr);
+}
+
+
+void SbRtl_Beep(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ Sound::Beep();
+}
+
+void SbRtl_Load(StarBASIC *, SbxArray & rPar, bool)
+{
+ if( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+
+ SbxBase* pObj = rPar.Get32(1)->GetObject();
+ if ( !pObj )
+ return;
+
+ if (SbUserFormModule* pModule = dynamic_cast<SbUserFormModule*>(pObj))
+ {
+ pModule->Load();
+ }
+ else if (SbxObject* pSbxObj = dynamic_cast<SbxObject*>(pObj))
+ {
+ SbxVariable* pVar = pSbxObj->Find("Load", SbxClassType::Method);
+ if( pVar )
+ {
+ pVar->GetInteger();
+ }
+ }
+}
+
+void SbRtl_Unload(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+
+ SbxBase* pObj = rPar.Get32(1)->GetObject();
+ if ( !pObj )
+ return;
+
+ if (SbUserFormModule* pFormModule = dynamic_cast<SbUserFormModule*>(pObj))
+ {
+ pFormModule->Unload();
+ }
+ else if (SbxObject *pSbxObj = dynamic_cast<SbxObject*>(pObj))
+ {
+ SbxVariable* pVar = pSbxObj->Find("Unload", SbxClassType::Method);
+ if( pVar )
+ {
+ pVar->GetInteger();
+ }
+ }
+}
+
+void SbRtl_LoadPicture(StarBASIC *, SbxArray & rPar, bool)
+{
+ if( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aFileURL = getFullPath( rPar.Get32(1)->GetOUString() );
+ std::unique_ptr<SvStream> pStream(utl::UcbStreamHelper::CreateStream( aFileURL, StreamMode::READ ));
+ if( pStream )
+ {
+ Bitmap aBmp;
+ ReadDIB(aBmp, *pStream, true);
+ Graphic aGraphic(aBmp);
+
+ SbxObjectRef xRef = new SbStdPicture;
+ static_cast<SbStdPicture*>(xRef.get())->SetGraphic( aGraphic );
+ rPar.Get32(0)->PutObject( xRef.get() );
+ }
+}
+
+void SbRtl_SavePicture(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if( rPar.Count32() != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ SbxBase* pObj = rPar.Get32(1)->GetObject();
+ if (SbStdPicture *pPicture = dynamic_cast<SbStdPicture*>(pObj))
+ {
+ SvFileStream aOStream( rPar.Get32(2)->GetOUString(), StreamMode::WRITE | StreamMode::TRUNC );
+ const Graphic& aGraphic = pPicture->GetGraphic();
+ WriteGraphic( aOStream, aGraphic );
+ }
+}
+
+void SbRtl_MsgBox(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32();
+ if( nArgCount < 2 || nArgCount > 6 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ WinBits nType = 0; // MB_OK
+ if( nArgCount >= 3 )
+ nType = static_cast<WinBits>(rPar.Get32(2)->GetInteger());
+ WinBits nStyle = nType;
+ nStyle &= 15; // delete bits 4-16
+ if (nStyle > 5)
+ nStyle = 0;
+
+ enum BasicResponse
+ {
+ Ok = 1,
+ Cancel = 2,
+ Abort = 3,
+ Retry = 4,
+ Ignore = 5,
+ Yes = 6,
+ No = 7
+ };
+
+ OUString aMsg = rPar.Get32(1)->GetOUString();
+ OUString aTitle;
+ if( nArgCount >= 4 )
+ {
+ aTitle = rPar.Get32(3)->GetOUString();
+ }
+ else
+ {
+ aTitle = Application::GetDisplayName();
+ }
+
+ WinBits nDialogType = nType & (16+32+64);
+
+ SolarMutexGuard aSolarGuard;
+ vcl::Window* pParentWin = Application::GetDefDialogParent();
+ weld::Widget* pParent = pParentWin ? pParentWin->GetFrameWeld() : nullptr;
+
+ VclMessageType eType = VclMessageType::Other;
+
+ switch (nDialogType)
+ {
+ case 16:
+ eType = VclMessageType::Error;
+ break;
+ case 32:
+ eType = VclMessageType::Question;
+ break;
+ case 48:
+ eType = VclMessageType::Warning;
+ break;
+ case 64:
+ eType = VclMessageType::Info;
+ break;
+ }
+
+ std::unique_ptr<weld::MessageDialog> xBox(Application::CreateMessageDialog(pParent,
+ eType, VclButtonsType::NONE, aMsg));
+
+ switch (nStyle)
+ {
+ case 0: // MB_OK
+ default:
+ xBox->add_button(GetStandardText(StandardButtonType::OK), BasicResponse::Ok);
+ break;
+ case 1: // MB_OKCANCEL
+ xBox->add_button(GetStandardText(StandardButtonType::OK), BasicResponse::Ok);
+ xBox->add_button(GetStandardText(StandardButtonType::Cancel), BasicResponse::Cancel);
+
+ if (nType & 256 || nType & 512)
+ xBox->set_default_response(BasicResponse::Cancel);
+ else
+ xBox->set_default_response(BasicResponse::Ok);
+
+ break;
+ case 2: // MB_ABORTRETRYIGNORE
+ xBox->add_button(GetStandardText(StandardButtonType::Abort), BasicResponse::Abort);
+ xBox->add_button(GetStandardText(StandardButtonType::Retry), BasicResponse::Retry);
+ xBox->add_button(GetStandardText(StandardButtonType::Ignore), BasicResponse::Ignore);
+
+ if (nType & 256)
+ xBox->set_default_response(BasicResponse::Retry);
+ else if (nType & 512)
+ xBox->set_default_response(BasicResponse::Ignore);
+ else
+ xBox->set_default_response(BasicResponse::Cancel);
+
+ break;
+ case 3: // MB_YESNOCANCEL
+ xBox->add_button(GetStandardText(StandardButtonType::Yes), BasicResponse::Yes);
+ xBox->add_button(GetStandardText(StandardButtonType::No), BasicResponse::No);
+ xBox->add_button(GetStandardText(StandardButtonType::Cancel), BasicResponse::Cancel);
+
+ if (nType & 256 || nType & 512)
+ xBox->set_default_response(BasicResponse::Cancel);
+ else
+ xBox->set_default_response(BasicResponse::Yes);
+
+ break;
+ case 4: // MB_YESNO
+ xBox->add_button(GetStandardText(StandardButtonType::Yes), BasicResponse::Yes);
+ xBox->add_button(GetStandardText(StandardButtonType::No), BasicResponse::No);
+
+ if (nType & 256 || nType & 512)
+ xBox->set_default_response(BasicResponse::No);
+ else
+ xBox->set_default_response(BasicResponse::Yes);
+
+ break;
+ case 5: // MB_RETRYCANCEL
+ xBox->add_button(GetStandardText(StandardButtonType::Retry), BasicResponse::Retry);
+ xBox->add_button(GetStandardText(StandardButtonType::Cancel), BasicResponse::Cancel);
+
+ if (nType & 256 || nType & 512)
+ xBox->set_default_response(BasicResponse::Cancel);
+ else
+ xBox->set_default_response(BasicResponse::Retry);
+
+ break;
+ }
+
+ xBox->set_title(aTitle);
+ sal_Int16 nRet = xBox->run();
+ rPar.Get32(0)->PutInteger(nRet);
+}
+
+void SbRtl_SetAttr(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if ( rPar.Count32() == 3 )
+ {
+ OUString aStr = rPar.Get32(1)->GetOUString();
+ SbAttributes nFlags = static_cast<SbAttributes>( rPar.Get32(2)->GetInteger() );
+
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ bool bReadOnly = bool(nFlags & SbAttributes::READONLY);
+ xSFI->setReadOnly( aStr, bReadOnly );
+ bool bHidden = bool(nFlags & SbAttributes::HIDDEN);
+ xSFI->setHidden( aStr, bHidden );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_Reset(StarBASIC *, SbxArray &, bool)
+{
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ if (pIO)
+ {
+ pIO->CloseAll();
+ }
+}
+
+void SbRtl_DumpAllObjects(StarBASIC * pBasic, SbxArray & rPar, bool)
+{
+ const sal_uInt32 nArgCount = rPar.Count32();
+ if( nArgCount < 2 || nArgCount > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else if( !pBasic )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+ else
+ {
+ SbxObject* p = pBasic;
+ while( p->GetParent() )
+ {
+ p = p->GetParent();
+ }
+ SvFileStream aStrm( rPar.Get32(1)->GetOUString(),
+ StreamMode::WRITE | StreamMode::TRUNC );
+ p->Dump( aStrm, rPar.Get32(2)->GetBool() );
+ aStrm.Close();
+ if( aStrm.GetError() != ERRCODE_NONE )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_IO_ERROR );
+ }
+ }
+}
+
+
+void SbRtl_FileExists(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() == 2 )
+ {
+ OUString aStr = rPar.Get32(1)->GetOUString();
+ bool bExists = false;
+
+ if( hasUno() )
+ {
+ const uno::Reference< ucb::XSimpleFileAccess3 >& xSFI = getFileAccess();
+ if( xSFI.is() )
+ {
+ try
+ {
+ bExists = xSFI->exists( aStr );
+ }
+ catch(const Exception & )
+ {
+ StarBASIC::Error( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ else
+ {
+ DirectoryItem aItem;
+ FileBase::RC nRet = DirectoryItem::get( getFullPath( aStr ), aItem );
+ bExists = (nRet == FileBase::E_None);
+ }
+ rPar.Get32(0)->PutBool( bExists );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_Partition(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ sal_Int32 nNumber = rPar.Get32(1)->GetLong();
+ sal_Int32 nStart = rPar.Get32(2)->GetLong();
+ sal_Int32 nStop = rPar.Get32(3)->GetLong();
+ sal_Int32 nInterval = rPar.Get32(4)->GetLong();
+
+ if( nStart < 0 || nStop <= nStart || nInterval < 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // the Partition function inserts leading spaces before lowervalue and uppervalue
+ // so that they both have the same number of characters as the string
+ // representation of the value (Stop + 1). This ensures that if you use the output
+ // of the Partition function with several values of Number, the resulting text
+ // will be handled properly during any subsequent sort operation.
+
+ // calculate the maximum number of characters before lowervalue and uppervalue
+ OUString aBeforeStart = OUString::number( nStart - 1 );
+ OUString aAfterStop = OUString::number( nStop + 1 );
+ sal_Int32 nLen1 = aBeforeStart.getLength();
+ sal_Int32 nLen2 = aAfterStop.getLength();
+ sal_Int32 nLen = nLen1 >= nLen2 ? nLen1:nLen2;
+
+ OUStringBuffer aRetStr( nLen * 2 + 1);
+ OUString aLowerValue;
+ OUString aUpperValue;
+ if( nNumber < nStart )
+ {
+ aUpperValue = aBeforeStart;
+ }
+ else if( nNumber > nStop )
+ {
+ aLowerValue = aAfterStop;
+ }
+ else
+ {
+ sal_Int32 nLowerValue = nNumber;
+ sal_Int32 nUpperValue = nLowerValue;
+ if( nInterval > 1 )
+ {
+ nLowerValue = ((( nNumber - nStart ) / nInterval ) * nInterval ) + nStart;
+ nUpperValue = nLowerValue + nInterval - 1;
+ }
+ aLowerValue = OUString::number( nLowerValue );
+ aUpperValue = OUString::number( nUpperValue );
+ }
+
+ nLen1 = aLowerValue.getLength();
+ nLen2 = aUpperValue.getLength();
+
+ if( nLen > nLen1 )
+ {
+ // appending the leading spaces for the lowervalue
+ for ( sal_Int32 i= nLen - nLen1; i > 0; --i )
+ {
+ aRetStr.append(" ");
+ }
+ }
+ aRetStr.append( aLowerValue ).append(":");
+ if( nLen > nLen2 )
+ {
+ // appending the leading spaces for the uppervalue
+ for ( sal_Int32 i= nLen - nLen2; i > 0; --i )
+ {
+ aRetStr.append(" ");
+ }
+ }
+ aRetStr.append( aUpperValue );
+ rPar.Get32(0)->PutString( aRetStr.makeStringAndClear());
+}
+
+#endif
+
+static long GetDayDiff( const Date& rDate )
+{
+ Date aRefDate( 1,1,1900 );
+ long nDiffDays;
+ if ( aRefDate > rDate )
+ {
+ nDiffDays = aRefDate - rDate;
+ nDiffDays *= -1;
+ }
+ else
+ {
+ nDiffDays = rDate - aRefDate;
+ }
+ nDiffDays += 2; // adjustment VisualBasic: 1.Jan.1900 == 2
+ return nDiffDays;
+}
+
+sal_Int16 implGetDateYear( double aDate )
+{
+ Date aRefDate( 1,1,1900 );
+ long nDays = static_cast<long>(aDate);
+ nDays -= 2; // standardize: 1.1.1900 => 0.0
+ aRefDate.AddDays( nDays );
+ sal_Int16 nRet = aRefDate.GetYear();
+ return nRet;
+}
+
+bool implDateSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay,
+ bool bUseTwoDigitYear, SbDateCorrection eCorr, double& rdRet )
+{
+ // XXX NOTE: For VBA years<0 are invalid and years in the range 0..29 and
+ // 30..99 can not be input as they are 2-digit for 2000..2029 and
+ // 1930..1999, VBA mode overrides bUseTwoDigitYear (as if that was always
+ // true). For VBA years > 9999 are invalid.
+ // For StarBASIC, if bUseTwoDigitYear==true then years in the range 0..99
+ // can not be input as they are 2-digit for 1900..1999, years<0 are
+ // accepted. If bUseTwoDigitYear==false then all years are accepted, but
+ // year 0 is invalid (last day BCE -0001-12-31, first day CE 0001-01-01).
+#if HAVE_FEATURE_SCRIPTING
+ if ( (nYear < 0 || 9999 < nYear) && SbiRuntime::isVBAEnabled() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return false;
+ }
+ else if ( nYear < 30 && SbiRuntime::isVBAEnabled() )
+ {
+ nYear += 2000;
+ }
+ else
+#endif
+ {
+ if ( 0 <= nYear && nYear < 100 && (bUseTwoDigitYear
+#if HAVE_FEATURE_SCRIPTING
+ || SbiRuntime::isVBAEnabled()
+#endif
+ ) )
+ {
+ nYear += 1900;
+ }
+ }
+
+ sal_Int32 nAddMonths = 0;
+ sal_Int32 nAddDays = 0;
+ // Always sanitize values to set date and to use for validity detection.
+ if (nMonth < 1 || 12 < nMonth)
+ {
+ sal_Int16 nM = ((nMonth < 1) ? (12 + (nMonth % 12)) : (nMonth % 12));
+ nAddMonths = nMonth - nM;
+ nMonth = nM;
+ }
+ // Day 0 would already be normalized during Date::Normalize(), include
+ // it in negative days, also to detect non-validity. The actual day of
+ // month is 1+(nDay-1)
+ if (nDay < 1)
+ {
+ nAddDays = nDay - 1;
+ nDay = 1;
+ }
+ else if (nDay > 31)
+ {
+ nAddDays = nDay - 31;
+ nDay = 31;
+ }
+
+ Date aCurDate( nDay, nMonth, nYear );
+
+ /* TODO: we could enable the same rollover mechanism for StarBASIC to be
+ * compatible with VBA (just with our wider supported date range), then
+ * documentation would need to be adapted. As is, the DateSerial() runtime
+ * function works as dumb as documented... (except that the resulting date
+ * is checked for validity now and not just day<=31 and month<=12).
+ * If change wanted then simply remove overriding RollOver here and adapt
+ * documentation.*/
+#if HAVE_FEATURE_SCRIPTING
+ if (eCorr == SbDateCorrection::RollOver && !SbiRuntime::isVBAEnabled())
+ eCorr = SbDateCorrection::None;
+#endif
+
+ if (nYear == 0 || (eCorr == SbDateCorrection::None && (nAddMonths || nAddDays || !aCurDate.IsValidDate())))
+ {
+#if HAVE_FEATURE_SCRIPTING
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+#endif
+ return false;
+ }
+
+ if (eCorr != SbDateCorrection::None)
+ {
+ aCurDate.Normalize();
+ if (nAddMonths)
+ aCurDate.AddMonths( nAddMonths);
+ if (nAddDays)
+ aCurDate.AddDays( nAddDays);
+ if (eCorr == SbDateCorrection::TruncateToMonth && aCurDate.GetMonth() != nMonth)
+ {
+ if (aCurDate.GetYear() == SAL_MAX_INT16 && nMonth == 12)
+ {
+ // Roll over and back not possible, hard max.
+ aCurDate.SetMonth(12);
+ aCurDate.SetDay(31);
+ }
+ else
+ {
+ aCurDate.SetMonth(nMonth);
+ aCurDate.SetDay(1);
+ aCurDate.AddMonths(1);
+ aCurDate.AddDays(-1);
+ }
+ }
+ }
+
+ long nDiffDays = GetDayDiff( aCurDate );
+ rdRet = static_cast<double>(nDiffDays);
+ return true;
+}
+
+double implTimeSerial( sal_Int16 nHours, sal_Int16 nMinutes, sal_Int16 nSeconds )
+{
+ return
+ static_cast<double>( nHours * ::tools::Time::secondPerHour +
+ nMinutes * ::tools::Time::secondPerMinute +
+ nSeconds)
+ /
+ static_cast<double>( ::tools::Time::secondPerDay );
+}
+
+bool implDateTimeSerial( sal_Int16 nYear, sal_Int16 nMonth, sal_Int16 nDay,
+ sal_Int16 nHour, sal_Int16 nMinute, sal_Int16 nSecond,
+ double& rdRet )
+{
+ double dDate;
+ if(!implDateSerial(nYear, nMonth, nDay, false/*bUseTwoDigitYear*/, SbDateCorrection::None, dDate))
+ return false;
+ rdRet += dDate + implTimeSerial(nHour, nMinute, nSecond);
+ return true;
+}
+
+sal_Int16 implGetMinute( double dDate )
+{
+ double nFrac = dDate - floor( dDate );
+ nFrac *= 86400.0;
+ sal_Int32 nSeconds = static_cast<sal_Int32>(nFrac + 0.5);
+ sal_Int16 nTemp = static_cast<sal_Int16>(nSeconds % 3600);
+ sal_Int16 nMin = nTemp / 60;
+ return nMin;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/methods1.cxx b/basic/source/runtime/methods1.cxx
new file mode 100644
index 000000000..75f273042
--- /dev/null
+++ b/basic/source/runtime/methods1.cxx
@@ -0,0 +1,3066 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+
+#include <sal/config.h>
+#include <config_version.h>
+
+#include <cstddef>
+
+#include <stdlib.h>
+#include <vcl/svapp.hxx>
+#include <vcl/mapmod.hxx>
+#include <vcl/outdev.hxx>
+#include <vcl/timer.hxx>
+#include <vcl/settings.hxx>
+#include <basic/sbxvar.hxx>
+#include <basic/sbx.hxx>
+#include <svl/zforlist.hxx>
+#include <tools/urlobj.hxx>
+#include <tools/fract.hxx>
+#include <o3tl/temporary.hxx>
+#include <osl/file.hxx>
+#include <sbobjmod.hxx>
+#include <basic/sbuno.hxx>
+
+#include <date.hxx>
+#include <sbintern.hxx>
+#include <runtime.hxx>
+#include <rtlproto.hxx>
+#include "dllmgr.hxx"
+#include <iosys.hxx>
+#include <sbunoobj.hxx>
+#include <propacc.hxx>
+#include <sal/log.hxx>
+#include <eventatt.hxx>
+
+#include <comphelper/processfactory.hxx>
+#include <comphelper/string.hxx>
+
+#include <com/sun/star/uno/Sequence.hxx>
+#include <com/sun/star/lang/XMultiServiceFactory.hpp>
+#include <com/sun/star/i18n/LocaleCalendar2.hpp>
+#include <com/sun/star/sheet/XFunctionAccess.hpp>
+#include <memory>
+
+using namespace comphelper;
+using namespace com::sun::star::i18n;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::sheet;
+using namespace com::sun::star::uno;
+
+static Reference< XCalendar4 > const & getLocaleCalendar()
+{
+ static Reference< XCalendar4 > xCalendar = LocaleCalendar2::create(getProcessComponentContext());
+ static css::lang::Locale aLastLocale;
+ static bool bNeedsInit = true;
+
+ css::lang::Locale aLocale = Application::GetSettings().GetLanguageTag().getLocale();
+ bool bNeedsReload = false;
+ if( bNeedsInit )
+ {
+ bNeedsInit = false;
+ bNeedsReload = true;
+ }
+ else if( aLocale.Language != aLastLocale.Language ||
+ aLocale.Country != aLastLocale.Country ||
+ aLocale.Variant != aLastLocale.Variant )
+ {
+ bNeedsReload = true;
+ }
+ if( bNeedsReload )
+ {
+ aLastLocale = aLocale;
+ xCalendar->loadDefaultCalendar( aLocale );
+ }
+ return xCalendar;
+}
+
+#if HAVE_FEATURE_SCRIPTING
+
+void SbRtl_CallByName(StarBASIC *, SbxArray & rPar, bool)
+{
+ const sal_Int16 vbGet = 2;
+ const sal_Int16 vbLet = 4;
+ const sal_Int16 vbMethod = 1;
+ const sal_Int16 vbSet = 8;
+
+ // At least 3 parameter needed plus function itself -> 4
+ sal_uInt32 nParCount = rPar.Count32();
+ if ( nParCount < 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // 1. parameter is object
+ SbxBase* pObjVar = rPar.Get32(1)->GetObject();
+ SbxObject* pObj = nullptr;
+ if( pObjVar )
+ pObj = dynamic_cast<SbxObject*>( pObjVar );
+ if( !pObj && dynamic_cast<const SbxVariable*>( pObjVar) )
+ {
+ SbxBase* pObjVarObj = static_cast<SbxVariable*>(pObjVar)->GetObject();
+ pObj = dynamic_cast<SbxObject*>( pObjVarObj );
+ }
+ if( !pObj )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_PARAMETER );
+ return;
+ }
+
+ // 2. parameter is ProcedureName
+ OUString aNameStr = rPar.Get32(2)->GetOUString();
+
+ // 3. parameter is CallType
+ sal_Int16 nCallType = rPar.Get32(3)->GetInteger();
+
+ //SbxObject* pFindObj = NULL;
+ SbxVariable* pFindVar = pObj->Find( aNameStr, SbxClassType::DontCare );
+ if( pFindVar == nullptr )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROC_UNDEFINED );
+ return;
+ }
+
+ switch( nCallType )
+ {
+ case vbGet:
+ {
+ SbxValues aVals;
+ aVals.eType = SbxVARIANT;
+ pFindVar->Get( aVals );
+
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->Put( aVals );
+ }
+ break;
+ case vbLet:
+ case vbSet:
+ {
+ if ( nParCount != 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ SbxVariableRef pValVar = rPar.Get32(4);
+ if( nCallType == vbLet )
+ {
+ SbxValues aVals;
+ aVals.eType = SbxVARIANT;
+ pValVar->Get( aVals );
+ pFindVar->Put( aVals );
+ }
+ else
+ {
+ SbxVariableRef rFindVar = pFindVar;
+ SbiInstance* pInst = GetSbData()->pInst;
+ SbiRuntime* pRT = pInst ? pInst->pRun : nullptr;
+ if( pRT != nullptr )
+ {
+ pRT->StepSET_Impl( pValVar, rFindVar );
+ }
+ }
+ }
+ break;
+ case vbMethod:
+ {
+ SbMethod* pMeth = dynamic_cast<SbMethod*>( pFindVar );
+ if( pMeth == nullptr )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROC_UNDEFINED );
+ return;
+ }
+
+ // Setup parameters
+ SbxArrayRef xArray;
+ sal_uInt32 nMethParamCount = nParCount - 4;
+ if( nMethParamCount > 0 )
+ {
+ xArray = new SbxArray;
+ for( sal_uInt32 i = 0 ; i < nMethParamCount ; i++ )
+ {
+ SbxVariable* pPar = rPar.Get32( i + 4 );
+ xArray->Put32( pPar, i + 1 );
+ }
+ }
+
+ // Call method
+ SbxVariableRef refVar = rPar.Get32(0);
+ if( xArray.is() )
+ pMeth->SetParameters( xArray.get() );
+ pMeth->Call( refVar.get() );
+ pMeth->SetParameters( nullptr );
+ }
+ break;
+ default:
+ StarBASIC::Error( ERRCODE_BASIC_PROC_UNDEFINED );
+ }
+}
+
+void SbRtl_CBool(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ bool bVal = false;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ bVal = pSbxVariable->GetBool();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutBool(bVal);
+}
+
+void SbRtl_CByte(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ sal_uInt8 nByte = 0;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ nByte = pSbxVariable->GetByte();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutByte(nByte);
+}
+
+void SbRtl_CCur(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_Int64 nCur = 0;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ nCur = pSbxVariable->GetCurrency();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutCurrency( nCur );
+}
+
+void SbRtl_CDec(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
+{
+ (void)pBasic;
+ (void)bWrite;
+
+#ifdef _WIN32
+ SbxDecimal* pDec = nullptr;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ pDec = pSbxVariable->GetDecimal();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutDecimal( pDec );
+#else
+ rPar.Get32(0)->PutEmpty();
+ StarBASIC::Error(ERRCODE_BASIC_NOT_IMPLEMENTED);
+#endif
+}
+
+void SbRtl_CDate(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ double nVal = 0.0;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ nVal = pSbxVariable->GetDate();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutDate(nVal);
+}
+
+void SbRtl_CDbl(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ double nVal = 0.0;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ if( pSbxVariable->GetType() == SbxSTRING )
+ {
+ // #41690
+ OUString aScanStr = pSbxVariable->GetOUString();
+ ErrCode Error = SbxValue::ScanNumIntnl( aScanStr, nVal );
+ if( Error != ERRCODE_NONE )
+ {
+ StarBASIC::Error( Error );
+ }
+ }
+ else
+ {
+ nVal = pSbxVariable->GetDouble();
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+
+ rPar.Get32(0)->PutDouble(nVal);
+}
+
+void SbRtl_CInt(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ sal_Int16 nVal = 0;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ nVal = pSbxVariable->GetInteger();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutInteger(nVal);
+}
+
+void SbRtl_CLng(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ sal_Int32 nVal = 0;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ nVal = pSbxVariable->GetLong();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutLong(nVal);
+}
+
+void SbRtl_CSng(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ float nVal = float(0.0);
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ if( pSbxVariable->GetType() == SbxSTRING )
+ {
+ // #41690
+ double dVal = 0.0;
+ OUString aScanStr = pSbxVariable->GetOUString();
+ ErrCode Error = SbxValue::ScanNumIntnl( aScanStr, dVal, /*bSingle=*/true );
+ if( SbxBase::GetError() == ERRCODE_NONE && Error != ERRCODE_NONE )
+ {
+ StarBASIC::Error( Error );
+ }
+ nVal = static_cast<float>(dVal);
+ }
+ else
+ {
+ nVal = pSbxVariable->GetSingle();
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutSingle(nVal);
+}
+
+void SbRtl_CStr(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ OUString aString;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ aString = pSbxVariable->GetOUString();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutString(aString);
+}
+
+void SbRtl_CVar(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ SbxValues aVals( SbxVARIANT );
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ pSbxVariable->Get( aVals );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->Put( aVals );
+}
+
+void SbRtl_CVErr(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_Int16 nErrCode = 0;
+ if ( rPar.Count32() == 2 )
+ {
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ nErrCode = pSbxVariable->GetInteger();
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ rPar.Get32(0)->PutErr( nErrCode );
+}
+
+void SbRtl_Iif(StarBASIC *, SbxArray & rPar, bool) // JSM
+{
+ if ( rPar.Count32() == 4 )
+ {
+ if (rPar.Get32(1)->GetBool())
+ {
+ *rPar.Get32(0) = *rPar.Get32(2);
+ }
+ else
+ {
+ *rPar.Get32(0) = *rPar.Get32(3);
+ }
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_GetSystemType(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // Removed for SRC595
+ rPar.Get32(0)->PutInteger( -1 );
+ }
+}
+
+void SbRtl_GetGUIType(StarBASIC * pBasic, SbxArray & rPar, bool bWrite)
+{
+ (void)pBasic;
+ (void)bWrite;
+
+ if ( rPar.Count32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // 17.7.2000 Make simple solution for testtool / fat office
+#if defined(_WIN32)
+ rPar.Get32(0)->PutInteger( 1 );
+#elif defined(UNX)
+ rPar.Get32(0)->PutInteger( 4 );
+#else
+ rPar.Get32(0)->PutInteger( -1 );
+#endif
+ }
+}
+
+void SbRtl_Red(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int32 nRGB = rPar.Get32(1)->GetLong();
+ nRGB &= 0x00FF0000;
+ nRGB >>= 16;
+ rPar.Get32(0)->PutInteger( static_cast<sal_Int16>(nRGB) );
+ }
+}
+
+void SbRtl_Green(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int32 nRGB = rPar.Get32(1)->GetLong();
+ nRGB &= 0x0000FF00;
+ nRGB >>= 8;
+ rPar.Get32(0)->PutInteger( static_cast<sal_Int16>(nRGB) );
+ }
+}
+
+void SbRtl_Blue(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ sal_Int32 nRGB = rPar.Get32(1)->GetLong();
+ nRGB &= 0x000000FF;
+ rPar.Get32(0)->PutInteger( static_cast<sal_Int16>(nRGB) );
+ }
+}
+
+
+void SbRtl_Switch(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nCount = rPar.Count32();
+ if( !(nCount & 0x0001 ))
+ {
+ // number of arguments must be odd
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ sal_uInt32 nCurExpr = 1;
+ while( nCurExpr < (nCount-1) )
+ {
+ if( rPar.Get32( nCurExpr )->GetBool())
+ {
+ (*rPar.Get32(0)) = *(rPar.Get32(nCurExpr+1));
+ return;
+ }
+ nCurExpr += 2;
+ }
+ rPar.Get32(0)->PutNull();
+}
+
+//i#64882# Common wait impl for existing Wait and new WaitUntil
+// rtl functions
+void Wait_Impl( bool bDurationBased, SbxArray& rPar )
+{
+ if( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ long nWait = 0;
+ if ( bDurationBased )
+ {
+ double dWait = rPar.Get32(1)->GetDouble();
+ double dNow = Now_Impl();
+ double dSecs = ( dWait - dNow ) * 24.0 * 3600.0;
+ nWait = static_cast<long>( dSecs * 1000 ); // wait in thousands of sec
+ }
+ else
+ {
+ nWait = rPar.Get32(1)->GetLong();
+ }
+ if( nWait < 0 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ Timer aTimer;
+ aTimer.SetTimeout( nWait );
+ aTimer.Start();
+ while ( aTimer.IsActive() )
+ {
+ Application::Yield();
+ }
+}
+
+//i#64882#
+void SbRtl_Wait(StarBASIC *, SbxArray & rPar, bool)
+{
+ Wait_Impl( false, rPar );
+}
+
+//i#64882# add new WaitUntil ( for application.wait )
+// share wait_impl with 'normal' oobasic wait
+void SbRtl_WaitUntil(StarBASIC *, SbxArray & rPar, bool)
+{
+ Wait_Impl( true, rPar );
+}
+
+void SbRtl_DoEvents(StarBASIC *, SbxArray & rPar, bool)
+{
+// don't understand what upstream are up to
+// we already process application events etc. in between
+// basic runtime pcode ( on a timed basis )
+ // always return 0
+ rPar.Get32(0)->PutInteger( 0 );
+ Application::Reschedule( true );
+}
+
+void SbRtl_GetGUIVersion(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ // Removed for SRC595
+ rPar.Get32(0)->PutLong( -1 );
+ }
+}
+
+void SbRtl_Choose(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ sal_Int16 nIndex = rPar.Get32(1)->GetInteger();
+ sal_uInt32 nCount = rPar.Count32();
+ nCount--;
+ if( nCount == 1 || nIndex > sal::static_int_cast<sal_Int16>(nCount-1) || nIndex < 1 )
+ {
+ rPar.Get32(0)->PutNull();
+ return;
+ }
+ (*rPar.Get32(0)) = *(rPar.Get32(nIndex+1));
+}
+
+
+void SbRtl_Trim(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ OUString aStr(comphelper::string::strip(rPar.Get32(1)->GetOUString(), ' '));
+ rPar.Get32(0)->PutString(aStr);
+ }
+}
+
+void SbRtl_GetSolarVersion(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutLong( LIBO_VERSION_MAJOR * 10000 + LIBO_VERSION_MINOR * 100 + LIBO_VERSION_MICRO * 1);
+}
+
+void SbRtl_TwipsPerPixelX(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_Int32 nResult = 0;
+ Size aSize( 100,0 );
+ MapMode aMap( MapUnit::MapTwip );
+ OutputDevice* pDevice = Application::GetDefaultDevice();
+ if( pDevice )
+ {
+ aSize = pDevice->PixelToLogic( aSize, aMap );
+ nResult = aSize.Width() / 100;
+ }
+ rPar.Get32(0)->PutLong( nResult );
+}
+
+void SbRtl_TwipsPerPixelY(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_Int32 nResult = 0;
+ Size aSize( 0,100 );
+ MapMode aMap( MapUnit::MapTwip );
+ OutputDevice* pDevice = Application::GetDefaultDevice();
+ if( pDevice )
+ {
+ aSize = pDevice->PixelToLogic( aSize, aMap );
+ nResult = aSize.Height() / 100;
+ }
+ rPar.Get32(0)->PutLong( nResult );
+}
+
+
+void SbRtl_FreeLibrary(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ GetSbData()->pInst->GetDllMgr()->FreeDll( rPar.Get32(1)->GetOUString() );
+}
+bool IsBaseIndexOne()
+{
+ bool bResult = false;
+ if ( GetSbData()->pInst && GetSbData()->pInst->pRun )
+ {
+ sal_uInt16 res = GetSbData()->pInst->pRun->GetBase();
+ if ( res )
+ {
+ bResult = true;
+ }
+ }
+ return bResult;
+}
+
+void SbRtl_Array(StarBASIC *, SbxArray & rPar, bool)
+{
+ SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
+ sal_uInt32 nArraySize = rPar.Count32() - 1;
+
+ // ignore Option Base so far (unfortunately only known by the compiler)
+ bool bIncIndex = (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() );
+ if( nArraySize )
+ {
+ if ( bIncIndex )
+ {
+ pArray->AddDim32( 1, sal::static_int_cast<sal_Int32>(nArraySize) );
+ }
+ else
+ {
+ pArray->AddDim32( 0, sal::static_int_cast<sal_Int32>(nArraySize) - 1 );
+ }
+ }
+ else
+ {
+ pArray->unoAddDim32( 0, -1 );
+ }
+
+ // insert parameters into the array
+ for( sal_uInt32 i = 0 ; i < nArraySize ; i++ )
+ {
+ SbxVariable* pVar = rPar.Get32(i+1);
+ SbxVariable* pNew = new SbxEnsureParentVariable(*pVar);
+ pNew->SetFlag( SbxFlagBits::Write );
+ sal_Int32 aIdx[1];
+ aIdx[0] = static_cast<sal_Int32>(i);
+ if ( bIncIndex )
+ {
+ ++aIdx[0];
+ }
+ pArray->Put32(pNew, aIdx);
+ }
+
+ // return array
+ SbxVariableRef refVar = rPar.Get32(0);
+ SbxFlagBits nFlags = refVar->GetFlags();
+ refVar->ResetFlag( SbxFlagBits::Fixed );
+ refVar->PutObject( pArray );
+ refVar->SetFlags( nFlags );
+ refVar->SetParameters( nullptr );
+}
+
+
+// Featurewish #57868
+// The function returns a variant-array; if there are no parameters passed,
+// an empty array is created (according to dim a(); equal to a sequence of
+// the length 0 in Uno).
+// If there are parameters passed, there's a dimension created for each of
+// them; DimArray( 2, 2, 4 ) is equal to DIM a( 2, 2, 4 )
+// the array is always of the type variant
+void SbRtl_DimArray(StarBASIC *, SbxArray & rPar, bool)
+{
+ SbxDimArray * pArray = new SbxDimArray( SbxVARIANT );
+ sal_uInt32 nArrayDims = rPar.Count32() - 1;
+ if( nArrayDims > 0 )
+ {
+ for( sal_uInt32 i = 0; i < nArrayDims ; i++ )
+ {
+ sal_Int32 ub = rPar.Get32(i+1)->GetLong();
+ if( ub < 0 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ ub = 0;
+ }
+ pArray->AddDim32( 0, ub );
+ }
+ }
+ else
+ {
+ pArray->unoAddDim32( 0, -1 );
+ }
+ SbxVariableRef refVar = rPar.Get32(0);
+ SbxFlagBits nFlags = refVar->GetFlags();
+ refVar->ResetFlag( SbxFlagBits::Fixed );
+ refVar->PutObject( pArray );
+ refVar->SetFlags( nFlags );
+ refVar->SetParameters( nullptr );
+}
+
+/*
+ * FindObject and FindPropertyObject make it possible to
+ * address objects and properties of the type Object with
+ * their name as string-parameters at the runtime.
+ *
+ * Example:
+ * MyObj.Prop1.Bla = 5
+ *
+ * is equal to:
+ * dim ObjVar as Object
+ * dim ObjProp as Object
+ * ObjName$ = "MyObj"
+ * ObjVar = FindObject( ObjName$ )
+ * PropName$ = "Prop1"
+ * ObjProp = FindPropertyObject( ObjVar, PropName$ )
+ * ObjProp.Bla = 5
+ *
+ * The names can be created dynamically at the runtime
+ * so that e. g. via controls "TextEdit1" to "TextEdit5"
+ * can be iterated in a dialog in a loop.
+ */
+
+
+// 1st parameter = the object's name as string
+void SbRtl_FindObject(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aNameStr = rPar.Get32(1)->GetOUString();
+
+ SbxBase* pFind = StarBASIC::FindSBXInCurrentScope( aNameStr );
+ SbxObject* pFindObj = nullptr;
+ if( pFind )
+ {
+ pFindObj = dynamic_cast<SbxObject*>( pFind );
+ }
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutObject( pFindObj );
+}
+
+// address object-property in an object
+// 1st parameter = object
+// 2nd parameter = the property's name as string
+void SbRtl_FindPropertyObject(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ SbxBase* pObjVar = rPar.Get32(1)->GetObject();
+ SbxObject* pObj = nullptr;
+ if( pObjVar )
+ {
+ pObj = dynamic_cast<SbxObject*>( pObjVar );
+ }
+ if( !pObj && dynamic_cast<const SbxVariable*>( pObjVar) )
+ {
+ SbxBase* pObjVarObj = static_cast<SbxVariable*>(pObjVar)->GetObject();
+ pObj = dynamic_cast<SbxObject*>( pObjVarObj );
+ }
+
+ OUString aNameStr = rPar.Get32(2)->GetOUString();
+
+ SbxObject* pFindObj = nullptr;
+ if( pObj )
+ {
+ SbxVariable* pFindVar = pObj->Find( aNameStr, SbxClassType::Object );
+ pFindObj = dynamic_cast<SbxObject*>( pFindVar );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_PARAMETER );
+ }
+
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutObject( pFindObj );
+}
+
+
+static bool lcl_WriteSbxVariable( const SbxVariable& rVar, SvStream* pStrm,
+ bool bBinary, short nBlockLen, bool bIsArray )
+{
+ sal_uInt64 const nFPos = pStrm->Tell();
+
+ bool bIsVariant = !rVar.IsFixed();
+ SbxDataType eType = rVar.GetType();
+
+ switch( eType )
+ {
+ case SbxBOOL:
+ case SbxCHAR:
+ case SbxBYTE:
+ if( bIsVariant )
+ {
+ pStrm->WriteUInt16( SbxBYTE ); // VarType Id
+ }
+ pStrm->WriteUChar( rVar.GetByte() );
+ break;
+
+ case SbxEMPTY:
+ case SbxNULL:
+ case SbxVOID:
+ case SbxINTEGER:
+ case SbxUSHORT:
+ case SbxINT:
+ case SbxUINT:
+ if( bIsVariant )
+ {
+ pStrm->WriteUInt16( SbxINTEGER ); // VarType Id
+ }
+ pStrm->WriteInt16( rVar.GetInteger() );
+ break;
+
+ case SbxLONG:
+ case SbxULONG:
+ if( bIsVariant )
+ {
+ pStrm->WriteUInt16( SbxLONG ); // VarType Id
+ }
+ pStrm->WriteInt32( rVar.GetLong() );
+ break;
+ case SbxSALINT64:
+ case SbxSALUINT64:
+ if( bIsVariant )
+ {
+ pStrm->WriteUInt16( SbxSALINT64 ); // VarType Id
+ }
+ pStrm->WriteUInt64( rVar.GetInt64() );
+ break;
+ case SbxSINGLE:
+ if( bIsVariant )
+ {
+ pStrm->WriteUInt16( eType ); // VarType Id
+ }
+ pStrm->WriteFloat( rVar.GetSingle() );
+ break;
+
+ case SbxDOUBLE:
+ case SbxCURRENCY:
+ case SbxDATE:
+ if( bIsVariant )
+ {
+ pStrm->WriteUInt16( eType ); // VarType Id
+ }
+ pStrm->WriteDouble( rVar.GetDouble() );
+ break;
+
+ case SbxSTRING:
+ case SbxLPSTR:
+ {
+ const OUString& rStr = rVar.GetOUString();
+ if( !bBinary || bIsArray )
+ {
+ if( bIsVariant )
+ {
+ pStrm->WriteUInt16( SbxSTRING );
+ }
+ pStrm->WriteUniOrByteString( rStr, osl_getThreadTextEncoding() );
+ }
+ else
+ {
+ // without any length information! without end-identifier!
+ // What does that mean for Unicode?! Choosing conversion to ByteString...
+ OString aByteStr(OUStringToOString(rStr, osl_getThreadTextEncoding()));
+ pStrm->WriteOString( aByteStr );
+ }
+ }
+ break;
+
+ default:
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return false;
+ }
+
+ if( nBlockLen )
+ {
+ pStrm->Seek( nFPos + nBlockLen );
+ }
+ return pStrm->GetErrorCode() == ERRCODE_NONE;
+}
+
+static bool lcl_ReadSbxVariable( SbxVariable& rVar, SvStream* pStrm,
+ bool bBinary, short nBlockLen )
+{
+ double aDouble;
+
+ sal_uInt64 const nFPos = pStrm->Tell();
+
+ bool bIsVariant = !rVar.IsFixed();
+ SbxDataType eVarType = rVar.GetType();
+
+ SbxDataType eSrcType = eVarType;
+ if( bIsVariant )
+ {
+ sal_uInt16 nTemp;
+ pStrm->ReadUInt16( nTemp );
+ eSrcType = static_cast<SbxDataType>(nTemp);
+ }
+
+ switch( eSrcType )
+ {
+ case SbxBOOL:
+ case SbxCHAR:
+ case SbxBYTE:
+ {
+ sal_uInt8 aByte;
+ pStrm->ReadUChar( aByte );
+
+ if( bBinary && SbiRuntime::isVBAEnabled() && aByte == 1 && pStrm->eof() )
+ {
+ aByte = 0;
+ }
+ rVar.PutByte( aByte );
+ }
+ break;
+
+ case SbxEMPTY:
+ case SbxNULL:
+ case SbxVOID:
+ case SbxINTEGER:
+ case SbxUSHORT:
+ case SbxINT:
+ case SbxUINT:
+ {
+ sal_Int16 aInt;
+ pStrm->ReadInt16( aInt );
+ rVar.PutInteger( aInt );
+ }
+ break;
+
+ case SbxLONG:
+ case SbxULONG:
+ {
+ sal_Int32 aInt;
+ pStrm->ReadInt32( aInt );
+ rVar.PutLong( aInt );
+ }
+ break;
+ case SbxSALINT64:
+ case SbxSALUINT64:
+ {
+ sal_uInt32 aInt;
+ pStrm->ReadUInt32( aInt );
+ rVar.PutInt64( static_cast<sal_Int64>(aInt) );
+ }
+ break;
+ case SbxSINGLE:
+ {
+ float nS;
+ pStrm->ReadFloat( nS );
+ rVar.PutSingle( nS );
+ }
+ break;
+
+ case SbxDOUBLE:
+ case SbxCURRENCY:
+ {
+ pStrm->ReadDouble( aDouble );
+ rVar.PutDouble( aDouble );
+ }
+ break;
+
+ case SbxDATE:
+ {
+ pStrm->ReadDouble( aDouble );
+ rVar.PutDate( aDouble );
+ }
+ break;
+
+ case SbxSTRING:
+ case SbxLPSTR:
+ {
+ OUString aStr = pStrm->ReadUniOrByteString(osl_getThreadTextEncoding());
+ rVar.PutString( aStr );
+ }
+ break;
+
+ default:
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return false;
+ }
+
+ if( nBlockLen )
+ {
+ pStrm->Seek( nFPos + nBlockLen );
+ }
+ return pStrm->GetErrorCode() == ERRCODE_NONE;
+}
+
+
+// nCurDim = 1...n
+static bool lcl_WriteReadSbxArray( SbxDimArray& rArr, SvStream* pStrm,
+ bool bBinary, sal_Int32 nCurDim, sal_Int32* pOtherDims, bool bWrite )
+{
+ SAL_WARN_IF( nCurDim <= 0,"basic", "Bad Dim");
+ sal_Int32 nLower, nUpper;
+ if( !rArr.GetDim32( nCurDim, nLower, nUpper ) )
+ return false;
+ for(sal_Int32 nCur = nLower; nCur <= nUpper; nCur++ )
+ {
+ pOtherDims[ nCurDim-1 ] = nCur;
+ if( nCurDim != 1 )
+ lcl_WriteReadSbxArray(rArr, pStrm, bBinary, nCurDim-1, pOtherDims, bWrite);
+ else
+ {
+ SbxVariable* pVar = rArr.Get32( pOtherDims );
+ bool bRet;
+ if( bWrite )
+ bRet = lcl_WriteSbxVariable(*pVar, pStrm, bBinary, 0, true );
+ else
+ bRet = lcl_ReadSbxVariable(*pVar, pStrm, bBinary, 0 );
+ if( !bRet )
+ return false;
+ }
+ }
+ return true;
+}
+
+static void PutGet( SbxArray& rPar, bool bPut )
+{
+ if ( rPar.Count32() != 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ sal_Int16 nFileNo = rPar.Get32(1)->GetInteger();
+ SbxVariable* pVar2 = rPar.Get32(2);
+ SbxDataType eType2 = pVar2->GetType();
+ bool bHasRecordNo = (eType2 != SbxEMPTY && eType2 != SbxERROR);
+ long nRecordNo = pVar2->GetLong();
+ if ( nFileNo < 1 || ( bHasRecordNo && nRecordNo < 1 ) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ nRecordNo--;
+ SbiIoSystem* pIO = GetSbData()->pInst->GetIoSystem();
+ SbiStream* pSbStrm = pIO->GetStream( nFileNo );
+
+ if ( !pSbStrm || !(pSbStrm->GetMode() & (SbiStreamFlags::Binary | SbiStreamFlags::Random)) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
+ return;
+ }
+
+ SvStream* pStrm = pSbStrm->GetStrm();
+ bool bRandom = pSbStrm->IsRandom();
+ short nBlockLen = bRandom ? pSbStrm->GetBlockLen() : 0;
+
+ if( bPut )
+ {
+ pSbStrm->ExpandFile();
+ }
+
+ if( bHasRecordNo )
+ {
+ sal_uInt64 const nFilePos = bRandom
+ ? static_cast<sal_uInt64>(nBlockLen * nRecordNo)
+ : static_cast<sal_uInt64>(nRecordNo);
+ pStrm->Seek( nFilePos );
+ }
+
+ SbxDimArray* pArr = nullptr;
+ SbxVariable* pVar = rPar.Get32(3);
+ if( pVar->GetType() & SbxARRAY )
+ {
+ SbxBase* pParObj = pVar->GetObject();
+ pArr = dynamic_cast<SbxDimArray*>( pParObj );
+ }
+
+ bool bRet;
+
+ if( pArr )
+ {
+ sal_uInt64 const nFPos = pStrm->Tell();
+ sal_Int32 nDims = pArr->GetDims32();
+ std::unique_ptr<sal_Int32[]> pDims(new sal_Int32[ nDims ]);
+ bRet = lcl_WriteReadSbxArray(*pArr,pStrm,!bRandom,nDims,pDims.get(),bPut);
+ pDims.reset();
+ if( nBlockLen )
+ pStrm->Seek( nFPos + nBlockLen );
+ }
+ else
+ {
+ if( bPut )
+ bRet = lcl_WriteSbxVariable(*pVar, pStrm, !bRandom, nBlockLen, false);
+ else
+ bRet = lcl_ReadSbxVariable(*pVar, pStrm, !bRandom, nBlockLen);
+ }
+ if( !bRet || pStrm->GetErrorCode() )
+ StarBASIC::Error( ERRCODE_BASIC_IO_ERROR );
+}
+
+void SbRtl_Put(StarBASIC *, SbxArray & rPar, bool)
+{
+ PutGet( rPar, true );
+}
+
+void SbRtl_Get(StarBASIC *, SbxArray & rPar, bool)
+{
+ PutGet( rPar, false );
+}
+
+void SbRtl_Environ(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ OUString aResult;
+ // should be ANSI but that's not possible under Win16 in the DLL
+ OString aByteStr(OUStringToOString(rPar.Get32(1)->GetOUString(),
+ osl_getThreadTextEncoding()));
+ const char* pEnvStr = getenv(aByteStr.getStr());
+ if ( pEnvStr )
+ {
+ aResult = OUString(pEnvStr, strlen(pEnvStr), osl_getThreadTextEncoding());
+ }
+ rPar.Get32(0)->PutString( aResult );
+}
+
+static double GetDialogZoomFactor( bool bX, long nValue )
+{
+ OutputDevice* pDevice = Application::GetDefaultDevice();
+ double nResult = 0;
+ if( pDevice )
+ {
+ Size aRefSize( nValue, nValue );
+ Fraction aFracX( 1, 26 );
+ Fraction aFracY( 1, 24 );
+ MapMode aMap( MapUnit::MapAppFont, Point(), aFracX, aFracY );
+ Size aScaledSize = pDevice->LogicToPixel( aRefSize, aMap );
+ aRefSize = pDevice->LogicToPixel( aRefSize, MapMode(MapUnit::MapTwip) );
+
+ double nRef, nScaled;
+ if( bX )
+ {
+ nRef = aRefSize.Width();
+ nScaled = aScaledSize.Width();
+ }
+ else
+ {
+ nRef = aRefSize.Height();
+ nScaled = aScaledSize.Height();
+ }
+ nResult = nScaled / nRef;
+ }
+ return nResult;
+}
+
+
+void SbRtl_GetDialogZoomFactorX(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ rPar.Get32(0)->PutDouble( GetDialogZoomFactor( true, rPar.Get32(1)->GetLong() ));
+}
+
+void SbRtl_GetDialogZoomFactorY(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ rPar.Get32(0)->PutDouble( GetDialogZoomFactor( false, rPar.Get32(1)->GetLong()));
+}
+
+
+void SbRtl_EnableReschedule(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutEmpty();
+ if ( rPar.Count32() != 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ if( GetSbData()->pInst )
+ GetSbData()->pInst->EnableReschedule( rPar.Get32(1)->GetBool() );
+}
+
+void SbRtl_GetSystemTicks(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ rPar.Get32(0)->PutLong( tools::Time::GetSystemTicks() );
+}
+
+void SbRtl_GetPathSeparator(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ rPar.Get32(0)->PutString( OUString( SAL_PATHDELIMITER ) );
+}
+
+void SbRtl_ResolvePath(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() == 2 )
+ {
+ OUString aStr = rPar.Get32(1)->GetOUString();
+ rPar.Get32(0)->PutString( aStr );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_TypeLen(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ SbxDataType eType = rPar.Get32(1)->GetType();
+ sal_Int16 nLen = 0;
+ switch( eType )
+ {
+ case SbxEMPTY:
+ case SbxNULL:
+ case SbxVECTOR:
+ case SbxARRAY:
+ case SbxBYREF:
+ case SbxVOID:
+ case SbxHRESULT:
+ case SbxPOINTER:
+ case SbxDIMARRAY:
+ case SbxCARRAY:
+ case SbxUSERDEF:
+ nLen = 0;
+ break;
+
+ case SbxINTEGER:
+ case SbxERROR:
+ case SbxUSHORT:
+ case SbxINT:
+ case SbxUINT:
+ nLen = 2;
+ break;
+
+ case SbxLONG:
+ case SbxSINGLE:
+ case SbxULONG:
+ nLen = 4;
+ break;
+
+ case SbxDOUBLE:
+ case SbxCURRENCY:
+ case SbxDATE:
+ case SbxSALINT64:
+ case SbxSALUINT64:
+ nLen = 8;
+ break;
+
+ case SbxOBJECT:
+ case SbxVARIANT:
+ case SbxDATAOBJECT:
+ nLen = 0;
+ break;
+
+ case SbxCHAR:
+ case SbxBYTE:
+ case SbxBOOL:
+ nLen = 1;
+ break;
+
+ case SbxLPSTR:
+ case SbxLPWSTR:
+ case SbxCoreSTRING:
+ case SbxSTRING:
+ nLen = static_cast<sal_Int16>(rPar.Get32(1)->GetOUString().getLength());
+ break;
+
+ default:
+ nLen = 0;
+ break;
+ }
+ rPar.Get32(0)->PutInteger( nLen );
+ }
+}
+
+
+// 1st parameter == class name, other parameters for initialisation
+void SbRtl_CreateUnoStruct(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_CreateUnoStruct( rPar );
+}
+
+
+// 1st parameter == service-name
+void SbRtl_CreateUnoService(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_CreateUnoService( rPar );
+}
+
+void SbRtl_CreateUnoServiceWithArguments(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_CreateUnoServiceWithArguments( rPar );
+}
+
+
+void SbRtl_CreateUnoValue(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_CreateUnoValue( rPar );
+}
+
+
+// no parameters
+void SbRtl_GetProcessServiceManager(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_GetProcessServiceManager( rPar );
+}
+
+
+// 1st parameter == Sequence<PropertyValue>
+void SbRtl_CreatePropertySet(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_CreatePropertySet( rPar );
+}
+
+
+// multiple interface-names as parameters
+void SbRtl_HasUnoInterfaces(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_HasInterfaces( rPar );
+}
+
+
+void SbRtl_IsUnoStruct(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_IsUnoStruct( rPar );
+}
+
+
+void SbRtl_EqualUnoObjects(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_EqualUnoObjects( rPar );
+}
+
+void SbRtl_CreateUnoDialog(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_CreateUnoDialog( rPar );
+}
+
+// Return the application standard lib as root scope
+void SbRtl_GlobalScope(StarBASIC * pBasic, SbxArray & rPar, bool)
+{
+ SbxObject* p = pBasic;
+ while( p->GetParent() )
+ {
+ p = p->GetParent();
+ }
+ SbxVariableRef refVar = rPar.Get32(0);
+ refVar->PutObject( p );
+}
+
+// Helper functions to convert Url from/to system paths
+void SbRtl_ConvertToUrl(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() == 2 )
+ {
+ OUString aStr = rPar.Get32(1)->GetOUString();
+ INetURLObject aURLObj( aStr, INetProtocol::File );
+ OUString aFileURL = aURLObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( aFileURL.isEmpty() )
+ {
+ osl::File::getFileURLFromSystemPath(aStr, aFileURL);
+ }
+ if( aFileURL.isEmpty() )
+ {
+ aFileURL = aStr;
+ }
+ rPar.Get32(0)->PutString(aFileURL);
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_ConvertFromUrl(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() == 2 )
+ {
+ OUString aStr = rPar.Get32(1)->GetOUString();
+ OUString aSysPath;
+ ::osl::File::getSystemPathFromFileURL( aStr, aSysPath );
+ if( aSysPath.isEmpty() )
+ {
+ aSysPath = aStr;
+ }
+ rPar.Get32(0)->PutString(aSysPath);
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+
+// Provide DefaultContext
+void SbRtl_GetDefaultContext(StarBASIC *, SbxArray & rPar, bool)
+{
+ RTL_Impl_GetDefaultContext( rPar );
+}
+
+void SbRtl_Join(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if ( nParCount != 3 && nParCount != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ SbxBase* pParObj = rPar.Get32(1)->GetObject();
+ SbxDimArray* pArr = dynamic_cast<SbxDimArray*>( pParObj );
+ if( pArr )
+ {
+ if( pArr->GetDims32() != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_WRONG_DIMS ); // Syntax Error?!
+ return;
+ }
+ OUString aDelim;
+ if( nParCount == 3 )
+ {
+ aDelim = rPar.Get32(2)->GetOUString();
+ }
+ else
+ {
+ aDelim = " ";
+ }
+ OUStringBuffer aRetStr(32);
+ sal_Int32 nLower, nUpper;
+ pArr->GetDim32( 1, nLower, nUpper );
+ sal_Int32 aIdx[1];
+ for (aIdx[0] = nLower; aIdx[0] <= nUpper; ++aIdx[0])
+ {
+ OUString aStr = pArr->Get32(aIdx)->GetOUString();
+ aRetStr.append(aStr);
+ if (aIdx[0] != nUpper)
+ {
+ aRetStr.append(aDelim);
+ }
+ }
+ rPar.Get32(0)->PutString( aRetStr.makeStringAndClear() );
+ }
+ else
+ {
+ StarBASIC::Error( ERRCODE_BASIC_MUST_HAVE_DIMS );
+ }
+}
+
+
+void SbRtl_Split(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if ( nParCount < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aExpression = rPar.Get32(1)->GetOUString();
+ sal_Int32 nArraySize = 0;
+ std::vector< OUString > vRet;
+ if( !aExpression.isEmpty() )
+ {
+ OUString aDelim;
+ if( nParCount >= 3 )
+ {
+ aDelim = rPar.Get32(2)->GetOUString();
+ }
+ else
+ {
+ aDelim = " ";
+ }
+
+ sal_Int32 nCount = -1;
+ if( nParCount == 4 )
+ {
+ nCount = rPar.Get32(3)->GetLong();
+ }
+ sal_Int32 nDelimLen = aDelim.getLength();
+ if( nDelimLen )
+ {
+ sal_Int32 iSearch = -1;
+ sal_Int32 iStart = 0;
+ do
+ {
+ bool bBreak = false;
+ if( nCount >= 0 && nArraySize == nCount - 1 )
+ {
+ bBreak = true;
+ }
+ iSearch = aExpression.indexOf( aDelim, iStart );
+ OUString aSubStr;
+ if( iSearch >= 0 && !bBreak )
+ {
+ aSubStr = aExpression.copy( iStart, iSearch - iStart );
+ iStart = iSearch + nDelimLen;
+ }
+ else
+ {
+ aSubStr = aExpression.copy( iStart );
+ }
+ vRet.push_back( aSubStr );
+ nArraySize++;
+
+ if( bBreak )
+ {
+ break;
+ }
+ }
+ while( iSearch >= 0 );
+ }
+ else
+ {
+ vRet.push_back( aExpression );
+ nArraySize = 1;
+ }
+ }
+
+ SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
+ pArray->unoAddDim32( 0, nArraySize-1 );
+
+ // insert parameter(s) into the array
+ for(sal_Int32 i = 0 ; i < nArraySize ; i++ )
+ {
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ xVar->PutString( vRet[i] );
+ pArray->Put32( xVar.get(), &i );
+ }
+
+ // return array
+ SbxVariableRef refVar = rPar.Get32(0);
+ SbxFlagBits nFlags = refVar->GetFlags();
+ refVar->ResetFlag( SbxFlagBits::Fixed );
+ refVar->PutObject( pArray );
+ refVar->SetFlags( nFlags );
+ refVar->SetParameters( nullptr );
+}
+
+// MonthName(month[, abbreviate])
+void SbRtl_MonthName(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount != 2 && nParCount != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ const Reference< XCalendar4 >& xCalendar = getLocaleCalendar();
+ if( !xCalendar.is() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+ Sequence< CalendarItem2 > aMonthSeq = xCalendar->getMonths2();
+ sal_Int32 nMonthCount = aMonthSeq.getLength();
+
+ sal_Int16 nVal = rPar.Get32(1)->GetInteger();
+ if( nVal < 1 || nVal > nMonthCount )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ bool bAbbreviate = false;
+ if( nParCount == 3 )
+ bAbbreviate = rPar.Get32(2)->GetBool();
+
+ const CalendarItem2* pCalendarItems = aMonthSeq.getConstArray();
+ const CalendarItem2& rItem = pCalendarItems[nVal - 1];
+
+ OUString aRetStr = ( bAbbreviate ? rItem.AbbrevName : rItem.FullName );
+ rPar.Get32(0)->PutString(aRetStr);
+}
+
+// WeekdayName(weekday, abbreviate, firstdayofweek)
+void SbRtl_WeekdayName(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount < 2 || nParCount > 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ const Reference< XCalendar4 >& xCalendar = getLocaleCalendar();
+ if( !xCalendar.is() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+
+ Sequence< CalendarItem2 > aDaySeq = xCalendar->getDays2();
+ sal_Int16 nDayCount = static_cast<sal_Int16>(aDaySeq.getLength());
+ sal_Int16 nDay = rPar.Get32(1)->GetInteger();
+ sal_Int16 nFirstDay = 0;
+ if( nParCount == 4 )
+ {
+ nFirstDay = rPar.Get32(3)->GetInteger();
+ if( nFirstDay < 0 || nFirstDay > 7 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ }
+ if( nFirstDay == 0 )
+ {
+ nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 );
+ }
+ nDay = 1 + (nDay + nDayCount + nFirstDay - 2) % nDayCount;
+ if( nDay < 1 || nDay > nDayCount )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ bool bAbbreviate = false;
+ if( nParCount >= 3 )
+ {
+ SbxVariable* pPar2 = rPar.Get32(2);
+ if( !pPar2->IsErr() )
+ {
+ bAbbreviate = pPar2->GetBool();
+ }
+ }
+
+ const CalendarItem2* pCalendarItems = aDaySeq.getConstArray();
+ const CalendarItem2& rItem = pCalendarItems[nDay - 1];
+
+ OUString aRetStr = ( bAbbreviate ? rItem.AbbrevName : rItem.FullName );
+ rPar.Get32(0)->PutString( aRetStr );
+}
+
+void SbRtl_Weekday(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if ( nParCount < 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ double aDate = rPar.Get32(1)->GetDate();
+
+ bool bFirstDay = false;
+ sal_Int16 nFirstDay = 0;
+ if ( nParCount > 2 )
+ {
+ nFirstDay = rPar.Get32(2)->GetInteger();
+ bFirstDay = true;
+ }
+ sal_Int16 nDay = implGetWeekDay( aDate, bFirstDay, nFirstDay );
+ rPar.Get32(0)->PutInteger( nDay );
+ }
+}
+
+namespace {
+
+enum Interval
+{
+ INTERVAL_YYYY,
+ INTERVAL_Q,
+ INTERVAL_M,
+ INTERVAL_Y,
+ INTERVAL_D,
+ INTERVAL_W,
+ INTERVAL_WW,
+ INTERVAL_H,
+ INTERVAL_N,
+ INTERVAL_S
+};
+
+struct IntervalInfo
+{
+ Interval meInterval;
+ char const * mStringCode;
+ double mdValue;
+ bool mbSimple;
+};
+
+}
+
+static IntervalInfo const * getIntervalInfo( const OUString& rStringCode )
+{
+ static IntervalInfo const aIntervalTable[] =
+ {
+ { INTERVAL_YYYY, "yyyy", 0.0, false }, // Year
+ { INTERVAL_Q, "q", 0.0, false }, // Quarter
+ { INTERVAL_M, "m", 0.0, false }, // Month
+ { INTERVAL_Y, "y", 1.0, true }, // Day of year
+ { INTERVAL_D, "d", 1.0, true }, // Day
+ { INTERVAL_W, "w", 1.0, true }, // Weekday
+ { INTERVAL_WW, "ww", 7.0, true }, // Week
+ { INTERVAL_H, "h", 1.0 / 24.0, true }, // Hour
+ { INTERVAL_N, "n", 1.0 / 1440.0, true }, // Minute
+ { INTERVAL_S, "s", 1.0 / 86400.0, true } // Second
+ };
+ for( std::size_t i = 0; i != SAL_N_ELEMENTS(aIntervalTable); ++i )
+ {
+ if( rStringCode.equalsIgnoreAsciiCaseAscii(
+ aIntervalTable[i].mStringCode ) )
+ {
+ return &aIntervalTable[i];
+ }
+ }
+ return nullptr;
+}
+
+static void implGetDayMonthYear( sal_Int16& rnYear, sal_Int16& rnMonth, sal_Int16& rnDay, double dDate )
+{
+ rnDay = implGetDateDay( dDate );
+ rnMonth = implGetDateMonth( dDate );
+ rnYear = implGetDateYear( dDate );
+}
+
+/** Limits a date to valid dates within tools' class Date capabilities.
+
+ @return the year number, truncated if necessary and in that case also
+ rMonth and rDay adjusted.
+ */
+static sal_Int16 limitDate( sal_Int32 n32Year, sal_Int16& rMonth, sal_Int16& rDay )
+{
+ if( n32Year > SAL_MAX_INT16 )
+ {
+ n32Year = SAL_MAX_INT16;
+ rMonth = 12;
+ rDay = 31;
+ }
+ else if( n32Year < SAL_MIN_INT16 )
+ {
+ n32Year = SAL_MIN_INT16;
+ rMonth = 1;
+ rDay = 1;
+ }
+ return static_cast<sal_Int16>(n32Year);
+}
+
+void SbRtl_DateAdd(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount != 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aStringCode = rPar.Get32(1)->GetOUString();
+ IntervalInfo const * pInfo = getIntervalInfo( aStringCode );
+ if( !pInfo )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ sal_Int32 lNumber = rPar.Get32(2)->GetLong();
+ double dDate = rPar.Get32(3)->GetDate();
+ double dNewDate = 0;
+ if( pInfo->mbSimple )
+ {
+ double dAdd = pInfo->mdValue * lNumber;
+ dNewDate = dDate + dAdd;
+ }
+ else
+ {
+ // Keep hours, minutes, seconds
+ double dHoursMinutesSeconds = dDate - floor( dDate );
+
+ bool bOk = true;
+ sal_Int16 nYear, nMonth, nDay;
+ sal_Int16 nTargetYear16 = 0, nTargetMonth = 0;
+ implGetDayMonthYear( nYear, nMonth, nDay, dDate );
+ switch( pInfo->meInterval )
+ {
+ case INTERVAL_YYYY:
+ {
+ sal_Int32 nTargetYear = lNumber + nYear;
+ nTargetYear16 = limitDate( nTargetYear, nMonth, nDay );
+ /* TODO: should the result be error if the date was limited? It never was. */
+ nTargetMonth = nMonth;
+ bOk = implDateSerial( nTargetYear16, nTargetMonth, nDay, false, SbDateCorrection::TruncateToMonth, dNewDate );
+ break;
+ }
+ case INTERVAL_Q:
+ case INTERVAL_M:
+ {
+ bool bNeg = (lNumber < 0);
+ if( bNeg )
+ lNumber = -lNumber;
+ sal_Int32 nYearsAdd;
+ sal_Int16 nMonthAdd;
+ if( pInfo->meInterval == INTERVAL_Q )
+ {
+ nYearsAdd = lNumber / 4;
+ nMonthAdd = static_cast<sal_Int16>( 3 * (lNumber % 4) );
+ }
+ else
+ {
+ nYearsAdd = lNumber / 12;
+ nMonthAdd = static_cast<sal_Int16>( lNumber % 12 );
+ }
+
+ sal_Int32 nTargetYear;
+ if( bNeg )
+ {
+ nTargetMonth = nMonth - nMonthAdd;
+ if( nTargetMonth <= 0 )
+ {
+ nTargetMonth += 12;
+ nYearsAdd++;
+ }
+ nTargetYear = static_cast<sal_Int32>(nYear) - nYearsAdd;
+ }
+ else
+ {
+ nTargetMonth = nMonth + nMonthAdd;
+ if( nTargetMonth > 12 )
+ {
+ nTargetMonth -= 12;
+ nYearsAdd++;
+ }
+ nTargetYear = static_cast<sal_Int32>(nYear) + nYearsAdd;
+ }
+ nTargetYear16 = limitDate( nTargetYear, nTargetMonth, nDay );
+ /* TODO: should the result be error if the date was limited? It never was. */
+ bOk = implDateSerial( nTargetYear16, nTargetMonth, nDay, false, SbDateCorrection::TruncateToMonth, dNewDate );
+ break;
+ }
+ default: break;
+ }
+
+ if( bOk )
+ dNewDate += dHoursMinutesSeconds;
+ }
+
+ rPar.Get32(0)->PutDate( dNewDate );
+}
+
+static double RoundImpl( double d )
+{
+ return ( d >= 0 ) ? floor( d + 0.5 ) : -floor( -d + 0.5 );
+}
+
+void SbRtl_DateDiff(StarBASIC *, SbxArray & rPar, bool)
+{
+ // DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]])
+
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount < 4 || nParCount > 6 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aStringCode = rPar.Get32(1)->GetOUString();
+ IntervalInfo const * pInfo = getIntervalInfo( aStringCode );
+ if( !pInfo )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ double dDate1 = rPar.Get32(2)->GetDate();
+ double dDate2 = rPar.Get32(3)->GetDate();
+
+ double dRet = 0.0;
+ switch( pInfo->meInterval )
+ {
+ case INTERVAL_YYYY:
+ {
+ sal_Int16 nYear1 = implGetDateYear( dDate1 );
+ sal_Int16 nYear2 = implGetDateYear( dDate2 );
+ dRet = nYear2 - nYear1;
+ break;
+ }
+ case INTERVAL_Q:
+ {
+ sal_Int16 nYear1 = implGetDateYear( dDate1 );
+ sal_Int16 nYear2 = implGetDateYear( dDate2 );
+ sal_Int16 nQ1 = 1 + (implGetDateMonth( dDate1 ) - 1) / 3;
+ sal_Int16 nQ2 = 1 + (implGetDateMonth( dDate2 ) - 1) / 3;
+ sal_Int16 nQGes1 = 4 * nYear1 + nQ1;
+ sal_Int16 nQGes2 = 4 * nYear2 + nQ2;
+ dRet = nQGes2 - nQGes1;
+ break;
+ }
+ case INTERVAL_M:
+ {
+ sal_Int16 nYear1 = implGetDateYear( dDate1 );
+ sal_Int16 nYear2 = implGetDateYear( dDate2 );
+ sal_Int16 nMonth1 = implGetDateMonth( dDate1 );
+ sal_Int16 nMonth2 = implGetDateMonth( dDate2 );
+ sal_Int16 nMonthGes1 = 12 * nYear1 + nMonth1;
+ sal_Int16 nMonthGes2 = 12 * nYear2 + nMonth2;
+ dRet = nMonthGes2 - nMonthGes1;
+ break;
+ }
+ case INTERVAL_Y:
+ case INTERVAL_D:
+ {
+ double dDays1 = floor( dDate1 );
+ double dDays2 = floor( dDate2 );
+ dRet = dDays2 - dDays1;
+ break;
+ }
+ case INTERVAL_W:
+ case INTERVAL_WW:
+ {
+ double dDays1 = floor( dDate1 );
+ double dDays2 = floor( dDate2 );
+ if( pInfo->meInterval == INTERVAL_WW )
+ {
+ sal_Int16 nFirstDay = 1; // Default
+ if( nParCount >= 5 )
+ {
+ nFirstDay = rPar.Get32(4)->GetInteger();
+ if( nFirstDay < 0 || nFirstDay > 7 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ if( nFirstDay == 0 )
+ {
+ const Reference< XCalendar4 >& xCalendar = getLocaleCalendar();
+ if( !xCalendar.is() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+ nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 );
+ }
+ }
+ sal_Int16 nDay1 = implGetWeekDay( dDate1 );
+ sal_Int16 nDay1_Diff = nDay1 - nFirstDay;
+ if( nDay1_Diff < 0 )
+ nDay1_Diff += 7;
+ dDays1 -= nDay1_Diff;
+
+ sal_Int16 nDay2 = implGetWeekDay( dDate2 );
+ sal_Int16 nDay2_Diff = nDay2 - nFirstDay;
+ if( nDay2_Diff < 0 )
+ nDay2_Diff += 7;
+ dDays2 -= nDay2_Diff;
+ }
+
+ double dDiff = dDays2 - dDays1;
+ dRet = ( dDiff >= 0 ) ? floor( dDiff / 7.0 ) : -floor( -dDiff / 7.0 );
+ break;
+ }
+ case INTERVAL_H:
+ {
+ dRet = RoundImpl( 24.0 * (dDate2 - dDate1) );
+ break;
+ }
+ case INTERVAL_N:
+ {
+ dRet = RoundImpl( 1440.0 * (dDate2 - dDate1) );
+ break;
+ }
+ case INTERVAL_S:
+ {
+ dRet = RoundImpl( 86400.0 * (dDate2 - dDate1) );
+ break;
+ }
+ }
+ rPar.Get32(0)->PutDouble( dRet );
+}
+
+static double implGetDateOfFirstDayInFirstWeek
+ ( sal_Int16 nYear, sal_Int16& nFirstDay, sal_Int16& nFirstWeek, bool* pbError = nullptr )
+{
+ ErrCode nError = ERRCODE_NONE;
+ if( nFirstDay < 0 || nFirstDay > 7 )
+ nError = ERRCODE_BASIC_BAD_ARGUMENT;
+
+ if( nFirstWeek < 0 || nFirstWeek > 3 )
+ nError = ERRCODE_BASIC_BAD_ARGUMENT;
+
+ Reference< XCalendar4 > xCalendar;
+ if( nFirstDay == 0 || nFirstWeek == 0 )
+ {
+ xCalendar = getLocaleCalendar();
+ if( !xCalendar.is() )
+ nError = ERRCODE_BASIC_BAD_ARGUMENT;
+ }
+
+ if( nError != ERRCODE_NONE )
+ {
+ StarBASIC::Error( nError );
+ if( pbError )
+ *pbError = true;
+ return 0.0;
+ }
+
+ if( nFirstDay == 0 )
+ nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 );
+
+ sal_Int16 nFirstWeekMinDays = 0; // Not used for vbFirstJan1 = default
+ if( nFirstWeek == 0 )
+ {
+ nFirstWeekMinDays = xCalendar->getMinimumNumberOfDaysForFirstWeek();
+ if( nFirstWeekMinDays == 1 )
+ {
+ nFirstWeekMinDays = 0;
+ nFirstWeek = 1;
+ }
+ else if( nFirstWeekMinDays == 4 )
+ nFirstWeek = 2;
+ else if( nFirstWeekMinDays == 7 )
+ nFirstWeek = 3;
+ }
+ else if( nFirstWeek == 2 )
+ nFirstWeekMinDays = 4; // vbFirstFourDays
+ else if( nFirstWeek == 3 )
+ nFirstWeekMinDays = 7; // vbFirstFourDays
+
+ double dBaseDate;
+ implDateSerial( nYear, 1, 1, false, SbDateCorrection::None, dBaseDate );
+
+ sal_Int16 nWeekDay0101 = implGetWeekDay( dBaseDate );
+ sal_Int16 nDayDiff = nWeekDay0101 - nFirstDay;
+ if( nDayDiff < 0 )
+ nDayDiff += 7;
+
+ if( nFirstWeekMinDays )
+ {
+ sal_Int16 nThisWeeksDaysInYearCount = 7 - nDayDiff;
+ if( nThisWeeksDaysInYearCount < nFirstWeekMinDays )
+ nDayDiff -= 7;
+ }
+ double dRetDate = dBaseDate - nDayDiff;
+ return dRetDate;
+}
+
+void SbRtl_DatePart(StarBASIC *, SbxArray & rPar, bool)
+{
+ // DatePart(interval, date[,firstdayofweek[, firstweekofyear]])
+
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount < 3 || nParCount > 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aStringCode = rPar.Get32(1)->GetOUString();
+ IntervalInfo const * pInfo = getIntervalInfo( aStringCode );
+ if( !pInfo )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ double dDate = rPar.Get32(2)->GetDate();
+
+ sal_Int32 nRet = 0;
+ switch( pInfo->meInterval )
+ {
+ case INTERVAL_YYYY:
+ {
+ nRet = implGetDateYear( dDate );
+ break;
+ }
+ case INTERVAL_Q:
+ {
+ nRet = 1 + (implGetDateMonth( dDate ) - 1) / 3;
+ break;
+ }
+ case INTERVAL_M:
+ {
+ nRet = implGetDateMonth( dDate );
+ break;
+ }
+ case INTERVAL_Y:
+ {
+ sal_Int16 nYear = implGetDateYear( dDate );
+ double dBaseDate;
+ implDateSerial( nYear, 1, 1, false, SbDateCorrection::None, dBaseDate );
+ nRet = 1 + sal_Int32( dDate - dBaseDate );
+ break;
+ }
+ case INTERVAL_D:
+ {
+ nRet = implGetDateDay( dDate );
+ break;
+ }
+ case INTERVAL_W:
+ {
+ bool bFirstDay = false;
+ sal_Int16 nFirstDay = 1; // Default
+ if( nParCount >= 4 )
+ {
+ nFirstDay = rPar.Get32(3)->GetInteger();
+ bFirstDay = true;
+ }
+ nRet = implGetWeekDay( dDate, bFirstDay, nFirstDay );
+ break;
+ }
+ case INTERVAL_WW:
+ {
+ sal_Int16 nFirstDay = 1; // Default
+ if( nParCount >= 4 )
+ nFirstDay = rPar.Get32(3)->GetInteger();
+
+ sal_Int16 nFirstWeek = 1; // Default
+ if( nParCount == 5 )
+ nFirstWeek = rPar.Get32(4)->GetInteger();
+
+ sal_Int16 nYear = implGetDateYear( dDate );
+ bool bError = false;
+ double dYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear, nFirstDay, nFirstWeek, &bError );
+ if( !bError )
+ {
+ if( dYearFirstDay > dDate )
+ {
+ // Date belongs to last year's week
+ dYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear - 1, nFirstDay, nFirstWeek );
+ }
+ else if( nFirstWeek != 1 )
+ {
+ // Check if date belongs to next year
+ double dNextYearFirstDay = implGetDateOfFirstDayInFirstWeek( nYear + 1, nFirstDay, nFirstWeek );
+ if( dDate >= dNextYearFirstDay )
+ dYearFirstDay = dNextYearFirstDay;
+ }
+
+ // Calculate week
+ double dDiff = dDate - dYearFirstDay;
+ nRet = 1 + sal_Int32( dDiff / 7 );
+ }
+ break;
+ }
+ case INTERVAL_H:
+ {
+ nRet = implGetHour( dDate );
+ break;
+ }
+ case INTERVAL_N:
+ {
+ nRet = implGetMinute( dDate );
+ break;
+ }
+ case INTERVAL_S:
+ {
+ nRet = implGetSecond( dDate );
+ break;
+ }
+ }
+ rPar.Get32(0)->PutLong( nRet );
+}
+
+// FormatDateTime(Date[,NamedFormat])
+void SbRtl_FormatDateTime(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount < 2 || nParCount > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ double dDate = rPar.Get32(1)->GetDate();
+ sal_Int16 nNamedFormat = 0;
+ if( nParCount > 2 )
+ {
+ nNamedFormat = rPar.Get32(2)->GetInteger();
+ if( nNamedFormat < 0 || nNamedFormat > 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ }
+
+ const Reference< XCalendar4 >& xCalendar = getLocaleCalendar();
+ if( !xCalendar.is() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+
+ OUString aRetStr;
+ SbxVariableRef pSbxVar = new SbxVariable( SbxSTRING );
+ switch( nNamedFormat )
+ {
+ // GeneralDate:
+ // Display a date and/or time. If there is a date part,
+ // display it as a short date. If there is a time part,
+ // display it as a long time. If present, both parts are displayed.
+
+ // 12/21/2004 11:24:50 AM
+ // 21.12.2004 12:13:51
+ case 0:
+ pSbxVar->PutDate( dDate );
+ aRetStr = pSbxVar->GetOUString();
+ break;
+
+ // LongDate: Display a date using the long date format specified
+ // in your computer's regional settings.
+ // Tuesday, December 21, 2004
+ // Dienstag, 21. December 2004
+ case 1:
+ {
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ if( GetSbData()->pInst )
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ }
+ else
+ {
+ sal_uInt32 n; // Dummy
+ pFormatter = SbiInstance::PrepareNumberFormatter( n, n, n );
+ }
+
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ const sal_uInt32 nIndex = pFormatter->GetFormatIndex( NF_DATE_SYSTEM_LONG, eLangType );
+ Color* pCol;
+ pFormatter->GetOutputString( dDate, nIndex, aRetStr, &pCol );
+ break;
+ }
+
+ // ShortDate: Display a date using the short date format specified
+ // in your computer's regional settings.
+ // 21.12.2004
+ case 2:
+ pSbxVar->PutDate( floor(dDate) );
+ aRetStr = pSbxVar->GetOUString();
+ break;
+
+ // LongTime: Display a time using the time format specified
+ // in your computer's regional settings.
+ // 11:24:50 AM
+ // 12:13:51
+ case 3:
+ // ShortTime: Display a time using the 24-hour format (hh:mm).
+ // 11:24
+ case 4:
+ double dTime = modf( dDate, &o3tl::temporary(double()) );
+ pSbxVar->PutDate( dTime );
+ if( nNamedFormat == 3 )
+ {
+ aRetStr = pSbxVar->GetOUString();
+ }
+ else
+ {
+ aRetStr = pSbxVar->GetOUString().copy( 0, 5 );
+ }
+ break;
+ }
+
+ rPar.Get32(0)->PutString( aRetStr );
+}
+
+void SbRtl_Frac(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount != 2)
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ double dVal = pSbxVariable->GetDouble();
+ if(dVal >= 0)
+ rPar.Get32(0)->PutDouble(dVal - ::rtl::math::approxFloor(dVal));
+ else
+ rPar.Get32(0)->PutDouble(dVal - ::rtl::math::approxCeil(dVal));
+}
+
+void SbRtl_Round(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nParCount = rPar.Count32();
+ if( nParCount != 2 && nParCount != 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ double dVal = pSbxVariable->GetDouble();
+ double dRes = 0.0;
+ if( dVal != 0.0 )
+ {
+ bool bNeg = false;
+ if( dVal < 0.0 )
+ {
+ bNeg = true;
+ dVal = -dVal;
+ }
+
+ sal_Int16 numdecimalplaces = 0;
+ if( nParCount == 3 )
+ {
+ numdecimalplaces = rPar.Get32(2)->GetInteger();
+ if( numdecimalplaces < 0 || numdecimalplaces > 22 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ }
+
+ if( numdecimalplaces == 0 )
+ {
+ dRes = floor( dVal + 0.5 );
+ }
+ else
+ {
+ double dFactor = pow( 10.0, numdecimalplaces );
+ dVal *= dFactor;
+ dRes = floor( dVal + 0.5 );
+ dRes /= dFactor;
+ }
+
+ if( bNeg )
+ dRes = -dRes;
+ }
+ rPar.Get32(0)->PutDouble( dRes );
+}
+
+static void CallFunctionAccessFunction( const Sequence< Any >& aArgs, const OUString& sFuncName, SbxVariable* pRet )
+{
+ static Reference< XFunctionAccess > xFunc;
+ try
+ {
+ if ( !xFunc.is() )
+ {
+ Reference< XMultiServiceFactory > xFactory( getProcessServiceFactory() );
+ if( xFactory.is() )
+ {
+ xFunc.set( xFactory->createInstance("com.sun.star.sheet.FunctionAccess"), UNO_QUERY_THROW);
+ }
+ }
+ Any aRet = xFunc->callFunction( sFuncName, aArgs );
+
+ unoToSbxValue( pRet, aRet );
+
+ }
+ catch(const Exception& )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+}
+
+void SbRtl_SYD(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 4 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // retrieve non-optional params
+
+ Sequence< Any > aParams( 4 );
+ aParams[ 0 ] <<= rPar.Get32(1)->GetDouble();
+ aParams[ 1 ] <<= rPar.Get32(2)->GetDouble();
+ aParams[ 2 ] <<= rPar.Get32(3)->GetDouble();
+ aParams[ 3 ] <<= rPar.Get32(4)->GetDouble();
+
+ CallFunctionAccessFunction( aParams, "SYD", rPar.Get32( 0 ) );
+}
+
+void SbRtl_SLN(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // retrieve non-optional params
+
+ Sequence< Any > aParams( 3 );
+ aParams[ 0 ] <<= rPar.Get32(1)->GetDouble();
+ aParams[ 1 ] <<= rPar.Get32(2)->GetDouble();
+ aParams[ 2 ] <<= rPar.Get32(3)->GetDouble();
+
+ CallFunctionAccessFunction( aParams, "SLN", rPar.Get32( 0 ) );
+}
+
+void SbRtl_Pmt(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 3 || nArgCount > 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double rate = rPar.Get32(1)->GetDouble();
+ double nper = rPar.Get32(2)->GetDouble();
+ double pmt = rPar.Get32(3)->GetDouble();
+
+ // set default values for Optional args
+ double fv = 0;
+ double type = 0;
+
+ // fv
+ if ( nArgCount >= 4 )
+ {
+ if( rPar.Get32(4)->GetType() != SbxEMPTY )
+ fv = rPar.Get32(4)->GetDouble();
+ }
+ // type
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ type = rPar.Get32(5)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 5 );
+ aParams[ 0 ] <<= rate;
+ aParams[ 1 ] <<= nper;
+ aParams[ 2 ] <<= pmt;
+ aParams[ 3 ] <<= fv;
+ aParams[ 4 ] <<= type;
+
+ CallFunctionAccessFunction( aParams, "Pmt", rPar.Get32( 0 ) );
+}
+
+void SbRtl_PPmt(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 4 || nArgCount > 6 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double rate = rPar.Get32(1)->GetDouble();
+ double per = rPar.Get32(2)->GetDouble();
+ double nper = rPar.Get32(3)->GetDouble();
+ double pv = rPar.Get32(4)->GetDouble();
+
+ // set default values for Optional args
+ double fv = 0;
+ double type = 0;
+
+ // fv
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ fv = rPar.Get32(5)->GetDouble();
+ }
+ // type
+ if ( nArgCount >= 6 )
+ {
+ if( rPar.Get32(6)->GetType() != SbxEMPTY )
+ type = rPar.Get32(6)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 6 );
+ aParams[ 0 ] <<= rate;
+ aParams[ 1 ] <<= per;
+ aParams[ 2 ] <<= nper;
+ aParams[ 3 ] <<= pv;
+ aParams[ 4 ] <<= fv;
+ aParams[ 5 ] <<= type;
+
+ CallFunctionAccessFunction( aParams, "PPmt", rPar.Get32( 0 ) );
+}
+
+void SbRtl_PV(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 3 || nArgCount > 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double rate = rPar.Get32(1)->GetDouble();
+ double nper = rPar.Get32(2)->GetDouble();
+ double pmt = rPar.Get32(3)->GetDouble();
+
+ // set default values for Optional args
+ double fv = 0;
+ double type = 0;
+
+ // fv
+ if ( nArgCount >= 4 )
+ {
+ if( rPar.Get32(4)->GetType() != SbxEMPTY )
+ fv = rPar.Get32(4)->GetDouble();
+ }
+ // type
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ type = rPar.Get32(5)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 5 );
+ aParams[ 0 ] <<= rate;
+ aParams[ 1 ] <<= nper;
+ aParams[ 2 ] <<= pmt;
+ aParams[ 3 ] <<= fv;
+ aParams[ 4 ] <<= type;
+
+ CallFunctionAccessFunction( aParams, "PV", rPar.Get32( 0 ) );
+}
+
+void SbRtl_NPV(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 1 || nArgCount > 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ Sequence< Any > aParams( 2 );
+ aParams[ 0 ] <<= rPar.Get32(1)->GetDouble();
+ Any aValues = sbxToUnoValue( rPar.Get32(2),
+ cppu::UnoType<Sequence<double>>::get() );
+
+ // convert for calc functions
+ Sequence< Sequence< double > > sValues(1);
+ aValues >>= sValues[ 0 ];
+ aValues <<= sValues;
+
+ aParams[ 1 ] = aValues;
+
+ CallFunctionAccessFunction( aParams, "NPV", rPar.Get32( 0 ) );
+}
+
+void SbRtl_NPer(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 3 || nArgCount > 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double rate = rPar.Get32(1)->GetDouble();
+ double pmt = rPar.Get32(2)->GetDouble();
+ double pv = rPar.Get32(3)->GetDouble();
+
+ // set default values for Optional args
+ double fv = 0;
+ double type = 0;
+
+ // fv
+ if ( nArgCount >= 4 )
+ {
+ if( rPar.Get32(4)->GetType() != SbxEMPTY )
+ fv = rPar.Get32(4)->GetDouble();
+ }
+ // type
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ type = rPar.Get32(5)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 5 );
+ aParams[ 0 ] <<= rate;
+ aParams[ 1 ] <<= pmt;
+ aParams[ 2 ] <<= pv;
+ aParams[ 3 ] <<= fv;
+ aParams[ 4 ] <<= type;
+
+ CallFunctionAccessFunction( aParams, "NPer", rPar.Get32( 0 ) );
+}
+
+void SbRtl_MIRR(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ // retrieve non-optional params
+
+ Sequence< Any > aParams( 3 );
+ Any aValues = sbxToUnoValue( rPar.Get32(1),
+ cppu::UnoType<Sequence<double>>::get() );
+
+ // convert for calc functions
+ Sequence< Sequence< double > > sValues(1);
+ aValues >>= sValues[ 0 ];
+ aValues <<= sValues;
+
+ aParams[ 0 ] = aValues;
+ aParams[ 1 ] <<= rPar.Get32(2)->GetDouble();
+ aParams[ 2 ] <<= rPar.Get32(3)->GetDouble();
+
+ CallFunctionAccessFunction( aParams, "MIRR", rPar.Get32( 0 ) );
+}
+
+void SbRtl_IRR(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 1 || nArgCount > 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+ Any aValues = sbxToUnoValue( rPar.Get32(1),
+ cppu::UnoType<Sequence<double>>::get() );
+
+ // convert for calc functions
+ Sequence< Sequence< double > > sValues(1);
+ aValues >>= sValues[ 0 ];
+ aValues <<= sValues;
+
+ // set default values for Optional args
+ double guess = 0.1;
+ // guess
+ if ( nArgCount >= 2 )
+ {
+ if( rPar.Get32(2)->GetType() != SbxEMPTY )
+ guess = rPar.Get32(2)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 2 );
+ aParams[ 0 ] = aValues;
+ aParams[ 1 ] <<= guess;
+
+ CallFunctionAccessFunction( aParams, "IRR", rPar.Get32( 0 ) );
+}
+
+void SbRtl_IPmt(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 4 || nArgCount > 6 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double rate = rPar.Get32(1)->GetDouble();
+ double per = rPar.Get32(2)->GetInteger();
+ double nper = rPar.Get32(3)->GetDouble();
+ double pv = rPar.Get32(4)->GetDouble();
+
+ // set default values for Optional args
+ double fv = 0;
+ double type = 0;
+
+ // fv
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ fv = rPar.Get32(5)->GetDouble();
+ }
+ // type
+ if ( nArgCount >= 6 )
+ {
+ if( rPar.Get32(6)->GetType() != SbxEMPTY )
+ type = rPar.Get32(6)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 6 );
+ aParams[ 0 ] <<= rate;
+ aParams[ 1 ] <<= per;
+ aParams[ 2 ] <<= nper;
+ aParams[ 3 ] <<= pv;
+ aParams[ 4 ] <<= fv;
+ aParams[ 5 ] <<= type;
+
+ CallFunctionAccessFunction( aParams, "IPmt", rPar.Get32( 0 ) );
+}
+
+void SbRtl_FV(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 3 || nArgCount > 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double rate = rPar.Get32(1)->GetDouble();
+ double nper = rPar.Get32(2)->GetDouble();
+ double pmt = rPar.Get32(3)->GetDouble();
+
+ // set default values for Optional args
+ double pv = 0;
+ double type = 0;
+
+ // pv
+ if ( nArgCount >= 4 )
+ {
+ if( rPar.Get32(4)->GetType() != SbxEMPTY )
+ pv = rPar.Get32(4)->GetDouble();
+ }
+ // type
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ type = rPar.Get32(5)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 5 );
+ aParams[ 0 ] <<= rate;
+ aParams[ 1 ] <<= nper;
+ aParams[ 2 ] <<= pmt;
+ aParams[ 3 ] <<= pv;
+ aParams[ 4 ] <<= type;
+
+ CallFunctionAccessFunction( aParams, "FV", rPar.Get32( 0 ) );
+}
+
+void SbRtl_DDB(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 4 || nArgCount > 5 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double cost = rPar.Get32(1)->GetDouble();
+ double salvage = rPar.Get32(2)->GetDouble();
+ double life = rPar.Get32(3)->GetDouble();
+ double period = rPar.Get32(4)->GetDouble();
+
+ // set default values for Optional args
+ double factor = 2;
+
+ // factor
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ factor = rPar.Get32(5)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 5 );
+ aParams[ 0 ] <<= cost;
+ aParams[ 1 ] <<= salvage;
+ aParams[ 2 ] <<= life;
+ aParams[ 3 ] <<= period;
+ aParams[ 4 ] <<= factor;
+
+ CallFunctionAccessFunction( aParams, "DDB", rPar.Get32( 0 ) );
+}
+
+void SbRtl_Rate(StarBASIC *, SbxArray & rPar, bool)
+{
+ sal_uInt32 nArgCount = rPar.Count32()-1;
+
+ if ( nArgCount < 3 || nArgCount > 6 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+ // retrieve non-optional params
+
+ double nper = 0;
+ double pmt = 0;
+ double pv = 0;
+
+ nper = rPar.Get32(1)->GetDouble();
+ pmt = rPar.Get32(2)->GetDouble();
+ pv = rPar.Get32(3)->GetDouble();
+
+ // set default values for Optional args
+ double fv = 0;
+ double type = 0;
+ double guess = 0.1;
+
+ // fv
+ if ( nArgCount >= 4 )
+ {
+ if( rPar.Get32(4)->GetType() != SbxEMPTY )
+ fv = rPar.Get32(4)->GetDouble();
+ }
+
+ // type
+ if ( nArgCount >= 5 )
+ {
+ if( rPar.Get32(5)->GetType() != SbxEMPTY )
+ type = rPar.Get32(5)->GetDouble();
+ }
+
+ // guess
+ if ( nArgCount >= 6 )
+ {
+ if( rPar.Get32(6)->GetType() != SbxEMPTY )
+ guess = rPar.Get32(6)->GetDouble();
+ }
+
+ Sequence< Any > aParams( 6 );
+ aParams[ 0 ] <<= nper;
+ aParams[ 1 ] <<= pmt;
+ aParams[ 2 ] <<= pv;
+ aParams[ 3 ] <<= fv;
+ aParams[ 4 ] <<= type;
+ aParams[ 5 ] <<= guess;
+
+ CallFunctionAccessFunction( aParams, "Rate", rPar.Get32( 0 ) );
+}
+
+void SbRtl_StrReverse(StarBASIC *, SbxArray & rPar, bool)
+{
+ if ( rPar.Count32() != 2 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ SbxVariable *pSbxVariable = rPar.Get32(1);
+ if( pSbxVariable->IsNull() )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ OUString aStr = comphelper::string::reverseString(pSbxVariable->GetOUString());
+ rPar.Get32(0)->PutString( aStr );
+}
+
+void SbRtl_CompatibilityMode(StarBASIC *, SbxArray & rPar, bool)
+{
+ bool bEnabled = false;
+ sal_uInt32 nCount = rPar.Count32();
+ if ( nCount != 1 && nCount != 2 )
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+
+ SbiInstance* pInst = GetSbData()->pInst;
+ if( pInst )
+ {
+ if ( nCount == 2 )
+ {
+ pInst->EnableCompatibility( rPar.Get32(1)->GetBool() );
+ }
+ bEnabled = pInst->IsCompatibility();
+ }
+ rPar.Get32(0)->PutBool( bEnabled );
+}
+
+void SbRtl_Input(StarBASIC *, SbxArray & rPar, bool)
+{
+ // 2 parameters needed
+ if ( rPar.Count32() < 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ sal_uInt16 nByteCount = rPar.Get32(1)->GetUShort();
+ sal_Int16 nFileNumber = rPar.Get32(2)->GetInteger();
+
+ SbiIoSystem* pIosys = GetSbData()->pInst->GetIoSystem();
+ SbiStream* pSbStrm = pIosys->GetStream( nFileNumber );
+ if ( !pSbStrm || !(pSbStrm->GetMode() & (SbiStreamFlags::Binary | SbiStreamFlags::Input)) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_CHANNEL );
+ return;
+ }
+
+ OString aByteBuffer;
+ ErrCode err = pSbStrm->Read( aByteBuffer, nByteCount, true );
+ if( !err )
+ err = pIosys->GetError();
+
+ if( err )
+ {
+ StarBASIC::Error( err );
+ return;
+ }
+ rPar.Get32(0)->PutString(OStringToOUString(aByteBuffer, osl_getThreadTextEncoding()));
+}
+
+void SbRtl_Me(StarBASIC *, SbxArray & rPar, bool)
+{
+ SbModule* pActiveModule = GetSbData()->pInst->GetActiveModule();
+ SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pActiveModule );
+ SbxVariableRef refVar = rPar.Get32(0);
+ if( pClassModuleObject == nullptr )
+ {
+ SbObjModule* pMod = dynamic_cast<SbObjModule*>( pActiveModule );
+ if ( pMod )
+ refVar->PutObject( pMod );
+ else
+ StarBASIC::Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ }
+ else
+ refVar->PutObject( pClassModuleObject );
+}
+
+#endif
+
+sal_Int16 implGetWeekDay( double aDate, bool bFirstDayParam, sal_Int16 nFirstDay )
+{
+ Date aRefDate( 1,1,1900 );
+ sal_Int32 nDays = static_cast<sal_Int32>(aDate);
+ nDays -= 2; // normalize: 1.1.1900 => 0
+ aRefDate.AddDays( nDays);
+ DayOfWeek aDay = aRefDate.GetDayOfWeek();
+ sal_Int16 nDay;
+ if ( aDay != SUNDAY )
+ nDay = static_cast<sal_Int16>(aDay) + 2;
+ else
+ nDay = 1; // 1 == Sunday
+
+ // #117253 optional 2nd parameter "firstdayofweek"
+ if( bFirstDayParam )
+ {
+ if( nFirstDay < 0 || nFirstDay > 7 )
+ {
+#if HAVE_FEATURE_SCRIPTING
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+#endif
+ return 0;
+ }
+ if( nFirstDay == 0 )
+ {
+ const Reference< XCalendar4 >& xCalendar = getLocaleCalendar();
+ if( !xCalendar.is() )
+ {
+#if HAVE_FEATURE_SCRIPTING
+ StarBASIC::Error( ERRCODE_BASIC_INTERNAL_ERROR );
+#endif
+ return 0;
+ }
+ nFirstDay = sal_Int16( xCalendar->getFirstDayOfWeek() + 1 );
+ }
+ nDay = 1 + (nDay + 7 - nFirstDay) % 7;
+ }
+ return nDay;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/props.cxx b/basic/source/runtime/props.cxx
new file mode 100644
index 000000000..1d81ee727
--- /dev/null
+++ b/basic/source/runtime/props.cxx
@@ -0,0 +1,448 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <runtime.hxx>
+#include <rtlproto.hxx>
+#include <errobject.hxx>
+#include <basegfx/numeric/ftools.hxx>
+
+
+// Properties and methods lay the return value down at Get (bWrite = sal_False)
+// at the element 0 of the Argv; at Put (bWrite = sal_True) the value from
+// element 0 is stored.
+
+void SbRtl_Erl(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutLong( StarBASIC::GetErl() );
+}
+
+void SbRtl_Err(StarBASIC *, SbxArray & rPar, bool bWrite)
+{
+ if( SbiRuntime::isVBAEnabled() )
+ {
+ rPar.Get32(0)->PutObject( SbxErrObject::getErrObject().get() );
+ }
+ else
+ {
+ if( bWrite )
+ {
+ sal_Int32 nVal = rPar.Get32(0)->GetLong();
+ if( nVal <= 65535 )
+ StarBASIC::Error( StarBASIC::GetSfxFromVBError( static_cast<sal_uInt16>(nVal) ) );
+ }
+ else
+ rPar.Get32(0)->PutLong( StarBASIC::GetVBErrorCode( StarBASIC::GetErrBasic() ) );
+ }
+}
+
+void SbRtl_False(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutBool( false );
+}
+
+void SbRtl_Empty(StarBASIC *, SbxArray &, bool) {}
+
+void SbRtl_Nothing(StarBASIC *, SbxArray & rPar, bool)
+{
+ // return an empty object
+ rPar.Get32(0)->PutObject( nullptr );
+}
+
+void SbRtl_Null(StarBASIC *, SbxArray & rPar, bool)
+{
+ // returns an empty object-variable
+ rPar.Get32(0)->PutNull();
+}
+
+void SbRtl_PI(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutDouble( F_PI );
+}
+
+void SbRtl_True(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutBool( true );
+}
+
+void SbRtl_ATTR_NORMAL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+void SbRtl_ATTR_READONLY(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_ATTR_HIDDEN(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+void SbRtl_ATTR_SYSTEM(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(4);
+}
+void SbRtl_ATTR_VOLUME(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(8);
+}
+void SbRtl_ATTR_DIRECTORY(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(16);
+}
+void SbRtl_ATTR_ARCHIVE(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(32);
+}
+
+void SbRtl_V_EMPTY(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+void SbRtl_V_NULL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_V_INTEGER(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+void SbRtl_V_LONG(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(3);
+}
+void SbRtl_V_SINGLE(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(4);
+}
+void SbRtl_V_DOUBLE(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(5);
+}
+void SbRtl_V_CURRENCY(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(6);
+}
+void SbRtl_V_DATE(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(7);
+}
+void SbRtl_V_STRING(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(8);
+}
+
+void SbRtl_MB_OK(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+void SbRtl_MB_OKCANCEL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_MB_ABORTRETRYIGNORE(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+void SbRtl_MB_YESNOCANCEL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(3);
+}
+void SbRtl_MB_YESNO(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(4);
+}
+void SbRtl_MB_RETRYCANCEL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(5);
+}
+void SbRtl_MB_ICONSTOP(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(16);
+}
+void SbRtl_MB_ICONQUESTION(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(32);
+}
+void SbRtl_MB_ICONEXCLAMATION(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(48);
+}
+void SbRtl_MB_ICONINFORMATION(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(64);
+}
+void SbRtl_MB_DEFBUTTON1(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+void SbRtl_MB_DEFBUTTON2(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(256);
+}
+void SbRtl_MB_DEFBUTTON3(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(512);
+}
+void SbRtl_MB_APPLMODAL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+void SbRtl_MB_SYSTEMMODAL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(4096);
+}
+
+void SbRtl_IDOK(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+
+void SbRtl_IDCANCEL(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+void SbRtl_IDABORT(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(3);
+}
+void SbRtl_IDRETRY(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(4);
+}
+void SbRtl_IDYES(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(6);
+}
+void SbRtl_IDNO(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(7);
+}
+
+void SbRtl_CF_TEXT(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_CF_BITMAP(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+void SbRtl_CF_METAFILEPICT(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(3);
+}
+
+void SbRtl_TYP_AUTHORFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(7);
+}
+void SbRtl_TYP_CHAPTERFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(4);
+}
+void SbRtl_TYP_CONDTXTFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(27);
+}
+void SbRtl_TYP_DATEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+void SbRtl_TYP_DBFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(19);
+}
+void SbRtl_TYP_DBNAMEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(3);
+}
+void SbRtl_TYP_DBNEXTSETFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(24);
+}
+void SbRtl_TYP_DBNUMSETFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(25);
+}
+void SbRtl_TYP_DBSETNUMBERFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(26);
+}
+void SbRtl_TYP_DDEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(14);
+}
+void SbRtl_TYP_DOCINFOFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(18);
+}
+void SbRtl_TYP_DOCSTATFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(6);
+}
+void SbRtl_TYP_EXTUSERFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(30);
+}
+void SbRtl_TYP_FILENAMEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+void SbRtl_TYP_FIXDATEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(31);
+}
+void SbRtl_TYP_FIXTIMEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(32);
+}
+void SbRtl_TYP_FORMELFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(10);
+}
+void SbRtl_TYP_GETFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(9);
+}
+void SbRtl_TYP_GETREFFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(13);
+}
+void SbRtl_TYP_HIDDENPARAFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(17);
+}
+void SbRtl_TYP_HIDDENTXTFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(11);
+}
+void SbRtl_TYP_INPUTFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(16);
+}
+void SbRtl_TYP_MACROFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(15);
+}
+void SbRtl_TYP_NEXTPAGEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(28);
+}
+void SbRtl_TYP_PAGENUMBERFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(5);
+}
+void SbRtl_TYP_POSTITFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(21);
+}
+void SbRtl_TYP_PREVPAGEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(29);
+}
+void SbRtl_TYP_SEQFLD(StarBASIC * , SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(23);
+}
+void SbRtl_TYP_SETFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(8);
+}
+void SbRtl_TYP_SETINPFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(33);
+}
+void SbRtl_TYP_SETREFFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(12);
+}
+void SbRtl_TYP_TEMPLNAMEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(22);
+}
+void SbRtl_TYP_TIMEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_TYP_USERFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(20);
+}
+void SbRtl_TYP_USRINPFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(34);
+}
+void SbRtl_TYP_SETREFPAGEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(35);
+}
+void SbRtl_TYP_GETREFPAGEFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(36);
+}
+void SbRtl_TYP_INTERNETFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(37);
+}
+
+void SbRtl_SET_ON(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_SET_OFF(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+void SbRtl_TOGGLE(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+
+void SbRtl_FRAMEANCHORPAGE(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_FRAMEANCHORPARA(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(14);
+}
+void SbRtl_FRAMEANCHORCHAR(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(15);
+}
+
+void SbRtl_CLEAR_ALLTABS(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(2);
+}
+void SbRtl_CLEAR_TAB(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(1);
+}
+void SbRtl_SET_TAB(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(0);
+}
+
+void SbRtl_TYP_JUMPEDITFLD(StarBASIC *, SbxArray & rPar, bool)
+{
+ rPar.Get32(0)->PutInteger(38);
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/runtime.cxx b/basic/source/runtime/runtime.cxx
new file mode 100644
index 000000000..cf05da0f0
--- /dev/null
+++ b/basic/source/runtime/runtime.cxx
@@ -0,0 +1,4641 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <stdlib.h>
+
+#include <algorithm>
+#include <string_view>
+#include <unordered_map>
+
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/container/XEnumerationAccess.hpp>
+#include <com/sun/star/container/XIndexAccess.hpp>
+#include <com/sun/star/script/XDefaultMethod.hpp>
+#include <com/sun/star/uno/Any.hxx>
+#include <com/sun/star/util/SearchAlgorithms2.hpp>
+
+#include <comphelper/processfactory.hxx>
+#include <comphelper/string.hxx>
+#include <o3tl/safeint.hxx>
+#include <sal/log.hxx>
+
+#include <tools/wldcrd.hxx>
+#include <tools/diagnose_ex.h>
+
+#include <vcl/svapp.hxx>
+#include <vcl/settings.hxx>
+
+#include <rtl/instance.hxx>
+#include <rtl/math.hxx>
+#include <rtl/ustrbuf.hxx>
+#include <rtl/character.hxx>
+
+#include <svl/zforlist.hxx>
+
+#include <i18nutil/searchopt.hxx>
+#include <unotools/syslocale.hxx>
+#include <unotools/textsearch.hxx>
+
+#include <basic/sbuno.hxx>
+
+#include <codegen.hxx>
+#include "comenumwrapper.hxx"
+#include "ddectrl.hxx"
+#include "dllmgr.hxx"
+#include <errobject.hxx>
+#include <image.hxx>
+#include <iosys.hxx>
+#include <opcodes.hxx>
+#include <runtime.hxx>
+#include <sb.hxx>
+#include <sbintern.hxx>
+#include <sbprop.hxx>
+#include <sbunoobj.hxx>
+#include <basic/codecompletecache.hxx>
+#include <memory>
+
+using com::sun::star::uno::Reference;
+
+using namespace com::sun::star::uno;
+using namespace com::sun::star::container;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::beans;
+using namespace com::sun::star::script;
+
+using namespace ::com::sun::star;
+
+static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType );
+static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled );
+
+bool SbiRuntime::isVBAEnabled()
+{
+ bool bResult = false;
+ SbiInstance* pInst = GetSbData()->pInst;
+ if ( pInst && GetSbData()->pInst->pRun )
+ bResult = pInst->pRun->bVBAEnabled;
+ return bResult;
+}
+
+void StarBASIC::SetVBAEnabled( bool bEnabled )
+{
+ if ( bDocBasic )
+ {
+ bVBAEnabled = bEnabled;
+ }
+}
+
+bool StarBASIC::isVBAEnabled() const
+{
+ if ( bDocBasic )
+ {
+ if( SbiRuntime::isVBAEnabled() )
+ return true;
+ return bVBAEnabled;
+ }
+ return false;
+}
+
+struct SbiArgv { // Argv stack:
+ SbxArrayRef refArgv; // Argv
+ short nArgc; // Argc
+
+ SbiArgv(SbxArrayRef const & refArgv_, short nArgc_) :
+ refArgv(refArgv_),
+ nArgc(nArgc_) {}
+};
+
+struct SbiGosub { // GOSUB-Stack:
+ const sal_uInt8* pCode; // Return-Pointer
+ sal_uInt16 nStartForLvl; // #118235: For Level in moment of gosub
+
+ SbiGosub(const sal_uInt8* pCode_, sal_uInt16 nStartForLvl_) :
+ pCode(pCode_),
+ nStartForLvl(nStartForLvl_) {}
+};
+
+SbiRuntime::pStep0 SbiRuntime::aStep0[] = { // all opcodes without operands
+ &SbiRuntime::StepNOP,
+ &SbiRuntime::StepEXP,
+ &SbiRuntime::StepMUL,
+ &SbiRuntime::StepDIV,
+ &SbiRuntime::StepMOD,
+ &SbiRuntime::StepPLUS,
+ &SbiRuntime::StepMINUS,
+ &SbiRuntime::StepNEG,
+ &SbiRuntime::StepEQ,
+ &SbiRuntime::StepNE,
+ &SbiRuntime::StepLT,
+ &SbiRuntime::StepGT,
+ &SbiRuntime::StepLE,
+ &SbiRuntime::StepGE,
+ &SbiRuntime::StepIDIV,
+ &SbiRuntime::StepAND,
+ &SbiRuntime::StepOR,
+ &SbiRuntime::StepXOR,
+ &SbiRuntime::StepEQV,
+ &SbiRuntime::StepIMP,
+ &SbiRuntime::StepNOT,
+ &SbiRuntime::StepCAT,
+
+ &SbiRuntime::StepLIKE,
+ &SbiRuntime::StepIS,
+ // load/save
+ &SbiRuntime::StepARGC, // establish new Argv
+ &SbiRuntime::StepARGV, // TOS ==> current Argv
+ &SbiRuntime::StepINPUT, // Input ==> TOS
+ &SbiRuntime::StepLINPUT, // Line Input ==> TOS
+ &SbiRuntime::StepGET, // touch TOS
+ &SbiRuntime::StepSET, // save object TOS ==> TOS-1
+ &SbiRuntime::StepPUT, // TOS ==> TOS-1
+ &SbiRuntime::StepPUTC, // TOS ==> TOS-1, then ReadOnly
+ &SbiRuntime::StepDIM, // DIM
+ &SbiRuntime::StepREDIM, // REDIM
+ &SbiRuntime::StepREDIMP, // REDIM PRESERVE
+ &SbiRuntime::StepERASE, // delete TOS
+ // branch
+ &SbiRuntime::StepSTOP, // program end
+ &SbiRuntime::StepINITFOR, // initialize FOR-Variable
+ &SbiRuntime::StepNEXT, // increment FOR-Variable
+ &SbiRuntime::StepCASE, // beginning CASE
+ &SbiRuntime::StepENDCASE, // end CASE
+ &SbiRuntime::StepSTDERROR, // standard error handling
+ &SbiRuntime::StepNOERROR, // no error handling
+ &SbiRuntime::StepLEAVE, // leave UP
+ // E/A
+ &SbiRuntime::StepCHANNEL, // TOS = channel number
+ &SbiRuntime::StepPRINT, // print TOS
+ &SbiRuntime::StepPRINTF, // print TOS in field
+ &SbiRuntime::StepWRITE, // write TOS
+ &SbiRuntime::StepRENAME, // Rename Tos+1 to Tos
+ &SbiRuntime::StepPROMPT, // define Input Prompt from TOS
+ &SbiRuntime::StepRESTART, // Set restart point
+ &SbiRuntime::StepCHANNEL0, // set E/A-channel 0
+ &SbiRuntime::StepEMPTY, // empty expression on stack
+ &SbiRuntime::StepERROR, // TOS = error code
+ &SbiRuntime::StepLSET, // save object TOS ==> TOS-1
+ &SbiRuntime::StepRSET, // save object TOS ==> TOS-1
+ &SbiRuntime::StepREDIMP_ERASE,// Copy array object for REDIMP
+ &SbiRuntime::StepINITFOREACH,// Init for each loop
+ &SbiRuntime::StepVBASET,// vba-like set statement
+ &SbiRuntime::StepERASE_CLEAR,// vba-like set statement
+ &SbiRuntime::StepARRAYACCESS,// access TOS as array
+ &SbiRuntime::StepBYVAL, // access TOS as array
+};
+
+SbiRuntime::pStep1 SbiRuntime::aStep1[] = { // all opcodes with one operand
+ &SbiRuntime::StepLOADNC, // loading a numeric constant (+ID)
+ &SbiRuntime::StepLOADSC, // loading a string constant (+ID)
+ &SbiRuntime::StepLOADI, // Immediate Load (+value)
+ &SbiRuntime::StepARGN, // save a named Args in Argv (+StringID)
+ &SbiRuntime::StepPAD, // bring string to a definite length (+length)
+ // branches
+ &SbiRuntime::StepJUMP, // jump (+Target)
+ &SbiRuntime::StepJUMPT, // evaluate TOS, conditional jump (+Target)
+ &SbiRuntime::StepJUMPF, // evaluate TOS, conditional jump (+Target)
+ &SbiRuntime::StepONJUMP, // evaluate TOS, jump into JUMP-table (+MaxVal)
+ &SbiRuntime::StepGOSUB, // UP-call (+Target)
+ &SbiRuntime::StepRETURN, // UP-return (+0 or Target)
+ &SbiRuntime::StepTESTFOR, // check FOR-variable, increment (+Endlabel)
+ &SbiRuntime::StepCASETO, // Tos+1 <= Case <= Tos), 2xremove (+Target)
+ &SbiRuntime::StepERRHDL, // error handler (+Offset)
+ &SbiRuntime::StepRESUME, // resume after errors (+0 or 1 or Label)
+ // E/A
+ &SbiRuntime::StepCLOSE, // (+channel/0)
+ &SbiRuntime::StepPRCHAR, // (+char)
+ // management
+ &SbiRuntime::StepSETCLASS, // check set + class names (+StringId)
+ &SbiRuntime::StepTESTCLASS, // Check TOS class (+StringId)
+ &SbiRuntime::StepLIB, // lib for declare-call (+StringId)
+ &SbiRuntime::StepBASED, // TOS is incremented by BASE, BASE is pushed before
+ &SbiRuntime::StepARGTYP, // convert last parameter in Argv (+Type)
+ &SbiRuntime::StepVBASETCLASS,// vba-like set statement
+};
+
+SbiRuntime::pStep2 SbiRuntime::aStep2[] = {// all opcodes with two operands
+ &SbiRuntime::StepRTL, // load from RTL (+StringID+Typ)
+ &SbiRuntime::StepFIND, // load (+StringID+Typ)
+ &SbiRuntime::StepELEM, // load element (+StringID+Typ)
+ &SbiRuntime::StepPARAM, // Parameter (+Offset+Typ)
+ // branches
+ &SbiRuntime::StepCALL, // Declare-Call (+StringID+Typ)
+ &SbiRuntime::StepCALLC, // CDecl-Declare-Call (+StringID+Typ)
+ &SbiRuntime::StepCASEIS, // Case-Test (+Test-Opcode+False-Target)
+ // management
+ &SbiRuntime::StepSTMNT, // beginning of a statement (+Line+Col)
+ // E/A
+ &SbiRuntime::StepOPEN, // (+StreamMode+Flags)
+ // Objects
+ &SbiRuntime::StepLOCAL, // define local variable (+StringId+Typ)
+ &SbiRuntime::StepPUBLIC, // module global variable (+StringID+Typ)
+ &SbiRuntime::StepGLOBAL, // define global variable (+StringID+Typ)
+ &SbiRuntime::StepCREATE, // create object (+StringId+StringId)
+ &SbiRuntime::StepSTATIC, // static variable (+StringId+StringId)
+ &SbiRuntime::StepTCREATE, // user-defined objects (+StringId+StringId)
+ &SbiRuntime::StepDCREATE, // create object-array (+StringID+StringID)
+ &SbiRuntime::StepGLOBAL_P, // define global variable which is not overwritten
+ // by the Basic on a restart (+StringID+Typ)
+ &SbiRuntime::StepFIND_G, // finds global variable with special treatment because of _GLOBAL_P
+ &SbiRuntime::StepDCREATE_REDIMP, // redimension object array (+StringID+StringID)
+ &SbiRuntime::StepFIND_CM, // Search inside a class module (CM) to enable global search in time
+ &SbiRuntime::StepPUBLIC_P, // Search inside a class module (CM) to enable global search in time
+ &SbiRuntime::StepFIND_STATIC, // Search inside a class module (CM) to enable global search in time
+};
+
+
+// SbiRTLData
+
+SbiRTLData::SbiRTLData()
+{
+ nDirFlags = SbAttributes::NONE;
+ nCurDirPos = 0;
+}
+
+SbiRTLData::~SbiRTLData()
+{
+}
+
+// SbiInstance
+
+// 16.10.96: #31460 new concept for StepInto/Over/Out
+// The decision whether StepPoint shall be called is done with the help of
+// the CallLevel. It's stopped when the current CallLevel is <= nBreakCallLvl.
+// The current CallLevel can never be smaller than 1, as it's also incremented
+// during the call of a method (also main). Therefore a BreakCallLvl from 0
+// means that the program isn't stopped at all.
+// (also have a look at: step2.cxx, SbiRuntime::StepSTMNT() )
+
+
+void SbiInstance::CalcBreakCallLevel( BasicDebugFlags nFlags )
+{
+
+ nFlags &= ~BasicDebugFlags::Break;
+
+ sal_uInt16 nRet;
+ if (nFlags == BasicDebugFlags::StepInto) {
+ nRet = nCallLvl + 1; // CallLevel+1 is also stopped
+ } else if (nFlags == (BasicDebugFlags::StepOver | BasicDebugFlags::StepInto)) {
+ nRet = nCallLvl; // current CallLevel is stopped
+ } else if (nFlags == BasicDebugFlags::StepOut) {
+ nRet = nCallLvl - 1; // smaller CallLevel is stopped
+ } else {
+ // Basic-IDE returns 0 instead of BasicDebugFlags::Continue, so also default=continue
+ nRet = 0; // CallLevel is always > 0 -> no StepPoint
+ }
+ nBreakCallLvl = nRet; // take result
+}
+
+SbiInstance::SbiInstance( StarBASIC* p )
+ : pIosys(new SbiIoSystem)
+ , pDdeCtrl(new SbiDdeControl)
+ , pBasic(p)
+ , meFormatterLangType(LANGUAGE_DONTKNOW)
+ , meFormatterDateOrder(DateOrder::YMD)
+ , nStdDateIdx(0)
+ , nStdTimeIdx(0)
+ , nStdDateTimeIdx(0)
+ , nErr(0)
+ , nErl(0)
+ , bReschedule(true)
+ , bCompatibility(false)
+ , pRun(nullptr)
+ , nCallLvl(0)
+ , nBreakCallLvl(0)
+{
+}
+
+SbiInstance::~SbiInstance()
+{
+ while( pRun )
+ {
+ SbiRuntime* p = pRun->pNext;
+ delete pRun;
+ pRun = p;
+ }
+
+ try
+ {
+ int nSize = ComponentVector.size();
+ if( nSize )
+ {
+ for( int i = nSize - 1 ; i >= 0 ; --i )
+ {
+ Reference< XComponent > xDlgComponent = ComponentVector[i];
+ if( xDlgComponent.is() )
+ xDlgComponent->dispose();
+ }
+ }
+ }
+ catch( const Exception& )
+ {
+ TOOLS_WARN_EXCEPTION("basic", "SbiInstance::~SbiInstance: caught an exception while disposing the components" );
+ }
+}
+
+SbiDllMgr* SbiInstance::GetDllMgr()
+{
+ if( !pDllMgr )
+ {
+ pDllMgr.reset(new SbiDllMgr);
+ }
+ return pDllMgr.get();
+}
+
+// #39629 create NumberFormatter with the help of a static method now
+std::shared_ptr<SvNumberFormatter> const & SbiInstance::GetNumberFormatter()
+{
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ SvtSysLocale aSysLocale;
+ DateOrder eDate = aSysLocale.GetLocaleData().getDateOrder();
+ if( pNumberFormatter )
+ {
+ if( eLangType != meFormatterLangType ||
+ eDate != meFormatterDateOrder )
+ {
+ pNumberFormatter.reset();
+ }
+ }
+ meFormatterLangType = eLangType;
+ meFormatterDateOrder = eDate;
+ if( !pNumberFormatter )
+ {
+ pNumberFormatter = PrepareNumberFormatter( nStdDateIdx, nStdTimeIdx, nStdDateTimeIdx,
+ &meFormatterLangType, &meFormatterDateOrder);
+ }
+ return pNumberFormatter;
+}
+
+// #39629 offer NumberFormatter static too
+std::shared_ptr<SvNumberFormatter> SbiInstance::PrepareNumberFormatter( sal_uInt32 &rnStdDateIdx,
+ sal_uInt32 &rnStdTimeIdx, sal_uInt32 &rnStdDateTimeIdx,
+ LanguageType const * peFormatterLangType, DateOrder const * peFormatterDateOrder )
+{
+ LanguageType eLangType;
+ if( peFormatterLangType )
+ {
+ eLangType = *peFormatterLangType;
+ }
+ else
+ {
+ eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ }
+ DateOrder eDate;
+ if( peFormatterDateOrder )
+ {
+ eDate = *peFormatterDateOrder;
+ }
+ else
+ {
+ SvtSysLocale aSysLocale;
+ eDate = aSysLocale.GetLocaleData().getDateOrder();
+ }
+
+ std::shared_ptr<SvNumberFormatter> pNumberFormatter =
+ std::make_shared<SvNumberFormatter>( comphelper::getProcessComponentContext(), eLangType );
+
+ // Several parser methods pass SvNumberFormatter::IsNumberFormat() a number
+ // format index to parse against. Tell the formatter the proper date
+ // evaluation order, which also determines the date acceptance patterns to
+ // use if a format was passed. NF_EVALDATEFORMAT_FORMAT restricts to the
+ // format's locale's date patterns/order (no init/system locale match
+ // tried) and falls back to NF_EVALDATEFORMAT_INTL if no specific (i.e. 0)
+ // (or an unknown) format index was passed.
+ pNumberFormatter->SetEvalDateFormat( NF_EVALDATEFORMAT_FORMAT);
+
+ sal_Int32 nCheckPos = 0;
+ SvNumFormatType nType;
+ rnStdTimeIdx = pNumberFormatter->GetStandardFormat( SvNumFormatType::TIME, eLangType );
+
+ // the formatter's standard templates have only got a two-digit date
+ // -> registering an own format
+
+ // HACK, because the numberformatter doesn't swap the place holders
+ // for month, day and year according to the system setting.
+ // Problem: Print Year(Date) under engl. BS
+ // also have a look at: basic/source/sbx/sbxdate.cxx
+
+ OUString aDateStr;
+ switch( eDate )
+ {
+ default:
+ case DateOrder::MDY: aDateStr = "MM/DD/YYYY"; break;
+ case DateOrder::DMY: aDateStr = "DD/MM/YYYY"; break;
+ case DateOrder::YMD: aDateStr = "YYYY/MM/DD"; break;
+ }
+ OUString aStr( aDateStr ); // PutandConvertEntry() modifies string!
+ pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
+ rnStdDateIdx, LANGUAGE_ENGLISH_US, eLangType, true);
+ nCheckPos = 0;
+ aDateStr += " HH:MM:SS";
+ aStr = aDateStr;
+ pNumberFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
+ rnStdDateTimeIdx, LANGUAGE_ENGLISH_US, eLangType, true);
+ return pNumberFormatter;
+}
+
+
+// Let engine run. If Flags == BasicDebugFlags::Continue, take Flags over
+
+void SbiInstance::Stop()
+{
+ for( SbiRuntime* p = pRun; p; p = p->pNext )
+ {
+ p->Stop();
+ }
+}
+
+// Allows Basic IDE to set watch mode to suppress errors
+static bool bWatchMode = false;
+
+void setBasicWatchMode( bool bOn )
+{
+ bWatchMode = bOn;
+}
+
+void SbiInstance::Error( ErrCode n )
+{
+ Error( n, OUString() );
+}
+
+void SbiInstance::Error( ErrCode n, const OUString& rMsg )
+{
+ if( !bWatchMode )
+ {
+ aErrorMsg = rMsg;
+ pRun->Error( n );
+ }
+}
+
+void SbiInstance::ErrorVB( sal_Int32 nVBNumber, const OUString& rMsg )
+{
+ if( !bWatchMode )
+ {
+ ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
+ if ( !n )
+ {
+ n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors
+ }
+ aErrorMsg = rMsg;
+ SbiRuntime::translateErrorToVba( n, aErrorMsg );
+
+ pRun->Error( ERRCODE_BASIC_COMPAT, true/*bVBATranslationAlreadyDone*/ );
+ }
+}
+
+void SbiInstance::setErrorVB( sal_Int32 nVBNumber )
+{
+ ErrCode n = StarBASIC::GetSfxFromVBError( static_cast< sal_uInt16 >( nVBNumber ) );
+ if( !n )
+ {
+ n = ErrCode(nVBNumber); // force orig number, probably should have a specific table of vb ( localized ) errors
+ }
+ aErrorMsg = OUString();
+ SbiRuntime::translateErrorToVba( n, aErrorMsg );
+
+ nErr = n;
+}
+
+
+void SbiInstance::FatalError( ErrCode n )
+{
+ pRun->FatalError( n );
+}
+
+void SbiInstance::FatalError( ErrCode _errCode, const OUString& _details )
+{
+ pRun->FatalError( _errCode, _details );
+}
+
+void SbiInstance::Abort()
+{
+ StarBASIC* pErrBasic = GetCurrentBasic( pBasic );
+ pErrBasic->RTError( nErr, aErrorMsg, pRun->nLine, pRun->nCol1, pRun->nCol2 );
+ StarBASIC::Stop();
+}
+
+// can be unequal to pRTBasic
+StarBASIC* GetCurrentBasic( StarBASIC* pRTBasic )
+{
+ StarBASIC* pCurBasic = pRTBasic;
+ SbModule* pActiveModule = StarBASIC::GetActiveModule();
+ if( pActiveModule )
+ {
+ SbxObject* pParent = pActiveModule->GetParent();
+ if (StarBASIC *pBasic = dynamic_cast<StarBASIC*>(pParent))
+ pCurBasic = pBasic;
+ }
+ return pCurBasic;
+}
+
+SbModule* SbiInstance::GetActiveModule()
+{
+ if( pRun )
+ {
+ return pRun->GetModule();
+ }
+ else
+ {
+ return nullptr;
+ }
+}
+
+SbMethod* SbiInstance::GetCaller( sal_uInt16 nLevel )
+{
+ SbiRuntime* p = pRun;
+ while( nLevel-- && p )
+ {
+ p = p->pNext;
+ }
+ return p ? p->GetCaller() : nullptr;
+}
+
+// SbiInstance
+
+// Attention: pMeth can also be NULL (on a call of the init-code)
+
+SbiRuntime::SbiRuntime( SbModule* pm, SbMethod* pe, sal_uInt32 nStart )
+ : rBasic( *static_cast<StarBASIC*>(pm->pParent) ), pInst( GetSbData()->pInst ),
+ pMod( pm ), pMeth( pe ), pImg( pMod->pImage ), mpExtCaller(nullptr), m_nLastTime(0)
+{
+ nFlags = pe ? pe->GetDebugFlags() : BasicDebugFlags::NONE;
+ pIosys = pInst->GetIoSystem();
+ pForStk = nullptr;
+ pError = nullptr;
+ pErrCode =
+ pErrStmnt =
+ pRestart = nullptr;
+ pNext = nullptr;
+ pCode =
+ pStmnt = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nStart;
+ bRun =
+ bError = true;
+ bInError = false;
+ bBlocked = false;
+ nLine = 0;
+ nCol1 = 0;
+ nCol2 = 0;
+ nExprLvl = 0;
+ nArgc = 0;
+ nError = ERRCODE_NONE;
+ nForLvl = 0;
+ nOps = 0;
+ refExprStk = new SbxArray;
+ SetVBAEnabled( pMod->IsVBACompat() );
+ SetParameters( pe ? pe->GetParameters() : nullptr );
+}
+
+SbiRuntime::~SbiRuntime()
+{
+ ClearArgvStack();
+ ClearForStack();
+}
+
+void SbiRuntime::SetVBAEnabled(bool bEnabled )
+{
+ bVBAEnabled = bEnabled;
+ if ( bVBAEnabled )
+ {
+ if ( pMeth )
+ {
+ mpExtCaller = pMeth->mCaller;
+ }
+ }
+ else
+ {
+ mpExtCaller = nullptr;
+ }
+}
+
+// tdf#79426, tdf#125180 - adds the information about a missing parameter
+void SbiRuntime::SetIsMissing( SbxVariable* pVar )
+{
+ SbxInfo* pInfo = pVar->GetInfo() ? pVar->GetInfo() : new SbxInfo();
+ pInfo->AddParam( pVar->GetName(), SbxMISSING, pVar->GetFlags() );
+ pVar->SetInfo( pInfo );
+}
+
+// tdf#79426, tdf#125180 - checks if a variable contains the information about a missing parameter
+bool SbiRuntime::IsMissing( SbxVariable* pVar, sal_uInt16 nIdx )
+{
+ return pVar->GetInfo() && pVar->GetInfo()->GetParam( nIdx ) && pVar->GetInfo()->GetParam( nIdx )->eType & SbxMISSING;
+}
+
+// Construction of the parameter list. All ByRef-parameters are directly
+// taken over; copies of ByVal-parameters are created. If a particular
+// data type is requested, it is converted.
+
+void SbiRuntime::SetParameters( SbxArray* pParams )
+{
+ refParams = new SbxArray;
+ // for the return value
+ refParams->Put32( pMeth, 0 );
+
+ SbxInfo* pInfo = pMeth ? pMeth->GetInfo() : nullptr;
+ sal_uInt32 nParamCount = pParams ? pParams->Count32() : 1;
+ assert(nParamCount <= std::numeric_limits<sal_uInt16>::max());
+ if( nParamCount > 1 )
+ {
+ for( sal_uInt32 i = 1 ; i < nParamCount ; i++ )
+ {
+ const SbxParamInfo* p = pInfo ? pInfo->GetParam( sal::static_int_cast<sal_uInt16>(i) ) : nullptr;
+
+ // #111897 ParamArray
+ if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
+ {
+ SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
+ sal_uInt32 nParamArrayParamCount = nParamCount - i;
+ pArray->unoAddDim32( 0, nParamArrayParamCount - 1 );
+ for (sal_uInt32 j = i; j < nParamCount ; ++j)
+ {
+ SbxVariable* v = pParams->Get32( j );
+ sal_Int32 aDimIndex[1];
+ aDimIndex[0] = j - i;
+ pArray->Put32(v, aDimIndex);
+ }
+ SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
+ pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
+ pArrayVar->PutObject( pArray );
+ refParams->Put32( pArrayVar, i );
+
+ // Block ParamArray for missing parameter
+ pInfo = nullptr;
+ break;
+ }
+
+ SbxVariable* v = pParams->Get32( i );
+ // methods are always byval!
+ bool bByVal = dynamic_cast<const SbxMethod *>(v) != nullptr;
+ SbxDataType t = v->GetType();
+ bool bTargetTypeIsArray = false;
+ if( p )
+ {
+ bByVal |= ( p->eType & SbxBYREF ) == 0;
+ // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
+ if ( !IsMissing( v, 1 ) )
+ {
+ t = static_cast<SbxDataType>( p->eType & 0x0FFF );
+ }
+
+ if( !bByVal && t != SbxVARIANT &&
+ (!v->IsFixed() || static_cast<SbxDataType>(v->GetType() & 0x0FFF ) != t) )
+ {
+ bByVal = true;
+ }
+
+ bTargetTypeIsArray = (p->nUserData & PARAM_INFO_WITHBRACKETS) != 0;
+ }
+ if( bByVal )
+ {
+ // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
+ if( bTargetTypeIsArray && !IsMissing( v, 1 ) )
+ {
+ t = SbxOBJECT;
+ }
+ SbxVariable* v2 = new SbxVariable( t );
+ v2->SetFlag( SbxFlagBits::ReadWrite );
+ // tdf#79426, tdf#125180 - if parameter was missing, readd additional information about a missing parameter
+ if ( IsMissing( v, 1 ) )
+ {
+ SetIsMissing( v2 );
+ }
+ *v2 = *v;
+ refParams->Put32( v2, i );
+ }
+ else
+ {
+ // tdf#79426, tdf#125180 - don't convert missing arguments to the requested parameter type
+ if( t != SbxVARIANT && !IsMissing( v, 1 ) && t != ( v->GetType() & 0x0FFF ) )
+ {
+ if( p && (p->eType & SbxARRAY) )
+ {
+ Error( ERRCODE_BASIC_CONVERSION );
+ }
+ else
+ {
+ v->Convert( t );
+ }
+ }
+ refParams->Put32( v, i );
+ }
+ if( p )
+ {
+ refParams->PutAlias32( p->aName, i );
+ }
+ }
+ }
+
+ // ParamArray for missing parameter
+ if( !pInfo )
+ return;
+
+ // #111897 Check first missing parameter for ParamArray
+ const SbxParamInfo* p = pInfo->GetParam(sal::static_int_cast<sal_uInt16>(nParamCount));
+ if( p && (p->nUserData & PARAM_INFO_PARAMARRAY) != 0 )
+ {
+ SbxDimArray* pArray = new SbxDimArray( SbxVARIANT );
+ pArray->unoAddDim32( 0, -1 );
+ SbxVariable* pArrayVar = new SbxVariable( SbxVARIANT );
+ pArrayVar->SetFlag( SbxFlagBits::ReadWrite );
+ pArrayVar->PutObject( pArray );
+ refParams->Put32( pArrayVar, nParamCount );
+ }
+}
+
+
+// execute a P-Code
+
+bool SbiRuntime::Step()
+{
+ if( bRun )
+ {
+ // in any case check casually!
+ if( !( ++nOps & 0xF ) && pInst->IsReschedule() )
+ {
+ sal_uInt32 nTime = osl_getGlobalTimer();
+ if (nTime - m_nLastTime > 5 ) // 20 ms
+ {
+ Application::Reschedule();
+ m_nLastTime = nTime;
+ }
+ }
+
+ // #i48868 blocked by next call level?
+ while( bBlocked )
+ {
+ if( pInst->IsReschedule() )
+ {
+ Application::Reschedule();
+ }
+ }
+
+ SbiOpcode eOp = static_cast<SbiOpcode>( *pCode++ );
+ sal_uInt32 nOp1, nOp2;
+ if (eOp <= SbiOpcode::SbOP0_END)
+ {
+ (this->*( aStep0[ int(eOp) ] ) )();
+ }
+ else if (eOp >= SbiOpcode::SbOP1_START && eOp <= SbiOpcode::SbOP1_END)
+ {
+ nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
+
+ (this->*( aStep1[ int(eOp) - int(SbiOpcode::SbOP1_START) ] ) )( nOp1 );
+ }
+ else if (eOp >= SbiOpcode::SbOP2_START && eOp <= SbiOpcode::SbOP2_END)
+ {
+ nOp1 = *pCode++; nOp1 |= *pCode++ << 8; nOp1 |= *pCode++ << 16; nOp1 |= *pCode++ << 24;
+ nOp2 = *pCode++; nOp2 |= *pCode++ << 8; nOp2 |= *pCode++ << 16; nOp2 |= *pCode++ << 24;
+ (this->*( aStep2[ int(eOp) - int(SbiOpcode::SbOP2_START) ] ) )( nOp1, nOp2 );
+ }
+ else
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+
+ ErrCode nErrCode = SbxBase::GetError();
+ Error( nErrCode.IgnoreWarning() );
+
+ // from 13.2.1997, new error handling:
+ // ATTENTION: nError can be set already even if !nErrCode
+ // since nError can now also be set from other RT-instances
+
+ if( nError )
+ {
+ SbxBase::ResetError();
+ }
+
+ // from 15.3.96: display errors only if BASIC is still active
+ // (especially not after compiler errors at the runtime)
+ if( nError && bRun )
+ {
+ ErrCode err = nError;
+ ClearExprStack();
+ nError = ERRCODE_NONE;
+ pInst->nErr = err;
+ pInst->nErl = nLine;
+ pErrCode = pCode;
+ pErrStmnt = pStmnt;
+ // An error occurred in an error handler
+ // force parent handler ( if there is one )
+ // to handle the error
+ bool bLetParentHandleThis = false;
+
+ // in the error handler? so std-error
+ if ( !bInError )
+ {
+ bInError = true;
+
+ if( !bError ) // On Error Resume Next
+ {
+ StepRESUME( 1 );
+ }
+ else if( pError ) // On Error Goto ...
+ {
+ pCode = pError;
+ }
+ else
+ {
+ bLetParentHandleThis = true;
+ }
+ }
+ else
+ {
+ bLetParentHandleThis = true;
+ pError = nullptr; //terminate the handler
+ }
+ if ( bLetParentHandleThis )
+ {
+ // from 13.2.1997, new error handling:
+ // consider superior error handlers
+
+ // there's no error handler -> find one farther above
+ SbiRuntime* pRtErrHdl = nullptr;
+ SbiRuntime* pRt = this;
+ while( (pRt = pRt->pNext) != nullptr )
+ {
+ if( !pRt->bError || pRt->pError != nullptr )
+ {
+ pRtErrHdl = pRt;
+ break;
+ }
+ }
+
+
+ if( pRtErrHdl )
+ {
+ // manipulate all the RTs that are below in the call-stack
+ pRt = this;
+ do
+ {
+ pRt->nError = err;
+ if( pRt != pRtErrHdl )
+ {
+ pRt->bRun = false;
+ }
+ else
+ {
+ break;
+ }
+ pRt = pRt->pNext;
+ }
+ while( pRt );
+ }
+ // no error-hdl found -> old behaviour
+ else
+ {
+ pInst->Abort();
+ }
+ }
+ }
+ }
+ return bRun;
+}
+
+void SbiRuntime::Error( ErrCode n, bool bVBATranslationAlreadyDone )
+{
+ if( !n )
+ return;
+
+ nError = n;
+ if( !(isVBAEnabled() && !bVBATranslationAlreadyDone) )
+ return;
+
+ OUString aMsg = pInst->GetErrorMsg();
+ sal_Int32 nVBAErrorNumber = translateErrorToVba( nError, aMsg );
+ SbxVariable* pSbxErrObjVar = SbxErrObject::getErrObject().get();
+ SbxErrObject* pGlobErr = static_cast< SbxErrObject* >( pSbxErrObjVar );
+ if( pGlobErr != nullptr )
+ {
+ pGlobErr->setNumberAndDescription( nVBAErrorNumber, aMsg );
+ }
+ pInst->aErrorMsg = aMsg;
+ nError = ERRCODE_BASIC_COMPAT;
+}
+
+void SbiRuntime::Error( ErrCode _errCode, const OUString& _details )
+{
+ if ( !_errCode )
+ return;
+
+ // Not correct for class module usage, remove for now
+ //OSL_WARN_IF( pInst->pRun != this, "basic", "SbiRuntime::Error: can't propagate the error message details!" );
+ if ( pInst->pRun == this )
+ {
+ pInst->Error( _errCode, _details );
+ //OSL_WARN_IF( nError != _errCode, "basic", "SbiRuntime::Error: the instance is expected to propagate the error code back to me!" );
+ }
+ else
+ {
+ nError = _errCode;
+ }
+}
+
+void SbiRuntime::FatalError( ErrCode n )
+{
+ StepSTDERROR();
+ Error( n );
+}
+
+void SbiRuntime::FatalError( ErrCode _errCode, const OUString& _details )
+{
+ StepSTDERROR();
+ Error( _errCode, _details );
+}
+
+sal_Int32 SbiRuntime::translateErrorToVba( ErrCode nError, OUString& rMsg )
+{
+ // If a message is defined use that ( in preference to
+ // the defined one for the error ) NB #TODO
+ // if there is an error defined it more than likely
+ // is not the one you want ( some are the same though )
+ // we really need a new vba compatible error list
+ if ( rMsg.isEmpty() )
+ {
+ StarBASIC::MakeErrorText( nError, rMsg );
+ rMsg = StarBASIC::GetErrorText();
+ if ( rMsg.isEmpty() ) // no message for err no, need localized resource here
+ {
+ rMsg = "Internal Object Error:";
+ }
+ }
+ // no num? most likely then it *is* really a vba err
+ sal_uInt16 nVBErrorCode = StarBASIC::GetVBErrorCode( nError );
+ sal_Int32 nVBAErrorNumber = ( nVBErrorCode == 0 ) ? sal_uInt32(nError) : nVBErrorCode;
+ return nVBAErrorNumber;
+}
+
+// Stacks
+
+// The expression-stack is available for the continuous evaluation
+// of expressions.
+
+void SbiRuntime::PushVar( SbxVariable* pVar )
+{
+ if( pVar )
+ {
+ refExprStk->Put32( pVar, nExprLvl++ );
+ }
+}
+
+SbxVariableRef SbiRuntime::PopVar()
+{
+#ifdef DBG_UTIL
+ if( !nExprLvl )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ return new SbxVariable;
+ }
+#endif
+ SbxVariableRef xVar = refExprStk->Get32( --nExprLvl );
+ SAL_INFO_IF( xVar->GetName() == "Cells", "basic", "PopVar: Name equals 'Cells'" );
+ // methods hold themselves in parameter 0
+ if( dynamic_cast<const SbxMethod *>(xVar.get()) != nullptr )
+ {
+ xVar->SetParameters(nullptr);
+ }
+ return xVar;
+}
+
+void SbiRuntime::ClearExprStack()
+{
+ // Attention: Clear() doesn't suffice as methods must be deleted
+ while ( nExprLvl )
+ {
+ PopVar();
+ }
+ refExprStk->Clear();
+}
+
+// Take variable from the expression-stack without removing it
+// n counts from 0
+
+SbxVariable* SbiRuntime::GetTOS()
+{
+ short n = nExprLvl - 1;
+#ifdef DBG_UTIL
+ if( n < 0 )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ return new SbxVariable;
+ }
+#endif
+ return refExprStk->Get32( static_cast<sal_uInt32>(n) );
+}
+
+
+void SbiRuntime::TOSMakeTemp()
+{
+ SbxVariable* p = refExprStk->Get32( nExprLvl - 1 );
+ if ( p->GetType() == SbxEMPTY )
+ {
+ p->Broadcast( SfxHintId::BasicDataWanted );
+ }
+
+ SbxVariable* pDflt = nullptr;
+ if ( bVBAEnabled && ( p->GetType() == SbxOBJECT || p->GetType() == SbxVARIANT ) && ((pDflt = getDefaultProp(p)) != nullptr) )
+ {
+ pDflt->Broadcast( SfxHintId::BasicDataWanted );
+ // replacing new p on stack causes object pointed by
+ // pDft->pParent to be deleted, when p2->Compute() is
+ // called below pParent is accessed (but it's deleted)
+ // so set it to NULL now
+ pDflt->SetParent( nullptr );
+ p = new SbxVariable( *pDflt );
+ p->SetFlag( SbxFlagBits::ReadWrite );
+ refExprStk->Put32( p, nExprLvl - 1 );
+ }
+ else if( p->GetRefCount() != 1 )
+ {
+ SbxVariable* pNew = new SbxVariable( *p );
+ pNew->SetFlag( SbxFlagBits::ReadWrite );
+ refExprStk->Put32( pNew, nExprLvl - 1 );
+ }
+}
+
+// the GOSUB-stack collects return-addresses for GOSUBs
+void SbiRuntime::PushGosub( const sal_uInt8* pc )
+{
+ if( pGosubStk.size() >= MAXRECURSION )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_STACK_OVERFLOW );
+ }
+ pGosubStk.emplace_back(pc, nForLvl);
+}
+
+void SbiRuntime::PopGosub()
+{
+ if( pGosubStk.empty() )
+ {
+ Error( ERRCODE_BASIC_NO_GOSUB );
+ }
+ else
+ {
+ pCode = pGosubStk.back().pCode;
+ pGosubStk.pop_back();
+ }
+}
+
+// the Argv-stack collects current argument-vectors
+
+void SbiRuntime::PushArgv()
+{
+ pArgvStk.emplace_back(refArgv, nArgc);
+ nArgc = 1;
+ refArgv.clear();
+}
+
+void SbiRuntime::PopArgv()
+{
+ if( !pArgvStk.empty() )
+ {
+ refArgv = pArgvStk.back().refArgv;
+ nArgc = pArgvStk.back().nArgc;
+ pArgvStk.pop_back();
+ }
+}
+
+
+void SbiRuntime::ClearArgvStack()
+{
+ while( !pArgvStk.empty() )
+ {
+ PopArgv();
+ }
+}
+
+// Push of the for-stack. The stack has increment, end, begin and variable.
+// After the creation of the stack-element the stack's empty.
+
+void SbiRuntime::PushFor()
+{
+ SbiForStack* p = new SbiForStack;
+ p->eForType = ForType::To;
+ p->pNext = pForStk;
+ pForStk = p;
+
+ p->refInc = PopVar();
+ p->refEnd = PopVar();
+ SbxVariableRef xBgn = PopVar();
+ p->refVar = PopVar();
+ *(p->refVar) = *xBgn;
+ nForLvl++;
+}
+
+void SbiRuntime::PushForEach()
+{
+ SbiForStack* p = new SbiForStack;
+ // Set default value in case of error which is ignored in Resume Next
+ p->eForType = ForType::EachArray;
+ p->pNext = pForStk;
+ pForStk = p;
+
+ SbxVariableRef xObjVar = PopVar();
+ SbxBase* pObj = xObjVar && xObjVar->GetFullType() == SbxOBJECT ? xObjVar->GetObject() : nullptr;
+
+ if (SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj))
+ {
+ p->refEnd = reinterpret_cast<SbxVariable*>(pArray);
+
+ sal_Int32 nDims = pArray->GetDims32();
+ p->pArrayLowerBounds.reset( new sal_Int32[nDims] );
+ p->pArrayUpperBounds.reset( new sal_Int32[nDims] );
+ p->pArrayCurIndices.reset( new sal_Int32[nDims] );
+ sal_Int32 lBound, uBound;
+ for( sal_Int32 i = 0 ; i < nDims ; i++ )
+ {
+ pArray->GetDim32( i+1, lBound, uBound );
+ p->pArrayCurIndices[i] = p->pArrayLowerBounds[i] = lBound;
+ p->pArrayUpperBounds[i] = uBound;
+ }
+ }
+ else if (BasicCollection* pCollection = dynamic_cast<BasicCollection*>(pObj))
+ {
+ p->eForType = ForType::EachCollection;
+ p->refEnd = pCollection;
+ p->nCurCollectionIndex = 0;
+ }
+ else if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>(pObj))
+ {
+ // XEnumerationAccess?
+ Any aAny = pUnoObj->getUnoAny();
+ Reference< XEnumerationAccess > xEnumerationAccess;
+ if( aAny >>= xEnumerationAccess )
+ {
+ p->xEnumeration = xEnumerationAccess->createEnumeration();
+ p->eForType = ForType::EachXEnumeration;
+ }
+ else if ( isVBAEnabled() && pUnoObj->isNativeCOMObject() )
+ {
+ uno::Reference< script::XInvocation > xInvocation;
+ if ( ( aAny >>= xInvocation ) && xInvocation.is() )
+ {
+ try
+ {
+ p->xEnumeration = new ComEnumerationWrapper( xInvocation );
+ p->eForType = ForType::EachXEnumeration;
+ }
+ catch(const uno::Exception& )
+ {}
+ }
+ }
+ }
+
+ // Container variable
+ p->refVar = PopVar();
+ nForLvl++;
+}
+
+
+void SbiRuntime::PopFor()
+{
+ if( pForStk )
+ {
+ SbiForStack* p = pForStk;
+ pForStk = p->pNext;
+ delete p;
+ nForLvl--;
+ }
+}
+
+
+void SbiRuntime::ClearForStack()
+{
+ while( pForStk )
+ {
+ PopFor();
+ }
+}
+
+SbiForStack* SbiRuntime::FindForStackItemForCollection( class BasicCollection const * pCollection )
+{
+ for (SbiForStack *p = pForStk; p; p = p->pNext)
+ {
+ SbxVariable* pVar = p->refEnd.is() ? p->refEnd.get() : nullptr;
+ if( p->eForType == ForType::EachCollection
+ && pVar != nullptr
+ && dynamic_cast<BasicCollection*>( pVar) == pCollection )
+ {
+ return p;
+ }
+ }
+
+ return nullptr;
+}
+
+
+// DLL-calls
+
+void SbiRuntime::DllCall
+ ( const OUString& aFuncName,
+ const OUString& aDLLName,
+ SbxArray* pArgs, // parameter (from index 1, can be NULL)
+ SbxDataType eResType, // return value
+ bool bCDecl ) // true: according to C-conventions
+{
+ // NOT YET IMPLEMENTED
+
+ SbxVariable* pRes = new SbxVariable( eResType );
+ SbiDllMgr* pDllMgr = pInst->GetDllMgr();
+ ErrCode nErr = pDllMgr->Call( aFuncName, aDLLName, pArgs, *pRes, bCDecl );
+ if( nErr )
+ {
+ Error( nErr );
+ }
+ PushVar( pRes );
+}
+
+bool SbiRuntime::IsImageFlag( SbiImageFlags n ) const
+{
+ return pImg->IsFlag( n );
+}
+
+sal_uInt16 SbiRuntime::GetBase() const
+{
+ return pImg->GetBase();
+}
+
+void SbiRuntime::StepNOP()
+{}
+
+void SbiRuntime::StepArith( SbxOperator eOp )
+{
+ SbxVariableRef p1 = PopVar();
+ TOSMakeTemp();
+ SbxVariable* p2 = GetTOS();
+
+ p2->ResetFlag( SbxFlagBits::Fixed );
+ p2->Compute( eOp, *p1 );
+
+ checkArithmeticOverflow( p2 );
+}
+
+void SbiRuntime::StepUnary( SbxOperator eOp )
+{
+ TOSMakeTemp();
+ SbxVariable* p = GetTOS();
+ p->Compute( eOp, *p );
+}
+
+void SbiRuntime::StepCompare( SbxOperator eOp )
+{
+ SbxVariableRef p1 = PopVar();
+ SbxVariableRef p2 = PopVar();
+
+ // Make sure objects with default params have
+ // values ( and type ) set as appropriate
+ SbxDataType p1Type = p1->GetType();
+ SbxDataType p2Type = p2->GetType();
+ if ( p1Type == SbxEMPTY )
+ {
+ p1->Broadcast( SfxHintId::BasicDataWanted );
+ p1Type = p1->GetType();
+ }
+ if ( p2Type == SbxEMPTY )
+ {
+ p2->Broadcast( SfxHintId::BasicDataWanted );
+ p2Type = p2->GetType();
+ }
+ if ( p1Type == p2Type )
+ {
+ // if both sides are an object and have default props
+ // then we need to use the default props
+ // we don't need to worry if only one side ( lhs, rhs ) is an
+ // object ( object side will get coerced to correct type in
+ // Compare )
+ if ( p1Type == SbxOBJECT )
+ {
+ SbxVariable* pDflt = getDefaultProp( p1.get() );
+ if ( pDflt )
+ {
+ p1 = pDflt;
+ p1->Broadcast( SfxHintId::BasicDataWanted );
+ }
+ pDflt = getDefaultProp( p2.get() );
+ if ( pDflt )
+ {
+ p2 = pDflt;
+ p2->Broadcast( SfxHintId::BasicDataWanted );
+ }
+ }
+
+ }
+ static SbxVariable* pTRUE = nullptr;
+ static SbxVariable* pFALSE = nullptr;
+ // why do this on non-windows ?
+ // why do this at all ?
+ // I dumbly follow the pattern :-/
+ if ( bVBAEnabled && ( p1->IsNull() || p2->IsNull() ) )
+ {
+ static SbxVariable* pNULL = [&]() {
+ SbxVariable* p = new SbxVariable;
+ p->PutNull();
+ p->AddFirstRef();
+ return p;
+ }();
+ PushVar( pNULL );
+ }
+ else if( p2->Compare( eOp, *p1 ) )
+ {
+ if( !pTRUE )
+ {
+ pTRUE = new SbxVariable;
+ pTRUE->PutBool( true );
+ pTRUE->AddFirstRef();
+ }
+ PushVar( pTRUE );
+ }
+ else
+ {
+ if( !pFALSE )
+ {
+ pFALSE = new SbxVariable;
+ pFALSE->PutBool( false );
+ pFALSE->AddFirstRef();
+ }
+ PushVar( pFALSE );
+ }
+}
+
+void SbiRuntime::StepEXP() { StepArith( SbxEXP ); }
+void SbiRuntime::StepMUL() { StepArith( SbxMUL ); }
+void SbiRuntime::StepDIV() { StepArith( SbxDIV ); }
+void SbiRuntime::StepIDIV() { StepArith( SbxIDIV ); }
+void SbiRuntime::StepMOD() { StepArith( SbxMOD ); }
+void SbiRuntime::StepPLUS() { StepArith( SbxPLUS ); }
+void SbiRuntime::StepMINUS() { StepArith( SbxMINUS ); }
+void SbiRuntime::StepCAT() { StepArith( SbxCAT ); }
+void SbiRuntime::StepAND() { StepArith( SbxAND ); }
+void SbiRuntime::StepOR() { StepArith( SbxOR ); }
+void SbiRuntime::StepXOR() { StepArith( SbxXOR ); }
+void SbiRuntime::StepEQV() { StepArith( SbxEQV ); }
+void SbiRuntime::StepIMP() { StepArith( SbxIMP ); }
+
+void SbiRuntime::StepNEG() { StepUnary( SbxNEG ); }
+void SbiRuntime::StepNOT() { StepUnary( SbxNOT ); }
+
+void SbiRuntime::StepEQ() { StepCompare( SbxEQ ); }
+void SbiRuntime::StepNE() { StepCompare( SbxNE ); }
+void SbiRuntime::StepLT() { StepCompare( SbxLT ); }
+void SbiRuntime::StepGT() { StepCompare( SbxGT ); }
+void SbiRuntime::StepLE() { StepCompare( SbxLE ); }
+void SbiRuntime::StepGE() { StepCompare( SbxGE ); }
+
+namespace
+{
+ bool NeedEsc(sal_Unicode cCode)
+ {
+ if(!rtl::isAscii(cCode))
+ {
+ return false;
+ }
+ switch(cCode)
+ {
+ case '.':
+ case '^':
+ case '$':
+ case '+':
+ case '\\':
+ case '|':
+ case '{':
+ case '}':
+ case '(':
+ case ')':
+ return true;
+ default:
+ return false;
+ }
+ }
+
+ OUString VBALikeToRegexp(const OUString &rIn)
+ {
+ OUStringBuffer sResult;
+ const sal_Unicode *start = rIn.getStr();
+ const sal_Unicode *end = start + rIn.getLength();
+
+ int seenright = 0;
+
+ sResult.append('^');
+
+ while (start < end)
+ {
+ switch (*start)
+ {
+ case '?':
+ sResult.append('.');
+ start++;
+ break;
+ case '*':
+ sResult.append(".*");
+ start++;
+ break;
+ case '#':
+ sResult.append("[0-9]");
+ start++;
+ break;
+ case ']':
+ sResult.append('\\');
+ sResult.append(*start++);
+ break;
+ case '[':
+ sResult.append(*start++);
+ seenright = 0;
+ while (start < end && !seenright)
+ {
+ switch (*start)
+ {
+ case '[':
+ case '?':
+ case '*':
+ sResult.append('\\');
+ sResult.append(*start);
+ break;
+ case ']':
+ sResult.append(*start);
+ seenright = 1;
+ break;
+ case '!':
+ sResult.append('^');
+ break;
+ default:
+ if (NeedEsc(*start))
+ {
+ sResult.append('\\');
+ }
+ sResult.append(*start);
+ break;
+ }
+ start++;
+ }
+ break;
+ default:
+ if (NeedEsc(*start))
+ {
+ sResult.append('\\');
+ }
+ sResult.append(*start++);
+ }
+ }
+
+ sResult.append('$');
+
+ return sResult.makeStringAndClear();
+ }
+}
+
+void SbiRuntime::StepLIKE()
+{
+ SbxVariableRef refVar1 = PopVar();
+ SbxVariableRef refVar2 = PopVar();
+
+ OUString pattern = VBALikeToRegexp(refVar1->GetOUString());
+ OUString value = refVar2->GetOUString();
+
+ i18nutil::SearchOptions2 aSearchOpt;
+
+ aSearchOpt.AlgorithmType2 = css::util::SearchAlgorithms2::REGEXP;
+
+ aSearchOpt.Locale = Application::GetSettings().GetLanguageTag().getLocale();
+ aSearchOpt.searchString = pattern;
+
+ bool bTextMode(true);
+ bool bCompatibility = ( GetSbData()->pInst && GetSbData()->pInst->IsCompatibility() );
+ if( bCompatibility )
+ {
+ bTextMode = IsImageFlag( SbiImageFlags::COMPARETEXT );
+ }
+ if( bTextMode )
+ {
+ aSearchOpt.transliterateFlags |= TransliterationFlags::IGNORE_CASE;
+ }
+ SbxVariable* pRes = new SbxVariable;
+ utl::TextSearch aSearch( aSearchOpt);
+ sal_Int32 nStart=0, nEnd=value.getLength();
+ bool bRes = aSearch.SearchForward(value, &nStart, &nEnd);
+ pRes->PutBool( bRes );
+
+ PushVar( pRes );
+}
+
+// TOS and TOS-1 are both object variables and contain the same pointer
+
+void SbiRuntime::StepIS()
+{
+ SbxVariableRef refVar1 = PopVar();
+ SbxVariableRef refVar2 = PopVar();
+
+ SbxDataType eType1 = refVar1->GetType();
+ SbxDataType eType2 = refVar2->GetType();
+ if ( eType1 == SbxEMPTY )
+ {
+ refVar1->Broadcast( SfxHintId::BasicDataWanted );
+ eType1 = refVar1->GetType();
+ }
+ if ( eType2 == SbxEMPTY )
+ {
+ refVar2->Broadcast( SfxHintId::BasicDataWanted );
+ eType2 = refVar2->GetType();
+ }
+
+ bool bRes = ( eType1 == SbxOBJECT && eType2 == SbxOBJECT );
+ if ( bVBAEnabled && !bRes )
+ {
+ Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ }
+ bRes = ( bRes && refVar1->GetObject() == refVar2->GetObject() );
+ SbxVariable* pRes = new SbxVariable;
+ pRes->PutBool( bRes );
+ PushVar( pRes );
+}
+
+// update the value of TOS
+
+void SbiRuntime::StepGET()
+{
+ SbxVariable* p = GetTOS();
+ p->Broadcast( SfxHintId::BasicDataWanted );
+}
+
+// #67607 copy Uno-Structs
+static bool checkUnoStructCopy( bool bVBA, SbxVariableRef const & refVal, SbxVariableRef const & refVar )
+{
+ SbxDataType eVarType = refVar->GetType();
+ SbxDataType eValType = refVal->GetType();
+
+ if ( ( bVBA && ( eVarType == SbxEMPTY ) ) || !refVar->CanWrite() )
+ return false;
+
+ if ( eValType != SbxOBJECT )
+ return false;
+ // we seem to be duplicating parts of SbxValue=operator, maybe we should just move this to
+ // there :-/ not sure if for every '=' we would want struct handling
+ if( eVarType != SbxOBJECT )
+ {
+ if ( refVar->IsFixed() )
+ return false;
+ }
+ // #115826: Exclude ProcedureProperties to avoid call to Property Get procedure
+ else if( dynamic_cast<const SbProcedureProperty*>( refVar.get() ) != nullptr )
+ return false;
+
+ SbxObjectRef xValObj = static_cast<SbxObject*>(refVal->GetObject());
+ if( !xValObj.is() || dynamic_cast<const SbUnoAnyObject*>( xValObj.get() ) != nullptr )
+ return false;
+
+ SbUnoObject* pUnoVal = dynamic_cast<SbUnoObject*>( xValObj.get() );
+ SbUnoStructRefObject* pUnoStructVal = dynamic_cast<SbUnoStructRefObject*>( xValObj.get() );
+ Any aAny;
+ // make doubly sure value is either a Uno object or
+ // a uno struct
+ if ( pUnoVal || pUnoStructVal )
+ aAny = pUnoVal ? pUnoVal->getUnoAny() : pUnoStructVal->getUnoAny();
+ else
+ return false;
+ if ( aAny.getValueType().getTypeClass() == TypeClass_STRUCT )
+ {
+ refVar->SetType( SbxOBJECT );
+ ErrCode eOldErr = SbxBase::GetError();
+ // There are some circumstances when calling GetObject
+ // will trigger an error, we need to squash those here.
+ // Alternatively it is possible that the same scenario
+ // could overwrite and existing error. Lets prevent that
+ SbxObjectRef xVarObj = static_cast<SbxObject*>(refVar->GetObject());
+ if ( eOldErr != ERRCODE_NONE )
+ SbxBase::SetError( eOldErr );
+ else
+ SbxBase::ResetError();
+
+ SbUnoStructRefObject* pUnoStructObj = dynamic_cast<SbUnoStructRefObject*>( xVarObj.get() );
+
+ OUString sClassName = pUnoVal ? pUnoVal->GetClassName() : pUnoStructVal->GetClassName();
+ OUString sName = pUnoVal ? pUnoVal->GetName() : pUnoStructVal->GetName();
+
+ if ( pUnoStructObj )
+ {
+ StructRefInfo aInfo = pUnoStructObj->getStructInfo();
+ aInfo.setValue( aAny );
+ }
+ else
+ {
+ SbUnoObject* pNewUnoObj = new SbUnoObject( sName, aAny );
+ // #70324: adopt ClassName
+ pNewUnoObj->SetClassName( sClassName );
+ refVar->PutObject( pNewUnoObj );
+ }
+ return true;
+ }
+ return false;
+}
+
+
+// laying down TOS in TOS-1
+
+void SbiRuntime::StepPUT()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ // store on its own method (inside a function)?
+ bool bFlagsChanged = false;
+ SbxFlagBits n = SbxFlagBits::NONE;
+ if( refVar.get() == pMeth )
+ {
+ bFlagsChanged = true;
+ n = refVar->GetFlags();
+ refVar->SetFlag( SbxFlagBits::Write );
+ }
+
+ // if left side arg is an object or variant and right handside isn't
+ // either an object or a variant then try and see if a default
+ // property exists.
+ // to use e.g. Range{"A1") = 34
+ // could equate to Range("A1").Value = 34
+ if ( bVBAEnabled )
+ {
+ // yet more hacking at this, I feel we don't quite have the correct
+ // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe
+ // obj1 ) has default member/property ) ) It seems that default props
+ // aren't dealt with if the object is a member of some parent object
+ bool bObjAssign = false;
+ if ( refVar->GetType() == SbxEMPTY )
+ refVar->Broadcast( SfxHintId::BasicDataWanted );
+ if ( refVar->GetType() == SbxOBJECT )
+ {
+ if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVar.get() );
+
+ if ( pDflt )
+ refVar = pDflt;
+ }
+ else
+ bObjAssign = true;
+ }
+ if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( dynamic_cast<const SbxMethod *>(refVal.get()) != nullptr || ! refVal->GetParent() ) )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVal.get() );
+ if ( pDflt )
+ refVal = pDflt;
+ }
+ }
+
+ if ( !checkUnoStructCopy( bVBAEnabled, refVal, refVar ) )
+ *refVar = *refVal;
+
+ if( bFlagsChanged )
+ refVar->SetFlags( n );
+}
+
+namespace {
+
+// VBA Dim As New behavior handling, save init object information
+struct DimAsNewRecoverItem
+{
+ OUString m_aObjClass;
+ OUString m_aObjName;
+ SbxObject* m_pObjParent;
+ SbModule* m_pClassModule;
+
+ DimAsNewRecoverItem()
+ : m_pObjParent( nullptr )
+ , m_pClassModule( nullptr )
+ {}
+
+ DimAsNewRecoverItem( const OUString& rObjClass, const OUString& rObjName,
+ SbxObject* pObjParent, SbModule* pClassModule )
+ : m_aObjClass( rObjClass )
+ , m_aObjName( rObjName )
+ , m_pObjParent( pObjParent )
+ , m_pClassModule( pClassModule )
+ {}
+
+};
+
+
+struct SbxVariablePtrHash
+{
+ size_t operator()( SbxVariable* pVar ) const
+ { return reinterpret_cast<size_t>(pVar); }
+};
+
+}
+
+typedef std::unordered_map< SbxVariable*, DimAsNewRecoverItem,
+ SbxVariablePtrHash > DimAsNewRecoverHash;
+
+namespace {
+
+class GaDimAsNewRecoverHash : public rtl::Static<DimAsNewRecoverHash, GaDimAsNewRecoverHash> {};
+
+}
+
+void removeDimAsNewRecoverItem( SbxVariable* pVar )
+{
+ DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
+ DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( pVar );
+ if( it != rDimAsNewRecoverHash.end() )
+ {
+ rDimAsNewRecoverHash.erase( it );
+ }
+}
+
+
+// saving object variable
+// not-object variables will cause errors
+
+static const char pCollectionStr[] = "Collection";
+
+void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, bool bHandleDefaultProp )
+{
+ // #67733 types with array-flag are OK too
+
+ // Check var, !object is no error for sure if, only if type is fixed
+ SbxDataType eVarType = refVar->GetType();
+ if( !bHandleDefaultProp && eVarType != SbxOBJECT && !(eVarType & SbxARRAY) && refVar->IsFixed() )
+ {
+ Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ return;
+ }
+
+ // Check value, !object is no error for sure if, only if type is fixed
+ SbxDataType eValType = refVal->GetType();
+ if( !bHandleDefaultProp && eValType != SbxOBJECT && !(eValType & SbxARRAY) && refVal->IsFixed() )
+ {
+ Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ return;
+ }
+
+ // Getting in here causes problems with objects with default properties
+ // if they are SbxEMPTY I guess
+ if ( !bHandleDefaultProp || eValType == SbxOBJECT )
+ {
+ // activate GetObject for collections on refVal
+ SbxBase* pObjVarObj = refVal->GetObject();
+ if( pObjVarObj )
+ {
+ SbxVariableRef refObjVal = dynamic_cast<SbxObject*>( pObjVarObj );
+
+ if( refObjVal.is() )
+ {
+ refVal = refObjVal;
+ }
+ else if( !(eValType & SbxARRAY) )
+ {
+ refVal = nullptr;
+ }
+ }
+ }
+
+ // #52896 refVal can be invalid here, if uno-sequences - or more
+ // general arrays - are assigned to variables that are declared
+ // as an object!
+ if( !refVal.is() )
+ {
+ Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ bool bFlagsChanged = false;
+ SbxFlagBits n = SbxFlagBits::NONE;
+ if( refVar.get() == pMeth )
+ {
+ bFlagsChanged = true;
+ n = refVar->GetFlags();
+ refVar->SetFlag( SbxFlagBits::Write );
+ }
+ SbProcedureProperty* pProcProperty = dynamic_cast<SbProcedureProperty*>( refVar.get() );
+ if( pProcProperty )
+ {
+ pProcProperty->setSet( true );
+ }
+ if ( bHandleDefaultProp )
+ {
+ // get default properties for lhs & rhs where necessary
+ // SbxVariable* defaultProp = NULL; unused variable
+ // LHS try determine if a default prop exists
+ // again like in StepPUT (see there too ) we are tweaking the
+ // heuristics again for when to assign an object reference or
+ // use default members if they exist
+ // #FIXME we really need to get to the bottom of this mess
+ bool bObjAssign = false;
+ if ( refVar->GetType() == SbxOBJECT )
+ {
+ if ( dynamic_cast<const SbxMethod *>(refVar.get()) != nullptr || ! refVar->GetParent() )
+ {
+ SbxVariable* pDflt = getDefaultProp( refVar.get() );
+ if ( pDflt )
+ {
+ refVar = pDflt;
+ }
+ }
+ else
+ bObjAssign = true;
+ }
+ // RHS only get a default prop is the rhs has one
+ if ( refVal->GetType() == SbxOBJECT )
+ {
+ // check if lhs is a null object
+ // if it is then use the object not the default property
+ SbxObject* pObj = dynamic_cast<SbxObject*>( refVar.get() );
+
+ // calling GetObject on a SbxEMPTY variable raises
+ // object not set errors, make sure it's an Object
+ if ( !pObj && refVar->GetType() == SbxOBJECT )
+ {
+ SbxBase* pObjVarObj = refVar->GetObject();
+ pObj = dynamic_cast<SbxObject*>( pObjVarObj );
+ }
+ SbxVariable* pDflt = nullptr;
+ if ( pObj && !bObjAssign )
+ {
+ // lhs is either a valid object || or has a defaultProp
+ pDflt = getDefaultProp( refVal.get() );
+ }
+ if ( pDflt )
+ {
+ refVal = pDflt;
+ }
+ }
+ }
+
+ // Handle Dim As New
+ bool bDimAsNew = bVBAEnabled && refVar->IsSet( SbxFlagBits::DimAsNew );
+ SbxBaseRef xPrevVarObj;
+ if( bDimAsNew )
+ {
+ xPrevVarObj = refVar->GetObject();
+ }
+ // Handle withevents
+ bool bWithEvents = refVar->IsSet( SbxFlagBits::WithEvents );
+ if ( bWithEvents )
+ {
+ Reference< XInterface > xComListener;
+
+ SbxBase* pObj = refVal->GetObject();
+ SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj );
+ if( pUnoObj != nullptr )
+ {
+ Any aControlAny = pUnoObj->getUnoAny();
+ OUString aDeclareClassName = refVar->GetDeclareClassName();
+ OUString aPrefix = refVar->GetName();
+ SbxObjectRef xScopeObj = refVar->GetParent();
+ xComListener = createComListener( aControlAny, aDeclareClassName, aPrefix, xScopeObj );
+
+ refVal->SetDeclareClassName( aDeclareClassName );
+ refVal->SetComListener( xComListener, &rBasic ); // Hold reference
+ }
+
+ }
+
+ // lhs is a property who's value is currently (Empty e.g. no broadcast yet)
+ // in this case if there is a default prop involved the value of the
+ // default property may in fact be void so the type will also be SbxEMPTY
+ // in this case we do not want to call checkUnoStructCopy 'cause that will
+ // cause an error also
+ if ( !checkUnoStructCopy( bHandleDefaultProp, refVal, refVar ) )
+ {
+ *refVar = *refVal;
+ }
+ if ( bDimAsNew )
+ {
+ if( dynamic_cast<const SbxObject*>( refVar.get() ) == nullptr )
+ {
+ SbxBase* pValObjBase = refVal->GetObject();
+ if( pValObjBase == nullptr )
+ {
+ if( xPrevVarObj.is() )
+ {
+ // Object is overwritten with NULL, instantiate init object
+ DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
+ DimAsNewRecoverHash::iterator it = rDimAsNewRecoverHash.find( refVar.get() );
+ if( it != rDimAsNewRecoverHash.end() )
+ {
+ const DimAsNewRecoverItem& rItem = it->second;
+ if( rItem.m_pClassModule != nullptr )
+ {
+ SbClassModuleObject* pNewObj = new SbClassModuleObject( rItem.m_pClassModule );
+ pNewObj->SetName( rItem.m_aObjName );
+ pNewObj->SetParent( rItem.m_pObjParent );
+ refVar->PutObject( pNewObj );
+ }
+ else if( rItem.m_aObjClass.equalsIgnoreAsciiCase( pCollectionStr ) )
+ {
+ BasicCollection* pNewCollection = new BasicCollection( pCollectionStr );
+ pNewCollection->SetName( rItem.m_aObjName );
+ pNewCollection->SetParent( rItem.m_pObjParent );
+ refVar->PutObject( pNewCollection );
+ }
+ }
+ }
+ }
+ else
+ {
+ // Does old value exist?
+ bool bFirstInit = !xPrevVarObj.is();
+ if( bFirstInit )
+ {
+ // Store information to instantiate object later
+ SbxObject* pValObj = dynamic_cast<SbxObject*>( pValObjBase );
+ if( pValObj != nullptr )
+ {
+ OUString aObjClass = pValObj->GetClassName();
+
+ SbClassModuleObject* pClassModuleObj = dynamic_cast<SbClassModuleObject*>( pValObjBase );
+ DimAsNewRecoverHash &rDimAsNewRecoverHash = GaDimAsNewRecoverHash::get();
+ if( pClassModuleObj != nullptr )
+ {
+ SbModule* pClassModule = pClassModuleObj->getClassModule();
+ rDimAsNewRecoverHash[refVar.get()] =
+ DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), pClassModule );
+ }
+ else if( aObjClass.equalsIgnoreAsciiCase( "Collection" ) )
+ {
+ rDimAsNewRecoverHash[refVar.get()] =
+ DimAsNewRecoverItem( aObjClass, pValObj->GetName(), pValObj->GetParent(), nullptr );
+ }
+ }
+ }
+ }
+ }
+ }
+
+ if( bFlagsChanged )
+ {
+ refVar->SetFlags( n );
+ }
+ }
+}
+
+void SbiRuntime::StepSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ StepSET_Impl( refVal, refVar, bVBAEnabled ); // this is really assignment
+}
+
+void SbiRuntime::StepVBASET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ // don't handle default property
+ StepSET_Impl( refVal, refVar ); // set obj = something
+}
+
+
+void SbiRuntime::StepLSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ if( refVar->GetType() != SbxSTRING ||
+ refVal->GetType() != SbxSTRING )
+ {
+ Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ SbxFlagBits n = refVar->GetFlags();
+ if( refVar.get() == pMeth )
+ {
+ refVar->SetFlag( SbxFlagBits::Write );
+ }
+ OUString aRefVarString = refVar->GetOUString();
+ OUString aRefValString = refVal->GetOUString();
+
+ sal_Int32 nVarStrLen = aRefVarString.getLength();
+ sal_Int32 nValStrLen = aRefValString.getLength();
+ OUString aNewStr;
+ if( nVarStrLen > nValStrLen )
+ {
+ OUStringBuffer buf(aRefValString);
+ comphelper::string::padToLength(buf, nVarStrLen, ' ');
+ aNewStr = buf.makeStringAndClear();
+ }
+ else
+ {
+ aNewStr = aRefValString.copy( 0, nVarStrLen );
+ }
+
+ refVar->PutString(aNewStr);
+ refVar->SetFlags( n );
+ }
+}
+
+void SbiRuntime::StepRSET()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ if( refVar->GetType() != SbxSTRING || refVal->GetType() != SbxSTRING )
+ {
+ Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ SbxFlagBits n = refVar->GetFlags();
+ if( refVar.get() == pMeth )
+ {
+ refVar->SetFlag( SbxFlagBits::Write );
+ }
+ OUString aRefVarString = refVar->GetOUString();
+ OUString aRefValString = refVal->GetOUString();
+ sal_Int32 nVarStrLen = aRefVarString.getLength();
+ sal_Int32 nValStrLen = aRefValString.getLength();
+
+ OUStringBuffer aNewStr(nVarStrLen);
+ if (nVarStrLen > nValStrLen)
+ {
+ comphelper::string::padToLength(aNewStr, nVarStrLen - nValStrLen, ' ');
+ aNewStr.append(aRefValString);
+ }
+ else
+ {
+ aNewStr.append(std::u16string_view(aRefValString).substr(0, nVarStrLen));
+ }
+ refVar->PutString(aNewStr.makeStringAndClear());
+
+ refVar->SetFlags( n );
+ }
+}
+
+// laying down TOS in TOS-1, then set ReadOnly-Bit
+
+void SbiRuntime::StepPUTC()
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ refVar->SetFlag( SbxFlagBits::Write );
+ *refVar = *refVal;
+ refVar->ResetFlag( SbxFlagBits::Write );
+ refVar->SetFlag( SbxFlagBits::Const );
+}
+
+// DIM
+// TOS = variable for the array with dimension information as parameter
+
+void SbiRuntime::StepDIM()
+{
+ SbxVariableRef refVar = PopVar();
+ DimImpl( refVar );
+}
+
+// #56204 swap out DIM-functionality into a help method (step0.cxx)
+void SbiRuntime::DimImpl(const SbxVariableRef& refVar)
+{
+ // If refDim then this DIM statement is terminating a ReDIM and
+ // previous StepERASE_CLEAR for an array, the following actions have
+ // been delayed from ( StepERASE_CLEAR ) 'till here
+ if ( refRedim.is() )
+ {
+ if ( !refRedimpArray.is() ) // only erase the array not ReDim Preserve
+ {
+ lcl_eraseImpl( refVar, bVBAEnabled );
+ }
+ SbxDataType eType = refVar->GetType();
+ lcl_clearImpl( refVar, eType );
+ refRedim = nullptr;
+ }
+ SbxArray* pDims = refVar->GetParameters();
+ // must have an even number of arguments
+ // have in mind that Arg[0] does not count!
+ if( pDims && !( pDims->Count32() & 1 ) )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+ else
+ {
+ SbxDataType eType = refVar->IsFixed() ? refVar->GetType() : SbxVARIANT;
+ SbxDimArray* pArray = new SbxDimArray( eType );
+ // allow arrays without dimension information, too (VB-compatible)
+ if( pDims )
+ {
+ refVar->ResetFlag( SbxFlagBits::VarToDim );
+
+ for( sal_uInt32 i = 1; i < pDims->Count32(); )
+ {
+ sal_Int32 lb = pDims->Get32( i++ )->GetLong();
+ sal_Int32 ub = pDims->Get32( i++ )->GetLong();
+ if( ub < lb )
+ {
+ Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ ub = lb;
+ }
+ pArray->AddDim32( lb, ub );
+ if ( lb != ub )
+ {
+ pArray->setHasFixedSize( true );
+ }
+ }
+ }
+ else
+ {
+ // #62867 On creating an array of the length 0, create
+ // a dimension (like for Uno-Sequences of the length 0)
+ pArray->unoAddDim32( 0, -1 );
+ }
+ SbxFlagBits nSavFlags = refVar->GetFlags();
+ refVar->ResetFlag( SbxFlagBits::Fixed );
+ refVar->PutObject( pArray );
+ refVar->SetFlags( nSavFlags );
+ refVar->SetParameters( nullptr );
+ }
+}
+
+// REDIM
+// TOS = variable for the array
+// argv = dimension information
+
+void SbiRuntime::StepREDIM()
+{
+ // Nothing different than dim at the moment because
+ // a double dim is already recognized by the compiler.
+ StepDIM();
+}
+
+
+// Helper function for StepREDIMP and StepDCREATE_IMPL / bRedimp = true
+static void implCopyDimArray( SbxDimArray* pNewArray, SbxDimArray* pOldArray, sal_Int32 nMaxDimIndex,
+ sal_Int32 nActualDim, sal_Int32* pActualIndices, sal_Int32* pLowerBounds, sal_Int32* pUpperBounds )
+{
+ sal_Int32& ri = pActualIndices[nActualDim];
+ for( ri = pLowerBounds[nActualDim] ; ri <= pUpperBounds[nActualDim] ; ri++ )
+ {
+ if( nActualDim < nMaxDimIndex )
+ {
+ implCopyDimArray( pNewArray, pOldArray, nMaxDimIndex, nActualDim + 1,
+ pActualIndices, pLowerBounds, pUpperBounds );
+ }
+ else
+ {
+ SbxVariable* pSource = pOldArray->Get32( pActualIndices );
+ if (pSource && pOldArray->GetRefCount() > 1)
+ // tdf#134692: old array will stay alive after the redim - we need to copy deep
+ pSource = new SbxVariable(*pSource);
+ pNewArray->Put32(pSource, pActualIndices);
+ }
+ }
+}
+
+// Returns true when actually restored
+static bool implRestorePreservedArray(SbxDimArray* pNewArray, SbxArrayRef& rrefRedimpArray, bool* pbWasError = nullptr)
+{
+ assert(pNewArray);
+ bool bResult = false;
+ if (pbWasError)
+ *pbWasError = false;
+ if (rrefRedimpArray)
+ {
+ SbxDimArray* pOldArray = static_cast<SbxDimArray*>(rrefRedimpArray.get());
+ const sal_Int32 nDimsNew = pNewArray->GetDims32();
+ const sal_Int32 nDimsOld = pOldArray->GetDims32();
+
+ if (nDimsOld != nDimsNew)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_OUT_OF_RANGE);
+ if (pbWasError)
+ *pbWasError = true;
+ }
+ else if (nDimsNew > 0)
+ {
+ // Store dims to use them for copying later
+ std::unique_ptr<sal_Int32[]> pLowerBounds(new sal_Int32[nDimsNew]);
+ std::unique_ptr<sal_Int32[]> pUpperBounds(new sal_Int32[nDimsNew]);
+ std::unique_ptr<sal_Int32[]> pActualIndices(new sal_Int32[nDimsNew]);
+ bool bNeedsPreallocation = true;
+
+ // Compare bounds
+ for (sal_Int32 i = 1; i <= nDimsNew; i++)
+ {
+ sal_Int32 lBoundNew, uBoundNew;
+ sal_Int32 lBoundOld, uBoundOld;
+ pNewArray->GetDim32(i, lBoundNew, uBoundNew);
+ pOldArray->GetDim32(i, lBoundOld, uBoundOld);
+ lBoundNew = std::max(lBoundNew, lBoundOld);
+ uBoundNew = std::min(uBoundNew, uBoundOld);
+ sal_Int32 j = i - 1;
+ pActualIndices[j] = pLowerBounds[j] = lBoundNew;
+ pUpperBounds[j] = uBoundNew;
+ if (lBoundNew > uBoundNew) // No elements in the dimension -> no elements to restore
+ bNeedsPreallocation = false;
+ }
+
+ // Optimization: pre-allocate underlying container
+ if (bNeedsPreallocation)
+ pNewArray->Put32(nullptr, pUpperBounds.get());
+
+ // Copy data from old array by going recursively through all dimensions
+ // (It would be faster to work on the flat internal data array of an
+ // SbyArray but this solution is clearer and easier)
+ implCopyDimArray(pNewArray, pOldArray, nDimsNew - 1, 0, pActualIndices.get(),
+ pLowerBounds.get(), pUpperBounds.get());
+ bResult = true;
+ }
+
+ rrefRedimpArray.clear();
+ }
+ return bResult;
+}
+
+// REDIM PRESERVE
+// TOS = variable for the array
+// argv = dimension information
+
+void SbiRuntime::StepREDIMP()
+{
+ SbxVariableRef refVar = PopVar();
+ DimImpl( refVar );
+
+ // Now check, if we can copy from the old array
+ if( refRedimpArray.is() )
+ {
+ if (SbxDimArray* pNewArray = dynamic_cast<SbxDimArray*>(refVar->GetObject()))
+ implRestorePreservedArray(pNewArray, refRedimpArray);
+ }
+}
+
+// REDIM_COPY
+// TOS = Array-Variable, Reference to array is copied
+// Variable is cleared as in ERASE
+
+void SbiRuntime::StepREDIMP_ERASE()
+{
+ SbxVariableRef refVar = PopVar();
+ refRedim = refVar;
+ SbxDataType eType = refVar->GetType();
+ if( eType & SbxARRAY )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
+ if( pDimArray )
+ {
+ refRedimpArray = pDimArray;
+ }
+
+ }
+ else if( refVar->IsFixed() )
+ {
+ refVar->Clear();
+ }
+ else
+ {
+ refVar->SetType( SbxEMPTY );
+ }
+}
+
+static void lcl_clearImpl( SbxVariableRef const & refVar, SbxDataType const & eType )
+{
+ SbxFlagBits nSavFlags = refVar->GetFlags();
+ refVar->ResetFlag( SbxFlagBits::Fixed );
+ refVar->SetType( SbxDataType(eType & 0x0FFF) );
+ refVar->SetFlags( nSavFlags );
+ refVar->Clear();
+}
+
+static void lcl_eraseImpl( SbxVariableRef const & refVar, bool bVBAEnabled )
+{
+ SbxDataType eType = refVar->GetType();
+ if( eType & SbxARRAY )
+ {
+ if ( bVBAEnabled )
+ {
+ SbxBase* pElemObj = refVar->GetObject();
+ SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
+ if( pDimArray )
+ {
+ if ( pDimArray->hasFixedSize() )
+ {
+ // Clear all Value(s)
+ pDimArray->SbxArray::Clear();
+ }
+ else
+ {
+ pDimArray->Clear(); // clear dims and values
+ }
+ }
+ else
+ {
+ SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
+ if ( pArray )
+ {
+ pArray->Clear();
+ }
+ }
+ }
+ else
+ {
+ // Arrays have on an erase to VB quite a complex behaviour. Here are
+ // only the type problems at REDIM (#26295) removed at first:
+ // Set type hard onto the array-type, because a variable with array is
+ // SbxOBJECT. At REDIM there's an SbxOBJECT-array generated then and
+ // the original type is lost -> runtime error
+ lcl_clearImpl( refVar, eType );
+ }
+ }
+ else if( refVar->IsFixed() )
+ {
+ refVar->Clear();
+ }
+ else
+ {
+ refVar->SetType( SbxEMPTY );
+ }
+}
+
+// delete variable
+// TOS = variable
+
+void SbiRuntime::StepERASE()
+{
+ SbxVariableRef refVar = PopVar();
+ lcl_eraseImpl( refVar, bVBAEnabled );
+}
+
+void SbiRuntime::StepERASE_CLEAR()
+{
+ refRedim = PopVar();
+}
+
+void SbiRuntime::StepARRAYACCESS()
+{
+ if( !refArgv.is() )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+ SbxVariableRef refVar = PopVar();
+ refVar->SetParameters( refArgv.get() );
+ PopArgv();
+ PushVar( CheckArray( refVar.get() ) );
+}
+
+void SbiRuntime::StepBYVAL()
+{
+ // Copy variable on stack to break call by reference
+ SbxVariableRef pVar = PopVar();
+ SbxDataType t = pVar->GetType();
+
+ SbxVariable* pCopyVar = new SbxVariable( t );
+ pCopyVar->SetFlag( SbxFlagBits::ReadWrite );
+ *pCopyVar = *pVar;
+
+ PushVar( pCopyVar );
+}
+
+// establishing an argv
+// nOp1 stays as it is -> 1st element is the return value
+
+void SbiRuntime::StepARGC()
+{
+ PushArgv();
+ refArgv = new SbxArray;
+ nArgc = 1;
+}
+
+// storing an argument in Argv
+
+void SbiRuntime::StepARGV()
+{
+ if( !refArgv.is() )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+ else
+ {
+ SbxVariableRef pVal = PopVar();
+
+ // Before fix of #94916:
+ if( dynamic_cast<const SbxMethod*>( pVal.get() ) != nullptr
+ || dynamic_cast<const SbUnoProperty*>( pVal.get() ) != nullptr
+ || dynamic_cast<const SbProcedureProperty*>( pVal.get() ) != nullptr )
+ {
+ // evaluate methods and properties!
+ SbxVariable* pRes = new SbxVariable( *pVal );
+ pVal = pRes;
+ }
+ refArgv->Put32( pVal.get(), nArgc++ );
+ }
+}
+
+// Input to Variable. The variable is on TOS and is
+// is removed afterwards.
+void SbiRuntime::StepINPUT()
+{
+ OUStringBuffer sin;
+ OUString s;
+ char ch = 0;
+ ErrCode err;
+ // Skip whitespace
+ while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
+ {
+ ch = pIosys->Read();
+ if( ch != ' ' && ch != '\t' && ch != '\n' )
+ {
+ break;
+ }
+ }
+ if( !err )
+ {
+ // Scan until comma or whitespace
+ char sep = ( ch == '"' ) ? ch : 0;
+ if( sep )
+ {
+ ch = pIosys->Read();
+ }
+ while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
+ {
+ if( ch == sep )
+ {
+ ch = pIosys->Read();
+ if( ch != sep )
+ {
+ break;
+ }
+ }
+ else if( !sep && (ch == ',' || ch == '\n') )
+ {
+ break;
+ }
+ sin.append( ch );
+ ch = pIosys->Read();
+ }
+ // skip whitespace
+ if( ch == ' ' || ch == '\t' )
+ {
+ while( ( err = pIosys->GetError() ) == ERRCODE_NONE )
+ {
+ if( ch != ' ' && ch != '\t' && ch != '\n' )
+ {
+ break;
+ }
+ ch = pIosys->Read();
+ }
+ }
+ }
+ if( !err )
+ {
+ s = sin.makeStringAndClear();
+ SbxVariableRef pVar = GetTOS();
+ // try to fill the variable with a numeric value first,
+ // then with a string value
+ if( !pVar->IsFixed() || pVar->IsNumeric() )
+ {
+ sal_uInt16 nLen = 0;
+ if( !pVar->Scan( s, &nLen ) )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ // the value has to be scanned in completely
+ else if( nLen != s.getLength() && !pVar->PutString( s ) )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ else if( nLen != s.getLength() && pVar->IsNumeric() )
+ {
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ if( !err )
+ {
+ err = ERRCODE_BASIC_CONVERSION;
+ }
+ }
+ }
+ else
+ {
+ pVar->PutString( s );
+ err = SbxBase::GetError();
+ SbxBase::ResetError();
+ }
+ }
+ if( err == ERRCODE_BASIC_USER_ABORT )
+ {
+ Error( err );
+ }
+ else if( err )
+ {
+ if( pRestart && !pIosys->GetChannel() )
+ {
+ pCode = pRestart;
+ }
+ else
+ {
+ Error( err );
+ }
+ }
+ else
+ {
+ PopVar();
+ }
+}
+
+// Line Input to Variable. The variable is on TOS and is
+// deleted afterwards.
+
+void SbiRuntime::StepLINPUT()
+{
+ OString aInput;
+ pIosys->Read( aInput );
+ Error( pIosys->GetError() );
+ SbxVariableRef p = PopVar();
+ p->PutString(OStringToOUString(aInput, osl_getThreadTextEncoding()));
+}
+
+// end of program
+
+void SbiRuntime::StepSTOP()
+{
+ pInst->Stop();
+}
+
+
+void SbiRuntime::StepINITFOR()
+{
+ PushFor();
+}
+
+void SbiRuntime::StepINITFOREACH()
+{
+ PushForEach();
+}
+
+// increment FOR-variable
+
+void SbiRuntime::StepNEXT()
+{
+ if( !pForStk )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+ if (pForStk->eForType != ForType::To)
+ return;
+ if (!pForStk->refVar)
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+ pForStk->refVar->Compute( SbxPLUS, *pForStk->refInc );
+}
+
+// beginning CASE: TOS in CASE-stack
+
+void SbiRuntime::StepCASE()
+{
+ if( !refCaseStk.is() )
+ {
+ refCaseStk = new SbxArray;
+ }
+ SbxVariableRef xVar = PopVar();
+ refCaseStk->Put32( xVar.get(), refCaseStk->Count32() );
+}
+
+// end CASE: free variable
+
+void SbiRuntime::StepENDCASE()
+{
+ if( !refCaseStk.is() || !refCaseStk->Count32() )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+ else
+ {
+ refCaseStk->Remove( refCaseStk->Count32() - 1 );
+ }
+}
+
+
+void SbiRuntime::StepSTDERROR()
+{
+ pError = nullptr; bError = true;
+ pInst->aErrorMsg.clear();
+ pInst->nErr = ERRCODE_NONE;
+ pInst->nErl = 0;
+ nError = ERRCODE_NONE;
+ SbxErrObject::getUnoErrObject()->Clear();
+}
+
+void SbiRuntime::StepNOERROR()
+{
+ pInst->aErrorMsg.clear();
+ pInst->nErr = ERRCODE_NONE;
+ pInst->nErl = 0;
+ nError = ERRCODE_NONE;
+ SbxErrObject::getUnoErrObject()->Clear();
+ bError = false;
+}
+
+// leave UP
+
+void SbiRuntime::StepLEAVE()
+{
+ bRun = false;
+ // If VBA and we are leaving an ErrorHandler then clear the error ( it's been processed )
+ if ( bInError && pError )
+ {
+ SbxErrObject::getUnoErrObject()->Clear();
+ }
+}
+
+void SbiRuntime::StepCHANNEL() // TOS = channel number
+{
+ SbxVariableRef pChan = PopVar();
+ short nChan = pChan->GetInteger();
+ pIosys->SetChannel( nChan );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepCHANNEL0()
+{
+ pIosys->ResetChannel();
+}
+
+void SbiRuntime::StepPRINT() // print TOS
+{
+ SbxVariableRef p = PopVar();
+ OUString s1 = p->GetOUString();
+ OUString s;
+ if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
+ {
+ s = " "; // one blank before
+ }
+ s += s1;
+ pIosys->Write( s );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepPRINTF() // print TOS in field
+{
+ SbxVariableRef p = PopVar();
+ OUString s1 = p->GetOUString();
+ OUStringBuffer s;
+ if( p->GetType() >= SbxINTEGER && p->GetType() <= SbxDOUBLE )
+ {
+ s.append(' ');
+ }
+ s.append(s1);
+ comphelper::string::padToLength(s, 14, ' ');
+ pIosys->Write( s.makeStringAndClear() );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepWRITE() // write TOS
+{
+ SbxVariableRef p = PopVar();
+ // Does the string have to be encapsulated?
+ char ch = 0;
+ switch (p->GetType() )
+ {
+ case SbxSTRING: ch = '"'; break;
+ case SbxCURRENCY:
+ case SbxBOOL:
+ case SbxDATE: ch = '#'; break;
+ default: break;
+ }
+ OUString s;
+ if( ch )
+ {
+ s += OUString(ch);
+ }
+ s += p->GetOUString();
+ if( ch )
+ {
+ s += OUString(ch);
+ }
+ pIosys->Write( s );
+ Error( pIosys->GetError() );
+}
+
+void SbiRuntime::StepRENAME() // Rename Tos+1 to Tos
+{
+ SbxVariableRef pTos1 = PopVar();
+ SbxVariableRef pTos = PopVar();
+ OUString aDest = pTos1->GetOUString();
+ OUString aSource = pTos->GetOUString();
+
+ if( hasUno() )
+ {
+ implStepRenameUCB( aSource, aDest );
+ }
+ else
+ {
+ implStepRenameOSL( aSource, aDest );
+ }
+}
+
+// TOS = Prompt
+
+void SbiRuntime::StepPROMPT()
+{
+ SbxVariableRef p = PopVar();
+ OString aStr(OUStringToOString(p->GetOUString(), osl_getThreadTextEncoding()));
+ pIosys->SetPrompt( aStr );
+}
+
+// Set Restart point
+
+void SbiRuntime::StepRESTART()
+{
+ pRestart = pCode;
+}
+
+// empty expression on stack for missing parameter
+
+void SbiRuntime::StepEMPTY()
+{
+ // #57915 The semantics of StepEMPTY() is the representation of a missing argument.
+ // This is represented by the value 448 (ERRCODE_BASIC_NAMED_NOT_FOUND) of the type error
+ // in VB. StepEmpty should now rather be named StepMISSING() but the name is kept
+ // to simplify matters.
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ xVar->PutErr( 448 );
+ // tdf#79426, tdf#125180 - add additional information about a missing parameter
+ SetIsMissing( xVar.get() );
+ PushVar( xVar.get() );
+}
+
+// TOS = error code
+
+void SbiRuntime::StepERROR()
+{
+ SbxVariableRef refCode = PopVar();
+ sal_uInt16 n = refCode->GetUShort();
+ ErrCode error = StarBASIC::GetSfxFromVBError( n );
+ if ( bVBAEnabled )
+ {
+ pInst->Error( error );
+ }
+ else
+ {
+ Error( error );
+ }
+}
+
+// loading a numeric constant (+ID)
+
+void SbiRuntime::StepLOADNC( sal_uInt32 nOp1 )
+{
+ // #57844 use localized function
+ OUString aStr = pImg->GetString( static_cast<short>( nOp1 ) );
+ // also allow , !!!
+ sal_Int32 iComma = aStr.indexOf(',');
+ if( iComma >= 0 )
+ {
+ aStr = aStr.replaceAt(iComma, 1, ".");
+ }
+ sal_Int32 nParseEnd = 0;
+ rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok;
+ double n = ::rtl::math::stringToDouble( aStr, '.', ',', &eStatus, &nParseEnd );
+
+ // tdf#131296 - retrieve data type put in SbiExprNode::Gen
+ SbxDataType eType = SbxDOUBLE;
+ if ( nParseEnd < aStr.getLength() )
+ {
+ switch ( aStr[nParseEnd] )
+ {
+ // See GetSuffixType in basic/source/comp/scanner.cxx for type characters
+ case '%': eType = SbxINTEGER; break;
+ case '&': eType = SbxLONG; break;
+ case '!': eType = SbxSINGLE; break;
+ case '@': eType = SbxCURRENCY; break;
+ }
+ }
+ SbxVariable* p = new SbxVariable( eType );
+ p->PutDouble( n );
+ // tdf#133913 - create variable with Variant/Type in order to prevent type conversion errors
+ p->ResetFlag( SbxFlagBits::Fixed );
+ PushVar( p );
+}
+
+// loading a string constant (+ID)
+
+void SbiRuntime::StepLOADSC( sal_uInt32 nOp1 )
+{
+ SbxVariable* p = new SbxVariable;
+ p->PutString( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ PushVar( p );
+}
+
+// Immediate Load (+value)
+// The opcode is not generated in SbiExprNode::Gen anymore; used for legacy images
+
+void SbiRuntime::StepLOADI( sal_uInt32 nOp1 )
+{
+ SbxVariable* p = new SbxVariable;
+ p->PutInteger( static_cast<sal_Int16>( nOp1 ) );
+ PushVar( p );
+}
+
+// store a named argument in Argv (+Arg-no. from 1!)
+
+void SbiRuntime::StepARGN( sal_uInt32 nOp1 )
+{
+ if( !refArgv.is() )
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ else
+ {
+ OUString aAlias( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ SbxVariableRef pVal = PopVar();
+ if( bVBAEnabled &&
+ ( dynamic_cast<const SbxMethod*>( pVal.get()) != nullptr
+ || dynamic_cast<const SbUnoProperty*>( pVal.get()) != nullptr
+ || dynamic_cast<const SbProcedureProperty*>( pVal.get()) != nullptr ) )
+ {
+ // named variables ( that are Any especially properties ) can be empty at this point and need a broadcast
+ if ( pVal->GetType() == SbxEMPTY )
+ pVal->Broadcast( SfxHintId::BasicDataWanted );
+ // evaluate methods and properties!
+ SbxVariable* pRes = new SbxVariable( *pVal );
+ pVal = pRes;
+ }
+ refArgv->Put32( pVal.get(), nArgc );
+ refArgv->PutAlias32( aAlias, nArgc++ );
+ }
+}
+
+// converting the type of an argument in Argv for DECLARE-Fkt. (+type)
+
+void SbiRuntime::StepARGTYP( sal_uInt32 nOp1 )
+{
+ if( !refArgv.is() )
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ else
+ {
+ bool bByVal = (nOp1 & 0x8000) != 0; // Is BYVAL requested?
+ SbxDataType t = static_cast<SbxDataType>(nOp1 & 0x7FFF);
+ SbxVariable* pVar = refArgv->Get32( refArgv->Count32() - 1 ); // last Arg
+
+ // check BYVAL
+ if( pVar->GetRefCount() > 2 ) // 2 is normal for BYVAL
+ {
+ // parameter is a reference
+ if( bByVal )
+ {
+ // Call by Value is requested -> create a copy
+ pVar = new SbxVariable( *pVar );
+ pVar->SetFlag( SbxFlagBits::ReadWrite );
+ refExprStk->Put32( pVar, refArgv->Count32() - 1 );
+ }
+ else
+ pVar->SetFlag( SbxFlagBits::Reference ); // Ref-Flag for DllMgr
+ }
+ else
+ {
+ // parameter is NO reference
+ if( bByVal )
+ pVar->ResetFlag( SbxFlagBits::Reference ); // no reference -> OK
+ else
+ Error( ERRCODE_BASIC_BAD_PARAMETERS ); // reference needed
+ }
+
+ if( pVar->GetType() != t )
+ {
+ // variant for correct conversion
+ // besides error, if SbxBYREF
+ pVar->Convert( SbxVARIANT );
+ pVar->Convert( t );
+ }
+ }
+}
+
+// bring string to a definite length (+length)
+
+void SbiRuntime::StepPAD( sal_uInt32 nOp1 )
+{
+ SbxVariable* p = GetTOS();
+ OUString s = p->GetOUString();
+ sal_Int32 nLen(nOp1);
+ if( s.getLength() == nLen )
+ return;
+
+ OUStringBuffer aBuf(s);
+ if (aBuf.getLength() > nLen)
+ {
+ comphelper::string::truncateToLength(aBuf, nLen);
+ }
+ else
+ {
+ comphelper::string::padToLength(aBuf, nLen, ' ');
+ }
+ s = aBuf.makeStringAndClear();
+}
+
+// jump (+target)
+
+void SbiRuntime::StepJUMP( sal_uInt32 nOp1 )
+{
+#ifdef DBG_UTIL
+ // #QUESTION shouldn't this be
+ // if( (sal_uInt8*)( nOp1+pImagGetCode() ) >= pImg->GetCodeSize() )
+ if( nOp1 >= pImg->GetCodeSize() )
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+#endif
+ pCode = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
+}
+
+// evaluate TOS, conditional jump (+target)
+
+void SbiRuntime::StepJUMPT( sal_uInt32 nOp1 )
+{
+ SbxVariableRef p = PopVar();
+ if( p->GetBool() )
+ StepJUMP( nOp1 );
+}
+
+// evaluate TOS, conditional jump (+target)
+
+void SbiRuntime::StepJUMPF( sal_uInt32 nOp1 )
+{
+ SbxVariableRef p = PopVar();
+ // In a test e.g. If Null then
+ // will evaluate Null will act as if False
+ if( ( bVBAEnabled && p->IsNull() ) || !p->GetBool() )
+ StepJUMP( nOp1 );
+}
+
+// evaluate TOS, jump into JUMP-table (+MaxVal)
+// looks like this:
+// ONJUMP 2
+// JUMP target1
+// JUMP target2
+
+// if 0x8000 is set in the operand, push the return address (ON..GOSUB)
+
+void SbiRuntime::StepONJUMP( sal_uInt32 nOp1 )
+{
+ SbxVariableRef p = PopVar();
+ sal_Int16 n = p->GetInteger();
+ if( nOp1 & 0x8000 )
+ {
+ nOp1 &= 0x7FFF;
+ PushGosub( pCode + 5 * nOp1 );
+ }
+ if( n < 1 || o3tl::make_unsigned(n) > nOp1 )
+ n = static_cast<sal_Int16>( nOp1 + 1 );
+ nOp1 = static_cast<sal_uInt32>( reinterpret_cast<const char*>(pCode) - pImg->GetCode() ) + 5 * --n;
+ StepJUMP( nOp1 );
+}
+
+// UP-call (+target)
+
+void SbiRuntime::StepGOSUB( sal_uInt32 nOp1 )
+{
+ PushGosub( pCode );
+ if( nOp1 >= pImg->GetCodeSize() )
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ pCode = reinterpret_cast<const sal_uInt8*>(pImg->GetCode()) + nOp1;
+}
+
+// UP-return (+0 or target)
+
+void SbiRuntime::StepRETURN( sal_uInt32 nOp1 )
+{
+ PopGosub();
+ if( nOp1 )
+ StepJUMP( nOp1 );
+}
+
+// check FOR-variable (+Endlabel)
+
+void SbiRuntime::StepTESTFOR( sal_uInt32 nOp1 )
+{
+ if( !pForStk )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ return;
+ }
+
+ bool bEndLoop = false;
+ switch( pForStk->eForType )
+ {
+ case ForType::To:
+ {
+ SbxOperator eOp = ( pForStk->refInc->GetDouble() < 0 ) ? SbxLT : SbxGT;
+ if( pForStk->refVar->Compare( eOp, *pForStk->refEnd ) )
+ bEndLoop = true;
+ if (SbxBase::IsError())
+ pForStk->eForType = ForType::Error; // terminate loop at the next iteration
+ break;
+ }
+ case ForType::EachArray:
+ {
+ SbiForStack* p = pForStk;
+ if (!p->refEnd)
+ {
+ SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
+ pForStk->eForType = ForType::Error; // terminate loop at the next iteration
+ }
+ else if (p->pArrayCurIndices == nullptr)
+ {
+ bEndLoop = true;
+ }
+ else
+ {
+ SbxDimArray* pArray = reinterpret_cast<SbxDimArray*>(p->refEnd.get());
+ sal_Int32 nDims = pArray->GetDims32();
+
+ // Empty array?
+ if( nDims == 1 && p->pArrayLowerBounds[0] > p->pArrayUpperBounds[0] )
+ {
+ bEndLoop = true;
+ break;
+ }
+ SbxVariable* pVal = pArray->Get32( p->pArrayCurIndices.get() );
+ *(p->refVar) = *pVal;
+
+ bool bFoundNext = false;
+ for(sal_Int32 i = 0 ; i < nDims ; i++ )
+ {
+ if( p->pArrayCurIndices[i] < p->pArrayUpperBounds[i] )
+ {
+ bFoundNext = true;
+ p->pArrayCurIndices[i]++;
+ for( sal_Int32 j = i - 1 ; j >= 0 ; j-- )
+ p->pArrayCurIndices[j] = p->pArrayLowerBounds[j];
+ break;
+ }
+ }
+ if( !bFoundNext )
+ {
+ p->pArrayCurIndices.reset();
+ }
+ }
+ break;
+ }
+ case ForType::EachCollection:
+ {
+ if (!pForStk->refEnd)
+ {
+ SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
+ pForStk->eForType = ForType::Error; // terminate loop at the next iteration
+ break;
+ }
+
+ BasicCollection* pCollection = static_cast<BasicCollection*>(pForStk->refEnd.get());
+ SbxArrayRef xItemArray = pCollection->xItemArray;
+ sal_Int32 nCount = xItemArray->Count32();
+ if( pForStk->nCurCollectionIndex < nCount )
+ {
+ SbxVariable* pRes = xItemArray->Get32( pForStk->nCurCollectionIndex );
+ pForStk->nCurCollectionIndex++;
+ (*pForStk->refVar) = *pRes;
+ }
+ else
+ {
+ bEndLoop = true;
+ }
+ break;
+ }
+ case ForType::EachXEnumeration:
+ {
+ SbiForStack* p = pForStk;
+ if (!p->xEnumeration)
+ {
+ SbxBase::SetError(ERRCODE_BASIC_CONVERSION);
+ pForStk->eForType = ForType::Error; // terminate loop at the next iteration
+ }
+ else if (p->xEnumeration->hasMoreElements())
+ {
+ Any aElem = p->xEnumeration->nextElement();
+ SbxVariableRef xVar = new SbxVariable( SbxVARIANT );
+ unoToSbxValue( xVar.get(), aElem );
+ (*pForStk->refVar) = *xVar;
+ }
+ else
+ {
+ bEndLoop = true;
+ }
+ break;
+ }
+ case ForType::Error:
+ {
+ // We are in Resume Next mode after failed loop initialization
+ bEndLoop = true;
+ Error(ERRCODE_BASIC_BAD_PARAMETER);
+ break;
+ }
+ }
+ if( bEndLoop )
+ {
+ PopFor();
+ StepJUMP( nOp1 );
+ }
+}
+
+// Tos+1 <= Tos+2 <= Tos, 2xremove (+Target)
+
+void SbiRuntime::StepCASETO( sal_uInt32 nOp1 )
+{
+ if( !refCaseStk.is() || !refCaseStk->Count32() )
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ else
+ {
+ SbxVariableRef xTo = PopVar();
+ SbxVariableRef xFrom = PopVar();
+ SbxVariableRef xCase = refCaseStk->Get32( refCaseStk->Count32() - 1 );
+ if( *xCase >= *xFrom && *xCase <= *xTo )
+ StepJUMP( nOp1 );
+ }
+}
+
+
+void SbiRuntime::StepERRHDL( sal_uInt32 nOp1 )
+{
+ const sal_uInt8* p = pCode;
+ StepJUMP( nOp1 );
+ pError = pCode;
+ pCode = p;
+ pInst->aErrorMsg.clear();
+ pInst->nErr = ERRCODE_NONE;
+ pInst->nErl = 0;
+ nError = ERRCODE_NONE;
+ SbxErrObject::getUnoErrObject()->Clear();
+}
+
+// Resume after errors (+0=statement, 1=next or Label)
+
+void SbiRuntime::StepRESUME( sal_uInt32 nOp1 )
+{
+ // #32714 Resume without error? -> error
+ if( !bInError )
+ {
+ Error( ERRCODE_BASIC_BAD_RESUME );
+ return;
+ }
+ if( nOp1 )
+ {
+ // set Code-pointer to the next statement
+ sal_uInt16 n1, n2;
+ pCode = pMod->FindNextStmnt( pErrCode, n1, n2, true, pImg );
+ }
+ else
+ pCode = pErrStmnt;
+ if ( pError ) // current in error handler ( and got a Resume Next statement )
+ SbxErrObject::getUnoErrObject()->Clear();
+
+ if( nOp1 > 1 )
+ StepJUMP( nOp1 );
+ pInst->aErrorMsg.clear();
+ pInst->nErr = ERRCODE_NONE;
+ pInst->nErl = 0;
+ nError = ERRCODE_NONE;
+ bInError = false;
+}
+
+// close channel (+channel, 0=all)
+void SbiRuntime::StepCLOSE( sal_uInt32 nOp1 )
+{
+ ErrCode err;
+ if( !nOp1 )
+ pIosys->Shutdown();
+ else
+ {
+ err = pIosys->GetError();
+ if( !err )
+ {
+ pIosys->Close();
+ }
+ }
+ err = pIosys->GetError();
+ Error( err );
+}
+
+// output character (+char)
+
+void SbiRuntime::StepPRCHAR( sal_uInt32 nOp1 )
+{
+ OUString s(static_cast<sal_Unicode>(nOp1));
+ pIosys->Write( s );
+ Error( pIosys->GetError() );
+}
+
+// check whether TOS is a certain object class (+StringID)
+
+bool SbiRuntime::implIsClass( SbxObject const * pObj, const OUString& aClass )
+{
+ bool bRet = true;
+
+ if( !aClass.isEmpty() )
+ {
+ bRet = pObj->IsClass( aClass );
+ if( !bRet )
+ bRet = aClass.equalsIgnoreAsciiCase( "object" );
+ if( !bRet )
+ {
+ const OUString& aObjClass = pObj->GetClassName();
+ SbModule* pClassMod = GetSbData()->pClassFac->FindClass( aObjClass );
+ if( pClassMod )
+ {
+ SbClassData* pClassData = pClassMod->pClassData.get();
+ if (pClassData != nullptr )
+ {
+ SbxVariable* pClassVar = pClassData->mxIfaces->Find( aClass, SbxClassType::DontCare );
+ bRet = (pClassVar != nullptr);
+ }
+ }
+ }
+ }
+ return bRet;
+}
+
+bool SbiRuntime::checkClass_Impl( const SbxVariableRef& refVal,
+ const OUString& aClass, bool bRaiseErrors, bool bDefault )
+{
+ bool bOk = bDefault;
+
+ SbxDataType t = refVal->GetType();
+ SbxVariable* pVal = refVal.get();
+ // we don't know the type of uno properties that are (maybevoid)
+ if ( t == SbxEMPTY )
+ {
+ if ( auto pProp = dynamic_cast<SbUnoProperty*>( refVal.get() ) )
+ {
+ t = pProp->getRealType();
+ }
+ }
+ if( t == SbxOBJECT || bVBAEnabled )
+ {
+ SbxObject* pObj = dynamic_cast<SbxObject*>(pVal);
+ if (!pObj)
+ {
+ pObj = dynamic_cast<SbxObject*>(refVal->GetObject());
+ }
+ if( pObj )
+ {
+ if( !implIsClass( pObj, aClass ) )
+ {
+ SbUnoObject* pUnoObj(nullptr);
+ if (bVBAEnabled || CodeCompleteOptions::IsExtendedTypeDeclaration())
+ {
+ pUnoObj = dynamic_cast<SbUnoObject*>(pObj);
+ }
+
+ if (pUnoObj)
+ bOk = checkUnoObjectType(*pUnoObj, aClass);
+ else
+ bOk = false;
+ if ( !bOk && bRaiseErrors )
+ Error( ERRCODE_BASIC_INVALID_USAGE_OBJECT );
+ }
+ else
+ {
+ bOk = true;
+
+ SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pObj );
+ if( pClassModuleObject != nullptr )
+ pClassModuleObject->triggerInitializeEvent();
+ }
+ }
+ }
+ else
+ {
+ if( bRaiseErrors )
+ Error( ERRCODE_BASIC_NEEDS_OBJECT );
+ bOk = false;
+ }
+ return bOk;
+}
+
+void SbiRuntime::StepSETCLASS_impl( sal_uInt32 nOp1, bool bHandleDflt )
+{
+ SbxVariableRef refVal = PopVar();
+ SbxVariableRef refVar = PopVar();
+ OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
+
+ bool bOk = checkClass_Impl( refVal, aClass, true, true );
+ if( bOk )
+ {
+ StepSET_Impl( refVal, refVar, bHandleDflt ); // don't do handle default prop for a "proper" set
+ }
+}
+
+void SbiRuntime::StepVBASETCLASS( sal_uInt32 nOp1 )
+{
+ StepSETCLASS_impl( nOp1, false );
+}
+
+void SbiRuntime::StepSETCLASS( sal_uInt32 nOp1 )
+{
+ StepSETCLASS_impl( nOp1, true );
+}
+
+void SbiRuntime::StepTESTCLASS( sal_uInt32 nOp1 )
+{
+ SbxVariableRef xObjVal = PopVar();
+ OUString aClass( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ bool bDefault = !bVBAEnabled;
+ bool bOk = checkClass_Impl( xObjVal, aClass, false, bDefault );
+
+ SbxVariable* pRet = new SbxVariable;
+ pRet->PutBool( bOk );
+ PushVar( pRet );
+}
+
+// define library for following declare-call
+
+void SbiRuntime::StepLIB( sal_uInt32 nOp1 )
+{
+ aLibName = pImg->GetString( static_cast<short>( nOp1 ) );
+}
+
+// TOS is incremented by BASE, BASE is pushed before (+BASE)
+// This opcode is pushed before DIM/REDIM-commands,
+// if there's been only one index named.
+
+void SbiRuntime::StepBASED( sal_uInt32 nOp1 )
+{
+ SbxVariable* p1 = new SbxVariable;
+ SbxVariableRef x2 = PopVar();
+
+ // #109275 Check compatibility mode
+ bool bCompatible = ((nOp1 & 0x8000) != 0);
+ sal_uInt16 uBase = static_cast<sal_uInt16>(nOp1 & 1); // Can only be 0 or 1
+ p1->PutInteger( uBase );
+ if( !bCompatible )
+ x2->Compute( SbxPLUS, *p1 );
+ PushVar( x2.get() ); // first the Expr
+ PushVar( p1 ); // then the Base
+}
+
+// the bits in the String-ID:
+// 0x8000 - Argv is reserved
+
+SbxVariable* SbiRuntime::FindElement( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
+ ErrCode nNotFound, bool bLocal, bool bStatic )
+{
+ bool bIsVBAInterOp = SbiRuntime::isVBAEnabled();
+ if( bIsVBAInterOp )
+ {
+ StarBASIC* pMSOMacroRuntimeLib = GetSbData()->pMSOMacroRuntimLib;
+ if( pMSOMacroRuntimeLib != nullptr )
+ {
+ pMSOMacroRuntimeLib->ResetFlag( SbxFlagBits::ExtSearch );
+ }
+ }
+
+ SbxVariable* pElem = nullptr;
+ if( !pObj )
+ {
+ Error( ERRCODE_BASIC_NO_OBJECT );
+ pElem = new SbxVariable;
+ }
+ else
+ {
+ bool bFatalError = false;
+ SbxDataType t = static_cast<SbxDataType>(nOp2);
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
+ // Hacky capture of Evaluate [] syntax
+ // this should be tackled I feel at the pcode level
+ if ( bIsVBAInterOp && aName.startsWith("[") )
+ {
+ // emulate pcode here
+ StepARGC();
+ // pseudo StepLOADSC
+ OUString sArg = aName.copy( 1, aName.getLength() - 2 );
+ SbxVariable* p = new SbxVariable;
+ p->PutString( sArg );
+ PushVar( p );
+ StepARGV();
+ nOp1 = nOp1 | 0x8000; // indicate params are present
+ aName = "Evaluate";
+ }
+ if( bLocal )
+ {
+ if ( bStatic && pMeth )
+ {
+ pElem = pMeth->GetStatics()->Find( aName, SbxClassType::DontCare );
+ }
+
+ if ( !pElem )
+ {
+ pElem = refLocals->Find( aName, SbxClassType::DontCare );
+ }
+ }
+ if( !pElem )
+ {
+ bool bSave = rBasic.bNoRtl;
+ rBasic.bNoRtl = true;
+ pElem = pObj->Find( aName, SbxClassType::DontCare );
+
+ // #110004, #112015: Make private really private
+ if( bLocal && pElem ) // Local as flag for global search
+ {
+ if( pElem->IsSet( SbxFlagBits::Private ) )
+ {
+ SbiInstance* pInst_ = GetSbData()->pInst;
+ if( pInst_ && pInst_->IsCompatibility() && pObj != pElem->GetParent() )
+ {
+ pElem = nullptr; // Found but in wrong module!
+ }
+ // Interfaces: Use SbxFlagBits::ExtFound
+ }
+ }
+ rBasic.bNoRtl = bSave;
+
+ // is it a global uno-identifier?
+ if( bLocal && !pElem )
+ {
+ bool bSetName = true; // preserve normal behaviour
+
+ // i#i68894# if VBAInterOp favour searching vba globals
+ // over searching for uno classes
+ if ( bVBAEnabled )
+ {
+ // Try Find in VBA symbols space
+ pElem = rBasic.VBAFind( aName, SbxClassType::DontCare );
+ if ( pElem )
+ {
+ bSetName = false; // don't overwrite uno name
+ }
+ else
+ {
+ pElem = VBAConstantHelper::instance().getVBAConstant( aName );
+ }
+ }
+
+ if( !pElem )
+ {
+ // #72382 ATTENTION! ALWAYS returns a result now
+ // because of unknown modules!
+ SbUnoClass* pUnoClass = findUnoClass( aName );
+ if( pUnoClass )
+ {
+ pElem = new SbxVariable( t );
+ SbxValues aRes( SbxOBJECT );
+ aRes.pObj = pUnoClass;
+ pElem->SbxVariable::Put( aRes );
+ }
+ }
+
+ // #62939 If a uno-class has been found, the wrapper
+ // object has to be held, because the uno-class, e. g.
+ // "stardiv", has to be read out of the registry
+ // every time again otherwise
+ if( pElem )
+ {
+ // #63774 May not be saved too!!!
+ pElem->SetFlag( SbxFlagBits::DontStore );
+ pElem->SetFlag( SbxFlagBits::NoModify);
+
+ // #72382 save locally, all variables that have been declared
+ // implicit would become global automatically otherwise!
+ if ( bSetName )
+ {
+ pElem->SetName( aName );
+ }
+ refLocals->Put32( pElem, refLocals->Count32() );
+ }
+ }
+
+ if( !pElem )
+ {
+ // not there and not in the object?
+ // don't establish if that thing has parameters!
+ if( nOp1 & 0x8000 )
+ {
+ bFatalError = true;
+ }
+
+ // else, if there are parameters, use different error code
+ if( !bLocal || pImg->IsFlag( SbiImageFlags::EXPLICIT ) )
+ {
+ // #39108 if explicit and as ELEM always a fatal error
+ bFatalError = true;
+
+
+ if( !( nOp1 & 0x8000 ) && nNotFound == ERRCODE_BASIC_PROC_UNDEFINED )
+ {
+ nNotFound = ERRCODE_BASIC_VAR_UNDEFINED;
+ }
+ }
+ if( bFatalError )
+ {
+ // #39108 use dummy variable instead of fatal error
+ if( !xDummyVar.is() )
+ {
+ xDummyVar = new SbxVariable( SbxVARIANT );
+ }
+ pElem = xDummyVar.get();
+
+ ClearArgvStack();
+
+ Error( nNotFound, aName );
+ }
+ else
+ {
+ if ( bStatic )
+ {
+ pElem = StepSTATIC_Impl( aName, t, 0 );
+ }
+ if ( !pElem )
+ {
+ pElem = new SbxVariable( t );
+ if( t != SbxVARIANT )
+ {
+ pElem->SetFlag( SbxFlagBits::Fixed );
+ }
+ pElem->SetName( aName );
+ refLocals->Put32( pElem, refLocals->Count32() );
+ }
+ }
+ }
+ }
+ // #39108 Args can already be deleted!
+ if( !bFatalError )
+ {
+ SetupArgs( pElem, nOp1 );
+ }
+ // because a particular call-type is requested
+ if (SbxMethod* pMethod = dynamic_cast<SbxMethod*>(pElem))
+ {
+ // shall the type be converted?
+ SbxDataType t2 = pElem->GetType();
+ bool bSet = false;
+ if( (pElem->GetFlags() & SbxFlagBits::Fixed) == SbxFlagBits::NONE )
+ {
+ if( t != SbxVARIANT && t != t2 &&
+ t >= SbxINTEGER && t <= SbxSTRING )
+ {
+ pElem->SetType( t );
+ bSet = true;
+ }
+ }
+ // assign pElem to a Ref, to delete a temp-var if applicable
+ SbxVariableRef xDeleteRef = pElem;
+
+ // remove potential rests of the last call of the SbxMethod
+ // free Write before, so that there's no error
+ SbxFlagBits nSavFlags = pElem->GetFlags();
+ pElem->SetFlag( SbxFlagBits::ReadWrite | SbxFlagBits::NoBroadcast );
+ pElem->SbxValue::Clear();
+ pElem->SetFlags( nSavFlags );
+
+ // don't touch before setting, as e. g. LEFT()
+ // has to know the difference between Left$() and Left()
+
+ // because the methods' parameters are cut away in PopVar()
+ SbxVariable* pNew = new SbxMethod(*pMethod);
+ //OLD: SbxVariable* pNew = new SbxVariable( *pElem );
+
+ pElem->SetParameters(nullptr);
+ pNew->SetFlag( SbxFlagBits::ReadWrite );
+
+ if( bSet )
+ {
+ pElem->SetType( t2 );
+ }
+ pElem = pNew;
+ }
+ // consider index-access for UnoObjects
+ // definitely we want this for VBA where properties are often
+ // collections ( which need index access ), but lets only do
+ // this if we actually have params following
+ else if( bVBAEnabled && dynamic_cast<const SbUnoProperty*>( pElem) != nullptr && pElem->GetParameters() )
+ {
+ SbxVariableRef xDeleteRef = pElem;
+
+ // dissolve the notify while copying variable
+ SbxVariable* pNew = new SbxVariable( *pElem );
+ pElem->SetParameters( nullptr );
+ pElem = pNew;
+ }
+ }
+ return CheckArray( pElem );
+}
+
+// for current scope (e. g. query from BASIC-IDE)
+SbxBase* SbiRuntime::FindElementExtern( const OUString& rName )
+{
+ // don't expect pMeth to be != 0, as there are none set
+ // in the RunInit yet
+
+ SbxVariable* pElem = nullptr;
+ if( !pMod || rName.isEmpty() )
+ {
+ return nullptr;
+ }
+ if( refLocals.is() )
+ {
+ pElem = refLocals->Find( rName, SbxClassType::DontCare );
+ }
+ if ( !pElem && pMeth )
+ {
+ // for statics, set the method's name in front
+ OUString aMethName = pMeth->GetName() + ":" + rName;
+ pElem = pMod->Find(aMethName, SbxClassType::DontCare);
+ }
+
+ // search in parameter list
+ if( !pElem && pMeth )
+ {
+ SbxInfo* pInfo = pMeth->GetInfo();
+ if( pInfo && refParams.is() )
+ {
+ sal_uInt32 nParamCount = refParams->Count32();
+ assert(nParamCount <= std::numeric_limits<sal_uInt16>::max());
+ sal_uInt16 j = 1;
+ const SbxParamInfo* pParam = pInfo->GetParam( j );
+ while( pParam )
+ {
+ if( pParam->aName.equalsIgnoreAsciiCase( rName ) )
+ {
+ if( j >= nParamCount )
+ {
+ // Parameter is missing
+ pElem = new SbxVariable( SbxSTRING );
+ pElem->PutString( "<missing parameter>");
+ }
+ else
+ {
+ pElem = refParams->Get32( j );
+ }
+ break;
+ }
+ pParam = pInfo->GetParam( ++j );
+ }
+ }
+ }
+
+ // search in module
+ if( !pElem )
+ {
+ bool bSave = rBasic.bNoRtl;
+ rBasic.bNoRtl = true;
+ pElem = pMod->Find( rName, SbxClassType::DontCare );
+ rBasic.bNoRtl = bSave;
+ }
+ return pElem;
+}
+
+
+void SbiRuntime::SetupArgs( SbxVariable* p, sal_uInt32 nOp1 )
+{
+ if( nOp1 & 0x8000 )
+ {
+ if( !refArgv.is() )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+ bool bHasNamed = false;
+ sal_uInt32 i;
+ sal_uInt32 nArgCount = refArgv->Count32();
+ for( i = 1 ; i < nArgCount ; i++ )
+ {
+ if( !refArgv->GetAlias32(i).isEmpty() )
+ {
+ bHasNamed = true; break;
+ }
+ }
+ if( bHasNamed )
+ {
+ SbxInfo* pInfo = p->GetInfo();
+ if( !pInfo )
+ {
+ bool bError_ = true;
+
+ SbUnoMethod* pUnoMethod = dynamic_cast<SbUnoMethod*>( p );
+ SbUnoProperty* pUnoProperty = dynamic_cast<SbUnoProperty*>( p );
+ if( pUnoMethod || pUnoProperty )
+ {
+ SbUnoObject* pParentUnoObj = dynamic_cast<SbUnoObject*>( p->GetParent() );
+ if( pParentUnoObj )
+ {
+ Any aUnoAny = pParentUnoObj->getUnoAny();
+ Reference< XInvocation > xInvocation;
+ aUnoAny >>= xInvocation;
+ if( xInvocation.is() ) // TODO: if( xOLEAutomation.is() )
+ {
+ bError_ = false;
+
+ sal_uInt32 nCurPar = 1;
+ AutomationNamedArgsSbxArray* pArg =
+ new AutomationNamedArgsSbxArray( nArgCount );
+ OUString* pNames = pArg->getNames().getArray();
+ for( i = 1 ; i < nArgCount ; i++ )
+ {
+ SbxVariable* pVar = refArgv->Get32( i );
+ OUString aName = refArgv->GetAlias32(i);
+ if (!aName.isEmpty())
+ {
+ pNames[i] = aName;
+ }
+ pArg->Put32( pVar, nCurPar++ );
+ }
+ refArgv = pArg;
+ }
+ }
+ }
+ else if( bVBAEnabled && p->GetType() == SbxOBJECT && (dynamic_cast<const SbxMethod*>( p) == nullptr || !p->IsBroadcaster()) )
+ {
+ // Check for default method with named parameters
+ SbxBaseRef xObj = p->GetObject();
+ if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( xObj.get() ))
+ {
+ Any aAny = pUnoObj->getUnoAny();
+
+ if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
+ {
+ Reference< XDefaultMethod > xDfltMethod( aAny, UNO_QUERY );
+
+ OUString sDefaultMethod;
+ if ( xDfltMethod.is() )
+ {
+ sDefaultMethod = xDfltMethod->getDefaultMethodName();
+ }
+ if ( !sDefaultMethod.isEmpty() )
+ {
+ SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
+ if( meth != nullptr )
+ {
+ pInfo = meth->GetInfo();
+ }
+ if( pInfo )
+ {
+ bError_ = false;
+ }
+ }
+ }
+ }
+ }
+ if( bError_ )
+ {
+ Error( ERRCODE_BASIC_NO_NAMED_ARGS );
+ }
+ }
+ else
+ {
+ sal_uInt32 nCurPar = 1;
+ SbxArray* pArg = new SbxArray;
+ for( i = 1 ; i < nArgCount ; i++ )
+ {
+ SbxVariable* pVar = refArgv->Get32( i );
+ OUString aName = refArgv->GetAlias32(i);
+ if (!aName.isEmpty())
+ {
+ // nCurPar is set to the found parameter
+ sal_uInt16 j = 1;
+ const SbxParamInfo* pParam = pInfo->GetParam( j );
+ while( pParam )
+ {
+ if( pParam->aName.equalsIgnoreAsciiCase( aName ) )
+ {
+ nCurPar = j;
+ break;
+ }
+ pParam = pInfo->GetParam( ++j );
+ }
+ if( !pParam )
+ {
+ Error( ERRCODE_BASIC_NAMED_NOT_FOUND ); break;
+ }
+ }
+ pArg->Put32( pVar, nCurPar++ );
+ }
+ refArgv = pArg;
+ }
+ }
+ // own var as parameter 0
+ refArgv->Put32( p, 0 );
+ p->SetParameters( refArgv.get() );
+ PopArgv();
+ }
+ else
+ {
+ p->SetParameters( nullptr );
+ }
+}
+
+// getting an array element
+
+SbxVariable* SbiRuntime::CheckArray( SbxVariable* pElem )
+{
+ SbxArray* pPar;
+ if( ( pElem->GetType() & SbxARRAY ) && refRedim.get() != pElem )
+ {
+ SbxBase* pElemObj = pElem->GetObject();
+ SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( pElemObj );
+ pPar = pElem->GetParameters();
+ if( pDimArray )
+ {
+ // parameters may be missing, if an array is
+ // passed as an argument
+ if( pPar )
+ pElem = pDimArray->Get( pPar );
+ }
+ else
+ {
+ SbxArray* pArray = dynamic_cast<SbxArray*>( pElemObj );
+ if( pArray )
+ {
+ if( !pPar )
+ {
+ Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ pElem = new SbxVariable;
+ }
+ else
+ {
+ pElem = pArray->Get32( pPar->Get32( 1 )->GetInteger() );
+ }
+ }
+ }
+
+ // #42940, set parameter 0 to NULL so that var doesn't contain itself
+ if( pPar )
+ {
+ pPar->Put32( nullptr, 0 );
+ }
+ }
+ // consider index-access for UnoObjects
+ else if( pElem->GetType() == SbxOBJECT &&
+ dynamic_cast<const SbxMethod*>( pElem) == nullptr &&
+ ( !bVBAEnabled || dynamic_cast<const SbxProperty*>( pElem) == nullptr ) )
+ {
+ pPar = pElem->GetParameters();
+ if ( pPar )
+ {
+ // is it a uno-object?
+ SbxBaseRef pObj = pElem->GetObject();
+ if( pObj.is() )
+ {
+ if (SbUnoObject* pUnoObj = dynamic_cast<SbUnoObject*>( pObj.get()))
+ {
+ Any aAny = pUnoObj->getUnoAny();
+
+ if( aAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
+ {
+ Reference< XIndexAccess > xIndexAccess( aAny, UNO_QUERY );
+ if ( !bVBAEnabled )
+ {
+ if( xIndexAccess.is() )
+ {
+ sal_uInt32 nParamCount = pPar->Count32() - 1;
+ if( nParamCount != 1 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return pElem;
+ }
+
+ // get index
+ sal_Int32 nIndex = pPar->Get32( 1 )->GetLong();
+ Reference< XInterface > xRet;
+ try
+ {
+ Any aAny2 = xIndexAccess->getByIndex( nIndex );
+ aAny2 >>= xRet;
+ }
+ catch (const IndexOutOfBoundsException&)
+ {
+ // usually expect converting problem
+ StarBASIC::Error( ERRCODE_BASIC_OUT_OF_RANGE );
+ }
+
+ // #57847 always create a new variable, else error
+ // due to PutObject(NULL) at ReadOnly-properties
+ pElem = new SbxVariable( SbxVARIANT );
+ if( xRet.is() )
+ {
+ aAny <<= xRet;
+
+ // #67173 don't specify a name so that the real class name is entered
+ SbxObjectRef xWrapper = static_cast<SbxObject*>(new SbUnoObject( OUString(), aAny ));
+ pElem->PutObject( xWrapper.get() );
+ }
+ else
+ {
+ pElem->PutObject( nullptr );
+ }
+ }
+ }
+ else
+ {
+ // check if there isn't a default member between the current variable
+ // and the params, e.g.
+ // Dim rst1 As New ADODB.Recordset
+ // "
+ // val = rst1("FirstName")
+ // has the default 'Fields' member between rst1 and '("FirstName")'
+ Any x = aAny;
+ SbxVariable* pDflt = getDefaultProp( pElem );
+ if ( pDflt )
+ {
+ pDflt->Broadcast( SfxHintId::BasicDataWanted );
+ SbxBaseRef pDfltObj = pDflt->GetObject();
+ if( pDfltObj.is() )
+ {
+ if (SbUnoObject* pSbObj = dynamic_cast<SbUnoObject*>(pDfltObj.get()))
+ {
+ pUnoObj = pSbObj;
+ Any aUnoAny = pUnoObj->getUnoAny();
+
+ if( aUnoAny.getValueType().getTypeClass() == TypeClass_INTERFACE )
+ x = aUnoAny;
+ pElem = pDflt;
+ }
+ }
+ }
+ OUString sDefaultMethod;
+
+ Reference< XDefaultMethod > xDfltMethod( x, UNO_QUERY );
+
+ if ( xDfltMethod.is() )
+ {
+ sDefaultMethod = xDfltMethod->getDefaultMethodName();
+ }
+ else if( xIndexAccess.is() )
+ {
+ sDefaultMethod = "getByIndex";
+ }
+ if ( !sDefaultMethod.isEmpty() )
+ {
+ SbxVariable* meth = pUnoObj->Find( sDefaultMethod, SbxClassType::Method );
+ SbxVariableRef refTemp = meth;
+ if ( refTemp.is() )
+ {
+ meth->SetParameters( pPar );
+ SbxVariable* pNew = new SbxMethod( *static_cast<SbxMethod*>(meth) );
+ pElem = pNew;
+ }
+ }
+ }
+ }
+
+ // #42940, set parameter 0 to NULL so that var doesn't contain itself
+ pPar->Put32( nullptr, 0 );
+ }
+ else if (BasicCollection* pCol = dynamic_cast<BasicCollection*>(pObj.get()))
+ {
+ pElem = new SbxVariable( SbxVARIANT );
+ pPar->Put32( pElem, 0 );
+ pCol->CollItem( pPar );
+ }
+ }
+ else if( bVBAEnabled ) // !pObj
+ {
+ SbxArray* pParam = pElem->GetParameters();
+ if( pParam != nullptr && !pElem->IsSet( SbxFlagBits::VarToDim ) )
+ {
+ Error( ERRCODE_BASIC_NO_OBJECT );
+ }
+ }
+ }
+ }
+
+ return pElem;
+}
+
+// loading an element from the runtime-library (+StringID+type)
+
+void SbiRuntime::StepRTL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ PushVar( FindElement( rBasic.pRtl.get(), nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, false ) );
+}
+
+void SbiRuntime::StepFIND_Impl( SbxObject* pObj, sal_uInt32 nOp1, sal_uInt32 nOp2,
+ ErrCode nNotFound, bool bStatic )
+{
+ if( !refLocals.is() )
+ {
+ refLocals = new SbxArray;
+ }
+ PushVar( FindElement( pObj, nOp1, nOp2, nNotFound, true/*bLocal*/, bStatic ) );
+}
+// loading a local/global variable (+StringID+type)
+
+void SbiRuntime::StepFIND( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED );
+}
+
+// Search inside a class module (CM) to enable global search in time
+void SbiRuntime::StepFIND_CM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+
+ SbClassModuleObject* pClassModuleObject = dynamic_cast<SbClassModuleObject*>( pMod );
+ if( pClassModuleObject )
+ {
+ pMod->SetFlag( SbxFlagBits::GlobalSearch );
+ }
+ StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED);
+
+ if( pClassModuleObject )
+ {
+ pMod->ResetFlag( SbxFlagBits::GlobalSearch );
+ }
+}
+
+void SbiRuntime::StepFIND_STATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ StepFIND_Impl( pMod, nOp1, nOp2, ERRCODE_BASIC_PROC_UNDEFINED, true );
+}
+
+// loading an object-element (+StringID+type)
+// the object lies on TOS
+
+void SbiRuntime::StepELEM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ SbxVariableRef pObjVar = PopVar();
+
+ SbxObject* pObj = dynamic_cast<SbxObject*>( pObjVar.get() );
+ if( !pObj )
+ {
+ SbxBase* pObjVarObj = pObjVar->GetObject();
+ pObj = dynamic_cast<SbxObject*>( pObjVarObj );
+ }
+
+ // #56368 save reference at StepElem, otherwise objects could
+ // lose their reference too early in qualification chains like
+ // ActiveComponent.Selection(0).Text
+ // #74254 now per list
+ if( pObj )
+ {
+ aRefSaved.emplace_back(pObj );
+ }
+ PushVar( FindElement( pObj, nOp1, nOp2, ERRCODE_BASIC_NO_METHOD, false ) );
+}
+
+/** Loading of a parameter (+offset+type)
+ If the data type is wrong, create a copy and search for optionals including
+ the default value. The data type SbxEMPTY shows that no parameters are given.
+ Get( 0 ) may be EMPTY
+
+ @param nOp1
+ the index of the current parameter being processed,
+ where the entry of the index 0 is for the return value.
+
+ @param nOp2
+ the data type of the parameter.
+ */
+void SbiRuntime::StepPARAM( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ sal_uInt16 nIdx = static_cast<sal_uInt16>( nOp1 & 0x7FFF );
+ SbxDataType eType = static_cast<SbxDataType>(nOp2);
+ SbxVariable* pVar;
+
+ // #57915 solve missing in a cleaner way
+ sal_uInt32 nParamCount = refParams->Count32();
+ if( nIdx >= nParamCount )
+ {
+ sal_uInt16 iLoop = nIdx;
+ while( iLoop >= nParamCount )
+ {
+ pVar = new SbxVariable();
+ pVar->PutErr( 448 ); // like in VB: Error-Code 448 (ERRCODE_BASIC_NAMED_NOT_FOUND)
+ // tdf#79426, tdf#125180 - add additional information about a missing parameter
+ SetIsMissing( pVar );
+ refParams->Put32( pVar, iLoop );
+ iLoop--;
+ }
+ }
+ pVar = refParams->Get32( nIdx );
+
+ // tdf#79426, tdf#125180 - check for optionals only if the parameter is actually missing
+ if( pVar->GetType() == SbxERROR && IsMissing( pVar, 1 ) && nIdx )
+ {
+ // if there's a parameter missing, it can be OPTIONAL
+ bool bOpt = false;
+ if( pMeth )
+ {
+ SbxInfo* pInfo = pMeth->GetInfo();
+ if ( pInfo )
+ {
+ const SbxParamInfo* pParam = pInfo->GetParam( nIdx );
+ if( pParam && ( pParam->nFlags & SbxFlagBits::Optional ) )
+ {
+ // tdf#136143 - reset SbxFlagBits::Fixed in order to prevent type conversion errors
+ pVar->ResetFlag( SbxFlagBits::Fixed );
+ // Default value?
+ sal_uInt16 nDefaultId = static_cast<sal_uInt16>(pParam->nUserData & 0x0ffff);
+ if( nDefaultId > 0 )
+ {
+ OUString aDefaultStr = pImg->GetString( nDefaultId );
+ pVar = new SbxVariable(pParam-> eType);
+ pVar->PutString( aDefaultStr );
+ refParams->Put32( pVar, nIdx );
+ }
+ else if ( SbiRuntime::isVBAEnabled() && eType != SbxVARIANT )
+ {
+ // tdf#36737 - initialize the parameter with the default value of its type
+ pVar = new SbxVariable( pParam->eType );
+ refParams->Put32( pVar, nIdx );
+ }
+ bOpt = true;
+ }
+ }
+ }
+ if( !bOpt )
+ {
+ Error( ERRCODE_BASIC_NOT_OPTIONAL );
+ }
+ }
+ else if( eType != SbxVARIANT && static_cast<SbxDataType>(pVar->GetType() & 0x0FFF ) != eType )
+ {
+ SbxVariable* q = new SbxVariable( eType );
+ aRefSaved.emplace_back(q );
+ *q = *pVar;
+ pVar = q;
+ if ( nIdx )
+ {
+ refParams->Put32( pVar, nIdx );
+ }
+ }
+ SetupArgs( pVar, nOp1 );
+ PushVar( CheckArray( pVar ) );
+}
+
+// Case-Test (+True-Target+Test-Opcode)
+
+void SbiRuntime::StepCASEIS( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ if( !refCaseStk.is() || !refCaseStk->Count32() )
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_INTERNAL_ERROR );
+ }
+ else
+ {
+ SbxVariableRef xComp = PopVar();
+ SbxVariableRef xCase = refCaseStk->Get32( refCaseStk->Count32() - 1 );
+ if( xCase->Compare( static_cast<SbxOperator>(nOp2), *xComp ) )
+ {
+ StepJUMP( nOp1 );
+ }
+ }
+}
+
+// call of a DLL-procedure (+StringID+type)
+// the StringID's MSB shows that Argv is occupied
+
+void SbiRuntime::StepCALL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
+ SbxArray* pArgs = nullptr;
+ if( nOp1 & 0x8000 )
+ {
+ pArgs = refArgv.get();
+ }
+ DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), false );
+ aLibName.clear();
+ if( nOp1 & 0x8000 )
+ {
+ PopArgv();
+ }
+}
+
+// call of a DLL-procedure after CDecl (+StringID+type)
+
+void SbiRuntime::StepCALLC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName = pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) );
+ SbxArray* pArgs = nullptr;
+ if( nOp1 & 0x8000 )
+ {
+ pArgs = refArgv.get();
+ }
+ DllCall( aName, aLibName, pArgs, static_cast<SbxDataType>(nOp2), true );
+ aLibName.clear();
+ if( nOp1 & 0x8000 )
+ {
+ PopArgv();
+ }
+}
+
+
+// beginning of a statement (+Line+Col)
+
+void SbiRuntime::StepSTMNT( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ // If the Expr-Stack at the beginning of a statement contains a variable,
+ // some fool has called X as a function, although it's a variable!
+ bool bFatalExpr = false;
+ OUString sUnknownMethodName;
+ if( nExprLvl > 1 )
+ {
+ bFatalExpr = true;
+ }
+ else if( nExprLvl )
+ {
+ SbxVariable* p = refExprStk->Get32( 0 );
+ if( p->GetRefCount() > 1 &&
+ refLocals.is() && refLocals->Find( p->GetName(), p->GetClass() ) )
+ {
+ sUnknownMethodName = p->GetName();
+ bFatalExpr = true;
+ }
+ }
+
+ ClearExprStack();
+
+ aRefSaved.clear();
+
+ // We have to cancel hard here because line and column
+ // would be wrong later otherwise!
+ if( bFatalExpr)
+ {
+ StarBASIC::FatalError( ERRCODE_BASIC_NO_METHOD, sUnknownMethodName );
+ return;
+ }
+ pStmnt = pCode - 9;
+ sal_uInt16 nOld = nLine;
+ nLine = static_cast<short>( nOp1 );
+
+ // #29955 & 0xFF, to filter out for-loop-level
+ nCol1 = static_cast<short>( nOp2 & 0xFF );
+
+ // find the next STMNT-command to set the final column
+ // of this statement
+
+ nCol2 = 0xffff;
+ sal_uInt16 n1, n2;
+ const sal_uInt8* p = pMod->FindNextStmnt( pCode, n1, n2 );
+ if( p )
+ {
+ if( n1 == nOp1 )
+ {
+ // #29955 & 0xFF, to filter out for-loop-level
+ nCol2 = (n2 & 0xFF) - 1;
+ }
+ }
+
+ // #29955 correct for-loop-level, #67452 NOT in the error-handler
+ if( !bInError )
+ {
+ // (there's a difference here in case of a jump out of a loop)
+ sal_uInt16 nExspectedForLevel = static_cast<sal_uInt16>( nOp2 / 0x100 );
+ if( !pGosubStk.empty() )
+ {
+ nExspectedForLevel = nExspectedForLevel + pGosubStk.back().nStartForLvl;
+ }
+
+ // if the actual for-level is too small it'd jump out
+ // of a loop -> corrected
+ while( nForLvl > nExspectedForLevel )
+ {
+ PopFor();
+ }
+ }
+
+ // 16.10.96: #31460 new concept for StepInto/Over/Out
+ // see explanation at _ImplGetBreakCallLevel
+ if( pInst->nCallLvl <= pInst->nBreakCallLvl )
+ {
+ StarBASIC* pStepBasic = GetCurrentBasic( &rBasic );
+ BasicDebugFlags nNewFlags = pStepBasic->StepPoint( nLine, nCol1, nCol2 );
+
+ pInst->CalcBreakCallLevel( nNewFlags );
+ }
+
+ // break points only at STMNT-commands in a new line!
+ else if( ( nOp1 != nOld )
+ && ( nFlags & BasicDebugFlags::Break )
+ && pMod->IsBP( static_cast<sal_uInt16>( nOp1 ) ) )
+ {
+ StarBASIC* pBreakBasic = GetCurrentBasic( &rBasic );
+ BasicDebugFlags nNewFlags = pBreakBasic->BreakPoint( nLine, nCol1, nCol2 );
+
+ pInst->CalcBreakCallLevel( nNewFlags );
+ }
+}
+
+// (+StreamMode+Flags)
+// Stack: block length
+// channel number
+// file name
+
+void SbiRuntime::StepOPEN( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ SbxVariableRef pName = PopVar();
+ SbxVariableRef pChan = PopVar();
+ SbxVariableRef pLen = PopVar();
+ short nBlkLen = pLen->GetInteger();
+ short nChan = pChan->GetInteger();
+ OString aName(OUStringToOString(pName->GetOUString(), osl_getThreadTextEncoding()));
+ pIosys->Open( nChan, aName, static_cast<StreamMode>( nOp1 ),
+ static_cast<SbiStreamFlags>( nOp2 ), nBlkLen );
+ Error( pIosys->GetError() );
+}
+
+// create object (+StringID+StringID)
+
+void SbiRuntime::StepCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
+ SbxObject *pObj = SbxBase::CreateObject( aClass );
+ if( !pObj )
+ {
+ Error( ERRCODE_BASIC_INVALID_OBJECT );
+ }
+ else
+ {
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ pObj->SetName( aName );
+ // the object must be able to call the BASIC
+ pObj->SetParent( &rBasic );
+ SbxVariable* pNew = new SbxVariable;
+ pNew->PutObject( pObj );
+ PushVar( pNew );
+ }
+}
+
+void SbiRuntime::StepDCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ StepDCREATE_IMPL( nOp1, nOp2 );
+}
+
+void SbiRuntime::StepDCREATE_REDIMP( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ StepDCREATE_IMPL( nOp1, nOp2 );
+}
+
+// #56204 create object array (+StringID+StringID), DCREATE == Dim-Create
+void SbiRuntime::StepDCREATE_IMPL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ SbxVariableRef refVar = PopVar();
+
+ DimImpl( refVar );
+
+ // fill the array with instances of the requested class
+ SbxBase* pObj = refVar->GetObject();
+ if (!pObj)
+ {
+ StarBASIC::Error( ERRCODE_BASIC_INVALID_OBJECT );
+ return;
+ }
+
+ SbxDimArray* pArray = dynamic_cast<SbxDimArray*>(pObj);
+ if (!pArray)
+ return;
+
+ const sal_Int32 nDims = pArray->GetDims32();
+ sal_Int32 nTotalSize = nDims > 0 ? 1 : 0;
+
+ // must be a one-dimensional array
+ sal_Int32 nLower, nUpper;
+ for( sal_Int32 i = 0 ; i < nDims ; ++i )
+ {
+ pArray->GetDim32( i+1, nLower, nUpper );
+ const sal_Int32 nSize = nUpper - nLower + 1;
+ nTotalSize *= nSize;
+ }
+
+ // Optimization: pre-allocate underlying container
+ if (nTotalSize > 0)
+ pArray->SbxArray::GetRef32(nTotalSize - 1);
+
+ // First, fill those parts of the array that are preserved
+ bool bWasError = false;
+ const bool bRestored = implRestorePreservedArray(pArray, refRedimpArray, &bWasError);
+ if (bWasError)
+ nTotalSize = 0; // on error, don't create objects
+
+ // create objects and insert them into the array
+ OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
+ OUString aName;
+ for( sal_Int32 i = 0 ; i < nTotalSize ; ++i )
+ {
+ if (!bRestored || !pArray->SbxArray::GetRef32(i)) // For those left unset after preserve
+ {
+ SbxObject* pClassObj = SbxBase::CreateObject(aClass);
+ if (!pClassObj)
+ {
+ Error(ERRCODE_BASIC_INVALID_OBJECT);
+ break;
+ }
+ else
+ {
+ if (aName.isEmpty())
+ aName = pImg->GetString(static_cast<short>(nOp1));
+ pClassObj->SetName(aName);
+ // the object must be able to call the basic
+ pClassObj->SetParent(&rBasic);
+ pArray->SbxArray::Put32(pClassObj, i);
+ }
+ }
+ }
+}
+
+void SbiRuntime::StepTCREATE( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ OUString aClass( pImg->GetString( static_cast<short>( nOp2 ) ) );
+
+ SbxObject* pCopyObj = createUserTypeImpl( aClass );
+ if( pCopyObj )
+ {
+ pCopyObj->SetName( aName );
+ }
+ SbxVariable* pNew = new SbxVariable;
+ pNew->PutObject( pCopyObj );
+ pNew->SetDeclareClassName( aClass );
+ PushVar( pNew );
+}
+
+void SbiRuntime::implHandleSbxFlags( SbxVariable* pVar, SbxDataType t, sal_uInt32 nOp2 )
+{
+ bool bWithEvents = ((t & 0xff) == SbxOBJECT && (nOp2 & SBX_TYPE_WITH_EVENTS_FLAG) != 0);
+ if( bWithEvents )
+ {
+ pVar->SetFlag( SbxFlagBits::WithEvents );
+ }
+ bool bDimAsNew = ((nOp2 & SBX_TYPE_DIM_AS_NEW_FLAG) != 0);
+ if( bDimAsNew )
+ {
+ pVar->SetFlag( SbxFlagBits::DimAsNew );
+ }
+ bool bFixedString = ((t & 0xff) == SbxSTRING && (nOp2 & SBX_FIXED_LEN_STRING_FLAG) != 0);
+ if( bFixedString )
+ {
+ sal_uInt16 nCount = static_cast<sal_uInt16>( nOp2 >> 17 ); // len = all bits above 0x10000
+ OUStringBuffer aBuf;
+ comphelper::string::padToLength(aBuf, nCount);
+ pVar->PutString(aBuf.makeStringAndClear());
+ }
+
+ bool bVarToDim = ((nOp2 & SBX_TYPE_VAR_TO_DIM_FLAG) != 0);
+ if( bVarToDim )
+ {
+ pVar->SetFlag( SbxFlagBits::VarToDim );
+ }
+}
+
+// establishing a local variable (+StringID+type)
+
+void SbiRuntime::StepLOCAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ if( !refLocals.is() )
+ {
+ refLocals = new SbxArray;
+ }
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ if( refLocals->Find( aName, SbxClassType::DontCare ) == nullptr )
+ {
+ SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
+ SbxVariable* p = new SbxVariable( t );
+ p->SetName( aName );
+ implHandleSbxFlags( p, t, nOp2 );
+ refLocals->Put32( p, refLocals->Count32() );
+ }
+}
+
+// establishing a module-global variable (+StringID+type)
+
+void SbiRuntime::StepPUBLIC_Impl( sal_uInt32 nOp1, sal_uInt32 nOp2, bool bUsedForClassModule )
+{
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
+ bool bFlag = pMod->IsSet( SbxFlagBits::NoModify );
+ pMod->SetFlag( SbxFlagBits::NoModify );
+ SbxVariableRef p = pMod->Find( aName, SbxClassType::Property );
+ if( p.is() )
+ {
+ pMod->Remove (p.get());
+ }
+ SbProperty* pProp = pMod->GetProperty( aName, t );
+ if( !bUsedForClassModule )
+ {
+ pProp->SetFlag( SbxFlagBits::Private );
+ }
+ if( !bFlag )
+ {
+ pMod->ResetFlag( SbxFlagBits::NoModify );
+ }
+ if( pProp )
+ {
+ pProp->SetFlag( SbxFlagBits::DontStore );
+ // from 2.7.1996: HACK because of 'reference can't be saved'
+ pProp->SetFlag( SbxFlagBits::NoModify);
+
+ implHandleSbxFlags( pProp, t, nOp2 );
+ }
+}
+
+void SbiRuntime::StepPUBLIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ StepPUBLIC_Impl( nOp1, nOp2, false );
+}
+
+void SbiRuntime::StepPUBLIC_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ // Creates module variable that isn't reinitialised when
+ // between invocations ( for VBASupport & document basic only )
+ if( pMod->pImage->bFirstInit )
+ {
+ bool bUsedForClassModule = pImg->IsFlag( SbiImageFlags::CLASSMODULE );
+ StepPUBLIC_Impl( nOp1, nOp2, bUsedForClassModule );
+ }
+}
+
+// establishing a global variable (+StringID+type)
+
+void SbiRuntime::StepGLOBAL( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ if( pImg->IsFlag( SbiImageFlags::CLASSMODULE ) )
+ {
+ StepPUBLIC_Impl( nOp1, nOp2, true );
+ }
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
+
+ // Store module scope variables at module scope
+ // in non vba mode these are stored at the library level :/
+ // not sure if this really should not be enabled for ALL basic
+ SbxObject* pStorage = &rBasic;
+ if ( SbiRuntime::isVBAEnabled() )
+ {
+ pStorage = pMod;
+ pMod->AddVarName( aName );
+ }
+
+ bool bFlag = pStorage->IsSet( SbxFlagBits::NoModify );
+ rBasic.SetFlag( SbxFlagBits::NoModify );
+ SbxVariableRef p = pStorage->Find( aName, SbxClassType::Property );
+ if( p.is() )
+ {
+ pStorage->Remove (p.get());
+ }
+ p = pStorage->Make( aName, SbxClassType::Property, t );
+ if( !bFlag )
+ {
+ pStorage->ResetFlag( SbxFlagBits::NoModify );
+ }
+ if( p.is() )
+ {
+ p->SetFlag( SbxFlagBits::DontStore );
+ // from 2.7.1996: HACK because of 'reference can't be saved'
+ p->SetFlag( SbxFlagBits::NoModify);
+ }
+}
+
+
+// Creates global variable that isn't reinitialised when
+// basic is restarted, P=PERSIST (+StringID+Typ)
+
+void SbiRuntime::StepGLOBAL_P( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ if( pMod->pImage->bFirstInit )
+ {
+ StepGLOBAL( nOp1, nOp2 );
+ }
+}
+
+
+// Searches for global variable, behavior depends on the fact
+// if the variable is initialised for the first time
+
+void SbiRuntime::StepFIND_G( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ if( pMod->pImage->bFirstInit )
+ {
+ // Behave like always during first init
+ StepFIND( nOp1, nOp2 );
+ }
+ else
+ {
+ // Return dummy variable
+ SbxDataType t = static_cast<SbxDataType>(nOp2);
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 & 0x7FFF ) ) );
+
+ SbxVariable* pDummyVar = new SbxVariable( t );
+ pDummyVar->SetName( aName );
+ PushVar( pDummyVar );
+ }
+}
+
+
+SbxVariable* SbiRuntime::StepSTATIC_Impl(
+ OUString const & aName, SbxDataType t, sal_uInt32 nOp2 )
+{
+ SbxVariable* p = nullptr;
+ if ( pMeth )
+ {
+ SbxArray* pStatics = pMeth->GetStatics();
+ if( pStatics && ( pStatics->Find( aName, SbxClassType::DontCare ) == nullptr ) )
+ {
+ p = new SbxVariable( t );
+ if( t != SbxVARIANT )
+ {
+ p->SetFlag( SbxFlagBits::Fixed );
+ }
+ p->SetName( aName );
+ implHandleSbxFlags( p, t, nOp2 );
+ pStatics->Put32( p, pStatics->Count32() );
+ }
+ }
+ return p;
+}
+// establishing a static variable (+StringID+type)
+void SbiRuntime::StepSTATIC( sal_uInt32 nOp1, sal_uInt32 nOp2 )
+{
+ OUString aName( pImg->GetString( static_cast<short>( nOp1 ) ) );
+ SbxDataType t = static_cast<SbxDataType>(nOp2 & 0xffff);
+ StepSTATIC_Impl( aName, t, nOp2 );
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx
new file mode 100644
index 000000000..8a9513e81
--- /dev/null
+++ b/basic/source/runtime/stdobj.cxx
@@ -0,0 +1,898 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <runtime.hxx>
+#include <stdobj.hxx>
+#include <sbstdobj.hxx>
+#include <rtlproto.hxx>
+#include <sbintern.hxx>
+// The nArgs-field of a table entry is encrypted as follows:
+// At the moment it is assumed that properties don't need any
+// parameters!
+
+// previously ARGSMASK_ was 0x007F ( e.g. up to 127 args ) however 63 should be
+// enough, if not we need to increase the size of nArgs member in the Methods
+// struct below.
+// note: the limitation of 63 args is only for RTL functions defined here and
+// does NOT impose a limit on User defined procedures ). This changes is to
+// allow us space for a flag to blacklist some functions in vba mode
+
+#define ARGSMASK_ 0x003F // 63 Arguments
+#define COMPTMASK_ 0x00C0 // COMPATIBILITY mask
+#define COMPATONLY_ 0x0080 // procedure is visible in vba mode only
+#define NORMONLY_ 0x0040 // procedure is visible in normal mode only
+
+#define RWMASK_ 0x0F00 // mask for R/W-bits
+#define TYPEMASK_ 0xF000 // mask for the entry's type
+
+#define OPT_ 0x0400 // parameter is optional
+#define CONST_ 0x0800 // property is const
+#define METHOD_ 0x3000
+#define PROPERTY_ 0x4000
+#define OBJECT_ 0x8000
+ // combination of bits above:
+#define FUNCTION_ 0x1100
+#define LFUNCTION_ 0x1300 // mask for function which also works as Lvalue
+#define SUB_ 0x2100
+#define ROPROP_ 0x4100 // mask Read Only-Property
+#define RWPROP_ 0x4300 // mask Read/Write-Property
+#define CPROP_ 0x4900 // mask for constant
+
+namespace {
+
+struct Methods {
+ const char* pName;
+ SbxDataType eType;
+ short nArgs;
+ RtlCall pFunc;
+ sal_uInt16 nHash;
+};
+
+}
+
+static Methods aMethods[] = {
+
+{ "Abs", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Abs),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "Array", SbxOBJECT, FUNCTION_, RTLNAME(Array),0 },
+{ "Asc", SbxLONG, 1 | FUNCTION_, RTLNAME(Asc),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+{ "AscW", SbxLONG, 1 | FUNCTION_ | COMPATONLY_, RTLNAME(Asc),0},
+ { "string", SbxSTRING, 0,nullptr,0 },
+{ "Atn", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Atn),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "ATTR_ARCHIVE", SbxINTEGER, CPROP_, RTLNAME(ATTR_ARCHIVE),0 },
+{ "ATTR_DIRECTORY", SbxINTEGER, CPROP_, RTLNAME(ATTR_DIRECTORY),0 },
+{ "ATTR_HIDDEN", SbxINTEGER, CPROP_, RTLNAME(ATTR_HIDDEN),0 },
+{ "ATTR_NORMAL", SbxINTEGER, CPROP_, RTLNAME(ATTR_NORMAL),0 },
+{ "ATTR_READONLY", SbxINTEGER, CPROP_, RTLNAME(ATTR_READONLY),0 },
+{ "ATTR_SYSTEM", SbxINTEGER, CPROP_, RTLNAME(ATTR_SYSTEM),0 },
+{ "ATTR_VOLUME", SbxINTEGER, CPROP_, RTLNAME(ATTR_VOLUME),0 },
+
+{ "Beep", SbxNULL, FUNCTION_, RTLNAME(Beep),0 },
+{ "Blue", SbxINTEGER, 1 | FUNCTION_ | NORMONLY_, RTLNAME(Blue),0 },
+ { "RGB-Value", SbxLONG, 0,nullptr,0 },
+
+{ "CallByName", SbxVARIANT, 3 | FUNCTION_, RTLNAME(CallByName),0 },
+ { "Object", SbxOBJECT, 0,nullptr,0 },
+ { "ProcedureName",SbxSTRING, 0,nullptr,0 },
+ { "CallType", SbxINTEGER, 0,nullptr,0 },
+{ "CBool", SbxBOOL, 1 | FUNCTION_, RTLNAME(CBool),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CByte", SbxBYTE, 1 | FUNCTION_, RTLNAME(CByte),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CCur", SbxCURRENCY, 1 | FUNCTION_, RTLNAME(CCur),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CDate", SbxDATE, 1 | FUNCTION_, RTLNAME(CDate),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CDateFromUnoDate", SbxDATE, 1 | FUNCTION_, RTLNAME(CDateFromUnoDate),0 },
+ { "UnoDate", SbxOBJECT, 0,nullptr,0 },
+{ "CDateToUnoDate", SbxOBJECT, 1 | FUNCTION_, RTLNAME(CDateToUnoDate),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+{ "CDateFromUnoTime", SbxDATE, 1 | FUNCTION_, RTLNAME(CDateFromUnoTime),0 },
+ { "UnoTime", SbxOBJECT, 0,nullptr,0 },
+{ "CDateToUnoTime", SbxOBJECT, 1 | FUNCTION_, RTLNAME(CDateToUnoTime),0 },
+ { "Time", SbxDATE, 0,nullptr,0 },
+{ "CDateFromUnoDateTime", SbxDATE, 1 | FUNCTION_, RTLNAME(CDateFromUnoDateTime),0 },
+ { "UnoDateTime", SbxOBJECT, 0,nullptr,0 },
+{ "CDateToUnoDateTime", SbxOBJECT, 1 | FUNCTION_, RTLNAME(CDateToUnoDateTime),0 },
+ { "DateTime", SbxDATE, 0,nullptr,0 },
+{ "CDateFromIso", SbxDATE, 1 | FUNCTION_, RTLNAME(CDateFromIso),0 },
+ { "IsoDate", SbxSTRING, 0,nullptr,0 },
+{ "CDateToIso", SbxSTRING, 1 | FUNCTION_, RTLNAME(CDateToIso),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+{ "CDec", SbxDECIMAL, 1 | FUNCTION_, RTLNAME(CDec),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CDbl", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(CDbl),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CF_BITMAP", SbxINTEGER, CPROP_, RTLNAME(CF_BITMAP),0 },
+{ "CF_METAFILEPICT",SbxINTEGER, CPROP_, RTLNAME(CF_METAFILEPICT),0 },
+{ "CF_TEXT", SbxINTEGER, CPROP_, RTLNAME(CF_TEXT),0 },
+{ "ChDir", SbxNULL, 1 | FUNCTION_, RTLNAME(ChDir),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+{ "ChDrive", SbxNULL, 1 | FUNCTION_, RTLNAME(ChDrive),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+
+{ "Choose", SbxVARIANT, 2 | FUNCTION_, RTLNAME(Choose),0 },
+ { "Index", SbxINTEGER, 0,nullptr,0 },
+ { "Expression", SbxVARIANT, 0,nullptr,0 },
+
+{ "Chr", SbxSTRING, 1 | FUNCTION_, RTLNAME(Chr),0 },
+ { "string", SbxINTEGER, 0,nullptr,0 },
+{ "ChrW", SbxSTRING, 1 | FUNCTION_ | COMPATONLY_, RTLNAME(ChrW),0},
+ { "string", SbxINTEGER, 0,nullptr,0 },
+
+{ "CInt", SbxINTEGER, 1 | FUNCTION_, RTLNAME(CInt),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CLEAR_ALLTABS", SbxINTEGER, CPROP_, RTLNAME(CLEAR_ALLTABS),0 },
+{ "CLEAR_TAB", SbxINTEGER, CPROP_, RTLNAME(CLEAR_TAB),0 },
+{ "CLng", SbxLONG, 1 | FUNCTION_, RTLNAME(CLng),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CompatibilityMode", SbxBOOL, 1 | FUNCTION_, RTLNAME(CompatibilityMode),0},
+ { "bEnable", SbxBOOL, 0,nullptr,0 },
+{ "ConvertFromUrl", SbxSTRING, 1 | FUNCTION_, RTLNAME(ConvertFromUrl),0 },
+ { "Url", SbxSTRING, 0,nullptr,0 },
+{ "ConvertToUrl", SbxSTRING, 1 | FUNCTION_, RTLNAME(ConvertToUrl),0 },
+ { "SystemPath", SbxSTRING, 0,nullptr,0 },
+{ "Cos", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Cos),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "CreateObject", SbxOBJECT, 1 | FUNCTION_, RTLNAME( CreateObject ),0 },
+ { "class", SbxSTRING, 0,nullptr,0 },
+{ "CreateUnoListener",SbxOBJECT, 1 | FUNCTION_, RTLNAME( CreateUnoListener ),0 },
+ { "prefix", SbxSTRING, 0,nullptr,0 },
+ { "typename", SbxSTRING, 0,nullptr,0 },
+{ "CreateUnoDialog",SbxOBJECT, 2 | FUNCTION_, RTLNAME( CreateUnoDialog ),0 },
+ { "dialoglibrary",SbxOBJECT, 0,nullptr,0 },
+ { "dialogname", SbxSTRING, 0,nullptr,0 },
+{ "CreateUnoService",SbxOBJECT, 1 | FUNCTION_, RTLNAME( CreateUnoService ),0 },
+ { "servicename", SbxSTRING, 0,nullptr,0 },
+{ "CreateUnoServiceWithArguments",SbxOBJECT, 2 | FUNCTION_, RTLNAME( CreateUnoServiceWithArguments ),0 },
+ { "servicename", SbxSTRING, 0,nullptr,0 },
+ { "arguments", SbxARRAY, 0,nullptr,0 },
+{ "CreateUnoStruct",SbxOBJECT, 1 | FUNCTION_, RTLNAME( CreateUnoStruct ),0 },
+ { "classname", SbxSTRING, 0,nullptr,0 },
+{ "CreateUnoValue", SbxOBJECT, 2 | FUNCTION_, RTLNAME( CreateUnoValue ),0 },
+ { "type", SbxSTRING, 0,nullptr,0 },
+ { "value", SbxVARIANT, 0,nullptr,0 },
+{ "CreatePropertySet",SbxOBJECT, 1 | FUNCTION_, RTLNAME( CreatePropertySet ),0 },
+ { "values", SbxARRAY, 0,nullptr,0 },
+{ "CSng", SbxSINGLE, 1 | FUNCTION_, RTLNAME(CSng),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CStr", SbxSTRING, 1 | FUNCTION_, RTLNAME(CStr),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CurDir", SbxSTRING, 1 | FUNCTION_, RTLNAME(CurDir),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+{ "CVar", SbxVARIANT, 1 | FUNCTION_, RTLNAME(CVar),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "CVErr", SbxVARIANT, 1 | FUNCTION_, RTLNAME(CVErr),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+{ "DDB", SbxDOUBLE, 5 | FUNCTION_ | COMPATONLY_, RTLNAME(DDB),0 },
+ { "Cost", SbxDOUBLE, 0, nullptr,0 },
+ { "Salvage", SbxDOUBLE, 0, nullptr,0 },
+ { "Life", SbxDOUBLE, 0, nullptr,0 },
+ { "Period", SbxDOUBLE, 0, nullptr,0 },
+ { "Factor", SbxVARIANT, OPT_, nullptr,0 },
+{ "Date", SbxDATE, LFUNCTION_,RTLNAME(Date),0 },
+{ "DateAdd", SbxDATE, 3 | FUNCTION_, RTLNAME(DateAdd),0 },
+ { "Interval", SbxSTRING, 0,nullptr,0 },
+ { "Number", SbxLONG, 0,nullptr,0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+{ "DateDiff", SbxDOUBLE, 5 | FUNCTION_, RTLNAME(DateDiff),0 },
+ { "Interval", SbxSTRING, 0,nullptr,0 },
+ { "Date1", SbxDATE, 0,nullptr,0 },
+ { "Date2", SbxDATE, 0,nullptr,0 },
+ { "Firstdayofweek" , SbxINTEGER, OPT_,nullptr,0 },
+ { "Firstweekofyear", SbxINTEGER, OPT_,nullptr,0 },
+{ "DatePart", SbxLONG, 4 | FUNCTION_, RTLNAME(DatePart),0 },
+ { "Interval", SbxSTRING, 0,nullptr,0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+ { "Firstdayofweek" , SbxINTEGER, OPT_, nullptr,0 },
+ { "Firstweekofyear", SbxINTEGER, OPT_, nullptr,0 },
+{ "DateSerial", SbxDATE, 3 | FUNCTION_, RTLNAME(DateSerial),0 },
+ { "Year", SbxINTEGER, 0,nullptr,0 },
+ { "Month", SbxINTEGER, 0,nullptr,0 },
+ { "Day", SbxINTEGER, 0,nullptr,0 },
+{ "DateValue", SbxDATE, 1 | FUNCTION_, RTLNAME(DateValue),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+{ "Day", SbxINTEGER, 1 | FUNCTION_, RTLNAME(Day),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+{ "Ddeexecute", SbxNULL, 2 | FUNCTION_, RTLNAME(DDEExecute),0 },
+ { "Channel", SbxLONG, 0,nullptr,0 },
+ { "Command", SbxSTRING, 0,nullptr,0 },
+{ "Ddeinitiate", SbxINTEGER, 2 | FUNCTION_, RTLNAME(DDEInitiate),0 },
+ { "Application", SbxSTRING, 0,nullptr,0 },
+ { "Topic", SbxSTRING, 0,nullptr,0 },
+{ "Ddepoke", SbxNULL, 3 | FUNCTION_, RTLNAME(DDEPoke),0 },
+ { "Channel", SbxLONG, 0,nullptr,0 },
+ { "Item", SbxSTRING, 0,nullptr,0 },
+ { "Data", SbxSTRING, 0,nullptr,0 },
+{ "Dderequest", SbxSTRING, 2 | FUNCTION_, RTLNAME(DDERequest),0 },
+ { "Channel", SbxLONG, 0,nullptr,0 },
+ { "Item", SbxSTRING, 0,nullptr,0 },
+{ "Ddeterminate", SbxNULL, 1 | FUNCTION_, RTLNAME(DDETerminate),0 },
+ { "Channel", SbxLONG, 0,nullptr,0 },
+{ "Ddeterminateall", SbxNULL, FUNCTION_, RTLNAME(DDETerminateAll),0 },
+{ "DimArray", SbxOBJECT, FUNCTION_, RTLNAME(DimArray),0 },
+{ "Dir", SbxSTRING, 2 | FUNCTION_, RTLNAME(Dir),0 },
+ { "FileSpec", SbxSTRING, OPT_, nullptr,0 },
+ { "attrmask", SbxINTEGER, OPT_, nullptr,0 },
+{ "DoEvents", SbxINTEGER, FUNCTION_, RTLNAME(DoEvents),0 },
+{ "DumpAllObjects", SbxEMPTY, 2 | SUB_, RTLNAME(DumpAllObjects),0 },
+ { "FileSpec", SbxSTRING, 0,nullptr,0 },
+ { "DumpAll", SbxINTEGER, OPT_, nullptr,0 },
+
+{ "Empty", SbxVARIANT, CPROP_, RTLNAME(Empty),0 },
+{ "EqualUnoObjects",SbxBOOL, 2 | FUNCTION_, RTLNAME(EqualUnoObjects),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "EnableReschedule", SbxNULL, 1 | FUNCTION_, RTLNAME(EnableReschedule),0},
+ { "bEnable", SbxBOOL, 0,nullptr,0 },
+{ "Environ", SbxSTRING, 1 | FUNCTION_, RTLNAME(Environ),0 },
+ { "Environmentstring",SbxSTRING, 0,nullptr,0 },
+{ "EOF", SbxBOOL, 1 | FUNCTION_, RTLNAME(EOF),0 },
+ { "Channel", SbxINTEGER, 0,nullptr,0 },
+{ "Erl", SbxLONG, ROPROP_, RTLNAME( Erl ),0 },
+{ "Err", SbxVARIANT, RWPROP_, RTLNAME( Err ),0 },
+{ "Error", SbxSTRING, 1 | FUNCTION_, RTLNAME( Error ),0 },
+ { "code", SbxLONG, 0,nullptr,0 },
+{ "Exp", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Exp),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+
+{ "False", SbxBOOL, CPROP_, RTLNAME(False),0 },
+{ "FileAttr", SbxINTEGER, 2 | FUNCTION_, RTLNAME(FileAttr),0 },
+ { "Channel", SbxINTEGER, 0,nullptr,0 },
+ { "Attributes", SbxINTEGER, 0,nullptr,0 },
+{ "FileCopy", SbxNULL, 2 | FUNCTION_, RTLNAME(FileCopy),0 },
+ { "Source", SbxSTRING, 0,nullptr,0 },
+ { "Destination", SbxSTRING, 0,nullptr,0 },
+{ "FileDateTime", SbxSTRING, 1 | FUNCTION_, RTLNAME(FileDateTime),0 },
+ { "filename", SbxSTRING, 0,nullptr,0 },
+{ "FileExists", SbxBOOL, 1 | FUNCTION_, RTLNAME(FileExists),0 },
+ { "filename", SbxSTRING, 0,nullptr,0 },
+{ "FileLen", SbxLONG, 1 | FUNCTION_, RTLNAME(FileLen),0 },
+ { "filename", SbxSTRING, 0,nullptr,0 },
+{ "FindObject", SbxOBJECT, 1 | FUNCTION_, RTLNAME(FindObject),0 },
+ { "Name", SbxSTRING, 0,nullptr,0 },
+{ "FindPropertyObject", SbxOBJECT, 2 | FUNCTION_, RTLNAME(FindPropertyObject),0 },
+ { "Object", SbxOBJECT, 0,nullptr,0 },
+ { "Name", SbxSTRING, 0,nullptr,0 },
+{ "Fix", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Fix),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "Format", SbxSTRING, 2 | FUNCTION_, RTLNAME(Format),0 },
+ { "expression", SbxVARIANT, 0,nullptr,0 },
+ { "format", SbxSTRING, OPT_, nullptr,0 },
+{ "FormatDateTime", SbxSTRING, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(FormatDateTime),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+ { "NamedFormat", SbxINTEGER, OPT_, nullptr,0 },
+{ "FormatNumber", SbxSTRING, 5 | FUNCTION_ | COMPATONLY_, RTLNAME(FormatNumber), 0 },
+ { "expression", SbxDOUBLE, 0, nullptr, 0 },
+ { "numDigitsAfterDecimal", SbxINTEGER, OPT_, nullptr, 0 },
+ { "includeLeadingDigit", SbxINTEGER, OPT_, nullptr, 0 }, // vbTriState
+ { "useParensForNegativeNumbers", SbxINTEGER, OPT_, nullptr, 0 }, // vbTriState
+ { "groupDigits", SbxINTEGER, OPT_, nullptr, 0 }, // vbTriState
+{ "Frac", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Frac),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "FRAMEANCHORCHAR", SbxINTEGER, CPROP_, RTLNAME(FRAMEANCHORCHAR),0 },
+{ "FRAMEANCHORPAGE", SbxINTEGER, CPROP_, RTLNAME(FRAMEANCHORPAGE),0 },
+{ "FRAMEANCHORPARA", SbxINTEGER, CPROP_, RTLNAME(FRAMEANCHORPARA),0 },
+{ "FreeFile", SbxINTEGER, FUNCTION_, RTLNAME(FreeFile),0 },
+{ "FreeLibrary", SbxNULL, 1 | FUNCTION_, RTLNAME(FreeLibrary),0 },
+ { "Modulename", SbxSTRING, 0,nullptr,0 },
+
+{ "FV", SbxDOUBLE, 5 | FUNCTION_ | COMPATONLY_, RTLNAME(FV),0 },
+ { "Rate", SbxDOUBLE, 0, nullptr,0 },
+ { "NPer", SbxDOUBLE, 0, nullptr,0 },
+ { "Pmt", SbxDOUBLE, 0, nullptr,0 },
+ { "PV", SbxVARIANT, OPT_, nullptr,0 },
+ { "Due", SbxVARIANT, OPT_, nullptr,0 },
+{ "Get", SbxNULL, 3 | FUNCTION_, RTLNAME(Get),0 },
+ { "filenumber", SbxINTEGER, 0,nullptr,0 },
+ { "recordnumber", SbxLONG, 0,nullptr,0 },
+ { "variablename", SbxVARIANT, 0,nullptr,0 },
+{ "GetAttr", SbxINTEGER, 1 | FUNCTION_, RTLNAME(GetAttr),0 },
+ { "filename", SbxSTRING, 0,nullptr,0 },
+{ "GetDefaultContext", SbxOBJECT, 0 | FUNCTION_, RTLNAME(GetDefaultContext),0 },
+{ "GetDialogZoomFactorX", SbxDOUBLE, FUNCTION_,RTLNAME(GetDialogZoomFactorX),0 },
+{ "GetDialogZoomFactorY", SbxDOUBLE, FUNCTION_,RTLNAME(GetDialogZoomFactorY),0 },
+{ "GetGUIType", SbxINTEGER, FUNCTION_,RTLNAME(GetGUIType),0 },
+{ "GetGUIVersion", SbxLONG, FUNCTION_,RTLNAME(GetGUIVersion),0 },
+{ "GetPathSeparator", SbxSTRING, FUNCTION_,RTLNAME(GetPathSeparator),0 },
+{ "GetProcessServiceManager", SbxOBJECT, 0 | FUNCTION_, RTLNAME(GetProcessServiceManager),0 },
+{ "GetSolarVersion", SbxLONG, FUNCTION_,RTLNAME(GetSolarVersion),0 },
+{ "GetSystemTicks", SbxLONG, FUNCTION_,RTLNAME(GetSystemTicks),0 },
+{ "GetSystemType", SbxINTEGER, FUNCTION_,RTLNAME(GetSystemType),0 },
+{ "GlobalScope", SbxOBJECT, FUNCTION_,RTLNAME(GlobalScope),0 },
+{ "Green", SbxINTEGER, 1 | FUNCTION_ | NORMONLY_, RTLNAME(Green),0 },
+ { "RGB-Value", SbxLONG, 0,nullptr,0 },
+
+{ "HasUnoInterfaces", SbxBOOL, 1 | FUNCTION_, RTLNAME(HasUnoInterfaces),0},
+ { "InterfaceName",SbxSTRING, 0,nullptr,0 },
+{ "Hex", SbxSTRING, 1 | FUNCTION_, RTLNAME(Hex),0 },
+ { "number", SbxLONG, 0,nullptr,0 },
+{ "Hour", SbxINTEGER, 1 | FUNCTION_, RTLNAME(Hour),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+
+{ "IDABORT", SbxINTEGER, CPROP_, RTLNAME(IDABORT),0 },
+{ "IDCANCEL", SbxINTEGER, CPROP_, RTLNAME(IDCANCEL),0 },
+{ "IDNO", SbxINTEGER, CPROP_, RTLNAME(IDNO),0 },
+{ "IDOK", SbxINTEGER, CPROP_, RTLNAME(IDOK),0 },
+{ "IDRETRY", SbxINTEGER, CPROP_, RTLNAME(IDRETRY),0 },
+{ "IDYES", SbxINTEGER, CPROP_, RTLNAME(IDYES),0 },
+
+{ "Iif", SbxVARIANT, 3 | FUNCTION_, RTLNAME(Iif),0 },
+ { "Bool", SbxBOOL, 0,nullptr,0 },
+ { "Variant1", SbxVARIANT, 0,nullptr,0 },
+ { "Variant2", SbxVARIANT, 0,nullptr,0 },
+
+{ "Input", SbxSTRING, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(Input),0},
+ { "Number", SbxLONG, 0,nullptr,0 },
+ { "FileNumber", SbxLONG, 0,nullptr,0 },
+{ "InputBox", SbxSTRING, 5 | FUNCTION_, RTLNAME(InputBox),0 },
+ { "Prompt", SbxSTRING, 0,nullptr,0 },
+ { "Title", SbxSTRING, OPT_, nullptr,0 },
+ { "Default", SbxSTRING, OPT_, nullptr,0 },
+ { "XPosTwips", SbxLONG, OPT_, nullptr,0 },
+ { "YPosTwips", SbxLONG, OPT_, nullptr,0 },
+{ "InStr", SbxLONG, 4 | FUNCTION_, RTLNAME(InStr),0 },
+ { "Start", SbxSTRING, OPT_, nullptr,0 },
+ { "String1", SbxSTRING, 0,nullptr,0 },
+ { "String2", SbxSTRING, 0,nullptr,0 },
+ { "Compare", SbxINTEGER, OPT_, nullptr,0 },
+{ "InStrRev", SbxLONG, 4 | FUNCTION_ | COMPATONLY_, RTLNAME(InStrRev),0},
+ { "String1", SbxSTRING, 0,nullptr,0 },
+ { "String2", SbxSTRING, 0,nullptr,0 },
+ { "Start", SbxSTRING, OPT_, nullptr,0 },
+ { "Compare", SbxINTEGER, OPT_, nullptr,0 },
+{ "Int", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Int),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "IPmt", SbxDOUBLE, 6 | FUNCTION_ | COMPATONLY_, RTLNAME(IPmt),0 },
+ { "Rate", SbxDOUBLE, 0, nullptr,0 },
+ { "Per", SbxDOUBLE, 0, nullptr,0 },
+ { "NPer", SbxDOUBLE, 0, nullptr,0 },
+ { "PV", SbxDOUBLE, 0, nullptr,0 },
+ { "FV", SbxVARIANT, OPT_, nullptr,0 },
+ { "Due", SbxVARIANT, OPT_, nullptr,0 },
+{ "IRR", SbxDOUBLE, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(IRR),0 },
+ { "ValueArray", SbxARRAY, 0, nullptr,0 },
+ { "Guess", SbxVARIANT, OPT_, nullptr,0 },
+{ "IsArray", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsArray),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsDate", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsDate),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsEmpty", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsEmpty),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsError", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsError),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsMissing", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsMissing),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsNull", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsNull),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsNumeric", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsNumeric),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsObject", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsObject),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "IsUnoStruct", SbxBOOL, 1 | FUNCTION_, RTLNAME(IsUnoStruct),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "Join", SbxSTRING, 2 | FUNCTION_, RTLNAME(Join),0 },
+ { "list", SbxOBJECT, 0,nullptr,0 },
+ { "delimiter", SbxSTRING, 0,nullptr,0 },
+{ "Kill", SbxNULL, 1 | FUNCTION_, RTLNAME(Kill),0 },
+ { "filespec", SbxSTRING, 0,nullptr,0 },
+{ "LBound", SbxLONG, 1 | FUNCTION_, RTLNAME(LBound),0 },
+ { "Variant", SbxVARIANT, 0,nullptr,0 },
+{ "LCase", SbxSTRING, 1 | FUNCTION_, RTLNAME(LCase),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+{ "Left", SbxSTRING, 2 | FUNCTION_, RTLNAME(Left),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+ { "Count", SbxLONG, 0,nullptr,0 },
+{ "Len", SbxLONG, 1 | FUNCTION_, RTLNAME(Len),0 },
+ { "StringOrVariant", SbxVARIANT, 0,nullptr,0 },
+{ "LenB", SbxLONG, 1 | FUNCTION_, RTLNAME(Len),0 },
+ { "StringOrVariant", SbxVARIANT, 0,nullptr,0 },
+{ "Load", SbxNULL, 1 | FUNCTION_, RTLNAME(Load),0 },
+ { "object", SbxOBJECT, 0,nullptr,0 },
+{ "LoadPicture", SbxOBJECT, 1 | FUNCTION_, RTLNAME(LoadPicture),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+{ "Loc", SbxLONG, 1 | FUNCTION_, RTLNAME(Loc),0 },
+ { "Channel", SbxINTEGER, 0,nullptr,0 },
+{ "Lof", SbxLONG, 1 | FUNCTION_, RTLNAME(Lof),0 },
+ { "Channel", SbxINTEGER, 0,nullptr,0 },
+{ "Log", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Log),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "LTrim", SbxSTRING, 1 | FUNCTION_, RTLNAME(LTrim),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+
+{ "MB_ABORTRETRYIGNORE", SbxINTEGER, CPROP_, RTLNAME(MB_ABORTRETRYIGNORE),0},
+{ "MB_APPLMODAL", SbxINTEGER, CPROP_, RTLNAME(MB_APPLMODAL),0 },
+{ "MB_DEFBUTTON1", SbxINTEGER, CPROP_, RTLNAME(MB_DEFBUTTON1),0 },
+{ "MB_DEFBUTTON2", SbxINTEGER, CPROP_, RTLNAME(MB_DEFBUTTON2),0 },
+{ "MB_DEFBUTTON3", SbxINTEGER, CPROP_, RTLNAME(MB_DEFBUTTON3),0 },
+{ "MB_ICONEXCLAMATION", SbxINTEGER, CPROP_, RTLNAME(MB_ICONEXCLAMATION),0},
+{ "MB_ICONINFORMATION", SbxINTEGER, CPROP_, RTLNAME(MB_ICONINFORMATION),0},
+{ "MB_ICONQUESTION",SbxINTEGER, CPROP_, RTLNAME(MB_ICONQUESTION),0 },
+{ "MB_ICONSTOP", SbxINTEGER, CPROP_, RTLNAME(MB_ICONSTOP),0 },
+{ "MB_OK", SbxINTEGER, CPROP_, RTLNAME(MB_OK),0 },
+{ "MB_OKCANCEL", SbxINTEGER, CPROP_, RTLNAME(MB_OKCANCEL),0 },
+{ "MB_RETRYCANCEL", SbxINTEGER, CPROP_, RTLNAME(MB_RETRYCANCEL),0 },
+{ "MB_SYSTEMMODAL", SbxINTEGER, CPROP_, RTLNAME(MB_SYSTEMMODAL),0 },
+{ "MB_YESNO", SbxINTEGER, CPROP_, RTLNAME(MB_YESNO),0 },
+{ "MB_YESNOCANCEL", SbxINTEGER, CPROP_, RTLNAME(MB_YESNOCANCEL),0 },
+
+{ "Me", SbxOBJECT, 0 | FUNCTION_ | COMPATONLY_, RTLNAME(Me),0 },
+{ "Mid", SbxSTRING, 3 | LFUNCTION_,RTLNAME(Mid),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+ { "StartPos", SbxLONG, 0,nullptr,0 },
+ { "Length", SbxLONG, OPT_, nullptr,0 },
+{ "Minute", SbxINTEGER, 1 | FUNCTION_, RTLNAME(Minute),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+{ "MIRR", SbxDOUBLE, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(MIRR),0 },
+ { "ValueArray", SbxARRAY, 0, nullptr,0 },
+ { "FinanceRate", SbxDOUBLE, 0, nullptr,0 },
+ { "ReinvestRate", SbxDOUBLE, 0, nullptr,0 },
+{ "MkDir", SbxNULL, 1 | FUNCTION_, RTLNAME(MkDir),0 },
+ { "pathname", SbxSTRING, 0,nullptr,0 },
+{ "Month", SbxINTEGER, 1 | FUNCTION_, RTLNAME(Month),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+{ "MonthName", SbxSTRING, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(MonthName),0 },
+ { "Month", SbxINTEGER, 0,nullptr,0 },
+ { "Abbreviate", SbxBOOL, OPT_, nullptr,0 },
+{ "MsgBox", SbxINTEGER, 5 | FUNCTION_, RTLNAME(MsgBox),0 },
+ { "Prompt", SbxSTRING, 0,nullptr,0 },
+ { "Buttons", SbxINTEGER, OPT_, nullptr,0 },
+ { "Title", SbxSTRING, OPT_, nullptr,0 },
+ { "Helpfile", SbxSTRING, OPT_, nullptr,0 },
+ { "Context", SbxINTEGER, OPT_, nullptr,0 },
+
+{ "Nothing", SbxOBJECT, CPROP_, RTLNAME(Nothing),0 },
+{ "Now", SbxDATE, FUNCTION_, RTLNAME(Now),0 },
+{ "NPer", SbxDOUBLE, 5 | FUNCTION_ | COMPATONLY_, RTLNAME(NPer),0 },
+ { "Rate", SbxDOUBLE, 0, nullptr,0 },
+ { "Pmt", SbxDOUBLE, 0, nullptr,0 },
+ { "PV", SbxDOUBLE, 0, nullptr,0 },
+ { "FV", SbxVARIANT, OPT_, nullptr,0 },
+ { "Due", SbxVARIANT, OPT_, nullptr,0 },
+{ "NPV", SbxDOUBLE, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(NPV),0 },
+ { "Rate", SbxDOUBLE, 0, nullptr,0 },
+ { "ValueArray", SbxARRAY, 0, nullptr,0 },
+{ "Null", SbxNULL, CPROP_, RTLNAME(Null),0 },
+
+{ "Oct", SbxSTRING, 1 | FUNCTION_, RTLNAME(Oct),0 },
+ { "number", SbxLONG, 0,nullptr,0 },
+
+{ "Partition", SbxSTRING, 4 | FUNCTION_, RTLNAME(Partition),0 },
+ { "number", SbxLONG, 0,nullptr,0 },
+ { "start", SbxLONG, 0,nullptr,0 },
+ { "stop", SbxLONG, 0,nullptr,0 },
+ { "interval", SbxLONG, 0,nullptr,0 },
+{ "Pi", SbxDOUBLE, CPROP_, RTLNAME(PI),0 },
+
+{ "Pmt", SbxDOUBLE, 5 | FUNCTION_ | COMPATONLY_, RTLNAME(Pmt),0 },
+ { "Rate", SbxDOUBLE, 0, nullptr,0 },
+ { "NPer", SbxDOUBLE, 0, nullptr,0 },
+ { "PV", SbxDOUBLE, 0, nullptr,0 },
+ { "FV", SbxVARIANT, OPT_, nullptr,0 },
+ { "Due", SbxVARIANT, OPT_, nullptr,0 },
+
+{ "PPmt", SbxDOUBLE, 6 | FUNCTION_ | COMPATONLY_, RTLNAME(PPmt),0 },
+ { "Rate", SbxDOUBLE, 0, nullptr,0 },
+ { "Per", SbxDOUBLE, 0, nullptr,0 },
+ { "NPer", SbxDOUBLE, 0, nullptr,0 },
+ { "PV", SbxDOUBLE, 0, nullptr,0 },
+ { "FV", SbxVARIANT, OPT_, nullptr,0 },
+ { "Due", SbxVARIANT, OPT_, nullptr,0 },
+
+{ "Put", SbxNULL, 3 | FUNCTION_, RTLNAME(Put),0 },
+ { "filenumber", SbxINTEGER, 0,nullptr,0 },
+ { "recordnumber", SbxLONG, 0,nullptr,0 },
+ { "variablename", SbxVARIANT, 0,nullptr,0 },
+
+{ "PV", SbxDOUBLE, 5 | FUNCTION_ | COMPATONLY_, RTLNAME(PV),0 },
+ { "Rate", SbxDOUBLE, 0, nullptr,0 },
+ { "NPer", SbxDOUBLE, 0, nullptr,0 },
+ { "Pmt", SbxDOUBLE, 0, nullptr,0 },
+ { "FV", SbxVARIANT, OPT_, nullptr,0 },
+ { "Due", SbxVARIANT, OPT_, nullptr,0 },
+
+{ "QBColor", SbxLONG, 1 | FUNCTION_, RTLNAME(QBColor),0 },
+ { "number", SbxINTEGER, 0,nullptr,0 },
+
+{ "Randomize", SbxNULL, 1 | FUNCTION_, RTLNAME(Randomize),0 },
+ { "Number", SbxDOUBLE, OPT_, nullptr,0 },
+{ "Rate", SbxDOUBLE, 6 | FUNCTION_ | COMPATONLY_, RTLNAME(Rate),0 },
+ { "NPer", SbxDOUBLE, 0, nullptr,0 },
+ { "Pmt", SbxDOUBLE, 0, nullptr,0 },
+ { "PV", SbxDOUBLE, 0, nullptr,0 },
+ { "FV", SbxVARIANT, OPT_, nullptr,0 },
+ { "Due", SbxVARIANT, OPT_, nullptr,0 },
+ { "Guess", SbxVARIANT, OPT_, nullptr,0 },
+{ "Red", SbxINTEGER, 1 | FUNCTION_ | NORMONLY_, RTLNAME(Red),0 },
+ { "RGB-Value", SbxLONG, 0,nullptr,0 },
+{ "Reset", SbxNULL, 0 | FUNCTION_, RTLNAME(Reset),0 },
+{ "ResolvePath", SbxSTRING, 1 | FUNCTION_, RTLNAME(ResolvePath),0 },
+ { "Path", SbxSTRING, 0,nullptr,0 },
+{ "RGB", SbxLONG, 3 | FUNCTION_, RTLNAME(RGB),0 },
+ { "Red", SbxINTEGER, 0,nullptr,0 },
+ { "Green", SbxINTEGER, 0,nullptr,0 },
+ { "Blue", SbxINTEGER, 0,nullptr,0 },
+{ "Replace", SbxSTRING, 6 | FUNCTION_, RTLNAME(Replace),0 },
+ { "Expression", SbxSTRING, 0,nullptr,0 },
+ { "Find", SbxSTRING, 0,nullptr,0 },
+ { "Replace", SbxSTRING, 0,nullptr,0 },
+ { "Start", SbxINTEGER, OPT_, nullptr,0 },
+ { "Count", SbxINTEGER, OPT_, nullptr,0 },
+ { "Compare", SbxINTEGER, OPT_, nullptr,0 },
+{ "Right", SbxSTRING, 2 | FUNCTION_, RTLNAME(Right),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+ { "Count", SbxLONG, 0,nullptr,0 },
+{ "RmDir", SbxNULL, 1 | FUNCTION_, RTLNAME(RmDir),0 },
+ { "pathname", SbxSTRING, 0,nullptr,0 },
+{ "Round", SbxDOUBLE, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(Round),0},
+ { "Expression", SbxDOUBLE, 0,nullptr,0 },
+ { "Numdecimalplaces", SbxINTEGER, OPT_, nullptr,0 },
+{ "Rnd", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Rnd),0 },
+ { "Number", SbxDOUBLE, OPT_, nullptr,0 },
+{ "RTL", SbxOBJECT, 0 | FUNCTION_ | COMPATONLY_, RTLNAME(RTL),0},
+{ "RTrim", SbxSTRING, 1 | FUNCTION_, RTLNAME(RTrim),0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+
+{ "SavePicture", SbxNULL, 2 | FUNCTION_, RTLNAME(SavePicture),0 },
+ { "object", SbxOBJECT, 0,nullptr,0 },
+ { "string", SbxSTRING, 0,nullptr,0 },
+{ "Second", SbxINTEGER, 1 | FUNCTION_, RTLNAME(Second),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+{ "Seek", SbxLONG, 1 | FUNCTION_, RTLNAME(Seek),0 },
+ { "Channel", SbxINTEGER, 0,nullptr,0 },
+{ "SendKeys", SbxNULL, 2 | FUNCTION_, RTLNAME(SendKeys),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+ { "Wait", SbxBOOL, OPT_, nullptr,0 },
+{ "SetAttr", SbxNULL, 2 | FUNCTION_, RTLNAME(SetAttr),0 },
+ { "File" , SbxSTRING, 0,nullptr,0 },
+ { "Attributes", SbxINTEGER, 0,nullptr,0 },
+{ "SET_OFF", SbxINTEGER, CPROP_, RTLNAME(SET_OFF),0 },
+{ "SET_ON", SbxINTEGER, CPROP_, RTLNAME(SET_ON),0 },
+{ "SET_TAB", SbxINTEGER, CPROP_, RTLNAME(SET_TAB),0 },
+{ "Sgn", SbxINTEGER, 1 | FUNCTION_, RTLNAME(Sgn),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "Shell", SbxLONG, 2 | FUNCTION_, RTLNAME(Shell),0 },
+ { "Commandstring",SbxSTRING, 0,nullptr,0 },
+ { "WindowStyle", SbxINTEGER, OPT_, nullptr,0 },
+{ "Sin", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Sin),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "SLN", SbxDOUBLE, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(SLN),0 },
+ { "Cost", SbxDOUBLE, 0,nullptr,0 },
+ { "Double", SbxDOUBLE, 0,nullptr,0 },
+ { "Life", SbxDOUBLE, 0,nullptr,0 },
+{ "SYD", SbxDOUBLE, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(SYD),0 },
+ { "Cost", SbxDOUBLE, 0,nullptr,0 },
+ { "Salvage", SbxDOUBLE, 0,nullptr,0 },
+ { "Life", SbxDOUBLE, 0,nullptr,0 },
+ { "Period", SbxDOUBLE, 0,nullptr,0 },
+{ "Space", SbxSTRING, 1 | FUNCTION_, RTLNAME(Space),0 },
+ { "string", SbxLONG, 0,nullptr,0 },
+{ "Spc", SbxSTRING, 1 | FUNCTION_, RTLNAME(Spc),0 },
+ { "Count", SbxLONG, 0,nullptr,0 },
+{ "Split", SbxOBJECT, 3 | FUNCTION_, RTLNAME(Split),0 },
+ { "expression", SbxSTRING, 0,nullptr,0 },
+ { "delimiter", SbxSTRING, 0,nullptr,0 },
+ { "count", SbxLONG, 0,nullptr,0 },
+{ "Sqr", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Sqr),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "Str", SbxSTRING, 1 | FUNCTION_, RTLNAME(Str),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "StrComp", SbxINTEGER, 3 | FUNCTION_, RTLNAME(StrComp),0 },
+ { "String1", SbxSTRING, 0,nullptr,0 },
+ { "String2", SbxSTRING, 0,nullptr,0 },
+ { "Compare", SbxINTEGER, OPT_, nullptr,0 },
+{ "StrConv", SbxOBJECT, 3 | FUNCTION_, RTLNAME(StrConv),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+ { "Conversion", SbxSTRING, 0,nullptr,0 },
+ { "LCID", SbxINTEGER, OPT_,nullptr,0 },
+{ "String", SbxSTRING, 2 | FUNCTION_, RTLNAME(String),0 },
+ { "Count", SbxLONG, 0,nullptr,0 },
+ { "Filler", SbxVARIANT, 0,nullptr,0 },
+{ "StrReverse", SbxSTRING, 1 | FUNCTION_ | COMPATONLY_, RTLNAME(StrReverse),0 },
+ { "String1", SbxSTRING, 0,nullptr,0 },
+{ "Switch", SbxVARIANT, 2 | FUNCTION_, RTLNAME(Switch),0 },
+ { "Expression", SbxVARIANT, 0,nullptr,0 },
+ { "Value", SbxVARIANT, 0,nullptr,0 },
+{ "Tab", SbxSTRING, 1 | FUNCTION_, RTLNAME(Tab),0 },
+ { "Count", SbxLONG, 0,nullptr,0 },
+{ "Tan", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Tan),0 },
+ { "number", SbxDOUBLE, 0,nullptr,0 },
+{ "Time", SbxVARIANT, LFUNCTION_,RTLNAME(Time),0 },
+{ "Timer", SbxDATE, FUNCTION_, RTLNAME(Timer),0 },
+{ "TimeSerial", SbxDATE, 3 | FUNCTION_, RTLNAME(TimeSerial),0 },
+ { "Hour", SbxLONG, 0,nullptr,0 },
+ { "Minute", SbxLONG, 0,nullptr,0 },
+ { "Second", SbxLONG, 0,nullptr,0 },
+{ "TimeValue", SbxDATE, 1 | FUNCTION_, RTLNAME(TimeValue),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+{ "TOGGLE", SbxINTEGER, CPROP_, RTLNAME(TOGGLE),0 },
+{ "Trim", SbxSTRING, 1 | FUNCTION_, RTLNAME(Trim),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+{ "True", SbxBOOL, CPROP_, RTLNAME(True),0 },
+{ "TwipsPerPixelX", SbxLONG, FUNCTION_, RTLNAME(TwipsPerPixelX),0 },
+{ "TwipsPerPixelY", SbxLONG, FUNCTION_, RTLNAME(TwipsPerPixelY),0 },
+
+{ "TYP_AUTHORFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_AUTHORFLD),0 },
+{ "TYP_CHAPTERFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_CHAPTERFLD),0 },
+{ "TYP_CONDTXTFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_CONDTXTFLD),0 },
+{ "TYP_DATEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DATEFLD),0 },
+{ "TYP_DBFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DBFLD),0 },
+{ "TYP_DBNAMEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DBNAMEFLD),0 },
+{ "TYP_DBNEXTSETFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DBNEXTSETFLD),0 },
+{ "TYP_DBNUMSETFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DBNUMSETFLD),0 },
+{ "TYP_DBSETNUMBERFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DBSETNUMBERFLD),0 },
+{ "TYP_DDEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DDEFLD),0 },
+{ "TYP_DOCINFOFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DOCINFOFLD),0 },
+{ "TYP_DOCSTATFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_DOCSTATFLD),0 },
+{ "TYP_EXTUSERFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_EXTUSERFLD),0 },
+{ "TYP_FILENAMEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_FILENAMEFLD),0 },
+{ "TYP_FIXDATEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_FIXDATEFLD),0 },
+{ "TYP_FIXTIMEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_FIXTIMEFLD),0 },
+{ "TYP_FORMELFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_FORMELFLD),0 },
+{ "TYP_GETFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_GETFLD),0 },
+{ "TYP_GETREFFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_GETREFFLD),0 },
+{ "TYP_GETREFPAGEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_GETREFPAGEFLD),0 },
+{ "TYP_HIDDENPARAFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_HIDDENPARAFLD),0 },
+{ "TYP_HIDDENTXTFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_HIDDENTXTFLD),0 },
+{ "TYP_INPUTFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_INPUTFLD),0 },
+{ "TYP_INTERNETFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_INTERNETFLD),0 },
+{ "TYP_JUMPEDITFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_JUMPEDITFLD),0 },
+{ "TYP_MACROFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_MACROFLD),0 },
+{ "TYP_NEXTPAGEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_NEXTPAGEFLD),0 },
+{ "TYP_PAGENUMBERFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_PAGENUMBERFLD),0 },
+{ "TYP_POSTITFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_POSTITFLD),0 },
+{ "TYP_PREVPAGEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_PREVPAGEFLD),0 },
+{ "TYP_SEQFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_SEQFLD),0 },
+{ "TYP_SETFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_SETFLD),0 },
+{ "TYP_SETINPFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_SETINPFLD),0 },
+{ "TYP_SETREFFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_SETREFFLD),0 },
+{ "TYP_SETREFPAGEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_SETREFPAGEFLD),0 },
+{ "TYP_TEMPLNAMEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_TEMPLNAMEFLD),0},
+{ "TYP_TIMEFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_TIMEFLD),0 },
+{ "TYP_USERFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_USERFLD),0 },
+{ "TYP_USRINPFLD", SbxINTEGER, CPROP_, RTLNAME(TYP_USRINPFLD),0 },
+
+{ "TypeLen", SbxINTEGER, 1 | FUNCTION_, RTLNAME(TypeLen),0 },
+ { "Var", SbxVARIANT, 0,nullptr,0 },
+{ "TypeName", SbxSTRING, 1 | FUNCTION_, RTLNAME(TypeName),0 },
+ { "Var", SbxVARIANT, 0,nullptr,0 },
+
+{ "UBound", SbxLONG, 1 | FUNCTION_, RTLNAME(UBound),0 },
+ { "Var", SbxVARIANT, 0,nullptr,0 },
+{ "UCase", SbxSTRING, 1 | FUNCTION_, RTLNAME(UCase),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+{ "Unload", SbxNULL, 1 | FUNCTION_, RTLNAME(Unload),0 },
+ { "Dialog", SbxOBJECT, 0,nullptr,0 },
+
+{ "Val", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Val),0 },
+ { "String", SbxSTRING, 0,nullptr,0 },
+{ "VarType", SbxINTEGER, 1 | FUNCTION_, RTLNAME(VarType),0 },
+ { "Var", SbxVARIANT, 0,nullptr,0 },
+{ "V_EMPTY", SbxINTEGER, CPROP_, RTLNAME(V_EMPTY),0 },
+{ "V_NULL", SbxINTEGER, CPROP_, RTLNAME(V_NULL),0 },
+{ "V_INTEGER", SbxINTEGER, CPROP_, RTLNAME(V_INTEGER),0 },
+{ "V_LONG", SbxINTEGER, CPROP_, RTLNAME(V_LONG),0 },
+{ "V_SINGLE", SbxINTEGER, CPROP_, RTLNAME(V_SINGLE),0 },
+{ "V_DOUBLE", SbxINTEGER, CPROP_, RTLNAME(V_DOUBLE),0 },
+{ "V_CURRENCY", SbxINTEGER, CPROP_, RTLNAME(V_CURRENCY),0 },
+{ "V_DATE", SbxINTEGER, CPROP_, RTLNAME(V_DATE),0 },
+{ "V_STRING", SbxINTEGER, CPROP_, RTLNAME(V_STRING),0 },
+
+{ "Wait", SbxNULL, 1 | FUNCTION_, RTLNAME(Wait),0 },
+ { "Milliseconds", SbxLONG, 0,nullptr,0 },
+{ "FuncCaller", SbxVARIANT, FUNCTION_, RTLNAME(FuncCaller),0 },
+//#i64882#
+{ "WaitUntil", SbxNULL, 1 | FUNCTION_, RTLNAME(WaitUntil),0 },
+ { "Date", SbxDOUBLE, 0,nullptr,0 },
+{ "Weekday", SbxINTEGER, 2 | FUNCTION_, RTLNAME(Weekday),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+ { "Firstdayofweek", SbxINTEGER, OPT_, nullptr,0 },
+{ "WeekdayName", SbxSTRING, 3 | FUNCTION_ | COMPATONLY_, RTLNAME(WeekdayName),0 },
+ { "Weekday", SbxINTEGER, 0,nullptr,0 },
+ { "Abbreviate", SbxBOOL, OPT_, nullptr,0 },
+ { "Firstdayofweek", SbxINTEGER, OPT_, nullptr,0 },
+{ "Year", SbxINTEGER, 1 | FUNCTION_, RTLNAME(Year),0 },
+ { "Date", SbxDATE, 0,nullptr,0 },
+
+{ nullptr, SbxNULL, -1,nullptr,0 }}; // end of the table
+
+SbiStdObject::SbiStdObject( const OUString& r, StarBASIC* pb ) : SbxObject( r )
+{
+ // do we have to initialize the hashcodes?
+ Methods* p = aMethods;
+ if( !p->nHash )
+ while( p->nArgs != -1 )
+ {
+ OUString aName_ = OUString::createFromAscii( p->pName );
+ p->nHash = SbxVariable::MakeHashCode( aName_ );
+ p += ( p->nArgs & ARGSMASK_ ) + 1;
+ }
+
+ // #i92642: Remove default properties
+ Remove( "Name", SbxClassType::DontCare );
+ Remove( "Parent", SbxClassType::DontCare );
+
+ SetParent( pb );
+
+ pStdFactory.reset( new SbStdFactory );
+ SbxBase::AddFactory( pStdFactory.get() );
+
+ Insert( new SbStdClipboard );
+}
+
+SbiStdObject::~SbiStdObject()
+{
+ SbxBase::RemoveFactory( pStdFactory.get() );
+ pStdFactory.reset();
+}
+
+// Finding an element:
+// It runs linearly through the method table here until an
+// adequate method is has been found. Because of the bits in
+// the nArgs-field the adequate instance of an SbxObjElement
+// is created then. If the method/property hasn't been found,
+// return NULL without error code, so that a whole chain of
+// objects can be asked for the method/property.
+
+SbxVariable* SbiStdObject::Find( const OUString& rName, SbxClassType t )
+{
+ // entered already?
+ SbxVariable* pVar = SbxObject::Find( rName, t );
+ if( !pVar )
+ {
+ // else search one
+ sal_uInt16 nHash_ = SbxVariable::MakeHashCode( rName );
+ Methods* p = aMethods;
+ bool bFound = false;
+ short nIndex = 0;
+ sal_uInt16 nSrchMask = TYPEMASK_;
+ switch( t )
+ {
+ case SbxClassType::Method: nSrchMask = METHOD_; break;
+ case SbxClassType::Property: nSrchMask = PROPERTY_; break;
+ case SbxClassType::Object: nSrchMask = OBJECT_; break;
+ default: break;
+ }
+ while( p->nArgs != -1 )
+ {
+ if( ( p->nArgs & nSrchMask )
+ && ( p->nHash == nHash_ )
+ && ( rName.equalsIgnoreAsciiCaseAscii( p->pName ) ) )
+ {
+ bFound = true;
+ if( p->nArgs & COMPTMASK_ )
+ {
+ bool bCompatibility = false;
+ SbiInstance* pInst = GetSbData()->pInst;
+ if (pInst)
+ {
+ bCompatibility = pInst->IsCompatibility();
+ }
+ else
+ {
+ // No instance running => compiling a source on module level.
+ const SbModule* pModule = GetSbData()->pCompMod;
+ if (pModule)
+ bCompatibility = pModule->IsVBACompat();
+ }
+ if ((bCompatibility && (NORMONLY_ & p->nArgs)) || (!bCompatibility && (COMPATONLY_ & p->nArgs)))
+ bFound = false;
+ }
+ break;
+ }
+ nIndex += ( p->nArgs & ARGSMASK_ ) + 1;
+ p = aMethods + nIndex;
+ }
+
+ if( bFound )
+ {
+ // isolate Args-fields:
+ SbxFlagBits nAccess = static_cast<SbxFlagBits>(( p->nArgs & RWMASK_ ) >> 8);
+ short nType = ( p->nArgs & TYPEMASK_ );
+ if( p->nArgs & CONST_ )
+ nAccess |= SbxFlagBits::Const;
+ OUString aName_ = OUString::createFromAscii( p->pName );
+ SbxClassType eCT = SbxClassType::Object;
+ if( nType & PROPERTY_ )
+ {
+ eCT = SbxClassType::Property;
+ }
+ else if( nType & METHOD_ )
+ {
+ eCT = SbxClassType::Method;
+ }
+ pVar = Make( aName_, eCT, p->eType, ( p->nArgs & FUNCTION_ ) == FUNCTION_ );
+ pVar->SetUserData( nIndex + 1 );
+ pVar->SetFlags( nAccess );
+ }
+ }
+ return pVar;
+}
+
+// SetModified must be pinched off at the RTL
+void SbiStdObject::SetModified( bool )
+{
+}
+
+
+void SbiStdObject::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+
+{
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+ if( !pHint )
+ return;
+
+ SbxVariable* pVar = pHint->GetVar();
+ SbxArray* pPar_ = pVar->GetParameters();
+ const sal_uInt16 nCallId = static_cast<sal_uInt16>(pVar->GetUserData());
+ if( nCallId )
+ {
+ const SfxHintId t = pHint->GetId();
+ if( t == SfxHintId::BasicInfoWanted )
+ pVar->SetInfo( GetInfo( static_cast<short>(pVar->GetUserData()) ) );
+ else
+ {
+ bool bWrite = false;
+ if( t == SfxHintId::BasicDataChanged )
+ bWrite = true;
+ if( t == SfxHintId::BasicDataWanted || bWrite )
+ {
+ RtlCall p = aMethods[ nCallId-1 ].pFunc;
+ SbxArrayRef rPar( pPar_ );
+ if( !pPar_ )
+ {
+ rPar = pPar_ = new SbxArray;
+ pPar_->Put32( pVar, 0 );
+ }
+ p( static_cast<StarBASIC*>(GetParent()), *pPar_, bWrite );
+ return;
+ }
+ }
+ }
+ SbxObject::Notify( rBC, rHint );
+}
+
+// building the info-structure for single elements
+// if nIdx = 0, don't create anything (Std-Props!)
+
+SbxInfo* SbiStdObject::GetInfo( short nIdx )
+{
+ if( !nIdx )
+ return nullptr;
+ Methods* p = &aMethods[ --nIdx ];
+ SbxInfo* pInfo_ = new SbxInfo;
+ short nPar = p->nArgs & ARGSMASK_;
+ for( short i = 0; i < nPar; i++ )
+ {
+ p++;
+ OUString aName_ = OUString::createFromAscii( p->pName );
+ SbxFlagBits nFlags_ = static_cast<SbxFlagBits>(( p->nArgs >> 8 ) & 0x03);
+ if( p->nArgs & OPT_ )
+ {
+ nFlags_ |= SbxFlagBits::Optional;
+ }
+ pInfo_->AddParam( aName_, p->eType, nFlags_ );
+ }
+ return pInfo_;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/stdobj1.cxx b/basic/source/runtime/stdobj1.cxx
new file mode 100644
index 000000000..20268bfbf
--- /dev/null
+++ b/basic/source/runtime/stdobj1.cxx
@@ -0,0 +1,422 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/sberrors.hxx>
+#include <basic/sbstar.hxx>
+#include <vcl/outdev.hxx>
+#include <vcl/svapp.hxx>
+#include <sbstdobj.hxx>
+
+#define ATTR_IMP_TYPE 1
+#define ATTR_IMP_WIDTH 2
+#define ATTR_IMP_HEIGHT 3
+#define ATTR_IMP_BOLD 4
+#define ATTR_IMP_ITALIC 5
+#define ATTR_IMP_STRIKETHROUGH 6
+#define ATTR_IMP_UNDERLINE 7
+#define ATTR_IMP_SIZE 9
+#define ATTR_IMP_NAME 10
+
+#define METH_CLEAR 20
+#define METH_GETDATA 21
+#define METH_GETFORMAT 22
+#define METH_GETTEXT 23
+#define METH_SETDATA 24
+#define METH_SETTEXT 25
+
+
+SbStdFactory::SbStdFactory()
+{
+}
+
+SbxObject* SbStdFactory::CreateObject( const OUString& rClassName )
+{
+ if( rClassName.equalsIgnoreAsciiCase("Picture") )
+ return new SbStdPicture;
+ else if( rClassName.equalsIgnoreAsciiCase("Font") )
+ return new SbStdFont;
+ else
+ return nullptr;
+}
+
+
+void SbStdPicture::PropType( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROP_READONLY );
+ return;
+ }
+
+ GraphicType eType = aGraphic.GetType();
+ sal_Int16 nType = 0;
+
+ if( eType == GraphicType::Bitmap )
+ nType = 1;
+ else if( eType != GraphicType::NONE )
+ nType = 2;
+
+ pVar->PutInteger( nType );
+}
+
+
+void SbStdPicture::PropWidth( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROP_READONLY );
+ return;
+ }
+
+ Size aSize = OutputDevice::LogicToLogic(aGraphic.GetPrefSize(), aGraphic.GetPrefMapMode(), MapMode(MapUnit::MapTwip));
+ pVar->PutInteger( static_cast<sal_Int16>(aSize.Width()) );
+}
+
+void SbStdPicture::PropHeight( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_PROP_READONLY );
+ return;
+ }
+
+ Size aSize = OutputDevice::LogicToLogic(aGraphic.GetPrefSize(), aGraphic.GetPrefMapMode(), MapMode(MapUnit::MapTwip));
+ pVar->PutInteger( static_cast<sal_Int16>(aSize.Height()) );
+}
+
+
+SbStdPicture::SbStdPicture() :
+ SbxObject( "Picture" )
+{
+ // Properties
+ SbxVariable* p = Make( "Type", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::Read | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_TYPE );
+ p = Make( "Width", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::Read | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_WIDTH );
+ p = Make( "Height", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::Read | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_HEIGHT );
+}
+
+SbStdPicture::~SbStdPicture()
+{
+}
+
+
+void SbStdPicture::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+
+{
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+
+ if( !pHint )
+ return;
+
+ if( pHint->GetId() == SfxHintId::BasicInfoWanted )
+ {
+ SbxObject::Notify( rBC, rHint );
+ return;
+ }
+
+ SbxVariable* pVar = pHint->GetVar();
+ const sal_uInt32 nWhich = pVar->GetUserData();
+ bool bWrite = pHint->GetId() == SfxHintId::BasicDataChanged;
+
+ // Properties
+ switch( nWhich )
+ {
+ case ATTR_IMP_TYPE: PropType( pVar, bWrite ); return;
+ case ATTR_IMP_WIDTH: PropWidth( pVar, bWrite ); return;
+ case ATTR_IMP_HEIGHT: PropHeight( pVar, bWrite ); return;
+ }
+
+ SbxObject::Notify( rBC, rHint );
+}
+
+
+void SbStdFont::PropBold( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ SetBold( pVar->GetBool() );
+ else
+ pVar->PutBool( IsBold() );
+}
+
+void SbStdFont::PropItalic( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ SetItalic( pVar->GetBool() );
+ else
+ pVar->PutBool( IsItalic() );
+}
+
+void SbStdFont::PropStrikeThrough( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ SetStrikeThrough( pVar->GetBool() );
+ else
+ pVar->PutBool( IsStrikeThrough() );
+}
+
+void SbStdFont::PropUnderline( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ SetUnderline( pVar->GetBool() );
+ else
+ pVar->PutBool( IsUnderline() );
+}
+
+void SbStdFont::PropSize( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ SetSize( static_cast<sal_uInt16>(pVar->GetInteger()) );
+ else
+ pVar->PutInteger( static_cast<sal_Int16>(GetSize()) );
+}
+
+void SbStdFont::PropName( SbxVariable* pVar, bool bWrite )
+{
+ if( bWrite )
+ {
+ aName = pVar->GetOUString();
+ }
+ else
+ {
+ pVar->PutString( aName );
+ }
+}
+
+
+SbStdFont::SbStdFont()
+ : SbxObject( "Font" )
+ , bBold(false)
+ , bItalic(false)
+ , bStrikeThrough(false)
+ , bUnderline(false)
+ , nSize(0)
+{
+ // Properties
+ SbxVariable* p = Make( "Bold", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::ReadWrite | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_BOLD );
+ p = Make( "Italic", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::ReadWrite | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_ITALIC );
+ p = Make( "StrikeThrough", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::ReadWrite | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_STRIKETHROUGH );
+ p = Make( "Underline", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::ReadWrite | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_UNDERLINE );
+ p = Make( "Size", SbxClassType::Property, SbxVARIANT );
+ p->SetFlags( SbxFlagBits::ReadWrite | SbxFlagBits::DontStore );
+ p->SetUserData( ATTR_IMP_SIZE );
+
+ // handle name property yourself
+ p = Find( "Name", SbxClassType::Property );
+ assert(p && "No Name Property");
+ p->SetUserData( ATTR_IMP_NAME );
+}
+
+SbStdFont::~SbStdFont()
+{
+}
+
+void SbStdFont::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+
+ if( !pHint )
+ return;
+
+ if( pHint->GetId() == SfxHintId::BasicInfoWanted )
+ {
+ SbxObject::Notify( rBC, rHint );
+ return;
+ }
+
+ SbxVariable* pVar = pHint->GetVar();
+ const sal_uInt32 nWhich = pVar->GetUserData();
+ bool bWrite = pHint->GetId() == SfxHintId::BasicDataChanged;
+
+ // Properties
+ switch( nWhich )
+ {
+ case ATTR_IMP_BOLD: PropBold( pVar, bWrite ); return;
+ case ATTR_IMP_ITALIC: PropItalic( pVar, bWrite ); return;
+ case ATTR_IMP_STRIKETHROUGH:PropStrikeThrough( pVar, bWrite ); return;
+ case ATTR_IMP_UNDERLINE: PropUnderline( pVar, bWrite ); return;
+ case ATTR_IMP_SIZE: PropSize( pVar, bWrite ); return;
+ case ATTR_IMP_NAME: PropName( pVar, bWrite ); return;
+ }
+
+ SbxObject::Notify( rBC, rHint );
+}
+
+
+void SbStdClipboard::MethClear( SbxArray const * pPar_ )
+{
+ if( pPar_ && (pPar_->Count32() > 1) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_NUMBER_OF_ARGS );
+ return;
+ }
+
+}
+
+void SbStdClipboard::MethGetData( SbxArray* pPar_ )
+{
+ if( !pPar_ || (pPar_->Count32() != 2) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_NUMBER_OF_ARGS );
+ return;
+ }
+
+ sal_Int16 nFormat = pPar_->Get32(1)->GetInteger();
+ if( nFormat <= 0 || nFormat > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+}
+
+void SbStdClipboard::MethGetFormat( SbxVariable* pVar, SbxArray* pPar_ )
+{
+ if( !pPar_ || (pPar_->Count32() != 2) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_NUMBER_OF_ARGS );
+ return;
+ }
+
+ sal_Int16 nFormat = pPar_->Get32(1)->GetInteger();
+ if( nFormat <= 0 || nFormat > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+ pVar->PutBool( false );
+}
+
+void SbStdClipboard::MethGetText( SbxVariable* pVar, SbxArray const * pPar_ )
+{
+ if( pPar_ && (pPar_->Count32() > 1) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_NUMBER_OF_ARGS );
+ return;
+ }
+
+ pVar->PutString( OUString() );
+}
+
+void SbStdClipboard::MethSetData( SbxArray* pPar_ )
+{
+ if( !pPar_ || (pPar_->Count32() != 3) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_NUMBER_OF_ARGS );
+ return;
+ }
+
+ sal_Int16 nFormat = pPar_->Get32(2)->GetInteger();
+ if( nFormat <= 0 || nFormat > 3 )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_ARGUMENT );
+ return;
+ }
+
+}
+
+void SbStdClipboard::MethSetText( SbxArray const * pPar_ )
+{
+ if( !pPar_ || (pPar_->Count32() != 2) )
+ {
+ StarBASIC::Error( ERRCODE_BASIC_BAD_NUMBER_OF_ARGS );
+ return;
+ }
+
+}
+
+
+SbStdClipboard::SbStdClipboard() :
+ SbxObject( "Clipboard" )
+{
+ SbxVariable* p = Find( "Name", SbxClassType::Property );
+ assert(p && "No Name Property");
+ p->SetUserData( ATTR_IMP_NAME );
+
+ // register methods
+ p = Make( "Clear", SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p->SetUserData( METH_CLEAR );
+ p = Make( "GetData", SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p->SetUserData( METH_GETDATA );
+ p = Make( "GetFormat", SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p->SetUserData( METH_GETFORMAT );
+ p = Make( "GetText", SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p->SetUserData( METH_GETTEXT );
+ p = Make( "SetData", SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p->SetUserData( METH_SETDATA );
+ p = Make( "SetText", SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p->SetUserData( METH_SETTEXT );
+}
+
+SbStdClipboard::~SbStdClipboard()
+{
+}
+
+void SbStdClipboard::Notify( SfxBroadcaster& rBC, const SfxHint& rHint )
+{
+ const SbxHint* pHint = dynamic_cast<const SbxHint*>(&rHint);
+
+ if( !pHint )
+ return;
+
+ if( pHint->GetId() == SfxHintId::BasicInfoWanted )
+ {
+ SbxObject::Notify( rBC, rHint );
+ return;
+ }
+
+ SbxVariable* pVar = pHint->GetVar();
+ SbxArray* pPar_ = pVar->GetParameters();
+ const sal_uInt32 nWhich = pVar->GetUserData();
+
+ // Methods
+ switch( nWhich )
+ {
+ case METH_CLEAR: MethClear( pPar_ ); return;
+ case METH_GETDATA: MethGetData( pPar_ ); return;
+ case METH_GETFORMAT: MethGetFormat( pVar, pPar_ ); return;
+ case METH_GETTEXT: MethGetText( pVar, pPar_ ); return;
+ case METH_SETDATA: MethSetData( pPar_ ); return;
+ case METH_SETTEXT: MethSetText( pPar_ ); return;
+ }
+
+ SbxObject::Notify( rBC, rHint );
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/runtime/wnt-x86.asm b/basic/source/runtime/wnt-x86.asm
new file mode 100644
index 000000000..08bd70fc2
--- /dev/null
+++ b/basic/source/runtime/wnt-x86.asm
@@ -0,0 +1,47 @@
+;
+; This file is part of the LibreOffice project.
+;
+; This Source Code Form is subject to the terms of the Mozilla Public
+; License, v. 2.0. If a copy of the MPL was not distributed with this
+; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;
+; This file incorporates work covered by the following license notice:
+;
+; Licensed to the Apache Software Foundation (ASF) under one or more
+; contributor license agreements. See the NOTICE file distributed
+; with this work for additional information regarding copyright
+; ownership. The ASF licenses this file to you under the Apache
+; License, Version 2.0 (the "License"); you may not use this file
+; except in compliance with the License. You may obtain a copy of
+; the License at http://www.apache.org/licenses/LICENSE-2.0 .
+;
+
+.386
+
+PUBLIC _DllMgr_call32@12
+PUBLIC _DllMgr_callFp@12
+
+_TEXT SEGMENT
+_DllMgr_call32@12:
+_DllMgr_callFp@12:
+ push ebp
+ mov ebp, esp
+ push esi
+ push edi
+ mov ecx, [ebp+16]
+ jecxz $1
+ sub esp, ecx
+ mov edi, esp
+ mov esi, [ebp+12]
+ shr ecx, 2
+ rep movsd
+$1: call DWORD PTR [ebp+8]
+ ; for extra safety, do not trust esp after call (in case the Basic Declare
+ ; signature is wrong):
+ mov edi, [ebp-8]
+ mov esi, [ebp-4]
+ mov esp, ebp
+ pop ebp
+ ret 12
+_TEXT ENDS
+END
diff --git a/basic/source/sbx/sbxarray.cxx b/basic/source/sbx/sbxarray.cxx
new file mode 100644
index 000000000..0dcd6c8aa
--- /dev/null
+++ b/basic/source/sbx/sbxarray.cxx
@@ -0,0 +1,561 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+#include <o3tl/safeint.hxx>
+#include <tools/debug.hxx>
+#include <tools/stream.hxx>
+#include <basic/sbx.hxx>
+#include <runtime.hxx>
+
+#include <optional>
+
+using namespace std;
+
+struct SbxVarEntry
+{
+ SbxVariableRef mpVar;
+ std::optional<OUString> maAlias;
+};
+
+
+// SbxArray
+
+SbxArray::SbxArray( SbxDataType t ) : SbxBase()
+{
+ eType = t;
+ if( t != SbxVARIANT )
+ SetFlag( SbxFlagBits::Fixed );
+}
+
+SbxArray& SbxArray::operator=( const SbxArray& rArray )
+{
+ if( &rArray != this )
+ {
+ eType = rArray.eType;
+ Clear();
+ for( const auto& rpSrcRef : rArray.mVarEntries )
+ {
+ SbxVariableRef pSrc_ = rpSrcRef.mpVar;
+ if( !pSrc_.is() )
+ continue;
+
+ if( eType != SbxVARIANT )
+ {
+ // Convert no objects
+ if( eType != SbxOBJECT || pSrc_->GetClass() != SbxClassType::Object )
+ {
+ pSrc_->Convert(eType);
+ }
+ }
+ mVarEntries.push_back( rpSrcRef );
+ }
+ }
+ return *this;
+}
+
+SbxArray::~SbxArray()
+{
+}
+
+SbxDataType SbxArray::GetType() const
+{
+ return static_cast<SbxDataType>( eType | SbxARRAY );
+}
+
+void SbxArray::Clear()
+{
+ mVarEntries.clear();
+}
+
+sal_uInt32 SbxArray::Count32() const
+{
+ return mVarEntries.size();
+}
+
+SbxVariableRef& SbxArray::GetRef32( sal_uInt32 nIdx )
+{
+ // If necessary extend the array
+ DBG_ASSERT( nIdx <= SBX_MAXINDEX32, "SBX: Array-Index > SBX_MAXINDEX32" );
+ // Very Hot Fix
+ if( nIdx > SBX_MAXINDEX32 )
+ {
+ SetError( ERRCODE_BASIC_OUT_OF_RANGE );
+ nIdx = 0;
+ }
+ if ( mVarEntries.size() <= nIdx )
+ mVarEntries.resize(nIdx+1);
+
+ return mVarEntries[nIdx].mpVar;
+}
+
+SbxVariable* SbxArray::Get32( sal_uInt32 nIdx )
+{
+ if( !CanRead() )
+ {
+ SetError( ERRCODE_BASIC_PROP_WRITEONLY );
+ return nullptr;
+ }
+ SbxVariableRef& rRef = GetRef32( nIdx );
+
+ if ( !rRef.is() )
+ rRef = new SbxVariable( eType );
+
+ return rRef.get();
+}
+
+void SbxArray::Put32( SbxVariable* pVar, sal_uInt32 nIdx )
+{
+ if( !CanWrite() )
+ SetError( ERRCODE_BASIC_PROP_READONLY );
+ else
+ {
+ if( pVar )
+ if( eType != SbxVARIANT )
+ // Convert no objects
+ if( eType != SbxOBJECT || pVar->GetClass() != SbxClassType::Object )
+ pVar->Convert( eType );
+ SbxVariableRef& rRef = GetRef32( nIdx );
+ // tdf#122250. It is possible that I hold the last reference to myself, so check, otherwise I might
+ // call SetFlag on myself after I have died.
+ bool removingMyself = rRef && rRef->GetParameters() == this && GetRefCount() == 1;
+ if( rRef.get() != pVar )
+ {
+ rRef = pVar;
+ if (!removingMyself)
+ SetFlag( SbxFlagBits::Modified );
+ }
+ }
+}
+
+OUString SbxArray::GetAlias32( sal_uInt32 nIdx )
+{
+ if( !CanRead() )
+ {
+ SetError( ERRCODE_BASIC_PROP_WRITEONLY );
+ return OUString();
+ }
+ SbxVarEntry& rRef = reinterpret_cast<SbxVarEntry&>(GetRef32( nIdx ));
+
+ if (!rRef.maAlias)
+ return OUString();
+
+ return *rRef.maAlias;
+}
+
+void SbxArray::PutAlias32( const OUString& rAlias, sal_uInt32 nIdx )
+{
+ if( !CanWrite() )
+ {
+ SetError( ERRCODE_BASIC_PROP_READONLY );
+ }
+ else
+ {
+ SbxVarEntry& rRef = reinterpret_cast<SbxVarEntry&>( GetRef32( nIdx ) );
+ rRef.maAlias = rAlias;
+ }
+}
+
+void SbxArray::Insert32( SbxVariable* pVar, sal_uInt32 nIdx )
+{
+ DBG_ASSERT( mVarEntries.size() <= SBX_MAXINDEX32, "SBX: Array gets too big" );
+ if( mVarEntries.size() > SBX_MAXINDEX32 )
+ {
+ return;
+ }
+ SbxVarEntry p;
+ p.mpVar = pVar;
+ size_t nSize = mVarEntries.size();
+ if( nIdx > nSize )
+ {
+ nIdx = nSize;
+ }
+ if( eType != SbxVARIANT && pVar )
+ {
+ p.mpVar->Convert(eType);
+ }
+ if( nIdx == nSize )
+ {
+ mVarEntries.push_back( p );
+ }
+ else
+ {
+ mVarEntries.insert( mVarEntries.begin() + nIdx, p );
+ }
+ SetFlag( SbxFlagBits::Modified );
+}
+
+void SbxArray::Remove( sal_uInt32 nIdx )
+{
+ if( nIdx < mVarEntries.size() )
+ {
+ mVarEntries.erase( mVarEntries.begin() + nIdx );
+ SetFlag( SbxFlagBits::Modified );
+ }
+}
+
+void SbxArray::Remove( SbxVariable const * pVar )
+{
+ if( pVar )
+ {
+ for( size_t i = 0; i < mVarEntries.size(); i++ )
+ {
+ if (mVarEntries[i].mpVar.get() == pVar)
+ {
+ Remove( i ); break;
+ }
+ }
+ }
+}
+
+// Taking over of the data from the passed array, at which
+// the variable of the same name will be overwritten.
+
+void SbxArray::Merge( SbxArray* p )
+{
+ if (!p)
+ return;
+
+ for (auto& rEntry1: p->mVarEntries)
+ {
+ if (!rEntry1.mpVar.is())
+ continue;
+
+ OUString aName = rEntry1.mpVar->GetName();
+ sal_uInt16 nHash = rEntry1.mpVar->GetHashCode();
+
+ // Is the element by the same name already inside?
+ // Then overwrite!
+ for (auto& rEntry2: mVarEntries)
+ {
+ if (!rEntry2.mpVar.is())
+ continue;
+
+ if (rEntry2.mpVar->GetHashCode() == nHash &&
+ rEntry2.mpVar->GetName().equalsIgnoreAsciiCase(aName))
+ {
+ // Take this element and clear the original.
+ rEntry2.mpVar = rEntry1.mpVar;
+ rEntry1.mpVar.clear();
+ break;
+ }
+ }
+
+ if (rEntry1.mpVar.is())
+ {
+ // We don't have element with the same name. Add a new entry.
+ SbxVarEntry aNewEntry;
+ aNewEntry.mpVar = rEntry1.mpVar;
+ if (rEntry1.maAlias)
+ aNewEntry.maAlias = *rEntry1.maAlias;
+ mVarEntries.push_back(aNewEntry);
+ }
+ }
+}
+
+// Search of an element by his name and type. If an element is an object,
+// it will also be scanned...
+
+SbxVariable* SbxArray::Find( const OUString& rName, SbxClassType t )
+{
+ SbxVariable* p = nullptr;
+ if( mVarEntries.empty() )
+ return nullptr;
+ bool bExtSearch = IsSet( SbxFlagBits::ExtSearch );
+ sal_uInt16 nHash = SbxVariable::MakeHashCode( rName );
+ for (auto& rEntry : mVarEntries)
+ {
+ if (!rEntry.mpVar.is() || !rEntry.mpVar->IsVisible())
+ continue;
+
+ // The very secure search works as well, if there is no hashcode!
+ sal_uInt16 nVarHash = rEntry.mpVar->GetHashCode();
+ if ( (!nVarHash || nVarHash == nHash)
+ && (t == SbxClassType::DontCare || rEntry.mpVar->GetClass() == t)
+ && (rEntry.mpVar->GetName().equalsIgnoreAsciiCase(rName)))
+ {
+ p = rEntry.mpVar.get();
+ p->ResetFlag(SbxFlagBits::ExtFound);
+ break;
+ }
+
+ // Did we have an array/object with extended search?
+ if (bExtSearch && rEntry.mpVar->IsSet(SbxFlagBits::ExtSearch))
+ {
+ switch (rEntry.mpVar->GetClass())
+ {
+ case SbxClassType::Object:
+ {
+ // Objects are not allowed to scan their parent.
+ SbxFlagBits nOld = rEntry.mpVar->GetFlags();
+ rEntry.mpVar->ResetFlag(SbxFlagBits::GlobalSearch);
+ p = static_cast<SbxObject&>(*rEntry.mpVar).Find(rName, t);
+ rEntry.mpVar->SetFlags(nOld);
+ }
+ break;
+ case SbxClassType::Array:
+ // Casting SbxVariable to SbxArray? Really?
+ p = reinterpret_cast<SbxArray&>(*rEntry.mpVar).Find(rName, t);
+ break;
+ default:
+ ;
+ }
+
+ if (p)
+ {
+ p->SetFlag(SbxFlagBits::ExtFound);
+ break;
+ }
+ }
+ }
+ return p;
+}
+
+bool SbxArray::LoadData( SvStream& rStrm, sal_uInt16 /*nVer*/ )
+{
+ sal_uInt16 nElem;
+ Clear();
+ bool bRes = true;
+ SbxFlagBits f = nFlags;
+ nFlags |= SbxFlagBits::Write;
+ rStrm.ReadUInt16( nElem );
+ nElem &= 0x7FFF;
+ for( sal_uInt32 n = 0; n < nElem; n++ )
+ {
+ sal_uInt16 nIdx;
+ rStrm.ReadUInt16( nIdx );
+ SbxVariable* pVar = static_cast<SbxVariable*>(Load( rStrm ));
+ if( pVar )
+ {
+ SbxVariableRef& rRef = GetRef32( nIdx );
+ rRef = pVar;
+ }
+ else
+ {
+ bRes = false;
+ break;
+ }
+ }
+ nFlags = f;
+ return bRes;
+}
+
+bool SbxArray::StoreData( SvStream& rStrm ) const
+{
+ sal_uInt32 nElem = 0;
+ // Which elements are even defined?
+ for( auto& rEntry: mVarEntries )
+ {
+ if (rEntry.mpVar.is() && !(rEntry.mpVar->GetFlags() & SbxFlagBits::DontStore))
+ nElem++;
+ }
+ rStrm.WriteUInt16( nElem );
+ for( size_t n = 0; n < mVarEntries.size(); n++ )
+ {
+ const SbxVarEntry& rEntry = mVarEntries[n];
+ if (rEntry.mpVar.is() && !(rEntry.mpVar->GetFlags() & SbxFlagBits::DontStore))
+ {
+ rStrm.WriteUInt16( n );
+ if (!rEntry.mpVar->Store(rStrm))
+ return false;
+ }
+ }
+ return true;
+}
+
+// #100883 Method to set method directly to parameter array
+void SbxArray::PutDirect( SbxVariable* pVar, sal_uInt32 nIdx )
+{
+ SbxVariableRef& rRef = GetRef32( nIdx );
+ rRef = pVar;
+}
+
+
+// SbxArray
+
+SbxDimArray::SbxDimArray( SbxDataType t ) : SbxArray( t ), mbHasFixedSize( false )
+{
+}
+
+SbxDimArray& SbxDimArray::operator=( const SbxDimArray& rArray )
+{
+ if( &rArray != this )
+ {
+ SbxArray::operator=( static_cast<const SbxArray&>(rArray) );
+ m_vDimensions = rArray.m_vDimensions;
+ mbHasFixedSize = rArray.mbHasFixedSize;
+ }
+ return *this;
+}
+
+SbxDimArray::~SbxDimArray()
+{
+}
+
+void SbxDimArray::Clear()
+{
+ m_vDimensions.clear();
+ SbxArray::Clear();
+}
+
+// Add a dimension
+
+void SbxDimArray::AddDimImpl32( sal_Int32 lb, sal_Int32 ub, bool bAllowSize0 )
+{
+ ErrCode eRes = ERRCODE_NONE;
+ if( ub < lb && !bAllowSize0 )
+ {
+ eRes = ERRCODE_BASIC_OUT_OF_RANGE;
+ ub = lb;
+ }
+ SbxDim d;
+ d.nLbound = lb;
+ d.nUbound = ub;
+ d.nSize = ub - lb + 1;
+ m_vDimensions.push_back(d);
+ if( eRes )
+ SetError( eRes );
+}
+
+void SbxDimArray::AddDim32( sal_Int32 lb, sal_Int32 ub )
+{
+ AddDimImpl32( lb, ub, false );
+}
+
+void SbxDimArray::unoAddDim32( sal_Int32 lb, sal_Int32 ub )
+{
+ AddDimImpl32( lb, ub, true );
+}
+
+
+// Readout dimension data
+
+bool SbxDimArray::GetDim32( sal_Int32 n, sal_Int32& rlb, sal_Int32& rub ) const
+{
+ if( n < 1 || n > static_cast<sal_Int32>(m_vDimensions.size()) )
+ {
+ SetError( ERRCODE_BASIC_OUT_OF_RANGE );
+ rub = rlb = 0;
+ return false;
+ }
+ SbxDim d = m_vDimensions[n - 1];
+ rub = d.nUbound;
+ rlb = d.nLbound;
+ return true;
+}
+
+// Element-Ptr with the help of an index list
+
+sal_uInt32 SbxDimArray::Offset32( const sal_Int32* pIdx )
+{
+ sal_uInt32 nPos = 0;
+ for( const auto& rDimension : m_vDimensions )
+ {
+ sal_Int32 nIdx = *pIdx++;
+ if( nIdx < rDimension.nLbound || nIdx > rDimension.nUbound )
+ {
+ nPos = sal_uInt32(SBX_MAXINDEX32) + 1; break;
+ }
+ nPos = nPos * rDimension.nSize + nIdx - rDimension.nLbound;
+ }
+ if( m_vDimensions.empty() || nPos > SBX_MAXINDEX32 )
+ {
+ SetError( ERRCODE_BASIC_OUT_OF_RANGE );
+ nPos = 0;
+ }
+ return nPos;
+}
+
+SbxVariable* SbxDimArray::Get32( const sal_Int32* pIdx )
+{
+ return SbxArray::Get32( Offset32( pIdx ) );
+}
+
+void SbxDimArray::Put32( SbxVariable* p, const sal_Int32* pIdx )
+{
+ SbxArray::Put32( p, Offset32( pIdx ) );
+}
+
+// Element-Number with the help of Parameter-Array
+sal_uInt32 SbxDimArray::Offset32( SbxArray* pPar )
+{
+#if HAVE_FEATURE_SCRIPTING
+ if (m_vDimensions.empty() || !pPar ||
+ ((m_vDimensions.size() != sal::static_int_cast<size_t>(pPar->Count32() - 1))
+ && SbiRuntime::isVBAEnabled()))
+ {
+ SetError( ERRCODE_BASIC_OUT_OF_RANGE );
+ return 0;
+ }
+#endif
+ sal_uInt32 nPos = 0;
+ sal_uInt32 nOff = 1; // Non element 0!
+ for (auto const& vDimension : m_vDimensions)
+ {
+ sal_Int32 nIdx = pPar->Get32( nOff++ )->GetLong();
+ if( nIdx < vDimension.nLbound || nIdx > vDimension.nUbound )
+ {
+ nPos = sal_uInt32(SBX_MAXINDEX32)+1;
+ break;
+ }
+ nPos = nPos * vDimension.nSize + nIdx - vDimension.nLbound;
+ if (IsError())
+ break;
+ }
+ if( nPos > o3tl::make_unsigned(SBX_MAXINDEX32) )
+ {
+ SetError( ERRCODE_BASIC_OUT_OF_RANGE );
+ nPos = 0;
+ }
+ return nPos;
+}
+
+SbxVariable* SbxDimArray::Get( SbxArray* pPar )
+{
+ return SbxArray::Get32( Offset32( pPar ) );
+}
+
+bool SbxDimArray::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ short nDimension;
+ rStrm.ReadInt16( nDimension );
+ for( short i = 0; i < nDimension && rStrm.GetError() == ERRCODE_NONE; i++ )
+ {
+ sal_Int16 lb(0), ub(0);
+ rStrm.ReadInt16( lb ).ReadInt16( ub );
+ AddDim32( lb, ub );
+ }
+ return SbxArray::LoadData( rStrm, nVer );
+}
+
+bool SbxDimArray::StoreData( SvStream& rStrm ) const
+{
+ assert(m_vDimensions.size() <= sal::static_int_cast<size_t>(std::numeric_limits<sal_Int16>::max()));
+ rStrm.WriteInt16( m_vDimensions.size() );
+ for( sal_Int32 i = 1; i <= static_cast<sal_Int32>(m_vDimensions.size()); i++ )
+ {
+ sal_Int32 lb32, ub32;
+ GetDim32(i, lb32, ub32);
+ assert(lb32 >= -SBX_MAXINDEX && ub32 <= SBX_MAXINDEX);
+ rStrm.WriteInt16(lb32).WriteInt16(ub32);
+ }
+ return SbxArray::StoreData( rStrm );
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxbase.cxx b/basic/source/sbx/sbxbase.cxx
new file mode 100644
index 000000000..c80b681c6
--- /dev/null
+++ b/basic/source/sbx/sbxbase.cxx
@@ -0,0 +1,335 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <memory>
+#include <tools/debug.hxx>
+#include <tools/stream.hxx>
+#include <vcl/svapp.hxx>
+
+#include <basic/sbx.hxx>
+#include <sbxfac.hxx>
+#include <sbxform.hxx>
+#include <basic/sbxmeth.hxx>
+#include <sbxprop.hxx>
+#include <sbxbase.hxx>
+
+#include <rtl/ustring.hxx>
+#include <sal/log.hxx>
+
+// AppData-Structure for SBX:
+
+
+SbxAppData::SbxAppData()
+ : eErrCode(ERRCODE_NONE)
+ , eBasicFormaterLangType(LANGUAGE_DONTKNOW)
+{
+}
+
+SbxAppData::~SbxAppData()
+{
+ SolarMutexGuard g;
+
+ pBasicFormater.reset();
+ // basic manager repository must be destroyed before factories
+ mrImplRepository.clear();
+ m_Factories.clear();
+}
+
+SbxBase::SbxBase()
+{
+ nFlags = SbxFlagBits::ReadWrite;
+}
+
+SbxBase::SbxBase( const SbxBase& r )
+ : SvRefBase( r )
+{
+ nFlags = r.nFlags;
+}
+
+SbxBase::~SbxBase()
+{
+}
+
+SbxBase& SbxBase::operator=( const SbxBase& r )
+{
+ nFlags = r.nFlags;
+ return *this;
+}
+
+SbxDataType SbxBase::GetType() const
+{
+ return SbxEMPTY;
+}
+
+bool SbxBase::IsFixed() const
+{
+ return IsSet( SbxFlagBits::Fixed );
+}
+
+void SbxBase::SetModified( bool b )
+{
+ if( IsSet( SbxFlagBits::NoModify ) )
+ return;
+ if( b )
+ SetFlag( SbxFlagBits::Modified );
+ else
+ ResetFlag( SbxFlagBits::Modified );
+}
+
+ErrCode const & SbxBase::GetError()
+{
+ return GetSbxData_Impl().eErrCode;
+}
+
+void SbxBase::SetError( ErrCode e )
+{
+ SbxAppData& r = GetSbxData_Impl();
+ if( e && r.eErrCode == ERRCODE_NONE )
+ r.eErrCode = e;
+}
+
+bool SbxBase::IsError()
+{
+ return GetSbxData_Impl().eErrCode != ERRCODE_NONE;
+}
+
+void SbxBase::ResetError()
+{
+ GetSbxData_Impl().eErrCode = ERRCODE_NONE;
+}
+
+void SbxBase::AddFactory( SbxFactory* pFac )
+{
+ GetSbxData_Impl().m_Factories.emplace_back(pFac);
+}
+
+void SbxBase::RemoveFactory( SbxFactory const * pFac )
+{
+ SbxAppData& r = GetSbxData_Impl();
+ auto it = std::find_if(r.m_Factories.begin(), r.m_Factories.end(),
+ [&pFac](const std::unique_ptr<SbxFactory>& rxFactory) { return rxFactory.get() == pFac; });
+ if (it != r.m_Factories.end())
+ {
+ std::unique_ptr<SbxFactory> tmp(std::move(*it));
+ r.m_Factories.erase( it );
+ (void)tmp.release();
+ }
+}
+
+
+SbxBase* SbxBase::Create( sal_uInt16 nSbxId, sal_uInt32 nCreator )
+{
+ // #91626: Hack to skip old Basic dialogs
+ // Problem: There does not exist a factory any more,
+ // so we have to create a dummy SbxVariable instead
+ if( nSbxId == 0x65 ) // Dialog Id
+ return new SbxVariable;
+
+ if( nCreator == SBXCR_SBX )
+ switch( nSbxId )
+ {
+ case SBXID_VALUE: return new SbxValue;
+ case SBXID_VARIABLE: return new SbxVariable;
+ case SBXID_ARRAY: return new SbxArray;
+ case SBXID_DIMARRAY: return new SbxDimArray;
+ case SBXID_OBJECT: return new SbxObject( "" );
+ case SBXID_COLLECTION: return new SbxCollection;
+ case SBXID_FIXCOLLECTION:
+ return new SbxStdCollection;
+ case SBXID_METHOD: return new SbxMethod( "", SbxEMPTY );
+ case SBXID_PROPERTY: return new SbxProperty( "", SbxEMPTY );
+ }
+ // Unknown type: go over the factories!
+ SbxAppData& r = GetSbxData_Impl();
+ SbxBase* pNew = nullptr;
+ for (auto const& rpFac : r.m_Factories)
+ {
+ pNew = rpFac->Create( nSbxId, nCreator );
+ if( pNew )
+ break;
+ }
+ SAL_WARN_IF(!pNew, "basic", "No factory for SBX ID " << nSbxId);
+ return pNew;
+}
+
+SbxObject* SbxBase::CreateObject( const OUString& rClass )
+{
+ SbxAppData& r = GetSbxData_Impl();
+ SbxObject* pNew = nullptr;
+ for (auto const& rpFac : r.m_Factories)
+ {
+ pNew = rpFac->CreateObject( rClass );
+ if( pNew )
+ break;
+ }
+ SAL_WARN_IF(!pNew, "basic", "No factory for object class " << rClass);
+ return pNew;
+}
+
+SbxBase* SbxBase::Load( SvStream& rStrm )
+{
+ sal_uInt16 nSbxId, nFlagsTmp, nVer;
+ sal_uInt32 nCreator, nSize;
+ rStrm.ReadUInt32( nCreator ).ReadUInt16( nSbxId ).ReadUInt16( nFlagsTmp ).ReadUInt16( nVer );
+ SbxFlagBits nFlags = static_cast<SbxFlagBits>(nFlagsTmp);
+
+ // Correcting a foolishness of mine:
+ if( nFlags & SbxFlagBits::Reserved )
+ nFlags = ( nFlags & ~SbxFlagBits::Reserved ) | SbxFlagBits::GlobalSearch;
+
+ sal_uInt64 nOldPos = rStrm.Tell();
+ rStrm.ReadUInt32( nSize );
+ SbxBase* p = Create( nSbxId, nCreator );
+ if( p )
+ {
+ p->nFlags = nFlags;
+ if( p->LoadData( rStrm, nVer ) )
+ {
+ sal_uInt64 const nNewPos = rStrm.Tell();
+ nOldPos += nSize;
+ DBG_ASSERT( nOldPos >= nNewPos, "SBX: Too much data loaded" );
+ if( nOldPos != nNewPos )
+ rStrm.Seek( nOldPos );
+ if( !p->LoadCompleted() )
+ {
+ // Deleting of the object
+ SbxBaseRef xDeleteRef( p );
+ p = nullptr;
+ }
+ }
+ else
+ {
+ rStrm.SetError( SVSTREAM_FILEFORMAT_ERROR );
+ // Deleting of the object
+ SbxBaseRef xDeleteRef( p );
+ p = nullptr;
+ }
+ }
+ else
+ rStrm.SetError( SVSTREAM_FILEFORMAT_ERROR );
+ return p;
+}
+
+bool SbxBase::Store( SvStream& rStrm )
+{
+ if( ( nFlags & SbxFlagBits::DontStore ) == SbxFlagBits::NONE )
+ {
+ rStrm.WriteUInt32( SBXCR_SBX )
+ .WriteUInt16( GetSbxId() )
+ .WriteUInt16( static_cast<sal_uInt16>(GetFlags()) )
+ .WriteUInt16( GetVersion() );
+ sal_uInt64 const nOldPos = rStrm.Tell();
+ rStrm.WriteUInt32( 0 );
+ bool bRes = StoreData( rStrm );
+ sal_uInt64 const nNewPos = rStrm.Tell();
+ rStrm.Seek( nOldPos );
+ rStrm.WriteUInt32( nNewPos - nOldPos );
+ rStrm.Seek( nNewPos );
+ if( rStrm.GetError() != ERRCODE_NONE )
+ bRes = false;
+ if( bRes )
+ bRes = true;
+ return bRes;
+ }
+ else
+ return true;
+}
+
+bool SbxBase::LoadCompleted()
+{
+ return true;
+}
+
+//////////////////////////////// SbxFactory
+
+SbxFactory::~SbxFactory()
+{
+}
+
+SbxBase* SbxFactory::Create( sal_uInt16, sal_uInt32 )
+{
+ return nullptr;
+}
+
+SbxObject* SbxFactory::CreateObject( const OUString& )
+{
+ return nullptr;
+}
+
+///////////////////////////////// SbxInfo
+
+SbxInfo::~SbxInfo()
+{}
+
+void SbxInfo::AddParam(const OUString& rName, SbxDataType eType, SbxFlagBits nFlags)
+{
+ m_Params.push_back(std::make_unique<SbxParamInfo>(rName, eType, nFlags));
+}
+
+const SbxParamInfo* SbxInfo::GetParam( sal_uInt16 n ) const
+{
+ if (n < 1 || n > m_Params.size())
+ return nullptr;
+ else
+ return m_Params[n - 1].get();
+}
+
+void SbxInfo::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ m_Params.clear();
+ sal_uInt16 nParam;
+ aComment = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ aHelpFile = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ rStrm.ReadUInt32( nHelpId ).ReadUInt16( nParam );
+ while( nParam-- )
+ {
+ sal_uInt16 nType, nFlagsTmp;
+ sal_uInt32 nUserData = 0;
+ OUString aName = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ rStrm.ReadUInt16( nType ).ReadUInt16( nFlagsTmp );
+ SbxFlagBits nFlags = static_cast<SbxFlagBits>(nFlagsTmp);
+ if( nVer > 1 )
+ rStrm.ReadUInt32( nUserData );
+ AddParam( aName, static_cast<SbxDataType>(nType), nFlags );
+ SbxParamInfo& p(*m_Params.back());
+ p.nUserData = nUserData;
+ }
+}
+
+void SbxInfo::StoreData( SvStream& rStrm ) const
+{
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, aComment,
+ RTL_TEXTENCODING_ASCII_US );
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, aHelpFile,
+ RTL_TEXTENCODING_ASCII_US);
+ rStrm.WriteUInt32( nHelpId ).WriteUInt16( m_Params.size() );
+ for (auto const& i : m_Params)
+ {
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, i->aName,
+ RTL_TEXTENCODING_ASCII_US);
+ rStrm.WriteUInt16( i->eType )
+ .WriteUInt16( static_cast<sal_uInt16>(i->nFlags) )
+ .WriteUInt32( i->nUserData );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxbool.cxx b/basic/source/sbx/sbxbool.cxx
new file mode 100644
index 000000000..723939fb0
--- /dev/null
+++ b/basic/source/sbx/sbxbool.cxx
@@ -0,0 +1,221 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <vcl/errcode.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+#include "sbxres.hxx"
+
+enum SbxBOOL ImpGetBool( const SbxValues* p )
+{
+ enum SbxBOOL nRes;
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = SbxFALSE; break;
+ case SbxCHAR:
+ nRes = p->nChar ? SbxTRUE : SbxFALSE; break;
+ case SbxBYTE:
+ nRes = p->nByte ? SbxTRUE : SbxFALSE; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger ? SbxTRUE : SbxFALSE; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort ? SbxTRUE : SbxFALSE; break;
+ case SbxLONG:
+ nRes = p->nLong ? SbxTRUE : SbxFALSE; break;
+ case SbxULONG:
+ nRes = p->nULong ? SbxTRUE : SbxFALSE; break;
+ case SbxSINGLE:
+ nRes = p->nSingle ? SbxTRUE : SbxFALSE; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ nRes = p->nDouble ? SbxTRUE : SbxFALSE; break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double dVal = 0.0;
+ if( p->pDecimal )
+ p->pDecimal->getDouble( dVal );
+ nRes = dVal ? SbxTRUE : SbxFALSE;
+ }
+ break;
+ case SbxSALINT64:
+ case SbxCURRENCY:
+ nRes = p->nInt64 ? SbxTRUE : SbxFALSE; break;
+ case SbxSALUINT64:
+ nRes = p->uInt64 ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ nRes = SbxFALSE;
+ if ( p->pOUString )
+ {
+ if( p->pOUString->equalsIgnoreAsciiCase( GetSbxRes( StringId::True ) ) )
+ nRes = SbxTRUE;
+ else if( !p->pOUString->equalsIgnoreAsciiCase( GetSbxRes( StringId::False ) ) )
+ {
+ // it can be convertible to a number
+ bool bError = true;
+ double n;
+ SbxDataType t;
+ sal_uInt16 nLen = 0;
+ if( ImpScan( *p->pOUString, n, t, &nLen, true ) == ERRCODE_NONE )
+ {
+ if( nLen == p->pOUString->getLength() )
+ {
+ bError = false;
+ if( n != 0.0 )
+ nRes = SbxTRUE;
+ }
+ }
+ if( bError )
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetBool() ? SbxTRUE : SbxFALSE;
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = SbxFALSE;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxLONG:
+ nRes = *p->pLong ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxULONG:
+ nRes = *p->pULong ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ nRes = *p->pUShort ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxSINGLE:
+ nRes = ( *p->pSingle != 0 ) ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ nRes = ( *p->pDouble != 0 ) ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ nRes = ( *p->pnInt64 ) ? SbxTRUE : SbxFALSE; break;
+ case SbxBYREF | SbxSALUINT64:
+ nRes = ( *p->puInt64 ) ? SbxTRUE : SbxFALSE; break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = SbxFALSE;
+ }
+ return nRes;
+}
+
+void ImpPutBool( SbxValues* p, sal_Int16 n )
+{
+ if( n )
+ n = SbxTRUE;
+ switch( +p->eType )
+ {
+ case SbxCHAR:
+ p->nChar = static_cast<sal_Unicode>(n); break;
+ case SbxUINT:
+ p->nByte = static_cast<sal_uInt8>(n); break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ p->nInteger = n; break;
+ case SbxLONG:
+ p->nLong = n; break;
+ case SbxULONG:
+ p->nULong = static_cast<sal_uInt32>(n); break;
+ case SbxERROR:
+ case SbxUSHORT:
+ p->nUShort = static_cast<sal_uInt16>(n); break;
+ case SbxSINGLE:
+ p->nSingle = n; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ p->nInt64 = static_cast<sal_Int64>(n); break;
+ case SbxSALUINT64:
+ p->uInt64 = static_cast<sal_uInt64>(n); break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ ImpCreateDecimal( p )->setInt( n );
+ break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if ( !p->pOUString )
+ p->pOUString = new OUString( GetSbxRes( n ? StringId::True : StringId::False ) );
+ else
+ *p->pOUString = GetSbxRes( n ? StringId::True : StringId::False );
+ break;
+
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutBool( n != 0 );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ *p->pInteger = n; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ *p->pLong = n; break;
+ case SbxBYREF | SbxULONG:
+ *p->pULong = static_cast<sal_uInt32>(n); break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = n; break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = n; break;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = static_cast<sal_Int64>(n); break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = static_cast<sal_uInt64>(n); break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxbyte.cxx b/basic/source/sbx/sbxbyte.cxx
new file mode 100644
index 000000000..4974213dc
--- /dev/null
+++ b/basic/source/sbx/sbxbyte.cxx
@@ -0,0 +1,312 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#include <o3tl/safeint.hxx>
+#include <vcl/errcode.hxx>
+//#include <basic/sbx.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+#include <rtl/math.hxx>
+
+sal_uInt8 ImpGetByte( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_uInt8 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ if( p->nChar > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(p->nChar);
+ break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ if( p->nInteger > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else if( p->nInteger < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(p->nInteger);
+ break;
+ case SbxERROR:
+ case SbxUSHORT:
+ if( p->nUShort > o3tl::make_unsigned(SbxMAXBYTE) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(p->nUShort);
+ break;
+ case SbxLONG:
+ if( p->nLong > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else if( p->nLong < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(p->nLong);
+ break;
+ case SbxULONG:
+ if( p->nULong > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(p->nULong);
+ break;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ {
+ sal_Int64 val = p->nInt64;
+ if ( p->eType == SbxCURRENCY )
+ val = val / CURRENCY_FACTOR;
+ if( val > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else if( p->nInt64 < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(val);
+ break;
+ }
+ case SbxSALUINT64:
+ if( p->uInt64 > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(p->uInt64);
+ break;
+ case SbxSINGLE:
+ if( p->nSingle > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else if( p->nSingle < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(rtl::math::round( p->nSingle ));
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double dVal;
+ if( p->eType == SbxDECIMAL )
+ {
+ dVal = 0.0;
+ if( p->pDecimal )
+ p->pDecimal->getDouble( dVal );
+ }
+ else
+ dVal = p->nDouble;
+
+ if( dVal > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else if( dVal < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(rtl::math::round( dVal ));
+ break;
+ }
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( d > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXBYTE;
+ }
+ else if( d < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt8>( d + 0.5 );
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetByte();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxBYTE:
+ nRes = p->nByte; break;
+
+ // from here on will be tested
+ case SbxBYREF | SbxCHAR:
+ aTmp.nChar = *p->pChar; goto ref;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ aTmp.nInteger = *p->pInteger; goto ref;
+ case SbxBYREF | SbxLONG:
+ aTmp.nLong = *p->pLong; goto ref;
+ case SbxBYREF | SbxULONG:
+ aTmp.nULong = *p->pULong; goto ref;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ aTmp.nUShort = *p->pUShort; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutByte( SbxValues* p, sal_uInt8 n )
+{
+ switch( +p->eType )
+ {
+ case SbxBYTE:
+ p->nByte = n; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ p->nInteger = n; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ p->nUShort = n; break;
+ case SbxLONG:
+ p->nLong = n; break;
+ case SbxULONG:
+ p->nULong = n; break;
+ case SbxSINGLE:
+ p->nSingle = n; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+ case SbxCURRENCY:
+ p->nInt64 = n * CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ p->nInt64 = n; break;
+ case SbxSALUINT64:
+ p->uInt64 = n; break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ ImpCreateDecimal( p )->setByte( n );
+ break;
+
+ case SbxCHAR:
+ p->nChar = static_cast<sal_Unicode>(n); break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ ImpCvtNum( static_cast<double>(n), 0, *p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutByte( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ *p->pByte = n; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ *p->pInteger = n; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ *p->pUShort = n; break;
+ case SbxBYREF | SbxLONG:
+ *p->pLong = n; break;
+ case SbxBYREF | SbxULONG:
+ *p->pULong = n; break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = n; break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = n; break;
+ case SbxBYREF | SbxCURRENCY:
+ p->nInt64 = n * CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = n; break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = n; break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxchar.cxx b/basic/source/sbx/sbxchar.cxx
new file mode 100644
index 000000000..d25ccc083
--- /dev/null
+++ b/basic/source/sbx/sbxchar.cxx
@@ -0,0 +1,300 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <vcl/errcode.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+#include <rtl/math.hxx>
+
+sal_Unicode ImpGetChar( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_Unicode nRes = 0;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar; break;
+ case SbxBYTE:
+ nRes = static_cast<sal_Unicode>(p->nByte);
+ break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ if( p->nInteger < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINCHAR;
+ }
+ else
+ nRes = static_cast<sal_Unicode>(p->nInteger);
+ break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = static_cast<sal_Unicode>(p->nUShort);
+ break;
+ case SbxLONG:
+ if( p->nLong > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXCHAR;
+ }
+ else if( p->nLong < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINCHAR;
+ }
+ else
+ nRes = static_cast<sal_Unicode>(p->nLong);
+ break;
+ case SbxULONG:
+ if( p->nULong > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXCHAR;
+ }
+ else
+ nRes = static_cast<sal_Unicode>(p->nULong);
+ break;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ {
+ sal_Int64 val = p->nInt64;
+
+ if ( p->eType == SbxCURRENCY )
+ val = val / CURRENCY_FACTOR;
+
+ if( val > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXCHAR;
+ }
+ else if( p->nInt64 < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINCHAR;
+ }
+ else
+ nRes = static_cast<sal_Unicode>(val);
+ break;
+ }
+ case SbxSALUINT64:
+ if( p->uInt64 > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXCHAR;
+ }
+ else
+ nRes = static_cast<sal_Unicode>(p->uInt64);
+ break;
+ case SbxSINGLE:
+ if( p->nSingle > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXCHAR;
+ }
+ else if( p->nSingle < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINCHAR;
+ }
+ else
+ nRes = static_cast<sal_Unicode>(rtl::math::round( p->nSingle ));
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double dVal;
+ if( p->eType == SbxDECIMAL )
+ {
+ dVal = 0.0;
+ if( p->pDecimal )
+ p->pDecimal->getDouble( dVal );
+ }
+ else
+ dVal = p->nDouble;
+
+ if( dVal > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXCHAR;
+ }
+ else if( dVal < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINCHAR;
+ }
+ else
+ nRes = static_cast<sal_uInt8>(rtl::math::round( dVal ));
+ break;
+ }
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if ( p->pOUString )
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( d > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXCHAR;
+ }
+ else if( d < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINCHAR;
+ }
+ else
+ nRes = static_cast<sal_Unicode>(rtl::math::round( d ));
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetChar();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar; break;
+ // from here on will be tested
+ case SbxBYREF | SbxBYTE:
+ aTmp.nByte = *p->pByte; goto ref;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ aTmp.nInteger = *p->pInteger; goto ref;
+ case SbxBYREF | SbxLONG:
+ aTmp.nLong = *p->pLong; goto ref;
+ case SbxBYREF | SbxULONG:
+ aTmp.nULong = *p->pULong; goto ref;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ aTmp.nUShort = *p->pUShort; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutChar( SbxValues* p, sal_Unicode n )
+{
+ SbxValues aTmp;
+start:
+ switch( +p->eType )
+ {
+ case SbxCHAR:
+ p->nChar = n; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ p->nInteger = n; break;
+ case SbxLONG:
+ p->nLong = n; break;
+ case SbxSINGLE:
+ p->nSingle = n; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+ case SbxCURRENCY:
+ p->nInt64 = n * CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ p->nInt64 = n; break;
+ case SbxSALUINT64:
+ p->uInt64 = n; break;
+ case SbxBYREF | SbxDECIMAL:
+ ImpCreateDecimal( p )->setChar( n );
+ break;
+
+ // from here on will be tested
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if ( !p->pOUString )
+ p->pOUString = new OUString( n );
+ else
+ *p->pOUString = OUString( n );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutChar( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ *p->pChar = n; break;
+ case SbxBYREF | SbxBYTE:
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ *p->pInteger = n; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ *p->pLong = static_cast<sal_Int32>(n); break;
+ case SbxBYREF | SbxULONG:
+ *p->pULong = static_cast<sal_uInt32>(n); break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = static_cast<float>(n); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = static_cast<double>(n); break;
+ case SbxBYREF | SbxCURRENCY:
+ p->nInt64 = n * CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = n; break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = n; break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxcoll.cxx b/basic/source/sbx/sbxcoll.cxx
new file mode 100644
index 000000000..7c186b476
--- /dev/null
+++ b/basic/source/sbx/sbxcoll.cxx
@@ -0,0 +1,307 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <tools/stream.hxx>
+
+#include <basic/sbx.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxres.hxx"
+
+
+static OUString pCount;
+static OUString pAdd;
+static OUString pItem;
+static OUString pRemove;
+static sal_uInt16 nCountHash = 0, nAddHash, nItemHash, nRemoveHash;
+
+
+SbxCollection::SbxCollection()
+ : SbxObject( "" )
+{
+ if( !nCountHash )
+ {
+ pCount = GetSbxRes( StringId::CountProp );
+ pAdd = GetSbxRes( StringId::AddMeth );
+ pItem = GetSbxRes( StringId::ItemMeth );
+ pRemove = GetSbxRes( StringId::RemoveMeth );
+ nCountHash = MakeHashCode( pCount );
+ nAddHash = MakeHashCode( pAdd );
+ nItemHash = MakeHashCode( pItem );
+ nRemoveHash = MakeHashCode( pRemove );
+ }
+ Initialize();
+ // For Access on itself
+ StartListening(GetBroadcaster(), DuplicateHandling::Prevent);
+}
+
+SbxCollection::SbxCollection( const SbxCollection& rColl )
+ : SvRefBase( rColl ), SbxObject( rColl )
+{}
+
+SbxCollection& SbxCollection::operator=( const SbxCollection& r )
+{
+ if( &r != this )
+ SbxObject::operator=( r );
+ return *this;
+}
+
+SbxCollection::~SbxCollection()
+{}
+
+void SbxCollection::Clear()
+{
+ SbxObject::Clear();
+ Initialize();
+}
+
+void SbxCollection::Initialize()
+{
+ SetType( SbxOBJECT );
+ SetFlag( SbxFlagBits::Fixed );
+ ResetFlag( SbxFlagBits::Write );
+ SbxVariable* p;
+ p = Make( pCount , SbxClassType::Property, SbxINTEGER );
+ p->ResetFlag( SbxFlagBits::Write );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p = Make( pAdd, SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p = Make( pItem , SbxClassType::Method, SbxOBJECT );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p = Make( pRemove, SbxClassType::Method, SbxEMPTY );
+ p->SetFlag( SbxFlagBits::DontStore );
+}
+
+SbxVariable* SbxCollection::Find( const OUString& rName, SbxClassType t )
+{
+ if( GetParameters() )
+ {
+ SbxObject* pObj = static_cast<SbxObject*>(GetObject());
+ return pObj ? pObj->Find( rName, t ) : nullptr;
+ }
+ else
+ {
+ return SbxObject::Find( rName, t );
+ }
+}
+
+void SbxCollection::Notify( SfxBroadcaster& rCst, const SfxHint& rHint )
+{
+ const SbxHint* p = dynamic_cast<const SbxHint*>(&rHint);
+ if( p )
+ {
+ const SfxHintId nId = p->GetId();
+ bool bRead = ( nId == SfxHintId::BasicDataWanted );
+ bool bWrite = ( nId == SfxHintId::BasicDataChanged );
+ SbxVariable* pVar = p->GetVar();
+ SbxArray* pArg = pVar->GetParameters();
+ if( bRead || bWrite )
+ {
+ OUString aVarName( pVar->GetName() );
+ if( pVar == this )
+ {
+ CollItem( pArg );
+ }
+ else if( pVar->GetHashCode() == nCountHash
+ && aVarName.equalsIgnoreAsciiCase( pCount ) )
+ {
+ pVar->PutLong( sal::static_int_cast<sal_Int32>(pObjs->Count32()) );
+ }
+ else if( pVar->GetHashCode() == nAddHash
+ && aVarName.equalsIgnoreAsciiCase( pAdd ) )
+ {
+ CollAdd( pArg );
+ }
+ else if( pVar->GetHashCode() == nItemHash
+ && aVarName.equalsIgnoreAsciiCase( pItem ) )
+ {
+ CollItem( pArg );
+ }
+ else if( pVar->GetHashCode() == nRemoveHash
+ && aVarName.equalsIgnoreAsciiCase( pRemove ) )
+ {
+ CollRemove( pArg );
+ }
+ else
+ {
+ SbxObject::Notify( rCst, rHint );
+ }
+ return;
+ }
+ }
+ SbxObject::Notify( rCst, rHint );
+}
+
+// Default: argument is object
+
+void SbxCollection::CollAdd( SbxArray* pPar_ )
+{
+ if( pPar_->Count32() != 2 )
+ {
+ SetError( ERRCODE_BASIC_WRONG_ARGS );
+ }
+ else
+ {
+ SbxBase* pObj = pPar_->Get32( 1 )->GetObject();
+ if( !pObj || dynamic_cast<const SbxObject*>(pObj) == nullptr )
+ {
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ else
+ {
+ Insert( static_cast<SbxObject*>(pObj) );
+ }
+ }
+}
+
+// Default: index from 1 or object name
+
+void SbxCollection::CollItem( SbxArray* pPar_ )
+{
+ if( pPar_->Count32() != 2 )
+ {
+ SetError( ERRCODE_BASIC_WRONG_ARGS );
+ }
+ else
+ {
+ SbxVariable* pRes = nullptr;
+ SbxVariable* p = pPar_->Get32( 1 );
+ if( p->GetType() == SbxSTRING )
+ {
+ pRes = Find( p->GetOUString(), SbxClassType::Object );
+ }
+ else
+ {
+ short n = p->GetInteger();
+ if( n >= 1 && n <= static_cast<sal_Int32>(pObjs->Count32()) )
+ {
+ pRes = pObjs->Get32( static_cast<sal_uInt32>(n) - 1 );
+ }
+ }
+ if( !pRes )
+ {
+ SetError( ERRCODE_BASIC_BAD_INDEX );
+ }
+ pPar_->Get32( 0 )->PutObject( pRes );
+ }
+}
+
+// Default: index from 1
+
+void SbxCollection::CollRemove( SbxArray* pPar_ )
+{
+ if( pPar_->Count32() != 2 )
+ SetError( ERRCODE_BASIC_WRONG_ARGS );
+ else
+ {
+ short n = pPar_->Get32( 1 )->GetInteger();
+ if( n < 1 || n > static_cast<sal_Int32>(pObjs->Count32()) )
+ SetError( ERRCODE_BASIC_BAD_INDEX );
+ else
+ Remove( pObjs->Get32( static_cast<sal_uInt32>(n) - 1 ) );
+ }
+}
+
+bool SbxCollection::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ bool bRes = SbxObject::LoadData( rStrm, nVer );
+ Initialize();
+ return bRes;
+}
+
+
+SbxStdCollection::SbxStdCollection()
+ : bAddRemoveOk( true )
+{}
+
+SbxStdCollection::SbxStdCollection( const SbxStdCollection& r )
+ : SvRefBase( r ), SbxCollection( r ),
+ aElemClass( r.aElemClass ), bAddRemoveOk( r.bAddRemoveOk )
+{}
+
+SbxStdCollection& SbxStdCollection::operator=( const SbxStdCollection& r )
+{
+ if( &r != this )
+ {
+ if( !r.aElemClass.equalsIgnoreAsciiCase( aElemClass ) )
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ }
+ else
+ {
+ SbxCollection::operator=( r );
+ }
+ }
+ return *this;
+}
+
+SbxStdCollection::~SbxStdCollection()
+{}
+
+// Default: Error, if wrong object
+
+void SbxStdCollection::Insert( SbxVariable* p )
+{
+ SbxObject* pObj = dynamic_cast<SbxObject*>( p );
+ if( pObj && !pObj->IsClass( aElemClass ) )
+ SetError( ERRCODE_BASIC_BAD_ACTION );
+ else
+ SbxCollection::Insert( p );
+}
+
+void SbxStdCollection::CollAdd( SbxArray* pPar_ )
+{
+ if( !bAddRemoveOk )
+ SetError( ERRCODE_BASIC_BAD_ACTION );
+ else
+ SbxCollection::CollAdd( pPar_ );
+}
+
+void SbxStdCollection::CollRemove( SbxArray* pPar_ )
+{
+ if( !bAddRemoveOk )
+ SetError( ERRCODE_BASIC_BAD_ACTION );
+ else
+ SbxCollection::CollRemove( pPar_ );
+}
+
+bool SbxStdCollection::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ bool bRes = SbxCollection::LoadData( rStrm, nVer );
+ if( bRes )
+ {
+ aElemClass = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ rStrm.ReadCharAsBool( bAddRemoveOk );
+ }
+ return bRes;
+}
+
+bool SbxStdCollection::StoreData( SvStream& rStrm ) const
+{
+ bool bRes = SbxCollection::StoreData( rStrm );
+ if( bRes )
+ {
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, aElemClass,
+ RTL_TEXTENCODING_ASCII_US);
+ rStrm.WriteBool( bAddRemoveOk );
+ }
+ return bRes;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxconv.hxx b/basic/source/sbx/sbxconv.hxx
new file mode 100644
index 000000000..e053e7e02
--- /dev/null
+++ b/basic/source/sbx/sbxconv.hxx
@@ -0,0 +1,132 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#ifndef INCLUDED_BASIC_SOURCE_SBX_SBXCONV_HXX
+#define INCLUDED_BASIC_SOURCE_SBX_SBXCONV_HXX
+
+#include "sbxdec.hxx"
+#include <basic/sbx.hxx>
+
+class SbxArray;
+
+// SBXSCAN.CXX
+extern void ImpCvtNum( double nNum, short nPrec, OUString& rRes, bool bCoreString=false );
+extern ErrCode ImpScan
+ ( const OUString& rSrc, double& nVal, SbxDataType& rType, sal_uInt16* pLen,
+ bool bOnlyIntntl );
+
+// with advanced evaluation (International, "TRUE"/"FALSE")
+extern bool ImpConvStringExt( OUString& rSrc, SbxDataType eTargetType );
+
+void ImpGetIntntlSep( sal_Unicode& rcDecimalSep, sal_Unicode& rcThousandSep, sal_Unicode& rcDecimalSepAlt );
+
+// SBXINT.CXX
+
+sal_Int16 ImpGetInteger( const SbxValues* );
+void ImpPutInteger( SbxValues*, sal_Int16 );
+
+sal_Int64 ImpGetInt64( const SbxValues* );
+void ImpPutInt64( SbxValues*, sal_Int64 );
+sal_uInt64 ImpGetUInt64( const SbxValues* );
+void ImpPutUInt64( SbxValues*, sal_uInt64 );
+
+sal_Int64 ImpDoubleToSalInt64 ( double d );
+sal_uInt64 ImpDoubleToSalUInt64( double d );
+double ImpSalUInt64ToDouble( sal_uInt64 n );
+
+// SBXLNG.CXX
+
+sal_Int32 ImpGetLong( const SbxValues* );
+void ImpPutLong( SbxValues*, sal_Int32 );
+
+// SBXSNG.CXX
+
+float ImpGetSingle( const SbxValues* );
+void ImpPutSingle( SbxValues*, float );
+
+// SBXDBL.CXX
+
+double ImpGetDouble( const SbxValues* );
+void ImpPutDouble( SbxValues*, double, bool bCoreString=false );
+
+// SBXCURR.CXX
+
+sal_Int64 ImpGetCurrency( const SbxValues* );
+void ImpPutCurrency( SbxValues*, const sal_Int64 );
+
+inline sal_Int64 ImpDoubleToCurrency( double d )
+{
+ if (d > 0)
+ return static_cast<sal_Int64>( d * CURRENCY_FACTOR + 0.5);
+ else
+ return static_cast<sal_Int64>( d * CURRENCY_FACTOR - 0.5);
+}
+
+inline double ImpCurrencyToDouble( const sal_Int64 r )
+ { return static_cast<double>(r) / double(CURRENCY_FACTOR); }
+
+
+// SBXDEC.CXX
+
+SbxDecimal* ImpCreateDecimal( SbxValues* p );
+SbxDecimal* ImpGetDecimal( const SbxValues* p );
+void ImpPutDecimal( SbxValues* p, SbxDecimal* pDec );
+
+// SBXDATE.CXX
+
+double ImpGetDate( const SbxValues* );
+void ImpPutDate( SbxValues*, double );
+
+// SBXSTR.CXX
+
+OUString ImpGetString( const SbxValues* );
+OUString ImpGetCoreString( const SbxValues* );
+void ImpPutString( SbxValues*, const OUString* );
+
+// SBXCHAR.CXX
+
+sal_Unicode ImpGetChar( const SbxValues* );
+void ImpPutChar( SbxValues*, sal_Unicode );
+
+// SBXBYTE.CXX
+sal_uInt8 ImpGetByte( const SbxValues* );
+void ImpPutByte( SbxValues*, sal_uInt8 );
+
+// SBXUINT.CXX
+
+sal_uInt16 ImpGetUShort( const SbxValues* );
+void ImpPutUShort( SbxValues*, sal_uInt16 );
+
+// SBXULNG.CXX
+
+sal_uInt32 ImpGetULong( const SbxValues* );
+void ImpPutULong( SbxValues*, sal_uInt32 );
+
+// SBXBOOL.CXX
+
+enum SbxBOOL ImpGetBool( const SbxValues* );
+void ImpPutBool( SbxValues*, sal_Int16 );
+
+// ByteArray <--> String
+SbxArray* StringToByteArray(const OUString& rStr);
+OUString ByteArrayToString(SbxArray* pArr);
+
+#endif
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxcurr.cxx b/basic/source/sbx/sbxcurr.cxx
new file mode 100644
index 000000000..50b530cda
--- /dev/null
+++ b/basic/source/sbx/sbxcurr.cxx
@@ -0,0 +1,486 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <rtl/ustrbuf.hxx>
+
+#include <basic/sberrors.hxx>
+#include <basic/sbxvar.hxx>
+#include "sbxconv.hxx"
+
+
+static OUString ImpCurrencyToString( sal_Int64 rVal )
+{
+ bool isNeg = ( rVal < 0 );
+ sal_Int64 absVal = isNeg ? -rVal : rVal;
+
+ sal_Unicode const cDecimalSep = '.';
+
+ OUString aAbsStr = OUString::number( absVal );
+
+ sal_Int32 initialLen = aAbsStr.getLength();
+
+ bool bLessThanOne = false;
+ if ( initialLen <= 4 ) // if less the 1
+ bLessThanOne = true;
+
+ sal_Int32 nCapacity = 6; // minimum e.g. 0.0000
+
+ if ( !bLessThanOne )
+ {
+ nCapacity = initialLen + 1;
+ }
+
+ if ( isNeg )
+ ++nCapacity;
+
+ OUStringBuffer aBuf( nCapacity );
+ aBuf.setLength( nCapacity );
+
+
+ sal_Int32 nDigitCount = 0;
+ sal_Int32 nInsertIndex = nCapacity - 1;
+ sal_Int32 nEndIndex = isNeg ? 1 : 0;
+
+ for ( sal_Int32 charCpyIndex = aAbsStr.getLength() - 1; nInsertIndex >= nEndIndex; ++nDigitCount )
+ {
+ if ( nDigitCount == 4 )
+ aBuf[nInsertIndex--] = cDecimalSep;
+ if ( nDigitCount < initialLen )
+ aBuf[nInsertIndex--] = aAbsStr[ charCpyIndex-- ];
+ else
+ // Handle leading 0's to right of decimal point
+ // Note: in VBA the stringification is a little more complex
+ // but more natural as only the necessary digits
+ // to the right of the decimal places are displayed
+ // It would be great to conditionally be able to display like that too
+
+ // Val OOo (Cur) VBA (Cur)
+ // --- --------- ---------
+ // 0 0.0000 0
+ // 0.1 0.1000 0.1
+
+ aBuf[nInsertIndex--] = '0';
+ }
+ if ( isNeg )
+ aBuf[nInsertIndex] = '-';
+
+ aAbsStr = aBuf.makeStringAndClear();
+ return aAbsStr;
+}
+
+
+static sal_Int64 ImpStringToCurrency( const OUString &rStr )
+{
+
+ sal_Int32 nFractDigit = 4;
+
+ sal_Unicode const cDeciPnt = '.';
+ sal_Unicode const c1000Sep = ',';
+
+ // lets use the existing string number conversions
+ // there is a performance impact here ( multiple string copies )
+ // but better I think than a home brewed string parser, if we need a parser
+ // we should share some existing ( possibly from calc is there a currency
+ // conversion there ? #TODO check )
+
+ OUString sTmp( rStr.trim() );
+ const sal_Unicode* p = sTmp.getStr();
+
+ // normalise string number by removing thousand & decimal point separators
+ OUStringBuffer sNormalisedNumString( sTmp.getLength() + nFractDigit );
+
+ if ( *p == '-' || *p == '+' )
+ sNormalisedNumString.append( *p );
+
+ while ( *p >= '0' && *p <= '9' )
+ {
+ sNormalisedNumString.append( *p++ );
+ // #TODO in vba mode set runtime error when a space ( or other )
+ // illegal character is found
+ if( *p == c1000Sep )
+ p++;
+ }
+
+ bool bRoundUp = false;
+
+ if( *p == cDeciPnt )
+ {
+ p++;
+ while( nFractDigit && *p >= '0' && *p <= '9' )
+ {
+ sNormalisedNumString.append( *p++ );
+ nFractDigit--;
+ }
+ // Consume trailing content
+ if ( p != nullptr )
+ {
+ // Round up if necessary
+ if( *p >= '5' && *p <= '9' )
+ bRoundUp = true;
+ while( *p >= '0' && *p <= '9' )
+ p++;
+ }
+
+ }
+ // can we raise error here ? ( previous behaviour was more forgiving )
+ // so... not sure that could break existing code, let's see if anyone
+ // complains.
+
+ if ( p != sTmp.getStr() + sTmp.getLength() )
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ while( nFractDigit )
+ {
+ sNormalisedNumString.append( '0' );
+ nFractDigit--;
+ }
+
+ sal_Int64 result = sNormalisedNumString.makeStringAndClear().toInt64();
+
+ if ( bRoundUp )
+ ++result;
+ return result;
+}
+
+
+sal_Int64 ImpGetCurrency( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_Int64 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxERROR:
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ nRes = 0; break;
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCURRENCY:
+ nRes = p->nInt64; break;
+ case SbxBYTE:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(p->nByte);
+ break;
+ case SbxCHAR:
+ nRes = sal_Int64(CURRENCY_FACTOR) * reinterpret_cast<sal_Int64>(p->pChar);
+ break;
+ case SbxBOOL:
+ case SbxINTEGER:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(p->nInteger);
+ break;
+ case SbxUSHORT:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(p->nUShort);
+ break;
+ case SbxLONG:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(p->nLong);
+ break;
+ case SbxULONG:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(p->nULong);
+ break;
+
+ case SbxSALINT64:
+ {
+ nRes = p->nInt64 * CURRENCY_FACTOR; break;
+#if 0
+ // Huh, is the 'break' above intentional? That means this
+ // is unreachable, obviously. Avoid warning by ifdeffing
+ // this out for now. Do not delete this #if 0 block unless
+ // you know for sure the 'break' above is intentional.
+ if ( nRes > SAL_MAX_INT64 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MAX_INT64;
+ }
+#endif
+ }
+ case SbxSALUINT64:
+ nRes = p->nInt64 * CURRENCY_FACTOR; break;
+#if 0
+ // As above
+ if ( nRes > SAL_MAX_INT64 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MAX_INT64;
+ }
+ else if ( nRes < SAL_MIN_INT64 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MIN_INT64;
+ }
+ break;
+#endif
+//TODO: bring back SbxINT64 types here for limits -1 with flag value at SAL_MAX/MIN
+ case SbxSINGLE:
+ if( p->nSingle * CURRENCY_FACTOR + 0.5 > float(SAL_MAX_INT64)
+ || p->nSingle * CURRENCY_FACTOR - 0.5 < float(SAL_MIN_INT64) )
+ {
+ nRes = SAL_MAX_INT64;
+ if( p->nSingle * CURRENCY_FACTOR - 0.5 < float(SAL_MIN_INT64) )
+ nRes = SAL_MIN_INT64;
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ nRes = ImpDoubleToCurrency( static_cast<double>(p->nSingle) );
+ break;
+
+ case SbxDATE:
+ case SbxDOUBLE:
+ if( p->nDouble * CURRENCY_FACTOR + 0.5 > double(SAL_MAX_INT64)
+ || p->nDouble * CURRENCY_FACTOR - 0.5 < double(SAL_MIN_INT64) )
+ {
+ nRes = SAL_MAX_INT64;
+ if( p->nDouble * CURRENCY_FACTOR - 0.5 < double(SAL_MIN_INT64) )
+ nRes = SAL_MIN_INT64;
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ nRes = ImpDoubleToCurrency( p->nDouble );
+ break;
+
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double d = 0.0;
+ if( p->pDecimal )
+ p->pDecimal->getDouble( d );
+ nRes = ImpDoubleToCurrency( d );
+ break;
+ }
+
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes=0;
+ else
+ nRes = ImpStringToCurrency( *p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetCurrency();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ nRes=0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(*p->pChar);
+ break;
+ case SbxBYREF | SbxBYTE:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(*p->pByte);
+ break;
+ case SbxBYREF | SbxBOOL:
+ case SbxBYREF | SbxINTEGER:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(*p->pInteger);
+ break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ nRes = sal_Int64(CURRENCY_FACTOR) * static_cast<sal_Int64>(*p->pUShort);
+ break;
+
+ // from here on had to be tested
+ case SbxBYREF | SbxLONG:
+ aTmp.nLong = *p->pLong; goto ref;
+ case SbxBYREF | SbxULONG:
+ aTmp.nULong = *p->pULong; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & ~SbxBYREF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ nRes=0;
+ }
+ return nRes;
+}
+
+
+void ImpPutCurrency( SbxValues* p, const sal_Int64 r )
+{
+ SbxValues aTmp;
+start:
+ switch( +p->eType )
+ {
+ // Here are tests necessary
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxLONG:
+ aTmp.pLong = &p->nLong; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ // from here no longer
+ case SbxSINGLE:
+ p->nSingle = static_cast<float>( r / CURRENCY_FACTOR ); break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = ImpCurrencyToDouble( r ); break;
+ case SbxSALUINT64:
+ p->uInt64 = r / CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ p->nInt64 = r / CURRENCY_FACTOR; break;
+
+ case SbxCURRENCY:
+ p->nInt64 = r; break;
+
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ SbxDecimal* pDec = ImpCreateDecimal( p );
+ if( !pDec->setDouble( ImpCurrencyToDouble( r ) / CURRENCY_FACTOR ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+
+ *p->pOUString = ImpCurrencyToString( r );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutCurrency( r );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ {
+ sal_Int64 val = r / CURRENCY_FACTOR;
+ if( val > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMAXCHAR;
+ }
+ else if( val < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMINCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(val); break;
+ }
+ case SbxBYREF | SbxBYTE:
+ {
+ sal_Int64 val = r / CURRENCY_FACTOR;
+ if( val > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMAXBYTE;
+ }
+ else if( val < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = 0;
+ }
+ *p->pByte = static_cast<sal_uInt8>(val); break;
+ }
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ {
+ sal_Int64 val = r / CURRENCY_FACTOR;
+ if( r > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMAXINT;
+ }
+ else if( r < SbxMININT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMININT;
+ }
+ *p->pInteger = static_cast<sal_uInt16>(val); break;
+ }
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ {
+ sal_Int64 val = r / CURRENCY_FACTOR;
+ if( val > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMAXUINT;
+ }
+ else if( val < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = 0;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(val); break;
+ }
+ case SbxBYREF | SbxLONG:
+ {
+ sal_Int64 val = r / CURRENCY_FACTOR;
+ if( val > SbxMAXLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMAXLNG;
+ }
+ else if( val < SbxMINLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMINLNG;
+ }
+ *p->pLong = static_cast<sal_Int32>(val); break;
+ }
+ case SbxBYREF | SbxULONG:
+ {
+ sal_Int64 val = r / CURRENCY_FACTOR;
+ if( val > SbxMAXULNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = SbxMAXULNG;
+ }
+ else if( val < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); val = 0;
+ }
+ *p->pULong = static_cast<sal_uInt32>(val); break;
+ }
+ case SbxBYREF | SbxCURRENCY:
+ *p->pnInt64 = r; break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = r / CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = static_cast<sal_uInt64>(r) / CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSINGLE:
+ p->nSingle = static_cast<float>( r / CURRENCY_FACTOR ); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = ImpCurrencyToDouble( r ); break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxdate.cxx b/basic/source/sbx/sbxdate.cxx
new file mode 100644
index 000000000..e716b57ee
--- /dev/null
+++ b/basic/source/sbx/sbxdate.cxx
@@ -0,0 +1,460 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <vcl/svapp.hxx>
+#include <vcl/settings.hxx>
+#include <svl/zforlist.hxx>
+#include <tools/color.hxx>
+#include <i18nlangtag/lang.h>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+#include <runtime.hxx>
+#include <sbintern.hxx>
+#include <math.h>
+#include <memory>
+#include <config_features.h>
+
+
+double ImpGetDate( const SbxValues* p )
+{
+ double nRes;
+ SbxValue* pVal;
+
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0;
+ break;
+ case SbxCHAR:
+ nRes = p->nChar;
+ break;
+ case SbxBYTE:
+ nRes = p->nByte;
+ break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger;
+ break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort;
+ break;
+ case SbxLONG:
+ nRes = static_cast<double>(p->nLong);
+ break;
+ case SbxULONG:
+ nRes = static_cast<double>(p->nULong);
+ break;
+ case SbxSINGLE:
+ nRes = p->nSingle;
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ nRes = p->nDouble;
+ break;
+ case SbxCURRENCY:
+ nRes = ImpCurrencyToDouble( p->nInt64 );
+ break;
+ case SbxSALINT64:
+ nRes = static_cast< double >(p->nInt64);
+ break;
+ case SbxSALUINT64:
+ nRes = ImpSalUInt64ToDouble( p->uInt64 );
+ break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ if( p->pDecimal )
+ {
+ p->pDecimal->getDouble( nRes );
+ }
+ else
+ {
+ nRes = 0.0;
+ }
+ break;
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+#if HAVE_FEATURE_SCRIPTING
+ if( !p->pOUString )
+ {
+ nRes = 0;
+ }
+ else
+ {
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ if (GetSbData()->pInst)
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ }
+ else
+ {
+ sal_uInt32 nDummy;
+ pFormatter = SbiInstance::PrepareNumberFormatter( nDummy, nDummy, nDummy );
+ }
+
+ sal_uInt32 nIndex;
+ sal_Int32 nCheckPos = 0;
+ SvNumFormatType nType = SvNumFormatType::DEFINED | SvNumFormatType::DATE | SvNumFormatType::TIME | SvNumFormatType::CURRENCY
+ | SvNumFormatType::NUMBER | SvNumFormatType::SCIENTIFIC | SvNumFormatType::FRACTION;
+
+ // Default templates of the formatter have only two-digit
+ // date. Therefore register an own format.
+
+ // HACK, because the number formatter in PutandConvertEntry replace the wildcard
+ // for month, day, year not according to the configuration.
+ // Problem: Print Year(Date) under Engl. OS
+ // quod vide basic/source/runtime/runtime.cxx
+
+ SvtSysLocale aSysLocale;
+ DateOrder eDate = aSysLocale.GetLocaleData().getDateOrder();
+ OUString aDateStr;
+ switch( eDate )
+ {
+ default:
+ case DateOrder::MDY: aDateStr = "MM/DD/YYYY"; break;
+ case DateOrder::DMY: aDateStr = "DD/MM/YYYY"; break;
+ case DateOrder::YMD: aDateStr = "YYYY/MM/DD"; break;
+ }
+
+ OUString aStr = aDateStr + " HH:MM:SS";
+
+ pFormatter->PutandConvertEntry( aStr, nCheckPos, nType,
+ nIndex, LANGUAGE_ENGLISH_US, eLangType, true);
+ bool bSuccess = pFormatter->IsNumberFormat( *p->pOUString, nIndex, nRes );
+ if ( bSuccess )
+ {
+ SvNumFormatType nType_ = pFormatter->GetType( nIndex );
+ if(!(nType_ & ( SvNumFormatType::DATETIME | SvNumFormatType::DATE |
+ SvNumFormatType::TIME | SvNumFormatType::DEFINED )))
+ {
+ bSuccess = false;
+ }
+ }
+
+ if ( !bSuccess )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ }
+#else
+ nRes = 0;
+#endif
+ break;
+ case SbxOBJECT:
+ pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ {
+ nRes = pVal->GetDate();
+ }
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar;
+ break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte;
+ break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger;
+ break;
+ case SbxBYREF | SbxLONG:
+ nRes = *p->pLong;
+ break;
+ case SbxBYREF | SbxULONG:
+ nRes = *p->pULong;
+ break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ nRes = *p->pUShort;
+ break;
+ case SbxBYREF | SbxSINGLE:
+ nRes = *p->pSingle;
+ break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ nRes = *p->pDouble;
+ break;
+ case SbxBYREF | SbxCURRENCY:
+ nRes = ImpCurrencyToDouble( *p->pnInt64 );
+ break;
+ case SbxBYREF | SbxSALINT64:
+ nRes = static_cast< double >(*p->pnInt64);
+ break;
+ case SbxBYREF | SbxSALUINT64:
+ nRes = ImpSalUInt64ToDouble( *p->puInt64 );
+ break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ break;
+ }
+ return nRes;
+}
+
+void ImpPutDate( SbxValues* p, double n )
+{
+ SbxValues aTmp;
+ SbxDecimal* pDec;
+ SbxValue* pVal;
+
+start:
+ switch( +p->eType )
+ {
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n;
+ break;
+ // from here will be tested
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar;
+ goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte;
+ goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger;
+ goto direct;
+ case SbxLONG:
+ aTmp.pLong = &p->nLong;
+ goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong;
+ goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort;
+ goto direct;
+ case SbxSINGLE:
+ aTmp.pSingle = &p->nSingle;
+ goto direct;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ aTmp.pnInt64 = &p->nInt64;
+ goto direct;
+ case SbxSALUINT64:
+ aTmp.puInt64 = &p->uInt64;
+ goto direct;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ pDec = ImpCreateDecimal( p );
+ if( !pDec->setDouble( n ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ }
+ break;
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ {
+#if HAVE_FEATURE_SCRIPTING
+ if( !p->pOUString )
+ {
+ p->pOUString = new OUString;
+ }
+ Color* pColor;
+
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ if (GetSbData()->pInst)
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ }
+ else
+ {
+ sal_uInt32 nDummy;
+ pFormatter = SbiInstance::PrepareNumberFormatter( nDummy, nDummy, nDummy );
+ }
+
+ sal_uInt32 nIndex;
+ sal_Int32 nCheckPos = 0;
+ SvNumFormatType nType;
+
+ SvtSysLocale aSysLocale;
+ DateOrder eDate = aSysLocale.GetLocaleData().getDateOrder();
+ OUString aStr;
+ // if the whole-number part is 0, we want no year!
+ if( n <= -1.0 || n >= 1.0 )
+ {
+ // Time only if != 00:00:00
+ if( rtl::math::approxEqual(floor( n ), n) )
+ {
+ switch( eDate )
+ {
+ default:
+ case DateOrder::MDY: aStr = "MM/DD/YYYY"; break;
+ case DateOrder::DMY: aStr = "DD/MM/YYYY"; break;
+ case DateOrder::YMD: aStr = "YYYY/MM/DD"; break;
+ }
+ }
+ else
+ {
+ switch( eDate )
+ {
+ default:
+ case DateOrder::MDY: aStr = "MM/DD/YYYY HH:MM:SS"; break;
+ case DateOrder::DMY: aStr = "DD/MM/YYYY HH:MM:SS"; break;
+ case DateOrder::YMD: aStr = "YYYY/MM/DD HH:MM:SS"; break;
+ }
+ }
+ }
+ else
+ {
+ aStr = "HH:MM:SS";
+ }
+ pFormatter->PutandConvertEntry( aStr,
+ nCheckPos,
+ nType,
+ nIndex,
+ LANGUAGE_ENGLISH_US,
+ eLangType, true);
+ pFormatter->GetOutputString( n, nIndex, *p->pOUString, &pColor );
+#endif
+ break;
+ }
+ case SbxOBJECT:
+ pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ {
+ pVal->PutDate( n );
+ }
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ }
+ break;
+ case SbxBYREF | SbxCHAR:
+ if( n > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCHAR;
+ }
+ else if( n < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(n);
+ break;
+ case SbxBYREF | SbxBYTE:
+ if( n > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n);
+ break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( n > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ else if( n < SbxMININT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMININT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n);
+ break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( n > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXUINT;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n);
+ break;
+ case SbxBYREF | SbxLONG:
+ if( n > SbxMAXLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXLNG;
+ }
+ else if( n < SbxMINLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINLNG;
+ }
+ *p->pLong = static_cast<sal_Int32>(n);
+ break;
+ case SbxBYREF | SbxULONG:
+ if( n > SbxMAXULNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXULNG;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pULong = static_cast<sal_uInt32>(n);
+ break;
+ case SbxBYREF | SbxSINGLE:
+ if( n > SbxMAXSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXSNG;
+ }
+ else if( n < SbxMINSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINSNG;
+ }
+ *p->pSingle = static_cast<float>(n);
+ break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = ImpDoubleToSalInt64( n );
+ break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = ImpDoubleToSalUInt64( n );
+ break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = n;
+ break;
+ case SbxBYREF | SbxCURRENCY:
+ if( n > SbxMAXCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCURR;
+ }
+ else if( n < SbxMINCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCURR;
+ }
+ *p->pnInt64 = ImpDoubleToCurrency( n );
+ break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ break;
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxdbl.cxx b/basic/source/sbx/sbxdbl.cxx
new file mode 100644
index 000000000..9010dfaa3
--- /dev/null
+++ b/basic/source/sbx/sbxdbl.cxx
@@ -0,0 +1,315 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+
+#include <o3tl/float_int_conversion.hxx>
+#include <vcl/errcode.hxx>
+#include "sbxconv.hxx"
+#include <runtime.hxx>
+
+double ImpGetDouble( const SbxValues* p )
+{
+ double nRes;
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar; break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort; break;
+ case SbxLONG:
+ nRes = p->nLong; break;
+ case SbxULONG:
+ nRes = p->nULong; break;
+ case SbxSINGLE:
+ nRes = p->nSingle; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ nRes = p->nDouble; break;
+ case SbxCURRENCY:
+ nRes = ImpCurrencyToDouble( p->nInt64 ); break;
+ case SbxSALINT64:
+ nRes = static_cast< double >(p->nInt64); break;
+ case SbxSALUINT64:
+ nRes = ImpSalUInt64ToDouble( p->uInt64 ); break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ if( p->pDecimal )
+ p->pDecimal->getDouble( nRes );
+ else
+ nRes = 0.0;
+ break;
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ {
+ nRes = 0;
+#if HAVE_FEATURE_SCRIPTING
+ if ( SbiRuntime::isVBAEnabled() )// VBA only behaviour
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+#endif
+ }
+ else
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ {
+ nRes = 0;
+#if HAVE_FEATURE_SCRIPTING
+ if ( SbiRuntime::isVBAEnabled() )// VBA only behaviour
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+#endif
+ }
+ else
+ nRes = d;
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetDouble();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar; break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger; break;
+ case SbxBYREF | SbxLONG:
+ nRes = *p->pLong; break;
+ case SbxBYREF | SbxULONG:
+ nRes = *p->pULong; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ nRes = *p->pUShort; break;
+ case SbxBYREF | SbxSINGLE:
+ nRes = *p->pSingle; break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ nRes = *p->pDouble; break;
+ case SbxBYREF | SbxCURRENCY:
+ nRes = ImpCurrencyToDouble( *p->pnInt64 ); break;
+ case SbxBYREF | SbxSALINT64:
+ nRes = static_cast< double >(*p->pnInt64); break;
+ case SbxBYREF | SbxSALUINT64:
+ nRes = ImpSalUInt64ToDouble( *p->puInt64 ); break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutDouble( SbxValues* p, double n, bool bCoreString )
+{
+ SbxValues aTmp;
+start:
+ switch( +p->eType )
+ {
+ // Here are tests necessary
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxLONG:
+ aTmp.pLong = &p->nLong; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ case SbxSINGLE:
+ aTmp.pSingle = &p->nSingle; goto direct;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ SbxDecimal* pDec = ImpCreateDecimal( p );
+ if( !pDec->setDouble( n ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ case SbxCURRENCY:
+ if( n > SbxMAXCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCURR;
+ }
+ else if( n < SbxMINCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCURR;
+ }
+ p->nInt64 = ImpDoubleToCurrency( n );
+ break;
+
+ // from here on no longer
+ case SbxSALINT64:
+ p->nInt64 = ImpDoubleToSalInt64( n ); break;
+ case SbxSALUINT64:
+ p->uInt64 = ImpDoubleToSalUInt64( n ); break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ ImpCvtNum( n, 14, *p->pOUString, bCoreString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutDouble( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXCHAR) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCHAR;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(n), SbxMINCHAR) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXBYTE) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(n), SbxMININT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMININT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXUINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXUINT;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXLNG;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(n), SbxMINLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINLNG;
+ }
+ *p->pLong = static_cast<sal_Int32>(n); break;
+ case SbxBYREF | SbxULONG:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXULNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXULNG;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pULong = static_cast<sal_uInt32>(n); break;
+ case SbxBYREF | SbxSINGLE:
+ if( n > SbxMAXSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXSNG;
+ }
+ else if( n < SbxMINSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINSNG;
+ }
+ else if( n > 0 && n < SbxMAXSNG2 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXSNG2;
+ }
+ else if( n < 0 && n > SbxMINSNG2 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINSNG2;
+ }
+ *p->pSingle = static_cast<float>(n); break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = ImpDoubleToSalInt64( n ); break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = ImpDoubleToSalUInt64( n ); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = n; break;
+ case SbxBYREF | SbxCURRENCY:
+ if( n > SbxMAXCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCURR;
+ }
+ else if( n < SbxMINCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCURR;
+ }
+ *p->pnInt64 = ImpDoubleToCurrency( n ); break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxdec.cxx b/basic/source/sbx/sbxdec.cxx
new file mode 100644
index 000000000..81685f774
--- /dev/null
+++ b/basic/source/sbx/sbxdec.cxx
@@ -0,0 +1,685 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <o3tl/char16_t2wchar_t.hxx>
+
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+#include <com/sun/star/bridge/oleautomation/Decimal.hpp>
+
+// Implementation SbxDecimal
+SbxDecimal::SbxDecimal()
+ : mnRefCount(0)
+{
+ setInt( 0 );
+}
+
+SbxDecimal::SbxDecimal( const SbxDecimal& rDec )
+ : mnRefCount(0)
+{
+#ifdef _WIN32
+ maDec = rDec.maDec;
+#else
+ (void)rDec;
+#endif
+}
+
+SbxDecimal::SbxDecimal
+ ( const css::bridge::oleautomation::Decimal& rAutomationDec )
+ : mnRefCount(0)
+{
+#ifdef _WIN32
+ maDec.scale = rAutomationDec.Scale;
+ maDec.sign = rAutomationDec.Sign;
+ maDec.Lo32 = rAutomationDec.LowValue;
+ maDec.Mid32 = rAutomationDec.MiddleValue;
+ maDec.Hi32 = rAutomationDec.HighValue;
+#else
+ (void)rAutomationDec;
+#endif
+}
+
+void SbxDecimal::fillAutomationDecimal
+ ( css::bridge::oleautomation::Decimal& rAutomationDec )
+{
+#ifdef _WIN32
+ rAutomationDec.Scale = maDec.scale;
+ rAutomationDec.Sign = maDec.sign;
+ rAutomationDec.LowValue = maDec.Lo32;
+ rAutomationDec.MiddleValue = maDec.Mid32;
+ rAutomationDec.HighValue = maDec.Hi32;
+#else
+ (void)rAutomationDec;
+#endif
+}
+
+SbxDecimal::~SbxDecimal()
+{
+}
+
+void releaseDecimalPtr( SbxDecimal*& rpDecimal )
+{
+ if( rpDecimal )
+ {
+ rpDecimal->mnRefCount--;
+ if( rpDecimal->mnRefCount == 0 )
+ {
+ delete rpDecimal;
+ rpDecimal = nullptr;
+ }
+ }
+}
+
+#ifdef _WIN32
+
+bool SbxDecimal::operator -= ( const SbxDecimal &r )
+{
+ HRESULT hResult = VarDecSub( &maDec, const_cast<LPDECIMAL>(&r.maDec), &maDec );
+ bool bRet = ( hResult == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::operator += ( const SbxDecimal &r )
+{
+ HRESULT hResult = VarDecAdd( &maDec, const_cast<LPDECIMAL>(&r.maDec), &maDec );
+ bool bRet = ( hResult == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::operator /= ( const SbxDecimal &r )
+{
+ HRESULT hResult = VarDecDiv( &maDec, const_cast<LPDECIMAL>(&r.maDec), &maDec );
+ bool bRet = ( hResult == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::operator *= ( const SbxDecimal &r )
+{
+ HRESULT hResult = VarDecMul( &maDec, const_cast<LPDECIMAL>(&r.maDec), &maDec );
+ bool bRet = ( hResult == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::neg()
+{
+ HRESULT hResult = VarDecNeg( &maDec, &maDec );
+ bool bRet = ( hResult == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::isZero() const
+{
+ SbxDecimal aZeroDec;
+ aZeroDec.setLong( 0 );
+ bool bZero = CmpResult::EQ == compare( *this, aZeroDec );
+ return bZero;
+}
+
+SbxDecimal::CmpResult compare( const SbxDecimal &rLeft, const SbxDecimal &rRight )
+{
+ HRESULT hResult = VarDecCmp( const_cast<LPDECIMAL>(&rLeft.maDec), const_cast<LPDECIMAL>(&rRight.maDec) );
+ SbxDecimal::CmpResult eRes = static_cast<SbxDecimal::CmpResult>(hResult);
+ return eRes;
+}
+
+void SbxDecimal::setChar( sal_Unicode val )
+{
+ VarDecFromUI2( static_cast<sal_uInt16>(val), &maDec );
+}
+
+void SbxDecimal::setByte( sal_uInt8 val )
+{
+ VarDecFromUI1( val, &maDec );
+}
+
+void SbxDecimal::setShort( sal_Int16 val )
+{
+ VarDecFromI2( static_cast<short>(val), &maDec );
+}
+
+void SbxDecimal::setLong( sal_Int32 val )
+{
+ VarDecFromI4( static_cast<long>(val), &maDec );
+}
+
+void SbxDecimal::setUShort( sal_uInt16 val )
+{
+ VarDecFromUI2( val, &maDec );
+}
+
+void SbxDecimal::setULong( sal_uInt32 val )
+{
+ VarDecFromUI4( static_cast<ULONG>(val), &maDec );
+}
+
+bool SbxDecimal::setSingle( float val )
+{
+ bool bRet = ( VarDecFromR4( val, &maDec ) == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::setDouble( double val )
+{
+ bool bRet = ( VarDecFromR8( val, &maDec ) == S_OK );
+ return bRet;
+}
+
+void SbxDecimal::setInt( int val )
+{
+ setLong( static_cast<sal_Int32>(val) );
+}
+
+void SbxDecimal::setUInt( unsigned int val )
+{
+ setULong( static_cast<sal_uInt32>(val) );
+}
+
+bool SbxDecimal::setString( OUString* pOUString )
+{
+ assert(pOUString);
+
+ static LCID nLANGID = MAKELANGID( LANG_ENGLISH, SUBLANG_ENGLISH_US );
+
+ // Convert delimiter
+ sal_Unicode cDecimalSep;
+ sal_Unicode cThousandSep;
+ sal_Unicode cDecimalSepAlt;
+ ImpGetIntntlSep( cDecimalSep, cThousandSep, cDecimalSepAlt );
+
+ bool bRet = false;
+ HRESULT hResult;
+ if( cDecimalSep != '.' || cThousandSep != ',' )
+ {
+ int nLen = pOUString->getLength();
+ std::unique_ptr<sal_Unicode[]> pBuffer(new sal_Unicode[nLen + 1]);
+ pBuffer[nLen] = 0;
+
+ const sal_Unicode* pSrc = pOUString->getStr();
+ for( int i = 0 ; i < nLen ; ++i )
+ {
+ sal_Unicode c = pSrc[i];
+ if (c == cDecimalSep)
+ c = '.';
+ else if (c == cThousandSep)
+ c = ',';
+
+ pBuffer[i] = c;
+ }
+ hResult = VarDecFromStr( o3tl::toW(pBuffer.get()), nLANGID, 0, &maDec );
+ }
+ else
+ {
+ hResult = VarDecFromStr( o3tl::toW(pOUString->getStr()), nLANGID, 0, &maDec );
+ }
+ bRet = ( hResult == S_OK );
+ return bRet;
+}
+
+
+bool SbxDecimal::getChar( sal_Unicode& rVal )
+{
+ USHORT n;
+ bool bRet = ( VarUI2FromDec( &maDec, &n ) == S_OK );
+ if (bRet) {
+ rVal = n;
+ }
+ return bRet;
+}
+
+bool SbxDecimal::getShort( sal_Int16& rVal )
+{
+ bool bRet = ( VarI2FromDec( &maDec, &rVal ) == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::getLong( sal_Int32& rVal )
+{
+ bool bRet = ( VarI4FromDec( &maDec, &rVal ) == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::getUShort( sal_uInt16& rVal )
+{
+ bool bRet = ( VarUI2FromDec( &maDec, &rVal ) == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::getULong( sal_uInt32& rVal )
+{
+ bool bRet = ( VarUI4FromDec( &maDec, &rVal ) == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::getSingle( float& rVal )
+{
+ bool bRet = ( VarR4FromDec( &maDec, &rVal ) == S_OK );
+ return bRet;
+}
+
+bool SbxDecimal::getDouble( double& rVal )
+{
+ bool bRet = ( VarR8FromDec( &maDec, &rVal ) == S_OK );
+ return bRet;
+}
+
+#else
+// !_WIN32
+
+bool SbxDecimal::operator -= ( const SbxDecimal & )
+{
+ return false;
+}
+
+bool SbxDecimal::operator += ( const SbxDecimal & )
+{
+ return false;
+}
+
+bool SbxDecimal::operator /= ( const SbxDecimal & )
+{
+ return false;
+}
+
+bool SbxDecimal::operator *= ( const SbxDecimal & )
+{
+ return false;
+}
+
+bool SbxDecimal::neg()
+{
+ return false;
+}
+
+bool SbxDecimal::isZero() const
+{
+ return false;
+}
+
+SbxDecimal::CmpResult compare( SAL_UNUSED_PARAMETER const SbxDecimal &, SAL_UNUSED_PARAMETER const SbxDecimal & )
+{
+ return SbxDecimal::CmpResult::LT;
+}
+
+void SbxDecimal::setChar( SAL_UNUSED_PARAMETER sal_Unicode ) {}
+void SbxDecimal::setByte( SAL_UNUSED_PARAMETER sal_uInt8 ) {}
+void SbxDecimal::setShort( SAL_UNUSED_PARAMETER sal_Int16 ) {}
+void SbxDecimal::setLong( SAL_UNUSED_PARAMETER sal_Int32 ) {}
+void SbxDecimal::setUShort( SAL_UNUSED_PARAMETER sal_uInt16 ) {}
+void SbxDecimal::setULong( SAL_UNUSED_PARAMETER sal_uInt32 ) {}
+bool SbxDecimal::setSingle( SAL_UNUSED_PARAMETER float ) { return false; }
+bool SbxDecimal::setDouble( SAL_UNUSED_PARAMETER double ) { return false; }
+void SbxDecimal::setInt( SAL_UNUSED_PARAMETER int ) {}
+void SbxDecimal::setUInt( SAL_UNUSED_PARAMETER unsigned int ) {}
+bool SbxDecimal::setString( SAL_UNUSED_PARAMETER OUString* ) { return false; }
+
+bool SbxDecimal::getChar( SAL_UNUSED_PARAMETER sal_Unicode& ) { return false; }
+bool SbxDecimal::getShort( SAL_UNUSED_PARAMETER sal_Int16& ) { return false; }
+bool SbxDecimal::getLong( SAL_UNUSED_PARAMETER sal_Int32& ) { return false; }
+bool SbxDecimal::getUShort( SAL_UNUSED_PARAMETER sal_uInt16& ) { return false; }
+bool SbxDecimal::getULong( SAL_UNUSED_PARAMETER sal_uInt32& ) { return false; }
+bool SbxDecimal::getSingle( SAL_UNUSED_PARAMETER float& ) { return false; }
+bool SbxDecimal::getDouble( SAL_UNUSED_PARAMETER double& ) { return false; }
+
+#endif
+
+void SbxDecimal::getString( OUString& rString )
+{
+#ifdef _WIN32
+ static LCID nLANGID = MAKELANGID( LANG_ENGLISH, SUBLANG_ENGLISH_US );
+
+ BSTR pBStr = nullptr;
+ // VarBstrFromDec allocates new BSTR that needs to be released with SysFreeString
+ HRESULT hResult = VarBstrFromDec( &maDec, nLANGID, 0, &pBStr );
+ if( hResult == S_OK )
+ {
+ // Convert delimiter
+ sal_Unicode cDecimalSep;
+ sal_Unicode cThousandSep;
+ sal_Unicode cDecimalSepAlt;
+ ImpGetIntntlSep( cDecimalSep, cThousandSep, cDecimalSepAlt );
+
+ if( cDecimalSep != '.' || cThousandSep != ',' )
+ {
+ sal_Unicode c;
+ int i = 0;
+ while( (c = pBStr[i]) != 0 )
+ {
+ if( c == '.' )
+ pBStr[i] = cDecimalSep;
+ else if( c == ',' )
+ pBStr[i] = cThousandSep;
+ i++;
+ }
+ }
+ rString = o3tl::toU( pBStr );
+ SysFreeString( pBStr );
+ }
+#else
+ (void)rString;
+#endif
+}
+
+SbxDecimal* ImpCreateDecimal( SbxValues* p )
+{
+ if( !p )
+ return nullptr;
+
+ SbxDecimal*& rpDecimal = p->pDecimal;
+ if( rpDecimal == nullptr )
+ {
+ rpDecimal = new SbxDecimal();
+ rpDecimal->addRef();
+ }
+ return rpDecimal;
+}
+
+SbxDecimal* ImpGetDecimal( const SbxValues* p )
+{
+ SbxValues aTmp;
+ SbxDecimal* pnDecRes;
+
+ SbxDataType eType = p->eType;
+ if( eType == SbxDECIMAL && p->pDecimal )
+ {
+ pnDecRes = new SbxDecimal( *p->pDecimal );
+ pnDecRes->addRef();
+ return pnDecRes;
+ }
+ pnDecRes = new SbxDecimal();
+ pnDecRes->addRef();
+
+start:
+ switch( +eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ pnDecRes->setShort( 0 ); break;
+ case SbxCHAR:
+ pnDecRes->setChar( p->nChar ); break;
+ case SbxBYTE:
+ pnDecRes->setByte( p->nByte ); break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ pnDecRes->setInt( p->nInteger ); break;
+ case SbxERROR:
+ case SbxUSHORT:
+ pnDecRes->setUShort( p->nUShort ); break;
+ case SbxLONG:
+ pnDecRes->setLong( p->nLong ); break;
+ case SbxULONG:
+ pnDecRes->setULong( p->nULong ); break;
+ case SbxSINGLE:
+ if( !pnDecRes->setSingle( p->nSingle ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ case SbxCURRENCY:
+ {
+ if( !pnDecRes->setDouble( ImpCurrencyToDouble( p->nInt64 ) ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ case SbxSALINT64:
+ {
+ if( !pnDecRes->setDouble( static_cast<double>(p->nInt64) ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ case SbxSALUINT64:
+ {
+ if( !pnDecRes->setDouble( static_cast<double>(p->uInt64) ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ case SbxDATE:
+ case SbxDOUBLE:
+ {
+ double dVal = p->nDouble;
+ if( !pnDecRes->setDouble( dVal ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ case SbxLPSTR:
+ case SbxSTRING:
+ case SbxBYREF | SbxSTRING:
+ if ( p->pOUString )
+ pnDecRes->setString( p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pnDecRes->setDecimal( pVal->GetDecimal() );
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ pnDecRes->setShort( 0 );
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ pnDecRes->setChar( *p->pChar ); break;
+ case SbxBYREF | SbxBYTE:
+ pnDecRes->setByte( *p->pByte ); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ pnDecRes->setInt( *p->pInteger ); break;
+ case SbxBYREF | SbxLONG:
+ pnDecRes->setLong( *p->pLong ); break;
+ case SbxBYREF | SbxULONG:
+ pnDecRes->setULong( *p->pULong ); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ pnDecRes->setUShort( *p->pUShort ); break;
+
+ // from here on had to be tested
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); pnDecRes->setShort( 0 );
+ }
+ return pnDecRes;
+}
+
+void ImpPutDecimal( SbxValues* p, SbxDecimal* pDec )
+{
+ if( !pDec )
+ return;
+
+ SbxValues aTmp;
+start:
+ switch( +p->eType )
+ {
+ // here had to be tested
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxLONG:
+ aTmp.pLong = &p->nLong; goto direct;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ aTmp.pnInt64 = &p->nInt64; goto direct;
+ case SbxSALUINT64:
+ aTmp.puInt64 = &p->uInt64; goto direct;
+
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ // from here on no longer
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ if( pDec != p->pDecimal )
+ {
+ releaseDecimalPtr( p->pDecimal );
+ p->pDecimal = pDec;
+ if( pDec )
+ pDec->addRef();
+ }
+ break;
+ }
+ case SbxSINGLE:
+ {
+ float f(0.0);
+ pDec->getSingle( f );
+ p->nSingle = f;
+ break;
+ }
+ case SbxDATE:
+ case SbxDOUBLE:
+ {
+ double d(0.0);
+ pDec->getDouble( d );
+ p->nDouble = d;
+ break;
+ }
+
+ case SbxLPSTR:
+ case SbxSTRING:
+ case SbxBYREF | SbxSTRING:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ pDec->getString( *p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutDecimal( pDec );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ if( !pDec->getChar( *p->pChar ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pChar = 0;
+ }
+ break;
+ case SbxBYREF | SbxBYTE:
+ if( !pDec->getChar( *p->pChar ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pByte = 0;
+ }
+ break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( !pDec->getShort( *p->pInteger ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pInteger = 0;
+ }
+ break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( !pDec->getUShort( *p->pUShort ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pUShort = 0;
+ }
+ break;
+ case SbxBYREF | SbxLONG:
+ if( !pDec->getLong( *p->pLong ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pLong = 0;
+ }
+ break;
+ case SbxBYREF | SbxULONG:
+ if( !pDec->getULong( *p->pULong ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pULong = 0;
+ }
+ break;
+ case SbxBYREF | SbxCURRENCY:
+ {
+ double d(0.0);
+ if( !pDec->getDouble( d ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pnInt64 = ImpDoubleToCurrency( d );
+ }
+ break;
+ case SbxBYREF | SbxSALINT64:
+ {
+ double d(0.0);
+ if( !pDec->getDouble( d ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ else
+ *p->pnInt64 = ImpDoubleToSalInt64( d );
+ }
+ break;
+ case SbxBYREF | SbxSALUINT64:
+ {
+ double d(0.0);
+ if( !pDec->getDouble( d ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ else
+ *p->puInt64 = ImpDoubleToSalUInt64( d );
+ }
+ break;
+ case SbxBYREF | SbxSINGLE:
+ if( !pDec->getSingle( *p->pSingle ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pSingle = 0;
+ }
+ break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ if( !pDec->getDouble( *p->pDouble ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->pDouble = 0;
+ }
+ break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxdec.hxx b/basic/source/sbx/sbxdec.hxx
new file mode 100644
index 000000000..3db396ea6
--- /dev/null
+++ b/basic/source/sbx/sbxdec.hxx
@@ -0,0 +1,99 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#pragma once
+
+#ifdef _WIN32
+#include <prewin.h>
+#include <postwin.h>
+#include <comutil.h>
+#include <oleauto.h>
+#endif
+
+#include <com/sun/star/bridge/oleautomation/Decimal.hpp>
+
+
+// Decimal support
+// Implementation only for windows
+
+class SbxDecimal
+{
+ friend void releaseDecimalPtr( SbxDecimal*& rpDecimal );
+
+#ifdef _WIN32
+ DECIMAL maDec;
+#endif
+ sal_Int32 mnRefCount;
+
+public:
+ SbxDecimal();
+ SbxDecimal( const SbxDecimal& rDec );
+ explicit SbxDecimal( const css::bridge::oleautomation::Decimal& rAutomationDec );
+
+ ~SbxDecimal();
+
+ void addRef()
+ { mnRefCount++; }
+
+ void fillAutomationDecimal( css::bridge::oleautomation::Decimal& rAutomationDec );
+
+ void setChar( sal_Unicode val );
+ void setByte( sal_uInt8 val );
+ void setShort( sal_Int16 val );
+ void setLong( sal_Int32 val );
+ void setUShort( sal_uInt16 val );
+ void setULong( sal_uInt32 val );
+ bool setSingle( float val );
+ bool setDouble( double val );
+ void setInt( int val );
+ void setUInt( unsigned int val );
+ bool setString( OUString* pOUString );
+ void setDecimal( SbxDecimal const * pDecimal )
+ {
+#ifdef _WIN32
+ if( pDecimal )
+ maDec = pDecimal->maDec;
+#else
+ (void)pDecimal;
+#endif
+ }
+
+ bool getChar( sal_Unicode& rVal );
+ bool getShort( sal_Int16& rVal );
+ bool getLong( sal_Int32& rVal );
+ bool getUShort( sal_uInt16& rVal );
+ bool getULong( sal_uInt32& rVal );
+ bool getSingle( float& rVal );
+ bool getDouble( double& rVal );
+ void getString( OUString& rString );
+
+ bool operator -= ( const SbxDecimal &r );
+ bool operator += ( const SbxDecimal &r );
+ bool operator /= ( const SbxDecimal &r );
+ bool operator *= ( const SbxDecimal &r );
+ bool neg();
+
+ bool isZero() const;
+
+ // must match the return values of the Microsoft VarDecCmp Automation function
+ enum class CmpResult { LT, EQ, GT };
+ friend CmpResult compare( const SbxDecimal &rLeft, const SbxDecimal &rRight );
+};
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxexec.cxx b/basic/source/sbx/sbxexec.cxx
new file mode 100644
index 000000000..63f54b19d
--- /dev/null
+++ b/basic/source/sbx/sbxexec.cxx
@@ -0,0 +1,381 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/sbx.hxx>
+#include <basic/sberrors.hxx>
+#include <rtl/character.hxx>
+#include <rtl/ustrbuf.hxx>
+
+
+static SbxVariableRef Element
+ ( SbxObject* pObj, SbxObject* pGbl, const sal_Unicode** ppBuf,
+ SbxClassType );
+
+static const sal_Unicode* SkipWhitespace( const sal_Unicode* p )
+{
+ while( *p && ( *p == ' ' || *p == '\t' ) )
+ p++;
+ return p;
+}
+
+// Scanning of a symbol. The symbol were inserted in rSym, the return value
+// is the new scan position. The symbol is at errors empty.
+
+static const sal_Unicode* Symbol( const sal_Unicode* p, OUString& rSym )
+{
+ sal_uInt16 nLen = 0;
+ // Did we have a nonstandard symbol?
+ if( *p == '[' )
+ {
+ rSym = ++p;
+ while( *p && *p != ']' )
+ {
+ p++;
+ nLen++;
+ }
+ p++;
+ }
+ else
+ {
+ // A symbol had to begin with an alphabetic character or an underline
+ if( !rtl::isAsciiAlpha( *p ) && *p != '_' )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_SYNTAX );
+ }
+ else
+ {
+ rSym = p;
+ // The it can contain alphabetic characters, numbers or underlines
+ while( *p && (rtl::isAsciiAlphanumeric( *p ) || *p == '_') )
+ {
+ p++;
+ nLen++;
+ }
+ // Ignore standard BASIC suffixes
+ if( *p && (*p == '%' || *p == '&' || *p == '!' || *p == '#' || *p == '$' ) )
+ {
+ p++;
+ }
+ }
+ }
+ rSym = rSym.copy( 0, nLen );
+ return p;
+}
+
+// Qualified name. Element.Element...
+
+static SbxVariableRef QualifiedName
+ ( SbxObject* pObj, SbxObject* pGbl, const sal_Unicode** ppBuf, SbxClassType t )
+{
+
+ SbxVariableRef refVar;
+ const sal_Unicode* p = SkipWhitespace( *ppBuf );
+ if( rtl::isAsciiAlpha( *p ) || *p == '_' || *p == '[' )
+ {
+ // Read in the element
+ refVar = Element( pObj, pGbl, &p, t );
+ while( refVar.is() && (*p == '.' || *p == '!') )
+ {
+ // It follows still an objectelement. The current element
+ // had to be a SBX-Object or had to deliver such an object!
+ pObj = dynamic_cast<SbxObject*>( refVar.get() );
+ if( !pObj )
+ // Then it had to deliver an object
+ pObj = dynamic_cast<SbxObject*>( refVar->GetObject() );
+ refVar.clear();
+ if( !pObj )
+ break;
+ p++;
+ // And the next element please
+ refVar = Element( pObj, pGbl, &p, t );
+ }
+ }
+ else
+ SbxBase::SetError( ERRCODE_BASIC_SYNTAX );
+ *ppBuf = p;
+ return refVar;
+}
+
+// Read in of an operand. This could be a number, a string or
+// a function (with optional parameters).
+
+static SbxVariableRef Operand
+ ( SbxObject* pObj, SbxObject* pGbl, const sal_Unicode** ppBuf, bool bVar )
+{
+ SbxVariableRef refVar( new SbxVariable );
+ const sal_Unicode* p = SkipWhitespace( *ppBuf );
+ if( !bVar && ( rtl::isAsciiDigit( *p )
+ || ( *p == '.' && rtl::isAsciiDigit( *( p+1 ) ) )
+ || *p == '-'
+ || *p == '&' ) )
+ {
+ // A number could be scanned in directly!
+ sal_uInt16 nLen;
+ if( !refVar->Scan( OUString( p ), &nLen ) )
+ {
+ refVar.clear();
+ }
+ else
+ {
+ p += nLen;
+ }
+ }
+ else if( !bVar && *p == '"' )
+ {
+ // A string
+ OUStringBuffer aString;
+ p++;
+ for( ;; )
+ {
+ // This is perhaps an error
+ if( !*p )
+ {
+ return nullptr;
+ }
+ // Double quotes are OK
+ if( *p == '"' && (*++p) != '"' )
+ {
+ break;
+ }
+ aString.append(*p++);
+ }
+ refVar->PutString( aString.makeStringAndClear() );
+ }
+ else
+ {
+ refVar = QualifiedName( pObj, pGbl, &p, SbxClassType::DontCare );
+ }
+ *ppBuf = p;
+ return refVar;
+}
+
+// Read in of a simple term. The operands +, -, * and /
+// are supported.
+
+static SbxVariableRef MulDiv( SbxObject* pObj, SbxObject* pGbl, const sal_Unicode** ppBuf )
+{
+ const sal_Unicode* p = *ppBuf;
+ SbxVariableRef refVar( Operand( pObj, pGbl, &p, false ) );
+ p = SkipWhitespace( p );
+ while( refVar.is() && ( *p == '*' || *p == '/' ) )
+ {
+ sal_Unicode cOp = *p++;
+ SbxVariableRef refVar2( Operand( pObj, pGbl, &p, false ) );
+ if( refVar2.is() )
+ {
+ // temporary variable!
+ SbxVariable* pVar = refVar.get();
+ pVar = new SbxVariable( *pVar );
+ refVar = pVar;
+ if( cOp == '*' )
+ *refVar *= *refVar2;
+ else
+ *refVar /= *refVar2;
+ }
+ else
+ {
+ refVar.clear();
+ break;
+ }
+ }
+ *ppBuf = p;
+ return refVar;
+}
+
+static SbxVariableRef PlusMinus( SbxObject* pObj, SbxObject* pGbl, const sal_Unicode** ppBuf )
+{
+ const sal_Unicode* p = *ppBuf;
+ SbxVariableRef refVar( MulDiv( pObj, pGbl, &p ) );
+ p = SkipWhitespace( p );
+ while( refVar.is() && ( *p == '+' || *p == '-' ) )
+ {
+ sal_Unicode cOp = *p++;
+ SbxVariableRef refVar2( MulDiv( pObj, pGbl, &p ) );
+ if( refVar2.is() )
+ {
+ // temporary Variable!
+ SbxVariable* pVar = refVar.get();
+ pVar = new SbxVariable( *pVar );
+ refVar = pVar;
+ if( cOp == '+' )
+ *refVar += *refVar2;
+ else
+ *refVar -= *refVar2;
+ }
+ else
+ {
+ refVar.clear();
+ break;
+ }
+ }
+ *ppBuf = p;
+ return refVar;
+}
+
+static SbxVariableRef Assign( SbxObject* pObj, SbxObject* pGbl, const sal_Unicode** ppBuf )
+{
+ const sal_Unicode* p = *ppBuf;
+ SbxVariableRef refVar( Operand( pObj, pGbl, &p, true ) );
+ p = SkipWhitespace( p );
+ if( refVar.is() )
+ {
+ if( *p == '=' )
+ {
+ // Assign only onto properties!
+ if( refVar->GetClass() != SbxClassType::Property )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_BAD_ACTION );
+ refVar.clear();
+ }
+ else
+ {
+ p++;
+ SbxVariableRef refVar2( PlusMinus( pObj, pGbl, &p ) );
+ if( refVar2.is() )
+ {
+ SbxVariable* pVar = refVar.get();
+ SbxVariable* pVar2 = refVar2.get();
+ *pVar = *pVar2;
+ pVar->SetParameters( nullptr );
+ }
+ }
+ }
+ else
+ // Simple call: once activating
+ refVar->Broadcast( SfxHintId::BasicDataWanted );
+ }
+ *ppBuf = p;
+ return refVar;
+}
+
+// Read in of an element. This is a symbol, optional followed
+// by a parameter list. The symbol will be searched in the
+// specified object and the parameter list will be attached if necessary.
+
+static SbxVariableRef Element
+ ( SbxObject* pObj, SbxObject* pGbl, const sal_Unicode** ppBuf,
+ SbxClassType t )
+{
+ OUString aSym;
+ const sal_Unicode* p = Symbol( *ppBuf, aSym );
+ SbxVariableRef refVar;
+ if( !aSym.isEmpty() )
+ {
+ SbxFlagBits nOld = pObj->GetFlags();
+ if( pObj == pGbl )
+ {
+ pObj->SetFlag( SbxFlagBits::GlobalSearch );
+ }
+ refVar = pObj->Find( aSym, t );
+ pObj->SetFlags( nOld );
+ if( refVar.is() )
+ {
+ refVar->SetParameters( nullptr );
+ // Follow still parameter?
+ p = SkipWhitespace( p );
+ if( *p == '(' )
+ {
+ p++;
+ auto refPar = tools::make_ref<SbxArray>();
+ sal_uInt32 nArg = 0;
+ // We are once relaxed and accept as well
+ // the line- or command end as delimiter
+ // Search parameter always global!
+ while( *p && *p != ')' && *p != ']' )
+ {
+ SbxVariableRef refArg = PlusMinus( pGbl, pGbl, &p );
+ if( !refArg.is() )
+ {
+ // Error during the parsing
+ refVar.clear(); break;
+ }
+ else
+ {
+ // One copies the parameter, so that
+ // one have the current status (triggers also
+ // the call per access)
+ refPar->Put32( new SbxVariable( *refArg ), ++nArg );
+ }
+ p = SkipWhitespace( p );
+ if( *p == ',' )
+ p++;
+ }
+ if( *p == ')' )
+ p++;
+ if( refVar.is() )
+ refVar->SetParameters( refPar.get() );
+ }
+ }
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_METHOD );
+ }
+ *ppBuf = p;
+ return refVar;
+}
+
+// Mainroutine
+
+SbxVariable* SbxObject::Execute( const OUString& rTxt )
+{
+ SbxVariableRef pVar;
+ const sal_Unicode* p = rTxt.getStr();
+ for( ;; )
+ {
+ p = SkipWhitespace( p );
+ if( !*p )
+ {
+ break;
+ }
+ if( *p++ != '[' )
+ {
+ SetError( ERRCODE_BASIC_SYNTAX ); break;
+ }
+ pVar = Assign( this, this, &p );
+ if( !pVar.is() )
+ {
+ break;
+ }
+ p = SkipWhitespace( p );
+ if( *p++ != ']' )
+ {
+ SetError( ERRCODE_BASIC_SYNTAX ); break;
+ }
+ }
+ return pVar.get();
+}
+
+SbxVariable* SbxObject::FindQualified( const OUString& rName, SbxClassType t )
+{
+ SbxVariableRef pVar;
+ const sal_Unicode* p = rName.getStr();
+ p = SkipWhitespace( p );
+ if( !*p )
+ {
+ return nullptr;
+ }
+ pVar = QualifiedName( this, this, &p, t );
+ p = SkipWhitespace( p );
+ if( *p )
+ {
+ SetError( ERRCODE_BASIC_SYNTAX );
+ }
+ return pVar.get();
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxform.cxx b/basic/source/sbx/sbxform.cxx
new file mode 100644
index 000000000..85374facd
--- /dev/null
+++ b/basic/source/sbx/sbxform.cxx
@@ -0,0 +1,1001 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include <stdlib.h>
+
+#include <sbxform.hxx>
+#include <rtl/ustrbuf.hxx>
+
+#include <rtl/character.hxx>
+
+/*
+TODO: are there any Star-Basic characteristics unconsidered?
+
+ what means: * as placeholder
+
+COMMENT: Visual-Basic treats the following (invalid) format-strings
+ as shown:
+
+ ##0##.##0## --> ##000.000##
+
+ (this class behaves the same way)
+*/
+
+#include <stdio.h>
+#include <float.h>
+#include <math.h>
+
+#define NO_DIGIT_ -1
+
+#define MAX_NO_OF_DIGITS DBL_DIG
+#define MAX_DOUBLE_BUFFER_LENGTH MAX_NO_OF_DIGITS + 9
+ // +1 for leading sign
+ // +1 for digit before the decimal point
+ // +1 for decimal point
+ // +2 for exponent E and exp. leading sign
+ // +3 for the exponent's value
+ // +1 for closing 0
+
+#define CREATE_1000SEP_CHAR '@'
+
+#define FORMAT_SEPARATOR ';'
+
+// predefined formats for the Format$()-command:
+#define BASICFORMAT_GENERALNUMBER "General Number"
+#define BASICFORMAT_CURRENCY "Currency"
+#define BASICFORMAT_FIXED "Fixed"
+#define BASICFORMAT_STANDARD "Standard"
+#define BASICFORMAT_PERCENT "Percent"
+#define BASICFORMAT_SCIENTIFIC "Scientific"
+#define BASICFORMAT_YESNO "Yes/No"
+#define BASICFORMAT_TRUEFALSE "True/False"
+#define BASICFORMAT_ONOFF "On/Off"
+
+// Comment: Visual-Basic has a maximum of 12 positions after the
+// decimal point for floating-point-numbers.
+// all format-strings are compatible to Visual-Basic:
+#define GENERALNUMBER_FORMAT "0.############"
+#define FIXED_FORMAT "0.00"
+#define STANDARD_FORMAT "@0.00"
+#define PERCENT_FORMAT "0.00%"
+#define SCIENTIFIC_FORMAT "#.00E+00"
+// Comment: the character @ means that thousand-separators shall
+// be generated. That's a StarBasic 'extension'.
+
+
+static double get_number_of_digits( double dNumber )
+//double floor_log10_fabs( double dNumber )
+{
+ if( dNumber==0.0 )
+ return 0.0; // used to be 1.0, now 0.0 because of #40025;
+ else
+ return floor( log10( fabs( dNumber ) ) );
+}
+
+
+SbxBasicFormater::SbxBasicFormater( sal_Unicode _cDecPoint, sal_Unicode _cThousandSep,
+ const OUString& _sOnStrg,
+ const OUString& _sOffStrg,
+ const OUString& _sYesStrg,
+ const OUString& _sNoStrg,
+ const OUString& _sTrueStrg,
+ const OUString& _sFalseStrg,
+ const OUString& _sCurrencyStrg,
+ const OUString& _sCurrencyFormatStrg )
+ : cDecPoint(_cDecPoint)
+ , cThousandSep(_cThousandSep)
+ , sOnStrg(_sOnStrg)
+ , sOffStrg(_sOffStrg)
+ , sYesStrg(_sYesStrg)
+ , sNoStrg(_sNoStrg)
+ , sTrueStrg(_sTrueStrg)
+ , sFalseStrg(_sFalseStrg)
+ , sCurrencyStrg(_sCurrencyStrg)
+ , sCurrencyFormatStrg(_sCurrencyFormatStrg)
+ , dNum(0.0)
+ , nNumExp(0)
+ , nExpExp(0)
+{
+}
+
+// function to output an error-text (for debugging)
+// displaces all characters of the string, starting from nStartPos
+// for one position to larger indexes, i. e. place for a new
+// character (which is to be inserted) is created.
+// ATTENTION: the string MUST be long enough!
+inline void SbxBasicFormater::ShiftString( OUStringBuffer& sStrg, sal_uInt16 nStartPos )
+{
+ sStrg.remove(nStartPos,1);
+}
+
+void SbxBasicFormater::AppendDigit( OUStringBuffer& sStrg, short nDigit )
+{
+ if( nDigit>=0 && nDigit<=9 )
+ {
+ sStrg.append(static_cast<sal_Unicode>(nDigit+'0'));
+ }
+}
+
+void SbxBasicFormater::LeftShiftDecimalPoint( OUStringBuffer& sStrg )
+{
+ sal_Int32 nPos = -1;
+
+ for(sal_Int32 i = 0; i < sStrg.getLength(); i++)
+ {
+ if(sStrg[i] == cDecPoint)
+ {
+ nPos = i;
+ break;
+ }
+ }
+ if( nPos >= 0 )
+ {
+ sStrg[nPos] = sStrg[nPos - 1];
+ sStrg[nPos - 1] = cDecPoint;
+ }
+}
+
+// returns a flag if rounding a 9
+void SbxBasicFormater::StrRoundDigit( OUStringBuffer& sStrg, short nPos, bool& bOverflow )
+{
+ if( nPos<0 )
+ {
+ return;
+ }
+ bOverflow = false;
+ sal_Unicode c = sStrg[nPos];
+ if( nPos > 0 && (c == cDecPoint || c == cThousandSep) )
+ {
+ StrRoundDigit( sStrg, nPos - 1, bOverflow );
+ // CHANGE from 9.3.1997: end the method immediately after recursive call!
+ return;
+ }
+ // skip non-digits:
+ // COMMENT:
+ // in a valid format-string the number's output should be done
+ // in one piece, i. e. special characters should ONLY be in
+ // front OR behind the number and not right in the middle of
+ // the format information for the number
+ while( nPos >= 0 && ! rtl::isAsciiDigit(sStrg[nPos]))
+ {
+ nPos--;
+ }
+ if( nPos==-1 )
+ {
+ ShiftString( sStrg, 0 );
+ sStrg[0] = '1';
+ bOverflow = true;
+ }
+ else
+ {
+ sal_Unicode c2 = sStrg[nPos];
+ if( rtl::isAsciiDigit(c2) )
+ {
+ if( c2 == '9' )
+ {
+ sStrg[nPos] = '0';
+ StrRoundDigit( sStrg, nPos - 1, bOverflow );
+ }
+ else
+ {
+ sStrg[nPos] = c2 + 1;
+ }
+ }
+ else
+ {
+ ShiftString( sStrg,nPos+1 );
+ sStrg[nPos + 1] = '1';
+ bOverflow = true;
+ }
+ }
+}
+
+void SbxBasicFormater::StrRoundDigit( OUStringBuffer& sStrg, short nPos )
+{
+ bool bOverflow;
+
+ StrRoundDigit( sStrg, nPos, bOverflow );
+}
+
+void SbxBasicFormater::ParseBack( OUStringBuffer& sStrg, const OUString& sFormatStrg,
+ short nFormatPos )
+{
+ for( sal_Int32 i = nFormatPos;
+ i>0 && sFormatStrg[ i ] == '#' && sStrg[sStrg.getLength() - 1] == '0';
+ i-- )
+ {
+ sStrg.setLength(sStrg.getLength() - 1 );
+ }
+}
+
+void SbxBasicFormater::InitScan( double _dNum )
+{
+ char sBuffer[ MAX_DOUBLE_BUFFER_LENGTH ];
+
+ dNum = _dNum;
+ InitExp( get_number_of_digits( dNum ) );
+ // maximum of 15 positions behind the decimal point, example: -1.234000000000000E-001
+ /*int nCount =*/ sprintf( sBuffer,"%+22.15lE",dNum );
+ sSciNumStrg = OUString::createFromAscii( sBuffer );
+}
+
+
+void SbxBasicFormater::InitExp( double _dNewExp )
+{
+ char sBuffer[ MAX_DOUBLE_BUFFER_LENGTH ];
+ nNumExp = static_cast<short>(_dNewExp);
+ /*int nCount =*/ sprintf( sBuffer,"%+i",nNumExp );
+ sNumExpStrg = OUString::createFromAscii( sBuffer );
+ nExpExp = static_cast<short>(get_number_of_digits( static_cast<double>(nNumExp) ));
+}
+
+
+short SbxBasicFormater::GetDigitAtPosScan( short nPos, bool& bFoundFirstDigit )
+{
+ // trying to read a higher digit,
+ // e. g. position 4 in 1.234,
+ // or to read a digit outside of the
+ // number's dissolution (double)
+ if( nPos>nNumExp || abs(nNumExp-nPos)>MAX_NO_OF_DIGITS )
+ {
+ return NO_DIGIT_;
+ }
+ // determine the index of the position in the number-string:
+ // skip the leading sign
+ sal_uInt16 no = 1;
+ // skip the decimal point if necessary
+ if( nPos<nNumExp )
+ no++;
+ no += nNumExp-nPos;
+ // query of the number's first valid digit --> set flag
+ if( nPos==nNumExp )
+ bFoundFirstDigit = true;
+ return static_cast<short>(sSciNumStrg[ no ] - '0');
+}
+
+short SbxBasicFormater::GetDigitAtPosExpScan( short nPos, bool& bFoundFirstDigit )
+{
+ if( nPos>nExpExp )
+ return -1;
+
+ sal_uInt16 no = 1;
+ no += nExpExp-nPos;
+
+ if( nPos==nExpExp )
+ bFoundFirstDigit = true;
+ return static_cast<short>(sNumExpStrg[ no ] - '0');
+}
+
+// a value for the exponent can be given because the number maybe shall
+// not be displayed in a normed way (e. g. 1.2345e-03) but maybe 123.345e-3 !
+short SbxBasicFormater::GetDigitAtPosExpScan( double dNewExponent, short nPos,
+ bool& bFoundFirstDigit )
+{
+ InitExp( dNewExponent );
+
+ return GetDigitAtPosExpScan( nPos,bFoundFirstDigit );
+}
+
+// Copies the respective part of the format-string, if existing, and returns it.
+// So a new string is created, which has to be freed by the caller later.
+OUString SbxBasicFormater::GetPosFormatString( const OUString& sFormatStrg, bool & bFound )
+{
+ bFound = false; // default...
+ sal_Int32 nPos = sFormatStrg.indexOf( FORMAT_SEPARATOR );
+
+ if( nPos >= 0 )
+ {
+ bFound = true;
+ // the format-string for positive numbers is
+ // everything before the first ';'
+ return sFormatStrg.copy( 0,nPos );
+ }
+
+ return OUString();
+}
+
+// see also GetPosFormatString()
+OUString SbxBasicFormater::GetNegFormatString( const OUString& sFormatStrg, bool & bFound )
+{
+ bFound = false; // default...
+ sal_Int32 nPos = sFormatStrg.indexOf( FORMAT_SEPARATOR );
+
+ if( nPos >= 0)
+ {
+ // the format-string for negative numbers is
+ // everything between the first and the second ';'
+ OUString sTempStrg = sFormatStrg.copy( nPos+1 );
+ nPos = sTempStrg.indexOf( FORMAT_SEPARATOR );
+ bFound = true;
+ if( nPos < 0 )
+ {
+ return sTempStrg;
+ }
+ else
+ {
+ return sTempStrg.copy( 0,nPos );
+ }
+ }
+ return OUString();
+}
+
+// see also GetPosFormatString()
+OUString SbxBasicFormater::Get0FormatString( const OUString& sFormatStrg, bool & bFound )
+{
+ bFound = false; // default...
+ sal_Int32 nPos = sFormatStrg.indexOf( FORMAT_SEPARATOR );
+
+ if( nPos >= 0 )
+ {
+ // the format string for the zero is
+ // everything after the second ';'
+ OUString sTempStrg = sFormatStrg.copy( nPos+1 );
+ nPos = sTempStrg.indexOf( FORMAT_SEPARATOR );
+ if( nPos >= 0 )
+ {
+ bFound = true;
+ sTempStrg = sTempStrg.copy( nPos+1 );
+ nPos = sTempStrg.indexOf( FORMAT_SEPARATOR );
+ if( nPos < 0 )
+ {
+ return sTempStrg;
+ }
+ else
+ {
+ return sTempStrg.copy( 0,nPos );
+ }
+ }
+ }
+
+ return OUString();
+}
+
+// see also GetPosFormatString()
+OUString SbxBasicFormater::GetNullFormatString( const OUString& sFormatStrg, bool & bFound )
+{
+ bFound = false; // default...
+ sal_Int32 nPos = sFormatStrg.indexOf( FORMAT_SEPARATOR );
+
+ if( nPos >= 0 )
+ {
+ // the format-string for the Null is
+ // everything after the third ';'
+ OUString sTempStrg = sFormatStrg.copy( nPos+1 );
+ nPos = sTempStrg.indexOf( FORMAT_SEPARATOR );
+ if( nPos >= 0 )
+ {
+ sTempStrg = sTempStrg.copy( nPos+1 );
+ nPos = sTempStrg.indexOf( FORMAT_SEPARATOR );
+ if( nPos >= 0 )
+ {
+ bFound = true;
+ return sTempStrg.copy( nPos+1 );
+ }
+ }
+ }
+
+ return OUString();
+}
+
+// returns value <> 0 in case of an error
+void SbxBasicFormater::AnalyseFormatString( const OUString& sFormatStrg,
+ short& nNoOfDigitsLeft, short& nNoOfDigitsRight,
+ short& nNoOfOptionalDigitsLeft,
+ short& nNoOfExponentDigits, short& nNoOfOptionalExponentDigits,
+ bool& bPercent, bool& bCurrency, bool& bScientific,
+ bool& bGenerateThousandSeparator,
+ short& nMultipleThousandSeparators )
+{
+ sal_Int32 nLen;
+ short nState = 0;
+
+ nLen = sFormatStrg.getLength();
+ nNoOfDigitsLeft = 0;
+ nNoOfDigitsRight = 0;
+ nNoOfOptionalDigitsLeft = 0;
+ nNoOfExponentDigits = 0;
+ nNoOfOptionalExponentDigits = 0;
+ bPercent = false;
+ bCurrency = false;
+ bScientific = false;
+ // from 11.7.97: as soon as a comma (point?) is found in the format string,
+ // all three decimal powers are marked (i. e. thousand, million, ...)
+ bGenerateThousandSeparator = sFormatStrg.indexOf( ',' ) >= 0;
+ nMultipleThousandSeparators = 0;
+
+ for( sal_Int32 i = 0; i < nLen; i++ )
+ {
+ sal_Unicode c = sFormatStrg[ i ];
+ switch( c )
+ {
+ case '#':
+ case '0':
+ if( nState==0 )
+ {
+ nNoOfDigitsLeft++;
+// TODO here maybe better error inspection of the mantissa for valid syntax (see grammar)h
+ // ATTENTION: 'undefined' behaviour if # and 0 are combined!
+ // REMARK: #-placeholders are actually useless for
+ // scientific display before the decimal point!
+ if( c=='#' )
+ {
+ nNoOfOptionalDigitsLeft++;
+ }
+ }
+ else if( nState==1 )
+ {
+ nNoOfDigitsRight++;
+ }
+ else if( nState==-1 ) // search 0 in the exponent
+ {
+ if( c=='#' ) // # switches on the condition
+ {
+ nNoOfOptionalExponentDigits++;
+ nState = -2;
+ }
+ nNoOfExponentDigits++;
+ }
+ else if( nState==-2 ) // search # in the exponent
+ {
+ if( c=='0' )
+ {
+ // ERROR: 0 after # in the exponent is NOT allowed!!
+ return;
+ }
+ nNoOfOptionalExponentDigits++;
+ nNoOfExponentDigits++;
+ }
+ break;
+ case '.':
+ nState++;
+ if( nState>1 )
+ {
+ return; // ERROR: too many decimal points
+ }
+ break;
+ case '%':
+ bPercent = true;
+ break;
+ case '(':
+ bCurrency = true;
+ break;
+ case ',':
+ {
+ sal_Unicode ch = sFormatStrg[ i+1 ];
+
+ if( ch!=0 && (ch==',' || ch=='.') )
+ {
+ nMultipleThousandSeparators++;
+ }
+ }
+ break;
+ case 'e':
+ case 'E':
+ // #i13821 not when no digits before
+ if( nNoOfDigitsLeft > 0 || nNoOfDigitsRight > 0 )
+ {
+ nState = -1; // abort counting digits
+ bScientific = true;
+ }
+ break;
+ // OWN command-character which turns on
+ // the creation of thousand-separators
+ case '\\':
+ // Ignore next char
+ i++;
+ break;
+ case CREATE_1000SEP_CHAR:
+ bGenerateThousandSeparator = true;
+ break;
+ }
+ }
+}
+
+// the flag bCreateSign says that at the mantissa a leading sign
+// shall be created
+void SbxBasicFormater::ScanFormatString( double dNumber,
+ const OUString& sFormatStrg, OUString& sReturnStrgFinal,
+ bool bCreateSign )
+{
+ short /*nErr,*/nNoOfDigitsLeft,nNoOfDigitsRight,nNoOfOptionalDigitsLeft,
+ nNoOfExponentDigits,nNoOfOptionalExponentDigits,
+ nMultipleThousandSeparators;
+ bool bPercent,bCurrency,bScientific,bGenerateThousandSeparator;
+
+ OUStringBuffer sReturnStrg(32);
+
+ // analyse the format-string, i. e. determine the following values:
+ /*
+ - number of digits before decimal point
+ - number of digits after decimal point
+ - optional digits before decimal point
+ - number of digits in the exponent
+ - optional digits in the exponent
+ - percent-character found?
+ - () for negative leading sign?
+ - exponential-notation?
+ - shall thousand-separators be generated?
+ - is a percent-character being found? --> dNumber *= 100.0;
+ - are there thousand-separators in a row?
+ ,, or ,. --> dNumber /= 1000.0;
+ - other errors? multiple decimal points, E's, etc.
+ --> errors are simply ignored at the moment
+ */
+ AnalyseFormatString( sFormatStrg, nNoOfDigitsLeft, nNoOfDigitsRight,
+ nNoOfOptionalDigitsLeft, nNoOfExponentDigits,
+ nNoOfOptionalExponentDigits,
+ bPercent, bCurrency, bScientific,
+ bGenerateThousandSeparator, nMultipleThousandSeparators );
+ // special handling for special characters
+ if( bPercent )
+ {
+ dNumber *= 100.0;
+ }
+// TODO: this condition (,, or ,.) is NOT Visual-Basic compatible!
+ // Question: shall this stay here (requirements)?
+ if( nMultipleThousandSeparators )
+ {
+ dNumber /= 1000.0;
+ }
+ double dExponent;
+ short i,nLen;
+ short nState,nDigitPos,nExponentPos,nMaxDigit,nMaxExponentDigit;
+ bool bFirstDigit,bFirstExponentDigit,bFoundFirstDigit,
+ bIsNegative,bZeroSpaceOn, bSignHappend,bDigitPosNegative;
+
+ bSignHappend = false;
+ bFoundFirstDigit = false;
+ bIsNegative = dNumber < 0.0;
+ nLen = sFormatStrg.getLength();
+ dExponent = get_number_of_digits( dNumber );
+ nExponentPos = 0;
+ nMaxExponentDigit = 0;
+ nMaxDigit = static_cast<short>(dExponent);
+ bDigitPosNegative = false;
+ if( bScientific )
+ {
+ dExponent = dExponent - static_cast<double>(nNoOfDigitsLeft-1);
+ nDigitPos = nMaxDigit;
+ nMaxExponentDigit = static_cast<short>(get_number_of_digits( dExponent ));
+ nExponentPos = nNoOfExponentDigits - 1 - nNoOfOptionalExponentDigits;
+ }
+ else
+ {
+ nDigitPos = nNoOfDigitsLeft - 1; // counting starts at 0, 10^0
+ // no exponent-data is needed here!
+ bDigitPosNegative = (nDigitPos < 0);
+ }
+ bFirstDigit = true;
+ bFirstExponentDigit = true;
+ nState = 0; // 0 --> mantissa; 1 --> exponent
+ bZeroSpaceOn = false;
+
+
+ InitScan( dNumber );
+ // scanning the format-string:
+ sal_Unicode cForce = 0;
+ for( i = 0; i < nLen; i++ )
+ {
+ sal_Unicode c;
+ if( cForce )
+ {
+ c = cForce;
+ cForce = 0;
+ }
+ else
+ {
+ c = sFormatStrg[ i ];
+ }
+ switch( c )
+ {
+ case '0':
+ case '#':
+ if( nState==0 )
+ {
+ // handling of the mantissa
+ if( bFirstDigit )
+ {
+ // remark: at bCurrency the negative
+ // leading sign shall be shown with ()
+ if( bIsNegative && !bCreateSign && !bSignHappend )
+ {
+ bSignHappend = true;
+ sReturnStrg.append('-');
+ }
+ // output redundant positions, i. e. those which
+ // are undocumented by the format-string
+ if( nMaxDigit > nDigitPos )
+ {
+ for( short j = nMaxDigit; j > nDigitPos; j-- )
+ {
+ short nTempDigit = GetDigitAtPosScan( j, bFoundFirstDigit );
+ AppendDigit( sReturnStrg, nTempDigit );
+ if( nTempDigit != NO_DIGIT_ )
+ {
+ bFirstDigit = false;
+ }
+ // coverity[copy_paste_error : FALSE] - this is correct and nDigitPos should not be j
+ if( bGenerateThousandSeparator && ( c=='0' || nMaxDigit >= nDigitPos ) && j > 0 && (j % 3 == 0) )
+ {
+ sReturnStrg.append(cThousandSep );
+ }
+ }
+ }
+ }
+
+ if( nMaxDigit<nDigitPos && ( c=='0' || bZeroSpaceOn ) )
+ {
+ AppendDigit( sReturnStrg, 0 );
+ bFirstDigit = false;
+ bZeroSpaceOn = true;
+ // Remark: in Visual-Basic the first 0 turns on the 0 for
+ // all the following # (up to the decimal point),
+ // this behaviour is simulated here with the flag.
+ if (bGenerateThousandSeparator && c == '0' && nDigitPos > 0 && (nDigitPos % 3 == 0))
+ {
+ sReturnStrg.append(cThousandSep);
+ }
+ }
+ else
+ {
+ short nTempDigit = GetDigitAtPosScan( nDigitPos, bFoundFirstDigit ) ;
+ AppendDigit( sReturnStrg, nTempDigit );
+
+ if( nTempDigit != NO_DIGIT_ )
+ {
+ bFirstDigit = false;
+ }
+ if( bGenerateThousandSeparator && ( c=='0' || nMaxDigit>=nDigitPos ) && nDigitPos>0 && (nDigitPos % 3 == 0) )
+ {
+ sReturnStrg.append(cThousandSep);
+ }
+ }
+ nDigitPos--;
+ }
+ else
+ {
+ // handling the exponent
+ if( bFirstExponentDigit )
+ {
+ // leading sign has been given out at e/E already
+ bFirstExponentDigit = false;
+ if( nMaxExponentDigit > nExponentPos )
+ // output redundant positions, i. e. those which
+ // are undocumented by the format-string
+ {
+ for( short j = nMaxExponentDigit; j > nExponentPos; j-- )
+ {
+ AppendDigit( sReturnStrg, GetDigitAtPosExpScan( dExponent, j, bFoundFirstDigit ) );
+ }
+ }
+ }
+
+ if( nMaxExponentDigit < nExponentPos && c=='0' )
+ {
+ AppendDigit( sReturnStrg, 0 );
+ }
+ else
+ {
+ AppendDigit( sReturnStrg, GetDigitAtPosExpScan( dExponent, nExponentPos, bFoundFirstDigit ) );
+ }
+ nExponentPos--;
+ }
+ break;
+ case '.':
+ if( bDigitPosNegative ) // #i13821: If no digits before .
+ {
+ bDigitPosNegative = false;
+ nDigitPos = 0;
+ cForce = '#';
+ i-=2;
+ break;
+ }
+ sReturnStrg.append(cDecPoint);
+ break;
+ case '%':
+ // maybe remove redundant 0s, e. g. 4.500e4 in 0.0##e-00
+ ParseBack( sReturnStrg, sFormatStrg, i-1 );
+ sReturnStrg.append('%');
+ break;
+ case 'e':
+ case 'E':
+ // does mantissa have to be rounded, before the exponent is displayed?
+ {
+ // is there a mantissa at all?
+ if( bFirstDigit )
+ {
+ // apparently not, i. e. invalid format string, e. g. E000.00
+ // so ignore these e and E characters
+ // maybe output an error (like in Visual Basic)?
+
+ // #i13821: VB 6 behaviour
+ sReturnStrg.append(c);
+ break;
+ }
+
+ bool bOverflow = false;
+ short nNextDigit = GetDigitAtPosScan( nDigitPos, bFoundFirstDigit );
+ if( nNextDigit>=5 )
+ {
+ StrRoundDigit( sReturnStrg, sReturnStrg.getLength() - 1, bOverflow );
+ }
+ if( bOverflow )
+ {
+ // a leading 9 has been rounded
+ LeftShiftDecimalPoint( sReturnStrg );
+ sReturnStrg[sReturnStrg.getLength() - 1] = 0;
+ dExponent += 1.0;
+ }
+ // maybe remove redundant 0s, e. g. 4.500e4 in 0.0##e-00
+ ParseBack( sReturnStrg, sFormatStrg, i-1 );
+ }
+ // change the scanner's condition
+ nState++;
+ // output exponent character
+ sReturnStrg.append(c);
+ // i++; // MANIPULATION of the loop-variable!
+ c = sFormatStrg[ ++i ];
+ // output leading sign / exponent
+ if( c != 0 )
+ {
+ if( c == '-' )
+ {
+ if( dExponent < 0.0 )
+ {
+ sReturnStrg.append('-');
+ }
+ }
+ else if( c == '+' )
+ {
+ if( dExponent < 0.0 )
+ {
+ sReturnStrg.append('-');
+ }
+ else
+ {
+ sReturnStrg.append('+');
+ }
+ }
+ }
+ break;
+ case ',':
+ break;
+ case ';':
+ break;
+ case '(':
+ case ')':
+ // maybe remove redundant 0s, e. g. 4.500e4 in 0.0##e-00
+ ParseBack( sReturnStrg, sFormatStrg, i-1 );
+ if( bIsNegative )
+ {
+ sReturnStrg.append(c);
+ }
+ break;
+ case '$':
+ // append the string for the currency:
+ sReturnStrg.append(sCurrencyStrg);
+ break;
+ case ' ':
+ case '-':
+ case '+':
+ ParseBack( sReturnStrg, sFormatStrg, i-1 );
+ sReturnStrg.append(c);
+ break;
+ case '\\':
+ ParseBack( sReturnStrg, sFormatStrg, i-1 );
+ // special character found, output next
+ // character directly (if existing)
+ c = sFormatStrg[ ++i ];
+ if( c!=0 )
+ {
+ sReturnStrg.append(c);
+ }
+ break;
+ case CREATE_1000SEP_CHAR:
+ // ignore here, action has already been
+ // executed in AnalyseFormatString
+ break;
+ default:
+ // output characters and digits, too (like in Visual-Basic)
+ if( ( c>='a' && c<='z' ) ||
+ ( c>='A' && c<='Z' ) ||
+ ( c>='1' && c<='9' ) )
+ {
+ sReturnStrg.append(c);
+ }
+ }
+ }
+
+ // scan completed - rounding necessary?
+ if( !bScientific )
+ {
+ short nNextDigit = GetDigitAtPosScan( nDigitPos, bFoundFirstDigit );
+ if( nNextDigit>=5 )
+ {
+ StrRoundDigit( sReturnStrg, sReturnStrg.getLength() - 1 );
+ }
+ }
+
+ if( nNoOfDigitsRight>0 )
+ {
+ ParseBack( sReturnStrg, sFormatStrg, sFormatStrg.getLength()-1 );
+ }
+ sReturnStrgFinal = sReturnStrg.makeStringAndClear();
+}
+
+OUString SbxBasicFormater::BasicFormatNull( const OUString& sFormatStrg )
+{
+ bool bNullFormatFound;
+ OUString sNullFormatStrg = GetNullFormatString( sFormatStrg, bNullFormatFound );
+
+ if( bNullFormatFound )
+ {
+ return sNullFormatStrg;
+ }
+ return "null";
+}
+
+OUString SbxBasicFormater::BasicFormat( double dNumber, const OUString& _sFormatStrg )
+{
+ bool bPosFormatFound,bNegFormatFound,b0FormatFound;
+ OUString sFormatStrg = _sFormatStrg;
+
+ // analyse format-string concerning predefined formats:
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_GENERALNUMBER ) )
+ {
+ sFormatStrg = GENERALNUMBER_FORMAT;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_CURRENCY ) )
+ {
+ sFormatStrg = sCurrencyFormatStrg;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_FIXED ) )
+ {
+ sFormatStrg = FIXED_FORMAT;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_STANDARD ) )
+ {
+ sFormatStrg = STANDARD_FORMAT;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_PERCENT ) )
+ {
+ sFormatStrg = PERCENT_FORMAT;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_SCIENTIFIC ) )
+ {
+ sFormatStrg = SCIENTIFIC_FORMAT;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_YESNO ) )
+ {
+ return ( dNumber==0.0 ) ? sNoStrg : sYesStrg ;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_TRUEFALSE ) )
+ {
+ return ( dNumber==0.0 ) ? sFalseStrg : sTrueStrg ;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_ONOFF ) )
+ {
+ return ( dNumber==0.0 ) ? sOffStrg : sOnStrg ;
+ }
+
+ // analyse format-string concerning ';', i. e. format-strings for
+ // positive-, negative- and 0-values
+ OUString sPosFormatStrg = GetPosFormatString( sFormatStrg, bPosFormatFound );
+ OUString sNegFormatStrg = GetNegFormatString( sFormatStrg, bNegFormatFound );
+ OUString s0FormatStrg = Get0FormatString( sFormatStrg, b0FormatFound );
+
+ OUString sReturnStrg;
+ OUString sTempStrg;
+
+ if( dNumber==0.0 )
+ {
+ sTempStrg = sFormatStrg;
+ if( b0FormatFound )
+ {
+ if( s0FormatStrg.isEmpty() && bPosFormatFound )
+ {
+ sTempStrg = sPosFormatStrg;
+ }
+ else
+ {
+ sTempStrg = s0FormatStrg;
+ }
+ }
+ else if( bPosFormatFound )
+ {
+ sTempStrg = sPosFormatStrg;
+ }
+ ScanFormatString( dNumber, sTempStrg, sReturnStrg,/*bCreateSign=*/false );
+ }
+ else
+ {
+ if( dNumber<0.0 )
+ {
+ if( bNegFormatFound )
+ {
+ if( sNegFormatStrg.isEmpty() && bPosFormatFound )
+ {
+ sTempStrg = "-" + sPosFormatStrg;
+ }
+ else
+ {
+ sTempStrg = sNegFormatStrg;
+ }
+ }
+ else
+ {
+ sTempStrg = sFormatStrg;
+ }
+ // if NO format-string especially for negative
+ // values is given, output the leading sign
+ ScanFormatString( dNumber, sTempStrg, sReturnStrg,/*bCreateSign=*/bNegFormatFound/*sNegFormatStrg!=EMPTYFORMATSTRING*/ );
+ }
+ else // if( dNumber>0.0 )
+ {
+ ScanFormatString( dNumber,
+ (/*sPosFormatStrg!=EMPTYFORMATSTRING*/bPosFormatFound ? sPosFormatStrg : sFormatStrg),
+ sReturnStrg,/*bCreateSign=*/false );
+ }
+ }
+ return sReturnStrg;
+}
+
+bool SbxBasicFormater::isBasicFormat( const OUString& sFormatStrg )
+{
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_GENERALNUMBER ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_CURRENCY ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_FIXED ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_STANDARD ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_PERCENT ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_SCIENTIFIC ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_YESNO ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_TRUEFALSE ) )
+ {
+ return true;
+ }
+ if( sFormatStrg.equalsIgnoreAsciiCase( BASICFORMAT_ONOFF ) )
+ {
+ return true;
+ }
+ return false;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxint.cxx b/basic/source/sbx/sbxint.cxx
new file mode 100644
index 000000000..a28b810eb
--- /dev/null
+++ b/basic/source/sbx/sbxint.cxx
@@ -0,0 +1,905 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#include <o3tl/float_int_conversion.hxx>
+#include <o3tl/safeint.hxx>
+#include <vcl/errcode.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+#include <rtl/math.hxx>
+
+sal_Int16 ImpGetInteger( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_Int16 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar; break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ if( p->nUShort > o3tl::make_unsigned(SbxMAXINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(p->nUShort);
+ break;
+ case SbxLONG:
+ if( p->nLong > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else if( p->nLong < SbxMININT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMININT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(p->nLong);
+ break;
+ case SbxULONG:
+ if( p->nULong > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(p->nULong);
+ break;
+ case SbxSINGLE:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(p->nSingle), SbxMAXINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(p->nSingle), SbxMININT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMININT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(rtl::math::round( p->nSingle ));
+ break;
+ case SbxCURRENCY:
+ {
+ sal_Int64 tstVal = p->nInt64 / sal_Int64(CURRENCY_FACTOR);
+
+ if( tstVal > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else if( tstVal < SbxMININT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMININT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(tstVal);
+ break;
+ }
+ case SbxSALINT64:
+ if( p->nInt64 > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else if( p->nInt64 < SbxMININT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMININT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(p->nInt64);
+ break;
+ case SbxSALUINT64:
+ if( p->uInt64 > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(p->uInt64);
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double dVal = 0.0;
+ if( p->eType == SbxDECIMAL )
+ {
+ if( p->pDecimal )
+ p->pDecimal->getDouble( dVal );
+ }
+ else
+ dVal = p->nDouble;
+
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(dVal), SbxMAXINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(dVal), SbxMININT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMININT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(rtl::math::round( dVal ));
+ break;
+ }
+ case SbxLPSTR:
+ case SbxSTRING:
+ case SbxBYREF | SbxSTRING:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( !o3tl::convertsToAtMost(o3tl::roundAway(d), SbxMAXINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXINT;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(d), SbxMININT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMININT;
+ }
+ else
+ nRes = static_cast<sal_Int16>(rtl::math::round( d ));
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetInteger();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar; break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger; break;
+
+ // from here had to be tested
+ case SbxBYREF | SbxLONG:
+ aTmp.nLong = *p->pLong; goto ref;
+ case SbxBYREF | SbxULONG:
+ aTmp.nULong = *p->pULong; goto ref;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ aTmp.nUShort = *p->pUShort; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutInteger( SbxValues* p, sal_Int16 n )
+{
+ SbxValues aTmp;
+start:
+ switch( +p->eType )
+ {
+ // here had to be tested
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ case SbxSALUINT64:
+ aTmp.puInt64 = &p->uInt64; goto direct;
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ // from here no tests needed
+ case SbxINTEGER:
+ case SbxBOOL:
+ p->nInteger = n; break;
+ case SbxLONG:
+ p->nLong = n; break;
+ case SbxSINGLE:
+ p->nSingle = n; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+ case SbxCURRENCY:
+ p->nInt64 = n * CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ p->nInt64 = n; break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ ImpCreateDecimal( p )->setInt( n );
+ break;
+
+ case SbxLPSTR:
+ case SbxSTRING:
+ case SbxBYREF | SbxSTRING:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ ImpCvtNum( static_cast<double>(n), 0, *p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutInteger( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ if( n < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCHAR;
+ }
+ *p->pChar = static_cast<char>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( n > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ *p->pInteger = n; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ *p->pLong = static_cast<sal_Int32>(n); break;
+ case SbxBYREF | SbxULONG:
+ if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pULong = static_cast<sal_uInt32>(n); break;
+ case SbxBYREF | SbxCURRENCY:
+ *p->pnInt64 = n * CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = n; break;
+ case SbxBYREF | SbxSALUINT64:
+ if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ *p->puInt64 = 0;
+ }
+ else
+ *p->puInt64 = n;
+ break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = static_cast<float>(n); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = static_cast<double>(n); break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+
+// sal_Int64 / hyper
+
+sal_Int64 ImpDoubleToSalInt64( double d )
+{
+ sal_Int64 nRes;
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(d), SAL_MAX_INT64) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MAX_INT64;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(d), SAL_MIN_INT64) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MIN_INT64;
+ }
+ else
+ nRes = static_cast<sal_Int64>(rtl::math::round( d ));
+ return nRes;
+}
+
+sal_uInt64 ImpDoubleToSalUInt64( double d )
+{
+ sal_uInt64 nRes;
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(d), SAL_MAX_UINT64) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MAX_UINT64;
+ }
+ else if( d < 0.0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt64>(rtl::math::round( d ));
+ return nRes;
+}
+
+
+double ImpSalUInt64ToDouble( sal_uInt64 n )
+{
+ double d = 0.0;
+ if( n > SAL_MAX_INT64 )
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ else
+ d = static_cast<double>(static_cast<sal_Int64>(n));
+ return d;
+}
+
+
+sal_Int64 ImpGetInt64( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_Int64 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar; break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = static_cast<sal_Int64>(p->nUShort); break;
+ case SbxLONG:
+ nRes = static_cast<sal_Int64>(p->nLong); break;
+ case SbxULONG:
+ nRes = static_cast<sal_Int64>(p->nULong); break;
+ case SbxSINGLE:
+ nRes = static_cast<sal_Int64>(p->nSingle);
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ nRes = static_cast<sal_Int64>(p->nDouble);
+ break;
+ case SbxCURRENCY:
+ nRes = p->nInt64 / CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ nRes = p->nInt64; break;
+ case SbxSALUINT64:
+ if( p->uInt64 > SAL_MAX_INT64 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MAX_INT64;
+ }
+ else
+ nRes = static_cast<sal_Int64>(p->uInt64);
+ break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ ::OString aOStr = OUStringToOString( *p->pOUString, RTL_TEXTENCODING_ASCII_US );
+ nRes = aOStr.toInt64();
+ if( nRes == 0 )
+ {
+ // Check if really 0 or invalid conversion
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else
+ nRes = static_cast<sal_Int64>(d);
+ }
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetInt64();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar; break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger; break;
+ case SbxBYREF | SbxLONG:
+ nRes = *p->pLong; break;
+ case SbxBYREF | SbxULONG:
+ nRes = *p->pULong; break;
+ case SbxBYREF | SbxCURRENCY:
+ nRes = p->nInt64 / CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALINT64:
+ nRes = *p->pnInt64; break;
+
+ // from here the values has to be checked
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ aTmp.nUShort = *p->pUShort; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutInt64( SbxValues* p, sal_Int64 n )
+{
+ SbxValues aTmp;
+
+start:
+ switch( +p->eType )
+ {
+ // Check necessary
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ case SbxLONG:
+ aTmp.pnInt64 = &p->nInt64; goto direct;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ aTmp.pnInt64 = &p->nInt64; goto direct;
+ case SbxSALUINT64:
+ aTmp.puInt64 = &p->uInt64; goto direct;
+
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ case SbxSINGLE:
+ p->nSingle = static_cast<float>(n); break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = static_cast<double>(n); break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ {
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+
+ ::OString aOStr = OString::number( n );
+ (*p->pOUString) = ::OStringToOUString( aOStr, RTL_TEXTENCODING_ASCII_US );
+ break;
+ }
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutInt64( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ if( n > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCHAR;
+ }
+ else if( n < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( n > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( n > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ else if( n < SbxMININT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMININT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( n > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXUINT;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ if( n > SbxMAXLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXLNG;
+ }
+ else if( n < SbxMINLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINLNG;
+ }
+ *p->pLong = static_cast<sal_Int32>(n); break;
+ case SbxBYREF | SbxULONG:
+ if( n > SbxMAXULNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXULNG;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pULong = static_cast<sal_uInt32>(n); break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = static_cast<float>(n); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = static_cast<double>(n); break;
+ case SbxBYREF | SbxCURRENCY:
+ *p->pnInt64 = n * CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = n; break;
+ case SbxBYREF | SbxSALUINT64:
+ if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->puInt64 = n; break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+sal_uInt64 ImpGetUInt64( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_uInt64 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar; break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort; break;
+ case SbxLONG:
+ nRes = p->nLong; break;
+ case SbxULONG:
+ nRes = static_cast<sal_uInt64>(p->nULong); break;
+ case SbxSINGLE:
+ nRes = static_cast<sal_uInt64>(p->nSingle); break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ {
+//TODO overflow check
+ nRes = static_cast<sal_uInt64>(p->nDouble);
+ break;
+ }
+ case SbxCURRENCY:
+ nRes = p->nInt64 * CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ if( p->nInt64 < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt64>(p->nInt64);
+ break;
+ case SbxSALUINT64:
+ nRes = p->uInt64; break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ ::OString aOStr = OUStringToOString
+ ( *p->pOUString, RTL_TEXTENCODING_ASCII_US );
+ sal_Int64 n64 = aOStr.toInt64();
+ if( n64 == 0 )
+ {
+ // Check if really 0 or invalid conversion
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( !o3tl::convertsToAtMost(o3tl::roundAway(d), SAL_MAX_UINT64) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SAL_MAX_UINT64;
+ }
+ else if( d < 0.0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt64>(rtl::math::round( d ));
+ }
+ else if( n64 < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ {
+ nRes = n64;
+ }
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetUInt64();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar; break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger; break;
+ case SbxBYREF | SbxLONG:
+ nRes = *p->pLong; break;
+ case SbxBYREF | SbxULONG:
+ nRes = *p->pULong; break;
+ case SbxBYREF | SbxSALUINT64:
+ nRes = *p->puInt64; break;
+
+ // from here on the value has to be checked
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ aTmp.nUShort = *p->pUShort; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutUInt64( SbxValues* p, sal_uInt64 n )
+{
+ SbxValues aTmp;
+
+start:
+ switch( +p->eType )
+ {
+ // Check necessary
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ case SbxLONG:
+ aTmp.pnInt64 = &p->nInt64; goto direct;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ aTmp.pnInt64 = &p->nInt64; goto direct;
+ case SbxSINGLE:
+ aTmp.pSingle = &p->nSingle; goto direct;
+ case SbxDATE:
+ case SbxDOUBLE:
+ aTmp.pDouble = &p->nDouble; goto direct;
+
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ // Check not necessary
+ case SbxSALUINT64:
+ p->uInt64 = n; break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ if( n > SAL_MAX_INT64 )
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ else
+ {
+ ::OString aOStr = OString::number( n );
+ (*p->pOUString) = ::OStringToOUString( aOStr, RTL_TEXTENCODING_ASCII_US );
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutUInt64( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ if( n > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( n > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( n > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( n > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXUINT;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ if( n > SbxMAXLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXLNG;
+ }
+ *p->pLong = static_cast<sal_Int32>(n); break;
+ case SbxBYREF | SbxULONG:
+ if( n > SbxMAXULNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXULNG;
+ }
+ *p->pULong = static_cast<sal_uInt32>(n); break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pDouble = static_cast<float>(ImpSalUInt64ToDouble( n )); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+
+ *p->pDouble = ImpSalUInt64ToDouble( n ); break;
+ case SbxBYREF | SbxCURRENCY:
+ if ( n > ( SAL_MAX_INT64 / CURRENCY_FACTOR ) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ n = SAL_MAX_INT64;
+ }
+ *p->pnInt64 = static_cast<sal_Int64>( n * CURRENCY_FACTOR ); break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = n; break;
+ case SbxBYREF | SbxSALINT64:
+ if( n > SAL_MAX_INT64 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pnInt64 = static_cast<sal_Int64>(n); break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxlng.cxx b/basic/source/sbx/sbxlng.cxx
new file mode 100644
index 000000000..bda401b98
--- /dev/null
+++ b/basic/source/sbx/sbxlng.cxx
@@ -0,0 +1,318 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#include <o3tl/float_int_conversion.hxx>
+#include <vcl/errcode.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+#include <rtl/math.hxx>
+
+sal_Int32 ImpGetLong( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_Int32 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar; break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort; break;
+ case SbxLONG:
+ nRes = p->nLong; break;
+ case SbxULONG:
+ if( p->nULong > SbxMAXLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXLNG;
+ }
+ else
+ nRes = static_cast<sal_Int32>(p->nULong);
+ break;
+ case SbxSINGLE:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(p->nSingle), SbxMAXLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXLNG;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(p->nSingle), SbxMINLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINLNG;
+ }
+ else
+ nRes = static_cast<sal_Int32>(rtl::math::round( p->nSingle ));
+ break;
+ case SbxSALINT64:
+ nRes = p->nInt64;
+ break;
+ case SbxSALUINT64:
+ nRes = p->uInt64;
+ break;
+ case SbxCURRENCY:
+ {
+ sal_Int64 tstVal = p->nInt64 / CURRENCY_FACTOR;
+ nRes = static_cast<sal_Int32>(tstVal);
+ if( tstVal < SbxMINLNG || SbxMAXLNG < tstVal ) SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ if( SbxMAXLNG < tstVal ) nRes = SbxMAXLNG;
+ if( tstVal < SbxMINLNG ) nRes = SbxMINLNG;
+ break;
+ }
+ case SbxDATE:
+ case SbxDOUBLE:
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double dVal;
+ if( p->eType == SbxDECIMAL )
+ {
+ dVal = 0.0;
+ if( p->pDecimal )
+ p->pDecimal->getDouble( dVal );
+ }
+ else
+ dVal = p->nDouble;
+
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(dVal), SbxMAXLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXLNG;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(dVal), SbxMINLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINLNG;
+ }
+ else
+ nRes = static_cast<sal_Int32>(rtl::math::round( dVal ));
+ break;
+ }
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( !o3tl::convertsToAtMost(o3tl::roundAway(d), SbxMAXLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXLNG;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(d), SbxMINLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMINLNG;
+ }
+ else
+ nRes = static_cast<sal_Int32>(rtl::math::round( d ));
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetLong();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar; break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger; break;
+ case SbxBYREF | SbxLONG:
+ nRes = *p->pLong; break;
+
+ // from here had to be tested
+ case SbxBYREF | SbxULONG:
+ aTmp.nULong = *p->pULong; goto ref;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ aTmp.nUShort = *p->pUShort; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutLong( SbxValues* p, sal_Int32 n )
+{
+ SbxValues aTmp;
+
+start:
+ switch( +p->eType )
+ {
+ // From here had to be tested
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxSALUINT64:
+ aTmp.puInt64 = &p->uInt64; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort;
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ // from here no longer
+ case SbxLONG:
+ p->nLong = n; break;
+ case SbxSINGLE:
+ p->nSingle = static_cast<float>(n); break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+ case SbxCURRENCY:
+ p->nInt64 = n * CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ p->nInt64 = n; break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ ImpCreateDecimal( p )->setLong( n );
+ break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ ImpCvtNum( static_cast<double>(n), 0, *p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutLong( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ if( n > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCHAR;
+ }
+ else if( n < SbxMINCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( n > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( n > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ else if( n < SbxMININT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMININT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( n > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXUINT;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ *p->pLong = n; break;
+ case SbxBYREF | SbxULONG:
+ if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pULong = static_cast<sal_uInt32>(n); break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = n; break;
+ case SbxBYREF | SbxSALUINT64:
+ if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); *p->puInt64 = 0;
+ }
+ else
+ *p->puInt64 = n;
+ break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = static_cast<float>(n); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = static_cast<double>(n); break;
+ case SbxBYREF | SbxCURRENCY:
+ *p->pnInt64 = static_cast<sal_Int64>(n) * sal_Int64(CURRENCY_FACTOR); break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxobj.cxx b/basic/source/sbx/sbxobj.cxx
new file mode 100644
index 000000000..fe42fa193
--- /dev/null
+++ b/basic/source/sbx/sbxobj.cxx
@@ -0,0 +1,868 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+#include <sal/log.hxx>
+
+#include <iomanip>
+
+#include <tools/debug.hxx>
+#include <tools/stream.hxx>
+#include <basic/sbx.hxx>
+#include <basic/sberrors.hxx>
+#include <basic/sbxmeth.hxx>
+#include <sbxprop.hxx>
+#include <svl/SfxBroadcaster.hxx>
+#include "sbxres.hxx"
+
+
+static OUString pNameProp; // Name-Property
+static OUString pParentProp; // Parent-Property
+
+static sal_uInt16 nNameHash = 0, nParentHash = 0;
+
+
+SbxObject::SbxObject( const OUString& rClass )
+ : SbxVariable( SbxOBJECT ), aClassName( rClass )
+{
+ aData.pObj = this;
+ if( !nNameHash )
+ {
+ pNameProp = GetSbxRes( StringId::NameProp );
+ pParentProp = GetSbxRes( StringId::ParentProp );
+ nNameHash = MakeHashCode( pNameProp );
+ nParentHash = MakeHashCode( pParentProp );
+ }
+ SbxObject::Clear();
+ SbxObject::SetName( rClass );
+}
+
+SbxObject::SbxObject( const SbxObject& rObj )
+ : SvRefBase( rObj ), SbxVariable( rObj.GetType() ),
+ SfxListener( rObj )
+{
+ *this = rObj;
+}
+
+SbxObject& SbxObject::operator=( const SbxObject& r )
+{
+ if( &r != this )
+ {
+ SbxVariable::operator=( r );
+ aClassName = r.aClassName;
+ pMethods = new SbxArray;
+ pProps = new SbxArray;
+ pObjs = new SbxArray( SbxOBJECT );
+ // The arrays were copied, the content taken over
+ *pMethods = *r.pMethods;
+ *pProps = *r.pProps;
+ *pObjs = *r.pObjs;
+ // Because the variables were taken over, this is OK
+ pDfltProp = r.pDfltProp;
+ SetName( r.GetName() );
+ SetFlags( r.GetFlags() );
+ SetModified( true );
+ }
+ return *this;
+}
+
+static void CheckParentsOnDelete( SbxObject* pObj, SbxArray* p )
+{
+ for( sal_uInt32 i = 0; i < p->Count32(); i++ )
+ {
+ SbxVariableRef& rRef = p->GetRef32( i );
+ if( rRef->IsBroadcaster() )
+ {
+ pObj->EndListening( rRef->GetBroadcaster(), true );
+ }
+ // does the element have more than one reference and still a Listener?
+ if( rRef->GetRefCount() > 1 )
+ {
+ rRef->SetParent( nullptr );
+ SAL_INFO_IF(rRef->IsBroadcaster() && rRef->GetBroadcaster().GetListenerCount(), "basic.sbx", "Object element with dangling parent");
+ }
+ }
+}
+
+SbxObject::~SbxObject()
+{
+ CheckParentsOnDelete( this, pProps.get() );
+ CheckParentsOnDelete( this, pMethods.get() );
+ CheckParentsOnDelete( this, pObjs.get() );
+
+ // avoid handling in ~SbxVariable as SbxFlagBits::DimAsNew == SbxFlagBits::GlobalSearch
+ ResetFlag( SbxFlagBits::DimAsNew );
+}
+
+SbxDataType SbxObject::GetType() const
+{
+ return SbxOBJECT;
+}
+
+SbxClassType SbxObject::GetClass() const
+{
+ return SbxClassType::Object;
+}
+
+void SbxObject::Clear()
+{
+ pMethods = new SbxArray;
+ pProps = new SbxArray;
+ pObjs = new SbxArray( SbxOBJECT );
+ SbxVariable* p;
+ p = Make( pNameProp, SbxClassType::Property, SbxSTRING );
+ p->SetFlag( SbxFlagBits::DontStore );
+ p = Make( pParentProp, SbxClassType::Property, SbxOBJECT );
+ p->ResetFlag( SbxFlagBits::Write );
+ p->SetFlag( SbxFlagBits::DontStore );
+ pDfltProp = nullptr;
+ SetModified( false );
+}
+
+void SbxObject::Notify( SfxBroadcaster&, const SfxHint& rHint )
+{
+ const SbxHint* p = dynamic_cast<const SbxHint*>(&rHint);
+ if( !p )
+ return;
+
+ const SfxHintId nId = p->GetId();
+ bool bRead = ( nId == SfxHintId::BasicDataWanted );
+ bool bWrite = ( nId == SfxHintId::BasicDataChanged );
+ SbxVariable* pVar = p->GetVar();
+ if( !(bRead || bWrite) )
+ return;
+
+ OUString aVarName( pVar->GetName() );
+ sal_uInt16 nHash_ = MakeHashCode( aVarName );
+ if( nHash_ == nNameHash && aVarName.equalsIgnoreAsciiCase( pNameProp ) )
+ {
+ if( bRead )
+ {
+ pVar->PutString( GetName() );
+ }
+ else
+ {
+ SetName( pVar->GetOUString() );
+ }
+ }
+ else if( nHash_ == nParentHash && aVarName.equalsIgnoreAsciiCase( pParentProp ) )
+ {
+ SbxObject* p_ = GetParent();
+ if( !p_ )
+ {
+ p_ = this;
+ }
+ pVar->PutObject( p_ );
+ }
+}
+
+bool SbxObject::IsClass( const OUString& rName ) const
+{
+ return aClassName.equalsIgnoreAsciiCase( rName );
+}
+
+SbxVariable* SbxObject::Find( const OUString& rName, SbxClassType t )
+{
+#ifdef DBG_UTIL
+ static int nLvl = 1;
+ static const char* pCls[] = { "DontCare","Array","Value","Variable","Method","Property","Object" };
+ SAL_INFO(
+ "basic.sbx",
+ "search" << std::setw(nLvl) << " "
+ << (t >= SbxClassType::DontCare && t <= SbxClassType::Object
+ ? pCls[static_cast<int>(t) - 1] : "Unknown class")
+ << " " << rName << " in " << SbxVariable::GetName());
+ ++nLvl;
+#endif
+
+ SbxVariable* pRes = nullptr;
+ pObjs->SetFlag( SbxFlagBits::ExtSearch );
+ if( t == SbxClassType::DontCare )
+ {
+ pRes = pMethods->Find( rName, SbxClassType::Method );
+ if( !pRes )
+ {
+ pRes = pProps->Find( rName, SbxClassType::Property );
+ }
+ if( !pRes )
+ {
+ pRes = pObjs->Find( rName, t );
+ }
+ }
+ else
+ {
+ SbxArray* pArray = nullptr;
+ switch( t )
+ {
+ case SbxClassType::Variable:
+ case SbxClassType::Property: pArray = pProps.get(); break;
+ case SbxClassType::Method: pArray = pMethods.get(); break;
+ case SbxClassType::Object: pArray = pObjs.get(); break;
+ default: SAL_WARN( "basic.sbx", "Invalid SBX-Class" ); break;
+ }
+ if( pArray )
+ {
+ pRes = pArray->Find( rName, t );
+ }
+ }
+ // Extended Search in the Object-Array?
+ // For objects and DontCare the array of objects has already been searched
+ if( !pRes && ( t == SbxClassType::Method || t == SbxClassType::Property ) )
+ pRes = pObjs->Find( rName, t );
+ // Search in the parents?
+ if( !pRes && IsSet( SbxFlagBits::GlobalSearch ) )
+ {
+ SbxObject* pCur = this;
+ while( !pRes && pCur->pParent )
+ {
+ // I myself was already searched!
+ SbxFlagBits nOwn = pCur->GetFlags();
+ pCur->ResetFlag( SbxFlagBits::ExtSearch );
+ // I search already global!
+ SbxFlagBits nPar = pCur->pParent->GetFlags();
+ pCur->pParent->ResetFlag( SbxFlagBits::GlobalSearch );
+ pRes = pCur->pParent->Find( rName, t );
+ pCur->SetFlags( nOwn );
+ pCur->pParent->SetFlags( nPar );
+ pCur = pCur->pParent;
+ }
+ }
+#ifdef DBG_UTIL
+ --nLvl;
+ SAL_INFO_IF(
+ pRes, "basic.sbx",
+ "found" << std::setw(nLvl) << " " << rName << " in "
+ << SbxVariable::GetName());
+#endif
+ return pRes;
+}
+
+// Abbreviated version: The parent-string will be searched
+// The whole thing recursive, because Call() might be overridden
+// Qualified names are allowed
+
+bool SbxObject::Call( const OUString& rName, SbxArray* pParam )
+{
+ SbxVariable* pMeth = FindQualified( rName, SbxClassType::DontCare);
+ if( dynamic_cast<const SbxMethod*>( pMeth) )
+ {
+ // FindQualified() might have struck already!
+ if( pParam )
+ {
+ pMeth->SetParameters( pParam );
+ }
+ pMeth->Broadcast( SfxHintId::BasicDataWanted );
+ pMeth->SetParameters( nullptr );
+ return true;
+ }
+ SetError( ERRCODE_BASIC_NO_METHOD );
+ return false;
+}
+
+SbxProperty* SbxObject::GetDfltProperty()
+{
+ if ( !pDfltProp && !aDfltPropName.isEmpty() )
+ {
+ pDfltProp = static_cast<SbxProperty*>( Find( aDfltPropName, SbxClassType::Property ) );
+ if( !pDfltProp )
+ {
+ pDfltProp = static_cast<SbxProperty*>( Make( aDfltPropName, SbxClassType::Property, SbxVARIANT ) );
+ }
+ }
+ return pDfltProp;
+}
+void SbxObject::SetDfltProperty( const OUString& rName )
+{
+ if ( rName != aDfltPropName )
+ {
+ pDfltProp = nullptr;
+ }
+ aDfltPropName = rName;
+ SetModified( true );
+}
+
+// Search of an already available variable. If it was located,
+// the index will be set, otherwise the Count of the Array will be returned.
+// In any case the correct Array will be returned.
+
+SbxArray* SbxObject::FindVar( SbxVariable const * pVar, sal_uInt32& nArrayIdx )
+{
+ SbxArray* pArray = nullptr;
+ if( pVar )
+ {
+ switch( pVar->GetClass() )
+ {
+ case SbxClassType::Variable:
+ case SbxClassType::Property: pArray = pProps.get(); break;
+ case SbxClassType::Method: pArray = pMethods.get(); break;
+ case SbxClassType::Object: pArray = pObjs.get(); break;
+ default: SAL_WARN( "basic.sbx", "Invalid SBX-Class" ); break;
+ }
+ }
+ if( pArray )
+ {
+ nArrayIdx = pArray->Count32();
+ // Is the variable per name available?
+ pArray->ResetFlag( SbxFlagBits::ExtSearch );
+ SbxVariable* pOld = pArray->Find( pVar->GetName(), pVar->GetClass() );
+ if( pOld )
+ {
+ for( sal_uInt32 i = 0; i < pArray->Count32(); i++ )
+ {
+ SbxVariableRef& rRef = pArray->GetRef32( i );
+ if( rRef.get() == pOld )
+ {
+ nArrayIdx = i; break;
+ }
+ }
+ }
+ }
+ return pArray;
+}
+
+// If a new object will be established, this object will be indexed,
+// if an object of this name exists already.
+
+SbxVariable* SbxObject::Make( const OUString& rName, SbxClassType ct, SbxDataType dt, bool bIsRuntimeFunction )
+{
+ // Is the object already available?
+ SbxArray* pArray = nullptr;
+ switch( ct )
+ {
+ case SbxClassType::Variable:
+ case SbxClassType::Property: pArray = pProps.get(); break;
+ case SbxClassType::Method: pArray = pMethods.get(); break;
+ case SbxClassType::Object: pArray = pObjs.get(); break;
+ default: SAL_WARN( "basic.sbx", "Invalid SBX-Class" ); break;
+ }
+ if( !pArray )
+ {
+ return nullptr;
+ }
+ // Collections may contain objects of the same name
+ if( !( ct == SbxClassType::Object && dynamic_cast<const SbxCollection*>( this ) != nullptr ) )
+ {
+ SbxVariable* pRes = pArray->Find( rName, ct );
+ if( pRes )
+ {
+ return pRes;
+ }
+ }
+ SbxVariable* pVar = nullptr;
+ switch( ct )
+ {
+ case SbxClassType::Variable:
+ case SbxClassType::Property:
+ pVar = new SbxProperty( rName, dt );
+ break;
+ case SbxClassType::Method:
+ pVar = new SbxMethod( rName, dt, bIsRuntimeFunction );
+ break;
+ case SbxClassType::Object:
+ pVar = CreateObject( rName );
+ break;
+ default:
+ break;
+ }
+ pVar->SetParent( this );
+ pArray->Put32( pVar, pArray->Count32() );
+ SetModified( true );
+ // The object listen always
+ StartListening(pVar->GetBroadcaster(), DuplicateHandling::Prevent);
+ return pVar;
+}
+
+void SbxObject::Insert( SbxVariable* pVar )
+{
+ sal_uInt32 nIdx;
+ SbxArray* pArray = FindVar( pVar, nIdx );
+ if( !pArray )
+ return;
+
+ // Into with it. But you should pay attention at the Pointer!
+ if( nIdx < pArray->Count32() )
+ {
+ // Then this element exists already
+ // There are objects of the same name allowed at collections
+ if( pArray == pObjs.get() && dynamic_cast<const SbxCollection*>( this ) != nullptr )
+ {
+ nIdx = pArray->Count32();
+ }
+ else
+ {
+ SbxVariable* pOld = pArray->Get32( nIdx );
+ // already inside: overwrite
+ if( pOld == pVar )
+ {
+ return;
+ }
+ EndListening( pOld->GetBroadcaster(), true );
+ if( pVar->GetClass() == SbxClassType::Property )
+ {
+ if( pOld == pDfltProp )
+ {
+ pDfltProp = static_cast<SbxProperty*>(pVar);
+ }
+ }
+ }
+ }
+ StartListening(pVar->GetBroadcaster(), DuplicateHandling::Prevent);
+ pArray->Put32( pVar, nIdx );
+ if( pVar->GetParent() != this )
+ {
+ pVar->SetParent( this );
+ }
+ SetModified( true );
+#ifdef DBG_UTIL
+ static const char* pCls[] =
+ { "DontCare","Array","Value","Variable","Method","Property","Object" };
+ OUString aVarName( pVar->GetName() );
+ if (const SbxObject *pSbxObj = aVarName.isEmpty() ? dynamic_cast<const SbxObject*>(pVar) : nullptr)
+ {
+ aVarName = pSbxObj->GetClassName();
+ }
+ SAL_INFO(
+ "basic.sbx",
+ "insert "
+ << ((pVar->GetClass() >= SbxClassType::DontCare
+ && pVar->GetClass() <= SbxClassType::Object)
+ ? pCls[static_cast<int>(pVar->GetClass()) - 1] : "Unknown class")
+ << " " << aVarName << " in " << SbxVariable::GetName());
+#endif
+}
+
+// Optimisation, Insertion without checking about
+// double entry and without broadcasts, will only be used in SO2/auto.cxx
+void SbxObject::QuickInsert( SbxVariable* pVar )
+{
+ SbxArray* pArray = nullptr;
+ if( pVar )
+ {
+ switch( pVar->GetClass() )
+ {
+ case SbxClassType::Variable:
+ case SbxClassType::Property: pArray = pProps.get(); break;
+ case SbxClassType::Method: pArray = pMethods.get(); break;
+ case SbxClassType::Object: pArray = pObjs.get(); break;
+ default: SAL_WARN( "basic.sbx", "Invalid SBX-Class" ); break;
+ }
+ }
+ if( !pArray )
+ return;
+
+ StartListening(pVar->GetBroadcaster(), DuplicateHandling::Prevent);
+ pArray->Put32( pVar, pArray->Count32() );
+ if( pVar->GetParent() != this )
+ {
+ pVar->SetParent( this );
+ }
+ SetModified( true );
+#ifdef DBG_UTIL
+ static const char* pCls[] =
+ { "DontCare","Array","Value","Variable","Method","Property","Object" };
+ OUString aVarName( pVar->GetName() );
+ if (const SbxObject *pSbxObj = aVarName.isEmpty() ? dynamic_cast<const SbxObject*>(pVar) : nullptr)
+ {
+ aVarName = pSbxObj->GetClassName();
+ }
+ SAL_INFO(
+ "basic.sbx",
+ "insert "
+ << ((pVar->GetClass() >= SbxClassType::DontCare
+ && pVar->GetClass() <= SbxClassType::Object)
+ ? pCls[static_cast<int>(pVar->GetClass()) - 1] : "Unknown class")
+ << " " << aVarName << " in " << SbxVariable::GetName());
+#endif
+}
+
+void SbxObject::Remove( const OUString& rName, SbxClassType t )
+{
+ Remove( SbxObject::Find( rName, t ) );
+}
+
+void SbxObject::Remove( SbxVariable* pVar )
+{
+ sal_uInt32 nIdx;
+ SbxArray* pArray = FindVar( pVar, nIdx );
+ if( !(pArray && nIdx < pArray->Count32()) )
+ return;
+
+#ifdef DBG_UTIL
+ OUString aVarName( pVar->GetName() );
+ if (const SbxObject *pSbxObj = aVarName.isEmpty() ? dynamic_cast<const SbxObject*>(pVar) : nullptr)
+ {
+ aVarName = pSbxObj->GetClassName();
+ }
+ SAL_INFO(
+ "basic.sbx",
+ "remove " << aVarName << " in " << SbxVariable::GetName());
+#endif
+ SbxVariableRef pVar_ = pArray->Get32( nIdx );
+ if( pVar_->IsBroadcaster() )
+ {
+ EndListening( pVar_->GetBroadcaster(), true );
+ }
+ if( pVar_.get() == pDfltProp )
+ {
+ pDfltProp = nullptr;
+ }
+ pArray->Remove( nIdx );
+ if( pVar_->GetParent() == this )
+ {
+ pVar_->SetParent( nullptr );
+ }
+ SetModified( true );
+}
+
+static bool LoadArray( SvStream& rStrm, SbxObject* pThis, SbxArray* pArray )
+{
+ SbxArrayRef p = static_cast<SbxArray*>( SbxBase::Load( rStrm ) );
+ if( !p.is() )
+ {
+ return false;
+ }
+ for( sal_uInt32 i = 0; i < p->Count32(); i++ )
+ {
+ SbxVariableRef& r = p->GetRef32( i );
+ SbxVariable* pVar = r.get();
+ if( pVar )
+ {
+ pVar->SetParent( pThis );
+ pThis->StartListening(pVar->GetBroadcaster(), DuplicateHandling::Prevent);
+ }
+ }
+ pArray->Merge( p.get() );
+ return true;
+}
+
+// The load of an object is additive!
+
+bool SbxObject::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ // Help for the read in of old objects: just return TRUE,
+ // LoadPrivateData() has to set the default status up
+ if( !nVer )
+ {
+ return true;
+ }
+ pDfltProp = nullptr;
+ if( !SbxVariable::LoadData( rStrm, nVer ) )
+ {
+ return false;
+ }
+ // If it contains no alien object, insert ourselves
+ if( aData.eType == SbxOBJECT && !aData.pObj )
+ {
+ aData.pObj = this;
+ }
+ sal_uInt32 nSize;
+ OUString aDfltProp;
+ aClassName = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm, RTL_TEXTENCODING_ASCII_US);
+ aDfltProp = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm, RTL_TEXTENCODING_ASCII_US);
+ sal_uInt64 nPos = rStrm.Tell();
+ rStrm.ReadUInt32( nSize );
+ sal_uInt64 const nNewPos = rStrm.Tell();
+ nPos += nSize;
+ DBG_ASSERT( nPos >= nNewPos, "SBX: Loaded too much data" );
+ if( nPos != nNewPos )
+ {
+ rStrm.Seek( nPos );
+ }
+ if( !LoadArray( rStrm, this, pMethods.get() ) ||
+ !LoadArray( rStrm, this, pProps.get() ) ||
+ !LoadArray( rStrm, this, pObjs.get() ) )
+ {
+ return false;
+ }
+ // Set properties
+ if( !aDfltProp.isEmpty() )
+ {
+ pDfltProp = static_cast<SbxProperty*>( pProps->Find( aDfltProp, SbxClassType::Property ) );
+ }
+ SetModified( false );
+ return true;
+}
+
+bool SbxObject::StoreData( SvStream& rStrm ) const
+{
+ if( !SbxVariable::StoreData( rStrm ) )
+ {
+ return false;
+ }
+ OUString aDfltProp;
+ if( pDfltProp )
+ {
+ aDfltProp = pDfltProp->GetName();
+ }
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, aClassName, RTL_TEXTENCODING_ASCII_US);
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, aDfltProp, RTL_TEXTENCODING_ASCII_US);
+ sal_uInt64 const nPos = rStrm.Tell();
+ rStrm.WriteUInt32( 0 );
+ sal_uInt64 const nNew = rStrm.Tell();
+ rStrm.Seek( nPos );
+ rStrm.WriteUInt32( nNew - nPos );
+ rStrm.Seek( nNew );
+ if( !pMethods->Store( rStrm ) )
+ {
+ return false;
+ }
+ if( !pProps->Store( rStrm ) )
+ {
+ return false;
+ }
+ if( !pObjs->Store( rStrm ) )
+ {
+ return false;
+ }
+ const_cast<SbxObject*>(this)->SetModified( false );
+ return true;
+}
+
+static bool CollectAttrs( const SbxBase* p, OUString& rRes )
+{
+ OUString aAttrs;
+ if( p->IsHidden() )
+ {
+ aAttrs = "Hidden";
+ }
+ if( p->IsSet( SbxFlagBits::ExtSearch ) )
+ {
+ if( !aAttrs.isEmpty() )
+ {
+ aAttrs += ",";
+ }
+ aAttrs += "ExtSearch";
+ }
+ if( !p->IsVisible() )
+ {
+ if( !aAttrs.isEmpty() )
+ {
+ aAttrs += ",";
+ }
+ aAttrs += "Invisible";
+ }
+ if( p->IsSet( SbxFlagBits::DontStore ) )
+ {
+ if( !aAttrs.isEmpty() )
+ {
+ aAttrs += ",";
+ }
+ aAttrs += "DontStore";
+ }
+ if( !aAttrs.isEmpty() )
+ {
+ rRes = " (" + aAttrs + ")";
+ return true;
+ }
+ else
+ {
+ rRes.clear();
+ return false;
+ }
+}
+
+void SbxObject::Dump( SvStream& rStrm, bool bFill )
+{
+ // Shifting
+ static sal_uInt16 nLevel = 0;
+ if ( nLevel > 10 )
+ {
+ rStrm.WriteCharPtr( "<too deep>" ) << endl;
+ return;
+ }
+ ++nLevel;
+ OUString aIndent("");
+ for ( sal_uInt16 n = 1; n < nLevel; ++n )
+ {
+ aIndent += " ";
+ }
+ // Output the data of the object itself
+ OString aNameStr(OUStringToOString(GetName(), RTL_TEXTENCODING_ASCII_US));
+ OString aClassNameStr(OUStringToOString(aClassName, RTL_TEXTENCODING_ASCII_US));
+ rStrm.WriteCharPtr( "Object( " )
+ .WriteOString( OString::number(reinterpret_cast<sal_Int64>(this)) ).WriteCharPtr( "=='" )
+ .WriteCharPtr( aNameStr.isEmpty() ? "<unnamed>" : aNameStr.getStr() ).WriteCharPtr( "', " )
+ .WriteCharPtr( "of class '" ).WriteOString( aClassNameStr ).WriteCharPtr( "', " )
+ .WriteCharPtr( "counts " )
+ .WriteOString( OString::number(GetRefCount()) )
+ .WriteCharPtr( " refs, " );
+ if ( GetParent() )
+ {
+ OString aParentNameStr(OUStringToOString(GetName(), RTL_TEXTENCODING_ASCII_US));
+ rStrm.WriteCharPtr( "in parent " )
+ .WriteOString( OString::number(reinterpret_cast<sal_Int64>(GetParent())) )
+ .WriteCharPtr( "=='" ).WriteCharPtr( aParentNameStr.isEmpty() ? "<unnamed>" : aParentNameStr.getStr() ).WriteCharPtr( "'" );
+ }
+ else
+ {
+ rStrm.WriteCharPtr( "no parent " );
+ }
+ rStrm.WriteCharPtr( " )" ) << endl;
+ OString aIndentNameStr(OUStringToOString(aIndent, RTL_TEXTENCODING_ASCII_US));
+ rStrm.WriteOString( aIndentNameStr ).WriteCharPtr( "{" ) << endl;
+
+ // Flags
+ OUString aAttrs;
+ if( CollectAttrs( this, aAttrs ) )
+ {
+ OString aAttrStr(OUStringToOString(aAttrs, RTL_TEXTENCODING_ASCII_US));
+ rStrm.WriteOString( aIndentNameStr ).WriteCharPtr( "- Flags: " ).WriteOString( aAttrStr ) << endl;
+ }
+
+ // Methods
+ rStrm.WriteOString( aIndentNameStr ).WriteCharPtr( "- Methods:" ) << endl;
+ for( sal_uInt32 i = 0; i < pMethods->Count32(); i++ )
+ {
+ SbxVariableRef& r = pMethods->GetRef32( i );
+ SbxVariable* pVar = r.get();
+ if( pVar )
+ {
+ OUString aLine = aIndent + " - " + pVar->GetName( SbxNameType::ShortTypes );
+ OUString aAttrs2;
+ if( CollectAttrs( pVar, aAttrs2 ) )
+ {
+ aLine += aAttrs2;
+ }
+ if( dynamic_cast<const SbxMethod *>(pVar) == nullptr )
+ {
+ aLine += " !! Not a Method !!";
+ }
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, aLine, RTL_TEXTENCODING_ASCII_US);
+
+ // Output also the object at object-methods
+ if ( pVar->GetValues_Impl().eType == SbxOBJECT &&
+ pVar->GetValues_Impl().pObj &&
+ pVar->GetValues_Impl().pObj != this &&
+ pVar->GetValues_Impl().pObj != GetParent() )
+ {
+ rStrm.WriteCharPtr( " contains " );
+ static_cast<SbxObject*>(pVar->GetValues_Impl().pObj)->Dump( rStrm, bFill );
+ }
+ else
+ {
+ rStrm << endl;
+ }
+ }
+ }
+
+ // Properties
+ rStrm.WriteOString( aIndentNameStr ).WriteCharPtr( "- Properties:" ) << endl;
+ {
+ for( sal_uInt32 i = 0; i < pProps->Count32(); i++ )
+ {
+ SbxVariableRef& r = pProps->GetRef32( i );
+ SbxVariable* pVar = r.get();
+ if( pVar )
+ {
+ OUString aLine = aIndent + " - " + pVar->GetName( SbxNameType::ShortTypes );
+ OUString aAttrs3;
+ if( CollectAttrs( pVar, aAttrs3 ) )
+ {
+ aLine += aAttrs3;
+ }
+ if( dynamic_cast<const SbxProperty *>(pVar) == nullptr )
+ {
+ aLine += " !! Not a Property !!";
+ }
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, aLine, RTL_TEXTENCODING_ASCII_US);
+
+ // output also the object at object properties
+ if ( pVar->GetValues_Impl().eType == SbxOBJECT &&
+ pVar->GetValues_Impl().pObj &&
+ pVar->GetValues_Impl().pObj != this &&
+ pVar->GetValues_Impl().pObj != GetParent() )
+ {
+ rStrm.WriteCharPtr( " contains " );
+ static_cast<SbxObject*>(pVar->GetValues_Impl().pObj)->Dump( rStrm, bFill );
+ }
+ else
+ {
+ rStrm << endl;
+ }
+ }
+ }
+ }
+
+ // Objects
+ rStrm.WriteOString( aIndentNameStr ).WriteCharPtr( "- Objects:" ) << endl;
+ {
+ for( sal_uInt32 i = 0; i < pObjs->Count32(); i++ )
+ {
+ SbxVariableRef& r = pObjs->GetRef32( i );
+ SbxVariable* pVar = r.get();
+ if ( pVar )
+ {
+ rStrm.WriteOString( aIndentNameStr ).WriteCharPtr( " - Sub" );
+ if (SbxObject *pSbxObj = dynamic_cast<SbxObject*>(pVar))
+ {
+ pSbxObj->Dump(rStrm, bFill);
+ }
+ else
+ {
+ pVar->Dump(rStrm, bFill);
+ }
+ }
+ }
+ }
+
+ rStrm.WriteOString( aIndentNameStr ).WriteCharPtr( "}" ) << endl << endl;
+ --nLevel;
+}
+
+SbxMethod::SbxMethod( const OUString& r, SbxDataType t, bool bIsRuntimeFunction )
+ : SbxVariable(t)
+ , mbIsRuntimeFunction(bIsRuntimeFunction)
+ , mbRuntimeFunctionReturnType(t)
+{
+ SetName(r);
+}
+
+SbxMethod::SbxMethod( const SbxMethod& r )
+ : SvRefBase(r)
+ , SbxVariable(r)
+ , mbIsRuntimeFunction(r.IsRuntimeFunction())
+ , mbRuntimeFunctionReturnType(r.GetRuntimeFunctionReturnType())
+{
+}
+
+SbxMethod::~SbxMethod()
+{
+}
+
+SbxClassType SbxMethod::GetClass() const
+{
+ return SbxClassType::Method;
+}
+
+SbxProperty::SbxProperty( const OUString& r, SbxDataType t )
+ : SbxVariable( t )
+{
+ SetName( r );
+}
+
+SbxProperty::~SbxProperty()
+{
+}
+
+SbxClassType SbxProperty::GetClass() const
+{
+ return SbxClassType::Property;
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxres.cxx b/basic/source/sbx/sbxres.cxx
new file mode 100644
index 000000000..125969e3e
--- /dev/null
+++ b/basic/source/sbx/sbxres.cxx
@@ -0,0 +1,80 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+
+#include "sbxres.hxx"
+
+#include <rtl/ustring.hxx>
+
+static const char* pSbxRes[] = {
+ "Empty",
+ "Null",
+ "Integer",
+ "Long",
+ "Single",
+ "Double",
+ "Currency",
+ "Date",
+ "String",
+ "Object",
+ "Error",
+ "Boolean",
+ "Variant",
+ "Any",
+ "Type14",
+ "Type15",
+ "Char",
+ "Byte",
+ "UShort",
+ "ULong",
+ "Long64",
+ "ULong64",
+ "Int",
+ "UInt",
+ "Void",
+ "HResult",
+ "Pointer",
+ "DimArray",
+ "CArray",
+ "Any",
+ "LpStr",
+ "LpWStr",
+ " As ",
+ "Optional ",
+ "Byref ",
+
+ "Name",
+ "Parent",
+ "Application",
+ "Count",
+ "Add",
+ "Item",
+ "Remove",
+
+ "Error ", // with blank!
+ "False",
+ "True"
+};
+
+OUString GetSbxRes( StringId nId )
+{
+ return OUString::createFromAscii( ( nId > StringId::LastValue ) ? "???" : pSbxRes[ static_cast<int>( nId ) ] );
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxres.hxx b/basic/source/sbx/sbxres.hxx
new file mode 100644
index 000000000..185dad408
--- /dev/null
+++ b/basic/source/sbx/sbxres.hxx
@@ -0,0 +1,51 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#pragma once
+
+#include <rtl/ustring.hxx>
+
+// Currently there are no resources provided in the SVTOOLS-Project.
+// Because it is non-critical resources (BASIC-Keywords),
+// we can work with dummies.
+
+enum class StringId {
+ Types = 0,
+ Any = 13,
+ As = 32,
+ Optional = 33,
+ ByRef = 34,
+
+ NameProp = 35,
+ ParentProp = 36,
+ CountProp = 38,
+ AddMeth = 39,
+ ItemMeth = 40,
+ RemoveMeth = 41,
+
+ ErrorMsg = 42,
+ False = 43,
+ True = 44,
+
+ LastValue = 44
+};
+
+OUString GetSbxRes( StringId );
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxscan.cxx b/basic/source/sbx/sbxscan.cxx
new file mode 100644
index 000000000..24e3dba5e
--- /dev/null
+++ b/basic/source/sbx/sbxscan.cxx
@@ -0,0 +1,900 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+
+#include <vcl/errcode.hxx>
+#include <unotools/resmgr.hxx>
+#include "sbxconv.hxx"
+
+#include <unotools/syslocale.hxx>
+#include <unotools/charclass.hxx>
+
+#include <vcl/svapp.hxx>
+#include <vcl/settings.hxx>
+
+#include <math.h>
+
+#include <sbxbase.hxx>
+#include <sbintern.hxx>
+#include <sbxform.hxx>
+
+#include <date.hxx>
+#include <runtime.hxx>
+#include <strings.hrc>
+
+#include <rtl/character.hxx>
+#include <sal/log.hxx>
+#include <svl/zforlist.hxx>
+
+
+void ImpGetIntntlSep( sal_Unicode& rcDecimalSep, sal_Unicode& rcThousandSep, sal_Unicode& rcDecimalSepAlt )
+{
+ SvtSysLocale aSysLocale;
+ const LocaleDataWrapper& rData = aSysLocale.GetLocaleData();
+ rcDecimalSep = rData.getNumDecimalSep()[0];
+ rcThousandSep = rData.getNumThousandSep()[0];
+ rcDecimalSepAlt = rData.getNumDecimalSepAlt().toChar();
+}
+
+
+/** NOTE: slightly differs from strchr() in that it does not consider the
+ terminating NULL character to be part of the string and returns bool
+ instead of pointer, if character is 0 returns false.
+ */
+static bool ImpStrChr( const sal_Unicode* p, sal_Unicode c )
+{
+ if (!c)
+ return false;
+ while (*p)
+ {
+ if (*p++ == c)
+ return true;
+ }
+ return false;
+}
+
+
+// scanning a string according to BASIC-conventions
+// but exponent may also be a D, so data type is SbxDOUBLE
+// conversion error if data type is fixed and it doesn't fit
+
+ErrCode ImpScan( const OUString& rWSrc, double& nVal, SbxDataType& rType,
+ sal_uInt16* pLen, bool bOnlyIntntl )
+{
+ sal_Unicode cIntntlDecSep, cIntntlGrpSep, cIntntlDecSepAlt;
+ sal_Unicode cNonIntntlDecSep = '.';
+ if( bOnlyIntntl )
+ {
+ ImpGetIntntlSep( cIntntlDecSep, cIntntlGrpSep, cIntntlDecSepAlt );
+ cNonIntntlDecSep = cIntntlDecSep;
+ // Ensure that the decimal separator alternative is really one.
+ if (cIntntlDecSepAlt && cIntntlDecSepAlt == cNonIntntlDecSep)
+ cIntntlDecSepAlt = 0;
+ }
+ else
+ {
+ cIntntlDecSep = cNonIntntlDecSep;
+ cIntntlGrpSep = 0; // no group separator accepted in non-i18n
+ cIntntlDecSepAlt = 0;
+ }
+
+ const sal_Unicode* const pStart = rWSrc.getStr();
+ const sal_Unicode* p = pStart;
+ OUStringBuffer aBuf( rWSrc.getLength());
+ bool bRes = true;
+ bool bMinus = false;
+ nVal = 0;
+ SbxDataType eScanType = SbxSINGLE;
+ while( *p == ' ' || *p == '\t' )
+ p++;
+ if( *p == '-' )
+ {
+ p++;
+ bMinus = true;
+ }
+ if( rtl::isAsciiDigit( *p ) || ((*p == cNonIntntlDecSep || *p == cIntntlDecSep ||
+ (cIntntlDecSep && *p == cIntntlGrpSep) || (cIntntlDecSepAlt && *p == cIntntlDecSepAlt)) &&
+ rtl::isAsciiDigit( *(p+1) )))
+ {
+ // tdf#118442: Whitespace and minus are skipped; store the position to calculate index
+ const sal_Unicode* const pDigitsStart = p;
+ short exp = 0;
+ short decsep = 0;
+ short ndig = 0;
+ short ncdig = 0; // number of digits after decimal point
+ OUStringBuffer aSearchStr("0123456789DEde");
+ aSearchStr.append(cNonIntntlDecSep);
+ if( cIntntlDecSep != cNonIntntlDecSep )
+ aSearchStr.append(cIntntlDecSep);
+ if( cIntntlDecSepAlt && cIntntlDecSepAlt != cNonIntntlDecSep )
+ aSearchStr.append(cIntntlDecSepAlt);
+ if( bOnlyIntntl )
+ aSearchStr.append(cIntntlGrpSep);
+ const sal_Unicode* const pSearchStr = aSearchStr.getStr();
+ const sal_Unicode pDdEe[] = { 'D', 'd', 'E', 'e', 0 };
+ while( ImpStrChr( pSearchStr, *p ) )
+ {
+ aBuf.append( *p );
+ if( bOnlyIntntl && *p == cIntntlGrpSep )
+ {
+ p++;
+ continue;
+ }
+ if( *p == cNonIntntlDecSep || *p == cIntntlDecSep || (cIntntlDecSepAlt && *p == cIntntlDecSepAlt) )
+ {
+ // Use the separator that is passed to stringToDouble()
+ aBuf[p - pDigitsStart] = cIntntlDecSep;
+ p++;
+ if( ++decsep > 1 )
+ continue;
+ }
+ else if( ImpStrChr( pDdEe, *p ) )
+ {
+ if( ++exp > 1 )
+ {
+ p++;
+ continue;
+ }
+ if( *p == 'D' || *p == 'd' )
+ eScanType = SbxDOUBLE;
+ aBuf[p - pDigitsStart] = 'E';
+ p++;
+ if (*p == '+')
+ ++p;
+ else if (*p == '-')
+ {
+ aBuf.append('-');
+ ++p;
+ }
+ }
+ else
+ {
+ p++;
+ if( decsep && !exp )
+ ncdig++;
+ }
+ if( !exp )
+ ndig++;
+ }
+
+ if( decsep > 1 || exp > 1 )
+ bRes = false;
+
+ OUString aBufStr( aBuf.makeStringAndClear());
+ rtl_math_ConversionStatus eStatus = rtl_math_ConversionStatus_Ok;
+ sal_Int32 nParseEnd = 0;
+ nVal = rtl::math::stringToDouble( aBufStr, cIntntlDecSep, cIntntlGrpSep, &eStatus, &nParseEnd );
+ if( eStatus != rtl_math_ConversionStatus_Ok || nParseEnd != aBufStr.getLength() )
+ bRes = false;
+
+ if( !decsep && !exp )
+ {
+ if( nVal >= SbxMININT && nVal <= SbxMAXINT )
+ eScanType = SbxINTEGER;
+ else if( nVal >= SbxMINLNG && nVal <= SbxMAXLNG )
+ eScanType = SbxLONG;
+ }
+
+ ndig = ndig - decsep;
+ // too many numbers for SINGLE?
+ if( ndig > 15 || ncdig > 6 )
+ eScanType = SbxDOUBLE;
+
+ // type detection?
+ const sal_Unicode pTypes[] = { '%', '!', '&', '#', 0 };
+ if( ImpStrChr( pTypes, *p ) )
+ p++;
+ }
+ // hex/octal number? read in and convert:
+ else if( *p == '&' )
+ {
+ p++;
+ eScanType = SbxLONG;
+ OUString aCmp( "0123456789ABCDEFabcdef" );
+ char base = 16;
+ char ndig = 8;
+ switch( *p++ )
+ {
+ case 'O':
+ case 'o':
+ aCmp = "01234567";
+ base = 8;
+ ndig = 11;
+ break;
+ case 'H':
+ case 'h':
+ break;
+ default :
+ bRes = false;
+ }
+ const sal_Unicode* const pCmp = aCmp.getStr();
+ while( rtl::isAsciiAlphanumeric( *p ) ) /* XXX: really munge all alnum also when error? */
+ {
+ sal_Unicode ch = *p;
+ if( ImpStrChr( pCmp, ch ) )
+ {
+ if (ch > 0x60)
+ ch -= 0x20; // convert ASCII lower to upper case
+ aBuf.append( ch );
+ }
+ else
+ bRes = false;
+ p++;
+ }
+ OUString aBufStr( aBuf.makeStringAndClear());
+ sal_Int32 l = 0;
+ for( const sal_Unicode* q = aBufStr.getStr(); bRes && *q; q++ )
+ {
+ int i = *q - '0';
+ if( i > 9 )
+ i -= 7; // 'A'-'0' = 17 => 10, ...
+ l = ( l * base ) + i;
+ if( !ndig-- )
+ bRes = false;
+ }
+ if( *p == '&' )
+ p++;
+ nVal = static_cast<double>(l);
+ if( l >= SbxMININT && l <= SbxMAXINT )
+ eScanType = SbxINTEGER;
+ }
+#if HAVE_FEATURE_SCRIPTING
+ else if ( SbiRuntime::isVBAEnabled() )
+ {
+ return ERRCODE_BASIC_CONVERSION;
+ }
+#endif
+ if( pLen )
+ *pLen = static_cast<sal_uInt16>( p - pStart );
+ if( !bRes )
+ return ERRCODE_BASIC_CONVERSION;
+ if( bMinus )
+ nVal = -nVal;
+ rType = eScanType;
+ return ERRCODE_NONE;
+}
+
+// port for CDbl in the Basic
+ErrCode SbxValue::ScanNumIntnl( const OUString& rSrc, double& nVal, bool bSingle )
+{
+ SbxDataType t;
+ sal_uInt16 nLen = 0;
+ ErrCode nRetError = ImpScan( rSrc, nVal, t, &nLen,
+ /*bOnlyIntntl*/true );
+ // read completely?
+ if( nRetError == ERRCODE_NONE && nLen != rSrc.getLength() )
+ {
+ nRetError = ERRCODE_BASIC_CONVERSION;
+ }
+ if( bSingle )
+ {
+ SbxValues aValues( nVal );
+ nVal = static_cast<double>(ImpGetSingle( &aValues )); // here error at overflow
+ }
+ return nRetError;
+}
+
+
+static const double roundArray[] = {
+ 5.0e+0, 0.5e+0, 0.5e-1, 0.5e-2, 0.5e-3, 0.5e-4, 0.5e-5, 0.5e-6, 0.5e-7,
+ 0.5e-8, 0.5e-9, 0.5e-10,0.5e-11,0.5e-12,0.5e-13,0.5e-14,0.5e-15 };
+
+/*
+|*
+|* void myftoa( double, char *, short, short, bool, bool )
+|*
+|* description: conversion double --> ASCII
+|* parameters: double the number
+|* char * target buffer
+|* short number of positions after decimal point
+|* short range of the exponent ( 0=no E )
+|* bool true: with 1000-separators
+|* bool true: output without formatting
+|*
+ */
+
+static void myftoa( double nNum, char * pBuf, short nPrec, short nExpWidth )
+{
+
+ short nExp = 0;
+ short nDig = nPrec + 1;
+ short nDec; // number of positions before decimal point
+ int i;
+
+ sal_Unicode cDecimalSep, cThousandSep, cDecimalSepAlt;
+ ImpGetIntntlSep( cDecimalSep, cThousandSep, cDecimalSepAlt );
+
+ // compute exponent
+ nExp = 0;
+ if( nNum > 0.0 )
+ {
+ while( nNum < 1.0 )
+ {
+ nNum *= 10.0;
+ nExp--;
+ }
+ while( nNum >= 10.0 )
+ {
+ nNum /= 10.0;
+ nExp++;
+ }
+ }
+ if( !nPrec )
+ nDig = nExp + 1;
+
+ // round number
+ if( (nNum += roundArray [std::min<short>( nDig, 16 )] ) >= 10.0 )
+ {
+ nNum = 1.0;
+ ++nExp;
+ if( !nExpWidth ) ++nDig;
+ }
+
+ // determine positions before decimal point
+ if( !nExpWidth )
+ {
+ if( nExp < 0 )
+ {
+ // #41691: also a 0 at bFix
+ *pBuf++ = '0';
+ if( nPrec ) *pBuf++ = static_cast<char>(cDecimalSep);
+ i = -nExp - 1;
+ if( nDig <= 0 ) i = nPrec;
+ while( i-- ) *pBuf++ = '0';
+ nDec = 0;
+ }
+ else
+ nDec = nExp+1;
+ }
+ else
+ nDec = 1;
+
+ // output number
+ if( nDig > 0 )
+ {
+ int digit;
+ for( i = 0 ; ; ++i )
+ {
+ if( i < 16 )
+ {
+ digit = static_cast<int>(nNum);
+ *pBuf++ = sal::static_int_cast< char >(digit + '0');
+ nNum =( nNum - digit ) * 10.0;
+ } else
+ *pBuf++ = '0';
+ if( --nDig == 0 ) break;
+ if( nDec )
+ {
+ nDec--;
+ if( !nDec )
+ *pBuf++ = static_cast<char>(cDecimalSep);
+ }
+ }
+ }
+
+ // output exponent
+ if( nExpWidth )
+ {
+ if( nExpWidth < 3 ) nExpWidth = 3;
+ nExpWidth -= 2;
+ *pBuf++ = 'E';
+ if ( nExp < 0 )
+ {
+ nExp = -nExp;
+ *pBuf++ = '-';
+ }
+ else
+ *pBuf++ = '+';
+ while( nExpWidth > 3 )
+ {
+ *pBuf++ = '0';
+ nExpWidth--;
+ }
+ if( nExp >= 100 || nExpWidth == 3 )
+ {
+ *pBuf++ = sal::static_int_cast< char >(nExp/100 + '0');
+ nExp %= 100;
+ }
+ if( nExp/10 || nExpWidth >= 2 )
+ *pBuf++ = sal::static_int_cast< char >(nExp/10 + '0');
+ *pBuf++ = sal::static_int_cast< char >(nExp%10 + '0');
+ }
+ *pBuf = 0;
+}
+
+// The number is prepared unformattedly with the given number of
+// NK-positions. A leading minus is added if applicable.
+// This routine is public because it's also used by the Put-functions
+// in the class SbxImpSTRING.
+
+void ImpCvtNum( double nNum, short nPrec, OUString& rRes, bool bCoreString )
+{
+ char *q;
+ char cBuf[ 40 ], *p = cBuf;
+
+ sal_Unicode cDecimalSep, cThousandSep, cDecimalSepAlt;
+ ImpGetIntntlSep( cDecimalSep, cThousandSep, cDecimalSepAlt );
+ if( bCoreString )
+ cDecimalSep = '.';
+
+ if( nNum < 0.0 ) {
+ nNum = -nNum;
+ *p++ = '-';
+ }
+ double dMaxNumWithoutExp = (nPrec == 6) ? 1E6 : 1E14;
+ myftoa( nNum, p, nPrec,( nNum &&( nNum < 1E-1 || nNum >= dMaxNumWithoutExp ) ) ? 4:0 );
+ // remove trailing zeros
+ for( p = cBuf; *p &&( *p != 'E' ); p++ ) {}
+ q = p; p--;
+ while( nPrec && *p == '0' )
+ {
+ nPrec--;
+ p--;
+ }
+ if( *p == cDecimalSep ) p--;
+ while( *q ) *++p = *q++;
+ *++p = 0;
+ rRes = OUString::createFromAscii( cBuf );
+}
+
+bool ImpConvStringExt( OUString& rSrc, SbxDataType eTargetType )
+{
+ bool bChanged = false;
+ OUString aNewString;
+
+ // only special cases are handled, nothing on default
+ switch( eTargetType )
+ {
+ // consider international for floating point
+ case SbxSINGLE:
+ case SbxDOUBLE:
+ case SbxCURRENCY:
+ {
+ sal_Unicode cDecimalSep, cThousandSep, cDecimalSepAlt;
+ ImpGetIntntlSep( cDecimalSep, cThousandSep, cDecimalSepAlt );
+ aNewString = rSrc;
+
+ if( cDecimalSep != '.' || (cDecimalSepAlt && cDecimalSepAlt != '.') )
+ {
+ sal_Int32 nPos = aNewString.indexOf( cDecimalSep );
+ if( nPos == -1 && cDecimalSepAlt )
+ nPos = aNewString.indexOf( cDecimalSepAlt );
+ if( nPos != -1 )
+ {
+ sal_Unicode* pStr = const_cast<sal_Unicode*>(aNewString.getStr());
+ pStr[nPos] = '.';
+ bChanged = true;
+ }
+ }
+ break;
+ }
+
+ // check as string in case of sal_Bool sal_True and sal_False
+ case SbxBOOL:
+ {
+ if( rSrc.equalsIgnoreAsciiCase("true") )
+ {
+ aNewString = OUString::number( SbxTRUE );
+ bChanged = true;
+ }
+ else if( rSrc.equalsIgnoreAsciiCase("false") )
+ {
+ aNewString = OUString::number( SbxFALSE );
+ bChanged = true;
+ }
+ break;
+ }
+ default: break;
+ }
+
+ if( bChanged )
+ rSrc = aNewString;
+ return bChanged;
+}
+
+
+// formatted number output
+// the return value is the number of characters used
+// from the format
+
+static sal_uInt16 printfmtstr( const OUString& rStr, OUString& rRes, const OUString& rFmt )
+{
+ OUStringBuffer aTemp;
+ const sal_Unicode* pStr = rStr.getStr();
+ const sal_Unicode* pFmtStart = rFmt.getStr();
+ const sal_Unicode* pFmt = pFmtStart;
+
+ switch( *pFmt )
+ {
+ case '!':
+ aTemp.append(*pStr++);
+ pFmt++;
+ break;
+ case '\\':
+ do
+ {
+ aTemp.append( *pStr ? *pStr++ : u' ');
+ pFmt++;
+ }
+ while( *pFmt && *pFmt != '\\' );
+ aTemp.append(*pStr ? *pStr++ : u' ');
+ pFmt++; break;
+ case '&':
+ aTemp = rStr;
+ pFmt++; break;
+ default:
+ aTemp = rStr;
+ break;
+ }
+ rRes = aTemp.makeStringAndClear();
+ return static_cast<sal_uInt16>( pFmt - pFmtStart );
+}
+
+
+bool SbxValue::Scan( const OUString& rSrc, sal_uInt16* pLen )
+{
+ ErrCode eRes = ERRCODE_NONE;
+ if( !CanWrite() )
+ {
+ eRes = ERRCODE_BASIC_PROP_READONLY;
+ }
+ else
+ {
+ double n;
+ SbxDataType t;
+ eRes = ImpScan( rSrc, n, t, pLen, true );
+ if( eRes == ERRCODE_NONE )
+ {
+ if( !IsFixed() )
+ {
+ SetType( t );
+ }
+ PutDouble( n );
+ }
+ }
+ if( eRes )
+ {
+ SetError( eRes );
+ return false;
+ }
+ else
+ {
+ return true;
+ }
+}
+
+std::locale BasResLocale()
+{
+ return Translate::Create("sb");
+}
+
+OUString BasResId(const char *pId)
+{
+ return Translate::get(pId, BasResLocale());
+}
+
+namespace
+{
+
+enum class VbaFormatType
+{
+ Offset, // standard number format
+ UserDefined, // user defined number format
+ Null
+};
+
+struct VbaFormatInfo
+{
+ VbaFormatType meType;
+ OUStringLiteral mpVbaFormat; // Format string in vba
+ NfIndexTableOffset meOffset; // SvNumberFormatter format index, if meType = VbaFormatType::Offset
+ const char* mpOOoFormat; // if meType = VbaFormatType::UserDefined
+};
+
+#if HAVE_FEATURE_SCRIPTING
+const VbaFormatInfo pFormatInfoTable[] =
+{
+ { VbaFormatType::Offset, OUStringLiteral("Long Date"), NF_DATE_SYSTEM_LONG, nullptr },
+ { VbaFormatType::UserDefined, OUStringLiteral("Medium Date"), NF_NUMBER_STANDARD, "DD-MMM-YY" },
+ { VbaFormatType::Offset, OUStringLiteral("Short Date"), NF_DATE_SYSTEM_SHORT, nullptr },
+ { VbaFormatType::UserDefined, OUStringLiteral("Long Time"), NF_NUMBER_STANDARD, "H:MM:SS AM/PM" },
+ { VbaFormatType::Offset, OUStringLiteral("Medium Time"), NF_TIME_HHMMAMPM, nullptr },
+ { VbaFormatType::Offset, OUStringLiteral("Short Time"), NF_TIME_HHMM, nullptr },
+ { VbaFormatType::Offset, OUStringLiteral("ddddd"), NF_DATE_SYSTEM_SHORT, nullptr },
+ { VbaFormatType::Offset, OUStringLiteral("dddddd"), NF_DATE_SYSTEM_LONG, nullptr },
+ { VbaFormatType::UserDefined, OUStringLiteral("ttttt"), NF_NUMBER_STANDARD, "H:MM:SS AM/PM" },
+ { VbaFormatType::Offset, OUStringLiteral("ww"), NF_DATE_WW, nullptr },
+ { VbaFormatType::Null, OUStringLiteral(""), NF_INDEX_TABLE_ENTRIES, nullptr }
+};
+
+const VbaFormatInfo* getFormatInfo( const OUString& rFmt )
+{
+ const VbaFormatInfo* pInfo = pFormatInfoTable;
+ while( pInfo->meType != VbaFormatType::Null )
+ {
+ if( rFmt.equalsIgnoreAsciiCase( pInfo->mpVbaFormat ) )
+ break;
+ ++pInfo;
+ }
+ return pInfo;
+}
+#endif
+
+} // namespace
+
+#if HAVE_FEATURE_SCRIPTING
+#define VBAFORMAT_GENERALDATE "General Date"
+#define VBAFORMAT_C "c"
+#define VBAFORMAT_N "n"
+#define VBAFORMAT_NN "nn"
+#define VBAFORMAT_W "w"
+#define VBAFORMAT_Y "y"
+#define VBAFORMAT_LOWERCASE "<"
+#define VBAFORMAT_UPPERCASE ">"
+#endif
+
+void SbxValue::Format( OUString& rRes, const OUString* pFmt ) const
+{
+ short nComma = 0;
+ double d = 0;
+
+ // pflin, It is better to use SvNumberFormatter to handle the date/time/number format.
+ // the SvNumberFormatter output is mostly compatible with
+ // VBA output besides the OOo-basic output
+#if HAVE_FEATURE_SCRIPTING
+ if( pFmt && !SbxBasicFormater::isBasicFormat( *pFmt ) )
+ {
+ OUString aStr = GetOUString();
+
+ SvtSysLocale aSysLocale;
+ const CharClass& rCharClass = aSysLocale.GetCharClass();
+
+ if( pFmt->equalsIgnoreAsciiCase( VBAFORMAT_LOWERCASE ) )
+ {
+ rRes = rCharClass.lowercase( aStr );
+ return;
+ }
+ if( pFmt->equalsIgnoreAsciiCase( VBAFORMAT_UPPERCASE ) )
+ {
+ rRes = rCharClass.uppercase( aStr );
+ return;
+ }
+
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ std::shared_ptr<SvNumberFormatter> pFormatter;
+ if (GetSbData()->pInst)
+ {
+ pFormatter = GetSbData()->pInst->GetNumberFormatter();
+ }
+ else
+ {
+ sal_uInt32 n; // Dummy
+ pFormatter = SbiInstance::PrepareNumberFormatter( n, n, n );
+ }
+
+ // Passing an index of a locale switches IsNumberFormat() to use that
+ // locale in case the formatter wasn't default created with it.
+ sal_uInt32 nIndex = pFormatter->GetStandardIndex( eLangType);
+ double nNumber;
+ Color* pCol;
+
+ bool bSuccess = pFormatter->IsNumberFormat( aStr, nIndex, nNumber );
+
+ // number format, use SvNumberFormatter to handle it.
+ if( bSuccess )
+ {
+ sal_Int32 nCheckPos = 0;
+ SvNumFormatType nType;
+ OUString aFmtStr = *pFmt;
+ const VbaFormatInfo* pInfo = getFormatInfo( aFmtStr );
+ if( pInfo->meType != VbaFormatType::Null )
+ {
+ if( pInfo->meType == VbaFormatType::Offset )
+ {
+ nIndex = pFormatter->GetFormatIndex( pInfo->meOffset, eLangType );
+ }
+ else
+ {
+ aFmtStr = OUString::createFromAscii(pInfo->mpOOoFormat);
+ pFormatter->PutandConvertEntry( aFmtStr, nCheckPos, nType, nIndex, LANGUAGE_ENGLISH, eLangType, true);
+ }
+ pFormatter->GetOutputString( nNumber, nIndex, rRes, &pCol );
+ }
+ else if( aFmtStr.equalsIgnoreAsciiCase( VBAFORMAT_GENERALDATE )
+ || aFmtStr.equalsIgnoreAsciiCase( VBAFORMAT_C ))
+ {
+ if( nNumber <=-1.0 || nNumber >= 1.0 )
+ {
+ // short date
+ nIndex = pFormatter->GetFormatIndex( NF_DATE_SYSTEM_SHORT, eLangType );
+ pFormatter->GetOutputString( nNumber, nIndex, rRes, &pCol );
+
+ // long time
+ if( floor( nNumber ) != nNumber )
+ {
+ aFmtStr = "H:MM:SS AM/PM";
+ pFormatter->PutandConvertEntry( aFmtStr, nCheckPos, nType, nIndex, LANGUAGE_ENGLISH, eLangType, true);
+ OUString aTime;
+ pFormatter->GetOutputString( nNumber, nIndex, aTime, &pCol );
+ rRes += " " + aTime;
+ }
+ }
+ else
+ {
+ // long time only
+ aFmtStr = "H:MM:SS AM/PM";
+ pFormatter->PutandConvertEntry( aFmtStr, nCheckPos, nType, nIndex, LANGUAGE_ENGLISH, eLangType, true);
+ pFormatter->GetOutputString( nNumber, nIndex, rRes, &pCol );
+ }
+ }
+ else if( aFmtStr.equalsIgnoreAsciiCase( VBAFORMAT_N ) ||
+ aFmtStr.equalsIgnoreAsciiCase( VBAFORMAT_NN ))
+ {
+ sal_Int32 nMin = implGetMinute( nNumber );
+ if( nMin < 10 && aFmtStr.equalsIgnoreAsciiCase( VBAFORMAT_NN ))
+ {
+ // Minute in two digits
+ sal_Unicode aBuf[2];
+ aBuf[0] = '0';
+ aBuf[1] = '0' + nMin;
+ rRes = OUString(aBuf, SAL_N_ELEMENTS(aBuf));
+ }
+ else
+ {
+ rRes = OUString::number(nMin);
+ }
+ }
+ else if( aFmtStr.equalsIgnoreAsciiCase( VBAFORMAT_W ))
+ {
+ sal_Int32 nWeekDay = implGetWeekDay( nNumber );
+ rRes = OUString::number(nWeekDay);
+ }
+ else if( aFmtStr.equalsIgnoreAsciiCase( VBAFORMAT_Y ))
+ {
+ sal_Int16 nYear = implGetDateYear( nNumber );
+ double dBaseDate;
+ implDateSerial( nYear, 1, 1, true, SbDateCorrection::None, dBaseDate );
+ sal_Int32 nYear32 = 1 + sal_Int32( nNumber - dBaseDate );
+ rRes = OUString::number(nYear32);
+ }
+ else
+ {
+ pFormatter->PutandConvertEntry( aFmtStr, nCheckPos, nType, nIndex, LANGUAGE_ENGLISH, eLangType, true);
+ pFormatter->GetOutputString( nNumber, nIndex, rRes, &pCol );
+ }
+
+ return;
+ }
+ }
+#endif
+
+ SbxDataType eType = GetType();
+ switch( eType )
+ {
+ case SbxCHAR:
+ case SbxBYTE:
+ case SbxINTEGER:
+ case SbxUSHORT:
+ case SbxLONG:
+ case SbxULONG:
+ case SbxINT:
+ case SbxUINT:
+ case SbxNULL: // #45929 NULL with a little cheating
+ nComma = 0; goto cvt;
+ case SbxSINGLE:
+ nComma = 6; goto cvt;
+ case SbxDOUBLE:
+ nComma = 14;
+
+ cvt:
+ if( eType != SbxNULL )
+ {
+ d = GetDouble();
+ }
+ // #45355 another point to jump in for isnumeric-String
+ cvt2:
+ if( pFmt )
+ {
+ SbxAppData& rAppData = GetSbxData_Impl();
+
+ LanguageType eLangType = Application::GetSettings().GetLanguageTag().getLanguageType();
+ if( rAppData.pBasicFormater )
+ {
+ if( rAppData.eBasicFormaterLangType != eLangType )
+ {
+ rAppData.pBasicFormater.reset();
+ }
+ }
+ rAppData.eBasicFormaterLangType = eLangType;
+
+
+ if( !rAppData.pBasicFormater )
+ {
+ SvtSysLocale aSysLocale;
+ const LocaleDataWrapper& rData = aSysLocale.GetLocaleData();
+ sal_Unicode cComma = rData.getNumDecimalSep()[0];
+ sal_Unicode c1000 = rData.getNumThousandSep()[0];
+ const OUString& aCurrencyStrg = rData.getCurrSymbol();
+
+ // initialize the Basic-formater help object:
+ // get resources for predefined output
+ // of the Format()-command, e. g. for "On/Off"
+ OUString aOnStrg = BasResId(STR_BASICKEY_FORMAT_ON);
+ OUString aOffStrg = BasResId(STR_BASICKEY_FORMAT_OFF);
+ OUString aYesStrg = BasResId(STR_BASICKEY_FORMAT_YES);
+ OUString aNoStrg = BasResId(STR_BASICKEY_FORMAT_NO);
+ OUString aTrueStrg = BasResId(STR_BASICKEY_FORMAT_TRUE);
+ OUString aFalseStrg = BasResId(STR_BASICKEY_FORMAT_FALSE);
+ OUString aCurrencyFormatStrg = BasResId(STR_BASICKEY_FORMAT_CURRENCY);
+
+ rAppData.pBasicFormater = std::make_unique<SbxBasicFormater>(
+ cComma,c1000,aOnStrg,aOffStrg,
+ aYesStrg,aNoStrg,aTrueStrg,aFalseStrg,
+ aCurrencyStrg,aCurrencyFormatStrg );
+ }
+ // Remark: For performance reasons there's only ONE BasicFormater-
+ // object created and 'stored', so that the expensive resource-
+ // loading is saved (for country-specific predefined outputs,
+ // e. g. "On/Off") and the continuous string-creation
+ // operations, too.
+ // BUT: therefore this code is NOT multithreading capable!
+
+ // here are problems with ;;;Null because this method is only
+ // called, if SbxValue is a number!!!
+ // in addition rAppData.pBasicFormater->BasicFormatNull( *pFmt ); could be called!
+ if( eType != SbxNULL )
+ {
+ rRes = rAppData.pBasicFormater->BasicFormat( d ,*pFmt );
+ }
+ else
+ {
+ rRes = SbxBasicFormater::BasicFormatNull( *pFmt );
+ }
+
+ }
+ else
+ ImpCvtNum( GetDouble(), nComma, rRes );
+ break;
+ case SbxSTRING:
+ if( pFmt )
+ {
+ // #45355 converting if numeric
+ if( IsNumericRTL() )
+ {
+ ScanNumIntnl( GetOUString(), d );
+ goto cvt2;
+ }
+ else
+ {
+ printfmtstr( GetOUString(), rRes, *pFmt );
+ }
+ }
+ else
+ {
+ rRes = GetOUString();
+ }
+ break;
+ default:
+ rRes = GetOUString();
+ }
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxsng.cxx b/basic/source/sbx/sbxsng.cxx
new file mode 100644
index 000000000..ad4301f9c
--- /dev/null
+++ b/basic/source/sbx/sbxsng.cxx
@@ -0,0 +1,343 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#include <o3tl/float_int_conversion.hxx>
+#include <vcl/errcode.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+float ImpGetSingle( const SbxValues* p )
+{
+ SbxValues aTmp;
+ float nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar; break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ nRes = p->nInteger; break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort; break;
+ case SbxLONG:
+ nRes = static_cast<float>(p->nLong); break;
+ case SbxULONG:
+ nRes = static_cast<float>(p->nULong); break;
+ case SbxSINGLE:
+ nRes = p->nSingle; break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ if( p->pDecimal )
+ p->pDecimal->getSingle( nRes );
+ else
+ nRes = 0.0;
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ case SbxSALUINT64:
+ {
+ double dVal;
+ if( p->eType == SbxCURRENCY )
+ dVal = ImpCurrencyToDouble( p->nInt64 );
+ else if( p->eType == SbxSALINT64 )
+ dVal = static_cast<float>(p->nInt64);
+ else if( p->eType == SbxSALUINT64 )
+ dVal = static_cast<float>(p->uInt64);
+ else
+ dVal = p->nDouble;
+
+ if( dVal > SbxMAXSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ nRes = static_cast< float >(SbxMAXSNG);
+ }
+ else if( dVal < SbxMINSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ nRes = static_cast< float >(SbxMINSNG);
+ }
+ // tests for underflow - storing value too small for precision of single
+ else if( dVal > 0 && dVal < SbxMAXSNG2 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ nRes = static_cast< float >(SbxMAXSNG2);
+ }
+ else if( dVal < 0 && dVal > SbxMINSNG2 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ nRes = static_cast< float >(SbxMINSNG2);
+ }
+ else
+ nRes = static_cast<float>(dVal);
+ break;
+ }
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( d > SbxMAXSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ nRes = static_cast< float >(SbxMAXSNG);
+ }
+ else if( d < SbxMINSNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ nRes = static_cast< float >(SbxMINSNG);
+ }
+ else
+ nRes = static_cast<float>(d);
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetSingle();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ nRes = *p->pChar; break;
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ nRes = *p->pInteger; break;
+ case SbxBYREF | SbxLONG:
+ nRes = static_cast<float>(*p->pLong); break;
+ case SbxBYREF | SbxULONG:
+ nRes = static_cast<float>(*p->pULong); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ nRes = *p->pUShort; break;
+ case SbxBYREF | SbxSINGLE:
+ nRes = *p->pSingle; break;
+ // from here had to be tested
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxSALINT64:
+ case SbxBYREF | SbxCURRENCY:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutSingle( SbxValues* p, float n )
+{
+ SbxValues aTmp;
+start:
+ switch( +p->eType )
+ {
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxLONG:
+ aTmp.pLong = &p->nLong; goto direct;
+ case SbxULONG:
+ aTmp.pULong = &p->nULong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ aTmp.pnInt64 = &p->nInt64; goto direct;
+ case SbxSALUINT64:
+ aTmp.puInt64 = &p->uInt64; goto direct;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ SbxDecimal* pDec = ImpCreateDecimal( p );
+ if( !pDec->setSingle( n ) )
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ // from here no tests
+ case SbxSINGLE:
+ p->nSingle = n; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ {
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ ImpCvtNum( static_cast<double>(n), 6, *p->pOUString );
+ break;
+ }
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutSingle( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXCHAR) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCHAR;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(n), SbxMINCHAR) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMINCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXBYTE) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(n), SbxMININT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMININT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXUINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXUINT;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = 0;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ {
+ sal_Int32 i;
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); i = SbxMAXLNG;
+ }
+ else if( !o3tl::convertsToAtLeast(o3tl::roundAway(n), SbxMINLNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); i = SbxMINLNG;
+ }
+ else
+ {
+ i = sal::static_int_cast< sal_Int32 >(n);
+ }
+ *p->pLong = i; break;
+ }
+ case SbxBYREF | SbxULONG:
+ {
+ sal_uInt32 i;
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(n), SbxMAXULNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); i = SbxMAXULNG;
+ }
+ else if( n < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); i = 0;
+ }
+ else
+ {
+ i = sal::static_int_cast< sal_uInt32 >(n);
+ }
+ *p->pULong = i; break;
+ }
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = n; break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = static_cast<double>(n); break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = static_cast<sal_Int64>(n); break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = static_cast<sal_uInt64>(n); break;
+ case SbxBYREF | SbxCURRENCY:
+ double d;
+ if( n > SbxMAXCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); d = SbxMAXCURR;
+ }
+ else if( n < SbxMINCURR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); d = SbxMINCURR;
+ }
+ else
+ {
+ d = n;
+ }
+ *p->pnInt64 = ImpDoubleToCurrency( d ); break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxstr.cxx b/basic/source/sbx/sbxstr.cxx
new file mode 100644
index 000000000..8edfb9d7a
--- /dev/null
+++ b/basic/source/sbx/sbxstr.cxx
@@ -0,0 +1,331 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+
+#include <basic/sbx.hxx>
+#include "sbxconv.hxx"
+#include "sbxres.hxx"
+#include <runtime.hxx>
+#include <rtl/ustrbuf.hxx>
+#include <memory>
+
+// The conversion of an item onto String was handled via the Put-Methods
+// of the several data types to avoid duplicated code.
+
+OUString ImpGetString( const SbxValues* p )
+{
+ SbxValues aTmp;
+ OUString aRes;
+ aTmp.eType = SbxSTRING;
+ aTmp.pOUString = &aRes;
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ break;
+ case SbxCHAR:
+ ImpPutChar( &aTmp, p->nChar ); break;
+ case SbxBYTE:
+ ImpPutByte( &aTmp, p->nByte ); break;
+ case SbxINTEGER:
+ ImpPutInteger( &aTmp, p->nInteger ); break;
+ case SbxBOOL:
+ ImpPutBool( &aTmp, p->nUShort ); break;
+ case SbxUSHORT:
+ ImpPutUShort( &aTmp, p->nUShort ); break;
+ case SbxLONG:
+ ImpPutLong( &aTmp, p->nLong ); break;
+ case SbxULONG:
+ ImpPutULong( &aTmp, p->nULong ); break;
+ case SbxSINGLE:
+ ImpPutSingle( &aTmp, p->nSingle ); break;
+ case SbxDOUBLE:
+ ImpPutDouble( &aTmp, p->nDouble ); break;
+ case SbxCURRENCY:
+ ImpPutCurrency( &aTmp, p->nInt64 ); break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ ImpPutDecimal( &aTmp, p->pDecimal ); break;
+ case SbxSALINT64:
+ ImpPutInt64( &aTmp, p->nInt64 ); break;
+ case SbxSALUINT64:
+ ImpPutUInt64( &aTmp, p->uInt64 ); break;
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if ( p->pOUString )
+ {
+ *aTmp.pOUString = *p->pOUString;
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ {
+ aRes = pVal->GetOUString();
+ }
+ else if( p->pObj && p->pObj->IsFixed()
+ && (p->pObj->GetType() == (SbxARRAY | SbxBYTE )) )
+ {
+ // convert byte array to string
+ SbxArray* pArr = dynamic_cast<SbxArray*>( p->pObj );
+ if( pArr )
+ {
+ aRes = ByteArrayToString( pArr );
+ }
+ }
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ }
+ break;
+ }
+ case SbxERROR:
+ // Here the String "Error n" is generated
+ aRes = GetSbxRes( StringId::ErrorMsg ) + OUString::number(p->nUShort);
+ break;
+ case SbxDATE:
+ ImpPutDate( &aTmp, p->nDouble ); break;
+
+ case SbxBYREF | SbxCHAR:
+ ImpPutChar( &aTmp, *p->pChar ); break;
+ case SbxBYREF | SbxBYTE:
+ ImpPutByte( &aTmp, *p->pByte ); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ ImpPutInteger( &aTmp, *p->pInteger ); break;
+ case SbxBYREF | SbxLONG:
+ ImpPutLong( &aTmp, *p->pLong ); break;
+ case SbxBYREF | SbxULONG:
+ ImpPutULong( &aTmp, *p->pULong ); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ ImpPutUShort( &aTmp, *p->pUShort ); break;
+ case SbxBYREF | SbxSINGLE:
+ ImpPutSingle( &aTmp, *p->pSingle ); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ ImpPutDouble( &aTmp, *p->pDouble ); break;
+ case SbxBYREF | SbxCURRENCY:
+ ImpPutCurrency( &aTmp, *p->pnInt64 ); break;
+ case SbxBYREF | SbxSALINT64:
+ ImpPutInt64( &aTmp, *p->pnInt64 ); break;
+ case SbxBYREF | SbxSALUINT64:
+ ImpPutUInt64( &aTmp, *p->puInt64 ); break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+ return aRes;
+}
+
+// From 1997-04-10, new function for SbxValue::GetCoreString()
+OUString ImpGetCoreString( const SbxValues* p )
+{
+ // For now only for double
+ if( ( p->eType & (~SbxBYREF) ) == SbxDOUBLE )
+ {
+ SbxValues aTmp;
+ OUString aRes;
+ aTmp.eType = SbxSTRING;
+ aTmp.pOUString = &aRes;
+ if( p->eType == SbxDOUBLE )
+ ImpPutDouble( &aTmp, p->nDouble, true ); // true = bCoreString
+ else
+ ImpPutDouble( &aTmp, *p->pDouble, true ); // true = bCoreString
+ return aRes;
+ }
+ else
+ return ImpGetString( p );
+}
+
+void ImpPutString( SbxValues* p, const OUString* n )
+{
+ SbxValues aTmp;
+ aTmp.eType = SbxSTRING;
+ std::unique_ptr<OUString> pTmp;
+ // as a precaution, if a NULL-Ptr appears
+ if( !n )
+ {
+ pTmp.reset(new OUString);
+ n = pTmp.get();
+ }
+ aTmp.pOUString = const_cast<OUString*>(n);
+ switch( +p->eType )
+ {
+ case SbxCHAR:
+ p->nChar = ImpGetChar( &aTmp ); break;
+ case SbxBYTE:
+ p->nByte = ImpGetByte( &aTmp ); break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ p->nInteger = ImpGetInteger( &aTmp ); break;
+ case SbxLONG:
+ p->nLong = ImpGetLong( &aTmp ); break;
+ case SbxULONG:
+ p->nULong = ImpGetULong( &aTmp ); break;
+ case SbxERROR:
+ case SbxUSHORT:
+ p->nUShort = ImpGetUShort( &aTmp ); break;
+ case SbxSINGLE:
+ p->nSingle = ImpGetSingle( &aTmp ); break;
+ case SbxDATE:
+ p->nDouble = ImpGetDate( &aTmp ); break;
+ case SbxDOUBLE:
+ p->nDouble = ImpGetDouble( &aTmp ); break;
+ case SbxCURRENCY:
+ p->nInt64 = ImpGetCurrency( &aTmp ); break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ releaseDecimalPtr( p->pDecimal );
+ p->pDecimal = ImpGetDecimal( &aTmp ); break;
+ case SbxSALINT64:
+ p->nInt64 = ImpGetInt64( &aTmp ); break;
+ case SbxSALUINT64:
+ p->uInt64 = ImpGetUInt64( &aTmp ); break;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !n->isEmpty() )
+ {
+ if( !p->pOUString )
+ p->pOUString = new OUString( *n );
+ else
+ *p->pOUString = *n;
+ }
+ else
+ {
+ delete p->pOUString;
+ p->pOUString = nullptr;
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutString( *n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ *p->pChar = ImpGetChar( p ); break;
+ case SbxBYREF | SbxBYTE:
+ *p->pByte = ImpGetByte( p ); break;
+ case SbxBYREF | SbxINTEGER:
+ *p->pInteger = ImpGetInteger( p ); break;
+ case SbxBYREF | SbxBOOL:
+ *p->pUShort = sal::static_int_cast< sal_uInt16 >( ImpGetBool( p ) );
+ break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ *p->pUShort = ImpGetUShort( p ); break;
+ case SbxBYREF | SbxLONG:
+ *p->pLong = ImpGetLong( p ); break;
+ case SbxBYREF | SbxULONG:
+ *p->pULong = ImpGetULong( p ); break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = ImpGetSingle( p ); break;
+ case SbxBYREF | SbxDATE:
+ *p->pDouble = ImpGetDate( p ); break;
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = ImpGetDouble( p ); break;
+ case SbxBYREF | SbxCURRENCY:
+ *p->pnInt64 = ImpGetCurrency( p ); break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = ImpGetInt64( p ); break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = ImpGetUInt64( p ); break;
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+
+// Convert string to an array of bytes, preserving unicode (2bytes per character)
+SbxArray* StringToByteArray(const OUString& rStr)
+{
+ sal_Int32 nArraySize = rStr.getLength() * 2;
+ const sal_Unicode* pSrc = rStr.getStr();
+ SbxDimArray* pArray = new SbxDimArray(SbxBYTE);
+ if( nArraySize )
+ {
+#if !HAVE_FEATURE_SCRIPTING
+ bool bIncIndex = false;
+#else
+ bool bIncIndex = ( IsBaseIndexOne() && SbiRuntime::isVBAEnabled() );
+#endif
+ if( bIncIndex )
+ pArray->AddDim32( 1, nArraySize );
+ else
+ pArray->AddDim32( 0, nArraySize-1 );
+ }
+ else
+ {
+ pArray->unoAddDim32( 0, -1 );
+ }
+
+ for( sal_Int32 i=0; i< nArraySize; i++)
+ {
+ SbxVariable* pNew = new SbxVariable( SbxBYTE );
+ sal_uInt8 aByte = static_cast< sal_uInt8 >( (i%2) ? ((*pSrc) >> 8) & 0xff : (*pSrc) & 0xff );
+ pNew->PutByte( aByte );
+ pNew->SetFlag( SbxFlagBits::Write );
+ pArray->Put32( pNew, i );
+ if( i%2 )
+ pSrc++;
+ }
+ return pArray;
+}
+
+// Convert an array of bytes to string (2bytes per character)
+OUString ByteArrayToString(SbxArray* pArr)
+{
+ sal_uInt32 nCount = pArr->Count32();
+ OUStringBuffer aStrBuf;
+ sal_Unicode aChar = 0;
+ for( sal_uInt32 i = 0 ; i < nCount ; i++ )
+ {
+ sal_Unicode aTempChar = pArr->Get32(i)->GetByte();
+ if( i%2 )
+ {
+ aChar = (aTempChar << 8 ) | aChar;
+ aStrBuf.append(aChar);
+ aChar = 0;
+ }
+ else
+ {
+ aChar = aTempChar;
+ }
+ }
+
+ if( nCount%2 )
+ {
+ aStrBuf.append(aChar);
+ }
+
+ return aStrBuf.makeStringAndClear();
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxuint.cxx b/basic/source/sbx/sbxuint.cxx
new file mode 100644
index 000000000..a3751e266
--- /dev/null
+++ b/basic/source/sbx/sbxuint.cxx
@@ -0,0 +1,317 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#include <o3tl/float_int_conversion.hxx>
+#include <vcl/errcode.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+sal_uInt16 ImpGetUShort( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_uInt16 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar;
+ break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ if( p->nInteger < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = p->nInteger;
+ break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort;
+ break;
+ case SbxLONG:
+ if( p->nLong > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else if( p->nLong < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt16>(p->nLong);
+ break;
+ case SbxULONG:
+ if( p->nULong > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else
+ nRes = static_cast<sal_uInt16>(p->nULong);
+ break;
+ case SbxCURRENCY:
+ if( p->nInt64 / CURRENCY_FACTOR > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else if( p->nInt64 < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt16>(p->nInt64 / CURRENCY_FACTOR);
+ break;
+ case SbxSALINT64:
+ if( p->nInt64 > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else if( p->nInt64 < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt16>(p->nInt64);
+ break;
+ case SbxSALUINT64:
+ if( p->uInt64 > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else
+ nRes = static_cast<sal_uInt16>(p->uInt64);
+ break;
+ case SbxSINGLE:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(p->nSingle), SbxMAXUINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else if( p->nSingle < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt16>( p->nSingle + 0.5 );
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double dVal;
+ if( p->eType == SbxDECIMAL )
+ {
+ dVal = 0.0;
+ if( p->pDecimal )
+ p->pDecimal->getDouble( dVal );
+ }
+ else
+ dVal = p->nDouble;
+
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(dVal), SbxMAXUINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else if( dVal < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt16>( dVal + 0.5 );
+ break;
+ }
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( !o3tl::convertsToAtMost(o3tl::roundAway(d), SbxMAXUINT) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXUINT;
+ }
+ else if( d < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt16>( d + 0.5 );
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetUShort();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ nRes = *p->pUShort; break;
+
+ // from here on will be tested
+ case SbxBYREF | SbxCHAR:
+ aTmp.nChar = *p->pChar; goto ref;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ aTmp.nInteger = *p->pInteger; goto ref;
+ case SbxBYREF | SbxLONG:
+ aTmp.nLong = *p->pLong; goto ref;
+ case SbxBYREF | SbxULONG:
+ aTmp.nULong = *p->pULong; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutUShort( SbxValues* p, sal_uInt16 n )
+{
+ SbxValues aTmp;
+
+start:
+ switch( +p->eType )
+ {
+ case SbxERROR:
+ case SbxUSHORT:
+ p->nUShort = n; break;
+ case SbxLONG:
+ p->nLong = n; break;
+ case SbxULONG:
+ p->nULong = n; break;
+ case SbxSINGLE:
+ p->nSingle = n; break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+ case SbxCURRENCY:
+ p->nInt64 = n * CURRENCY_FACTOR; break;
+ case SbxSALINT64:
+ p->nInt64 = n; break;
+ case SbxSALUINT64:
+ p->uInt64 = n; break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ ImpCreateDecimal( p )->setUInt( n );
+ break;
+
+ // from here on tests
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxBYTE:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger;
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ ImpCvtNum( static_cast<double>(n), 0, *p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutUShort( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+
+ case SbxBYREF | SbxCHAR:
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( n > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( n > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ *p->pUShort = n; break;
+ case SbxBYREF | SbxLONG:
+ *p->pLong = n; break;
+ case SbxBYREF | SbxULONG:
+ *p->pULong = n; break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = n; break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = n; break;
+ case SbxBYREF | SbxCURRENCY:
+ *p->pnInt64 = n * CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = n; break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = n; break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxulng.cxx b/basic/source/sbx/sbxulng.cxx
new file mode 100644
index 000000000..bcb1ce0f2
--- /dev/null
+++ b/basic/source/sbx/sbxulng.cxx
@@ -0,0 +1,293 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <sal/config.h>
+
+#include <o3tl/float_int_conversion.hxx>
+#include <vcl/errcode.hxx>
+#include <basic/sberrors.hxx>
+#include "sbxconv.hxx"
+
+sal_uInt32 ImpGetULong( const SbxValues* p )
+{
+ SbxValues aTmp;
+ sal_uInt32 nRes;
+start:
+ switch( +p->eType )
+ {
+ case SbxNULL:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ [[fallthrough]];
+ case SbxEMPTY:
+ nRes = 0; break;
+ case SbxCHAR:
+ nRes = p->nChar;
+ break;
+ case SbxBYTE:
+ nRes = p->nByte; break;
+ case SbxINTEGER:
+ case SbxBOOL:
+ if( p->nInteger < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = p->nInteger;
+ break;
+ case SbxERROR:
+ case SbxUSHORT:
+ nRes = p->nUShort;
+ break;
+ case SbxLONG:
+ if( p->nLong < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = p->nLong;
+ break;
+ case SbxULONG:
+ nRes = p->nULong; break;
+ case SbxSINGLE:
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(p->nSingle), SbxMAXULNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXULNG;
+ }
+ else if( p->nSingle < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt32>( p->nSingle + 0.5 );
+ break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ case SbxSALINT64:
+ case SbxSALUINT64:
+ case SbxCURRENCY:
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ {
+ double dVal;
+ if( p->eType == SbxCURRENCY )
+ dVal = ImpCurrencyToDouble( p->nInt64 );
+ else if( p->eType == SbxSALINT64 )
+ dVal = static_cast< double >(p->nInt64);
+ else if( p->eType == SbxSALUINT64 )
+ dVal = ImpSalUInt64ToDouble( p->uInt64 );
+ else if( p->eType == SbxDECIMAL )
+ {
+ dVal = 0.0;
+ if( p->pDecimal )
+ p->pDecimal->getDouble( dVal );
+ }
+ else
+ dVal = p->nDouble;
+
+ if( !o3tl::convertsToAtMost(o3tl::roundAway(dVal), SbxMAXULNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXULNG;
+ }
+ else if( dVal < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt32>( dVal + 0.5 );
+ break;
+ }
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ nRes = 0;
+ else
+ {
+ double d;
+ SbxDataType t;
+ if( ImpScan( *p->pOUString, d, t, nullptr, true ) != ERRCODE_NONE )
+ nRes = 0;
+ else if( !o3tl::convertsToAtMost(o3tl::roundAway(d), SbxMAXULNG) )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = SbxMAXULNG;
+ }
+ else if( d < 0 )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); nRes = 0;
+ }
+ else
+ nRes = static_cast<sal_uInt32>( d + 0.5 );
+ }
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ nRes = pVal->GetULong();
+ else
+ {
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT ); nRes = 0;
+ }
+ break;
+ }
+
+ case SbxBYREF | SbxBYTE:
+ nRes = *p->pByte; break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ nRes = *p->pUShort; break;
+ case SbxBYREF | SbxULONG:
+ nRes = *p->pULong; break;
+
+ // from here on tests
+ case SbxBYREF | SbxCHAR:
+ aTmp.nChar = *p->pChar; goto ref;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ aTmp.nInteger = *p->pInteger; goto ref;
+ case SbxBYREF | SbxLONG:
+ aTmp.nLong = *p->pLong; goto ref;
+ case SbxBYREF | SbxSINGLE:
+ aTmp.nSingle = *p->pSingle; goto ref;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ aTmp.nDouble = *p->pDouble; goto ref;
+ case SbxBYREF | SbxCURRENCY:
+ case SbxBYREF | SbxSALINT64:
+ aTmp.nInt64 = *p->pnInt64; goto ref;
+ case SbxBYREF | SbxSALUINT64:
+ aTmp.uInt64 = *p->puInt64; goto ref;
+ ref:
+ aTmp.eType = SbxDataType( p->eType & 0x0FFF );
+ p = &aTmp; goto start;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION ); nRes = 0;
+ }
+ return nRes;
+}
+
+void ImpPutULong( SbxValues* p, sal_uInt32 n )
+{
+ SbxValues aTmp;
+start:
+ switch( +p->eType )
+ {
+ case SbxULONG:
+ p->nULong = n; break;
+ case SbxSINGLE:
+ p->nSingle = static_cast<float>(n); break;
+ case SbxDATE:
+ case SbxDOUBLE:
+ p->nDouble = n; break;
+ case SbxCURRENCY:
+ case SbxSALINT64:
+ aTmp.pnInt64 = &p->nInt64; goto direct;
+ case SbxSALUINT64:
+ p->uInt64 = n; break;
+ case SbxDECIMAL:
+ case SbxBYREF | SbxDECIMAL:
+ ImpCreateDecimal( p )->setULong( n );
+ break;
+
+ // from here on tests
+ case SbxCHAR:
+ aTmp.pChar = &p->nChar; goto direct;
+ case SbxUINT:
+ aTmp.pByte = &p->nByte; goto direct;
+ case SbxINTEGER:
+ case SbxBOOL:
+ aTmp.pInteger = &p->nInteger; goto direct;
+ case SbxLONG:
+ aTmp.pLong = &p->nLong; goto direct;
+ case SbxERROR:
+ case SbxUSHORT:
+ aTmp.pUShort = &p->nUShort; goto direct;
+ direct:
+ aTmp.eType = SbxDataType( p->eType | SbxBYREF );
+ p = &aTmp; goto start;
+
+ case SbxBYREF | SbxSTRING:
+ case SbxSTRING:
+ case SbxLPSTR:
+ if( !p->pOUString )
+ p->pOUString = new OUString;
+ ImpCvtNum( static_cast<double>(n), 0, *p->pOUString );
+ break;
+ case SbxOBJECT:
+ {
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->pObj );
+ if( pVal )
+ pVal->PutULong( n );
+ else
+ SbxBase::SetError( ERRCODE_BASIC_NO_OBJECT );
+ break;
+ }
+ case SbxBYREF | SbxCHAR:
+ if( n > SbxMAXCHAR )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXCHAR;
+ }
+ *p->pChar = static_cast<sal_Unicode>(n); break;
+ case SbxBYREF | SbxBYTE:
+ if( n > SbxMAXBYTE )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXBYTE;
+ }
+ *p->pByte = static_cast<sal_uInt8>(n); break;
+ case SbxBYREF | SbxINTEGER:
+ case SbxBYREF | SbxBOOL:
+ if( n > SbxMAXINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXINT;
+ }
+ *p->pInteger = static_cast<sal_Int16>(n); break;
+ case SbxBYREF | SbxERROR:
+ case SbxBYREF | SbxUSHORT:
+ if( n > SbxMAXUINT )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXUINT;
+ }
+ *p->pUShort = static_cast<sal_uInt16>(n); break;
+ case SbxBYREF | SbxLONG:
+ if( n > SbxMAXLNG )
+ {
+ SbxBase::SetError( ERRCODE_BASIC_MATH_OVERFLOW ); n = SbxMAXLNG;
+ }
+ *p->pLong = static_cast<sal_Int32>(n); break;
+ case SbxBYREF | SbxULONG:
+ *p->pULong = n; break;
+ case SbxBYREF | SbxSINGLE:
+ *p->pSingle = static_cast<float>(n); break;
+ case SbxBYREF | SbxDATE:
+ case SbxBYREF | SbxDOUBLE:
+ *p->pDouble = n; break;
+ case SbxBYREF | SbxCURRENCY:
+ *p->pnInt64 = n * CURRENCY_FACTOR; break;
+ case SbxBYREF | SbxSALINT64:
+ *p->pnInt64 = n; break;
+ case SbxBYREF | SbxSALUINT64:
+ *p->puInt64 = n; break;
+
+ default:
+ SbxBase::SetError( ERRCODE_BASIC_CONVERSION );
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxvalue.cxx b/basic/source/sbx/sbxvalue.cxx
new file mode 100644
index 000000000..bd668a029
--- /dev/null
+++ b/basic/source/sbx/sbxvalue.cxx
@@ -0,0 +1,1588 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+
+#include <math.h>
+
+#include <o3tl/float_int_conversion.hxx>
+#include <tools/debug.hxx>
+#include <tools/stream.hxx>
+#include <sal/log.hxx>
+
+#include <basic/sbx.hxx>
+#include <sbunoobj.hxx>
+#include "sbxconv.hxx"
+#include <runtime.hxx>
+
+
+///////////////////////////// constructors
+
+SbxValue::SbxValue() : SbxBase()
+{
+ aData.eType = SbxEMPTY;
+}
+
+SbxValue::SbxValue( SbxDataType t ) : SbxBase()
+{
+ int n = t & 0x0FFF;
+
+ if( n == SbxVARIANT )
+ n = SbxEMPTY;
+ else
+ SetFlag( SbxFlagBits::Fixed );
+ aData.clear(SbxDataType( n ));
+}
+
+SbxValue::SbxValue( const SbxValue& r )
+ : SvRefBase( r ), SbxBase( r )
+{
+ if( !r.CanRead() )
+ {
+ SetError( ERRCODE_BASIC_PROP_WRITEONLY );
+ if( !IsFixed() )
+ aData.eType = SbxNULL;
+ }
+ else
+ {
+ const_cast<SbxValue*>(&r)->Broadcast( SfxHintId::BasicDataWanted );
+ aData = r.aData;
+ // Copy pointer, increment references
+ switch( aData.eType )
+ {
+ case SbxSTRING:
+ if( aData.pOUString )
+ aData.pOUString = new OUString( *aData.pOUString );
+ break;
+ case SbxOBJECT:
+ if( aData.pObj )
+ aData.pObj->AddFirstRef();
+ break;
+ case SbxDECIMAL:
+ if( aData.pDecimal )
+ aData.pDecimal->addRef();
+ break;
+ default: break;
+ }
+ }
+}
+
+SbxValue& SbxValue::operator=( const SbxValue& r )
+{
+ if( &r != this )
+ {
+ if( !CanWrite() )
+ SetError( ERRCODE_BASIC_PROP_READONLY );
+ else
+ {
+ // string -> byte array
+ if( IsFixed() && (aData.eType == SbxOBJECT)
+ && aData.pObj && ( aData.pObj->GetType() == (SbxARRAY | SbxBYTE) )
+ && (r.aData.eType == SbxSTRING) )
+ {
+ OUString aStr = r.GetOUString();
+ SbxArray* pArr = StringToByteArray(aStr);
+ PutObject(pArr);
+ return *this;
+ }
+ // byte array -> string
+ if( r.IsFixed() && (r.aData.eType == SbxOBJECT)
+ && r.aData.pObj && ( r.aData.pObj->GetType() == (SbxARRAY | SbxBYTE) )
+ && (aData.eType == SbxSTRING) )
+ {
+ SbxBase* pObj = r.GetObject();
+ SbxArray* pArr = dynamic_cast<SbxArray*>( pObj );
+ if( pArr )
+ {
+ OUString aStr = ByteArrayToString( pArr );
+ PutString(aStr);
+ return *this;
+ }
+ }
+ // Readout the content of the variables
+ SbxValues aNew;
+ if( IsFixed() )
+ // then the type has to match
+ aNew.eType = aData.eType;
+ else if( r.IsFixed() )
+ // Source fixed: copy the type
+ aNew.eType = SbxDataType( r.aData.eType & 0x0FFF );
+ else
+ // both variant: then don't care
+ aNew.eType = SbxVARIANT;
+ if( r.Get( aNew ) )
+ Put( aNew );
+ }
+ }
+ return *this;
+}
+
+SbxValue::~SbxValue()
+{
+ SetFlag( SbxFlagBits::Write );
+ SbxValue::Clear();
+}
+
+void SbxValue::Clear()
+{
+ switch( aData.eType )
+ {
+ case SbxNULL:
+ case SbxEMPTY:
+ case SbxVOID:
+ break;
+ case SbxSTRING:
+ delete aData.pOUString; aData.pOUString = nullptr;
+ break;
+ case SbxOBJECT:
+ if( aData.pObj )
+ {
+ if( aData.pObj != this )
+ {
+ SAL_INFO("basic.sbx", "Not at Parent-Prop - otherwise CyclicRef");
+ SbxVariable *pThisVar = dynamic_cast<SbxVariable*>( this );
+ bool bParentProp = pThisVar && (pThisVar->GetUserData() & 0xFFFF) == 5345;
+ if ( !bParentProp )
+ aData.pObj->ReleaseRef();
+ }
+ aData.pObj = nullptr;
+ }
+ break;
+ case SbxDECIMAL:
+ releaseDecimalPtr( aData.pDecimal );
+ break;
+ case SbxDATAOBJECT:
+ aData.pData = nullptr; break;
+ default:
+ {
+ SbxValues aEmpty;
+ aEmpty.clear(GetType());
+ Put( aEmpty );
+ }
+ }
+}
+
+// Dummy
+
+void SbxValue::Broadcast( SfxHintId )
+{}
+
+//////////////////////////// Readout data
+
+// Detect the "right" variables. If it is an object, will be addressed either
+// the object itself or its default property.
+// If the variable contain a variable or an object, this will be
+// addressed.
+
+SbxValue* SbxValue::TheRealValue( bool bObjInObjError ) const
+{
+ SbxValue* p = const_cast<SbxValue*>(this);
+ for( ;; )
+ {
+ SbxDataType t = SbxDataType( p->aData.eType & 0x0FFF );
+ if( t == SbxOBJECT )
+ {
+ // The block contains an object or a variable
+ SbxObject* pObj = dynamic_cast<SbxObject*>( p->aData.pObj );
+ if( pObj )
+ {
+ // Has the object a default property?
+ SbxVariable* pDflt = pObj->GetDfltProperty();
+
+ // If this is an object and contains itself,
+ // we cannot access on it
+ // The old condition to set an error is not correct,
+ // because e.g. a regular variant variable with an object
+ // could be affected if another value should be assigned.
+ // Therefore with flag.
+ if( bObjInObjError && !pDflt &&
+ static_cast<SbxValue*>(pObj)->aData.eType == SbxOBJECT &&
+ static_cast<SbxValue*>(pObj)->aData.pObj == pObj )
+ {
+#if !HAVE_FEATURE_SCRIPTING
+ const bool bSuccess = false;
+#else
+ bool bSuccess = handleToStringForCOMObjects( pObj, p );
+#endif
+ if( !bSuccess )
+ {
+ SetError( ERRCODE_BASIC_BAD_PROP_VALUE );
+ p = nullptr;
+ }
+ }
+ else if( pDflt )
+ p = pDflt;
+ break;
+ }
+ // Did we have an array?
+ SbxArray* pArray = dynamic_cast<SbxArray*>( p->aData.pObj );
+ if( pArray )
+ {
+ // When indicated get the parameter
+ SbxArray* pPar = nullptr;
+ SbxVariable* pVar = dynamic_cast<SbxVariable*>( p );
+ if( pVar )
+ pPar = pVar->GetParameters();
+ if( pPar )
+ {
+ // Did we have a dimensioned array?
+ SbxDimArray* pDimArray = dynamic_cast<SbxDimArray*>( p->aData.pObj );
+ if( pDimArray )
+ p = pDimArray->Get( pPar );
+ else
+ p = pArray->Get32( pPar->Get32( 1 )->GetInteger() );
+ break;
+ }
+ }
+ // Otherwise guess a SbxValue
+ SbxValue* pVal = dynamic_cast<SbxValue*>( p->aData.pObj );
+ if( pVal )
+ p = pVal;
+ else
+ break;
+ }
+ else
+ break;
+ }
+ return p;
+}
+
+bool SbxValue::Get( SbxValues& rRes ) const
+{
+ bool bRes = false;
+ ErrCode eOld = GetError();
+ if( eOld != ERRCODE_NONE )
+ ResetError();
+ if( !CanRead() )
+ {
+ SetError( ERRCODE_BASIC_PROP_WRITEONLY );
+ rRes.pObj = nullptr;
+ }
+ else
+ {
+ // If an object or a VARIANT is requested, don't search the real values
+ SbxValue* p = const_cast<SbxValue*>(this);
+ if( rRes.eType != SbxOBJECT && rRes.eType != SbxVARIANT )
+ p = TheRealValue( true );
+ if( p )
+ {
+ p->Broadcast( SfxHintId::BasicDataWanted );
+ switch( rRes.eType )
+ {
+ case SbxEMPTY:
+ case SbxVOID:
+ case SbxNULL: break;
+ case SbxVARIANT: rRes = p->aData; break;
+ case SbxINTEGER: rRes.nInteger = ImpGetInteger( &p->aData ); break;
+ case SbxLONG: rRes.nLong = ImpGetLong( &p->aData ); break;
+ case SbxSALINT64: rRes.nInt64 = ImpGetInt64( &p->aData ); break;
+ case SbxSALUINT64: rRes.uInt64 = ImpGetUInt64( &p->aData ); break;
+ case SbxSINGLE: rRes.nSingle = ImpGetSingle( &p->aData ); break;
+ case SbxDOUBLE: rRes.nDouble = ImpGetDouble( &p->aData ); break;
+ case SbxCURRENCY:rRes.nInt64 = ImpGetCurrency( &p->aData ); break;
+ case SbxDECIMAL: rRes.pDecimal = ImpGetDecimal( &p->aData ); break;
+ case SbxDATE: rRes.nDouble = ImpGetDate( &p->aData ); break;
+ case SbxBOOL:
+ rRes.nUShort = sal::static_int_cast< sal_uInt16 >(
+ ImpGetBool( &p->aData ) );
+ break;
+ case SbxCHAR: rRes.nChar = ImpGetChar( &p->aData ); break;
+ case SbxBYTE: rRes.nByte = ImpGetByte( &p->aData ); break;
+ case SbxUSHORT: rRes.nUShort = ImpGetUShort( &p->aData ); break;
+ case SbxULONG: rRes.nULong = ImpGetULong( &p->aData ); break;
+ case SbxLPSTR:
+ case SbxSTRING: p->aPic = ImpGetString( &p->aData );
+ rRes.pOUString = &p->aPic; break;
+ case SbxCoreSTRING: p->aPic = ImpGetCoreString( &p->aData );
+ rRes.pOUString = &p->aPic; break;
+ case SbxINT:
+ rRes.nInt = static_cast<int>(ImpGetLong( &p->aData ));
+ break;
+ case SbxUINT:
+ rRes.nUInt = static_cast<int>(ImpGetULong( &p->aData ));
+ break;
+ case SbxOBJECT:
+ if( p->aData.eType == SbxOBJECT )
+ rRes.pObj = p->aData.pObj;
+ else
+ {
+ SetError( ERRCODE_BASIC_NO_OBJECT );
+ rRes.pObj = nullptr;
+ }
+ break;
+ default:
+ if( p->aData.eType == rRes.eType )
+ rRes = p->aData;
+ else
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ rRes.pObj = nullptr;
+ }
+ }
+ }
+ else
+ {
+ // Object contained itself
+ SbxDataType eTemp = rRes.eType;
+ rRes.clear(eTemp);
+ }
+ }
+ if( !IsError() )
+ {
+ bRes = true;
+ if( eOld != ERRCODE_NONE )
+ SetError( eOld );
+ }
+ return bRes;
+}
+
+const OUString& SbxValue::GetCoreString() const
+{
+ SbxValues aRes;
+ aRes.eType = SbxCoreSTRING;
+ if( Get( aRes ) )
+ {
+ const_cast<SbxValue*>(this)->aToolString = *aRes.pOUString;
+ }
+ else
+ {
+ const_cast<SbxValue*>(this)->aToolString.clear();
+ }
+ return aToolString;
+}
+
+OUString SbxValue::GetOUString() const
+{
+ OUString aResult;
+ SbxValues aRes;
+ aRes.eType = SbxSTRING;
+ if( Get( aRes ) )
+ {
+ aResult = *aRes.pOUString;
+ }
+ return aResult;
+}
+
+bool SbxValue::GetBool() const
+{
+ SbxValues aRes;
+ aRes.eType = SbxBOOL;
+ Get( aRes );
+ return aRes.nUShort != 0;
+}
+
+#define GET( g, e, t, m ) \
+t SbxValue::g() const { SbxValues aRes(e); Get( aRes ); return aRes.m; }
+
+GET( GetByte, SbxBYTE, sal_uInt8, nByte )
+GET( GetChar, SbxCHAR, sal_Unicode, nChar )
+GET( GetCurrency, SbxCURRENCY, sal_Int64, nInt64 )
+GET( GetDate, SbxDATE, double, nDouble )
+GET( GetDouble, SbxDOUBLE, double, nDouble )
+GET( GetInteger, SbxINTEGER, sal_Int16, nInteger )
+GET( GetLong, SbxLONG, sal_Int32, nLong )
+GET( GetObject, SbxOBJECT, SbxBase*, pObj )
+GET( GetSingle, SbxSINGLE, float, nSingle )
+GET( GetULong, SbxULONG, sal_uInt32, nULong )
+GET( GetUShort, SbxUSHORT, sal_uInt16, nUShort )
+GET( GetInt64, SbxSALINT64, sal_Int64, nInt64 )
+GET( GetUInt64, SbxSALUINT64, sal_uInt64, uInt64 )
+GET( GetDecimal, SbxDECIMAL, SbxDecimal*, pDecimal )
+
+
+//////////////////////////// Write data
+
+bool SbxValue::Put( const SbxValues& rVal )
+{
+ bool bRes = false;
+ ErrCode eOld = GetError();
+ if( eOld != ERRCODE_NONE )
+ ResetError();
+ if( !CanWrite() )
+ SetError( ERRCODE_BASIC_PROP_READONLY );
+ else if( rVal.eType & 0xF000 )
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ else
+ {
+ // If an object is requested, don't search the real values
+ SbxValue* p = this;
+ if( rVal.eType != SbxOBJECT )
+ p = TheRealValue( false ); // Don't allow an error here
+ if( p )
+ {
+ if( !p->CanWrite() )
+ SetError( ERRCODE_BASIC_PROP_READONLY );
+ else if( p->IsFixed() || p->SetType( static_cast<SbxDataType>( rVal.eType & 0x0FFF ) ) )
+ switch( rVal.eType & 0x0FFF )
+ {
+ case SbxEMPTY:
+ case SbxVOID:
+ case SbxNULL: break;
+ case SbxINTEGER: ImpPutInteger( &p->aData, rVal.nInteger ); break;
+ case SbxLONG: ImpPutLong( &p->aData, rVal.nLong ); break;
+ case SbxSALINT64: ImpPutInt64( &p->aData, rVal.nInt64 ); break;
+ case SbxSALUINT64: ImpPutUInt64( &p->aData, rVal.uInt64 ); break;
+ case SbxSINGLE: ImpPutSingle( &p->aData, rVal.nSingle ); break;
+ case SbxDOUBLE: ImpPutDouble( &p->aData, rVal.nDouble ); break;
+ case SbxCURRENCY: ImpPutCurrency( &p->aData, rVal.nInt64 ); break;
+ case SbxDECIMAL: ImpPutDecimal( &p->aData, rVal.pDecimal ); break;
+ case SbxDATE: ImpPutDate( &p->aData, rVal.nDouble ); break;
+ case SbxBOOL: ImpPutBool( &p->aData, rVal.nInteger ); break;
+ case SbxCHAR: ImpPutChar( &p->aData, rVal.nChar ); break;
+ case SbxBYTE: ImpPutByte( &p->aData, rVal.nByte ); break;
+ case SbxUSHORT: ImpPutUShort( &p->aData, rVal.nUShort ); break;
+ case SbxULONG: ImpPutULong( &p->aData, rVal.nULong ); break;
+ case SbxLPSTR:
+ case SbxSTRING: ImpPutString( &p->aData, rVal.pOUString ); break;
+ case SbxINT:
+ ImpPutLong( &p->aData, static_cast<sal_Int32>(rVal.nInt) );
+ break;
+ case SbxUINT:
+ ImpPutULong( &p->aData, static_cast<sal_uInt32>(rVal.nUInt) );
+ break;
+ case SbxOBJECT:
+ if( !p->IsFixed() || p->aData.eType == SbxOBJECT )
+ {
+ // is already inside
+ if( p->aData.eType == SbxOBJECT && p->aData.pObj == rVal.pObj )
+ break;
+
+ // Delete only the value part!
+ p->SbxValue::Clear();
+
+ // real assignment
+ p->aData.pObj = rVal.pObj;
+
+ // if necessary increment Ref-Count
+ if( p->aData.pObj && p->aData.pObj != p )
+ {
+ if ( p != this )
+ {
+ OSL_FAIL( "TheRealValue" );
+ }
+ SAL_INFO("basic.sbx", "Not at Parent-Prop - otherwise CyclicRef");
+ SbxVariable *pThisVar = dynamic_cast<SbxVariable*>( this );
+ bool bParentProp = pThisVar && (pThisVar->GetUserData() & 0xFFFF) == 5345;
+ if ( !bParentProp )
+ p->aData.pObj->AddFirstRef();
+ }
+ }
+ else
+ SetError( ERRCODE_BASIC_CONVERSION );
+ break;
+ default:
+ if( p->aData.eType == rVal.eType )
+ p->aData = rVal;
+ else
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ if( !p->IsFixed() )
+ p->aData.eType = SbxNULL;
+ }
+ }
+ if( !IsError() )
+ {
+ p->SetModified( true );
+ p->Broadcast( SfxHintId::BasicDataChanged );
+ if( eOld != ERRCODE_NONE )
+ SetError( eOld );
+ bRes = true;
+ }
+ }
+ }
+ return bRes;
+}
+
+// From 1996-03-28:
+// Method to execute a pretreatment of the strings at special types.
+// In particular necessary for BASIC-IDE, so that
+// the output in the Watch-Window can be written back with PutStringExt,
+// if Float were declared with ',' as the decimal separator or BOOl
+// explicit with "TRUE" or "FALSE".
+// Implementation in ImpConvStringExt (SBXSCAN.CXX)
+void SbxValue::PutStringExt( const OUString& r )
+{
+ // Copy; if it is Unicode convert it immediately
+ OUString aStr( r );
+
+ // Identify the own type (not as in Put() with TheRealValue(),
+ // Objects are not handled anyway)
+ SbxDataType eTargetType = SbxDataType( aData.eType & 0x0FFF );
+
+ // tinker a Source-Value
+ SbxValues aRes;
+ aRes.eType = SbxSTRING;
+
+ // Only if really something was converted, take the copy,
+ // otherwise take the original (Unicode remains)
+ bool bRet;
+ if( ImpConvStringExt( aStr, eTargetType ) )
+ aRes.pOUString = &aStr;
+ else
+ aRes.pOUString = const_cast<OUString*>(&r);
+
+ // #34939: For Strings which contain a number, and if this has a Num-Type,
+ // set a Fixed flag so that the type will not be changed
+ SbxFlagBits nFlags_ = GetFlags();
+ if( ( eTargetType >= SbxINTEGER && eTargetType <= SbxCURRENCY ) ||
+ ( eTargetType >= SbxCHAR && eTargetType <= SbxUINT ) ||
+ eTargetType == SbxBOOL )
+ {
+ SbxValue aVal;
+ aVal.Put( aRes );
+ if( aVal.IsNumeric() )
+ SetFlag( SbxFlagBits::Fixed );
+ }
+
+ Put( aRes );
+ bRet = bool( !IsError() );
+
+ // If FIXED resulted in an error, set it back
+ // (UI-Action should not result in an error, but simply fail)
+ if( !bRet )
+ ResetError();
+
+ SetFlags( nFlags_ );
+}
+
+bool SbxValue::PutBool( bool b )
+{
+ SbxValues aRes;
+ aRes.eType = SbxBOOL;
+ aRes.nUShort = sal::static_int_cast< sal_uInt16 >(b ? SbxTRUE : SbxFALSE);
+ Put( aRes );
+ return !IsError();
+}
+
+bool SbxValue::PutEmpty()
+{
+ bool bRet = SetType( SbxEMPTY );
+ SetModified( true );
+ return bRet;
+}
+
+void SbxValue::PutNull()
+{
+ bool bRet = SetType( SbxNULL );
+ if( bRet )
+ SetModified( true );
+}
+
+
+// Special decimal methods
+void SbxValue::PutDecimal( css::bridge::oleautomation::Decimal const & rAutomationDec )
+{
+ SbxValue::Clear();
+ aData.pDecimal = new SbxDecimal( rAutomationDec );
+ aData.pDecimal->addRef();
+ aData.eType = SbxDECIMAL;
+}
+
+void SbxValue::fillAutomationDecimal
+ ( css::bridge::oleautomation::Decimal& rAutomationDec ) const
+{
+ SbxDecimal* pDecimal = GetDecimal();
+ if( pDecimal != nullptr )
+ {
+ pDecimal->fillAutomationDecimal( rAutomationDec );
+ }
+}
+
+
+bool SbxValue::PutString( const OUString& r )
+{
+ SbxValues aRes;
+ aRes.eType = SbxSTRING;
+ aRes.pOUString = const_cast<OUString*>(&r);
+ Put( aRes );
+ return !IsError();
+}
+
+
+#define PUT( p, e, t, m ) \
+bool SbxValue::p( t n ) \
+{ SbxValues aRes(e); aRes.m = n; Put( aRes ); return !IsError(); }
+
+void SbxValue::PutDate( double n )
+{ SbxValues aRes(SbxDATE); aRes.nDouble = n; Put( aRes ); }
+void SbxValue::PutErr( sal_uInt16 n )
+{ SbxValues aRes(SbxERROR); aRes.nUShort = n; Put( aRes ); }
+
+PUT( PutByte, SbxBYTE, sal_uInt8, nByte )
+PUT( PutChar, SbxCHAR, sal_Unicode, nChar )
+PUT( PutCurrency, SbxCURRENCY, sal_Int64, nInt64 )
+PUT( PutDouble, SbxDOUBLE, double, nDouble )
+PUT( PutInteger, SbxINTEGER, sal_Int16, nInteger )
+PUT( PutLong, SbxLONG, sal_Int32, nLong )
+PUT( PutObject, SbxOBJECT, SbxBase*, pObj )
+PUT( PutSingle, SbxSINGLE, float, nSingle )
+PUT( PutULong, SbxULONG, sal_uInt32, nULong )
+PUT( PutUShort, SbxUSHORT, sal_uInt16, nUShort )
+PUT( PutInt64, SbxSALINT64, sal_Int64, nInt64 )
+PUT( PutUInt64, SbxSALUINT64, sal_uInt64, uInt64 )
+PUT( PutDecimal, SbxDECIMAL, SbxDecimal*, pDecimal )
+
+////////////////////////// Setting of the data type
+
+bool SbxValue::IsFixed() const
+{
+ return (GetFlags() & SbxFlagBits::Fixed) || ((aData.eType & SbxBYREF) != 0);
+}
+
+// A variable is numeric, if it is EMPTY or really numeric
+// or if it contains a complete convertible String
+
+// #41692, implement it for RTL and Basic-Core separately
+bool SbxValue::IsNumeric() const
+{
+ return ImpIsNumeric( /*bOnlyIntntl*/false );
+}
+
+bool SbxValue::IsNumericRTL() const
+{
+ return ImpIsNumeric( /*bOnlyIntntl*/true );
+}
+
+bool SbxValue::ImpIsNumeric( bool bOnlyIntntl ) const
+{
+
+ if( !CanRead() )
+ {
+ SetError( ERRCODE_BASIC_PROP_WRITEONLY );
+ return false;
+ }
+ // Test downcast!!!
+ if( dynamic_cast<const SbxVariable*>( this) != nullptr )
+ const_cast<SbxVariable*>(static_cast<const SbxVariable*>(this))->Broadcast( SfxHintId::BasicDataWanted );
+ SbxDataType t = GetType();
+ if( t == SbxSTRING )
+ {
+ if( aData.pOUString )
+ {
+ OUString s( *aData.pOUString );
+ double n;
+ SbxDataType t2;
+ sal_uInt16 nLen = 0;
+ if( ImpScan( s, n, t2, &nLen, bOnlyIntntl ) == ERRCODE_NONE )
+ return nLen == s.getLength();
+ }
+ return false;
+ }
+ else
+ return t == SbxEMPTY
+ || ( t >= SbxINTEGER && t <= SbxCURRENCY )
+ || ( t >= SbxCHAR && t <= SbxUINT );
+}
+
+SbxDataType SbxValue::GetType() const
+{
+ return SbxDataType( aData.eType & 0x0FFF );
+}
+
+
+bool SbxValue::SetType( SbxDataType t )
+{
+ DBG_ASSERT( !( t & 0xF000 ), "SetType of BYREF|ARRAY is forbidden!" );
+ if( ( t == SbxEMPTY && aData.eType == SbxVOID )
+ || ( aData.eType == SbxEMPTY && t == SbxVOID ) )
+ return true;
+ if( ( t & 0x0FFF ) == SbxVARIANT )
+ {
+ // Try to set the data type to Variant
+ ResetFlag( SbxFlagBits::Fixed );
+ if( IsFixed() )
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ return false;
+ }
+ t = SbxEMPTY;
+ }
+ if( ( t & 0x0FFF ) != ( aData.eType & 0x0FFF ) )
+ {
+ if( !CanWrite() || IsFixed() )
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ return false;
+ }
+ else
+ {
+ // De-allocate potential objects
+ switch( aData.eType )
+ {
+ case SbxSTRING:
+ delete aData.pOUString;
+ break;
+ case SbxOBJECT:
+ if( aData.pObj && aData.pObj != this )
+ {
+ SAL_WARN("basic.sbx", "Not at Parent-Prop - otherwise CyclicRef");
+ SbxVariable *pThisVar = dynamic_cast<SbxVariable*>( this );
+ sal_uInt32 nSlotId = pThisVar
+ ? pThisVar->GetUserData() & 0xFFFF
+ : 0;
+ DBG_ASSERT( nSlotId != 5345 || pThisVar->GetName() == "Parent",
+ "SID_PARENTOBJECT is not named 'Parent'" );
+ bool bParentProp = nSlotId == 5345;
+ if ( !bParentProp )
+ aData.pObj->ReleaseRef();
+ }
+ break;
+ default: break;
+ }
+ aData.clear(t);
+ }
+ }
+ return true;
+}
+
+bool SbxValue::Convert( SbxDataType eTo )
+{
+ eTo = SbxDataType( eTo & 0x0FFF );
+ if( ( aData.eType & 0x0FFF ) == eTo )
+ return true;
+ if( !CanWrite() )
+ return false;
+ if( eTo == SbxVARIANT )
+ {
+ // Trial to set the data type to Variant
+ ResetFlag( SbxFlagBits::Fixed );
+ if( IsFixed() )
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ return false;
+ }
+ else
+ return true;
+ }
+ // Converting from null doesn't work. Once null, always null!
+ if( aData.eType == SbxNULL )
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ return false;
+ }
+
+ // Conversion of the data:
+ SbxValues aNew;
+ aNew.eType = eTo;
+ if( Get( aNew ) )
+ {
+ // The data type could be converted. It ends here with fixed elements,
+ // because the data had not to be taken over
+ if( !IsFixed() )
+ {
+ SetType( eTo );
+ Put( aNew );
+ SetModified( true );
+ }
+ return true;
+ }
+ else
+ return false;
+}
+////////////////////////////////// Calculating
+
+bool SbxValue::Compute( SbxOperator eOp, const SbxValue& rOp )
+{
+#if !HAVE_FEATURE_SCRIPTING
+ const bool bVBAInterop = false;
+#else
+ bool bVBAInterop = SbiRuntime::isVBAEnabled();
+#endif
+ SbxDataType eThisType = GetType();
+ SbxDataType eOpType = rOp.GetType();
+ ErrCode eOld = GetError();
+ if( eOld != ERRCODE_NONE )
+ ResetError();
+ if( !CanWrite() )
+ SetError( ERRCODE_BASIC_PROP_READONLY );
+ else if( !rOp.CanRead() )
+ SetError( ERRCODE_BASIC_PROP_WRITEONLY );
+ // Special rule 1: If one operand is null, the result is null
+ else if( eThisType == SbxNULL || eOpType == SbxNULL )
+ SetType( SbxNULL );
+ else
+ {
+ SbxValues aL, aR;
+ bool bDecimal = false;
+ if( bVBAInterop && ( ( eThisType == SbxSTRING && eOpType != SbxSTRING && eOpType != SbxEMPTY ) ||
+ ( eThisType != SbxSTRING && eThisType != SbxEMPTY && eOpType == SbxSTRING ) ) &&
+ ( eOp == SbxMUL || eOp == SbxDIV || eOp == SbxPLUS || eOp == SbxMINUS ) )
+ {
+ goto Lbl_OpIsDouble;
+ }
+ else if( eThisType == SbxSTRING || eOp == SbxCAT || ( bVBAInterop && ( eOpType == SbxSTRING ) && ( eOp == SbxPLUS ) ) )
+ {
+ if( eOp == SbxCAT || eOp == SbxPLUS )
+ {
+ // From 1999-11-5, keep OUString in mind
+ aL.eType = aR.eType = SbxSTRING;
+ rOp.Get( aR );
+ // From 1999-12-8, #70399: Here call GetType() again, Get() can change the type!
+ if( rOp.GetType() == SbxEMPTY )
+ goto Lbl_OpIsEmpty; // concatenate empty, *this stays lhs as result
+ Get( aL );
+
+ // #30576: To begin with test, if the conversion worked
+ if( aL.pOUString != nullptr && aR.pOUString != nullptr )
+ {
+ // tdf#108039: catch possible bad_alloc
+ try {
+ *aL.pOUString += *aR.pOUString;
+ }
+ catch (const std::bad_alloc&) {
+ SetError(ERRCODE_BASIC_MATH_OVERFLOW);
+ }
+ }
+ // Not even Left OK?
+ else if( aL.pOUString == nullptr )
+ {
+ aL.pOUString = new OUString();
+ }
+ }
+ else
+ SetError( ERRCODE_BASIC_CONVERSION );
+ }
+ else if( eOpType == SbxSTRING && rOp.IsFixed() )
+ { // Numeric: there is no String allowed on the right side
+ SetError( ERRCODE_BASIC_CONVERSION );
+ // falls all the way out
+ }
+ else if( ( eOp >= SbxIDIV && eOp <= SbxNOT ) || eOp == SbxMOD )
+ {
+ if( GetType() == eOpType )
+ {
+ if( GetType() == SbxSALUINT64 || GetType() == SbxSALINT64
+ || GetType() == SbxCURRENCY || GetType() == SbxULONG )
+ aL.eType = aR.eType = GetType();
+ else if ( bVBAInterop && eOpType == SbxBOOL )
+ aL.eType = aR.eType = SbxBOOL;
+ else
+ aL.eType = aR.eType = SbxLONG;
+ }
+ else
+ aL.eType = aR.eType = SbxLONG;
+
+ if( rOp.Get( aR ) ) // re-do Get after type assigns above
+ {
+ if( Get( aL ) ) switch( eOp )
+ {
+ /* TODO: For SbxEMPTY operands with boolean operators use
+ * the VBA Nothing definition of Comparing Nullable Types?
+ * https://docs.microsoft.com/en-us/dotnet/visual-basic/programming-guide/language-features/data-types/nullable-value-types
+ */
+ /* TODO: it is unclear yet whether this also should be done
+ * for the non-bVBAInterop case or not, or at all, consider
+ * user defined spreadsheet functions where an empty cell
+ * is SbxEMPTY and usually is treated as 0 zero or "" empty
+ * string.
+ */
+ case SbxIDIV:
+ if( aL.eType == SbxCURRENCY )
+ if( !aR.nInt64 ) SetError( ERRCODE_BASIC_ZERODIV );
+ else {
+ aL.nInt64 /= aR.nInt64;
+ aL.nInt64 *= CURRENCY_FACTOR;
+ }
+ else if( aL.eType == SbxSALUINT64 )
+ if( !aR.uInt64 ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.uInt64 /= aR.uInt64;
+ else if( aL.eType == SbxSALINT64 )
+ if( !aR.nInt64 ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.nInt64 /= aR.nInt64;
+ else if( aL.eType == SbxLONG )
+ if( !aR.nLong ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.nLong /= aR.nLong;
+ else
+ if( !aR.nULong ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.nULong /= aR.nULong;
+ break;
+ case SbxMOD:
+ if( aL.eType == SbxCURRENCY || aL.eType == SbxSALINT64 )
+ if( !aR.nInt64 ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.nInt64 %= aR.nInt64;
+ else if( aL.eType == SbxSALUINT64 )
+ if( !aR.uInt64 ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.uInt64 %= aR.uInt64;
+ else if( aL.eType == SbxLONG )
+ if( !aR.nLong ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.nLong %= aR.nLong;
+ else
+ if( !aR.nULong ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.nULong %= aR.nULong;
+ break;
+ case SbxAND:
+ if( aL.eType != SbxLONG && aL.eType != SbxULONG )
+ aL.nInt64 &= aR.nInt64;
+ else
+ aL.nLong &= aR.nLong;
+ break;
+ case SbxOR:
+ if( aL.eType != SbxLONG && aL.eType != SbxULONG )
+ aL.nInt64 |= aR.nInt64;
+ else
+ aL.nLong |= aR.nLong;
+ break;
+ case SbxXOR:
+ if( aL.eType != SbxLONG && aL.eType != SbxULONG )
+ aL.nInt64 ^= aR.nInt64;
+ else
+ aL.nLong ^= aR.nLong;
+ break;
+ case SbxEQV:
+ if( aL.eType != SbxLONG && aL.eType != SbxULONG )
+ aL.nInt64 = (aL.nInt64 & aR.nInt64) | (~aL.nInt64 & ~aR.nInt64);
+ else
+ aL.nLong = (aL.nLong & aR.nLong) | (~aL.nLong & ~aR.nLong);
+ break;
+ case SbxIMP:
+ if( aL.eType != SbxLONG && aL.eType != SbxULONG )
+ aL.nInt64 = ~aL.nInt64 | aR.nInt64;
+ else
+ aL.nLong = ~aL.nLong | aR.nLong;
+ break;
+ case SbxNOT:
+ if( aL.eType != SbxLONG && aL.eType != SbxULONG )
+ {
+ if ( aL.eType != SbxBOOL )
+ aL.nInt64 = ~aL.nInt64;
+ else
+ aL.nLong = ~aL.nLong;
+ }
+ else
+ aL.nLong = ~aL.nLong;
+ break;
+ default: break;
+ }
+ }
+ }
+ else if( ( GetType() == SbxDECIMAL || rOp.GetType() == SbxDECIMAL )
+ && ( eOp == SbxMUL || eOp == SbxDIV || eOp == SbxPLUS || eOp == SbxMINUS || eOp == SbxNEG ) )
+ {
+ aL.eType = aR.eType = SbxDECIMAL;
+ bDecimal = true;
+ if( rOp.Get( aR ) && Get( aL ) )
+ {
+ if( aL.pDecimal && aR.pDecimal )
+ {
+ bool bOk = true;
+ switch( eOp )
+ {
+ case SbxMUL:
+ bOk = ( *(aL.pDecimal) *= *(aR.pDecimal) );
+ break;
+ case SbxDIV:
+ if( aR.pDecimal->isZero() )
+ SetError( ERRCODE_BASIC_ZERODIV );
+ else
+ bOk = ( *(aL.pDecimal) /= *(aR.pDecimal) );
+ break;
+ case SbxPLUS:
+ bOk = ( *(aL.pDecimal) += *(aR.pDecimal) );
+ break;
+ case SbxMINUS:
+ bOk = ( *(aL.pDecimal) -= *(aR.pDecimal) );
+ break;
+ case SbxNEG:
+ bOk = ( aL.pDecimal->neg() );
+ break;
+ default:
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ if( !bOk )
+ SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ }
+ else
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ }
+ }
+ }
+ else if( GetType() == SbxCURRENCY || rOp.GetType() == SbxCURRENCY )
+ {
+ aL.eType = SbxCURRENCY;
+ aR.eType = SbxCURRENCY;
+
+ if( rOp.Get( aR ) )
+ {
+ if( Get( aL ) ) switch( eOp )
+ {
+ case SbxMUL:
+ {
+ // first overflow check: see if product will fit - test real value of product (hence 2 curr factors)
+ double dTest = static_cast<double>(aL.nInt64) * static_cast<double>(aR.nInt64) / double(CURRENCY_FACTOR_SQUARE);
+ if( dTest < SbxMINCURR || SbxMAXCURR < dTest)
+ {
+ aL.nInt64 = SAL_MAX_INT64;
+ if( dTest < SbxMINCURR ) aL.nInt64 = SAL_MIN_INT64;
+ SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ // second overflow check: see if unscaled product overflows - if so use doubles
+ dTest = static_cast<double>(aL.nInt64) * static_cast<double>(aR.nInt64);
+ if( !(o3tl::convertsToAtLeast(dTest, SAL_MIN_INT64)
+ && o3tl::convertsToAtMost(dTest, SAL_MAX_INT64)))
+ {
+ aL.nInt64 = static_cast<sal_Int64>( dTest / double(CURRENCY_FACTOR) );
+ break;
+ }
+ // precise calc: multiply then scale back (move decimal pt)
+ aL.nInt64 *= aR.nInt64;
+ aL.nInt64 /= CURRENCY_FACTOR;
+ break;
+ }
+
+ case SbxDIV:
+ {
+ if( !aR.nInt64 )
+ {
+ SetError( ERRCODE_BASIC_ZERODIV );
+ break;
+ }
+ // first overflow check: see if quotient will fit - calc real value of quotient (curr factors cancel)
+ double dTest = static_cast<double>(aL.nInt64) / static_cast<double>(aR.nInt64);
+ if( dTest < SbxMINCURR || SbxMAXCURR < dTest)
+ {
+ SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ // second overflow check: see if scaled dividend overflows - if so use doubles
+ dTest = static_cast<double>(aL.nInt64) * double(CURRENCY_FACTOR);
+ if( !(o3tl::convertsToAtLeast(dTest, SAL_MIN_INT64)
+ && o3tl::convertsToAtMost(dTest, SAL_MAX_INT64)))
+ {
+ aL.nInt64 = static_cast<sal_Int64>(dTest / static_cast<double>(aR.nInt64));
+ break;
+ }
+ // precise calc: scale (move decimal pt) then divide
+ aL.nInt64 *= CURRENCY_FACTOR;
+ aL.nInt64 /= aR.nInt64;
+ break;
+ }
+
+ case SbxPLUS:
+ {
+ double dTest = ( static_cast<double>(aL.nInt64) + static_cast<double>(aR.nInt64) ) / double(CURRENCY_FACTOR);
+ if( dTest < SbxMINCURR || SbxMAXCURR < dTest)
+ {
+ SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ aL.nInt64 += aR.nInt64;
+ break;
+ }
+
+ case SbxMINUS:
+ {
+ double dTest = ( static_cast<double>(aL.nInt64) - static_cast<double>(aR.nInt64) ) / double(CURRENCY_FACTOR);
+ if( dTest < SbxMINCURR || SbxMAXCURR < dTest)
+ {
+ SetError( ERRCODE_BASIC_MATH_OVERFLOW );
+ break;
+ }
+ aL.nInt64 -= aR.nInt64;
+ break;
+ }
+ case SbxNEG:
+ aL.nInt64 = -aL.nInt64;
+ break;
+ default:
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ }
+ }
+ else
+Lbl_OpIsDouble:
+ { // other types and operators including Date, Double and Single
+ aL.eType = aR.eType = SbxDOUBLE;
+ if( rOp.Get( aR ) )
+ {
+ if( Get( aL ) )
+ {
+ switch( eOp )
+ {
+ case SbxEXP:
+ aL.nDouble = pow( aL.nDouble, aR.nDouble );
+ break;
+ case SbxMUL:
+ aL.nDouble *= aR.nDouble; break;
+ case SbxDIV:
+ if( !aR.nDouble ) SetError( ERRCODE_BASIC_ZERODIV );
+ else aL.nDouble /= aR.nDouble;
+ break;
+ case SbxPLUS:
+ aL.nDouble += aR.nDouble; break;
+ case SbxMINUS:
+ aL.nDouble -= aR.nDouble; break;
+ case SbxNEG:
+ aL.nDouble = -aL.nDouble; break;
+ default:
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ // Date with "+" or "-" needs special handling that
+ // forces the Date type. If the operation is '+' the
+ // result is always a Date, if '-' the result is only
+ // a Date if one of lhs or rhs ( but not both ) is already
+ // a Date
+ if( GetType() == SbxDATE || rOp.GetType() == SbxDATE )
+ {
+ if( eOp == SbxPLUS || ( ( eOp == SbxMINUS ) && ( GetType() != rOp.GetType() ) ) )
+ aL.eType = SbxDATE;
+ }
+
+ }
+ }
+
+ }
+ if( !IsError() )
+ Put( aL );
+ if( bDecimal )
+ {
+ releaseDecimalPtr( aL.pDecimal );
+ releaseDecimalPtr( aR.pDecimal );
+ }
+ }
+Lbl_OpIsEmpty:
+
+ bool bRes = !IsError();
+ if( bRes && eOld != ERRCODE_NONE )
+ SetError( eOld );
+ return bRes;
+}
+
+// The comparison routine deliver TRUE or FALSE.
+
+bool SbxValue::Compare( SbxOperator eOp, const SbxValue& rOp ) const
+{
+#if !HAVE_FEATURE_SCRIPTING
+ const bool bVBAInterop = false;
+#else
+ bool bVBAInterop = SbiRuntime::isVBAEnabled();
+#endif
+
+ bool bRes = false;
+ ErrCode eOld = GetError();
+ if( eOld != ERRCODE_NONE )
+ ResetError();
+ if( !CanRead() || !rOp.CanRead() )
+ SetError( ERRCODE_BASIC_PROP_WRITEONLY );
+ else if( GetType() == SbxNULL && rOp.GetType() == SbxNULL && !bVBAInterop )
+ {
+ bRes = true;
+ }
+ else if( GetType() == SbxEMPTY && rOp.GetType() == SbxEMPTY )
+ bRes = !bVBAInterop || ( eOp == SbxEQ );
+ // Special rule 1: If an operand is null, the result is FALSE
+ else if( GetType() == SbxNULL || rOp.GetType() == SbxNULL )
+ bRes = false;
+ // Special rule 2: If both are variant and one is numeric
+ // and the other is a String, num is < str
+ else if( !IsFixed() && !rOp.IsFixed()
+ && ( rOp.GetType() == SbxSTRING && GetType() != SbxSTRING && IsNumeric() ) && !bVBAInterop
+ )
+ bRes = eOp == SbxLT || eOp == SbxLE || eOp == SbxNE;
+ else if( !IsFixed() && !rOp.IsFixed()
+ && ( GetType() == SbxSTRING && rOp.GetType() != SbxSTRING && rOp.IsNumeric() )
+&& !bVBAInterop
+ )
+ bRes = eOp == SbxGT || eOp == SbxGE || eOp == SbxNE;
+ else
+ {
+ SbxValues aL, aR;
+ // If one of the operands is a String,
+ // a String comparing take place
+ if( GetType() == SbxSTRING || rOp.GetType() == SbxSTRING )
+ {
+ aL.eType = aR.eType = SbxSTRING;
+ if( Get( aL ) && rOp.Get( aR ) ) switch( eOp )
+ {
+ case SbxEQ:
+ bRes = ( *aL.pOUString == *aR.pOUString ); break;
+ case SbxNE:
+ bRes = ( *aL.pOUString != *aR.pOUString ); break;
+ case SbxLT:
+ bRes = ( *aL.pOUString < *aR.pOUString ); break;
+ case SbxGT:
+ bRes = ( *aL.pOUString > *aR.pOUString ); break;
+ case SbxLE:
+ bRes = ( *aL.pOUString <= *aR.pOUString ); break;
+ case SbxGE:
+ bRes = ( *aL.pOUString >= *aR.pOUString ); break;
+ default:
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ }
+ // From 1995-12-19: If SbxSINGLE participate, then convert to SINGLE,
+ // otherwise it shows a numeric error
+ else if( GetType() == SbxSINGLE || rOp.GetType() == SbxSINGLE )
+ {
+ aL.eType = aR.eType = SbxSINGLE;
+ if( Get( aL ) && rOp.Get( aR ) )
+ switch( eOp )
+ {
+ case SbxEQ:
+ bRes = ( aL.nSingle == aR.nSingle ); break;
+ case SbxNE:
+ bRes = ( aL.nSingle != aR.nSingle ); break;
+ case SbxLT:
+ bRes = ( aL.nSingle < aR.nSingle ); break;
+ case SbxGT:
+ bRes = ( aL.nSingle > aR.nSingle ); break;
+ case SbxLE:
+ bRes = ( aL.nSingle <= aR.nSingle ); break;
+ case SbxGE:
+ bRes = ( aL.nSingle >= aR.nSingle ); break;
+ default:
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ }
+ else if( GetType() == SbxDECIMAL && rOp.GetType() == SbxDECIMAL )
+ {
+ aL.eType = aR.eType = SbxDECIMAL;
+ Get( aL );
+ rOp.Get( aR );
+ if( aL.pDecimal && aR.pDecimal )
+ {
+ SbxDecimal::CmpResult eRes = compare( *aL.pDecimal, *aR.pDecimal );
+ switch( eOp )
+ {
+ case SbxEQ:
+ bRes = ( eRes == SbxDecimal::CmpResult::EQ ); break;
+ case SbxNE:
+ bRes = ( eRes != SbxDecimal::CmpResult::EQ ); break;
+ case SbxLT:
+ bRes = ( eRes == SbxDecimal::CmpResult::LT ); break;
+ case SbxGT:
+ bRes = ( eRes == SbxDecimal::CmpResult::GT ); break;
+ case SbxLE:
+ bRes = ( eRes != SbxDecimal::CmpResult::GT ); break;
+ case SbxGE:
+ bRes = ( eRes != SbxDecimal::CmpResult::LT ); break;
+ default:
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ }
+ else
+ {
+ SetError( ERRCODE_BASIC_CONVERSION );
+ }
+ releaseDecimalPtr( aL.pDecimal );
+ releaseDecimalPtr( aR.pDecimal );
+ }
+ // Everything else comparing on a SbxDOUBLE-Basis
+ else
+ {
+ aL.eType = aR.eType = SbxDOUBLE;
+ bool bGetL = Get( aL );
+ bool bGetR = rOp.Get( aR );
+ if( bGetL && bGetR )
+ switch( eOp )
+ {
+ case SbxEQ:
+ bRes = ( aL.nDouble == aR.nDouble ); break;
+ case SbxNE:
+ bRes = ( aL.nDouble != aR.nDouble ); break;
+ case SbxLT:
+ bRes = ( aL.nDouble < aR.nDouble ); break;
+ case SbxGT:
+ bRes = ( aL.nDouble > aR.nDouble ); break;
+ case SbxLE:
+ bRes = ( aL.nDouble <= aR.nDouble ); break;
+ case SbxGE:
+ bRes = ( aL.nDouble >= aR.nDouble ); break;
+ default:
+ SetError( ERRCODE_BASIC_BAD_ARGUMENT );
+ }
+ // at least one value was got
+ // if this is VBA then a conversion error for one
+ // side will yield a false result of an equality test
+ else if ( bGetR || bGetL )
+ {
+ if ( bVBAInterop && eOp == SbxEQ && GetError() == ERRCODE_BASIC_CONVERSION )
+ {
+#ifndef IOS
+ ResetError();
+ bRes = false;
+#endif
+ }
+ }
+ }
+ }
+ if( eOld != ERRCODE_NONE )
+ SetError( eOld );
+ return bRes;
+}
+
+///////////////////////////// Reading/Writing
+
+bool SbxValue::LoadData( SvStream& r, sal_uInt16 )
+{
+ // #TODO see if these types are really dumped to any stream
+ // more than likely this is functionality used in the binfilter alone
+ SbxValue::Clear();
+ sal_uInt16 nType;
+ r.ReadUInt16( nType );
+ aData.eType = SbxDataType( nType );
+ switch( nType )
+ {
+ case SbxBOOL:
+ case SbxINTEGER:
+ r.ReadInt16( aData.nInteger ); break;
+ case SbxLONG:
+ r.ReadInt32( aData.nLong ); break;
+ case SbxSINGLE:
+ {
+ // Floats as ASCII
+ OUString aVal = read_uInt16_lenPrefixed_uInt8s_ToOUString(r,
+ RTL_TEXTENCODING_ASCII_US);
+ double d;
+ SbxDataType t;
+ if( ImpScan( aVal, d, t, nullptr, true ) != ERRCODE_NONE || t == SbxDOUBLE )
+ {
+ aData.nSingle = 0.0F;
+ return false;
+ }
+ aData.nSingle = static_cast<float>(d);
+ break;
+ }
+ case SbxDATE:
+ case SbxDOUBLE:
+ {
+ // Floats as ASCII
+ OUString aVal = read_uInt16_lenPrefixed_uInt8s_ToOUString(r,
+ RTL_TEXTENCODING_ASCII_US);
+ SbxDataType t;
+ if( ImpScan( aVal, aData.nDouble, t, nullptr, true ) != ERRCODE_NONE )
+ {
+ aData.nDouble = 0.0;
+ return false;
+ }
+ break;
+ }
+ case SbxSALINT64:
+ r.ReadInt64(aData.nInt64);
+ break;
+ case SbxSALUINT64:
+ r.ReadUInt64( aData.uInt64 );
+ break;
+ case SbxCURRENCY:
+ {
+ sal_uInt32 tmpHi = 0;
+ sal_uInt32 tmpLo = 0;
+ r.ReadUInt32( tmpHi ).ReadUInt32( tmpLo );
+ aData.nInt64 = (static_cast<sal_Int64>(tmpHi) << 32);
+ aData.nInt64 |= static_cast<sal_Int64>(tmpLo);
+ break;
+ }
+ case SbxSTRING:
+ {
+ OUString aVal = read_uInt16_lenPrefixed_uInt8s_ToOUString(r,
+ RTL_TEXTENCODING_ASCII_US);
+ if( !aVal.isEmpty() )
+ aData.pOUString = new OUString( aVal );
+ else
+ aData.pOUString = nullptr; // JSM 1995-09-22
+ break;
+ }
+ case SbxERROR:
+ case SbxUSHORT:
+ r.ReadUInt16( aData.nUShort ); break;
+ case SbxOBJECT:
+ {
+ sal_uInt8 nMode;
+ r.ReadUChar( nMode );
+ switch( nMode )
+ {
+ case 0:
+ aData.pObj = nullptr;
+ break;
+ case 1:
+ aData.pObj = SbxBase::Load( r );
+ return ( aData.pObj != nullptr );
+ case 2:
+ aData.pObj = this;
+ break;
+ }
+ break;
+ }
+ case SbxCHAR:
+ {
+ char c;
+ r.ReadChar( c );
+ aData.nChar = c;
+ break;
+ }
+ case SbxBYTE:
+ r.ReadUChar( aData.nByte ); break;
+ case SbxULONG:
+ r.ReadUInt32( aData.nULong ); break;
+ case SbxINT:
+ {
+ sal_uInt8 n;
+ r.ReadUChar( n );
+ // Match the Int on this system?
+ if( n > SAL_TYPES_SIZEOFINT )
+ {
+ r.ReadInt32( aData.nLong );
+ aData.eType = SbxLONG;
+ }
+ else {
+ sal_Int32 nInt;
+ r.ReadInt32( nInt );
+ aData.nInt = nInt;
+ }
+ break;
+ }
+ case SbxUINT:
+ {
+ sal_uInt8 n;
+ r.ReadUChar( n );
+ // Match the UInt on this system?
+ if( n > SAL_TYPES_SIZEOFINT )
+ {
+ r.ReadUInt32( aData.nULong );
+ aData.eType = SbxULONG;
+ }
+ else {
+ sal_uInt32 nUInt;
+ r.ReadUInt32( nUInt );
+ aData.nUInt = nUInt;
+ }
+ break;
+ }
+ case SbxEMPTY:
+ case SbxNULL:
+ case SbxVOID:
+ break;
+ case SbxDATAOBJECT:
+ r.ReadInt32( aData.nLong );
+ break;
+ // #78919 For backwards compatibility
+ case SbxWSTRING:
+ case SbxWCHAR:
+ break;
+ default:
+ aData.clear(SbxNULL);
+ ResetFlag(SbxFlagBits::Fixed);
+ SAL_WARN( "basic.sbx", "Loaded a non-supported data type" );
+
+ return false;
+ }
+ return true;
+}
+
+ bool SbxValue::StoreData( SvStream& r ) const
+ {
+ sal_uInt16 nType = sal::static_int_cast< sal_uInt16 >(aData.eType);
+ r.WriteUInt16( nType );
+ switch( nType & 0x0FFF )
+ {
+ case SbxBOOL:
+ case SbxINTEGER:
+ r.WriteInt16( aData.nInteger ); break;
+ case SbxLONG:
+ r.WriteInt32( aData.nLong ); break;
+ case SbxDATE:
+ // #49935: Save as double, otherwise an error during the read in
+ const_cast<SbxValue*>(this)->aData.eType = static_cast<SbxDataType>( ( nType & 0xF000 ) | SbxDOUBLE );
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(r, GetCoreString(), RTL_TEXTENCODING_ASCII_US);
+ const_cast<SbxValue*>(this)->aData.eType = static_cast<SbxDataType>(nType);
+ break;
+ case SbxSINGLE:
+ case SbxDOUBLE:
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(r, GetCoreString(), RTL_TEXTENCODING_ASCII_US);
+ break;
+ case SbxSALUINT64:
+ case SbxSALINT64:
+ // see comment in SbxValue::StoreData
+ r.WriteUInt64( aData.uInt64 );
+ break;
+ case SbxCURRENCY:
+ {
+ sal_Int32 tmpHi = ( (aData.nInt64 >> 32) & 0xFFFFFFFF );
+ sal_Int32 tmpLo = static_cast<sal_Int32>(aData.nInt64);
+ r.WriteInt32( tmpHi ).WriteInt32( tmpLo );
+ break;
+ }
+ case SbxSTRING:
+ if( aData.pOUString )
+ {
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(r, *aData.pOUString, RTL_TEXTENCODING_ASCII_US);
+ }
+ else
+ {
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(r, OUString(), RTL_TEXTENCODING_ASCII_US);
+ }
+ break;
+ case SbxERROR:
+ case SbxUSHORT:
+ r.WriteUInt16( aData.nUShort ); break;
+ case SbxOBJECT:
+ // to save itself as Objectptr does not work!
+ if( aData.pObj )
+ {
+ if( dynamic_cast<SbxValue*>( aData.pObj) != this )
+ {
+ r.WriteUChar( 1 );
+ return aData.pObj->Store( r );
+ }
+ else
+ r.WriteUChar( 2 );
+ }
+ else
+ r.WriteUChar( 0 );
+ break;
+ case SbxCHAR:
+ {
+ char c = sal::static_int_cast< char >(aData.nChar);
+ r.WriteChar( c );
+ break;
+ }
+ case SbxBYTE:
+ r.WriteUChar( aData.nByte ); break;
+ case SbxULONG:
+ r.WriteUInt32( aData.nULong ); break;
+ case SbxINT:
+ {
+ r.WriteUChar( SAL_TYPES_SIZEOFINT ).WriteInt32( aData.nInt );
+ break;
+ }
+ case SbxUINT:
+ {
+ r.WriteUChar( SAL_TYPES_SIZEOFINT ).WriteUInt32( aData.nUInt );
+ break;
+ }
+ case SbxEMPTY:
+ case SbxNULL:
+ case SbxVOID:
+ break;
+ case SbxDATAOBJECT:
+ r.WriteInt32( aData.nLong );
+ break;
+ // #78919 For backwards compatibility
+ case SbxWSTRING:
+ case SbxWCHAR:
+ break;
+ default:
+ SAL_WARN( "basic.sbx", "Saving a non-supported data type" );
+ return false;
+ }
+ return true;
+ }
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/sbx/sbxvar.cxx b/basic/source/sbx/sbxvar.cxx
new file mode 100644
index 000000000..5f8924178
--- /dev/null
+++ b/basic/source/sbx/sbxvar.cxx
@@ -0,0 +1,650 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_features.h>
+
+#include <tools/stream.hxx>
+#include <svl/SfxBroadcaster.hxx>
+
+#include <basic/sbx.hxx>
+#include <runtime.hxx>
+#include "sbxres.hxx"
+#include "sbxconv.hxx"
+#include <sbunoobj.hxx>
+#include <rtl/character.hxx>
+#include <sal/log.hxx>
+
+#include <com/sun/star/uno/XInterface.hpp>
+using namespace com::sun::star::uno;
+
+// SbxVariable
+
+
+// SbxVariableImpl
+
+class SbxVariableImpl
+{
+ friend class SbxVariable;
+ OUString m_aDeclareClassName;
+ Reference< XInterface > m_xComListener;
+ StarBASIC* m_pComListenerParentBasic;
+
+ SbxVariableImpl()
+ : m_pComListenerParentBasic( nullptr )
+ {}
+};
+
+
+// Constructors
+
+SbxVariable::SbxVariable() : SbxValue()
+{
+ pParent = nullptr;
+ nUserData = 0;
+ nHash = 0;
+}
+
+SbxVariable::SbxVariable( const SbxVariable& r )
+ : SvRefBase( r ),
+ SbxValue( r ),
+ mpPar( r.mpPar ),
+ pInfo( r.pInfo )
+{
+ if( r.mpImpl != nullptr )
+ {
+ mpImpl.reset( new SbxVariableImpl( *r.mpImpl ) );
+#if HAVE_FEATURE_SCRIPTING
+ if( mpImpl->m_xComListener.is() )
+ {
+ registerComListenerVariableForBasic( this, mpImpl->m_pComListenerParentBasic );
+ }
+#endif
+ }
+ if( r.CanRead() )
+ {
+ pParent = r.pParent;
+ nUserData = r.nUserData;
+ maName = r.maName;
+ nHash = r.nHash;
+ }
+ else
+ {
+ pParent = nullptr;
+ nUserData = 0;
+ nHash = 0;
+ }
+}
+
+SbxEnsureParentVariable::SbxEnsureParentVariable(const SbxVariable& r)
+ : SbxVariable(r)
+ , xParent(const_cast<SbxVariable&>(r).GetParent())
+{
+ assert(GetParent() == xParent.get());
+}
+
+void SbxEnsureParentVariable::SetParent(SbxObject* p)
+{
+ assert(GetParent() == xParent.get());
+ SbxVariable::SetParent(p);
+ xParent = SbxObjectRef(p);
+ assert(GetParent() == xParent.get());
+}
+
+SbxVariable::SbxVariable( SbxDataType t ) : SbxValue( t )
+{
+ pParent = nullptr;
+ nUserData = 0;
+ nHash = 0;
+}
+
+SbxVariable::~SbxVariable()
+{
+#if HAVE_FEATURE_SCRIPTING
+ if( IsSet( SbxFlagBits::DimAsNew ))
+ {
+ removeDimAsNewRecoverItem( this );
+ }
+#endif
+ mpBroadcaster.reset();
+}
+
+// Broadcasting
+
+SfxBroadcaster& SbxVariable::GetBroadcaster()
+{
+ if( !mpBroadcaster )
+ {
+ mpBroadcaster.reset( new SfxBroadcaster );
+ }
+ return *mpBroadcaster;
+}
+
+SbxArray* SbxVariable::GetParameters() const
+{
+ return mpPar.get();
+}
+
+
+// Perhaps some day one could cut the parameter 0.
+// Then the copying will be dropped...
+
+void SbxVariable::Broadcast( SfxHintId nHintId )
+{
+ if( !(mpBroadcaster && !IsSet( SbxFlagBits::NoBroadcast )) )
+ return;
+
+ // Because the method could be called from outside, check the
+ // rights here again
+ if( nHintId == SfxHintId::BasicDataWanted )
+ {
+ if( !CanRead() )
+ {
+ return;
+ }
+ }
+ if( nHintId == SfxHintId::BasicDataChanged )
+ {
+ if( !CanWrite() )
+ {
+ return;
+ }
+ }
+
+ //fdo#86843 Add a ref during the following block to guard against
+ //getting deleted before completing this method
+ SbxVariableRef aBroadcastGuard(this);
+
+ // Avoid further broadcasting
+ std::unique_ptr<SfxBroadcaster> pSave = std::move(mpBroadcaster);
+ SbxFlagBits nSaveFlags = GetFlags();
+ SetFlag( SbxFlagBits::ReadWrite );
+ if( mpPar.is() )
+ {
+ // Register this as element 0, but don't change over the parent!
+ mpPar->GetRef32( 0 ) = this;
+ }
+ pSave->Broadcast( SbxHint( nHintId, this ) );
+ mpBroadcaster = std::move(pSave);
+ SetFlags( nSaveFlags );
+}
+
+SbxInfo* SbxVariable::GetInfo()
+{
+ if( !pInfo.is() )
+ {
+ Broadcast( SfxHintId::BasicInfoWanted );
+ if( pInfo.is() )
+ {
+ SetModified( true );
+ }
+ }
+ return pInfo.get();
+}
+
+void SbxVariable::SetInfo( SbxInfo* p )
+{
+ pInfo = p;
+}
+
+void SbxVariable::SetParameters( SbxArray* p )
+{
+ mpPar = p;
+}
+
+
+// Name of the variables
+
+void SbxVariable::SetName( const OUString& rName )
+{
+ maName = rName;
+ nHash = MakeHashCode( rName );
+}
+
+const OUString& SbxVariable::GetName( SbxNameType t ) const
+{
+ static const OUString cSuffixes { " %&!#@ $" };
+ if( t == SbxNameType::NONE )
+ {
+ return maName;
+ }
+ // Request parameter-information (not for objects)
+ const_cast<SbxVariable*>(this)->GetInfo();
+ // Append nothing, if it is a simple property (no empty brackets)
+ if (!pInfo.is() || (pInfo->m_Params.empty() && GetClass() == SbxClassType::Property))
+ {
+ return maName;
+ }
+ sal_Unicode cType = ' ';
+ OUStringBuffer aTmp( maName );
+ // short type? Then fetch it, possible this is 0.
+ SbxDataType et = GetType();
+ if( t == SbxNameType::ShortTypes )
+ {
+ if( et <= SbxSTRING )
+ {
+ cType = cSuffixes[ et ];
+ }
+ if( cType != ' ' )
+ {
+ aTmp.append(cType);
+ }
+ }
+ aTmp.append("(");
+
+ for (SbxParams::const_iterator iter = pInfo->m_Params.begin(); iter != pInfo->m_Params.end(); ++iter)
+ {
+ auto const& i = *iter;
+ int nt = i->eType & 0x0FFF;
+ if (iter != pInfo->m_Params.begin())
+ {
+ aTmp.append(",");
+ }
+ if( i->nFlags & SbxFlagBits::Optional )
+ {
+ aTmp.append( GetSbxRes( StringId::Optional ) );
+ }
+ if( i->eType & SbxBYREF )
+ {
+ aTmp.append( GetSbxRes( StringId::ByRef ) );
+ }
+ aTmp.append( i->aName );
+ cType = ' ';
+ // short type? Then fetch it, possible this is 0.
+ if( t == SbxNameType::ShortTypes )
+ {
+ if( nt <= SbxSTRING )
+ {
+ cType = cSuffixes[ nt ];
+ }
+ }
+ if( cType != ' ' )
+ {
+ aTmp.append(cType);
+ if( i->eType & SbxARRAY )
+ {
+ aTmp.append("()");
+ }
+ }
+ else
+ {
+ if( i->eType & SbxARRAY )
+ {
+ aTmp.append("()");
+ }
+ // long type?
+ aTmp.append(GetSbxRes( StringId::As ));
+ if( nt < 32 )
+ {
+ aTmp.append(GetSbxRes( static_cast<StringId>( static_cast<int>( StringId::Types ) + nt ) ));
+ }
+ else
+ {
+ aTmp.append(GetSbxRes( StringId::Any ));
+ }
+ }
+ }
+ aTmp.append(")");
+ const_cast<SbxVariable*>(this)->aToolString = aTmp.makeStringAndClear();
+ return aToolString;
+}
+
+// Create a simple hashcode: the first six characters are evaluated.
+
+sal_uInt16 SbxVariable::MakeHashCode( const OUString& rName )
+{
+ sal_uInt16 n = 0;
+ sal_Int32 nLen = rName.getLength();
+ if( nLen > 6 )
+ {
+ nLen = 6;
+ }
+ for( sal_Int32 i=0; i<nLen; ++i )
+ {
+ sal_uInt8 c = static_cast<sal_uInt8>(rName[i]);
+ // If we have a comment sign break!!
+ if( c >= 0x80 )
+ {
+ return 0;
+ }
+ n = sal::static_int_cast< sal_uInt16 >( ( n << 3 ) + rtl::toAsciiUpperCase( c ) );
+ }
+ return n;
+}
+
+// Operators
+
+SbxVariable& SbxVariable::operator=( const SbxVariable& r )
+{
+ if (this != &r)
+ {
+ SbxValue::operator=( r );
+ mpImpl.reset();
+ if( r.mpImpl != nullptr )
+ {
+ mpImpl.reset( new SbxVariableImpl( *r.mpImpl ) );
+#if HAVE_FEATURE_SCRIPTING
+ if( mpImpl->m_xComListener.is() )
+ {
+ registerComListenerVariableForBasic( this, mpImpl->m_pComListenerParentBasic );
+ }
+#endif
+ }
+ }
+ return *this;
+}
+
+// Conversion
+
+SbxDataType SbxVariable::GetType() const
+{
+ if( aData.eType == SbxOBJECT )
+ {
+ return aData.pObj ? aData.pObj->GetType() : SbxOBJECT;
+ }
+ else if( aData.eType == SbxVARIANT )
+ {
+ return aData.pObj ? aData.pObj->GetType() : SbxVARIANT;
+ }
+ else
+ {
+ return aData.eType;
+ }
+}
+
+SbxClassType SbxVariable::GetClass() const
+{
+ return SbxClassType::Variable;
+}
+
+void SbxVariable::SetModified( bool b )
+{
+ if( IsSet( SbxFlagBits::NoModify ) )
+ {
+ return;
+ }
+ SbxBase::SetModified( b );
+ if( pParent && pParent != this ) //??? HotFix: Recursion out here MM
+ {
+ pParent->SetModified( b );
+ }
+}
+
+void SbxVariable::SetParent( SbxObject* p )
+{
+#ifdef DBG_UTIL
+ // Will the parent of a SbxObject be set?
+ if (p && dynamic_cast<SbxObject*>(this))
+ {
+ // then this had to be a child of the new parent
+ bool bFound = false;
+ SbxArray *pChildren = p->GetObjects();
+ if ( pChildren )
+ {
+ for ( sal_uInt32 nIdx = 0; !bFound && nIdx < pChildren->Count32(); ++nIdx )
+ {
+ bFound = ( this == pChildren->Get32(nIdx) );
+ }
+ }
+ SAL_INFO_IF(
+ !bFound, "basic.sbx",
+ "dangling: [" << GetName() << "].SetParent([" << p->GetName()
+ << "])");
+ }
+#endif
+
+ pParent = p;
+}
+
+SbxVariableImpl* SbxVariable::getImpl()
+{
+ if(!mpImpl)
+ {
+ mpImpl.reset(new SbxVariableImpl);
+ }
+ return mpImpl.get();
+}
+
+const OUString& SbxVariable::GetDeclareClassName()
+{
+ SbxVariableImpl* pImpl = getImpl();
+ return pImpl->m_aDeclareClassName;
+}
+
+void SbxVariable::SetDeclareClassName( const OUString& rDeclareClassName )
+{
+ SbxVariableImpl* pImpl = getImpl();
+ pImpl->m_aDeclareClassName = rDeclareClassName;
+}
+
+void SbxVariable::SetComListener( const css::uno::Reference< css::uno::XInterface >& xComListener,
+ StarBASIC* pParentBasic )
+{
+ SbxVariableImpl* pImpl = getImpl();
+ pImpl->m_xComListener = xComListener;
+ pImpl->m_pComListenerParentBasic = pParentBasic;
+#if HAVE_FEATURE_SCRIPTING
+ registerComListenerVariableForBasic( this, pParentBasic );
+#endif
+}
+
+void SbxVariable::ClearComListener()
+{
+ SbxVariableImpl* pImpl = getImpl();
+ pImpl->m_xComListener.clear();
+}
+
+
+// Loading/Saving
+
+bool SbxVariable::LoadData( SvStream& rStrm, sal_uInt16 nVer )
+{
+ sal_uInt8 cMark;
+ rStrm.ReadUChar( cMark );
+ if( cMark == 0xFF )
+ {
+ if( !SbxValue::LoadData( rStrm, nVer ) )
+ {
+ return false;
+ }
+ maName = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ sal_uInt32 nTemp;
+ rStrm.ReadUInt32( nTemp );
+ nUserData = nTemp;
+ }
+ else
+ {
+ sal_uInt16 nType;
+ rStrm.SeekRel( -1 );
+ rStrm.ReadUInt16( nType );
+ maName = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ sal_uInt32 nTemp;
+ rStrm.ReadUInt32( nTemp );
+ nUserData = nTemp;
+ // correction: old methods have instead of SbxNULL now SbxEMPTY
+ if( nType == SbxNULL && GetClass() == SbxClassType::Method )
+ {
+ nType = SbxEMPTY;
+ }
+ SbxValues aTmp;
+ OUString aTmpString;
+ OUString aVal;
+ aTmp.eType = aData.eType = static_cast<SbxDataType>(nType);
+ aTmp.pOUString = &aVal;
+ switch( nType )
+ {
+ case SbxBOOL:
+ case SbxERROR:
+ case SbxINTEGER:
+ rStrm.ReadInt16( aTmp.nInteger ); break;
+ case SbxLONG:
+ rStrm.ReadInt32( aTmp.nLong ); break;
+ case SbxSINGLE:
+ {
+ // Floats as ASCII
+ aTmpString = read_uInt16_lenPrefixed_uInt8s_ToOUString(
+ rStrm, RTL_TEXTENCODING_ASCII_US);
+ double d;
+ SbxDataType t;
+ if( ImpScan( aTmpString, d, t, nullptr, true ) != ERRCODE_NONE || t == SbxDOUBLE )
+ {
+ aTmp.nSingle = 0;
+ return false;
+ }
+ aTmp.nSingle = static_cast<float>(d);
+ break;
+ }
+ case SbxDATE:
+ case SbxDOUBLE:
+ {
+ // Floats as ASCII
+ aTmpString = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ SbxDataType t;
+ if( ImpScan( aTmpString, aTmp.nDouble, t, nullptr, true ) != ERRCODE_NONE )
+ {
+ aTmp.nDouble = 0;
+ return false;
+ }
+ break;
+ }
+ case SbxSTRING:
+ aVal = read_uInt16_lenPrefixed_uInt8s_ToOUString(rStrm,
+ RTL_TEXTENCODING_ASCII_US);
+ break;
+ case SbxEMPTY:
+ case SbxNULL:
+ break;
+ default:
+ aData.eType = SbxNULL;
+ SAL_WARN( "basic.sbx", "Loaded a non-supported data type" );
+ return false;
+ }
+ // putt value
+ if( nType != SbxNULL && nType != SbxEMPTY && !Put( aTmp ) )
+ {
+ return false;
+ }
+ }
+ rStrm.ReadUChar( cMark );
+ // cMark is also a version number!
+ // 1: initial version
+ // 2: with nUserData
+ if( cMark )
+ {
+ if( cMark > 2 )
+ {
+ return false;
+ }
+ pInfo = new SbxInfo;
+ pInfo->LoadData( rStrm, static_cast<sal_uInt16>(cMark) );
+ }
+ Broadcast( SfxHintId::BasicDataChanged );
+ nHash = MakeHashCode( maName );
+ SetModified( true );
+ return true;
+}
+
+bool SbxVariable::StoreData( SvStream& rStrm ) const
+{
+ rStrm.WriteUChar( 0xFF ); // Marker
+ bool bValStore;
+ if( dynamic_cast<const SbxMethod *>(this) != nullptr )
+ {
+ // #50200 Avoid that objects , which during the runtime
+ // as return-value are saved in the method as a value were saved
+ SbxVariable* pThis = const_cast<SbxVariable*>(this);
+ SbxFlagBits nSaveFlags = GetFlags();
+ pThis->SetFlag( SbxFlagBits::Write );
+ pThis->SbxValue::Clear();
+ pThis->SetFlags( nSaveFlags );
+
+ // So that the method will not be executed in any case!
+ // CAST, to avoid const!
+ pThis->SetFlag( SbxFlagBits::NoBroadcast );
+ bValStore = SbxValue::StoreData( rStrm );
+ pThis->ResetFlag( SbxFlagBits::NoBroadcast );
+ }
+ else
+ {
+ bValStore = SbxValue::StoreData( rStrm );
+ }
+ if( !bValStore )
+ {
+ return false;
+ }
+ write_uInt16_lenPrefixed_uInt8s_FromOUString(rStrm, maName,
+ RTL_TEXTENCODING_ASCII_US);
+ rStrm.WriteUInt32( nUserData );
+ if( pInfo.is() )
+ {
+ rStrm.WriteUChar( 2 ); // Version 2: with UserData!
+ pInfo->StoreData( rStrm );
+ }
+ else
+ {
+ rStrm.WriteUChar( 0 );
+ }
+ return true;
+}
+
+// SbxInfo
+
+SbxInfo::SbxInfo()
+ : aHelpFile(), nHelpId(0)
+{}
+
+SbxInfo::SbxInfo( const OUString& r, sal_uInt32 n )
+ : aHelpFile( r ), nHelpId( n )
+{}
+
+void SbxVariable::Dump( SvStream& rStrm, bool bFill )
+{
+ OString aBNameStr(OUStringToOString(GetName( SbxNameType::ShortTypes ), RTL_TEXTENCODING_ASCII_US));
+ rStrm.WriteCharPtr( "Variable( " )
+ .WriteOString( OString::number(reinterpret_cast<sal_Int64>(this)) ).WriteCharPtr( "==" )
+ .WriteOString( aBNameStr );
+ OString aBParentNameStr(OUStringToOString(GetParent()->GetName(), RTL_TEXTENCODING_ASCII_US));
+ if ( GetParent() )
+ {
+ rStrm.WriteCharPtr( " in parent '" ).WriteOString( aBParentNameStr ).WriteCharPtr( "'" );
+ }
+ else
+ {
+ rStrm.WriteCharPtr( " no parent" );
+ }
+ rStrm.WriteCharPtr( " ) " );
+
+ // output also the object at object-vars
+ if ( GetValues_Impl().eType == SbxOBJECT &&
+ GetValues_Impl().pObj &&
+ GetValues_Impl().pObj != this &&
+ GetValues_Impl().pObj != GetParent() )
+ {
+ rStrm.WriteCharPtr( " contains " );
+ static_cast<SbxObject*>(GetValues_Impl().pObj)->Dump( rStrm, bFill );
+ }
+ else
+ {
+ rStrm << endl;
+ }
+}
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/uno/dlgcont.cxx b/basic/source/uno/dlgcont.cxx
new file mode 100644
index 000000000..eee4e8300
--- /dev/null
+++ b/basic/source/uno/dlgcont.cxx
@@ -0,0 +1,584 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <com/sun/star/container/XNameContainer.hpp>
+#include <com/sun/star/xml/sax/Parser.hpp>
+#include <com/sun/star/xml/sax/InputSource.hpp>
+#include <com/sun/star/xml/sax/Writer.hpp>
+#include <com/sun/star/io/XOutputStream.hpp>
+#include <com/sun/star/io/XInputStream.hpp>
+#include <com/sun/star/io/XInputStreamProvider.hpp>
+#include <com/sun/star/embed/ElementModes.hpp>
+#include <com/sun/star/xml/sax/XDocumentHandler.hpp>
+#include <com/sun/star/resource/StringResourceWithStorage.hpp>
+#include <com/sun/star/resource/StringResourceWithLocation.hpp>
+#include <com/sun/star/document/GraphicStorageHandler.hpp>
+#include <com/sun/star/document/XGraphicStorageHandler.hpp>
+#include <dlgcont.hxx>
+#include <comphelper/fileformat.h>
+#include <comphelper/processfactory.hxx>
+#include <tools/diagnose_ex.h>
+#include <vcl/svapp.hxx>
+#include <vcl/settings.hxx>
+#include <xmlscript/xmldlg_imexp.hxx>
+#include <sot/storage.hxx>
+#include <svtools/sfxecode.hxx>
+#include <svtools/ehdl.hxx>
+#include <vcl/GraphicObject.hxx>
+#include <i18nlangtag/languagetag.hxx>
+
+namespace basic
+{
+
+using namespace com::sun::star::document;
+using namespace com::sun::star::container;
+using namespace com::sun::star::io;
+using namespace com::sun::star::uno;
+using namespace com::sun::star::ucb;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::script;
+using namespace com::sun::star::xml::sax;
+using namespace com::sun::star;
+using namespace cppu;
+
+using com::sun::star::uno::Reference;
+
+
+// Implementation class SfxDialogLibraryContainer
+
+const char* SfxDialogLibraryContainer::getInfoFileName() const { return "dialog"; }
+const char* SfxDialogLibraryContainer::getOldInfoFileName() const { return "dialogs"; }
+const char* SfxDialogLibraryContainer::getLibElementFileExtension() const { return "xdl"; }
+const char* SfxDialogLibraryContainer::getLibrariesDir() const { return "Dialogs"; }
+
+// Ctor for service
+SfxDialogLibraryContainer::SfxDialogLibraryContainer()
+{
+ // all initialisation has to be done
+ // by calling XInitialization::initialize
+}
+
+SfxDialogLibraryContainer::SfxDialogLibraryContainer( const uno::Reference< embed::XStorage >& xStorage )
+{
+ init( OUString(), xStorage );
+}
+
+// Methods to get library instances of the correct type
+SfxLibrary* SfxDialogLibraryContainer::implCreateLibrary( const OUString& aName )
+{
+ SfxLibrary* pRet = new SfxDialogLibrary( maModifiable, aName, mxSFI, this );
+ return pRet;
+}
+
+SfxLibrary* SfxDialogLibraryContainer::implCreateLibraryLink
+ ( const OUString& aName, const OUString& aLibInfoFileURL,
+ const OUString& StorageURL, bool ReadOnly )
+{
+ SfxLibrary* pRet = new SfxDialogLibrary
+ ( maModifiable, aName, mxSFI, aLibInfoFileURL, StorageURL, ReadOnly, this );
+ return pRet;
+}
+
+Any SfxDialogLibraryContainer::createEmptyLibraryElement()
+{
+ Reference< XInputStreamProvider > xISP;
+ Any aRetAny;
+ aRetAny <<= xISP;
+ return aRetAny;
+}
+
+bool SfxDialogLibraryContainer::isLibraryElementValid(const Any& rElement) const
+{
+ return SfxDialogLibrary::containsValidDialog(rElement);
+}
+
+static bool writeOasis2OOoLibraryElement(
+ const Reference< XInputStream >& xInput, const Reference< XOutputStream >& xOutput )
+{
+ Reference< XComponentContext > xContext(
+ comphelper::getProcessComponentContext() );
+
+ Reference< lang::XMultiComponentFactory > xSMgr(
+ xContext->getServiceManager() );
+
+ Reference< xml::sax::XParser > xParser = xml::sax::Parser::create(xContext);
+
+ Reference< xml::sax::XWriter > xWriter = xml::sax::Writer::create(xContext);
+
+ xWriter->setOutputStream( xOutput );
+
+ Sequence<Any> aArgs( 1 );
+ aArgs[0] <<= xWriter;
+
+ Reference< xml::sax::XDocumentHandler > xHandler(
+ xSMgr->createInstanceWithArgumentsAndContext(
+ "com.sun.star.comp.Oasis2OOoTransformer",
+ aArgs, xContext ),
+ UNO_QUERY );
+
+ xParser->setDocumentHandler( xHandler );
+
+ xml::sax::InputSource source;
+ source.aInputStream = xInput;
+ source.sSystemId = "virtual file";
+
+ xParser->parseStream( source );
+
+ return true;
+}
+
+void SfxDialogLibraryContainer::writeLibraryElement
+(
+ const Reference < XNameContainer >& xLib,
+ const OUString& aElementName,
+ const Reference< XOutputStream >& xOutput
+)
+{
+ Any aElement = xLib->getByName( aElementName );
+ Reference< XInputStreamProvider > xISP;
+ aElement >>= xISP;
+ if( !xISP.is() )
+ return;
+
+ Reference< XInputStream > xInput( xISP->createInputStream() );
+
+ bool bComplete = false;
+ if ( mbOasis2OOoFormat )
+ {
+ bComplete = writeOasis2OOoLibraryElement( xInput, xOutput );
+ }
+
+ if ( !bComplete )
+ {
+ Sequence< sal_Int8 > bytes;
+ sal_Int32 nRead = xInput->readBytes( bytes, xInput->available() );
+ for (;;)
+ {
+ if( nRead )
+ xOutput->writeBytes( bytes );
+
+ nRead = xInput->readBytes( bytes, 1024 );
+ if (! nRead)
+ break;
+ }
+ }
+ xInput->closeInput();
+}
+
+void SfxDialogLibraryContainer::storeLibrariesToStorage( const uno::Reference< embed::XStorage >& xStorage )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ mbOasis2OOoFormat = false;
+
+ if ( mxStorage.is() && xStorage.is() )
+ {
+ try
+ {
+ long nSource = SotStorage::GetVersion( mxStorage );
+ long nTarget = SotStorage::GetVersion( xStorage );
+
+ if ( nSource == SOFFICE_FILEFORMAT_CURRENT &&
+ nTarget != SOFFICE_FILEFORMAT_CURRENT )
+ {
+ mbOasis2OOoFormat = true;
+ }
+ }
+ catch (const Exception& )
+ {
+ TOOLS_WARN_EXCEPTION("basic", "");
+ // if we cannot get the version then the
+ // Oasis2OOoTransformer will not be used
+ assert(false);
+ }
+ }
+
+ SfxLibraryContainer::storeLibrariesToStorage( xStorage );
+
+ // we need to export out any embedded image object(s)
+ // associated with any Dialogs. First, we need to actually gather any such urls
+ // for each dialog in this container
+ const Sequence< OUString > sLibraries = getElementNames();
+ for ( const OUString& rName : sLibraries )
+ {
+ loadLibrary( rName );
+ Reference< XNameContainer > xLib;
+ getByName( rName ) >>= xLib;
+ if ( xLib.is() )
+ {
+ Sequence< OUString > sDialogs = xLib->getElementNames();
+ sal_Int32 nDialogs( sDialogs.getLength() );
+ for ( sal_Int32 j=0; j < nDialogs; ++j )
+ {
+ // Each Dialog has an associated xISP
+ Reference< io::XInputStreamProvider > xISP;
+ xLib->getByName( sDialogs[ j ] ) >>= xISP;
+ if ( xISP.is() )
+ {
+ Reference< io::XInputStream > xInput( xISP->createInputStream() );
+ Reference< XNameContainer > xDialogModel(
+ mxContext->getServiceManager()->createInstanceWithContext("com.sun.star.awt.UnoControlDialogModel", mxContext),
+ UNO_QUERY );
+ ::xmlscript::importDialogModel( xInput, xDialogModel, mxContext, mxOwnerDocument );
+ std::vector<uno::Reference<graphic::XGraphic>> vxGraphicList;
+ vcl::graphic::SearchForGraphics(Reference<XInterface>(xDialogModel, UNO_QUERY), vxGraphicList);
+ if (!vxGraphicList.empty())
+ {
+ // Export the images to the storage
+ Reference<document::XGraphicStorageHandler> xGraphicStorageHandler;
+ xGraphicStorageHandler.set(document::GraphicStorageHandler::createWithStorage(mxContext, xStorage));
+ if (xGraphicStorageHandler.is())
+ {
+ for (uno::Reference<graphic::XGraphic> const & rxGraphic : vxGraphicList)
+ {
+ xGraphicStorageHandler->saveGraphic(rxGraphic);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ mbOasis2OOoFormat = false;
+}
+
+
+Any SfxDialogLibraryContainer::importLibraryElement
+ ( const Reference < XNameContainer >& /*xLib*/,
+ const OUString& /*aElementName */, const OUString& aFile,
+ const uno::Reference< io::XInputStream >& xElementStream )
+{
+ Any aRetAny;
+
+ // TODO: Member because later it will be a component
+ //Reference< XMultiServiceFactory > xMSF( comphelper::getProcessServiceFactory() );
+ //if( !xMSF.is() )
+ //{
+ // OSL_FAIL( "### couldn't get ProcessServiceFactory" );
+ // return aRetAny;
+ //}
+
+ Reference< XParser > xParser = xml::sax::Parser::create( mxContext );
+
+ Reference< XNameContainer > xDialogModel(
+ mxContext->getServiceManager()->createInstanceWithContext("com.sun.star.awt.UnoControlDialogModel", mxContext),
+ UNO_QUERY );
+ if( !xDialogModel.is() )
+ {
+ OSL_FAIL( "### couldn't create com.sun.star.awt.UnoControlDialogModel component" );
+ return aRetAny;
+ }
+
+ // Read from storage?
+ bool bStorage = xElementStream.is();
+ Reference< XInputStream > xInput;
+
+ if( bStorage )
+ {
+ xInput = xElementStream;
+ }
+ else
+ {
+ try
+ {
+ xInput = mxSFI->openFileRead( aFile );
+ }
+ catch(const Exception& )
+ //catch( Exception& e )
+ {
+ // TODO:
+ //throw WrappedTargetException( e );
+ }
+ }
+ if( !xInput.is() )
+ return aRetAny;
+
+ InputSource source;
+ source.aInputStream = xInput;
+ source.sSystemId = aFile;
+
+ try {
+ // start parsing
+ xParser->setDocumentHandler( ::xmlscript::importDialogModel( xDialogModel, mxContext, mxOwnerDocument ) );
+ xParser->parseStream( source );
+ }
+ catch(const Exception& )
+ {
+ OSL_FAIL( "Parsing error" );
+ SfxErrorContext aEc( ERRCTX_SFX_LOADBASIC, aFile );
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ return aRetAny;
+ }
+
+ // Create InputStream, TODO: Implement own InputStreamProvider
+ // to avoid creating the DialogModel here!
+ Reference< XInputStreamProvider > xISP = ::xmlscript::exportDialogModel( xDialogModel, mxContext, mxOwnerDocument );
+ aRetAny <<= xISP;
+ return aRetAny;
+}
+
+void SfxDialogLibraryContainer::importFromOldStorage( const OUString& )
+{
+ // Nothing to do here, old dialogs cannot be imported
+}
+
+SfxLibraryContainer* SfxDialogLibraryContainer::createInstanceImpl()
+{
+ return new SfxDialogLibraryContainer();
+}
+
+const char aResourceFileNameBase[] = "DialogStrings";
+const char aResourceFileCommentBase[] = "# Strings for Dialog Library ";
+
+// Resource handling
+Reference< css::resource::XStringResourcePersistence >
+ SfxDialogLibraryContainer::implCreateStringResource( SfxDialogLibrary* pDialogLibrary )
+{
+ Reference< resource::XStringResourcePersistence > xRet;
+ OUString aLibName = pDialogLibrary->getName();
+ bool bReadOnly = pDialogLibrary->mbReadOnly;
+
+ // get ui locale
+ ::com::sun ::star::lang::Locale aLocale = Application::GetSettings().GetUILanguageTag().getLocale();
+
+ OUString aComment= aResourceFileCommentBase + aLibName;
+
+ bool bStorage = mxStorage.is();
+ if( bStorage )
+ {
+ uno::Reference< embed::XStorage > xLibrariesStor;
+ uno::Reference< embed::XStorage > xLibraryStor;
+ try {
+ xLibrariesStor = mxStorage->openStorageElement( maLibrariesDir, embed::ElementModes::READ );
+ // TODO: Should be READWRITE with new storage concept using store() instead of storeTo()
+ if ( !xLibrariesStor.is() )
+ throw uno::RuntimeException("null returned from openStorageElement");
+
+ xLibraryStor = xLibrariesStor->openStorageElement( aLibName, embed::ElementModes::READ );
+ // TODO: Should be READWRITE with new storage concept using store() instead of storeTo()
+ if ( !xLibraryStor.is() )
+ throw uno::RuntimeException("null returned from openStorageElement");
+ }
+ catch(const uno::Exception& )
+ {
+ // Something went wrong while trying to get the storage library.
+ // Return an object that supports StringResourceWithStorage, give it a storage location later.
+ xRet = Reference< resource::XStringResourcePersistence >(
+ mxContext->getServiceManager()->createInstanceWithContext("com.sun.star.resource.StringResourceWithStorage", mxContext),
+ UNO_QUERY );
+ return xRet;
+ }
+
+ xRet = resource::StringResourceWithStorage::create(mxContext, xLibraryStor, bReadOnly, aLocale, aResourceFileNameBase, aComment);
+ }
+ else
+ {
+ OUString aLocation = createAppLibraryFolder( pDialogLibrary, aLibName );
+ // TODO: Real handler?
+ Reference< task::XInteractionHandler > xDummyHandler;
+
+ xRet = resource::StringResourceWithLocation::create(mxContext, aLocation, bReadOnly, aLocale, aResourceFileNameBase, aComment, xDummyHandler);
+ }
+
+ return xRet;
+}
+
+void SfxDialogLibraryContainer::onNewRootStorage()
+{
+ // the library container is not modified, go through the libraries and check whether they are modified
+ Sequence< OUString > aNames = maNameContainer->getElementNames();
+ const OUString* pNames = aNames.getConstArray();
+ sal_Int32 nNameCount = aNames.getLength();
+
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aName = pNames[ i ];
+ SfxDialogLibrary* pDialogLibrary = static_cast<SfxDialogLibrary*>( getImplLib( aName ) );
+
+ Reference< resource::XStringResourcePersistence > xStringResourcePersistence =
+ pDialogLibrary->getStringResourcePersistence();
+
+ if( xStringResourcePersistence.is() )
+ {
+ Reference< embed::XStorage > xLibrariesStor;
+ Reference< embed::XStorage > xLibraryStor;
+ try {
+ xLibrariesStor = mxStorage->openStorageElement( maLibrariesDir, embed::ElementModes::READWRITE );
+ if ( !xLibrariesStor.is() )
+ throw uno::RuntimeException("null returned from openStorageElement");
+
+ OUString aLibName = pDialogLibrary->getName();
+ xLibraryStor = xLibrariesStor->openStorageElement( aLibName, embed::ElementModes::READWRITE );
+ if ( !xLibraryStor.is() )
+ throw uno::RuntimeException("null returned from openStorageElement");
+
+ Reference< resource::XStringResourceWithStorage >
+ xStringResourceWithStorage( xStringResourcePersistence, UNO_QUERY );
+ if( xStringResourceWithStorage.is() )
+ xStringResourceWithStorage->setStorage( xLibraryStor );
+ }
+ catch(const uno::Exception& )
+ {
+ // TODO: Error handling?
+ }
+ }
+ }
+}
+
+sal_Bool SAL_CALL
+SfxDialogLibraryContainer:: HasExecutableCode( const OUString& /*Library*/ )
+{
+ return false; // dialog library has no executable code
+}
+
+// Service
+
+OUString SAL_CALL SfxDialogLibraryContainer::getImplementationName( )
+{
+ return "com.sun.star.comp.sfx2.DialogLibraryContainer";
+}
+
+Sequence< OUString > SAL_CALL SfxDialogLibraryContainer::getSupportedServiceNames( )
+{
+ return {"com.sun.star.script.DocumentDialogLibraryContainer",
+ "com.sun.star.script.DialogLibraryContainer"}; // for compatibility
+}
+
+// Implementation class SfxDialogLibrary
+
+// Ctor
+SfxDialogLibrary::SfxDialogLibrary( ModifiableHelper& _rModifiable,
+ const OUString& aName,
+ const Reference< XSimpleFileAccess3 >& xSFI,
+ SfxDialogLibraryContainer* pParent )
+ : SfxLibrary( _rModifiable, cppu::UnoType<XInputStreamProvider>::get(), xSFI )
+ , m_pParent( pParent )
+ , m_aName( aName )
+{
+}
+
+SfxDialogLibrary::SfxDialogLibrary( ModifiableHelper& _rModifiable,
+ const OUString& aName,
+ const Reference< XSimpleFileAccess3 >& xSFI,
+ const OUString& aLibInfoFileURL,
+ const OUString& aStorageURL,
+ bool ReadOnly,
+ SfxDialogLibraryContainer* pParent )
+ : SfxLibrary( _rModifiable, cppu::UnoType<XInputStreamProvider>::get(),
+ xSFI, aLibInfoFileURL, aStorageURL, ReadOnly)
+ , m_pParent( pParent )
+ , m_aName( aName )
+{
+}
+
+IMPLEMENT_FORWARD_XINTERFACE2( SfxDialogLibrary, SfxLibrary, SfxDialogLibrary_BASE );
+IMPLEMENT_FORWARD_XTYPEPROVIDER2( SfxDialogLibrary, SfxLibrary, SfxDialogLibrary_BASE );
+
+// Provide modify state including resources
+bool SfxDialogLibrary::isModified()
+{
+ bool bRet = implIsModified();
+
+ if( !bRet && m_xStringResourcePersistence.is() )
+ bRet = m_xStringResourcePersistence->isModified();
+ // else: Resources not accessed so far -> not modified
+
+ return bRet;
+}
+
+void SfxDialogLibrary::storeResources()
+{
+ if( m_xStringResourcePersistence.is() )
+ m_xStringResourcePersistence->store();
+}
+
+void SfxDialogLibrary::storeResourcesAsURL
+ ( const OUString& URL, const OUString& NewName )
+{
+ OUString aComment(aResourceFileCommentBase);
+ m_aName = NewName;
+ aComment += m_aName;
+
+ if( m_xStringResourcePersistence.is() )
+ {
+ m_xStringResourcePersistence->setComment( aComment );
+
+ Reference< resource::XStringResourceWithLocation >
+ xStringResourceWithLocation( m_xStringResourcePersistence, UNO_QUERY );
+ if( xStringResourceWithLocation.is() )
+ xStringResourceWithLocation->storeAsURL( URL );
+ }
+}
+
+void SfxDialogLibrary::storeResourcesToURL( const OUString& URL,
+ const Reference< task::XInteractionHandler >& xHandler )
+{
+ OUString aComment = aResourceFileCommentBase + m_aName;
+
+ if( m_xStringResourcePersistence.is() )
+ {
+ m_xStringResourcePersistence->storeToURL
+ ( URL, aResourceFileNameBase, aComment, xHandler );
+ }
+}
+
+void SfxDialogLibrary::storeResourcesToStorage( const css::uno::Reference< css::embed::XStorage >& xStorage )
+{
+ OUString aComment = aResourceFileCommentBase + m_aName;
+
+ if( m_xStringResourcePersistence.is() )
+ {
+ m_xStringResourcePersistence->storeToStorage
+ ( xStorage, aResourceFileNameBase, aComment );
+ }
+}
+
+
+// XStringResourceSupplier
+Reference< resource::XStringResourceResolver >
+ SAL_CALL SfxDialogLibrary::getStringResource( )
+{
+ if( !m_xStringResourcePersistence.is() )
+ m_xStringResourcePersistence = m_pParent->implCreateStringResource( this );
+
+ return m_xStringResourcePersistence;
+}
+
+bool SfxDialogLibrary::containsValidDialog( const css::uno::Any& aElement )
+{
+ Reference< XInputStreamProvider > xISP;
+ aElement >>= xISP;
+ return xISP.is();
+}
+
+bool SfxDialogLibrary::isLibraryElementValid(const css::uno::Any& rElement) const
+{
+ return SfxDialogLibrary::containsValidDialog(rElement);
+}
+
+}
+
+extern "C" SAL_DLLPUBLIC_EXPORT css::uno::XInterface*
+com_sun_star_comp_sfx2_DialogLibraryContainer_get_implementation(css::uno::XComponentContext*,
+ css::uno::Sequence<css::uno::Any> const &)
+{
+ return cppu::acquire(new basic::SfxDialogLibraryContainer());
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/uno/modsizeexceeded.cxx b/basic/source/uno/modsizeexceeded.cxx
new file mode 100644
index 000000000..a54b426c7
--- /dev/null
+++ b/basic/source/uno/modsizeexceeded.cxx
@@ -0,0 +1,59 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <basic/modsizeexceeded.hxx>
+
+#include <comphelper/interaction.hxx>
+#include <comphelper/sequence.hxx>
+#include <com/sun/star/script/ModuleSizeExceededRequest.hpp>
+
+using namespace com::sun::star;
+using namespace cppu;
+using namespace osl;
+
+ModuleSizeExceeded::ModuleSizeExceeded( const std::vector< OUString >& sModules )
+{
+ script::ModuleSizeExceededRequest aReq;
+ aReq.Names = comphelper::containerToSequence(sModules);
+
+ m_aRequest <<= aReq;
+
+ m_xAbort = new comphelper::OInteractionAbort;
+ m_xApprove = new comphelper::OInteractionApprove;
+ m_lContinuations.realloc( 2 );
+ m_lContinuations[0] = m_xApprove;
+ m_lContinuations[1] = m_xAbort;
+}
+
+bool
+ModuleSizeExceeded::isAbort() const
+{
+ comphelper::OInteractionAbort* pBase = static_cast< comphelper::OInteractionAbort* >( m_xAbort.get() );
+ return pBase->wasSelected();
+}
+
+bool
+ModuleSizeExceeded::isApprove() const
+{
+ comphelper::OInteractionApprove* pBase = static_cast< comphelper::OInteractionApprove* >( m_xApprove.get() );
+ return pBase->wasSelected();
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/uno/namecont.cxx b/basic/source/uno/namecont.cxx
new file mode 100644
index 000000000..0904dcb76
--- /dev/null
+++ b/basic/source/uno/namecont.cxx
@@ -0,0 +1,3462 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <config_extensions.h>
+#include <config_folders.h>
+
+#include <com/sun/star/container/XNameContainer.hpp>
+#include <com/sun/star/container/XContainer.hpp>
+#include <com/sun/star/embed/ElementModes.hpp>
+#include <com/sun/star/embed/XTransactedObject.hpp>
+#include <com/sun/star/io/IOException.hpp>
+#include <com/sun/star/lang/XMultiServiceFactory.hpp>
+#include <com/sun/star/lang/XServiceInfo.hpp>
+#include <com/sun/star/ucb/ContentCreationException.hpp>
+#include <com/sun/star/xml/sax/SAXException.hpp>
+#include <vcl/svapp.hxx>
+#include <osl/mutex.hxx>
+#include <vcl/errinf.hxx>
+#include <rtl/ustring.hxx>
+#include <sal/log.hxx>
+#include <sot/storage.hxx>
+#include <comphelper/getexpandeduri.hxx>
+#include <comphelper/processfactory.hxx>
+#include <comphelper/sequence.hxx>
+
+#include <namecont.hxx>
+#include <basic/basicmanagerrepository.hxx>
+#include <tools/diagnose_ex.h>
+#include <tools/urlobj.hxx>
+#include <unotools/pathoptions.hxx>
+#include <svtools/sfxecode.hxx>
+#include <svtools/ehdl.hxx>
+#include <basic/basmgr.hxx>
+#include <com/sun/star/xml/sax/Parser.hpp>
+#include <com/sun/star/xml/sax/InputSource.hpp>
+#include <com/sun/star/io/XOutputStream.hpp>
+#include <com/sun/star/xml/sax/Writer.hpp>
+#include <com/sun/star/io/XInputStream.hpp>
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/uno/DeploymentException.hpp>
+#include <com/sun/star/lang/DisposedException.hpp>
+#include <com/sun/star/script/LibraryNotLoadedException.hpp>
+#include <com/sun/star/script/vba/VBAScriptEventId.hpp>
+#include <com/sun/star/ucb/SimpleFileAccess.hpp>
+#include <com/sun/star/util/PathSubstitution.hpp>
+#include <com/sun/star/deployment/ExtensionManager.hpp>
+#include <comphelper/storagehelper.hxx>
+#include <cppuhelper/exc_hlp.hxx>
+#include <cppuhelper/queryinterface.hxx>
+#include <cppuhelper/supportsservice.hxx>
+#include <cppuhelper/typeprovider.hxx>
+#include <memory>
+
+namespace basic
+{
+
+using namespace com::sun::star::document;
+using namespace com::sun::star::container;
+using namespace com::sun::star::uno;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::io;
+using namespace com::sun::star::ucb;
+using namespace com::sun::star::script;
+using namespace com::sun::star::beans;
+using namespace com::sun::star::xml::sax;
+using namespace com::sun::star::util;
+using namespace com::sun::star::task;
+using namespace com::sun::star::embed;
+using namespace com::sun::star::frame;
+using namespace com::sun::star::deployment;
+using namespace com::sun::star;
+using namespace cppu;
+using namespace osl;
+
+using com::sun::star::uno::Reference;
+
+// #i34411: Flag for error handling during migration
+static bool GbMigrationSuppressErrors = false;
+
+
+// Implementation class NameContainer
+
+// Methods XElementAccess
+Type NameContainer::getElementType()
+{
+ return mType;
+}
+
+sal_Bool NameContainer::hasElements()
+{
+ bool bRet = (mnElementCount > 0);
+ return bRet;
+}
+
+// Methods XNameAccess
+Any NameContainer::getByName( const OUString& aName )
+{
+ NameContainerNameMap::iterator aIt = mHashMap.find( aName );
+ if( aIt == mHashMap.end() )
+ {
+ throw NoSuchElementException();
+ }
+ sal_Int32 iHashResult = (*aIt).second;
+ Any aRetAny = mValues[ iHashResult ];
+ return aRetAny;
+}
+
+Sequence< OUString > NameContainer::getElementNames()
+{
+ return comphelper::containerToSequence(mNames);
+}
+
+sal_Bool NameContainer::hasByName( const OUString& aName )
+{
+ NameContainerNameMap::iterator aIt = mHashMap.find( aName );
+ bool bRet = ( aIt != mHashMap.end() );
+ return bRet;
+}
+
+
+// Methods XNameReplace
+void NameContainer::replaceByName( const OUString& aName, const Any& aElement )
+{
+ const Type& aAnyType = aElement.getValueType();
+ if( mType != aAnyType )
+ {
+ throw IllegalArgumentException();
+ }
+ NameContainerNameMap::iterator aIt = mHashMap.find( aName );
+ if( aIt == mHashMap.end() )
+ {
+ throw NoSuchElementException();
+ }
+ sal_Int32 iHashResult = (*aIt).second;
+ Any aOldElement = mValues[ iHashResult ];
+ mValues[ iHashResult ] = aElement;
+
+
+ // Fire event
+ if( maContainerListeners.getLength() > 0 )
+ {
+ ContainerEvent aEvent;
+ aEvent.Source = mpxEventSource;
+ aEvent.Accessor <<= aName;
+ aEvent.Element = aElement;
+ aEvent.ReplacedElement = aOldElement;
+ maContainerListeners.notifyEach( &XContainerListener::elementReplaced, aEvent );
+ }
+
+ /* After the container event has been fired (one listener will update the
+ core Basic manager), fire change event. Listeners can rely on that the
+ Basic source code of the core Basic manager is up-to-date. */
+ if( maChangesListeners.getLength() > 0 )
+ {
+ ChangesEvent aEvent;
+ aEvent.Source = mpxEventSource;
+ aEvent.Base <<= aEvent.Source;
+ aEvent.Changes.realloc( 1 );
+ aEvent.Changes[ 0 ].Accessor <<= aName;
+ aEvent.Changes[ 0 ].Element = aElement;
+ aEvent.Changes[ 0 ].ReplacedElement = aOldElement;
+ maChangesListeners.notifyEach( &XChangesListener::changesOccurred, aEvent );
+ }
+}
+
+void NameContainer::insertCheck(const OUString& aName, const Any& aElement)
+{
+ NameContainerNameMap::iterator aIt = mHashMap.find(aName);
+ if( aIt != mHashMap.end() )
+ {
+ throw ElementExistException();
+ }
+ insertNoCheck(aName, aElement);
+}
+
+void NameContainer::insertNoCheck(const OUString& aName, const Any& aElement)
+{
+ const Type& aAnyType = aElement.getValueType();
+ if( mType != aAnyType )
+ {
+ throw IllegalArgumentException();
+ }
+
+ sal_Int32 nCount = mNames.size();
+ mNames.push_back( aName );
+ mValues.push_back( aElement );
+
+ mHashMap[ aName ] = nCount;
+ mnElementCount++;
+
+ // Fire event
+ if( maContainerListeners.getLength() > 0 )
+ {
+ ContainerEvent aEvent;
+ aEvent.Source = mpxEventSource;
+ aEvent.Accessor <<= aName;
+ aEvent.Element = aElement;
+ maContainerListeners.notifyEach( &XContainerListener::elementInserted, aEvent );
+ }
+
+ /* After the container event has been fired (one listener will update the
+ core Basic manager), fire change event. Listeners can rely on that the
+ Basic source code of the core Basic manager is up-to-date. */
+ if( maChangesListeners.getLength() > 0 )
+ {
+ ChangesEvent aEvent;
+ aEvent.Source = mpxEventSource;
+ aEvent.Base <<= aEvent.Source;
+ aEvent.Changes.realloc( 1 );
+ aEvent.Changes[ 0 ].Accessor <<= aName;
+ aEvent.Changes[ 0 ].Element = aElement;
+ maChangesListeners.notifyEach( &XChangesListener::changesOccurred, aEvent );
+ }
+}
+
+// Methods XNameContainer
+void NameContainer::insertByName( const OUString& aName, const Any& aElement )
+{
+ insertCheck(aName, aElement);
+}
+
+void NameContainer::removeByName( const OUString& aName )
+{
+ NameContainerNameMap::iterator aIt = mHashMap.find( aName );
+ if( aIt == mHashMap.end() )
+ {
+ OUString sMessage = "\"" + aName + "\" not found";
+ throw NoSuchElementException(sMessage);
+ }
+
+ sal_Int32 iHashResult = (*aIt).second;
+ Any aOldElement = mValues[ iHashResult ];
+ mHashMap.erase( aIt );
+ sal_Int32 iLast = mNames.size() - 1;
+ if( iLast != iHashResult )
+ {
+ mNames[ iHashResult ] = mNames[ iLast ];
+ mValues[ iHashResult ] = mValues[ iLast ];
+ mHashMap[ mNames[ iHashResult ] ] = iHashResult;
+ }
+ mNames.resize( iLast );
+ mValues.resize( iLast );
+ mnElementCount--;
+
+ // Fire event
+ if( maContainerListeners.getLength() > 0 )
+ {
+ ContainerEvent aEvent;
+ aEvent.Source = mpxEventSource;
+ aEvent.Accessor <<= aName;
+ aEvent.Element = aOldElement;
+ maContainerListeners.notifyEach( &XContainerListener::elementRemoved, aEvent );
+ }
+
+ /* After the container event has been fired (one listener will update the
+ core Basic manager), fire change event. Listeners can rely on that the
+ Basic source code of the core Basic manager is up-to-date. */
+ if( maChangesListeners.getLength() > 0 )
+ {
+ ChangesEvent aEvent;
+ aEvent.Source = mpxEventSource;
+ aEvent.Base <<= aEvent.Source;
+ aEvent.Changes.realloc( 1 );
+ aEvent.Changes[ 0 ].Accessor <<= aName;
+ // aEvent.Changes[ 0 ].Element remains empty (meaning "replaced with nothing")
+ aEvent.Changes[ 0 ].ReplacedElement = aOldElement;
+ maChangesListeners.notifyEach( &XChangesListener::changesOccurred, aEvent );
+ }
+}
+
+
+// Methods XContainer
+void SAL_CALL NameContainer::addContainerListener( const Reference< XContainerListener >& xListener )
+{
+ if( !xListener.is() )
+ {
+ throw RuntimeException("addContainerListener called with null xListener");
+ }
+ maContainerListeners.addInterface( Reference<XInterface>(xListener, UNO_QUERY) );
+}
+
+void SAL_CALL NameContainer::removeContainerListener( const Reference< XContainerListener >& xListener )
+{
+ if( !xListener.is() )
+ {
+ throw RuntimeException("removeContainerListener called with null xListener");
+ }
+ maContainerListeners.removeInterface( Reference<XInterface>(xListener, UNO_QUERY) );
+}
+
+// Methods XChangesNotifier
+void SAL_CALL NameContainer::addChangesListener( const Reference< XChangesListener >& xListener )
+{
+ if( !xListener.is() )
+ {
+ throw RuntimeException("addChangesListener called with null xListener");
+ }
+ maChangesListeners.addInterface( Reference<XInterface>(xListener, UNO_QUERY) );
+}
+
+void SAL_CALL NameContainer::removeChangesListener( const Reference< XChangesListener >& xListener )
+{
+ if( !xListener.is() )
+ {
+ throw RuntimeException("removeChangesListener called with null xListener");
+ }
+ maChangesListeners.removeInterface( Reference<XInterface>(xListener, UNO_QUERY) );
+}
+
+
+// ModifiableHelper
+
+void ModifiableHelper::setModified( bool _bModified )
+{
+ if ( _bModified == mbModified )
+ {
+ return;
+ }
+ mbModified = _bModified;
+
+ if ( m_aModifyListeners.getLength() == 0 )
+ {
+ return;
+ }
+ EventObject aModifyEvent( m_rEventSource );
+ m_aModifyListeners.notifyEach( &XModifyListener::modified, aModifyEvent );
+}
+
+
+VBAScriptListenerContainer::VBAScriptListenerContainer( ::osl::Mutex& rMutex ) :
+ VBAScriptListenerContainer_BASE( rMutex )
+{
+}
+
+bool VBAScriptListenerContainer::implTypedNotify( const Reference< vba::XVBAScriptListener >& rxListener, const vba::VBAScriptEvent& rEvent )
+{
+ rxListener->notifyVBAScriptEvent( rEvent );
+ return true; // notify all other listeners too
+}
+
+// Ctor
+SfxLibraryContainer::SfxLibraryContainer()
+ : SfxLibraryContainer_BASE( m_aMutex )
+ , maVBAScriptListeners( m_aMutex )
+ , mnRunningVBAScripts( 0 )
+ , mbVBACompat( false )
+ , maModifiable( *this, m_aMutex )
+ , maNameContainer( new NameContainer(cppu::UnoType<XNameAccess>::get()) )
+ , mbOldInfoFormat( false )
+ , mbOasis2OOoFormat( false )
+ , mpBasMgr( nullptr )
+ , mbOwnBasMgr( false )
+ , meInitMode(DEFAULT)
+{
+ mxContext = comphelper::getProcessComponentContext();
+
+ mxSFI = ucb::SimpleFileAccess::create( mxContext );
+
+ mxStringSubstitution = util::PathSubstitution::create( mxContext );
+}
+
+SfxLibraryContainer::~SfxLibraryContainer()
+{
+ if( mbOwnBasMgr )
+ {
+ delete mpBasMgr;
+ }
+}
+
+void SfxLibraryContainer::enterMethod()
+{
+ Application::GetSolarMutex().acquire();
+ if ( rBHelper.bInDispose || rBHelper.bDisposed )
+ {
+ throw DisposedException( OUString(), *this );
+ }
+}
+
+void SfxLibraryContainer::leaveMethod()
+{
+ Application::GetSolarMutex().release();
+}
+
+BasicManager* SfxLibraryContainer::getBasicManager()
+{
+ try
+ {
+ if ( mpBasMgr )
+ {
+ return mpBasMgr;
+ }
+ Reference< XModel > xDocument( mxOwnerDocument.get(), UNO_QUERY );
+ SAL_WARN_IF(
+ !xDocument.is(), "basic",
+ ("SfxLibraryContainer::getBasicManager: cannot obtain a BasicManager"
+ " without document!"));
+ if ( xDocument.is() )
+ {
+ mpBasMgr = BasicManagerRepository::getDocumentBasicManager( xDocument );
+ }
+ }
+ catch (const css::ucb::ContentCreationException&)
+ {
+ TOOLS_WARN_EXCEPTION( "basic", "SfxLibraryContainer::getBasicManager:" );
+ }
+ return mpBasMgr;
+}
+
+// Methods XStorageBasedLibraryContainer
+Reference< XStorage > SAL_CALL SfxLibraryContainer::getRootStorage()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ return mxStorage;
+}
+
+void SAL_CALL SfxLibraryContainer::setRootStorage( const Reference< XStorage >& _rxRootStorage )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ if ( !_rxRootStorage.is() )
+ {
+ throw IllegalArgumentException();
+ }
+ mxStorage = _rxRootStorage;
+ onNewRootStorage();
+}
+
+void SAL_CALL SfxLibraryContainer::storeLibrariesToStorage( const Reference< XStorage >& _rxRootStorage )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ if ( !_rxRootStorage.is() )
+ {
+ throw IllegalArgumentException();
+ }
+ try
+ {
+ storeLibraries_Impl( _rxRootStorage, true );
+ }
+ catch( const Exception& )
+ {
+ throw WrappedTargetException( OUString(),
+ *this, ::cppu::getCaughtException() );
+ }
+}
+
+
+// Methods XModifiable
+sal_Bool SfxLibraryContainer::isModified()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ if ( maModifiable.isModified() )
+ {
+ return true;
+ }
+ // the library container is not modified, go through the libraries and check whether they are modified
+ Sequence< OUString > aNames = maNameContainer->getElementNames();
+ const OUString* pNames = aNames.getConstArray();
+ sal_Int32 nNameCount = aNames.getLength();
+
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aName = pNames[ i ];
+ try
+ {
+ SfxLibrary* pImplLib = getImplLib( aName );
+ if( pImplLib->isModified() )
+ {
+ if ( aName == "Standard" )
+ {
+ // this is a workaround that has to be implemented because
+ // empty standard library should stay marked as modified
+ // but should not be treated as modified while it is empty
+ if ( pImplLib->hasElements() )
+ return true;
+ }
+ else
+ {
+ return true;
+ }
+ }
+ }
+ catch(const css::container::NoSuchElementException&)
+ {
+ }
+ }
+
+ return false;
+}
+
+void SAL_CALL SfxLibraryContainer::setModified( sal_Bool _bModified )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ maModifiable.setModified( _bModified );
+}
+
+void SAL_CALL SfxLibraryContainer::addModifyListener( const Reference< XModifyListener >& _rxListener )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ maModifiable.addModifyListener( _rxListener );
+}
+
+void SAL_CALL SfxLibraryContainer::removeModifyListener( const Reference< XModifyListener >& _rxListener )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ maModifiable.removeModifyListener( _rxListener );
+}
+
+// Methods XPersistentLibraryContainer
+Any SAL_CALL SfxLibraryContainer::getRootLocation()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ return Any( getRootStorage() );
+}
+
+OUString SAL_CALL SfxLibraryContainer::getContainerLocationName()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ return maLibrariesDir;
+}
+
+void SAL_CALL SfxLibraryContainer::storeLibraries( )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ try
+ {
+ storeLibraries_Impl( mxStorage, mxStorage.is() );
+ // we need to store *all* libraries if and only if we are based on a storage:
+ // in this case, storeLibraries_Impl will remove the source storage, after loading
+ // all libraries, so we need to force them to be stored, again
+ }
+ catch( const Exception& )
+ {
+ throw WrappedTargetException( OUString(), *this, ::cppu::getCaughtException() );
+ }
+}
+
+static void checkAndCopyFileImpl( const INetURLObject& rSourceFolderInetObj,
+ const INetURLObject& rTargetFolderInetObj,
+ const OUString& rCheckFileName,
+ const OUString& rCheckExtension,
+ const Reference< XSimpleFileAccess3 >& xSFI )
+{
+ INetURLObject aTargetFolderInetObj( rTargetFolderInetObj );
+ aTargetFolderInetObj.insertName( rCheckFileName, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aTargetFolderInetObj.setExtension( rCheckExtension );
+ OUString aTargetFile = aTargetFolderInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( !xSFI->exists( aTargetFile ) )
+ {
+ INetURLObject aSourceFolderInetObj( rSourceFolderInetObj );
+ aSourceFolderInetObj.insertName( rCheckFileName, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aSourceFolderInetObj.setExtension( rCheckExtension );
+ OUString aSourceFile = aSourceFolderInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ xSFI->copy( aSourceFile, aTargetFile );
+ }
+}
+
+static void createVariableURL( OUString& rStr, const OUString& rLibName,
+ const OUString& rInfoFileName, bool bUser )
+{
+ if( bUser )
+ {
+ rStr = "$(USER)/basic/";
+ }
+ else
+ {
+ rStr = "$(INST)/" LIBO_SHARE_FOLDER "/basic/";
+ }
+ rStr += rLibName + "/" + rInfoFileName + ".xlb/";
+}
+
+void SfxLibraryContainer::init( const OUString& rInitialDocumentURL, const uno::Reference< embed::XStorage >& rxInitialStorage )
+{
+ // this might be called from within the ctor, and the impl_init might (indirectly) create
+ // a UNO reference to ourself.
+ // Ensure that we're not destroyed while we're in here
+ osl_atomic_increment( &m_refCount );
+ init_Impl( rInitialDocumentURL, rxInitialStorage );
+ osl_atomic_decrement( &m_refCount );
+}
+
+void SfxLibraryContainer::init_Impl( const OUString& rInitialDocumentURL,
+ const uno::Reference< embed::XStorage >& rxInitialStorage )
+{
+ uno::Reference< embed::XStorage > xStorage = rxInitialStorage;
+
+ maInitialDocumentURL = rInitialDocumentURL;
+ maInfoFileName = OUString::createFromAscii( getInfoFileName() );
+ maOldInfoFileName = OUString::createFromAscii( getOldInfoFileName() );
+ maLibElementFileExtension = OUString::createFromAscii( getLibElementFileExtension() );
+ maLibrariesDir = OUString::createFromAscii( getLibrariesDir() );
+
+ meInitMode = DEFAULT;
+ INetURLObject aInitUrlInetObj( maInitialDocumentURL );
+ OUString aInitFileName = aInitUrlInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( !aInitFileName.isEmpty() )
+ {
+ // We need a BasicManager to avoid problems
+ StarBASIC* pBas = new StarBASIC();
+ mpBasMgr = new BasicManager( pBas );
+ mbOwnBasMgr = true;
+
+ OUString aExtension = aInitUrlInetObj.getExtension();
+ if( aExtension == "xlc" )
+ {
+ meInitMode = CONTAINER_INIT_FILE;
+ INetURLObject aLibPathInetObj( aInitUrlInetObj );
+ aLibPathInetObj.removeSegment();
+ maLibraryPath = aLibPathInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ }
+ else if( aExtension == "xlb" )
+ {
+ meInitMode = LIBRARY_INIT_FILE;
+ uno::Reference< embed::XStorage > xDummyStor;
+ ::xmlscript::LibDescriptor aLibDesc;
+ implLoadLibraryIndexFile( nullptr, aLibDesc, xDummyStor, aInitFileName );
+ return;
+ }
+ else
+ {
+ // Decide between old and new document
+ bool bOldStorage = SotStorage::IsOLEStorage( aInitFileName );
+ if ( bOldStorage )
+ {
+ meInitMode = OLD_BASIC_STORAGE;
+ importFromOldStorage( aInitFileName );
+ return;
+ }
+ else
+ {
+ meInitMode = OFFICE_DOCUMENT;
+ try
+ {
+ xStorage = ::comphelper::OStorageHelper::GetStorageFromURL( aInitFileName, embed::ElementModes::READ );
+ }
+ catch (const uno::Exception& )
+ {
+ // TODO: error handling
+ }
+ }
+ }
+ }
+ else
+ {
+ // Default paths
+ maLibraryPath = SvtPathOptions().GetBasicPath();
+ }
+
+ Reference< XParser > xParser = xml::sax::Parser::create(mxContext);
+
+ uno::Reference< io::XInputStream > xInput;
+
+ mxStorage = xStorage;
+ bool bStorage = mxStorage.is();
+
+
+ // #110009: Scope to force the StorageRefs to be destructed and
+ // so the streams to be closed before the preload operation
+ {
+
+ uno::Reference< embed::XStorage > xLibrariesStor;
+ OUString aFileName;
+
+ int nPassCount = 1;
+ if( !bStorage && meInitMode == DEFAULT )
+ {
+ nPassCount = 2;
+ }
+ for( int nPass = 0 ; nPass < nPassCount ; nPass++ )
+ {
+ if( bStorage )
+ {
+ SAL_WARN_IF(
+ meInitMode != DEFAULT && meInitMode != OFFICE_DOCUMENT, "basic",
+ "Wrong InitMode for document");
+ try
+ {
+ uno::Reference< io::XStream > xStream;
+ xLibrariesStor = xStorage->openStorageElement( maLibrariesDir, embed::ElementModes::READ );
+
+ if ( xLibrariesStor.is() )
+ {
+ aFileName = maInfoFileName + "-lc.xml";
+ try
+ {
+ xStream = xLibrariesStor->openStreamElement( aFileName, embed::ElementModes::READ );
+ }
+ catch(const uno::Exception& )
+ {}
+
+ if( !xStream.is() )
+ {
+ mbOldInfoFormat = true;
+
+ // Check old version
+ aFileName = maOldInfoFileName + ".xml";
+ try
+ {
+ xStream = xLibrariesStor->openStreamElement( aFileName, embed::ElementModes::READ );
+ }
+ catch(const uno::Exception& )
+ {}
+
+ if( !xStream.is() )
+ {
+ // Check for EA2 document version with wrong extensions
+ aFileName = maOldInfoFileName + ".xli";
+ xStream = xLibrariesStor->openStreamElement( aFileName, embed::ElementModes::READ );
+ }
+ }
+ }
+
+ if ( xStream.is() )
+ {
+ xInput = xStream->getInputStream();
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ // TODO: error handling?
+ }
+ }
+ else
+ {
+ std::unique_ptr<INetURLObject> pLibInfoInetObj;
+ if( meInitMode == CONTAINER_INIT_FILE )
+ {
+ aFileName = aInitFileName;
+ }
+ else
+ {
+ if( nPass == 1 )
+ {
+ pLibInfoInetObj.reset(new INetURLObject( maLibraryPath.getToken(0, ';') ));
+ }
+ else
+ {
+ pLibInfoInetObj.reset(new INetURLObject( maLibraryPath.getToken(1, ';') ));
+ }
+ pLibInfoInetObj->insertName( maInfoFileName, false, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ pLibInfoInetObj->setExtension( "xlc" );
+ aFileName = pLibInfoInetObj->GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ }
+
+ try
+ {
+ xInput = mxSFI->openFileRead( aFileName );
+ }
+ catch(const Exception& )
+ {
+ // Silently tolerate empty or missing files
+ xInput.clear();
+ }
+
+ // Old variant?
+ if( !xInput.is() && nPass == 0 )
+ {
+ INetURLObject aLibInfoInetObj( maLibraryPath.getToken(1, ';') );
+ aLibInfoInetObj.insertName( maOldInfoFileName, false, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ aLibInfoInetObj.setExtension( "xli" );
+ aFileName = aLibInfoInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ try
+ {
+ xInput = mxSFI->openFileRead( aFileName );
+ mbOldInfoFormat = true;
+ }
+ catch(const Exception& )
+ {
+ xInput.clear();
+ }
+ }
+ }
+
+ if( xInput.is() )
+ {
+ InputSource source;
+ source.aInputStream = xInput;
+ source.sSystemId = aFileName;
+
+ // start parsing
+ std::unique_ptr< ::xmlscript::LibDescriptorArray> pLibArray(new ::xmlscript::LibDescriptorArray());
+
+ try
+ {
+ xParser->setDocumentHandler( ::xmlscript::importLibraryContainer( pLibArray.get() ) );
+ xParser->parseStream( source );
+ }
+ catch ( const xml::sax::SAXException& )
+ {
+ TOOLS_WARN_EXCEPTION( "basic", "" );
+ return;
+ }
+ catch ( const io::IOException& )
+ {
+ TOOLS_WARN_EXCEPTION( "basic", "" );
+ return;
+ }
+
+ sal_Int32 nLibCount = pLibArray->mnLibCount;
+ for( sal_Int32 i = 0 ; i < nLibCount ; i++ )
+ {
+ ::xmlscript::LibDescriptor& rLib = pLibArray->mpLibs[i];
+
+ // Check storage URL
+ OUString aStorageURL = rLib.aStorageURL;
+ if( !bStorage && aStorageURL.isEmpty() && nPass == 0 )
+ {
+ OUString aLibraryPath;
+ if( meInitMode == CONTAINER_INIT_FILE )
+ {
+ aLibraryPath = maLibraryPath;
+ }
+ else
+ {
+ aLibraryPath = maLibraryPath.getToken(1, ';');
+ }
+ INetURLObject aInetObj( aLibraryPath );
+
+ aInetObj.insertName( rLib.aName, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ OUString aLibDirPath = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( mxSFI->isFolder( aLibDirPath ) )
+ {
+ createVariableURL( rLib.aStorageURL, rLib.aName, maInfoFileName, true );
+ maModifiable.setModified( true );
+ }
+ else if( rLib.bLink )
+ {
+ // Check "share" path
+ INetURLObject aShareInetObj( maLibraryPath.getToken(0, ';') );
+ aShareInetObj.insertName( rLib.aName, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ OUString aShareLibDirPath = aShareInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( mxSFI->isFolder( aShareLibDirPath ) )
+ {
+ createVariableURL( rLib.aStorageURL, rLib.aName, maInfoFileName, false );
+ maModifiable.setModified( true );
+ }
+ else
+ {
+ // #i25537: Ignore lib if library folder does not really exist
+ continue;
+ }
+ }
+ }
+
+ OUString aLibName = rLib.aName;
+
+ // If the same library name is used by the shared and the
+ // user lib container index files the user file wins
+ if( nPass == 1 && hasByName( aLibName ) )
+ {
+ continue;
+ }
+ SfxLibrary* pImplLib;
+ if( rLib.bLink )
+ {
+ Reference< XNameAccess > xLib =
+ createLibraryLink( aLibName, rLib.aStorageURL, rLib.bReadOnly );
+ pImplLib = static_cast< SfxLibrary* >( xLib.get() );
+ }
+ else
+ {
+ Reference< XNameContainer > xLib = createLibrary( aLibName );
+ pImplLib = static_cast< SfxLibrary* >( xLib.get() );
+ pImplLib->mbLoaded = false;
+ pImplLib->mbReadOnly = rLib.bReadOnly;
+ if( !bStorage )
+ {
+ checkStorageURL( rLib.aStorageURL, pImplLib->maLibInfoFileURL,
+ pImplLib->maStorageURL, pImplLib->maUnexpandedStorageURL );
+ }
+ }
+ maModifiable.setModified( false );
+
+ // Read library info files
+ if( !mbOldInfoFormat )
+ {
+ uno::Reference< embed::XStorage > xLibraryStor;
+ if( !pImplLib->mbInitialised && bStorage )
+ {
+ try
+ {
+ xLibraryStor = xLibrariesStor->openStorageElement( rLib.aName,
+ embed::ElementModes::READ );
+ }
+ catch(const uno::Exception& )
+ {
+ #if OSL_DEBUG_LEVEL > 0
+ TOOLS_WARN_EXCEPTION(
+ "basic",
+ "couldn't open sub storage for library \"" << rLib.aName << "\"");
+ #endif
+ }
+ }
+
+ // Link is already initialised in createLibraryLink()
+ if( !pImplLib->mbInitialised && (!bStorage || xLibraryStor.is()) )
+ {
+ bool bLoaded = implLoadLibraryIndexFile( pImplLib, rLib, xLibraryStor, OUString() );
+ SAL_WARN_IF(
+ bLoaded && aLibName != rLib.aName, "basic",
+ ("Different library names in library container and"
+ " library info files!"));
+ if( GbMigrationSuppressErrors && !bLoaded )
+ {
+ removeLibrary( aLibName );
+ }
+ }
+ }
+ else if( !bStorage )
+ {
+ // Write new index file immediately because otherwise
+ // the library elements will be lost when storing into
+ // the new info format
+ uno::Reference< embed::XStorage > xTmpStorage;
+ implStoreLibraryIndexFile( pImplLib, rLib, xTmpStorage );
+ }
+
+ implImportLibDescriptor( pImplLib, rLib );
+
+ if( nPass == 1 )
+ {
+ pImplLib->mbSharedIndexFile = true;
+ pImplLib->mbReadOnly = true;
+ }
+ }
+
+ // Keep flag for documents to force writing the new index files
+ if( !bStorage )
+ {
+ mbOldInfoFormat = false;
+ }
+ }
+ }
+
+ // #110009: END Scope to force the StorageRefs to be destructed
+ }
+
+ if( !bStorage && meInitMode == DEFAULT )
+ {
+ try
+ {
+ implScanExtensions();
+ }
+ catch(const uno::Exception& )
+ {
+ // TODO: error handling?
+ SAL_WARN("basic", "Cannot access extensions!");
+ }
+ }
+
+ // Preload?
+ {
+ Sequence< OUString > aNames = maNameContainer->getElementNames();
+ const OUString* pNames = aNames.getConstArray();
+ sal_Int32 nNameCount = aNames.getLength();
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aName = pNames[ i ];
+ SfxLibrary* pImplLib = getImplLib( aName );
+ if( pImplLib->mbPreload )
+ {
+ loadLibrary( aName );
+ }
+ }
+ }
+
+ if( meInitMode != DEFAULT )
+ return;
+
+ INetURLObject aUserBasicInetObj( maLibraryPath.getToken(1, ';') );
+ OUString aStandardStr("Standard");
+
+ INetURLObject aPrevUserBasicInetObj_1( aUserBasicInetObj );
+ aPrevUserBasicInetObj_1.removeSegment();
+ INetURLObject aPrevUserBasicInetObj_2 = aPrevUserBasicInetObj_1;
+ aPrevUserBasicInetObj_1.Append( "__basic_80" );
+ aPrevUserBasicInetObj_2.Append( "__basic_80_2" );
+
+ // #i93163
+ bool bCleanUp = false;
+ try
+ {
+ INetURLObject aPrevUserBasicInetObj = aPrevUserBasicInetObj_1;
+ OUString aPrevFolder = aPrevUserBasicInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( mxSFI->isFolder( aPrevFolder ) )
+ {
+ // Check if Standard folder exists and is complete
+ INetURLObject aUserBasicStandardInetObj( aUserBasicInetObj );
+ aUserBasicStandardInetObj.insertName( aStandardStr, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ INetURLObject aPrevUserBasicStandardInetObj( aPrevUserBasicInetObj );
+ aPrevUserBasicStandardInetObj.insertName( aStandardStr, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ OUString aPrevStandardFolder = aPrevUserBasicStandardInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( mxSFI->isFolder( aPrevStandardFolder ) )
+ {
+ OUString aXlbExtension( "xlb" );
+ OUString aCheckFileName;
+
+ // Check if script.xlb exists
+ aCheckFileName = "script";
+ checkAndCopyFileImpl( aUserBasicStandardInetObj,
+ aPrevUserBasicStandardInetObj,
+ aCheckFileName, aXlbExtension, mxSFI );
+
+ // Check if dialog.xlb exists
+ aCheckFileName = "dialog";
+ checkAndCopyFileImpl( aUserBasicStandardInetObj,
+ aPrevUserBasicStandardInetObj,
+ aCheckFileName, aXlbExtension, mxSFI );
+
+ // Check if module1.xba exists
+ aCheckFileName = "Module1";
+ checkAndCopyFileImpl( aUserBasicStandardInetObj,
+ aPrevUserBasicStandardInetObj,
+ aCheckFileName, "xba", mxSFI );
+ }
+ else
+ {
+ OUString aStandardFolder = aUserBasicStandardInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ mxSFI->copy( aStandardFolder, aPrevStandardFolder );
+ }
+
+ OUString aPrevCopyToFolder = aPrevUserBasicInetObj_2.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ mxSFI->copy( aPrevFolder, aPrevCopyToFolder );
+ }
+ else
+ {
+ aPrevUserBasicInetObj = aPrevUserBasicInetObj_2;
+ aPrevFolder = aPrevUserBasicInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ }
+ if( mxSFI->isFolder( aPrevFolder ) )
+ {
+ rtl::Reference<SfxLibraryContainer> pPrevCont = createInstanceImpl();
+
+ // Rename previous basic folder to make storage URLs correct during initialisation
+ OUString aFolderUserBasic = aUserBasicInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ INetURLObject aUserBasicTmpInetObj( aUserBasicInetObj );
+ aUserBasicTmpInetObj.removeSegment();
+ aUserBasicTmpInetObj.Append( "__basic_tmp" );
+ OUString aFolderTmp = aUserBasicTmpInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ mxSFI->move( aFolderUserBasic, aFolderTmp );
+ try
+ {
+ mxSFI->move( aPrevFolder, aFolderUserBasic );
+ }
+ catch(const Exception& )
+ {
+ // Move back user/basic folder
+ try
+ {
+ mxSFI->kill( aFolderUserBasic );
+ }
+ catch(const Exception& )
+ {}
+ mxSFI->move( aFolderTmp, aFolderUserBasic );
+ throw;
+ }
+
+ INetURLObject aPrevUserBasicLibInfoInetObj( aUserBasicInetObj );
+ aPrevUserBasicLibInfoInetObj.insertName( maInfoFileName, false, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aPrevUserBasicLibInfoInetObj.setExtension( "xlc");
+ OUString aLibInfoFileName = aPrevUserBasicLibInfoInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ Sequence<Any> aInitSeq( 1 );
+ aInitSeq.getArray()[0] <<= aLibInfoFileName;
+ GbMigrationSuppressErrors = true;
+ pPrevCont->initialize( aInitSeq );
+ GbMigrationSuppressErrors = false;
+
+ // Rename folders back
+ mxSFI->move( aFolderUserBasic, aPrevFolder );
+ mxSFI->move( aFolderTmp, aFolderUserBasic );
+
+ Sequence< OUString > aNames = pPrevCont->getElementNames();
+ const OUString* pNames = aNames.getConstArray();
+ sal_Int32 nNameCount = aNames.getLength();
+
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aLibName = pNames[ i ];
+ if( hasByName( aLibName ) )
+ {
+ if( aLibName == aStandardStr )
+ {
+ SfxLibrary* pImplLib = getImplLib( aStandardStr );
+ OUString aStandardFolder = pImplLib->maStorageURL;
+ mxSFI->kill( aStandardFolder );
+ }
+ else
+ {
+ continue;
+ }
+ }
+
+ SfxLibrary* pImplLib = pPrevCont->getImplLib( aLibName );
+ if( pImplLib->mbLink )
+ {
+ OUString aStorageURL = pImplLib->maUnexpandedStorageURL;
+ bool bCreateLink = true;
+ if( aStorageURL.indexOf( "vnd.sun.star.expand:$UNO_USER_PACKAGES_CACHE" ) != -1 ||
+ aStorageURL.indexOf( "vnd.sun.star.expand:$UNO_SHARED_PACKAGES_CACHE" ) != -1 ||
+ aStorageURL.indexOf( "vnd.sun.star.expand:$BUNDLED_EXTENSIONS" ) != -1 ||
+ aStorageURL.indexOf( "$(INST)" ) != -1 )
+ {
+ bCreateLink = false;
+ }
+ if( bCreateLink )
+ {
+ createLibraryLink( aLibName, pImplLib->maStorageURL, pImplLib->mbReadOnly );
+ }
+ }
+ else
+ {
+ // Move folder if not already done
+ INetURLObject aUserBasicLibFolderInetObj( aUserBasicInetObj );
+ aUserBasicLibFolderInetObj.Append( aLibName );
+ OUString aLibFolder = aUserBasicLibFolderInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ INetURLObject aPrevUserBasicLibFolderInetObj( aPrevUserBasicInetObj );
+ aPrevUserBasicLibFolderInetObj.Append( aLibName );
+ OUString aPrevLibFolder = aPrevUserBasicLibFolderInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ if( mxSFI->isFolder( aPrevLibFolder ) && !mxSFI->isFolder( aLibFolder ) )
+ {
+ mxSFI->move( aPrevLibFolder, aLibFolder );
+ }
+
+ if( aLibName == aStandardStr )
+ {
+ maNameContainer->removeByName( aLibName );
+ }
+
+ // Create library
+ Reference< XNameContainer > xLib = createLibrary( aLibName );
+ SfxLibrary* pNewLib = static_cast< SfxLibrary* >( xLib.get() );
+ pNewLib->mbLoaded = false;
+ pNewLib->implSetModified( false );
+ checkStorageURL( aLibFolder, pNewLib->maLibInfoFileURL,
+ pNewLib->maStorageURL, pNewLib->maUnexpandedStorageURL );
+
+ uno::Reference< embed::XStorage > xDummyStor;
+ ::xmlscript::LibDescriptor aLibDesc;
+ implLoadLibraryIndexFile( pNewLib, aLibDesc, xDummyStor, pNewLib->maLibInfoFileURL );
+ implImportLibDescriptor( pNewLib, aLibDesc );
+ }
+ }
+ mxSFI->kill( aPrevFolder );
+ }
+ }
+ catch(const Exception&)
+ {
+ TOOLS_WARN_EXCEPTION("basic", "Upgrade of Basic installation failed somehow" );
+ bCleanUp = true;
+ }
+
+ // #i93163
+ if( !bCleanUp )
+ return;
+
+ INetURLObject aPrevUserBasicInetObj_Err( aUserBasicInetObj );
+ aPrevUserBasicInetObj_Err.removeSegment();
+ aPrevUserBasicInetObj_Err.Append( "__basic_80_err" );
+ OUString aPrevFolder_Err = aPrevUserBasicInetObj_Err.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ bool bSaved = false;
+ try
+ {
+ OUString aPrevFolder_1 = aPrevUserBasicInetObj_1.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( mxSFI->isFolder( aPrevFolder_1 ) )
+ {
+ mxSFI->move( aPrevFolder_1, aPrevFolder_Err );
+ bSaved = true;
+ }
+ }
+ catch(const Exception& )
+ {}
+ try
+ {
+ OUString aPrevFolder_2 = aPrevUserBasicInetObj_2.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( !bSaved && mxSFI->isFolder( aPrevFolder_2 ) )
+ {
+ mxSFI->move( aPrevFolder_2, aPrevFolder_Err );
+ }
+ else
+ {
+ mxSFI->kill( aPrevFolder_2 );
+ }
+ }
+ catch(const Exception& )
+ {}
+}
+
+void SfxLibraryContainer::implScanExtensions()
+{
+#if HAVE_FEATURE_EXTENSIONS
+ ScriptExtensionIterator aScriptIt;
+
+ bool bPureDialogLib = false;
+ for (;;)
+ {
+ OUString aLibURL = aScriptIt.nextBasicOrDialogLibrary( bPureDialogLib );
+ if (aLibURL.isEmpty())
+ break;
+ if( bPureDialogLib && maInfoFileName == "script" )
+ {
+ continue;
+ }
+ // Extract lib name
+ sal_Int32 nLen = aLibURL.getLength();
+ sal_Int32 indexLastSlash = aLibURL.lastIndexOf( '/' );
+ sal_Int32 nReduceCopy = 0;
+ if( indexLastSlash == nLen - 1 )
+ {
+ nReduceCopy = 1;
+ indexLastSlash = aLibURL.lastIndexOf( '/', nLen - 1 );
+ }
+
+ OUString aLibName = aLibURL.copy( indexLastSlash + 1, nLen - indexLastSlash - nReduceCopy - 1 );
+
+ // If a library of the same exists the existing library wins
+ if( hasByName( aLibName ) )
+ {
+ continue;
+ }
+ // Add index file to URL
+ OUString aIndexFileURL = aLibURL;
+ if( nReduceCopy == 0 )
+ {
+ aIndexFileURL += "/";
+ }
+ aIndexFileURL += maInfoFileName + ".xlb";
+
+ // Create link
+ const bool bReadOnly = false;
+ createLibraryLink( aLibName, aIndexFileURL, bReadOnly );
+ }
+#else
+ (void) this;
+#endif
+}
+
+// Handle maLibInfoFileURL and maStorageURL correctly
+void SfxLibraryContainer::checkStorageURL( const OUString& aSourceURL,
+ OUString& aLibInfoFileURL, OUString& aStorageURL,
+ OUString& aUnexpandedStorageURL )
+{
+ OUString aExpandedSourceURL = expand_url( aSourceURL );
+ if( aExpandedSourceURL != aSourceURL )
+ {
+ aUnexpandedStorageURL = aSourceURL;
+ }
+ INetURLObject aInetObj( aExpandedSourceURL );
+ OUString aExtension = aInetObj.getExtension();
+ if( aExtension == "xlb" )
+ {
+ // URL to xlb file
+ aLibInfoFileURL = aExpandedSourceURL;
+ aInetObj.removeSegment();
+ aStorageURL = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ }
+ else
+ {
+ // URL to library folder
+ aStorageURL = aExpandedSourceURL;
+ aInetObj.insertName( maInfoFileName, false, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ aInetObj.setExtension( "xlb" );
+ aLibInfoFileURL = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ }
+}
+
+SfxLibrary* SfxLibraryContainer::getImplLib( const OUString& rLibraryName )
+{
+ Any aLibAny = maNameContainer->getByName( rLibraryName ) ;
+ Reference< XNameAccess > xNameAccess;
+ aLibAny >>= xNameAccess;
+ SfxLibrary* pImplLib = static_cast< SfxLibrary* >( xNameAccess.get() );
+ return pImplLib;
+}
+
+
+// Storing with password encryption
+
+// Empty implementation, avoids unnecessary implementation in dlgcont.cxx
+bool SfxLibraryContainer::implStorePasswordLibrary( SfxLibrary*,
+ const OUString&,
+ const uno::Reference< embed::XStorage >&,
+ const uno::Reference< task::XInteractionHandler >& )
+{
+ return false;
+}
+
+bool SfxLibraryContainer::implStorePasswordLibrary(
+ SfxLibrary* /*pLib*/,
+ const OUString& /*aName*/,
+ const css::uno::Reference< css::embed::XStorage >& /*xStorage*/,
+ const OUString& /*aTargetURL*/,
+ const Reference< XSimpleFileAccess3 >& /*xToUseSFI*/,
+ const uno::Reference< task::XInteractionHandler >& )
+{
+ return false;
+}
+
+bool SfxLibraryContainer::implLoadPasswordLibrary(
+ SfxLibrary* /*pLib*/,
+ const OUString& /*Name*/,
+ bool /*bVerifyPasswordOnly*/ )
+{
+ return true;
+}
+
+OUString SfxLibraryContainer::createAppLibraryFolder( SfxLibrary* pLib, const OUString& aName )
+{
+ OUString aLibDirPath = pLib->maStorageURL;
+ if( aLibDirPath.isEmpty() )
+ {
+ INetURLObject aInetObj( maLibraryPath.getToken(1, ';') );
+ aInetObj.insertName( aName, true, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ checkStorageURL( aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE ), pLib->maLibInfoFileURL,
+ pLib->maStorageURL, pLib->maUnexpandedStorageURL );
+ aLibDirPath = pLib->maStorageURL;
+ }
+
+ if( !mxSFI->isFolder( aLibDirPath ) )
+ {
+ try
+ {
+ mxSFI->createFolder( aLibDirPath );
+ }
+ catch(const Exception& )
+ {}
+ }
+
+ return aLibDirPath;
+}
+
+// Storing
+void SfxLibraryContainer::implStoreLibrary( SfxLibrary* pLib,
+ const OUString& aName,
+ const uno::Reference< embed::XStorage >& xStorage )
+{
+ Reference< XSimpleFileAccess3 > xDummySFA;
+ Reference< XInteractionHandler > xDummyHandler;
+ implStoreLibrary( pLib, aName, xStorage, OUString(), xDummySFA, xDummyHandler );
+}
+
+// New variant for library export
+void SfxLibraryContainer::implStoreLibrary( SfxLibrary* pLib,
+ const OUString& aName,
+ const uno::Reference< embed::XStorage >& xStorage,
+ const OUString& aTargetURL,
+ const Reference< XSimpleFileAccess3 >& rToUseSFI,
+ const Reference< XInteractionHandler >& xHandler )
+{
+ bool bLink = pLib->mbLink;
+ bool bStorage = xStorage.is() && !bLink;
+
+ Sequence< OUString > aElementNames = pLib->getElementNames();
+ sal_Int32 nNameCount = aElementNames.getLength();
+ const OUString* pNames = aElementNames.getConstArray();
+
+ if( bStorage )
+ {
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+ OUString aStreamName = aElementName + ".xml";
+
+ if( !isLibraryElementValid( pLib->getByName( aElementName ) ) )
+ {
+ SAL_WARN(
+ "basic",
+ "invalid library element \"" << aElementName << '"');
+ continue;
+ }
+ try
+ {
+ uno::Reference< io::XStream > xElementStream = xStorage->openStreamElement(
+ aStreamName,
+ embed::ElementModes::READWRITE );
+ // throw uno::RuntimeException(); // TODO: method must either return the stream or throw an exception
+
+ uno::Reference< beans::XPropertySet > xProps( xElementStream, uno::UNO_QUERY );
+ SAL_WARN_IF(
+ !xProps.is(), "basic",
+ "The StorageStream must implement XPropertySet interface!");
+ //if ( !xProps.is() ) //TODO
+
+ if ( xProps.is() )
+ {
+ xProps->setPropertyValue("MediaType", uno::Any( OUString( "text/xml" ) ) );
+
+ // #87671 Allow encryption
+ xProps->setPropertyValue("UseCommonStoragePasswordEncryption", uno::Any( true ) );
+
+ Reference< XOutputStream > xOutput = xElementStream->getOutputStream();
+ Reference< XNameContainer > xLib( pLib );
+ writeLibraryElement( xLib, aElementName, xOutput );
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ SAL_WARN("basic", "Problem during storing of library!");
+ // TODO: error handling?
+ }
+ }
+ pLib->storeResourcesToStorage( xStorage );
+ }
+ else
+ {
+ // Export?
+ bool bExport = !aTargetURL.isEmpty();
+ try
+ {
+ Reference< XSimpleFileAccess3 > xSFI = mxSFI;
+ if( rToUseSFI.is() )
+ {
+ xSFI = rToUseSFI;
+ }
+ OUString aLibDirPath;
+ if( bExport )
+ {
+ INetURLObject aInetObj( aTargetURL );
+ aInetObj.insertName( aName, true, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ aLibDirPath = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ if( !xSFI->isFolder( aLibDirPath ) )
+ {
+ xSFI->createFolder( aLibDirPath );
+ }
+ pLib->storeResourcesToURL( aLibDirPath, xHandler );
+ }
+ else
+ {
+ aLibDirPath = createAppLibraryFolder( pLib, aName );
+ pLib->storeResources();
+ }
+
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ INetURLObject aElementInetObj( aLibDirPath );
+ aElementInetObj.insertName( aElementName, false,
+ INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aElementInetObj.setExtension( maLibElementFileExtension );
+ OUString aElementPath( aElementInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE ) );
+
+ if( !isLibraryElementValid( pLib->getByName( aElementName ) ) )
+ {
+ SAL_WARN(
+ "basic",
+ "invalid library element \"" << aElementName << '"');
+ continue;
+ }
+
+ // TODO: Check modified
+ try
+ {
+ if( xSFI->exists( aElementPath ) )
+ {
+ xSFI->kill( aElementPath );
+ }
+ Reference< XOutputStream > xOutput = xSFI->openFileWrite( aElementPath );
+ Reference< XNameContainer > xLib( pLib );
+ writeLibraryElement( xLib, aElementName, xOutput );
+ xOutput->closeOutput();
+ }
+ catch(const Exception& )
+ {
+ if( bExport )
+ {
+ throw;
+ }
+ SfxErrorContext aEc( ERRCTX_SFX_SAVEDOC, aElementPath );
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ catch(const Exception& )
+ {
+ if( bExport )
+ {
+ throw;
+ }
+ }
+ }
+}
+
+void SfxLibraryContainer::implStoreLibraryIndexFile( SfxLibrary* pLib,
+ const ::xmlscript::LibDescriptor& rLib,
+ const uno::Reference< embed::XStorage >& xStorage )
+{
+ Reference< XSimpleFileAccess3 > xDummySFA;
+ implStoreLibraryIndexFile( pLib, rLib, xStorage, OUString(), xDummySFA );
+}
+
+// New variant for library export
+void SfxLibraryContainer::implStoreLibraryIndexFile( SfxLibrary* pLib,
+ const ::xmlscript::LibDescriptor& rLib,
+ const uno::Reference< embed::XStorage >& xStorage,
+ const OUString& aTargetURL,
+ const Reference< XSimpleFileAccess3 >& rToUseSFI )
+{
+ // Create sax writer
+ Reference< XWriter > xWriter = xml::sax::Writer::create(mxContext);
+
+ bool bLink = pLib->mbLink;
+ bool bStorage = xStorage.is() && !bLink;
+
+ // Write info file
+ uno::Reference< io::XOutputStream > xOut;
+ uno::Reference< io::XStream > xInfoStream;
+ if( bStorage )
+ {
+ OUString aStreamName = maInfoFileName + "-lb.xml";
+
+ try
+ {
+ xInfoStream = xStorage->openStreamElement( aStreamName, embed::ElementModes::READWRITE );
+ SAL_WARN_IF(!xInfoStream.is(), "basic", "No stream!");
+ uno::Reference< beans::XPropertySet > xProps( xInfoStream, uno::UNO_QUERY );
+ // throw uno::RuntimeException(); // TODO
+
+ if ( xProps.is() )
+ {
+ xProps->setPropertyValue("MediaType", uno::Any( OUString("text/xml") ) );
+
+ // #87671 Allow encryption
+ xProps->setPropertyValue("UseCommonStoragePasswordEncryption", uno::Any( true ) );
+
+ xOut = xInfoStream->getOutputStream();
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ SAL_WARN("basic", "Problem during storing of library index file!");
+ // TODO: error handling?
+ }
+ }
+ else
+ {
+ // Export?
+ bool bExport = !aTargetURL.isEmpty();
+ Reference< XSimpleFileAccess3 > xSFI = mxSFI;
+ if( rToUseSFI.is() )
+ {
+ xSFI = rToUseSFI;
+ }
+ OUString aLibInfoPath;
+ if( bExport )
+ {
+ INetURLObject aInetObj( aTargetURL );
+ aInetObj.insertName( rLib.aName, true, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ OUString aLibDirPath = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ if( !xSFI->isFolder( aLibDirPath ) )
+ {
+ xSFI->createFolder( aLibDirPath );
+ }
+ aInetObj.insertName( maInfoFileName, false, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ aInetObj.setExtension( "xlb" );
+ aLibInfoPath = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ }
+ else
+ {
+ createAppLibraryFolder( pLib, rLib.aName );
+ aLibInfoPath = pLib->maLibInfoFileURL;
+ }
+
+ try
+ {
+ if( xSFI->exists( aLibInfoPath ) )
+ {
+ xSFI->kill( aLibInfoPath );
+ }
+ xOut = xSFI->openFileWrite( aLibInfoPath );
+ }
+ catch(const Exception& )
+ {
+ if( bExport )
+ {
+ throw;
+ }
+ SfxErrorContext aEc( ERRCTX_SFX_SAVEDOC, aLibInfoPath );
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ }
+ }
+ if( !xOut.is() )
+ {
+ SAL_WARN("basic", "couldn't open output stream");
+ return;
+ }
+ xWriter->setOutputStream( xOut );
+ xmlscript::exportLibrary( xWriter, rLib );
+}
+
+
+bool SfxLibraryContainer::implLoadLibraryIndexFile( SfxLibrary* pLib,
+ ::xmlscript::LibDescriptor& rLib,
+ const uno::Reference< embed::XStorage >& xStorage,
+ const OUString& aIndexFileName )
+{
+ Reference< XParser > xParser = xml::sax::Parser::create(mxContext);
+
+ bool bStorage = false;
+ if( pLib )
+ {
+ bool bLink = pLib->mbLink;
+ bStorage = xStorage.is() && !bLink;
+ }
+
+ // Read info file
+ uno::Reference< io::XInputStream > xInput;
+ OUString aLibInfoPath;
+ if( bStorage )
+ {
+ aLibInfoPath = maInfoFileName + "-lb.xml";
+
+ try
+ {
+ uno::Reference< io::XStream > xInfoStream =
+ xStorage->openStreamElement( aLibInfoPath, embed::ElementModes::READ );
+ xInput = xInfoStream->getInputStream();
+ }
+ catch(const uno::Exception& )
+ {}
+ }
+ else
+ {
+ // Create Input stream
+ //String aLibInfoPath; // attention: THIS PROBLEM MUST BE REVIEWED BY SCRIPTING OWNER!!!
+
+ if( pLib )
+ {
+ createAppLibraryFolder( pLib, rLib.aName );
+ aLibInfoPath = pLib->maLibInfoFileURL;
+ }
+ else
+ {
+ aLibInfoPath = aIndexFileName;
+ }
+ try
+ {
+ xInput = mxSFI->openFileRead( aLibInfoPath );
+ }
+ catch(const Exception& )
+ {
+ xInput.clear();
+ if( !GbMigrationSuppressErrors )
+ {
+ SfxErrorContext aEc( ERRCTX_SFX_LOADBASIC, aLibInfoPath );
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ }
+ }
+ }
+ if( !xInput.is() )
+ {
+ return false;
+ }
+
+ InputSource source;
+ source.aInputStream = xInput;
+ source.sSystemId = aLibInfoPath;
+
+ // start parsing
+ try
+ {
+ xParser->setDocumentHandler( ::xmlscript::importLibrary( rLib ) );
+ xParser->parseStream( source );
+ }
+ catch(const Exception& )
+ {
+ SAL_WARN("basic", "Parsing error");
+ SfxErrorContext aEc( ERRCTX_SFX_LOADBASIC, aLibInfoPath );
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ return false;
+ }
+
+ if( !pLib )
+ {
+ Reference< XNameContainer > xLib = createLibrary( rLib.aName );
+ pLib = static_cast< SfxLibrary* >( xLib.get() );
+ pLib->mbLoaded = false;
+ rLib.aStorageURL = aIndexFileName;
+ checkStorageURL( rLib.aStorageURL, pLib->maLibInfoFileURL, pLib->maStorageURL,
+ pLib->maUnexpandedStorageURL );
+
+ implImportLibDescriptor( pLib, rLib );
+ }
+
+ return true;
+}
+
+void SfxLibraryContainer::implImportLibDescriptor( SfxLibrary* pLib,
+ ::xmlscript::LibDescriptor const & rLib )
+{
+ if( pLib->mbInitialised )
+ return;
+
+ sal_Int32 nElementCount = rLib.aElementNames.getLength();
+ const OUString* pElementNames = rLib.aElementNames.getConstArray();
+ Any aDummyElement = createEmptyLibraryElement();
+ for( sal_Int32 i = 0 ; i < nElementCount ; i++ )
+ {
+ pLib->maNameContainer->insertByName( pElementNames[i], aDummyElement );
+ }
+ pLib->mbPasswordProtected = rLib.bPasswordProtected;
+ pLib->mbReadOnly = rLib.bReadOnly;
+ pLib->mbPreload = rLib.bPreload;
+ pLib->implSetModified( false );
+ pLib->mbInitialised = true;
+}
+
+
+// Methods of new XLibraryStorage interface?
+void SfxLibraryContainer::storeLibraries_Impl( const uno::Reference< embed::XStorage >& i_rStorage,
+ bool bComplete )
+{
+ const Sequence< OUString > aNames = maNameContainer->getElementNames();
+ const sal_Int32 nNameCount = aNames.getLength();
+ const OUString* pName = aNames.getConstArray();
+ const OUString* pNamesEnd = aNames.getConstArray() + nNameCount;
+
+ // Don't count libs from shared index file
+ sal_Int32 nLibsToSave = nNameCount;
+ for( ; pName != pNamesEnd; ++pName )
+ {
+ SfxLibrary* pImplLib = getImplLib( *pName );
+ if( pImplLib->mbSharedIndexFile || pImplLib->mbExtension )
+ {
+ nLibsToSave--;
+ }
+ }
+ // Write to storage?
+ bool bStorage = i_rStorage.is();
+ uno::Reference< embed::XStorage > xSourceLibrariesStor;
+ uno::Reference< embed::XStorage > xTargetLibrariesStor;
+ OUString sTempTargetStorName;
+ const bool bInplaceStorage = bStorage && ( i_rStorage == mxStorage );
+
+ if( nLibsToSave == 0 )
+ {
+ if ( bInplaceStorage && mxStorage->hasByName(maLibrariesDir) )
+ {
+ mxStorage->removeElement(maLibrariesDir);
+ }
+ return;
+ }
+
+ if ( bStorage )
+ {
+ // Don't write if only empty standard lib exists
+ if ( ( nLibsToSave == 1 ) && ( aNames[0] == "Standard" ) )
+ {
+ Any aLibAny = maNameContainer->getByName( aNames[0] );
+ Reference< XNameAccess > xNameAccess;
+ aLibAny >>= xNameAccess;
+ if ( ! xNameAccess->hasElements() )
+ {
+ if ( bInplaceStorage && mxStorage->hasByName(maLibrariesDir) )
+ {
+ mxStorage->removeElement(maLibrariesDir);
+ }
+ return;
+ }
+ }
+
+ // create the empty target storage
+ try
+ {
+ OUString sTargetLibrariesStoreName;
+ if ( bInplaceStorage )
+ {
+ // create a temporary target storage
+ const OUStringBuffer aTempTargetNameBase = maLibrariesDir + "_temp_";
+ sal_Int32 index = 0;
+ do
+ {
+ OUStringBuffer aTempTargetName( aTempTargetNameBase );
+ aTempTargetName.append( index++ );
+
+ sTargetLibrariesStoreName = aTempTargetName.makeStringAndClear();
+ if ( !i_rStorage->hasByName( sTargetLibrariesStoreName ) )
+ {
+ break;
+ }
+ }
+ while ( true );
+ sTempTargetStorName = sTargetLibrariesStoreName;
+ }
+ else
+ {
+ sTargetLibrariesStoreName = maLibrariesDir;
+ if ( i_rStorage->hasByName( sTargetLibrariesStoreName ) )
+ {
+ i_rStorage->removeElement( sTargetLibrariesStoreName );
+ }
+ }
+
+ xTargetLibrariesStor.set( i_rStorage->openStorageElement( sTargetLibrariesStoreName, embed::ElementModes::READWRITE ), UNO_SET_THROW );
+ }
+ catch( const uno::Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ return;
+ }
+
+ // open the source storage which might be used to copy yet-unmodified libraries
+ try
+ {
+ if ( mxStorage->hasByName( maLibrariesDir ) || bInplaceStorage )
+ {
+ xSourceLibrariesStor = mxStorage->openStorageElement( maLibrariesDir,
+ bInplaceStorage ? embed::ElementModes::READWRITE : embed::ElementModes::READ );
+ }
+ }
+ catch( const uno::Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ return;
+ }
+ }
+
+ int iArray = 0;
+ pName = aNames.getConstArray();
+ ::xmlscript::LibDescriptor aLibDescriptorForExtensionLibs;
+ std::unique_ptr< ::xmlscript::LibDescriptorArray > pLibArray(new ::xmlscript::LibDescriptorArray(nLibsToSave));
+ for( ; pName != pNamesEnd; ++pName )
+ {
+ SfxLibrary* pImplLib = getImplLib( *pName );
+ if( pImplLib->mbSharedIndexFile )
+ {
+ continue;
+ }
+ const bool bExtensionLib = pImplLib->mbExtension;
+ ::xmlscript::LibDescriptor& rLib = bExtensionLib ?
+ aLibDescriptorForExtensionLibs : pLibArray->mpLibs[iArray];
+ if( !bExtensionLib )
+ {
+ iArray++;
+ }
+ rLib.aName = *pName;
+
+ rLib.bLink = pImplLib->mbLink;
+ if( !bStorage || pImplLib->mbLink )
+ {
+ rLib.aStorageURL = ( pImplLib->maUnexpandedStorageURL.getLength() ) ?
+ pImplLib->maUnexpandedStorageURL : pImplLib->maLibInfoFileURL;
+ }
+ rLib.bReadOnly = pImplLib->mbReadOnly;
+ rLib.bPreload = pImplLib->mbPreload;
+ rLib.bPasswordProtected = pImplLib->mbPasswordProtected;
+ rLib.aElementNames = pImplLib->getElementNames();
+
+ if( pImplLib->implIsModified() || bComplete )
+ {
+// Testing pImplLib->implIsModified() is not reliable,
+// IMHO the value of pImplLib->implIsModified() should
+// reflect whether the library ( in-memory ) model
+// is in sync with the library container's own storage. Currently
+// whenever the library model is written to *any* storage
+// pImplLib->implSetModified( sal_False ) is called
+// The way the code works, especially the way that sfx uses
+// temp storage when saving ( and later sets the root storage of the
+// library container ) and similar madness in dbaccess means some surgery
+// is required to make it possible to successfully use this optimisation
+// It would be possible to do the implSetModified() call below only
+// conditionally, but that would require an additional boolean to be
+// passed in via the XStorageBasedDocument::storeLibrariesToStorage()...
+// fdo#68983: If there's a password and the password is not known, only
+// copying the storage works!
+ // Can we simply copy the storage?
+ bool isCopyStorage = !mbOldInfoFormat && !mbOasis2OOoFormat
+ && !pImplLib->isLoadedStorable()
+ && xSourceLibrariesStor.is() /* null for user profile */;
+ if (isCopyStorage)
+ {
+ try
+ {
+ (void)xSourceLibrariesStor->isStorageElement(rLib.aName);
+ }
+ catch (container::NoSuchElementException const&)
+ {
+ isCopyStorage = false;
+ }
+ }
+ if (isCopyStorage)
+ {
+ try
+ {
+ xSourceLibrariesStor->copyElementTo( rLib.aName, xTargetLibrariesStor, rLib.aName );
+ }
+ catch( const uno::Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ // TODO: error handling?
+ }
+ }
+ else
+ {
+ uno::Reference< embed::XStorage > xLibraryStor;
+ if( bStorage )
+ {
+#if OSL_DEBUG_LEVEL > 0
+ try
+ {
+#endif
+ xLibraryStor = xTargetLibrariesStor->openStorageElement(
+ rLib.aName,
+ embed::ElementModes::READWRITE );
+#if OSL_DEBUG_LEVEL > 0
+ }
+ catch(const uno::Exception& )
+ {
+ TOOLS_WARN_EXCEPTION(
+ "basic",
+ "couldn't create sub storage for library \"" << rLib.aName << "\"");
+ throw;
+ }
+#endif
+ }
+
+ // Maybe lib is not loaded?!
+ if( bComplete )
+ {
+ loadLibrary( rLib.aName );
+ }
+ if( pImplLib->mbPasswordProtected )
+ {
+ implStorePasswordLibrary( pImplLib, rLib.aName, xLibraryStor, uno::Reference< task::XInteractionHandler >() );
+ // TODO: Check return value
+ }
+ else
+ {
+ implStoreLibrary( pImplLib, rLib.aName, xLibraryStor );
+ }
+ implStoreLibraryIndexFile( pImplLib, rLib, xLibraryStor );
+ if( bStorage )
+ {
+ try
+ {
+ uno::Reference< embed::XTransactedObject > xTransact( xLibraryStor, uno::UNO_QUERY_THROW );
+ xTransact->commit();
+ }
+ catch(const uno::Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ // TODO: error handling
+ throw;
+ }
+ }
+ }
+ maModifiable.setModified( true );
+ pImplLib->implSetModified( false );
+ }
+
+ // For container info ReadOnly refers to mbReadOnlyLink
+ rLib.bReadOnly = pImplLib->mbReadOnlyLink;
+ }
+
+ // if we did an in-place save into a storage (i.e. a save into the storage we were already based on),
+ // then we need to clean up the temporary storage we used for this
+ if ( bInplaceStorage && !sTempTargetStorName.isEmpty() )
+ {
+ SAL_WARN_IF(
+ !xSourceLibrariesStor.is(), "basic",
+ ("SfxLibrariesContainer::storeLibraries_impl: unexpected: we should"
+ " have a source storage here!"));
+ try
+ {
+ // for this, we first remove everything from the source storage, then copy the complete content
+ // from the temporary target storage. From then on, what used to be the "source storage" becomes
+ // the "target storage" for all subsequent operations.
+
+ // (We cannot simply remove the storage, denoted by maLibrariesDir, from i_rStorage - there might be
+ // open references to it.)
+
+ if ( xSourceLibrariesStor.is() )
+ {
+ // remove
+ const Sequence< OUString > aRemoveNames( xSourceLibrariesStor->getElementNames() );
+ for ( auto const & removeName : aRemoveNames )
+ {
+ xSourceLibrariesStor->removeElement( removeName );
+ }
+
+ // copy
+ const Sequence< OUString > aCopyNames( xTargetLibrariesStor->getElementNames() );
+ for ( auto const & copyName : aCopyNames )
+ {
+ xTargetLibrariesStor->copyElementTo( copyName, xSourceLibrariesStor, copyName );
+ }
+ }
+
+ // close and remove temp target
+ xTargetLibrariesStor->dispose();
+ i_rStorage->removeElement( sTempTargetStorName );
+ xTargetLibrariesStor.clear();
+ sTempTargetStorName.clear();
+
+ // adjust target
+ xTargetLibrariesStor = xSourceLibrariesStor;
+ xSourceLibrariesStor.clear();
+ }
+ catch( const Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ throw;
+ }
+ }
+
+ if( !mbOldInfoFormat && !maModifiable.isModified() )
+ {
+ return;
+ }
+ maModifiable.setModified( false );
+ mbOldInfoFormat = false;
+
+ // Write library container info
+ // Create sax writer
+ Reference< XWriter > xWriter = xml::sax::Writer::create(mxContext);
+
+ // Write info file
+ uno::Reference< io::XOutputStream > xOut;
+ uno::Reference< io::XStream > xInfoStream;
+ if( bStorage )
+ {
+ OUString aStreamName = maInfoFileName + "-lc.xml";
+
+ try
+ {
+ xInfoStream = xTargetLibrariesStor->openStreamElement( aStreamName, embed::ElementModes::READWRITE );
+ uno::Reference< beans::XPropertySet > xProps( xInfoStream, uno::UNO_QUERY_THROW );
+ xProps->setPropertyValue("MediaType", uno::Any( OUString( "text/xml" ) ) );
+
+ // #87671 Allow encryption
+ xProps->setPropertyValue("UseCommonStoragePasswordEncryption", uno::Any( true ) );
+
+ xOut = xInfoStream->getOutputStream();
+ }
+ catch(const uno::Exception& )
+ {
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ }
+ }
+ else
+ {
+ // Create Output stream
+ INetURLObject aLibInfoInetObj( maLibraryPath.getToken(1, ';') );
+ aLibInfoInetObj.insertName( maInfoFileName, false, INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ aLibInfoInetObj.setExtension( "xlc" );
+ OUString aLibInfoPath( aLibInfoInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE ) );
+
+ try
+ {
+ if( mxSFI->exists( aLibInfoPath ) )
+ {
+ mxSFI->kill( aLibInfoPath );
+ }
+ xOut = mxSFI->openFileWrite( aLibInfoPath );
+ }
+ catch(const Exception& )
+ {
+ xOut.clear();
+ SfxErrorContext aEc( ERRCTX_SFX_SAVEDOC, aLibInfoPath );
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ }
+
+ }
+ if( !xOut.is() )
+ {
+ SAL_WARN("basic", "couldn't open output stream");
+ return;
+ }
+
+ xWriter->setOutputStream( xOut );
+
+ try
+ {
+ xmlscript::exportLibraryContainer( xWriter, pLibArray.get() );
+ if ( bStorage )
+ {
+ uno::Reference< embed::XTransactedObject > xTransact( xTargetLibrariesStor, uno::UNO_QUERY_THROW );
+ xTransact->commit();
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ SAL_WARN("basic", "Problem during storing of libraries!");
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ }
+}
+
+
+// Methods XElementAccess
+Type SAL_CALL SfxLibraryContainer::getElementType()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ return maNameContainer->getElementType();
+}
+
+sal_Bool SfxLibraryContainer::hasElements()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ bool bRet = maNameContainer->hasElements();
+ return bRet;
+}
+
+// Methods XNameAccess
+Any SfxLibraryContainer::getByName( const OUString& aName )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ Any aRetAny = maNameContainer->getByName( aName ) ;
+ return aRetAny;
+}
+
+Sequence< OUString > SfxLibraryContainer::getElementNames()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ return maNameContainer->getElementNames();
+}
+
+sal_Bool SfxLibraryContainer::hasByName( const OUString& aName )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ return maNameContainer->hasByName( aName ) ;
+}
+
+// Methods XLibraryContainer
+Reference< XNameContainer > SAL_CALL SfxLibraryContainer::createLibrary( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pNewLib = implCreateLibrary( Name );
+ pNewLib->maLibElementFileExtension = maLibElementFileExtension;
+
+ createVariableURL( pNewLib->maUnexpandedStorageURL, Name, maInfoFileName, true );
+
+ Reference< XNameAccess > xNameAccess = static_cast< XNameAccess* >( pNewLib );
+ Any aElement;
+ aElement <<= xNameAccess;
+ maNameContainer->insertByName( Name, aElement );
+ maModifiable.setModified( true );
+ Reference< XNameContainer > xRet( xNameAccess, UNO_QUERY );
+ return xRet;
+}
+
+Reference< XNameAccess > SAL_CALL SfxLibraryContainer::createLibraryLink
+ ( const OUString& Name, const OUString& StorageURL, sal_Bool ReadOnly )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ // TODO: Check other reasons to force ReadOnly status
+ //if( !ReadOnly )
+ //{
+ //}
+
+ OUString aLibInfoFileURL;
+ OUString aLibDirURL;
+ OUString aUnexpandedStorageURL;
+ checkStorageURL( StorageURL, aLibInfoFileURL, aLibDirURL, aUnexpandedStorageURL );
+
+
+ SfxLibrary* pNewLib = implCreateLibraryLink( Name, aLibInfoFileURL, aLibDirURL, ReadOnly );
+ pNewLib->maLibElementFileExtension = maLibElementFileExtension;
+ pNewLib->maUnexpandedStorageURL = aUnexpandedStorageURL;
+ pNewLib->maOriginalStorageURL = StorageURL;
+
+ uno::Reference< embed::XStorage > xDummyStor;
+ ::xmlscript::LibDescriptor aLibDesc;
+ implLoadLibraryIndexFile( pNewLib, aLibDesc, xDummyStor, OUString() );
+ implImportLibDescriptor( pNewLib, aLibDesc );
+
+ Reference< XNameAccess > xRet = static_cast< XNameAccess* >( pNewLib );
+ Any aElement;
+ aElement <<= xRet;
+ maNameContainer->insertByName( Name, aElement );
+ maModifiable.setModified( true );
+
+ if( StorageURL.indexOf( "vnd.sun.star.expand:$UNO_USER_PACKAGES_CACHE" ) != -1 )
+ {
+ pNewLib->mbExtension = true;
+ }
+ else if( StorageURL.indexOf( "vnd.sun.star.expand:$UNO_SHARED_PACKAGES_CACHE" ) != -1
+ || StorageURL.indexOf( "vnd.sun.star.expand:$BUNDLED_EXTENSIONS" ) != -1 )
+ {
+ pNewLib->mbExtension = true;
+ pNewLib->mbReadOnly = true;
+ }
+
+ return xRet;
+}
+
+void SAL_CALL SfxLibraryContainer::removeLibrary( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ // Get and hold library before removing
+ Any aLibAny = maNameContainer->getByName( Name ) ;
+ Reference< XNameAccess > xNameAccess;
+ aLibAny >>= xNameAccess;
+ SfxLibrary* pImplLib = static_cast< SfxLibrary* >( xNameAccess.get() );
+ if( pImplLib->mbReadOnly && !pImplLib->mbLink )
+ {
+ throw IllegalArgumentException();
+ }
+ // Remove from container
+ maNameContainer->removeByName( Name );
+ maModifiable.setModified( true );
+
+ // Delete library files, but not for linked libraries
+ if( pImplLib->mbLink )
+ return;
+
+ if( mxStorage.is() )
+ {
+ return;
+ }
+ if( xNameAccess->hasElements() )
+ {
+ Sequence< OUString > aNames = pImplLib->getElementNames();
+ sal_Int32 nNameCount = aNames.getLength();
+ const OUString* pNames = aNames.getConstArray();
+ for( sal_Int32 i = 0 ; i < nNameCount ; ++i, ++pNames )
+ {
+ pImplLib->removeElementWithoutChecks( *pNames, SfxLibrary::LibraryContainerAccess() );
+ }
+ }
+
+ // Delete index file
+ createAppLibraryFolder( pImplLib, Name );
+ OUString aLibInfoPath = pImplLib->maLibInfoFileURL;
+ try
+ {
+ if( mxSFI->exists( aLibInfoPath ) )
+ {
+ mxSFI->kill( aLibInfoPath );
+ }
+ }
+ catch(const Exception& ) {}
+
+ // Delete folder if empty
+ INetURLObject aInetObj( maLibraryPath.getToken(1, ';') );
+ aInetObj.insertName( Name, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ OUString aLibDirPath = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ try
+ {
+ if( mxSFI->isFolder( aLibDirPath ) )
+ {
+ Sequence< OUString > aContentSeq = mxSFI->getFolderContents( aLibDirPath, true );
+ sal_Int32 nCount = aContentSeq.getLength();
+ if( !nCount )
+ {
+ mxSFI->kill( aLibDirPath );
+ }
+ }
+ }
+ catch(const Exception& )
+ {
+ }
+}
+
+sal_Bool SAL_CALL SfxLibraryContainer::isLibraryLoaded( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ bool bRet = pImplLib->mbLoaded;
+ return bRet;
+}
+
+
+void SAL_CALL SfxLibraryContainer::loadLibrary( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ Any aLibAny = maNameContainer->getByName( Name ) ;
+ Reference< XNameAccess > xNameAccess;
+ aLibAny >>= xNameAccess;
+ SfxLibrary* pImplLib = static_cast< SfxLibrary* >( xNameAccess.get() );
+
+ bool bLoaded = pImplLib->mbLoaded;
+ pImplLib->mbLoaded = true;
+ if( !(!bLoaded && xNameAccess->hasElements()) )
+ return;
+
+ if( pImplLib->mbPasswordProtected )
+ {
+ implLoadPasswordLibrary( pImplLib, Name );
+ return;
+ }
+
+ bool bLink = pImplLib->mbLink;
+ bool bStorage = mxStorage.is() && !bLink;
+
+ uno::Reference< embed::XStorage > xLibrariesStor;
+ uno::Reference< embed::XStorage > xLibraryStor;
+ if( bStorage )
+ {
+#if OSL_DEBUG_LEVEL > 0
+ try
+ {
+#endif
+ xLibrariesStor = mxStorage->openStorageElement( maLibrariesDir, embed::ElementModes::READ );
+ SAL_WARN_IF(
+ !xLibrariesStor.is(), "basic",
+ ("The method must either throw exception or return a"
+ " storage!"));
+ if ( !xLibrariesStor.is() )
+ {
+ throw uno::RuntimeException("null returned from openStorageElement");
+ }
+
+ xLibraryStor = xLibrariesStor->openStorageElement( Name, embed::ElementModes::READ );
+ SAL_WARN_IF(
+ !xLibraryStor.is(), "basic",
+ ("The method must either throw exception or return a"
+ " storage!"));
+ if ( !xLibrariesStor.is() )
+ {
+ throw uno::RuntimeException("null returned from openStorageElement");
+ }
+#if OSL_DEBUG_LEVEL > 0
+ }
+ catch(const uno::Exception& )
+ {
+ TOOLS_WARN_EXCEPTION(
+ "basic",
+ "couldn't open sub storage for library \"" << Name << "\"");
+ throw;
+ }
+#endif
+ }
+
+ Sequence< OUString > aNames = pImplLib->getElementNames();
+ sal_Int32 nNameCount = aNames.getLength();
+ const OUString* pNames = aNames.getConstArray();
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ OUString aFile;
+ uno::Reference< io::XInputStream > xInStream;
+
+ if( bStorage )
+ {
+ uno::Reference< io::XStream > xElementStream;
+
+ aFile = aElementName + ".xml";
+
+ try
+ {
+ xElementStream = xLibraryStor->openStreamElement( aFile, embed::ElementModes::READ );
+ }
+ catch(const uno::Exception& )
+ {}
+
+ if( !xElementStream.is() )
+ {
+ // Check for EA2 document version with wrong extensions
+ aFile = aElementName + "." + maLibElementFileExtension;
+ try
+ {
+ xElementStream = xLibraryStor->openStreamElement( aFile, embed::ElementModes::READ );
+ }
+ catch(const uno::Exception& )
+ {}
+ }
+
+ if ( xElementStream.is() )
+ {
+ xInStream = xElementStream->getInputStream();
+ }
+ if ( !xInStream.is() )
+ {
+ SAL_WARN(
+ "basic",
+ "couldn't open library element stream - attempted to"
+ " open library \"" << Name << '"');
+ throw RuntimeException("couldn't open library element stream", *this);
+ }
+ }
+ else
+ {
+ OUString aLibDirPath = pImplLib->maStorageURL;
+ INetURLObject aElementInetObj( aLibDirPath );
+ aElementInetObj.insertName( aElementName, false,
+ INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aElementInetObj.setExtension( maLibElementFileExtension );
+ aFile = aElementInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+ }
+
+ Reference< XNameContainer > xLib( pImplLib );
+ Any aAny = importLibraryElement( xLib, aElementName,
+ aFile, xInStream );
+ if( pImplLib->hasByName( aElementName ) )
+ {
+ if( aAny.hasValue() )
+ {
+ pImplLib->maNameContainer->replaceByName( aElementName, aAny );
+ }
+ }
+ else
+ {
+ pImplLib->maNameContainer->insertNoCheck(aElementName, aAny);
+ }
+ }
+ pImplLib->implSetModified( false );
+}
+
+// Methods XLibraryContainer2
+sal_Bool SAL_CALL SfxLibraryContainer::isLibraryLink( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ bool bRet = pImplLib->mbLink;
+ return bRet;
+}
+
+OUString SAL_CALL SfxLibraryContainer::getLibraryLinkURL( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ bool bLink = pImplLib->mbLink;
+ if( !bLink )
+ {
+ throw IllegalArgumentException();
+ }
+ OUString aRetStr = pImplLib->maLibInfoFileURL;
+ return aRetStr;
+}
+
+sal_Bool SAL_CALL SfxLibraryContainer::isLibraryReadOnly( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ bool bRet = pImplLib->mbReadOnly || (pImplLib->mbLink && pImplLib->mbReadOnlyLink);
+ return bRet;
+}
+
+void SAL_CALL SfxLibraryContainer::setLibraryReadOnly( const OUString& Name, sal_Bool bReadOnly )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ if( pImplLib->mbLink )
+ {
+ if( pImplLib->mbReadOnlyLink != bool(bReadOnly) )
+ {
+ pImplLib->mbReadOnlyLink = bReadOnly;
+ pImplLib->implSetModified( true );
+ maModifiable.setModified( true );
+ }
+ }
+ else
+ {
+ if( pImplLib->mbReadOnly != bool(bReadOnly) )
+ {
+ pImplLib->mbReadOnly = bReadOnly;
+ pImplLib->implSetModified( true );
+ }
+ }
+}
+
+void SAL_CALL SfxLibraryContainer::renameLibrary( const OUString& Name, const OUString& NewName )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ if( maNameContainer->hasByName( NewName ) )
+ {
+ throw ElementExistException();
+ }
+ // Get and hold library before removing
+ Any aLibAny = maNameContainer->getByName( Name ) ;
+
+ // #i24094 Maybe lib is not loaded!
+ Reference< XNameAccess > xNameAccess;
+ aLibAny >>= xNameAccess;
+ SfxLibrary* pImplLib = static_cast< SfxLibrary* >( xNameAccess.get() );
+ if( pImplLib->mbPasswordProtected && !pImplLib->mbPasswordVerified )
+ {
+ return; // Lib with unverified password cannot be renamed
+ }
+ loadLibrary( Name );
+
+ // Remove from container
+ maNameContainer->removeByName( Name );
+ maModifiable.setModified( true );
+
+ // Rename library folder, but not for linked libraries
+ bool bMovedSuccessful = true;
+
+ // Rename files
+ bool bStorage = mxStorage.is();
+ if( !bStorage && !pImplLib->mbLink )
+ {
+ bMovedSuccessful = false;
+
+ OUString aLibDirPath = pImplLib->maStorageURL;
+
+ INetURLObject aDestInetObj( maLibraryPath.getToken(1, ';'));
+ aDestInetObj.insertName( NewName, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ OUString aDestDirPath = aDestInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ // Store new URL
+ OUString aLibInfoFileURL = pImplLib->maLibInfoFileURL;
+ checkStorageURL( aDestDirPath, pImplLib->maLibInfoFileURL, pImplLib->maStorageURL,
+ pImplLib->maUnexpandedStorageURL );
+
+ try
+ {
+ if( mxSFI->isFolder( aLibDirPath ) )
+ {
+ if( !mxSFI->isFolder( aDestDirPath ) )
+ {
+ mxSFI->createFolder( aDestDirPath );
+ }
+ // Move index file
+ try
+ {
+ if( mxSFI->exists( pImplLib->maLibInfoFileURL ) )
+ {
+ mxSFI->kill( pImplLib->maLibInfoFileURL );
+ }
+ mxSFI->move( aLibInfoFileURL, pImplLib->maLibInfoFileURL );
+ }
+ catch(const Exception& )
+ {
+ }
+
+ Sequence< OUString > aElementNames = xNameAccess->getElementNames();
+ sal_Int32 nNameCount = aElementNames.getLength();
+ const OUString* pNames = aElementNames.getConstArray();
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ INetURLObject aElementInetObj( aLibDirPath );
+ aElementInetObj.insertName( aElementName, false,
+ INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ aElementInetObj.setExtension( maLibElementFileExtension );
+ OUString aElementPath( aElementInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE ) );
+
+ INetURLObject aElementDestInetObj( aDestDirPath );
+ aElementDestInetObj.insertName( aElementName, false,
+ INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aElementDestInetObj.setExtension( maLibElementFileExtension );
+ OUString aDestElementPath( aElementDestInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE ) );
+
+ try
+ {
+ if( mxSFI->exists( aDestElementPath ) )
+ {
+ mxSFI->kill( aDestElementPath );
+ }
+ mxSFI->move( aElementPath, aDestElementPath );
+ }
+ catch(const Exception& )
+ {
+ }
+ }
+ pImplLib->storeResourcesAsURL( aDestDirPath, NewName );
+
+ // Delete folder if empty
+ Sequence< OUString > aContentSeq = mxSFI->getFolderContents( aLibDirPath, true );
+ sal_Int32 nCount = aContentSeq.getLength();
+ if( !nCount )
+ {
+ mxSFI->kill( aLibDirPath );
+ }
+
+ bMovedSuccessful = true;
+ pImplLib->implSetModified( true );
+ }
+ }
+ catch(const Exception& )
+ {
+ // Restore old library
+ maNameContainer->insertByName( Name, aLibAny ) ;
+ }
+ }
+
+ if( bStorage && !pImplLib->mbLink )
+ {
+ pImplLib->implSetModified( true );
+ }
+ if( bMovedSuccessful )
+ {
+ maNameContainer->insertByName( NewName, aLibAny ) ;
+ }
+}
+
+
+// Methods XInitialization
+void SAL_CALL SfxLibraryContainer::initialize( const Sequence< Any >& _rArguments )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ sal_Int32 nArgCount = _rArguments.getLength();
+ if ( nArgCount == 1 )
+ {
+ OUString sInitialDocumentURL;
+ Reference< XStorageBasedDocument > xDocument;
+ if ( _rArguments[0] >>= sInitialDocumentURL )
+ {
+ init( sInitialDocumentURL, nullptr );
+ return;
+ }
+
+ if ( _rArguments[0] >>= xDocument )
+ {
+ initializeFromDocument( xDocument );
+ return;
+ }
+ }
+
+ throw IllegalArgumentException();
+}
+
+void SfxLibraryContainer::initializeFromDocument( const Reference< XStorageBasedDocument >& _rxDocument )
+{
+ // check whether this is a valid OfficeDocument, and obtain the document's root storage
+ Reference< XStorage > xDocStorage;
+ try
+ {
+ Reference< XServiceInfo > xSI( _rxDocument, UNO_QUERY_THROW );
+ if ( xSI->supportsService("com.sun.star.document.OfficeDocument"))
+ {
+ xDocStorage.set( _rxDocument->getDocumentStorage(), UNO_SET_THROW );
+ }
+ Reference< XModel > xDocument( _rxDocument, UNO_QUERY_THROW );
+ Reference< XComponent > xDocComponent( _rxDocument, UNO_QUERY_THROW );
+
+ mxOwnerDocument = xDocument;
+ startComponentListening( xDocComponent );
+ }
+ catch( const Exception& ) { }
+
+ if ( !xDocStorage.is() )
+ {
+ throw IllegalArgumentException();
+ }
+ init( OUString(), xDocStorage );
+}
+
+// OEventListenerAdapter
+void SfxLibraryContainer::_disposing( const EventObject& _rSource )
+{
+#if OSL_DEBUG_LEVEL > 0
+ Reference< XModel > xDocument( mxOwnerDocument.get(), UNO_QUERY );
+ SAL_WARN_IF(
+ xDocument != _rSource.Source || !xDocument.is(), "basic",
+ "SfxLibraryContainer::_disposing: where does this come from?");
+#else
+ (void)_rSource;
+#endif
+ dispose();
+}
+
+// OComponentHelper
+void SAL_CALL SfxLibraryContainer::disposing()
+{
+ Reference< XModel > xModel = mxOwnerDocument;
+ EventObject aEvent( xModel.get() );
+ maVBAScriptListeners.disposing( aEvent );
+ stopAllComponentListening();
+ mxOwnerDocument.clear();
+}
+
+// Methods XLibraryContainerPassword
+sal_Bool SAL_CALL SfxLibraryContainer::isLibraryPasswordProtected( const OUString& )
+{
+ return false;
+}
+
+sal_Bool SAL_CALL SfxLibraryContainer::isLibraryPasswordVerified( const OUString& )
+{
+ throw IllegalArgumentException();
+}
+
+sal_Bool SAL_CALL SfxLibraryContainer::verifyLibraryPassword( const OUString&, const OUString& )
+{
+ throw IllegalArgumentException();
+}
+
+void SAL_CALL SfxLibraryContainer::changeLibraryPassword(const OUString&, const OUString&, const OUString& )
+{
+ throw IllegalArgumentException();
+}
+
+// Methods XContainer
+void SAL_CALL SfxLibraryContainer::addContainerListener( const Reference< XContainerListener >& xListener )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ maNameContainer->setEventSource( static_cast< XInterface* >( static_cast<OWeakObject*>(this) ) );
+ maNameContainer->addContainerListener( xListener );
+}
+
+void SAL_CALL SfxLibraryContainer::removeContainerListener( const Reference< XContainerListener >& xListener )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ maNameContainer->removeContainerListener( xListener );
+}
+
+// Methods XLibraryContainerExport
+void SAL_CALL SfxLibraryContainer::exportLibrary( const OUString& Name, const OUString& URL,
+ const Reference< XInteractionHandler >& Handler )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+
+ Reference< XSimpleFileAccess3 > xToUseSFI;
+ if( Handler.is() )
+ {
+ xToUseSFI = ucb::SimpleFileAccess::create( mxContext );
+ xToUseSFI->setInteractionHandler( Handler );
+ }
+
+ // Maybe lib is not loaded?!
+ loadLibrary( Name );
+
+ uno::Reference< css::embed::XStorage > xDummyStor;
+ if( pImplLib->mbPasswordProtected )
+ {
+ implStorePasswordLibrary( pImplLib, Name, xDummyStor, URL, xToUseSFI, Handler );
+ }
+ else
+ {
+ implStoreLibrary( pImplLib, Name, xDummyStor, URL, xToUseSFI, Handler );
+ }
+ ::xmlscript::LibDescriptor aLibDesc;
+ aLibDesc.aName = Name;
+ aLibDesc.bLink = false; // Link status gets lost?
+ aLibDesc.bReadOnly = pImplLib->mbReadOnly;
+ aLibDesc.bPreload = false; // Preload status gets lost?
+ aLibDesc.bPasswordProtected = pImplLib->mbPasswordProtected;
+ aLibDesc.aElementNames = pImplLib->getElementNames();
+
+ implStoreLibraryIndexFile( pImplLib, aLibDesc, xDummyStor, URL, xToUseSFI );
+}
+
+OUString SfxLibraryContainer::expand_url( const OUString& url )
+{
+ if (url.startsWithIgnoreAsciiCase( "vnd.sun.star.expand:" ))
+ {
+ return comphelper::getExpandedUri(mxContext, url);
+ }
+ else if( mxStringSubstitution.is() )
+ {
+ OUString ret( mxStringSubstitution->substituteVariables( url, false ) );
+ return ret;
+ }
+ else
+ {
+ return url;
+ }
+}
+
+//XLibraryContainer3
+OUString SAL_CALL SfxLibraryContainer::getOriginalLibraryLinkURL( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ bool bLink = pImplLib->mbLink;
+ if( !bLink )
+ {
+ throw IllegalArgumentException();
+ }
+ OUString aRetStr = pImplLib->maOriginalStorageURL;
+ return aRetStr;
+}
+
+
+// XVBACompatibility
+sal_Bool SAL_CALL SfxLibraryContainer::getVBACompatibilityMode()
+{
+ return mbVBACompat;
+}
+
+void SAL_CALL SfxLibraryContainer::setVBACompatibilityMode( sal_Bool _vbacompatmodeon )
+{
+ /* The member variable mbVBACompat must be set first, the following call
+ to getBasicManager() may call getVBACompatibilityMode() which returns
+ this value. */
+ mbVBACompat = _vbacompatmodeon;
+ BasicManager* pBasMgr = getBasicManager();
+ if( !pBasMgr )
+ return;
+
+ // get the standard library
+ OUString aLibName = pBasMgr->GetName();
+ if ( aLibName.isEmpty())
+ {
+ aLibName = "Standard";
+ }
+ if( StarBASIC* pBasic = pBasMgr->GetLib( aLibName ) )
+ {
+ pBasic->SetVBAEnabled( _vbacompatmodeon );
+ }
+ /* If in VBA compatibility mode, force creation of the VBA Globals
+ object. Each application will create an instance of its own
+ implementation and store it in its Basic manager. Implementations
+ will do all necessary additional initialization, such as
+ registering the global "This***Doc" UNO constant, starting the
+ document events processor etc.
+ */
+ if( mbVBACompat ) try
+ {
+ Reference< XModel > xModel( mxOwnerDocument ); // weak-ref -> ref
+ Reference< XMultiServiceFactory > xFactory( xModel, UNO_QUERY_THROW );
+ xFactory->createInstance("ooo.vba.VBAGlobals");
+ }
+ catch(const Exception& )
+ {
+ }
+}
+
+void SAL_CALL SfxLibraryContainer::setProjectName( const OUString& _projectname )
+{
+ msProjectName = _projectname;
+ BasicManager* pBasMgr = getBasicManager();
+ // Temporary HACK
+ // Some parts of the VBA handling ( e.g. in core basic )
+ // code expect the name of the VBA project to be set as the name of
+ // the basic manager. Provide fail back here.
+ if( pBasMgr )
+ {
+ pBasMgr->SetName( msProjectName );
+ }
+}
+
+sal_Int32 SAL_CALL SfxLibraryContainer::getRunningVBAScripts()
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ return mnRunningVBAScripts;
+}
+
+void SAL_CALL SfxLibraryContainer::addVBAScriptListener( const Reference< vba::XVBAScriptListener >& rxListener )
+{
+ maVBAScriptListeners.addTypedListener( rxListener );
+}
+
+void SAL_CALL SfxLibraryContainer::removeVBAScriptListener( const Reference< vba::XVBAScriptListener >& rxListener )
+{
+ maVBAScriptListeners.removeTypedListener( rxListener );
+}
+
+void SAL_CALL SfxLibraryContainer::broadcastVBAScriptEvent( sal_Int32 nIdentifier, const OUString& rModuleName )
+{
+ // own lock for accessing the number of running scripts
+ enterMethod();
+ switch( nIdentifier )
+ {
+ case vba::VBAScriptEventId::SCRIPT_STARTED:
+ ++mnRunningVBAScripts;
+ break;
+ case vba::VBAScriptEventId::SCRIPT_STOPPED:
+ --mnRunningVBAScripts;
+ break;
+ }
+ leaveMethod();
+
+ Reference< XModel > xModel = mxOwnerDocument; // weak-ref -> ref
+ vba::VBAScriptEvent aEvent( Reference<XInterface>(xModel, UNO_QUERY), nIdentifier, rModuleName );
+ maVBAScriptListeners.notify( aEvent );
+}
+
+// Methods XServiceInfo
+sal_Bool SAL_CALL SfxLibraryContainer::supportsService( const OUString& _rServiceName )
+{
+ return cppu::supportsService(this, _rServiceName);
+}
+
+// Implementation class SfxLibrary
+
+// Ctor
+SfxLibrary::SfxLibrary( ModifiableHelper& _rModifiable, const Type& aType,
+ const Reference< XSimpleFileAccess3 >& xSFI )
+ : OComponentHelper( m_aMutex )
+ , mxSFI( xSFI )
+ , mrModifiable( _rModifiable )
+ , maNameContainer( new NameContainer(aType) )
+ , mbLoaded( true )
+ , mbIsModified( true )
+ , mbInitialised( false )
+ , mbLink( false )
+ , mbReadOnly( false )
+ , mbReadOnlyLink( false )
+ , mbPreload( false )
+ , mbPasswordProtected( false )
+ , mbPasswordVerified( false )
+ , mbDoc50Password( false )
+ , mbSharedIndexFile( false )
+ , mbExtension( false )
+{
+}
+
+SfxLibrary::SfxLibrary( ModifiableHelper& _rModifiable, const Type& aType,
+ const Reference< XSimpleFileAccess3 >& xSFI,
+ const OUString& aLibInfoFileURL, const OUString& aStorageURL, bool ReadOnly )
+ : OComponentHelper( m_aMutex )
+ , mxSFI( xSFI )
+ , mrModifiable( _rModifiable )
+ , maNameContainer( new NameContainer(aType) )
+ , mbLoaded( false )
+ , mbIsModified( true )
+ , mbInitialised( false )
+ , maLibInfoFileURL( aLibInfoFileURL )
+ , maStorageURL( aStorageURL )
+ , mbLink( true )
+ , mbReadOnly( false )
+ , mbReadOnlyLink( ReadOnly )
+ , mbPreload( false )
+ , mbPasswordProtected( false )
+ , mbPasswordVerified( false )
+ , mbDoc50Password( false )
+ , mbSharedIndexFile( false )
+ , mbExtension( false )
+{
+}
+
+bool SfxLibrary::isLoadedStorable()
+{
+ return mbLoaded && (!mbPasswordProtected || mbPasswordVerified);
+}
+
+void SfxLibrary::implSetModified( bool _bIsModified )
+{
+ if ( mbIsModified == _bIsModified )
+ {
+ return;
+ }
+ mbIsModified = _bIsModified;
+ if ( mbIsModified )
+ {
+ mrModifiable.setModified( true );
+ }
+}
+
+// Methods XInterface
+Any SAL_CALL SfxLibrary::queryInterface( const Type& rType )
+{
+ Any aRet =
+ ::cppu::queryInterface(
+ rType,
+ static_cast< XContainer * >( this ),
+ static_cast< XNameContainer * >( this ),
+ static_cast< XNameAccess * >( this ),
+ static_cast< XElementAccess * >( this ),
+ static_cast< XChangesNotifier * >( this ) );
+ if( !aRet.hasValue() )
+ {
+ aRet = OComponentHelper::queryInterface( rType );
+ }
+ return aRet;
+}
+
+// Methods XElementAccess
+Type SfxLibrary::getElementType()
+{
+ return maNameContainer->getElementType();
+}
+
+sal_Bool SfxLibrary::hasElements()
+{
+ bool bRet = maNameContainer->hasElements();
+ return bRet;
+}
+
+// Methods XNameAccess
+Any SfxLibrary::getByName( const OUString& aName )
+{
+ impl_checkLoaded();
+
+ Any aRetAny = maNameContainer->getByName( aName ) ;
+ return aRetAny;
+}
+
+Sequence< OUString > SfxLibrary::getElementNames()
+{
+ return maNameContainer->getElementNames();
+}
+
+sal_Bool SfxLibrary::hasByName( const OUString& aName )
+{
+ bool bRet = maNameContainer->hasByName( aName );
+ return bRet;
+}
+
+void SfxLibrary::impl_checkReadOnly()
+{
+ if( mbReadOnly || (mbLink && mbReadOnlyLink) )
+ {
+ throw IllegalArgumentException(
+ "Library is readonly.",
+ // TODO: resource
+ *this, 0
+ );
+ }
+}
+
+void SfxLibrary::impl_checkLoaded()
+{
+ if ( !mbLoaded )
+ {
+ throw WrappedTargetException(
+ OUString(),
+ *this,
+ Any( LibraryNotLoadedException(
+ OUString(),
+ *this
+ ) )
+ );
+ }
+}
+
+// Methods XNameReplace
+void SfxLibrary::replaceByName( const OUString& aName, const Any& aElement )
+{
+ impl_checkReadOnly();
+ impl_checkLoaded();
+
+ SAL_WARN_IF(
+ !isLibraryElementValid(aElement), "basic",
+ "SfxLibrary::replaceByName: replacing element is invalid!");
+
+ maNameContainer->replaceByName( aName, aElement );
+ implSetModified( true );
+}
+
+
+// Methods XNameContainer
+void SfxLibrary::insertByName( const OUString& aName, const Any& aElement )
+{
+ impl_checkReadOnly();
+ impl_checkLoaded();
+
+ SAL_WARN_IF(
+ !isLibraryElementValid(aElement), "basic",
+ "SfxLibrary::insertByName: to-be-inserted element is invalid!");
+
+ maNameContainer->insertByName( aName, aElement );
+ implSetModified( true );
+}
+
+void SfxLibrary::impl_removeWithoutChecks( const OUString& _rElementName )
+{
+ maNameContainer->removeByName( _rElementName );
+ implSetModified( true );
+
+ // Remove element file
+ if( maStorageURL.isEmpty() )
+ return;
+
+ INetURLObject aElementInetObj( maStorageURL );
+ aElementInetObj.insertName( _rElementName, false,
+ INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aElementInetObj.setExtension( maLibElementFileExtension );
+ OUString aFile = aElementInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ try
+ {
+ if( mxSFI->exists( aFile ) )
+ {
+ mxSFI->kill( aFile );
+ }
+ }
+ catch(const Exception& )
+ {
+ DBG_UNHANDLED_EXCEPTION("basic");
+ }
+}
+
+void SfxLibrary::removeByName( const OUString& Name )
+{
+ impl_checkReadOnly();
+ impl_checkLoaded();
+ impl_removeWithoutChecks( Name );
+}
+
+// XTypeProvider
+Sequence< Type > SfxLibrary::getTypes()
+{
+ static OTypeCollection ourTypes_NameContainer(
+ cppu::UnoType<XNameContainer>::get(),
+ cppu::UnoType<XContainer>::get(),
+ cppu::UnoType<XChangesNotifier>::get(),
+ OComponentHelper::getTypes() );
+
+ return ourTypes_NameContainer.getTypes();
+}
+
+
+Sequence< sal_Int8 > SfxLibrary::getImplementationId()
+{
+ return css::uno::Sequence<sal_Int8>();
+}
+
+// Methods XContainer
+void SAL_CALL SfxLibrary::addContainerListener( const Reference< XContainerListener >& xListener )
+{
+ maNameContainer->setEventSource( static_cast< XInterface* >( static_cast<OWeakObject*>(this) ) );
+ maNameContainer->addContainerListener( xListener );
+}
+
+void SAL_CALL SfxLibrary::removeContainerListener( const Reference< XContainerListener >& xListener )
+{
+ maNameContainer->removeContainerListener( xListener );
+}
+
+// Methods XChangesNotifier
+void SAL_CALL SfxLibrary::addChangesListener( const Reference< XChangesListener >& xListener )
+{
+ maNameContainer->setEventSource( static_cast< XInterface* >( static_cast<OWeakObject*>(this) ) );
+ maNameContainer->addChangesListener( xListener );
+}
+
+void SAL_CALL SfxLibrary::removeChangesListener( const Reference< XChangesListener >& xListener )
+{
+ maNameContainer->removeChangesListener( xListener );
+}
+
+
+// Implementation class ScriptExtensionIterator
+
+#define sBasicLibMediaType "application/vnd.sun.star.basic-library"
+#define sDialogLibMediaType "application/vnd.sun.star.dialog-library"
+
+ScriptExtensionIterator::ScriptExtensionIterator()
+ : m_xContext( comphelper::getProcessComponentContext() )
+ , m_eState( USER_EXTENSIONS )
+ , m_bUserPackagesLoaded( false )
+ , m_bSharedPackagesLoaded( false )
+ , m_bBundledPackagesLoaded( false )
+ , m_iUserPackage( 0 )
+ , m_iSharedPackage( 0 )
+ , m_iBundledPackage( 0 )
+ , m_pScriptSubPackageIterator( nullptr )
+{}
+
+OUString ScriptExtensionIterator::nextBasicOrDialogLibrary( bool& rbPureDialogLib )
+{
+ OUString aRetLib;
+
+ while( aRetLib.isEmpty() && m_eState != END_REACHED )
+ {
+ switch( m_eState )
+ {
+ case USER_EXTENSIONS:
+ {
+ Reference< deployment::XPackage > xScriptPackage =
+ implGetNextUserScriptPackage( rbPureDialogLib );
+ if( !xScriptPackage.is() )
+ {
+ break;
+ }
+ aRetLib = xScriptPackage->getURL();
+ break;
+ }
+
+ case SHARED_EXTENSIONS:
+ {
+ Reference< deployment::XPackage > xScriptPackage =
+ implGetNextSharedScriptPackage( rbPureDialogLib );
+ if( !xScriptPackage.is() )
+ {
+ break;
+ }
+ aRetLib = xScriptPackage->getURL();
+ break;
+ }
+ case BUNDLED_EXTENSIONS:
+ {
+ Reference< deployment::XPackage > xScriptPackage =
+ implGetNextBundledScriptPackage( rbPureDialogLib );
+ if( !xScriptPackage.is() )
+ {
+ break;
+ }
+ aRetLib = xScriptPackage->getURL();
+ break;
+ }
+ case END_REACHED:
+ SAL_WARN(
+ "basic",
+ ("ScriptExtensionIterator::nextBasicOrDialogLibrary():"
+ " Invalid case END_REACHED"));
+ break;
+ }
+ }
+
+ return aRetLib;
+}
+
+ScriptSubPackageIterator::ScriptSubPackageIterator( Reference< deployment::XPackage > const & xMainPackage )
+ : m_xMainPackage( xMainPackage )
+ , m_bIsValid( false )
+ , m_bIsBundle( false )
+ , m_nSubPkgCount( 0 )
+ , m_iNextSubPkg( 0 )
+{
+ if( !m_xMainPackage.is() )
+ {
+ return;
+ }
+ // Check if parent package is registered
+ beans::Optional< beans::Ambiguous<sal_Bool> > option( m_xMainPackage->isRegistered
+ ( Reference<task::XAbortChannel>(), Reference<ucb::XCommandEnvironment>() ) );
+ bool bRegistered = false;
+ if( option.IsPresent )
+ {
+ beans::Ambiguous<sal_Bool> const & reg = option.Value;
+ if( !reg.IsAmbiguous && reg.Value )
+ {
+ bRegistered = true;
+ }
+ }
+ if( bRegistered )
+ {
+ m_bIsValid = true;
+ if( m_xMainPackage->isBundle() )
+ {
+ m_bIsBundle = true;
+ m_aSubPkgSeq = m_xMainPackage->getBundle( Reference<task::XAbortChannel>(),
+ Reference<ucb::XCommandEnvironment>() );
+ m_nSubPkgCount = m_aSubPkgSeq.getLength();
+ }
+ }
+}
+
+Reference< deployment::XPackage > ScriptSubPackageIterator::getNextScriptSubPackage( bool& rbPureDialogLib )
+{
+ rbPureDialogLib = false;
+
+ Reference< deployment::XPackage > xScriptPackage;
+ if( !m_bIsValid )
+ {
+ return xScriptPackage;
+ }
+ if( m_bIsBundle )
+ {
+ const Reference< deployment::XPackage >* pSeq = m_aSubPkgSeq.getConstArray();
+ sal_Int32 iPkg;
+ for( iPkg = m_iNextSubPkg ; iPkg < m_nSubPkgCount ; ++iPkg )
+ {
+ const Reference< deployment::XPackage > xSubPkg = pSeq[ iPkg ];
+ xScriptPackage = implDetectScriptPackage( xSubPkg, rbPureDialogLib );
+ if( xScriptPackage.is() )
+ {
+ break;
+ }
+ }
+ m_iNextSubPkg = iPkg + 1;
+ }
+ else
+ {
+ xScriptPackage = implDetectScriptPackage( m_xMainPackage, rbPureDialogLib );
+ m_bIsValid = false; // No more script packages
+ }
+
+ return xScriptPackage;
+}
+
+Reference< deployment::XPackage > ScriptSubPackageIterator::implDetectScriptPackage ( const Reference< deployment::XPackage >& rPackage,
+ bool& rbPureDialogLib )
+{
+ Reference< deployment::XPackage > xScriptPackage;
+
+ if( rPackage.is() )
+ {
+ const Reference< deployment::XPackageTypeInfo > xPackageTypeInfo = rPackage->getPackageType();
+ OUString aMediaType = xPackageTypeInfo->getMediaType();
+ if ( aMediaType == sBasicLibMediaType )
+ {
+ xScriptPackage = rPackage;
+ }
+ else if ( aMediaType == sDialogLibMediaType )
+ {
+ rbPureDialogLib = true;
+ xScriptPackage = rPackage;
+ }
+ }
+
+ return xScriptPackage;
+}
+
+Reference< deployment::XPackage > ScriptExtensionIterator::implGetNextUserScriptPackage( bool& rbPureDialogLib )
+{
+ Reference< deployment::XPackage > xScriptPackage;
+
+ if( !m_bUserPackagesLoaded )
+ {
+ try
+ {
+ Reference< XExtensionManager > xManager = ExtensionManager::get( m_xContext );
+ m_aUserPackagesSeq = xManager->getDeployedExtensions("user",
+ Reference< task::XAbortChannel >(),
+ Reference< ucb::XCommandEnvironment >() );
+ }
+ catch(const css::uno::DeploymentException& )
+ {
+ // Special Office installations may not contain deployment code
+ m_eState = END_REACHED;
+ return xScriptPackage;
+ }
+
+ m_bUserPackagesLoaded = true;
+ }
+
+ if( m_iUserPackage == m_aUserPackagesSeq.getLength() )
+ {
+ m_eState = SHARED_EXTENSIONS; // Later: SHARED_MODULE
+ }
+ else
+ {
+ if( m_pScriptSubPackageIterator == nullptr )
+ {
+ const Reference< deployment::XPackage >* pUserPackages = m_aUserPackagesSeq.getConstArray();
+ Reference< deployment::XPackage > xPackage = pUserPackages[ m_iUserPackage ];
+ SAL_WARN_IF(
+ !xPackage.is(), "basic",
+ ("ScriptExtensionIterator::implGetNextUserScriptPackage():"
+ " Invalid package"));
+ m_pScriptSubPackageIterator = new ScriptSubPackageIterator( xPackage );
+ }
+
+ xScriptPackage = m_pScriptSubPackageIterator->getNextScriptSubPackage( rbPureDialogLib );
+ if( !xScriptPackage.is() )
+ {
+ delete m_pScriptSubPackageIterator;
+ m_pScriptSubPackageIterator = nullptr;
+ m_iUserPackage++;
+ }
+ }
+
+ return xScriptPackage;
+}
+
+Reference< deployment::XPackage > ScriptExtensionIterator::implGetNextSharedScriptPackage( bool& rbPureDialogLib )
+{
+ Reference< deployment::XPackage > xScriptPackage;
+
+ if( !m_bSharedPackagesLoaded )
+ {
+ try
+ {
+ Reference< XExtensionManager > xSharedManager = ExtensionManager::get( m_xContext );
+ m_aSharedPackagesSeq = xSharedManager->getDeployedExtensions("shared",
+ Reference< task::XAbortChannel >(),
+ Reference< ucb::XCommandEnvironment >() );
+ }
+ catch(const css::uno::DeploymentException& )
+ {
+ // Special Office installations may not contain deployment code
+ return xScriptPackage;
+ }
+
+ m_bSharedPackagesLoaded = true;
+ }
+
+ if( m_iSharedPackage == m_aSharedPackagesSeq.getLength() )
+ {
+ m_eState = BUNDLED_EXTENSIONS;
+ }
+ else
+ {
+ if( m_pScriptSubPackageIterator == nullptr )
+ {
+ const Reference< deployment::XPackage >* pSharedPackages = m_aSharedPackagesSeq.getConstArray();
+ Reference< deployment::XPackage > xPackage = pSharedPackages[ m_iSharedPackage ];
+ SAL_WARN_IF(
+ !xPackage.is(), "basic",
+ ("ScriptExtensionIterator::implGetNextSharedScriptPackage():"
+ " Invalid package"));
+ m_pScriptSubPackageIterator = new ScriptSubPackageIterator( xPackage );
+ }
+
+ xScriptPackage = m_pScriptSubPackageIterator->getNextScriptSubPackage( rbPureDialogLib );
+ if( !xScriptPackage.is() )
+ {
+ delete m_pScriptSubPackageIterator;
+ m_pScriptSubPackageIterator = nullptr;
+ m_iSharedPackage++;
+ }
+ }
+
+ return xScriptPackage;
+}
+
+Reference< deployment::XPackage > ScriptExtensionIterator::implGetNextBundledScriptPackage( bool& rbPureDialogLib )
+{
+ Reference< deployment::XPackage > xScriptPackage;
+
+ if( !m_bBundledPackagesLoaded )
+ {
+ try
+ {
+ Reference< XExtensionManager > xManager = ExtensionManager::get( m_xContext );
+ m_aBundledPackagesSeq = xManager->getDeployedExtensions("bundled",
+ Reference< task::XAbortChannel >(),
+ Reference< ucb::XCommandEnvironment >() );
+ }
+ catch(const css::uno::DeploymentException& )
+ {
+ // Special Office installations may not contain deployment code
+ return xScriptPackage;
+ }
+
+ m_bBundledPackagesLoaded = true;
+ }
+
+ if( m_iBundledPackage == m_aBundledPackagesSeq.getLength() )
+ {
+ m_eState = END_REACHED;
+ }
+ else
+ {
+ if( m_pScriptSubPackageIterator == nullptr )
+ {
+ const Reference< deployment::XPackage >* pBundledPackages = m_aBundledPackagesSeq.getConstArray();
+ Reference< deployment::XPackage > xPackage = pBundledPackages[ m_iBundledPackage ];
+ SAL_WARN_IF(
+ !xPackage.is(), "basic",
+ ("ScriptExtensionIterator::implGetNextBundledScriptPackage():"
+ " Invalid package"));
+ m_pScriptSubPackageIterator = new ScriptSubPackageIterator( xPackage );
+ }
+
+ xScriptPackage = m_pScriptSubPackageIterator->getNextScriptSubPackage( rbPureDialogLib );
+ if( !xScriptPackage.is() )
+ {
+ delete m_pScriptSubPackageIterator;
+ m_pScriptSubPackageIterator = nullptr;
+ m_iBundledPackage++;
+ }
+ }
+
+ return xScriptPackage;
+}
+
+} // namespace basic
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/source/uno/scriptcont.cxx b/basic/source/uno/scriptcont.cxx
new file mode 100644
index 000000000..c9b8fdeb0
--- /dev/null
+++ b/basic/source/uno/scriptcont.cxx
@@ -0,0 +1,1230 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ */
+
+#include <scriptcont.hxx>
+#include <com/sun/star/packages/WrongPasswordException.hpp>
+#include <com/sun/star/xml/sax/Parser.hpp>
+#include <com/sun/star/xml/sax/InputSource.hpp>
+#include <com/sun/star/xml/sax/Writer.hpp>
+#include <com/sun/star/io/XTruncate.hpp>
+#include <com/sun/star/embed/ElementModes.hpp>
+#include <com/sun/star/embed/XEncryptionProtectedSource.hpp>
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/embed/XTransactedObject.hpp>
+#include <com/sun/star/task/ErrorCodeIOException.hpp>
+#include <com/sun/star/script/ModuleType.hpp>
+#include <com/sun/star/lang/XMultiServiceFactory.hpp>
+#include <comphelper/storagehelper.hxx>
+#include <unotools/ucbstreamhelper.hxx>
+#include <sal/log.hxx>
+#include <sot/storage.hxx>
+
+// For password functionality
+#include <tools/urlobj.hxx>
+
+
+#include <svtools/sfxecode.hxx>
+#include <svtools/ehdl.hxx>
+#include <basic/basmgr.hxx>
+#include <basic/sbmod.hxx>
+#include <basic/modsizeexceeded.hxx>
+#include <xmlscript/xmlmod_imexp.hxx>
+#include <com/sun/star/util/VetoException.hpp>
+#include <memory>
+
+namespace basic
+{
+
+using namespace com::sun::star::document;
+using namespace com::sun::star::container;
+using namespace com::sun::star::io;
+using namespace com::sun::star::uno;
+using namespace com::sun::star::ucb;
+using namespace com::sun::star::lang;
+using namespace com::sun::star::script;
+using namespace com::sun::star::xml::sax;
+using namespace com::sun::star;
+using namespace cppu;
+using namespace osl;
+
+
+// Implementation class SfxScriptLibraryContainer
+
+const char* SfxScriptLibraryContainer::getInfoFileName() const { return "script"; }
+const char* SfxScriptLibraryContainer::getOldInfoFileName() const { return "script"; }
+const char* SfxScriptLibraryContainer::getLibElementFileExtension() const { return "xba"; }
+const char* SfxScriptLibraryContainer::getLibrariesDir() const { return "Basic"; }
+
+// OldBasicPassword interface
+void SfxScriptLibraryContainer::setLibraryPassword( const OUString& rLibraryName, const OUString& rPassword )
+{
+ try
+ {
+ SfxLibrary* pImplLib = getImplLib( rLibraryName );
+ if( !rPassword.isEmpty() )
+ {
+ pImplLib->mbDoc50Password = true;
+ pImplLib->mbPasswordProtected = true;
+ pImplLib->maPassword = rPassword;
+ SfxScriptLibrary *const pSL(dynamic_cast<SfxScriptLibrary *>(pImplLib));
+ if (pSL && pSL->mbLoaded)
+ {
+ pSL->mbLoadedSource = true; // must store source code now!
+ }
+ }
+ }
+ catch(const NoSuchElementException& ) {}
+}
+
+// Ctor for service
+SfxScriptLibraryContainer::SfxScriptLibraryContainer()
+{
+ // all initialisation has to be done
+ // by calling XInitialization::initialize
+}
+
+SfxScriptLibraryContainer::SfxScriptLibraryContainer( const uno::Reference< embed::XStorage >& xStorage )
+{
+ init( OUString(), xStorage );
+}
+
+// Methods to get library instances of the correct type
+SfxLibrary* SfxScriptLibraryContainer::implCreateLibrary( const OUString& )
+{
+ SfxLibrary* pRet = new SfxScriptLibrary( maModifiable, mxSFI );
+ return pRet;
+}
+
+SfxLibrary* SfxScriptLibraryContainer::implCreateLibraryLink( const OUString&,
+ const OUString& aLibInfoFileURL,
+ const OUString& StorageURL,
+ bool ReadOnly )
+{
+ SfxLibrary* pRet = new SfxScriptLibrary( maModifiable, mxSFI,
+ aLibInfoFileURL, StorageURL, ReadOnly );
+ return pRet;
+}
+
+Any SfxScriptLibraryContainer::createEmptyLibraryElement()
+{
+ Any aRetAny;
+ aRetAny <<= OUString();
+ return aRetAny;
+}
+
+bool SfxScriptLibraryContainer::isLibraryElementValid(const Any& rElement) const
+{
+ return SfxScriptLibrary::containsValidModule(rElement);
+}
+
+void SfxScriptLibraryContainer::writeLibraryElement( const Reference < XNameContainer >& xLib,
+ const OUString& aElementName,
+ const Reference< XOutputStream >& xOutput)
+{
+ // Create sax writer
+ Reference< XWriter > xWriter = xml::sax::Writer::create(mxContext);
+
+ Reference< XTruncate > xTruncate( xOutput, UNO_QUERY );
+ OSL_ENSURE( xTruncate.is(), "Currently only the streams that can be truncated are expected!" );
+ if ( xTruncate.is() )
+ {
+ xTruncate->truncate();
+ }
+ xWriter->setOutputStream( xOutput );
+
+ xmlscript::ModuleDescriptor aMod;
+ aMod.aName = aElementName;
+ aMod.aLanguage = "StarBasic";
+ Any aElement = xLib->getByName( aElementName );
+ aElement >>= aMod.aCode;
+
+ Reference< script::vba::XVBAModuleInfo > xModInfo( xLib, UNO_QUERY );
+ if( xModInfo.is() && xModInfo->hasModuleInfo( aElementName ) )
+ {
+ script::ModuleInfo aModInfo = xModInfo->getModuleInfo( aElementName );
+ switch( aModInfo.ModuleType )
+ {
+ case ModuleType::NORMAL:
+ aMod.aModuleType = "normal";
+ break;
+ case ModuleType::CLASS:
+ aMod.aModuleType ="class";
+ break;
+ case ModuleType::FORM:
+ aMod.aModuleType = "form";
+ break;
+ case ModuleType::DOCUMENT:
+ aMod.aModuleType = "document";
+ break;
+ case ModuleType::UNKNOWN:
+ // nothing
+ break;
+ }
+ }
+
+ xmlscript::exportScriptModule( xWriter, aMod );
+}
+
+
+Any SfxScriptLibraryContainer::importLibraryElement
+ ( const Reference < XNameContainer >& xLib,
+ const OUString& aElementName, const OUString& aFile,
+ const uno::Reference< io::XInputStream >& xInStream )
+{
+ Any aRetAny;
+
+ Reference< XParser > xParser = xml::sax::Parser::create( mxContext );
+
+ // Read from storage?
+ bool bStorage = xInStream.is();
+ Reference< XInputStream > xInput;
+
+ if( bStorage )
+ {
+ xInput = xInStream;
+ }
+ else
+ {
+ try
+ {
+ xInput = mxSFI->openFileRead( aFile );
+ }
+ catch(const Exception& )
+ //catch( Exception& e )
+ {
+ // TODO:
+ //throw WrappedTargetException( e );
+ }
+ }
+
+ if( !xInput.is() )
+ return aRetAny;
+
+ InputSource source;
+ source.aInputStream = xInput;
+ source.sSystemId = aFile;
+
+ // start parsing
+ xmlscript::ModuleDescriptor aMod;
+
+ try
+ {
+ xParser->setDocumentHandler( ::xmlscript::importScriptModule( aMod ) );
+ xParser->parseStream( source );
+ }
+ catch(const Exception& )
+ {
+ SfxErrorContext aEc( ERRCTX_SFX_LOADBASIC, aFile );
+ ErrorHandler::HandleError( ERRCODE_IO_GENERAL );
+ }
+
+ aRetAny <<= aMod.aCode;
+
+ // TODO: Check language
+ // aMod.aLanguage
+ // aMod.aName ignored
+ if( !aMod.aModuleType.isEmpty() )
+ {
+ /* If in VBA compatibility mode, force creation of the VBA Globals
+ object. Each application will create an instance of its own
+ implementation and store it in its Basic manager. Implementations
+ will do all necessary additional initialization, such as
+ registering the global "This***Doc" UNO constant, starting the
+ document events processor etc.
+ */
+ if( getVBACompatibilityMode() ) try
+ {
+ Reference< frame::XModel > xModel( mxOwnerDocument ); // weak-ref -> ref
+ Reference< XMultiServiceFactory > xFactory( xModel, UNO_QUERY_THROW );
+ xFactory->createInstance("ooo.vba.VBAGlobals");
+ }
+ catch(const Exception& )
+ {
+ }
+
+ script::ModuleInfo aModInfo;
+ aModInfo.ModuleType = ModuleType::UNKNOWN;
+ if( aMod.aModuleType == "normal" )
+ {
+ aModInfo.ModuleType = ModuleType::NORMAL;
+ }
+ else if( aMod.aModuleType == "class" )
+ {
+ aModInfo.ModuleType = ModuleType::CLASS;
+ }
+ else if( aMod.aModuleType == "form" )
+ {
+ aModInfo.ModuleType = ModuleType::FORM;
+ aModInfo.ModuleObject = mxOwnerDocument;
+ }
+ else if( aMod.aModuleType == "document" )
+ {
+ aModInfo.ModuleType = ModuleType::DOCUMENT;
+
+ // #163691# use the same codename access instance for all document modules
+ if( !mxCodeNameAccess.is() ) try
+ {
+ Reference<frame::XModel > xModel( mxOwnerDocument );
+ Reference< XMultiServiceFactory> xSF( xModel, UNO_QUERY_THROW );
+ mxCodeNameAccess.set( xSF->createInstance("ooo.vba.VBAObjectModuleObjectProvider"), UNO_QUERY );
+ }
+ catch(const Exception& ) {}
+
+ if( mxCodeNameAccess.is() )
+ {
+ try
+ {
+ aModInfo.ModuleObject.set( mxCodeNameAccess->getByName( aElementName), uno::UNO_QUERY );
+ }
+ catch(const uno::Exception&)
+ {
+ SAL_WARN("basic", "Failed to get document object for " << aElementName );
+ }
+ }
+ }
+
+ Reference< script::vba::XVBAModuleInfo > xVBAModuleInfo( xLib, UNO_QUERY );
+ if( xVBAModuleInfo.is() )
+ {
+ if( xVBAModuleInfo->hasModuleInfo( aElementName ) )
+ {
+ xVBAModuleInfo->removeModuleInfo( aElementName );
+ }
+ xVBAModuleInfo->insertModuleInfo( aElementName, aModInfo );
+ }
+ }
+
+ return aRetAny;
+}
+
+SfxLibraryContainer* SfxScriptLibraryContainer::createInstanceImpl()
+{
+ return new SfxScriptLibraryContainer();
+}
+
+void SfxScriptLibraryContainer::importFromOldStorage( const OUString& aFile )
+{
+ // TODO: move loading from old storage to binary filters?
+ auto xStorage = tools::make_ref<SotStorage>( false, aFile );
+ if( xStorage->GetError() == ERRCODE_NONE )
+ {
+ std::unique_ptr<BasicManager> pBasicManager(new BasicManager( *xStorage, aFile ));
+
+ // Set info
+ LibraryContainerInfo aInfo( this, nullptr, static_cast< OldBasicPassword* >( this ) );
+ pBasicManager->SetLibraryContainerInfo( aInfo );
+ }
+}
+
+
+// Storing with password encryption
+
+// Methods XLibraryContainerPassword
+sal_Bool SAL_CALL SfxScriptLibraryContainer::isLibraryPasswordProtected( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ bool bRet = pImplLib->mbPasswordProtected;
+ return bRet;
+}
+
+sal_Bool SAL_CALL SfxScriptLibraryContainer::isLibraryPasswordVerified( const OUString& Name )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ if( !pImplLib->mbPasswordProtected )
+ {
+ throw IllegalArgumentException();
+ }
+ bool bRet = pImplLib->mbPasswordVerified;
+ return bRet;
+}
+
+sal_Bool SAL_CALL SfxScriptLibraryContainer::verifyLibraryPassword
+ ( const OUString& Name, const OUString& Password )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ if( !pImplLib->mbPasswordProtected || pImplLib->mbPasswordVerified )
+ {
+ throw IllegalArgumentException();
+ }
+ // Test password
+ bool bSuccess = false;
+ if( pImplLib->mbDoc50Password )
+ {
+ bSuccess = ( Password == pImplLib->maPassword );
+ if( bSuccess )
+ {
+ pImplLib->mbPasswordVerified = true;
+ }
+ }
+ else
+ {
+ pImplLib->maPassword = Password;
+ bSuccess = implLoadPasswordLibrary( pImplLib, Name, true );
+ if( bSuccess )
+ {
+ // The library gets modified by verifying the password, because other-
+ // wise for saving the storage would be copied and that doesn't work
+ // with mtg's storages when the password is verified
+ pImplLib->implSetModified( true );
+ pImplLib->mbPasswordVerified = true;
+
+ // Reload library to get source
+ if( pImplLib->mbLoaded )
+ {
+ implLoadPasswordLibrary( pImplLib, Name );
+ }
+ }
+ }
+ return bSuccess;
+}
+
+void SAL_CALL SfxScriptLibraryContainer::changeLibraryPassword( const OUString& Name,
+ const OUString& OldPassword,
+ const OUString& NewPassword )
+{
+ LibraryContainerMethodGuard aGuard( *this );
+ SfxLibrary* pImplLib = getImplLib( Name );
+ if( OldPassword == NewPassword )
+ {
+ return;
+ }
+ bool bOldPassword = !OldPassword.isEmpty();
+ bool bNewPassword = !NewPassword.isEmpty();
+ bool bStorage = mxStorage.is() && !pImplLib->mbLink;
+
+ if( pImplLib->mbReadOnly || (bOldPassword && !pImplLib->mbPasswordProtected) )
+ {
+ throw IllegalArgumentException();
+ }
+ // Library must be loaded
+ loadLibrary( Name );
+
+ bool bKillCryptedFiles = false;
+ bool bKillUncryptedFiles = false;
+
+ // Remove or change password?
+ if( bOldPassword )
+ {
+ if( isLibraryPasswordVerified( Name ) )
+ {
+ if( pImplLib->maPassword != OldPassword )
+ {
+ throw IllegalArgumentException();
+ }
+ }
+ else
+ {
+ if( !verifyLibraryPassword( Name, OldPassword ) )
+ {
+ throw IllegalArgumentException();
+ }
+ // Reload library to get source
+ // Should be done in verifyLibraryPassword loadLibrary( Name );
+ }
+
+ if( !bNewPassword )
+ {
+ pImplLib->mbPasswordProtected = false;
+ pImplLib->mbPasswordVerified = false;
+ pImplLib->maPassword.clear();
+
+ maModifiable.setModified( true );
+ pImplLib->implSetModified( true );
+
+ if( !bStorage && !pImplLib->mbDoc50Password )
+ {
+ // Store application basic unencrypted
+ uno::Reference< embed::XStorage > xStorage;
+ storeLibraries_Impl( xStorage, false );
+ bKillCryptedFiles = true;
+ }
+ }
+ }
+
+ // Set new password?
+ if( bNewPassword )
+ {
+ pImplLib->mbPasswordProtected = true;
+ pImplLib->mbPasswordVerified = true;
+ pImplLib->maPassword = NewPassword;
+ SfxScriptLibrary *const pSL(dynamic_cast<SfxScriptLibrary *>(pImplLib));
+ if (pSL && pSL->mbLoaded)
+ {
+ pSL->mbLoadedSource = true; // must store source code now!
+ }
+
+ maModifiable.setModified( true );
+ pImplLib->implSetModified( true );
+
+ if( !bStorage && !pImplLib->mbDoc50Password )
+ {
+ // Store application basic crypted
+ uno::Reference< embed::XStorage > xStorage;
+ storeLibraries_Impl( xStorage, false );
+ bKillUncryptedFiles = true;
+ }
+ }
+
+ if( !(bKillCryptedFiles || bKillUncryptedFiles) )
+ return;
+
+ Sequence< OUString > aElementNames = pImplLib->getElementNames();
+ sal_Int32 nNameCount = aElementNames.getLength();
+ const OUString* pNames = aElementNames.getConstArray();
+ OUString aLibDirPath = createAppLibraryFolder( pImplLib, Name );
+ try
+ {
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ INetURLObject aElementInetObj( aLibDirPath );
+ aElementInetObj.insertName( aElementName, false,
+ INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ if( bKillUncryptedFiles )
+ {
+ aElementInetObj.setExtension( maLibElementFileExtension );
+ }
+ else
+ {
+ aElementInetObj.setExtension( "pba" );
+ }
+ OUString aElementPath( aElementInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE ) );
+
+ if( mxSFI->exists( aElementPath ) )
+ {
+ mxSFI->kill( aElementPath );
+ }
+ }
+ }
+ catch(const Exception& ) {}
+}
+
+
+static void setStreamKey( const uno::Reference< io::XStream >& xStream, const OUString& aPass )
+{
+ uno::Reference< embed::XEncryptionProtectedSource > xEncrStream( xStream, uno::UNO_QUERY );
+ if ( xEncrStream.is() )
+ {
+ xEncrStream->setEncryptionPassword( aPass );
+ }
+}
+
+
+// Impl methods
+bool SfxScriptLibraryContainer::implStorePasswordLibrary( SfxLibrary* pLib,
+ const OUString& aName,
+ const uno::Reference< embed::XStorage >& xStorage,
+ const css::uno::Reference< css::task::XInteractionHandler >& xHandler )
+{
+ Reference< XSimpleFileAccess3 > xDummySFA;
+ return implStorePasswordLibrary( pLib, aName, xStorage, OUString(), xDummySFA, xHandler );
+}
+
+bool SfxScriptLibraryContainer::implStorePasswordLibrary( SfxLibrary* pLib, const OUString& aName,
+ const css::uno::Reference< css::embed::XStorage >& xStorage,
+ const OUString& aTargetURL,
+ const Reference< XSimpleFileAccess3 >& rToUseSFI,
+ const css::uno::Reference< css::task::XInteractionHandler >& xHandler )
+{
+ bool bExport = !aTargetURL.isEmpty();
+
+ BasicManager* pBasicMgr = getBasicManager();
+ OSL_ENSURE( pBasicMgr, "SfxScriptLibraryContainer::implStorePasswordLibrary: cannot do this without a BasicManager!" );
+ if ( !pBasicMgr )
+ {
+ return false;
+ }
+ // Only need to handle the export case here,
+ // save/saveas etc are handled in sfxbasemodel::storeSelf &
+ // sfxbasemodel::impl_store
+ std::vector<OUString> aNames;
+ if ( bExport && pBasicMgr->LegacyPsswdBinaryLimitExceeded(aNames) )
+ {
+ if ( xHandler.is() )
+ {
+ ModuleSizeExceeded* pReq = new ModuleSizeExceeded( aNames );
+ uno::Reference< task::XInteractionRequest > xReq( pReq );
+ xHandler->handle( xReq );
+ if ( pReq->isAbort() )
+ {
+ throw util::VetoException();
+ }
+ }
+ }
+
+ StarBASIC* pBasicLib = pBasicMgr->GetLib( aName );
+ if( !pBasicLib )
+ {
+ return false;
+ }
+ Sequence< OUString > aElementNames = pLib->getElementNames();
+ sal_Int32 nNameCount = aElementNames.getLength();
+ const OUString* pNames = aElementNames.getConstArray();
+
+ bool bLink = pLib->mbLink;
+ bool bStorage = xStorage.is() && !bLink;
+ if( bStorage )
+ {
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ // Write binary image stream
+ SbModule* pMod = pBasicLib->FindModule( aElementName );
+ if( pMod )
+ {
+ OUString aCodeStreamName = aElementName + ".bin";
+ try
+ {
+ uno::Reference< io::XStream > xCodeStream = xStorage->openStreamElement(
+ aCodeStreamName,
+ embed::ElementModes::READWRITE | embed::ElementModes::TRUNCATE );
+
+ if ( !xCodeStream.is() )
+ {
+ throw uno::RuntimeException("null returned from openStreamElement");
+ }
+ SvMemoryStream aMemStream;
+ /*sal_Bool bStore = */pMod->StoreBinaryData( aMemStream );
+
+ sal_Int32 const nSize = aMemStream.Tell();
+ if (nSize < 0) { abort(); }
+ Sequence< sal_Int8 > aBinSeq( nSize );
+ sal_Int8* pData = aBinSeq.getArray();
+ memcpy( pData, aMemStream.GetData(), nSize );
+
+ Reference< XOutputStream > xOut = xCodeStream->getOutputStream();
+ if ( !xOut.is() )
+ {
+ throw io::IOException(); // access denied because the stream is readonly
+ }
+ xOut->writeBytes( aBinSeq );
+ xOut->closeOutput();
+ }
+ catch(const uno::Exception& )
+ {
+ // TODO: handle error
+ }
+ }
+
+ if( pLib->mbPasswordVerified || pLib->mbDoc50Password )
+ {
+ if( !isLibraryElementValid( pLib->getByName( aElementName ) ) )
+ {
+ SAL_WARN( "basic", "invalid library element '" << aElementName << "'.");
+ continue;
+ }
+
+ OUString aSourceStreamName = aElementName + ".xml";
+ try
+ {
+ uno::Reference< io::XStream > xSourceStream = xStorage->openStreamElement(
+ aSourceStreamName,
+ embed::ElementModes::READWRITE );
+ uno::Reference< beans::XPropertySet > xProps( xSourceStream, uno::UNO_QUERY_THROW );
+ xProps->setPropertyValue("MediaType", uno::Any( OUString( "text/xml" ) ) );
+
+ // Set encryption key
+ setStreamKey( xSourceStream, pLib->maPassword );
+
+ Reference< XOutputStream > xOutput = xSourceStream->getOutputStream();
+ Reference< XNameContainer > xLib( pLib );
+ writeLibraryElement( xLib, aElementName, xOutput );
+ }
+ catch(const uno::Exception& )
+ {
+ OSL_FAIL( "Problem on storing of password library!" );
+ // TODO: error handling
+ }
+ }
+ else // !mbPasswordVerified
+ {
+ // TODO
+ // What to do if not verified?! In any case it's already loaded here
+ }
+ }
+
+ }
+ // Application libraries have only to be saved if the password
+ // is verified because otherwise they can't be modified
+ else if( pLib->mbPasswordVerified || bExport )
+ {
+ try
+ {
+ Reference< XSimpleFileAccess3 > xSFI = mxSFI;
+ if( rToUseSFI.is() )
+ {
+ xSFI = rToUseSFI;
+ }
+ OUString aLibDirPath;
+ if( bExport )
+ {
+ INetURLObject aInetObj( aTargetURL );
+ aInetObj.insertName( aName, true, INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aLibDirPath = aInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ if( !xSFI->isFolder( aLibDirPath ) )
+ {
+ xSFI->createFolder( aLibDirPath );
+ }
+ }
+ else
+ {
+ aLibDirPath = createAppLibraryFolder( pLib, aName );
+ }
+
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ INetURLObject aElementInetObj( aLibDirPath );
+ aElementInetObj.insertName( aElementName, false,
+ INetURLObject::LAST_SEGMENT,
+ INetURLObject::EncodeMechanism::All );
+ aElementInetObj.setExtension( "pba" );
+ OUString aElementPath = aElementInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ if( !isLibraryElementValid( pLib->getByName( aElementName ) ) )
+ {
+ SAL_WARN( "basic", "invalid library element '" << aElementName << "'.");
+ continue;
+ }
+
+ try
+ {
+ uno::Reference< embed::XStorage > xElementRootStorage =
+ ::comphelper::OStorageHelper::GetStorageFromURL(
+ aElementPath,
+ embed::ElementModes::READWRITE );
+ if ( !xElementRootStorage.is() )
+ {
+ throw uno::RuntimeException("null returned from GetStorageFromURL");
+ }
+ // Write binary image stream
+ SbModule* pMod = pBasicLib->FindModule( aElementName );
+ if( pMod )
+ {
+ uno::Reference< io::XStream > xCodeStream = xElementRootStorage->openStreamElement(
+ "code.bin",
+ embed::ElementModes::WRITE | embed::ElementModes::TRUNCATE );
+
+ SvMemoryStream aMemStream;
+ /*sal_Bool bStore = */pMod->StoreBinaryData( aMemStream );
+
+ sal_Int32 const nSize = aMemStream.Tell();
+ if (nSize < 0) { abort(); }
+ Sequence< sal_Int8 > aBinSeq( nSize );
+ sal_Int8* pData = aBinSeq.getArray();
+ memcpy( pData, aMemStream.GetData(), nSize );
+
+ Reference< XOutputStream > xOut = xCodeStream->getOutputStream();
+ if ( xOut.is() )
+ {
+ xOut->writeBytes( aBinSeq );
+ xOut->closeOutput();
+ }
+ }
+
+ // Write encrypted source stream
+ OUString aSourceStreamName( "source.xml" );
+
+ uno::Reference< io::XStream > xSourceStream;
+ try
+ {
+ xSourceStream = xElementRootStorage->openStreamElement(
+ aSourceStreamName,
+ embed::ElementModes::WRITE | embed::ElementModes::TRUNCATE );
+
+ // #87671 Allow encryption
+ uno::Reference< embed::XEncryptionProtectedSource > xEncr( xSourceStream, uno::UNO_QUERY_THROW );
+ xEncr->setEncryptionPassword( pLib->maPassword );
+ }
+ catch(const css::packages::WrongPasswordException& )
+ {
+ xSourceStream = xElementRootStorage->openEncryptedStreamElement(
+ aSourceStreamName,
+ embed::ElementModes::WRITE | embed::ElementModes::TRUNCATE,
+ pLib->maPassword );
+ }
+
+ uno::Reference< beans::XPropertySet > xProps( xSourceStream, uno::UNO_QUERY_THROW );
+ xProps->setPropertyValue("MediaType", uno::Any( OUString( "text/xml" ) ) );
+
+ Reference< XOutputStream > xOut = xSourceStream->getOutputStream();
+ Reference< XNameContainer > xLib( pLib );
+ writeLibraryElement( xLib, aElementName, xOut );
+ // i50568: sax writer already closes stream
+ // xOut->closeOutput();
+
+ uno::Reference< embed::XTransactedObject > xTransact( xElementRootStorage, uno::UNO_QUERY_THROW );
+ xTransact->commit();
+ }
+ catch(const uno::Exception& )
+ {
+ // TODO: handle error
+ }
+
+ }
+ }
+ catch(const Exception& )
+ {
+ }
+ }
+ return true;
+}
+
+bool SfxScriptLibraryContainer::implLoadPasswordLibrary
+ ( SfxLibrary* pLib, const OUString& Name, bool bVerifyPasswordOnly )
+{
+ bool bRet = true;
+
+ bool bLink = pLib->mbLink;
+ bool bStorage = mxStorage.is() && !bLink;
+
+ // Already loaded? Then only verifiedPassword can change something
+ SfxScriptLibrary* pScriptLib = static_cast< SfxScriptLibrary* >( pLib );
+ if( pScriptLib->mbLoaded )
+ {
+ if( pScriptLib->mbLoadedBinary && !bVerifyPasswordOnly &&
+ (pScriptLib->mbLoadedSource || !pLib->mbPasswordVerified) )
+ {
+ return false;
+ }
+ }
+
+ StarBASIC* pBasicLib = nullptr;
+ bool bLoadBinary = false;
+ if( !pScriptLib->mbLoadedBinary && !bVerifyPasswordOnly && !pLib->mbPasswordVerified )
+ {
+ BasicManager* pBasicMgr = getBasicManager();
+ OSL_ENSURE( pBasicMgr, "SfxScriptLibraryContainer::implLoadPasswordLibrary: cannot do this without a BasicManager!" );
+ bool bLoaded = pScriptLib->mbLoaded;
+ pScriptLib->mbLoaded = true; // Necessary to get lib
+ pBasicLib = pBasicMgr ? pBasicMgr->GetLib( Name ) : nullptr;
+ pScriptLib->mbLoaded = bLoaded; // Restore flag
+ if( !pBasicLib )
+ {
+ return false;
+ }
+ bLoadBinary = true;
+ pScriptLib->mbLoadedBinary = true;
+ }
+
+ bool bLoadSource = false;
+ if( !pScriptLib->mbLoadedSource && pLib->mbPasswordVerified && !bVerifyPasswordOnly )
+ {
+ bLoadSource = true;
+ pScriptLib->mbLoadedSource = true;
+ }
+
+ Sequence< OUString > aElementNames = pLib->getElementNames();
+ sal_Int32 nNameCount = aElementNames.getLength();
+ const OUString* pNames = aElementNames.getConstArray();
+
+ if( bStorage )
+ {
+ uno::Reference< embed::XStorage > xLibrariesStor;
+ uno::Reference< embed::XStorage > xLibraryStor;
+ try {
+ xLibrariesStor = mxStorage->openStorageElement( maLibrariesDir, embed::ElementModes::READ );
+ if ( !xLibrariesStor.is() )
+ {
+ throw uno::RuntimeException("null returned from openStorageElement");
+ }
+ xLibraryStor = xLibrariesStor->openStorageElement( Name, embed::ElementModes::READ );
+ if ( !xLibraryStor.is() )
+ {
+ throw uno::RuntimeException("null returned from openStorageElement");
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ OSL_FAIL( "### couldn't open sub storage for library" );
+ return false;
+ }
+
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ // Load binary
+ if( bLoadBinary )
+ {
+ SbModule* pMod = pBasicLib->FindModule( aElementName );
+ if( !pMod )
+ {
+ pMod = pBasicLib->MakeModule( aElementName, OUString() );
+ pBasicLib->SetModified( false );
+ }
+
+ OUString aCodeStreamName= aElementName + ".bin";
+ try
+ {
+ uno::Reference< io::XStream > xCodeStream = xLibraryStor->openStreamElement(
+ aCodeStreamName,
+ embed::ElementModes::READ );
+ if ( !xCodeStream.is() )
+ {
+ throw uno::RuntimeException("null returned from openStreamElement");
+ }
+ std::unique_ptr<SvStream> pStream(::utl::UcbStreamHelper::CreateStream( xCodeStream ));
+ if ( !pStream || pStream->GetError() )
+ {
+ sal_uInt32 nError = sal_uInt32(pStream ? pStream->GetError() : ERRCODE_IO_GENERAL);
+ throw task::ErrorCodeIOException(
+ ("utl::UcbStreamHelper::CreateStream failed for \""
+ + aCodeStreamName + "\": 0x"
+ + OUString::number(nError, 16)),
+ uno::Reference< uno::XInterface >(), nError);
+ }
+
+ /*sal_Bool bRet = */pMod->LoadBinaryData( *pStream );
+ // TODO: Check return value
+ }
+ catch(const uno::Exception& )
+ {
+ // TODO: error handling
+ }
+ }
+
+ // Load source
+ if( bLoadSource || bVerifyPasswordOnly )
+ {
+ // Access encrypted source stream
+ OUString aSourceStreamName = aElementName + ".xml";
+ try
+ {
+ uno::Reference< io::XStream > xSourceStream = xLibraryStor->openEncryptedStreamElement(
+ aSourceStreamName,
+ embed::ElementModes::READ,
+ pLib->maPassword );
+ if ( !xSourceStream.is() )
+ {
+ throw uno::RuntimeException("null returned from openEncryptedStreamElement");
+ }
+ // if this point is reached then the password is correct
+ if ( !bVerifyPasswordOnly )
+ {
+ uno::Reference< io::XInputStream > xInStream = xSourceStream->getInputStream();
+ if ( !xInStream.is() )
+ {
+ throw io::IOException(); // read access denied, seems to be impossible
+ }
+ Reference< XNameContainer > xLib( pLib );
+ Any aAny = importLibraryElement( xLib,
+ aElementName, aSourceStreamName,
+ xInStream );
+ if( pLib->hasByName( aElementName ) )
+ {
+ if( aAny.hasValue() )
+ {
+ pLib->maNameContainer->replaceByName( aElementName, aAny );
+ }
+ }
+ else
+ {
+ pLib->maNameContainer->insertByName( aElementName, aAny );
+ }
+ }
+ }
+ catch(const uno::Exception& )
+ {
+ bRet = false;
+ }
+ }
+ }
+ }
+ else
+ {
+ try
+ {
+ OUString aLibDirPath = createAppLibraryFolder( pLib, Name );
+
+ for( sal_Int32 i = 0 ; i < nNameCount ; i++ )
+ {
+ OUString aElementName = pNames[ i ];
+
+ INetURLObject aElementInetObj( aLibDirPath );
+ aElementInetObj.insertName( aElementName, false,
+ INetURLObject::LAST_SEGMENT, INetURLObject::EncodeMechanism::All );
+ aElementInetObj.setExtension( "pba" );
+ OUString aElementPath = aElementInetObj.GetMainURL( INetURLObject::DecodeMechanism::NONE );
+
+ uno::Reference< embed::XStorage > xElementRootStorage;
+ try
+ {
+ xElementRootStorage = ::comphelper::OStorageHelper::GetStorageFromURL(
+ aElementPath,
+ embed::ElementModes::READ );
+ } catch(const uno::Exception& )
+ {
+ // TODO: error handling
+ }
+
+ if ( xElementRootStorage.is() )
+ {
+ // Load binary
+ if( bLoadBinary )
+ {
+ SbModule* pMod = pBasicLib->FindModule( aElementName );
+ if( !pMod )
+ {
+ pMod = pBasicLib->MakeModule( aElementName, OUString() );
+ pBasicLib->SetModified( false );
+ }
+
+ try
+ {
+ uno::Reference< io::XStream > xCodeStream = xElementRootStorage->openStreamElement(
+ "code.bin",
+ embed::ElementModes::READ );
+
+ std::unique_ptr<SvStream> pStream(::utl::UcbStreamHelper::CreateStream( xCodeStream ));
+ if ( !pStream || pStream->GetError() )
+ {
+ sal_uInt32 nError = sal_uInt32(pStream ? pStream->GetError() : ERRCODE_IO_GENERAL);
+ throw task::ErrorCodeIOException(
+ ("utl::UcbStreamHelper::CreateStream failed"
+ " for code.bin: 0x"
+ + OUString::number(nError, 16)),
+ uno::Reference< uno::XInterface >(),
+ nError);
+ }
+
+ /*sal_Bool bRet = */pMod->LoadBinaryData( *pStream );
+ // TODO: Check return value
+ }
+ catch(const uno::Exception& )
+ {
+ // TODO: error handling
+ }
+ }
+
+ // Load source
+ if( bLoadSource || bVerifyPasswordOnly )
+ {
+ // Access encrypted source stream
+ OUString aSourceStreamName( "source.xml" );
+ try
+ {
+ uno::Reference< io::XStream > xSourceStream = xElementRootStorage->openEncryptedStreamElement(
+ aSourceStreamName,
+ embed::ElementModes::READ,
+ pLib->maPassword );
+ if ( !xSourceStream.is() )
+ {
+ throw uno::RuntimeException("null returned from openEncryptedStreamElement");
+ }
+ if ( !bVerifyPasswordOnly )
+ {
+ uno::Reference< io::XInputStream > xInStream = xSourceStream->getInputStream();
+ if ( !xInStream.is() )
+ {
+ throw io::IOException(); // read access denied, seems to be impossible
+ }
+ Reference< XNameContainer > xLib( pLib );
+ Any aAny = importLibraryElement( xLib,
+ aElementName,
+ aSourceStreamName,
+ xInStream );
+ if( pLib->hasByName( aElementName ) )
+ {
+ if( aAny.hasValue() )
+ {
+ pLib->maNameContainer->replaceByName( aElementName, aAny );
+ }
+ }
+ else
+ {
+ pLib->maNameContainer->insertByName( aElementName, aAny );
+ }
+ }
+ }
+ catch (const uno::Exception& )
+ {
+ bRet = false;
+ }
+ }
+ }
+ }
+ }
+ catch(const Exception& )
+ {
+ // TODO
+ //throw e;
+ }
+ }
+
+ return bRet;
+}
+
+
+void SfxScriptLibraryContainer::onNewRootStorage()
+{
+}
+
+sal_Bool SAL_CALL SfxScriptLibraryContainer:: HasExecutableCode( const OUString& Library )
+{
+ BasicManager* pBasicMgr = getBasicManager();
+ OSL_ENSURE( pBasicMgr, "we need a basicmanager, really we do" );
+ if ( pBasicMgr )
+ {
+ return pBasicMgr->HasExeCode( Library ); // need to change this to take name
+ }
+ // default to it has code if we can't decide
+ return true;
+}
+
+
+// Service
+OUString SAL_CALL SfxScriptLibraryContainer::getImplementationName( )
+{
+ return "com.sun.star.comp.sfx2.ScriptLibraryContainer";
+}
+
+Sequence< OUString > SAL_CALL SfxScriptLibraryContainer::getSupportedServiceNames( )
+{
+ return {"com.sun.star.script.DocumentScriptLibraryContainer",
+ "com.sun.star.script.ScriptLibraryContainer"}; // for compatibility
+}
+
+// Implementation class SfxScriptLibrary
+
+// Ctor
+SfxScriptLibrary::SfxScriptLibrary( ModifiableHelper& _rModifiable,
+ const Reference< XSimpleFileAccess3 >& xSFI )
+ : SfxLibrary( _rModifiable, cppu::UnoType<OUString>::get(), xSFI )
+ , mbLoadedSource( false )
+ , mbLoadedBinary( false )
+{
+}
+
+SfxScriptLibrary::SfxScriptLibrary( ModifiableHelper& _rModifiable,
+ const Reference< XSimpleFileAccess3 >& xSFI,
+ const OUString& aLibInfoFileURL,
+ const OUString& aStorageURL,
+ bool ReadOnly )
+ : SfxLibrary( _rModifiable, cppu::UnoType<OUString>::get(), xSFI,
+ aLibInfoFileURL, aStorageURL, ReadOnly)
+ , mbLoadedSource( false )
+ , mbLoadedBinary( false )
+{
+}
+
+bool SfxScriptLibrary::isLoadedStorable()
+{
+ // note: mbLoadedSource can only be true for password-protected lib!
+ return SfxLibrary::isLoadedStorable() && (!mbPasswordProtected || mbLoadedSource);
+}
+
+// Provide modify state including resources
+bool SfxScriptLibrary::isModified()
+{
+ return implIsModified(); // No resources
+}
+
+void SfxScriptLibrary::storeResources()
+{
+ // No resources
+}
+
+void SfxScriptLibrary::storeResourcesToURL( const OUString&,
+ const Reference< task::XInteractionHandler >& )
+{}
+
+void SfxScriptLibrary::storeResourcesAsURL
+ ( const OUString&, const OUString& )
+{}
+
+void SfxScriptLibrary::storeResourcesToStorage( const css::uno::Reference
+ < css::embed::XStorage >& )
+{
+ // No resources
+}
+
+bool SfxScriptLibrary::containsValidModule(const Any& rElement)
+{
+ OUString sModuleText;
+ rElement >>= sModuleText;
+ return ( !sModuleText.isEmpty() );
+}
+
+bool SfxScriptLibrary::isLibraryElementValid(const css::uno::Any& rElement) const
+{
+ return SfxScriptLibrary::containsValidModule(rElement);
+}
+
+IMPLEMENT_FORWARD_XINTERFACE2( SfxScriptLibrary, SfxLibrary, SfxScriptLibrary_BASE );
+IMPLEMENT_FORWARD_XTYPEPROVIDER2( SfxScriptLibrary, SfxLibrary, SfxScriptLibrary_BASE );
+
+script::ModuleInfo SAL_CALL SfxScriptLibrary::getModuleInfo( const OUString& ModuleName )
+{
+ if ( !hasModuleInfo( ModuleName ) )
+ {
+ throw NoSuchElementException();
+ }
+ return mModuleInfo[ ModuleName ];
+}
+
+sal_Bool SAL_CALL SfxScriptLibrary::hasModuleInfo( const OUString& ModuleName )
+{
+ bool bRes = false;
+ ModuleInfoMap::iterator it = mModuleInfo.find( ModuleName );
+
+ if ( it != mModuleInfo.end() )
+ {
+ bRes = true;
+ }
+ return bRes;
+}
+
+void SAL_CALL SfxScriptLibrary::insertModuleInfo( const OUString& ModuleName, const script::ModuleInfo& ModuleInfo )
+{
+ if ( hasModuleInfo( ModuleName ) )
+ {
+ throw ElementExistException();
+ }
+ mModuleInfo[ ModuleName ] = ModuleInfo;
+}
+
+void SAL_CALL SfxScriptLibrary::removeModuleInfo( const OUString& ModuleName )
+{
+ // #FIXME add NoSuchElementException to the spec
+ if ( mModuleInfo.erase( ModuleName ) == 0 )
+ throw NoSuchElementException();
+}
+
+} // namespace basic
+
+
+extern "C" SAL_DLLPUBLIC_EXPORT css::uno::XInterface*
+com_sun_star_comp_sfx2_ScriptLibraryContainer_get_implementation(css::uno::XComponentContext*,
+ css::uno::Sequence<css::uno::Any> const &)
+{
+ return cppu::acquire(new basic::SfxScriptLibraryContainer());
+}
+
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/util/sb.component b/basic/util/sb.component
new file mode 100644
index 000000000..9271a84eb
--- /dev/null
+++ b/basic/util/sb.component
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!--
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+ -->
+
+<component loader="com.sun.star.loader.SharedLibrary" environment="@CPPU_ENV@"
+ xmlns="http://openoffice.org/2010/uno-components">
+ <implementation name="com.sun.star.comp.sfx2.DialogLibraryContainer"
+ constructor="com_sun_star_comp_sfx2_DialogLibraryContainer_get_implementation">
+ <service name="com.sun.star.script.DialogLibraryContainer"/>
+ <service name="com.sun.star.script.DocumentDialogLibraryContainer"/>
+ </implementation>
+ <implementation name="com.sun.star.comp.sfx2.ScriptLibraryContainer"
+ constructor="com_sun_star_comp_sfx2_ScriptLibraryContainer_get_implementation">
+ <service name="com.sun.star.script.DocumentScriptLibraryContainer"/>
+ <service name="com.sun.star.script.ScriptLibraryContainer"/>
+ </implementation>
+</component>