diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dd2645469847a0b5a90c9c594e5524c052dbf2ff..1499ed11f01b3bd94920a58f5dc1a06846787208 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,63 @@
+2013-01-29 Robert Dewar <dewar@adacore.com>
+
+ * par-ch6.adb (No_Constraint_Maybe_Expr_Func): New procedure.
+ * par-util.adb (No_Constraint): Undo special handling, moved
+ to par-ch6.adb.
+
+2013-01-29 Robert Dewar <dewar@adacore.com>
+
+ * aspects.ads: Aspect Warnings is implementation defined Add
+ some other missing entries to impl-defined list Mark Warnings
+ as GNAT pragma in main list.
+ * sem_ch8.adb: Process aspects for all cases of renaming
+ declarations.
+
+2013-01-29 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch6.adb (Analyze_Function_Call): Set In_Assertion flag.
+ * sem_elab.adb (Check_Internal_Call_Continue): Do not issue
+ warnings about possible elaboration error if call is within
+ an assertion.
+ * sinfo.ads, sinfo.adb (In_Assertion): New flag in N_Function_Call node.
+
+2013-01-29 Robert Dewar <dewar@adacore.com>
+
+ * a-calend-vms.adb, g-eacodu-vms.adb, g-trasym-vms-alpha.adb,
+ * s-auxdec-vms-ia64.adb, s-mastop-vms.adb, s-osprim-vms.adb,
+ s-tasdeb-vms.adb: Replace pragma Interface by pragma Import.
+
+2013-01-29 Robert Dewar <dewar@adacore.com>
+
+ * opt.ads (Ignore_Style_Checks_Pragmas): New flag.
+ * par-prag.adb (Par, case Style_Checks): Recognize
+ Ignore_Style_Checks_Pragmas.
+ * sem_prag.adb (Analyze_Pragma, case Style_Checks): Recognize
+ Ignore_Style_Checks_Pragmas.
+ * switch-c.adb: Recognize -gnateY switch.
+ * usage.adb: Add documentation for "-gnateY".
+ * vms_data.ads: Add IGNORE_STYLE_CHECKS_PRAGMAS (-gnateY).
+
+2013-01-29 Vincent Celier <celier@adacore.com>
+
+ * clean.adb (Clean_Executables): Add Sid component when calling
+ Queue.Insert.
+ * make.adb: When inserting in the Queue, add the Source_Id
+ (Sid) when it is known (Start_Compile_If_Possible): When the
+ Source_Id is known (Sid), get the path name of the ALI file
+ (Full_Lib_File) from it, to avoid finding old ALI files in other
+ object directories.
+ * makeutl.ads (Source_Info): New Source_Id component Sid in
+ Format_Gnatmake variant.
+
+2013-01-29 Robert Dewar <dewar@adacore.com>
+
+ * gnat_ugn.texi: Document -gnateY.
+
+2013-01-29 Doug Rupp <rupp@adacore.com>
+
+ * s-osinte-vms.ads, s-taprop-vms.adb, system-vms_64.ads,
+ system-vms-ia64.ads: Replace pragma Interface by pragma Import.
+
2013-01-29 Robert Dewar <dewar@adacore.com>
* atree.ads, atree.adb (Node30): New function.
diff --git a/gcc/ada/a-calend-vms.adb b/gcc/ada/a-calend-vms.adb
index 9d6913d0434f5ebf891a031589fffdb54566cbdb..7c2b3a62b467d86c2ba9a9252182786287a0705c 100644
--- a/gcc/ada/a-calend-vms.adb
+++ b/gcc/ada/a-calend-vms.adb
@@ -49,7 +49,7 @@ package body Ada.Calendar is
-- on various targets, a system independent model is incorporated into
-- Ada.Calendar. The idea behind the design is to encapsulate all target
-- dependent machinery in a single package, thus providing a uniform
- -- interface to all existing and any potential children.
+ -- pragma Import to all existing and any potential children.
-- package Ada.Calendar
-- procedure Split (5 parameters) -------+
@@ -1017,7 +1017,7 @@ package body Ada.Calendar is
Timbuf : out Unsigned_Word_Array;
Timadr : Time);
- pragma Interface (External, Numtim);
+ pragma Import (External, Numtim);
pragma Import_Valued_Procedure
(Numtim, "SYS$NUMTIM",
@@ -1134,7 +1134,7 @@ package body Ada.Calendar is
Input_Time : Unsigned_Word_Array;
Resultant_Time : out Time);
- pragma Interface (External, Cvt_Vectim);
+ pragma Import (External, Cvt_Vectim);
pragma Import_Valued_Procedure
(Cvt_Vectim, "LIB$CVT_VECTIM",
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 94c3c617827d6ed9be61f3343ced07eea2d1acaa..c3199cc0d4b2a7683cd452bbdb40e2161040d0c6 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -127,7 +127,7 @@ package Aspects is
Aspect_Unsuppress,
Aspect_Value_Size, -- GNAT
Aspect_Variable_Indexing,
- Aspect_Warnings,
+ Aspect_Warnings, -- GNAT
Aspect_Write,
-- The following aspects correspond to library unit pragmas
@@ -234,6 +234,7 @@ package Aspects is
Aspect_Favor_Top_Level => True,
Aspect_Global => True,
Aspect_Inline_Always => True,
+ Aspect_Invariant => True,
Aspect_Lock_Free => True,
Aspect_Object_Size => True,
Aspect_Persistent_BSS => True,
@@ -243,18 +244,19 @@ package Aspects is
Aspect_Pure_12 => True,
Aspect_Pure_Function => True,
Aspect_Remote_Access_Type => True,
- Aspect_Shared => True,
Aspect_Scalar_Storage_Order => True,
+ Aspect_Shared => True,
Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True,
Aspect_Test_Case => True,
- Aspect_Universal_Data => True,
Aspect_Universal_Aliasing => True,
+ Aspect_Universal_Data => True,
Aspect_Unmodified => True,
Aspect_Unreferenced => True,
Aspect_Unreferenced_Objects => True,
Aspect_Value_Size => True,
+ Aspect_Warnings => True,
others => False);
-- The following array indicates aspects for which multiple occurrences of
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index f952e18ab74bedb5d4d041af217db60a1ad8cc03..9819ff962236fb60485a4a180d6f601988948381 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -397,7 +397,8 @@ package body Clean is
File => Main_Lib_File,
Unit => No_Unit_Name,
Index => 0,
- Project => No_Project));
+ Project => No_Project,
+ Sid => No_Source));
end if;
while not Queue.Is_Empty loop
@@ -440,7 +441,8 @@ package body Clean is
File => Withs.Table (K).Afile,
Unit => No_Unit_Name,
Index => 0,
- Project => No_Project));
+ Project => No_Project,
+ Sid => No_Source));
end if;
end loop;
end loop;
diff --git a/gcc/ada/g-eacodu-vms.adb b/gcc/ada/g-eacodu-vms.adb
index ae7646eb2575fbd217c4042f41d09342f3667a01..ceff6e98c09f8d839e4a07a55072f2cfb65becf9 100644
--- a/gcc/ada/g-eacodu-vms.adb
+++ b/gcc/ada/g-eacodu-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2012, 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- --
@@ -56,14 +56,14 @@ procedure Core_Dump (Occurrence : Exception_Occurrence) is
Addres : Address := Address_Zero;
Acmode : Access_Mode_Type := Access_Mode_Zero;
Prvhnd : Unsigned_Longword := 0);
- pragma Interface (External, Setexv);
+ pragma Import (External, Setexv);
pragma Import_Valued_Procedure (Setexv, "SYS$SETEXV",
(Cond_Value_Type, Unsigned_Longword, Address, Access_Mode_Type,
Unsigned_Longword),
(Value, Value, Value, Value, Value));
procedure Lib_Signal (I : Integer);
- pragma Interface (C, Lib_Signal);
+ pragma Import (C, Lib_Signal);
pragma Import_Procedure (Lib_Signal, "LIB$SIGNAL", Mechanism => (Value));
begin
Setexv (Status, 1, Address_Zero, 3);
diff --git a/gcc/ada/g-trasym-vms-alpha.adb b/gcc/ada/g-trasym-vms-alpha.adb
index c58c5610bfd0a108faf77c42065f672b3c25db0b..c1ea305cfbf6c17c12a53b066c16df69b559ab16 100644
--- a/gcc/ada/g-trasym-vms-alpha.adb
+++ b/gcc/ada/g-trasym-vms-alpha.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2012, 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- --
@@ -93,7 +93,7 @@ package body GNAT.Traceback.Symbolic is
User_Arg_Value : User_Arg_Type := 0);
-- Comment on above procedure required ???
- pragma Interface (External, Symbolize);
+ pragma Import (External, Symbolize);
pragma Import_Valued_Procedure
(Symbolize, "TBK$SYMBOLIZE",
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index b109b69e122e0faceed11854d088a2ff3cef1695..17478c0b263be2d2b46650d61b1fbc00826311c5 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -4280,6 +4280,13 @@ Generate target dependent information.
@cindex @option{-gnateV} (@command{gcc})
Check validity of subprogram parameters.
+@item ^-gnateY^/IGNORE_SUPPRESS_SYLE_CHECK_PRAGMAS^
+@cindex @option{-gnateY} (@command{gcc})
+Ignore all STYLE_CHECKS pragmas. Full legality checks
+are still carried out, but the pragmas have no effect
+on what style checks are active. This allows all style
+checking options to be controlled from the command line.
+
@item -gnatE
@cindex @option{-gnatE} (@command{gcc})
Full dynamic elaboration checks.
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 97d4278c32be08b54aa3c465f102273bd5bbfa45..61649da3bb8d15d4b401214181256a74d0b112ea 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -2746,7 +2746,8 @@ package body Make is
File => Sfile,
Unit => No_Unit_Name,
Project => No_Project,
- Index => 0))
+ Index => 0,
+ Sid => No_Source))
then
if Is_In_Obsoleted (Sfile) then
Executable_Obsolete := True;
@@ -3091,6 +3092,7 @@ package body Make is
ALI : ALI_Id;
Source_Index : Int;
Sfile : File_Name_Type;
+ Sid : Prj.Source_Id;
Uname : Unit_Name_Type;
Unit_Name : Name_Id;
Uid : Prj.Unit_Index;
@@ -3137,6 +3139,7 @@ package body Make is
loop
Sfile := Withs.Table (K).Sfile;
Uname := Withs.Table (K).Uname;
+ Sid := No_Source;
-- If project files are used, find the proper source to
-- compile in case Sfile is the spec but there is a body.
@@ -3154,12 +3157,14 @@ package body Make is
then
Sfile := Uid.File_Names (Impl).File;
Source_Index := Uid.File_Names (Impl).Index;
+ Sid := Uid.File_Names (Impl);
elsif Uid.File_Names (Spec) /= null
and then not Uid.File_Names (Spec).Locally_Removed
then
Sfile := Uid.File_Names (Spec).File;
Source_Index := Uid.File_Names (Spec).Index;
+ Sid := Uid.File_Names (Spec);
end if;
end if;
end if;
@@ -3187,7 +3192,8 @@ package body Make is
File => Sfile,
Project => ALI_P.Project,
Unit => Withs.Table (K).Uname,
- Index => Source_Index));
+ Index => Source_Index,
+ Sid => Sid));
end if;
end if;
end loop;
@@ -3308,16 +3314,16 @@ package body Make is
is
In_Lib_Dir : Boolean;
Need_To_Compile : Boolean;
- Pid : Process_Id;
+ Pid : Process_Id := Invalid_Pid;
Process_Created : Boolean;
Source : Queue.Source_Info;
- Full_Source_File : File_Name_Type;
+ Full_Source_File : File_Name_Type := No_File;
Source_File_Attr : aliased File_Attributes;
-- The full name of the source file and its attributes (size, ...)
Lib_File : File_Name_Type;
- Full_Lib_File : File_Name_Type;
+ Full_Lib_File : File_Name_Type := No_File;
Lib_File_Attr : aliased File_Attributes;
Read_Only : Boolean := False;
ALI : ALI_Id;
@@ -3335,23 +3341,49 @@ package body Make is
then
Queue.Extract (Found, Source);
- Osint.Full_Source_Name
- (Source.File,
- Full_File => Full_Source_File,
- Attr => Source_File_Attr'Access);
+ -- If it is a source in a project, first look for the ALI file
+ -- in the object directory. When the project is extending another
+ -- the ALI file may not be found, but the source does not
+ -- necessarily need to be compiled, as it may already be up to
+ -- date in the project being extended. In this case, look for an
+ -- ALI file in all the object directories, as is done when
+ -- gnatmake is not invoked with a project file.
+
+ if Source.Sid /= No_Source then
+ Initialize_Source_Record (Source.Sid);
+ Full_Source_File :=
+ File_Name_Type (Source.Sid.Path.Display_Name);
+ Lib_File := Source.Sid.Dep_Name;
+ Full_Lib_File := File_Name_Type (Source.Sid.Dep_Path);
+ Lib_File_Attr := Unknown_Attributes;
+
+ if Full_Lib_File /= No_File then
+ declare
+ FLF : constant String :=
+ Get_Name_String (Full_Lib_File) & ASCII.NUL;
+ begin
+ if not Is_Regular_File
+ (FLF'Address, Lib_File_Attr'Access)
+ then
+ Full_Lib_File := No_File;
+ end if;
+ end;
+ end if;
+ end if;
- Lib_File := Osint.Lib_File_Name (Source.File, Source.Index);
+ if Full_Lib_File = No_File then
+ Osint.Full_Source_Name
+ (Source.File,
+ Full_File => Full_Source_File,
+ Attr => Source_File_Attr'Access);
- -- ??? This call could be avoided when using projects, since we
- -- know where the ALI file is supposed to be. That would avoid
- -- searches in the object directories, including in the runtime
- -- dir. However, that would require getting access to the
- -- Source_Id.
+ Lib_File := Osint.Lib_File_Name (Source.File, Source.Index);
- Osint.Full_Lib_File_Name
- (Lib_File,
- Lib_File => Full_Lib_File,
- Attr => Lib_File_Attr);
+ Osint.Full_Lib_File_Name
+ (Lib_File,
+ Lib_File => Full_Lib_File,
+ Attr => Lib_File_Attr);
+ end if;
-- If source has already been compiled, executable is obsolete
@@ -3734,7 +3766,8 @@ package body Make is
File => Main_Source,
Project => Main_Project,
Unit => No_Unit_Name,
- Index => Main_Index));
+ Index => Main_Index,
+ Sid => No_Source));
First_Compiled_File := No_File;
Most_Recent_Obj_File := No_File;
@@ -6650,6 +6683,7 @@ package body Make is
Put_In_Q : Boolean := Into_Q;
Unit : Unit_Index;
Sfile : File_Name_Type;
+ Sid : Prj.Source_Id;
Index : Int;
Project : Project_Id;
@@ -6659,6 +6693,7 @@ package body Make is
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= null loop
Sfile := No_File;
+ Sid := No_Source;
Index := 0;
Project := No_Project;
@@ -6704,15 +6739,18 @@ package body Make is
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Sfile := No_File;
Index := 0;
+ Sid := No_Source;
else
Sfile := Unit.File_Names (Impl).Display_File;
Index := Unit.File_Names (Impl).Index;
+ Sid := Unit.File_Names (Impl);
end if;
end;
else
Sfile := Unit.File_Names (Impl).Display_File;
Index := Unit.File_Names (Impl).Index;
+ Sid := Unit.File_Names (Impl);
end if;
end if;
@@ -6728,6 +6766,7 @@ package body Make is
Sfile := Unit.File_Names (Spec).Display_File;
Index := Unit.File_Names (Spec).Index;
+ Sid := Unit.File_Names (Spec);
Project := Unit.File_Names (Spec).Project;
end if;
@@ -6744,7 +6783,8 @@ package body Make is
File => Sfile,
Project => Project,
Unit => No_Unit_Name,
- Index => Index));
+ Index => Index,
+ Sid => Sid));
end if;
if not Put_In_Q and then Sfile /= No_File then
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index 37e9f6107752143fe86c03e1d0eb1298426188b8..e5f430440ec72099ea927de0209c149333ed3b9a 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -485,14 +485,15 @@ package Makeutl is
record
case Format is
when Format_Gprbuild =>
- Tree : Project_Tree_Ref := null;
- Id : Source_Id := null;
+ Tree : Project_Tree_Ref := No_Project_Tree;
+ Id : Source_Id := No_Source;
when Format_Gnatmake =>
File : File_Name_Type := No_File;
Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0;
Project : Project_Id := No_Project;
+ Sid : Source_Id := No_Source;
end case;
end record;
-- Information about files stored in the queue. The exact information
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 2bd5956434ff2b51935d1d62ef7170454ceb02cd..59a93103ed3193cdb9981501eba1272e12b91cda 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -720,6 +720,11 @@ package Opt is
-- code from foreign compilers for checking or ASIS purposes. Can be
-- set True by use of -gnatI.
+ Ignore_Style_Checks_Pragmas : Boolean := False;
+ -- GNAT
+ -- Set True to ignore all Style_Checks pragmas. Can be set True by use
+ -- of -gnateY.
+
Implementation_Unit_Warnings : Boolean := True;
-- GNAT
-- Set True to active warnings for use of implementation internal units.
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 74736ceb4aec163db4fa66961d44eadf3367b75f..2243acea2eb308bd55f6342a1e329efcdc3911a9 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -39,16 +39,19 @@ package body Ch6 is
function P_Return_Object_Declaration return Node_Id;
procedure P_Return_Subtype_Indication (Decl_Node : Node_Id);
- -- Decl_Node is a N_Object_Declaration.
- -- Set the Null_Exclusion_Present and Object_Definition fields of
- -- Decl_Node.
+ -- Decl_Node is a N_Object_Declaration. Set the Null_Exclusion_Present and
+ -- Object_Definition fields of Decl_Node.
procedure Check_Junk_Semicolon_Before_Return;
-
-- Check for common error of junk semicolon before RETURN keyword of
- -- function specification. If present, skip over it with appropriate
- -- error message, leaving Scan_Ptr pointing to the RETURN after. This
- -- routine also deals with a possibly misspelled version of Return.
+ -- function specification. If present, skip over it with appropriate error
+ -- message, leaving Scan_Ptr pointing to the RETURN after. This routine
+ -- also deals with a possibly misspelled version of Return.
+
+ procedure No_Constraint_Maybe_Expr_Func;
+ -- Called after scanning return subtype to check for missing constraint,
+ -- taking into account the possibility of an occurrence of an expression
+ -- function where the IS has been forgotten.
----------------------------------------
-- Check_Junk_Semicolon_Before_Return --
@@ -76,6 +79,52 @@ package body Ch6 is
end if;
end Check_Junk_Semicolon_Before_Return;
+ -----------------------------------
+ -- No_Constraint_Maybe_Expr_Func --
+ -----------------------------------
+
+ procedure No_Constraint_Maybe_Expr_Func is
+ begin
+ -- If we have a left paren at the start of the line, then assume this is
+ -- the case of an expression function with missing IS. We do not have to
+ -- diagnose the missing IS, that is done elsewhere. We do this game in
+ -- Ada 2012 mode where expression functions are legal.
+
+ if Token = Tok_Left_Paren
+ and Ada_Version >= Ada_2012
+ and Token_Is_At_Start_Of_Line
+ then
+ -- One exception if we have "(token .." then this is a constraint
+
+ declare
+ Scan_State : Saved_Scan_State;
+
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past left paren
+ Scan; -- past following token
+
+ -- If we have "(token .." then restore scan state and treat as
+ -- unexpected constraint.
+
+ if Token = Tok_Dot_Dot then
+ Restore_Scan_State (Scan_State);
+ No_Constraint;
+
+ -- Otherwise we treat this as an expression function
+
+ else
+ Restore_Scan_State (Scan_State);
+ end if;
+ end;
+
+ -- Otherwise use standard routine to check for no constraint present
+
+ else
+ No_Constraint;
+ end if;
+ end No_Constraint_Maybe_Expr_Func;
+
-----------------------------------------------------
-- 6.1 Subprogram (Also 6.3, 8.5.4, 10.1.3, 12.3) --
-----------------------------------------------------
@@ -385,7 +434,7 @@ package body Ch6 is
else
Result_Node := P_Subtype_Mark;
- No_Constraint;
+ No_Constraint_Maybe_Expr_Func;
end if;
else
@@ -965,7 +1014,7 @@ package body Ch6 is
else
Result_Node := P_Subtype_Mark;
- No_Constraint;
+ No_Constraint_Maybe_Expr_Func;
end if;
Set_Null_Exclusion_Present (Specification_Node, Result_Not_Null);
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 313567b6bd8add7a16df09131898d74ab6b8279e..dd7b1d704677046a29810b7f8cc20e78ec2ec2a0 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -935,7 +935,10 @@ begin
end if;
if J = Slen then
- Set_Style_Check_Options (Options, OK, Ptr);
+ if not Ignore_Style_Checks_Pragmas then
+ Set_Style_Check_Options (Options, OK, Ptr);
+ end if;
+
exit;
else
@@ -955,17 +958,23 @@ begin
OK := False;
elsif Chars (A) = Name_All_Checks then
- if GNAT_Mode then
- Stylesw.Set_GNAT_Style_Check_Options;
- else
- Stylesw.Set_Default_Style_Check_Options;
+ if not Ignore_Style_Checks_Pragmas then
+ if GNAT_Mode then
+ Stylesw.Set_GNAT_Style_Check_Options;
+ else
+ Stylesw.Set_Default_Style_Check_Options;
+ end if;
end if;
elsif Chars (A) = Name_On then
- Style_Check := True;
+ if not Ignore_Style_Checks_Pragmas then
+ Style_Check := True;
+ end if;
elsif Chars (A) = Name_Off then
- Style_Check := False;
+ if not Ignore_Style_Checks_Pragmas then
+ Style_Check := False;
+ end if;
else
OK := False;
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index e18801f024fc572ec46df5ff09190400d538d969..3b59287b703534d5cd653ee14d15af15cdb11f2e 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -635,14 +635,9 @@ package body Util is
procedure No_Constraint is
begin
- -- If next token is at start of line, don't object, it seems relatively
- -- unlikely that a constraint would be on its own starting a line.
-
- if Token_Is_At_Start_Of_Line then
- return;
- end if;
-
- -- Otherwise if we have a token that could start a constraint, object
+ -- If we have a token that could start a constraint on the same line
+ -- then cnsider this an illegal constraint. It seems unlikely it could
+ -- be anything else if it is on the same line.
if Token in Token_Class_Consk then
Error_Msg_SC ("constraint not allowed here");
diff --git a/gcc/ada/s-auxdec-vms-ia64.adb b/gcc/ada/s-auxdec-vms-ia64.adb
index a744917449a1c79a7401f9f4dd49a4b88a492fcd..b8ca67e85b2fec4ac801c823b68a6d6738b5145a 100644
--- a/gcc/ada/s-auxdec-vms-ia64.adb
+++ b/gcc/ada/s-auxdec-vms-ia64.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -411,7 +411,7 @@ package body System.Aux_DEC is
procedure SYS_PAL_INSQHIL
(STATUS : out Integer; Header : Address; ITEM : Address);
- pragma Interface (External, SYS_PAL_INSQHIL);
+ pragma Import (External, SYS_PAL_INSQHIL);
pragma Import_Valued_Procedure (SYS_PAL_INSQHIL, "SYS$PAL_INSQHIL",
(Integer, Address, Address),
(Value, Value, Value));
@@ -454,7 +454,7 @@ package body System.Aux_DEC is
procedure SYS_PAL_REMQHIL
(Remret : out Remq; Header : Address);
- pragma Interface (External, SYS_PAL_REMQHIL);
+ pragma Import (External, SYS_PAL_REMQHIL);
pragma Import_Valued_Procedure
(SYS_PAL_REMQHIL, "SYS$PAL_REMQHIL",
(Remq, Address),
@@ -499,7 +499,7 @@ package body System.Aux_DEC is
procedure SYS_PAL_INSQTIL
(STATUS : out Integer; Header : Address; ITEM : Address);
- pragma Interface (External, SYS_PAL_INSQTIL);
+ pragma Import (External, SYS_PAL_INSQTIL);
pragma Import_Valued_Procedure (SYS_PAL_INSQTIL, "SYS$PAL_INSQTIL",
(Integer, Address, Address),
(Value, Value, Value));
@@ -542,7 +542,7 @@ package body System.Aux_DEC is
procedure SYS_PAL_REMQTIL
(Remret : out Remq; Header : Address);
- pragma Interface (External, SYS_PAL_REMQTIL);
+ pragma Import (External, SYS_PAL_REMQTIL);
pragma Import_Valued_Procedure (SYS_PAL_REMQTIL, "SYS$PAL_REMQTIL",
(Remq, Address),
(Value, Value));
diff --git a/gcc/ada/s-mastop-vms.adb b/gcc/ada/s-mastop-vms.adb
index 9ae830099622915b01add9dbbbf1a2f6477e1879..7426f50a5ec6cd2fc43889c1191e171ad9bcb648 100644
--- a/gcc/ada/s-mastop-vms.adb
+++ b/gcc/ada/s-mastop-vms.adb
@@ -7,7 +7,7 @@
-- B o d y --
-- (Version for Alpha/VMS) --
-- --
--- Copyright (C) 2001-2010, AdaCore --
+-- Copyright (C) 2001-2012, AdaCore --
-- --
-- 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- --
@@ -176,7 +176,7 @@ package body System.Machine_State_Operations is
Invo_Handle : Invo_Handle_Type;
Invo_Context : out Invo_Context_Blk_Type);
- pragma Interface (External, Get_Invo_Context);
+ pragma Import (External, Get_Invo_Context);
pragma Import_Valued_Procedure (Get_Invo_Context, "LIB$GET_INVO_CONTEXT",
(Unsigned_Longword, Invo_Handle_Type, Invo_Context_Blk_Type),
@@ -221,7 +221,7 @@ package body System.Machine_State_Operations is
Result : out Invo_Handle_Type; -- return value
ICB : Invo_Handle_Type);
- pragma Interface (External, Get_Prev_Invo_Handle);
+ pragma Import (External, Get_Prev_Invo_Handle);
pragma Import_Valued_Procedure
(Get_Prev_Invo_Handle, "LIB$GET_PREV_INVO_HANDLE",
@@ -244,7 +244,7 @@ package body System.Machine_State_Operations is
procedure Get_Curr_Invo_Context
(Invo_Context : out Invo_Context_Blk_Type);
- pragma Interface (External, Get_Curr_Invo_Context);
+ pragma Import (External, Get_Curr_Invo_Context);
pragma Import_Valued_Procedure
(Get_Curr_Invo_Context, "LIB$GET_CURR_INVO_CONTEXT",
@@ -255,7 +255,7 @@ package body System.Machine_State_Operations is
Result : out Invo_Handle_Type; -- return value
Invo_Context : Invo_Context_Blk_Type);
- pragma Interface (External, Get_Invo_Handle);
+ pragma Import (External, Get_Invo_Handle);
pragma Import_Valued_Procedure (Get_Invo_Handle, "LIB$GET_INVO_HANDLE",
(Invo_Handle_Type, Invo_Context_Blk_Type),
diff --git a/gcc/ada/s-osinte-vms.ads b/gcc/ada/s-osinte-vms.ads
index cadc6526aca1c06008e3c2881f207e1b52548d5c..e8cc6b8cb42c0bfa4312f6426b9604399f885d2d 100644
--- a/gcc/ada/s-osinte-vms.ads
+++ b/gcc/ada/s-osinte-vms.ads
@@ -125,7 +125,7 @@ package System.OS_Interface is
Acmode : unsigned_short := 0;
Mbxnam : String := String'Null_Parameter;
Flags : unsigned_long := 0);
- pragma Interface (External, Sys_Assign);
+ pragma Import (External, Sys_Assign);
pragma Import_Valued_Procedure
(Sys_Assign, "SYS$ASSIGN",
(Cond_Value_Type, String, unsigned_short,
@@ -148,7 +148,7 @@ package System.OS_Interface is
(Status : out Cond_Value_Type;
Reqidt : Address;
Acmode : unsigned);
- pragma Interface (External, Sys_Cantim);
+ pragma Import (External, Sys_Cantim);
pragma Import_Valued_Procedure
(Sys_Cantim, "SYS$CANTIM",
(Cond_Value_Type, Address, unsigned),
@@ -180,7 +180,7 @@ package System.OS_Interface is
Acmode : unsigned_short := 0;
Lognam : String;
Flags : unsigned_long := 0);
- pragma Interface (External, Sys_Crembx);
+ pragma Import (External, Sys_Crembx);
pragma Import_Valued_Procedure
(Sys_Crembx, "SYS$CREMBX",
(Cond_Value_Type, unsigned_char, unsigned_short,
@@ -235,7 +235,7 @@ package System.OS_Interface is
P5 : unsigned_long := 0;
P6 : unsigned_long := 0);
- pragma Interface (External, Sys_QIO);
+ pragma Import (External, Sys_QIO);
pragma Import_Valued_Procedure
(Sys_QIO, "SYS$QIO",
(Cond_Value_Type, unsigned_long, unsigned_short, unsigned_long,
@@ -278,7 +278,7 @@ package System.OS_Interface is
AST : AST_Handler;
Reqidt : Address;
Flags : unsigned_long);
- pragma Interface (External, Sys_Setimr);
+ pragma Import (External, Sys_Setimr);
pragma Import_Valued_Procedure
(Sys_Setimr, "SYS$SETIMR",
(Cond_Value_Type, unsigned_long, Long_Integer,
diff --git a/gcc/ada/s-osprim-vms.adb b/gcc/ada/s-osprim-vms.adb
index c08b4fe8990d280d87b5e06988d5913617a552b3..5fa499bd13f7339725a3bab2a733b05190bc066a 100644
--- a/gcc/ada/s-osprim-vms.adb
+++ b/gcc/ada/s-osprim-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2012, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -81,7 +81,7 @@ package body System.OS_Primitives is
Reptim : Long_Integer := Long_Integer'Null_Parameter
);
- pragma Interface (External, Sys_Schdwk);
+ pragma Import (External, Sys_Schdwk);
-- VMS system call to schedule a wakeup event
pragma Import_Valued_Procedure
(Sys_Schdwk, "SYS$SCHDWK",
@@ -105,7 +105,7 @@ package body System.OS_Primitives is
Tim : out OS_Time
);
-- VMS system call to get the current system time
- pragma Interface (External, Sys_Gettim);
+ pragma Import (External, Sys_Gettim);
pragma Import_Valued_Procedure
(Sys_Gettim, "SYS$GETTIM",
(Cond_Value_Type, OS_Time),
@@ -122,7 +122,7 @@ package body System.OS_Primitives is
procedure Sys_Hiber (Status : out Cond_Value_Type);
-- VMS system call to hibernate the current process
- pragma Interface (External, Sys_Hiber);
+ pragma Import (External, Sys_Hiber);
pragma Import_Valued_Procedure
(Sys_Hiber, "SYS$HIBER",
(Cond_Value_Type),
diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index 046aa037b6d6760934444331700d3b2814c938e8..53034cad012318297913418c2cb1fd29ac48aab9 100644
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -1225,7 +1225,7 @@ package body System.Task_Primitives.Operations is
return System.Aux_DEC.Unsigned_Word;
-- DBGEXT is imported from s-tasdeb.adb and its parameter re-typed
-- as Address to avoid having a VMS specific s-tasdeb.ads.
- pragma Interface (C, DBGEXT);
+ pragma Import (C, DBGEXT);
pragma Import_Function (DBGEXT, "GNAT$DBGEXT");
type Facility_Type is range 0 .. 65535;
diff --git a/gcc/ada/s-tasdeb-vms.adb b/gcc/ada/s-tasdeb-vms.adb
index acd7fcce862f54de906241ec5faccd3d2d8500df..1dbb5c53fc5b044e2056b1ebbfdd5e57850a793d 100644
--- a/gcc/ada/s-tasdeb-vms.adb
+++ b/gcc/ada/s-tasdeb-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2008-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2012, 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- --
@@ -556,7 +556,7 @@ package body System.Tasking.Debug is
Item_Req : Unsigned_Word;
Out_Buff : Unsigned_Longword;
Buff_Siz : Unsigned_Word);
- pragma Interface (External, Debug_Get);
+ pragma Import (External, Debug_Get);
pragma Import_Procedure (Debug_Get, "CMA$DEBUG_GET",
(OSI.Thread_Id, Unsigned_Word, System.Address, Unsigned_Word),
@@ -572,7 +572,7 @@ package body System.Tasking.Debug is
Outlen : out Unsigned_Word;
Outbuf : out String;
Prmlst : Unsigned_Longword_Array);
- pragma Interface (External, FAOL);
+ pragma Import (External, FAOL);
pragma Import_Valued_Procedure (FAOL, "SYS$FAOL",
(Cond_Value_Type, String, Unsigned_Word, String, Unsigned_Longword_Array),
@@ -583,7 +583,7 @@ package body System.Tasking.Debug is
Message_String : String);
procedure Put_Output (Message_String : String);
- pragma Interface (External, Put_Output);
+ pragma Import (External, Put_Output);
pragma Import_Valued_Procedure (Put_Output, "LIB$PUT_OUTPUT",
(Cond_Value_Type, String),
@@ -598,7 +598,7 @@ package body System.Tasking.Debug is
Number_Of_Arguments : Integer := Integer'Null_Parameter;
FAO_Argument_1 : Unsigned_Longword :=
Unsigned_Longword'Null_Parameter);
- pragma Interface (External, Signal);
+ pragma Import (External, Signal);
pragma Import_Procedure (Signal, "LIB$SIGNAL",
(Cond_Value_Type, Integer, Unsigned_Longword),
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index eae2df3c0006bc58733b04b9e3ded26ca1fdda12..976d3e2f27bfa87dea4c15c5a2b8fd4399389f2c 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -501,6 +501,12 @@ package body Sem_Ch6 is
end if;
Analyze_Call (N);
+
+ -- Mark function call if within assertion
+
+ if In_Assertion_Expr /= 0 then
+ Set_In_Assertion (N);
+ end if;
end Analyze_Function_Call;
-----------------------------
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index a3be9db025eb527147839d8a55e3092d7b814824..a3837951962e4578981bf8e9c34f40de5a21e5ac 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -554,6 +554,14 @@ package body Sem_Ch8 is
Set_Renamed_Object (Id, Entity (Nam));
end if;
end if;
+
+ -- Implementation-defined aspect specifications can appear in a renaming
+ -- declaration, but not language-defined ones. The call to procedure
+ -- Analyze_Aspect_Specifications will take care of this error check.
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
end Analyze_Exception_Renaming;
---------------------------
@@ -681,6 +689,14 @@ package body Sem_Ch8 is
Check_Library_Unit_Renaming (N, Old_P);
end if;
+
+ -- Implementation-defined aspect specifications can appear in a renaming
+ -- declaration, but not language-defined ones. The call to procedure
+ -- Analyze_Aspect_Specifications will take care of this error check.
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, New_P);
+ end if;
end Analyze_Generic_Renaming;
-----------------------------
@@ -728,8 +744,7 @@ package body Sem_Ch8 is
then
null;
- -- A renaming of an unchecked union does not have an
- -- actual subtype.
+ -- A renaming of an unchecked union has no actual subtype
elsif Is_Unchecked_Union (Typ) then
null;
@@ -800,9 +815,7 @@ package body Sem_Ch8 is
-- when the renaming is generated in removing side effects of an
-- already-analyzed expression.
- if Nkind (Nam) = N_Selected_Component
- and then Analyzed (Nam)
- then
+ if Nkind (Nam) = N_Selected_Component and then Analyzed (Nam) then
T := Etype (Nam);
Dec := Build_Actual_Subtype_Of_Component (Etype (Nam), Nam);
@@ -1235,6 +1248,17 @@ package body Sem_Ch8 is
end if;
Set_Renamed_Object (Id, Nam);
+
+ -- Implementation-defined aspect specifications can appear in a renaming
+ -- declaration, but not language-defined ones. The call to procedure
+ -- Analyze_Aspect_Specifications will take care of this error check.
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
+
+ -- Deal with dimensions
+
Analyze_Dimension (N);
end Analyze_Object_Renaming;
@@ -1381,6 +1405,14 @@ package body Sem_Ch8 is
end;
end if;
end if;
+
+ -- Implementation-defined aspect specifications can appear in a renaming
+ -- declaration, but not language-defined ones. The call to procedure
+ -- Analyze_Aspect_Specifications will take care of this error check.
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, New_P);
+ end if;
end Analyze_Package_Renaming;
-------------------------------
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 06c994a1b430e7698bfcd3dd5205e480aba3271c..74cbdf10df6b6eb32409d02e287e159d682fe581 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -2252,6 +2252,13 @@ package body Sem_Elab is
if not Suppress_Elaboration_Warnings (E)
and then not Elaboration_Checks_Suppressed (E)
+
+ -- Suppress this warning if we have a function call that occurred
+ -- within an assertion expression, since we can get false warnings
+ -- in this case, due to the out of order handling in this case.
+
+ and then (Nkind (Original_Node (N)) /= N_Function_Call
+ or else not In_Assertion (Original_Node (N)))
then
if Inst_Case then
Error_Msg_NE
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8d8735596fe21762a956e9ff5371584eda5fb45d..d0c9661222cb4a4483bad3371001089293184489 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -10454,8 +10454,9 @@ package body Sem_Prag is
-- Implemented --
-----------------
- -- pragma Implemented (procedure_LOCAL_NAME, implementation_kind);
- -- implementation_kind ::=
+ -- pragma Implemented (procedure_LOCAL_NAME, IMPLEMENTATION_KIND);
+
+ -- IMPLEMENTATION_KIND ::=
-- By_Entry | By_Protected_Procedure | By_Any | Optional
-- "By_Any" and "Optional" are treated as synonyms in order to
@@ -14945,15 +14946,17 @@ package body Sem_Prag is
E := Entity (E_Id);
- if E = Any_Id then
- return;
- else
- loop
- Set_Suppress_Style_Checks (E,
- (Chars (Get_Pragma_Arg (Arg1)) = Name_Off));
- exit when No (Homonym (E));
- E := Homonym (E);
- end loop;
+ if not Ignore_Style_Checks_Pragmas then
+ if E = Any_Id then
+ return;
+ else
+ loop
+ Set_Suppress_Style_Checks
+ (E, Chars (Get_Pragma_Arg (Arg1)) = Name_Off);
+ exit when No (Homonym (E));
+ E := Homonym (E);
+ end loop;
+ end if;
end if;
end;
@@ -14982,7 +14985,10 @@ package body Sem_Prag is
-- them in the parser.
if J = Slen then
- Set_Style_Check_Options (Options);
+ if not Ignore_Style_Checks_Pragmas then
+ Set_Style_Check_Options (Options);
+ end if;
+
exit;
end if;
@@ -14992,17 +14998,23 @@ package body Sem_Prag is
elsif Nkind (A) = N_Identifier then
if Chars (A) = Name_All_Checks then
- if GNAT_Mode then
- Set_GNAT_Style_Check_Options;
- else
- Set_Default_Style_Check_Options;
+ if not Ignore_Style_Checks_Pragmas then
+ if GNAT_Mode then
+ Set_GNAT_Style_Check_Options;
+ else
+ Set_Default_Style_Check_Options;
+ end if;
end if;
elsif Chars (A) = Name_On then
- Style_Check := True;
+ if not Ignore_Style_Checks_Pragmas then
+ Style_Check := True;
+ end if;
elsif Chars (A) = Name_Off then
- Style_Check := False;
+ if not Ignore_Style_Checks_Pragmas then
+ Style_Check := False;
+ end if;
end if;
end if;
end if;
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 32f7edaab252ab2ae438b06d380608c27cbc3763..3d5a64434f241146bfeba6257791de57e85f2cb8 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1631,6 +1631,14 @@ package body Sinfo is
return Flag16 (N);
end Import_Interface_Present;
+ function In_Assertion
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Function_Call);
+ return Flag4 (N);
+ end In_Assertion;
+
function In_Present
(N : Node_Id) return Boolean is
begin
@@ -4695,6 +4703,14 @@ package body Sinfo is
Set_Flag16 (N, Val);
end Set_Import_Interface_Present;
+ procedure Set_In_Assertion
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Function_Call);
+ Set_Flag4 (N, Val);
+ end Set_In_Assertion;
+
procedure Set_In_Present
(N : Node_Id; Val : Boolean := True) is
begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 20ad9244a01a0c9cbff0427610267ecfa1f8f461..20fb08c407187d98d48c782ce5005c27144b47e8 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1218,6 +1218,11 @@ package Sinfo is
-- pragma of the other kind is also present. This is used to avoid
-- generating some unwanted error messages.
+ -- In_Assertion (Flag4-Sem)
+ -- This flag is present in N_Function_Call nodes. It is set if the
+ -- function is called from within an assertion expression. This is
+ -- used to avoid some bogus warnings about early elaboration.
+
-- Includes_Infinities (Flag11-Sem)
-- This flag is present in N_Range nodes. It is set for the range of
-- unconstrained float types defined in Standard, which include not only
@@ -4757,6 +4762,7 @@ package Sinfo is
-- actual parameter part)
-- First_Named_Actual (Node4-Sem)
-- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
+ -- In_Assertion (Flag4-Sem)
-- Is_Expanded_Build_In_Place_Call (Flag11-Sem)
-- Do_Tag_Check (Flag13-Sem)
-- No_Elaboration_Check (Flag14-Sem)
@@ -8590,6 +8596,9 @@ package Sinfo is
function Import_Interface_Present
(N : Node_Id) return Boolean; -- Flag16
+ function In_Assertion
+ (N : Node_Id) return Boolean; -- Flag4
+
function In_Present
(N : Node_Id) return Boolean; -- Flag15
@@ -9565,6 +9574,9 @@ package Sinfo is
procedure Set_Import_Interface_Present
(N : Node_Id; Val : Boolean := True); -- Flag16
+ procedure Set_In_Assertion
+ (N : Node_Id; Val : Boolean := True); -- Flag4
+
procedure Set_In_Present
(N : Node_Id; Val : Boolean := True); -- Flag15
@@ -11952,6 +11964,7 @@ package Sinfo is
pragma Inline (Interface_Present);
pragma Inline (Includes_Infinities);
pragma Inline (Import_Interface_Present);
+ pragma Inline (In_Assertion);
pragma Inline (In_Present);
pragma Inline (Inherited_Discriminant);
pragma Inline (Instance_Spec);
@@ -12272,6 +12285,7 @@ package Sinfo is
pragma Inline (Set_Interface_List);
pragma Inline (Set_Interface_Present);
pragma Inline (Set_Import_Interface_Present);
+ pragma Inline (Set_In_Assertion);
pragma Inline (Set_In_Present);
pragma Inline (Set_Inherited_Discriminant);
pragma Inline (Set_Instance_Spec);
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index ebb18b0c4016f25a67d1b351072f263ed7567424..2ac486bd30fd1975bede85b8dde5bee757508a63 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -633,6 +633,12 @@ package body Switch.C is
Ptr := Ptr + 1;
Check_Validity_Of_Parameters := True;
+ -- -gnateY (ignore Style_Checks pragmas)
+
+ when 'Y' =>
+ Ignore_Style_Checks_Pragmas := True;
+ Ptr := Ptr + 1;
+
-- -gnatez (final delimiter of explicit switches)
-- All switches that come after -gnatez have been added by
diff --git a/gcc/ada/system-vms-ia64.ads b/gcc/ada/system-vms-ia64.ads
index f8ed51afad81eb7a7470af7a49f73159967dd163..bdf2b2cb7ab516479a25c31d25eb4adc0f583a51 100644
--- a/gcc/ada/system-vms-ia64.ads
+++ b/gcc/ada/system-vms-ia64.ads
@@ -239,7 +239,7 @@ private
----------------------------
procedure Lib_Stop (Cond_Value : Integer);
- pragma Interface (C, Lib_Stop);
+ pragma Import (C, Lib_Stop);
pragma Import_Procedure (Lib_Stop, "LIB$STOP", Mechanism => (Value));
-- Interface to VMS condition handling. Used by RTSfind and pragma
-- {Import,Export}_Exception. Put here because this is the only
diff --git a/gcc/ada/system-vms_64.ads b/gcc/ada/system-vms_64.ads
index aa4fa3750bc31218b4e7f3c06c42dda10ebac6e3..b8c57de99917242953bd56790f849e5dd943f3e0 100644
--- a/gcc/ada/system-vms_64.ads
+++ b/gcc/ada/system-vms_64.ads
@@ -239,7 +239,7 @@ private
----------------------------
procedure Lib_Stop (Cond_Value : Integer);
- pragma Interface (C, Lib_Stop);
+ pragma Import (C, Lib_Stop);
pragma Import_Procedure (Lib_Stop, "LIB$STOP", Mechanism => (Value));
-- Interface to VMS condition handling. Used by RTSfind and pragma
-- {Import,Export}_Exception. Put here because this is the only
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index f4cceb46d23033ca8ac7889cacedaf3309ef14a6..4efa6076185b4267c2b16f14724a1ad3779953c5 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -257,6 +257,11 @@ begin
Write_Switch_Char ("eV");
Write_Line ("Validity checks on subprogram parameters");
+ -- Line for -gnateY switch
+
+ Write_Switch_Char ("eY");
+ Write_Line ("Ignore all Style_Checks pragmas in source");
+
-- Line for -gnatez switch
Write_Switch_Char ("ez");
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index ed6f1b5c4fc9df9f6aeefb99521112f07e600a6c..e2d926032396d186a0757ec4f29422439a4cddd8 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -1786,7 +1786,7 @@ package VMS_Data is
"-gnati1";
-- NODOC (see /IDENTIFIER_CHARACTER_SET)
- S_GCC_Ignore : aliased constant S := "/IGNORE_REP_CLAUSES " &
+ S_GCC_IgnoreR : aliased constant S := "/IGNORE_REP_CLAUSES " &
"-gnatI";
-- /IGNORE_REP_CLAUSES
--
@@ -1794,6 +1794,14 @@ package VMS_Data is
-- comments. Useful when compiling foreign code (for example when ASIS
-- is used to analyze such code).
+ S_GCC_IgnoreS : aliased constant S := "/IGNORE_STYLE_CHECKS_PRAGMAS " &
+ "-gnateY";
+ -- /IGNORE_STYLE_CHECKS_PRAGMAS
+ --
+ -- Causes all Style_Checks pragmas to be checked for legality, but
+ -- otherwise ignored. Allows style checks to be fully controlled by
+ -- command line qualifiers.
+
S_GCC_Immed : aliased constant S := "/IMMEDIATE_ERRORS " &
"-gnatdO";
-- /NOIMMEDIATE_ERRORS (D)
@@ -3660,7 +3668,8 @@ package VMS_Data is
S_GCC_Help 'Access,
S_GCC_Ident 'Access,
S_GCC_IdentX 'Access,
- S_GCC_Ignore 'Access,
+ S_GCC_IgnoreR 'Access,
+ S_GCC_IgnoreS 'Access,
S_GCC_Immed 'Access,
S_GCC_Inline 'Access,
S_GCC_InlineX 'Access,