For v2003.06.01 Release $Revision: 1.25 $ Support: ------------- Language : Ada - Ada83 Features : Component Testing - Code Coverage Tested Against: ------------------------ Host Machine : Windows 2000 Compiler : Rational Apex Ada 4.0.0 - Rational Apex Ada 4.2.0 Linker : Rational Apex Ada 4.0.0 - Rational Apex Ada 4.2.0 Debugger : Rational Apex Ada 4.0.0 - Rational Apex Ada 4.2.0 OS : Native Target : Native 1 - Setup of the Apex GUI/TestRT integration (needs product administrator permissions on Apex and TestRT installations) - add the path of the Apex TDP's cmd directory to the Apex %APEX_MENUS_PATH% (so that Apex may find the ada_menus and ada_rules file in this directory). 2 - Setup of Test RealTime runtime and model views (needs product administrator permissions on Apex installation) Before creating test views with Apex, the appropriate set(s) of Test RealTime runtime and model views should be setup, based on the model(s) of the Apex views containing the units to test. - This may be done using the 'testrtbuild' script provided with the TDP, using the '-model' option to designate the base model from which the runtime view should be built, and the new model (which includes an import of the runtime view) generated. - This may also be done by selecting in an Apex directory viewer a user view with the appropriate base model, and using the 'TestRT> Maintenance> Build Test runtime and model views' menu item. 3 - Component Testing / Code Coverage / Trace - Select in the Apex directory browser the tower of views containing the units to test. This may be done by explicit selection of a (single) view or/and by selection of configuration files listing the views. - In the Apex menu, select 'TestRT> Component Testing> Create Test Tower'. This will generate a copy (The TestRT tower) of the origin tower to be used to build and execute Rational Test Realtime tests. Views in this new tower have a '_TestRT' suffix. - Launch 'Studio', the Rational Test RealTime GUI. - Create a new project. - Choose a name for your project. - Choose the Rational Apex TDP. - Create a new Component Testing Activity. - Select (in the origin tower) the unit to test. - The name of the Component Testing node should be the Ada name of the unit under test. - In 'Settings...> Build> Compiler', change the setting for 'User Link File for Ada' to be the 'link.alk' file in the TestRT view containing the unit under test. - In 'Settings...> General> Directories', change the setting for 'Temporary' directory to be the 'TestRT' subdirectory of the TestRT view containing the unit under test. - Then complete the creation of your project as usual. Once the project has been generated, the user can use Rational Test RealTime with Rational Apex as usual. Note: - Using 'TestRT> Component Testing> Create Test Tower' when the Test tower already exists simply re-generates the 'link file' in the existing tower. - To force the deletion/re-creation of any existing views in the Test tower, use 'TestRT> Component Testing> Re-create Test Tower' . 4 - Code Coverage Standalone mode - Select in the Apex directory browser the tower of views containing the units to instrument. This may be done by explicit selection of a (single) view or/and by selection of configuration files listing the views. - In the Apex menu, select 'TestRT> Code Coverage> Code Coverage Options...'. Enable these options and modify them as desired. Do not forget to specify the dump point in 'Function-specific Dump'. - In the Apex menu, select 'TestRT> Code Coverage> Create Instrumented Tower'. This will generate a copy (The Coverage tower) of the origin tower containing instrumented versions of the unit. Views in this new tower have a '_TestRT_Cov' suffix. - The instrumentation options (and name of the main procedure) used will be those listed in the 'coverage_<userid>.opt' options file of the Coverage tower (this file will be created if not present in the origin tower). - Link this main procedure in the Coverage tower to generate the instrumented executable. - Run this executable. - Select the 'attolcov.spt' traces file that gets generated in the same view. - In the Apex menu, select 'TestRT> Code Coverage> View Coverage Report'. This will launch the Rational Test RealTime GUI to display the coverage results. Note: - Using 'TestRT> Code Coverage> Create Instrumented Tower' when the Coverage tower already exists simply re-instruments the units in the existing tower (with different options if the options file was modified). - To force the deletion/re-creation of any existing views in the Coverage tower, use 'TestRT> Code Coverage> Re-create Instrumented Tower' . ada o exe ENV_ATTOLCHOP APEX ada o exe ENV_ATTOLCHOP APEX Does not in fact compile the source file. Runs attochop to generate appropriately named unit(s) in target INTDIR (which should be in an Apex testing view). sub atl_cc($$$$\@\@) { my ( $lang,$src,$out,$cflags,$Defines,$Includes) = @_; if ( ! ( $INTDIR=~/\.wrk\\.+/ ) && ( ! ( $INTDIR=~/\.rss\\.+/ ) ) ) # Win32 { print "!!! The temporary directory must be a subdirectory of an Apex test view\n"; print "--- Please modify your project settings\n"; return 1; } print "--- Chopping $src\n"; my $attolchop = "attolchop"; # if ( ! -e $attolchop ) # { # $attolchop .= ".exe" ; # if ( ! -e $attolchop ) # { # print "*** Cannot find attolchop executable\n"; # return 1; # } # } my $status=SystemP("$attolchop -w \"$src\" \"$INTDIR\""); return $status; } 1; Stubs units as needed and uses Apex link command to link main unit - this will trigger any needed (re-)compilations. sub atl_link($\@$\@$) { my ($exe,$Objects,$ldflags,$LibPath,$libs) = @_; if ( ! ( $INTDIR=~/\.wrk\\.+/ ) && ( ! ( $INTDIR=~/\.rss\\.+/ ) ) ) # Win32 { print "!!! The 'temporary' directory must be a subdirectory of an Apex test view\n"; print "--- Please modify your project settings\n"; return 1; } my $main = $ATL_MAIN_PROCEDURE; print "--- Linking $main into $exe\n"; if (!defined $ENV{'APEX_BASE_PORT'}) # Win32 { print "*** You must be in the context of an Apex session!\n"; return (2); } #Suppress executable before linking unlink("$exe"); unlink("$INTDIR/$main.exe"); print "--- Parsing link file...\n"; ($Link_TestRT=$USER_ALK_FILE)=~s/link\.alk$/\.Rational\/TestRT\/link\.alk/; open(IN_LNK,"<$Link_TestRT") || die "*** Cannot open $Link_TestRT link file\n"; my $stubs_lst="$INTDIR/stubs.lst"; open(OU_LNK,">$stubs_lst") || die "*** Cannot create $stubs_lst file\n"; while(<IN_LNK>) { next if (/--file-/); my $file=(split(/\s+/))[0]; $file=~s/"//g; if ( NeedToMask ($file) ) { print "+++ Masking original $file\n"; if ( ! ( $file=~/_TestRT\.wrk\\/ ) && ( ! ( $file=~/_TestRT\.rss\\/ ) ) ) # Win32 { print "*** Cannot stub units which are not located in a test view\n"; exit(1); } rename("$file","$file.orig"); print OU_LNK "$file\n"; } } close(IN_LNK); close(OU_LNK); # Use Apex link command to link main unit - this will trigger any needed (re-)compilations. $ENV{'APEX_PREFIX_LAYOUT'}="symbols"; # no time stamps in Apex messages... $Status=SystemP("apex -context $INTDIR link $INTDIR/$main.2.ada"); # Win32 ('-context' needed when using ClearCase) # # Rename back original filenames before returning # open(IN_STUB,"<$stubs_lst") || die "*** Cannot open $stubs_lst file\n"; while(<IN_STUB>) { $file=$_; chomp($file); print "+++ Restoring original $file\n"; rename("$file.orig","$file"); ## CleanupStub ($file); # Unfortunately can't do this (stub would not be regenerated on next build!?) } close(IN_STUB); unlink("$stubs_lst"); # Create desired file for linked executable rename("$INTDIR/$main.exe","$exe"); # Win32 #system("chmod 777 $INTDIR/$exe"); # WIn32 # Cleanup temporary directory (brute-force workaround to cleanup stubs) chdir("$INTDIR"); # Win32 system("$ENV{'COMSPEC'} /c del/q *.ada"); # Win32 return($Status); } ########################################################### # Utility function: determine if an (original) file needs # # to be masked from Apex (because a stub was generated). # ########################################################### sub NeedToMask ($) { my ($filename) = @_; my ($dir,$name,$kind,$ext) = SplitApexName ($filename); my $stub="$name.$kind.$ext"; if ( -e "$INTDIR/$stub" ) { return (1); # stub exists: mask original } # No stub generated for unit itself. # but could it be a separate from a stubbed unit? my ($unit, $subunit) = ($name =~ /^(\w+)\.*(.*)$/); if ( ( $kind eq "2" ) && ( $subunit ne "" ) ) { my $spec="$dir/$name.1.$ext"; # possible original spec if ( -e "$spec" ) { return (0); # spec exists: this is a child unit } else { # this is a separate my $parentstub="$unit.2.$ext"; # possible stub for parent unit if ( -e "$INTDIR/$parentstub" ) { return (1); # stub exists for parent: mask original separate } else { return (0); # no stub for parent } } } } ########################################################### # Utility function: remove local stub for given Apex file # ########################################################### sub CleanupStub ($) { my ($filename) = @_; my ($dir,$name,$kind,$ext) = SplitApexName ($filename); my $stub="$name.$kind.$ext"; if ( -e "$INTDIR/$stub" ) { unlink("$INTDIR/$stub"); } } ################################################## # Utility function: split an Apex file name into # # (Directory,Name,Kind, Extension) # ################################################## sub SplitApexName ($) { my ($filename) = @_; my ($dir,$name,$kind,$ext) = ($filename =~ /^((?:.*[:\\\/])?)(.*)\.([12])\.(ada)$/); return ($dir,$name,$kind,$ext); } 1; sub atl_exec($$$) { my ($exe,$out,$parameters) = @_; print "--- Running $exe $parameters\n"; unlink( $out ); unlink("attolcov.spt"); $status = SystemP( $exe, "$parameters" ); if ( (! -e "$out") && (-e "attolcov.spt") ) { rename ("attolcov.spt", "$out"); } return $status; } sub atl_execdbg($$$) { my ($exe,$out,$parameters) = @_; print "--- Debugging $exe $parameters\n"; unlink( $out ); # $status=SystemP("apex_display debug $exe $parameters"); # return $status; print "!!! Debug execution not supported from TestRT Studio\n"; print "--- Please debug '$exe' from Apex\n"; return 1; } 1; Apex NT/TestRT integration README file For v2003.06.01 Release $Revision: 1.25 $ 1 - Setup of the Apex GUI/TestRT integration (needs product administrator permissions on Apex and TestRT installations) - add the path of the Apex TDP's cmd directory to the Apex %APEX_MENUS_PATH% (so that Apex may find the ada_menus and ada_rules file in this directory). 2 - Setup of Test RealTime runtime and model views (needs product administrator permissions on Apex installation) Before creating test views with Apex, the appropriate set(s) of Test RealTime runtime and model views should be setup, based on the model(s) of the Apex views containing the units to test. - This may be done using the 'testrtbuild' script provided with the TDP, using the '-model' option to designate the base model from which the runtime view should be built, and the new model (which includes an import of the runtime view) generated. - This may also be done by selecting in an Apex directory viewer a user view with the appropriate base model, and using the 'TestRT> Maintenance> Build Test runtime and model views' menu item. 3 - Component Testing / Code Coverage / Trace - Select in the Apex directory browser the tower of views containing the units to test. This may be done by explicit selection of a (single) view or/and by selection of configuration files listing the views. - In the Apex menu, select 'TestRT> Component Testing> Create Test Tower'. This will generate a copy (The TestRT tower) of the origin tower to be used to build and execute Rational Test Realtime tests. Views in this new tower have a '_TestRT' suffix. - Launch 'Studio', the Rational Test RealTime GUI. - Create a new project. - Choose a name for your project. - Choose the Rational Apex TDP. - Create a new Component Testing Activity. - Select (in the origin tower) the unit to test. - The name of the Component Testing node should be the Ada name of the unit under test. - In 'Settings...> Build> Compiler', change the setting for 'User Link File for Ada' to be the 'link.alk' file in the TestRT view containing the unit under test. - In 'Settings...> General> Directories', change the setting for 'Temporary' directory to be the 'TestRT' subdirectory of the TestRT view containing the unit under test. - Then complete the creation of your project as usual. Once the project has been generated, the user can use Rational Test RealTime with Rational Apex as usual. Note: - Using 'TestRT> Component Testing> Create Test Tower' when the Test tower already exists simply re-generates the 'link file' in the existing tower. - To force the deletion/re-creation of any existing views in the Test tower, use 'TestRT> Component Testing> Re-create Test Tower' . 4 - Code Coverage Standalone mode - Select in the Apex directory browser the tower of views containing the units to instrument. This may be done by explicit selection of a (single) view or/and by selection of configuration files listing the views. - In the Apex menu, select 'TestRT> Code Coverage> Code Coverage Options...'. Enable these options and modify them as desired. Do not forget to specify the dump point in 'Function-specific Dump'. - In the Apex menu, select 'TestRT> Code Coverage> Create Instrumented Tower'. This will generate a copy (The Coverage tower) of the origin tower containing instrumented versions of the unit. Views in this new tower have a '_TestRT_Cov' suffix. - The instrumentation options (and name of the main procedure) used will be those listed in the 'coverage_<userid>.opt' options file of the Coverage tower (this file will be created if not present in the origin tower). - Link this main procedure in the Coverage tower to generate the instrumented executable. - Run this executable. - Select the 'attolcov.spt' traces file that gets generated in the same view. - In the Apex menu, select 'TestRT> Code Coverage> View Coverage Report'. This will launch the Rational Test RealTime GUI to display the coverage results. Note: - Using 'TestRT> Code Coverage> Create Instrumented Tower' when the Coverage tower already exists simply re-instruments the units in the existing tower (with different options if the options file was modified). - To force the deletion/re-creation of any existing views in the Coverage tower, use 'TestRT> Code Coverage> Re-create Instrumented Tower' . Create a tower of Apex views for unit testing from a base tower require $ENV{'RTRT_APEX_TDP'}."/cmd/utility.pl"; ############################################### # Setup global/environment variables # ############################################### sub Setup { &Set_env(); $login = getlogin() || (getpwuid($<))[0] || ""; $login=~s/ +.*//; $delete_existing = 0; $TEMP_MODEL_LST="$ENV{'TEMP'}/model.$$.lst"; $TEMP_ALL_MODEL_LST="$ENV{'TEMP'}/all_model.$$.lst"; $TEMP_ATTOLCMD_LOG="$ENV{'TEMP'}/attolcmd.$$.log"; } ############################################### # Split from a ss name - build target view name # ############################################### sub SplitSsName { my ($dir_src_view,$base_src_view,$ext_src_view) = SplitFileName($view_list[0]); # arbitrarily based on 1st view in list if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { $dest_suffix="$login\_TestRT.rss"; $dir_src_view=~/(.*\.rss)\/(.*)\//; $dir_src_view=~s/\/$//; $dir_src_enclosing=$2; } else { $dest_suffix="$login\_TestRT.wrk"; $dir_src_view=~/(.*\.ss)\/(.*)\//; $dir_src_enclosing=$2; } if ( $dir_src_enclosing eq "") { $target_view_name="$base_src_view\_$dest_suffix"; } else { $target_view_name="$dir_src_enclosing/$base_src_view\_$dest_suffix"; } } ############################################### # Parameters check - build list of source views # ############################################### sub Check_parameters { if ( ($#ARGV+1) == 0 ) { Mexit ("*** No source view(s) or configuration(s) selected", 1); } foreach(@ARGV) { if ( $_ eq "-force" ) { $delete_existing = 1; } elsif ( ( ! ( /\.wrk$/ ) ) && ( ! ( /\.cfg$/ ) ) && ( ! (/\.rel$/) ) && ( ! (/\.rss$/) ) ) { print "++* Ignoring: $_\n"; } elsif ( ( /\.wrk$/ ) || ( /\.rel$/) || ( /\.rss$/) ) { push(@view_list,$_); } elsif ( /\.cfg$/ ) { push(@cfg_list,$_); } } foreach(@cfg_list) { my $cfg_file=$_; open(IN_CFG,"$cfg_file") || Mexit("*** Cannot open file $cfg_file",1); while(<IN_CFG>) { chomp; next if(/^[ \t]*$/); next if(/^#/); push(@view_list,$_); } close(IN_CFG); } if ( ($#view_list+1) == 0 ) { Mexit ("*** No source view(s) selected", 1); } } ############################################### # Check if all the models are compliant and # # if the corresponding TestRT model exists # ############################################### sub Check_model { my @Parameters=@view_list; my $model; my $ref_model=""; unlink("$TEMP_MODEL_LST"); unlink("$TEMP_ALL_MODEL_LST"); foreach(@Parameters) { system("apex properties $_ > $TEMP_MODEL_LST"); open(IN_MODEL,"$TEMP_MODEL_LST") || Mexit("*** Cannot open file $TEMP_MODEL_LST",1); open(OU_MODEL,">>$TEMP_ALL_MODEL_LST") || Mexit("*** Cannot open file $TEMP_ALL_MODEL_LST",1); while(<IN_MODEL>) { if (/model: /i) { ($model=$_)=~s/model://i; $model=~s/^\s+//; print OU_MODEL $model; } } close(IN_MODEL); close(OU_MODEL); } open(IN_ALL_MODEL,"$TEMP_ALL_MODEL_LST") || Mexit("*** Cannot open file $TEMP_ALL_MODEL_LST",1); while(<IN_ALL_MODEL>) { if ( $ref_model eq "" ) { $ref_model=$_; } if ( ! ( $ref_model eq $_ ) ) { Mexit("*** Cannot create a test tower from views with different models",1); } } close(IN_ALL_MODEL); if ($ref_model=~/\.testrt\./) { Mexit("*** Cannot create a test view from a test view",1); } ($testrt_model=$ref_model)=~s/\.(...)$/\.testrt\.$ENV{'RTRT_PROD_VERSION'}\.$1/; chomp($testrt_model); if ( ! ( -d $testrt_model ) ) { print "*** The required TestRT model is not installed : $testrt_model\n"; Mexit("!!! Please have it installed by your Apex administrator",1); } } ############################################### # Copy source views to target views (Apex/Summit) # ############################################### sub Copy_views_Summit { my @Parameters=@view_list; $existing_views=0; my $dest_view; foreach (@Parameters) { my $ss=`cpath -s $_`; chomp ($ss); $dest_view="$ss/$target_view_name"; if ( -d $dest_view ) { $existing_views+=1; if ( $delete_existing == 1) { my $status=system("apex discard -uncontrol -recursive -force $dest_view"); $existing_views-=1 if(! $status); } else { print "!!! View $dest_view already exists.\n"; } } } if ( $existing_views == 0 ) { my $status=system("apex copy_view -model $testrt_model @view_list $target_view_name"); # Win32 Mexit("*** View copy failed",$status) if($status); } elsif ( $existing_views < ($#view_list + 1) ) { print "*** A subset of destination views already exists\n"; Mexit("!!! Please delete it before recreating it or select matching subset of source views.",1); } else { print "--- Assuming link file generation only for existing destination views.\n"; } } ############################################### # Copy source views to target views (Apex/Clearcase) # ############################################### sub Copy_views_Clearcase { my @Parameters=@view_list; $existing_views=0; my $dest_view; foreach (@Parameters) { my $ss=`cpath -s $_`; chomp ($ss); ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; if ( -d $dest_view ) { $existing_views+=1; if ( $delete_existing == 1) { my $status=system("apex discard -recursive -force $dest_view"); $existing_views-=1 if(! $status); } else { print "!!! View $dest_view already exists.\n"; } } } if ( $existing_views == 0 ) { my @Params=@view_list; foreach (@Params) { my $ss=`cpath -s $_`; chomp ($ss); ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; my $status=system("apex copy_view -model $testrt_model $ss $dest_view"); # Win32 Mexit("*** View copy failed",$status) if($status); } } elsif ( $existing_views < ($#view_list + 1) ) { print "*** A subset of destination views already exists\n"; Mexit("!!! Please delete it before recreating it or select matching subset of source views.",1); } else { print "--- Assuming link file generation only for existing destination views.\n"; } } ################################################## # Update imports for generated rss (Apex/Clearcase) # ################################################## sub Update_Imports { my @Parameters=@view_list; my $dest_view; foreach (@Parameters) { my $ss=`cpath -s $_`; chomp ($ss); ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; my @ImportsToRemoveAfterCopy; my @ImportsToAddAfterCopy; open(IN,"<$dest_view/Imports/Description.cfg") || die "Cannot open Imports File $dest_view/Imports/Description.cfg\n"; while(<IN>) { chomp; $current_view=$_; if (/_$dest_suffix/) { if ( ! ( -d $current_view ) ) { push(@ImportsToRemoveAfterCopy,"$current_view"); ($original_view=$current_view)=~s/_$dest_suffix$/\.rss/; push(@ImportsToAddAfterCopy,"$original_view"); } } else { ($test_view=$current_view)=~s/\.rss$/_$dest_suffix/; if ( -d $test_view ) { push(@ImportsToRemoveAfterCopy,"$current_view"); push(@ImportsToAddAfterCopy,"$test_view"); } } } close(IN); foreach(@ImportsToRemoveAfterCopy) { next if(/\Q$ENV{'APEX_BASE'}\E/); $Status=system("apex remove_import $dest_view $_"); Mexit("apex remove_import $dest_view $_",$Status) if($Status); } foreach(@ImportsToAddAfterCopy) { next if(/\Q$ENV{'APEX_BASE'}\E/); $Status=system("apex import $dest_view $_"); Mexit("apex import $dest_view $_",$Status) if($Status); } $Status=system("apex import -refresh $dest_view"); Mexit("apex import -refresh $dest_view",$Status) if($Status); } } ############################################### # Link file creation # ############################################### sub Create_alk { my @Parameters=@view_list; foreach(@Parameters) { my %MLDirs_src; my %MLDirs_dest; my $src_view=$_; my $ss=`cpath -s $src_view`; chomp ($ss); if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; } else { $dest_view="$ss/$target_view_name"; } getDirsFromView("$src_view",'\\.[12]\\.ada$',\%MLDirs_src); my $status=system("attolalk $dest_view/link.alk ".join(' ',keys %MLDirs_src)." > $TEMP_ATTOLCMD_LOG 2>&1"); Mexit("*** attolalk failed for $src_view",$status) if($status); unlink("$TEMP_ATTOLCMD_LOG"); # Create view subdirectory that will be usable as INTDIR mkdir ("$dest_view/TestRT",0777); getDirsFromView("$dest_view",'\\.[12]\\.ada$',\%MLDirs_dest); mkdir ("$dest_view/.Rational/TestRT",0777); my $status=system("attolalk $dest_view/.Rational/TestRT/link.alk ".join(' ',keys %MLDirs_dest)." > $TEMP_ATTOLCMD_LOG 2>&1"); Mexit("*** attolalk failed for $dest_view",$status) if($status); unlink("$TEMP_ATTOLCMD_LOG"); print "+++ Link file generation was successful for $dest_view\n"; } } ############################################### # All target views # # are mutually imported # ############################################### sub Mutual_imports { my @Parameters=@view_list; my $dest_views=""; my $dest_view; foreach(@Parameters) { my $ss=`cpath -s $_`; chomp ($ss); if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; $dest_views.="$dest_view "; } else { $dest_views.="$ss/$target_view_name "; } } foreach(@Parameters) { # Win32: (partial) workaround for ApexNT bug: # Win32: must remove inter-tower explicit imports before setting up mutual imports my $ss=`cpath -s $_`; chomp ($ss); if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; } else { $dest_view="$ss/$target_view_name"; } my $status=system("apex remove_import $dest_view $dest_views"); Mexit("*** Remove imports failed",$status) if($status); } my $status=system("apex import -mutual $dest_views"); Mexit("*** Mutual import setup failed",$status) if($status); } ############################################### # Cleanup function # ############################################### sub Cleanup { my $status = shift; &Dump_log ("$TEMP_ATTOLCMD_LOG") if($status); # Clean up any leftover files unlink("$TEMP_MODEL_LST"); unlink("$TEMP_ALL_MODEL_LST"); unlink("$TEMP_ATTOLCMD_LOG"); } ############################################### # Error exit function # ############################################### sub Mexit { my $string=shift; my $status=shift; &Cleanup($status); print $string."\n"; print "++* Test tower creation was unsuccessful\n"; print "::: [Test tower creation has finished]\n"; exit($status); } ############################################### # main # ############################################### print "::: [$0 @ARGV]\n"; &Setup(); &Check_parameters(); &SplitSsName(); &Check_model(); if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { &Copy_views_Clearcase(); &Update_Imports(); } else { &Copy_views_Summit(); } &Create_alk(); if ( ( $existing_views == 0 ) && ( ($#view_list+1) > 1 ) ) { &Mutual_imports(); } &Cleanup(0); print "+++ Test tower creation was successful\n"; print "::: [Test tower creation has finished]\n"; 1; Utility script executed (from lib/scripts/tdp/tdpgen.pl) after saving TDP. use File::Copy; sub postGen { my $DirTdp=shift; $pwd='cd'; chdir("$ENV{'TESTRTDIR'}/bin/intel"); $TestRtDir = ShortPathName($ENV{'TESTRTDIR'}); chdir($pwd); copy("$DirTdp/cmd/ada95.alk","$DirTdp/ana/ada95/ada95.alk"); copy("$DirTdp/cmd/ada83.alk","$DirTdp/ana/ada83/ada83.alk"); # Generate front-end .bat files for Perl scripts copy("$DirTdp/cmd/generic.bat","$DirTdp/cmd/coverage.bat"); copy("$DirTdp/cmd/generic.bat","$DirTdp/cmd/viewReport.bat"); copy("$DirTdp/cmd/generic.bat","$DirTdp/cmd/unitest.bat"); copy("$DirTdp/cmd/generic.bat","$DirTdp/cmd/testrtbuild.bat"); # Patch paths in 'ada_rules' file open(IN_RULES,"$DirTdp/cmd/ada_rules"); open(OU_RULES,">$DirTdp/cmd/ada_rules_tmp"); while(<IN_RULES>) { my $line = $_; if ( /_TESTRTDIR_/ ) { $line=~s/_TESTRTDIR_/$TestRtDir/g; } print OU_RULES $line; } close(IN_RULES); close(OU_RULES); rename("$DirTdp/cmd/ada_rules_tmp","$DirTdp/cmd/ada_rules"); unlink("$DirTdp/cmd/ada_rules_tmp"); } 1; ----------------------------------------------------------------------------- -- $Revision: 1.25 $ ----------------------------------------------------------------------------- -- -- Link file for Ada95 predefined environment. -- -- CAUTION: -- This file contains configuration using types defined in Standard package. -- It's possible you have to comment lines using undefined types -- (like short_short_integer, or long_long_float ...) -- ----------------------------------------------------------------------------- -- Apex: use an "empty" standard link file -- (for Apex, predefined units, apart from Standard and System, will be managed as -- part of user link file). Create a tower of instrumented Apex views from a base tower (or re-instrumented existing tower). require $ENV{'RTRT_APEX_TDP'}."/cmd/utility.pl"; ############################################### # Setup global/environment variables # ############################################### sub Setup { &Set_env(); $login = getlogin() || (getpwuid($<))[0] || ""; $login=~s/ +.*//; $coverage_opt="Coverage_Options.opt"; $TESTRTCL="TestRTcl.exe"; # Win32 $delete_existing = 0; $TEMP_MODEL_LST="$ENV{'TEMP'}/model.$$.lst"; $TEMP_ALL_MODEL_LST="$ENV{'TEMP'}/all_model.$$.lst"; $TEMP_ATTOLCMD_LOG="$ENV{'TEMP'}/attolcmd.$$.log"; $TEMP_INSTR_ADA="$ENV{'TEMP'}/instr.$$.ada"; } ############################################### # Split from a ss name - build target view name # ############################################### sub SplitSsName { my ($dir_src_view,$base_src_view,$ext_src_view) = SplitFileName($view_list[0]); # arbitrarily based on 1st view in list if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { $dest_suffix="$login\_TestRT_Cov.rss"; $dir_src_view=~/(.*\.rss)\/(.*)\//; $dir_src_view=~s/\/$//; $dir_src_enclosing=$2; } else { $dest_suffix="$login\_TestRT_Cov.wrk"; $dir_src_view=~/(.*\.ss)\/(.*)\//; $dir_src_enclosing=$2; } if ( $dir_src_enclosing eq "") { $target_view_name="$base_src_view\_$dest_suffix"; } else { $target_view_name="$dir_src_enclosing/$base_src_view\_$dest_suffix"; } } ############################################### # Parameters check - build list of source views # ############################################### sub Check_parameters { if ( ($#ARGV+1) == 0 ) { Mexit ("*** No source view(s) or configuration(s) selected", 1); } foreach(@ARGV) { if ( $_ eq "-force" ) { $delete_existing = 1; } elsif ( ( ! ( /\.wrk$/ ) ) && ( ! ( /\.cfg$/ ) ) && ( ! (/\.rel$/) ) && ( ! (/\.rss$/) ) ) { print "++* Ignoring: $_\n"; } elsif ( ( /\.wrk$/ ) || ( /\.rel$/) || ( /\.rss$/) ) { push(@view_list,$_); } elsif ( /\.cfg$/ ) { push(@cfg_list,$_); } } foreach(@cfg_list) { my $cfg_file=$_; open(IN_CFG,"$cfg_file") || Mexit("*** Cannot open file $cfg_file",1); while(<IN_CFG>) { chomp; next if(/^[ \t]*$/); next if(/^#/); push(@view_list,$_); } close(IN_CFG); } if ( ($#view_list+1) == 0 ) { Mexit ("*** No source view(s) selected", 1); } } ############################################### # Check if all the models are compliant and # # if the corresponding TestRT model exists # ############################################### sub Check_model { my @Parameters=@view_list; my $model; my $ref_model=""; unlink("$TEMP_MODEL_LST"); unlink("$TEMP_ALL_MODEL_LST"); foreach(@Parameters) { system("apex properties $_ > $TEMP_MODEL_LST"); open(IN_MODEL,"$TEMP_MODEL_LST") || Mexit("*** Cannot open file $TEMP_MODEL_LST",1); open(OU_MODEL,">>$TEMP_ALL_MODEL_LST") || Mexit("*** Cannot open file $TEMP_ALL_MODEL_LST",1); while(<IN_MODEL>) { if (/model: /i) { ($model=$_)=~s/model://i; $model=~s/^\s+//; print OU_MODEL $model; } } close(IN_MODEL); close(OU_MODEL); } open(IN_ALL_MODEL,"$TEMP_ALL_MODEL_LST") || Mexit("*** Cannot open file $TEMP_ALL_MODEL_LST",1); while(<IN_ALL_MODEL>) { if ( $ref_model eq "" ) { $ref_model=$_; } if ( ! ( $ref_model eq $_ ) ) { Mexit("*** Cannot create an Instrumented tower from views with different models",1); } } close(IN_ALL_MODEL); if ($ref_model=~/\.testrt\./) { Mexit("*** Cannot create an instrumented view from an instrumented view",1); } ($testrt_model=$ref_model)=~s/\.(...)$/\.testrt\.$ENV{'RTRT_PROD_VERSION'}\.$1/; chomp($testrt_model); if ( ! ( -d $testrt_model ) ) { print "!!! The required TestRT model is not installed : $testrt_model\n"; Mexit("--- Please have it installed by your Apex administrator.",1); } # Ada83 or Ada95 ? my ($dir_model,$base_model,$ext_model) = SplitFileName($testrt_model); $base_model=~/.*\.(ada..)\..*/; $ada_language=$1; } ############################################### # Check if the instrumentation options # # file exists and if instrumentation phase is enabled (Win32 only) # ############################################### sub Check_attolopt { my @Parameters=@view_list; $attolopt; my $existence_attolopt=0; my $dest_view; $attolopt=$ENV{'RTRT_APEX_TDP'}."/cmd/$coverage_opt"; $attolopt_act=$ENV{'RTRT_APEX_TDP'}."/cmd/$coverage_opt"."_act"; open(IN_ACT,$attolopt_act) || Mexit("!!! No previous Coverage setup, please check Coverage options",1); my $act=<IN_ACT>; if ( $act == 0 ) { Mexit("!!! Coverage setup disabled, please check Coverage options",1); } close(IN_ACT); } ############################################### # Copy source views to target views (Apex/Summit) # ############################################### sub Copy_views_Summit { my @Parameters=@view_list; $existing_views=0; my $dest_view; foreach (@Parameters) { my $ss=`cpath -s $_`; chomp ($ss); $dest_view="$ss/$target_view_name"; if ( -d $dest_view ) { $existing_views+=1; if ( $delete_existing == 1) { my $status=system("apex discard -uncontrol -recursive -force $dest_view"); $existing_views-=1 if(! $status); } else { print "!!! View $dest_view already exists.\n"; } } } if ( $existing_views == 0 ) { my $status=system("apex copy_view -model $testrt_model @view_list $target_view_name"); # Win32 Mexit("*** View copy failed",$status) if($status); } elsif ( $existing_views < ($#view_list + 1) ) { print "*** A subset of destination views already exists\n"; Mexit("!!! Please delete it before recreating it or select matching subset of source views.",1); } else { print "--- Assuming instrumentation only for existing destination views.\n"; } } ############################################### # Copy source views to target views (Apex/Clearcase) # ############################################### sub Copy_views_Clearcase { my @Parameters=@view_list; $existing_views=0; my $dest_view; foreach (@Parameters) { my $ss=`cpath -s $_`; chomp ($ss); ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; if ( -d $dest_view ) { $existing_views+=1; if ( $delete_existing == 1) { my $status=system("apex discard -recursive -force $dest_view"); $existing_views-=1 if(! $status); } else { print "!!! View $dest_view already exists.\n"; } } } if ( $existing_views == 0 ) { my @Params=@view_list; foreach (@Params) { my $ss=`cpath -s $_`; chomp ($ss); ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; my $status=system("apex copy_view -model $testrt_model $ss $dest_view"); # Win32 Mexit("*** View copy failed",$status) if($status); } } elsif ( $existing_views < ($#view_list + 1) ) { print "*** A subset of destination views already exists\n"; Mexit("!!! Please delete it before recreating it or select matching subset of source views.",1); } else { print "--- Assuming instrumentation only for existing destination views.\n"; } } ############################################### # Update imports for generated rss (Apex/Clearcase) # # Remove-Replace Instrumented versions of imports # ############################################### sub Update_Imports { my @Parameters=@view_list; my $dest_view; foreach (@Parameters) { my $ss=`cpath -s $_`; chomp ($ss); ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; my @ImportsToRemoveAfterCopy; my @ImportsToAddAfterCopy; open(IN,"<$dest_view/Imports/Description.cfg") || die "Cannot open Imports File $dest_view/Imports/Description.cfg\n"; while(<IN>) { chomp; $current_view=$_; if (/_$dest_suffix/) { if ( ! ( -d $current_view ) ) { push(@ImportsToRemoveAfterCopy,"$current_view"); ($original_view=$current_view)=~s/_$dest_suffix$/\.rss/; push(@ImportsToAddAfterCopy,"$original_view"); } } else { ($test_view=$current_view)=~s/\.rss$/_$dest_suffix/; if ( -d $test_view ) { push(@ImportsToRemoveAfterCopy,"$current_view"); push(@ImportsToAddAfterCopy,"$test_view"); } } } close(IN); foreach(@ImportsToRemoveAfterCopy) { next if(/\Q$ENV{'APEX_BASE'}\E/); $Status=system("apex remove_import $dest_view $_"); Mexit("apex remove_import $dest_view $_",$Status) if($Status); } foreach(@ImportsToAddAfterCopy) { next if(/\Q$ENV{'APEX_BASE'}\E/); $Status=system("apex import $dest_view $_"); Mexit("apex import $dest_view $_",$Status) if($Status); } $Status=system("apex import -refresh $dest_view"); Mexit("apex import -refresh $dest_view",$Status) if($Status); } } ############################################### # Link file creation # ############################################### sub Create_alk { my @Parameters=@view_list; foreach(@Parameters) { my %MLDirs_src; my %MLDirs_dest; my $src_view=$_; my $ss=`cpath -s $src_view`; chomp ($ss); if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; } else { $dest_view="$ss/$target_view_name"; } getDirsFromView("$src_view",'\\.[12]\\.ada$',\%MLDirs_src); my $status=system("attolalk $dest_view/link.alk ".join(' ',keys %MLDirs_src)." > $TEMP_ATTOLCMD_LOG 2>&1"); Mexit("*** attolalk failed for $src_view",$status) if($status); unlink("$TEMP_ATTOLCMD_LOG"); getDirsFromView("$dest_view",'\\.[12]\\.ada$',\%MLDirs_dest); mkdir ("$dest_view/.Rational/TestRT",0777); my $status=system("attolalk $dest_view/.Rational/TestRT/link.alk ".join(' ',keys %MLDirs_dest)." > $TEMP_ATTOLCMD_LOG 2>&1"); Mexit("*** attolalk failed for $dest_view",$status) if($status); unlink("$TEMP_ATTOLCMD_LOG"); print "+++ Link file generation was successful for $dest_view\n"; } } ############################################### # Instrumentation of all Ada bodies # # in the target views # ############################################### sub Instrument { my @Parameters=@view_list; foreach(@Parameters) { my %DirsToInstr; my $src_view=$_; my $ss=`cpath -s $src_view`; chomp ($ss); if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { ($dest_view=$ss)=~s/\.rss$/_$dest_suffix/; } else { $dest_view="$ss/$target_view_name"; } getSubDirs("$src_view",'\\.2\\.ada$',\%DirsToInstr); foreach(keys %DirsToInstr) { my $src_dir=$_; my $dest_dir; $dest_view=~s/\\/\//g; # Win32 $src_view=~s/\\/\//g; # Win32 $src_dir=~s/\\/\//g; # Win32 ($dest_dir=$src_dir)=~s/$src_view/$dest_view/; my @bodies_list; opendir(DIR,$src_dir) || Mexit("*** Cannot open directory $src_dir",1); while($f=readdir(DIR)) { push(@bodies_list,$f) if($f=~/\.2\.ada$/); } closedir(DIR); foreach(@bodies_list) { chomp; my $body=$_; print "--- Instrumenting $dest_dir/$body\n"; my $status=system("attolada $src_dir/$body $TEMP_INSTR_ADA \@$attolopt -link=$dest_view/link.alk -$ada_language -fdcdir=$dest_view/.Rational/TestRT > $TEMP_ATTOLCMD_LOG 2>&1"); Mexit("*** attolada Error",$status) if($status); unlink("$TEMP_ATTOLCMD_LOG"); my $status=system("attolchop -w $TEMP_INSTR_ADA $dest_dir > $TEMP_ATTOLCMD_LOG 2>&1"); Mexit("*** attolchop Error",$status) if($status); unlink("$TEMP_ATTOLCMD_LOG"); unlink("$TEMP_INSTR_ADA"); } } } } ############################################### # Cleanup function # ############################################### sub Cleanup { my $status = shift; &Dump_log ("$TEMP_ATTOLCMD_LOG") if($status); # Clean up any leftover files unlink("$TEMP_ATTOLCMD_LOG"); unlink("$TEMP_INSTR_ADA"); unlink("$TEMP_MODEL_LST"); unlink("$TEMP_ALL_MODEL_LST"); } ############################################### # Error exit function # ############################################### sub Mexit { my $string=shift; my $status=shift; &Cleanup($status); print $string."\n"; print "++* Instrumented tower creation was unsuccessful\n"; print "::: [Instrumented tower creation has finished]\n"; exit($status); } ############################################### # main # ############################################### print "::: [$0 @ARGV]\n"; &Setup(); &Check_parameters(); &SplitSsName(); &Check_model(); &Check_attolopt(); if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { &Copy_views_Clearcase(); &Update_Imports(); } else { &Copy_views_Summit(); } &Create_alk(); &Instrument(); &Cleanup(0); print "+++ Instrumented tower creation was successful\n"; print "::: [Instrumented tower creation has finished]\n"; 1; Prepare coverage report from traces file(s) in instrumented Apex tower require $ENV{'RTRT_APEX_TDP'}."/cmd/utility.pl"; ############################################### # Setup global/environment variables # ############################################### sub Setup { &Set_env(); $TEMP_ATTOLCMD_LOG="$ENV{'TEMP'}/attolcmd.$$.log"; } ############################################### # Check Parameters and build a list of all the # # fdc directories in associated views # ############################################### sub Check_params { my @Parameters=@ARGV; $fdc_list=""; foreach(@Parameters) { my ($dir,$base,$ext)=SplitFileName($_); if ( ( ! ( $ext eq "tio" ) ) && ( ! ( $ext eq "spt" ) ) ) { print "++* Ignoring: $_\n"; } else { if ( lc($ENV{'APEX_CLEARCASE_ENABLED'}) eq "true" ) { $dir=~/(.*\.rss)/; $dir_src_view=$1; } else { $dir=~/(.*\.wrk)/; $dir_src_view=$1; } my %MLDirs_fdc; getDirsFromView("$dir_src_view",'\\.fdc$',\%MLDirs_fdc); $fdc_list.=join(' ',keys %MLDirs_fdc)." "; } } $fdc_list=~s/\.Rational\/TestRT/\.Rational\/TestRT\/\*\.fdc/g; # Remove duplicate parameters from fdc_list @array_fdc_list=split(/\s+/, $fdc_list); @sorted_array_fdc_list=sort @array_fdc_list; $last_elt=$sorted_array_fdc_list[0]; $fdc_list=""; $fdc_list="$last_elt " if ( $last_elt=~/\.Rational\/TestRT/ ); foreach (@sorted_array_fdc_list) { next if ( ! (/\.Rational\/TestRT/) ); $current_elt=$_; if ( ! ( $current_elt eq $last_elt ) ) { $fdc_list.=$current_elt." "; $last_elt=$current_elt; } } } ############################################### # Convert spt file into tio file # ############################################### sub Convert_spt { my @Parameters=@ARGV; foreach(@Parameters) { my ($dir,$base,$ext)=SplitFileName($_); if ( $ext eq "spt" ) { print "--- Splitting traces file $_\n"; $ENV{'ATC_TRACES'}="$dir$base.tio"; my $status=system("atlsplit $_ > $TEMP_ATTOLCMD_LOG 2>&1"); Mexit("*** atlsplit failed for $_",$status) if($status); unlink("$TEMP_ATTOLCMD_LOG"); } } } ############################################### # Launch GUI # ############################################### sub Launch_studio { my @Parameters=@ARGV; my $tio_list=""; foreach(@Parameters) { my ($dir,$base,$ext)=SplitFileName($_); if ( ( $ext eq "tio" ) || ( $ext eq "spt" ) ) { $tio_list.="$dir$base.tio "; } } print "--- Launching TestRT Studio on $tio_list...\n"; my $status=system("$ENV{'COMSPEC'} /c start studio $tio_list $fdc_list"); # Win32 Mexit("*** Launch of Studio failed",$status) if($status); } ############################################### # Cleanup function # ############################################### sub Cleanup { my $status = shift; &Dump_log ("$TEMP_ATTOLCMD_LOG") if($status); # Clean up any leftover files unlink("$TEMP_ATTOLCMD_LOG"); } ############################################### # Error exit # ############################################### sub Mexit { my $string=shift; my $status=shift; &Cleanup($status); print $string."\n"; print "++* View coverage report was unsuccessful\n"; print "::: [View coverage report has finished]\n"; exit($status); } ############################################### # main # ############################################### print "::: [$0 @ARGV]\n"; &Setup(); &Check_params(); &Convert_spt(); &Launch_studio(); &Cleanup(0); print "+++ View coverage report was successful\n"; print "::: [View coverage report has finished]\n"; 1; Utility functions shared by other scripts. $SCRIPTDIR="$ENV{'TESTRTDIR'}/lib/scripts/"; require $SCRIPTDIR."/Fcts.pl"; use File::Copy; ############################################### # Set environment variables # ############################################### sub Set_env { use FileHandle; STDOUT->autoflush(1); # make sure our output appears in correct order in Apex windows ##$ENV{'TEMP'}="/tmp"; # Win32: should use TEMP if defined... # The following variables are only used by coverage.pl and viewReport.pl $ENV{'ATLTGT'}="$ENV{'RTRT_APEX_TDP'}"; $ENV{'ATTOLCHOP'}="Apex"; ##$INSTR_OPTIONS="-PROC=RET -BLOCK=IMPLICIT -COND -MAIN=main"; # Win32: not needed } ############################################### # Split a file name into # # (Directory,Name,Extension) # ############################################### #sub SplitFileName ($) #{ # my ($filename) = @_; # # my @file = ($filename =~ /^((?:.*[:\\\/])?)(.*)\.(.*)/); # # return @file; #} ############################################### # List all the subdirectories where files match # # the pattern passed as parameter # ############################################### sub getSubDirs { my $in=shift; my $pattern=shift; my $tab=shift; my $flagSpc=0; my @SubDirs; opendir(DIR,$in) || Mexit("*** Cannot open directory $in",1); while($d=readdir(DIR)) { if ($d=~/^attol.*\.adb$/) { $flagSpc=0; # skip $INTDIR last; } next if($d=~/^AtlWork$/); next if($d=~/^\.$/); next if($d=~/^\.\.$/); next if(-l $in."/".$d); push(@SubDirs,$in."/".$d) if(-d $in."/".$d); $flagSpc=1 if($d=~/$pattern/); } closedir(DIR); $$tab{$in}=1 if($flagSpc==1); foreach(@SubDirs) { getSubDirs($_,$pattern,$tab); } } ############################################### # List all the directories contained in a given # # given view and the views it imports # ############################################### sub getDirsFromView { my $in=shift; my $pattern=shift; my $tab=shift; my @Imports; my @Mutual; open(IN,"$in/Imports/Description\.cfg") || Mexit("*** Cannot open file $in/Imports/Description\.cfg",1); while(<IN>) { chomp; next if(/^\s*$/); next if(/^#/); ##next if((/lrm\.ss/)||(/predefined\.ss/)); # do *not* skip predefined units push(@Imports,$_); } close(IN); foreach(@Imports) { getDirsFromView($_,$pattern,$tab); } open(IN,"$in/Imports/Mutual_Description\.cfg") || Mexit("*** Cannot open file $in/Imports/Mutual_Description\.cfg",1); while(<IN>) { chomp; next if(/^\s*$/); next if(/^#/); push(@Mutual,$_); } close(IN); foreach(@Mutual) { getSubDirs($_,$pattern,$tab); } getSubDirs($in,$pattern,$tab); } ############################################### # Dump log file if it exists # ############################################### sub Dump_log { my $logfile = shift; if ( -r $logfile ) { open(IN_LOG,"$logfile"); while(<IN_LOG>) { print "### $_"; } close(IN_LOG); } } 1; Utility script to build TestRT runtime view and associated model view from a given base Apex model require $ENV{'RTRT_APEX_TDP'}."/cmd/utility.pl"; ######################################################################### # Command: # # testrtbuild (build TestRT runtime view and associated model) # ######################################################################### sub do_exit { my $status = shift; if ( $status == 0 ) { print "+++ testrtbuild was successful\n"; } else { print "++* testrtbuild was unsuccessful\n"; } print "::: [testrtbuild has finished]\n"; exit($status); } ######################################################################### # usage # ######################################################################### sub usage { print "--- testrtbuild : build TestRT runtime view and associated model\n"; print "*** usage : testrtbuild (-model base_model_view | base_view)\n"; } ######################################################################### # setup # ######################################################################### sub setup { $RTRT_PROD_VERSION="$ENV{'RTRT_PROD_VERSION'}"; $RTRT_APEX_TDP="$ENV{'RTRT_APEX_TDP'}"; } ######################################################################### # Split a file name into # # (Directory,Name,Extension) # ######################################################################### #sub SplitFileName ($) #{ # my ($filename) = @_; # # my @file = ($filename =~ /^((?:.*[:\\\/])?)(.*)\.(.*)/); # # return @file; #} ######################################################################### # Read appropriate pattern in the properties file # ######################################################################### sub view_property { my $pattern = shift; my $view_name = shift; my $view_props_file = "$view_name/.Rational/View_Control/View_Properties.prop"; open(IN,"<$view_props_file") || die "Cannot open properties file $view_props_file\n"; while(<IN>) { if (/$pattern/) { ($value=$_)=~s/$pattern: //; } } close(IN); chomp($value); return($value); } ######################################################################### # Check context # ######################################################################### sub check_context { if ( ! $ENV{'APEX_BASE'} ) { print "*** testrtbuild : should be run in the context of an Apex session\n"; &do_exit(3); } $apex_base_ada = "$ENV{'APEX_BASE'}/ada"; $apex_base_ada=~s/\\/\//g; $testrt_sfx = "testrt.$RTRT_PROD_VERSION"; $tdp_ada_lib = "$RTRT_APEX_TDP/lib"; if ( ! ( -d $tdp_ada_lib ) ) { print "*** testrtbuild : TestRT runtime source directory '$tdp_ada_lib' not found\n"; &do_exit(3); } } ######################################################################### # Check arguments # ######################################################################### sub check_arguments { $base_view_path = ""; $base_model_path = ""; if ( ($#ARGV+1) == 1 ) { # given view is a standard view (whose model will be used as base model) $base_view_path = $ARGV[0]; } elsif ( ( ($#ARGV+1) == 2 ) && ( $ARGV[0] eq "-model" ) ) { # given view is a model view, which will be used as base model $base_model_path = $ARGV[1]; } else { &usage(); &do_exit(3); } if ( ! ($base_view_path eq "") ) { if ( ! ( -d $base_view_path ) ) { print "*** Base view '$base_view_path' not found\n"; &do_exit(1); } # Parse base view name and get its model property $base_view_path=`cpath $base_view_path`; # canonize chomp($base_view_path); $base_view=`cpath -v $base_view_path`; #get enclosing view path chomp($base_view); if ( $base_view ne $base_view_path ) { print "*** '$base_view_path' is not an Apex view\n"; &do_exit(1); } $base_model_path = &view_property(MODEL,$base_view_path); if ( $base_model_path eq "" ) { print "*** Base view '$base_view_path' has no model\n"; &do_exit(1); } else { print "--- using base model: '$base_model_path'\n"; } } if ( ! ( -d $base_model_path ) ) { print "*** Base model '$base_model_path' not found\n"; &do_exit(1); } # Parse base model name and get its properties $base_model_path=`cpath $base_model_path`; # canonize chomp($base_model_path); $base_model_view=`cpath -v $base_model_path`; # get enclosing view path chomp($base_model_view); if ( $base_model_view ne $base_model_path ) { print "*** '$base_model_path' is not an Apex view\n"; &do_exit(1); } $base_model_ss=`cpath -s $base_model_path`; # get enclosing subsystem path chomp($base_model_ss); if ( lc($base_model_ss) ne lc("$apex_base_ada/model.ss") ) { # Warn... print "!!! '$base_model_path' is not a predefined Apex model\n"; print "--- User-defined model assumed\n"; # and reset base directory ($model_dir,$model_name,$model_ext) = SplitFileName($base_model_ss); $apex_base_ada = $model_dir; print "!!! Subsystems and views will be created in '$apex_base_ada'\n"; } ($base_model_view_dir,$base_model_view_name,$ext) = SplitFileName($base_model_view); if ( ( $ext ne "wrk" ) && ( $ext ne "rel" ) ) { print "*** Unknown model view kind\n"; &do_exit(1); } $compiler_language = &view_property(COMPILER_ADA_DIALECT, $base_model_path); if ( $compiler_language eq "" ) { # Not Ada95 $compiler_language = &view_property(Compiler_Language, $base_model_path); } } ######################################################################### # Create TestRT subsystem if needed # ######################################################################### sub create_testrt_ss { $rts_ss = "$apex_base_ada/testrt.ss"; if ( ! ( -d $rts_ss ) ) { my $status = system("apex create_subsystem $rts_ss"); if ( $status ) { print "*** Could not create TestRT runtime subsystem '$rts_ss'\n"; &do_exit(1); } else { print "+++ TestRT runtime subsystem created\n"; } } } ######################################################################### # Create TestRT view from base model # ######################################################################### sub create_testrt_view { $rts_view = "$rts_ss/$base_model_view_name.$testrt_sfx.$ext"; my $status = system("apex create_working -model $base_model_view $rts_view"); if ( $status ) { print "*** Could not create TestRT runtime view '$rts_view'\n"; &do_exit(1); } else { print "+++ TestRT runtime view created\n"; } } ######################################################################### # Migrate units from TDP source library into runtime view # ######################################################################### sub migrate_units { # Start with common sources my $status = system("apex migrate -into $rts_view $tdp_ada_lib/*.ad?"); if ( ! $status ) { # go on with dialect specific sources if ( $compiler_language eq "Ada_95" ) { # Ada95 $status = system("apex migrate -into $rts_view $tdp_ada_lib/ada95/*.ad?"); } else { # assume Ada83 $status = system("apex migrate -into $rts_view $tdp_ada_lib/ada83/*.ad?"); } } if ( $status ) { print "*** Could not parse TestRT runtime sources into '$rts_view'\n"; &do_exit(1); } } ######################################################################### # Code units from TDP source library into runtime view # ######################################################################### sub code_units { # code view my $status = system("apex code $rts_view"); if ( $status ) { print "*** Could not code TestRT runtime units in '$rts_view'\n"; &do_exit(1); } else { print "+++ TestRT runtime view coded\n"; } } ######################################################################### # Create new TestRT specific model from base model # ######################################################################### sub create_model { $model_view="$base_model_view_dir/$base_model_view_name.$testrt_sfx.$ext"; my $status = system("apex copy_view $base_model_view $model_view"); if ( $status ) { print "*** Could not create TestRT model view '$model_view'\n"; &do_exit(1); } else { print "+++ TestRT model view created\n"; } } ######################################################################### # Add import of runtime view into new model # ######################################################################### sub add_import { my $status = system("apex import $model_view $rts_view"); if ( $status ) { print "*** Could not update imports of TestRT model view '$model_view'\n"; &do_exit(1); } else { print "+++ TestRT model view imports updated\n"; } } ######################################################################### # main # ######################################################################### print "::: [testrtbuild @ARGV]\n"; &setup(); &check_context(); &check_arguments(); &create_testrt_ss(); &create_testrt_view(); &migrate_units(); &code_units(); &create_model(); &add_import(); # All done print "--- TestRT runtime view '$rts_view' now available\n"; print "--- TestRT model view '$model_view' now available\n"; &do_exit(0); 1; ------------------------------------------------------------------------- -- $Revision: 1.25 $ ------------------------------------------------------------------------- -- -- Link File for predefined Ada83 environment. -- You can customise this file. -- ------------------------------------------------------------------------- -- Apex: use an "empty" standard link file -- (for Apex, predefined units, apart from Standard and System, will be managed as -- part of user link file). Generic front-end for Perl scripts @echo off rem Generic xxx.bat script to invoke xxx.pl TDP script from Apex rem change this if the Apex TDP is renamed set TDP=adawinapex set RTRT_PROD_VERSION=2003.06.01 rem (optional) set traces rem set ATTOLSTUDIO_VERBOSE=1 rem set env vars set RTRT_APEX_TDP=%~dp0.. set RTRT_PERL_LIB=%RTRT_APEX_TDP%\..\..\lib\perl set RTRT_ARCH_BIN=%RTRT_APEX_TDP%\..\..\bin\intel\win32 rem set other useful env vars set ATTOLCHOP=APEX "%RTRT_ARCH_BIN%\perl" -I"%RTRT_PERL_LIB%" "%~dpn0.pl" %1 %2 %3 %4 %5 %6 %7 %8 %9 @echo on TestRealTime ada_menus menu file for Apex NT #////////////////////////////////////////////////// # # TestRealTime directory_menus menu file for Apex # Apex expects to find it in a directory in %APEX_MENUS_PATH% # #///////////////////////////////////////////////// append cascade testrt Te&stRT append pushbutton testrt.LaunchStudio &Launch Studio append separator testrt.sep1 append cascade testrt.coverage Code Coverage append pushbutton testrt.coverage.CovOptions Code Coverage &Options... append pushbutton testrt.coverage.Instrument Create &Instrumented Tower append pushbutton testrt.coverage.InstrumentForce Re-create Instrumented Tower append pushbutton testrt.coverage.CovViewer View Co&verage Report append cascade testrt.unittesting Component Testing append pushbutton testrt.unittesting.TestTowerCreation Crea&te Test Tower append pushbutton testrt.unittesting.TestTowerCreationForce Re-create Test Tower append separator testrt.sep2 append cascade testrt.maintenance Maintenance append pushbutton testrt.maintenance.TestRTBuild &Build Test runtime and model views append pushbutton testrt.maintenance.ViewReadme View TDP &usage notes #///////////////////////////////////////////////// TestRealTime ada_rules menu file for Apex NT #////////////////////////////////////////////////// # # TestRealTime directory_rules menu file for Apex # Apex expects to find it in a directory in %APEX_MENUS_PATH% # #///////////////////////////////////////////////// action LaunchStudio options No_Register Title "Launching TestRT Studio in <CONTEXT>" _TESTRTDIR_\bin\intel\win32\studio <FILES> end_action action CovOptions options No_Register Title "Launching Coverage Setup for Ada Language" _TESTRTDIR_\bin\intel\win32\TestRTcl.exe -ada -nolink -nostaticdir _TESTRTDIR_\targets\adawinapex\cmd\Coverage_Options.opt end_action action Instrument options Title "Instrumentation in <CONTEXT>" options hide_window apex output_to_gui _TESTRTDIR_\targets\adawinapex\cmd\coverage.bat <FILES> end_action action InstrumentForce options Title "Instrumentation in <CONTEXT>" options hide_window apex output_to_gui _TESTRTDIR_\targets\adawinapex\cmd\coverage.bat -force <FILES> end_action action CovViewer options Title "View coverage report in <CONTEXT>" options hide_window apex output_to_gui _TESTRTDIR_\targets\adawinapex\cmd\viewReport.bat <FILES> end_action action TestTowerCreation options Title "Unit testing tower creation in <CONTEXT>" options hide_window apex output_to_gui _TESTRTDIR_\targets\adawinapex\cmd\unitest.bat <FILES> end_action action TestTowerCreationForce options Title "Unit testing tower creation in <CONTEXT>" options hide_window apex output_to_gui _TESTRTDIR_\targets\adawinapex\cmd\unitest.bat -force <FILES> end_action action TestRTBuild options Title "TestRT runtime and model view build for <CONTEXT>" options hide_window apex output_to_gui _TESTRTDIR_\targets\adawinapex\cmd\testrtbuild.bat <ENCLOSING_VIEW_OR_CONTEXT> end_action action ViewReadme options Title "View TDP usage notes" visit _TESTRTDIR_\targets\adawinapex\cmd\README.Apex end_action #////////////////////////// action doubleClick file *.rtp *.rtw *.ptu *.xrd *.tsf *.tdf *.tpf *.tqf *.fdc *.rtx options No_Register _TESTRTDIR_\studio <FILES> end_action action doubleClick file *.spt *.tio options Title "View coverage report in <CONTEXT>" options hide_window apex output_to_gui _TARGETDIR_\adawinapex\cmd\viewReport.bat <FILES> end_action #////////////////////////// -- Add with clauses with text_io; integer integer long_float text_io.file_type 100 32 Could be -(2**(access_size-1)) -(2**(access_size-1)) Could be (2**(access_size-1))-1 (2**(access_size-1))-1 31 0 1 1 "D0" "attolcov.spt" -- Give functions specifications -- Add with clauses with text_io; with system;use system; function priv_clock return priv_int is result:priv_int; begin -- must return -1 if clock is not implemented result:=-1; return(result); end priv_clock; procedure priv_init(I : in integer) is begin null; end priv_init; procedure priv_open(file : in out priv_file; name : in string ) is begin text_io.create(file,text_io.out_file,name,"REPLACE=>TRUE"); end priv_open; procedure priv_writeln(file : in out priv_file; line: in string) is begin text_io.put(file,line); text_io.new_line(file); end priv_writeln; procedure priv_close(file : in out priv_file) is begin text_io.close(file); end priv_close; -- Insert additional function bodies here package Standard is -- type *Universal_Integer* is [universal_integer]; -- type *Universal_Real* is [universal_real]; -- type *Universal_Fixed* is [universal_fixed]; -- type Boolean is (False, True); type BOOLEAN is _internal(BOOLEAN); type Integer is range -2147483648 .. 2147483647; type Short_Integer is range -32768 .. 32767; type Short_Short_Integer is range -128 .. 127; type Long_Integer is range -2147483648 .. 2147483647; type _INTERNAL_INTEGER is _internal(INTERNAL_INTEGER); type Float is digits 6 range -16#FFFFF.F#E+27 .. 16#FFFFF.F#E+27; type Short_Float is digits 6 range -16#FFFFF.F#E+27 .. 16#FFFFF.F#E+27; type Long_Float is digits 15 range -16#FFFFFFFFFFFFF.8#E+243 .. 16#FFFFFFFFFFFFF.8#E+243; type _INTERNAL_FLOAT is _internal(INTERNAL_FLOAT83); subtype Natural is Integer range 0 .. 2147483647; subtype Positive is Integer range 1 .. 2147483647; type Duration is delta 0.0001 range -214748.3648 .. 214748.3647; for Duration'Small use 0.0001; -- type Character is (ASCII.NUL, ASCII.SOH, ASCII.STX, ASCII.ETX, ASCII.EOT, -- ... -- 'w', 'x', 'y', 'z', '{', '|', '}', '~', ASCII.DEL, -- LATIN_1.CHAR_80, LATIN_1.CHAR_81, LATIN_1.CHAR_82, -- ... -- 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ'); type CHARACTER is _INTERNAL(CHARACTER_8); for CHARACTER'SIZE use 8; package Ascii is -- Nul : constant Character := *NUL*; -- Soh : constant Character := *SOH*; -- Stx : constant Character := *STX*; -- Etx : constant Character := *ETX*; -- Eot : constant Character := *EOT*; -- Enq : constant Character := *ENQ*; -- Ack : constant Character := *ACK*; -- Bel : constant Character := *BEL*; -- Bs : constant Character := *BS*; -- Ht : constant Character := *HT*; -- Lf : constant Character := *LF*; -- Vt : constant Character := *VT*; -- Ff : constant Character := *FF*; -- Cr : constant Character := *CR*; -- So : constant Character := *SO*; -- Si : constant Character := *SI*; -- Dle : constant Character := *DLE*; -- Dc1 : constant Character := *DC1*; -- Dc2 : constant Character := *DC2*; -- Dc3 : constant Character := *DC3*; -- Dc4 : constant Character := *DC4*; -- Nak : constant Character := *NAK*; -- Syn : constant Character := *SYN*; -- Etb : constant Character := *ETB*; -- Can : constant Character := *CAN*; -- Em : constant Character := *EM*; -- Sub : constant Character := *SUB*; -- Esc : constant Character := *ESC*; -- Fs : constant Character := *FS*; -- Gs : constant Character := *GS*; -- Rs : constant Character := *RS*; -- Us : constant Character := *US*; -- Del : constant Character := *DEL*; NUL : constant Character := CHARACTER'VAL(0); SOH : constant Character := CHARACTER'VAL(1); STX : constant Character := CHARACTER'VAL(2); ETX : constant Character := CHARACTER'VAL(3); EOT : constant Character := CHARACTER'VAL(4); ENQ : constant Character := CHARACTER'VAL(5); ACK : constant Character := CHARACTER'VAL(6); BEL : constant Character := CHARACTER'VAL(7); BS : constant Character := CHARACTER'VAL(8); HT : constant Character := CHARACTER'VAL(9); LF : constant Character := CHARACTER'VAL(10); VT : constant Character := CHARACTER'VAL(11); FF : constant Character := CHARACTER'VAL(12); CR : constant Character := CHARACTER'VAL(13); SO : constant Character := CHARACTER'VAL(14); SI : constant Character := CHARACTER'VAL(15); DLE : constant Character := CHARACTER'VAL(16); DC1 : constant Character := CHARACTER'VAL(17); DC2 : constant Character := CHARACTER'VAL(18); DC3 : constant Character := CHARACTER'VAL(19); DC4 : constant Character := CHARACTER'VAL(20); NAK : constant Character := CHARACTER'VAL(21); SYN : constant Character := CHARACTER'VAL(22); ETB : constant Character := CHARACTER'VAL(23); CAN : constant Character := CHARACTER'VAL(24); EM : constant Character := CHARACTER'VAL(25); SUB : constant Character := CHARACTER'VAL(26); ESC : constant Character := CHARACTER'VAL(27); FS : constant Character := CHARACTER'VAL(28); GS : constant Character := CHARACTER'VAL(29); RS : constant Character := CHARACTER'VAL(30); US : constant Character := CHARACTER'VAL(31); DEL : constant Character := CHARACTER'VAL(127); Exclam : constant Character := '!'; Sharp : constant Character := '#'; Percent : constant Character := '%'; Colon : constant Character := ':'; Query : constant Character := '?'; L_Bracket : constant Character := '['; R_Bracket : constant Character := ']'; Underline : constant Character := '_'; L_Brace : constant Character := '{'; R_Brace : constant Character := '}'; Quotation : constant Character := '"'; Dollar : constant Character := '$'; Ampersand : constant Character := '&'; Semicolon : constant Character := ';'; At_Sign : constant Character := '@'; Back_Slash : constant Character := '\'; Circumflex : constant Character := '^'; Grave : constant Character := '`'; Bar : constant Character := '|'; Tilde : constant Character := '~'; Lc_A : constant Character := 'a'; Lc_B : constant Character := 'b'; Lc_C : constant Character := 'c'; Lc_D : constant Character := 'd'; Lc_E : constant Character := 'e'; Lc_F : constant Character := 'f'; Lc_G : constant Character := 'g'; Lc_H : constant Character := 'h'; Lc_I : constant Character := 'i'; Lc_J : constant Character := 'j'; Lc_K : constant Character := 'k'; Lc_L : constant Character := 'l'; Lc_M : constant Character := 'm'; Lc_N : constant Character := 'n'; Lc_O : constant Character := 'o'; Lc_P : constant Character := 'p'; Lc_Q : constant Character := 'q'; Lc_R : constant Character := 'r'; Lc_S : constant Character := 's'; Lc_T : constant Character := 't'; Lc_U : constant Character := 'u'; Lc_V : constant Character := 'v'; Lc_W : constant Character := 'w'; Lc_X : constant Character := 'x'; Lc_Y : constant Character := 'y'; Lc_Z : constant Character := 'z'; end Ascii; type String is array (Positive range <>) of Character; Constraint_Error : exception; Numeric_Error : exception; Storage_Error : exception; Tasking_Error : exception; Program_Error : exception; -- type *Anytype* is -- record -- null; -- end record; end Standard; package Standard is -- type *Universal_Integer* is [universal_integer]; -- type *Universal_Real* is [universal_real]; -- type *Universal_Fixed* is [universal_fixed]; -- type Boolean is (False, True); type BOOLEAN is _internal(BOOLEAN); type Integer is range -2147483648 .. 2147483647; -- type *Root_Integer* is range -2147483648 .. 2147483647; type Short_Integer is range -32768 .. 32767; type Short_Short_Integer is range -128 .. 127; type Long_Integer is range -2147483648 .. 2147483647; type _INTERNAL_INTEGER is _internal(INTERNAL_INTEGER); type Float is digits 6 range -16#FFFFF.F#E+27 .. 16#FFFFF.F#E+27; type Short_Float is digits 6 range -16#FFFFF.F#E+27 .. 16#FFFFF.F#E+27; type Long_Float is digits 15 range -16#FFFFFFFFFFFFF.8#E+243 .. 16#FFFFFFFFFFFFF.8#E+243; -- type *Root_Real* is digits 15 range -16#FFFFFFFFFFFFF.8#E+243 .. -- 16#FFFFFFFFFFFFF.8#E+243; type _INTERNAL_FLOAT is _internal(INTERNAL_FLOAT); subtype Natural is Integer range 0 .. 2147483647; subtype Positive is Integer range 1 .. 2147483647; type Duration is delta 0.0001 range -214748.3648 .. 214748.3647; for Duration'Small use 0.0001; -- type Character is (ASCII.NUL, ASCII.SOH, ASCII.STX, ASCII.ETX, ASCII.EOT, -- ... -- 'w', 'x', 'y', 'z', '{', '|', '}', '~', ASCII.DEL, -- LATIN_1.CHAR_80, LATIN_1.CHAR_81, LATIN_1.CHAR_82, -- ... -- 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ'); type CHARACTER is _INTERNAL(CHARACTER_8); for CHARACTER'SIZE use 8; -- type Wide_Character is (ASCII.NUL, ASCII.SOH, ASCII.STX, ASCII.ETX, -- ... -- '|', '}', '~', ASCII.DEL, LATIN_1.CHAR_80, -- LATIN_1.CHAR_81, LATIN_1.CHAR_82, LATIN_1.CHAR_83, -- ... -- '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ', -- '["100"]', '["101"]', '["102"]', '["103"]', -- ... -- '["FFFC"]', '["FFFD"]', '["FFFE"]', '["FFFF"]'); type WIDE_CHARACTER is _INTERNAL(WIDE_CHARACTER); package Ascii is -- Nul : constant Character := *NUL*; -- Soh : constant Character := *SOH*; -- Stx : constant Character := *STX*; -- Etx : constant Character := *ETX*; -- Eot : constant Character := *EOT*; -- Enq : constant Character := *ENQ*; -- Ack : constant Character := *ACK*; -- Bel : constant Character := *BEL*; -- Bs : constant Character := *BS*; -- Ht : constant Character := *HT*; -- Lf : constant Character := *LF*; -- Vt : constant Character := *VT*; -- Ff : constant Character := *FF*; -- Cr : constant Character := *CR*; -- So : constant Character := *SO*; -- Si : constant Character := *SI*; -- Dle : constant Character := *DLE*; -- Dc1 : constant Character := *DC1*; -- Dc2 : constant Character := *DC2*; -- Dc3 : constant Character := *DC3*; -- Dc4 : constant Character := *DC4*; -- Nak : constant Character := *NAK*; -- Syn : constant Character := *SYN*; -- Etb : constant Character := *ETB*; -- Can : constant Character := *CAN*; -- Em : constant Character := *EM*; -- Sub : constant Character := *SUB*; -- Esc : constant Character := *ESC*; -- Fs : constant Character := *FS*; -- Gs : constant Character := *GS*; -- Rs : constant Character := *RS*; -- Us : constant Character := *US*; -- Del : constant Character := *DEL*; NUL : constant Character := CHARACTER'VAL(0); SOH : constant Character := CHARACTER'VAL(1); STX : constant Character := CHARACTER'VAL(2); ETX : constant Character := CHARACTER'VAL(3); EOT : constant Character := CHARACTER'VAL(4); ENQ : constant Character := CHARACTER'VAL(5); ACK : constant Character := CHARACTER'VAL(6); BEL : constant Character := CHARACTER'VAL(7); BS : constant Character := CHARACTER'VAL(8); HT : constant Character := CHARACTER'VAL(9); LF : constant Character := CHARACTER'VAL(10); VT : constant Character := CHARACTER'VAL(11); FF : constant Character := CHARACTER'VAL(12); CR : constant Character := CHARACTER'VAL(13); SO : constant Character := CHARACTER'VAL(14); SI : constant Character := CHARACTER'VAL(15); DLE : constant Character := CHARACTER'VAL(16); DC1 : constant Character := CHARACTER'VAL(17); DC2 : constant Character := CHARACTER'VAL(18); DC3 : constant Character := CHARACTER'VAL(19); DC4 : constant Character := CHARACTER'VAL(20); NAK : constant Character := CHARACTER'VAL(21); SYN : constant Character := CHARACTER'VAL(22); ETB : constant Character := CHARACTER'VAL(23); CAN : constant Character := CHARACTER'VAL(24); EM : constant Character := CHARACTER'VAL(25); SUB : constant Character := CHARACTER'VAL(26); ESC : constant Character := CHARACTER'VAL(27); FS : constant Character := CHARACTER'VAL(28); GS : constant Character := CHARACTER'VAL(29); RS : constant Character := CHARACTER'VAL(30); US : constant Character := CHARACTER'VAL(31); DEL : constant Character := CHARACTER'VAL(127); Exclam : constant Character := '!'; Sharp : constant Character := '#'; Percent : constant Character := '%'; Colon : constant Character := ':'; Query : constant Character := '?'; L_Bracket : constant Character := '['; R_Bracket : constant Character := ']'; Underline : constant Character := '_'; L_Brace : constant Character := '{'; R_Brace : constant Character := '}'; Quotation : constant Character := '"'; Dollar : constant Character := '$'; Ampersand : constant Character := '&'; Semicolon : constant Character := ';'; At_Sign : constant Character := '@'; Back_Slash : constant Character := '\'; Circumflex : constant Character := '^'; Grave : constant Character := '`'; Bar : constant Character := '|'; Tilde : constant Character := '~'; Lc_A : constant Character := 'a'; Lc_B : constant Character := 'b'; Lc_C : constant Character := 'c'; Lc_D : constant Character := 'd'; Lc_E : constant Character := 'e'; Lc_F : constant Character := 'f'; Lc_G : constant Character := 'g'; Lc_H : constant Character := 'h'; Lc_I : constant Character := 'i'; Lc_J : constant Character := 'j'; Lc_K : constant Character := 'k'; Lc_L : constant Character := 'l'; Lc_M : constant Character := 'm'; Lc_N : constant Character := 'n'; Lc_O : constant Character := 'o'; Lc_P : constant Character := 'p'; Lc_Q : constant Character := 'q'; Lc_R : constant Character := 'r'; Lc_S : constant Character := 's'; Lc_T : constant Character := 't'; Lc_U : constant Character := 'u'; Lc_V : constant Character := 'v'; Lc_W : constant Character := 'w'; Lc_X : constant Character := 'x'; Lc_Y : constant Character := 'y'; Lc_Z : constant Character := 'z'; end Ascii; type String is array (Positive range <>) of Character; type Wide_String is array (Positive range <>) of Wide_Character; Constraint_Error : exception; Numeric_Error : exception renames Constraint_Error; Storage_Error : exception; Tasking_Error : exception; Program_Error : exception; -- type *Anytype* is -- record -- null; -- end record; end Standard; package System is type Name is (Alpha_Osf1, Hppa_Hpux, I386_Rx_I386, I386_Vw_I386, M68K_Rx_Mc68020_Hfp, M68K_Rx_Mc68020_Sfp, M68K_Rx_Mc68040, M68K_Rx_Mc68060, M68K_Vw_Mc68020_Hfp, M68K_Vw_Mc68020_Sfp, M68K_Vw_Mc68040, M68K_Vw_Mc68060, Mips_Irix5, Mips_Irix_N32, Mips_Rx_Mips1B, Mips_Rx_Mips2B, Mips_Rx_Mips2L, Mips_Vw_Mips1B, Mips_Vw_Mips2B, Power_Cross_Os2000_Mc68881, Power_Lx_Ppc, Power_Rx_Ppc, Power_Rx_Ppcsfp, Power_Vw_Ppc, Power_Vw_Ppcsfp, Rh32_Rx_Rh32P3, Rs6000_Aix, Sparc_Solaris, Winnt_X86); System_Name : constant Name := Winnt_X86; Min_Int : constant := -16#80000000#; Max_Int : constant := 16#7FFFFFFF#; Max_Binary_Modulus : constant := 16#100000000#; Max_Digits : constant := 15; Max_Mantissa : constant := 31; Fine_Delta : constant := 16#0.2#E-7; Tick : constant := 1.0 / 100.0; type Address is private; Null_Address : constant Address; Storage_Unit : constant := 8; Memory_Size : constant := 16#100000000#; function "<" (Left, Right : in Address) return Boolean; function "<=" (Left, Right : in Address) return Boolean; function ">" (Left, Right : in Address) return Boolean; function ">=" (Left, Right : in Address) return Boolean; subtype Address_Sized_Integer is Integer; function To_Address (Value : in Address_Sized_Integer) return Address; function To_Integer (Value : in Address) return Address_Sized_Integer; type Address_Sized_Unsigned is mod 16#100000000#; function "+" (I : in Address_Sized_Unsigned) return Address; function Memory_Address (I : in Address_Sized_Unsigned) return Address renames "+"; function "+" (Left : in Address; Right : in Integer) return Address; function "+" (Left : in Integer; Right : in Address) return Address; function "-" (Left : in Address; Right : in Integer) return Address; function "-" (Left : in Address; Right : in Address) return Integer; function "+" (Left : in Address; Right : in Long_Integer) return Address; function "+" (Left : in Long_Integer; Right : in Address) return Address; function "-" (Left : in Address; Right : in Long_Integer) return Address; function "-" (Left : in Address; Right : in Address) return Long_Integer; type Bit_Order is (High_Order_First, Low_Order_First); Default_Bit_Order : constant Bit_Order := Low_Order_First; type Byte_Order_T is (Little_Endian, Big_Endian); Byte_Order : constant Byte_Order_T := Little_Endian; subtype Any_Priority is Integer range 0 .. 6; subtype Priority is Any_Priority range 0 .. 5; subtype Interrupt_Priority is Any_Priority range 6 .. 6; Default_Priority : constant Priority := 2; Address_Zero : constant Address; No_Addr : constant Address; Assertion_Error : exception; type Task_Id is private; No_Task_Id : constant Task_Id; type Passive_Task_Id is private; No_Passive_Task_Id : constant Passive_Task_Id; type Program_Id is private; No_Program_Id : constant Program_Id; subtype Sig_Status_T is Integer; Sig_Status_Size : constant := 4; subtype Day_T is Integer; function Return_Address return Address; private -- type *Addressable* is type _Addressable is record null; end record; -- type Address is access *Addressable*; type Address is access _Addressable; for Address'Storage_Size use 0; type Task_Id is new Address; type Passive_Task_Id is new Address; type Program_Id is new Address; Address_Zero : constant Address := null; Null_Address : constant Address := null; No_Addr : constant Address := null; No_Task_Id : constant Task_Id := null; No_Passive_Task_Id : constant Passive_Task_Id := null; No_Program_Id : constant Program_Id := null; pragma Import (Convention => Ada, Entity => Assertion_Error, External_Name => "SYSTEM.ASSERTION_ERROR", Link_Name => "__SYSTEM.ASSERTION_ERROR"); pragma Import (Convention => Intrinsic, Entity => To_Address); pragma Import (Convention => Intrinsic, Entity => To_Integer); pragma Import (Convention => Intrinsic, Entity => Return_Address); pragma Import (Convention => Intrinsic, Entity => "+"); pragma Import (Convention => Intrinsic, Entity => "-"); pragma Import (Convention => Intrinsic, Entity => "<"); pragma Import (Convention => Intrinsic, Entity => "<="); pragma Import (Convention => Intrinsic, Entity => ">"); pragma Import (Convention => Intrinsic, Entity => ">="); end System; pragma Api (Lrm); package System is pragma Pure; type Name is (Alpha_Osf1, Hppa_Hpux, I386_Rx_I386, I386_Vw_I386, M68K_Rx_Mc68020_Hfp, M68K_Rx_Mc68020_Sfp, M68K_Rx_Mc68040, M68K_Rx_Mc68060, M68K_Vw_Mc68020_Hfp, M68K_Vw_Mc68020_Sfp, M68K_Vw_Mc68040, M68K_Vw_Mc68060, Mips_Irix5, Mips_Irix_N32, Mips_Rx_Mips1B, Mips_Rx_Mips2B, Mips_Rx_Mips2L, Mips_Vw_Mips1B, Mips_Vw_Mips2B, Power_Cross_Os2000_Mc68881, Power_Lx_Ppc, Power_Rx_Ppc, Power_Rx_Ppcsfp, Power_Vw_Ppc, Power_Vw_Ppcsfp, Rh32_Rx_Rh32P3, Rs6000_Aix, Sparc_Solaris, Winnt_X86); System_Name : constant Name := Winnt_X86; Min_Int : constant := -16#80000000#; Max_Int : constant := 16#7FFFFFFF#; Max_Binary_Modulus : constant := 16#100000000#; Max_Nonbinary_Modulus : constant := 16#FFFFFFFF#; Max_Base_Digits : constant := 15; Max_Digits : constant := 15; Max_Mantissa : constant := 31; Fine_Delta : constant := 16#0.2#E-7; Tick : constant := 1.0 / 100.0; type Address is private; Null_Address : constant Address; Storage_Unit : constant := 8; Word_Size : constant := 32; Memory_Size : constant := 16#100000000#; function "<" (Left, Right : in Address) return Boolean; function "<=" (Left, Right : in Address) return Boolean; function ">" (Left, Right : in Address) return Boolean; function ">=" (Left, Right : in Address) return Boolean; type Bit_Order is (High_Order_First, Low_Order_First); Default_Bit_Order : constant Bit_Order := Low_Order_First; subtype Any_Priority is Integer range 0 .. 6; subtype Priority is Any_Priority range 0 .. 5; subtype Interrupt_Priority is Any_Priority range 6 .. 6; Default_Priority : constant Priority := 2; Address_Zero : constant Address; No_Addr : constant Address; Assertion_Error : exception; private -- type *Addressable* is null record; -- for *Addressable*'Alignment use 1; type _Addressable is null record; for _Addressable'Alignment use 1; -- type Address is access constant *Addressable*; type Address is access constant _Addressable; for Address'Storage_Size use 0; pragma Pure_Access_Type (Address); Address_Zero : constant Address := null; Null_Address : constant Address := null; No_Addr : constant Address := null; pragma Import (Convention => Ada, Entity => Assertion_Error, External_Name => "SYSTEM.ASSERTION_ERROR", Link_Name => "__SYSTEM.ASSERTION_ERROR"); pragma Import (Convention => Intrinsic, Entity => "<"); pragma Import (Convention => Intrinsic, Entity => "<="); pragma Import (Convention => Intrinsic, Entity => ">"); pragma Import (Convention => Intrinsic, Entity => ">="); end System; pragma Api (Lrm);