paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 11:29:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronised with trunk till r40443

Browse Source 
git-svn-id: branches/debug_eh@40444 -
This commit is contained in:
Jonas Maebe 2018-12-01 23:08:18 +00:00
commit 60488c3c06
22 changed files with 2219 additions and 1870 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7002,6 +7002,7 @@ packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
packages/pastojs/tests/tcfiler.pas svneol=native#text/plain

8
compiler/dbgdwarf.pas
View File

@ -1489,8 +1489,12 @@ implementation
sign : tdwarf_type;
signform : tdwarf_form;
fullbytesize : byte;
ordtype : tordtype;
begin
case def.ordtype of
ordtype:=def.ordtype;
if ordtype=customint then
ordtype:=range_to_basetype(def.low,def.high);
case ordtype of
s8bit,
s16bit,
s32bit,
@ -1524,7 +1528,7 @@ implementation
basedef:=s16inttype
else
basedef:=u16inttype;
4:
3,4:
if (sign=DW_ATE_signed) then
basedef:=s32inttype
else

116
compiler/msg/errore.msg
View File

@ -166,7 +166,7 @@ scan_f_end_of_file=02000_F_Unexpected end of file
scan_f_string_exceeds_line=02001_F_String exceeds line
% There is a missing closing ' in a string, so it occupies
% multiple lines.
scan_f_illegal_char=02002_F_illegal character "$1" ($2)
scan_f_illegal_char=02002_F_Illegal character "$1" ($2)
% An illegal character was encountered in the input file.
scan_f_syn_expected=02003_F_Syntax error, "$1" expected but "$2" found
% This indicates that the compiler expected a different token than
@ -236,7 +236,7 @@ scan_w_macro_too_deep=02030_W_Expanding of macros exceeds a depth of 16.
% When expanding a macro, macros have been nested to a level of 16.
% The compiler will expand no further, since this may be a sign that
% recursion is used.
scan_w_wrong_styled_switch=02031_W_compiler switches are not supported in // styled comments
scan_w_wrong_styled_switch=02031_W_Compiler switches are not supported in // styled comments
% Compiler switches should be in normal Pascal style comments.
scan_d_handling_switch=02032_DL_Handling switch "$1"
% When you set debugging info on (\var{-vd}) the compiler tells you when it
@ -502,17 +502,17 @@ parser_e_illegal_parameter_list=03024_E_Illegal parameter list
parser_e_wrong_parameter_size=03026_E_Wrong number of parameters specified for call to "$1"
% There is an error in the parameter list of the function or procedure --
% the number of parameters is not correct.
parser_e_overloaded_no_procedure=03027_E_overloaded identifier "$1" isn't a function
parser_e_overloaded_no_procedure=03027_E_Overloaded identifier "$1" isn't a function
% The compiler encountered a symbol with the same name as an overloaded
% function, but it is not a function it can overload.
parser_e_overloaded_have_same_parameters=03028_E_overloaded functions have the same parameter list
parser_e_overloaded_have_same_parameters=03028_E_Overloaded functions have the same parameter list
% You're declaring overloaded functions, but with the same parameter list.
% Overloaded function must have at least 1 different parameter in their
% declaration.
parser_e_header_dont_match_forward=03029_E_function header doesn't match the previous declaration "$1"
parser_e_header_dont_match_forward=03029_E_Function header doesn't match the previous declaration "$1"
% You declared a function with the same parameters but
% different result type or function modifiers.
parser_e_header_different_var_names=03030_E_function header "$1" doesn't match forward : var name changes $2 => $3
parser_e_header_different_var_names=03030_E_Function header "$1" doesn't match forward : var name changes $2 => $3
% You declared the function in the \var{interface} part, or with the
% \var{forward} directive, but defined it with a different parameter list.
parser_n_duplicate_enum=03031_N_Values in enumeration types have to be ascending
@ -527,49 +527,49 @@ parser_n_duplicate_enum=03031_N_Values in enumeration types have to be ascending
parser_e_no_with_for_variable_in_other_segments=03033_E_With cannot be used for variables in a different segment
% With stores a variable locally on the stack,
% but this is not possible if the variable belongs to another segment.
parser_e_too_much_lexlevel=03034_E_function nesting > 31
parser_e_too_much_lexlevel=03034_E_Function nesting > 31
% You can nest function definitions only 31 levels deep.
parser_e_range_check_error=03035_E_range check error while evaluating constants
parser_e_range_check_error=03035_E_Range check error while evaluating constants
% The constants are out of their allowed range.
parser_w_range_check_error=03036_W_range check error while evaluating constants
parser_w_range_check_error=03036_W_Range check error while evaluating constants
% The constants are out of their allowed range.
parser_e_double_caselabel=03037_E_duplicate case label
parser_e_double_caselabel=03037_E_Duplicate case label
% You are specifying the same label 2 times in a \var{case} statement.
parser_e_case_lower_less_than_upper_bound=03038_E_Upper bound of case range is less than lower bound
% The upper bound of a \var{case} label is less than the lower bound and this
% is useless.
parser_e_type_const_not_possible=03039_E_typed constants of classes or interfaces are not allowed
parser_e_type_const_not_possible=03039_E_Typed constants of classes or interfaces are not allowed
% You cannot declare a constant of type class or object.
parser_e_no_overloaded_procvars=03040_E_functions variables of overloaded functions are not allowed
parser_e_no_overloaded_procvars=03040_E_Function variables of overloaded functions are not allowed
% You are trying to assign an overloaded function to a procedural variable.
% This is not allowed.
parser_e_invalid_string_size=03041_E_string length must be a value from 1 to 255
parser_e_invalid_string_size=03041_E_String length must be a value from 1 to 255
% The length of a shortstring in Pascal is limited to 255 characters. You are
% trying to declare a string with length less than 1 or greater than 255.
parser_w_use_extended_syntax_for_objects=03042_W_use extended syntax of NEW and DISPOSE for instances of objects
parser_w_use_extended_syntax_for_objects=03042_W_Use extended syntax of NEW and DISPOSE for instances of objects
% If you have a pointer \var{a} to an object type, then the statement
% \var{new(a)} will not initialize the object (i.e. the constructor isn't
% called), although space will be allocated. You should issue the
% \var{new(a,init)} statement. This will allocate space, and call the
% constructor of the object.
parser_w_no_new_dispose_on_void_pointers=03043_W_use of NEW or DISPOSE for untyped pointers is meaningless
parser_e_no_new_dispose_on_void_pointers=03044_E_use of NEW or DISPOSE is not possible for untyped pointers
parser_w_no_new_dispose_on_void_pointers=03043_W_Use of NEW or DISPOSE for untyped pointers is meaningless
parser_e_no_new_dispose_on_void_pointers=03044_E_Use of NEW or DISPOSE is not possible for untyped pointers
% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer
% because no size is associated to an untyped pointer.
% It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the
% compiler will still warn you if it finds such a construct.
parser_e_class_id_expected=03045_E_class identifier expected
parser_e_class_id_expected=03045_E_Class identifier expected
% This happens when the compiler scans a procedure declaration that contains
% a dot, i.e., an object or class method, but the type in front of the dot is not
% a known type.
parser_e_no_type_not_allowed_here=03046_E_type identifier not allowed here
% You cannot use a type inside an expression.
parser_e_methode_id_expected=03047_E_method identifier expected
parser_e_methode_id_expected=03047_E_Method identifier expected
% This identifier is not a method.
% This happens when the compiler scans a procedure declaration that contains
% a dot, i.e., an object or class method, but the procedure name is not a
% procedure of this type.
parser_e_header_dont_match_any_member=03048_E_function header doesn't match any method of this class "$1"
parser_e_header_dont_match_any_member=03048_E_Function header doesn't match any method of this class "$1"
% This identifier is not a method.
% This happens when the compiler scans a procedure declaration that contains
% a dot, i.e., an object or class method, but the procedure name is not a
@ -668,7 +668,7 @@ parser_e_generic_methods_only_in_methods=03072_E_Methods can be only in other me
parser_e_illegal_colon_qualifier=03073_E_Illegal use of ':'
% You are using the format \var{:} (colon) 2 times on an expression that
% is not a real expression.
parser_e_illegal_set_expr=03074_E_range check error in set constructor or duplicate set element
parser_e_illegal_set_expr=03074_E_Range check error in set constructor or duplicate set element
% The declaration of a set contains an error. Either one of the elements is
% outside the range of the set type, or two of the elements are in fact
% the same.
@ -836,7 +836,7 @@ parser_h_inlining_disabled=03124_H_Inlining disabled
parser_i_writing_browser_log=03125_I_Writing Browser log $1
% When information messages are on, the compiler warns you when it
% writes the browser log (generated with the \var{\{\$Y+ \}} switch).
parser_h_maybe_deref_caret_missing=03126_H_may be pointer dereference is missing
parser_h_maybe_deref_caret_missing=03126_H_Maybe pointer dereference is missing?
% The compiler thinks that a pointer may need a dereference.
parser_f_assembler_reader_not_supported=03127_F_Selected assembler reader not supported
% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not
@ -873,10 +873,10 @@ parser_e_invalid_float_operation=03139_E_Invalid floating point operation
parser_e_array_lower_less_than_upper_bound=03140_E_Upper bound of range is less than lower bound
% The upper bound of an array declaration is less than the lower bound and this
% is not possible.
parser_w_string_too_long=03141_W_string "$1" is longer than "$2"
parser_w_string_too_long=03141_W_String "$1" is longer than "$2"
% The size of the constant string is larger than the size you specified in
% string type definition.
parser_e_string_larger_array=03142_E_string length is larger than array of char length
parser_e_string_larger_array=03142_E_String length is larger than array of char length
% The size of the constant string is larger than the size you specified in
% the \var{Array[x..y] of char} definition.
parser_e_ill_msg_expr=03143_E_Illegal expression after message directive
@ -966,7 +966,7 @@ parser_e_improper_guid_syntax=03165_E_Improper GUID syntax
parser_w_interface_mapping_notfound=03168_W_Procedure named "$1" not found that is suitable for implementing the $2.$3
% The compiler cannot find a suitable procedure which implements the given method of an interface.
% A procedure with the same name is found, but the arguments do not match.
parser_e_interface_id_expected=03169_E_interface identifier expected
parser_e_interface_id_expected=03169_E_Interface identifier expected
% This happens when the compiler scans a \var{class} declaration that contains
% \var{interface} function name mapping code like this:
% \begin{verbatim}
@ -1633,11 +1633,11 @@ type_e_ordinal_expr_expected=04007_E_Ordinal expression expected
% The expression must be of ordinal type, i.e., maximum a \var{Longint}.
% This happens, for instance, when you specify a second argument
% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value.
type_e_pointer_type_expected=04008_E_pointer type expected, but got "$1"
type_e_pointer_type_expected=04008_E_Pointer type expected, but got "$1"
% The variable or expression isn't of the type \var{pointer}. This
% happens when you pass a variable that isn't a pointer to \var{New}
% or \var{Dispose}.
type_e_class_type_expected=04009_E_class type expected, but got "$1"
type_e_class_type_expected=04009_E_Class type expected, but got "$1"
% The variable or expression isn't of the type \var{class}. This happens
% typically when
% \begin{enumerate}
@ -1660,13 +1660,13 @@ type_w_convert_real_2_comp=04014_W_Automatic type conversion from floating type
% An implicit type conversion from a real type to a \var{comp} is
% encountered. Since \var{comp} is a 64 bit integer type, this may indicate
% an error.
type_h_use_div_for_int=04015_H_use DIV instead to get an integer result
type_h_use_div_for_int=04015_H_Use DIV instead to get an integer result
% When hints are on, then an integer division with the '/' operator will
% produce this message, because the result will then be of type real.
type_e_strict_var_string_violation=04016_E_String types have to match exactly in $V+ mode
% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter
% should be of the exact same type as the declared parameter of the procedure.
type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_succ or pred on enums with assignments not possible
type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Succ or Pred on enums with assignments not possible
% If you declare an enumeration type which has C-like assignments
% in it, such as in the following:
% \begin{verbatim}
@ -1730,7 +1730,7 @@ type_e_no_assign_to_const=04032_E_Can't assign values to const variable
type_e_array_required=04033_E_Array type required
% If you are accessing a variable using an index '[<x>]' then
% the type must be an array. In FPC mode a pointer is also allowed.
type_e_interface_type_expected=04034_E_interface type expected, but got "$1"
type_e_interface_type_expected=04034_E_Interface type expected, but got "$1"
% The compiler expected to encounter an interface type name, but got something else.
% The following code would produce this error:
% \begin{verbatim}
@ -1754,7 +1754,7 @@ type_w_mixed_signed_unsigned2=04036_W_Mixing signed expressions and cardinals he
type_e_typecast_wrong_size_for_assignment=04037_E_Typecast has different size ($1 -> $2) in assignment
% Type casting to a type with a different size is not allowed when the variable is
% used in an assignment.
type_e_array_index_enums_with_assign_not_possible=04038_E_enums with assignments cannot be used as array index
type_e_array_index_enums_with_assign_not_possible=04038_E_Enums with assignments cannot be used as array index
% When you declared an enumeration type which has C-like
% assignments, such as in the following:
% \begin{verbatim}
@ -1971,8 +1971,8 @@ type_w_unicode_data_loss=04108_W_Unicode constant cast with potential data loss
% Conversion from a WideChar to AnsiChar can lose data since now all unicode characters may be represented in the current
% system codepage
% You can nest function definitions only 31 levels deep.
type_e_range_check_error_bounds=04109_E_range check error while evaluating constants ($1 must be between $2 and $3)
type_w_range_check_error_bounds=04110_W_range check error while evaluating constants ($1 must be between $2 and $3)
type_e_range_check_error_bounds=04109_E_Range check error while evaluating constants ($1 must be between $2 and $3)
type_w_range_check_error_bounds=04110_W_Range check error while evaluating constants ($1 must be between $2 and $3)
% The constants are outside their allowed range.
type_e_type_not_allowed_for_default=04111_E_This type is not supported for the Default() intrinsic
% Some types like for example Text and File Of X are not supported by the Default intrinsic.
@ -2083,11 +2083,11 @@ sym_e_goto_and_label_not_supported=05017_E_GOTO and LABEL are not supported (use
% supported.
sym_e_label_not_found=05018_E_Label not found
% A \var{goto label} was encountered, but the label wasn't declared.
sym_e_id_is_no_label_id=05019_E_identifier isn't a label
sym_e_id_is_no_label_id=05019_E_Identifier isn't a label
% The identifier specified after the \var{goto} isn't of type label.
sym_e_label_already_defined=05020_E_label already defined
sym_e_label_already_defined=05020_E_Label already defined
% You are defining a label twice. You can define a label only once.
sym_e_ill_type_decl_set=05021_E_illegal type declaration of set elements
sym_e_ill_type_decl_set=05021_E_Illegal type declaration of set elements
% The declaration of a set contains an invalid type definition.
sym_e_class_forward_not_resolved=05022_E_Forward class definition not resolved "$1"
% You declared a class, but you did not implement it.
@ -2135,7 +2135,7 @@ sym_w_uninitialized_variable=05037_W_Variable "$1" does not seem to be initializ
% be used (i.e. it appears in the right-hand side of an expression) when it
% was not initialized first (i.e. appeared in the left-hand side of an
% assignment).
sym_e_id_no_member=05038_E_identifier idents no member "$1"
sym_e_id_no_member=05038_E_Identifier idents no member "$1"
% This error is generated when an identifier of a record,
% field or method is accessed while it is not defined.
sym_h_param_list=05039_H_Found declaration: $1
@ -2320,7 +2320,7 @@ sym_h_uninitialized_managed_variable=05092_H_Variable "$1" of a managed type doe
% was not initialized first (i.e. t did not appear in the left-hand side of an
% assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
% does not necessarily mean that the code is wrong.
sym_w_managed_function_result_uninitialized=05093_W_function result variable of a managed type does not seem to be initialized
sym_w_managed_function_result_uninitialized=05093_W_Function result variable of a managed type does not seem to be initialized
% This message is displayed if the compiler thinks that the function result
% variable will be used (i.e. it appears in the right-hand side of an expression)
% before it is initialized (i.e. before it appeared in the left-hand side of an
@ -2378,7 +2378,7 @@ cg_w_member_cd_call_from_method=06016_W_Possible illegal call of constructor or
% require parameters on entry.
cg_n_inefficient_code=06017_N_Inefficient code
% Your statement seems dubious to the compiler.
cg_w_unreachable_code=06018_W_unreachable code
cg_w_unreachable_code=06018_W_Unreachable code
% You specified a construct which will never be executed. Example:
% \begin{verbatim}
% while false do
@ -2531,9 +2531,9 @@ asmr_e_no_local_or_para_allowed=07007_E_Cannot use local variable or parameters
% You cannot use a local variable or parameter here, mostly because the
% addressing of locals and parameters is done using the frame pointer register so the
% address cannot be obtained directly.
asmr_e_need_offset=07008_E_need to use OFFSET here
asmr_e_need_offset=07008_E_Need to use OFFSET here
% You need to use OFFSET <id> here to get the address of the identifier.
asmr_e_need_dollar=07009_E_need to use $ here
asmr_e_need_dollar=07009_E_Need to use $ here
% You need to use $<id> here to get the address of the identifier.
asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Cannot use multiple relocatable symbols
% You cannot have more than one relocatable symbol (variable/typed constant)
@ -2574,7 +2574,7 @@ asmr_e_expr_zero_divide=07025_E_Divide by zero in asm evaluator
% There is a division by zero in a constant expression
asmr_e_expr_illegal=07026_E_Illegal expression
% There is an illegal expression in a constant expression
asmr_e_escape_seq_ignored=07027_E_escape sequence ignored: $1
asmr_e_escape_seq_ignored=07027_E_Escape sequence ignored: $1
% There is a C-styled string, but the escape sequence in the string
% is unknown, and is therefore ignored
asmr_e_invalid_symbol_ref=07028_E_Invalid symbol reference
@ -2621,7 +2621,7 @@ asmr_e_invalid_opcode_and_operand=07048_E_Invalid combination of opcode and oper
asmr_e_syn_operand=07049_E_Assembler syntax error in operand
asmr_e_syn_constant=07050_E_Assembler syntax error in constant
asmr_e_invalid_string_expression=07051_E_Invalid String expression
asmr_w_const32bit_for_address=07052_W_constant with symbol $1 for address which is not on a pointer
asmr_w_const32bit_for_address=07052_W_Constant with symbol $1 for address which is not on a pointer
% A constant expression represents an address which does not fit
% into a pointer. The address is probably incorrect
asmr_e_unknown_opcode=07053_E_Unrecognized opcode $1
@ -2662,7 +2662,7 @@ asmr_e_string_not_allowed_as_const=07073_E_Strings not allowed as constants
asmr_e_no_var_type_specified=07074_E_No type of variable specified
% The syntax expects a type identifier after the dot, but
% none was found.
asmr_w_assembler_code_not_returned_to_text=07075_E_assembler code not returned to text section
asmr_w_assembler_code_not_returned_to_text=07075_E_Assembler code not returned to text section
% There was a directive in the assembler block to change sections,
% but there is a missing return to the text section at the end
% of the assembler block. This might cause errors during link time.
@ -2975,20 +2975,20 @@ exec_e_static_lib_not_supported=09035_E_Creation of Static Libraries not support
% not yet implemented in the compiler.
exec_i_closing_script=09020_I_Closing script $1
% Informational message showing when writing of the external assembling and linking script is finished.
exec_e_res_not_found=09021_E_resource compiler "$1" not found, switching to external mode
exec_e_res_not_found=09021_E_Resource compiler "$1" not found, switching to external mode
% An external resource compiler was not found. The compiler will produce a script that
% can be used to assemble, compile resources and link or postprocess the program.
exec_i_compilingresource=09022_I_Compiling resource $1
% An informational message, showing which resource is being compiled.
exec_t_unit_not_static_linkable_switch_to_smart=09023_T_unit $1 cannot be statically linked, switching to smart linking
exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Unit $1 cannot be statically linked, switching to smart linking
% Static linking was requested, but a unit which is not statically linkable was used.
exec_t_unit_not_smart_linkable_switch_to_static=09024_T_unit $1 cannot be smart linked, switching to static linking
exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Unit $1 cannot be smart linked, switching to static linking
% Smart linking was requested, but a unit which is not smart-linkable was used.
exec_t_unit_not_shared_linkable_switch_to_static=09025_T_unit $1 cannot be shared linked, switching to static linking
exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Unit $1 cannot be shared linked, switching to static linking
% Shared linking was requested, but a unit which is not shared-linkable was used.
exec_e_unit_not_smart_or_static_linkable=09026_E_unit $1 cannot be smart or static linked
exec_e_unit_not_smart_or_static_linkable=09026_E_Unit $1 cannot be smart or static linked
% Smart or static linking was requested, but a unit which cannot be used for either was used.
exec_e_unit_not_shared_or_static_linkable=09027_E_unit $1 cannot be shared or static linked
exec_e_unit_not_shared_or_static_linkable=09027_E_Unit $1 cannot be shared or static linked
% Shared or static linking was requested, but a unit which cannot be used for either was used.
exec_d_resbin_params=09028_D_Calling resource compiler "$1" with "$2" as command line
% An informational message showing which command line is used for the resource compiler.
@ -3152,7 +3152,7 @@ unit_f_ppu_cannot_write=10013_F_Can't Write PPU-File
unit_f_ppu_read_error=10014_F_Error reading PPU-File
% This means that the unit file was corrupted, and contains invalid
% information. Recompilation will be necessary.
unit_f_ppu_read_unexpected_end=10015_F_unexpected end of PPU-File
unit_f_ppu_read_unexpected_end=10015_F_Unexpected end of PPU-File
% Unexpected end of file. This may mean that the PPU file is
% corrupted.
unit_f_ppu_invalid_entry=10016_F_Invalid PPU-File entry: $1
@ -3350,7 +3350,7 @@ option_only_one_source_support=11001_W_Only one source file supported, changing
% you forgot a \var{'-'} sign.
option_def_only_for_os2=11002_W_DEF file can be created only for OS/2
% This option can only be specified when you're compiling for OS/2.
option_no_nested_response_file=11003_E_nested response files are not supported
option_no_nested_response_file=11003_E_Nested response files are not supported
% You cannot nest response files with the \var{@file} command line option.
option_no_source_found=11004_F_No source file name in command line
% The compiler expects a source file name on the command line.
@ -3420,15 +3420,15 @@ option_start_reading_configfile=11030_H_Start of reading config file $1
% Start of configuration file parsing.
option_end_reading_configfile=11031_H_End of reading config file $1
% End of configuration file parsing.
option_interpreting_option=11032_D_interpreting option "$1"
option_interpreting_option=11032_D_Interpreting option "$1"
% The compiler is interpreting an option
option_interpreting_firstpass_option=11036_D_interpreting firstpass option "$1"
option_interpreting_firstpass_option=11036_D_Interpreting firstpass option "$1"
% The compiler is interpreting an option for the first time.
option_interpreting_file_option=11033_D_interpreting file option "$1"
option_interpreting_file_option=11033_D_Interpreting file option "$1"
% The compiler is interpreting an option which it read from the configuration file.
option_read_config_file=11034_D_Reading config file "$1"
% The compiler is starting to read the configuration file.
option_found_file=11035_D_found source file name "$1"
option_found_file=11035_D_Found source file name "$1"
% Additional information about options.
% Displayed when you have the debug option turned on.
option_code_page_not_available=11039_E_Unknown codepage "$1"
@ -3475,9 +3475,9 @@ option_illegal_fpu_eabihf=11052_E_You must use a FPU type of VFPV2, VFPV3 or VFP
% The EABIHF (VFP hardfloat) ABI target can only be used with VFP FPUs.
option_w_unsupported_debug_format=11053_W_The selected debug format is not supported on the current target, not changing the current setting
% Not all targets support all debug formats (in particular, Stabs is not supported on 64 bit targets).
option_missing_arg=11054_E_argument to "$1" is missing
option_missing_arg=11054_E_Argument to "$1" is missing
% Displayed when parameter must be followed by an argument.
option_malformed_para=11055_E_malformed parameter: $1
option_malformed_para=11055_E_Malformed parameter: $1
% Given argument is not valid for parameter.
option_smart_link_requires_external_linker=11056_W_Smart linking requires external linker
option_com_files_require_tiny_model=11057_E_Creating .COM files is not supported in the current memory model. Only the tiny memory model supports making .COM files.
@ -3632,7 +3632,7 @@ package_f_pcp_cannot_write=13019_F_Can't Write PCP-File
package_f_pcp_read_error=13020_F_Error reading PCP-File
% This means that the package file was corrupted, and contains invalid
% information. Recompilation will be necessary.
package_f_pcp_read_unexpected_end=13021_F_unexpected end of PCP-File
package_f_pcp_read_unexpected_end=13021_F_Unexpected end of PCP-File
% Unexpected end of file. This may mean that the PCP file is
% corrupted.
package_f_pcp_invalid_entry=13022_F_Invalid PCP-File entry: $1

2
compiler/msgidx.inc
View File

@ -1105,7 +1105,7 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 82668;
MsgTxtSize = 82667;
MsgIdxMax : array[1..20] of longint=(
28,106,349,126,98,59,142,34,221,67,

758
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion = 204;
CurrentPPUVersion = 205;
{ unit flags }
uf_init = $000001; { unit has initialization section }

23
compiler/symdef.pas
View File

@ -158,6 +158,7 @@ interface
function getmangledparaname:TSymStr;override;
function size:asizeint;override;
procedure setsize;
function alignment: shortint; override;
end;
tfiledefclass = class of tfiledef;
@ -956,6 +957,7 @@ interface
procedure deref;override;
function GetTypeName:string;override;
function is_publishable : boolean;override;
function alignment: shortint; override;
end;
tsetdefclass = class of tsetdef;
@ -3212,6 +3214,20 @@ implementation
end;
function tfiledef.alignment: shortint;
begin
case filetyp of
ft_text:
result:=search_system_type('TEXTREC').typedef.alignment;
ft_typed,
ft_untyped:
result:=search_system_type('FILEREC').typedef.alignment;
else
internalerror(2018120101);
end;
end;
procedure tfiledef.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
@ -3665,6 +3681,13 @@ implementation
is_publishable:=savesize in [1,2,4];
end;
function tsetdef.alignment: shortint;
begin
Result:=inherited;
if result>sizeof(aint) then
result:=sizeof(aint);
end;
function tsetdef.GetTypeName : string;
begin

6
compiler/systems/i_android.pas
View File

@ -151,7 +151,7 @@ unit i_android;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -220,7 +220,7 @@ unit i_android;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -289,7 +289,7 @@ unit i_android;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;

6
compiler/systems/i_aros.pas
View File

@ -79,7 +79,7 @@ unit i_aros;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 0;
@ -145,7 +145,7 @@ unit i_aros;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -210,7 +210,7 @@ unit i_aros;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 0;

24
compiler/systems/i_bsd.pas
View File

@ -180,7 +180,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -250,7 +250,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -317,7 +317,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -383,7 +383,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -453,7 +453,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -656,7 +656,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -856,7 +856,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 0;
@ -924,11 +924,11 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 0;
localalignmax : 8;
localalignmax : 16;
recordalignmin : 0;
recordalignmax : 16;
maxCrecordalign : 16
@ -1061,7 +1061,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -1128,7 +1128,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -1263,7 +1263,7 @@ unit i_bsd;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;

4
compiler/systems/i_embed.pas
View File

@ -287,7 +287,7 @@ unit i_embed;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -354,7 +354,7 @@ unit i_embed;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;

6
compiler/systems/i_linux.pas
View File

@ -85,7 +85,7 @@ unit i_linux;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -427,7 +427,7 @@ unit i_linux;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -925,7 +925,7 @@ unit i_linux;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;

4
compiler/systems/i_sunos.pas
View File

@ -82,7 +82,7 @@ unit i_sunos;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;
@ -154,7 +154,7 @@ unit i_sunos;
coalescealign : 0;
coalescealignmax: 0;
constalignmin : 0;
constalignmax : 8;
constalignmax : 16;
varalignmin : 0;
varalignmax : 16;
localalignmin : 4;

5
packages/fcl-passrc/src/pasresolver.pp
View File

@ -285,7 +285,10 @@ interface
uses
{$ifdef pas2js}
js, NodeJSFS,
js,
{$IFDEF NODEJS}
NodeJSFS,
{$ENDIF}
{$endif}
Classes, SysUtils, Math, Types, contnrs,
PasTree, PScanner, PParser, PasResolveEval;

26
packages/fcl-passrc/src/pparser.pp
View File

@ -31,7 +31,7 @@ unit PParser;
interface
uses
{$ifdef pas2js}
{$ifdef NODEJS}
NodeJSFS,
{$endif}
SysUtils, Classes, PasTree, PScanner;
@ -94,6 +94,7 @@ const
nParserResourcestringsMustBeGlobal = 2054;
nParserOnlyOneVariableCanBeAbsolute = 2055;
nParserXNotAllowedInY = 2056;
nFileSystemsNotSupported = 2057;
// resourcestring patterns of messages
resourcestring
@ -153,6 +154,7 @@ resourcestring
SParserResourcestringsMustBeGlobal = 'Resourcestrings can be only static or global';
SParserOnlyOneVariableCanBeAbsolute = 'Only one variable can be absolute';
SParserXNotAllowedInY = '%s is not allowed in %s';
SErrFileSystemNotSupported = 'No support for filesystems enabled';
type
TPasScopeType = (
@ -472,6 +474,10 @@ Type
{$endif}
poSkipDefaultDefs);
TParseSourceOptions = set of TParseSourceOption;
Var
DefaultFileResolverClass : TBaseFileResolverClass = Nil;
function ParseSource(AEngine: TPasTreeContainer;
const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
{$ifdef HasStreams}
@ -597,8 +603,9 @@ end;
function ParseSource(AEngine: TPasTreeContainer;
const FPCCommandLine, OSTarget, CPUTarget: String;
Options : TParseSourceOptions): TPasModule;
var
FileResolver: TFileResolver;
FileResolver: TBaseFileResolver;
Parser: TPasParser;
Start, CurPos: integer; // in FPCCommandLine
Filename: String;
@ -648,7 +655,7 @@ var
end;
end else
if Filename <> '' then
raise Exception.Create(SErrMultipleSourceFiles)
raise ENotSupportedException.Create(SErrMultipleSourceFiles)
else
Filename := s;
end;
@ -656,14 +663,17 @@ var
var
s: String;
begin
if DefaultFileResolverClass=Nil then
raise ENotImplemented.Create(SErrFileSystemNotSupported);
Result := nil;
FileResolver := nil;
Scanner := nil;
Parser := nil;
try
FileResolver := TFileResolver.Create;
FileResolver := DefaultFileResolverClass.Create;
{$ifdef HasStreams}
FileResolver.UseStreams:=poUseStreams in Options;
if FileResolver is TFileResolver then
TFileResolver(FileResolver).UseStreams:=poUseStreams in Options;
{$endif}
Scanner := TPascalScanner.Create(FileResolver);
Scanner.LogEvents:=AEngine.ScannerLogEvents;
@ -733,7 +743,9 @@ begin
if Filename = '' then
raise Exception.Create(SErrNoSourceGiven);
{$IFDEF HASFS}
FileResolver.AddIncludePath(ExtractFilePath(FileName));
{$ENDIF}
Scanner.OpenFile(Filename);
Parser.ParseMain(Result);
finally
@ -6989,4 +7001,8 @@ begin
Result.Kind:=pekListOfExp;
end;
initialization
{$IFDEF HASFS}
DefaultFileResolverClass:=TFileResolver;
{$ENDIF}
end.

93
packages/fcl-passrc/src/pscanner.pp
View File

@ -26,13 +26,22 @@ unit PScanner;
{$IF FPC_FULLVERSION<30101}
{$define EmulateArrayInsert}
{$endif}
{$define HasFS}
{$endif}
{$IFDEF NODEJS}
{$define HasFS}
{$ENDIF}
interface
uses
{$ifdef pas2js}
js, NodeJSFS, Types,
js,
{$IFDEF NODEJS}
NodeJSFS,
{$ENDIF}
Types,
{$endif}
SysUtils, Classes;
@ -479,7 +488,6 @@ type
Protected
procedure SetBaseDirectory(AValue: string); virtual;
procedure SetStrictFileCase(AValue: Boolean); virtual;
Function FindIncludeFileName(const AName: string): String;
Property IncludePaths: TStringList Read FIncludePaths;
public
constructor Create; virtual;
@ -490,7 +498,9 @@ type
Property StrictFileCase : Boolean Read FStrictFileCase Write SetStrictFileCase;
property BaseDirectory: string read FBaseDirectory write SetBaseDirectory;
end;
TBaseFileResolverClass = Class of TBaseFileResolver;
{$IFDEF HASFS}
{ TFileResolver }
TFileResolver = class(TBaseFileResolver)
@ -499,6 +509,7 @@ type
FUseStreams: Boolean;
{$endif}
Protected
Function FindIncludeFileName(const AName: string): String; virtual;
Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
Public
function FindSourceFile(const AName: string): TLineReader; override;
@ -507,6 +518,7 @@ type
Property UseStreams : Boolean Read FUseStreams Write FUseStreams;
{$endif}
end;
{$ENDIF}
{$ifdef fpc}
{ TStreamResolver }
@ -1144,6 +1156,7 @@ function FilenameIsAbsolute(const TheFilename: string):boolean;
function FilenameIsWinAbsolute(const TheFilename: string): boolean;
function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
Function ExtractFilenameOnly(Const AFileName : String) : String;
procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
function SafeFormat(const Fmt: string; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): string;
@ -1159,6 +1172,13 @@ Var
SortedTokens : array of TToken;
LowerCaseTokens : Array[ttoken] of String;
Function ExtractFilenameOnly(Const AFileName : String) : String;
begin
Result:=ChangeFileExt(ExtractFileName(aFileName),'');
end;
Procedure SortTokenInfo;
Var
@ -2378,7 +2398,45 @@ begin
FStrictFileCase:=AValue;
end;
function TBaseFileResolver.FindIncludeFileName(const AName: string): String;
constructor TBaseFileResolver.Create;
begin
inherited Create;
FIncludePaths := TStringList.Create;
end;
destructor TBaseFileResolver.Destroy;
begin
FIncludePaths.Free;
inherited Destroy;
end;
procedure TBaseFileResolver.AddIncludePath(const APath: string);
Var
FP : String;
begin
if (APath='') then
FIncludePaths.Add('./')
else
begin
{$IFDEF HASFS}
FP:=IncludeTrailingPathDelimiter(ExpandFileName(APath));
{$ELSE}
FP:=APath;
{$ENDIF}
FIncludePaths.Add(FP);
end;
end;
{$IFDEF HASFS}
{ ---------------------------------------------------------------------
TFileResolver
---------------------------------------------------------------------}
function TFileResolver.FindIncludeFileName(const AName: string): String;
function SearchLowUpCase(FN: string): string;
@ -2432,30 +2490,6 @@ begin
end;
end;
constructor TBaseFileResolver.Create;
begin
inherited Create;
FIncludePaths := TStringList.Create;
end;
destructor TBaseFileResolver.Destroy;
begin
FIncludePaths.Free;
inherited Destroy;
end;
procedure TBaseFileResolver.AddIncludePath(const APath: string);
begin
if (APath='') then
FIncludePaths.Add('./')
else
FIncludePaths.Add(IncludeTrailingPathDelimiter(ExpandFileName(APath)));
end;
{ ---------------------------------------------------------------------
TFileResolver
---------------------------------------------------------------------}
function TFileResolver.CreateFileReader(const AFileName: String): TLineReader;
begin
{$ifdef HasStreams}
@ -2494,6 +2528,7 @@ begin
Result:=Nil;
end;
end;
{$ENDIF}
{$ifdef fpc}
{ TStreamResolver }
@ -2648,7 +2683,7 @@ begin
// Dont' free the first element, because it is CurSourceFile
while FIncludeStack.Count > 1 do
begin
TFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif};
TBaseFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif};
FIncludeStack.Delete(1);
end;
FIncludeStack.Clear;
@ -2684,7 +2719,9 @@ begin
FCurSourceFile := FileResolver.FindSourceFile(AFilename);
FCurFilename := AFilename;
AddFile(FCurFilename);
{$IFDEF HASFS}
FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
{$ENDIF}
if LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
end;

9
packages/pastojs/fpmake.pp
View File

@ -46,13 +46,16 @@ begin
T:=P.Targets.AddUnit('fppjssrcmap.pp');
T:=P.Targets.AddUnit('pas2jsfilecache.pp');
T:=P.Targets.AddUnit('pas2jsfileutils.pp');
T.Dependencies.AddInclude('pas2js_defines.inc');
T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
T.Dependencies.AddInclude('pas2js_defines.inc');
T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
T:=P.Targets.AddUnit('pas2jslogger.pp');
T:=P.Targets.AddUnit('pas2jspparser.pp');
T:=P.Targets.AddUnit('pas2jscompiler.pp');
T:=P.Targets.AddUnit('pas2jspcucompiler.pp');
T.Dependencies.AddUnit('pas2jscompiler');
T:=P.Targets.AddUnit('pas2jslibcompiler.pp');
T.Dependencies.AddUnit('pas2jscompiler');
{$ifndef ALLPACKAGES}
Run;
end;

1755
packages/pastojs/src/pas2jscompiler.pp
View File

File diff suppressed because it is too large Load Diff

791
packages/pastojs/src/pas2jsfilecache.pp
View File

File diff suppressed because it is too large Load Diff

431
packages/pastojs/src/pas2jspcucompiler.pp Normal file
View File

@ -0,0 +1,431 @@
unit pas2jspcucompiler;
{$mode objfpc}{$H+}
{$I pas2js_defines.inc}
{$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
{$DEFINE ReallyVerbose}
{$ENDIF}
interface
uses
Classes, SysUtils, pastree, pas2jscompiler, Pas2JsFiler;
Type
{ TFilerPCUSupport }
TFilerPCUSupport = Class(TPCUSupport)
Private
// This is the format that will be written.
FPCUFormat : TPas2JSPrecompileFormat;
// This is the format that will be read.
FFoundFormat : TPas2JSPrecompileFormat;
FPrecompileInitialFlags: TPCUInitialFlags;
FPCUReader: TPCUCustomReader;
FPCUReaderStream: TStream;
function OnPCUConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
function OnPCUConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
function OnWriterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer);
Public
constructor create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
Destructor destroy; override;
Function Compiler : TPas2JSCompiler;
Function HandleException(E: exception) : Boolean; override;
function FindPCU(const UseUnitName: string): string;override;
function FindPCU(const UseUnitName: string; out aFormat: TPas2JSPrecompileFormat): string;
Function HasReader : Boolean; override;
Function ReadContinue: Boolean; override;
Function ReadCanContinue : Boolean; override;
Procedure SetInitialCompileFlags; override;
Procedure WritePCU; override;
procedure CreatePCUReader; override;
Procedure ReadUnit; override;
property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
end;
{ TPas2jsPCUCompiler }
{ TPas2jsPCUCompilerFile }
TPas2jsPCUCompilerFile = Class(TPas2jsCompilerFile)
Function CreatePCUSupport: TPCUSupport; override;
end;
TPas2jsPCUCompiler = Class(TPas2JSCompiler)
FPrecompileFormat : TPas2JSPrecompileFormat;
Protected
procedure WritePrecompiledFormats; override;
function CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile; override;
Procedure HandleOptionPCUFormat(Value : string) ; override;
end;
implementation
uses fppas2js, pscanner, pas2jslogger, pas2jsfilecache, pasresolveeval, jstree, pas2jsfileutils;
{ ---------------------------------------------------------------------
TFilerPCUSupport
---------------------------------------------------------------------}
{ TFilerPCUSupport }
constructor TFilerPCUSupport.create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
begin
Inherited Create(aCompilerFile);
FPCUFormat:=AFormat;
FPrecompileInitialFlags:=TPCUInitialFlags.Create;
end;
destructor TFilerPCUSupport.destroy;
begin
FreeAndNil(FPrecompileInitialFlags);
FreeAndNil(FPCUReader);
FreeAndNil(FPCUReaderStream);
inherited destroy;
end;
function TFilerPCUSupport.Compiler: TPas2JSCompiler;
begin
Result:=MyFile.Compiler;
end;
Function TFilerPCUSupport.HandleException(E: Exception) : Boolean;
begin
Result:=False;
if E is EPas2JsReadError then
begin
Result:=True;
if EPas2JsReadError(E).Owner is TPCUCustomReader then
begin
MyFile.Log.Log(mtError,E.Message,0,MyFile.PCUFilename);
end else begin
MyFile.Log.Log(mtError,E.Message);
end;
Compiler.Terminate(ExitCodePCUError);
end
else if (E is EPas2JsWriteError) then
begin
MyFile.Log.Log(mtFatal,E.ClassName+':'+E.Message);
Compiler.Terminate(ExitCodeErrorInternal);
Result:=True;
end
end;
function TFilerPCUSupport.FindPCU(const UseUnitName: string): string;
begin
Result:=FindPCU(UseUnitName,FFoundFormat);
end;
function TFilerPCUSupport.HasReader: Boolean;
begin
Result:=Assigned(FPCUReader);
end;
function TFilerPCUSupport.ReadContinue: Boolean;
begin
Result:=FPCUReader.ReadContinue;
end;
function TFilerPCUSupport.ReadCanContinue: Boolean;
begin
Result:=FPCUReader.ReadCanContinue;
end;
procedure TFilerPCUSupport.SetInitialCompileFlags;
begin
PrecompileInitialFlags.ParserOptions:=MyFile.Parser.Options;
PrecompileInitialFlags.ModeSwitches:=MyFile.Scanner.CurrentModeSwitches;
PrecompileInitialFlags.BoolSwitches:=MyFile.Scanner.CurrentBoolSwitches;
PrecompileInitialFlags.ConverterOptions:=MyFile.GetInitialConverterOptions;
PrecompileInitialFlags.TargetPlatform:=Compiler.TargetPlatform;
PrecompileInitialFlags.TargetProcessor:=Compiler.TargetProcessor;
end;
procedure TFilerPCUSupport.CreatePCUReader;
var
aFile: TPas2jsCachedFile;
s: String;
begin
if MyFile.PCUFilename='' then
RaiseInternalError(20180312144742,MyFile.PCUFilename);
if FPCUReader<>nil then
RaiseInternalError(20180312142938,GetObjName(FPCUReader));
if FFoundFormat=nil then
RaiseInternalError(20180312142954,'');
FPCUReader:=FFoundFormat.ReaderClass.Create;
FPCUReader.SourceFilename:=ExtractFileName(MyFile.PCUFilename);
if MyFile.ShowDebug then
MyFile.Log.LogMsg(nParsingFile,[QuoteStr(MyFile.PCUFilename)]);
aFile:=Compiler.FileCache.LoadFile(MyFile.PCUFilename,true);
if aFile=nil then
RaiseInternalError(20180312145941,MyFile.PCUFilename);
FPCUReaderStream:=TMemoryStream.Create;
s:=aFile.Source;
//writeln('TPas2jsCompilerFile.CreatePCUReader ',PCUFilename,'-----START-----');
//writeln(s);
//writeln('TPas2jsCompilerFile.CreatePCUReader ',PCUFilename,'-----END-------');
if s<>'' then
begin
FPCUReaderStream.Write(s[1],length(s));
FPCUReaderStream.Position:=0;
end;
end;
procedure TFilerPCUSupport.ReadUnit;
begin
FPCUReader.ReadPCU(MyFile.PascalResolver,FPCUReaderStream);
SetPasModule(MyFile.PascalResolver.RootElement);
SetReaderState(prsCanContinue);
end;
function TFilerPCUSupport.FindPCU(const UseUnitName: string; out aFormat: TPas2JSPrecompileFormat): string;
function SearchInDir(DirPath: string): boolean;
var
i: Integer;
CurFormat: TPas2JSPrecompileFormat;
Filename: String;
begin
if DirPath='' then exit(false);
DirPath:=IncludeTrailingPathDelimiter(DirPath);
for i:=0 to PrecompileFormats.Count-1 do
begin
CurFormat:=PrecompileFormats[i];
if not CurFormat.Enabled then continue;
Filename:=DirPath+UseUnitName+'.'+CurFormat.Ext;
if Compiler.FileCache.SearchLowUpCase(Filename) then
begin
FindPCU:=Filename;
aFormat:=CurFormat;
exit(true);
end;
end;
Result:=false;
end;
var
Cache: TPas2jsFilesCache;
i: Integer;
begin
Result:='';
aFormat:=nil;
Cache:=Compiler.FileCache;
// search in output directory
if Cache.UnitOutputPath<>'' then
if SearchInDir(Cache.UnitOutputPath) then exit;
// then in BaseDirectory
if SearchInDir(MyFile.FileResolver.BaseDirectory) then exit;
// finally search in unit paths
for i:=0 to Cache.UnitPaths.Count-1 do
if SearchInDir(Cache.UnitPaths[i]) then exit;
end;
function TFilerPCUSupport.OnWriterIsElementUsed(Sender: TObject;
El: TPasElement): boolean;
begin
Result:=MyFile.UseAnalyzer.IsUsed(El);
end;
procedure TFilerPCUSupport.WritePCU;
Const
AllowCompressed =
{$IFDEF DisablePCUCompressed}false{$ELSE}true{$ENDIF};
var
Writer: TPCUWriter;
ms: TMemoryStream;
DestDir: String;
JS: TJSElement;
FN : String;
begin
if FPCUFormat=Nil then
exit; // Don't write
if MyFile.PasModule.ClassType<>TPasModule then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU not a unit: ',MyFile.PasFilename,' skip');
{$ENDIF}
exit;
end;
if (MyFile.PCUFilename<>'') or (FPCUReader<>nil) then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU already precompiled "',MyFile.PCUFilename,'" Reader=',GetObjName(FPCUReader));
{$ENDIF}
exit;
end;
// Determine output filename
FN:=ExtractFilenameOnly(MyFile.PasFilename)+'.'+FPCUFormat.Ext;
if Compiler.FileCache.UnitOutputPath<>'' then
FN:=Compiler.FileCache.UnitOutputPath+FN
else
FN:=ExtractFilePath(MyFile.PasFilename)+FN;
// Set as our filename
SetPCUFilename(FN);
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU precompiling ',MyFile.PCUFilename);
{$ENDIF}
JS:=nil;
ms:=TMemoryStream.Create;
Writer:=FPCUFormat.WriterClass.Create;
try
Writer.GUID:=Compiler.PrecompileGUID;
Writer.OnGetSrc:=@OnFilerGetSrc;
Writer.OnIsElementUsed:=@OnWriterIsElementUsed;
// create JavaScript for procs, initialization, finalization
MyFile.CreateConverter;
MyFile.Converter.Options:=MyFile.Converter.Options+[coStoreImplJS];
MyFile.Converter.OnIsElementUsed:=@OnPCUConverterIsElementUsed;
MyFile.Converter.OnIsTypeInfoUsed:=@OnPCUConverterIsTypeInfoUsed;
JS:=MyFile.Converter.ConvertPasElement(MyFile.PasModule,MyFile.PascalResolver);
MyFile.Converter.Options:=MyFile.Converter.Options-[coStoreImplJS];
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU create pcu ... ',MyFile.PCUFilename);
{$ENDIF}
Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,PrecompileInitialFlags,ms,AllowCompressed);
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU precompiled ',MyFile.PCUFilename);
{$ENDIF}
MyFile.Log.LogMsg(nWritingFile,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))],'',0,0,
not (coShowLineNumbers in Compiler.Options));
// check output directory
DestDir:=ChompPathDelim(ExtractFilePath(MyFile.PCUFilename));
if (DestDir<>'') and not Compiler.FileCache.DirectoryExists(DestDir) then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU output dir not found "',DestDir,'"');
{$ENDIF}
MyFile.Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(Compiler.FileCache.FormatPath(DestDir))]);
Compiler.Terminate(ExitCodeFileNotFound);
end;
if Compiler.FileCache.DirectoryExists(MyFile.PCUFilename) then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU file is folder "',DestDir,'"');
{$ENDIF}
MyFile.Log.LogMsg(nFileIsFolder,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))]);
Compiler.Terminate(ExitCodeWriteError);
end;
ms.Position:=0;
Compiler.FileCache.SaveToFile(ms,MyFile.PCUFilename);
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU written ',MyFile.PCUFilename);
{$ENDIF}
finally
JS.Free;
Writer.Free;
ms.Free;
end;
end;
procedure TFilerPCUSupport.OnFilerGetSrc(Sender: TObject; aFilename: string;
out p: PChar; out Count: integer);
var
SrcFile: TPas2jsCachedFile;
begin
if Sender=nil then
RaiseInternalError(20180311135558,aFilename);
SrcFile:=MyFile.Compiler.FileCache.LoadFile(aFilename);
if SrcFile=nil then
RaiseInternalError(20180311135329,aFilename);
p:=PChar(SrcFile.Source);
Count:=length(SrcFile.Source);
end;
function TFilerPCUSupport.OnPCUConverterIsElementUsed(Sender: TObject;
El: TPasElement): boolean;
begin
if (coKeepNotUsedPrivates in MyFile.Compiler.Options) then
Result:=true
else
Result:=MyFile.UseAnalyzer.IsUsed(El);
end;
function TFilerPCUSupport.OnPCUConverterIsTypeInfoUsed(Sender: TObject;
El: TPasElement): boolean;
begin
if Sender=nil then ;
if El=nil then ;
// PCU does not need precompiled typeinfo
Result:=false;
end;
{ TPas2jsPCUCompiler }
procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
Var
I : Integer;
begin
if PrecompileFormats.Count>0 then
begin
writeHelpLine(' -JU<x> : Create precompiled units in format x.');
for i:=0 to PrecompileFormats.Count-1 do
with PrecompileFormats[i] do
writeHelpLine(' -JU'+Ext+' : '+Description);
writeHelpLine(' -JU- : Disable prior -JU<x> option. Do not create precompiled units.');
end;
end;
function TPas2jsPCUCompiler.CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile;
begin
Result:=TPas2JSPCUCompilerFile.Create(Self,UnitFileName);
end;
procedure TPas2jsPCUCompiler.HandleOptionPCUFormat(Value: string);
Var
Found : Boolean;
I : integer;
PF: TPas2JSPrecompileFormat;
begin
Found:=false;
for i:=0 to PrecompileFormats.Count-1 do
begin
PF:=PrecompileFormats[i];
if not SameText(Value,PF.Ext) then continue;
FPrecompileFormat:=PrecompileFormats[i];
Found:=true;
end;
if not Found then
ParamFatal('invalid precompile output format (-JU) "'+Value+'"');
end;
{ TPas2jsPCUCompilerFile }
function TPas2jsPCUCompilerFile.CreatePCUSupport: TPCUSupport;
Var
PF: TPas2JSPrecompileFormat;
begin
// Note that if no format was preset, no files will be written
PF:=(Compiler as TPas2jsPCUCompiler).FPrecompileFormat;
if PF<>Nil then
Result:=TFilerPCUSupport.Create(Self,PF)
else
Result:=Nil;
end;
end.

