diff options
Diffstat (limited to 'gcc/ada/par-prag.adb')
| -rw-r--r-- | gcc/ada/par-prag.adb | 53 |
1 files changed, 39 insertions, 14 deletions
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index fef50e03f81..23f280c4aba 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -360,25 +360,27 @@ begin -- These two pragmas have the same syntax and semantics. -- There are five forms of these pragmas: - -- pragma Source_File_Name ( + -- pragma Source_File_Name[_Project] ( -- [UNIT_NAME =>] unit_NAME, - -- BODY_FILE_NAME => STRING_LITERAL); + -- BODY_FILE_NAME => STRING_LITERAL + -- [, [INDEX =>] INTEGER_LITERAL]); - -- pragma Source_File_Name ( + -- pragma Source_File_Name[_Project] ( -- [UNIT_NAME =>] unit_NAME, - -- SPEC_FILE_NAME => STRING_LITERAL); + -- SPEC_FILE_NAME => STRING_LITERAL + -- [, [INDEX =>] INTEGER_LITERAL]); - -- pragma Source_File_Name ( + -- pragma Source_File_Name[_Project] ( -- BODY_FILE_NAME => STRING_LITERAL -- [, DOT_REPLACEMENT => STRING_LITERAL] -- [, CASING => CASING_SPEC]); - -- pragma Source_File_Name ( + -- pragma Source_File_Name[_Project] ( -- SPEC_FILE_NAME => STRING_LITERAL -- [, DOT_REPLACEMENT => STRING_LITERAL] -- [, CASING => CASING_SPEC]); - -- pragma Source_File_Name ( + -- pragma Source_File_Name[_Project] ( -- SUBUNIT_FILE_NAME => STRING_LITERAL -- [, DOT_REPLACEMENT => STRING_LITERAL] -- [, CASING => CASING_SPEC]); @@ -410,6 +412,8 @@ begin Dot : String_Ptr; Cas : Casing_Type; Nast : Nat; + Expr : Node_Id; + Index : Nat; function Get_Fname (Arg : Node_Id) return Name_Id; -- Process file name from unit name form of pragma @@ -520,7 +524,6 @@ begin -- Source_File_Name_Project pragmas. begin - if Get_Pragma_Id (Pragma_Name) = Pragma_Source_File_Name then if Project_File_In_Use = In_Use then Error_Msg @@ -536,7 +539,6 @@ begin Error_Msg ("pragma Source_File_Name_Project should only be used " & "with a project file", Pragma_Sloc); - else Project_File_In_Use := In_Use; end if; @@ -569,7 +571,30 @@ begin return Error; end if; - Check_Arg_Count (2); + -- Process index argument if present + + if Arg_Count = 3 then + Expr := Expression (Arg3); + + if Nkind (Expr) /= N_Integer_Literal + or else not UI_Is_In_Int_Range (Intval (Expr)) + or else Intval (Expr) > 999 + or else Intval (Expr) <= 0 + then + Error_Msg + ("pragma% index must be integer literal" & + " in range 1 .. 999", Sloc (Expr)); + raise Error_Resync; + else + Index := UI_To_Int (Intval (Expr)); + end if; + + -- No index argument present + + else + Check_Arg_Count (2); + Index := 0; + end if; Check_Optional_Identifier (Arg1, Name_Unit_Name); Unam := Get_Unit_Name (Expr1); @@ -577,10 +602,12 @@ begin Check_Arg_Is_String_Literal (Arg2); if Chars (Arg2) = Name_Spec_File_Name then - Set_File_Name (Get_Spec_Name (Unam), Get_Fname (Arg2)); + Set_File_Name + (Get_Spec_Name (Unam), Get_Fname (Arg2), Index); elsif Chars (Arg2) = Name_Body_File_Name then - Set_File_Name (Unam, Get_Fname (Arg2)); + Set_File_Name + (Unam, Get_Fname (Arg2), Index); else Error_Msg_N @@ -635,7 +662,6 @@ begin -- Set defaults for Casing and Dot_Separator parameters Cas := All_Lower_Case; - Dot := new String'("."); -- Process second and third arguments if present @@ -703,7 +729,6 @@ begin ("file name required for first % pragma in file", Pragma_Sloc); raise Error_Resync; - else Fname := No_Name; end if; |