diff options
Diffstat (limited to 'gcc/ada/diagnostics-constructors.adb')
| -rw-r--r-- | gcc/ada/diagnostics-constructors.adb | 514 |
1 files changed, 0 insertions, 514 deletions
diff --git a/gcc/ada/diagnostics-constructors.adb b/gcc/ada/diagnostics-constructors.adb deleted file mode 100644 index 0bc8750..0000000 --- a/gcc/ada/diagnostics-constructors.adb +++ /dev/null @@ -1,514 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- D I A G N O S T I C S . C O N S T R U C T O R S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2025, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Sinfo.Nodes; use Sinfo.Nodes; -with Diagnostics.Utils; use Diagnostics.Utils; - -package body Diagnostics.Constructors is - - ----------------------------------------------- - -- Make_Default_Iterator_Not_Primitive_Error -- - ----------------------------------------------- - - function Make_Default_Iterator_Not_Primitive_Error - (Expr : Node_Id; - Subp : Entity_Id) return Diagnostic_Type - is - begin - return - Make_Diagnostic - (Msg => "improper function for default iterator", - Location => Primary_Labeled_Span (Expr), - Id => GNAT0001, - Kind => Diagnostics.Error, - Sub_Diags => - (1 => - Continuation - (Msg => - "default iterator defined " & - Sloc_To_String (Subp, Sloc (Expr)) & - " must be a local primitive or class-wide function", - Locations => - (1 => Primary_Labeled_Span (Subp))))); - end Make_Default_Iterator_Not_Primitive_Error; - - ------------------------------------------------- - -- Record_Default_Iterator_Not_Primitive_Error -- - ------------------------------------------------- - - procedure Record_Default_Iterator_Not_Primitive_Error - (Expr : Node_Id; - Subp : Entity_Id) - is - begin - Record_Diagnostic - (Make_Default_Iterator_Not_Primitive_Error (Expr, Subp)); - end Record_Default_Iterator_Not_Primitive_Error; - - --------------------------------------------------- - -- Make_Invalid_Operand_Types_For_Operator_Error -- - --------------------------------------------------- - - function Make_Invalid_Operand_Types_For_Operator_Error - (Op : Node_Id; - L : Node_Id; - L_Type : Node_Id; - R : Node_Id; - R_Type : Node_Id) return Diagnostic_Type - is - begin - return - Make_Diagnostic - (Msg => "invalid operand types for operator " & To_Name (Op), - Location => Primary_Labeled_Span (Op), - Id => GNAT0002, - Kind => Diagnostics.Error, - Spans => - (1 => - (Secondary_Labeled_Span - (N => L, - Label => To_Type_Name (L_Type))), - 2 => - Secondary_Labeled_Span - (N => R, - Label => To_Type_Name (R_Type)))); - end Make_Invalid_Operand_Types_For_Operator_Error; - - ----------------------------------------------------- - -- Record_Invalid_Operand_Types_For_Operator_Error -- - ----------------------------------------------------- - - procedure Record_Invalid_Operand_Types_For_Operator_Error - (Op : Node_Id; - L : Node_Id; - L_Type : Node_Id; - R : Node_Id; - R_Type : Node_Id) - is - - begin - Record_Diagnostic - (Make_Invalid_Operand_Types_For_Operator_Error - (Op, L, L_Type, R, R_Type)); - end Record_Invalid_Operand_Types_For_Operator_Error; - - --------------------------------------------------------- - -- Make_Invalid_Operand_Types_For_Operator_L_Int_Error -- - --------------------------------------------------------- - - function Make_Invalid_Operand_Types_For_Operator_L_Int_Error - (Op : Node_Id; - L : Node_Id; - L_Type : Node_Id; - R : Node_Id; - R_Type : Node_Id) return Diagnostic_Type - is - begin - return - Make_Diagnostic - (Msg => "invalid operand types for operator " & To_Name (Op), - Location => Primary_Labeled_Span (Op), - Id => GNAT0003, - Kind => Diagnostics.Error, - Spans => - (1 => - (Secondary_Labeled_Span - (N => L, - Label => - "left operand has type " & - To_Name (L_Type))), - 2 => - Secondary_Labeled_Span - (N => R, - Label => - "right operand has type " & - To_Name (R_Type))), - Sub_Diags => - (1 => Suggestion (Msg => "Convert left operand to ""Integer""") - ) - ); - end Make_Invalid_Operand_Types_For_Operator_L_Int_Error; - - ----------------------------------------------------------- - -- Record_Invalid_Operand_Types_For_Operator_L_Int_Error -- - ----------------------------------------------------------- - - procedure Record_Invalid_Operand_Types_For_Operator_L_Int_Error - (Op : Node_Id; - L : Node_Id; - L_Type : Node_Id; - R : Node_Id; - R_Type : Node_Id) - is - - begin - Record_Diagnostic - (Make_Invalid_Operand_Types_For_Operator_L_Int_Error - (Op, L, L_Type, R, R_Type)); - end Record_Invalid_Operand_Types_For_Operator_L_Int_Error; - - --------------------------------------------------------- - -- Make_Invalid_Operand_Types_For_Operator_R_Int_Error -- - --------------------------------------------------------- - - function Make_Invalid_Operand_Types_For_Operator_R_Int_Error - (Op : Node_Id; - L : Node_Id; - L_Type : Node_Id; - R : Node_Id; - R_Type : Node_Id) return Diagnostic_Type - is - begin - return - Make_Diagnostic - (Msg => "invalid operand types for operator " & To_Name (Op), - Location => Primary_Labeled_Span (Op), - Id => GNAT0004, - Kind => Diagnostics.Error, - Spans => - (1 => - Secondary_Labeled_Span - (N => L, - Label => - "left operand has type " & - To_Name (L_Type)), - 2 => - Secondary_Labeled_Span - (N => R, - Label => - "right operand has type " & - To_Name (R_Type))), - Sub_Diags => - (1 => Suggestion (Msg => "Convert right operand to ""Integer""") - ) - ); - end Make_Invalid_Operand_Types_For_Operator_R_Int_Error; - - ----------------------------------------------------------- - -- Record_Invalid_Operand_Types_For_Operator_R_Int_Error -- - ----------------------------------------------------------- - - procedure Record_Invalid_Operand_Types_For_Operator_R_Int_Error - (Op : Node_Id; - L : Node_Id; - L_Type : Node_Id; - R : Node_Id; - R_Type : Node_Id) - is - - begin - Record_Diagnostic - (Make_Invalid_Operand_Types_For_Operator_R_Int_Error - (Op, L, L_Type, R, R_Type)); - end Record_Invalid_Operand_Types_For_Operator_R_Int_Error; - - --------------------------------------------------------- - -- Make_Invalid_Operand_Types_For_Operator_L_Acc_Error -- - --------------------------------------------------------- - - function Make_Invalid_Operand_Types_For_Operator_L_Acc_Error - (Op : Node_Id; - L : Node_Id) return Diagnostic_Type - is - - begin - return - Make_Diagnostic - (Msg => "invalid operand types for operator " & To_Name (Op), - Location => Primary_Labeled_Span (Op), - Id => GNAT0005, - Kind => Diagnostics.Error, - Spans => - (1 => - Secondary_Labeled_Span - (N => L, - Label => - "left operand is access type ") - ) - ); - end Make_Invalid_Operand_Types_For_Operator_L_Acc_Error; - - ----------------------------------------------------------- - -- Record_Invalid_Operand_Types_For_Operator_L_Acc_Error -- - ----------------------------------------------------------- - - procedure Record_Invalid_Operand_Types_For_Operator_L_Acc_Error - (Op : Node_Id; - L : Node_Id) - is - begin - Record_Diagnostic - (Make_Invalid_Operand_Types_For_Operator_R_Acc_Error - (Op, L)); - end Record_Invalid_Operand_Types_For_Operator_L_Acc_Error; - - --------------------------------------------------------- - -- Make_Invalid_Operand_Types_For_Operator_L_Acc_Error -- - --------------------------------------------------------- - - function Make_Invalid_Operand_Types_For_Operator_R_Acc_Error - (Op : Node_Id; - R : Node_Id) return Diagnostic_Type - is - - begin - return - Make_Diagnostic - (Msg => "invalid operand types for operator " & To_Name (Op), - Location => Primary_Labeled_Span (Op), - Id => GNAT0006, - Kind => Diagnostics.Error, - Spans => - (1 => - Secondary_Labeled_Span - (N => R, - Label => - "right operand is access type ") - ) - ); - end Make_Invalid_Operand_Types_For_Operator_R_Acc_Error; - - ----------------------------------------------------------- - -- Record_Invalid_Operand_Types_For_Operator_R_Acc_Error -- - ----------------------------------------------------------- - - procedure Record_Invalid_Operand_Types_For_Operator_R_Acc_Error - (Op : Node_Id; - R : Node_Id) - is - begin - Record_Diagnostic - (Make_Invalid_Operand_Types_For_Operator_R_Acc_Error - (Op, R)); - end Record_Invalid_Operand_Types_For_Operator_R_Acc_Error; - - ----------------------------------------------------------- - -- Make_Invalid_Operand_Types_For_Operator_General_Error -- - ----------------------------------------------------------- - - function Make_Invalid_Operand_Types_For_Operator_General_Error - (Op : Node_Id) return Diagnostic_Type - is - - begin - return - Make_Diagnostic - (Msg => "invalid operand types for operator " & To_Name (Op), - Location => Primary_Labeled_Span (Op), - Id => GNAT0007, - Kind => Diagnostics.Error - ); - end Make_Invalid_Operand_Types_For_Operator_General_Error; - - ------------------------------------------------------------- - -- Record_Invalid_Operand_Types_For_Operator_General_Error -- - ------------------------------------------------------------- - - procedure Record_Invalid_Operand_Types_For_Operator_General_Error - (Op : Node_Id) - is - begin - Record_Diagnostic - (Make_Invalid_Operand_Types_For_Operator_General_Error (Op)); - end Record_Invalid_Operand_Types_For_Operator_General_Error; - - -------------------------------------------------- - -- Make_Pragma_No_Effect_With_Lock_Free_Warning -- - -------------------------------------------------- - - function Make_Pragma_No_Effect_With_Lock_Free_Warning - (Pragma_Node : Node_Id; Pragma_Name : Name_Id; - Lock_Free_Node : Node_Id; Lock_Free_Range : Node_Id) - return Diagnostic_Type - is - begin - return - Make_Diagnostic - (Msg => - "pragma " & '"' & Get_Name_String (Pragma_Name) & '"' & - " for " & To_Name (Lock_Free_Node) & - " has no effect when Lock_Free given", - Location => Primary_Labeled_Span (Pragma_Node, "No effect"), - Id => GNAT0008, - Kind => Diagnostics.Warning, - Spans => - (1 => - Labeled_Span - (Span => To_Full_Span (Lock_Free_Range), - Label => "Lock_Free in effect here", - Is_Primary => False, - Is_Region => True))); - end Make_Pragma_No_Effect_With_Lock_Free_Warning; - - -------------------------------------------- - -- Record_Pragma_No_Effect_With_Lock_Free -- - -------------------------------------------- - - procedure Record_Pragma_No_Effect_With_Lock_Free_Warning - (Pragma_Node : Node_Id; - Pragma_Name : Name_Id; - Lock_Free_Node : Node_Id; - Lock_Free_Range : Node_Id) - is - begin - Record_Diagnostic - (Make_Pragma_No_Effect_With_Lock_Free_Warning - (Pragma_Node, Pragma_Name, Lock_Free_Node, Lock_Free_Range)); - end Record_Pragma_No_Effect_With_Lock_Free_Warning; - - ---------------------------------- - -- Make_End_Loop_Expected_Error -- - ---------------------------------- - - function Make_End_Loop_Expected_Error - (End_Loc : Source_Span; - Start_Loc : Source_Ptr) return Diagnostic_Type - is - begin - return - Make_Diagnostic - (Msg => - """end loop;"" expected for ""loop"" " & - Sloc_To_String (Start_Loc, End_Loc.Ptr), - Location => Primary_Labeled_Span (End_Loc), - Id => GNAT0009, - Kind => Diagnostics.Error, - Spans => (1 => Secondary_Labeled_Span (To_Span (Start_Loc))), - Fixes => - (1 => - Fix - (Description => "Replace with 'end loop;'", - Edits => - (1 => Edit (Text => "end loop;", Span => End_Loc)), - Applicability => Legal))); - end Make_End_Loop_Expected_Error; - - ------------------------------------ - -- Record_End_Loop_Expected_Error -- - ------------------------------------ - - procedure Record_End_Loop_Expected_Error - (End_Loc : Source_Span; Start_Loc : Source_Ptr) - is - begin - Record_Diagnostic (Make_End_Loop_Expected_Error (End_Loc, Start_Loc)); - end Record_End_Loop_Expected_Error; - - ---------------------------------------- - -- Make_Representation_Too_Late_Error -- - ---------------------------------------- - - function Make_Representation_Too_Late_Error - (Rep : Node_Id; - Freeze : Node_Id; - Def : Node_Id) - return Diagnostic_Type - is - begin - return - Make_Diagnostic - (Msg => - "record representation cannot be specified" & - " after the type is frozen", - Location => - Primary_Labeled_Span - (N => Rep, - Label => "record representation clause specified here"), - Id => GNAT0010, - Kind => Error, - Spans => - (1 => - Secondary_Labeled_Span - (N => Freeze, - Label => - "Type " & To_Name (Def) & " is frozen here"), - 2 => - Secondary_Labeled_Span - (N => Def, - Label => - "Type " & To_Name (Def) & " is declared here")), - Sub_Diags => - (1 => - Suggestion - (Msg => - "move the record representation clause" & - " before the freeze point " & - Sloc_To_String (Sloc (Freeze), Sloc (Rep))))); - end Make_Representation_Too_Late_Error; - - ------------------------------------------ - -- Record_Representation_Too_Late_Error -- - ------------------------------------------ - - procedure Record_Representation_Too_Late_Error - (Rep : Node_Id; - Freeze : Node_Id; - Def : Node_Id) - is - begin - Record_Diagnostic - (Make_Representation_Too_Late_Error (Rep, Freeze, Def)); - end Record_Representation_Too_Late_Error; - - ------------------------------------------ - -- Make_Mixed_Container_Aggregate_Error -- - ------------------------------------------ - - function Make_Mixed_Container_Aggregate_Error - (Aggr : Node_Id; - Pos_Elem : Node_Id; - Named_Elem : Node_Id) return Diagnostic_Type - is - - begin - return - Make_Diagnostic - (Msg => - "container aggregate cannot be both positional and named", - Location => Primary_Labeled_Span (Aggr), - Id => GNAT0011, - Kind => Diagnostics.Error, - Spans => - (1 => Secondary_Labeled_Span - (Pos_Elem, "positional element "), - 2 => Secondary_Labeled_Span - (Named_Elem, "named element"))); - end Make_Mixed_Container_Aggregate_Error; - - -------------------------------------------- - -- Record_Mixed_Container_Aggregate_Error -- - -------------------------------------------- - - procedure Record_Mixed_Container_Aggregate_Error - (Aggr : Node_Id; - Pos_Elem : Node_Id; - Named_Elem : Node_Id) - is - begin - Record_Diagnostic - (Make_Mixed_Container_Aggregate_Error (Aggr, Pos_Elem, Named_Elem)); - end Record_Mixed_Container_Aggregate_Error; - -end Diagnostics.Constructors; |