7
packages/pastojs/tests/tcunitsearch.pas
View File

@ -221,11 +221,10 @@ begin
{$ENDIF}
inherited SetUp;
FDefaultFileAge:=DateTimeToFileDate(Now);
WorkDir:=ExtractFilePath(ParamStr(0));
{$IFDEF Windows}
WorkDir:='P:\test';
CompilerExe:='P:\bin\pas2js.exe';
{$ELSE}
WorkDir:='/home/user';
CompilerExe:='/usr/bin/pas2js';
{$ENDIF}
FCompiler:=TTestCompiler.Create;
@ -684,7 +683,7 @@ begin
' a:=b;',
'end.']);
Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
AssertEquals('ErrorMsg','Duplicate file found: "/home/user/sub/unit1.pas" and "/home/user/unit1.pas"',ErrorMsg);
AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub/unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
end;
procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
@ -704,7 +703,7 @@ begin
'begin',
'end.']);
Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
AssertEquals('ErrorMsg','Duplicate file found: "/home/user/unit1.pas" and "/home/user/sub/unit1.pas"',ErrorMsg);
AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub/unit1.pas"',ErrorMsg);
end;
Initialization

12
packages/pastojs/tests/testpas2js.lpi
View File

@ -19,9 +19,16 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<CommandLineParams Value="--suite=TTestCLI_UnitSearch"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
<Mode0 Name="default">
<local>
<CommandLineParams Value="--suite=TTestCLI_UnitSearch"/>
</local>
</Mode0>
</Modes>
</RunParams>
<RequiredPackages Count="2">
@ -103,9 +110,6 @@
</CodeGeneration>
<Other>
<CustomOptions Value="-dVerbosePas2JS"/>
<OtherDefines Count="1">
<Define0 Value="VerbosePas2JS"/>
</OtherDefines>
</Other>
</CompilerOptions>
<Debugging>