From 2e0717349d7cb5660d38c281ab6c65d5e01fa8fc Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 9 Feb 2004 15:56:05 +0100 Subject: [PATCH] [multiple changes] 2004-02-09 Ed Schonberg * exp_ch4.adb (Expand_N_Op_Eq): When looking for the primitive equality for a tagged type, verify that both formals have the same type. * exp_ch6.adb (Add_Call_By_Copy_Code): Initialize properly the temporary when the formal is an in-parameter and the actual a possibly unaligned slice. * exp_ch9.adb (Expand_Entry_Barrier): Resolve barrier expression even when expansion is disabled, to ensure proper name capture with overloaded literals. Condition can be of any boolean type, resolve accordingly. * sem_ch8.adb (Analyze_Subprogram_Renaming): Emit warning if the renaming is for a formal subprogram with a default operator name, and there is a usable operator that is visible at the point of instantiation. 2004-02-09 Robert Dewar * ali.adb (Scan_Ali) Add Ignore_Errors argument. This is a major rewrite to ignore errors in ali files, intended to allow tools downward compatibility with new versions of ali files. * ali.ads: Add new parameter Ignore_Errors * bcheck.adb (Check_Consistent_Restrictions): Fix error of sometimes duplicating the error message giving the file with restrictions. * debug.adb: Add debug flag I for gnatbind * errout.adb (Set_Msg_Insertion_Node): Suppress extra quotes around operators for the case where the operator is a defining operator. * exp_ch3.adb: Minor reformatting (new function spec format). * exp_ch4.adb: Add comment for previous change, and make minor adjustment to loop to always check for improper loop termination. Minor reformatting throughout (new function spec format). * gnatbind.adb: Implement -di debug flag for gnatbind * gnatlink.adb: Call Scan_ALI with Ignore_Errors set to True * gnatls.adb: Call Scan_ALI with Ignore_Errors set to True * lib-load.adb: Fix bad assertion. Found by testing and code reading. Minor reformatting. * lib-load.ads: Minor reformatting. * lib-writ.adb: There is only one R line now. * lib-writ.ads: Add documentation on making downward compatible changes to ali files so old tools work with new ali files. There is only one R line now. Add documentation on format incompatibilities (with special GPS note) * namet.ads, namet.adb: (Is_Operator_Name): New procedure * par-load.adb: Minor reformatting * sem_ch8.adb: Fix to error message from last update Minor reformatting and restructuring of code from last update * par-prag.adb, snames.adb, snames.ads, snames.h, sem_prag.adb: Implement pragma Profile. * stylesw.adb: Implement -gnatyN switch to turn off all style check options. * usage.adb: Add line for -gnatyN switch * vms_data.ads: Add entry STYLE_CHECKS=NONE for -gnatyN From-SVN: r77537 --- gcc/ada/ChangeLog | 77 ++++ gcc/ada/ali.adb | 558 +++++++++++++++--------- gcc/ada/ali.ads | 22 +- gcc/ada/bcheck.adb | 61 +-- gcc/ada/debug.adb | 11 +- gcc/ada/errout.adb | 36 +- gcc/ada/exp_ch3.adb | 77 ++-- gcc/ada/exp_ch4.adb | 103 +++-- gcc/ada/exp_ch6.adb | 4 + gcc/ada/exp_ch9.adb | 2 +- gcc/ada/gnatbind.adb | 19 +- gcc/ada/gnatlink.adb | 12 +- gcc/ada/gnatls.adb | 6 +- gcc/ada/lib-load.adb | 28 +- gcc/ada/lib-load.ads | 8 +- gcc/ada/lib-writ.adb | 11 +- gcc/ada/lib-writ.ads | 89 +++- gcc/ada/namet.adb | 14 +- gcc/ada/namet.ads | 6 +- gcc/ada/par-load.adb | 12 +- gcc/ada/par-prag.adb | 3 +- gcc/ada/sem_ch8.adb | 68 ++- gcc/ada/sem_prag.adb | 33 +- gcc/ada/snames.adb | 1 + gcc/ada/snames.ads | 999 ++++++++++++++++++++++--------------------- gcc/ada/snames.h | 235 +++++----- gcc/ada/stylesw.adb | 6 +- gcc/ada/usage.adb | 5 + gcc/ada/vms_data.ads | 6 +- 29 files changed, 1464 insertions(+), 1048 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 750937b26ac..e27477c96b7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,80 @@ +2004-02-09 Ed Schonberg + + * exp_ch4.adb (Expand_N_Op_Eq): When looking for the primitive equality + for a tagged type, verify that both formals have the same type. + + * exp_ch6.adb (Add_Call_By_Copy_Code): Initialize properly the + temporary when the formal is an in-parameter and the actual a possibly + unaligned slice. + + * exp_ch9.adb (Expand_Entry_Barrier): Resolve barrier expression even + when expansion is disabled, to ensure proper name capture with + overloaded literals. Condition can be of any boolean type, resolve + accordingly. + + * sem_ch8.adb (Analyze_Subprogram_Renaming): Emit warning if the + renaming is for a formal subprogram with a default operator name, and + there is a usable operator that is visible at the point of + instantiation. + +2004-02-09 Robert Dewar + + * ali.adb (Scan_Ali) Add Ignore_Errors argument. This is a major + rewrite to ignore errors in ali files, intended to allow tools downward + compatibility with new versions of ali files. + + * ali.ads: Add new parameter Ignore_Errors + + * bcheck.adb (Check_Consistent_Restrictions): Fix error of sometimes + duplicating the error message giving the file with restrictions. + + * debug.adb: Add debug flag I for gnatbind + + * errout.adb (Set_Msg_Insertion_Node): Suppress extra quotes around + operators for the case where the operator is a defining operator. + + * exp_ch3.adb: Minor reformatting (new function spec format). + + * exp_ch4.adb: Add comment for previous change, and make minor + adjustment to loop to always check for improper loop termination. + Minor reformatting throughout (new function spec format). + + * gnatbind.adb: Implement -di debug flag for gnatbind + + * gnatlink.adb: Call Scan_ALI with Ignore_Errors set to True + + * gnatls.adb: Call Scan_ALI with Ignore_Errors set to True + + * lib-load.adb: Fix bad assertion. + Found by testing and code reading. + Minor reformatting. + + * lib-load.ads: Minor reformatting. + + * lib-writ.adb: There is only one R line now. + + * lib-writ.ads: Add documentation on making downward compatible changes + to ali files so old tools work with new ali files. + There is only one R line now. + Add documentation on format incompatibilities (with special GPS note) + + * namet.ads, namet.adb: (Is_Operator_Name): New procedure + + * par-load.adb: Minor reformatting + + * sem_ch8.adb: Fix to error message from last update + Minor reformatting and restructuring of code from last update + + * par-prag.adb, snames.adb, snames.ads, snames.h, + sem_prag.adb: Implement pragma Profile. + + * stylesw.adb: Implement -gnatyN switch to turn off all style check + options. + + * usage.adb: Add line for -gnatyN switch + + * vms_data.ads: Add entry STYLE_CHECKS=NONE for -gnatyN + 2004-02-09 Albert Lee * errno.c: define _SGI_MP_SOURCE for task-safe errno on IRIX diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 66b748368ce..22466200830 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -37,6 +37,25 @@ package body ALI is use ASCII; -- Make control characters visible + -- The following variable records which characters currently are + -- used as line type markers in the ALI file. This is used in + -- Scan_ALI to detect (or skip) invalid lines. + + Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean := + ('V' => True, -- version + 'M' => True, -- main program + 'A' => True, -- argument + 'P' => True, -- program + 'R' => True, -- restriction + 'I' => True, -- interrupt + 'U' => True, -- unit + 'W' => True, -- with + 'L' => True, -- linker option + 'E' => True, -- external + 'D' => True, -- dependency + 'X' => True, -- xref + others => False); + -------------------- -- Initialize_ALI -- -------------------- @@ -99,13 +118,14 @@ package body ALI is -------------- function Scan_ALI - (F : File_Name_Type; - T : Text_Buffer_Ptr; - Ignore_ED : Boolean; - Err : Boolean; - Read_Xref : Boolean := False; - Read_Lines : String := ""; - Ignore_Lines : String := "X") return ALI_Id + (F : File_Name_Type; + T : Text_Buffer_Ptr; + Ignore_ED : Boolean; + Err : Boolean; + Read_Xref : Boolean := False; + Read_Lines : String := ""; + Ignore_Lines : String := "X"; + Ignore_Errors : Boolean := False) return ALI_Id is P : Text_Ptr := T'First; Line : Logical_Line_Number := 1; @@ -141,10 +161,26 @@ package body ALI is procedure Checkc (C : Character); -- Check next character is C. If so bump past it, if not fatal error + procedure Check_Unknown_Line; + -- If Ignore_Errors mode, then checks C to make sure that it is not + -- an unknown ALI line type characters, and if so, skips lines + -- until the first character of the line is one of these characters, + -- at which point it does a Getc to put that character in C. The + -- call has no effect if C is already an appropriate character. + -- If not in Ignore_Errors mode, a fatal error is signalled if the + -- line is unknown. Note that if C is an EOL on entry, the line is + -- skipped (it is assumed that blank lines are never significant). + -- If C is EOF on entry, the call has no effect (it is assumed that + -- the caller will properly handle this case). + procedure Fatal_Error; -- Generate fatal error message for badly formatted ALI file if -- Err is false, or raise Bad_ALI_Format if Err is True. + procedure Fatal_Error_Ignore; + pragma Inline (Fatal_Error_Ignore); + -- In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error + function Getc return Character; -- Get next character, bumping P past the character obtained @@ -210,7 +246,13 @@ package body ALI is procedure Check_At_End_Of_Field is begin if not At_End_Of_Field then - Fatal_Error; + if Ignore_Errors then + while Nextc > ' ' loop + P := P + 1; + end loop; + else + Fatal_Error; + end if; end if; end Check_At_End_Of_Field; @@ -222,11 +264,38 @@ package body ALI is begin if Nextc = C then P := P + 1; + elsif Ignore_Errors then + P := P + 1; else Fatal_Error; end if; end Checkc; + ------------------------ + -- Check_Unknown_Line -- + ------------------------ + + procedure Check_Unknown_Line is + begin + while C not in 'A' .. 'Z' + or else not Known_ALI_Lines (C) + loop + if C = CR or else C = LF then + Skip_Line; + + elsif C = EOF then + return; + + elsif Ignore_Errors then + Skip_Line; + C := Getc; + + else + Fatal_Error; + end if; + end loop; + end Check_Unknown_Line; + ----------------- -- Fatal_Error -- ----------------- @@ -323,6 +392,17 @@ package body ALI is Exit_Program (E_Fatal); end Fatal_Error; + ------------------------ + -- Fatal_Error_Ignore -- + ------------------------ + + procedure Fatal_Error_Ignore is + begin + if not Ignore_Errors then + Fatal_Error; + end if; + end Fatal_Error_Ignore; + -------------- -- Get_Name -- -------------- @@ -336,7 +416,11 @@ package body ALI is Skip_Space; if At_Eol then - Fatal_Error; + if Ignore_Errors then + return Error_Name; + else + Fatal_Error; + end if; end if; loop @@ -400,7 +484,11 @@ package body ALI is Skip_Space; if At_Eol then - Fatal_Error; + if Ignore_Errors then + return Dummy_Time_Stamp; + else + Fatal_Error; + end if; end if; -- Following reads old style time stamp missing first two digits @@ -454,7 +542,15 @@ package body ALI is begin Skip_Space; - if not At_Eol then Fatal_Error; end if; + if not At_Eol then + if Ignore_Errors then + while not At_Eol loop + P := P + 1; + end loop; + else + Fatal_Error; + end if; + end if; -- Loop to skip past blank lines (first time through skips this EOL) @@ -569,10 +665,16 @@ package body ALI is -- C is set to contain the first character of the following line. C := Getc; + Check_Unknown_Line; -- Acquire library version if C /= 'V' then + + -- The V line missing really indicates trouble, most likely it + -- means we don't have an ALI file at all, so here we give a + -- fatal error even if we are in Ignore_Errors mode. + Fatal_Error; elsif Ignore ('V') then @@ -594,6 +696,7 @@ package body ALI is end if; C := Getc; + Check_Unknown_Line; -- Acquire main program line if present @@ -648,7 +751,10 @@ package body ALI is First_Arg := Args.Last + 1; - Arg_Loop : while C = 'A' loop + A_Loop : loop + Check_Unknown_Line; + exit A_Loop when C /= 'A'; + if Ignore ('A') then Skip_Line; @@ -668,16 +774,29 @@ package body ALI is end if; C := Getc; - end loop Arg_Loop; + end loop A_Loop; -- Acquire P line - if C /= 'P' then - Fatal_Error; + Check_Unknown_Line; - elsif Ignore ('P') then + while C /= 'P' loop + if Ignore_Errors then + if C = EOF then + Fatal_Error; + else + Skip_Line; + end if; + else + Fatal_Error; + end if; + end loop; + + if Ignore ('P') then Skip_Line; + -- Process P line + else NS_Found := False; @@ -731,7 +850,7 @@ package body ALI is -- Invalid switch starting with N else - Fatal_Error; + Fatal_Error_Ignore; end if; -- Processing for Qx @@ -758,7 +877,7 @@ package body ALI is -- Invalid switch starting with S else - Fatal_Error; + Fatal_Error_Ignore; end if; -- Processing for Tx @@ -786,18 +905,26 @@ package body ALI is -- Invalid switches starting with U else - Fatal_Error; + Fatal_Error_Ignore; end if; -- Processing for ZX elsif C = 'Z' then - Checkc ('X'); + C := Getc; + + if C = 'X' then ALIs.Table (Id).Zero_Cost_Exceptions := True; Zero_Cost_Exceptions_Specified := True; + else + Fatal_Error_Ignore; + end if; + + -- Invalid parameter else - Fatal_Error; + C := Getc; + Fatal_Error_Ignore; end if; end loop; @@ -809,149 +936,173 @@ package body ALI is end if; C := Getc; + Check_Unknown_Line; - -- Acquire first restrictions line + -- Acquire restrictions line - if C /= 'R' then - Fatal_Error; + while C /= 'R' loop + if Ignore_Errors then + if C = EOF then + Fatal_Error; + else + Skip_Line; + end if; + else + Fatal_Error; + end if; + end loop; - elsif Ignore ('R') then + if Ignore ('R') then Skip_Line; - else - Checkc (' '); - Skip_Space; - - for R in All_Boolean_Restrictions loop - C := Getc; - - case C is - when 'v' => - ALIs.Table (Id).Restrictions.Violated (R) := True; - Cumulative_Restrictions.Violated (R) := True; - - when 'r' => - ALIs.Table (Id).Restrictions.Set (R) := True; - Cumulative_Restrictions.Set (R) := True; - - when 'n' => - null; - - when others => - Fatal_Error; - end case; - end loop; - - Skip_Eol; - end if; - - C := Getc; - - -- See if we have a second R line - - if C /= 'R' then - - -- If not, just ignore, and leave the restrictions variables - -- unchanged. This is useful for dealing with old format ALI - -- files with only one R line (this can be removed later on, - -- but is useful for transitional purposes). - - null; - - -- Here we have a second R line, ignore it if ignore flag set - - elsif Ignore ('R') then - Skip_Line; - C := Getc; - - -- Otherwise acquire second R line + -- Process restrictions line else - Checkc (' '); - Skip_Space; + Scan_Restrictions : declare + Save_R : constant Restrictions_Info := Cumulative_Restrictions; + -- Save cumulative restrictions in case we have a fatal error - for RP in All_Parameter_Restrictions loop + Bad_R_Line : exception; + -- Signal bad restrictions line - -- Acquire restrictions pragma information + begin + Checkc (' '); + Skip_Space; - case Getc is - when 'n' => - null; + -- Acquire information for boolean restrictions - when 'r' => - ALIs.Table (Id).Restrictions.Set (RP) := True; + for R in All_Boolean_Restrictions loop + C := Getc; - declare - N : constant Integer := Integer (Get_Nat); - begin - ALIs.Table (Id).Restrictions.Value (RP) := N; + case C is + when 'v' => + ALIs.Table (Id).Restrictions.Violated (R) := True; + Cumulative_Restrictions.Violated (R) := True; - if Cumulative_Restrictions.Set (RP) then - Cumulative_Restrictions.Value (RP) := - Integer'Min (Cumulative_Restrictions.Value (RP), N); - else - Cumulative_Restrictions.Set (RP) := True; - Cumulative_Restrictions.Value (RP) := N; - end if; - end; + when 'r' => + ALIs.Table (Id).Restrictions.Set (R) := True; + Cumulative_Restrictions.Set (R) := True; - when others => - Fatal_Error; - end case; + when 'n' => + null; - -- Acquire restrictions violations information + when others => + Fatal_Error; + end case; + end loop; - case Getc is - when 'n' => - null; + -- Skip separating space - when 'v' => - ALIs.Table (Id).Restrictions.Violated (RP) := True; - Cumulative_Restrictions.Violated (RP) := True; + Checkc (' '); - declare - N : constant Integer := Integer (Get_Nat); - pragma Unsuppress (Overflow_Check); + -- Acquire information for parameter restrictions - begin - ALIs.Table (Id).Restrictions.Count (RP) := N; + for RP in All_Parameter_Restrictions loop - if RP in Checked_Max_Parameter_Restrictions then - Cumulative_Restrictions.Count (RP) := - Integer'Max (Cumulative_Restrictions.Count (RP), N); - else - Cumulative_Restrictions.Count (RP) := - Cumulative_Restrictions.Count (RP) + N; - end if; + -- Acquire restrictions pragma information - exception - when Constraint_Error => + case Getc is + when 'n' => + null; - -- A constraint error comes from the addition in - -- the else branch. We reset to the maximum and - -- indicate that the real value is now unknown. + when 'r' => + ALIs.Table (Id).Restrictions.Set (RP) := True; - Cumulative_Restrictions.Value (RP) := Integer'Last; + declare + N : constant Integer := Integer (Get_Nat); + begin + ALIs.Table (Id).Restrictions.Value (RP) := N; + + if Cumulative_Restrictions.Set (RP) then + Cumulative_Restrictions.Value (RP) := + Integer'Min + (Cumulative_Restrictions.Value (RP), N); + else + Cumulative_Restrictions.Set (RP) := True; + Cumulative_Restrictions.Value (RP) := N; + end if; + end; + + when others => + Fatal_Error; + end case; + + -- Acquire restrictions violations information + + case Getc is + when 'n' => + null; + + when 'v' => + ALIs.Table (Id).Restrictions.Violated (RP) := True; + Cumulative_Restrictions.Violated (RP) := True; + + declare + N : constant Integer := Integer (Get_Nat); + pragma Unsuppress (Overflow_Check); + + begin + ALIs.Table (Id).Restrictions.Count (RP) := N; + + if RP in Checked_Max_Parameter_Restrictions then + Cumulative_Restrictions.Count (RP) := + Integer'Max + (Cumulative_Restrictions.Count (RP), N); + else + Cumulative_Restrictions.Count (RP) := + Cumulative_Restrictions.Count (RP) + N; + end if; + + exception + when Constraint_Error => + + -- A constraint error comes from the addition in + -- the else branch. We reset to the maximum and + -- indicate that the real value is now unknown. + + Cumulative_Restrictions.Value (RP) := Integer'Last; + Cumulative_Restrictions.Unknown (RP) := True; + end; + + if Nextc = '+' then + Skipc; + ALIs.Table (Id).Restrictions.Unknown (RP) := True; Cumulative_Restrictions.Unknown (RP) := True; - end; + end if; - if Nextc = '+' then - Skipc; - ALIs.Table (Id).Restrictions.Unknown (RP) := True; - Cumulative_Restrictions.Unknown (RP) := True; - end if; + when others => + Fatal_Error; + end case; + end loop; - when others => + Skip_Eol; + + -- Here if error during scanning of restrictions line + + exception + when Bad_R_Line => + + -- In Ignore_Errors mode, undo any changes to restrictions + -- from this unit, and continue on. + + if Ignore_Errors then + Cumulative_Restrictions := Save_R; + ALIs.Table (Id).Restrictions := Restrictions_Initial; + + -- In normal mode, this is a fatal error + + else Fatal_Error; - end case; - end loop; + end if; - Skip_Eol; - C := Getc; + end Scan_Restrictions; end if; -- Acquire 'I' lines if present + C := Getc; + Check_Unknown_Line; + while C = 'I' loop if Ignore ('I') then Skip_Line; @@ -983,7 +1134,9 @@ package body ALI is -- Loop to acquire unit entries - Unit_Loop : while C = 'U' loop + U_Loop : loop + Check_Unknown_Line; + exit U_Loop when C /= 'U'; -- Note: as per spec, we never ignore U lines @@ -1104,17 +1257,28 @@ package body ALI is -- BN parameter (Body needed) elsif C = 'B' then - Checkc ('N'); - Check_At_End_Of_Field; - Units.Table (Units.Last).Body_Needed_For_SAL := True; + C := Getc; - -- DE parameter (Dynamic elaboration checks + if C = 'N' then + Check_At_End_Of_Field; + Units.Table (Units.Last).Body_Needed_For_SAL := True; + else + Fatal_Error_Ignore; + end if; + + + -- DE parameter (Dynamic elaboration checks) elsif C = 'D' then - Checkc ('E'); - Check_At_End_Of_Field; - Units.Table (Units.Last).Dynamic_Elab := True; - Dynamic_Elaboration_Checks_Specified := True; + C := Getc; + + if C = 'E' then + Check_At_End_Of_Field; + Units.Table (Units.Last).Dynamic_Elab := True; + Dynamic_Elaboration_Checks_Specified := True; + else + Fatal_Error_Ignore; + end if; -- EB/EE parameters @@ -1123,12 +1287,10 @@ package body ALI is if C = 'B' then Units.Table (Units.Last).Elaborate_Body := True; - elsif C = 'E' then Units.Table (Units.Last).Set_Elab_Entity := True; - else - Fatal_Error; + Fatal_Error_Ignore; end if; Check_At_End_Of_Field; @@ -1136,9 +1298,14 @@ package body ALI is -- GE parameter (generic) elsif C = 'G' then - Checkc ('E'); - Check_At_End_Of_Field; - Units.Table (Units.Last).Is_Generic := True; + C := Getc; + + if C = 'E' then + Check_At_End_Of_Field; + Units.Table (Units.Last).Is_Generic := True; + else + Fatal_Error_Ignore; + end if; -- IL/IS/IU parameters @@ -1147,16 +1314,13 @@ package body ALI is if C = 'L' then Units.Table (Units.Last).Icasing := All_Lower_Case; - elsif C = 'S' then Units.Table (Units.Last).Init_Scalars := True; Initialize_Scalars_Used := True; - elsif C = 'U' then Units.Table (Units.Last).Icasing := All_Upper_Case; - else - Fatal_Error; + Fatal_Error_Ignore; end if; Check_At_End_Of_Field; @@ -1168,12 +1332,10 @@ package body ALI is if C = 'M' then Units.Table (Units.Last).Kcasing := Mixed_Case; - elsif C = 'U' then Units.Table (Units.Last).Kcasing := All_Upper_Case; - else - Fatal_Error; + Fatal_Error_Ignore; end if; Check_At_End_Of_Field; @@ -1181,32 +1343,29 @@ package body ALI is -- NE parameter elsif C = 'N' then - Checkc ('E'); - Units.Table (Units.Last).No_Elab := True; - Check_At_End_Of_Field; + C := Getc; + + if C = 'E' then + Units.Table (Units.Last).No_Elab := True; + Check_At_End_Of_Field; + else + Fatal_Error_Ignore; + end if; + -- PR/PU/PK parameters elsif C = 'P' then C := Getc; - -- PR parameter (preelaborate) - if C = 'R' then Units.Table (Units.Last).Preelab := True; - - -- PU parameter (pure) - elsif C = 'U' then Units.Table (Units.Last).Pure := True; - - -- PK indicates unit is package - elsif C = 'K' then Units.Table (Units.Last).Unit_Kind := 'p'; - else - Fatal_Error; + Fatal_Error_Ignore; end if; Check_At_End_Of_Field; @@ -1216,23 +1375,14 @@ package body ALI is elsif C = 'R' then C := Getc; - -- RC parameter (remote call interface) - if C = 'C' then Units.Table (Units.Last).RCI := True; - - -- RT parameter (remote types) - elsif C = 'T' then Units.Table (Units.Last).Remote_Types := True; - - -- RA parameter (remote access to class wide type) - elsif C = 'A' then Units.Table (Units.Last).Has_RACW := True; - else - Fatal_Error; + Fatal_Error_Ignore; end if; Check_At_End_Of_Field; @@ -1240,24 +1390,19 @@ package body ALI is elsif C = 'S' then C := Getc; - -- SP parameter (shared passive) - if C = 'P' then Units.Table (Units.Last).Shared_Passive := True; - - -- SU parameter indicates unit is subprogram - elsif C = 'U' then Units.Table (Units.Last).Unit_Kind := 's'; - else - Fatal_Error; + Fatal_Error_Ignore; end if; Check_At_End_Of_Field; else - Fatal_Error; + C := Getc; + Fatal_Error_Ignore; end if; end loop; @@ -1275,7 +1420,10 @@ package body ALI is -- Scan out With lines for this unit - With_Loop : while C = 'W' loop + With_Loop : loop + Check_Unknown_Line; + exit With_Loop when C /= 'W'; + if Ignore ('W') then Skip_Line; @@ -1345,7 +1493,9 @@ package body ALI is Name_Len := 0; - Linker_Options_Loop : while C = 'L' loop + Linker_Options_Loop : loop + Check_Unknown_Line; + exit Linker_Options_Loop when C /= 'L'; if Ignore ('L') then Skip_Line; @@ -1361,7 +1511,7 @@ package body ALI is if C < Character'Val (16#20#) or else C > Character'Val (16#7E#) then - Fatal_Error; + Fatal_Error_Ignore; elsif C = '{' then C := Character'Val (0); @@ -1386,7 +1536,7 @@ package body ALI is 10; else - Fatal_Error; + Fatal_Error_Ignore; end if; end loop; @@ -1428,7 +1578,7 @@ package body ALI is Linker_Options.Table (Linker_Options.Last).Original_Pos := Linker_Options.Last; end if; - end loop Unit_Loop; + end loop U_Loop; -- End loop through units for one ALI file @@ -1457,7 +1607,10 @@ package body ALI is -- Scan out external version references and put in hash table - while C = 'E' loop + E_Loop : loop + Check_Unknown_Line; + exit E_Loop when C /= 'E'; + if Ignore ('E') then Skip_Line; @@ -1483,13 +1636,16 @@ package body ALI is end if; C := Getc; - end loop; + end loop E_Loop; -- Scan out source dependency lines for this ALI file ALIs.Table (Id).First_Sdep := Sdep.Last + 1; - while C = 'D' loop + D_Loop : loop + Check_Unknown_Line; + exit D_Loop when C /= 'D'; + if Ignore ('D') then Skip_Line; @@ -1585,13 +1741,19 @@ package body ALI is end if; C := Getc; - end loop; + end loop D_Loop; ALIs.Table (Id).Last_Sdep := Sdep.Last; -- We must at this stage be at an Xref line or the end of file - if C /= EOF and then C /= 'X' then + if C = EOF then + return Id; + end if; + + Check_Unknown_Line; + + if C /= 'X' then Fatal_Error; end if; @@ -1604,7 +1766,9 @@ package body ALI is -- Loop through Xref sections - while C = 'X' loop + X_Loop : loop + Check_Unknown_Line; + exit X_Loop when C /= 'X'; -- Make new entry in section table @@ -1864,7 +2028,7 @@ package body ALI is end Read_Refs_For_One_File; C := Getc; - end loop; + end loop X_Loop; -- Here after dealing with xref sections diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 7fbf1a48e78..f789b0c3581 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -808,13 +808,14 @@ package ALI is -- Initialize the ALI tables. Also resets all switch values to defaults. function Scan_ALI - (F : File_Name_Type; - T : Text_Buffer_Ptr; - Ignore_ED : Boolean; - Err : Boolean; - Read_Xref : Boolean := False; - Read_Lines : String := ""; - Ignore_Lines : String := "X") return ALI_Id; + (F : File_Name_Type; + T : Text_Buffer_Ptr; + Ignore_ED : Boolean; + Err : Boolean; + Read_Xref : Boolean := False; + Read_Lines : String := ""; + Ignore_Lines : String := "X"; + Ignore_Errors : Boolean := False) return ALI_Id; -- Given the text, T, of an ALI file, F, scan and store the information -- from the file, and return the Id of the resulting entry in the ALI -- table. Switch settings may be modified as described above in the @@ -854,5 +855,12 @@ package ALI is -- Ignore_Lines and Read_Lines parameters are ignored (i.e. the -- use of True for Read_XREF is equivalent to specifying an -- argument of "UWDX" for Read_Lines. + -- + -- Ignore_Errors is normally False. If it is set True, then Scan_ALI + -- will do its best to scan through a file and extract all information + -- it can, even if there are errors. In this case Err is only set if + -- Scan_ALI was completely unable to process the file (e.g. it did not + -- look like an ALI file at all). Ignore_Errors is intended to improve + -- the downward compatibility of new compilers with old tools. end ALI; diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index ff534ba8d13..e2a5c7ae6eb 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -424,7 +424,7 @@ package body Bcheck is if not Restriction_File_Output then Restriction_File_Output := True; - -- Find the ali file specifying the restriction + -- Find an ali file specifying the restriction for A in ALIs.First .. ALIs.Last loop if ALIs.Table (A).Restrictions.Set (R) @@ -463,6 +463,7 @@ package body Bcheck is Consistency_Error_Msg (M2 (1 .. P - 1)); Consistency_Error_Msg ("but the following files violate this restriction:"); + return; end; end if; end loop; @@ -491,38 +492,50 @@ package body Bcheck is -- Loop through files looking for violators for A2 in ALIs.First .. ALIs.Last loop - if ALIs.Table (A2).Restrictions.Violated (R) then + declare + T : ALIs_Record renames ALIs.Table (A2); - -- We exclude predefined files from the list of - -- violators. This should be rethought. It is not - -- clear that this is the right thing to do, that - -- is particularly the case for restricted runtimes. + begin + if T.Restrictions.Violated (R) then - if not Is_Internal_File_Name (ALIs.Table (A2).Sfile) then - Print_Restriction_File (R); + -- We exclude predefined files from the list of + -- violators. This should be rethought. It is not + -- clear that this is the right thing to do, that + -- is particularly the case for restricted runtimes. - Error_Msg_Name_1 := ALIs.Table (A2).Sfile; + if not Is_Internal_File_Name (T.Sfile) then - if R in All_Boolean_Restrictions then - Consistency_Error_Msg (" %"); + -- Case of Boolean restriction, just print file name - elsif R in Checked_Add_Parameter_Restrictions - or else ALIs.Table (A2).Restrictions.Count (R) > - Cumulative_Restrictions.Value (R) - then - Error_Msg_Nat_1 := - Int (ALIs.Table (A2).Restrictions.Count (R)); + if R in All_Boolean_Restrictions then + Print_Restriction_File (R); + Error_Msg_Name_1 := T.Sfile; + Consistency_Error_Msg (" %"); - if ALIs.Table (A2).Restrictions.Unknown (R) then - Consistency_Error_Msg - (" % (count = at least #)"); - else - Consistency_Error_Msg - (" % (count = #)"); + -- Case of Parameter restriction where violation + -- count exceeds restriction value, print file + -- name and count, adding "at least" if the + -- exact count is not known. + + elsif R in Checked_Add_Parameter_Restrictions + or else T.Restrictions.Count (R) > + Cumulative_Restrictions.Value (R) + then + Print_Restriction_File (R); + Error_Msg_Name_1 := T.Sfile; + Error_Msg_Nat_1 := Int (T.Restrictions.Count (R)); + + if T.Restrictions.Unknown (R) then + Consistency_Error_Msg + (" % (count = at least #)"); + else + Consistency_Error_Msg + (" % (count = #)"); + end if; end if; end if; end if; - end if; + end; end loop; end if; end loop; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 3c6a67f5ac0..85f58ce64e3 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -142,7 +142,7 @@ package body Debug is -- df -- dg -- dh - -- di + -- di Ignore_Errors mode for reading ali files -- dj -- dk -- dl @@ -474,7 +474,6 @@ package body Debug is -- fully compiled and analyzed, they just get eliminated from the -- code generation step. - -- d1 Error messages have node numbers where possible. Normally error -- messages have only source locations. This option is useful when -- debugging errors caused by expanded code, where the source location @@ -528,6 +527,12 @@ package body Debug is -- dependencies) except that internal units are included in the -- listing. + -- di Normally gnatbind calls Read_Ali with Ignore_Errors set to + -- False, since the binder really needs correct version ALI + -- files to do its job. This debug flag causes Ignore_Errors + -- mode to be set for the binder (and is particularly useful + -- for testing ignore errors mode). + -- dn List details of manipulation of Num_Pred values during execution of -- the algorithm used to determine a correct order of elaboration. This -- is useful in diagnosing any problems in its behavior. diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index fb1cc76909a..4ae1d6b70ac 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -164,10 +164,9 @@ package body Errout is -- example, the entity A.B.C.D will output B.C. if N = 2. function Special_Msg_Delete - (Msg : String; - N : Node_Or_Entity_Id; - E : Node_Or_Entity_Id) - return Boolean; + (Msg : String; + N : Node_Or_Entity_Id; + E : Node_Or_Entity_Id) return Boolean; -- This function is called from Error_Msg_NEL, passing the message Msg, -- node N on which the error is to be posted, and the entity or node E -- to be used for an & insertion in the message if any. The job of this @@ -1795,6 +1794,8 @@ package body Errout is ---------------------------- procedure Set_Msg_Insertion_Node is + K : Node_Kind; + begin Suppress_Message := Error_Msg_Node_1 = Error @@ -1815,11 +1816,25 @@ package body Errout is else Set_Msg_Blank_Conditional; - -- Skip quotes for operator case + -- Output name - if Nkind (Error_Msg_Node_1) in N_Op then + K := Nkind (Error_Msg_Node_1); + + -- If we have operator case, skip quotes since name of operator + -- itself will supply the required quotations. An operator can be + -- an applied use in an expression or an explicit operator symbol, + -- or an identifier whose name indicates it is an operator. + + if K in N_Op + or else K = N_Operator_Symbol + or else K = N_Defining_Operator_Symbol + or else ((K = N_Identifier or else K = N_Defining_Identifier) + and then Is_Operator_Name (Chars (Error_Msg_Node_1))) + then Set_Msg_Node (Error_Msg_Node_1); + -- Normal case, not an operator, surround with quotes + else Set_Msg_Quote; Set_Qualification (Error_Msg_Qual_Level, Error_Msg_Node_1); @@ -2302,10 +2317,9 @@ package body Errout is ------------------------ function Special_Msg_Delete - (Msg : String; - N : Node_Or_Entity_Id; - E : Node_Or_Entity_Id) - return Boolean + (Msg : String; + N : Node_Or_Entity_Id; + E : Node_Or_Entity_Id) return Boolean is begin -- Never delete messages in -gnatdO mode diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 55d90516215..92295eb8102 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -90,8 +90,7 @@ package body Exp_Ch3 is function Build_Discriminant_Formals (Rec_Id : Entity_Id; - Use_Dl : Boolean) - return List_Id; + Use_Dl : Boolean) return List_Id; -- This function uses the discriminants of a type to build a list of -- formal parameters, used in the following function. If the flag Use_Dl -- is set, the list is built using the already defined discriminals @@ -246,8 +245,7 @@ package body Exp_Ch3 is Name : Name_Id; Profile : List_Id; Ret_Type : Entity_Id := Empty; - For_Body : Boolean := False) - return Node_Id; + For_Body : Boolean := False) return Node_Id; -- This function generates the appropriate expansion for a predefined -- primitive operation specified by its name, parameter profile and -- return type (Empty means this is a procedure). If For_Body is false, @@ -259,8 +257,7 @@ package body Exp_Ch3 is (Loc : Source_Ptr; Tag_Typ : Entity_Id; Name : TSS_Name_Type; - For_Body : Boolean := False) - return Node_Id; + For_Body : Boolean := False) return Node_Id; -- Specialized version of Predef_Spec_Or_Body that apply to read, write, -- input and output attribute whose specs are constructed in Exp_Strm. @@ -268,15 +265,13 @@ package body Exp_Ch3 is (Loc : Source_Ptr; Tag_Typ : Entity_Id; Name : TSS_Name_Type; - For_Body : Boolean := False) - return Node_Id; + For_Body : Boolean := False) return Node_Id; -- Specialized version of Predef_Spec_Or_Body that apply to _deep_adjust -- and _deep_finalize function Predefined_Primitive_Bodies (Tag_Typ : Entity_Id; - Renamed_Eq : Node_Id) - return List_Id; + Renamed_Eq : Node_Id) return List_Id; -- Create the bodies of the predefined primitives that are described in -- Predefined_Primitive_Specs. When not empty, Renamed_Eq must denote -- the defining unit name of the type's predefined equality as returned @@ -721,8 +716,7 @@ package body Exp_Ch3 is function Build_Case_Statement (Case_Id : Entity_Id; - Variant : Node_Id) - return Node_Id; + Variant : Node_Id) return Node_Id; -- Build a case statement containing only two alternatives. The -- first alternative corresponds exactly to the discrete choices -- given on the variant with contains the components that we are @@ -732,8 +726,7 @@ package body Exp_Ch3 is function Build_Dcheck_Function (Case_Id : Entity_Id; - Variant : Node_Id) - return Entity_Id; + Variant : Node_Id) return Entity_Id; -- Build the discriminant checking function for a given variant procedure Build_Dcheck_Functions (Variant_Part_Node : Node_Id); @@ -746,8 +739,7 @@ package body Exp_Ch3 is function Build_Case_Statement (Case_Id : Entity_Id; - Variant : Node_Id) - return Node_Id + Variant : Node_Id) return Node_Id is Alt_List : constant List_Id := New_List; Actuals_List : List_Id; @@ -834,8 +826,7 @@ package body Exp_Ch3 is function Build_Dcheck_Function (Case_Id : Entity_Id; - Variant : Node_Id) - return Entity_Id + Variant : Node_Id) return Entity_Id is Body_Node : Node_Id; Func_Id : Entity_Id; @@ -972,8 +963,7 @@ package body Exp_Ch3 is function Build_Discriminant_Formals (Rec_Id : Entity_Id; - Use_Dl : Boolean) - return List_Id + Use_Dl : Boolean) return List_Id is Loc : Source_Ptr := Sloc (Rec_Id); Parameter_List : constant List_Id := New_List; @@ -1046,8 +1036,7 @@ package body Exp_Ch3 is In_Init_Proc : Boolean := False; Enclos_Type : Entity_Id := Empty; Discr_Map : Elist_Id := New_Elmt_List; - With_Default_Init : Boolean := False) - return List_Id + With_Default_Init : Boolean := False) return List_Id is First_Arg : Node_Id; Args : List_Id; @@ -1374,9 +1363,7 @@ package body Exp_Ch3 is -- components of the given component list. This may involve building -- case statements for the variant parts. - function Build_Init_Call_Thru - (Parameters : List_Id) - return List_Id; + function Build_Init_Call_Thru (Parameters : List_Id) return List_Id; -- Given a non-tagged type-derivation that declares discriminants, -- such as -- @@ -1404,8 +1391,7 @@ package body Exp_Ch3 is -- to which the check actions are appended. function Component_Needs_Simple_Initialization - (T : Entity_Id) - return Boolean; + (T : Entity_Id) return Boolean; -- Determines if a component needs simple initialization, given its -- type T. This is the same as Needs_Simple_Initialization except -- for the following differences. The types Tag and Vtable_Ptr, @@ -1597,18 +1583,15 @@ package body Exp_Ch3 is -- Build_Init_Call_Thru -- -------------------------- - function Build_Init_Call_Thru - (Parameters : List_Id) - return List_Id - is - Parent_Proc : constant Entity_Id := - Base_Init_Proc (Etype (Rec_Type)); + function Build_Init_Call_Thru (Parameters : List_Id) return List_Id is + Parent_Proc : constant Entity_Id := + Base_Init_Proc (Etype (Rec_Type)); - Parent_Type : constant Entity_Id := - Etype (First_Formal (Parent_Proc)); + Parent_Type : constant Entity_Id := + Etype (First_Formal (Parent_Proc)); - Uparent_Type : constant Entity_Id := - Underlying_Type (Parent_Type); + Uparent_Type : constant Entity_Id := + Underlying_Type (Parent_Type); First_Discr_Param : Node_Id; @@ -2184,8 +2167,7 @@ package body Exp_Ch3 is ------------------------------------------- function Component_Needs_Simple_Initialization - (T : Entity_Id) - return Boolean + (T : Entity_Id) return Boolean is begin return @@ -4755,9 +4737,8 @@ package body Exp_Ch3 is ------------------------- function Get_Simple_Init_Val - (T : Entity_Id; - Loc : Source_Ptr) - return Node_Id + (T : Entity_Id; + Loc : Source_Ptr) return Node_Id is Val : Node_Id; Typ : Node_Id; @@ -5478,8 +5459,7 @@ package body Exp_Ch3 is (Loc : Source_Ptr; Tag_Typ : Entity_Id; Name : TSS_Name_Type; - For_Body : Boolean := False) - return Node_Id + For_Body : Boolean := False) return Node_Id is Prof : List_Id; Type_B : Entity_Id; @@ -5533,8 +5513,7 @@ package body Exp_Ch3 is Name : Name_Id; Profile : List_Id; Ret_Type : Entity_Id := Empty; - For_Body : Boolean := False) - return Node_Id + For_Body : Boolean := False) return Node_Id is Id : constant Entity_Id := Make_Defining_Identifier (Loc, Name); Spec : Node_Id; @@ -5604,8 +5583,7 @@ package body Exp_Ch3 is (Loc : Source_Ptr; Tag_Typ : Entity_Id; Name : TSS_Name_Type; - For_Body : Boolean := False) - return Node_Id + For_Body : Boolean := False) return Node_Id is Ret_Type : Entity_Id; @@ -5630,8 +5608,7 @@ package body Exp_Ch3 is function Predefined_Primitive_Bodies (Tag_Typ : Entity_Id; - Renamed_Eq : Node_Id) - return List_Id + Renamed_Eq : Node_Id) return List_Id is Loc : constant Source_Ptr := Sloc (Tag_Typ); Res : constant List_Id := New_List; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 1f2640d2206..b1764174e45 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -98,8 +98,7 @@ package body Exp_Ch4 is A_Typ : Entity_Id; Lhs : Node_Id; Rhs : Node_Id; - Bodies : List_Id) - return Node_Id; + Bodies : List_Id) return Node_Id; -- Expand an array equality into a call to a function implementing this -- equality, and a call to it. Loc is the location for the generated -- nodes. Typ is the type of the array, and Lhs, Rhs are the array @@ -119,8 +118,7 @@ package body Exp_Ch4 is Typ : Entity_Id; Lhs : Node_Id; Rhs : Node_Id; - Bodies : List_Id) - return Node_Id; + Bodies : List_Id) return Node_Id; -- Local recursive function used to expand equality for nested -- composite types. Used by Expand_Record/Array_Equality, Bodies -- is a list on which to attach bodies of local functions that are @@ -150,8 +148,7 @@ package body Exp_Ch4 is function Get_Allocator_Final_List (N : Node_Id; T : Entity_Id; - PtrT : Entity_Id) - return Entity_Id; + PtrT : Entity_Id) return Entity_Id; -- If the designated type is controlled, build final_list expression -- for created object. If context is an access parameter, create a -- local access type to have a usable finalization list. @@ -161,9 +158,8 @@ package body Exp_Ch4 is -- from Checked_Pool, expands a call to the primitive 'dereference'. function Make_Array_Comparison_Op - (Typ : Entity_Id; - Nod : Node_Id) - return Node_Id; + (Typ : Entity_Id; + Nod : Node_Id) return Node_Id; -- Comparisons between arrays are expanded in line. This function -- produces the body of the implementation of (a > b), where a and b -- are one-dimensional arrays of some discrete type. The original @@ -171,9 +167,8 @@ package body Exp_Ch4 is -- Nod provides the Sloc value for the generated code. function Make_Boolean_Array_Op - (Typ : Entity_Id; - N : Node_Id) - return Node_Id; + (Typ : Entity_Id; + N : Node_Id) return Node_Id; -- Boolean operations on boolean arrays are expanded in line. This -- function produce the body for the node N, which is (a and b), -- (a or b), or (a xor b). It is used only the normal case and not @@ -193,10 +188,9 @@ package body Exp_Ch4 is -- Deals with a second operand being (or not) a class-wide type. function Safe_In_Place_Array_Op - (Lhs : Node_Id; - Op1 : Node_Id; - Op2 : Node_Id) - return Boolean; + (Lhs : Node_Id; + Op1 : Node_Id; + Op2 : Node_Id) return Boolean; -- In the context of an assignment, where the right-hand side is a -- boolean operation on arrays, check whether operation can be performed -- in place. @@ -913,8 +907,7 @@ package body Exp_Ch4 is A_Typ : Entity_Id; Lhs : Node_Id; Rhs : Node_Id; - Bodies : List_Id) - return Node_Id + Bodies : List_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Nod); Decls : constant List_Id := New_List; @@ -932,8 +925,7 @@ package body Exp_Ch4 is function Arr_Attr (Arr : Entity_Id; Nam : Name_Id; - Num : Int) - return Node_Id; + Num : Int) return Node_Id; -- This builds the attribute reference Arr'Nam (Expr). function Component_Equality (Typ : Entity_Id) return Node_Id; @@ -942,8 +934,7 @@ package body Exp_Ch4 is function Handle_One_Dimension (N : Int; - Index : Node_Id) - return Node_Id; + Index : Node_Id) return Node_Id; -- This procedure returns a declare block: -- -- declare @@ -990,8 +981,7 @@ package body Exp_Ch4 is function Arr_Attr (Arr : Entity_Id; Nam : Name_Id; - Num : Int) - return Node_Id + Num : Int) return Node_Id is begin return @@ -1039,8 +1029,7 @@ package body Exp_Ch4 is function Handle_One_Dimension (N : Int; - Index : Node_Id) - return Node_Id + Index : Node_Id) return Node_Id is An : constant Entity_Id := Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('A')); @@ -1337,8 +1326,7 @@ package body Exp_Ch4 is Typ : Entity_Id; Lhs : Node_Id; Rhs : Node_Id; - Bodies : List_Id) - return Node_Id + Bodies : List_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Nod); Full_Type : Entity_Id; @@ -2841,10 +2829,9 @@ package body Exp_Ch4 is Check_Subscripts : declare function Construct_Attribute_Reference - (E : Node_Id; - Nam : Name_Id; - Dim : Nat) - return Node_Id; + (E : Node_Id; + Nam : Name_Id; + Dim : Nat) return Node_Id; -- Build attribute reference E'Nam(Dim) ----------------------------------- @@ -2852,10 +2839,9 @@ package body Exp_Ch4 is ----------------------------------- function Construct_Attribute_Reference - (E : Node_Id; - Nam : Name_Id; - Dim : Nat) - return Node_Id + (E : Node_Id; + Nam : Name_Id; + Dim : Nat) return Node_Id is begin return @@ -3710,13 +3696,23 @@ package body Exp_Ch4 is and then Is_Derived_Type (A_Typ) and then No (Full_View (A_Typ)) then + -- Search for equality operation, checking that the + -- operands have the same type. Note that we must find + -- a matching entry, or something is very wrong! + Prim := First_Elmt (Collect_Primitive_Operations (A_Typ)); - while Chars (Node (Prim)) /= Name_Op_Eq loop + while Present (Prim) loop + exit when Chars (Node (Prim)) = Name_Op_Eq + and then Etype (First_Formal (Node (Prim))) = + Etype (Next_Formal (First_Formal (Node (Prim)))) + and then + Base_Type (Etype (Node (Prim))) = Standard_Boolean; + Next_Elmt (Prim); - pragma Assert (Present (Prim)); end loop; + pragma Assert (Present (Prim)); Op_Name := Node (Prim); -- Find the type's predefined equality or an overriding @@ -3741,9 +3737,9 @@ package body Exp_Ch4 is Base_Type (Etype (Node (Prim))) = Standard_Boolean; Next_Elmt (Prim); - pragma Assert (Present (Prim)); end loop; + pragma Assert (Present (Prim)); Op_Name := Node (Prim); end if; @@ -6340,8 +6336,7 @@ package body Exp_Ch4 is Typ : Entity_Id; Lhs : Node_Id; Rhs : Node_Id; - Bodies : List_Id) - return Node_Id + Bodies : List_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Nod); @@ -6496,8 +6491,7 @@ package body Exp_Ch4 is function Get_Allocator_Final_List (N : Node_Id; T : Entity_Id; - PtrT : Entity_Id) - return Entity_Id + PtrT : Entity_Id) return Entity_Id is Loc : constant Source_Ptr := Sloc (N); Acc : Entity_Id; @@ -6540,7 +6534,11 @@ package body Exp_Ch4 is Pool : constant Entity_Id := Associated_Storage_Pool (Typ); function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean; - -- return true if type of P is derived from Checked_Pool; + -- Return true if type of P is derived from Checked_Pool; + + ----------------------------- + -- Is_Checked_Storage_Pool -- + ----------------------------- function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean is T : Entity_Id; @@ -6662,9 +6660,8 @@ package body Exp_Ch4 is -- instantiated function itself. function Make_Array_Comparison_Op - (Typ : Entity_Id; - Nod : Node_Id) - return Node_Id + (Typ : Entity_Id; + Nod : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Nod); @@ -6897,9 +6894,8 @@ package body Exp_Ch4 is -- Here typ is the boolean array type function Make_Boolean_Array_Op - (Typ : Entity_Id; - N : Node_Id) - return Node_Id + (Typ : Entity_Id; + N : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (N); @@ -7069,10 +7065,9 @@ package body Exp_Ch4 is ---------------------------- function Safe_In_Place_Array_Op - (Lhs : Node_Id; - Op1 : Node_Id; - Op2 : Node_Id) - return Boolean + (Lhs : Node_Id; + Op1 : Node_Id; + Op2 : Node_Id) return Boolean is Target : Entity_Id; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7632e29e0b7..744a0242b19 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -596,6 +596,10 @@ package body Exp_Ch6 is Init := Convert_To (Etype (Formal), New_Occurrence_Of (Var, Loc)); end if; + + elsif Ekind (Formal) = E_In_Parameter then + Init := New_Occurrence_Of (Var, Loc); + else Init := Empty; end if; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 8e2f2a3e1f7..e55f98776d1 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3369,7 +3369,7 @@ package body Exp_Ch9 is Set_Scope (Func, Scope (Prot)); else - Analyze (Cond); + Analyze_And_Resolve (Cond, Any_Boolean); end if; -- The Ravenscar profile restricts barriers to simple variables diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index e4af0c39de4..cb5c69520e8 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -34,6 +34,7 @@ with Bindusg; with Butil; use Butil; with Casing; use Casing; with Csets; +with Debug; use Debug; with Fmap; with Gnatvsn; use Gnatvsn; with Namet; use Namet; @@ -532,10 +533,11 @@ begin begin Id := Scan_ALI - (F => Main_Lib_File, - T => Text, - Ignore_ED => Force_RM_Elaboration_Order, - Err => False); + (F => Main_Lib_File, + T => Text, + Ignore_ED => Force_RM_Elaboration_Order, + Err => False, + Ignore_Errors => Debug_Flag_I); end; Free (Text); @@ -576,10 +578,11 @@ begin begin Id := Scan_ALI - (F => Std_Lib_File, - T => Text, - Ignore_ED => Force_RM_Elaboration_Order, - Err => False); + (F => Std_Lib_File, + T => Text, + Ignore_ED => Force_RM_Elaboration_Order, + Err => False, + Ignore_Errors => Debug_Flag_I); end; Free (Text); diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 9388fe4a82e..bb65a0f95a6 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1409,9 +1409,17 @@ begin T := Read_Library_Info (F, True); - -- Read it + -- Read it. Note that we ignore errors, since we only want very + -- limited information from the ali file, and likely a slightly + -- wrong version will be just fine, though in normal operation + -- we don't expect this to happen! - A := Scan_ALI (F, T, Ignore_ED => False, Err => False); + A := Scan_ALI + (F, + T, + Ignore_ED => False, + Err => False, + Ignore_Errors => True); if A /= No_ALI_Id then for diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index d1f8d9a13c1..2f5d3155ca3 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -943,7 +943,11 @@ begin begin Discard := Scan_ALI - (Ali_File, Text, Ignore_ED => False, Err => False); + (Ali_File, + Text, + Ignore_ED => False, + Err => False, + Ignore_Errors => True); end; Free (Text); diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index fbb50af0800..212c465c733 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -55,8 +55,7 @@ package body Lib.Load is function Spec_Is_Irrelevant (Spec_Unit : Unit_Number_Type; - Body_Unit : Unit_Number_Type) - return Boolean; + Body_Unit : Unit_Number_Type) return Boolean; -- The Spec_Unit and Body_Unit parameters are the unit numbers of the -- spec file that corresponds to the main unit which is a body. This -- function determines if the spec file is irrelevant and will be @@ -73,8 +72,7 @@ package body Lib.Load is function Create_Dummy_Package_Unit (With_Node : Node_Id; - Spec_Name : Unit_Name_Type) - return Unit_Number_Type + Spec_Name : Unit_Name_Type) return Unit_Number_Type is Unum : Unit_Number_Type; Cunit_Entity : Entity_Id; @@ -100,9 +98,6 @@ package body Lib.Load is -- Child package else - - -- Nkind (Name (With_Node)) = N_Expanded_Name - Cunit_Entity := Make_Defining_Identifier (No_Location, Chars => Chars (Selector_Name (Name (With_Node)))); @@ -117,7 +112,6 @@ package body Lib.Load is Make_Designator (No_Location, Name => New_Copy_Tree (Prefix (Name (With_Node))), Identifier => New_Occurrence_Of (Cunit_Entity, No_Location)); - end if; Set_Scope (Cunit_Entity, Standard_Standard); @@ -213,7 +207,6 @@ package body Lib.Load is Units.Table (Main_Unit).Unit_File_Name := Fname; if Fname /= No_File then - Main_Source_File := Load_Source_File (Fname); Current_Error_Source_File := Main_Source_File; @@ -249,8 +242,7 @@ package body Lib.Load is Error_Node : Node_Id; Subunit : Boolean; Corr_Body : Unit_Number_Type := No_Unit; - Renamings : Boolean := False) - return Unit_Number_Type + Renamings : Boolean := False) return Unit_Number_Type is Calling_Unit : Unit_Number_Type; Uname_Actual : Unit_Name_Type; @@ -340,14 +332,14 @@ package body Lib.Load is Par := Prefix (Par); end loop; - if Nkind (Par) = N_Selected_Component then - -- some intermediate parent is a renaming. + -- Case of some intermediate parent is a renaming + if Nkind (Par) = N_Selected_Component then Set_Entity (Selector_Name (Par), Cunit_Entity (Unump)); - else - -- the ultimate parent is a renaming. + -- Case where the ultimate parent is a renaming + else Set_Entity (Par, Cunit_Entity (Unump)); end if; end; @@ -705,11 +697,11 @@ package body Lib.Load is function Spec_Is_Irrelevant (Spec_Unit : Unit_Number_Type; - Body_Unit : Unit_Number_Type) - return Boolean + Body_Unit : Unit_Number_Type) return Boolean is Sunit : constant Node_Id := Cunit (Spec_Unit); Bunit : constant Node_Id := Cunit (Body_Unit); + begin -- The spec is irrelevant if the body is a subprogram body, and the -- spec is other than a subprogram spec or generic subprogram spec. diff --git a/gcc/ada/lib-load.ads b/gcc/ada/lib-load.ads index 36e7e06622e..662fe8f2e72 100644 --- a/gcc/ada/lib-load.ads +++ b/gcc/ada/lib-load.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -109,8 +109,7 @@ package Lib.Load is Error_Node : Node_Id; Subunit : Boolean; Corr_Body : Unit_Number_Type := No_Unit; - Renamings : Boolean := False) - return Unit_Number_Type; + Renamings : Boolean := False) return Unit_Number_Type; -- This function loads and parses the unit specified by Load_Name (or -- returns the unit number for the previously constructed units table -- entry if this is not the first call for this unit). Required indicates @@ -151,8 +150,7 @@ package Lib.Load is function Create_Dummy_Package_Unit (With_Node : Node_Id; - Spec_Name : Unit_Name_Type) - return Unit_Number_Type; + Spec_Name : Unit_Name_Type) return Unit_Number_Type; -- With_Node is the Node_Id of a with statement for which the file could -- not be found, and Spec_Name is the corresponding unit name. This call -- creates a dummy package unit so that compilation can continue without diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 2165505481c..4d0c29778d7 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -923,11 +923,13 @@ package body Lib.Writ is end if; end loop; - -- Output first restrictions line + -- Output restrictions line Write_Info_Initiate ('R'); Write_Info_Char (' '); + -- First the information for the boolean restrictions + for R in All_Boolean_Restrictions loop if Main_Restrictions.Set (R) then Write_Info_Char ('r'); @@ -938,13 +940,12 @@ package body Lib.Writ is end if; end loop; - Write_Info_EOL; + -- A separating space - -- Output second restrictions line - - Write_Info_Initiate ('R'); Write_Info_Char (' '); + -- And now the information for the parameter restrictions + for RP in All_Parameter_Restrictions loop if Main_Restrictions.Set (RP) then Write_Info_Char ('r'); diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index 6aa8dcf97ef..e21112cf6b0 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -32,10 +32,6 @@ package Lib.Writ is -- Format of Library Information -- ----------------------------------- - -- Note: the contents of the ali file are summarized in the GNAT - -- user's guide, so if any non-trivial changes are made to this - -- section, they should be reflected in the user's guide. - -- This section describes the format of the library information that is -- associated with object files. The exact method of this association is -- potentially implementation dependent and is described and implemented @@ -50,6 +46,48 @@ package Lib.Writ is -- Key_Character parameter parameter ... + -- The following sections describe the format of these lines in detail + + -------------------------------------- + -- Making Changes to the ALI Format -- + -------------------------------------- + + -- A number of tools use ali.adb to parse ali files. This means + -- that changes to this format can cause old versions of these tools + -- to be incompatible with new versions of the compiler. Any changes + -- to ali file formats must be carefully evaluated to understand any + -- such possible conflicts, and in particular, it is very undesirable + -- to create conflicts between older versions of GPS and newer versions + -- of the compiler. + + -- If the following guidelines are respected, downward compatibility + -- problems (old tools reading new ali files) should be minimized: + + -- The basic key character format must be kept. + + -- The V line must be the first line, this is checked by ali.adb + -- even in Ignore_Errors mode, and is used to verify that the file + -- at hand is indeed likely intended to be an ali file. + + -- The P line must be present, though may be modified in contents + -- according to remaining guidelines. Again, ali.adb assumes the + -- P line is present even in Ignore_Errors mode. + + -- New modifiers can generally be added (in particular adding new + -- two letter modifiers to the P or U lines is always safe) + + -- Adding entirely new lines (with a new key letter) to the ali + -- file is always safe, at any point (other than before the V + -- line), since suchy lines will be ignored. + + -- Following the guidelines in this section should ensure that this + -- problem is minimized and that old tools will be able to deal + -- successfully with new ali formats. Note that this does not apply + -- to the compiler itself, which always requires consistency between + -- the ali files and the binder. That is because one of the main + -- functions of the binder is to ensure consistency of the partition, + -- and this can be compromised if the ali files are inconsistent. + ------------------ -- Header Lines -- ------------------ @@ -72,6 +110,10 @@ package Lib.Writ is -- library info described in this package, or modifications to -- calling sequences, or to the way that data is represented. + -- Note: the V line absolutely must be the first line, and no change + -- to the ALI format should change this, since even in Ignore_Errors + -- mode, Scan_ALI insists on finding a V line. + -- --------------------- -- -- M Main Program -- -- --------------------- @@ -201,21 +243,26 @@ package Lib.Writ is -- possible cases. These values are checked for consistency by the -- binder and then copied to the generated binder output file. + -- Note: The P line must be present. Even in Ignore_Errors mode, + -- Scan_ALI insists on finding a P line. So if changes are made to + -- the ALI format, they should not include removing the P line! + -- --------------------- -- -- R Restrictions -- -- --------------------- - -- Two lines are generated to record the status of restrictions that can - -- be specified by pragma Restrictions. The first of these lines refers - -- to Restriction_Id values: + -- The R line records the status of restrictions generated by pragma + -- Restrictions encountered, as well as information on what the compiler + -- has been able to determine with respect to restrictions violations. + -- The format is: - -- R <> + -- R <> space <> - -- This line records information regarding restrictions that do - -- not take parameter values. Here "restriction-characters is a - -- string of characters, one for each value (in order) defined - -- in Restrict.All_Boolean_Restrictions. There are three possible - -- settings for each restriction: + -- The first parameter is a string of characters that records + -- information regarding restrictions that do not take parameter + -- not take parameter values. It is a string of characters, one + -- character for each value (in order) in All_Boolean_Restrictions. + -- There are three possible settings for each restriction: -- r Restricted. Unit was compiled under control of a pragma -- Restrictions for the corresponding restriction. In @@ -236,9 +283,8 @@ package Lib.Writ is -- has "v", which is not permitted, since these restrictions -- are partition-wide. - -- The second R line refers to parameter restrictions: - - -- R <> + -- Following a space, the second parameter refers to restriction + -- identifiers for which a parameter is given. -- The parameter is a string of entries, one for each value in -- Restrict.All_Parameter_Restrictions. Each entry has two @@ -284,9 +330,14 @@ package Lib.Writ is -- vN+ A violation was detected. The compiler cannot determine -- the exact count of violations, but it is at least N. - -- There are no spaces in the line, so the entry for the example - -- in the header of this section for Max_Tasks would appear as - -- the string r4v3. + -- There are no spaces within the parameter string, so the entry + -- described above in the header of this section for Max_Tasks would + -- appear as the string r4v3. + + -- Note: The restrictions line is required to be present. Even in + -- Ignore_Errors mode, Scan_ALI expects to find an R line and will + -- signal a fatal error if it is missing. This means that future + -- changes to the ALI file format must retain the R line. -- ------------------------ -- -- I Interrupt States -- diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index f99af5ff299..1b1af12e77d 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -905,6 +905,18 @@ package body Namet is and then C /= 'X'; end Is_OK_Internal_Letter; + ---------------------- + -- Is_Operator_Name -- + ---------------------- + + function Is_Operator_Name (Id : Name_Id) return Boolean is + S : Int; + begin + pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); + S := Name_Entries.Table (Id).Name_Chars_Index; + return Name_Chars.Table (S + 1) = 'O'; + end Is_Operator_Name; + -------------------- -- Length_Of_Name -- -------------------- diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 4fd0120da8a..1858968200b 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -204,6 +204,10 @@ package Namet is pragma Inline (Get_Name_Table_Info); -- Fetches the Int value associated with the given name + function Is_Operator_Name (Id : Name_Id) return Boolean; + -- Returns True if name given is of the form of an operator (that + -- is, it starts with an upper case O). + procedure Initialize; -- Initializes the names table, including initializing the first 26 -- entries in the table (for the 1-character lower case names a-z) diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index 163fb0b13e8..3910a107351 100644 --- a/gcc/ada/par-load.adb +++ b/gcc/ada/par-load.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -89,16 +89,18 @@ procedure Load is function Same_File_Name_Except_For_Case (Expected_File_Name : File_Name_Type; - Actual_File_Name : File_Name_Type) - return Boolean; + Actual_File_Name : File_Name_Type) return Boolean; -- Given an actual file name and an expected file name (the latter being -- derived from the unit name), determine if they are the same except for -- possibly different casing of letters. + ------------------------------------ + -- Same_File_Name_Except_For_Case -- + ------------------------------------ + function Same_File_Name_Except_For_Case (Expected_File_Name : File_Name_Type; - Actual_File_Name : File_Name_Type) - return Boolean + Actual_File_Name : File_Name_Type) return Boolean is begin Get_Name_String (Actual_File_Name); diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 19eefc42047..24e44c8aec1 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -951,6 +951,7 @@ begin Pragma_Persistent_Object | Pragma_Preelaborate | Pragma_Priority | + Pragma_Profile | Pragma_Propagate_Exceptions | Pragma_Psect_Object | Pragma_Pure | diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 0a44a2da090..31b2a4aa6a1 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -756,7 +756,6 @@ package body Sem_Ch8 is else Error_Msg_N ("expect object name in renaming", Nam); end if; - end if; Set_Etype (Id, T2); @@ -1179,10 +1178,49 @@ package body Sem_Ch8 is Old_S := Entity (Nam); New_S := Analyze_Subprogram_Specification (Spec); - if Ekind (Entity (Nam)) = E_Operator - and then Box_Present (Inst_Node) - then - Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual); + -- Operator case + + if Ekind (Entity (Nam)) = E_Operator then + + -- Box present + + if Box_Present (Inst_Node) then + Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual); + + -- If there is an immediately visible homonym of the operator + -- and the declaration has a default, this is worth a warning + -- because the user probably did not intend to get the pre- + -- defined operator, visible in the generic declaration. + -- To find if there is an intended candidate, analyze the + -- renaming again in the current context. + + elsif Scope (Old_S) = Standard_Standard + and then Present (Default_Name (Inst_Node)) + then + declare + Decl : constant Node_Id := New_Copy_Tree (N); + Hidden : Entity_Id; + + begin + Set_Entity (Name (Decl), Empty); + Analyze (Name (Decl)); + Hidden := + Find_Renamed_Entity (Decl, Name (Decl), New_S, True); + + if Present (Hidden) + and then In_Open_Scopes (Scope (Hidden)) + and then Is_Immediately_Visible (Hidden) + and then Comes_From_Source (Hidden) + and then Hidden /= Old_S + then + Error_Msg_Sloc := Sloc (Hidden); + Error_Msg_N ("?default subprogram is resolved " & + "in the generic declaration " & + "('R'M 12.6(17))", N); + Error_Msg_NE ("\?and will not use & #", N, Hidden); + end if; + end; + end if; end if; else @@ -2163,9 +2201,8 @@ package body Sem_Ch8 is Elmt : Elmt_Id; function Is_Primitive_Operator - (Op : Entity_Id; - F : Entity_Id) - return Boolean; + (Op : Entity_Id; + F : Entity_Id) return Boolean; -- Check whether Op is a primitive operator of a use-visible type --------------------------- @@ -2173,9 +2210,8 @@ package body Sem_Ch8 is --------------------------- function Is_Primitive_Operator - (Op : Entity_Id; - F : Entity_Id) - return Boolean + (Op : Entity_Id; + F : Entity_Id) return Boolean is T : constant Entity_Id := Etype (F); @@ -4730,10 +4766,8 @@ package body Sem_Ch8 is -- Is_Appropriate_For_Record -- ------------------------------- - function Is_Appropriate_For_Record - (T : Entity_Id) - return Boolean - is + function Is_Appropriate_For_Record (T : Entity_Id) return Boolean is + function Has_Components (T1 : Entity_Id) return Boolean; -- Determine if given type has components (i.e. is either a record -- type or a type that has discriminants). @@ -4968,6 +5002,10 @@ package body Sem_Ch8 is -- Scan context clause of compilation unit to find a with_clause -- for System. + ----------------- + -- Find_System -- + ----------------- + function Find_System (C_Unit : Node_Id) return Entity_Id is With_Clause : Node_Id; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 151721c4ba4..acf7ae1e771 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7724,9 +7724,9 @@ package body Sem_Prag is Set_Is_Preelaborated (Ent); end; - ------------------------ - -- Persistent_Object -- - ------------------------ + ----------------------- + -- Persistent_Object -- + ----------------------- when Pragma_Persistent_Object => declare Decl : Node_Id; @@ -7738,6 +7738,7 @@ package body Sem_Prag is GNAT_Pragma; Check_Arg_Count (1); Check_Arg_Is_Library_Level_Local_Name (Arg1); + if not Is_Entity_Name (Expression (Arg1)) or else (Ekind (Entity (Expression (Arg1))) /= E_Variable @@ -7933,6 +7934,31 @@ package body Sem_Prag is end if; end Priority; + ------------- + -- Profile -- + ------------- + + -- pragma Profile (profile_IDENTIFIER); + + -- profile_IDENTIFIER => Ravenscar + + when Pragma_Profile => + GNAT_Pragma; + Check_Arg_Count (1); + Check_Valid_Configuration_Pragma; + Check_No_Identifiers; + Set_Ravenscar (N); + + declare + Argx : constant Node_Id := Get_Pragma_Arg (Arg1); + begin + if Chars (Argx) = Name_Ravenscar then + Set_Ravenscar (N); + else + Error_Pragma_Arg ("& is not a valid profile", Argx); + end if; + end; + -------------------------- -- Propagate_Exceptions -- -------------------------- @@ -9886,6 +9912,7 @@ package body Sem_Prag is Pragma_Persistent_Object => -1, Pragma_Preelaborate => -1, Pragma_Priority => -1, + Pragma_Profile => 0, Pragma_Propagate_Exceptions => -1, Pragma_Psect_Object => -1, Pragma_Pure => 0, diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 4738620c3e9..52daeecc654 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -173,6 +173,7 @@ package body Snames is "polling#" & "persistent_data#" & "persistent_object#" & + "profile#" & "propagate_exceptions#" & "queuing_policy#" & "ravenscar#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 679cd560514..3f4db225bcb 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -280,6 +280,9 @@ package Snames is -- of these implementation dependent pragmas may be found in the -- appropriate section in unit Sem_Prag in file sem-prag.adb. + -- The entries marked Ada0Y are technically implementation dependent + -- pragmas, but they correspond to standard proposals for Ada 0Y. + -- The entries marked VMS are VMS specific pragmas that are recognized -- only in OpenVMS versions of GNAT. They are ignored in other versions -- with an appropriate warning. @@ -316,31 +319,32 @@ package Snames is Name_Polling : constant Name_Id := N + 113; -- GNAT Name_Persistent_Data : constant Name_Id := N + 114; -- GNAT Name_Persistent_Object : constant Name_Id := N + 115; -- GNAT - Name_Propagate_Exceptions : constant Name_Id := N + 116; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 117; - Name_Ravenscar : constant Name_Id := N + 118; - Name_Restricted_Run_Time : constant Name_Id := N + 119; - Name_Restrictions : constant Name_Id := N + 120; - Name_Restriction_Warnings : constant Name_Id := N + 121; -- GNAT - Name_Reviewable : constant Name_Id := N + 122; - Name_Source_File_Name : constant Name_Id := N + 123; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 124; -- GNAT - Name_Style_Checks : constant Name_Id := N + 125; -- GNAT - Name_Suppress : constant Name_Id := N + 126; - Name_Suppress_Exception_Locations : constant Name_Id := N + 127; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 128; - Name_Universal_Data : constant Name_Id := N + 129; -- AAMP - Name_Unsuppress : constant Name_Id := N + 130; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 131; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 132; -- GNAT - Name_Warnings : constant Name_Id := N + 133; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 133; + Name_Profile : constant Name_Id := N + 116; -- Ada0Y + Name_Propagate_Exceptions : constant Name_Id := N + 117; -- GNAT + Name_Queuing_Policy : constant Name_Id := N + 118; + Name_Ravenscar : constant Name_Id := N + 119; + Name_Restricted_Run_Time : constant Name_Id := N + 120; + Name_Restrictions : constant Name_Id := N + 121; + Name_Restriction_Warnings : constant Name_Id := N + 122; -- GNAT + Name_Reviewable : constant Name_Id := N + 123; + Name_Source_File_Name : constant Name_Id := N + 124; -- GNAT + Name_Source_File_Name_Project : constant Name_Id := N + 125; -- GNAT + Name_Style_Checks : constant Name_Id := N + 126; -- GNAT + Name_Suppress : constant Name_Id := N + 127; + Name_Suppress_Exception_Locations : constant Name_Id := N + 128; -- GNAT + Name_Task_Dispatching_Policy : constant Name_Id := N + 129; + Name_Universal_Data : constant Name_Id := N + 130; -- AAMP + Name_Unsuppress : constant Name_Id := N + 131; -- GNAT + Name_Use_VADS_Size : constant Name_Id := N + 132; -- GNAT + Name_Validity_Checks : constant Name_Id := N + 133; -- GNAT + Name_Warnings : constant Name_Id := N + 134; -- GNAT + Last_Configuration_Pragma_Name : constant Name_Id := N + 134; -- Remaining pragma names - Name_Abort_Defer : constant Name_Id := N + 134; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 135; - Name_Annotate : constant Name_Id := N + 136; -- GNAT + Name_Abort_Defer : constant Name_Id := N + 135; -- GNAT + Name_All_Calls_Remote : constant Name_Id := N + 136; + Name_Annotate : constant Name_Id := N + 137; -- GNAT -- Note: AST_Entry is not in this list because its name matches the -- name of the corresponding attribute. However, it is included in the @@ -348,78 +352,78 @@ package Snames is -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry. -- AST_Entry is a VMS specific pragma. - Name_Assert : constant Name_Id := N + 137; -- GNAT - Name_Asynchronous : constant Name_Id := N + 138; - Name_Atomic : constant Name_Id := N + 139; - Name_Atomic_Components : constant Name_Id := N + 140; - Name_Attach_Handler : constant Name_Id := N + 141; - Name_Comment : constant Name_Id := N + 142; -- GNAT - Name_Common_Object : constant Name_Id := N + 143; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 144; -- GNAT - Name_Controlled : constant Name_Id := N + 145; - Name_Convention : constant Name_Id := N + 146; - Name_CPP_Class : constant Name_Id := N + 147; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 148; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 149; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 150; -- GNAT - Name_Debug : constant Name_Id := N + 151; -- GNAT - Name_Elaborate : constant Name_Id := N + 152; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 153; - Name_Elaborate_Body : constant Name_Id := N + 154; - Name_Export : constant Name_Id := N + 155; - Name_Export_Exception : constant Name_Id := N + 156; -- VMS - Name_Export_Function : constant Name_Id := N + 157; -- GNAT - Name_Export_Object : constant Name_Id := N + 158; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 159; -- GNAT - Name_Export_Value : constant Name_Id := N + 160; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 161; -- GNAT - Name_External : constant Name_Id := N + 162; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 163; -- GNAT - Name_Ident : constant Name_Id := N + 164; -- VMS - Name_Import : constant Name_Id := N + 165; - Name_Import_Exception : constant Name_Id := N + 166; -- VMS - Name_Import_Function : constant Name_Id := N + 167; -- GNAT - Name_Import_Object : constant Name_Id := N + 168; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 169; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 170; -- GNAT - Name_Inline : constant Name_Id := N + 171; - Name_Inline_Always : constant Name_Id := N + 172; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 173; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 174; - Name_Interface : constant Name_Id := N + 175; -- Ada 83 - Name_Interface_Name : constant Name_Id := N + 176; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 177; - Name_Interrupt_Priority : constant Name_Id := N + 178; - Name_Java_Constructor : constant Name_Id := N + 179; -- GNAT - Name_Java_Interface : constant Name_Id := N + 180; -- GNAT - Name_Keep_Names : constant Name_Id := N + 181; -- GNAT - Name_Link_With : constant Name_Id := N + 182; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 183; -- GNAT - Name_Linker_Options : constant Name_Id := N + 184; - Name_Linker_Section : constant Name_Id := N + 185; -- GNAT - Name_List : constant Name_Id := N + 186; - Name_Machine_Attribute : constant Name_Id := N + 187; -- GNAT - Name_Main : constant Name_Id := N + 188; -- GNAT - Name_Main_Storage : constant Name_Id := N + 189; -- GNAT - Name_Memory_Size : constant Name_Id := N + 190; -- Ada 83 - Name_No_Return : constant Name_Id := N + 191; -- GNAT - Name_Obsolescent : constant Name_Id := N + 192; -- GNAT - Name_Optimize : constant Name_Id := N + 193; - Name_Optional_Overriding : constant Name_Id := N + 194; - Name_Overriding : constant Name_Id := N + 195; - Name_Pack : constant Name_Id := N + 196; - Name_Page : constant Name_Id := N + 197; - Name_Passive : constant Name_Id := N + 198; -- GNAT - Name_Preelaborate : constant Name_Id := N + 199; - Name_Priority : constant Name_Id := N + 200; - Name_Psect_Object : constant Name_Id := N + 201; -- VMS - Name_Pure : constant Name_Id := N + 202; - Name_Pure_Function : constant Name_Id := N + 203; -- GNAT - Name_Remote_Call_Interface : constant Name_Id := N + 204; - Name_Remote_Types : constant Name_Id := N + 205; - Name_Share_Generic : constant Name_Id := N + 206; -- GNAT - Name_Shared : constant Name_Id := N + 207; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 208; + Name_Assert : constant Name_Id := N + 138; -- GNAT + Name_Asynchronous : constant Name_Id := N + 139; + Name_Atomic : constant Name_Id := N + 140; + Name_Atomic_Components : constant Name_Id := N + 141; + Name_Attach_Handler : constant Name_Id := N + 142; + Name_Comment : constant Name_Id := N + 143; -- GNAT + Name_Common_Object : constant Name_Id := N + 144; -- GNAT + Name_Complex_Representation : constant Name_Id := N + 145; -- GNAT + Name_Controlled : constant Name_Id := N + 146; + Name_Convention : constant Name_Id := N + 147; + Name_CPP_Class : constant Name_Id := N + 148; -- GNAT + Name_CPP_Constructor : constant Name_Id := N + 149; -- GNAT + Name_CPP_Virtual : constant Name_Id := N + 150; -- GNAT + Name_CPP_Vtable : constant Name_Id := N + 151; -- GNAT + Name_Debug : constant Name_Id := N + 152; -- GNAT + Name_Elaborate : constant Name_Id := N + 153; -- Ada 83 + Name_Elaborate_All : constant Name_Id := N + 154; + Name_Elaborate_Body : constant Name_Id := N + 155; + Name_Export : constant Name_Id := N + 156; + Name_Export_Exception : constant Name_Id := N + 157; -- VMS + Name_Export_Function : constant Name_Id := N + 158; -- GNAT + Name_Export_Object : constant Name_Id := N + 159; -- GNAT + Name_Export_Procedure : constant Name_Id := N + 160; -- GNAT + Name_Export_Value : constant Name_Id := N + 161; -- GNAT + Name_Export_Valued_Procedure : constant Name_Id := N + 162; -- GNAT + Name_External : constant Name_Id := N + 163; -- GNAT + Name_Finalize_Storage_Only : constant Name_Id := N + 164; -- GNAT + Name_Ident : constant Name_Id := N + 165; -- VMS + Name_Import : constant Name_Id := N + 166; + Name_Import_Exception : constant Name_Id := N + 167; -- VMS + Name_Import_Function : constant Name_Id := N + 168; -- GNAT + Name_Import_Object : constant Name_Id := N + 169; -- GNAT + Name_Import_Procedure : constant Name_Id := N + 170; -- GNAT + Name_Import_Valued_Procedure : constant Name_Id := N + 171; -- GNAT + Name_Inline : constant Name_Id := N + 172; + Name_Inline_Always : constant Name_Id := N + 173; -- GNAT + Name_Inline_Generic : constant Name_Id := N + 174; -- GNAT + Name_Inspection_Point : constant Name_Id := N + 175; + Name_Interface : constant Name_Id := N + 176; -- Ada 83 + Name_Interface_Name : constant Name_Id := N + 177; -- GNAT + Name_Interrupt_Handler : constant Name_Id := N + 178; + Name_Interrupt_Priority : constant Name_Id := N + 179; + Name_Java_Constructor : constant Name_Id := N + 180; -- GNAT + Name_Java_Interface : constant Name_Id := N + 181; -- GNAT + Name_Keep_Names : constant Name_Id := N + 182; -- GNAT + Name_Link_With : constant Name_Id := N + 183; -- GNAT + Name_Linker_Alias : constant Name_Id := N + 184; -- GNAT + Name_Linker_Options : constant Name_Id := N + 185; + Name_Linker_Section : constant Name_Id := N + 186; -- GNAT + Name_List : constant Name_Id := N + 187; + Name_Machine_Attribute : constant Name_Id := N + 188; -- GNAT + Name_Main : constant Name_Id := N + 189; -- GNAT + Name_Main_Storage : constant Name_Id := N + 190; -- GNAT + Name_Memory_Size : constant Name_Id := N + 191; -- Ada 83 + Name_No_Return : constant Name_Id := N + 192; -- GNAT + Name_Obsolescent : constant Name_Id := N + 193; -- GNAT + Name_Optimize : constant Name_Id := N + 194; + Name_Optional_Overriding : constant Name_Id := N + 195; + Name_Overriding : constant Name_Id := N + 196; + Name_Pack : constant Name_Id := N + 197; + Name_Page : constant Name_Id := N + 198; + Name_Passive : constant Name_Id := N + 199; -- GNAT + Name_Preelaborate : constant Name_Id := N + 200; + Name_Priority : constant Name_Id := N + 201; + Name_Psect_Object : constant Name_Id := N + 202; -- VMS + Name_Pure : constant Name_Id := N + 203; + Name_Pure_Function : constant Name_Id := N + 204; -- GNAT + Name_Remote_Call_Interface : constant Name_Id := N + 205; + Name_Remote_Types : constant Name_Id := N + 206; + Name_Share_Generic : constant Name_Id := N + 207; -- GNAT + Name_Shared : constant Name_Id := N + 208; -- Ada 83 + Name_Shared_Passive : constant Name_Id := N + 209; -- Note: Storage_Size is not in this list because its name matches the -- name of the corresponding attribute. However, it is included in the @@ -429,27 +433,27 @@ package Snames is -- Note: Storage_Unit is also omitted from the list because of a clash -- with an attribute name, and is treated similarly. - Name_Source_Reference : constant Name_Id := N + 209; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 210; -- GNAT - Name_Subtitle : constant Name_Id := N + 211; -- GNAT - Name_Suppress_All : constant Name_Id := N + 212; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 213; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 214; -- GNAT - Name_System_Name : constant Name_Id := N + 215; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 216; -- GNAT - Name_Task_Name : constant Name_Id := N + 217; -- GNAT - Name_Task_Storage : constant Name_Id := N + 218; -- VMS - Name_Thread_Body : constant Name_Id := N + 219; -- GNAT - Name_Time_Slice : constant Name_Id := N + 220; -- GNAT - Name_Title : constant Name_Id := N + 221; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 222; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 223; -- GNAT - Name_Unreferenced : constant Name_Id := N + 224; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 225; -- GNAT - Name_Volatile : constant Name_Id := N + 226; - Name_Volatile_Components : constant Name_Id := N + 227; - Name_Weak_External : constant Name_Id := N + 228; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 228; + Name_Source_Reference : constant Name_Id := N + 210; -- GNAT + Name_Stream_Convert : constant Name_Id := N + 211; -- GNAT + Name_Subtitle : constant Name_Id := N + 212; -- GNAT + Name_Suppress_All : constant Name_Id := N + 213; -- GNAT + Name_Suppress_Debug_Info : constant Name_Id := N + 214; -- GNAT + Name_Suppress_Initialization : constant Name_Id := N + 215; -- GNAT + Name_System_Name : constant Name_Id := N + 216; -- Ada 83 + Name_Task_Info : constant Name_Id := N + 217; -- GNAT + Name_Task_Name : constant Name_Id := N + 218; -- GNAT + Name_Task_Storage : constant Name_Id := N + 219; -- VMS + Name_Thread_Body : constant Name_Id := N + 220; -- GNAT + Name_Time_Slice : constant Name_Id := N + 221; -- GNAT + Name_Title : constant Name_Id := N + 222; -- GNAT + Name_Unchecked_Union : constant Name_Id := N + 223; -- GNAT + Name_Unimplemented_Unit : constant Name_Id := N + 224; -- GNAT + Name_Unreferenced : constant Name_Id := N + 225; -- GNAT + Name_Unreserve_All_Interrupts : constant Name_Id := N + 226; -- GNAT + Name_Volatile : constant Name_Id := N + 227; + Name_Volatile_Components : constant Name_Id := N + 228; + Name_Weak_External : constant Name_Id := N + 229; -- GNAT + Last_Pragma_Name : constant Name_Id := N + 229; -- Language convention names for pragma Convention/Export/Import/Interface -- Note that Name_C is not included in this list, since it was already @@ -460,98 +464,98 @@ package Snames is -- Entry and Protected, this is because these conventions cannot be -- specified by a pragma. - First_Convention_Name : constant Name_Id := N + 229; - Name_Ada : constant Name_Id := N + 229; - Name_Assembler : constant Name_Id := N + 230; - Name_COBOL : constant Name_Id := N + 231; - Name_CPP : constant Name_Id := N + 232; - Name_Fortran : constant Name_Id := N + 233; - Name_Intrinsic : constant Name_Id := N + 234; - Name_Java : constant Name_Id := N + 235; - Name_Stdcall : constant Name_Id := N + 236; - Name_Stubbed : constant Name_Id := N + 237; - Last_Convention_Name : constant Name_Id := N + 237; + First_Convention_Name : constant Name_Id := N + 230; + Name_Ada : constant Name_Id := N + 230; + Name_Assembler : constant Name_Id := N + 231; + Name_COBOL : constant Name_Id := N + 232; + Name_CPP : constant Name_Id := N + 233; + Name_Fortran : constant Name_Id := N + 234; + Name_Intrinsic : constant Name_Id := N + 235; + Name_Java : constant Name_Id := N + 236; + Name_Stdcall : constant Name_Id := N + 237; + Name_Stubbed : constant Name_Id := N + 238; + Last_Convention_Name : constant Name_Id := N + 238; -- The following names are preset as synonyms for Assembler - Name_Asm : constant Name_Id := N + 238; - Name_Assembly : constant Name_Id := N + 239; + Name_Asm : constant Name_Id := N + 239; + Name_Assembly : constant Name_Id := N + 240; -- The following names are preset as synonyms for C - Name_Default : constant Name_Id := N + 240; + Name_Default : constant Name_Id := N + 241; -- Name_Exernal (previously defined as pragma) -- The following names are present as synonyms for Stdcall - Name_DLL : constant Name_Id := N + 241; - Name_Win32 : constant Name_Id := N + 242; + Name_DLL : constant Name_Id := N + 242; + Name_Win32 : constant Name_Id := N + 243; -- Other special names used in processing pragmas - Name_As_Is : constant Name_Id := N + 243; - Name_Body_File_Name : constant Name_Id := N + 244; - Name_Casing : constant Name_Id := N + 245; - Name_Code : constant Name_Id := N + 246; - Name_Component : constant Name_Id := N + 247; - Name_Component_Size_4 : constant Name_Id := N + 248; - Name_Copy : constant Name_Id := N + 249; - Name_D_Float : constant Name_Id := N + 250; - Name_Descriptor : constant Name_Id := N + 251; - Name_Dot_Replacement : constant Name_Id := N + 252; - Name_Dynamic : constant Name_Id := N + 253; - Name_Entity : constant Name_Id := N + 254; - Name_External_Name : constant Name_Id := N + 255; - Name_First_Optional_Parameter : constant Name_Id := N + 256; - Name_Form : constant Name_Id := N + 257; - Name_G_Float : constant Name_Id := N + 258; - Name_Gcc : constant Name_Id := N + 259; - Name_Gnat : constant Name_Id := N + 260; - Name_GPL : constant Name_Id := N + 261; - Name_IEEE_Float : constant Name_Id := N + 262; - Name_Homonym_Number : constant Name_Id := N + 263; - Name_Internal : constant Name_Id := N + 264; - Name_Link_Name : constant Name_Id := N + 265; - Name_Lowercase : constant Name_Id := N + 266; - Name_Max_Size : constant Name_Id := N + 267; - Name_Mechanism : constant Name_Id := N + 268; - Name_Mixedcase : constant Name_Id := N + 269; - Name_Modified_GPL : constant Name_Id := N + 270; - Name_Name : constant Name_Id := N + 271; - Name_NCA : constant Name_Id := N + 272; - Name_No : constant Name_Id := N + 273; - Name_On : constant Name_Id := N + 274; - Name_Parameter_Types : constant Name_Id := N + 275; - Name_Reference : constant Name_Id := N + 276; - Name_No_Requeue : constant Name_Id := N + 277; - Name_No_Task_Attributes : constant Name_Id := N + 278; - Name_Restricted : constant Name_Id := N + 279; - Name_Result_Mechanism : constant Name_Id := N + 280; - Name_Result_Type : constant Name_Id := N + 281; - Name_Runtime : constant Name_Id := N + 282; - Name_SB : constant Name_Id := N + 283; - Name_Secondary_Stack_Size : constant Name_Id := N + 284; - Name_Section : constant Name_Id := N + 285; - Name_Semaphore : constant Name_Id := N + 286; - Name_Spec_File_Name : constant Name_Id := N + 287; - Name_Static : constant Name_Id := N + 288; - Name_Stack_Size : constant Name_Id := N + 289; - Name_Subunit_File_Name : constant Name_Id := N + 290; - Name_Task_Stack_Size_Default : constant Name_Id := N + 291; - Name_Task_Type : constant Name_Id := N + 292; - Name_Time_Slicing_Enabled : constant Name_Id := N + 293; - Name_Top_Guard : constant Name_Id := N + 294; - Name_UBA : constant Name_Id := N + 295; - Name_UBS : constant Name_Id := N + 296; - Name_UBSB : constant Name_Id := N + 297; - Name_Unit_Name : constant Name_Id := N + 298; - Name_Unknown : constant Name_Id := N + 299; - Name_Unrestricted : constant Name_Id := N + 300; - Name_Uppercase : constant Name_Id := N + 301; - Name_User : constant Name_Id := N + 302; - Name_VAX_Float : constant Name_Id := N + 303; - Name_VMS : constant Name_Id := N + 304; - Name_Working_Storage : constant Name_Id := N + 305; + Name_As_Is : constant Name_Id := N + 244; + Name_Body_File_Name : constant Name_Id := N + 245; + Name_Casing : constant Name_Id := N + 246; + Name_Code : constant Name_Id := N + 247; + Name_Component : constant Name_Id := N + 248; + Name_Component_Size_4 : constant Name_Id := N + 249; + Name_Copy : constant Name_Id := N + 250; + Name_D_Float : constant Name_Id := N + 251; + Name_Descriptor : constant Name_Id := N + 252; + Name_Dot_Replacement : constant Name_Id := N + 253; + Name_Dynamic : constant Name_Id := N + 254; + Name_Entity : constant Name_Id := N + 255; + Name_External_Name : constant Name_Id := N + 256; + Name_First_Optional_Parameter : constant Name_Id := N + 257; + Name_Form : constant Name_Id := N + 258; + Name_G_Float : constant Name_Id := N + 259; + Name_Gcc : constant Name_Id := N + 260; + Name_Gnat : constant Name_Id := N + 261; + Name_GPL : constant Name_Id := N + 262; + Name_IEEE_Float : constant Name_Id := N + 263; + Name_Homonym_Number : constant Name_Id := N + 264; + Name_Internal : constant Name_Id := N + 265; + Name_Link_Name : constant Name_Id := N + 266; + Name_Lowercase : constant Name_Id := N + 267; + Name_Max_Size : constant Name_Id := N + 268; + Name_Mechanism : constant Name_Id := N + 269; + Name_Mixedcase : constant Name_Id := N + 270; + Name_Modified_GPL : constant Name_Id := N + 271; + Name_Name : constant Name_Id := N + 272; + Name_NCA : constant Name_Id := N + 273; + Name_No : constant Name_Id := N + 274; + Name_On : constant Name_Id := N + 275; + Name_Parameter_Types : constant Name_Id := N + 276; + Name_Reference : constant Name_Id := N + 277; + Name_No_Requeue : constant Name_Id := N + 278; + Name_No_Task_Attributes : constant Name_Id := N + 279; + Name_Restricted : constant Name_Id := N + 280; + Name_Result_Mechanism : constant Name_Id := N + 281; + Name_Result_Type : constant Name_Id := N + 282; + Name_Runtime : constant Name_Id := N + 283; + Name_SB : constant Name_Id := N + 284; + Name_Secondary_Stack_Size : constant Name_Id := N + 285; + Name_Section : constant Name_Id := N + 286; + Name_Semaphore : constant Name_Id := N + 287; + Name_Spec_File_Name : constant Name_Id := N + 288; + Name_Static : constant Name_Id := N + 289; + Name_Stack_Size : constant Name_Id := N + 290; + Name_Subunit_File_Name : constant Name_Id := N + 291; + Name_Task_Stack_Size_Default : constant Name_Id := N + 292; + Name_Task_Type : constant Name_Id := N + 293; + Name_Time_Slicing_Enabled : constant Name_Id := N + 294; + Name_Top_Guard : constant Name_Id := N + 295; + Name_UBA : constant Name_Id := N + 296; + Name_UBS : constant Name_Id := N + 297; + Name_UBSB : constant Name_Id := N + 298; + Name_Unit_Name : constant Name_Id := N + 299; + Name_Unknown : constant Name_Id := N + 300; + Name_Unrestricted : constant Name_Id := N + 301; + Name_Uppercase : constant Name_Id := N + 302; + Name_User : constant Name_Id := N + 303; + Name_VAX_Float : constant Name_Id := N + 304; + Name_VMS : constant Name_Id := N + 305; + Name_Working_Storage : constant Name_Id := N + 306; -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These @@ -565,158 +569,158 @@ package Snames is -- The entries marked VMS are recognized only in OpenVMS implementations -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + 306; - Name_Abort_Signal : constant Name_Id := N + 306; -- GNAT - Name_Access : constant Name_Id := N + 307; - Name_Address : constant Name_Id := N + 308; - Name_Address_Size : constant Name_Id := N + 309; -- GNAT - Name_Aft : constant Name_Id := N + 310; - Name_Alignment : constant Name_Id := N + 311; - Name_Asm_Input : constant Name_Id := N + 312; -- GNAT - Name_Asm_Output : constant Name_Id := N + 313; -- GNAT - Name_AST_Entry : constant Name_Id := N + 314; -- VMS - Name_Bit : constant Name_Id := N + 315; -- GNAT - Name_Bit_Order : constant Name_Id := N + 316; - Name_Bit_Position : constant Name_Id := N + 317; -- GNAT - Name_Body_Version : constant Name_Id := N + 318; - Name_Callable : constant Name_Id := N + 319; - Name_Caller : constant Name_Id := N + 320; - Name_Code_Address : constant Name_Id := N + 321; -- GNAT - Name_Component_Size : constant Name_Id := N + 322; - Name_Compose : constant Name_Id := N + 323; - Name_Constrained : constant Name_Id := N + 324; - Name_Count : constant Name_Id := N + 325; - Name_Default_Bit_Order : constant Name_Id := N + 326; -- GNAT - Name_Definite : constant Name_Id := N + 327; - Name_Delta : constant Name_Id := N + 328; - Name_Denorm : constant Name_Id := N + 329; - Name_Digits : constant Name_Id := N + 330; - Name_Elaborated : constant Name_Id := N + 331; -- GNAT - Name_Emax : constant Name_Id := N + 332; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 333; -- GNAT - Name_Epsilon : constant Name_Id := N + 334; -- Ada 83 - Name_Exponent : constant Name_Id := N + 335; - Name_External_Tag : constant Name_Id := N + 336; - Name_First : constant Name_Id := N + 337; - Name_First_Bit : constant Name_Id := N + 338; - Name_Fixed_Value : constant Name_Id := N + 339; -- GNAT - Name_Fore : constant Name_Id := N + 340; - Name_Has_Discriminants : constant Name_Id := N + 341; -- GNAT - Name_Identity : constant Name_Id := N + 342; - Name_Img : constant Name_Id := N + 343; -- GNAT - Name_Integer_Value : constant Name_Id := N + 344; -- GNAT - Name_Large : constant Name_Id := N + 345; -- Ada 83 - Name_Last : constant Name_Id := N + 346; - Name_Last_Bit : constant Name_Id := N + 347; - Name_Leading_Part : constant Name_Id := N + 348; - Name_Length : constant Name_Id := N + 349; - Name_Machine_Emax : constant Name_Id := N + 350; - Name_Machine_Emin : constant Name_Id := N + 351; - Name_Machine_Mantissa : constant Name_Id := N + 352; - Name_Machine_Overflows : constant Name_Id := N + 353; - Name_Machine_Radix : constant Name_Id := N + 354; - Name_Machine_Rounds : constant Name_Id := N + 355; - Name_Machine_Size : constant Name_Id := N + 356; -- GNAT - Name_Mantissa : constant Name_Id := N + 357; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 358; - Name_Maximum_Alignment : constant Name_Id := N + 359; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 360; -- GNAT - Name_Model_Emin : constant Name_Id := N + 361; - Name_Model_Epsilon : constant Name_Id := N + 362; - Name_Model_Mantissa : constant Name_Id := N + 363; - Name_Model_Small : constant Name_Id := N + 364; - Name_Modulus : constant Name_Id := N + 365; - Name_Null_Parameter : constant Name_Id := N + 366; -- GNAT - Name_Object_Size : constant Name_Id := N + 367; -- GNAT - Name_Partition_ID : constant Name_Id := N + 368; - Name_Passed_By_Reference : constant Name_Id := N + 369; -- GNAT - Name_Pool_Address : constant Name_Id := N + 370; - Name_Pos : constant Name_Id := N + 371; - Name_Position : constant Name_Id := N + 372; - Name_Range : constant Name_Id := N + 373; - Name_Range_Length : constant Name_Id := N + 374; -- GNAT - Name_Round : constant Name_Id := N + 375; - Name_Safe_Emax : constant Name_Id := N + 376; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 377; - Name_Safe_Large : constant Name_Id := N + 378; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 379; - Name_Safe_Small : constant Name_Id := N + 380; -- Ada 83 - Name_Scale : constant Name_Id := N + 381; - Name_Scaling : constant Name_Id := N + 382; - Name_Signed_Zeros : constant Name_Id := N + 383; - Name_Size : constant Name_Id := N + 384; - Name_Small : constant Name_Id := N + 385; - Name_Storage_Size : constant Name_Id := N + 386; - Name_Storage_Unit : constant Name_Id := N + 387; -- GNAT - Name_Tag : constant Name_Id := N + 388; - Name_Target_Name : constant Name_Id := N + 389; -- GNAT - Name_Terminated : constant Name_Id := N + 390; - Name_To_Address : constant Name_Id := N + 391; -- GNAT - Name_Type_Class : constant Name_Id := N + 392; -- GNAT - Name_UET_Address : constant Name_Id := N + 393; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 394; - Name_Unchecked_Access : constant Name_Id := N + 395; - Name_Unconstrained_Array : constant Name_Id := N + 396; - Name_Universal_Literal_String : constant Name_Id := N + 397; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 398; -- GNAT - Name_VADS_Size : constant Name_Id := N + 399; -- GNAT - Name_Val : constant Name_Id := N + 400; - Name_Valid : constant Name_Id := N + 401; - Name_Value_Size : constant Name_Id := N + 402; -- GNAT - Name_Version : constant Name_Id := N + 403; - Name_Wchar_T_Size : constant Name_Id := N + 404; -- GNAT - Name_Wide_Width : constant Name_Id := N + 405; - Name_Width : constant Name_Id := N + 406; - Name_Word_Size : constant Name_Id := N + 407; -- GNAT + First_Attribute_Name : constant Name_Id := N + 307; + Name_Abort_Signal : constant Name_Id := N + 307; -- GNAT + Name_Access : constant Name_Id := N + 308; + Name_Address : constant Name_Id := N + 309; + Name_Address_Size : constant Name_Id := N + 310; -- GNAT + Name_Aft : constant Name_Id := N + 311; + Name_Alignment : constant Name_Id := N + 312; + Name_Asm_Input : constant Name_Id := N + 313; -- GNAT + Name_Asm_Output : constant Name_Id := N + 314; -- GNAT + Name_AST_Entry : constant Name_Id := N + 315; -- VMS + Name_Bit : constant Name_Id := N + 316; -- GNAT + Name_Bit_Order : constant Name_Id := N + 317; + Name_Bit_Position : constant Name_Id := N + 318; -- GNAT + Name_Body_Version : constant Name_Id := N + 319; + Name_Callable : constant Name_Id := N + 320; + Name_Caller : constant Name_Id := N + 321; + Name_Code_Address : constant Name_Id := N + 322; -- GNAT + Name_Component_Size : constant Name_Id := N + 323; + Name_Compose : constant Name_Id := N + 324; + Name_Constrained : constant Name_Id := N + 325; + Name_Count : constant Name_Id := N + 326; + Name_Default_Bit_Order : constant Name_Id := N + 327; -- GNAT + Name_Definite : constant Name_Id := N + 328; + Name_Delta : constant Name_Id := N + 329; + Name_Denorm : constant Name_Id := N + 330; + Name_Digits : constant Name_Id := N + 331; + Name_Elaborated : constant Name_Id := N + 332; -- GNAT + Name_Emax : constant Name_Id := N + 333; -- Ada 83 + Name_Enum_Rep : constant Name_Id := N + 334; -- GNAT + Name_Epsilon : constant Name_Id := N + 335; -- Ada 83 + Name_Exponent : constant Name_Id := N + 336; + Name_External_Tag : constant Name_Id := N + 337; + Name_First : constant Name_Id := N + 338; + Name_First_Bit : constant Name_Id := N + 339; + Name_Fixed_Value : constant Name_Id := N + 340; -- GNAT + Name_Fore : constant Name_Id := N + 341; + Name_Has_Discriminants : constant Name_Id := N + 342; -- GNAT + Name_Identity : constant Name_Id := N + 343; + Name_Img : constant Name_Id := N + 344; -- GNAT + Name_Integer_Value : constant Name_Id := N + 345; -- GNAT + Name_Large : constant Name_Id := N + 346; -- Ada 83 + Name_Last : constant Name_Id := N + 347; + Name_Last_Bit : constant Name_Id := N + 348; + Name_Leading_Part : constant Name_Id := N + 349; + Name_Length : constant Name_Id := N + 350; + Name_Machine_Emax : constant Name_Id := N + 351; + Name_Machine_Emin : constant Name_Id := N + 352; + Name_Machine_Mantissa : constant Name_Id := N + 353; + Name_Machine_Overflows : constant Name_Id := N + 354; + Name_Machine_Radix : constant Name_Id := N + 355; + Name_Machine_Rounds : constant Name_Id := N + 356; + Name_Machine_Size : constant Name_Id := N + 357; -- GNAT + Name_Mantissa : constant Name_Id := N + 358; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 359; + Name_Maximum_Alignment : constant Name_Id := N + 360; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 361; -- GNAT + Name_Model_Emin : constant Name_Id := N + 362; + Name_Model_Epsilon : constant Name_Id := N + 363; + Name_Model_Mantissa : constant Name_Id := N + 364; + Name_Model_Small : constant Name_Id := N + 365; + Name_Modulus : constant Name_Id := N + 366; + Name_Null_Parameter : constant Name_Id := N + 367; -- GNAT + Name_Object_Size : constant Name_Id := N + 368; -- GNAT + Name_Partition_ID : constant Name_Id := N + 369; + Name_Passed_By_Reference : constant Name_Id := N + 370; -- GNAT + Name_Pool_Address : constant Name_Id := N + 371; + Name_Pos : constant Name_Id := N + 372; + Name_Position : constant Name_Id := N + 373; + Name_Range : constant Name_Id := N + 374; + Name_Range_Length : constant Name_Id := N + 375; -- GNAT + Name_Round : constant Name_Id := N + 376; + Name_Safe_Emax : constant Name_Id := N + 377; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 378; + Name_Safe_Large : constant Name_Id := N + 379; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 380; + Name_Safe_Small : constant Name_Id := N + 381; -- Ada 83 + Name_Scale : constant Name_Id := N + 382; + Name_Scaling : constant Name_Id := N + 383; + Name_Signed_Zeros : constant Name_Id := N + 384; + Name_Size : constant Name_Id := N + 385; + Name_Small : constant Name_Id := N + 386; + Name_Storage_Size : constant Name_Id := N + 387; + Name_Storage_Unit : constant Name_Id := N + 388; -- GNAT + Name_Tag : constant Name_Id := N + 389; + Name_Target_Name : constant Name_Id := N + 390; -- GNAT + Name_Terminated : constant Name_Id := N + 391; + Name_To_Address : constant Name_Id := N + 392; -- GNAT + Name_Type_Class : constant Name_Id := N + 393; -- GNAT + Name_UET_Address : constant Name_Id := N + 394; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 395; + Name_Unchecked_Access : constant Name_Id := N + 396; + Name_Unconstrained_Array : constant Name_Id := N + 397; + Name_Universal_Literal_String : constant Name_Id := N + 398; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 399; -- GNAT + Name_VADS_Size : constant Name_Id := N + 400; -- GNAT + Name_Val : constant Name_Id := N + 401; + Name_Valid : constant Name_Id := N + 402; + Name_Value_Size : constant Name_Id := N + 403; -- GNAT + Name_Version : constant Name_Id := N + 404; + Name_Wchar_T_Size : constant Name_Id := N + 405; -- GNAT + Name_Wide_Width : constant Name_Id := N + 406; + Name_Width : constant Name_Id := N + 407; + Name_Word_Size : constant Name_Id := N + 408; -- GNAT -- Attributes that designate attributes returning renamable functions, -- i.e. functions that return other than a universal value. - First_Renamable_Function_Attribute : constant Name_Id := N + 408; - Name_Adjacent : constant Name_Id := N + 408; - Name_Ceiling : constant Name_Id := N + 409; - Name_Copy_Sign : constant Name_Id := N + 410; - Name_Floor : constant Name_Id := N + 411; - Name_Fraction : constant Name_Id := N + 412; - Name_Image : constant Name_Id := N + 413; - Name_Input : constant Name_Id := N + 414; - Name_Machine : constant Name_Id := N + 415; - Name_Max : constant Name_Id := N + 416; - Name_Min : constant Name_Id := N + 417; - Name_Model : constant Name_Id := N + 418; - Name_Pred : constant Name_Id := N + 419; - Name_Remainder : constant Name_Id := N + 420; - Name_Rounding : constant Name_Id := N + 421; - Name_Succ : constant Name_Id := N + 422; - Name_Truncation : constant Name_Id := N + 423; - Name_Value : constant Name_Id := N + 424; - Name_Wide_Image : constant Name_Id := N + 425; - Name_Wide_Value : constant Name_Id := N + 426; - Last_Renamable_Function_Attribute : constant Name_Id := N + 426; + First_Renamable_Function_Attribute : constant Name_Id := N + 409; + Name_Adjacent : constant Name_Id := N + 409; + Name_Ceiling : constant Name_Id := N + 410; + Name_Copy_Sign : constant Name_Id := N + 411; + Name_Floor : constant Name_Id := N + 412; + Name_Fraction : constant Name_Id := N + 413; + Name_Image : constant Name_Id := N + 414; + Name_Input : constant Name_Id := N + 415; + Name_Machine : constant Name_Id := N + 416; + Name_Max : constant Name_Id := N + 417; + Name_Min : constant Name_Id := N + 418; + Name_Model : constant Name_Id := N + 419; + Name_Pred : constant Name_Id := N + 420; + Name_Remainder : constant Name_Id := N + 421; + Name_Rounding : constant Name_Id := N + 422; + Name_Succ : constant Name_Id := N + 423; + Name_Truncation : constant Name_Id := N + 424; + Name_Value : constant Name_Id := N + 425; + Name_Wide_Image : constant Name_Id := N + 426; + Name_Wide_Value : constant Name_Id := N + 427; + Last_Renamable_Function_Attribute : constant Name_Id := N + 427; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 427; - Name_Output : constant Name_Id := N + 427; - Name_Read : constant Name_Id := N + 428; - Name_Write : constant Name_Id := N + 429; - Last_Procedure_Attribute : constant Name_Id := N + 429; + First_Procedure_Attribute : constant Name_Id := N + 428; + Name_Output : constant Name_Id := N + 428; + Name_Read : constant Name_Id := N + 429; + Name_Write : constant Name_Id := N + 430; + Last_Procedure_Attribute : constant Name_Id := N + 430; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 430; - Name_Elab_Body : constant Name_Id := N + 430; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 431; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 432; + First_Entity_Attribute_Name : constant Name_Id := N + 431; + Name_Elab_Body : constant Name_Id := N + 431; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 432; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 433; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 433; - Name_Base : constant Name_Id := N + 433; - Name_Class : constant Name_Id := N + 434; - Last_Type_Attribute_Name : constant Name_Id := N + 434; - Last_Entity_Attribute_Name : constant Name_Id := N + 434; - Last_Attribute_Name : constant Name_Id := N + 434; + First_Type_Attribute_Name : constant Name_Id := N + 434; + Name_Base : constant Name_Id := N + 434; + Name_Class : constant Name_Id := N + 435; + Last_Type_Attribute_Name : constant Name_Id := N + 435; + Last_Entity_Attribute_Name : constant Name_Id := N + 435; + Last_Attribute_Name : constant Name_Id := N + 435; -- Names of recognized locking policy identifiers @@ -724,10 +728,10 @@ package Snames is -- name (e.g. C for Ceiling_Locking). If new policy names are added, -- the first character must be distinct. - First_Locking_Policy_Name : constant Name_Id := N + 435; - Name_Ceiling_Locking : constant Name_Id := N + 435; - Name_Inheritance_Locking : constant Name_Id := N + 436; - Last_Locking_Policy_Name : constant Name_Id := N + 436; + First_Locking_Policy_Name : constant Name_Id := N + 436; + Name_Ceiling_Locking : constant Name_Id := N + 436; + Name_Inheritance_Locking : constant Name_Id := N + 437; + Last_Locking_Policy_Name : constant Name_Id := N + 437; -- Names of recognized queuing policy identifiers. @@ -735,10 +739,10 @@ package Snames is -- name (e.g. F for FIFO_Queuing). If new policy names are added, -- the first character must be distinct. - First_Queuing_Policy_Name : constant Name_Id := N + 437; - Name_FIFO_Queuing : constant Name_Id := N + 437; - Name_Priority_Queuing : constant Name_Id := N + 438; - Last_Queuing_Policy_Name : constant Name_Id := N + 438; + First_Queuing_Policy_Name : constant Name_Id := N + 438; + Name_FIFO_Queuing : constant Name_Id := N + 438; + Name_Priority_Queuing : constant Name_Id := N + 439; + Last_Queuing_Policy_Name : constant Name_Id := N + 439; -- Names of recognized task dispatching policy identifiers @@ -746,193 +750,193 @@ package Snames is -- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names -- are added, the first character must be distinct. - First_Task_Dispatching_Policy_Name : constant Name_Id := N + 439; - Name_Fifo_Within_Priorities : constant Name_Id := N + 439; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 439; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 440; + Name_Fifo_Within_Priorities : constant Name_Id := N + 440; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 440; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 440; - Name_Access_Check : constant Name_Id := N + 440; - Name_Accessibility_Check : constant Name_Id := N + 441; - Name_Discriminant_Check : constant Name_Id := N + 442; - Name_Division_Check : constant Name_Id := N + 443; - Name_Elaboration_Check : constant Name_Id := N + 444; - Name_Index_Check : constant Name_Id := N + 445; - Name_Length_Check : constant Name_Id := N + 446; - Name_Overflow_Check : constant Name_Id := N + 447; - Name_Range_Check : constant Name_Id := N + 448; - Name_Storage_Check : constant Name_Id := N + 449; - Name_Tag_Check : constant Name_Id := N + 450; - Name_All_Checks : constant Name_Id := N + 451; - Last_Check_Name : constant Name_Id := N + 451; + First_Check_Name : constant Name_Id := N + 441; + Name_Access_Check : constant Name_Id := N + 441; + Name_Accessibility_Check : constant Name_Id := N + 442; + Name_Discriminant_Check : constant Name_Id := N + 443; + Name_Division_Check : constant Name_Id := N + 444; + Name_Elaboration_Check : constant Name_Id := N + 445; + Name_Index_Check : constant Name_Id := N + 446; + Name_Length_Check : constant Name_Id := N + 447; + Name_Overflow_Check : constant Name_Id := N + 448; + Name_Range_Check : constant Name_Id := N + 449; + Name_Storage_Check : constant Name_Id := N + 450; + Name_Tag_Check : constant Name_Id := N + 451; + Name_All_Checks : constant Name_Id := N + 452; + Last_Check_Name : constant Name_Id := N + 452; -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Range). - Name_Abort : constant Name_Id := N + 452; - Name_Abs : constant Name_Id := N + 453; - Name_Accept : constant Name_Id := N + 454; - Name_And : constant Name_Id := N + 455; - Name_All : constant Name_Id := N + 456; - Name_Array : constant Name_Id := N + 457; - Name_At : constant Name_Id := N + 458; - Name_Begin : constant Name_Id := N + 459; - Name_Body : constant Name_Id := N + 460; - Name_Case : constant Name_Id := N + 461; - Name_Constant : constant Name_Id := N + 462; - Name_Declare : constant Name_Id := N + 463; - Name_Delay : constant Name_Id := N + 464; - Name_Do : constant Name_Id := N + 465; - Name_Else : constant Name_Id := N + 466; - Name_Elsif : constant Name_Id := N + 467; - Name_End : constant Name_Id := N + 468; - Name_Entry : constant Name_Id := N + 469; - Name_Exception : constant Name_Id := N + 470; - Name_Exit : constant Name_Id := N + 471; - Name_For : constant Name_Id := N + 472; - Name_Function : constant Name_Id := N + 473; - Name_Generic : constant Name_Id := N + 474; - Name_Goto : constant Name_Id := N + 475; - Name_If : constant Name_Id := N + 476; - Name_In : constant Name_Id := N + 477; - Name_Is : constant Name_Id := N + 478; - Name_Limited : constant Name_Id := N + 479; - Name_Loop : constant Name_Id := N + 480; - Name_Mod : constant Name_Id := N + 481; - Name_New : constant Name_Id := N + 482; - Name_Not : constant Name_Id := N + 483; - Name_Null : constant Name_Id := N + 484; - Name_Of : constant Name_Id := N + 485; - Name_Or : constant Name_Id := N + 486; - Name_Others : constant Name_Id := N + 487; - Name_Out : constant Name_Id := N + 488; - Name_Package : constant Name_Id := N + 489; - Name_Pragma : constant Name_Id := N + 490; - Name_Private : constant Name_Id := N + 491; - Name_Procedure : constant Name_Id := N + 492; - Name_Raise : constant Name_Id := N + 493; - Name_Record : constant Name_Id := N + 494; - Name_Rem : constant Name_Id := N + 495; - Name_Renames : constant Name_Id := N + 496; - Name_Return : constant Name_Id := N + 497; - Name_Reverse : constant Name_Id := N + 498; - Name_Select : constant Name_Id := N + 499; - Name_Separate : constant Name_Id := N + 500; - Name_Subtype : constant Name_Id := N + 501; - Name_Task : constant Name_Id := N + 502; - Name_Terminate : constant Name_Id := N + 503; - Name_Then : constant Name_Id := N + 504; - Name_Type : constant Name_Id := N + 505; - Name_Use : constant Name_Id := N + 506; - Name_When : constant Name_Id := N + 507; - Name_While : constant Name_Id := N + 508; - Name_With : constant Name_Id := N + 509; - Name_Xor : constant Name_Id := N + 510; + Name_Abort : constant Name_Id := N + 453; + Name_Abs : constant Name_Id := N + 454; + Name_Accept : constant Name_Id := N + 455; + Name_And : constant Name_Id := N + 456; + Name_All : constant Name_Id := N + 457; + Name_Array : constant Name_Id := N + 458; + Name_At : constant Name_Id := N + 459; + Name_Begin : constant Name_Id := N + 460; + Name_Body : constant Name_Id := N + 461; + Name_Case : constant Name_Id := N + 462; + Name_Constant : constant Name_Id := N + 463; + Name_Declare : constant Name_Id := N + 464; + Name_Delay : constant Name_Id := N + 465; + Name_Do : constant Name_Id := N + 466; + Name_Else : constant Name_Id := N + 467; + Name_Elsif : constant Name_Id := N + 468; + Name_End : constant Name_Id := N + 469; + Name_Entry : constant Name_Id := N + 470; + Name_Exception : constant Name_Id := N + 471; + Name_Exit : constant Name_Id := N + 472; + Name_For : constant Name_Id := N + 473; + Name_Function : constant Name_Id := N + 474; + Name_Generic : constant Name_Id := N + 475; + Name_Goto : constant Name_Id := N + 476; + Name_If : constant Name_Id := N + 477; + Name_In : constant Name_Id := N + 478; + Name_Is : constant Name_Id := N + 479; + Name_Limited : constant Name_Id := N + 480; + Name_Loop : constant Name_Id := N + 481; + Name_Mod : constant Name_Id := N + 482; + Name_New : constant Name_Id := N + 483; + Name_Not : constant Name_Id := N + 484; + Name_Null : constant Name_Id := N + 485; + Name_Of : constant Name_Id := N + 486; + Name_Or : constant Name_Id := N + 487; + Name_Others : constant Name_Id := N + 488; + Name_Out : constant Name_Id := N + 489; + Name_Package : constant Name_Id := N + 490; + Name_Pragma : constant Name_Id := N + 491; + Name_Private : constant Name_Id := N + 492; + Name_Procedure : constant Name_Id := N + 493; + Name_Raise : constant Name_Id := N + 494; + Name_Record : constant Name_Id := N + 495; + Name_Rem : constant Name_Id := N + 496; + Name_Renames : constant Name_Id := N + 497; + Name_Return : constant Name_Id := N + 498; + Name_Reverse : constant Name_Id := N + 499; + Name_Select : constant Name_Id := N + 500; + Name_Separate : constant Name_Id := N + 501; + Name_Subtype : constant Name_Id := N + 502; + Name_Task : constant Name_Id := N + 503; + Name_Terminate : constant Name_Id := N + 504; + Name_Then : constant Name_Id := N + 505; + Name_Type : constant Name_Id := N + 506; + Name_Use : constant Name_Id := N + 507; + Name_When : constant Name_Id := N + 508; + Name_While : constant Name_Id := N + 509; + Name_With : constant Name_Id := N + 510; + Name_Xor : constant Name_Id := N + 511; -- Names of intrinsic subprograms -- Note: Asm is missing from this list, since Asm is a legitimate -- convention name. So is To_Adress, which is a GNAT attribute. - First_Intrinsic_Name : constant Name_Id := N + 511; - Name_Divide : constant Name_Id := N + 511; - Name_Enclosing_Entity : constant Name_Id := N + 512; - Name_Exception_Information : constant Name_Id := N + 513; - Name_Exception_Message : constant Name_Id := N + 514; - Name_Exception_Name : constant Name_Id := N + 515; - Name_File : constant Name_Id := N + 516; - Name_Import_Address : constant Name_Id := N + 517; - Name_Import_Largest_Value : constant Name_Id := N + 518; - Name_Import_Value : constant Name_Id := N + 519; - Name_Is_Negative : constant Name_Id := N + 520; - Name_Line : constant Name_Id := N + 521; - Name_Rotate_Left : constant Name_Id := N + 522; - Name_Rotate_Right : constant Name_Id := N + 523; - Name_Shift_Left : constant Name_Id := N + 524; - Name_Shift_Right : constant Name_Id := N + 525; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 526; - Name_Source_Location : constant Name_Id := N + 527; - Name_Unchecked_Conversion : constant Name_Id := N + 528; - Name_Unchecked_Deallocation : constant Name_Id := N + 529; - Name_To_Pointer : constant Name_Id := N + 530; - Last_Intrinsic_Name : constant Name_Id := N + 530; + First_Intrinsic_Name : constant Name_Id := N + 512; + Name_Divide : constant Name_Id := N + 512; + Name_Enclosing_Entity : constant Name_Id := N + 513; + Name_Exception_Information : constant Name_Id := N + 514; + Name_Exception_Message : constant Name_Id := N + 515; + Name_Exception_Name : constant Name_Id := N + 516; + Name_File : constant Name_Id := N + 517; + Name_Import_Address : constant Name_Id := N + 518; + Name_Import_Largest_Value : constant Name_Id := N + 519; + Name_Import_Value : constant Name_Id := N + 520; + Name_Is_Negative : constant Name_Id := N + 521; + Name_Line : constant Name_Id := N + 522; + Name_Rotate_Left : constant Name_Id := N + 523; + Name_Rotate_Right : constant Name_Id := N + 524; + Name_Shift_Left : constant Name_Id := N + 525; + Name_Shift_Right : constant Name_Id := N + 526; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 527; + Name_Source_Location : constant Name_Id := N + 528; + Name_Unchecked_Conversion : constant Name_Id := N + 529; + Name_Unchecked_Deallocation : constant Name_Id := N + 530; + Name_To_Pointer : constant Name_Id := N + 531; + Last_Intrinsic_Name : constant Name_Id := N + 531; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 531; - Name_Abstract : constant Name_Id := N + 531; - Name_Aliased : constant Name_Id := N + 532; - Name_Protected : constant Name_Id := N + 533; - Name_Until : constant Name_Id := N + 534; - Name_Requeue : constant Name_Id := N + 535; - Name_Tagged : constant Name_Id := N + 536; - Last_95_Reserved_Word : constant Name_Id := N + 536; + First_95_Reserved_Word : constant Name_Id := N + 532; + Name_Abstract : constant Name_Id := N + 532; + Name_Aliased : constant Name_Id := N + 533; + Name_Protected : constant Name_Id := N + 534; + Name_Until : constant Name_Id := N + 535; + Name_Requeue : constant Name_Id := N + 536; + Name_Tagged : constant Name_Id := N + 537; + Last_95_Reserved_Word : constant Name_Id := N + 537; subtype Ada_95_Reserved_Words is Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; -- Miscellaneous names used in semantic checking - Name_Raise_Exception : constant Name_Id := N + 537; + Name_Raise_Exception : constant Name_Id := N + 538; -- Additional reserved words in GNAT Project Files -- Note that Name_External is already previously declared - Name_Binder : constant Name_Id := N + 538; - Name_Body_Suffix : constant Name_Id := N + 539; - Name_Builder : constant Name_Id := N + 540; - Name_Compiler : constant Name_Id := N + 541; - Name_Cross_Reference : constant Name_Id := N + 542; - Name_Default_Switches : constant Name_Id := N + 543; - Name_Exec_Dir : constant Name_Id := N + 544; - Name_Executable : constant Name_Id := N + 545; - Name_Executable_Suffix : constant Name_Id := N + 546; - Name_Extends : constant Name_Id := N + 547; - Name_Finder : constant Name_Id := N + 548; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 549; - Name_Gnatls : constant Name_Id := N + 550; - Name_Gnatstub : constant Name_Id := N + 551; - Name_Implementation : constant Name_Id := N + 552; - Name_Implementation_Exceptions : constant Name_Id := N + 553; - Name_Implementation_Suffix : constant Name_Id := N + 554; - Name_Languages : constant Name_Id := N + 555; - Name_Library_Dir : constant Name_Id := N + 556; - Name_Library_Auto_Init : constant Name_Id := N + 557; - Name_Library_GCC : constant Name_Id := N + 558; - Name_Library_Interface : constant Name_Id := N + 559; - Name_Library_Kind : constant Name_Id := N + 560; - Name_Library_Name : constant Name_Id := N + 561; - Name_Library_Options : constant Name_Id := N + 562; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 563; - Name_Library_Src_Dir : constant Name_Id := N + 564; - Name_Library_Symbol_File : constant Name_Id := N + 565; - Name_Library_Symbol_Policy : constant Name_Id := N + 566; - Name_Library_Version : constant Name_Id := N + 567; - Name_Linker : constant Name_Id := N + 568; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 569; - Name_Locally_Removed_Files : constant Name_Id := N + 570; - Name_Naming : constant Name_Id := N + 571; - Name_Object_Dir : constant Name_Id := N + 572; - Name_Pretty_Printer : constant Name_Id := N + 573; - Name_Project : constant Name_Id := N + 574; - Name_Separate_Suffix : constant Name_Id := N + 575; - Name_Source_Dirs : constant Name_Id := N + 576; - Name_Source_Files : constant Name_Id := N + 577; - Name_Source_List_File : constant Name_Id := N + 578; - Name_Spec : constant Name_Id := N + 579; - Name_Spec_Suffix : constant Name_Id := N + 580; - Name_Specification : constant Name_Id := N + 581; - Name_Specification_Exceptions : constant Name_Id := N + 582; - Name_Specification_Suffix : constant Name_Id := N + 583; - Name_Switches : constant Name_Id := N + 584; + Name_Binder : constant Name_Id := N + 539; + Name_Body_Suffix : constant Name_Id := N + 540; + Name_Builder : constant Name_Id := N + 541; + Name_Compiler : constant Name_Id := N + 542; + Name_Cross_Reference : constant Name_Id := N + 543; + Name_Default_Switches : constant Name_Id := N + 544; + Name_Exec_Dir : constant Name_Id := N + 545; + Name_Executable : constant Name_Id := N + 546; + Name_Executable_Suffix : constant Name_Id := N + 547; + Name_Extends : constant Name_Id := N + 548; + Name_Finder : constant Name_Id := N + 549; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 550; + Name_Gnatls : constant Name_Id := N + 551; + Name_Gnatstub : constant Name_Id := N + 552; + Name_Implementation : constant Name_Id := N + 553; + Name_Implementation_Exceptions : constant Name_Id := N + 554; + Name_Implementation_Suffix : constant Name_Id := N + 555; + Name_Languages : constant Name_Id := N + 556; + Name_Library_Dir : constant Name_Id := N + 557; + Name_Library_Auto_Init : constant Name_Id := N + 558; + Name_Library_GCC : constant Name_Id := N + 559; + Name_Library_Interface : constant Name_Id := N + 560; + Name_Library_Kind : constant Name_Id := N + 561; + Name_Library_Name : constant Name_Id := N + 562; + Name_Library_Options : constant Name_Id := N + 563; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 564; + Name_Library_Src_Dir : constant Name_Id := N + 565; + Name_Library_Symbol_File : constant Name_Id := N + 566; + Name_Library_Symbol_Policy : constant Name_Id := N + 567; + Name_Library_Version : constant Name_Id := N + 568; + Name_Linker : constant Name_Id := N + 569; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 570; + Name_Locally_Removed_Files : constant Name_Id := N + 571; + Name_Naming : constant Name_Id := N + 572; + Name_Object_Dir : constant Name_Id := N + 573; + Name_Pretty_Printer : constant Name_Id := N + 574; + Name_Project : constant Name_Id := N + 575; + Name_Separate_Suffix : constant Name_Id := N + 576; + Name_Source_Dirs : constant Name_Id := N + 577; + Name_Source_Files : constant Name_Id := N + 578; + Name_Source_List_File : constant Name_Id := N + 579; + Name_Spec : constant Name_Id := N + 580; + Name_Spec_Suffix : constant Name_Id := N + 581; + Name_Specification : constant Name_Id := N + 582; + Name_Specification_Exceptions : constant Name_Id := N + 583; + Name_Specification_Suffix : constant Name_Id := N + 584; + Name_Switches : constant Name_Id := N + 585; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 585; + Name_Unaligned_Valid : constant Name_Id := N + 586; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 585; + Last_Predefined_Name : constant Name_Id := N + 586; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; @@ -1159,6 +1163,7 @@ package Snames is Pragma_Polling, Pragma_Persistent_Data, Pragma_Persistent_Object, + Pragma_Profile, Pragma_Propagate_Exceptions, Pragma_Queuing_Policy, Pragma_Ravenscar, diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index d81122763c0..a10c25d56b9 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2003 Free Software Foundation, Inc. * + * Copyright (C) 1992-2004 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- * @@ -220,128 +220,129 @@ extern unsigned char Get_Pragma_Id (int); #define Pragma_Polling 21 #define Pragma_Persistent_Data 22 #define Pragma_Persistent_Object 23 -#define Pragma_Propagate_Exceptions 24 -#define Pragma_Queuing_Policy 25 -#define Pragma_Ravenscar 26 -#define Pragma_Restricted_Run_Time 27 -#define Pragma_Restrictions 28 -#define Pragma_Restriction_Warnings 29 -#define Pragma_Reviewable 30 -#define Pragma_Source_File_Name 31 -#define Pragma_Source_File_Name_Project 32 -#define Pragma_Style_Checks 33 -#define Pragma_Suppress 34 -#define Pragma_Suppress_Exception_Locations 35 -#define Pragma_Task_Dispatching_Policy 36 -#define Pragma_Universal_Data 37 -#define Pragma_Unsuppress 38 -#define Pragma_Use_VADS_Size 39 -#define Pragma_Validity_Checks 40 -#define Pragma_Warnings 41 +#define Pragma_Profile 24 +#define Pragma_Propagate_Exceptions 25 +#define Pragma_Queuing_Policy 26 +#define Pragma_Ravenscar 27 +#define Pragma_Restricted_Run_Time 28 +#define Pragma_Restrictions 29 +#define Pragma_Restriction_Warnings 30 +#define Pragma_Reviewable 31 +#define Pragma_Source_File_Name 32 +#define Pragma_Source_File_Name_Project 33 +#define Pragma_Style_Checks 34 +#define Pragma_Suppress 35 +#define Pragma_Suppress_Exception_Locations 36 +#define Pragma_Task_Dispatching_Policy 37 +#define Pragma_Universal_Data 38 +#define Pragma_Unsuppress 39 +#define Pragma_Use_VADS_Size 40 +#define Pragma_Validity_Checks 41 +#define Pragma_Warnings 42 /* Remaining pragmas */ -#define Pragma_Abort_Defer 42 -#define Pragma_All_Calls_Remote 43 -#define Pragma_Annotate 44 -#define Pragma_Assert 45 -#define Pragma_Asynchronous 46 -#define Pragma_Atomic 47 -#define Pragma_Atomic_Components 48 -#define Pragma_Attach_Handler 49 -#define Pragma_Comment 50 -#define Pragma_Common_Object 51 -#define Pragma_Complex_Representation 52 -#define Pragma_Controlled 53 -#define Pragma_Convention 54 -#define Pragma_CPP_Class 55 -#define Pragma_CPP_Constructor 56 -#define Pragma_CPP_Virtual 57 -#define Pragma_CPP_Vtable 58 -#define Pragma_Debug 59 -#define Pragma_Elaborate 60 -#define Pragma_Elaborate_All 61 -#define Pragma_Elaborate_Body 62 -#define Pragma_Export 63 -#define Pragma_Export_Exception 64 -#define Pragma_Export_Function 65 -#define Pragma_Export_Object 66 -#define Pragma_Export_Procedure 67 -#define Pragma_Export_Value 68 -#define Pragma_Export_Valued_Procedure 69 -#define Pragma_External 70 -#define Pragma_Finalize_Storage_Only 71 -#define Pragma_Ident 72 -#define Pragma_Import 73 -#define Pragma_Import_Exception 74 -#define Pragma_Import_Function 75 -#define Pragma_Import_Object 76 -#define Pragma_Import_Procedure 77 -#define Pragma_Import_Valued_Procedure 78 -#define Pragma_Inline 79 -#define Pragma_Inline_Always 80 -#define Pragma_Inline_Generic 81 -#define Pragma_Inspection_Point 82 -#define Pragma_Interface 83 -#define Pragma_Interface_Name 84 -#define Pragma_Interrupt_Handler 85 -#define Pragma_Interrupt_Priority 86 -#define Pragma_Java_Constructor 87 -#define Pragma_Java_Interface 88 -#define Pragma_Keep_Names 89 -#define Pragma_Link_With 90 -#define Pragma_Linker_Alias 91 -#define Pragma_Linker_Options 92 -#define Pragma_Linker_Section 93 -#define Pragma_List 94 -#define Pragma_Machine_Attribute 95 -#define Pragma_Main 96 -#define Pragma_Main_Storage 97 -#define Pragma_Memory_Size 98 -#define Pragma_No_Return 99 -#define Pragma_Obsolescent 100 -#define Pragma_Optimize 101 -#define Pragma_Optional_Overriding 102 -#define Pragma_Overriding 103 -#define Pragma_Pack 104 -#define Pragma_Page 105 -#define Pragma_Passive 106 -#define Pragma_Preelaborate 107 -#define Pragma_Priority 108 -#define Pragma_Psect_Object 109 -#define Pragma_Pure 110 -#define Pragma_Pure_Function 111 -#define Pragma_Remote_Call_Interface 112 -#define Pragma_Remote_Types 113 -#define Pragma_Share_Generic 114 -#define Pragma_Shared 115 -#define Pragma_Shared_Passive 116 -#define Pragma_Source_Reference 117 -#define Pragma_Stream_Convert 118 -#define Pragma_Subtitle 119 -#define Pragma_Suppress_All 120 -#define Pragma_Suppress_Debug_Info 121 -#define Pragma_Suppress_Initialization 122 -#define Pragma_System_Name 123 -#define Pragma_Task_Info 124 -#define Pragma_Task_Name 125 -#define Pragma_Task_Storage 126 -#define Pragma_Thread_Body 127 -#define Pragma_Time_Slice 128 -#define Pragma_Title 129 -#define Pragma_Unchecked_Union 130 -#define Pragma_Unimplemented_Unit 131 -#define Pragma_Unreferenced 132 -#define Pragma_Unreserve_All_Interrupts 133 -#define Pragma_Volatile 134 -#define Pragma_Volatile_Components 135 -#define Pragma_Weak_External 136 +#define Pragma_Abort_Defer 43 +#define Pragma_All_Calls_Remote 44 +#define Pragma_Annotate 45 +#define Pragma_Assert 46 +#define Pragma_Asynchronous 47 +#define Pragma_Atomic 48 +#define Pragma_Atomic_Components 49 +#define Pragma_Attach_Handler 50 +#define Pragma_Comment 51 +#define Pragma_Common_Object 52 +#define Pragma_Complex_Representation 53 +#define Pragma_Controlled 54 +#define Pragma_Convention 55 +#define Pragma_CPP_Class 56 +#define Pragma_CPP_Constructor 57 +#define Pragma_CPP_Virtual 58 +#define Pragma_CPP_Vtable 59 +#define Pragma_Debug 60 +#define Pragma_Elaborate 61 +#define Pragma_Elaborate_All 62 +#define Pragma_Elaborate_Body 63 +#define Pragma_Export 64 +#define Pragma_Export_Exception 65 +#define Pragma_Export_Function 66 +#define Pragma_Export_Object 67 +#define Pragma_Export_Procedure 68 +#define Pragma_Export_Value 69 +#define Pragma_Export_Valued_Procedure 70 +#define Pragma_External 71 +#define Pragma_Finalize_Storage_Only 72 +#define Pragma_Ident 73 +#define Pragma_Import 74 +#define Pragma_Import_Exception 75 +#define Pragma_Import_Function 76 +#define Pragma_Import_Object 77 +#define Pragma_Import_Procedure 78 +#define Pragma_Import_Valued_Procedure 79 +#define Pragma_Inline 80 +#define Pragma_Inline_Always 81 +#define Pragma_Inline_Generic 82 +#define Pragma_Inspection_Point 83 +#define Pragma_Interface 84 +#define Pragma_Interface_Name 85 +#define Pragma_Interrupt_Handler 86 +#define Pragma_Interrupt_Priority 87 +#define Pragma_Java_Constructor 88 +#define Pragma_Java_Interface 89 +#define Pragma_Keep_Names 90 +#define Pragma_Link_With 91 +#define Pragma_Linker_Alias 92 +#define Pragma_Linker_Options 93 +#define Pragma_Linker_Section 94 +#define Pragma_List 95 +#define Pragma_Machine_Attribute 96 +#define Pragma_Main 97 +#define Pragma_Main_Storage 98 +#define Pragma_Memory_Size 99 +#define Pragma_No_Return 100 +#define Pragma_Obsolescent 101 +#define Pragma_Optimize 102 +#define Pragma_Optional_Overriding 103 +#define Pragma_Overriding 104 +#define Pragma_Pack 105 +#define Pragma_Page 106 +#define Pragma_Passive 107 +#define Pragma_Preelaborate 108 +#define Pragma_Priority 109 +#define Pragma_Psect_Object 110 +#define Pragma_Pure 111 +#define Pragma_Pure_Function 112 +#define Pragma_Remote_Call_Interface 113 +#define Pragma_Remote_Types 114 +#define Pragma_Share_Generic 115 +#define Pragma_Shared 116 +#define Pragma_Shared_Passive 117 +#define Pragma_Source_Reference 118 +#define Pragma_Stream_Convert 119 +#define Pragma_Subtitle 120 +#define Pragma_Suppress_All 121 +#define Pragma_Suppress_Debug_Info 122 +#define Pragma_Suppress_Initialization 123 +#define Pragma_System_Name 124 +#define Pragma_Task_Info 125 +#define Pragma_Task_Name 126 +#define Pragma_Task_Storage 127 +#define Pragma_Thread_Body 128 +#define Pragma_Time_Slice 129 +#define Pragma_Title 130 +#define Pragma_Unchecked_Union 131 +#define Pragma_Unimplemented_Unit 132 +#define Pragma_Unreferenced 133 +#define Pragma_Unreserve_All_Interrupts 134 +#define Pragma_Volatile 135 +#define Pragma_Volatile_Components 136 +#define Pragma_Weak_External 137 /* The following are deliberately out of alphabetical order, see Snames */ -#define Pragma_AST_Entry 137 -#define Pragma_Storage_Size 138 -#define Pragma_Storage_Unit 139 +#define Pragma_AST_Entry 138 +#define Pragma_Storage_Size 139 +#define Pragma_Storage_Unit 140 /* Define the numeric values for the conventions. */ diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb index b0b351d4f32..30d5d43471d 100644 --- a/gcc/ada/stylesw.adb +++ b/gcc/ada/stylesw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -134,7 +134,6 @@ package body Stylesw is procedure Set_Style_Check_Options (Options : String) is OK : Boolean; EC : Natural; - begin Set_Style_Check_Options (Options, OK, EC); end Set_Style_Check_Options; @@ -194,6 +193,9 @@ package body Stylesw is when 'n' => Style_Check_Standard := True; + when 'N' => + Reset_Style_Check_Options; + when 'M' => Style_Max_Line_Length := 0; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 7b42274316e..249274f52a7 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -441,6 +441,11 @@ begin Write_Line (" s check separate subprogram specs present"); Write_Line (" t check token separation rules"); + -- Lines for -gnatyN switch + + Write_Switch_Char ("yN"); + Write_Line ("Cancel all previously set style checks"); + -- Lines for -gnatz switch Write_Switch_Char ("z"); diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 3aa3837ab64..caba275c142 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2004 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- -- @@ -1761,6 +1761,8 @@ package VMS_Data is "-gnatyl " & "LINE_LENGTH " & "-gnatym " & + "NONE " & + "-gnatyN " & "STANDARD_CASING " & "-gnatyn " & "ORDERED_SUBPROGRAMS " & @@ -1975,6 +1977,8 @@ package VMS_Data is -- for possible special treatment of 80 character -- lines. -- + -- NONE Clear any previously set style checks. + -- -- ORDERED_SUBPROGRAMS Check order of subprogram bodies. -- All subprogram bodies in a given scope (e.g. -- a package body) must be in alphabetical order.