Browse Source

* Fixes in array type handling

Michaël Van Canneyt 8 months ago
parent
commit
b95db4b610

+ 56 - 6
packages/fcl-jsonschema/src/fpjson.schema.codegen.pp

@@ -31,6 +31,8 @@ Type
 
   { TJSONSchemaCodeGen }
 
+  { TJSONSchemaCodeGenerator }
+
   TJSONSchemaCodeGenerator = class(TPascalCodeGenerator)
   private
     FData: TSchemaData;
@@ -39,6 +41,8 @@ Type
     FWriteClassType: boolean;
   protected
     procedure GenerateHeader; virtual;
+    procedure GenerateFPCDirectives(modeswitches : array of string);
+    procedure GenerateFPCDirectives();
     function GetPascalTypeAndDefault(aType: TSchemaSimpleType; out aPasType, aPasDefault: string) : boolean;
     function GetJSONDefault(aType: TPropertyType) : String;
     procedure SetTypeData(aData : TSchemaData);
@@ -57,6 +61,7 @@ Type
     procedure WriteDtoConstructor(aType: TPascalTypeData);
     procedure WriteDtoField(aType: TPascalTypeData; aProperty: TPascalPropertyData);
     procedure WriteDtoType(aType: TPascalTypeData);
+    procedure WriteDtoArrayType(aType: TPascalTypeData);
   public
     constructor Create(AOwner: TComponent); override;
     procedure Execute(aData: TSchemaData);
@@ -171,6 +176,32 @@ begin
   // Do nothing
 end;
 
+procedure TJSONSchemaCodeGenerator.GenerateFPCDirectives(modeswitches: array of string);
+
+var
+  S : String;
+
+begin
+  if DelphiCode then
+    begin
+    Addln('{$ifdef FPC}');
+    AddLn('{$mode delphi}');
+    end
+  else
+    AddLn('{$mode objfpc}');
+  AddLn('{$h+}');
+  for S in modeswitches do
+    AddLn('{$modeswitch %s}',[lowercase(S)]);
+  if DelphiCode then
+    Addln('{$endif FPC}');
+  Addln('');
+end;
+
+procedure TJSONSchemaCodeGenerator.GenerateFPCDirectives;
+begin
+  GenerateFPCDirectives([]);
+end;
+
 
 { TTypeCodeGenerator }
 
@@ -239,6 +270,19 @@ begin
   Addln('');
 end;
 
+procedure TTypeCodeGenerator.WriteDtoArrayType(aType: TPascalTypeData);
+
+var
+  Fmt : String;
+
+begin
+  if DelphiCode then
+    Fmt:='%s = TArray<%s>;'
+  else
+    Fmt:='%s = Array of %s;';
+  Addln(Fmt,[aType.PascalName,aType.ElementTypeData.PascalName]);
+end;
+
 
 constructor TTypeCodeGenerator.Create(AOwner: TComponent);
 begin
@@ -251,6 +295,7 @@ procedure TTypeCodeGenerator.Execute(aData: TSchemaData);
 
 var
   I: integer;
+  lArray : TPascalTypeData;
 
 begin
   FData := aData;
@@ -258,8 +303,11 @@ begin
   try
     Addln('unit %s;', [OutputUnitName]);
     Addln('');
+    GenerateFPCDirectives();
+    Addln('');
     Addln('interface');
     Addln('');
+    AddLn('uses types;');
     EnsureSection(csType);
     indent;
     for I := 0 to aData.TypeCount-1 do
@@ -267,7 +315,13 @@ begin
         begin
           DoLog('Generating type %s', [aData.Types[I].PascalName]);
           WriteDtoType(aData.Types[I]);
+          lArray:=aData.FindSchemaTypeData('['+aData.Types[I].SchemaName+']');
+          if lArray<>Nil then
+            WriteDtoArrayType(lArray);
         end;
+{      else if (aData.Types[I].PascalType=ptArray) then
+        WriteDtoArrayType(aData.Types[I]);}
+
     undent;
     Addln('implementation');
     Addln('');
@@ -773,12 +827,8 @@ begin
     Addln('');
     Addln('interface');
     Addln('');
-    if not DelphiCode then
-    begin
-      Addln('{$mode objfpc}');
-      Addln('{$h+}');
-      Addln('{$modeswitch typehelpers}');
-    end;
+    GenerateFPCDirectives(['typehelpers']);
+    Addln('');
     Addln('uses');
     indent;
     if DelphiCode then

+ 22 - 16
packages/fcl-jsonschema/src/fpjson.schema.pascaltypes.pp

@@ -115,6 +115,7 @@ Type
 
   TPascalTypeData = class(TObject)
   private
+    FElementTypeData: TPascalTypeData;
     FSchemaName: String;
     FImplementationName: String;
     FIndex: Integer;
@@ -163,7 +164,6 @@ Type
     Function HasArrayProperty : Boolean;
     // Component has object-typed property ? (SchemaComponentsonly = False -> also return array of string etc.)
     function HasObjectProperty(aSchemaComponentsOnly: Boolean): Boolean;
