From fce68ebe21414ddb666ea729f21b515c1dedd5e7 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 11 Apr 2013 15:37:02 +0200 Subject: [PATCH] [multiple changes] 2013-04-11 Robert Dewar * sem_prag.adb, prj-env.adb: Minor reformatting. 2013-04-11 Ben Brosgol * gnat_ugn.texi: Clean ups. 2013-04-11 Yannick Moy * set_targ.adb: Minor comment update. From-SVN: r197798 --- gcc/ada/ChangeLog | 12 +++ gcc/ada/gnat_ugn.texi | 183 +++++++++++++----------------------------- gcc/ada/prj-env.adb | 4 +- gcc/ada/sem_prag.adb | 181 ++++++++++++++++++++--------------------- gcc/ada/set_targ.adb | 34 ++++++-- 5 files changed, 185 insertions(+), 229 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9628a886ba1..5451d7c82e2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2013-04-11 Robert Dewar + + * sem_prag.adb, prj-env.adb: Minor reformatting. + +2013-04-11 Ben Brosgol + + * gnat_ugn.texi: Clean ups. + +2013-04-11 Yannick Moy + + * set_targ.adb: Minor comment update. + 2013-04-11 Pascal Obry * gnat_ugn.texi: Remove obsolete comment about DLL calling diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index d84bc04d99b..9be0dbff2f2 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -169,9 +169,9 @@ AdaCore@* * About This Guide:: * Getting Started with GNAT:: * The GNAT Compilation Model:: -* Compiling Using gcc:: -* Binding Using gnatbind:: -* Linking Using gnatlink:: +* Compiling With gcc:: +* Binding With gnatbind:: +* Linking With gnatlink:: * The GNAT Make Program gnatmake:: * Improving Performance:: * Renaming Files Using gnatchop:: @@ -198,10 +198,10 @@ AdaCore@* * Performing Dimensionality Analysis in GNAT:: * Generating Ada Bindings for C and C++ headers:: * Other Utility Programs:: -* Running and Debugging Ada Programs:: @ifclear vms * Code Coverage and Profiling:: @end ifclear +* Running and Debugging Ada Programs:: @ifset vms * Compatibility with HP Ada:: @end ifset @@ -217,17 +217,15 @@ AdaCore@* * GNU Free Documentation License:: * Index:: - --- The Detailed Node Listing --- + --- Detailed Contents --- About This Guide - * What This Guide Contains:: * What You Should Know before Reading This Guide:: * Related Information:: * Conventions:: Getting Started with GNAT - * Running GNAT:: * Running a Simple Ada Program:: * Running a Program with Multiple Units:: @@ -240,7 +238,6 @@ Getting Started with GNAT @end ifclear The GNAT Compilation Model - * Source Representation:: * Foreign Language Representation:: * File Naming Rules:: @@ -260,67 +257,25 @@ The GNAT Compilation Model * Placement of temporary files:: @end ifset -Foreign Language Representation - -* Latin-1:: -* Other 8-Bit Codes:: -* Wide Character Encodings:: - -Compiling Ada Programs With gcc - +Compiling With gcc * Compiling Programs:: * Switches for gcc:: * Search Paths and the Run-Time Library (RTL):: * Order of Compilation Issues:: * Examples:: -Switches for gcc - -* Output and Error Message Control:: -* Warning Message Control:: -* Debugging and Assertion Control:: -* Validity Checking:: -* Style Checking:: -* Run-Time Checks:: -* Using gcc for Syntax Checking:: -* Using gcc for Semantic Checking:: -* Compiling Different Versions of Ada:: -* Character Set Control:: -* File Naming Control:: -* Subprogram Inlining Control:: -* Auxiliary Output Control:: -* Debugging Control:: -* Exception Handling Control:: -* Units to Sources Mapping Files:: -* Integrated Preprocessing:: -@ifset vms -* Return Codes:: -@end ifset - -Binding Ada Programs With gnatbind - +Binding With gnatbind * Running gnatbind:: * Switches for gnatbind:: * Command-Line Access:: * Search Paths for gnatbind:: * Examples of gnatbind Usage:: -Switches for gnatbind - -* Consistency-Checking Modes:: -* Binder Error Message Control:: -* Elaboration Control:: -* Output Control:: -* Binding with Non-Ada Main Programs:: -* Binding Programs with No Main Subprogram:: - -Linking Using gnatlink - +Linking With gnatlink * Running gnatlink:: * Switches for gnatlink:: The GNAT Make Program gnatmake - * Running gnatmake:: * Switches for gnatmake:: * Mode Switches for gnatmake:: @@ -334,33 +289,7 @@ Improving Performance * Reducing Size of Ada Executables with gnatelim:: * Reducing Size of Executables with unused subprogram/data elimination:: -Performance Considerations -* Controlling Run-Time Checks:: -* Use of Restrictions:: -* Optimization Levels:: -* Debugging Optimized Code:: -* Inlining of Subprograms:: -* Vectorization of loops:: -* Other Optimization Switches:: -* Optimization and Strict Aliasing:: -@ifset vms -* Coverage Analysis:: -@end ifset - -Reducing Size of Ada Executables with gnatelim -* About gnatelim:: -* Running gnatelim:: -* Processing Precompiled Libraries:: -* Correcting the List of Eliminate Pragmas:: -* Making Your Executables Smaller:: -* Summary of the gnatelim Usage Cycle:: - -Reducing Size of Executables with unused subprogram/data elimination -* About unused subprogram/data elimination:: -* Compilation options:: - Renaming Files Using gnatchop - * Handling Files with Multiple Units:: * Operating gnatchop in Compilation Mode:: * Command Line for gnatchop:: @@ -368,19 +297,34 @@ Renaming Files Using gnatchop * Examples of gnatchop Usage:: Configuration Pragmas - * Handling of Configuration Pragmas:: * The Configuration Pragmas Files:: Handling Arbitrary File Naming Conventions Using gnatname - * Arbitrary File Naming Conventions:: * Running gnatname:: * Switches for gnatname:: * Examples of gnatname Usage:: -The Cross-Referencing Tools gnatxref and gnatfind +GNAT Project Manager +* Introduction:: +* Building With Projects:: +* Organizing Projects into Subsystems:: +* Scenarios in Projects:: +* Library Projects:: +* Project Extension:: +* Aggregate Projects:: +* Aggregate Library Projects:: +* Project File Reference:: + +Tools Supporting Project Files +* Switches Related to Project Files:: +* Switches and Project Files:: +* Specifying Configuration Pragmas:: +* Project Files and Main Subprograms:: +* Library Project Files:: +The Cross-Referencing Tools gnatxref and gnatfind * Switches for gnatxref:: * Switches for gnatfind:: * Project Files for gnatxref and gnatfind:: @@ -389,16 +333,13 @@ The Cross-Referencing Tools gnatxref and gnatfind * Examples of gnatfind Usage:: The GNAT Pretty-Printer gnatpp - * Switches for gnatpp:: * Formatting Rules:: The GNAT Metrics Tool gnatmetric - * Switches for gnatmetric:: File Name Krunching Using gnatkr - * About gnatkr:: * Using gnatkr:: * Krunching Method:: @@ -412,28 +353,23 @@ Preprocessing Using gnatprep * Form of Input Text for gnatprep:: The GNAT Library Browser gnatls - * Running gnatls:: * Switches for gnatls:: * Examples of gnatls Usage:: Cleaning Up Using gnatclean - * Running gnatclean:: * Switches for gnatclean:: @c * Examples of gnatclean Usage:: @ifclear vms - GNAT and Libraries - * Introduction to Libraries in GNAT:: * General Ada Libraries:: * Stand-alone Ada Libraries:: * Rebuilding the GNAT Run-Time Library:: Using the GNU make Utility - * Using gnatmake in a Makefile:: * Automatically Creating a List of Directories:: * Generating the Command Line Switches:: @@ -441,7 +377,6 @@ Using the GNU make Utility @end ifclear Memory Management Issues - * Some Useful Memory Pools:: * The GNAT Debug Pool Facility:: @ifclear vms @@ -449,20 +384,17 @@ Memory Management Issues @end ifclear Stack Related Facilities - * Stack Overflow Checking:: * Static Stack Usage Analysis:: * Dynamic Stack Usage Analysis:: Verifying Properties Using gnatcheck -Sample Bodies Using gnatstub - +Creating Sample Bodies Using gnatstub * Running gnatstub:: * Switches for gnatstub:: Creating Unit Tests Using gnattest - * Running gnattest:: * Switches for gnattest:: * Project Attributes for gnattest:: @@ -480,21 +412,30 @@ Creating Unit Tests Using gnattest @end ifclear * Current Limitations:: -Other Utility Programs +Performing Dimensionality Analysis in GNAT + +Generating Ada Bindings for C and C++ headers +* Running the binding generator:: +* Generating bindings for C++ headers:: +* Switches:: +Other Utility Programs * Using Other Utility Programs with GNAT:: * The External Symbol Naming Scheme of GNAT:: * Converting Ada Files to html with gnathtml:: +* Installing gnathtml:: +@ifset vms +* LSE:: +* Profiling:: +@end ifset @ifclear vms Code Coverage and Profiling - * Code Coverage of Ada Programs using gcov:: * Profiling an Ada Program using gprof:: @end ifclear Running and Debugging Ada Programs - * The GNAT Debugger GDB:: * Running GDB:: * Introduction to GDB Commands:: @@ -510,13 +451,8 @@ Running and Debugging Ada Programs * Getting Internal Debugging Information:: * Stack Traceback:: -@ifset vms -* LSE:: -@end ifset - @ifset vms Compatibility with HP Ada - * Ada Language Compatibility:: * Differences in the Definition of Package System:: * Language-Related Features:: @@ -535,7 +471,6 @@ Compatibility with HP Ada * Tools and Utilities:: Language-Related Features - * Integer Types and Representations:: * Floating-Point Types and Representations:: * Pragmas Float_Representation and Long_Float:: @@ -545,7 +480,6 @@ Language-Related Features * Other Representation Clauses:: Tasking and Task-Related Features - * Implementation of Tasks in HP Ada for OpenVMS Alpha Systems:: * Assigning Task IDs:: * Task IDs and Delays:: @@ -555,23 +489,19 @@ Tasking and Task-Related Features * External Interrupts:: Pragmas and Pragma-Related Features - * Restrictions on the Pragma INLINE:: * Restrictions on the Pragma INTERFACE:: * Restrictions on the Pragma SYSTEM_NAME:: Library of Predefined Units - * Changes to DECLIB:: Bindings - * Shared Libraries and Options Files:: * Interfaces to C:: @end ifset Platform-Specific Information for the Run-Time Libraries - * Summary of Run-Time Configurations:: * Specifying a Run-Time Library:: * Choosing the Scheduling Policy:: @@ -584,7 +514,6 @@ Platform-Specific Information for the Run-Time Libraries Example of Binder Output File Elaboration Order Handling in GNAT - * Elaboration Code:: * Checking the Elaboration Order:: * Controlling the Elaboration Order:: @@ -614,7 +543,6 @@ Conditional Compilation * Preprocessing:: Inline Assembler - * Basic Assembler Syntax:: * A Simple Example of Inline Assembler:: * Output Variables in Inline Assembler:: @@ -623,7 +551,6 @@ Inline Assembler * Other Asm Functionality:: Compatibility and Porting Guide - * Compatibility with Ada 83:: * Compatibility between Ada 95 and Ada 2005:: * Implementation-dependent characteristics:: @@ -639,7 +566,6 @@ Compatibility and Porting Guide @end ifset Microsoft Windows Topics - @ifclear FSFEDITION * Installing from the Command Line:: @end ifclear @@ -658,10 +584,11 @@ Microsoft Windows Topics * Setting Heap Size from gnatlink:: Mac OS Topics - * Codesigning the Debugger:: -* Index:: +GNU Free Documentation License + +Index @end menu @end ifnottex @@ -723,16 +650,16 @@ and running Ada programs with the GNAT Ada programming environment. by GNAT. @item -@ref{Compiling Using gcc}, describes how to compile +@ref{Compiling With gcc}, describes how to compile Ada programs with @command{gcc}, the Ada compiler. @item -@ref{Binding Using gnatbind}, describes how to +@ref{Binding With gnatbind}, describes how to perform binding of Ada programs with @code{gnatbind}, the GNAT binding utility. @item -@ref{Linking Using gnatlink}, +@ref{Linking With gnatlink}, describes @command{gnatlink}, a program that provides for linking using the GNAT run-time library to construct a program. @command{gnatlink} can also incorporate foreign language @@ -3798,8 +3725,8 @@ GNAT uses the current directory for temporary files. @end ifset @c ************************* -@node Compiling Using gcc -@chapter Compiling Using @command{gcc} +@node Compiling With gcc +@chapter Compiling With @command{gcc} @noindent This chapter discusses how to compile Ada programs using the @command{gcc} @@ -7088,7 +7015,7 @@ on subprogram calls and generic instantiations. Note that @option{-gnatE} is not necessary for safety, because in the default mode, GNAT ensures statically that the checks would not fail. For full details of the effect and use of this switch, -@xref{Compiling Using gcc}. +@xref{Compiling With gcc}. @item -fstack-check @cindex @option{-fstack-check} (@command{gcc}) @@ -8280,8 +8207,8 @@ Compile the subunit in file @file{abc-def.adb} in semantic-checking-only mode. @end table -@node Binding Using gnatbind -@chapter Binding Using @code{gnatbind} +@node Binding With gnatbind +@chapter Binding With @code{gnatbind} @findex gnatbind @menu @@ -9276,8 +9203,8 @@ since gnatlink will not be able to find the generated file. @end table @c ------------------------------------ -@node Linking Using gnatlink -@chapter Linking Using @command{gnatlink} +@node Linking With gnatlink +@chapter Linking With @command{gnatlink} @c ------------------------------------ @findex gnatlink @@ -29729,6 +29656,12 @@ end API; @end group @end smallexample +@noindent +Note that a variable is +@strong{always imported with a DLL convention}. A function +can have @code{C} or @code{Stdcall} convention. +(@pxref{Windows Calling Conventions}). + @node Creating an Import Library @subsection Creating an Import Library @cindex Import library diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index ee4d0396fb2..67b077f372f 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -23,8 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Text_IO; use Ada.Text_IO; - with Fmap; with Hostparm; with Makeutl; use Makeutl; @@ -35,6 +33,8 @@ with Prj.Com; use Prj.Com; with Sdefault; with Tempdir; +with Ada.Text_IO; use Ada.Text_IO; + with GNAT.Directory_Operations; use GNAT.Directory_Operations; package body Prj.Env is diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 7c27f0f927b..c31056cdd60 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -401,9 +401,8 @@ package body Sem_Prag is Error_Msg_Name_2 := Name_Class; Error_Msg_N - ("aspect `%''%` can only be specified for a primitive " & - "operation of a tagged type", - Corresponding_Aspect (N)); + ("aspect `%''%` can only be specified for a primitive " + & "operation of a tagged type", Corresponding_Aspect (N)); end if; Replace_Type (Get_Pragma_Arg (Arg1)); @@ -1430,8 +1429,8 @@ package body Sem_Prag is and then not Is_Unchecked_Union (Etype (Subtype_Mark (Sindic))) then Error_Msg_N - ("component subtype subject to per-object constraint " & - "must be an Unchecked_Union", Comp); + ("component subtype subject to per-object constraint " + & "must be an Unchecked_Union", Comp); -- Ada 2012 (AI05-0026): For an unchecked union type declared within -- the body of a generic unit, or within the body of any of its @@ -1948,12 +1947,12 @@ package body Sem_Prag is begin if Nkind (Constr) = N_Pragma then Error_Pragma - ("pragma % must appear immediately within the statements " & - "of a loop"); + ("pragma % must appear immediately within the statements " + & "of a loop"); else Error_Pragma_Arg - ("block containing pragma % must appear immediately within " & - "the statements of a loop", Constr); + ("block containing pragma % must appear immediately within " + & "the statements of a loop", Constr); end if; end Placement_Error; @@ -3482,9 +3481,8 @@ package body Sem_Prag is and then C /= Convention (Overridden_Operation (E)) then Error_Pragma_Arg - ("cannot change convention for " & - "overridden dispatching operation", - Arg1); + ("cannot change convention for overridden " + & "dispatching operation", Arg1); end if; -- Set the convention @@ -4796,8 +4794,8 @@ package body Sem_Prag is then Error_Msg_Sloc := Sloc (Def_Id); Error_Msg_NE - ("cannot import&, renaming already provided for " & - "declaration #", N, Def_Id); + ("cannot import&, renaming already provided for " + & "declaration #", N, Def_Id); end if; end; @@ -6878,8 +6876,8 @@ package body Sem_Prag is (not Input_Seen and then not Output_Seen)) -- none then Error_Msg_N - ("property Volatile requires exactly one Input or " & - "Output", State); + ("property Volatile requires exactly one Input or " + & "Output", State); end if; -- Either Input or Output require Volatile @@ -7606,8 +7604,7 @@ package body Sem_Prag is -- unit (RM E.4.1(4)). Error_Pragma - ("pragma% not in Remote_Call_Interface or " & - "Remote_Types unit"); + ("pragma% not in Remote_Call_Interface or Remote_Types unit"); end if; if Ekind (Nm) = E_Procedure @@ -8238,8 +8235,8 @@ package body Sem_Prag is and then not Is_Array_Type (Typ) then Error_Pragma_Arg - ("Name parameter of pragma% must identify record or " & - "array type", Name); + ("Name parameter of pragma% must identify record or " + & "array type", Name); end if; -- An explicit Component_Alignment pragma overrides an @@ -8525,10 +8522,9 @@ package body Sem_Prag is GNAT_Pragma; if Warn_On_Obsolescent_Feature then - -- Following message is obsolete ??? Error_Msg_N - ("'G'N'A'T pragma cpp'_class is now obsolete and has no " & - "effect; replace it by pragma import?j?", N); + ("'G'N'A'T pragma cpp'_class is now obsolete and has no " + & "effect; replace it by pragma import?j?", N); end if; Check_Arg_Count (1); @@ -8591,8 +8587,8 @@ package body Sem_Prag is then if Scope (Def_Id) /= Scope (Etype (Def_Id)) then Error_Msg_N - ("'C'P'P constructor must be defined in the scope of " & - "its returned type", Arg1); + ("'C'P'P constructor must be defined in the scope of " + & "its returned type", Arg1); end if; if Arg_Count >= 2 then @@ -8652,8 +8648,8 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("'G'N'A'T pragma cpp'_virtual is now obsolete and has " & - "no effect?j?", N); + ("'G'N'A'T pragma cpp'_virtual is now obsolete and has " + & "no effect?j?", N); end if; end CPP_Virtual; @@ -8667,8 +8663,8 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("'G'N'A'T pragma cpp'_vtable is now obsolete and has " & - "no effect?j?", N); + ("'G'N'A'T pragma cpp'_vtable is now obsolete and has " + & "no effect?j?", N); end if; end CPP_Vtable; @@ -9071,8 +9067,8 @@ package body Sem_Prag is then Error_Msg_Name_1 := Name_Result; Error_Msg_N - ("prefix of attribute % must denote the enclosing " & - "function", Item); + ("prefix of attribute % must denote the enclosing " + & "function", Item); -- Function'Result is allowed to appear on the output -- side of a dependency clause. @@ -9096,8 +9092,8 @@ package body Sem_Prag is if Is_Output and then not Is_Last then Error_Msg_N - ("null output list must be the last clause in " & - "a dependency relation", Item); + ("null output list must be the last clause in " + & "a dependency relation", Item); end if; end if; @@ -9142,8 +9138,8 @@ package body Sem_Prag is and then Contains (All_Inputs_Seen, Item_Id) then Error_Msg_N - ("input of a null output list appears in " & - "multiple input lists", Item); + ("input of a null output list appears in " + & "multiple input lists", Item); else if No (All_Inputs_Seen) then All_Inputs_Seen := New_Elmt_List; @@ -9165,16 +9161,16 @@ package body Sem_Prag is else Error_Msg_N - ("item must denote variable, state or formal " & - "parameter", Item); + ("item must denote variable, state or formal " + & "parameter", Item); end if; -- All other input/output items are illegal else Error_Msg_N - ("item must denote variable, state or formal " & - "parameter", Item); + ("item must denote variable, state or formal " + & "parameter", Item); end if; end if; end Analyze_Input_Output; @@ -10047,8 +10043,8 @@ package body Sem_Prag is Present (Source_Location) then Error_Pragma - ("parameter profile and source location cannot " & - "be used together in pragma%"); + ("parameter profile and source location cannot " + & "be used together in pragma%"); end if; Process_Eliminate_Pragma @@ -10904,8 +10900,8 @@ package body Sem_Prag is if Ekind (Item_Id) = E_Abstract_State and then Is_Volatile_State (Item_Id) then - -- A global item of mode In_Out or Output cannot denote a - -- volatile Input state. + -- A global item of mode In_Out or Output cannot denote + -- a volatile Input state. if Is_Input_State (Item_Id) and then (Global_Mode = Name_In_Out @@ -10913,8 +10909,8 @@ package body Sem_Prag is Global_Mode = Name_Output) then Error_Msg_N - ("global item of mode In_Out or Output cannot " & - "reference Volatile Input state", Item); + ("global item of mode In_Out or Output cannot " + & "reference Volatile Input state", Item); -- A global item of mode In_Out or Input cannot reference -- a volatile Output state. @@ -11316,8 +11312,8 @@ package body Sem_Prag is null; else Error_Pragma_Arg - ("controlling formal must be of synchronized " & - "tagged type", Arg1); + ("controlling formal must be of synchronized " + & "tagged type", Arg1); return; end if; @@ -11345,8 +11341,8 @@ package body Sem_Prag is and then Is_Task_Interface (Typ) then Error_Pragma_Arg - ("implementation kind By_Protected_Procedure cannot be " & - "applied to a task interface primitive", Arg2); + ("implementation kind By_Protected_Procedure cannot be " + & "applied to a task interface primitive", Arg2); return; end if; @@ -12168,8 +12164,8 @@ package body Sem_Prag is Int_Val > Expr_Value (Type_High_Bound (Int_Id)) then Error_Pragma_Arg - ("value not in range of type " & - """Ada.Interrupts.Interrupt_'I'D""", Arg1); + ("value not in range of type " + & """Ada.Interrupts.Interrupt_'I'D""", Arg1); end if; end if; @@ -12275,8 +12271,8 @@ package body Sem_Prag is elsif In_Private_Part (Current_Scope) then Error_Pragma_Arg - ("pragma% only allowed for private type " & - "declared in visible part", Arg1); + ("pragma% only allowed for private type " + & "declared in visible part", Arg1); else Error_Pragma_Arg @@ -12369,12 +12365,12 @@ package body Sem_Prag is if Ekind (Def_Id) /= E_Function then if VM_Target = JVM_Target then Error_Pragma_Arg - ("pragma% requires function returning a " & - "'Java access type", Def_Id); + ("pragma% requires function returning a " + & "'Java access type", Def_Id); else Error_Pragma_Arg - ("pragma% requires function returning a " & - "'C'I'L access type", Def_Id); + ("pragma% requires function returning a " + & "'C'I'L access type", Def_Id); end if; end if; @@ -12470,8 +12466,8 @@ package body Sem_Prag is then Error_Msg_Name_1 := Pname; Error_Msg_N - ("first formal of % function must be a named access" & - " to subprogram type", + ("first formal of % function must be a named access " + & "to subprogram type", Parameter_Type (Parent (This_Formal))); -- Warning: We should reject anonymous access types because @@ -12487,9 +12483,8 @@ package body Sem_Prag is then Error_Msg_Name_1 := Pname; Error_Msg_N - ("first formal of % function must be a named access" & - " type", - Parameter_Type (Parent (This_Formal))); + ("first formal of % function must be a named access " + & " type", Parameter_Type (Parent (This_Formal))); elsif Atree.Convention (Designated_Type (Etype (This_Formal))) /= Convention @@ -12498,14 +12493,12 @@ package body Sem_Prag is if Convention = Convention_Java then Error_Msg_N - ("pragma% requires convention 'Cil in designated" & - " type", - Parameter_Type (Parent (This_Formal))); + ("pragma% requires convention 'Cil in designated " + & "type", Parameter_Type (Parent (This_Formal))); else Error_Msg_N - ("pragma% requires convention 'Java in designated" & - " type", - Parameter_Type (Parent (This_Formal))); + ("pragma% requires convention 'Java in designated " + & "type", Parameter_Type (Parent (This_Formal))); end if; elsif No (Expression (Parent (This_Formal))) @@ -12534,13 +12527,13 @@ package body Sem_Prag is if Atree.Convention (Etype (Def_Id)) /= Convention then if Convention = Convention_Java then Error_Pragma_Arg - ("pragma% requires function returning a " & - "'Java access type", Arg1); + ("pragma% requires function returning a " + & "'Java access type", Arg1); else pragma Assert (Convention = Convention_CIL); Error_Pragma_Arg - ("pragma% requires function returning a " & - "'C'I'L access type", Arg1); + ("pragma% requires function returning a " + & "'C'I'L access type", Arg1); end if; end if; @@ -12555,12 +12548,12 @@ package body Sem_Prag is if Convention = Convention_Java then Error_Pragma_Arg - ("pragma% requires function returning a named" & - "'Java access type", Arg1); + ("pragma% requires function returning a named " + & "'Java access type", Arg1); else Error_Pragma_Arg - ("pragma% requires function returning a named" & - "'C'I'L access type", Arg1); + ("pragma% requires function returning a named " + & "'C'I'L access type", Arg1); end if; end if; end if; @@ -13585,8 +13578,8 @@ package body Sem_Prag is loop if No (Ent) then Error_Pragma - ("pragma % entity name does not match any " & - "enumeration literal"); + ("pragma % entity name does not match any " + & "enumeration literal"); elsif Chars (Ent) = Chars (Ename) then Set_Entity (Ename, Ent); @@ -14154,8 +14147,8 @@ package body Sem_Prag is and then not Has_Preelaborable_Initialization (Ent) then Error_Msg_N - ("protected type & does not have preelaborable " & - "initialization", Ent); + ("protected type & does not have preelaborable " + & "initialization", Ent); -- Otherwise mark the type as definitely having preelaborable -- initialization. @@ -14614,8 +14607,8 @@ package body Sem_Prag is elsif Lower_Val > Upper_Val then Error_Pragma - ("last_priority_expression must be greater than" & - " or equal to first_priority_expression"); + ("last_priority_expression must be greater than " + & "or equal to first_priority_expression"); -- Store the new policy, but always preserve System_Location since -- we like the error message with the run-time name. @@ -15457,8 +15450,8 @@ package body Sem_Prag is or else In_Package_Body (Current_Scope) then Error_Pragma - ("pragma% can only apply to type declared immediately " & - "within a package declaration"); + ("pragma% can only apply to type declared immediately" + & " within a package declaration"); end if; -- A simple storage pool type must be an immutably limited record @@ -15696,8 +15689,8 @@ package body Sem_Prag is or else Present (Next_Formal (First_Formal (Ent))) then Error_Pragma_Arg - ("argument for pragma% must be" & - " function of one argument", Arg); + ("argument for pragma% must be function of one argument", + Arg); end if; end Check_OK_Stream_Convert_Function; @@ -16831,8 +16824,8 @@ package body Sem_Prag is elsif not Is_Static_String_Expression (Arg1) then Error_Pragma_Arg - ("argument of pragma% must be On/Off or " & - "static string expression", Arg1); + ("argument of pragma% must be On/Off or " + & "static string expression", Arg1); -- One argument string expression case @@ -16876,8 +16869,8 @@ package body Sem_Prag is if not Set_Dot_Warning_Switch (Chr) then Error_Pragma_Arg - ("invalid warning switch character " & - '.' & Chr, Arg1); + ("invalid warning switch character " + & '.' & Chr, Arg1); end if; -- Non-Dot case @@ -16970,8 +16963,8 @@ package body Sem_Prag is elsif not Is_Static_String_Expression (Arg2) then Error_Pragma_Arg - ("second argument of pragma% must be entity " & - "name or static string expression", Arg2); + ("second argument of pragma% must be entity " + & "name or static string expression", Arg2); -- String literal case @@ -17010,8 +17003,8 @@ package body Sem_Prag is if Err then Error_Msg - ("??pragma Warnings On with no " & - "matching Warnings Off", + ("??pragma Warnings On with no " + & "matching Warnings Off", Loc); end if; end if; diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb index bc8cf674fcf..4b0c75c4b65 100755 --- a/gcc/ada/set_targ.adb +++ b/gcc/ada/set_targ.adb @@ -487,22 +487,40 @@ begin pragma Import (C, save_argv); -- Saved value of argv (argument pointers), imported from misc.c + function Len_Arg (Arg : Pos) return Nat; + -- Determine length of argument number Arg on original gnat1 command + -- line. + + ------------- + -- Len_Arg -- + ------------- + + function Len_Arg (Arg : Pos) return Nat is + begin + for J in 1 .. Nat'Last loop + if save_argv (Arg).all (Natural (J)) = ASCII.NUL then + return J - 1; + end if; + end loop; + + raise Program_Error; + end Len_Arg; + begin -- Loop through arguments looking for -gnateT, also look for -gnatd.b for Arg in 1 .. save_argc - 1 loop declare Argv_Ptr : constant Big_String_Ptr := save_argv (Arg); + Argv_Len : constant Nat := Len_Arg (Arg); begin - - -- ??? Is there no problem accessing at indices 1 to 7 or 8 - -- without first checking if the length of the underlying string - -- may be smaller? See back_end.adb for an example where function - -- Len_Arg is used to retrieve this length. - - if Argv_Ptr (1 .. 7) = "-gnateT" then + if Argv_Len = 7 + and then Argv_Ptr (1 .. 7) = "-gnateT" + then Opt.Target_Dependent_Info_Read := True; - elsif Argv_Ptr (1 .. 8) = "-gnatd.b" then + elsif Argv_Len >= 8 + and then Argv_Ptr (1 .. 8) = "-gnatd.b" + then Debug_Flag_Dot_B := True; end if; end; -- 2.30.2