Changeset 19 for trunk/Compiler/Analyze/UAnalyzerPascal.pas
- Timestamp:
- Nov 9, 2010, 11:19:28 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Compiler/Analyze/UAnalyzerPascal.pas
r18 r19 38 38 function ParseCommand(SourceCode: TCommonBlock): TCommand; 39 39 function ParseBeginEnd(var BeginEnd: TBeginEnd; SourceCode: TCommonBlock): Boolean; 40 function ParseFunction List(SourceCode: TFunctionList; Exported: Boolean = False): Boolean;40 function ParseFunction(SourceCode: TFunctionList; Exported: Boolean = False): Boolean; 41 41 procedure ParseFunctionParameters(SourceCode: TFunction; ValidateParams: Boolean = False); 42 42 function ParseIfThenElse(var IfThenElse: TIfThenElse; SourceCode: TCommonBlock): Boolean; … … 48 48 function ParseConstantList(SourceCode: TConstantList; Exported: Boolean = False): Boolean; 49 49 function ParseConstant(SourceCode: TConstantList; Exported: Boolean = False): Boolean; 50 function ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False; 51 AssignSymbol: string = '='): Boolean; 52 function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; 53 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): TType; 54 function ParseTypeSubType(TypeList: TTypeList; Name: string; 55 ExpectName: Boolean; ForwardDeclaration: Boolean): TType; 56 function ParseTypeBase(TypeList: TTypeList; Name: string): TType; 57 function ParseTypePointer(TypeList: TTypeList; Name: string): TType; 58 function ParseTypeEnumeration(TypeList: TTypeList; Name: string): TType; 59 function ParseTypeRecord(TypeList: TTypeList; Name: string): TType; 60 function ParseTypeClass(TypeList: TTypeList; Name: string): TType; 61 function ParseTypeArray(TypeList: TTypeList; Name: string): TType; 62 function ParseTypeSubRange(TypeList: TTypeList; Name: string): TType; 50 function ParseType(TypeList: TTypeList; var NewType: TType; ExpectName: Boolean = True; 51 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): Boolean; 52 function ParseTypeSubType(TypeList: TTypeList; var NewType: TType; Name: string; 53 ExpectName: Boolean; ForwardDeclaration: Boolean): Boolean; 54 function ParseTypeBase(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 55 function ParseTypePointer(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 56 function ParseTypeEnumeration(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 57 function ParseTypeRecord(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 58 function ParseTypeClass(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 59 function ParseTypeArray(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 60 function ParseTypeSubRange(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 63 61 constructor Create; 64 62 destructor Destroy; override; … … 78 76 SUnknownProcName = 'Unknown proc name "%s".'; 79 77 SUnknownModuleType = 'Unknown module name "%s".'; 80 SInvalidConstruction = 'Invalid construction .';78 SInvalidConstruction = 'Invalid construction "%s".'; 81 79 SInvalidAssignmentValue = 'Invalid assignment "%s".'; 82 80 SParamDiffers = 'Declaration of parametr "%s" differs.'; … … 511 509 procedure TAnalyzerPascal.ParseCommonBlock(SourceCode: TCommonBlock; 512 510 EndSymbol: char = ';'; WithBody: Boolean = True); 511 var 512 Section: TCommonBlockSection; 513 NewType: TType; 513 514 begin 514 515 with SourceCode do begin 515 516 while (NextToken <> EndSymbol) and (NextTokenType <> ttEndOfFile) do begin 516 if not ParseVariableList(Variables) then 517 if not ParseConstantList(Constants) then 518 if not ParseTypeList(Types) then 519 if not ParseFunctionList(Functions) then begin 520 if WithBody then 521 if not ParseBeginEnd(Code, SourceCode) then 522 ErrorMessage(SExpectedButFound, ['begin', NextToken]); 517 if NextToken = 'var' then begin 518 Expect('var'); 519 Section := cbsVariable; 520 end else 521 if NextToken = 'type' then begin 522 Expect('type'); 523 Section := cbsType; 524 end; 525 if NextToken = 'const' then begin 526 Expect('const'); 527 Section := cbsConstant; 528 end; 529 530 if not ParseFunction(Functions) then 531 if WithBody and ParseBeginEnd(Code, SourceCode) then begin 523 532 Break; 533 end else 534 if Section = cbsVariable then begin 535 ParseVariable(Variables); 536 end else 537 if Section = cbsType then begin 538 if ParseType(Types, NewType) then begin 539 Types.Add(NewType); 540 NewType.Parent := Types; 541 NewType.Exported := False; 542 Order.Add(NewType); 543 end; 544 Expect(';'); 545 end else 546 if Section = cbsConstant then begin 547 ParseConstant(Constants); 548 end else begin 549 ErrorMessage(SInvalidConstruction, [NextToken]); 550 ReadToken; 524 551 end; 525 552 end; … … 529 556 530 557 procedure TAnalyzerPascal.ParseCommonBlockInterface(SourceCode: TCommonBlock); 558 var 559 Section: TCommonBlockSection; 560 NewType: TType; 531 561 begin 532 562 with SourceCode do begin 533 563 while (NextToken <> 'implementation') and (NextTokenType <> ttEndOfFile) do begin 534 if not ParseVariableList(Variables, True) then 535 if not ParseConstantList(Constants, True) then 536 if not ParseTypeList(Types, True) then 537 if not ParseFunctionList(Functions, True) then begin 538 ErrorMessage(SUnknownIdentifier, [NextToken], -1); 539 ReadToken; 564 if NextToken = 'var' then begin 565 Expect('var'); 566 Section := cbsVariable; 567 end else 568 if NextToken = 'type' then begin 569 Expect('type'); 570 Section := cbsType; 571 end; 572 if NextToken = 'const' then begin 573 Expect('const'); 574 Section := cbsConstant; 575 end; 576 577 if not ParseFunction(Functions, True) then 578 if Section = cbsVariable then begin 579 ParseVariable(Variables, True); 580 end else 581 if Section = cbsType then begin 582 if ParseType(Types, NewType) and Assigned(NewType) then begin 583 Types.Add(NewType); 584 NewType.Parent := Types; 585 NewType.Exported := True; 586 Order.Add(NewType); 587 end; 588 Expect(';'); 589 end else 590 if Section = cbsConstant then begin 591 ParseConstant(Constants, True); 540 592 end; 541 593 end; … … 573 625 { TParserParseFunctionList } 574 626 575 function TAnalyzerPascal.ParseFunction List(SourceCode: TFunctionList;627 function TAnalyzerPascal.ParseFunction(SourceCode: TFunctionList; 576 628 Exported: Boolean = False): Boolean; 577 629 var … … 859 911 Identifiers: TStringList; 860 912 I: Integer; 913 NewVariable: TVariable; 861 914 begin 862 915 try … … 880 933 ErrorMessage(SUndefinedType, [TypeName], -1) 881 934 else 882 for I := 0 to Identifiers.Count - 1 do 883 with TVariable(Items[Add(TVariable.Create)]) do begin 884 Name := Identifiers[I]; 885 ValueType := NewValueType; 886 end; 935 for I := 0 to Identifiers.Count - 1 do begin 936 Variable := TVariable.Create; 937 Variable.Name := Identifiers[I]; 938 Variable.ValueType := NewValueType; 939 Variable.Exported := Exported; 940 Add(Variable); 941 Parent.Order.Add(Variable); 942 end; 887 943 Expect(';'); 888 944 end; … … 940 996 Expect(';'); 941 997 942 if NewValueType = nil then 943 ErrorMessage(SUndefinedType, [TypeName], -1) 944 else 945 for I := 0 to Identifiers.Count - 1 do 946 with TConstant(Items[Add(TConstant.Create)]) do 947 begin 948 Name := Identifiers[I]; 949 ValueType := NewValueType; 950 Value := ConstantValue; 951 end; 998 //if NewValueType = nil then 999 // ErrorMessage(SUndefinedType, [TypeName], -1) 1000 //else 1001 for I := 0 to Identifiers.Count - 1 do begin 1002 Constant := TConstant.Create; 1003 Constant.Name := Identifiers[I]; 1004 Constant.ValueType := NewValueType; 1005 Constant.Value := ConstantValue; 1006 Constant.Exported := Exported; 1007 Add(Constant); 1008 Parent.Order.Add(Constant); 1009 end; 952 1010 finally 953 1011 Identifiers.Free; … … 955 1013 end; 956 1014 957 { TParserTypeList }958 959 function TAnalyzerPascal.ParseTypeList(SourceCode: TTypeList;960 Exported: Boolean = False; AssignSymbol: string = '='): Boolean;961 var962 NewType: TType;963 begin964 if NextToken = 'type' then begin965 Expect('type');966 with SourceCode do begin967 while IsIdentificator(NextToken) do begin968 NewType := ParseType(SourceCode, True, AssignSymbol);969 if Assigned(NewType) then begin970 NewType.Parent := SourceCode;971 Add(NewType);972 end;973 Expect(';');974 end;975 end;976 Result := True;977 end else Result := False978 end;979 980 1015 { TParserType } 981 1016 982 function TAnalyzerPascal.ParseType(TypeList: TTypeList; ExpectName: Boolean = True;983 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): TType;1017 function TAnalyzerPascal.ParseType(TypeList: TTypeList; var NewType: TType; ExpectName: Boolean = True; 1018 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): Boolean; 984 1019 var 985 1020 Name: string; 986 1021 TypeName: string; 987 1022 begin 1023 NewType := nil; 988 1024 //with SourceCode do 989 1025 begin … … 992 1028 Expect(AssignSymbol); 993 1029 end; 994 Result := ParseTypeEnumeration(TypeList, Name); 995 if not Assigned(Result) then Result := ParseTypeRecord(TypeList, Name); 996 if not Assigned(Result) then Result := ParseTypeClass(TypeList, Name); 997 if not Assigned(Result) then Result := ParseTypeArray(TypeList, Name); 998 if not Assigned(Result) then Result := ParseTypePointer(TypeList, Name); 999 if not Assigned(Result) then Result := ParseTypeBase(TypeList, Name); 1000 if not Assigned(Result) then Result := ParseTypeSubType(TypeList, Name, 1001 ExpectName, ForwardDeclaration); 1002 if not Assigned(Result) then Result := ParseTypeSubRange(TypeList, Name); 1003 if not Assigned(Result) then begin 1004 ErrorMessage(SInvalidConstruction, []); 1005 end; 1006 end; 1007 end; 1008 1009 function TAnalyzerPascal.ParseTypeSubType(TypeList: TTypeList; Name: string; 1010 ExpectName: Boolean; ForwardDeclaration: Boolean): TType; 1030 1031 Result := True; 1032 if not ParseTypeEnumeration(TypeList, NewType, Name) then 1033 if not ParseTypeRecord(TypeList, NewType, Name) then 1034 if not ParseTypeClass(TypeList, NewType, Name) then 1035 if not ParseTypeArray(TypeList, NewType, Name) then 1036 if not ParseTypePointer(TypeList, NewType, Name) then 1037 if not ParseTypeBase(TypeList, NewType, Name) then 1038 if not ParseTypeSubType(TypeList, NewType, Name, ExpectName, ForwardDeclaration) then 1039 if not ParseTypeSubRange(TypeList, NewType, Name) then begin 1040 ErrorMessage(SInvalidConstruction, [NextToken]); 1041 Result := False; 1042 end; 1043 end; 1044 end; 1045 1046 function TAnalyzerPascal.ParseTypeSubType(TypeList: TTypeList; var NewType: TType; Name: string; 1047 ExpectName: Boolean; ForwardDeclaration: Boolean): Boolean; 1011 1048 var 1012 1049 TypeName: string; 1013 1050 begin 1051 Result := False; 1052 NewType := nil; 1014 1053 // Use existed type 1015 1054 if NextTokenType = ttIdentifier then begin 1016 1055 TypeName := ReadToken; 1017 1056 if ExpectName then begin 1018 Result := TType.Create; 1019 TType(Result).Parent := TypeList; 1020 TType(Result).Name := Name; 1021 TType(Result).UsedType := TypeList.Search(TypeName); 1022 if not Assigned(TType(Result).UsedType) then 1057 NewType := TType.Create; 1058 NewType.Parent := TypeList; 1059 NewType.Name := Name; 1060 NewType.UsedType := TypeList.Search(TypeName); 1061 Result := True; 1062 if not Assigned(NewType.UsedType) then 1023 1063 ErrorMessage(SUndefinedType, [TypeName], -1); 1024 1064 end else begin 1025 TType(Result):= TypeList.Search(TypeName);1026 if not Assigned(TType( Result)) then begin1065 NewType := TypeList.Search(TypeName); 1066 if not Assigned(TType(NewType)) then begin 1027 1067 if ForwardDeclaration then begin 1028 1068 // ForwardDeclaration 1029 Result:= TType.Create;1030 TType(Result).Parent := TypeList;1031 TType(Result).Name := TypeName;1032 TType(Result).UsedType := nil;1069 NewType := TType.Create; 1070 NewType.Parent := TypeList; 1071 NewType.Name := TypeName; 1072 NewType.UsedType := nil; 1033 1073 end else 1034 1074 ErrorMessage(SUndefinedType, [TypeName], -1); 1035 1075 end; 1036 end; 1037 end else Result := nil; 1038 end; 1039 1040 function TAnalyzerPascal.ParseTypeBase(TypeList: TTypeList; Name: string): TType; 1041 begin 1042 // Buildin base type construction 1043 if NextToken = 'type' then begin 1044 Expect('type'); 1045 Result := TTypeInherited.Create; 1046 TTypeInherited(Result).Parent := TypeList; 1047 TTypeInherited(Result).Name := Name; 1048 if NextToken = '(' then begin 1049 Expect('('); 1050 TTypeInherited(Result).UsedType := ParseType(TypeList, False); 1051 Expect(')'); 1052 end else TTypeInherited(Result).UsedType := nil; 1053 end else Result := nil; 1054 end; 1055 1056 function TAnalyzerPascal.ParseTypePointer(TypeList: TTypeList; Name: string 1057 ): TType; 1076 Result := Assigned(NewType); 1077 end; 1078 end else Result := False; 1079 end; 1080 1081 function TAnalyzerPascal.ParseTypeBase(TypeList: TTypeList; var NewType: TType; Name: string): Boolean; 1082 begin 1083 // Buildin base type construction 1084 if NextToken = 'type' then begin 1085 Expect('type'); 1086 NewType := TTypeInherited.Create; 1087 NewType.Parent := TypeList; 1088 NewType.Name := Name; 1089 if NextToken = '(' then begin 1090 Expect('('); 1091 if ParseType(TypeList, NewType.UsedType, False) then ; 1092 Expect(')'); 1093 end else NewType.UsedType := nil; 1094 Result := True; 1095 end else Result := False; 1096 end; 1097 1098 function TAnalyzerPascal.ParseTypePointer(TypeList: TTypeList; var NewType: TType; Name: string 1099 ): Boolean; 1058 1100 begin 1059 1101 if NextToken = '^' then begin 1060 1102 Expect('^'); 1061 Result := TTypePointer.Create; 1062 TTypePointer(Result).Parent := TypeList; 1063 TTypePointer(Result).Name := Name; 1064 TTypePointer(Result).UsedType := ParseType(TypeList, False, '=', True); 1065 end else Result := nil; 1066 end; 1067 1068 function TAnalyzerPascal.ParseTypeEnumeration(TypeList: TTypeList; Name: string): TType; 1103 NewType := TTypePointer.Create; 1104 NewType.Parent := TypeList; 1105 NewType.Name := Name; 1106 Result := ParseType(TypeList, NewType.UsedType, False, '=', True); 1107 end else Result := False; 1108 end; 1109 1110 function TAnalyzerPascal.ParseTypeEnumeration(TypeList: TTypeList; var NewType: TType; 1111 Name: string): Boolean; 1069 1112 begin 1070 1113 if NextToken = '(' then begin 1071 1114 Expect('('); 1072 Result:= TTypeEnumeration.Create;1073 TTypeEnumeration(Result).Parent := TypeList;1074 TTypeEnumeration(Result).Name := Name;1075 with TTypeEnumeration( Result) do1115 NewType := TTypeEnumeration.Create; 1116 NewType.Parent := TypeList; 1117 NewType.Name := Name; 1118 with TTypeEnumeration(NewType) do 1076 1119 with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin 1077 1120 Name := ReadToken; … … 1084 1127 begin 1085 1128 Expect(','); 1086 with TTypeEnumeration( Result) do1129 with TTypeEnumeration(NewType) do 1087 1130 with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin 1088 1131 Name := ReadToken; … … 1094 1137 end; 1095 1138 Expect(')'); 1096 end else Result := nil; 1097 end; 1098 1099 function TAnalyzerPascal.ParseTypeRecord(TypeList: TTypeList; Name: string 1100 ): TType; 1101 type 1102 TSectionType = (stVar, stType, stConst); 1139 Result := True; 1140 end else Result := False; 1141 end; 1142 1143 function TAnalyzerPascal.ParseTypeRecord(TypeList: TTypeList; var NewType: TType; Name: string 1144 ): Boolean; 1103 1145 var 1104 1146 Visibility: TTypeVisibility; 1105 SectionType: TSectionType; 1147 SectionType: TCommonBlockSection; 1148 NewType2: TType; 1106 1149 begin 1107 1150 if NextToken = 'record' then begin 1108 1151 Expect('record'); 1109 SectionType := stVar;1152 SectionType := cbsVariable; 1110 1153 Visibility := tvPublic; 1111 Result:= TTypeRecord.Create;1112 TTypeRecord(Result).Parent := TypeList;1113 TTypeRecord( Result).CommonBlock.Parent := TypeList.Parent;1114 TType(Result).Name := Name;1154 NewType := TTypeRecord.Create; 1155 NewType.Parent := TypeList; 1156 TTypeRecord(NewType).CommonBlock.Parent := TypeList.Parent; 1157 NewType.Name := Name; 1115 1158 while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin 1159 // Visibility sections 1116 1160 if NextToken = 'public' then begin 1117 1161 Expect('public'); … … 1130 1174 Visibility := tvProtected; 1131 1175 end else 1176 1177 // Definition sections 1132 1178 if NextToken = 'var' then begin 1133 SectionType := stVar;1134 ParseVariableList(TTypeRecord(Result).CommonBlock.Variables, True);1179 Expect('var'); 1180 SectionType := cbsVariable; 1135 1181 end else 1136 1182 if NextToken = 'const' then begin 1137 SectionType := stConst;1138 ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)1183 Expect('const'); 1184 SectionType := cbsConstant; 1139 1185 end else 1140 1186 if NextToken = 'type' then begin 1141 SectionType := stType; 1142 ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True, '='); 1143 end else 1187 Expect('type'); 1188 SectionType := cbsType; 1189 end; 1190 1144 1191 if NextToken = 'procedure' then 1145 ParseFunction List(TTypeRecord(Result).CommonBlock.Functions, True)1192 ParseFunction(TTypeRecord(NewType).CommonBlock.Functions, True) 1146 1193 else if NextToken = 'function' then 1147 ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True) 1148 else begin 1149 if SectionType = stVar then begin 1150 if IsIdentificator(NextToken) then 1151 ParseVariable(TTypeRecord(Result).CommonBlock.Variables, True) 1152 else ReadToken; 1153 //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':')); 1154 //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility; 1155 end 1156 else if SectionType = stConst then 1157 ParseConstant(TTypeRecord(Result).CommonBlock.Constants, True) 1158 else if SectionType = stType then 1159 ParseType(TTypeRecord(Result).CommonBlock.Types, True, '='); 1194 ParseFunction(TTypeRecord(NewType).CommonBlock.Functions, True) 1195 else 1196 if SectionType = cbsConstant then begin 1197 ParseConstant(TTypeRecord(NewType).CommonBlock.Constants, True) 1198 end else 1199 if SectionType = cbsVariable then begin 1200 ParseVariable(TTypeRecord(NewType).CommonBlock.Variables, True); 1201 end else 1202 if SectionType = cbsType then 1203 with TTypeRecord(NewType).CommonBlock do begin 1204 if ParseType(Types, NewType2, True, '=') then begin 1205 Types.Add(NewType2); 1206 NewType2.Parent := Types; 1207 end; 1160 1208 end; 1161 1209 end; 1162 1210 Expect('end'); 1163 end else Result := nil; 1164 end; 1165 1166 function TAnalyzerPascal.ParseTypeClass(TypeList: TTypeList; Name: string 1167 ): TType; 1211 Result := True; 1212 end else Result := False; 1213 end; 1214 1215 function TAnalyzerPascal.ParseTypeClass(TypeList: TTypeList; var NewType: TType; Name: string 1216 ): Boolean; 1217 var 1218 NewType2: TType; 1168 1219 begin 1169 1220 if NextToken = 'class' then begin 1170 Expect('class'); 1171 Result := TTypeClass.Create; 1172 TTypeClass(Result).Parent := TypeList; 1173 TTypeClass(Result).Name := Name; 1174 if NextToken <> ';' then begin 1175 while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do 1176 begin 1177 TTypeClass(Result).Items.Add(ParseType(TypeList, True, ':')); 1178 Expect(';'); 1179 end; 1180 Expect('end'); 1181 end; 1182 end else Result := nil; 1183 end; 1184 1185 function TAnalyzerPascal.ParseTypeArray(TypeList: TTypeList; Name: string 1186 ): TType; 1221 Expect('class'); 1222 NewType := TTypeClass.Create; 1223 NewType.Parent := TypeList; 1224 NewType.Name := Name; 1225 if NextToken <> ';' then begin 1226 while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do 1227 begin 1228 if ParseType(TypeList, NewType2, True, ':') then begin 1229 NewType2.Parent := TypeList; 1230 TTypeClass(NewType).Items.Add(NewType2); 1231 end; 1232 Expect(';'); 1233 end; 1234 Expect('end'); 1235 end; 1236 Result := True; 1237 end else Result := False; 1238 end; 1239 1240 function TAnalyzerPascal.ParseTypeArray(TypeList: TTypeList; var NewType: TType; Name: string 1241 ): Boolean; 1187 1242 var 1188 1243 UseName: string; … … 1191 1246 if NextToken = 'array' then begin 1192 1247 Expect('array'); 1193 Result:= TTypeArray.Create;1194 TTypeArray(Result).Parent := TypeList;1195 TType(Result).Name := Name;1248 NewType := TTypeArray.Create; 1249 NewType.Parent := TypeList; 1250 NewType.Name := Name; 1196 1251 if NextToken = '[' then begin 1197 1252 Expect('['); 1198 1253 UseName := NextToken; 1199 1254 if NextTokenType = ttIdentifier then begin 1200 TTypeArray( Result).IndexType := TypeList.Parent.Types.Search(UseName);1201 if not Assigned(TTypeArray( Result).IndexType) then1255 TTypeArray(NewType).IndexType := TypeList.Parent.Types.Search(UseName); 1256 if not Assigned(TTypeArray(NewType).IndexType) then 1202 1257 ErrorMessage(SUndefinedType, [UseName], -1) else 1203 TTypeArray( Result).IndexType := UseType;1258 TTypeArray(NewType).IndexType := UseType; 1204 1259 end else 1205 1260 if NextTokenType = ttConstantNumber then begin 1206 TTypeArray(Result).IndexType := ParseTypeSubRange(TypeList, Name);1207 if not Assigned(TTypeArray( Result).IndexType) then begin1208 ErrorMessage(SInvalidConstruction, [ ], -1);1261 ParseTypeSubRange(TypeList, TTypeArray(NewType).IndexType, Name); 1262 if not Assigned(TTypeArray(NewType).IndexType) then begin 1263 ErrorMessage(SInvalidConstruction, [NextToken], -1); 1209 1264 end; 1210 1265 end; … … 1213 1268 Expect('of'); 1214 1269 UseName := NextToken; 1215 TTypeArray(Result).ItemType := ParseType(TypeList, False);1216 if not Assigned(TTypeArray( Result).ItemType) then1270 Result := ParseType(TypeList, TTypeArray(NewType).ItemType, False); 1271 if not Assigned(TTypeArray(NewType).ItemType) then 1217 1272 ErrorMessage(SUndefinedType, [UseName], -1); 1218 end else Result := nil;1219 end; 1220 1221 function TAnalyzerPascal.ParseTypeSubRange(TypeList: TTypeList; Name: string1222 ): TType;1273 end else Result := False; 1274 end; 1275 1276 function TAnalyzerPascal.ParseTypeSubRange(TypeList: TTypeList; var NewType: TType; 1277 Name: string): Boolean; 1223 1278 var 1224 1279 UseName: string; 1225 1280 begin 1226 1281 if NextTokenType = ttConstantString then begin 1227 Result:= TTypeSubRange.Create;1228 TTypeSubRange( Result).Bottom := ReadToken;1282 NewType := TTypeSubRange.Create; 1283 TTypeSubRange(NewType).Bottom := ReadToken; 1229 1284 Expect('..'); 1230 TTypeSubRange(Result).Top := ReadToken; 1285 TTypeSubRange(NewType).Top := ReadToken; 1286 Result := True; 1231 1287 end else 1232 1288 if NextTokenType = ttConstantNumber then begin 1233 Result:= TTypeSubRange.Create;1234 TTypeSubRange( Result).Bottom := ReadToken;1289 NewType := TTypeSubRange.Create; 1290 TTypeSubRange(NewType).Bottom := ReadToken; 1235 1291 Expect('..'); 1236 TTypeSubRange(Result).Top := ReadToken; 1237 end else Result := nil; 1292 TTypeSubRange(NewType).Top := ReadToken; 1293 Result := True; 1294 end else Result := False; 1238 1295 end; 1239 1296
Note:
See TracChangeset
for help on using the changeset viewer.