2007-09-09 22:30:50 +00:00
|
|
|
{ This file is part of the Web Service Toolkit
|
|
|
|
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
|
|
|
|
|
|
|
|
This file is provide under modified LGPL licence
|
|
|
|
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
|
|
|
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
}
|
|
|
|
{$INCLUDE wst_global.inc}
|
|
|
|
unit test_parsers;
|
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
|
|
uses
|
|
|
|
Classes, SysUtils,
|
|
|
|
{$IFDEF FPC}
|
2012-08-13 20:40:08 +00:00
|
|
|
fpcunit, testutils, testregistry, DOM, wst_fpc_xml,
|
2007-09-09 22:30:50 +00:00
|
|
|
{$ELSE}
|
|
|
|
TestFrameWork, xmldom, wst_delphi_xml,
|
|
|
|
{$ENDIF}
|
2009-11-23 17:55:10 +00:00
|
|
|
pastree, pascal_parser_intf, xsd_parser, wsdl_parser, test_suite_utils, wst_types;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
2014-05-17 17:27:34 +00:00
|
|
|
const
|
|
|
|
STRING_TYPE_NAME =
|
|
|
|
{$IFDEF WST_UNICODESTRING}
|
|
|
|
'UnicodeString';
|
|
|
|
{$ELSE WST_UNICODESTRING}
|
|
|
|
'string';
|
|
|
|
{$ENDIF WST_UNICODESTRING}
|
2007-09-09 22:30:50 +00:00
|
|
|
type
|
|
|
|
|
|
|
|
{ TTest_CustomXsdParser }
|
|
|
|
|
|
|
|
TTest_CustomXsdParser = class(TTestCase)
|
2011-09-14 02:31:02 +00:00
|
|
|
protected
|
|
|
|
function ParseDoc(const ADoc : string) : TwstPasTreeContainer;overload;virtual;
|
|
|
|
function ParseDoc(const ADoc : string; const ACaseSensistive : Boolean) : TwstPasTreeContainer;overload;virtual;abstract;
|
2007-09-09 22:30:50 +00:00
|
|
|
protected
|
|
|
|
function LoadEmptySchema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadSimpleType_Enum_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2007-10-19 15:30:20 +00:00
|
|
|
function LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
function LoadComplexType_Class_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2008-06-06 15:04:35 +00:00
|
|
|
function LoadComplexType_Class_default_values() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_properties_extended_metadata() : TwstPasTreeContainer;virtual;abstract;
|
2008-09-29 12:35:06 +00:00
|
|
|
function LoadComplexType_Class_properties_extended_metadata2() : TwstPasTreeContainer;virtual;abstract;
|
2007-09-09 22:30:50 +00:00
|
|
|
function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2007-12-29 00:58:19 +00:00
|
|
|
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2008-10-23 19:21:59 +00:00
|
|
|
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;virtual;abstract;
|
2009-05-29 15:19:58 +00:00
|
|
|
function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;virtual;abstract;
|
2011-09-14 02:31:02 +00:00
|
|
|
function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2015-07-15 16:02:12 +00:00
|
|
|
function LoadComplexType_Class_SameNameOfElementAndAttributeSchema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Group() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Group2() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Group3() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Group4() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Group5() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Group6() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_Group7() : TwstPasTreeContainer;virtual;abstract;
|
2016-07-20 19:41:11 +00:00
|
|
|
function LoadComplexType_Class_Group8() : TwstPasTreeContainer;virtual;
|
|
|
|
function LoadComplexType_Class_Group9() : TwstPasTreeContainer;virtual;
|
|
|
|
function LoadComplexType_Class_Group10() : TwstPasTreeContainer;virtual;
|
2015-07-15 16:02:12 +00:00
|
|
|
function LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;virtual;abstract;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
|
|
|
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2007-09-16 00:31:45 +00:00
|
|
|
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2015-07-15 16:02:12 +00:00
|
|
|
function LoadComplexType_Mixed() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function LoadComplexType_Mixed2() : TwstPasTreeContainer;virtual;abstract;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
|
|
|
function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2009-05-29 15:19:58 +00:00
|
|
|
function LoadComplexType_ArraySequence_ItemName_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2007-09-10 22:19:20 +00:00
|
|
|
function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2008-09-10 01:19:04 +00:00
|
|
|
function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;virtual;abstract;
|
2008-08-01 21:38:55 +00:00
|
|
|
|
|
|
|
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
|
|
|
|
function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;virtual;abstract;
|
2008-09-11 00:44:56 +00:00
|
|
|
|
|
|
|
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;virtual;abstract;
|
2008-09-17 01:45:04 +00:00
|
|
|
function load_class_widestring_property() : TwstPasTreeContainer;virtual;abstract;
|
2009-01-19 17:46:33 +00:00
|
|
|
function load_class_ansichar_property() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_class_widechar_property() : TwstPasTreeContainer;virtual;abstract;
|
2009-10-07 17:41:09 +00:00
|
|
|
function load_class_currency_property() : TwstPasTreeContainer;virtual;abstract;
|
2010-10-01 20:44:10 +00:00
|
|
|
function load_class_property_composed_name() : TwstPasTreeContainer;virtual;abstract;
|
2009-11-23 17:55:10 +00:00
|
|
|
|
|
|
|
function load_schema_import() : TwstPasTreeContainer;virtual;abstract;
|
2011-08-29 02:59:57 +00:00
|
|
|
function load_schema_include() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_include_parent_no_types() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_include_fail_namespace() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_include_circular1() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_include_circular2() : TwstPasTreeContainer;virtual;abstract;
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
function load_schema_case_sensitive() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_case_sensitive2() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_case_sensitive_import() : TwstPasTreeContainer;virtual;abstract;
|
2015-07-15 16:02:12 +00:00
|
|
|
function load_schema_default_elt_att_form() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_default_elt_qualified_form() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_default_att_unqualified_form() : TwstPasTreeContainer;virtual;abstract;
|
|
|
|
function load_schema_default_elt_att_form_present() : TwstPasTreeContainer;virtual;abstract;
|
2013-03-05 15:48:26 +00:00
|
|
|
|
|
|
|
function load_global_attribute() : TwstPasTreeContainer;virtual;abstract;
|
2016-04-23 15:02:11 +00:00
|
|
|
function load_att_inherited_maxbound() : TwstPasTreeContainer;virtual;
|
2016-05-04 12:32:49 +00:00
|
|
|
function load_embedded_unbounded_choice() : TwstPasTreeContainer;virtual;
|
2007-09-09 22:30:50 +00:00
|
|
|
published
|
|
|
|
procedure EmptySchema();
|
|
|
|
|
|
|
|
procedure SimpleType_Enum();
|
|
|
|
procedure SimpleType_Enum_Embedded();
|
2007-10-19 15:30:20 +00:00
|
|
|
procedure SimpleType_AliasToNativeType();
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
procedure ComplexType_Class();
|
2008-06-06 15:04:35 +00:00
|
|
|
procedure ComplexType_Class_default_values();
|
|
|
|
procedure ComplexType_Class_properties_extended_metadata();
|
2008-09-29 12:35:06 +00:00
|
|
|
procedure ComplexType_Class_properties_extended_metadata2();
|
2007-09-09 22:30:50 +00:00
|
|
|
procedure ComplexType_Class_Embedded();
|
2007-12-29 00:58:19 +00:00
|
|
|
procedure ComplexType_Class_Extend_Simple_Schema();
|
2008-10-23 19:21:59 +00:00
|
|
|
procedure ComplexType_Class_open_type_any();
|
|
|
|
procedure ComplexType_Class_open_extension_type_any();
|
|
|
|
procedure ComplexType_Class_open_extension_type_anyAttribute();
|
|
|
|
procedure ComplexType_Class_sequence_open_type_anyAttribute();
|
|
|
|
procedure ComplexType_Class_all_open_type_anyAttribute();
|
2009-05-29 15:19:58 +00:00
|
|
|
procedure ComplexType_Class_FalseArray();
|
2011-09-14 02:31:02 +00:00
|
|
|
procedure ComplexType_Class_Choice();
|
|
|
|
procedure ComplexType_Class_Choice2();
|
|
|
|
procedure ComplexType_Class_Choice3();
|
|
|
|
procedure ComplexType_Class_Choice4();
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure ComplexType_Class_SameNameOfElementAndAttributeSchema();
|
|
|
|
procedure ComplexType_Class_Group();
|
|
|
|
procedure ComplexType_Class_Group_use();
|
|
|
|
procedure ComplexType_Class_Group_use_forwarded();
|
|
|
|
procedure ComplexType_Class_Group_multi_use();
|
|
|
|
procedure ComplexType_Class_Group_use_forwarded_type();
|
|
|
|
procedure ComplexType_Class_Group_use_array();
|
|
|
|
procedure ComplexType_Class_Group_use_array_choice();
|
2016-07-20 19:41:11 +00:00
|
|
|
procedure ComplexType_Class_Group_ref_use_array();
|
|
|
|
procedure ComplexType_Class_Group_ref_use_array2();
|
|
|
|
procedure ComplexType_Class_Group_ref_use_array3();
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure ComplexType_Class_AttGroup();
|
|
|
|
procedure ComplexType_Class_AttGroup_use();
|
|
|
|
procedure ComplexType_Class_AttGroup_use_forwarded();
|
|
|
|
procedure ComplexType_Class_AttGroup_multi_use();
|
|
|
|
procedure ComplexType_Class_AttGroup_use_forwarded_type();
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
procedure ComplexType_Record();
|
2007-09-16 00:31:45 +00:00
|
|
|
procedure ComplexType_Record_Embedded();
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure ComplexType_Mixed();
|
|
|
|
procedure ComplexType_Mixed2();
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
procedure ComplexType_ArraySequence();
|
2009-05-29 15:19:58 +00:00
|
|
|
procedure ComplexType_ArraySequence_ItemName_Schema();
|
2007-09-10 22:19:20 +00:00
|
|
|
procedure ComplexType_ArraySequence_Embedded();
|
2008-09-10 01:19:04 +00:00
|
|
|
procedure ComplexType_Array_soaparray();
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
procedure ComplexType_CollectionSequence();
|
|
|
|
procedure pascal_class_default_parent();
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2008-09-11 00:44:56 +00:00
|
|
|
procedure class_headerblock_derived();
|
|
|
|
procedure class_headerblock_simplecontent_derived();
|
2008-09-17 01:45:04 +00:00
|
|
|
procedure class_widestring_property();
|
2009-01-19 17:46:33 +00:00
|
|
|
procedure class_ansichar_property();
|
|
|
|
procedure class_widechar_property();
|
2009-10-07 17:41:09 +00:00
|
|
|
procedure class_currency_property();
|
2010-10-01 20:44:10 +00:00
|
|
|
procedure class_property_composed_name();
|
2009-11-23 17:55:10 +00:00
|
|
|
procedure schema_import();
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure schema_include();
|
|
|
|
procedure schema_include_parent_no_types();
|
|
|
|
procedure schema_include_fail_namespace();
|
|
|
|
procedure schema_include_circular1();
|
|
|
|
procedure schema_include_circular2();
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure schema_default_elt_att_form();
|
|
|
|
procedure schema_default_elt_qualified_form();
|
|
|
|
procedure schema_default_att_unqualified_form();
|
|
|
|
procedure schema_default_elt_att_form_present();
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
procedure case_sensitive();
|
|
|
|
procedure case_sensitive2();
|
|
|
|
procedure case_sensitive_import();
|
2013-03-05 15:48:26 +00:00
|
|
|
|
|
|
|
procedure global_attribute();
|
2016-04-23 15:02:11 +00:00
|
|
|
procedure att_inherited_maxbound();
|
2016-05-04 12:32:49 +00:00
|
|
|
procedure embedded_unbounded_choice();
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
{ TTest_XsdParser }
|
|
|
|
|
|
|
|
TTest_XsdParser = class(TTest_CustomXsdParser)
|
2011-09-14 02:31:02 +00:00
|
|
|
protected
|
|
|
|
function ParseDoc(const ADoc : string; const ACaseSensistive : Boolean) : TwstPasTreeContainer;override;
|
2007-09-09 22:30:50 +00:00
|
|
|
protected
|
|
|
|
function LoadEmptySchema() : TwstPasTreeContainer;override;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadSimpleType_Enum_Embedded_Schema() : TwstPasTreeContainer;override;
|
2007-10-19 15:30:20 +00:00
|
|
|
function LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;override;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function LoadComplexType_Class_Schema() : TwstPasTreeContainer;override;
|
2008-06-06 15:04:35 +00:00
|
|
|
function LoadComplexType_Class_default_values() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_properties_extended_metadata() : TwstPasTreeContainer;override;
|
2008-09-29 12:35:06 +00:00
|
|
|
function LoadComplexType_Class_properties_extended_metadata2() : TwstPasTreeContainer;override;
|
2007-09-09 22:30:50 +00:00
|
|
|
function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;override;
|
2007-12-29 00:58:19 +00:00
|
|
|
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override;
|
2008-10-23 19:21:59 +00:00
|
|
|
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override;
|
2009-05-29 15:19:58 +00:00
|
|
|
function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override;
|
2011-09-14 02:31:02 +00:00
|
|
|
function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override;
|
2015-07-15 16:02:12 +00:00
|
|
|
function LoadComplexType_Class_SameNameOfElementAndAttributeSchema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group2() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group3() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group4() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group5() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group6() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group7() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;override;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
|
|
|
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override;
|
2007-09-16 00:31:45 +00:00
|
|
|
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override;
|
2015-07-15 16:02:12 +00:00
|
|
|
function LoadComplexType_Mixed() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Mixed2() : TwstPasTreeContainer;override;
|
2008-06-06 15:04:35 +00:00
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override;
|
2009-05-29 15:19:58 +00:00
|
|
|
function LoadComplexType_ArraySequence_ItemName_Schema() : TwstPasTreeContainer; override;
|
2007-09-10 22:19:20 +00:00
|
|
|
function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override;
|
2008-09-10 01:19:04 +00:00
|
|
|
function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;override;
|
2008-08-01 21:38:55 +00:00
|
|
|
|
|
|
|
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override;
|
|
|
|
|
|
|
|
function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override;
|
2008-09-11 00:44:56 +00:00
|
|
|
|
|
|
|
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override;
|
2008-09-17 01:45:04 +00:00
|
|
|
function load_class_widestring_property() : TwstPasTreeContainer;override;
|
2009-01-19 17:46:33 +00:00
|
|
|
function load_class_ansichar_property() : TwstPasTreeContainer;override;
|
|
|
|
function load_class_widechar_property() : TwstPasTreeContainer;override;
|
2009-10-07 17:41:09 +00:00
|
|
|
function load_class_currency_property() : TwstPasTreeContainer;override;
|
2010-10-01 20:44:10 +00:00
|
|
|
function load_class_property_composed_name() : TwstPasTreeContainer;override;
|
2009-11-23 17:55:10 +00:00
|
|
|
|
|
|
|
function load_schema_import() : TwstPasTreeContainer;override;
|
2011-08-29 02:59:57 +00:00
|
|
|
function load_schema_include() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_include_parent_no_types() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_include_fail_namespace() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_include_circular1() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_include_circular2() : TwstPasTreeContainer;override;
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
function load_schema_case_sensitive() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_case_sensitive2() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_case_sensitive_import() : TwstPasTreeContainer;override;
|
2015-07-15 16:02:12 +00:00
|
|
|
function load_schema_default_elt_att_form() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_default_elt_qualified_form() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_default_att_unqualified_form() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_default_elt_att_form_present() : TwstPasTreeContainer;override;
|
2013-03-05 15:48:26 +00:00
|
|
|
|
|
|
|
function load_global_attribute() : TwstPasTreeContainer;override;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
2008-06-06 15:04:35 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
{ TTest_WsdlParser }
|
|
|
|
|
|
|
|
TTest_WsdlParser = class(TTest_CustomXsdParser)
|
|
|
|
private
|
2011-09-14 02:31:02 +00:00
|
|
|
function ParseDoc(const ADoc : string; const ACaseSensitive : Boolean) : TwstPasTreeContainer;override;
|
2007-09-09 22:30:50 +00:00
|
|
|
protected
|
|
|
|
function LoadEmptySchema() : TwstPasTreeContainer;override;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;override;
|
2008-06-06 15:04:35 +00:00
|
|
|
function LoadComplexType_Class_default_values() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_properties_extended_metadata() : TwstPasTreeContainer;override;
|
2008-09-29 12:35:06 +00:00
|
|
|
function LoadComplexType_Class_properties_extended_metadata2() : TwstPasTreeContainer;override;
|
2007-09-09 22:30:50 +00:00
|
|
|
function LoadSimpleType_Enum_Embedded_Schema() : TwstPasTreeContainer;override;
|
2007-10-19 15:30:20 +00:00
|
|
|
function LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;override;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function LoadComplexType_Class_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;override;
|
2007-12-29 00:58:19 +00:00
|
|
|
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override;
|
2008-10-23 19:21:59 +00:00
|
|
|
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override;
|
2009-05-29 15:19:58 +00:00
|
|
|
function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override;
|
2011-09-14 02:31:02 +00:00
|
|
|
function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override;
|
2015-07-15 16:02:12 +00:00
|
|
|
function LoadComplexType_Class_SameNameOfElementAndAttributeSchema() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group2() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group3() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group4() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group5() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group6() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_Group7() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;override;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
|
|
|
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override;
|
2007-09-16 00:31:45 +00:00
|
|
|
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override;
|
2015-07-15 16:02:12 +00:00
|
|
|
function LoadComplexType_Mixed() : TwstPasTreeContainer;override;
|
|
|
|
function LoadComplexType_Mixed2() : TwstPasTreeContainer;override;
|
2007-09-10 22:19:20 +00:00
|
|
|
|
|
|
|
function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override;
|
2009-05-29 15:19:58 +00:00
|
|
|
function LoadComplexType_ArraySequence_ItemName_Schema() : TwstPasTreeContainer; override;
|
2007-09-10 22:19:20 +00:00
|
|
|
function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override;
|
2008-09-10 01:19:04 +00:00
|
|
|
function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;override;
|
2008-08-01 21:38:55 +00:00
|
|
|
|
|
|
|
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override;
|
|
|
|
|
|
|
|
function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override;
|
2008-09-11 00:44:56 +00:00
|
|
|
|
|
|
|
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override;
|
|
|
|
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override;
|
2008-09-17 01:45:04 +00:00
|
|
|
function load_class_widestring_property() : TwstPasTreeContainer;override;
|
2009-01-19 17:46:33 +00:00
|
|
|
function load_class_ansichar_property() : TwstPasTreeContainer;override;
|
|
|
|
function load_class_widechar_property() : TwstPasTreeContainer;override;
|
2010-10-01 20:44:10 +00:00
|
|
|
function load_class_currency_property() : TwstPasTreeContainer;override;
|
|
|
|
function load_class_property_composed_name() : TwstPasTreeContainer;override;
|
2009-11-23 17:55:10 +00:00
|
|
|
|
|
|
|
function load_schema_import() : TwstPasTreeContainer;override;
|
2011-08-29 02:59:57 +00:00
|
|
|
function load_schema_include() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_include_parent_no_types() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_include_fail_namespace() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_include_circular1() : TwstPasTreeContainer;override;
|
2011-09-14 02:31:02 +00:00
|
|
|
function load_schema_include_circular2() : TwstPasTreeContainer;override;
|
|
|
|
|
|
|
|
function load_schema_case_sensitive() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_case_sensitive2() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_case_sensitive_import() : TwstPasTreeContainer;override;
|
2015-07-15 16:02:12 +00:00
|
|
|
function load_schema_default_elt_att_form() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_default_elt_qualified_form() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_default_att_unqualified_form() : TwstPasTreeContainer;override;
|
|
|
|
function load_schema_default_elt_att_form_present() : TwstPasTreeContainer;override;
|
2013-03-05 15:48:26 +00:00
|
|
|
|
|
|
|
function load_global_attribute() : TwstPasTreeContainer;override;
|
2007-10-19 15:30:20 +00:00
|
|
|
published
|
|
|
|
procedure no_binding_style();
|
2008-09-10 01:19:04 +00:00
|
|
|
procedure signature_last();
|
|
|
|
procedure signature_result();
|
|
|
|
procedure signature_return();
|
2008-10-17 20:31:55 +00:00
|
|
|
procedure xsd_not_declared_at_top_node();
|
|
|
|
procedure xsd_not_declared_at_top_node_2();
|
2009-04-06 22:25:04 +00:00
|
|
|
procedure message_parts_type_hint();
|
2009-06-30 16:40:19 +00:00
|
|
|
procedure parameter_var();
|
|
|
|
procedure parameter_const_default();
|
2010-10-01 20:44:10 +00:00
|
|
|
procedure parameter_composed_name();
|
|
|
|
procedure parameter_composed_name_function();
|
2016-02-16 19:35:06 +00:00
|
|
|
procedure method_composed_name();
|
2010-07-02 15:33:29 +00:00
|
|
|
procedure soap_action();
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
2009-11-23 17:55:10 +00:00
|
|
|
uses parserutils, xsd_consts, typinfo, locators;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
const
|
2007-09-10 22:19:20 +00:00
|
|
|
x_complexType_SampleArrayIntFieldType = 'TArrayIntFieldType';
|
|
|
|
x_complexType_SampleArrayItemType = 'TArrayItemType';
|
2008-08-01 21:38:55 +00:00
|
|
|
|
|
|
|
x_complexType_SampleCollectionComplexType = 'TComplexType';
|
|
|
|
x_complexType_SampleCollectionCollectionComplexType = 'TCollectionComplexType';
|
|
|
|
x_complexType_SampleCollectionItemType = 'TCollectionItemType';
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
x_complexType_SampleDerivedType = 'TClassSampleDerivedType';
|
|
|
|
x_complexType_SampleClassType = 'TClassSampleType';
|
2007-12-29 00:58:19 +00:00
|
|
|
x_complexType_SampleClassTypeA = 'TClassSampleTypeA';
|
2007-09-10 22:19:20 +00:00
|
|
|
x_complexType_SampleClassTypeAll = 'TClassSampleTypeAll';
|
|
|
|
x_complexType_SampleClass = 'TClassSample';
|
|
|
|
|
|
|
|
x_complexType_SampleRecordType = 'TRecordSampleType';
|
|
|
|
x_complexType_SampleRecordTypeAll = 'TRecordSampleTypeAll';
|
|
|
|
x_complexType_SampleRecord = 'TRecordSample';
|
|
|
|
|
|
|
|
x_complexType_array_sequence = 'complex_array_sequence';
|
|
|
|
x_complexType_array_sequence_embedded = 'complex_array_sequence_embedded';
|
2008-08-01 21:38:55 +00:00
|
|
|
x_complexType_array_sequence_collection = 'complex_array_sequence_collection';
|
2008-09-10 01:19:04 +00:00
|
|
|
x_complexType_array_soaparray = 'complex_array_soaparray';
|
2008-08-01 21:38:55 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
x_complexType_class = 'complex_class';
|
2008-06-06 15:04:35 +00:00
|
|
|
x_complexType_class_default = 'complex_class_default';
|
|
|
|
x_complexType_class_properties_extended_metadata = 'class_properties_extended_metadata';
|
2007-12-29 00:58:19 +00:00
|
|
|
x_complexType_extend_simple = 'complex_class_extend_simple';
|
2007-09-09 22:30:50 +00:00
|
|
|
x_complexType_class_embedded = 'complex_class_embedded';
|
2007-09-10 22:19:20 +00:00
|
|
|
x_complexType_record = 'complex_record';
|
|
|
|
x_complexType_record_embedded = 'complex_record_embedded';
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
x_empty = 'empty';
|
|
|
|
|
|
|
|
x_enumSample = 'EnumSample';
|
|
|
|
x_enumSampleType = 'EnumSampleType';
|
|
|
|
x_enumSampleLIST_COUNT = 7;
|
|
|
|
x_enumSampleLIST : array[0..( x_enumSampleLIST_COUNT - 1 )] of string = ( 'esOne', 'esTwo', 'esThree', 'begin', 'finally', 'True', 'False' );
|
2007-10-19 15:30:20 +00:00
|
|
|
x_simpleTypeAliasString = 'AliasString';
|
|
|
|
x_simpleTypeAliasInt = 'AliasInt';
|
2009-04-07 16:28:22 +00:00
|
|
|
x_simpleTypeAliasWideString = 'AliasWideString';
|
2007-09-09 22:30:50 +00:00
|
|
|
x_simpleType = 'simpletype';
|
|
|
|
x_simpleTypeEmbedded = 'simpletype_embedded';
|
2007-10-19 15:30:20 +00:00
|
|
|
x_simpletypeNativeAlias = 'simpletypeNativeAlias';
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
x_targetNamespace = 'urn:wst-test';
|
|
|
|
|
|
|
|
|
|
|
|
x_byteField = 'byteField';
|
|
|
|
x_charField = 'charField';
|
|
|
|
x_classField = 'classField';
|
|
|
|
x_enumField = 'enumField';
|
2008-08-01 21:38:55 +00:00
|
|
|
x_field = 'field';
|
2007-09-09 22:30:50 +00:00
|
|
|
x_floatField = 'floatField';
|
|
|
|
x_intField = 'intField';
|
|
|
|
x_longField = 'longField';
|
|
|
|
x_strField = 'strField';
|
|
|
|
|
|
|
|
x_intAtt = 'intAtt';
|
|
|
|
x_strAtt = 'strAtt';
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
x_Item = 'Item';
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
function LoadXmlFile(const AFileName : string) : TXMLDocument;
|
|
|
|
begin
|
2012-08-13 20:40:08 +00:00
|
|
|
Result := ReadXMLFile(AFileName);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
{ TTest_CustomXsdParser }
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
function TTest_CustomXsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(ADoc,False);
|
2011-11-15 19:11:17 +00:00
|
|
|
Result.DefaultSearchNameKinds := NAME_KINDS_DEFAULT;
|
2011-09-14 02:31:02 +00:00
|
|
|
end;
|
|
|
|
|
2016-07-20 19:41:11 +00:00
|
|
|
function TTest_CustomXsdParser.LoadComplexType_Class_Group8() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group8');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_CustomXsdParser.LoadComplexType_Class_Group9 : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group9');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_CustomXsdParser.LoadComplexType_Class_Group10 : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group10');
|
|
|
|
end;
|
|
|
|
|
2016-04-23 15:02:11 +00:00
|
|
|
function TTest_CustomXsdParser.load_att_inherited_maxbound : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('att_inherited_maxbound');
|
|
|
|
end;
|
|
|
|
|
2016-05-04 12:32:49 +00:00
|
|
|
function TTest_CustomXsdParser.load_embedded_unbounded_choice : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('embedded_unbounded_choice');
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
procedure TTest_CustomXsdParser.EmptySchema();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
begin
|
|
|
|
tr := LoadEmptySchema();
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_empty,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
CheckEquals(0,mdl.InterfaceSection.Declarations.Count);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.SimpleType_Enum();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-09 22:30:50 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
enumType : TPasEnumType;
|
|
|
|
enumVal : TPasEnumValue;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
begin
|
|
|
|
tr := LoadSimpleType_Enum_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_simpleType,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count);
|
|
|
|
elt := tr.FindElement(x_enumSampleType);
|
|
|
|
CheckNotNull(elt,x_enumSampleType);
|
|
|
|
CheckEquals(x_enumSampleType,elt.Name);
|
|
|
|
CheckEquals(x_enumSampleType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
enumType := elt as TPasEnumType;
|
|
|
|
CheckEquals(x_enumSampleLIST_COUNT,enumType.Values.Count);
|
|
|
|
for i := 0 to Pred(x_enumSampleLIST_COUNT) do begin
|
|
|
|
enumVal := TPasEnumValue(enumType.Values[i]);
|
|
|
|
CheckNotNull(enumVal);
|
|
|
|
if IsReservedKeyWord(x_enumSampleLIST[i]) then begin
|
|
|
|
CheckEquals(Format('%s_%s',[enumType.Name,x_enumSampleLIST[i]]),enumVal.Name);
|
|
|
|
end else begin
|
|
|
|
CheckEquals(x_enumSampleLIST[i],enumVal.Name);
|
|
|
|
end;
|
|
|
|
CheckEquals(x_enumSampleLIST[i],tr.GetExternalName(enumVal));
|
|
|
|
end;
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
elt := tr.FindElement(x_enumSample);
|
|
|
|
CheckNotNull(elt,x_enumSample);
|
|
|
|
CheckEquals(x_enumSample,elt.Name);
|
|
|
|
CheckEquals(x_enumSample,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
aliasType := elt as TPasAliasType;
|
|
|
|
CheckNotNull(aliasType.DestType);
|
|
|
|
CheckEquals(x_enumSampleType, tr.GetExternalName(aliasType.DestType));
|
2009-07-16 17:39:56 +00:00
|
|
|
|
|
|
|
FreeAndNil(tr);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.SimpleType_Enum_Embedded();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-09 22:30:50 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
enumType : TPasEnumType;
|
|
|
|
enumVal : TPasEnumValue;
|
|
|
|
i : Integer;
|
|
|
|
begin
|
|
|
|
tr := LoadSimpleType_Enum_Embedded_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_simpleTypeEmbedded,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement(x_enumSampleType);
|
|
|
|
CheckNotNull(elt,x_enumSampleType);
|
|
|
|
CheckEquals(x_enumSampleType,elt.Name);
|
|
|
|
CheckEquals(x_enumSampleType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
enumType := elt as TPasEnumType;
|
|
|
|
CheckEquals(x_enumSampleLIST_COUNT,enumType.Values.Count);
|
|
|
|
for i := 0 to Pred(x_enumSampleLIST_COUNT) do begin
|
|
|
|
enumVal := TPasEnumValue(enumType.Values[i]);
|
|
|
|
CheckNotNull(enumVal);
|
|
|
|
if IsReservedKeyWord(x_enumSampleLIST[i]) then begin
|
|
|
|
CheckEquals(Format('%s_%s',[enumType.Name,x_enumSampleLIST[i]]),enumVal.Name);
|
|
|
|
end else begin
|
|
|
|
CheckEquals(x_enumSampleLIST[i],enumVal.Name);
|
|
|
|
end;
|
|
|
|
CheckEquals(x_enumSampleLIST[i],tr.GetExternalName(enumVal));
|
|
|
|
end;
|
2009-07-16 17:39:56 +00:00
|
|
|
|
|
|
|
FreeAndNil(tr);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
2007-10-19 15:30:20 +00:00
|
|
|
procedure TTest_CustomXsdParser.SimpleType_AliasToNativeType();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-10-19 15:30:20 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
begin
|
|
|
|
tr := LoadSimpleType_AliasToNativeType_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_simpletypeNativeAlias,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
2009-04-07 16:28:22 +00:00
|
|
|
CheckEquals(3,ls.Count);
|
2007-10-19 15:30:20 +00:00
|
|
|
elt := tr.FindElement(x_simpleTypeAliasString);
|
|
|
|
CheckNotNull(elt,x_simpleTypeAliasString);
|
|
|
|
CheckEquals(x_simpleTypeAliasString,elt.Name);
|
|
|
|
CheckEquals(x_simpleTypeAliasString,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
aliasType := elt as TPasAliasType;
|
|
|
|
CheckNotNull(aliasType.DestType);
|
|
|
|
Check(tr.SameName(aliasType.DestType,'string'));
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_simpleTypeAliasInt);
|
|
|
|
CheckNotNull(elt,x_simpleTypeAliasInt);
|
|
|
|
CheckEquals(x_simpleTypeAliasInt,elt.Name);
|
|
|
|
CheckEquals(x_simpleTypeAliasInt,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
aliasType := elt as TPasAliasType;
|
|
|
|
CheckNotNull(aliasType.DestType);
|
|
|
|
Check(tr.SameName(aliasType.DestType,'int'));
|
2009-04-07 16:28:22 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement(x_simpleTypeAliasWideString);
|
|
|
|
CheckNotNull(elt,x_simpleTypeAliasWideString);
|
|
|
|
CheckEquals(x_simpleTypeAliasWideString,elt.Name);
|
|
|
|
CheckEquals(x_simpleTypeAliasWideString,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
aliasType := elt as TPasAliasType;
|
|
|
|
CheckNotNull(aliasType.DestType);
|
|
|
|
CheckIs(aliasType.DestType,TPasNativeSimpleType);
|
|
|
|
CheckEquals('WideString',aliasType.DestType.Name);
|
2009-07-16 17:39:56 +00:00
|
|
|
|
|
|
|
FreeAndNil(tr);
|
2007-10-19 15:30:20 +00:00
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
type
|
|
|
|
TPropertyType = ( ptField, ptAttribute );
|
|
|
|
const
|
|
|
|
PropertyType_Att : array[TPropertyType] of Boolean = ( False, True );
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
2008-06-06 15:04:35 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
2008-06-06 15:04:35 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-09 22:30:50 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2007-09-09 22:30:50 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_class,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
2007-09-10 22:19:20 +00:00
|
|
|
CheckEquals(4,ls.Count);
|
2007-09-09 22:30:50 +00:00
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClass);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClass);
|
|
|
|
CheckEquals(x_complexType_SampleClass,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClass,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
aliasType := elt as TPasAliasType;
|
|
|
|
CheckNotNull(aliasType.DestType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType, tr.GetExternalName(aliasType.DestType));
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassTypeAll);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassTypeAll);
|
|
|
|
CheckEquals(x_complexType_SampleClassTypeAll,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassTypeAll,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
elt := tr.FindElement(x_complexType_SampleDerivedType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleDerivedType);
|
|
|
|
CheckEquals(x_complexType_SampleDerivedType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleDerivedType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(clsType.AncestorType));
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(4,prpLs.Count);
|
|
|
|
CheckProperty(x_intField + 'Ex','int',ptField);
|
|
|
|
CheckProperty(x_strField + 'Ex','string',ptField);
|
|
|
|
CheckProperty(x_strAtt + 'Ex','string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt + 'Ex','int',ptAttribute);
|
2007-09-09 22:30:50 +00:00
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Embedded();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
nestedClassName, nestedEnumName : string;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,ATypeName : string;
|
|
|
|
const AFieldType : TPropertyType;
|
|
|
|
const AClsType : TPasClassType
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(AClsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CheckEmbeddedClassType();
|
|
|
|
var
|
|
|
|
e : TPasElement;
|
|
|
|
k : Integer;
|
|
|
|
prpLst : TList;
|
|
|
|
nestedClsType : TPasClassType;
|
|
|
|
begin
|
|
|
|
prpLst := TList.Create();
|
|
|
|
try
|
|
|
|
nestedClassName := Format('%s_%s_Type',[x_complexType_SampleClassType,x_classField]);
|
|
|
|
e := tr.FindElement(nestedClassName);
|
|
|
|
CheckNotNull(e,nestedClassName);
|
|
|
|
CheckEquals(nestedClassName,e.Name);
|
|
|
|
CheckEquals(nestedClassName,tr.GetExternalName(e));
|
|
|
|
CheckIs(e,TPasClassType);
|
|
|
|
nestedClsType := e as TPasClassType;
|
|
|
|
for k := 0 to Pred(nestedClsType.Members.Count) do begin
|
|
|
|
if TPasElement(nestedClsType.Members[k]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLst.Add(nestedClsType.Members[k]);
|
|
|
|
end;
|
|
|
|
CheckEquals(4,prpLst.Count,nestedClassName + ' properties count.');
|
|
|
|
CheckProperty(x_intField + 'E','int',ptField,nestedClsType);
|
|
|
|
CheckProperty(x_strField + 'E','string',ptField,nestedClsType);
|
|
|
|
CheckProperty(x_strAtt + 'E','string',ptAttribute,nestedClsType);
|
|
|
|
CheckProperty(x_intAtt + 'E','int',ptAttribute,nestedClsType);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLst);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CheckEmbeddedEnum();
|
|
|
|
var
|
|
|
|
e : TPasElement;
|
|
|
|
enumType : TPasEnumType;
|
|
|
|
enumVal : TPasEnumValue;
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
nestedEnumName := Format('%s_%s_Type',[x_complexType_SampleClassType,x_enumField]);
|
|
|
|
e := tr.FindElement(nestedEnumName);
|
|
|
|
CheckNotNull(e,nestedEnumName);
|
|
|
|
CheckEquals(nestedEnumName,e.Name);
|
|
|
|
CheckEquals(nestedEnumName,tr.GetExternalName(e));
|
|
|
|
CheckIs(e,TPasEnumType);
|
|
|
|
enumType := e as TPasEnumType;
|
|
|
|
CheckEquals(x_enumSampleLIST_COUNT,enumType.Values.Count);
|
|
|
|
for k := 0 to Pred(x_enumSampleLIST_COUNT) do begin
|
|
|
|
enumVal := TPasEnumValue(enumType.Values[k]);
|
|
|
|
CheckNotNull(enumVal,'Enum value');
|
|
|
|
if IsReservedKeyWord(x_enumSampleLIST[k]) then begin
|
|
|
|
CheckEquals(Format('%s_%s',[enumType.Name,x_enumSampleLIST[k]]),enumVal.Name);
|
|
|
|
end else begin
|
|
|
|
CheckEquals(x_enumSampleLIST[k],enumVal.Name);
|
|
|
|
end;
|
|
|
|
CheckEquals(x_enumSampleLIST[k],tr.GetExternalName(enumVal));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
clsType : TPasClassType;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-09 22:30:50 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2007-09-09 22:30:50 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Embedded_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_class_embedded,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
|
|
|
|
CheckEmbeddedClassType();
|
|
|
|
CheckEmbeddedEnum();
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(10,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField,clsType);
|
|
|
|
CheckProperty(x_strField,'string',ptField,clsType);
|
|
|
|
CheckProperty(x_floatField,'float',ptField,clsType);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField,clsType);
|
|
|
|
CheckProperty(x_charField,'char',ptField,clsType);
|
|
|
|
CheckProperty(x_longField,'long',ptField,clsType);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute,clsType);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute,clsType);
|
|
|
|
CheckProperty(x_classField,nestedClassName,ptField,clsType);
|
|
|
|
CheckProperty(x_enumField,nestedEnumName,ptField,clsType);
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-12-29 00:58:19 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Extend_Simple_Schema();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-12-29 00:58:19 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
2008-08-01 21:38:55 +00:00
|
|
|
tr := nil;
|
2007-12-29 00:58:19 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Extend_Simple_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_extend_simple,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
2008-08-01 21:38:55 +00:00
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType is null');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckSame(tr.FindElementNS('TComplexUnicodeStringContentRemotable',sXSD_NS),clsType.AncestorType,clsType.AncestorType.Name);
|
2008-08-01 21:38:55 +00:00
|
|
|
|
2007-12-29 00:58:19 +00:00
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(1,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptAttribute);
|
|
|
|
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassTypeA);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassTypeA);
|
|
|
|
CheckEquals(x_complexType_SampleClassTypeA,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassTypeA,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
2008-08-01 21:38:55 +00:00
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType is null');
|
|
|
|
CheckSame(tr.FindElementNS('TBase64StringExtRemotable',sXSD_NS),clsType.AncestorType);
|
|
|
|
|
2007-12-29 00:58:19 +00:00
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(1,prpLs.Count);
|
|
|
|
CheckProperty(x_floatField,'float',ptAttribute);
|
|
|
|
finally
|
2008-08-01 21:38:55 +00:00
|
|
|
tr.Free();
|
2007-12-29 00:58:19 +00:00
|
|
|
FreeAndNil(prpLs);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-10-23 19:21:59 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_open_type_any();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
strBuffer : string;
|
|
|
|
ls : TStringList;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_Class_OpenType();
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
elt := tr.FindElement('TClass_1');
|
|
|
|
CheckNotNull(elt,'TClass_1');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_any]));
|
|
|
|
Check(Length(strBuffer) > 0, s_any);
|
|
|
|
ls := TStringList.Create();
|
|
|
|
try
|
|
|
|
ls.Delimiter := ';';
|
|
|
|
ls.DelimitedText := strBuffer;
|
|
|
|
CheckEquals('lax',ls.Values[s_processContents]);
|
|
|
|
CheckEquals('0',ls.Values[s_minOccurs]);
|
|
|
|
CheckEquals(s_unbounded,ls.Values[s_maxOccurs]);
|
|
|
|
finally
|
|
|
|
ls.Free();
|
|
|
|
end;
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-10-23 19:21:59 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_open_extension_type_any();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
strBuffer : string;
|
|
|
|
ls : TStringList;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_Class_OpenType();
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
elt := tr.FindElement('TClassSampleDerivedType');
|
|
|
|
CheckNotNull(elt,'TClassSampleDerivedType');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_any]));
|
|
|
|
Check(Length(strBuffer) > 0, s_any);
|
|
|
|
ls := TStringList.Create();
|
|
|
|
try
|
|
|
|
ls.Delimiter := ';';
|
|
|
|
ls.DelimitedText := strBuffer;
|
|
|
|
CheckEquals('skip',ls.Values[s_processContents]);
|
|
|
|
CheckEquals(s_unbounded,ls.Values[s_maxOccurs]);
|
|
|
|
finally
|
|
|
|
ls.Free();
|
|
|
|
end;
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-10-23 19:21:59 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_open_extension_type_anyAttribute();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
strBuffer : string;
|
|
|
|
ls : TStringList;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_Class_OpenType();
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
elt := tr.FindElement('TClassSampleDerivedType');
|
|
|
|
CheckNotNull(elt,'TClassSampleDerivedType');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_anyAttribute]));
|
|
|
|
Check(Length(strBuffer) > 0, s_anyAttribute);
|
|
|
|
ls := TStringList.Create();
|
|
|
|
try
|
|
|
|
ls.Delimiter := ';';
|
|
|
|
ls.DelimitedText := strBuffer;
|
|
|
|
CheckEquals('lax',ls.Values[s_processContents]);
|
|
|
|
finally
|
|
|
|
ls.Free();
|
|
|
|
end;
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-10-23 19:21:59 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_sequence_open_type_anyAttribute();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
strBuffer : string;
|
|
|
|
ls : TStringList;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_Class_OpenType();
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
elt := tr.FindElement('TClass_1');
|
|
|
|
CheckNotNull(elt,'TClass_1');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_anyAttribute]));
|
|
|
|
Check(Length(strBuffer) > 0, s_anyAttribute);
|
|
|
|
ls := TStringList.Create();
|
|
|
|
try
|
|
|
|
ls.Delimiter := ';';
|
|
|
|
ls.DelimitedText := strBuffer;
|
|
|
|
CheckEquals('strict',ls.Values[s_processContents]);
|
|
|
|
finally
|
|
|
|
ls.Free();
|
|
|
|
end;
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-10-23 19:21:59 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_all_open_type_anyAttribute();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
strBuffer : string;
|
|
|
|
ls : TStringList;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_Class_OpenType();
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
elt := tr.FindElement('TClassSampleTypeAll');
|
|
|
|
CheckNotNull(elt,'TClassSampleTypeAll');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_anyAttribute]));
|
|
|
|
Check(Length(strBuffer) > 0, s_anyAttribute);
|
|
|
|
ls := TStringList.Create();
|
|
|
|
try
|
|
|
|
ls.Delimiter := ';';
|
|
|
|
ls.DelimitedText := strBuffer;
|
|
|
|
CheckEquals('skip',ls.Values[s_processContents]);
|
|
|
|
finally
|
|
|
|
ls.Free();
|
|
|
|
end;
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-10-23 19:21:59 +00:00
|
|
|
end;
|
|
|
|
|
2009-05-29 15:19:58 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_FalseArray();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2009-05-29 15:19:58 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2009-05-29 15:19:58 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_FalseArray();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('complex_class_false_array',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleDerivedType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleDerivedType);
|
|
|
|
CheckEquals(x_complexType_SampleDerivedType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleDerivedType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(clsType.AncestorType));
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(1,prpLs.Count);
|
|
|
|
prp := TPasProperty(prpLs[0]);
|
|
|
|
CheckIs(prp.VarType,TPasArrayType);
|
|
|
|
CheckEquals(x_intField + 'Ex', tr.GetArrayItemExternalName(TPasArrayType(prp.VarType)));
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2009-05-29 15:19:58 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Choice();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-09-14 02:31:02 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Choice_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('complex_class_choice',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement('TSampleType1');
|
|
|
|
CheckNotNull(elt,'TSampleType1');
|
|
|
|
CheckEquals('TSampleType1',elt.Name);
|
|
|
|
CheckEquals('TSampleType1',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Choice2();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
prpType : TPasArrayType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckIs(prp.VarType,TPasArrayType);
|
|
|
|
prpType := TPasArrayType(prp.VarType);
|
|
|
|
CheckNotNull(prpType.ElType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prpType.ElType));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-09-14 02:31:02 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Choice2_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('complex_class_choice2',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
elt := tr.FindElement('TSampleType1');
|
|
|
|
CheckNotNull(elt,'TSampleType1');
|
|
|
|
CheckEquals('TSampleType1',elt.Name);
|
|
|
|
CheckEquals('TSampleType1',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int');
|
|
|
|
CheckProperty(x_strField,'string');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Choice3();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-09-14 02:31:02 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Choice3_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('complex_class_choice3',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement('TSampleType1');
|
|
|
|
CheckNotNull(elt,'TSampleType1');
|
|
|
|
CheckEquals('TSampleType1',elt.Name);
|
|
|
|
CheckEquals('TSampleType1',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(4,prpLs.Count);
|
|
|
|
CheckProperty('intField1','int',ptField);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty('dateField','date',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Choice4();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-09-14 02:31:02 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Choice4_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('complex_class_choice4',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement('TSampleType1');
|
|
|
|
CheckNotNull(elt,'TSampleType1');
|
|
|
|
CheckEquals('TSampleType1',elt.Name);
|
|
|
|
CheckEquals('TSampleType1',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(4,prpLs.Count);
|
|
|
|
CheckProperty('intField1','int',ptField);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty('dateField','date',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_SameNameOfElementAndAttributeSchema();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,ATypeName : string; const AFieldType : TPropertyType;
|
|
|
|
const AExternalName : string = ''
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
if IsStrEmpty(AExternalName) then
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp))
|
|
|
|
else
|
|
|
|
CheckEquals(AExternalName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_SameNameOfElementAndAttributeSchema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule('complex_class_same_name_elt_att');
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('complex_class_same_name_elt_att',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty('SomeField','int',ptField);
|
|
|
|
CheckProperty('SomeFieldAtt','string',ptAttribute,'SomeField');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count,'Declarations.Count');
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_use();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group2();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(5,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_forwarded();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group3();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(5,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_multi_use();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group4();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TJobGroupType');
|
|
|
|
CheckNotNull(elt,'TJobGroupType');
|
|
|
|
CheckEquals('TJobGroupType',elt.Name);
|
|
|
|
CheckEquals('TJobGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TJobGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty('jobPosition','string',ptField);
|
|
|
|
CheckProperty('employer','string',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+3+2),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
CheckProperty('jobPosition','string',ptField);
|
|
|
|
CheckProperty('employer','string',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_forwarded_type();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group5();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('occupation','TJobType',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TJobType');
|
|
|
|
CheckNotNull(elt,'TJobType');
|
|
|
|
CheckEquals('TJobType',elt.Name);
|
|
|
|
CheckEquals('TJobType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TJobType:'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty('jobPosition','string',ptField);
|
|
|
|
CheckProperty('employer','string',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+3),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('occupation','TJobType',ptField);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_array();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CheckArrayProperty(const AName,ATypeName : string);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
at : TPasArrayType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
|
|
|
|
at := prp.VarType as TPasArrayType;
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group6();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2+1{array def},ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(4,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
CheckArrayProperty('otherName','string');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+4),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
CheckArrayProperty('otherName','string');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_array_choice();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CheckArrayProperty(const AName,ATypeName : string);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
at : TPasArrayType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
|
|
|
|
at := prp.VarType as TPasArrayType;
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group7();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckArrayProperty('firstName','string');
|
|
|
|
CheckArrayProperty('lastName','string');
|
|
|
|
CheckArrayProperty('otherName','string');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+3),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckArrayProperty('firstName','string');
|
|
|
|
CheckArrayProperty('lastName','string');
|
|
|
|
CheckArrayProperty('otherName','string');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2016-07-20 19:41:11 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_ref_use_array();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CheckArrayProperty(const AName,ATypeName : string);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
at : TPasArrayType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
|
|
|
|
at := prp.VarType as TPasArrayType;
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group8();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+3),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckArrayProperty('firstName','string');
|
|
|
|
CheckArrayProperty('lastName','string');
|
|
|
|
CheckArrayProperty('Age','int');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_ref_use_array2();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CheckArrayProperty(const AName,ATypeName : string);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
at : TPasArrayType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
|
|
|
|
at := prp.VarType as TPasArrayType;
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group9();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckArrayProperty('lastName','string');
|
|
|
|
CheckProperty('Age','int',ptField);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+3),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckArrayProperty('firstName','string');
|
|
|
|
CheckArrayProperty('lastName','string');
|
|
|
|
CheckArrayProperty('Age','int');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_Group_ref_use_array3();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CheckArrayProperty(const AName,ATypeName : string);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
at : TPasArrayType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
|
|
|
|
at := prp.VarType as TPasArrayType;
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_Group10();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptField);
|
|
|
|
CheckProperty('lastName','string',ptField);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+3),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckArrayProperty('firstName','string');
|
|
|
|
CheckArrayProperty('lastName','string');
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_AttGroup();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count,'Declarations.Count');
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_use();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_AttGroup2();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(5,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_use_forwarded();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_AttGroup3();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(5,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_multi_use();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_AttGroup4();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(3,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TJobGroupType');
|
|
|
|
CheckNotNull(elt,'TJobGroupType');
|
|
|
|
CheckEquals('TJobGroupType',elt.Name);
|
|
|
|
CheckEquals('TJobGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TJobGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty('jobPosition','string',ptAttribute);
|
|
|
|
CheckProperty('employer','string',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+3+2),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('Age','int',ptAttribute);
|
|
|
|
CheckProperty('jobPosition','string',ptAttribute);
|
|
|
|
CheckProperty('employer','string',ptAttribute);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_use_forwarded_type();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_AttGroup5();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count,'Declarations.Count');
|
|
|
|
|
|
|
|
elt := tr.FindElement('TContactGroupType');
|
|
|
|
CheckNotNull(elt,'TContactGroupType');
|
|
|
|
CheckEquals('TContactGroupType',elt.Name);
|
|
|
|
CheckEquals('TContactGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(4,prpLs.Count);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('jobPosition','string',ptAttribute);
|
|
|
|
CheckProperty('employer','string',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TJobGroupType');
|
|
|
|
CheckNotNull(elt,'TJobGroupType');
|
|
|
|
CheckEquals('TJobGroupType',elt.Name);
|
|
|
|
CheckEquals('TJobGroupType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckTrue((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TJobGroupType:'+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty('jobPosition','string',ptAttribute);
|
|
|
|
CheckProperty('employer','string',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TClassSampleType');
|
|
|
|
CheckNotNull(elt,'TClassSampleType');
|
|
|
|
CheckEquals('TClassSampleType',elt.Name);
|
|
|
|
CheckEquals('TClassSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals((2+4),prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptAttribute);
|
|
|
|
CheckProperty('firstName','string',ptAttribute);
|
|
|
|
CheckProperty('lastName','string',ptAttribute);
|
|
|
|
CheckProperty('jobPosition','string',ptAttribute);
|
|
|
|
CheckProperty('employer','string',ptAttribute);
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Record();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
recType : TPasRecordType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasVariable;
|
|
|
|
begin
|
|
|
|
prp := FindMember(recType,AName) as TPasVariable;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
2007-09-16 00:31:45 +00:00
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp),Format('IsAttributeProperty("%s.%s")',[recType.Name, AName]));
|
2007-09-10 22:19:20 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-10 22:19:20 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2007-09-10 22:19:20 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Record_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_record,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleRecordType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleRecordType);
|
|
|
|
CheckEquals(x_complexType_SampleRecordType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleRecordType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasRecordType,'Element Type');
|
|
|
|
recType := elt as TPasRecordType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(recType.Members.Count) do begin
|
|
|
|
if TPasElement(recType.Members[i]).InheritsFrom(TPasVariable) then
|
|
|
|
prpLs.Add(recType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleRecord);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleRecord);
|
|
|
|
CheckEquals(x_complexType_SampleRecord,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleRecord,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
aliasType := elt as TPasAliasType;
|
|
|
|
CheckNotNull(aliasType.DestType);
|
|
|
|
CheckEquals(x_complexType_SampleRecordType, tr.GetExternalName(aliasType.DestType));
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleRecordTypeAll);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleRecordTypeAll);
|
|
|
|
CheckEquals(x_complexType_SampleRecordTypeAll,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleRecordTypeAll,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasRecordType,'Element type');
|
|
|
|
recType := elt as TPasRecordType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(recType.Members.Count) do begin
|
|
|
|
if TPasElement(recType.Members[i]).InheritsFrom(TPasVariable) then
|
|
|
|
prpLs.Add(recType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2007-09-10 22:19:20 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-09-16 00:31:45 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Record_Embedded();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
recType : TPasRecordType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasVariable;
|
|
|
|
begin
|
|
|
|
prp := FindMember(recType,AName) as TPasVariable;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp),Format('IsAttributeProperty("%s.%s")',[recType.Name, AName]));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-16 00:31:45 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2007-09-16 00:31:45 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Record_Embedded_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_record_embedded,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleRecordType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleRecordType);
|
|
|
|
CheckEquals(x_complexType_SampleRecordType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleRecordType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasRecordType,'Element Type');
|
|
|
|
recType := elt as TPasRecordType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(recType.Members.Count) do begin
|
|
|
|
if TPasElement(recType.Members[i]).InheritsFrom(TPasVariable) then
|
|
|
|
prpLs.Add(recType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleRecordTypeAll);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleRecordTypeAll);
|
|
|
|
CheckEquals(x_complexType_SampleRecordTypeAll,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleRecordTypeAll,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasRecordType,'Element type');
|
|
|
|
recType := elt as TPasRecordType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(recType.Members.Count) do begin
|
|
|
|
if TPasElement(recType.Members[i]).InheritsFrom(TPasVariable) then
|
|
|
|
prpLs.Add(recType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2007-09-16 00:31:45 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Mixed();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Mixed();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count,'Declarations.Count');
|
|
|
|
elt := tr.FindElement('TSampleType');
|
|
|
|
CheckNotNull(elt,'TSampleType');
|
|
|
|
CheckEquals('TSampleType',elt.Name);
|
|
|
|
CheckEquals('TSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType');
|
|
|
|
CheckEquals('TStringBufferRemotable',clsType.AncestorType.Name,'AncestorType.Name');
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(0,prpLs.Count,'Should not have properties.');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Mixed2();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
ls : TList2;
|
|
|
|
elt : TPasElement;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Mixed2();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count,'Declarations.Count');
|
|
|
|
elt := tr.FindElement('TSampleType');
|
|
|
|
CheckNotNull(elt,'TSampleType');
|
|
|
|
CheckEquals('TSampleType',elt.Name);
|
|
|
|
CheckEquals('TSampleType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType');
|
|
|
|
CheckEquals('TStringBufferRemotable',clsType.AncestorType.Name,'AncestorType.Name');
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(0,prpLs.Count,'Should not have properties.');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_ArraySequence();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-10 22:19:20 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
arrayType : TPasArrayType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
nestedClassName : string;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2007-09-10 22:19:20 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_ArraySequence_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_array_sequence,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleArrayIntFieldType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleArrayIntFieldType);
|
|
|
|
CheckEquals(x_complexType_SampleArrayIntFieldType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleArrayIntFieldType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals('int',tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals(x_intField,tr.GetArrayItemName(arrayType));
|
|
|
|
CheckEquals(x_intField,tr.GetArrayItemExternalName(arrayType));
|
|
|
|
|
|
|
|
|
|
|
|
nestedClassName := Format('%s_%s_Type',[x_complexType_SampleArrayItemType,x_Item]);
|
|
|
|
elt := tr.FindElement(nestedClassName);
|
|
|
|
CheckNotNull(elt,nestedClassName);
|
|
|
|
CheckEquals(nestedClassName,elt.Name,'Item Name');
|
|
|
|
CheckEquals(nestedClassName,tr.GetExternalName(elt),'Item ExternalName');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleArrayItemType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleArrayItemType);
|
|
|
|
CheckEquals(x_complexType_SampleArrayItemType,elt.Name, 'Array name');
|
|
|
|
CheckEquals(x_complexType_SampleArrayItemType,tr.GetExternalName(elt), 'Array external name');
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals(nestedClassName,tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals(x_Item,tr.GetArrayItemExternalName(arrayType));
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2007-09-10 22:19:20 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-05-29 15:19:58 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_ArraySequence_ItemName_Schema();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2009-05-29 15:19:58 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
arrayType : TPasArrayType;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_ArraySequence_ItemName_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('array_sequence_item_name',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(2,ls.Count);
|
|
|
|
elt := tr.FindElement('ArrayOfEmailAddress');
|
|
|
|
CheckNotNull(elt,'ArrayOfEmailAddress');
|
|
|
|
CheckEquals('ArrayOfEmailAddress',elt.Name);
|
|
|
|
CheckEquals('ArrayOfEmailAddress',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals('EmailAddress',tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals('EmailAddress',tr.GetArrayItemName(arrayType));
|
|
|
|
CheckEquals('EmailAddress',tr.GetArrayItemExternalName(arrayType));
|
2009-07-16 17:39:56 +00:00
|
|
|
|
|
|
|
FreeAndNil(tr);
|
2009-05-29 15:19:58 +00:00
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_ArraySequence_Embedded();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2007-09-10 22:19:20 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
arrayType : TPasArrayType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
nestedClassName : string;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2007-09-10 22:19:20 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_ArraySequence_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_array_sequence,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleArrayIntFieldType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleArrayIntFieldType);
|
|
|
|
CheckEquals(x_complexType_SampleArrayIntFieldType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleArrayIntFieldType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals('int',tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals(x_intField,tr.GetArrayItemName(arrayType));
|
|
|
|
CheckEquals(x_intField,tr.GetArrayItemExternalName(arrayType));
|
|
|
|
|
|
|
|
|
|
|
|
nestedClassName := Format('%s_%s_Type',[x_complexType_SampleArrayItemType,x_Item]);
|
|
|
|
elt := tr.FindElement(nestedClassName);
|
|
|
|
CheckNotNull(elt,nestedClassName);
|
|
|
|
CheckEquals(nestedClassName,elt.Name,'Item Name');
|
|
|
|
CheckEquals(nestedClassName,tr.GetExternalName(elt),'Item ExternalName');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleArrayItemType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleArrayItemType);
|
|
|
|
CheckEquals(x_complexType_SampleArrayItemType,elt.Name, 'Array name');
|
|
|
|
CheckEquals(x_complexType_SampleArrayItemType,tr.GetExternalName(elt), 'Array external name');
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals(nestedClassName,tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals(x_Item,tr.GetArrayItemExternalName(arrayType));
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2007-09-10 22:19:20 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-09-10 01:19:04 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Array_soaparray();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2008-09-10 01:19:04 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
arrayType : TPasArrayType;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_Array_soaparray();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_array_soaparray,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleArrayIntFieldType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleArrayIntFieldType);
|
|
|
|
CheckEquals(x_complexType_SampleArrayIntFieldType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleArrayIntFieldType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals('int',tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals('item',tr.GetArrayItemName(arrayType));
|
|
|
|
CheckEquals('item',tr.GetArrayItemExternalName(arrayType));
|
|
|
|
|
|
|
|
CheckNull(tr.FindElementNS('Array','http://schemas.xmlsoap.org/wsdl/'));
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_CollectionSequence();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2008-08-01 21:38:55 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
arrayType : TPasArrayType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
nestedClassName : string;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2008-08-01 21:38:55 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_CollectionSequence_Schema();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_array_sequence_collection,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(4,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleCollectionCollectionComplexType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleCollectionCollectionComplexType);
|
|
|
|
CheckEquals(x_complexType_SampleCollectionCollectionComplexType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleCollectionCollectionComplexType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
Check(tr.IsCollection(arrayType));
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals(x_complexType_SampleCollectionComplexType,tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals(x_field,tr.GetArrayItemName(arrayType));
|
|
|
|
CheckEquals(x_field,tr.GetArrayItemExternalName(arrayType));
|
|
|
|
|
|
|
|
|
|
|
|
nestedClassName := Format('%s_%s_Type',[x_complexType_SampleCollectionItemType,x_Item]);
|
|
|
|
elt := tr.FindElement(nestedClassName);
|
|
|
|
CheckNotNull(elt,nestedClassName);
|
|
|
|
CheckEquals(nestedClassName,elt.Name,'Item Name');
|
|
|
|
CheckEquals(nestedClassName,tr.GetExternalName(elt),'Item ExternalName');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField);
|
|
|
|
CheckProperty(x_strField,'string',ptField);
|
|
|
|
CheckProperty(x_floatField,'float',ptField);
|
|
|
|
CheckProperty(x_byteField,'byte',ptField);
|
|
|
|
CheckProperty(x_charField,'char',ptField);
|
|
|
|
CheckProperty(x_longField,'long',ptField);
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute);
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute);
|
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleCollectionItemType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleCollectionItemType);
|
|
|
|
CheckEquals(x_complexType_SampleCollectionItemType,elt.Name, 'Array name');
|
|
|
|
CheckEquals(x_complexType_SampleCollectionItemType,tr.GetExternalName(elt), 'Array external name');
|
|
|
|
CheckIs(elt,TPasArrayType);
|
|
|
|
arrayType := elt as TPasArrayType;
|
|
|
|
Check(tr.IsCollection(arrayType));
|
|
|
|
CheckNotNull(arrayType.ElType);
|
|
|
|
CheckEquals(nestedClassName,tr.GetExternalName(arrayType.ElType));
|
|
|
|
CheckEquals(x_Item,tr.GetArrayItemExternalName(arrayType));
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-08-01 21:38:55 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.pascal_class_default_parent();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_pascal_class_parent();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClass);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClass);
|
|
|
|
CheckEquals(x_complexType_SampleClass,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClass,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType is null');
|
|
|
|
CheckSame(tr.FindElementNS('TBaseComplexRemotable',sXSD_NS),clsType.AncestorType);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-09-11 00:44:56 +00:00
|
|
|
procedure TTest_CustomXsdParser.class_headerblock_derived();
|
2008-09-11 02:12:27 +00:00
|
|
|
const s_class_name = 'TSampleHeader'; s_emty_class_name = 'TEmptyHeader';
|
2008-09-11 00:44:56 +00:00
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_class_headerblock_derived_Schema();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('class_headerblock_derived');
|
|
|
|
CheckNotNull(mdl,'class_headerblock_derived');
|
2008-09-11 02:12:27 +00:00
|
|
|
elt := tr.FindElement(s_emty_class_name);
|
|
|
|
CheckNotNull(elt,s_emty_class_name);
|
|
|
|
CheckEquals(s_emty_class_name,elt.Name);
|
|
|
|
CheckEquals(s_emty_class_name,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType is null');
|
|
|
|
CheckSame(tr.FindElementNS('THeaderBlock',sXSD_NS),clsType.AncestorType);
|
2008-09-11 00:44:56 +00:00
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckEquals(s_class_name,elt.Name);
|
|
|
|
CheckEquals(s_class_name,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType is null');
|
|
|
|
CheckSame(tr.FindElementNS('THeaderBlock',sXSD_NS),clsType.AncestorType);
|
2008-09-11 02:12:27 +00:00
|
|
|
|
2008-09-11 00:44:56 +00:00
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.class_headerblock_simplecontent_derived();
|
|
|
|
const s_class_name = 'TSampleHeader';
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_class_headerblock_simplecontent_derived_Schema();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('class_headerblock_simplecontent_derived');
|
|
|
|
CheckNotNull(mdl,'class_headerblock_simplecontent_derived');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckEquals(s_class_name,elt.Name);
|
|
|
|
CheckEquals(s_class_name,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckNotNull(clsType.AncestorType,'AncestorType is null');
|
|
|
|
CheckSame(tr.FindElementNS('TSimpleContentHeaderBlock',sXSD_NS),clsType.AncestorType,'AncestorType');
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-09-17 01:45:04 +00:00
|
|
|
procedure TTest_CustomXsdParser.class_widestring_property();
|
|
|
|
const s_class_name = 'TSampleClass';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
|
|
|
|
CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName');
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_class_widestring_property();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('class_widestring_property');
|
|
|
|
CheckNotNull(mdl,'class_widestring_property');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckEquals(s_class_name,elt.Name);
|
|
|
|
CheckEquals(s_class_name,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('elementProp','WideString','string',ptField);
|
|
|
|
CheckProperty('elementAtt','WideString','string',ptAttribute);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_default_values();
|
2008-06-06 15:04:35 +00:00
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,
|
|
|
|
ATypeName : string;
|
|
|
|
const AFieldType : TPropertyType;
|
|
|
|
const ADefault : string
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
CheckEquals(ADefault,prp.DefaultValue,'default');
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2008-06-06 15:04:35 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2008-06-06 15:04:35 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_default_values();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_class_default,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField,'1210');
|
|
|
|
CheckProperty(x_strField,'string',ptField,'azerty');
|
|
|
|
CheckProperty(x_floatField,'float',ptField,'1234');
|
|
|
|
CheckProperty(x_byteField,'byte',ptField,'23');
|
|
|
|
CheckProperty(x_charField,'char',ptField,'i');
|
|
|
|
CheckProperty(x_longField,'long',ptField,'567');
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute,'attribute azerty');
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute,'789');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-06-06 15:04:35 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_properties_extended_metadata();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,
|
|
|
|
ATypeName : string;
|
|
|
|
const AFieldType : TPropertyType;
|
|
|
|
const ADefault : string;
|
|
|
|
const AExtMetaDataNameSpace,
|
|
|
|
AExtMetaDataLocalName,
|
|
|
|
AExtMetaDataValue : string
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
locExtMeta : string;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
CheckEquals(ADefault,prp.DefaultValue,'default');
|
|
|
|
locExtMeta := Format('%s#%s',[AExtMetaDataNameSpace,AExtMetaDataLocalName]);
|
|
|
|
if not IsStrEmpty(locExtMeta) then
|
|
|
|
CheckEquals(AExtMetaDataValue, tr.Properties.GetValue(prp,locExtMeta), 'extended metadata');
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2008-06-06 15:04:35 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
2009-07-16 17:39:56 +00:00
|
|
|
tr := nil;
|
2008-06-06 15:04:35 +00:00
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := LoadComplexType_Class_properties_extended_metadata();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals(x_complexType_class_properties_extended_metadata,mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(5,prpLs.Count);
|
|
|
|
CheckProperty(x_intField,'int',ptField,'', 'uri-4','a','1210');
|
|
|
|
CheckProperty(x_intField,'int',ptField,'', 'uri-4','b','uri-5#xx');
|
|
|
|
CheckProperty(x_strField,'string',ptField,'azerty', 'uri-4','a', 'http://www.w3.org/2001/XMLSchema#int');
|
|
|
|
CheckProperty(x_strAtt,'string',ptAttribute,'attribute azerty', 'uri-4','a', 'optional');
|
|
|
|
CheckProperty(x_intAtt,'int',ptAttribute,'', '', '', '');
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-06-06 15:04:35 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-10-23 19:21:59 +00:00
|
|
|
procedure TTest_CustomXsdParser.ComplexType_Class_properties_extended_metadata2();
|
2008-09-29 12:35:06 +00:00
|
|
|
const s_ProjectType = 'ProjectType';
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
i : Integer;
|
|
|
|
p : TPasProperty;
|
|
|
|
begin
|
|
|
|
tr := LoadComplexType_Class_properties_extended_metadata2();
|
|
|
|
mdl := tr.FindModule('uri:sample');
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
elt := tr.FindElement(s_ProjectType);
|
|
|
|
CheckNotNull(elt,s_ProjectType);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
p := nil;
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) and
|
|
|
|
SameText('ProjectLeader',TPasElement(clsType.Members[i]).Name)
|
|
|
|
then begin
|
|
|
|
p := TPasProperty(clsType.Members[i]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
CheckNotNull(p,'Property non found : "ProjectLeader"');
|
|
|
|
CheckEquals('uri:sample#Person', tr.Properties.GetValue(p,'commonj.sdo#propertyType'), 'extended metadata');
|
|
|
|
|
|
|
|
p := nil;
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) and
|
|
|
|
SameText('ProjectLeaderArray',TPasElement(clsType.Members[i]).Name)
|
|
|
|
then begin
|
|
|
|
p := TPasProperty(clsType.Members[i]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
CheckNotNull(p,'Property non found : "ProjectLeaderArray"');
|
|
|
|
CheckEquals('uri:sample#Person', tr.Properties.GetValue(p,'commonj.sdo#propertyType'), 'extended metadata');
|
|
|
|
|
2009-07-16 17:39:56 +00:00
|
|
|
FreeAndNil(tr);
|
2008-09-29 12:35:06 +00:00
|
|
|
end;
|
|
|
|
|
2009-01-19 17:46:33 +00:00
|
|
|
procedure TTest_CustomXsdParser.class_ansichar_property();
|
|
|
|
const s_class_name = 'TSampleClass';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
|
|
|
|
CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName');
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_class_ansichar_property();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('class_ansichar_property');
|
|
|
|
CheckNotNull(mdl,'class_ansichar_property');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckEquals(s_class_name,elt.Name);
|
|
|
|
CheckEquals(s_class_name,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('elementProp','AnsiChar','string',ptField);
|
|
|
|
CheckProperty('elementAtt','AnsiChar','string',ptAttribute);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.class_widechar_property();
|
|
|
|
const s_class_name = 'TSampleClass';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
|
|
|
|
CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName');
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_class_widechar_property();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('class_widechar_property');
|
|
|
|
CheckNotNull(mdl,'class_widechar_property');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckEquals(s_class_name,elt.Name);
|
|
|
|
CheckEquals(s_class_name,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('elementProp','WideChar','string',ptField);
|
|
|
|
CheckProperty('elementAtt','WideChar','string',ptAttribute);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-10-07 17:41:09 +00:00
|
|
|
procedure TTest_CustomXsdParser.class_currency_property();
|
|
|
|
const s_class_name = 'TSampleClass';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
|
|
|
|
CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName');
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_class_currency_property();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('class_currency_property');
|
|
|
|
CheckNotNull(mdl,'class_currency_property');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckEquals(s_class_name,elt.Name);
|
|
|
|
CheckEquals(s_class_name,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('elementProp','Currency','decimal',ptField);
|
|
|
|
CheckProperty('elementAtt','Currency','decimal',ptAttribute);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2010-10-01 20:44:10 +00:00
|
|
|
procedure TTest_CustomXsdParser.class_property_composed_name();
|
|
|
|
const s_class_name = 'TSampleClass';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,
|
|
|
|
ADeclaredName,
|
|
|
|
ATypeName : string;
|
|
|
|
const AFieldType : TPropertyType
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name,'Name');
|
|
|
|
CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_class_property_composed_name();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn_sample');
|
|
|
|
CheckNotNull(mdl,'urn_sample');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckProperty('one_prop','one-prop',STRING_TYPE_NAME,ptField);
|
|
|
|
CheckProperty('one_two_prop','one-two-prop',STRING_TYPE_NAME,ptAttribute);
|
2010-10-01 20:44:10 +00:00
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-11-23 17:55:10 +00:00
|
|
|
procedure TTest_CustomXsdParser.schema_import();
|
|
|
|
const
|
|
|
|
s_base_namespace = 'urn:base-library';
|
|
|
|
s_base_type = 'SampleBase_Type';
|
|
|
|
s_second_namespace = 'urn:second-library';
|
|
|
|
s_second_type = 'Second_Type';
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2009-11-23 17:55:10 +00:00
|
|
|
elt, prpElt : TPasElement;
|
|
|
|
prp : TPasProperty;
|
|
|
|
baseType, scdClass : TPasClassType;
|
|
|
|
begin
|
|
|
|
tr := load_schema_import();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(s_base_namespace);
|
|
|
|
CheckNotNull(mdl,s_base_namespace);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement(s_base_type);
|
|
|
|
CheckNotNull(elt,s_base_type);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
baseType := TPasClassType(elt);
|
|
|
|
|
|
|
|
mdl := tr.FindModule(s_second_namespace);
|
|
|
|
CheckNotNull(mdl,s_second_namespace);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(1,ls.Count);
|
|
|
|
elt := tr.FindElement(s_second_type);
|
|
|
|
CheckNotNull(elt,s_second_type);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
scdClass := TPasClassType(elt);
|
|
|
|
prpElt := FindMember(scdClass,'SampleProperty');
|
|
|
|
CheckNotNull(prpElt);
|
|
|
|
CheckIs(prpElt,TPasProperty);
|
|
|
|
prp := TPasProperty(prpElt);
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(PtrUInt(prp.VarType),PtrUInt(prp.VarType));
|
|
|
|
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure TTest_CustomXsdParser.schema_include();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-08-29 02:59:57 +00:00
|
|
|
elt, prpElt : TPasElement;
|
|
|
|
prp : TPasProperty;
|
|
|
|
baseType, scdClass : TPasClassType;
|
|
|
|
begin
|
|
|
|
tr := load_schema_include();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn:include');
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(4,ls.Count,'type count');
|
|
|
|
elt := tr.FindElement('TypeA');
|
|
|
|
CheckNotNull(elt,'TypeA');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TypeB');
|
|
|
|
CheckNotNull(elt,'TypeB');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TypeC');
|
|
|
|
CheckNotNull(elt,'TypeC');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TClassSample');
|
|
|
|
CheckNotNull(elt,'TClassSample');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.schema_include_parent_no_types();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-08-29 02:59:57 +00:00
|
|
|
elt, prpElt : TPasElement;
|
|
|
|
prp : TPasProperty;
|
|
|
|
baseType, scdClass : TPasClassType;
|
|
|
|
begin
|
|
|
|
tr := load_schema_include_parent_no_types();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn:include');
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count,'type count');
|
|
|
|
elt := tr.FindElement('TypeA');
|
|
|
|
CheckNotNull(elt,'TypeA');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TypeB');
|
|
|
|
CheckNotNull(elt,'TypeB');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TypeC');
|
|
|
|
CheckNotNull(elt,'TypeC');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.schema_include_fail_namespace();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
ok : Boolean;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
ok := False;
|
|
|
|
try
|
|
|
|
tr := load_schema_include_fail_namespace();
|
|
|
|
ok := True;
|
|
|
|
except
|
|
|
|
on e : EXsdParserAssertException do
|
|
|
|
ok := True;
|
|
|
|
end;
|
|
|
|
FreeAndNil(tr);
|
|
|
|
Check(ok);
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.schema_include_circular1();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-08-29 02:59:57 +00:00
|
|
|
elt, prpElt : TPasElement;
|
|
|
|
prp : TPasProperty;
|
|
|
|
baseType, scdClass : TPasClassType;
|
|
|
|
begin
|
|
|
|
tr := load_schema_include_circular1();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn:include');
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count,'type count');
|
|
|
|
elt := tr.FindElement('TypeA');
|
|
|
|
CheckNotNull(elt,'TypeA');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TypeB');
|
|
|
|
CheckNotNull(elt,'TypeB');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TClassSample');
|
|
|
|
CheckNotNull(elt,'TClassSample');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.schema_include_circular2();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-08-29 02:59:57 +00:00
|
|
|
elt, prpElt : TPasElement;
|
|
|
|
prp : TPasProperty;
|
|
|
|
baseType, scdClass : TPasClassType;
|
|
|
|
begin
|
|
|
|
tr := load_schema_include_circular2();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn:include');
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(4,ls.Count,'type count');
|
|
|
|
elt := tr.FindElement('TypeA');
|
|
|
|
CheckNotNull(elt,'TypeA');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TypeB');
|
|
|
|
CheckNotNull(elt,'TypeB');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TypeC');
|
|
|
|
CheckNotNull(elt,'TypeC');
|
|
|
|
CheckIs(elt,TPasEnumType);
|
|
|
|
elt := tr.FindElement('TClassSample');
|
|
|
|
CheckNotNull(elt,'TClassSample');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
procedure TTest_CustomXsdParser.schema_default_elt_att_form();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
begin
|
|
|
|
tr := load_schema_default_elt_att_form();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckFalse(
|
|
|
|
tr.Properties.HasValue(mdl,s_elementFormDefault),
|
|
|
|
'Should not have '+s_elementFormDefault
|
|
|
|
);
|
|
|
|
CheckFalse(
|
|
|
|
tr.Properties.HasValue(mdl,s_attributeFormDefault),
|
|
|
|
'Should not have '+s_attributeFormDefault
|
|
|
|
);
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.schema_default_elt_qualified_form();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
begin
|
|
|
|
tr := load_schema_default_elt_qualified_form();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckTrue(
|
|
|
|
tr.Properties.HasValue(mdl,s_elementFormDefault),
|
|
|
|
'Should have '+s_elementFormDefault
|
|
|
|
);
|
|
|
|
CheckEquals(s_qualified,tr.Properties.GetValue(mdl,s_elementFormDefault));
|
|
|
|
CheckFalse(
|
|
|
|
tr.Properties.HasValue(mdl,s_attributeFormDefault),
|
|
|
|
'Should not have '+s_attributeFormDefault
|
|
|
|
);
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.schema_default_att_unqualified_form();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
begin
|
|
|
|
tr := load_schema_default_att_unqualified_form();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckTrue(
|
|
|
|
tr.Properties.HasValue(mdl,s_attributeFormDefault),
|
|
|
|
'Should have '+s_attributeFormDefault
|
|
|
|
);
|
|
|
|
CheckEquals(s_unqualified,tr.Properties.GetValue(mdl,s_attributeFormDefault));
|
|
|
|
CheckFalse(
|
|
|
|
tr.Properties.HasValue(mdl,s_elementFormDefault),
|
|
|
|
'Should not have '+s_elementFormDefault
|
|
|
|
);
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.schema_default_elt_att_form_present();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
mdl : TPasModule;
|
|
|
|
begin
|
|
|
|
tr := load_schema_default_elt_att_form_present();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckTrue(
|
|
|
|
tr.Properties.HasValue(mdl,s_attributeFormDefault),
|
|
|
|
'Should have '+s_attributeFormDefault
|
|
|
|
);
|
|
|
|
CheckEquals(s_unqualified,tr.Properties.GetValue(mdl,s_attributeFormDefault));
|
|
|
|
|
|
|
|
CheckTrue(
|
|
|
|
tr.Properties.HasValue(mdl,s_attributeFormDefault),
|
|
|
|
'Should have '+s_attributeFormDefault
|
|
|
|
);
|
|
|
|
CheckEquals(s_unqualified,tr.Properties.GetValue(mdl,s_attributeFormDefault));
|
|
|
|
finally
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
procedure TTest_CustomXsdParser.case_sensitive();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-09-14 02:31:02 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := load_schema_case_sensitive();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('case_sensitive',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(4,ls.Count);
|
|
|
|
|
|
|
|
elt := tr.FindElement('Date');
|
|
|
|
CheckNotNull(elt,'Date');
|
|
|
|
CheckEquals('Date',tr.GetExternalName(elt));
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'Date.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement('String');
|
|
|
|
CheckNotNull(elt,'String');
|
|
|
|
CheckEquals('String',tr.GetExternalName(elt));
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'String.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement('Boolean');
|
|
|
|
CheckNotNull(elt,'Boolean');
|
|
|
|
CheckEquals('Boolean',tr.GetExternalName(elt));
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'Boolean.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(8,prpLs.Count);
|
|
|
|
CheckProperty('dateField','date',ptField);
|
|
|
|
CheckProperty('localDateField','Date',ptField);
|
|
|
|
CheckProperty('booleanField','boolean',ptField);
|
|
|
|
CheckProperty('localBooleanField','Boolean',ptField);
|
|
|
|
CheckProperty('stringField','string',ptField);
|
|
|
|
CheckProperty('localStringField','String',ptField);
|
|
|
|
CheckProperty('dateAtt','date',ptAttribute);
|
|
|
|
CheckProperty('localDateAtt','Date',ptAttribute);
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.case_sensitive2();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-09-14 02:31:02 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := load_schema_case_sensitive2();
|
|
|
|
|
|
|
|
mdl := tr.FindModule(x_targetNamespace);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('case_sensitive2',mdl.Name);
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
|
|
|
|
elt := tr.FindElement('SampleType');
|
|
|
|
CheckNotNull(elt,'SampleType');
|
|
|
|
CheckEquals('SampleType',tr.GetExternalName(elt));
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'SampleType.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement('SAMPLETYPE');
|
|
|
|
CheckNotNull(elt,'SAMPLETYPE');
|
|
|
|
CheckEquals('SAMPLETYPE',tr.GetExternalName(elt));
|
|
|
|
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'SAMPLETYPE.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement(x_complexType_SampleClassType);
|
|
|
|
CheckNotNull(elt,x_complexType_SampleClassType);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,elt.Name);
|
|
|
|
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(2,prpLs.Count);
|
|
|
|
CheckProperty('Field1','SampleType',ptField);
|
|
|
|
CheckProperty('Field2','SAMPLETYPE',ptField);
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_CustomXsdParser.case_sensitive_import();
|
|
|
|
const CONST_NS = 'urn:wst-test3';
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
clsType : TPasClassType;
|
|
|
|
|
|
|
|
procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name);
|
|
|
|
CheckEquals(AName,tr.GetExternalName(prp));
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
2011-11-26 17:54:55 +00:00
|
|
|
ls : TList2;
|
2011-09-14 02:31:02 +00:00
|
|
|
elt : TPasElement;
|
|
|
|
aliasType : TPasAliasType;
|
|
|
|
i : Integer;
|
|
|
|
prpLs : TList;
|
|
|
|
begin
|
|
|
|
tr := nil;
|
|
|
|
prpLs := TList.Create();
|
|
|
|
try
|
|
|
|
tr := load_schema_case_sensitive_import();
|
|
|
|
//-----------------------------------------
|
|
|
|
mdl := tr.FindModule('urn:wst-test');
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('case_sensitive2',mdl.Name);
|
|
|
|
CheckEquals('urn:wst-test',tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
|
|
|
|
elt := tr.FindElement('SampleType');
|
|
|
|
CheckNotNull(elt,'SampleType');
|
|
|
|
CheckEquals('SampleType',tr.GetExternalName(elt));
|
|
|
|
CheckEquals('urn:wst-test',tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'SampleType.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement('SAMPLETYPE');
|
|
|
|
CheckNotNull(elt,'SAMPLETYPE');
|
|
|
|
CheckEquals('SAMPLETYPE',tr.GetExternalName(elt));
|
|
|
|
CheckEquals('urn:wst-test',tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'SAMPLETYPE.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
//-----------------------------------------
|
|
|
|
mdl := tr.FindModule(CONST_NS);
|
|
|
|
CheckNotNull(mdl);
|
|
|
|
CheckEquals('case_sensitive3',mdl.Name);
|
|
|
|
CheckEquals(CONST_NS,tr.GetExternalName(mdl));
|
|
|
|
ls := mdl.InterfaceSection.Declarations;
|
|
|
|
CheckEquals(3,ls.Count);
|
|
|
|
|
|
|
|
elt := tr.FindElement('TypeA');
|
|
|
|
CheckNotNull(elt,'TypeA');
|
|
|
|
CheckEquals('TypeA',tr.GetExternalName(elt));
|
|
|
|
CheckEquals(CONST_NS,tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'TypeA.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement('TYPEA');
|
|
|
|
CheckNotNull(elt,'TYPEA');
|
|
|
|
CheckEquals('TYPEA',tr.GetExternalName(elt));
|
|
|
|
CheckEquals(CONST_NS,tr.GetNameSpace(elt as TPasType));
|
|
|
|
CheckIs(elt,TPasAliasType);
|
|
|
|
CheckNotNull(TPasAliasType(elt).DestType,'TYPEA.DestType');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(STRING_TYPE_NAME,TPasAliasType(elt).DestType.Name);
|
2011-09-14 02:31:02 +00:00
|
|
|
|
|
|
|
elt := tr.FindElement('CompoundType');
|
|
|
|
CheckNotNull(elt,'CompoundType');
|
|
|
|
CheckEquals('CompoundType',elt.Name);
|
|
|
|
CheckEquals('CompoundType',tr.GetExternalName(elt));
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
prpLs.Clear();
|
|
|
|
for i := 0 to Pred(clsType.Members.Count) do begin
|
|
|
|
if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
|
|
|
|
prpLs.Add(clsType.Members[i]);
|
|
|
|
end;
|
|
|
|
CheckEquals(4,prpLs.Count);
|
|
|
|
CheckProperty('f1','SampleType',ptField);
|
|
|
|
CheckProperty('f2','SAMPLETYPE',ptField);
|
|
|
|
CheckProperty('f3','TypeA',ptField);
|
|
|
|
CheckProperty('f4','TYPEA',ptField);
|
|
|
|
|
|
|
|
finally
|
|
|
|
FreeAndNil(prpLs);
|
|
|
|
FreeAndNil(tr);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2013-03-05 15:48:26 +00:00
|
|
|
procedure TTest_CustomXsdParser.global_attribute();
|
|
|
|
const s_class_name = 'TSampleClass';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,
|
|
|
|
ADeclaredName,
|
|
|
|
ATypeName : string;
|
|
|
|
const AFieldType : TPropertyType
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
t : TPasType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name,'Name');
|
|
|
|
CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
t := GetUltimeType(prp.VarType);
|
|
|
|
CheckNotNull(t,'Property''s Ultime Type not found.');
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(t),'TypeName');
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_global_attribute();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn:wst-test');
|
|
|
|
CheckNotNull(mdl,'urn:wst-test');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('intAtt','intAtt','int',ptAttribute);
|
|
|
|
CheckProperty('strAtt','strAtt','string',ptAttribute);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2016-04-23 15:02:11 +00:00
|
|
|
procedure TTest_CustomXsdParser.att_inherited_maxbound();
|
|
|
|
const s_class_name = 'TSampleType';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,
|
|
|
|
ADeclaredName,
|
|
|
|
ATypeName : string;
|
|
|
|
const AFieldType : TPropertyType;
|
|
|
|
const AIsArray : Boolean
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
t : TPasType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name,'Name');
|
|
|
|
CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
t := GetUltimeType(prp.VarType);
|
|
|
|
CheckNotNull(t,'Property''s Ultime Type not found.');
|
|
|
|
if AIsArray then begin
|
|
|
|
CheckEquals(AIsArray,(t is TPasArrayType));
|
|
|
|
CheckNotNull(TPasArrayType(t).ElType,'array element type');
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(TPasArrayType(t).ElType),'TypeName');
|
|
|
|
end else begin
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(t),'TypeName');
|
|
|
|
end;
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
begin
|
|
|
|
tr := load_att_inherited_maxbound();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn:wst-test');
|
|
|
|
CheckNotNull(mdl,'urn:wst-test');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('StringElement','StringElement','string',ptField,True);
|
|
|
|
CheckProperty('IntElement','IntElement','int',ptField,True);
|
|
|
|
CheckProperty('StringAtt','StringAtt','string',ptAttribute,False);
|
|
|
|
CheckProperty('IntAtt','IntAtt','int',ptAttribute,False);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2016-05-04 12:32:49 +00:00
|
|
|
procedure TTest_CustomXsdParser.embedded_unbounded_choice();
|
|
|
|
const s_class_name = 'EntityContainer';
|
|
|
|
var
|
|
|
|
clsType : TPasClassType;
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
procedure CheckProperty(
|
|
|
|
const AName,
|
|
|
|
ADeclaredName,
|
|
|
|
ATypeName : string;
|
|
|
|
const AFieldType : TPropertyType;
|
|
|
|
const AIsArray : Boolean
|
|
|
|
);
|
|
|
|
var
|
|
|
|
prp : TPasProperty;
|
|
|
|
t : TPasType;
|
|
|
|
begin
|
|
|
|
prp := FindMember(clsType,AName) as TPasProperty;
|
|
|
|
CheckNotNull(prp);
|
|
|
|
CheckEquals(AName,prp.Name,'Name');
|
|
|
|
CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
|
|
|
|
CheckNotNull(prp.VarType);
|
|
|
|
t := GetUltimeType(prp.VarType);
|
|
|
|
CheckNotNull(t,'Property''s Ultime Type not found.');
|
|
|
|
if AIsArray then begin
|
|
|
|
CheckEquals(AIsArray,(t is TPasArrayType));
|
|
|
|
CheckNotNull(TPasArrayType(t).ElType,'array element type');
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(TPasArrayType(t).ElType),'TypeName');
|
|
|
|
end else begin
|
|
|
|
CheckEquals(ATypeName,tr.GetExternalName(t),'TypeName');
|
|
|
|
end;
|
|
|
|
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
mdl : TPasModule;
|
|
|
|
elt : TPasElement;
|
|
|
|
s : string;
|
|
|
|
begin
|
|
|
|
tr := load_embedded_unbounded_choice();
|
|
|
|
try
|
|
|
|
mdl := tr.FindModule('urn:wst-test');
|
|
|
|
CheckNotNull(mdl,'urn:wst-test');
|
|
|
|
elt := tr.FindElement(s_class_name);
|
|
|
|
CheckNotNull(elt,s_class_name);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('Documentation','Documentation','string',ptField,False);
|
|
|
|
CheckProperty('FunctionImport','FunctionImport','EntityContainer_FunctionImport_Type',ptField,True);
|
|
|
|
CheckProperty('EntitySet','EntitySet','EntityContainer_EntitySet_Type',ptField,True);
|
|
|
|
|
|
|
|
s := 'EntityContainer_FunctionImport_Type';
|
|
|
|
elt := tr.FindElement(s);
|
|
|
|
CheckNotNull(elt,s);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('Documentation','Documentation','string',ptField,False);
|
|
|
|
CheckProperty('ReturnType','ReturnType','string',ptField,True);
|
|
|
|
CheckProperty('Parameter','Parameter','string',ptField,True);
|
|
|
|
|
|
|
|
s := 'EntityContainer_EntitySet_Type';
|
|
|
|
elt := tr.FindElement(s);
|
|
|
|
CheckNotNull(elt,s);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
clsType := elt as TPasClassType;
|
|
|
|
CheckProperty('Documentation','Documentation','string',ptField,False);
|
|
|
|
CheckProperty('ValueAnnotation','ValueAnnotation','string',ptField,True);
|
|
|
|
CheckProperty('TypeAnnotation','TypeAnnotation','integer',ptField,True);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
{ TTest_XsdParser }
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
function TTest_XsdParser.ParseDoc(
|
|
|
|
const ADoc: string;
|
|
|
|
const ACaseSensistive: Boolean
|
|
|
|
): TwstPasTreeContainer;
|
2007-09-09 22:30:50 +00:00
|
|
|
var
|
|
|
|
locDoc : TXMLDocument;
|
|
|
|
prs : IXsdPaser;
|
2009-11-23 17:55:10 +00:00
|
|
|
prsCtx : IParserContext;
|
2007-09-09 22:30:50 +00:00
|
|
|
fileName : string;
|
|
|
|
begin
|
2008-10-09 16:35:03 +00:00
|
|
|
fileName := wstExpandLocalFileName(TestFilesPath + ADoc + '.xsd');
|
2007-09-09 22:30:50 +00:00
|
|
|
locDoc := LoadXmlFile(fileName);
|
|
|
|
try
|
|
|
|
Result := TwstPasTreeContainer.Create();
|
2011-09-14 02:31:02 +00:00
|
|
|
Result.CaseSensitive := ACaseSensistive;
|
2007-09-09 22:30:50 +00:00
|
|
|
CreateWstInterfaceSymbolTable(Result);
|
|
|
|
prs := TXsdParser.Create(locDoc,Result,ADoc);
|
2009-11-23 17:55:10 +00:00
|
|
|
prsCtx := prs as IParserContext;
|
|
|
|
prsCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(fileName)));
|
2007-09-09 22:30:50 +00:00
|
|
|
prs.ParseTypes();
|
|
|
|
finally
|
|
|
|
ReleaseDomNode(locDoc);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadEmptySchema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_empty);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadSimpleType_Enum_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_simpleType);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadSimpleType_Enum_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_simpleTypeEmbedded);
|
|
|
|
end;
|
|
|
|
|
2007-10-19 15:30:20 +00:00
|
|
|
function TTest_XsdParser.LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_simpletypeNativeAlias);
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_embedded);
|
|
|
|
end;
|
|
|
|
|
2007-12-29 00:58:19 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Extend_Simple_Schema( ) : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_extend_simple);
|
|
|
|
end;
|
|
|
|
|
2008-10-23 19:21:59 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Class_OpenType( ): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_open_type');
|
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_record);
|
|
|
|
end;
|
|
|
|
|
2007-09-16 00:31:45 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Record_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_record_embedded);
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Mixed() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_mixed');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Mixed2() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_mixed2');
|
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_ArraySequence_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_sequence);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_ArraySequence_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_sequence_embedded);
|
|
|
|
end;
|
|
|
|
|
2008-09-10 01:19:04 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Array_soaparray() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_soaparray);
|
|
|
|
end;
|
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_sequence_collection);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('pascal_class_parent');
|
|
|
|
end;
|
|
|
|
|
2008-09-11 00:44:56 +00:00
|
|
|
function TTest_XsdParser.load_class_headerblock_derived_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_headerblock_derived');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_headerblock_simplecontent_derived');
|
|
|
|
end;
|
|
|
|
|
2008-09-17 01:45:04 +00:00
|
|
|
function TTest_XsdParser.load_class_widestring_property(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_widestring_property');
|
|
|
|
end;
|
|
|
|
|
2008-06-06 15:04:35 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_default);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_properties_extended_metadata(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_properties_extended_metadata);
|
|
|
|
end;
|
|
|
|
|
2008-10-17 20:31:55 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Class_properties_extended_metadata2(): TwstPasTreeContainer;
|
2008-09-29 12:35:06 +00:00
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_properties_extended_metadata + '_2');
|
|
|
|
end;
|
|
|
|
|
2009-01-19 17:46:33 +00:00
|
|
|
function TTest_XsdParser.load_class_ansichar_property(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_ansichar_property');
|
|
|
|
end;
|
|
|
|
|
2009-10-07 17:41:09 +00:00
|
|
|
function TTest_XsdParser.load_class_currency_property() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_currency_property');
|
|
|
|
end;
|
|
|
|
|
2010-10-01 20:44:10 +00:00
|
|
|
function TTest_XsdParser.load_class_property_composed_name() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_property_composed_name');
|
|
|
|
end;
|
|
|
|
|
2009-11-23 17:55:10 +00:00
|
|
|
function TTest_XsdParser.load_schema_import(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('import_second_library');
|
|
|
|
end;
|
|
|
|
|
2011-08-29 02:59:57 +00:00
|
|
|
function TTest_XsdParser.load_schema_include() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_include_parent_no_types() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_include_fail_namespace() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include_error');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_include_circular1() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include_circular1');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_include_circular2() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include_circular2');
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
function TTest_XsdParser.load_schema_case_sensitive(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('case_sensitive',True);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_case_sensitive2(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('case_sensitive2',True);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_case_sensitive_import(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('case_sensitive3',True);
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
function TTest_XsdParser.load_schema_default_elt_att_form() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform1');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_default_elt_qualified_form: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_default_att_unqualified_form: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.load_schema_default_elt_att_form_present: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform4');
|
|
|
|
end;
|
|
|
|
|
2013-03-05 15:48:26 +00:00
|
|
|
function TTest_XsdParser.load_global_attribute() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('global_attribute');
|
|
|
|
end;
|
|
|
|
|
2009-10-07 17:41:09 +00:00
|
|
|
function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer;
|
2009-01-19 17:46:33 +00:00
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_widechar_property');
|
|
|
|
end;
|
|
|
|
|
2009-05-29 15:19:58 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_ArraySequence_ItemName_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('array_sequence_item_name');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_FalseArray( ) : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_false_array');
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Choice_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Choice2_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Choice3_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Choice4_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice4');
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
function TTest_XsdParser.LoadComplexType_Class_SameNameOfElementAndAttributeSchema: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_same_name_elt_att');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Group: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Group2() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Group3() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Group4() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group4');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Group5() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group5');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Group6() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group6');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_Group7() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group7');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att4');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_XsdParser.LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att5');
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
{ TTest_WsdlParser }
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
function TTest_WsdlParser.ParseDoc(
|
|
|
|
const ADoc: string;
|
|
|
|
const ACaseSensitive: Boolean
|
|
|
|
) : TwstPasTreeContainer;
|
2007-09-09 22:30:50 +00:00
|
|
|
var
|
|
|
|
locDoc : TXMLDocument;
|
|
|
|
prs : IParser;
|
2009-11-23 17:55:10 +00:00
|
|
|
prsCtx : IParserContext;
|
2007-09-09 22:30:50 +00:00
|
|
|
fileName : string;
|
|
|
|
begin
|
2008-10-09 16:35:03 +00:00
|
|
|
fileName := wstExpandLocalFileName(TestFilesPath + ADoc + '.wsdl');
|
2007-09-09 22:30:50 +00:00
|
|
|
locDoc := LoadXmlFile(fileName);
|
|
|
|
try
|
|
|
|
Result := TwstPasTreeContainer.Create();
|
2011-09-14 02:31:02 +00:00
|
|
|
Result.CaseSensitive := ACaseSensitive;
|
2007-09-09 22:30:50 +00:00
|
|
|
CreateWstInterfaceSymbolTable(Result);
|
|
|
|
prs := TWsdlParser.Create(locDoc,Result);
|
2009-11-23 17:55:10 +00:00
|
|
|
prsCtx := prs as IParserContext;
|
|
|
|
prsCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(fileName)));
|
2007-09-09 22:30:50 +00:00
|
|
|
prs.Execute(pmAllTypes,ADoc);
|
|
|
|
finally
|
|
|
|
ReleaseDomNode(locDoc);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadEmptySchema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_empty);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadSimpleType_Enum_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_simpleType);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadSimpleType_Enum_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_simpleTypeEmbedded);
|
|
|
|
end;
|
|
|
|
|
2007-10-19 15:30:20 +00:00
|
|
|
function TTest_WsdlParser.LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_simpletypeNativeAlias);
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_embedded);
|
|
|
|
end;
|
|
|
|
|
2007-12-29 00:58:19 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_extend_simple);
|
|
|
|
end;
|
|
|
|
|
2008-10-23 19:21:59 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_OpenType(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_open_type');
|
|
|
|
end;
|
|
|
|
|
2009-05-29 15:19:58 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_false_array');
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Choice_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Choice2_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Choice3_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Choice4_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_choice4');
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_SameNameOfElementAndAttributeSchema: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_same_name_elt_att');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Group(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Group2() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Group3() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Group4() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group4');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Group5() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group5');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Group6() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group6');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_Group7() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group7');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att4');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_class_group_att5');
|
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_record);
|
|
|
|
end;
|
|
|
|
|
2007-09-16 00:31:45 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Record_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_record_embedded);
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Mixed(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_mixed');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Mixed2(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('complex_mixed2');
|
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_ArraySequence_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_sequence);
|
|
|
|
end;
|
|
|
|
|
2009-05-29 15:19:58 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_ArraySequence_ItemName_Schema( ) : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('array_sequence_item_name');
|
|
|
|
end;
|
|
|
|
|
2007-09-10 22:19:20 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_ArraySequence_Embedded_Schema(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_sequence_embedded);
|
|
|
|
end;
|
|
|
|
|
2008-09-10 01:19:04 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Array_soaparray() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_soaparray);
|
|
|
|
end;
|
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_array_sequence_collection);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('pascal_class_parent');
|
|
|
|
end;
|
|
|
|
|
2008-09-11 00:44:56 +00:00
|
|
|
function TTest_WsdlParser.load_class_headerblock_derived_Schema( ) : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_headerblock_derived');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_headerblock_simplecontent_derived');
|
|
|
|
end;
|
|
|
|
|
2008-09-17 01:45:04 +00:00
|
|
|
function TTest_WsdlParser.load_class_widestring_property(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_widestring_property');
|
|
|
|
end;
|
|
|
|
|
2007-10-19 15:30:20 +00:00
|
|
|
procedure TTest_WsdlParser.no_binding_style();
|
|
|
|
var
|
|
|
|
symTable : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
begin
|
|
|
|
symTable := ParseDoc('no_binding_style');
|
|
|
|
try
|
|
|
|
elt := symTable.FindElement('ISampleService');
|
|
|
|
CheckNotNull(elt);
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
Check(intf.ObjKind = okInterface);
|
|
|
|
CheckEquals(2,GetElementCount(intf.Members,TPasProcedure));
|
|
|
|
finally
|
|
|
|
symTable.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-09-10 01:19:04 +00:00
|
|
|
procedure TTest_WsdlParser.signature_last();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
i : Integer;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('signature_last');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := nil;
|
|
|
|
for i := 0 to (intf.Members.Count - 1) do begin
|
|
|
|
if TObject(intf.Members[i]).InheritsFrom(TPasProcedure) then begin
|
|
|
|
mth := TPasProcedure(intf.Members[i]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
CheckNotNull(mth,'test_proc not found');
|
|
|
|
CheckEquals('test_proc',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
|
|
|
CheckEquals('integer', LowerCase(res.ResultType.Name));
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2008-09-10 01:19:04 +00:00
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('boolean'), LowerCase(arg.ArgType.Name));
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_WsdlParser.signature_result();
|
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('signature_result');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := FindProc('test_proc',intf);
|
|
|
|
CheckNotNull(mth,'test_proc not found');
|
|
|
|
CheckEquals('test_proc',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
|
|
|
CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name));
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2008-09-10 01:19:04 +00:00
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2008-09-10 01:19:04 +00:00
|
|
|
mth := FindProc('test_proc2',intf);
|
|
|
|
CheckNotNull(mth,'test_proc2 not found');
|
|
|
|
CheckEquals('test_proc2',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(res.ResultType.Name));
|
2008-09-10 01:19:04 +00:00
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('boolean'), LowerCase(arg.ArgType.Name));
|
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
2009-07-16 17:39:56 +00:00
|
|
|
|
2008-09-10 01:19:04 +00:00
|
|
|
mth := FindProc('test_proc3',intf);
|
|
|
|
CheckNotNull(mth,'test_proc3 not found');
|
|
|
|
CheckEquals('test_proc3',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
|
|
|
CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name));
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2008-09-10 01:19:04 +00:00
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_WsdlParser.signature_return();
|
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('signature_return');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := FindProc('test_proc',intf);
|
|
|
|
CheckNotNull(mth,'test_proc not found');
|
|
|
|
CheckEquals('test_proc',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
|
|
|
CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name));
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2008-09-10 01:19:04 +00:00
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
|
|
|
|
mth := FindProc('test_proc2',intf);
|
|
|
|
CheckNotNull(mth,'test_proc2 not found');
|
|
|
|
CheckEquals('test_proc2',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(res.ResultType.Name));
|
2008-09-10 01:19:04 +00:00
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('boolean'), LowerCase(arg.ArgType.Name));
|
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
|
|
|
|
mth := FindProc('test_proc3',intf);
|
|
|
|
CheckNotNull(mth,'test_proc3 not found');
|
|
|
|
CheckEquals('test_proc3',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
|
|
|
CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name));
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2008-09-10 01:19:04 +00:00
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-10-17 20:31:55 +00:00
|
|
|
procedure TTest_WsdlParser.xsd_not_declared_at_top_node();
|
|
|
|
begin
|
|
|
|
ParseDoc('xsd_not_declared_at_top_node').Free();
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_WsdlParser.xsd_not_declared_at_top_node_2();
|
|
|
|
begin
|
|
|
|
ParseDoc('xsd_not_declared_at_top_node_2').Free();
|
|
|
|
end;
|
|
|
|
|
2009-04-06 22:25:04 +00:00
|
|
|
procedure TTest_WsdlParser.message_parts_type_hint();
|
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('echo_service');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('IEchoService');
|
|
|
|
CheckNotNull(elt,'IEchoService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := FindProc('EchoWideString',intf);
|
|
|
|
CheckNotNull(mth,'EchoWideString not found');
|
|
|
|
CheckEquals('EchoWideString',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
|
|
|
CheckEquals(LowerCase('WideString'), LowerCase(res.ResultType.Name),'Result');
|
|
|
|
CheckEquals(1, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AValue'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('WideString'), LowerCase(arg.ArgType.Name),'Parameter');
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-06-30 16:40:19 +00:00
|
|
|
procedure TTest_WsdlParser.parameter_var();
|
2009-05-15 19:01:13 +00:00
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('var_parameter');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := FindProc('sampleProc',intf);
|
|
|
|
CheckNotNull(mth,'sampleProc not found');
|
|
|
|
CheckEquals('sampleProc',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasProcedureType);
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AInParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2009-05-15 19:01:13 +00:00
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AInOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
CheckEquals('argVar',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'arg.Access');
|
|
|
|
|
|
|
|
mth := FindProc('sampleProc2',intf);
|
|
|
|
CheckNotNull(mth,'sampleProc2 not found');
|
|
|
|
CheckEquals('sampleProc2',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
|
|
|
CheckEquals(LowerCase('ShortInt'), LowerCase(res.ResultType.Name));
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AInParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2009-05-15 19:01:13 +00:00
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AInOutParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
CheckEquals('argConst',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'arg.Access');
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-06-30 16:40:19 +00:00
|
|
|
procedure TTest_WsdlParser.parameter_const_default();
|
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('parameter_const_default');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := FindProc('sampleProc',intf);
|
|
|
|
CheckNotNull(mth,'sampleProc not found');
|
|
|
|
CheckEquals('sampleProc',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasProcedureType);
|
|
|
|
CheckEquals(3, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name));
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(arg.ArgType.Name));
|
2009-06-30 16:40:19 +00:00
|
|
|
CheckEquals('argConst',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'AConstParam');
|
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('ADefaultParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
CheckEquals('argDefault',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'ADefaultParam');
|
|
|
|
arg := TPasArgument(mthType.Args[2]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals(LowerCase('ANonSpecifiedParam'), LowerCase(arg.Name));
|
|
|
|
CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
|
|
|
|
CheckEquals('argConst',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'ANonSpecifiedParam');
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2010-10-01 20:44:10 +00:00
|
|
|
procedure TTest_WsdlParser.parameter_composed_name();
|
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('parameter_composed_name');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := FindProc('sampleProc',intf);
|
|
|
|
CheckNotNull(mth,'sampleProc not found');
|
|
|
|
CheckEquals('sampleProc',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasProcedureType);
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals('one_param',arg.Name,'Param Name');
|
|
|
|
CheckEquals('one-param',tr.GetExternalName(arg),'Param External Name');
|
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals('one_two_param',arg.Name,'Param Name');
|
|
|
|
CheckEquals('one-two-param',tr.GetExternalName(arg),'Param External Name');
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TTest_WsdlParser.parameter_composed_name_function();
|
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('parameter_composed_name');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
mth := FindProc('sampleFunc',intf);
|
|
|
|
CheckNotNull(mth,'sampleFunc not found');
|
|
|
|
CheckEquals('sampleFunc',mth.Name);
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
CheckEquals(2, mthType.Args.Count, 'Parameter count');
|
|
|
|
arg := TPasArgument(mthType.Args[0]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals('one_param',arg.Name,'Param Name');
|
|
|
|
CheckEquals('one-param',tr.GetExternalName(arg),'Param External Name');
|
|
|
|
arg := TPasArgument(mthType.Args[1]);
|
|
|
|
CheckNotNull(arg);
|
|
|
|
CheckEquals('one_two_param',arg.Name,'Param Name');
|
|
|
|
CheckEquals('one-two-param',tr.GetExternalName(arg),'Param External Name');
|
|
|
|
res := TPasFunctionType(mthType).ResultEl;
|
|
|
|
CheckNotNull(res, 'Result');
|
2014-05-17 17:27:34 +00:00
|
|
|
CheckEquals(LowerCase(STRING_TYPE_NAME), LowerCase(res.ResultType.Name));
|
2010-10-01 20:44:10 +00:00
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2016-02-16 19:35:06 +00:00
|
|
|
procedure TTest_WsdlParser.method_composed_name();
|
|
|
|
const PROC_METHOD_NAME = 'Composed-Name-Proc'; PROC_METHOD_ID = 'Composed_Name_Proc';
|
|
|
|
FUNC_METHOD_NAME = 'Composed-Name-Func'; FUNC_METHOD_ID = 'Composed_Name_Func';
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
|
|
|
|
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
|
|
|
|
var
|
|
|
|
k : Integer;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
for k := 0 to (AIntf.Members.Count - 1) do begin
|
|
|
|
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and
|
|
|
|
(tr.GetExternalName(TPasElement(AIntf.Members[k])) = AName)
|
|
|
|
then begin
|
|
|
|
Result := TPasProcedure(AIntf.Members[k]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
mthType : TPasProcedureType;
|
|
|
|
res : TPasResultElement;
|
|
|
|
arg : TPasArgument;
|
|
|
|
i, c : Integer;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('function_composed_name');
|
|
|
|
try
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
|
|
|
|
|
|
|
|
c := 0;
|
|
|
|
for i := 0 to (intf.Members.Count - 1) do begin
|
|
|
|
if TObject(TObject(intf.Members[i])).InheritsFrom(TPasProcedure) then
|
|
|
|
c := c+1;
|
|
|
|
end;
|
|
|
|
CheckEquals(2,c,'number of method');
|
|
|
|
|
|
|
|
mth := FindProc(PROC_METHOD_NAME,intf);
|
|
|
|
CheckNotNull(mth,PROC_METHOD_NAME +' not found');
|
|
|
|
CheckEquals(PROC_METHOD_ID,mth.Name,'internal name');
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasProcedureType);
|
|
|
|
|
|
|
|
mth := FindProc(FUNC_METHOD_NAME,intf);
|
|
|
|
CheckNotNull(mth,FUNC_METHOD_NAME +' not found');
|
|
|
|
CheckEquals(FUNC_METHOD_ID,mth.Name,'internal name');
|
|
|
|
mthType := mth.ProcType;
|
|
|
|
CheckIs(mthType,TPasFunctionType);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2010-07-02 15:33:29 +00:00
|
|
|
procedure TTest_WsdlParser.soap_action();
|
|
|
|
var
|
|
|
|
tr : TwstPasTreeContainer;
|
|
|
|
elt : TPasElement;
|
|
|
|
intf : TPasClassType;
|
|
|
|
i : Integer;
|
|
|
|
mth : TPasProcedure;
|
|
|
|
begin
|
|
|
|
tr := ParseDoc('soap_action');
|
|
|
|
try //SymbolTable.Properties.SetValue(AOp,s_TRANSPORT + '_' + s_soapAction,nd.NodeValue);
|
|
|
|
elt := tr.FindElement('TestService');
|
|
|
|
CheckNotNull(elt,'TestService');
|
|
|
|
CheckIs(elt,TPasClassType);
|
|
|
|
intf := elt as TPasClassType;
|
|
|
|
mth := nil;
|
|
|
|
for i := 0 to (intf.Members.Count - 1) do begin
|
|
|
|
if TObject(intf.Members[i]).InheritsFrom(TPasProcedure) then begin
|
|
|
|
mth := TPasProcedure(intf.Members[i]);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
CheckNotNull(mth,'test_proc not found');
|
|
|
|
CheckEquals('test_proc',mth.Name);
|
|
|
|
CheckEquals(
|
|
|
|
'http://wst.Sample/Soap/Action/',
|
|
|
|
tr.Properties.GetValue(mth,s_TRANSPORT + '_' + s_soapAction)
|
|
|
|
);
|
|
|
|
finally
|
|
|
|
tr.Free();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-06-06 15:04:35 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_default);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_properties_extended_metadata(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_properties_extended_metadata);
|
|
|
|
end;
|
|
|
|
|
2008-10-17 20:31:55 +00:00
|
|
|
function TTest_WsdlParser.LoadComplexType_Class_properties_extended_metadata2(): TwstPasTreeContainer;
|
2008-09-29 12:35:06 +00:00
|
|
|
begin
|
|
|
|
Result := ParseDoc(x_complexType_class_properties_extended_metadata + '_2');
|
|
|
|
end;
|
|
|
|
|
2009-01-19 17:46:33 +00:00
|
|
|
function TTest_WsdlParser.load_class_ansichar_property() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_ansichar_property');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_class_widechar_property() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_widechar_property');
|
|
|
|
end;
|
|
|
|
|
2009-10-07 17:41:09 +00:00
|
|
|
function TTest_WsdlParser.load_class_currency_property() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_currency_property');
|
|
|
|
end;
|
|
|
|
|
2010-10-01 20:44:10 +00:00
|
|
|
function TTest_WsdlParser.load_class_property_composed_name() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('class_property_composed_name');
|
|
|
|
end;
|
|
|
|
|
2009-11-23 17:55:10 +00:00
|
|
|
function TTest_WsdlParser.load_schema_import(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('import_second_library');
|
|
|
|
end;
|
|
|
|
|
2011-08-29 02:59:57 +00:00
|
|
|
function TTest_WsdlParser.load_schema_include() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include_schema');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_include_parent_no_types() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_include_fail_namespace() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include_error');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_include_circular1() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include_circular1');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_include_circular2() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('include_circular2');
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
function TTest_WsdlParser.load_schema_case_sensitive(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('case_sensitive',True);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_case_sensitive2(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('case_sensitive2',True);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_case_sensitive_import(): TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('case_sensitive3',True);
|
|
|
|
end;
|
|
|
|
|
2015-07-15 16:02:12 +00:00
|
|
|
function TTest_WsdlParser.load_schema_default_elt_att_form: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform1');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_default_elt_qualified_form: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform2');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_default_att_unqualified_form: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform3');
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TTest_WsdlParser.load_schema_default_elt_att_form_present: TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('schema_defaultelementform4');
|
|
|
|
end;
|
|
|
|
|
2013-03-05 15:48:26 +00:00
|
|
|
function TTest_WsdlParser.load_global_attribute() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := ParseDoc('global_attribute',True);
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
initialization
|
|
|
|
RegisterTest('XSD parser',TTest_XsdParser.Suite);
|
|
|
|
RegisterTest('WSDL parser',TTest_WsdlParser.Suite);
|
|
|
|
|
|
|
|
end.
|