diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/gen_il-fields.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/gen_il-gen-gen_nodes.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/par-ch2.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch2.adb | 242 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 9 |
6 files changed, 213 insertions, 55 deletions
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 520ea55..9b85401 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -263,6 +263,7 @@ package Gen_IL.Fields is Is_In_Discriminant_Check, Is_Inherited_Pragma, Is_Initialization_Block, + Is_Interpolated_String_Literal, Is_Known_Guaranteed_ABE, Is_Machine_Number, Is_Null_Loop, diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index b1ca6cf..7224556 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -444,6 +444,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_String_Literal, N_Numeric_Or_String_Literal, (Sy (Strval, String_Id), Sy (Is_Folded_In_Parser, Flag), + Sy (Is_Interpolated_String_Literal, Flag), Sm (Has_Wide_Character, Flag), Sm (Has_Wide_Wide_Character, Flag))); diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index f249ae7..9823234 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -237,6 +237,7 @@ package body Ch2 is Error_Msg_SC ("string literal expected"); else + Set_Is_Interpolated_String_Literal (Token_Node); Append_To (Elements_List, Token_Node); Scan; -- past string_literal @@ -261,6 +262,7 @@ package body Ch2 is Error_Msg_SC ("unexpected string literal"); end if; + Set_Is_Interpolated_String_Literal (Token_Node); Append_To (Elements_List, Token_Node); Scan; -- past string_literal end if; diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index ddbb329..6d11b71 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -138,67 +138,113 @@ package body Sem_Ch2 is procedure Analyze_Interpolated_String_Literal (N : Node_Id) is - procedure Check_Ambiguous_Parameterless_Call (Func_Call : Node_Id); - -- Examine the interpretations of the call to the given parameterless - -- function call and report the location of each interpretation. + procedure Check_Ambiguous_Call (Func_Call : Node_Id); + -- Examine the interpretations of the call to the given function call + -- and report the location of each interpretation. - ---------------------------------------- - -- Check_Ambiguous_Parameterless_Call -- - ---------------------------------------- + -------------------------- + -- Check_Ambiguous_Call -- + -------------------------- - procedure Check_Ambiguous_Parameterless_Call (Func_Call : Node_Id) is + procedure Check_Ambiguous_Call (Func_Call : Node_Id) is - procedure Report_Interpretation (E : Entity_Id); - -- Report an interpretation of the function call + procedure Report_Interpretation (Nam : Entity_Id; Typ : Entity_Id); + -- Report an interpretation of the function call. When calling a + -- standard operator, use the location of the type, which may be + -- user-defined. --------------------------- -- Report_Interpretation -- --------------------------- - procedure Report_Interpretation (E : Entity_Id) is + procedure Report_Interpretation (Nam : Entity_Id; Typ : Entity_Id) is begin - Error_Msg_Sloc := Sloc (E); + if Sloc (Nam) = Standard_Location then + Error_Msg_Sloc := Sloc (Typ); + else + Error_Msg_Sloc := Sloc (Nam); + end if; - if Nkind (Parent (E)) = N_Full_Type_Declaration then - Error_Msg_N ("interpretation (inherited) #!", Func_Call); + if Nkind (Parent (Nam)) = N_Full_Type_Declaration then + Error_Msg_N + ("\\possible interpretation (inherited)#!", Func_Call); else - Error_Msg_N ("interpretation #!", Func_Call); + Error_Msg_N ("\\possible interpretation#!", Func_Call); end if; end Report_Interpretation; - -- Local variables - - Error_Reported : Boolean; - I : Interp_Index; - It : Interp; - - -- Start of processing for Check_Ambiguous_Parameterless_Call + -- Start of processing for Check_Ambiguous_Call begin - Error_Reported := False; - - -- Examine possible interpretations - - Get_First_Interp (Name (Func_Call), I, It); - while Present (It.Nam) loop - if It.Nam /= Entity (Name (Func_Call)) - and then Ekind (It.Nam) = E_Function - and then No (First_Formal (It.Nam)) - then - if not Error_Reported then - Error_Msg_NE - ("ambiguous call to&", Func_Call, - Entity (Name (Func_Call))); - Report_Interpretation (Entity (Name (Func_Call))); - Error_Reported := True; + Check_Parameterless_Call (Func_Call); + + if Is_Overloaded (Func_Call) then + declare + I : Interp_Index; + I1 : Interp_Index; + It : Interp; + It1 : Interp; + N1 : Entity_Id; + T1 : Entity_Id; + + begin + -- Remove procedure calls, as they cannot syntactically appear + -- in interpolated expressions. These calls were not removed by + -- type checking because interpolated expressions do not impose + -- a context type. + + Get_First_Interp (Func_Call, I, It); + while Present (It.Nam) loop + if It.Typ = Standard_Void_Type then + Remove_Interp (I); + end if; + + Get_Next_Interp (I, It); + end loop; + + Get_First_Interp (Func_Call, I, It); + + if No (It.Nam) then + Error_Msg_N ("illegal expression", Func_Call); + return; end if; - Report_Interpretation (It.Nam); - end if; + I1 := I; + It1 := It; + + -- The node may be labeled overloaded, but still contain only + -- one interpretation because others were discarded earlier. If + -- this is the case, retain the single interpretation. + + Get_Next_Interp (I, It); + + if Present (It.Typ) then + N1 := It1.Nam; + T1 := It1.Typ; - Get_Next_Interp (I, It); - end loop; - end Check_Ambiguous_Parameterless_Call; + It1 := Disambiguate + (N => Func_Call, + I1 => I1, + I2 => I, + Typ => Any_Type); + + if It1 = No_Interp then + Error_Msg_NE ("ambiguous call to&", Func_Call, + Entity (Name (Func_Call))); + + -- Report the first two interpretations + + Report_Interpretation (It.Nam, It.Typ); + Report_Interpretation (N1, T1); + + return; + end if; + end if; + + Set_Etype (Func_Call, It1.Typ); + end; + end if; + end Check_Ambiguous_Call; -- Local variables @@ -211,22 +257,114 @@ package body Sem_Ch2 is Str_Elem := First (Expressions (N)); while Present (Str_Elem) loop + Analyze (Str_Elem); - -- Before analyzed, a function call that has parameter is an - -- N_Indexed_Component node, and a call to a function that has - -- no parameters is an N_Identifier node. + -- The parser has split the contents of the interpolated string + -- into its components. For example, f"before {expr} after" is + -- stored in the list of expressions of N as follows: + -- first = "before " (is_interpolated_string_literal) + -- next = expr + -- next = " after" (is_interpolated_string_literal) + -- + -- No further action is needed for string literals with the + -- attribute Is_Interpolated_String_Literal set, as they are + -- components of the interpolated string literal. The type of + -- these components will be determined by the context when + -- resolved (see Expand_N_Interpolated_String_Literal). The + -- rest of the components in the list of expressions of N are + -- the root nodes of the interpolated expressions. + + if Nkind (Str_Elem) = N_String_Literal + and then Is_Interpolated_String_Literal (Str_Elem) + then + null; - Analyze (Str_Elem); + elsif Nkind (Str_Elem) = N_Function_Call then + Check_Ambiguous_Call (Str_Elem); - -- After analyzed, if it is still an N_Identifier node then we - -- found ambiguity and could not rewrite it as N_Function_Call. + -- Before analyzed, a function call that has parameters is an + -- N_Indexed_Component node, and a call to a function that has + -- no parameters is an N_Identifier or an N_Expanded_Name node. + -- If the analysis could not rewrite it as N_Function_Call, it + -- indicates that ambiguity may have been encountered. - if Nkind (Str_Elem) = N_Identifier + elsif Nkind (Str_Elem) in N_Identifier | N_Expanded_Name and then Ekind (Entity (Str_Elem)) = E_Function - and then Is_Overloaded (Str_Elem) then - Check_Parameterless_Call (Str_Elem); - Check_Ambiguous_Parameterless_Call (Str_Elem); + Check_Ambiguous_Call (Str_Elem); + + -- Report common errors + + elsif Nkind (Str_Elem) = N_String_Literal then + + -- No further action needed for components of the interpolated + -- string literal; its type will be imposed by its context when + -- resolved. + + if Is_Interpolated_String_Literal (Str_Elem) then + null; + + else + Error_Msg_N + ("ambiguous string literal in interpolated expression", + Str_Elem); + Error_Msg_N + ("\\possible interpretation 'Ada.'String type!", + Str_Elem); + Error_Msg_N + ("\\possible interpretation 'Ada.'Wide_'String type!", + Str_Elem); + Error_Msg_N + ("\\possible interpretation 'Ada.'Wide_'Wide_'String" + & " type!", Str_Elem); + Error_Msg_N + ("\\must use a qualified expression", Str_Elem); + end if; + + elsif Nkind (Str_Elem) = N_Character_Literal then + Error_Msg_N + ("ambiguous character literal in interpolated expression", + Str_Elem); + Error_Msg_N + ("\\possible interpretation 'Ada.'Character type!", + Str_Elem); + Error_Msg_N + ("\\possible interpretation 'Ada.'Wide_'Character type!", + Str_Elem); + Error_Msg_N + ("\\possible interpretation 'Ada.'Wide_'Wide_'Character" + & " type!", Str_Elem); + Error_Msg_N + ("\\must use a qualified expression", Str_Elem); + + elsif Nkind (Str_Elem) in N_Integer_Literal + | N_Real_Literal + then + Error_Msg_N + ("ambiguous number in interpolated expression", + Str_Elem); + Error_Msg_N + ("\\must use a qualified expression", Str_Elem); + + elsif Nkind (Str_Elem) = N_Interpolated_String_Literal then + Error_Msg_N ("nested interpolated string not allowed", Str_Elem); + + elsif Etype (Str_Elem) in Any_Type + | Any_Array + | Any_Composite + | Any_Discrete + | Any_Fixed + | Any_Integer + | Any_Modular + | Any_Numeric + | Any_Real + | Any_String + | Universal_Integer + | Universal_Real + | Universal_Fixed + | Universal_Access + then + Error_Msg_N ("ambiguous interpolated expression", Str_Elem); end if; Next (Str_Elem); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9a3b6dd..b23ca48 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9702,8 +9702,19 @@ package body Sem_Res is -- image function because under Ada 2022 all the types have such -- function available. - if Etype (Str_Elem) = Any_String then + if Nkind (Str_Elem) = N_String_Literal + and then Is_Interpolated_String_Literal (Str_Elem) + then Resolve (Str_Elem, Typ); + + -- Must have been rejected during analysis + + elsif Nkind (Str_Elem) in N_Character_Literal + | N_Integer_Literal + | N_Real_Literal + | N_String_Literal + then + pragma Assert (Error_Posted (Str_Elem)); end if; Next (Str_Elem); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 95fceb5..742527f 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1749,6 +1749,11 @@ package Sinfo is -- flag aids the ABE Processing phase to suppress the diagnostics of -- finalization actions in initialization contexts. + -- Is_Interpolated_String_Literal + -- Defined in string literals. Used to differentiate string literals + -- composed of interpolated string elements from string literals found + -- in interpolated expressions. + -- Is_Known_Guaranteed_ABE -- NOTE: this flag is shared between the legacy ABE mechanism and the -- default ABE mechanism. @@ -2610,6 +2615,7 @@ package Sinfo is -- Has_Wide_Character -- Has_Wide_Wide_Character -- Is_Folded_In_Parser + -- Is_Interpolated_String_Literal -- plus fields for expression --------------------------------------- @@ -2617,8 +2623,7 @@ package Sinfo is --------------------------------------- -- INTERPOLATED_STRING_LITERAL ::= - -- '{' "{INTERPOLATED_STRING_ELEMENT}" { - -- "{INTERPOLATED_STRING_ELEMENT}" } '}' + -- 'f' "{INTERPOLATED_STRING_ELEMENT}" -- INTERPOLATED_STRING_ELEMENT ::= -- ESCAPED_CHARACTER | INTERPOLATED_EXPRESSION |