-
     // Components his component depends on
     Property Dependency[aIndex : Integer] : TPascalTypeData Read GetDependency;
     // Number of Components his component depends on
@@ -192,6 +192,8 @@ Type
     Property Sorted : Boolean Read FSorted Write FSorted;
     // PascalType
     Property Pascaltype : TPascalType Read FType;
+    // For arrays, a pointer to the element type
+    Property ElementTypeData : TPascalTypeData Read FElementTypeData Write FElementTypeData;
   end;
 
   { TPascalTypeDataList }
@@ -630,7 +632,7 @@ procedure TSchemaData.CheckDependencies;
           end;
         ptArray:
           begin
-          lPropData:=GetSchemaTypeData(lPropData,lPropData.Schema.Items[0],False);
+          lPropData:=lPropData.ElementTypeData;
           if assigned(lPropData) and (lPropData.PascalType in [ptAnonStruct,ptSchemaStruct]) then
             begin
             lTop.AddDependency(lPropData);
@@ -785,7 +787,6 @@ function TSchemaData.GetSchemaTypeAndName(aType: TPascalTypeData; aSchema: TJSON
 
 var
   lTypeData : TPascalTypeData;
-  lName : string;
 
 begin
   lTypeData:=GetSchemaTypeData(aType,aSchema);
@@ -793,13 +794,6 @@ begin
     begin
     aPropType:=ptUnknown;
     Result:='';
-    {
-    if assigned(aType) then
-      lName:=aType.SchemaName
-    else
-      lName:='<unknown>';
-    Raise ESchemaData.CreateFmt('Could not find type data for %s, property %s',[lName,aSchema.Name]);
-    }
     end
   else
     begin
@@ -812,8 +806,12 @@ Procedure TSchemaData.FinishAutoCreatedType(aName : string; aType: TPascalTypeDa
 
 begin
   AddType(aName,aType);
-  if aType.Pascaltype=ptAnonStruct then
+  Case aType.Pascaltype of
+  ptAnonStruct:
     AddPropertiesToType(aType,aType.Schema,True);
+  ptArray:
+    aType.FElementTypeData:=lElementTypeData;
+  end;
 end;
 
 function TSchemaData.GetSchemaTypeData(aType: TPascalTypeData; lSchema: TJSONSchema; AllowCreate : Boolean = False) : TPascalTypeData;
@@ -877,16 +875,16 @@ begin
         begin
         lElTypeData:=GetSchemaTypeData(Nil,lSchema.Items[0]);
 //         Data.FindSchemaTypeData('Array of string')
-        if DelphiTypes then
-          lPascalName:='TArray<'+lElTypeData.PascalName+'>'
-        else
-          lPascalName:='Array of '+lElTypeData.PascalName;
+        lPascalName:=ArrayTypePrefix+lElTypeData.PascalName+ArrayTypeSuffix;
         lName:='['+lElTypeData.SchemaName+']';
         Result:=FindSchemaTypeData(lName);
+        if Result<>Nil then
+          lName:='';
         if (Result=Nil) and AllowCreate then
           begin
           Result:=CreatePascalType(-1,ptArray,lName,lPascalName,lSchema);
           FinishAutoCreatedType(lName,Result,lElTypeData);
+          lName:='';
           end;
         end;
       sstObject:
@@ -906,6 +904,7 @@ begin
             begin
             Result:=CreatePascalType(-1,ptAnonStruct,lName,lPascalName,lSchema);
             FinishAutoCreatedType(lName,Result,lElTypeData);
+            lName:='';
             end;
           end;
         end;
@@ -922,7 +921,7 @@ function TSchemaData.AddTypeProperty(aType: TPascalTypeData; lProp: TJSONSchema;
   ): TPascalPropertyData;
 
 var
-  Tmp, lTypeName, lName : string;
+  lTypeName, lName : string;
   lType,lEltype : TPropertyType;
   I : Integer;
   lPropTypeData : TPascaltypeData;
@@ -1017,6 +1016,8 @@ begin
   FObjectTypePrefix:='T';
   FObjectTypeSuffix:='';
   FInterfaceTypePrefix:='I';
+  FArrayTypeSuffix:='Array';
+  FArrayTypePrefix:='';
   FKeywordEscapeMode:=kemSuffix;
 end;
 
@@ -1044,6 +1045,11 @@ begin
   AddAliasToTypeMap(ptFloat64,'number','number','double',Nil);
   AddAliasToTypeMap(ptJSON,'JSON','object','string',Nil);
   AddAliasToTypeMap(ptJSON,'any','object','string',Nil);
+  AddAliasToTypeMap(ptArray,'[string]','[string]','TStringDynArray',Nil);
+  AddAliasToTypeMap(ptArray,'[integer]','[integer]','TIntegerDynArray',Nil);
+  AddAliasToTypeMap(ptArray,'[integer--int64]','[integer--int64]','TInt64DynArray',Nil);
+  AddAliasToTypeMap(ptArray,'[number]','[number]','TDoubleDynArray',Nil);
+  AddAliasToTypeMap(ptArray,'[boolean]','[boolean]','TBooleanDynArray',Nil);
 end;